diff --git a/CMakeLists.txt b/CMakeLists.txt index 4d5c8eae4..b8cb88418 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -1,27 +1,9 @@ -# Set default project to unknown -if(NOT PROJECT) - message(STATUS "Setting CCPP project to 'unknown' as none was specified.") - set(PROJECT "Unknown") -endif (NOT PROJECT) - -#------------------------------------------------------------------------------ -cmake_minimum_required(VERSION 3.0) +cmake_minimum_required(VERSION 3.3) project(ccpp_physics VERSION 5.0.0 LANGUAGES Fortran) -# Use rpaths on MacOSX -set(CMAKE_MACOSX_RPATH 1) -if(POLICY CMP0042) - cmake_policy(SET CMP0042 NEW) -endif(POLICY CMP0042) - -# CMP0057: Support new IN_LIST if() operator -if(POLICY CMP0057) - cmake_policy(SET CMP0057 NEW) -endif(POLICY CMP0057) - #------------------------------------------------------------------------------ set(PACKAGE "ccpp-physics") set(AUTHORS "Grant Firl" "Dom Heinzeller" "Man Zhang" "Laurie Carson") @@ -29,11 +11,7 @@ set(AUTHORS "Grant Firl" "Dom Heinzeller" "Man Zhang" "Laurie Carson") #------------------------------------------------------------------------------ # Set OpenMP flags for C/C++/Fortran if (OPENMP) - include(detect_openmp) - detect_openmp() - message(STATUS "Enable OpenMP support") -else (OPENMP) - message (STATUS "Disable OpenMP support") + find_package(OpenMP REQUIRED) endif() #------------------------------------------------------------------------------ @@ -41,11 +19,16 @@ endif() if(NOT CMAKE_BUILD_TYPE AND NOT CMAKE_CONFIGURATION_TYPES) message(STATUS "Setting build type to 'Release' as none was specified.") set(CMAKE_BUILD_TYPE Release CACHE STRING "Choose the type of build." FORCE) - # Set the possible values of build type for cmake-gui set_property(CACHE CMAKE_BUILD_TYPE PROPERTY STRINGS "Debug" "Bitforbit" "Release" "Coverage") endif() +#------------------------------------------------------------------------------ +# Pass debug/release flag to Fortran files for preprocessor +if(CMAKE_BUILD_TYPE STREQUAL "Debug") + add_definitions(-DDEBUG) +endif() + #------------------------------------------------------------------------------ # Request a static build option(BUILD_SHARED_LIBS "Build a shared library" OFF) @@ -54,10 +37,10 @@ option(BUILD_SHARED_LIBS "Build a shared library" OFF) # Set the sources: physics type definitions set(TYPEDEFS $ENV{CCPP_TYPEDEFS}) if(TYPEDEFS) - message(STATUS "Got CCPP TYPEDEFS from environment variable: ${TYPEDEFS}") + message(STATUS "Got CCPP TYPEDEFS from environment variable") else(TYPEDEFS) include(${CMAKE_CURRENT_BINARY_DIR}/CCPP_TYPEDEFS.cmake) - message(STATUS "Got CCPP TYPEDEFS from cmakefile include file: ${TYPEDEFS}") + message(STATUS "Got CCPP TYPEDEFS from cmakefile include file") endif(TYPEDEFS) # Generate list of Fortran modules from the CCPP type @@ -70,33 +53,28 @@ endforeach() # Set the sources: physics schemes set(SCHEMES $ENV{CCPP_SCHEMES}) if(SCHEMES) - message(STATUS "Got CCPP SCHEMES from environment variable: ${SCHEMES}") + message(STATUS "Got CCPP SCHEMES from environment variable") else(SCHEMES) include(${CMAKE_CURRENT_BINARY_DIR}/CCPP_SCHEMES.cmake) - message(STATUS "Got CCPP SCHEMES from cmakefile include file: ${SCHEMES}") + message(STATUS "Got CCPP SCHEMES from cmakefile include file") endif(SCHEMES) # Set the sources: physics scheme caps set(CAPS $ENV{CCPP_CAPS}) if(CAPS) - message(STATUS "Got CCPP CAPS from environment variable: ${CAPS}") + message(STATUS "Got CCPP CAPS from environment variable") else(CAPS) include(${CMAKE_CURRENT_BINARY_DIR}/CCPP_CAPS.cmake) - message(STATUS "Got CCPP CAPS from cmakefile include file: ${CAPS}") + message(STATUS "Got CCPP CAPS from cmakefile include file") endif(CAPS) -# Create empty lists for schemes with special compiler optimization flags -set(SCHEMES_SFX_OPT "") -# Create empty lists for schemes with special floating point precision flags -set(SCHEMES_SFX_PREC "") -# Create a duplicate of the SCHEMES list for handling floating point precision flags -set(SCHEMES2 ${SCHEMES}) - # Schemes and caps from the CCPP code generator use full paths with symlinks # resolved, we need to do the same here for the below logic to work get_filename_component(FULL_PATH_TO_CMAKELISTS CMakeLists.txt REALPATH BASE_DIR ${LOCAL_CURRENT_SOURCE_DIR}) get_filename_component(LOCAL_CURRENT_SOURCE_DIR ${FULL_PATH_TO_CMAKELISTS} DIRECTORY) +#------------------------------------------------------------------------------ + # List of files that need to be compiled without OpenMP set(SCHEMES_OPENMP_OFF ${LOCAL_CURRENT_SOURCE_DIR}/physics/rte-rrtmgp/rrtmgp/mo_gas_optics.F90 ${LOCAL_CURRENT_SOURCE_DIR}/physics/rte-rrtmgp/rrtmgp/mo_rrtmgp_constants.F90 @@ -110,7 +88,6 @@ set(SCHEMES_OPENMP_OFF ${LOCAL_CURRENT_SOURCE_DIR}/physics/rte-rrtmgp/rrtmgp/mo_ ${LOCAL_CURRENT_SOURCE_DIR}/physics/rte-rrtmgp/tests/mo_testing_io.F90 ${LOCAL_CURRENT_SOURCE_DIR}/physics/rte-rrtmgp/tests/clear_sky_regression.F90 ${LOCAL_CURRENT_SOURCE_DIR}/physics/rte-rrtmgp/extensions/mo_rrtmgp_clr_all_sky.F90 - ${LOCAL_CURRENT_SOURCE_DIR}/physics/rte-rrtmgp/extensions/mo_fluxes_byband_kernels.F90 ${LOCAL_CURRENT_SOURCE_DIR}/physics/rte-rrtmgp/extensions/mo_fluxes_byband.F90 ${LOCAL_CURRENT_SOURCE_DIR}/physics/rte-rrtmgp/extensions/solar_variability/mo_solar_variability.F90 ${LOCAL_CURRENT_SOURCE_DIR}/physics/rte-rrtmgp/extensions/mo_heating_rates.F90 @@ -140,113 +117,52 @@ set(SCHEMES_OPENMP_OFF ${LOCAL_CURRENT_SOURCE_DIR}/physics/rte-rrtmgp/rrtmgp/mo_ ${LOCAL_CURRENT_SOURCE_DIR}/physics/rte-rrtmgp/rte/mo_rte_kind.F90 ${LOCAL_CURRENT_SOURCE_DIR}/physics/rte-rrtmgp/rte/mo_optical_props.F90) -#------------------------------------------------------------------------------ -if (${CMAKE_Fortran_COMPILER_ID} STREQUAL "GNU") - - if (PROJECT STREQUAL "CCPP-FV3") - # Set 32-bit floating point precision flags for certain files - # that are executed in the dynamics (fast physics part) - if (DYN32) - if (${LOCAL_CURRENT_SOURCE_DIR}/physics/gfdl_fv_sat_adj.F90 IN_LIST SCHEMES) - # Reduce floating point precision from 64-bit to 32-bit, if necessary - set(CMAKE_Fortran_FLAGS_PREC32 ${CMAKE_Fortran_FLAGS_DEFAULT_PREC}) - string(REPLACE "-fdefault-real-8" "" - CMAKE_Fortran_FLAGS_PREC32 "${CMAKE_Fortran_FLAGS_PREC32}") - string(REPLACE "-fdefault-double-8" "" - CMAKE_Fortran_FLAGS_PREC32 "${CMAKE_Fortran_FLAGS_PREC32}") - SET_PROPERTY(SOURCE ${LOCAL_CURRENT_SOURCE_DIR}/physics/gfdl_fv_sat_adj.F90 - APPEND_STRING PROPERTY COMPILE_FLAGS " ${CMAKE_Fortran_FLAGS_PREC32} ${OpenMP_Fortran_FLAGS} ") - # Add all of the above files to the list of schemes with special floating point precision flags - list(APPEND SCHEMES_SFX_PREC ${LOCAL_CURRENT_SOURCE_DIR}/physics/gfdl_fv_sat_adj.F90) - endif() - endif() +# List of files that need to be compiled with different precision +set(SCHEMES_DYNAMICS) - # Remove files with special floating point precision flags from list - # of files with standard floating point precision flags - if (SCHEMES_SFX_PREC) - list(REMOVE_ITEM SCHEMES2 ${SCHEMES_SFX_PREC}) - endif () - - if (PROJECT STREQUAL "CCPP-FV3") - # 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) - list(REMOVE_ITEM SCHEMES2 ${SCHEMES_OPENMP_OFF}) - endif () - # Assign standard floating point precision flags to all remaining schemes and caps - SET_PROPERTY(SOURCE ${SCHEMES_OPENMP_OFF} - APPEND_STRING PROPERTY COMPILE_FLAGS " ${CMAKE_Fortran_FLAGS_DEFAULT_PREC} ") - endif() - - # Assign standard floating point precision flags to all remaining schemes and caps - SET_PROPERTY(SOURCE ${SCHEMES2} ${CAPS} - APPEND_STRING PROPERTY COMPILE_FLAGS " ${CMAKE_Fortran_FLAGS_DEFAULT_PREC} ${OpenMP_Fortran_FLAGS} ") - - endif (PROJECT STREQUAL "CCPP-FV3") - -elseif (${CMAKE_Fortran_COMPILER_ID} STREQUAL "Intel") - # Adjust settings for bit-for-bit reproducibility of NEMSfv3gfs - if (PROJECT STREQUAL "CCPP-FV3") - - if (${LOCAL_CURRENT_SOURCE_DIR}/physics/module_sf_mynn.F90 IN_LIST SCHEMES) - # Reduce optimization for module_sf_mynn.F90 (to avoid an apparent compiler bug with Intel 18 on Hera) - SET_SOURCE_FILES_PROPERTIES(${LOCAL_CURRENT_SOURCE_DIR}/physics/module_sf_mynn.F90 - PROPERTIES COMPILE_FLAGS "${CMAKE_Fortran_FLAGS_OPT} -O1") - list(APPEND SCHEMES_SFX_OPT ${LOCAL_CURRENT_SOURCE_DIR}/physics/module_sf_mynn.F90) - endif() - - # Remove files with special compiler flags from list of files with standard compiler flags - if (SCHEMES_SFX_OPT) - list(REMOVE_ITEM SCHEMES ${SCHEMES_SFX_OPT}) - endif(SCHEMES_SFX_OPT) - # Assign standard compiler flags to all remaining schemes and caps - SET_SOURCE_FILES_PROPERTIES(${SCHEMES} ${CAPS} - PROPERTIES COMPILE_FLAGS "${CMAKE_Fortran_FLAGS_OPT}") - - # Set 32-bit floating point precision flags for certain files - # that are executed in the dynamics (fast physics part) - if (DYN32) - if (${LOCAL_CURRENT_SOURCE_DIR}/physics/gfdl_fv_sat_adj.F90 IN_LIST SCHEMES) - # Reduce floating point precision from 64-bit to 32-bit, if necessary - set(CMAKE_Fortran_FLAGS_PREC32 ${CMAKE_Fortran_FLAGS_DEFAULT_PREC}) - string(REPLACE "-real-size 64" "-real-size 32" - CMAKE_Fortran_FLAGS_PREC32 "${CMAKE_Fortran_FLAGS_PREC32}") - SET_PROPERTY(SOURCE ${LOCAL_CURRENT_SOURCE_DIR}/physics/gfdl_fv_sat_adj.F90 - APPEND_STRING PROPERTY COMPILE_FLAGS " ${CMAKE_Fortran_FLAGS_PREC32} ${OpenMP_Fortran_FLAGS} ") - # Add all of the above files to the list of schemes with special floating point precision flags - list(APPEND SCHEMES_SFX_PREC ${LOCAL_CURRENT_SOURCE_DIR}/physics/gfdl_fv_sat_adj.F90) - endif() - endif() +if(${LOCAL_CURRENT_SOURCE_DIR}/physics/gfdl_fv_sat_adj.F90 IN_LIST SCHEMES) + list(APPEND SCHEMES_DYNAMICS ${LOCAL_CURRENT_SOURCE_DIR}/physics/gfdl_fv_sat_adj.F90) +endif() - # Remove files with special floating point precision flags from list - # of files with standard floating point precision flags flags - if (SCHEMES_SFX_PREC) - list(REMOVE_ITEM SCHEMES2 ${SCHEMES_SFX_PREC}) - endif (SCHEMES_SFX_PREC) +# Remove files that need to be compiled with different precision +# of files with standard compiler flags, and assign OpenMP flags +if(SCHEMES_DYNAMICS) + SET_PROPERTY(SOURCE ${SCHEMES_DYNAMICS} + APPEND_STRING PROPERTY COMPILE_FLAGS " ${CMAKE_Fortran_FLAGS_DYNAMICS} ${OpenMP_Fortran_FLAGS}") + list(REMOVE_ITEM SCHEMES ${SCHEMES_DYNAMICS}) +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) - list(REMOVE_ITEM SCHEMES2 ${SCHEMES_OPENMP_OFF}) - # Assign standard floating point precision flags to all remaining schemes and caps - SET_PROPERTY(SOURCE ${SCHEMES_OPENMP_OFF} - APPEND_STRING PROPERTY COMPILE_FLAGS " ${CMAKE_Fortran_FLAGS_DEFAULT_PREC} ") - 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}") + list(REMOVE_ITEM SCHEMES ${SCHEMES_OPENMP_OFF}) +endif() - # Assign standard floating point precision flags to all remaining schemes and caps - SET_PROPERTY(SOURCE ${SCHEMES2} ${CAPS} - APPEND_STRING PROPERTY COMPILE_FLAGS " ${CMAKE_Fortran_FLAGS_DEFAULT_PREC} ${OpenMP_Fortran_FLAGS} ") +# 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}") - endif (PROJECT STREQUAL "CCPP-FV3") +# Reduce optimization for module_sf_mynn.F90 (to avoid an apparent compiler bug with Intel 18 on Hera) +if(${LOCAL_CURRENT_SOURCE_DIR}/physics/module_sf_mynn.F90 IN_LIST SCHEMES AND + (CMAKE_BUILD_TYPE STREQUAL "Release" OR CMAKE_BUILD_TYPE STREQUAL "Bitforbit") AND + ${CMAKE_Fortran_COMPILER_ID} STREQUAL "Intel") + SET_SOURCE_FILES_PROPERTIES(${LOCAL_CURRENT_SOURCE_DIR}/physics/module_sf_mynn.F90 + APPEND_STRING PROPERTY COMPILE_FLAGS " ${CMAKE_Fortran_FLAGS_PHYSICS} ${OpenMP_Fortran_FLAGS} -O1") +endif() -else() - message ("CMAKE_Fortran_COMPILER full path: " ${CMAKE_Fortran_COMPILER}) - message ("Fortran compiler: " ${CMAKE_Fortran_COMPILER_ID}) - message (FATAL_ERROR "This program has only been compiled with gfortran and ifort. If another compiler is needed, the appropriate flags must be added in ${GFS_PHYS_SRC}/CMakeLists.txt") +# Reduce optimization for mo_gas_optics_kernels.F90 (to avoid an apparent compiler bug with Intel 19+) +if(${LOCAL_CURRENT_SOURCE_DIR}/physics/rte-rrtmgp/rrtmgp/kernels/mo_gas_optics_kernels.F90 IN_LIST SCHEMES_OPENMP_OFF AND + (CMAKE_BUILD_TYPE STREQUAL "Release" OR CMAKE_BUILD_TYPE STREQUAL "Bitforbit") AND + ${CMAKE_Fortran_COMPILER_ID} STREQUAL "Intel") + SET_SOURCE_FILES_PROPERTIES(${LOCAL_CURRENT_SOURCE_DIR}/physics/rte-rrtmgp/rrtmgp/kernels/mo_gas_optics_kernels.F90 + APPEND_STRING PROPERTY COMPILE_FLAGS " ${CMAKE_Fortran_FLAGS_PHYSICS} -O1") endif() #------------------------------------------------------------------------------ -add_library(ccpp_physics STATIC ${SCHEMES} ${SCHEMES_SFX_OPT} ${CAPS}) + +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) @@ -263,20 +179,18 @@ target_include_directories(ccpp_physics PUBLIC target_link_libraries(ccpp_physics PUBLIC w3nco::w3nco_d NetCDF::NetCDF_Fortran) -if (PROJECT STREQUAL "CCPP-FV3") - # Define where to install the library - install(TARGETS ccpp_physics - EXPORT ccpp_physics-targets - ARCHIVE DESTINATION lib - LIBRARY DESTINATION lib - RUNTIME DESTINATION lib - ) - # Export our configuration - 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) -endif (PROJECT STREQUAL "CCPP-FV3") +# Define where to install the library +install(TARGETS ccpp_physics + EXPORT ccpp_physics-targets + ARCHIVE DESTINATION lib + LIBRARY DESTINATION lib + RUNTIME DESTINATION lib +) +# Export our configuration +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) diff --git a/CODEOWNERS b/CODEOWNERS index b6c597371..f8492f59f 100644 --- a/CODEOWNERS +++ b/CODEOWNERS @@ -3,7 +3,7 @@ # These owners will be the default owners for everything in the repo. #* @defunkt -* @DomHeinzeller +* @SamuelTrahanNOAA @DomHeinzeller # Order is important. The last matching pattern has the most precedence. # So if a pull request only touches javascript files, only these owners diff --git a/physics/GFS_DCNV_generic.meta b/physics/GFS_DCNV_generic.meta index 335c5593b..c719ae96c 100644 --- a/physics/GFS_DCNV_generic.meta +++ b/physics/GFS_DCNV_generic.meta @@ -422,7 +422,7 @@ [dtend] standard_name = cumulative_change_of_state_variables long_name = diagnostic tendencies for state variables - units = various + units = mixed dimensions = (horizontal_loop_extent,vertical_layer_dimension,cumulative_change_of_state_variables_outer_index_max) type = real kind = kind_phys diff --git a/physics/GFS_GWD_generic.meta b/physics/GFS_GWD_generic.meta index bd2bfbe87..f761ac5bc 100644 --- a/physics/GFS_GWD_generic.meta +++ b/physics/GFS_GWD_generic.meta @@ -31,7 +31,7 @@ [mntvar] standard_name = statistical_measures_of_subgrid_orography_collection_array long_name = array of statistical measures of subgrid height_above_mean_sea_level - units = various + units = mixed dimensions = (horizontal_loop_extent,number_of_statistical_measures_of_subgrid_orography) type = real kind = kind_phys @@ -165,7 +165,7 @@ [dtend] standard_name = cumulative_change_of_state_variables long_name = diagnostic tendencies for state variables - units = various + units = mixed dimensions = (horizontal_loop_extent,vertical_layer_dimension,cumulative_change_of_state_variables_outer_index_max) type = real kind = kind_phys @@ -327,7 +327,7 @@ [dtend] standard_name = cumulative_change_of_state_variables long_name = diagnostic tendencies for state variables - units = various + units = mixed dimensions = (horizontal_loop_extent,vertical_layer_dimension,cumulative_change_of_state_variables_outer_index_max) type = real kind = kind_phys diff --git a/physics/GFS_MP_generic.meta b/physics/GFS_MP_generic.meta index ccb6ba6d3..d14c11baf 100644 --- a/physics/GFS_MP_generic.meta +++ b/physics/GFS_MP_generic.meta @@ -730,7 +730,7 @@ [dtend] standard_name = cumulative_change_of_state_variables long_name = diagnostic tendencies for state variables - units = various + units = mixed dimensions = (horizontal_loop_extent,vertical_layer_dimension,cumulative_change_of_state_variables_outer_index_max) type = real kind = kind_phys diff --git a/physics/GFS_PBL_generic.meta b/physics/GFS_PBL_generic.meta index f267bf609..3dcf81043 100644 --- a/physics/GFS_PBL_generic.meta +++ b/physics/GFS_PBL_generic.meta @@ -721,7 +721,7 @@ [dtend] standard_name = cumulative_change_of_state_variables long_name = diagnostic tendencies for state variables - units = various + units = mixed dimensions = (horizontal_loop_extent,vertical_layer_dimension,cumulative_change_of_state_variables_outer_index_max) type = real kind = kind_phys diff --git a/physics/GFS_SCNV_generic.meta b/physics/GFS_SCNV_generic.meta index 8464ae9b8..90dc72d42 100644 --- a/physics/GFS_SCNV_generic.meta +++ b/physics/GFS_SCNV_generic.meta @@ -383,7 +383,7 @@ [dtend] standard_name = cumulative_change_of_state_variables long_name = diagnostic tendencies for state variables - units = various + units = mixed dimensions = (horizontal_loop_extent,vertical_layer_dimension,cumulative_change_of_state_variables_outer_index_max) type = real kind = kind_phys diff --git a/physics/GFS_debug.F90 b/physics/GFS_debug.F90 index 582c95718..23d1be573 100644 --- a/physics/GFS_debug.F90 +++ b/physics/GFS_debug.F90 @@ -545,6 +545,8 @@ subroutine GFS_diagtoscreen_run (Model, Statein, Stateout, Sfcprop, Coupling, end if ! Revised surface albedo and emissivity calculation call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Sfcprop%emis_lnd', Sfcprop%emis_lnd) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Sfcprop%emis_ice', Sfcprop%emis_ice) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Sfcprop%emis_wat', Sfcprop%emis_wat) ! NoahMP and RUC if (Model%lsm == Model%lsm_ruc .or. Model%lsm == Model%lsm_noahmp) then call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Sfcprop%albdirvis_lnd', Sfcprop%albdirvis_lnd) @@ -554,7 +556,6 @@ subroutine GFS_diagtoscreen_run (Model, Statein, Stateout, Sfcprop, Coupling, end if ! RUC only if (Model%lsm == Model%lsm_ruc) then - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Sfcprop%emis_ice', Sfcprop%emis_ice) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Sfcprop%albdirvis_ice', Sfcprop%albdirvis_ice) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Sfcprop%albdifvis_ice', Sfcprop%albdifvis_ice) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Sfcprop%albdirnir_ice', Sfcprop%albdirnir_ice) @@ -900,8 +901,6 @@ subroutine GFS_diagtoscreen_run (Model, Statein, Stateout, Sfcprop, Coupling, end if if (Model%do_RRTMGP) then call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Coupling%fluxlwUP_jac', Coupling%fluxlwUP_jac) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Coupling%fluxlwUP_allsky', Coupling%fluxlwUP_allsky) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Coupling%fluxlwDOWN_allsky', Coupling%fluxlwDOWN_allsky) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Coupling%htrlw', Coupling%htrlw) end if ! @@ -1306,18 +1305,12 @@ subroutine GFS_interstitialtoscreen_run (Model, Statein, Stateout, Sfcprop, Coup call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%scmpsw%nirdf ', Interstitial%scmpsw%nirdf ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%scmpsw%visbm ', Interstitial%scmpsw%visbm ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%scmpsw%visdf ', Interstitial%scmpsw%visdf ) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%semis_ice ', Interstitial%semis_ice ) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%semis_land ', Interstitial%semis_land ) -! call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%semis_water ', Interstitial%semis_water ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%sfcalb ', Interstitial%sfcalb ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%sigma ', Interstitial%sigma ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%sigmaf ', Interstitial%sigmaf ) 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%snowd_water ', Interstitial%snowd_water ) 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 ) @@ -1333,7 +1326,6 @@ subroutine GFS_interstitialtoscreen_run (Model, Statein, Stateout, Sfcprop, Coup call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%trans ', Interstitial%trans ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%tseal ', Interstitial%tseal ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%tsfa ', Interstitial%tsfa ) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%tsfc_ice ', Interstitial%tsfc_ice ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%tsfc_water ', Interstitial%tsfc_water ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%tsfg ', Interstitial%tsfg ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%tsurf_ice ', Interstitial%tsurf_ice ) @@ -1346,9 +1338,6 @@ subroutine GFS_interstitialtoscreen_run (Model, Statein, Stateout, Sfcprop, Coup call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%vdftra ', Interstitial%vdftra ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%vegf1d ', Interstitial%vegf1d ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%wcbmax ', Interstitial%wcbmax ) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%weasd_ice ', Interstitial%weasd_ice ) -! call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%weasd_land ', Interstitial%weasd_land ) -! call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%weasd_water ', Interstitial%weasd_water ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%wind ', Interstitial%wind ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%work1 ', Interstitial%work1 ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%work2 ', Interstitial%work2 ) @@ -1441,8 +1430,8 @@ subroutine GFS_interstitialtoscreen_run (Model, Statein, Stateout, Sfcprop, Coup 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%icseed_lw ', Interstitial%icseed_lw ) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%icseed_sw ', Interstitial%icseed_sw ) + 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 ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%fluxlwUP_clrsky ', Interstitial%fluxlwUP_clrsky ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%fluxlwDOWN_clrsky ', Interstitial%fluxlwDOWN_clrsky ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%fluxswUP_allsky ', Interstitial%fluxswUP_allsky ) diff --git a/physics/GFS_phys_time_vary.fv3.F90 b/physics/GFS_phys_time_vary.fv3.F90 index a8ecc1a5e..d6155e6b1 100644 --- a/physics/GFS_phys_time_vary.fv3.F90 +++ b/physics/GFS_phys_time_vary.fv3.F90 @@ -21,7 +21,7 @@ module GFS_phys_time_vary use h2o_def, only : levh2o, h2o_coeff, h2o_lat, h2o_pres, h2o_time, h2oplin use h2ointerp, only : read_h2odata, setindxh2o, h2ointerpol - use aerclm_def, only : aerin, aer_pres, ntrcaer, ntrcaerm + use aerclm_def, only : aerin, aer_pres, ntrcaer, ntrcaerm, iamin, iamax, jamin, jamax use aerinterp, only : read_aerdata, setindxaer, aerinterpol, read_aerdataf use iccn_def, only : ciplin, ccnin, ci_pres @@ -68,7 +68,7 @@ module GFS_phys_time_vary !! @{ 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, ozpl, jindx1_h, jindx2_h, ddy_h, h2opl, & + jindx1_o3, jindx2_o3, ddy_o3, ozpl, 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, & @@ -88,6 +88,7 @@ subroutine GFS_phys_time_vary_init ( integer, intent(in) :: me, master, ntoz, iccn, iflip, im, nx, ny logical, intent(in) :: h2o_phys, iaerclm, flag_restart integer, intent(in) :: idate(:) + real(kind_phys), intent(in) :: fhour real(kind_phys), intent(in) :: xlat_d(:), xlon_d(:) integer, intent(inout) :: jindx1_o3(:), jindx2_o3(:), jindx1_h(:), jindx2_h(:) @@ -173,7 +174,7 @@ subroutine GFS_phys_time_vary_init ( integer, intent(out) :: errflg ! Local variables - integer :: i, j, ix, vegtyp, iamin, iamax, jamin, jamax + integer :: i, j, ix, vegtyp real(kind_phys) :: rsnow !--- Noah MP @@ -387,8 +388,7 @@ subroutine GFS_phys_time_vary_init ( if (errflg/=0) return if (iaerclm) then - call read_aerdataf (iamin, iamax, jamin, jamax, me, master, iflip, & - idate, errmsg, errflg) + call read_aerdataf (me, master, iflip, idate, fhour, errmsg, errflg) if (errflg/=0) return end if @@ -715,7 +715,7 @@ end subroutine GFS_phys_time_vary_init 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, & - jindx1_o3, jindx2_o3, ddy_o3, ozpl, jindx1_h, jindx2_h, ddy_h, h2opl, & + 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, nthrds, nx, ny, nsst, tile_num, nlunit, lsoil, lsoil_lsm,& @@ -730,7 +730,7 @@ subroutine GFS_phys_time_vary_timestep_init ( ! Interface variables integer, intent(in) :: me, master, cnx, cny, isc, jsc, nrcm, im, levs, kdt, & - nsswr, imfdeepcnv, iccn, nscyc, ntoz + nsswr, imfdeepcnv, iccn, nscyc, ntoz, iflip integer, intent(in) :: idate(:) real(kind_phys), intent(in) :: fhswr, fhour logical, intent(in) :: lsswr, cal_pre, random_clds, h2o_phys, iaerclm @@ -797,7 +797,7 @@ subroutine GFS_phys_time_vary_timestep_init ( !$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) & +!$OMP shared(ddy_j2tau,tau_amf,iflip) & !$OMP private(iseed,iskip,i,j,k) !$OMP sections @@ -889,7 +889,7 @@ subroutine GFS_phys_time_vary_timestep_init ( ! aerinterpol is using threading inside, don't ! move into OpenMP parallel section above call aerinterpol (me, master, nthrds, im, idate, & - fhour, jindx1_aer, jindx2_aer, & + fhour, iflip, jindx1_aer, jindx2_aer, & ddy_aer, iindx1_aer, & iindx2_aer, ddx_aer, & levs, prsl, aer_nm) diff --git a/physics/GFS_phys_time_vary.fv3.meta b/physics/GFS_phys_time_vary.fv3.meta index 6c7f086dd..0af6cda3c 100644 --- a/physics/GFS_phys_time_vary.fv3.meta +++ b/physics/GFS_phys_time_vary.fv3.meta @@ -127,7 +127,7 @@ [ozpl] standard_name = ozone_forcing long_name = ozone forcing data - units = various + units = mixed dimensions = (horizontal_dimension,vertical_dimension_of_ozone_forcing_data,number_of_coefficients_in_ozone_forcing_data) type = real kind = kind_phys @@ -157,11 +157,19 @@ [h2opl] standard_name = stratospheric_water_vapor_forcing long_name = water forcing data - units = various + units = mixed dimensions = (horizontal_dimension,vertical_dimension_of_h2o_forcing_data,number_of_coefficients_in_h2o_forcing_data) type = real kind = kind_phys intent = in +[fhour] + standard_name = forecast_time + long_name = current forecast time + units = h + dimensions = () + type = real + kind = kind_phys + intent = in [jindx1_aer] standard_name = lower_latitude_index_of_aerosol_forcing_for_interpolation long_name = interpolation low index for prescribed aerosols in the y direction @@ -1116,7 +1124,7 @@ [ozpl] standard_name = ozone_forcing long_name = ozone forcing data - units = various + units = mixed dimensions = (horizontal_dimension,vertical_dimension_of_ozone_forcing_data,number_of_coefficients_in_ozone_forcing_data) type = real kind = kind_phys @@ -1146,11 +1154,18 @@ [h2opl] standard_name = stratospheric_water_vapor_forcing long_name = water forcing data - units = various + units = mixed dimensions = (horizontal_dimension,vertical_dimension_of_h2o_forcing_data,number_of_coefficients_in_h2o_forcing_data) type = real kind = kind_phys intent = inout +[iflip] + standard_name = control_for_vertical_index_direction + long_name = iflip - is not the same as flipv + units = flag + dimensions = () + type = integer + intent = in [jindx1_aer] standard_name = lower_latitude_index_of_aerosol_forcing_for_interpolation long_name = interpolation low index for prescribed aerosols in the y direction @@ -1826,7 +1841,7 @@ [tau_amf] standard_name = absolute_momentum_flux_due_to_nonorographic_gravity_wave_drag long_name = ngw_absolute_momentum_flux - units = various + units = mixed dimensions = (horizontal_dimension) type = real kind = kind_phys diff --git a/physics/GFS_phys_time_vary.scm.meta b/physics/GFS_phys_time_vary.scm.meta index a7de26fe1..566636326 100644 --- a/physics/GFS_phys_time_vary.scm.meta +++ b/physics/GFS_phys_time_vary.scm.meta @@ -127,7 +127,7 @@ [ozpl] standard_name = ozone_forcing long_name = ozone forcing data - units = various + units = mixed dimensions = (horizontal_dimension,vertical_dimension_of_ozone_forcing_data,number_of_coefficients_in_ozone_forcing_data) type = real kind = kind_phys @@ -157,7 +157,7 @@ [h2opl] standard_name = stratospheric_water_vapor_forcing long_name = water forcing data - units = various + units = mixed dimensions = (horizontal_dimension,vertical_dimension_of_h2o_forcing_data,number_of_coefficients_in_h2o_forcing_data) type = real kind = kind_phys @@ -1109,7 +1109,7 @@ [ozpl] standard_name = ozone_forcing long_name = ozone forcing data - units = various + units = mixed dimensions = (horizontal_dimension,vertical_dimension_of_ozone_forcing_data,number_of_coefficients_in_ozone_forcing_data) type = real kind = kind_phys @@ -1139,7 +1139,7 @@ [h2opl] standard_name = stratospheric_water_vapor_forcing long_name = water forcing data - units = various + units = mixed dimensions = (horizontal_dimension,vertical_dimension_of_h2o_forcing_data,number_of_coefficients_in_h2o_forcing_data) type = real kind = kind_phys @@ -1333,7 +1333,7 @@ [tau_amf] standard_name = absolute_momentum_flux_due_to_nonorographic_gravity_wave_drag long_name = ngw_absolute_momentum_flux - units = various + units = mixed dimensions = (horizontal_dimension) type = real kind = kind_phys diff --git a/physics/GFS_rrtmg_post.F90 b/physics/GFS_rrtmg_post.F90 index b882930bf..8584f8463 100644 --- a/physics/GFS_rrtmg_post.F90 +++ b/physics/GFS_rrtmg_post.F90 @@ -17,7 +17,7 @@ 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, errmsg, errflg) + fluxr, total_albedo, errmsg, errflg) use machine, only: kind_phys use module_radsw_parameters, only: topfsw_type, sfcfsw_type, & @@ -43,6 +43,7 @@ subroutine GFS_rrtmg_post_run (im, km, kmp1, lm, ltp, kt, kb, kd, nspc1, & 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 @@ -196,6 +197,12 @@ subroutine GFS_rrtmg_post_run (im, km, kmp1, lm, ltp, kt, kb, kd, nspc1, & 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 diff --git a/physics/GFS_rrtmg_post.meta b/physics/GFS_rrtmg_post.meta index 0de8b7907..80bd5c22c 100644 --- a/physics/GFS_rrtmg_post.meta +++ b/physics/GFS_rrtmg_post.meta @@ -195,7 +195,7 @@ standard_name = total_cloud_fraction long_name = layer total cloud fraction units = frac - dimensions = (horizontal_loop_extent,vertical_layer_dimension) + dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) type = real kind = kind_phys intent = in @@ -253,11 +253,19 @@ [fluxr] standard_name = cumulative_radiation_diagnostic long_name = time-accumulated 2D radiation-related diagnostic fields - units = various + 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 diff --git a/physics/GFS_rrtmg_pre.F90 b/physics/GFS_rrtmg_pre.F90 index ccaff7335..3a3378e15 100644 --- a/physics/GFS_rrtmg_pre.F90 +++ b/physics/GFS_rrtmg_pre.F90 @@ -34,8 +34,9 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, & plvl, plyr, tlvl, tlyr, qlyr, olyr, gasvmr_co2, gasvmr_n2o, gasvmr_ch4,& gasvmr_o2, gasvmr_co, gasvmr_cfc11, gasvmr_cfc12, gasvmr_cfc22, & gasvmr_ccl4, gasvmr_cfc113, aerodp, clouds6, clouds7, clouds8, & - clouds9, cldsa, cldfra, faersw1, faersw2, faersw3, faerlw1, faerlw2, & - faerlw3, alpha, errmsg, errflg) + clouds9, cldsa, cldfra, cldfra2d, lwp_ex,iwp_ex, lwp_fc,iwp_fc, & + faersw1, faersw2, faersw3, faerlw1, faerlw2, faerlw3, alpha, & + errmsg, errflg) use machine, only: kind_phys @@ -54,6 +55,7 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, & & progcld2, & & progcld4, progcld5, & & progcld6, & + & progcld_thompson, & & progclduni, & & cal_cldfra3, & & find_cloudLayers, & @@ -125,7 +127,9 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, & 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) :: qci_conv + real(kind=kind_phys), dimension(:), intent(out) :: lwp_ex,iwp_ex, & + lwp_fc,iwp_fc integer, intent(out) :: kd, kt, kb @@ -159,6 +163,7 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, & clouds8, & clouds9, & cldfra + real(kind=kind_phys), dimension(:), intent(out) :: cldfra2d real(kind=kind_phys), dimension(:,:), intent(out) :: cldsa real(kind=kind_phys), dimension(:,:,:), intent(out) :: faersw1,& @@ -192,9 +197,10 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, & real(kind=kind_phys), dimension(im,lm+LTP) :: & re_cloud, re_ice, re_snow, qv_mp, qc_mp, & qi_mp, qs_mp, nc_mp, ni_mp, nwfa + real (kind=kind_phys), dimension(lm) :: cldfra1d, qv1d, & + & qc1d, qi1d, qs1d, dz1d, p1d, t1d ! for F-A MP - real(kind=kind_phys), dimension(im,lm+LTP) :: qc_save, qi_save, qs_save real(kind=kind_phys), dimension(im,lm+LTP+1) :: tem2db, hz real(kind=kind_phys), dimension(im,lm+LTP,min(4,ncnd)) :: ccnd @@ -207,6 +213,7 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, & ! for stochastic cloud perturbations real(kind=kind_phys), dimension(im) :: cldp1d real (kind=kind_phys) :: alpha0,beta0,m,s,cldtmp,tmp_wt,cdfz + real (kind=kind_phys) :: max_relh integer :: iflag integer :: ids, ide, jds, jde, kds, kde, & @@ -229,6 +236,21 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, & LP1 = LM + 1 ! num of in/out levels + gridkm = sqrt(2.0)*sqrt(dx(1)*0.001*dx(1)*0.001) + + if (imp_physics == imp_physics_thompson) then + max_relh = 1.5 + else + max_relh = 1.1 + endif + + do i = 1, IM + lwp_ex(i) = 0.0 + iwp_ex(i) = 0.0 + lwp_fc(i) = 0.0 + iwp_fc(i) = 0.0 + enddo + ! --- ... set local /level/layer indexes corresponding to in/out ! variables @@ -720,31 +742,33 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, & enddo endif elseif (imp_physics == imp_physics_gfdl) then ! GFDL MP - if (do_mynnedmf .and. kdt>1) THEN - do k=1,lm - k1 = k + kd - do i=1,im - if (tracer1(i,k1,ntrw)>1.0e-7 .OR. tracer1(i,k1,ntsw)>1.0e-7) then - ! GFDL cloud fraction - cldcov(i,k1) = tracer1(i,k1,ntclamt) - else - ! MYNN sub-grid cloud fraction + if ((imfdeepcnv==imfdeepcnv_gf .or. do_mynnedmf) .and. kdt>1) then + if (do_mynnedmf) then + do k=1,lm + k1 = k + kd + do i=1,im + if (tracer1(i,k1,ntrw)>1.0e-7 .OR. tracer1(i,k1,ntsw)>1.0e-7) then + ! GFDL cloud fraction + cldcov(i,k1) = tracer1(i,k1,ntclamt) + else + ! MYNN sub-grid cloud fraction + cldcov(i,k1) = clouds1(i,k1) + endif + enddo + enddo + else ! imfdeepcnv==imfdeepcnv_gf + do k=1,lm + k1 = k + kd + do i=1,im + if (qci_conv(i,k)>0.) then + ! GF sub-grid cloud fraction cldcov(i,k1) = clouds1(i,k1) + else + cldcov(i,k1) = tracer1(i,k1,ntclamt) endif + enddo enddo - enddo - elseif (imfdeepcnv == imfdeepcnv_gf .and. kdt>1) THEN - do k=1,lm - k1 = k + kd - do i=1,im - if (qci_conv(i,k)>0.) then - ! GF sub-grid cloud fraction - cldcov(i,k1) = clouds1(i,k1) - else - cldcov(i,k1) = tracer1(i,k1,ntclamt) - endif - enddo - enddo + endif else ! GFDL cloud fraction cldcov(1:IM,1+kd:LM+kd) = tracer1(1:IM,1:LM,ntclamt) @@ -867,88 +891,6 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, & enddo endif - !mz HWRF physics: icloud=3 - if(icloud == 3) then - - ! Set internal dimensions - ids = 1 - ims = 1 - its = 1 - ide = size(xlon,1) - ime = size(xlon,1) - ite = size(xlon,1) - jds = 1 - jms = 1 - jts = 1 - jde = 1 - jme = 1 - jte = 1 - kds = 1 - kms = 1 - kts = 1 - kde = lm+LTP ! should this be lmk instead of lm? no, or? - kme = lm+LTP - kte = lm+LTP - - do k = 1, LMK - do i = 1, IM - rho(i,k)=plyr(i,k)*100./(con_rd*tlyr(i,k)) - plyrpa(i,k)=plyr(i,k)*100. !hPa->Pa - end do - end do - - 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 HWRF - else - xland(i)=2.0 - endif - enddo - - gridkm = sqrt(2.0)*sqrt(dx(1)*0.001*dx(1)*0.001) - - do i =1, im - do k =1, lmk - qc_save(i,k) = ccnd(i,k,1) - qi_save(i,k) = ccnd(i,k,2) - qs_save(i,k) = ccnd(i,k,4) - enddo - enddo - - - call cal_cldfra3(cldcov,qlyr,ccnd(:,:,1),ccnd(:,:,2), & - ccnd(:,:,4),plyrpa,tlyr,rho,xland,gridkm, & - ids,ide,jds,jde,kds,kde, & - ims,ime,jms,jme,kms,kme, & - its,ite,jts,jte,kts,kte) - - !mz* back to micro-only qc qi,qs - do i =1, im - do k =1, lmk - ccnd(i,k,1) = qc_save(i,k) - ccnd(i,k,2) = qi_save(i,k) - ccnd(i,k,4) = qs_save(i,k) - enddo - enddo - - endif ! icloud == 3 - - if (lextop) then - do i=1,im - cldcov(i,lyb) = cldcov(i,lya) - deltaq(i,lyb) = deltaq(i,lya) - cnvw (i,lyb) = cnvw (i,lya) - cnvc (i,lyb) = cnvc (i,lya) - enddo - if (effr_in) then - do i=1,im - effrl(i,lyb) = effrl(i,lya) - effri(i,lyb) = effri(i,lya) - effrr(i,lyb) = effrr(i,lya) - effrs(i,lyb) = effrs(i,lya) - enddo - endif - endif if (imp_physics == imp_physics_zhao_carr) then ccnd(1:IM,1:LMK,1) = ccnd(1:IM,1:LMK,1) + cnvw(1:IM,1:LMK) @@ -1025,6 +967,20 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, & elseif(imp_physics == imp_physics_thompson) then ! Thompson MP if(do_mynnedmf .or. imfdeepcnv == imfdeepcnv_gf ) then ! MYNN PBL or GF conv + + if (icloud == 3) then + call progcld_thompson (plyr,plvl,tlyr,qlyr,qstl,rhly, & ! --- inputs + tracer1,xlat,xlon,slmsk,dz,delp, & + ntrac-1, ntcw-1,ntiw-1,ntrw-1, & + ntsw-1,ntgl-1, & + im, lm, lmp, uni_cld, lmfshal, lmfdeep2, & + cldcov(:,1:LM), effrl_inout, & + effri_inout, effrs_inout, & + lwp_ex, iwp_ex, lwp_fc, iwp_fc, & + dzb, xlat_d, julian, yearlen, gridkm, & + clouds, cldsa, mtopa ,mbota, de_lgth, alpha) ! --- outputs + else + !-- MYNN PBL or convective GF !-- use cloud fractions with SGS clouds do k=1,lmk @@ -1041,18 +997,35 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, & effrl, effri, effrr, effrs, effr_in , & dzb, xlat_d, julian, yearlen, & clouds, cldsa, mtopa, mbota, de_lgth, alpha) ! --- outputs + endif else ! MYNN PBL or GF convective are not used - call progcld6 (plyr,plvl,tlyr,qlyr,qstl,rhly,tracer1, & ! --- inputs - xlat,xlon,slmsk,dz,delp, & + + if (icloud == 3) then + call progcld_thompson (plyr,plvl,tlyr,qlyr,qstl,rhly, & ! --- inputs + tracer1,xlat,xlon,slmsk,dz,delp, & + ntrac-1, ntcw-1,ntiw-1,ntrw-1, & + ntsw-1,ntgl-1, & + im, lm, lmp, uni_cld, lmfshal, lmfdeep2, & + cldcov(:,1:LM), effrl_inout, & + effri_inout, effrs_inout, & + lwp_ex, iwp_ex, lwp_fc, iwp_fc, & + dzb, xlat_d, julian, yearlen, gridkm, & + clouds, cldsa, mtopa ,mbota, de_lgth, alpha) ! --- outputs + + else + call progcld6 (plyr,plvl,tlyr,qlyr,qstl,rhly, & ! --- inputs + tracer1,xlat,xlon,slmsk,dz,delp, & ntrac-1, ntcw-1,ntiw-1,ntrw-1, & ntsw-1,ntgl-1, & im, lmk, lmp, uni_cld, lmfshal, lmfdeep2, & - cldcov(:,1:LMK), effrl_inout(:,:), & - effri_inout(:,:), effrs_inout(:,:), & + cldcov(:,1:LMK), effrl_inout, & + effri_inout, effrs_inout, & + lwp_ex, iwp_ex, lwp_fc, iwp_fc, & dzb, xlat_d, julian, yearlen, & clouds, cldsa, mtopa ,mbota, de_lgth, alpha) ! --- outputs + endif endif ! MYNN PBL or GF endif ! end if_imp_physics @@ -1084,7 +1057,7 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, & enddo ! end_do_i_loop enddo ! end_do_k_loop endif - do k = 1, LMK + do k = 1, LM do i = 1, IM clouds1(i,k) = clouds(i,k,1) clouds2(i,k) = clouds(i,k,2) @@ -1098,6 +1071,12 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, & cldfra(i,k) = clouds(i,k,1) enddo enddo + do i = 1, IM + cldfra2d(i) = 0.0 + do k = 1, LM-1 + cldfra2d(i) = max(cldfra2d(i), cldfra(i,k)) + enddo + enddo ! mg, sfc-perts ! --- scale random patterns for surface perturbations with diff --git a/physics/GFS_rrtmg_pre.meta b/physics/GFS_rrtmg_pre.meta index 9763efbd2..ced68890e 100644 --- a/physics/GFS_rrtmg_pre.meta +++ b/physics/GFS_rrtmg_pre.meta @@ -570,7 +570,7 @@ intent = in [sppt_amp] standard_name = total_amplitude_of_sppt_perturbation - long_name = toal ampltidue of stochastic sppt perturbation + long_name = total ampltidue of stochastic sppt perturbation units = none dimensions = () type = real @@ -986,6 +986,46 @@ type = real kind = kind_phys intent = out +[cldfra2d] + standard_name = max_in_column_cloud_fraction + long_name = instantaneous 2D (max-in-column) cloud fraction + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = out +[lwp_ex] + standard_name = liq_water_path_from_microphysics + long_name = total liquid water path from explicit microphysics + units = kg m-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = out +[iwp_ex] + standard_name = ice_water_path_from_microphysics + long_name = total ice water path from explicit microphysics + units = kg m-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = out +[lwp_fc] + standard_name = liq_water_path_from_cloud_fraction + long_name = total liquid water path from cloud fraction scheme + units = kg m-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = out +[iwp_fc] + standard_name = ice_water_path_from_cloud_fraction + long_name = total ice water path from cloud fraction scheme + units = kg m-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = out [faersw1] standard_name = aerosol_optical_depth_for_shortwave_bands_01_16 long_name = aerosol optical depth for shortwave bands 01-16 diff --git a/physics/GFS_rrtmgp_cloud_overlap_pre.F90 b/physics/GFS_rrtmgp_cloud_overlap_pre.F90 index edd3aab93..f85621d8f 100644 --- a/physics/GFS_rrtmgp_cloud_overlap_pre.F90 +++ b/physics/GFS_rrtmgp_cloud_overlap_pre.F90 @@ -22,7 +22,7 @@ end subroutine GFS_rrtmgp_cloud_overlap_pre_init subroutine GFS_rrtmgp_cloud_overlap_pre_run(nCol, nLev, yearlen, doSWrad, doLWrad, & julian, lat, p_lev, p_lay, tv_lay, 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, & + idcor_oreopoulos, cld_frac, top_at_1, & de_lgth, cloud_overlap_param, precip_overlap_param, deltaZc, errmsg, errflg) implicit none @@ -40,6 +40,7 @@ subroutine GFS_rrtmgp_cloud_overlap_pre_run(nCol, nLev, yearlen, doSWrad, doLWra 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 real(kind_phys), intent(in) :: & @@ -74,9 +75,8 @@ subroutine GFS_rrtmgp_cloud_overlap_pre_run(nCol, nLev, yearlen, doSWrad, doLWra real(kind_phys) :: tem1,pfac real(kind_phys), dimension(nLev+1) :: hgtb real(kind_phys), dimension(nLev) :: hgtc - integer :: iCol,iLay,l,iSFC,iTOA + integer :: iCol,iLay,l real(kind_phys), dimension(nCol,nLev) :: deltaZ - logical :: top_at_1 ! Initialize CCPP error handling variables errmsg = '' @@ -84,37 +84,27 @@ subroutine GFS_rrtmgp_cloud_overlap_pre_run(nCol, nLev, yearlen, doSWrad, doLWra if (.not. (doSWrad .or. doLWrad)) return - ! What is vertical ordering? - top_at_1 = (p_lev(1,1) .lt. p_lev(1, nLev)) - if (top_at_1) then - iSFC = nLev - iTOA = 1 - else - iSFC = 1 - iTOA = nLev - endif - - ! - ! Compute layer-thickness between layer boundaries (deltaZ) and layer centers (deltaZc) - ! + ! + ! Compute layer-thickness between layer boundaries (deltaZ) and layer centers (deltaZc) + ! do iCol=1,nCol if (top_at_1) then - ! Layer thickness (km) + ! Layer thickness (km) do iLay=1,nLev deltaZ(iCol,iLay) = ((con_rd/con_g)*0.001) * abs(log(p_lev(iCol,iLay+1)) - log(p_lev(iCol,iLay))) * tv_lay(iCol,iLay) enddo - ! Height at layer boundaries + ! Height at layer boundaries hgtb(nLev+1) = 0._kind_phys do iLay=nLev,1,-1 hgtb(iLay)= hgtb(iLay+1) + deltaZ(iCol,iLay) enddo - ! Height at layer centers + ! Height at layer centers do iLay = nLev, 1, -1 pfac = abs(log(p_lev(iCol,iLay+1)) - log(p_lay(iCol,iLay))) / & abs(log(p_lev(iCol,iLay+1)) - log(p_lev(iCol,iLay))) hgtc(iLay) = hgtb(iLay+1) + pfac * (hgtb(iLay) - hgtb(iLay+1)) enddo - ! Layer thickness between centers + ! Layer thickness between centers do iLay = nLev-1, 1, -1 deltaZc(iCol,iLay) = hgtc(iLay) - hgtc(iLay+1) enddo @@ -123,18 +113,18 @@ subroutine GFS_rrtmgp_cloud_overlap_pre_run(nCol, nLev, yearlen, doSWrad, doLWra do iLay=nLev,1,-1 deltaZ(iCol,iLay) = ((con_rd/con_g)*0.001) * abs(log(p_lev(iCol,iLay)) - log(p_lev(iCol,iLay+1))) * tv_lay(iCol,iLay) enddo - ! Height at layer boundaries + ! Height at layer boundaries hgtb(1) = 0._kind_phys do iLay=1,nLev hgtb(iLay+1)= hgtb(iLay) + deltaZ(iCol,iLay) enddo - ! Height at layer centers + ! Height at layer centers do iLay = 1, nLev pfac = abs(log(p_lev(iCol,iLay)) - log(p_lay(iCol,iLay) )) / & abs(log(p_lev(iCol,iLay)) - log(p_lev(iCol,iLay+1))) hgtc(iLay) = hgtb(iLay) + pfac * (hgtb(iLay+1) - hgtb(iLay)) enddo - ! Layer thickness between centers + ! Layer thickness between centers do iLay = 2, nLev deltaZc(iCol,iLay) = hgtc(iLay) - hgtc(iLay-1) enddo @@ -142,9 +132,9 @@ subroutine GFS_rrtmgp_cloud_overlap_pre_run(nCol, nLev, yearlen, doSWrad, doLWra endif enddo - ! - ! Cloud decorrelation length - ! + ! + ! Cloud decorrelation length + ! if (idcor == idcor_hogan) then call cmp_dcorr_lgth(nCol, lat, con_pi, de_lgth) endif @@ -165,9 +155,9 @@ subroutine GFS_rrtmgp_cloud_overlap_pre_run(nCol, nLev, yearlen, doSWrad, doLWra cloud_overlap_param(:,:) = 0. endif - ! For exponential random overlap... - ! Decorrelate layers when a clear layer follows a cloudy layer to enforce - ! random correlation between non-adjacent blocks of cloudy layers + ! For exponential random overlap... + ! Decorrelate layers when a clear layer follows a cloudy layer to enforce + ! random correlation between non-adjacent blocks of cloudy layers if (iovr == iovr_exprand) then do iLay = 1, nLev do iCol = 1, nCol diff --git a/physics/GFS_rrtmgp_cloud_overlap_pre.meta b/physics/GFS_rrtmgp_cloud_overlap_pre.meta index 5a143f1ac..a15f1a8bd 100644 --- a/physics/GFS_rrtmgp_cloud_overlap_pre.meta +++ b/physics/GFS_rrtmgp_cloud_overlap_pre.meta @@ -186,6 +186,13 @@ type = real kind = kind_phys intent = in +[top_at_1] + standard_name = flag_for_vertical_ordering_in_RRTMGP + long_name = flag for vertical ordering in RRTMGP + units = flag + dimensions = () + type = logical + intent = in [de_lgth] standard_name = cloud_decorrelation_length long_name = cloud decorrelation length diff --git a/physics/GFS_rrtmgp_gfdlmp_pre.F90 b/physics/GFS_rrtmgp_gfdlmp_pre.F90 index ccbfd1df8..c6afd6ac0 100644 --- a/physics/GFS_rrtmgp_gfdlmp_pre.F90 +++ b/physics/GFS_rrtmgp_gfdlmp_pre.F90 @@ -98,7 +98,6 @@ subroutine GFS_rrtmgp_gfdlmp_pre_run(nCol, nLev, nTracers, ncnd, i_cldliq, i_cld real(kind_phys), dimension(nCol, nLev, min(4,ncnd)) :: cld_condensate integer :: iCol,iLay,l,ncndl real(kind_phys), dimension(nCol,nLev) :: deltaP,deltaZ - logical :: top_at_1 if (.not. (doSWrad .or. doLWrad)) return diff --git a/physics/GFS_rrtmgp_lw_post.F90 b/physics/GFS_rrtmgp_lw_post.F90 index ff0346fe4..cccaa501c 100644 --- a/physics/GFS_rrtmgp_lw_post.F90 +++ b/physics/GFS_rrtmgp_lw_post.F90 @@ -1,12 +1,8 @@ module GFS_rrtmgp_lw_post use machine, only: kind_phys - use module_radiation_aerosols, only: NSPC1 - use module_radlw_parameters, only: topflw_type, sfcflw_type, proflw_type - ! RRTMGP DDT's - use mo_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp - use mo_fluxes_byband, only: ty_fluxes_byband + use module_radlw_parameters, only: topflw_type, sfcflw_type use mo_heating_rates, only: compute_heating_rate - use radiation_tools, only: check_error_msg + use radiation_tools, only: check_error_msg implicit none public GFS_rrtmgp_lw_post_init,GFS_rrtmgp_lw_post_run,GFS_rrtmgp_lw_post_finalize @@ -25,14 +21,16 @@ end subroutine GFS_rrtmgp_lw_post_init !! \htmlinclude GFS_rrtmgp_lw_post.html !! subroutine GFS_rrtmgp_lw_post_run (nCol, nLev, lslwr, do_lw_clrsky_hr, save_diag, fhlwr, & - p_lev, t_lay, tsfa, fluxlwUP_allsky, fluxlwDOWN_allsky, fluxlwUP_clrsky, & - fluxlwDOWN_clrsky, raddt, aerodp, cldsa, mtopa, mbota, cld_frac, cldtaulw, fluxr, & - sfcdlw, sfculw, sfcflw, tsflw, htrlw, topflw, flxprf_lw, htrlwc, errmsg, errflg) + p_lev, t_lay, tsfa, fluxlwUP_allsky, fluxlwDOWN_allsky, fluxlwUP_clrsky, iSFC, iTOA,& + fluxlwDOWN_clrsky, raddt, cldsa, mtopa, mbota, cld_frac, cldtaulw, fluxr, sfcdlw, & + sfculw, sfcflw, tsflw, htrlw, htrlwu, topflw, htrlwc, errmsg, errflg) ! Inputs integer, intent(in) :: & nCol, & ! Horizontal loop extent - nLev ! Number of vertical layers + nLev, & ! Number of vertical layers + iSFC, & ! Vertical index for surface level + iTOA ! Vertical index for TOA level logical, intent(in) :: & lslwr, & ! Logical flags for lw radiation calls do_lw_clrsky_hr, & ! Output clear-sky SW heating-rate? @@ -51,8 +49,6 @@ subroutine GFS_rrtmgp_lw_post_run (nCol, nLev, lslwr, do_lw_clrsky_hr, save_diag fluxlwDOWN_clrsky ! RRTMGP longwave clear-sky flux (W/m2) real(kind_phys), intent(in) :: & raddt ! Radiation time step - real(kind_phys), dimension(nCol,NSPC1), intent(in) :: & - aerodp ! Vertical integrated optical depth for various aerosol species real(kind_phys), dimension(nCol,5), intent(in) :: & cldsa ! Fraction of clouds for low, middle, high, total and BL integer, dimension(nCol,3), intent(in) ::& @@ -72,27 +68,21 @@ subroutine GFS_rrtmgp_lw_post_run (nCol, nLev, lslwr, do_lw_clrsky_hr, save_diag type(sfcflw_type), dimension(nCol), intent(inout) :: & sfcflw ! LW radiation fluxes at sfc real(kind_phys), dimension(nCol,nLev), intent(inout) :: & - htrlw ! LW all-sky heating rate + htrlw, & ! LW all-sky heating rate + htrlwu ! Heating-rate updated in-between radiation calls. type(topflw_type), dimension(nCol), intent(out) :: & topflw ! lw_fluxes_top_atmosphere character(len=*), intent(out) :: & errmsg integer, intent(out) :: & errflg - + ! Outputs (optional) - type(proflw_type), dimension(nCol, nLev+1), optional, intent(inout) :: & - flxprf_lw ! 2D radiative fluxes, components: - ! upfxc - total sky upward flux (W/m2) - ! dnfxc - total sky dnward flux (W/m2) - ! upfx0 - clear sky upward flux (W/m2) - ! dnfx0 - clear sky dnward flux (W/m2) real(kind_phys),dimension(nCol, nLev),intent(inout),optional :: & htrlwc ! Longwave clear-sky heating-rate (K/sec) ! Local variables - integer :: i, j, k, iSFC, iTOA, itop, ibtc - logical :: l_fluxeslw2d, top_at_1 + integer :: i, j, k, itop, ibtc real(kind_phys) :: tem0d, tem1, tem2 real(kind_phys),dimension(nCol,nLev) :: hlwc @@ -101,22 +91,6 @@ subroutine GFS_rrtmgp_lw_post_run (nCol, nLev, lslwr, do_lw_clrsky_hr, save_diag errflg = 0 if (.not. lslwr) return - - ! Are any optional outputs requested? - l_fluxeslw2d = present(flxprf_lw) - - ! ####################################################################################### - ! What is vertical ordering? - ! ####################################################################################### - top_at_1 = (p_lev(1,1) .lt. p_lev(1, nLev)) - if (top_at_1) then - iSFC = nLev+1 - iTOA = 1 - else - iSFC = 1 - iTOA = nLev+1 - endif - ! ####################################################################################### ! Compute LW heating-rates. ! ####################################################################################### @@ -138,24 +112,18 @@ subroutine GFS_rrtmgp_lw_post_run (nCol, nLev, lslwr, do_lw_clrsky_hr, save_diag ! ####################################################################################### ! Save LW outputs. + ! (Copy fluxes from RRTMGP types into model radiation types.) ! ####################################################################################### - ! Copy fluxes from RRTGMP types into model radiation types. - ! Mandatory outputs + ! 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) - - ! Optional outputs - if(l_fluxeslw2d) then - flxprf_lw%upfxc = fluxlwUP_allsky - flxprf_lw%dnfxc = fluxlwDOWN_allsky - flxprf_lw%upfx0 = fluxlwUP_clrsky - flxprf_lw%dnfx0 = fluxlwDOWN_clrsky - endif - + ! Save surface air temp for diurnal adjustment at model t-steps tsflw (:) = tsfa(:) @@ -163,6 +131,9 @@ subroutine GFS_rrtmgp_lw_post_run (nCol, nLev, lslwr, do_lw_clrsky_hr, save_diag 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 diff --git a/physics/GFS_rrtmgp_lw_post.meta b/physics/GFS_rrtmgp_lw_post.meta index ebcf8350c..399f238d0 100644 --- a/physics/GFS_rrtmgp_lw_post.meta +++ b/physics/GFS_rrtmgp_lw_post.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = GFS_rrtmgp_lw_post type = scheme - dependencies = iounitdef.f,machine.F,radiation_aerosols.f,radlw_param.f,rte-rrtmgp/extensions/mo_fluxes_byband.F90,rte-rrtmgp/extensions/mo_fluxes_byband_kernels.F90,radiation_tools.F90,rte-rrtmgp/rte/mo_fluxes.F90,rte-rrtmgp/rte/kernels/mo_fluxes_broadband_kernels.F90,rte-rrtmgp/extensions/mo_heating_rates.F90 + dependencies = iounitdef.f,machine.F,radiation_aerosols.f,radlw_param.f,rte-rrtmgp/extensions/mo_fluxes_byband.F90,radiation_tools.F90,rte-rrtmgp/rte/mo_fluxes.F90,rte-rrtmgp/rte/kernels/mo_fluxes_broadband_kernels.F90,rte-rrtmgp/extensions/mo_heating_rates.F90 ######################################################################## [ccpp-arg-table] @@ -21,6 +21,20 @@ 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 [lslwr] standard_name = flag_for_calling_longwave_radiation long_name = logical flags for lw radiation calls @@ -114,14 +128,6 @@ 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 @@ -163,7 +169,7 @@ [fluxr] standard_name = cumulative_radiation_diagnostic long_name = time-accumulated 2D radiation-related diagnostic fields - units = various + units = mixed dimensions = (horizontal_loop_extent,number_of_diagnostics_variables_for_radiation) type = real kind = kind_phys @@ -207,6 +213,14 @@ 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 + units = K s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout [topflw] standard_name = lw_fluxes_top_atmosphere long_name = lw radiation fluxes at top diff --git a/physics/GFS_rrtmgp_pre.F90 b/physics/GFS_rrtmgp_pre.F90 index 2f41321bd..d3620a5fd 100644 --- a/physics/GFS_rrtmgp_pre.F90 +++ b/physics/GFS_rrtmgp_pre.F90 @@ -3,13 +3,15 @@ module GFS_rrtmgp_pre kind_phys ! Working type use funcphys, only: & fpvs ! Function ot compute sat. vapor pressure over liq. + use module_radiation_astronomy, only: & + coszmn use module_radiation_gases, only: & NF_VGAS, & ! Number of active gas species getgases, & ! Routine to setup trace gases getozn ! Routine to setup ozone ! RRTMGP types use mo_gas_concentrations, only: ty_gas_concs - use radiation_tools, only: check_error_msg,cmp_tlev + use radiation_tools, only: check_error_msg,cmp_tlev real(kind_phys), parameter :: & amd = 28.9644_kind_phys, & ! Molecular weight of dry-air (g/mol) @@ -96,11 +98,12 @@ end subroutine GFS_rrtmgp_pre_init !> \section arg_table_GFS_rrtmgp_pre_run !! \htmlinclude GFS_rrtmgp_pre_run.html !! - subroutine GFS_rrtmgp_pre_run(nCol, nLev, nTracers, i_o3, lsswr, lslwr, fhswr, fhlwr, & - xlat, xlon, prsl, tgrs, prslk, prsi, qgrs, tsfc, con_eps, con_epsm1, con_fvirt, & - con_epsqs, minGPpres, maxGPpres, minGPtemp, maxGPtemp, raddt, p_lay, t_lay, p_lev, & - t_lev, tsfg, tsfa, qs_lay, q_lay, tv_lay, relhum, tracer, active_gases_array, & - gas_concentrations, tsfc_radtime, errmsg, errflg) + subroutine GFS_rrtmgp_pre_run(me, nCol, nLev, nTracers, i_o3, lsswr, lslwr, fhswr, fhlwr, & + xlat, xlon, prsl, tgrs, prslk, prsi, qgrs, tsfc, coslat, sinlat, con_eps, con_epsm1,& + con_fvirt, con_epsqs, solhr, minGPpres, maxGPpres, minGPtemp, maxGPtemp, raddt, & + p_lay, t_lay, p_lev, t_lev, tsfg, tsfa, qs_lay, q_lay, tv_lay, relhum, tracer, & + active_gases_array, gas_concentrations, tsfc_radtime, coszen, coszdg, top_at_1, iSFC,& + iTOA, errmsg, errflg) ! Inputs integer, intent(in) :: & @@ -122,25 +125,32 @@ subroutine GFS_rrtmgp_pre_run(nCol, nLev, nTracers, i_o3, lsswr, lslwr, fhswr, f 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_epsqs, & ! Physical constant: Minimum saturation mixing-ratio (kg/kg) + solhr ! Time in hours after 00z at the current timestep real(kind_phys), dimension(nCol), intent(in) :: & xlon, & ! Longitude xlat, & ! Latitude - tsfc ! Surface skin temperature (K) + tsfc, & ! Surface skin temperature (K) + coslat, & ! Cosine(latitude) + sinlat ! Sine(latitude) real(kind_phys), dimension(nCol,nLev), intent(in) :: & prsl, & ! Pressure at model-layer centers (Pa) tgrs, & ! Temperature at model-layer centers (K) prslk ! Exner function at model layer centers (1) - real(kind_phys), dimension(nCol,nLev+1) :: & + real(kind_phys), dimension(nCol,nLev+1), intent(in) :: & prsi ! Pressure at model-interfaces (Pa) - real(kind_phys), dimension(nCol,nLev,nTracers) :: & + real(kind_phys), dimension(nCol,nLev,nTracers), intent(in) :: & qgrs ! Tracer concentrations (kg/kg) ! Outputs character(len=*), intent(out) :: & errmsg ! Error message integer, intent(out) :: & - errflg ! Error flag + errflg, & ! Error flag + iSFC, & ! Vertical index for surface + iTOA ! Vertical index for TOA + logical, intent(out) :: & + top_at_1 ! Vertical ordering flag real(kind_phys), intent(inout) :: & raddt ! Radiation time-step real(kind_phys), dimension(ncol), intent(inout) :: & @@ -160,13 +170,15 @@ subroutine GFS_rrtmgp_pre_run(nCol, nLev, nTracers, i_o3, lsswr, lslwr, fhswr, f real(kind_phys), dimension(nCol, nLev, nTracers),intent(inout) :: & tracer ! Array containing trace gases 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(ty_gas_concs), intent(inout) :: & gas_concentrations ! RRTMGP DDT: gas volumne mixing ratios + real(kind_phys), dimension(:), intent(inout) :: & + coszen, & ! Cosine of SZA + coszdg ! Cosine of SZA, daytime ! Local variables - integer :: i, j, iCol, iBand, iSFC, iTOA, iLay - logical :: top_at_1 + integer :: i, j, iCol, iBand, iLay real(kind_phys),dimension(nCol,nLev) :: vmr_o3, vmr_h2o real(kind_phys) :: es, tem1, tem2 real(kind_phys), dimension(nCol,nLev) :: o3_lay @@ -202,7 +214,7 @@ subroutine GFS_rrtmgp_pre_run(nCol, nLev, nTracers, i_o3, lsswr, lslwr, fhswr, f p_lev(1:NCOL,:) = prsi(1:NCOL,:) ! Pressure at layer-center - p_lay(1:NCOL,:) = prsl(1:NCOL,:) + p_lay(1:NCOL,:) = prsl(1:NCOL,:) ! Temperature at layer-center t_lay(1:NCOL,:) = tgrs(1:NCOL,:) @@ -275,6 +287,8 @@ subroutine GFS_rrtmgp_pre_run(nCol, nLev, nTracers, i_o3, lsswr, lslwr, fhswr, f vmr_o3 = merge(o3_lay*amdo3, 0., o3_lay .gt. 0.) ! Populate RRTMGP DDT w/ gas-concentrations + gas_concentrations%ncol = nCol + gas_concentrations%nlay = nLev gas_concentrations%gas_name(:) = active_gases_array(:) gas_concentrations%concs(istr_o2)%conc(:,:) = gas_vmr(:,:,4) gas_concentrations%concs(istr_co2)%conc(:,:) = gas_vmr(:,:,1) @@ -294,6 +308,13 @@ subroutine GFS_rrtmgp_pre_run(nCol, nLev, nTracers, i_o3, lsswr, lslwr, fhswr, f tsfg(1:NCOL) = tsfc(1:NCOL) tsfa(1:NCOL) = t_lay(1:NCOL,iSFC) + ! ####################################################################################### + ! Compute cosine of zenith angle (only when SW is called) + ! ####################################################################################### + if (lsswr) then + call coszmn (xlon, sinlat, coslat, solhr, nCol, me, coszen, coszdg) + endif + end subroutine GFS_rrtmgp_pre_run ! ######################################################################################### diff --git a/physics/GFS_rrtmgp_pre.meta b/physics/GFS_rrtmgp_pre.meta index bd578e2ad..15ce6db1a 100644 --- a/physics/GFS_rrtmgp_pre.meta +++ b/physics/GFS_rrtmgp_pre.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = GFS_rrtmgp_pre type = scheme - dependencies = funcphys.f90,iounitdef.f,machine.F,module_bfmicrophysics.f,physcons.F90,physparam.f,radcons.f90,radiation_aerosols.f + dependencies = funcphys.f90,iounitdef.f,machine.F,module_bfmicrophysics.f,physcons.F90,radcons.f90,radiation_aerosols.f dependencies = radiation_astronomy.f,radiation_clouds.f,radiation_gases.f,radiation_tools.F90,rrtmg_lw_cloud_optics.F90 ######################################################################## @@ -51,6 +51,13 @@ [ccpp-arg-table] name = GFS_rrtmgp_pre_run type = scheme +[me] + standard_name = mpi_rank + long_name = current MPI-rank + units = index + dimensions = () + type = integer + intent = in [ncol] standard_name = horizontal_loop_extent long_name = horizontal dimension @@ -125,6 +132,30 @@ type = real kind = kind_phys intent = in +[coslat] + standard_name = cosine_of_latitude + long_name = cosine of latitude + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in +[sinlat] + standard_name = sine_of_latitude + long_name = sine of latitude + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in +[solhr] + standard_name = forecast_utc_hour + long_name = time in hours after 00z at the current timestep + units = h + dimensions = () + type = real + kind = kind_phys + intent = in [prsi] standard_name = air_pressure_at_interface long_name = air pressure at model layer interfaces @@ -277,6 +308,27 @@ type = real kind = kind_phys intent = inout +[top_at_1] + standard_name = flag_for_vertical_ordering_in_RRTMGP + long_name = flag for vertical ordering in RRTMGP + units = flag + dimensions = () + type = logical + intent = out +[iSFC] + standard_name = vertical_index_for_surface_in_RRTMGP + long_name = index for surface layer in RRTMGP + units = flag + dimensions = () + type = integer + intent = out +[iTOA] + standard_name = vertical_index_for_TOA_in_RRTMGP + long_name = index for TOA layer in RRTMGP + units = flag + dimensions = () + type = integer + intent = out [tsfc_radtime] standard_name = surface_skin_temperature_on_radiation_timestep long_name = surface skin temperature on radiation timestep @@ -284,7 +336,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - intent = in + intent = inout [tsfg] standard_name = surface_ground_temperature_for_radiation long_name = surface ground temperature for radiation @@ -328,7 +380,7 @@ [q_lay] standard_name = water_vapor_mixing_ratio long_name = water vaport mixing ratio - units = kg/kg + units = kg kg-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys @@ -356,6 +408,22 @@ dimensions = () type = ty_gas_concs intent = inout +[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 = inout +[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 = inout [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/GFS_rrtmgp_sw_post.F90 b/physics/GFS_rrtmgp_sw_post.F90 index 23a681826..a52caac38 100644 --- a/physics/GFS_rrtmgp_sw_post.F90 +++ b/physics/GFS_rrtmgp_sw_post.F90 @@ -1,11 +1,9 @@ module GFS_rrtmgp_sw_post use machine, only: kind_phys use module_radiation_aerosols, only: NSPC1 - use module_radsw_parameters, only: topfsw_type, sfcfsw_type, profsw_type, cmpfsw_type - use mo_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp - use mo_fluxes_byband, only: ty_fluxes_byband + 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 radiation_tools, only: check_error_msg use rrtmgp_sw_gas_optics, only: sw_gas_props implicit none @@ -29,15 +27,17 @@ subroutine GFS_rrtmgp_sw_post_run (nCol, nLev, nDay, idxday, lsswr, do_sw_clrsky save_diag, fhswr, coszen, coszdg, t_lay, p_lev, sfc_alb_nir_dir, sfc_alb_nir_dif, & sfc_alb_uvvis_dir, sfc_alb_uvvis_dif, fluxswUP_allsky, & fluxswDOWN_allsky, fluxswUP_clrsky, fluxswDOWN_clrsky, raddt, aerodp, cldsa, mbota, & - mtopa, cld_frac, cldtausw, fluxr, & + mtopa, cld_frac, cldtausw, fluxr, iSFC, iTOA, & nirbmdi, nirdfdi, visbmdi, visdfdi, nirbmui, nirdfui, visbmui, visdfui, sfcnsw, & - sfcdsw, htrsw, sfcfsw, topfsw, htrswc, flxprf_sw, scmpsw, errmsg, errflg) + sfcdsw, htrsw, sfcfsw, topfsw, htrswc, scmpsw, errmsg, errflg) ! Inputs integer, intent(in) :: & nCol, & ! Horizontal loop extent nLev, & ! Number of vertical layers - nDay ! Number of daylit columns + nDay, & ! Number of daylit columns + iSFC, & ! Vertical index for surface level + iTOA ! Vertical index for TOA level integer, intent(in), dimension(nday) :: & idxday ! Index array for daytime points logical, intent(in) :: & @@ -74,9 +74,7 @@ subroutine GFS_rrtmgp_sw_post_run (nCol, nLev, nDay, idxday, lsswr, do_sw_clrsky real(kind_phys), dimension(nCol,nLev), intent(in) :: & cld_frac, & ! Total cloud fraction in each layer cldtausw ! approx .55mu band layer cloud optical depth - - ! Inputs (optional) - type(cmpfsw_type), dimension(nCol), intent(inout), optional :: & + type(cmpfsw_type), dimension(nCol), 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) @@ -111,20 +109,13 @@ subroutine GFS_rrtmgp_sw_post_run (nCol, nLev, nDay, idxday, lsswr, do_sw_clrsky errflg ! Outputs (optional) - type(profsw_type), dimension(nCol, nLev), intent(inout), optional :: & - flxprf_sw ! 2D radiative fluxes, components: - ! upfxc - total sky upward flux (W/m2) - ! dnfxc - total sky dnward flux (W/m2) - ! upfx0 - clear sky upward flux (W/m2) - ! dnfx0 - clear sky dnward flux (W/m2) real(kind_phys),dimension(nCol, nLev),intent(inout),optional :: & htrswc ! Clear-sky heating rate (K/s) ! Local variables - integer :: i, j, k, iSFC, iTOA, itop, ibtc + integer :: i, j, k, itop, ibtc real(kind_phys) :: tem0d, tem1, tem2 real(kind_phys), dimension(nDay, nLev) :: thetaTendClrSky, thetaTendAllSky - logical :: l_fluxessw2d, top_at_1, l_scmpsw ! Initialize CCPP error handling variables errmsg = '' @@ -133,24 +124,6 @@ subroutine GFS_rrtmgp_sw_post_run (nCol, nLev, nDay, idxday, lsswr, do_sw_clrsky if (.not. lsswr) return if (nDay .gt. 0) then - ! Are any optional outputs requested? - l_fluxessw2d = present(flxprf_sw) - - ! Are the components of the surface fluxes provided? - l_scmpsw = present(scmpsw) - - ! ####################################################################################### - ! What is vertical ordering? - ! ####################################################################################### - top_at_1 = (p_lev(1,1) .lt. p_lev(1, nLev)) - if (top_at_1) then - iSFC = nLev+1 - iTOA = 1 - else - iSFC = 1 - iTOA = nLev+1 - endif - ! ####################################################################################### ! Compute SW heating-rates ! ####################################################################################### @@ -176,48 +149,32 @@ subroutine GFS_rrtmgp_sw_post_run (nCol, nLev, nDay, idxday, lsswr, do_sw_clrsky ! ####################################################################################### ! Save SW outputs + ! (Copy fluxes from RRTMGP types into model radiation types.) ! ####################################################################################### - ! Copy fluxes from RRTGMP types into model radiation types. - ! Mandatory outputs + + ! 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) - ! Optional output - if(l_fluxessw2D) then - flxprf_sw(:,:)%upfxc = fluxswUP_allsky(:,:) - flxprf_sw(:,:)%dnfxc = fluxswDOWN_allsky(:,:) - flxprf_sw(:,:)%upfx0 = fluxswUP_clrsky(:,:) - flxprf_sw(:,:)%dnfx0 = fluxswDOWN_clrsky(:,:) - endif - ! Surface down and up spectral component fluxes ! - Save two spectral bands' surface downward and upward fluxes for output. - if (l_scmpsw) then - 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(1,i) - nirdfui(i) = scmpsw(i)%nirdf * sfc_alb_nir_dif(1,i) - visbmui(i) = scmpsw(i)%visbm * sfc_alb_uvvis_dir(1,i) - visdfui(i) = scmpsw(i)%visdf * sfc_alb_uvvis_dif(1,i) - enddo - else - nirbmdi(:) = 0.0 - nirdfdi(:) = 0.0 - visbmdi(:) = 0.0 - visdfdi(:) = 0.0 - nirbmui(:) = 0.0 - nirdfui(:) = 0.0 - visbmui(:) = 0.0 - visdfui(:) = 0.0 - endif + 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(1,i) + nirdfui(i) = scmpsw(i)%nirdf * sfc_alb_nir_dif(1,i) + visbmui(i) = scmpsw(i)%visbm * sfc_alb_uvvis_dir(1,i) + visdfui(i) = scmpsw(i)%visdf * sfc_alb_uvvis_dif(1,i) + enddo else ! if_nday_block ! ####################################################################################### ! Dark everywhere @@ -255,12 +212,12 @@ subroutine GFS_rrtmgp_sw_post_run (nCol, nLev, nDay, idxday, lsswr, do_sw_clrsky ! ####################################################################################### if (save_diag) then do i=1,nCol - 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 if (coszen(i) > 0.) then ! SW all-sky fluxes tem0d = fhswr * coszdg(i) / coszen(i) @@ -268,15 +225,15 @@ subroutine GFS_rrtmgp_sw_post_run (nCol, nLev, nDay, idxday, lsswr, do_sw_clrsky 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 + 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 + 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 + 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 diff --git a/physics/GFS_rrtmgp_sw_post.meta b/physics/GFS_rrtmgp_sw_post.meta index d3d026989..6d661b7f1 100644 --- a/physics/GFS_rrtmgp_sw_post.meta +++ b/physics/GFS_rrtmgp_sw_post.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = GFS_rrtmgp_sw_post type = scheme - dependencies = iounitdef.f,machine.F,radiation_aerosols.f,radsw_param.f,rte-rrtmgp/extensions/mo_fluxes_byband.F90,rte-rrtmgp/extensions/mo_fluxes_byband_kernels.F90 + dependencies = iounitdef.f,machine.F,radiation_aerosols.f,radsw_param.f,rte-rrtmgp/extensions/mo_fluxes_byband.F90 dependencies = rte-rrtmgp/rte/mo_fluxes.F90,rte-rrtmgp/rte/kernels/mo_fluxes_broadband_kernels.F90,rte-rrtmgp/extensions/mo_heating_rates.F90,radiation_tools.F90 ######################################################################## @@ -22,6 +22,20 @@ 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 @@ -114,7 +128,7 @@ kind = kind_phys intent = in [sfc_alb_uvvis_dir] - standard_name = surface_albedo_uvvis_dir + standard_name = surface_albedo_uvvis_direct long_name = UVVIS (direct) surface albedo (sfc_alb_uvvis_dir) units = none dimensions = (number_of_shortwave_bands,horizontal_loop_extent) @@ -122,7 +136,7 @@ kind = kind_phys intent = in [sfc_alb_uvvis_dif] - standard_name = surface_albedo_uvvis_dif + standard_name = surface_albedo_uvvis_diffuse long_name = UVVIS (diffuse) surface albedo (sfc_alb_uvvis_dif) units = none dimensions = (number_of_shortwave_bands,horizontal_loop_extent) @@ -218,7 +232,7 @@ [fluxr] standard_name = cumulative_radiation_diagnostic long_name = time-accumulated 2D radiation-related diagnostic fields - units = various + units = mixed dimensions = (horizontal_loop_extent,number_of_diagnostics_variables_for_radiation) type = real kind = kind_phys diff --git a/physics/GFS_rrtmgp_sw_pre.F90 b/physics/GFS_rrtmgp_sw_pre.F90 index 19f211d7f..3566575f4 100644 --- a/physics/GFS_rrtmgp_sw_pre.F90 +++ b/physics/GFS_rrtmgp_sw_pre.F90 @@ -1,13 +1,9 @@ module GFS_rrtmgp_sw_pre - use machine, only: & - kind_phys ! Working type - use module_radiation_astronomy, only: & - coszmn ! Function to compute cos(SZA) - use mo_gas_optics_rrtmgp, only: & - ty_gas_optics_rrtmgp + use machine, only: kind_phys + use mo_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp use rrtmgp_sw_gas_optics, only: sw_gas_props - public GFS_rrtmgp_sw_pre_run, GFS_rrtmgp_sw_pre_init, GFS_rrtmgp_sw_pre_finalize + public GFS_rrtmgp_sw_pre_run, GFS_rrtmgp_sw_pre_init, GFS_rrtmgp_sw_pre_finalize contains ! ######################################################################################### @@ -22,39 +18,34 @@ end subroutine GFS_rrtmgp_sw_pre_init !> \section arg_table_GFS_rrtmgp_sw_pre_run !! \htmlinclude GFS_rrtmgp_sw_pre.html !! - subroutine GFS_rrtmgp_sw_pre_run(me, nCol, doSWrad, solhr, lon, coslat, sinlat, & - nday, idxday, coszen, coszdg, sfcalb, sfc_alb_nir_dir, sfc_alb_nir_dif, & - sfc_alb_uvvis_dir, sfc_alb_uvvis_dif, errmsg, errflg) + subroutine GFS_rrtmgp_sw_pre_run(nCol, doSWrad, coszen, nday, idxday, sfc_alb_nir_dir, & + sfc_alb_nir_dif, sfc_alb_uvvis_dir, sfc_alb_uvvis_dif, sfc_alb_nir_dir_byband, & + sfc_alb_nir_dif_byband, sfc_alb_uvvis_dir_byband, sfc_alb_uvvis_dif_byband, errmsg, & + errflg) ! Input integer, intent(in) :: & - me, & ! Current MPI rank nCol ! Number of horizontal grid points - logical,intent(in) :: & doSWrad ! Call RRTMGP SW radiation? - real(kind_phys), intent(in) :: & - solhr ! Time in hours after 00z at the current timestep real(kind_phys), dimension(:), intent(in) :: & - lon, & ! Longitude - coslat, & ! Cosine(latitude) - sinlat ! Sine(latitude) - - real(kind_phys), dimension(:,:), intent(in) :: sfcalb + coszen + real(kind_phys), dimension(:), intent(in) :: & + sfc_alb_nir_dir, & ! + sfc_alb_nir_dif, & ! + sfc_alb_uvvis_dir, & ! + sfc_alb_uvvis_dif ! ! Outputs integer, intent(out) :: & nday ! Number of daylit points integer, dimension(:), intent(out) :: & idxday ! Indices for daylit points - real(kind_phys), dimension(:), intent(inout) :: & - coszen, & ! Cosine of SZA - coszdg ! Cosine of SZA, daytime real(kind_phys), dimension(:,:), intent(out) :: & - 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) + sfc_alb_nir_dir_byband, & ! Surface albedo (direct) + sfc_alb_nir_dif_byband, & ! Surface albedo (diffuse) + sfc_alb_uvvis_dir_byband, & ! Surface albedo (direct) + sfc_alb_uvvis_dif_byband ! Surface albedo (diffuse) character(len=*), intent(out) :: & errmsg ! Error message integer, intent(out) :: & @@ -68,12 +59,6 @@ subroutine GFS_rrtmgp_sw_pre_run(me, nCol, doSWrad, solhr, lon, coslat, sinlat, errflg = 0 if (doSWrad) then - - ! #################################################################################### - ! Compute cosine of zenith angle (only when SW is called) - ! #################################################################################### - call coszmn (lon, sinlat, coslat, solhr, nCol, me, coszen, coszdg) - ! #################################################################################### ! For SW gather daylit points ! #################################################################################### @@ -88,18 +73,18 @@ subroutine GFS_rrtmgp_sw_pre_run(me, nCol, doSWrad, solhr, lon, coslat, sinlat, ! Spread across all SW bands do iBand=1,sw_gas_props%get_nband() - sfc_alb_nir_dir(iBand,1:nCol) = sfcalb(1:nCol,1) - sfc_alb_nir_dif(iBand,1:nCol) = sfcalb(1:nCol,2) - sfc_alb_uvvis_dir(iBand,1:nCol) = sfcalb(1:nCol,3) - sfc_alb_uvvis_dif(iBand,1:nCol) = sfcalb(1:nCol,4) + sfc_alb_nir_dir_byband(iBand,1:nCol) = sfc_alb_nir_dir(1:nCol) + sfc_alb_nir_dif_byband(iBand,1:nCol) = sfc_alb_nir_dif(1:nCol) + sfc_alb_uvvis_dir_byband(iBand,1:nCol) = sfc_alb_uvvis_dir(1:nCol) + sfc_alb_uvvis_dif_byband(iBand,1:nCol) = sfc_alb_uvvis_dif(1:nCol) enddo else - nday = 0 - idxday = 0 - sfc_alb_nir_dir(:,1:nCol) = 0. - sfc_alb_nir_dif(:,1:nCol) = 0. - sfc_alb_uvvis_dir(:,1:nCol) = 0. - sfc_alb_uvvis_dif(:,1:nCol) = 0. + nday = 0 + idxday = 0 + sfc_alb_nir_dir_byband(:,1:nCol) = 0. + sfc_alb_nir_dif_byband(:,1:nCol) = 0. + sfc_alb_uvvis_dir_byband(:,1:nCol) = 0. + sfc_alb_uvvis_dif_byband(:,1:nCol) = 0. endif end subroutine GFS_rrtmgp_sw_pre_run diff --git a/physics/GFS_rrtmgp_sw_pre.meta b/physics/GFS_rrtmgp_sw_pre.meta index 3df699a9c..1d9f893b6 100644 --- a/physics/GFS_rrtmgp_sw_pre.meta +++ b/physics/GFS_rrtmgp_sw_pre.meta @@ -7,13 +7,6 @@ [ccpp-arg-table] name = GFS_rrtmgp_sw_pre_run type = scheme -[me] - standard_name = mpi_rank - long_name = current MPI-rank - units = index - dimensions = () - type = integer - intent = in [ncol] standard_name = horizontal_loop_extent long_name = horizontal loop extent @@ -28,38 +21,6 @@ dimensions = () type = logical intent = in -[solhr] - standard_name = forecast_utc_hour - long_name = time in hours after 00z at the current timestep - units = h - dimensions = () - type = real - kind = kind_phys - intent = in -[lon] - standard_name = longitude - long_name = longitude - units = radian - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in -[coslat] - standard_name = cosine_of_latitude - long_name = cosine of latitude - units = none - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in -[sinlat] - standard_name = sine_of_latitude - long_name = sine of latitude - units = none - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in [nday] standard_name = daytime_points_dimension long_name = daytime points dimension @@ -81,24 +42,40 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - intent = inout -[coszdg] - standard_name = cosine_of_solar_zenith_angle_on_radiation_timestep - long_name = daytime mean cosz over rad call period - units = none + 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) type = real kind = kind_phys - intent = inout -[sfcalb] - standard_name = surface_albedo_components - long_name = surface albedo IR/UV/VIS components + 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,number_of_components_for_surface_albedo) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in -[sfc_alb_nir_dir] +[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 = 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 = real + kind = kind_phys + intent = in +[sfc_alb_nir_dir_byband] standard_name = surface_albedo_nearIR_direct long_name = near-IR (direct) surface albedo (sfc_alb_nir_dir) units = none @@ -106,7 +83,7 @@ type = real kind = kind_phys intent = out -[sfc_alb_nir_dif] +[sfc_alb_nir_dif_byband] standard_name = surface_albedo_nearIR_diffuse long_name = near-IR (diffuse) surface albedo (sfc_alb_nir_dif) units = none @@ -114,16 +91,16 @@ type = real kind = kind_phys intent = out -[sfc_alb_uvvis_dir] - standard_name = surface_albedo_uvvis_dir +[sfc_alb_uvvis_dir_byband] + standard_name = surface_albedo_uvvis_direct long_name = UVVIS (direct) surface albedo (sfc_alb_uvvis_dir) units = none dimensions = (number_of_shortwave_bands,horizontal_loop_extent) type = real kind = kind_phys intent = out -[sfc_alb_uvvis_dif] - standard_name = surface_albedo_uvvis_dif +[sfc_alb_uvvis_dif_byband] + standard_name = surface_albedo_uvvis_diffuse long_name = UVVIS (diffuse) surface albedo (sfc_alb_uvvis_dif) units = none dimensions = (number_of_shortwave_bands,horizontal_loop_extent) diff --git a/physics/GFS_rrtmgp_thompsonmp_pre.meta b/physics/GFS_rrtmgp_thompsonmp_pre.meta index f8fdc0e4f..82d9a1b95 100644 --- a/physics/GFS_rrtmgp_thompsonmp_pre.meta +++ b/physics/GFS_rrtmgp_thompsonmp_pre.meta @@ -194,7 +194,7 @@ [q_lay] standard_name = water_vapor_mixing_ratio long_name = water vaport mixing ratio - units = kg/kg + units = kg kg-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys diff --git a/physics/GFS_suite_interstitial.meta b/physics/GFS_suite_interstitial.meta index 7afae62d2..f596b86cd 100644 --- a/physics/GFS_suite_interstitial.meta +++ b/physics/GFS_suite_interstitial.meta @@ -595,7 +595,7 @@ [dtend] standard_name = cumulative_change_of_state_variables long_name = diagnostic tendencies for state variables - units = various + units = mixed dimensions = (horizontal_loop_extent,vertical_layer_dimension,cumulative_change_of_state_variables_outer_index_max) type = real kind = kind_phys @@ -1768,7 +1768,7 @@ [dtend] standard_name = cumulative_change_of_state_variables long_name = diagnostic tendencies for state variables - units = various + units = mixed dimensions = (horizontal_loop_extent,vertical_layer_dimension,cumulative_change_of_state_variables_outer_index_max) type = real kind = kind_phys diff --git a/physics/GFS_surface_generic.F90 b/physics/GFS_surface_generic.F90 index 07d9c1770..1b39409b3 100644 --- a/physics/GFS_surface_generic.F90 +++ b/physics/GFS_surface_generic.F90 @@ -275,14 +275,14 @@ end subroutine GFS_surface_generic_post_finalize !! \htmlinclude GFS_surface_generic_post_run.html !! subroutine GFS_surface_generic_post_run (im, cplflx, cplchm, cplwav, lssav, dry, icy, wet, & - dtf, ep1d, gflx, tgrs_1, qgrs_1, ugrs_1, vgrs_1, & + 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, & + adjvisbmu, adjvisdfu, t2m, q2m, u10m, v10m, tsfc, tsfc_wat, pgr, xcosz, evbs, evcw, trans, sbsno, snowc, snohf, pah, pahi, & epi, gfluxi, t1, q1, u1, v1, 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, & - runoff, srunoff, runof, drain, lheatstrg, h0facu, h0facs, zvfun, hflx, evap, hflxq, hffac, & + nnirdf_cpl, nvisbm_cpl, nvisdf_cpl, gflux, evbsa, evcwa, transa, sbsnoa, snowca, snohfa, paha, ep, ecan, etran, edir, waxy, & + runoff, srunoff, runof, drain, tecan, tetran, tedir, twa, lheatstrg, h0facu, h0facs, zvfun, hflx, evap, hflxq, hffac, & isot, ivegsrc, islmsk, vtype, stype, slope, vtype_save, stype_save, slope_save, errmsg, errflg) implicit none @@ -290,17 +290,19 @@ subroutine GFS_surface_generic_post_run (im, cplflx, cplchm, cplwav, lssav, dry, integer, intent(in) :: im logical, intent(in) :: cplflx, cplchm, cplwav, 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 + t2m, q2m, u10m, v10m, tsfc, tsfc_wat, pgr, xcosz, evbs, evcw, trans, sbsno, snowc, snohf, pah, ecan, etran, edir, & + waxy real(kind=kind_phys), dimension(:), intent(inout) :: epi, gfluxi, t1, q1, u1, v1, 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 + evcwa, transa, sbsnoa, snowca, snohfa, ep, paha, tecan, tetran, tedir, twa, pahi real(kind=kind_phys), dimension(:), intent(inout) :: runoff, srunoff real(kind=kind_phys), dimension(:), intent(in) :: drain, runof @@ -333,6 +335,9 @@ subroutine GFS_surface_generic_post_run (im, cplflx, cplchm, cplwav, lssav, dry, do i=1,im epi(i) = ep1d(i) gfluxi(i) = gflx(i) + if (lsm == lsm_noahmp) then + pahi(i) = pah(i) + endif t1(i) = tgrs_1(i) q1(i) = qgrs_1(i) u1(i) = ugrs_1(i) @@ -426,6 +431,13 @@ subroutine GFS_surface_generic_post_run (im, cplflx, cplchm, cplwav, lssav, dry, ! runoff at the surface and is accumulated in unit of meters runoff(i) = runoff(i) + (drain(i)+runof(i)) * dtf srunoff(i) = srunoff(i) + runof(i) * dtf + tecan(i) = tecan(i) + ecan(i) * dtf + tetran(i) = tetran(i) + etran(i) * dtf + tedir(i) = tedir(i) + edir(i) * dtf + if (lsm == lsm_noahmp) then + paha(i) = paha(i) + pah(i) * dtf + twa(i) = waxy(i) + endif enddo endif diff --git a/physics/GFS_surface_generic.meta b/physics/GFS_surface_generic.meta index 5a87d1bd4..4dcf394db 100644 --- a/physics/GFS_surface_generic.meta +++ b/physics/GFS_surface_generic.meta @@ -600,6 +600,20 @@ dimensions = (horizontal_loop_extent) type = logical intent = in +[lsm] + standard_name = control_for_land_surface_scheme + long_name = flag for land surface model + units = flag + dimensions = () + type = integer + intent = in +[lsm_noahmp] + standard_name = identifier_for_noahmp_land_surface_scheme + long_name = flag for NOAH MP land surface model + units = flag + dimensions = () + type = integer + intent = in [dtf] standard_name = timestep_for_dynamics long_name = dynamics timestep @@ -864,6 +878,22 @@ type = real kind = kind_phys intent = in +[pah] + standard_name = total_precipitation_advected_heat + long_name = precipitation advected heat - total + units = W m-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in +[pahi] + standard_name = instantaneous_total_precipitation_advected_heat + long_name = instantaneous precipitation advected heat - total + units = W m-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in [epi] standard_name = instantaneous_surface_potential_evaporation long_name = instantaneous sfc potential evaporation @@ -1208,6 +1238,14 @@ type = real kind = kind_phys intent = inout +[paha] + standard_name = cumulative_precipitation_advected_heat_flux_multiplied_by_timestep + long_name = cumulative precipitation advected heat flux multiplied by timestep + units = W m-2 s + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout [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 @@ -1216,6 +1254,38 @@ type = real kind = kind_phys intent = inout +[ecan] + standard_name = evaporation_of_intercepted_water + long_name = evaporation of intercepted water + units = kg m-2 s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in +[etran] + standard_name = transpiration_rate + long_name = transpiration rate + units = kg m-2 s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in +[edir] + standard_name = soil_surface_evaporation_rate + long_name = soil surface evaporation rate + units = kg m-2 s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in +[waxy] + standard_name = water_storage_in_aquifer + long_name = water storage in aquifer + units = mm + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in [runoff] standard_name = total_runoff long_name = total water runoff @@ -1248,6 +1318,38 @@ type = real kind = kind_phys intent = in +[tecan] + standard_name = total_evaporation_of_intercepted_water + long_name = total evaporation of intercepted water + units = kg m-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout +[tetran] + standard_name = total_transpiration_rate + long_name = total transpiration rate + units = kg m-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout +[tedir] + standard_name = total_soil_surface_evaporation_rate + long_name = total soil surface evaporation rate + units = kg m-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout +[twa] + standard_name = total_water_storage_in_aquifer + long_name = total water storage in aquifer + units = kg m-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout [lheatstrg] standard_name = flag_for_canopy_heat_storage_in_land_surface_scheme long_name = flag for canopy heat storage parameterization diff --git a/physics/GFS_surface_loop_control.F90 b/physics/GFS_surface_loop_control.F90 index 82c55c4ad..0de1c8ee5 100644 --- a/physics/GFS_surface_loop_control.F90 +++ b/physics/GFS_surface_loop_control.F90 @@ -22,7 +22,8 @@ end subroutine GFS_surface_loop_control_part1_finalize !! \section detailed Detailed Algorithm !! @{ - subroutine GFS_surface_loop_control_part1_run (im, iter, wind, flag_guess, errmsg, errflg) + subroutine GFS_surface_loop_control_part1_run (im, iter, & + wind, flag_guess, errmsg, errflg) use machine, only: kind_phys @@ -78,8 +79,8 @@ end subroutine GFS_surface_loop_control_part2_finalize !! \section detailed Detailed Algorithm !! @{ - subroutine GFS_surface_loop_control_part2_run (im, iter, wind, & - flag_guess, flag_iter, dry, wet, icy, nstf_name1, errmsg, errflg) + subroutine GFS_surface_loop_control_part2_run (im, lsm, lsm_noahmp, iter,& + wind, flag_guess, flag_iter, dry, wet, icy, nstf_name1, errmsg, errflg) use machine, only: kind_phys @@ -88,6 +89,8 @@ subroutine GFS_surface_loop_control_part2_run (im, iter, wind, & ! Interface variables integer, intent(in) :: im integer, intent(in) :: iter + integer, intent(in) :: lsm + integer, intent(in) :: lsm_noahmp real(kind=kind_phys), dimension(:), intent(in) :: wind logical, dimension(:), intent(inout) :: flag_guess logical, dimension(:), intent(inout) :: flag_iter @@ -110,7 +113,7 @@ subroutine GFS_surface_loop_control_part2_run (im, iter, wind, & if (iter == 1 .and. wind(i) < 2.0d0) then !if (dry(i) .or. (wet(i) .and. .not.icy(i) .and. nstf_name1 > 0)) then - if (dry(i) .or. (wet(i) .and. nstf_name1 > 0)) then + if((dry(i) .and. lsm /= lsm_noahmp) .or. (wet(i) .and. nstf_name1 > 0)) then flag_iter(i) = .true. endif endif diff --git a/physics/GFS_surface_loop_control.meta b/physics/GFS_surface_loop_control.meta index 048c836da..edb19072a 100644 --- a/physics/GFS_surface_loop_control.meta +++ b/physics/GFS_surface_loop_control.meta @@ -69,6 +69,20 @@ dimensions = () type = integer intent = in +[lsm] + standard_name = control_for_land_surface_scheme + long_name = flag for land surface model + units = flag + dimensions = () + type = integer + intent = in +[lsm_noahmp] + standard_name = identifier_for_noahmp_land_surface_scheme + long_name = flag for NOAH MP land surface model + units = flag + dimensions = () + type = integer + intent = in [iter] standard_name = ccpp_loop_counter long_name = loop counter for subcycling loops in CCPP diff --git a/physics/aerclm_def.F b/physics/aerclm_def.F index e66825278..b6760f30c 100644 --- a/physics/aerclm_def.F +++ b/physics/aerclm_def.F @@ -2,8 +2,10 @@ module aerclm_def use machine , only : kind_phys, kind_io4 implicit none - integer, parameter :: levsaer=72, ntrcaerm=15, timeaer=12 + integer, parameter :: levsaer=72, ntrcaerm=15, timeaer=2 integer :: latsaer, lonsaer, ntrcaer, levsw + integer :: n1sv, n2sv + integer :: iamin, iamax, jamin, jamax character*10 :: specname(ntrcaerm) real (kind=kind_phys):: aer_time(13) diff --git a/physics/aerinterp.F90 b/physics/aerinterp.F90 index 4b3232ab1..30ff97dff 100644 --- a/physics/aerinterp.F90 +++ b/physics/aerinterp.F90 @@ -9,9 +9,9 @@ module aerinterp implicit none - private + private read_netfaer - public :: read_aerdata, setindxaer, aerinterpol, read_aerdataf + public :: read_aerdata, setindxaer, aerinterpol,read_aerdataf contains @@ -45,7 +45,7 @@ SUBROUTINE read_aerdata (me, master, iflip, idate, errmsg, errflg) !! =================================================================== !! check if all necessary files exist !! =================================================================== - do imon = 1, timeaer + do imon = 1, 12 write(mn,'(i2.2)') imon fname=trim("aeroclim.m"//mn//".nc") inquire (file = fname, exist = file_exist) @@ -97,27 +97,25 @@ SUBROUTINE read_aerdata (me, master, iflip, idate, errmsg, errflg) END SUBROUTINE read_aerdata ! !********************************************************************** - SUBROUTINE read_aerdataf (iamin, iamax, jamin, jamax, & - me, master, iflip, idate, errmsg, errflg) + SUBROUTINE read_aerdataf ( me, master, iflip, idate, FHOUR, errmsg, errflg) use machine, only: kind_phys, kind_io4, kind_io8 use aerclm_def - use netcdf !--- in/out integer, intent(in) :: me, master, iflip, idate(4) - integer, intent(in) :: iamin, iamax, jamin, jamax character(len=*), intent(inout) :: errmsg integer, intent(inout) :: errflg - + real(kind=kind_phys), intent(in) :: fhour !--- locals - integer :: ncid, varid - integer :: i, j, k, n, ii, imon, klev - character :: fname*50, mn*2, vname*10 + integer :: i, j, k, n, ii, imon, klev, n1, n2 logical :: file_exist + integer IDAT(8),JDAT(8) + real(kind=kind_phys) RINC(5), rjday + integer jdow, jdoy, jday + real(4) rinc4(5) + integer w3kindreal,w3kindint + integer, allocatable :: invardims(:) - real(kind=kind_io4),allocatable,dimension(:,:,:) :: buff - real(kind=kind_io4),allocatable,dimension(:,:,:,:):: buffx - real(kind=kind_io4),allocatable,dimension(:,:) :: pres_tmp ! if (.not. allocated(aerin)) then allocate(aerin(iamin:iamax,jamin:jamax,levsaer,ntrcaerm,timeaer)) @@ -125,77 +123,45 @@ SUBROUTINE read_aerdataf (iamin, iamax, jamin, jamax, & endif ! allocate local working arrays - allocate (buff(lonsaer, latsaer, levsw)) - allocate (pres_tmp(lonsaer, levsw)) - allocate (buffx(lonsaer, latsaer, levsw, 1)) - +!! 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 w3kind(w3kindreal,w3kindint) + if(w3kindreal == 4) then + rinc4 = rinc + CALL W3MOVDAT(RINC4,IDAT,JDAT) + else + CALL W3MOVDAT(RINC,IDAT,JDAT) + endif +! + jdow = 0 + jdoy = 0 + jday = 0 + call w3doxdat(jdat,jdow,jdoy,jday) + rjday = jdoy + jdat(5) / 24. + IF (RJDAY < aer_time(1)) RJDAY = RJDAY+365. +! + n2 = 13 + do j=2, 12 + if (rjday < aer_time(j)) then + n2 = j + exit + endif + enddo + n1 = n2 - 1 + if (n2 > 12) n2 = n2 -12 !! =================================================================== -!! loop thru m01 - m12 for aer/pres array + call read_netfaer(n1, iflip, 1) + call read_netfaer(n2, iflip, 2) !! =================================================================== - do imon = 1, timeaer - write(mn,'(i2.2)') imon - fname=trim("aeroclim.m"//mn//".nc") - call nf_open(fname , nf90_NOWRITE, ncid) - -! ====> construct 3-d pressure array (Pa) - call nf_inq_varid(ncid, "DELP", varid) - call nf_get_var(ncid, varid, buff) - - 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,imon) = 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)) - call nf_inq_varid(ncid, vname, varid) - call nf_get_var(ncid, varid, buffx) - - 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,imon) = 1.d0*buffx(i,j,klev,1) - if(aerin(i,j,k,ii,imon) < 0. .or. aerin(i,j,k,ii,imon) > 1.) then - aerin(i,j,k,ii,imon) = 1.e-15 - endif - enddo !i-loop (lon) - enddo !k-loop (lev) - enddo !j-loop (lat) - - ENDDO ! ii-loop (ntracaerm) - -! close the file - call nf_close(ncid) - enddo !imon-loop + n1sv=n1 + n2sv=n2 !--- - deallocate (buff, pres_tmp) - deallocate (buffx) END SUBROUTINE read_aerdataf ! SUBROUTINE setindxaer(npts,dlat,jindx1,jindx2,ddy,dlon, & @@ -256,15 +222,18 @@ END SUBROUTINE setindxaer !********************************************************************** !********************************************************************** ! - SUBROUTINE aerinterpol(me,master,nthrds,npts,IDATE,FHOUR,jindx1,jindx2, & + SUBROUTINE aerinterpol( me,master,nthrds,npts,IDATE,FHOUR,iflip, jindx1,jindx2, & ddy,iindx1,iindx2,ddx,lev,prsl,aerout) ! - USE MACHINE, ONLY : kind_phys + use machine, only: kind_phys, kind_io4, kind_io8 use aerclm_def + implicit none - integer i1,i2, iday,j,j1,j2,l,npts,nc,n1,n2,lev,k,i,ii + 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), dimension(npts) :: temij,temiy,temjx,ddxy + ! integer JINDX1(npts), JINDX2(npts), iINDX1(npts), iINDX2(npts) @@ -279,6 +248,7 @@ SUBROUTINE aerinterpol(me,master,nthrds,npts,IDATE,FHOUR,jindx1,jindx2, & integer jdow, jdoy, jday real(4) rinc4(5) integer w3kindreal,w3kindint + ! IDAT = 0 IDAT(1) = IDATE(4) @@ -310,6 +280,26 @@ SUBROUTINE aerinterpol(me,master,nthrds,npts,IDATE,FHOUR,jindx1,jindx2, & endif enddo n1 = n2 - 1 + if (n2 > 12) n2 = n2 -12 +! need to read a new month + if (n1.ne.n1sv) then +#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(n2, iflip, 2) + n1sv=n1 + n2sv=n2 + end if ! tx1 = (aer_time(n2) - rjday) / (aer_time(n2) - aer_time(n1)) tx2 = 1.0 - tx1 @@ -328,7 +318,7 @@ SUBROUTINE aerinterpol(me,master,nthrds,npts,IDATE,FHOUR,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,n1,n2,lev,nthrds) & +!$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) @@ -343,17 +333,17 @@ SUBROUTINE aerinterpol(me,master,nthrds,npts,IDATE,FHOUR,jindx1,jindx2, & I2 = IINDX2(J) DO ii=1,ntrcaer aerpm(j,L,ii) = & - tx1*(TEMIJ(j)*aerin(I1,J1,L,ii,n1)+DDXY(j)*aerin(I2,J2,L,ii,n1) & - +TEMIY(j)*aerin(I1,J2,L,ii,n1)+temjx(j)*aerin(I2,J1,L,ii,n1))& - +tx2*(TEMIJ(j)*aerin(I1,J1,L,ii,n2)+DDXY(j)*aerin(I2,J2,L,ii,n2) & - +TEMIY(j)*aerin(I1,J2,L,ii,n2)+temjx(j)*aerin(I2,J1,L,ii,n2)) + 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,n1)+DDXY(j)*aer_pres(I2,J2,L,n1) & - +TEMIY(j)*aer_pres(I1,J2,L,n1)+temjx(j)*aer_pres(I2,J1,L,n1))& - +tx2*(TEMIJ(j)*aer_pres(I1,J1,L,n2)+DDXY(j)*aer_pres(I2,J2,L,n2) & - +TEMIY(j)*aer_pres(I1,J2,L,n2)+temjx(j)*aer_pres(I2,J1,L,n2)) + 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__ @@ -398,5 +388,85 @@ SUBROUTINE aerinterpol(me,master,nthrds,npts,IDATE,FHOUR,jindx1,jindx2, & RETURN END SUBROUTINE aerinterpol + subroutine read_netfaer(nf, iflip,nt) + use machine, only: kind_phys, kind_io4, kind_io8 + use aerclm_def + use netcdf + integer, intent(in) :: iflip, nf, nt + integer :: ncid, varid, i,j,k,ii,klev + character :: fname*50, mn*2, vname*10 + real(kind=kind_io4),allocatable,dimension(:,:,:) :: buff + real(kind=kind_io4),allocatable,dimension(:,:,:,:):: buffx + real(kind=kind_io4),allocatable,dimension(:,:) :: pres_tmp + +!! =================================================================== + allocate (buff(lonsaer, latsaer, levsw)) + allocate (pres_tmp(lonsaer, levsw)) + allocate (buffx(lonsaer, latsaer, levsw, 1)) + + write(mn,'(i2.2)') nf + fname=trim("aeroclim.m"//mn//".nc") + call nf_open(fname , nf90_NOWRITE, ncid) + +! ====> construct 3-d pressure array (Pa) + call nf_inq_varid(ncid, "DELP", varid) + call nf_get_var(ncid, varid, buff) + + 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)) + call nf_inq_varid(ncid, vname, varid) + call nf_get_var(ncid, varid, buffx) + + 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 + call nf_close(ncid) + deallocate (buff, pres_tmp) + deallocate (buffx) + return + END SUBROUTINE read_netfaer + end module aerinterp diff --git a/physics/cires_ugwp.meta b/physics/cires_ugwp.meta index fe0e82390..0d4cbcfd8 100644 --- a/physics/cires_ugwp.meta +++ b/physics/cires_ugwp.meta @@ -780,7 +780,7 @@ [dtend] standard_name = cumulative_change_of_state_variables long_name = diagnostic tendencies for state variables - units = various + units = mixed dimensions = (horizontal_loop_extent,vertical_layer_dimension,cumulative_change_of_state_variables_outer_index_max) type = real kind = kind_phys diff --git a/physics/cu_gf_deep.F90 b/physics/cu_gf_deep.F90 index 59bbd566d..102179bee 100644 --- a/physics/cu_gf_deep.F90 +++ b/physics/cu_gf_deep.F90 @@ -2454,9 +2454,9 @@ subroutine cup_dd_edt(ierr,us,vs,z,ktop,kbcon,edt,p,pwav, & if(aeroevap.gt.1)then aeroadd=0. if((psumh(i)>0.).and.(psum2(i)>0.))then - aeroadd=((1.e-2*ccnclean)**beta3)*((psumh(i)*1.e0)**(alpha3-1)) + aeroadd=((1.e-2*ccnclean)**beta3)*(psumh(i)**(alpha3-1)) prop_c=.5*(pefb+pef)/aeroadd - aeroadd=((1.e-2*ccn(i))**beta3)*((psum2(i)*1.e0)**(alpha3-1)) + aeroadd=((1.e-2*ccn(i))**beta3)*(psum2(i)**(alpha3-1)) aeroadd=prop_c*aeroadd pefc=aeroadd diff --git a/physics/cu_gf_driver.meta b/physics/cu_gf_driver.meta index 7ff2bc313..3a54a9ecc 100644 --- a/physics/cu_gf_driver.meta +++ b/physics/cu_gf_driver.meta @@ -323,7 +323,7 @@ kind = kind_phys intent = in [aod_gf] - standard_name = aod_gf_deep + standard_name = aerosol_optical_depth_for_grell_freitas_deep_convection long_name = aerosol optical depth used in Grell-Freitas Convective Parameterization units = none dimensions = (horizontal_loop_extent) @@ -418,7 +418,7 @@ [dtend] standard_name = cumulative_change_of_state_variables long_name = diagnostic tendencies for state variables - units = various + units = mixed dimensions = (horizontal_loop_extent,vertical_layer_dimension,cumulative_change_of_state_variables_outer_index_max) type = real kind = kind_phys diff --git a/physics/dcyc2.meta b/physics/dcyc2.meta index 1d6821d0a..122d6a8e1 100644 --- a/physics/dcyc2.meta +++ b/physics/dcyc2.meta @@ -417,7 +417,7 @@ kind = kind_phys intent = in [flux2D_lwUP] - standard_name = RRTMGP_lw_flux_profile_upward_allsky + standard_name = RRTMGP_lw_flux_profile_upward_allsky_on_radiation_timestep long_name = RRTMGP upward longwave all-sky flux profile units = W m-2 dimensions = (horizontal_loop_extent,vertical_interface_dimension) @@ -425,7 +425,7 @@ kind = kind_phys intent = in [flux2D_lwDOWN] - standard_name = RRTMGP_lw_flux_profile_downward_allsky + standard_name = RRTMGP_lw_flux_profile_downward_allsky_on_radiation_timestep long_name = RRTMGP downward longwave all-sky flux profile units = W m-2 dimensions = (horizontal_loop_extent,vertical_interface_dimension) diff --git a/physics/drag_suite.meta b/physics/drag_suite.meta index c168167a3..ba9d4050d 100644 --- a/physics/drag_suite.meta +++ b/physics/drag_suite.meta @@ -497,7 +497,7 @@ standard_name = multiplicative_tunable_parameters_for_mountain_blocking_and_orographic_gravity_wave_drag long_name = multiplic. factors for (1) mountain blocking drag coeff. and (2) ref. level orographic gravity wave drag units = none - dimensions = (2) + dimensions = (4) type = real kind = kind_phys intent = in @@ -576,7 +576,7 @@ [dtend] standard_name = cumulative_change_of_state_variables long_name = diagnostic tendencies for state variables - units = various + units = mixed dimensions = (horizontal_loop_extent,vertical_layer_dimension,cumulative_change_of_state_variables_outer_index_max) type = real kind = kind_phys diff --git a/physics/gfdl_fv_sat_adj.meta b/physics/gfdl_fv_sat_adj.meta index fc22ecd9e..8eece5a9c 100644 --- a/physics/gfdl_fv_sat_adj.meta +++ b/physics/gfdl_fv_sat_adj.meta @@ -340,8 +340,8 @@ intent = inout [pkz] standard_name = finite_volume_mean_edge_pressure_raised_to_the_power_of_kappa - long_name = finite-volume mean edge pressure raised to the power of kappa - units = Pa**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) type = real kind = kind_dyn diff --git a/physics/gwdc.meta b/physics/gwdc.meta index 3d4d7b385..2e8076bca 100644 --- a/physics/gwdc.meta +++ b/physics/gwdc.meta @@ -529,7 +529,7 @@ [dtend] standard_name = cumulative_change_of_state_variables long_name = diagnostic tendencies for state variables - units = various + units = mixed dimensions = (horizontal_loop_extent,vertical_layer_dimension,cumulative_change_of_state_variables_outer_index_max) type = real kind = kind_phys diff --git a/physics/h2o_def.meta b/physics/h2o_def.meta index 524828ba4..17f0f8779 100644 --- a/physics/h2o_def.meta +++ b/physics/h2o_def.meta @@ -21,8 +21,8 @@ type = integer [h2o_pres] standard_name = natural_log_of_h2o_forcing_data_pressure_levels - long_name = natural log of h2o forcing data pressure levels - units = log(Pa) + long_name = natural log of h2o forcing data pressure levels in Pa + units = 1 dimensions = (vertical_dimension_of_h2o_forcing_data) type = real kind = kind_phys diff --git a/physics/h2ophys.meta b/physics/h2ophys.meta index 702da0193..759666baf 100644 --- a/physics/h2ophys.meta +++ b/physics/h2ophys.meta @@ -74,7 +74,7 @@ [ph2o] standard_name = natural_log_of_h2o_forcing_data_pressure_levels long_name = natural log of h2o forcing data pressure levels - units = log(Pa) + units = 1 dimensions = (vertical_dimension_of_h2o_forcing_data) type = real kind = kind_phys @@ -90,7 +90,7 @@ [h2opltc] standard_name = stratospheric_water_vapor_forcing long_name = water forcing data - units = various + units = mixed dimensions = (horizontal_loop_extent,vertical_dimension_of_h2o_forcing_data,number_of_coefficients_in_h2o_forcing_data) type = real kind = kind_phys diff --git a/physics/m_micro.meta b/physics/m_micro.meta index 43654a26c..e202f7b74 100644 --- a/physics/m_micro.meta +++ b/physics/m_micro.meta @@ -135,7 +135,7 @@ [mg_qcvar] standard_name = relative_variance_of_subgrid_cloud_condensate_distribution long_name = cloud water relative variance for MG microphysics - units = + units = frac dimensions = () type = real kind = kind_phys @@ -151,7 +151,7 @@ [mg_rhmini] standard_name = relative_humidity_threshold_for_ice_nucleation long_name = relative humidity threshold parameter for nucleating ice for MG microphysics - units = none + units = frac dimensions = () type = real kind = kind_phys diff --git a/physics/maximum_hourly_diagnostics.meta b/physics/maximum_hourly_diagnostics.meta index 6ce746daa..d9a236c29 100644 --- a/physics/maximum_hourly_diagnostics.meta +++ b/physics/maximum_hourly_diagnostics.meta @@ -194,7 +194,7 @@ [rh02max] standard_name = maximum_relative_humidity_at_2m_over_maximum_hourly_time_interval long_name = maximum relative humidity at 2m over maximum hourly time interval - units = % + units = frac dimensions = (horizontal_loop_extent) type = real kind = kind_phys @@ -202,7 +202,7 @@ [rh02min] standard_name = minimum_relative_humidity_at_2m_over_maximum_hourly_time_interval long_name = minumum relative humidity at 2m over maximum hourly time interval - units = % + units = frac dimensions = (horizontal_loop_extent) type = real kind = kind_phys diff --git a/physics/module_MYJPBL_wrapper.meta b/physics/module_MYJPBL_wrapper.meta index cc3673958..43e63b4ab 100644 --- a/physics/module_MYJPBL_wrapper.meta +++ b/physics/module_MYJPBL_wrapper.meta @@ -589,7 +589,7 @@ [dtend] standard_name = cumulative_change_of_state_variables long_name = diagnostic tendencies for state variables - units = various + units = mixed dimensions = (horizontal_loop_extent,vertical_layer_dimension,cumulative_change_of_state_variables_outer_index_max) type = real kind = kind_phys diff --git a/physics/module_MYNNPBL_wrapper.meta b/physics/module_MYNNPBL_wrapper.meta index 6f0c2b072..25dc89efe 100644 --- a/physics/module_MYNNPBL_wrapper.meta +++ b/physics/module_MYNNPBL_wrapper.meta @@ -1004,7 +1004,7 @@ [dtend] standard_name = cumulative_change_of_state_variables long_name = diagnostic tendencies for state variables - units = various + units = mixed dimensions = (horizontal_loop_extent,vertical_layer_dimension,cumulative_change_of_state_variables_outer_index_max) type = real kind = kind_phys diff --git a/physics/module_bl_mynn.F90 b/physics/module_bl_mynn.F90 index fb0f1455d..a492e50e0 100644 --- a/physics/module_bl_mynn.F90 +++ b/physics/module_bl_mynn.F90 @@ -519,7 +519,7 @@ SUBROUTINE mym_initialize ( & INTEGER :: k,l,lmax REAL :: phm,vkz,elq,elv,b1l,b2l,pmz=1.,phh=1.,flt=0.,flq=0.,tmpq REAL :: zi - REAL, DIMENSION(kts:kte) :: theta,thetav,thlsg,qwsg + REAL, DIMENSION(kts:kte) :: theta,thetav,thlsg,qwsg REAL, DIMENSION(kts:kte) :: rstoch_col INTEGER ::spp_pbl diff --git a/physics/module_mp_thompson.F90 b/physics/module_mp_thompson.F90 index 2068084c0..3183ca4bf 100644 --- a/physics/module_mp_thompson.F90 +++ b/physics/module_mp_thompson.F90 @@ -149,7 +149,7 @@ MODULE module_mp_thompson REAL, PARAMETER, PRIVATE:: fv_s = 100.0 REAL, PARAMETER, PRIVATE:: av_g = 442.0 REAL, PARAMETER, PRIVATE:: bv_g = 0.89 - REAL, PARAMETER, PRIVATE:: av_i = 1847.5 + REAL, PARAMETER, PRIVATE:: av_i = 1493.9 REAL, PARAMETER, PRIVATE:: bv_i = 1.0 REAL, PARAMETER, PRIVATE:: av_c = 0.316946E8 REAL, PARAMETER, PRIVATE:: bv_c = 2.0 @@ -214,8 +214,8 @@ MODULE module_mp_thompson REAL, PARAMETER, PRIVATE:: xm0i = 1.E-12 REAL, PARAMETER, PRIVATE:: D0c = 1.E-6 REAL, PARAMETER, PRIVATE:: D0r = 50.E-6 - REAL, PARAMETER, PRIVATE:: D0s = 200.E-6 - REAL, PARAMETER, PRIVATE:: D0g = 250.E-6 + REAL, PARAMETER, PRIVATE:: D0s = 300.E-6 + REAL, PARAMETER, PRIVATE:: D0g = 350.E-6 REAL, PRIVATE:: D0i, xm0s, xm0g !..Min and max radiative effective radius of cloud water, cloud ice, and snow; @@ -970,8 +970,7 @@ SUBROUTINE mp_gt_driver(qv, qc, qr, qi, qs, qg, ni, nr, nc, & nwfa, nifa, nwfa2d, nifa2d, & tt, th, pii, & p, w, dz, dt_in, dt_inner, & - sedi_semi, sedi_semi_update, & - sedi_semi_decfl, & + sedi_semi, decfl, & RAINNC, RAINNCV, & SNOWNC, SNOWNCV, & ICENC, ICENCV, & @@ -1049,7 +1048,8 @@ SUBROUTINE mp_gt_driver(qv, qc, qr, qi, qs, qg, ni, nr, nc, & vt_dbz_wt LOGICAL, INTENT(IN) :: first_time_step REAL, INTENT(IN):: dt_in, dt_inner - LOGICAL, INTENT(IN) :: sedi_semi, sedi_semi_update, sedi_semi_decfl + 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) :: reset_dBZ @@ -1425,7 +1425,7 @@ SUBROUTINE mp_gt_driver(qv, qc, qr, qi, qs, qg, ni, nr, nc, & #endif rand1, rand2, rand3, & kts, kte, dt, i, j, ext_diag, & - sedi_semi, sedi_semi_update, sedi_semi_decfl, & + sedi_semi, decfl, & !vtsk1, txri1, txrc1, & prw_vcdc1, prw_vcde1, & tpri_inu1, tpri_ide1_d, tpri_ide1_s, tprs_ide1, & @@ -1821,7 +1821,7 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & ! Extended diagnostics, most arrays only ! allocated if ext_diag flag is .true. ext_diag, & - sedi_semi, sedi_semi_update, sedi_semi_decfl, & + sedi_semi, decfl, & !vtsk1, txri1, txrc1, & prw_vcdc1, prw_vcde1, & tpri_inu1, tpri_ide1_d, tpri_ide1_s, tprs_ide1, & @@ -1851,7 +1851,8 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & REAL, INTENT(IN):: rand1, rand2, rand3 ! Extended diagnostics, most arrays only allocated if ext_diag is true LOGICAL, INTENT(IN) :: ext_diag - LOGICAL, INTENT(IN) :: sedi_semi, sedi_semi_update, sedi_semi_decfl + LOGICAL, INTENT(IN) :: sedi_semi + INTEGER, INTENT(IN) :: decfl REAL, DIMENSION(:), INTENT(OUT):: & !vtsk1, txri1, txrc1, & prw_vcdc1, & @@ -1907,13 +1908,12 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & prg_rcg, prg_ihm DOUBLE PRECISION, PARAMETER:: zeroD0 = 0.0d0 - REAL, PARAMETER :: decfl = 8.0 - REAL :: dtcfl,rainsfc + REAL :: dtcfl,rainsfc,graulsfc INTEGER :: niter REAL, DIMENSION(kts:kte):: temp, pres, qv REAL, DIMENSION(kts:kte):: rc, ri, rr, rs, rg, ni, nr, nc, nwfa, nifa - REAL, DIMENSION(kts:kte):: rr_tmp,nr_tmp + REAL, DIMENSION(kts:kte):: rr_tmp, nr_tmp, rg_tmp REAL, DIMENSION(kts:kte):: rho, rhof, rhof2 REAL, DIMENSION(kts:kte):: qvs, qvsi, delQvs REAL, DIMENSION(kts:kte):: satw, sati, ssatw, ssati @@ -1927,7 +1927,7 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & REAL, DIMENSION(kts:kte):: sed_r, sed_s, sed_g, sed_i, sed_n,sed_c - REAL:: rgvm, delta_tp, orho, lfus2 + REAL:: rgvm, delta_tp, orho, lfus2, orhodt REAL, DIMENSION(5):: onstep DOUBLE PRECISION:: N0_exp, N0_min, lam_exp, lamc, lamr, lamg DOUBLE PRECISION:: lami, ilami, ilamc @@ -2188,7 +2188,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(9999.D3, cig(1)*oig2*ri(k)/am_i*lami**bm_i) + ni(k) = MIN(999.D3, 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 @@ -2196,7 +2196,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(9999.D3, cig(1)*oig2*ri(k)/am_i*lami**bm_i) + ni(k) = MIN(999.D3, 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 @@ -2467,7 +2467,7 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & tau = 3.72/(rc(k)*taud) prr_wau(k) = zeta/tau prr_wau(k) = MIN(DBLE(rc(k)*odts), prr_wau(k)) - pnr_wau(k) = prr_wau(k) / (am_r*nu_c*200.*D0r*D0r*D0r) ! RAIN2M + pnr_wau(k) = prr_wau(k) / (am_r*nu_c*10.*D0r*D0r*D0r) ! RAIN2M pnc_wau(k) = MIN(DBLE(nc(k)*odts), prr_wau(k) & / (am_r*mvd_c(k)*mvd_c(k)*mvd_c(k))) ! Qc2M endif @@ -3237,7 +3237,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(9999.D3, cig(1)*oig2*xri/am_i*lami**bm_i) + xni = MIN(999.D3, 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 @@ -3248,8 +3248,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.9999.E3) & - niten(k) = (9999.E3-ni1d(k)*rho(k))*odts*orho + if (xni.gt.999.E3) & + niten(k) = (999.E3-ni1d(k)*rho(k))*odts*orho !> - Rain tendency qrten(k) = qrten(k) + (prr_wau(k) + prr_rcw(k) & @@ -3835,7 +3835,7 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & t3_vts = Kap0*csg(1)*ils1**cse(1) t4_vts = Kap1*Mrat**mu_s*csg(7)*ils2**cse(7) vts = rhof(k)*av_s * (t1_vts+t2_vts)/(t3_vts+t4_vts) - if (temp(k).gt. (T_0+0.1)) then + if (prr_sml(k) .gt. 0.0) then ! vtsk(k) = MAX(vts*vts_boost(k), & ! & vts*((vtrk(k)-vts*vts_boost(k))/(temp(k)-T_0))) SR = rs(k)/(rs(k)+rr(k)) @@ -3930,44 +3930,41 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & else !if(.not. sedi_semi) niter = 1 dtcfl = dt - if(sedi_semi_decfl) then - niter = int(nstep/decfl) + 1 - dtcfl = dt/niter - endif + niter = int(nstep/max(decfl,1)) + 1 + dtcfl = dt/niter do n = 1, niter rr_tmp(:) = rr(:) nr_tmp(:) = nr(:) - call nislfv_rain_ppm(kte,dzq,vtrk,rr,rainsfc,dtcfl,R1) - call nislfv_rain_ppm(kte,dzq,vtnrk,nr,vtr,dtcfl,R2) + call semi_lagrange_sedim(kte,dzq,vtrk,rr,rainsfc,dtcfl,R1) + call semi_lagrange_sedim(kte,dzq,vtnrk,nr,vtr,dtcfl,R2) do k = kts, kte - qrten(k) = qrten(k) + (rr(k) - rr_tmp(k))/rho(k)/dt - nrten(k) = nrten(k) + (nr(k) - nr_tmp(k))/rho(k)/dt + orhodt = 1./(rho(k)*dt) + qrten(k) = qrten(k) + (rr(k) - rr_tmp(k)) * orhodt + nrten(k) = nrten(k) + (nr(k) - nr_tmp(k)) * orhodt enddo pptrain = pptrain + rainsfc - if(sedi_semi_update) then - do k = kte+1, kts, -1 - vtrk(k) = 0. - vtnrk(k) = 0. - enddo - do k = kte, kts, -1 - vtr = 0. - if (rr(k).gt. R1) then - lamr = (am_r*crg(3)*org2*nr(k)/rr(k))**obmr - vtr = rhof(k)*av_r*crg(6)*org3 * lamr**cre(3) & - *((lamr+fv_r)**(-cre(6))) - vtrk(k) = vtr + do k = kte+1, kts, -1 + vtrk(k) = 0. + vtnrk(k) = 0. + enddo + do k = kte, kts, -1 + vtr = 0. + if (rr(k).gt. R1) then + lamr = (am_r*crg(3)*org2*nr(k)/rr(k))**obmr + vtr = rhof(k)*av_r*crg(6)*org3 * lamr**cre(3) & + *((lamr+fv_r)**(-cre(6))) + vtrk(k) = vtr ! First below is technically correct: ! vtr = rhof(k)*av_r*crg(5)*org2 * lamr**cre(2) & ! *((lamr+fv_r)**(-cre(5))) ! Test: make number fall faster (but still slower than mass) ! Goal: less prominent size sorting - vtr = rhof(k)*av_r*crg(7)/crg(12) * lamr**cre(12) & - *((lamr+fv_r)**(-cre(7))) - vtnrk(k) = vtr - endif - enddo - endif ! if(sedi_semi_update) + vtr = rhof(k)*av_r*crg(7)/crg(12) * lamr**cre(12) & + *((lamr+fv_r)**(-cre(7))) + vtnrk(k) = vtr + endif + enddo enddo endif! if(.not. sedi_semi) endif @@ -4054,28 +4051,59 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & if (ANY(L_qg .eqv. .true.)) then nstep = NINT(1./onstep(4)) - do n = 1, nstep - do k = kte, kts, -1 - sed_g(k) = vtgk(k)*rg(k) - enddo - k = kte - odzq = 1./dzq(k) - orho = 1./rho(k) - qgten(k) = qgten(k) - sed_g(k)*odzq*onstep(4)*orho - rg(k) = MAX(R1, rg(k) - sed_g(k)*odzq*DT*onstep(4)) - do k = ksed1(4), kts, -1 - odzq = 1./dzq(k) - orho = 1./rho(k) - qgten(k) = qgten(k) + (sed_g(k+1)-sed_g(k)) & - *odzq*onstep(4)*orho - rg(k) = MAX(R1, rg(k) + (sed_g(k+1)-sed_g(k)) & + if(.not. sedi_semi) then + do n = 1, nstep + do k = kte, kts, -1 + sed_g(k) = vtgk(k)*rg(k) + enddo + k = kte + odzq = 1./dzq(k) + orho = 1./rho(k) + qgten(k) = qgten(k) - sed_g(k)*odzq*onstep(4)*orho + rg(k) = MAX(R1, rg(k) - sed_g(k)*odzq*DT*onstep(4)) + do k = ksed1(4), kts, -1 + odzq = 1./dzq(k) + orho = 1./rho(k) + qgten(k) = qgten(k) + (sed_g(k+1)-sed_g(k)) & + *odzq*onstep(4)*orho + rg(k) = MAX(R1, rg(k) + (sed_g(k+1)-sed_g(k)) & *odzq*DT*onstep(4)) - enddo + enddo - if (rg(kts).gt.R1*10.) & - pptgraul = pptgraul + sed_g(kts)*DT*onstep(4) - enddo - endif + if (rg(kts).gt.R1*10.) & + pptgraul = pptgraul + sed_g(kts)*DT*onstep(4) + enddo + else ! if(.not. sedi_semi) then + niter = 1 + dtcfl = dt + niter = int(nstep/max(decfl,1)) + 1 + dtcfl = dt/niter + + do n = 1, niter + rg_tmp(:) = rg(:) + call semi_lagrange_sedim(kte,dzq,vtgk,rg,graulsfc,dtcfl,R1) + do k = kts, kte + orhodt = 1./(rho(k)*dt) + qgten(k) = qgten(k) + (rg(k) - rg_tmp(k))*orhodt + enddo + pptgraul = pptgraul + graulsfc + do k = kte+1, kts, -1 + vtgk(k) = 0. + enddo + do k = kte, kts, -1 + vtg = 0. + if (rg(k).gt. R1) then + vtg = rhof(k)*av_g*cgg(6)*ogg3 * ilamg(k)**bv_g + if (temp(k).gt. T_0) then + vtgk(k) = MAX(vtg, vtrk(k)) + else + vtgk(k) = vtg + endif + endif + enddo + enddo + endif ! if(.not. sedi_semi) then + endif !+---+-----------------------------------------------------------------+ !> - Instantly melt any cloud ice into cloud water if above 0C and @@ -4159,7 +4187,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, & - 9999.D3/rho(k)) + 999.D3/rho(k)) endif qr1d(k) = qr1d(k) + qrten(k)*DT nr1d(k) = MAX(R2/rho(k), nr1d(k) + nrten(k)*DT) @@ -6102,13 +6130,13 @@ subroutine calc_refl10cm (qv1d, qc1d, qr1d, nr1d, qs1d, qg1d, & end subroutine calc_refl10cm ! !------------------------------------------------------------------- - SUBROUTINE nislfv_rain_ppm(km,dzl,wwl,rql,precip,dt,R1) + SUBROUTINE semi_lagrange_sedim(km,dzl,wwl,rql,precip,dt,R1) !------------------------------------------------------------------- ! -! for non-iteration semi-Lagrangain forward advection for cloud +! 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 -! this routine is under assumption of decfl < 1 for semi_Lagrangian +! 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 @@ -6118,6 +6146,9 @@ SUBROUTINE nislfv_rain_ppm(km,dzl,wwl,rql,precip,dt,R1) ! ! author: hann-ming henry juang ! implemented by song-you hong +! reference: Juang, H.-M., and S.-Y. Hong, 2010: Forward semi-Lagrangian advection +! with mass conservation and positive definiteness for falling +! hydrometeors. *Mon. Wea. Rev.*, *138*, 1778-1791 ! implicit none @@ -6320,7 +6351,7 @@ SUBROUTINE nislfv_rain_ppm(km,dzl,wwl,rql,precip,dt,R1) ! ! ---------------------------------- ! - END SUBROUTINE nislfv_rain_ppm + END SUBROUTINE semi_lagrange_sedim !+---+-----------------------------------------------------------------+ !+---+-----------------------------------------------------------------+ !+---+-----------------------------------------------------------------+ diff --git a/physics/module_sf_noahmp_glacier.f90 b/physics/module_sf_noahmp_glacier.f90 index be24381f4..b5abd871b 100644 --- a/physics/module_sf_noahmp_glacier.f90 +++ b/physics/module_sf_noahmp_glacier.f90 @@ -6,6 +6,8 @@ module noahmp_glacier_globals use machine , only : kind_phys + use sfc_diff, only : stability + implicit none ! ================================================================================================== @@ -59,6 +61,8 @@ module noahmp_glacier_globals INTEGER :: OPT_GLA != 1 !(suggested 1) + INTEGER :: OPT_SFC != 1 !(suggested 1) + ! adjustable parameters for snow processes REAL, PARAMETER :: Z0SNO = 0.002 !< snow surface roughness length (m) (0.002) @@ -114,20 +118,21 @@ module noahmp_glacier_routines !>\ingroup NoahMP_LSM subroutine noahmp_glacier (& - iloc ,jloc ,cosz ,nsnow ,nsoil ,dt , & ! in : time/space/model-related - sfctmp ,sfcprs ,uu ,vv ,q2 ,soldn , & ! in : forcing - prcp ,lwdn ,tbot ,zlvl ,ficeold ,zsoil , & ! in : forcing - qsnow ,sneqvo ,albold ,cm ,ch ,isnow , & ! in/out : - sneqv ,smc ,zsnso ,snowh ,snice ,snliq , & ! in/out : - tg ,stc ,sh2o ,tauss ,qsfc , & ! in/out : - fsa ,fsr ,fira ,fsh ,fgev ,ssoil , & ! out : - trad ,edir ,runsrf ,runsub ,sag ,albedo , & ! out : - qsnbot ,ponding ,ponding1,ponding2,t2m ,q2e , & ! out : + iloc ,jloc ,cosz ,nsnow ,nsoil ,dt , & ! in : time/space/model-related + sfctmp ,sfcprs ,uu ,vv ,q2 ,soldn , & ! in : forcing + prcp ,lwdn ,tbot ,zlvl ,ficeold ,zsoil , & ! in : forcing + thsfc_loc ,prslkix ,prsik1x ,prslk1x ,sigmaf1 ,garea1 , & ! in : + qsnow ,sneqvo ,albold ,cm ,ch ,isnow , & ! in/out : + sneqv ,smc ,zsnso ,snowh ,snice ,snliq , & ! in/out : + tg ,stc ,sh2o ,tauss ,qsfc , & ! in/out : + fsa ,fsr ,fira ,fsh ,fgev ,ssoil , & ! out : + trad ,edir ,runsrf ,runsub ,sag ,albedo , & ! out : + qsnbot ,ponding ,ponding1 ,ponding2 ,t2m,q2e ,z0h_total , & ! out : #ifdef CCPP - emissi, fpice ,ch2b , esnow, albsnd, albsni , & - errmsg, errflg) + emissi ,fpice ,ch2b , esnow , albsnd , albsni , & + errmsg ,errflg) #else - emissi, fpice ,ch2b , esnow, albsnd, albsni) + emissi ,fpice ,ch2b , esnow. , albsnd , albsni) #endif @@ -156,6 +161,13 @@ subroutine noahmp_glacier (& real (kind=kind_phys) , intent(in) :: zlvl !< reference height (m) real (kind=kind_phys), dimension(-nsnow+1: 0), intent(in) :: ficeold!< ice fraction at last timestep real (kind=kind_phys), dimension( 1:nsoil), intent(in) :: zsoil !< layer-bottom depth from soil surf (m) + logical , intent(in) :: thsfc_loc + real (kind=kind_phys) , intent(in) :: prslkix !< pressure (pa) + real (kind=kind_phys) , intent(in) :: prsik1x !< pressure (pa) + real (kind=kind_phys) , intent(in) :: prslk1x !< pressure (pa) + real (kind=kind_phys) , intent(in) :: sigmaf1 !< areal fractional cover of green vegetation + real (kind=kind_phys) , intent(in) :: garea1 !< area of the grid cell + ! input/output : need arbitary intial values @@ -198,6 +210,7 @@ subroutine noahmp_glacier (& real (kind=kind_phys) , intent(out) :: ponding2!< surface ponding [mm] real (kind=kind_phys) , intent(out) :: t2m !< 2-m air temperature over bare ground part [k] real (kind=kind_phys) , intent(out) :: q2e + real (kind=kind_phys) , intent(out) :: z0h_total !< roughness length for heat real (kind=kind_phys) , intent(out) :: emissi real (kind=kind_phys) , intent(out) :: fpice real (kind=kind_phys) , intent(out) :: ch2b @@ -255,21 +268,22 @@ subroutine noahmp_glacier (& ! compute energy budget (momentum & energy fluxes and phase changes) - call energy_glacier (nsnow ,nsoil ,isnow ,dt ,qsnow ,rhoair , & !in - eair ,sfcprs ,qair ,sfctmp ,lwdn ,uu , & !in - vv ,solad ,solai ,cosz ,zlvl , & !in - tbot ,zbot ,zsnso ,dzsnso , & !in - tg ,stc ,snowh ,sneqv ,sneqvo ,sh2o , & !inout - smc ,snice ,snliq ,albold ,cm ,ch , & !inout + call energy_glacier (nsnow ,nsoil ,isnow ,dt ,qsnow ,rhoair , & !in + eair ,sfcprs ,qair ,sfctmp ,lwdn ,uu , & !in + vv ,solad ,solai ,cosz ,zlvl , & !in + tbot ,zbot ,zsnso ,dzsnso ,sigmaf1 ,garea1 , & !in + thsfc_loc ,prslkix ,prsik1x ,prslk1x , & !in + tg ,stc ,snowh ,sneqv ,sneqvo ,sh2o , & !inout + smc ,snice ,snliq ,albold ,cm ,ch , & !inout #ifdef CCPP - tauss ,qsfc ,errmsg ,errflg , & !inout + tauss ,qsfc ,errmsg ,errflg , & !inout #else - tauss ,qsfc , & !inout + tauss ,qsfc , & !inout #endif - imelt ,snicev ,snliqv ,epore ,qmelt ,ponding, & !out - sag ,fsa ,fsr ,fira ,fsh ,fgev , & !out - trad ,t2m ,ssoil ,lathea ,q2e ,emissi, & !out - ch2b ,albsnd ,albsni ) !out + imelt ,snicev ,snliqv ,epore ,qmelt ,ponding , & !out + sag ,fsa ,fsr ,fira ,fsh ,fgev , & !out + trad ,t2m ,ssoil ,lathea ,q2e ,emissi , & !out + ch2b ,albsnd ,albsni ,z0h_total) !out #ifdef CCPP if (errflg /= 0) return @@ -284,12 +298,12 @@ subroutine noahmp_glacier (& ! compute water budgets (water storages, et components, and runoff) - call water_glacier (nsnow ,nsoil ,imelt ,dt ,prcp ,sfctmp , & !in - qvap ,qdew ,ficeold,zsoil , & !in - isnow ,snowh ,sneqv ,snice ,snliq ,stc , & !inout - dzsnso ,sh2o ,sice ,ponding,zsnso ,fsh , & !inout - runsrf ,runsub ,qsnow ,ponding1 ,ponding2,qsnbot,fpice,esnow & !out - ) + call water_glacier (nsnow ,nsoil ,imelt ,dt ,prcp ,sfctmp , & !in + qvap ,qdew ,ficeold ,zsoil , & !in + isnow ,snowh ,sneqv ,snice ,snliq ,stc , & !inout + dzsnso ,sh2o ,sice ,ponding ,zsnso ,fsh , & !inout + runsrf ,runsub ,qsnow ,ponding1 ,ponding2 ,qsnbot , & !out + fpice ,esnow) !out if(opt_gla == 2) then edir = qvap - qdew @@ -306,7 +320,7 @@ subroutine noahmp_glacier (& call error_glacier (iloc ,jloc ,swdown ,fsa ,fsr ,fira , & fsh ,fgev ,ssoil ,sag ,prcp ,edir , & #ifdef CCPP - runsrf ,runsub ,sneqv ,dt ,beg_wb, errmsg, errflg ) + runsrf ,runsub ,sneqv ,dt ,beg_wb ,errmsg , errflg ) #else runsrf ,runsub ,sneqv ,dt ,beg_wb ) #endif @@ -385,21 +399,22 @@ end subroutine atm_glacier ! ================================================================================================== ! -------------------------------------------------------------------------------------------------- !>\ingroup NoahMP_LSM - subroutine energy_glacier (nsnow ,nsoil ,isnow ,dt ,qsnow ,rhoair , & !in - eair ,sfcprs ,qair ,sfctmp ,lwdn ,uu , & !in - vv ,solad ,solai ,cosz ,zref , & !in - tbot ,zbot ,zsnso ,dzsnso , & !in - tg ,stc ,snowh ,sneqv ,sneqvo ,sh2o , & !inout - smc ,snice ,snliq ,albold ,cm ,ch , & !inout + subroutine energy_glacier (nsnow ,nsoil ,isnow ,dt ,qsnow ,rhoair , & !in + eair ,sfcprs ,qair ,sfctmp ,lwdn ,uu , & !in + vv ,solad ,solai ,cosz ,zref , & !in + tbot ,zbot ,zsnso ,dzsnso ,sigmaf1 ,garea1 , & !in + thsfc_loc ,prslkix ,prsik1x ,prslk1x , & !in + tg ,stc ,snowh ,sneqv ,sneqvo ,sh2o , & !inout + smc ,snice ,snliq ,albold ,cm ,ch , & !inout #ifdef CCPP - tauss ,qsfc ,errmsg, errflg, & !inout + tauss ,qsfc ,errmsg ,errflg , & !inout #else - tauss ,qsfc , & !inout + tauss ,qsfc , & !inout #endif - imelt ,snicev ,snliqv ,epore ,qmelt ,ponding, & !out - sag ,fsa ,fsr ,fira ,fsh ,fgev , & !out - trad ,t2m ,ssoil ,lathea ,q2e ,emissi, & !out - ch2b ,albsnd ,albsni ) !out + imelt ,snicev ,snliqv ,epore ,qmelt ,ponding , & !out + sag ,fsa ,fsr ,fira ,fsh ,fgev , & !out + trad ,t2m ,ssoil ,lathea ,q2e ,emissi , & !out + ch2b ,albsnd ,albsni ,z0h_total) !out ! -------------------------------------------------------------------------------------------------- ! -------------------------------------------------------------------------------------------------- @@ -431,6 +446,13 @@ subroutine energy_glacier (nsnow ,nsoil ,isnow ,dt ,qsnow ,rhoair , & !i real (kind=kind_phys) , dimension(-nsnow+1:nsoil), intent(in) :: zsnso !< layer-bottom depth from snow surf [m] real (kind=kind_phys) , dimension(-nsnow+1:nsoil), intent(in) :: dzsnso !< depth of snow & soil layer-bottom [m] + logical , intent(in) :: thsfc_loc + real (kind=kind_phys) , intent(in) :: prslkix ! in exner function + real (kind=kind_phys) , intent(in) :: prsik1x ! in exner function + real (kind=kind_phys) , intent(in) :: prslk1x ! in exner function + real (kind=kind_phys) , intent(in) :: sigmaf1 !< areal fractional cover of green vegetation + real (kind=kind_phys) , intent(in) :: garea1 !< area of the grid cell + ! input & output real (kind=kind_phys) , intent(inout) :: tg !< ground temperature (k) real (kind=kind_phys) , dimension(-nsnow+1:nsoil), intent(inout) :: stc !< snow/soil temperature [k] @@ -474,6 +496,7 @@ subroutine energy_glacier (nsnow ,nsoil ,isnow ,dt ,qsnow ,rhoair , & !i real (kind=kind_phys) , intent(out) :: ch2b !< sensible heat conductance, canopy air to zlvl air (m/s) real (kind=kind_phys), dimension(1:2) , intent(out) :: albsnd !< snow albedo (direct) real (kind=kind_phys), dimension(1:2) , intent(out) :: albsni !< snow albedo (diffuse) + real (kind=kind_phys) , intent(out) :: z0h_total !< roughness length for heat ! local @@ -515,7 +538,7 @@ subroutine energy_glacier (nsnow ,nsoil ,isnow ,dt ,qsnow ,rhoair , & !i call radiation_glacier (dt ,tg ,sneqvo ,sneqv ,cosz , & !in qsnow ,solad ,solai , & !in albold ,tauss , & !inout - sag ,fsr ,fsa , albsnd ,albsni) !out + sag ,fsr ,fsa ,albsnd ,albsni) !out ! vegetation and ground emissivity @@ -533,17 +556,18 @@ subroutine energy_glacier (nsnow ,nsoil ,isnow ,dt ,qsnow ,rhoair , & !i ! surface temperatures of the ground and energy fluxes - call glacier_flux (nsoil ,nsnow ,emg ,isnow ,df ,dzsnso ,z0mg , & !in - zlvl ,zpd ,qair ,sfctmp ,rhoair ,sfcprs , & !in - ur ,gamma ,rsurf ,lwdn ,rhsur ,smc , & !in - eair ,stc ,sag ,snowh ,lathea ,sh2o , & !in + call glacier_flux (nsoil ,nsnow ,emg ,isnow ,df ,dzsnso ,z0mg , & !in + zlvl ,zpd ,qair ,sfctmp ,rhoair ,sfcprs , & !in + ur ,gamma ,rsurf ,lwdn ,rhsur ,smc , & !in + eair ,stc ,sag ,snowh ,lathea ,sh2o , & !in + thsfc_loc ,prslkix ,prsik1x ,prslk1x ,sigmaf1 ,garea1 , & !in #ifdef CCPP - cm ,ch ,tg ,qsfc ,errmsg ,errflg , & !inout + cm ,ch ,tg ,qsfc ,errmsg ,errflg , & !inout #else - cm ,ch ,tg ,qsfc , & !inout + cm ,ch ,tg ,qsfc , & !inout #endif - fira ,fsh ,fgev ,ssoil , & !out - t2m ,q2e ,ch2b) !out + fira ,fsh ,fgev ,ssoil , & !out + t2m ,q2e ,ch2b ,z0h_total) !out !energy balance at surface: sag=(irb+shb+evb+ghb) @@ -724,10 +748,10 @@ subroutine csnow_glacier (isnow ,nsnow ,nsoil ,snice ,snliq ,dzsnso , end subroutine csnow_glacier !=================================================================================================== !>\ingroup NoahMP_LSM - subroutine radiation_glacier (dt ,tg ,sneqvo ,sneqv ,cosz , & !in - qsnow ,solad ,solai , & !in - albold ,tauss , & !inout - sag ,fsr ,fsa,albsnd ,albsni) !out + subroutine radiation_glacier (dt ,tg ,sneqvo ,sneqv ,cosz , & !in + qsnow ,solad ,solai , & !in + albold ,tauss , & !inout + sag ,fsr ,fsa ,albsnd ,albsni) !out ! -------------------------------------------------------------------------------------------------- implicit none ! -------------------------------------------------------------------------------------------------- @@ -968,17 +992,18 @@ end subroutine snowalb_class_glacier !>\ingroup NoahMP_LSM !! use newton-raphson iteration to solve ground (tg) temperature !! that balances the surface energy budgets for glacier. - subroutine glacier_flux (nsoil ,nsnow ,emg ,isnow ,df ,dzsnso ,z0m , & !in - zlvl ,zpd ,qair ,sfctmp ,rhoair ,sfcprs , & !in - ur ,gamma ,rsurf ,lwdn ,rhsur ,smc , & !in - eair ,stc ,sag ,snowh ,lathea ,sh2o , & !in + subroutine glacier_flux (nsoil ,nsnow ,emg ,isnow ,df ,dzsnso ,z0m , & !in + zlvl ,zpd ,qair ,sfctmp ,rhoair ,sfcprs , & !in + ur ,gamma ,rsurf ,lwdn ,rhsur ,smc , & !in + eair ,stc ,sag ,snowh ,lathea ,sh2o , & !in + thsfc_loc ,prslkix ,prsik1x ,prslk1x ,sigmaf1 ,garea1 , & !in #ifdef CCPP - cm ,ch ,tgb ,qsfc ,errmsg ,errflg , & !inout + cm ,ch ,tgb ,qsfc ,errmsg ,errflg , & !inout #else - cm ,ch ,tgb ,qsfc , & !inout + cm ,ch ,tgb ,qsfc , & !inout #endif - irb ,shb ,evb ,ghb , & !out - t2mb ,q2b ,ehb2) !out + irb ,shb ,evb ,ghb , & !out + t2mb ,q2b ,ehb2 ,z0h_total) !out ! -------------------------------------------------------------------------------------------------- ! use newton-raphson iteration to solve ground (tg) temperature @@ -1018,6 +1043,13 @@ subroutine glacier_flux (nsoil ,nsnow ,emg ,isnow ,df ,dzsnso ,z real (kind=kind_phys), intent(in) :: snowh !< actual snow depth [m] real (kind=kind_phys), intent(in) :: lathea !< latent heat of vaporization/subli (j/kg) + logical , intent(in) :: thsfc_loc !way to th tmp + real (kind=kind_phys), intent(in) :: prslkix ! in exner function + real (kind=kind_phys), intent(in) :: prsik1x ! in exner function + real (kind=kind_phys), intent(in) :: prslk1x ! in exner function + real (kind=kind_phys), intent(in) :: sigmaf1 ! + real (kind=kind_phys), intent(in) :: garea1 ! + ! input/output real (kind=kind_phys), intent(inout) :: cm !< momentum drag coefficient real (kind=kind_phys), intent(inout) :: ch !< sensible heat exchange coefficient @@ -1038,10 +1070,13 @@ subroutine glacier_flux (nsoil ,nsnow ,emg ,isnow ,df ,dzsnso ,z real (kind=kind_phys), intent(out) :: t2mb !< 2 m height air temperature (k) real (kind=kind_phys), intent(out) :: q2b !< bare ground heat conductance real (kind=kind_phys), intent(out) :: ehb2 !< sensible heat conductance for diagnostics + real (kind=kind_phys), intent(out) :: z0h_total !< roughness length for heat ! local variables integer :: niterb !< number of iterations for surface temperature + integer :: niter !< number of iterations for surface temperature + real (kind=kind_phys) :: mpe !< prevents overflow error if division by zero real (kind=kind_phys) :: dtg !< change in tg, last iteration (k) integer :: mozsgn !< number of times moz changes sign @@ -1058,6 +1093,26 @@ subroutine glacier_flux (nsoil ,nsnow ,emg ,isnow ,df ,dzsnso ,z real (kind=kind_phys) :: cq2b !< integer :: iter !< iteration index real (kind=kind_phys) :: z0h !< roughness length, sensible heat, ground (m) + + real(kind=kind_phys) :: rb1i ! bulk richardson # + real(kind=kind_phys) :: fm10i ! fm10 over land ice + + real(kind=kind_phys) :: stress1i! wind stress m2 S-2 + + real(kind=kind_phys) :: tv1i ! virtual potential temp @ ref level + + real(kind=kind_phys) :: thv1i ! virtual potential temp @ ref level + real(kind=kind_phys) :: tvsi ! surface virtual temp + real(kind=kind_phys) :: zlvli ! ref. level + + real(kind=kind_phys) :: snwd ! snow depth in mm + + real(kind=kind_phys) :: reyni ! roughness Reynolds # + real(kind=kind_phys) :: virtfaci! virutal factor + + real(kind=kind_phys) :: tem1,tem2,zvfun1,gdx + real(kind=kind_phys), parameter :: z0lo=0.1, z0up=1.0 + real (kind=kind_phys) :: moz !< monin-obukhov stability parameter real (kind=kind_phys) :: fm !< momentum stability correction, weighted by prior iters real (kind=kind_phys) :: fh !< sen heat stability correction, weighted by prior iters @@ -1081,6 +1136,8 @@ subroutine glacier_flux (nsoil ,nsnow ,emg ,isnow ,df ,dzsnso ,z ! initialization variables that do not depend on stability iteration ! ----------------------------------------------------------------- niterb = 5 + niter = 1 + mpe = 1e-6 dtg = 0. mozsgn = 0 @@ -1088,16 +1145,47 @@ subroutine glacier_flux (nsoil ,nsnow ,emg ,isnow ,df ,dzsnso ,z moz = 0. h = 0. - fv = 0.1 + +! the following only applies to opt_sfc =3, opt_sfc = 1 still done its old way + + snwd = snowh*1000.0 + zlvli = zlvl - zpd + +! fv = ustarx ! the input maybe too high for glacial + fv = ur*vkc/log(zlvli/z0m) + reyni = fv*z0m/(1.5e-05) !introduction of fv dependent z0h for the iter + + if (reyni .gt. 2.0) then + z0h = z0m/exp(2.46*(reyni)**0.25 - log(7.4)) !Brutsaert 1982 + else + z0h = z0m/exp(-log(0.397)) !Brusaert 1982, table 4 + endif + + z0h_total = z0h + + virtfaci = 1.0 + 0.61 * max(qair, 1.e-8) + tv1i = sfctmp * virtfaci ! virt tmp @ middle + + if(thsfc_loc) then ! Use local potential temperature + thv1i = sfctmp * prslkix * virtfaci + else ! Use potential temperature reference to 1000 hPa + thv1i = sfctmp / prslk1x * virtfaci + endif + + if ( ur < 2.0) niter = 2 cir = emg*sb cgh = 2.*df(isnow+1)/dzsnso(isnow+1) ! ----------------------------------------------------------------- + tem1 = (z0m - z0lo) / (z0up - z0lo) + tem1 = min(max(tem1, 0.0_kind_phys), 1.0_kind_phys) + tem2 = max(sigmaf1, 0.1_kind_phys) + zvfun1= sqrt(tem1 * tem2) + gdx=sqrt(garea1) + if(opt_sfc == 1 .or. opt_sfc == 2) then !Add option for sfc scheme,use '1' for both '1'/'2' loop3: do iter = 1, niterb ! begin stability iteration - z0h = z0m - ! for now, only allow sfcdif1 until others can be fixed call sfcdif1_glacier(iter ,zlvl ,zpd ,z0h ,z0m , & !in @@ -1167,6 +1255,80 @@ subroutine glacier_flux (nsoil ,nsnow ,emg ,isnow ,df ,dzsnso ,z qsfc = 0.622*(estg*rhsur)/(sfcprs-0.378*(estg*rhsur)) end do loop3 ! end stability iteration + end if + + if (opt_sfc == 3) then + + do iter = 1, niter + + if(thsfc_loc) then ! Use local potential temperature + tvsi = tgb * virtfaci + else ! Use potential temperature referenced to 1000 hPa + tvsi = tgb/prsik1x * virtfaci + endif + + call stability & + (zlvli, zvfun1, gdx,tv1i,thv1i, ur, z0m, z0h, tvsi, grav,thsfc_loc, & + rb1i, fm,fh,fm10i,fh2,cm,ch,stress1i,fv) + +! maybe need to add some sorts of err handling if CCPP + + ramb = max(1.,1./(cm*ur)) + rahb = max(1.,1./(ch*ur)) + rawb = rahb + +! es and d(es)/dt evaluated at tg + + t = tdc(tgb) + call esat(t, esatw, esati, dsatw, dsati) + if (t .gt. 0.) then + estg = esatw + destg = dsatw + else + estg = esati + destg = dsati + end if + + csh = rhoair*cpair/rahb + + 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 + +! surface fluxes and dtg + + irb = cir * tgb**4 - emg*lwdn + shb = csh * (tgb - sfctmp ) + evb = cev * (estg*rhsur - eair ) + ghb = cgh * (tgb - stc(isnow+1)) + + b = sag-irb-shb-evb-ghb + a = 4.*cir*tgb**3 + csh + cev*destg + cgh + dtg = b/a + + irb = irb + 4.*cir*tgb**3*dtg + shb = shb + csh*dtg + evb = evb + cev*destg*dtg + ghb = ghb + cgh*dtg + +! update ground surface temperature to update cm/ch + + tgb = tgb + dtg + + t = tdc(tgb) + call esat(t, esatw, esati, dsatw, dsati) + if (t .gt. 0.) then + estg = esatw + else + estg = esati + end if + qsfc = 0.622*(estg*rhsur)/(sfcprs-0.378*(estg*rhsur)) + + end do !sfc_diff3 iter + end if !sfc_diff3 + ! ----------------------------------------------------------------- ! if snow on ground and tg > tfrz: reset tg = tfrz. reevaluate ground fluxes. @@ -1193,7 +1355,7 @@ subroutine glacier_flux (nsoil ,nsnow ,emg ,isnow ,df ,dzsnso ,z t2mb = tgb q2b = qsfc else - t2mb = tgb - shb/(rhoair*cpair) * 1./ehb2 + t2mb = tgb - shb/(rhoair*cpair) * 1./ehb2 q2b = qsfc - evb/(lathea*rhoair)*(1./cq2b + rsurf) endif @@ -1256,14 +1418,15 @@ end subroutine esat ! ================================================================================================== !>\ingroup NoahMP_LSM !! compute surface drag coefficient cm for momentum and ch for heat - subroutine sfcdif1_glacier(iter ,zlvl ,zpd ,z0h ,z0m , & !in - qair ,sfctmp ,h ,rhoair ,mpe ,ur , & !in + subroutine sfcdif1_glacier(iter ,zlvl ,zpd ,z0h ,z0m , & !in + qair ,sfctmp ,h ,rhoair ,mpe ,ur , & !in #ifdef CCPP - & moz ,mozsgn ,fm ,fh ,fm2 ,fh2 ,errmsg ,errflg , & !inout + & moz ,mozsgn ,fm ,fh ,fm2 ,fh2 , & !inout + & errmsg ,errflg , & !inout #else - & moz ,mozsgn ,fm ,fh ,fm2 ,fh2 , & !inout + & moz ,mozsgn ,fm ,fh ,fm2 ,fh2 , & !inout #endif - & fv ,cm ,ch ,ch2 ) !out + & fv ,cm ,ch ,ch2 ) !out ! ------------------------------------------------------------------------------------------------- ! computing surface drag coefficient cm for momentum and ch for heat ! ------------------------------------------------------------------------------------------------- @@ -2099,12 +2262,12 @@ subroutine phasechange_glacier (nsnow ,nsoil ,isnow ,dt ,fact , & end subroutine phasechange_glacier ! ================================================================================================== !>\ingroup NoahMP_LSM - subroutine water_glacier (nsnow ,nsoil ,imelt ,dt ,prcp ,sfctmp , & !in - qvap ,qdew ,ficeold,zsoil , & !in - isnow ,snowh ,sneqv ,snice ,snliq ,stc , & !inout - dzsnso ,sh2o ,sice ,ponding,zsnso ,fsh , & !inout - runsrf ,runsub ,qsnow ,ponding1 ,ponding2,qsnbot,fpice,esnow & !out - ) !out + subroutine water_glacier (nsnow ,nsoil ,imelt ,dt ,prcp ,sfctmp , & !in + qvap ,qdew ,ficeold ,zsoil , & !in + isnow ,snowh ,sneqv ,snice ,snliq ,stc , & !inout + dzsnso ,sh2o ,sice ,ponding ,zsnso ,fsh , & !inout + runsrf ,runsub ,qsnow ,ponding1 ,ponding2 ,qsnbot , & !out + fpice ,esnow) !out ! ---------------------------------------------------------------------- ! code history: ! initial code: guo-yue niu, oct. 2007 @@ -2223,13 +2386,13 @@ subroutine water_glacier (nsnow ,nsoil ,imelt ,dt ,prcp ,sfctmp , & !in qsnfro = qdew esnow = qsnsub*2.83e+6 - call snowwater_glacier (nsnow ,nsoil ,imelt ,dt ,sfctmp , & !in - snowhin,qsnow ,qsnfro ,qsnsub ,qrain , & !in - ficeold,zsoil , & !in - isnow ,snowh ,sneqv ,snice ,snliq , & !inout - sh2o ,sice ,stc ,dzsnso ,zsnso , & !inout - fsh , & !inout - qsnbot ,snoflow,ponding1 ,ponding2) !out + call snowwater_glacier (nsnow ,nsoil ,imelt ,dt ,sfctmp , & !in + snowhin ,qsnow ,qsnfro ,qsnsub ,qrain , & !in + ficeold ,zsoil , & !in + isnow ,snowh ,sneqv ,snice ,snliq , & !inout + sh2o ,sice ,stc ,dzsnso ,zsnso , & !inout + fsh , & !inout + qsnbot ,snoflow ,ponding1 ,ponding2) !out !ponding: melting water from snow when there is no layer @@ -2270,13 +2433,13 @@ end subroutine water_glacier ! ================================================================================================== ! ---------------------------------------------------------------------- !>\ingroup NoahMP_LSM - subroutine snowwater_glacier (nsnow ,nsoil ,imelt ,dt ,sfctmp , & !in - snowhin,qsnow ,qsnfro ,qsnsub ,qrain , & !in - ficeold,zsoil , & !in - isnow ,snowh ,sneqv ,snice ,snliq , & !inout - sh2o ,sice ,stc ,dzsnso ,zsnso , & !inout - fsh , & !inout - qsnbot ,snoflow,ponding1 ,ponding2) !out + subroutine snowwater_glacier (nsnow ,nsoil ,imelt ,dt ,sfctmp , & !in + snowhin ,qsnow ,qsnfro ,qsnsub ,qrain , & !in + ficeold ,zsoil , & !in + isnow ,snowh ,sneqv ,snice ,snliq , & !inout + sh2o ,sice ,stc ,dzsnso ,zsnso , & !inout + fsh , & !inout + qsnbot ,snoflow ,ponding1 ,ponding2) !out ! ---------------------------------------------------------------------- implicit none ! ---------------------------------------------------------------------- @@ -2288,8 +2451,8 @@ subroutine snowwater_glacier (nsnow ,nsoil ,imelt ,dt ,sfctmp , & !in real (kind=kind_phys), intent(in) :: sfctmp !< surface air temperature [k] real (kind=kind_phys), intent(in) :: snowhin!< snow depth increasing rate (m/s) real (kind=kind_phys), intent(in) :: qsnow !< snow at ground srf (mm/s) [+] - real (kind=kind_phys), intent(inout) :: qsnfro !< snow surface frost rate[mm/s] - real (kind=kind_phys), intent(inout) :: qsnsub !< snow surface sublimation rate[mm/s] + real (kind=kind_phys), intent(inout) :: qsnfro !< snow surface frost rate[mm/s] + real (kind=kind_phys), intent(inout) :: qsnsub !< snow surface sublimation rate[mm/s] real (kind=kind_phys), intent(in) :: qrain !< snow surface rain rate[mm/s] real (kind=kind_phys), dimension(-nsnow+1:0) , intent(in) :: ficeold!< ice fraction at last timestep real (kind=kind_phys), dimension( 1:nsoil), intent(in) :: zsoil !< layer-bottom depth from soil surf (m) @@ -2331,13 +2494,13 @@ subroutine snowwater_glacier (nsnow ,nsoil ,imelt ,dt ,sfctmp , & !in snliq ,imelt ,ficeold, & !in isnow ,dzsnso ) !inout - call combine_glacier (nsnow ,nsoil , & !in - isnow ,sh2o ,stc ,snice ,snliq , & !inout - dzsnso ,sice ,snowh ,sneqv , & !inout - ponding1 ,ponding2) !out + call combine_glacier (nsnow ,nsoil , & !in + isnow ,sh2o ,stc ,snice ,snliq , & !inout + dzsnso ,sice ,snowh ,sneqv , & !inout + ponding1 ,ponding2) !out - call divide_glacier (nsnow ,nsoil , & !in - isnow ,stc ,snice ,snliq ,dzsnso ) !inout + call divide_glacier (nsnow ,nsoil , & !in + isnow ,stc ,snice ,snliq ,dzsnso ) !inout end if !set empty snow layers to zero @@ -2350,12 +2513,12 @@ 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 + 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 @@ -2371,8 +2534,10 @@ subroutine snowwater_glacier (nsnow ,nsoil ,imelt ,dt ,sfctmp , & !in if(isnow /= 0) then sneqv = 0. + snowh = 0. do iz = isnow+1,0 sneqv = sneqv + snice(iz) + snliq(iz) + snowh = snowh + dzsnso(iz) enddo end if @@ -2565,10 +2730,10 @@ subroutine compact_glacier (nsnow ,nsoil ,dt ,stc ,snice , & !in end subroutine compact_glacier ! ================================================================================================== !>\ingroup NoahMP_LSM - subroutine combine_glacier (nsnow ,nsoil , & !in - isnow ,sh2o ,stc ,snice ,snliq , & !inout - dzsnso ,sice ,snowh ,sneqv , & !inout - ponding1 ,ponding2) !inout + subroutine combine_glacier (nsnow ,nsoil , & !in + isnow ,sh2o ,stc ,snice ,snliq , & !inout + dzsnso ,sice ,snowh ,sneqv , & !inout + ponding1 ,ponding2) !inout ! ---------------------------------------------------------------------- implicit none ! ---------------------------------------------------------------------- @@ -2916,12 +3081,12 @@ subroutine divide_glacier (nsnow ,nsoil , & !in end subroutine divide_glacier ! ================================================================================================== !>\ingroup NoahMP_LSM - subroutine 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 + subroutine 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 ! ---------------------------------------------------------------------- !> renew the mass of ice lens (snice) and liquid (snliq) of the !! surface snow layer resulting from sublimation (frost) / evaporation (dew) @@ -3080,9 +3245,9 @@ end subroutine snowh2o_glacier subroutine error_glacier (iloc ,jloc ,swdown ,fsa ,fsr ,fira , & fsh ,fgev ,ssoil ,sag ,prcp ,edir , & #ifdef CCPP - runsrf ,runsub ,sneqv ,dt ,beg_wb, errmsg, errflg ) + runsrf ,runsub ,sneqv ,dt ,beg_wb, errmsg , errflg ) #else - runsrf ,runsub ,sneqv ,dt ,beg_wb ) + runsrf ,runsub ,sneqv ,dt ,beg_wb ) #endif ! -------------------------------------------------------------------------------------------------- !> check surface energy balance and water balance @@ -3163,7 +3328,7 @@ end subroutine error_glacier ! ================================================================================================== !>\ingroup NoahMP_LSM - subroutine noahmp_options_glacier(iopt_alb ,iopt_snf ,iopt_tbot, iopt_stc, iopt_gla ) + subroutine noahmp_options_glacier(iopt_alb ,iopt_snf ,iopt_tbot, iopt_stc, iopt_gla, iopt_sfc) implicit none @@ -3173,6 +3338,7 @@ subroutine noahmp_options_glacier(iopt_alb ,iopt_snf ,iopt_tbot, iopt_stc, iop integer, intent(in) :: iopt_stc !< snow/soil temperature time scheme (only layer 1) !! 1 -> semi-implicit; 2 -> full implicit (original noah) integer, intent(in) :: iopt_gla !< glacier option (1->phase change; 2->simple) + integer, intent(in) :: iopt_sfc !< sfc scheme option ! ------------------------------------------------------------------------------------------------- @@ -3181,6 +3347,7 @@ subroutine noahmp_options_glacier(iopt_alb ,iopt_snf ,iopt_tbot, iopt_stc, iop opt_tbot = iopt_tbot opt_stc = iopt_stc opt_gla = iopt_gla + opt_sfc = iopt_sfc end subroutine noahmp_options_glacier diff --git a/physics/module_sf_noahmplsm.f90 b/physics/module_sf_noahmplsm.f90 index 00895d59f..81dd1dceb 100644 --- a/physics/module_sf_noahmplsm.f90 +++ b/physics/module_sf_noahmplsm.f90 @@ -8,6 +8,7 @@ module module_sf_noahmplsm use module_wrf_utl #endif use machine , only : kind_phys +use sfc_diff, only : stability implicit none @@ -377,8 +378,8 @@ subroutine noahmp_sflx (parameters, & dt , dx , dz8w , nsoil , zsoil , nsnow , & ! in : model configuration shdfac , shdmax , vegtyp , ice , ist , croptype, & ! in : vegetation/soil characteristics smceq , & ! in : vegetation/soil characteristics - sfctmp , sfcprs , psfc , uu , vv , q2 , & ! in : forcing - qc , soldn , lwdn , & ! in : forcing + sfctmp , sfcprs , psfc , uu , vv , q2, garea1 , & ! in : forcing + qc , soldn , lwdn,thsfc_loc, prslkix,prsik1x,prslk1x,& ! in : forcing prcpconv, prcpnonc, prcpshcv, prcpsnow, prcpgrpl, prcphail, & ! in : forcing tbot , co2air , o2air , foln , ficeold , zlvl , & ! in : forcing albold , sneqvo , & ! in/out : @@ -389,15 +390,15 @@ subroutine noahmp_sflx (parameters, & stmass , wood , stblcp , fastcp , lai , sai , & ! in/out : cm , ch , tauss , & ! in/out : grain , gdd , pgs , & ! in/out - smcwtd ,deeprech , rech , & ! in/out : - z0wrf , & + smcwtd ,deeprech , rech , ustarx , & ! in/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 : runsrf , runsub , apar , psn , sav , sag , & ! out : fsno , nee , gpp , npp , fveg , albedo , & ! out : qsnbot , ponding , ponding1, ponding2, rssun , rssha , & ! out : - albd , albi , albsnd , albsni , & ! 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 : @@ -435,6 +436,13 @@ subroutine noahmp_sflx (parameters, & real (kind=kind_phys) , intent(in) :: soldn !< downward shortwave radiation (w/m2) real (kind=kind_phys) , intent(in) :: lwdn !< downward longwave radiation (w/m2) real (kind=kind_phys) , intent(in) :: sfcprs !< pressure (pa) + + logical , intent(in) :: thsfc_loc + real (kind=kind_phys) , intent(in) :: prslkix ! in exner function + real (kind=kind_phys) , intent(in) :: prsik1x ! in exner function + real (kind=kind_phys) , intent(in) :: prslk1x ! in exner function + real (kind=kind_phys) , intent(in) :: garea1 ! in exner function + real (kind=kind_phys) , intent(inout) :: zlvl !< reference height (m) real (kind=kind_phys) , intent(in) :: cosz !< cosine solar zenith angle [0-1] real (kind=kind_phys) , intent(in) :: tbot !< bottom condition for soil temp. [k] @@ -473,6 +481,7 @@ subroutine noahmp_sflx (parameters, & real (kind=kind_phys) , intent(inout) :: cm !< momentum drag coefficient real (kind=kind_phys) , intent(inout) :: ch !< sensible heat exchange coefficient real (kind=kind_phys) , intent(inout) :: tauss !< non-dimensional snow age + real (kind=kind_phys) , intent(inout) :: ustarx !< friction velocity ! prognostic variables integer , intent(inout) :: isnow !< actual no. of snow layers [-] @@ -498,6 +507,7 @@ subroutine noahmp_sflx (parameters, & ! output real (kind=kind_phys) , intent(out) :: z0wrf !< combined z0 sent to coupled model + real (kind=kind_phys) , intent(out) :: z0hwrf !< combined z0h sent to coupled model real (kind=kind_phys) , intent(out) :: fsa !< total absorbed solar radiation (w/m2) real (kind=kind_phys) , intent(out) :: fsr !< total reflected solar radiation (w/m2) real (kind=kind_phys) , intent(out) :: fira !< total net lw rad (w/m2) [+ to atm] @@ -507,7 +517,7 @@ subroutine noahmp_sflx (parameters, & real (kind=kind_phys) , intent(out) :: fctr !< transpiration heat (w/m2) [+ to atm] real (kind=kind_phys) , intent(out) :: ssoil !< ground heat flux (w/m2) [+ to soil] real (kind=kind_phys) , intent(out) :: trad !< surface radiative temperature (k) - real (kind=kind_phys) :: ts !< surface temperature (k) + real (kind=kind_phys) , intent(out) :: ts !< surface combined aero temperature (k) real (kind=kind_phys) , intent(out) :: ecan !< evaporation of intercepted water (mm/s) real (kind=kind_phys) , intent(out) :: etran !< transpiration rate (mm/s) real (kind=kind_phys) , intent(out) :: edir !< soil surface evaporation rate (mm/s] @@ -761,15 +771,17 @@ subroutine noahmp_sflx (parameters, & elai ,esai ,fwet ,foln , & !in fveg ,pahv ,pahg ,pahb , & !in qsnow ,dzsnso ,lat ,canliq ,canice ,iloc, jloc , & !in - z0wrf , & + thsfc_loc, prslkix,prsik1x,prslk1x,garea1, & !in + z0wrf ,z0hwrf , & !out imelt ,snicev ,snliqv ,epore ,t2m ,fsno , & !out sav ,sag ,qmelt ,fsa ,fsr ,taux , & !out tauy ,fira ,fsh ,fcev ,fgev ,fctr , & !out trad ,psn ,apar ,ssoil ,btrani ,btran , & !out - ponding,ts ,latheav , latheag , frozen_canopy,frozen_ground, & !out + ponding,ts ,latheav , latheag , frozen_canopy,frozen_ground, & !out tv ,tg ,stc ,snowh ,eah ,tah , & !inout sneqvo ,sneqv ,sh2o ,smc ,snice ,snliq , & !inout albold ,cm ,ch ,dx ,dz8w ,q2 , & !inout + ustarx , & !inout #ifdef CCPP tauss ,laisun ,laisha ,rb , errmsg ,errflg , & !inout #else @@ -782,6 +794,8 @@ subroutine noahmp_sflx (parameters, & q1 ,q2v ,q2b ,q2e ,chv ,chb , & !out emissi ,pah , & shg,shc,shb,evg,evb,ghv,ghb,irg,irc,irb,tr,evc,chleaf,chuc,chv2,chb2 ) !out + + qsfc = q1 ! !jref:end #ifdef CCPP if (errflg /= 0) return @@ -1588,15 +1602,17 @@ subroutine energy (parameters,ice ,vegtyp ,ist ,nsnow ,nsoil , & !in elai ,esai ,fwet ,foln , & !in fveg ,pahv ,pahg ,pahb , & !in qsnow ,dzsnso ,lat ,canliq ,canice ,iloc , jloc, & !in - z0wrf , & + thsfc_loc, prslkix,prsik1x,prslk1x,garea1, & !in + z0wrf ,z0hwrf , & !out imelt ,snicev ,snliqv ,epore ,t2m ,fsno , & !out sav ,sag ,qmelt ,fsa ,fsr ,taux , & !out tauy ,fira ,fsh ,fcev ,fgev ,fctr , & !out trad ,psn ,apar ,ssoil ,btrani ,btran , & !out - ponding,ts ,latheav , latheag , frozen_canopy,frozen_ground, & !out + ponding,ts ,latheav , latheag , frozen_canopy,frozen_ground, & !out tv ,tg ,stc ,snowh ,eah ,tah , & !inout sneqvo ,sneqv ,sh2o ,smc ,snice ,snliq , & !inout albold ,cm ,ch ,dx ,dz8w ,q2 , & !inout + ustarx , & !inout #ifdef CCPP tauss ,laisun ,laisha ,rb ,errmsg ,errflg, & !inout #else @@ -1660,6 +1676,13 @@ subroutine energy (parameters,ice ,vegtyp ,ist ,nsnow ,nsoil , & !in real (kind=kind_phys) , intent(in) :: rhoair !density air (kg/m3) real (kind=kind_phys) , intent(in) :: eair !vapor pressure air (pa) real (kind=kind_phys) , intent(in) :: sfcprs !pressure (pa) + + logical , intent(in) :: thsfc_loc + real (kind=kind_phys) , intent(in) :: prslkix ! in exner function + real (kind=kind_phys) , intent(in) :: prsik1x ! in exner function + real (kind=kind_phys) , intent(in) :: prslk1x ! in exner function + real (kind=kind_phys) , intent(in) :: garea1 + real (kind=kind_phys) , intent(in) :: qair !specific humidity (kg/kg) real (kind=kind_phys) , intent(in) :: sfctmp !air temperature (k) real (kind=kind_phys) , intent(in) :: thair !potential temperature (k) @@ -1701,6 +1724,7 @@ subroutine energy (parameters,ice ,vegtyp ,ist ,nsnow ,nsoil , & !in ! outputs real (kind=kind_phys) , intent(out) :: z0wrf !combined z0 sent to coupled model + real (kind=kind_phys) , intent(out) :: z0hwrf !combined z0h sent to coupled model integer, dimension(-nsnow+1:nsoil), intent(out) :: imelt !phase change index [1-melt; 2-freeze] real (kind=kind_phys) , dimension(-nsnow+1: 0), intent(out) :: snicev !partial volume ice [m3/m3] real (kind=kind_phys) , dimension(-nsnow+1: 0), intent(out) :: snliqv !partial volume liq. water [m3/m3] @@ -1729,6 +1753,7 @@ subroutine energy (parameters,ice ,vegtyp ,ist ,nsnow ,nsoil , & !in ! real (kind=kind_phys) , intent(out) :: lathea !latent heat vap./sublimation (j/kg) real (kind=kind_phys) , intent(out) :: latheav !latent heat vap./sublimation (j/kg) real (kind=kind_phys) , intent(out) :: latheag !latent heat vap./sublimation (j/kg) + real (kind=kind_phys) , intent(out) :: ts !surface temperature (k) logical , intent(out) :: frozen_ground ! used to define latent heat pathway logical , intent(out) :: frozen_canopy ! used to define latent heat pathway @@ -1751,7 +1776,6 @@ subroutine energy (parameters,ice ,vegtyp ,ist ,nsnow ,nsoil , & !in !jref:end ! input & output - real (kind=kind_phys) , intent(inout) :: ts !surface temperature (k) real (kind=kind_phys) , intent(inout) :: tv !vegetation temperature (k) real (kind=kind_phys) , intent(inout) :: tg !ground temperature (k) real (kind=kind_phys) , dimension(-nsnow+1:nsoil), intent(inout) :: stc !snow/soil temperature [k] @@ -1769,6 +1793,7 @@ subroutine energy (parameters,ice ,vegtyp ,ist ,nsnow ,nsoil , & !in real (kind=kind_phys) , intent(inout) :: cm !momentum drag coefficient real (kind=kind_phys) , intent(inout) :: ch !sensible heat exchange coefficient real (kind=kind_phys) , intent(inout) :: q1 + real (kind=kind_phys) , intent(inout) :: ustarx !< friction velocity real (kind=kind_phys) , intent(inout) :: rb !leaf boundary layer resistance (s/m) real (kind=kind_phys) , intent(inout) :: laisun !sunlit leaf area index (m2/m2) real (kind=kind_phys) , intent(inout) :: laisha !shaded leaf area index (m2/m2) @@ -1861,6 +1886,24 @@ subroutine energy (parameters,ice ,vegtyp ,ist ,nsnow ,nsoil , & !in real (kind=kind_phys),intent(out) :: chv2 !sensible heat conductance, canopy air to zlvl air (m/s) real (kind=kind_phys),intent(out) :: chb2 !sensible heat conductance, canopy air to zlvl air (m/s) real (kind=kind_phys) :: noahmpres +! for new coupling + real (kind=kind_phys) :: csigmaf0 + real (kind=kind_phys) :: csigmaf1 + real (kind=kind_phys) :: csigmafveg + + real (kind=kind_phys) :: cdmnv + real (kind=kind_phys) :: ezpdv + real (kind=kind_phys) :: cdmng + real (kind=kind_phys) :: ezpdg + + real (kind=kind_phys) :: ezpd + real (kind=kind_phys) :: cdmn + real (kind=kind_phys) :: gsigma + + real (kind=kind_phys) :: kbsigmafveg + real (kind=kind_phys) :: aone + real (kind=kind_phys) :: coeffa + real (kind=kind_phys) :: coeffb !jref:end @@ -1891,6 +1934,29 @@ subroutine energy (parameters,ice ,vegtyp ,ist ,nsnow ,nsoil , & !in chv2 = 0. rb = 0. +! + cdmnv = 0. + ezpdv = 0. + + cdmng = 0. + ezpdg = 0. + + cdmn = 0. + ezpd = 0. + + gsigma = 0. + + z0hwrf = 0. + csigmaf1 = 0. + csigmaf0 = 0. + csigmafveg= 0. + kbsigmafveg = 0. + aone = 0. + coeffa = 0. + coeffb = 0. + +! + ! wind speed at reference height: ur >= 1 ur = max( sqrt(uu**2.+vv**2.), 1. ) @@ -2091,7 +2157,8 @@ subroutine energy (parameters,ice ,vegtyp ,ist ,nsnow ,nsoil , & !in rsurf ,latheav ,latheag ,parsun ,parsha ,igs , & !in foln ,co2air ,o2air ,btran ,sfcprs , & !in rhsur ,iloc ,jloc ,q2 ,pahv ,pahg , & !in - eah ,tah ,tv ,tgv ,cmv , & !inout + thsfc_loc, prslkix,prsik1x,prslk1x, garea1, & !in + eah ,tah ,tv ,tgv ,cmv, ustarx , & !inout #ifdef CCPP chv ,dx ,dz8w ,errmsg ,errflg , & !inout #else @@ -2099,10 +2166,15 @@ subroutine energy (parameters,ice ,vegtyp ,ist ,nsnow ,nsoil , & !in #endif tauxv ,tauyv ,irg ,irc ,shg , & !out shc ,evg ,evc ,tr ,ghv , & !out - t2mv ,psnsun ,psnsha , & !out + t2mv ,psnsun ,psnsha ,csigmaf1, & !out !jref:start qc ,qsfc ,psfc , & !in q2v ,chv2, chleaf, chuc) !inout + + cdmnv = 0.4*0.4/log((zlvl-zpd)/z0m)**2 + aone = 2.6*(10.0*parameters%hvt/(zlvl-zpd))**0.355 + ezpdv = zpd*fveg !for the grid + !jref:end #ifdef CCPP if (errflg /= 0) return @@ -2115,19 +2187,34 @@ subroutine energy (parameters,ice ,vegtyp ,ist ,nsnow ,nsoil , & !in call bare_flux (parameters,nsnow ,nsoil ,isnow ,dt ,sag , & !in lwdn ,ur ,uu ,vv ,sfctmp , & !in thair ,qair ,eair ,rhoair ,snowh , & !in - dzsnso ,zlvl ,zpdg ,z0mg ,fsno, & !in + dzsnso ,zlvl ,zpdg ,z0mg ,fsno, & !in emg ,stc ,df ,rsurf ,latheag , & !in gammag ,rhsur ,iloc ,jloc ,q2 ,pahb , & !in + thsfc_loc, prslkix,prsik1x,prslk1x,fveg,garea1, & !in #ifdef CCPP - tgb ,cmb ,chb ,errmsg ,errflg , & !inout + tgb ,cmb ,chb, ustarx,errmsg ,errflg , & !inout #else - tgb ,cmb ,chb , & !inout + tgb ,cmb ,chb, ustarx, & !inout #endif - tauxb ,tauyb ,irb ,shb ,evb , & !out + tauxb ,tauyb ,irb ,shb ,evb,csigmaf0,& !out ghb ,t2mb ,dx ,dz8w ,vegtyp , & !out !jref:start qc ,qsfc ,psfc , & !in sfcprs ,q2b, chb2) !in + + cdmng = 0.4*0.4/log((zlvl-zpdg)/z0mg)**2 + ezpdg = zpdg +! +! vegetation is optional; use the larger one +! + if (ezpdv .ge. ezpdg ) then + ezpd = ezpdv + elseif (ezpdv .gt. 0.0 .and. ezpdv .lt. ezpdg) then + ezpd = (1.0 -fveg)*ezpdg + else + ezpd = ezpdg + endif + !jref:end #ifdef CCPP if (errflg /= 0) return @@ -2148,12 +2235,31 @@ subroutine energy (parameters,ice ,vegtyp ,ist ,nsnow ,nsoil , & !in pah = fveg * pahg + (1.0 - fveg) * pahb + pahv tg = fveg * tgv + (1.0 - fveg) * tgb t2m = fveg * t2mv + (1.0 - fveg) * t2mb - ts = fveg * tv + (1.0 - fveg) * tgb + ts = fveg * tah + (1.0 - fveg) * tgb cm = fveg * cmv + (1.0 - fveg) * cmb ! better way to average? ch = fveg * chv + (1.0 - fveg) * chb q1 = fveg * (eah*0.622/(sfcprs - 0.378*eah)) + (1.0 - fveg)*qsfc q2e = fveg * q2v + (1.0 - fveg) * q2b - z0wrf = z0m + + coeffa = (csigmaf0 - csigmaf1)/(1.0 - exp(-1.0*aone)) + coeffb = csigmaf0 - coeffa + csigmafveg = coeffa * exp(-1.0*aone*fveg) + coeffb + + gsigma = fveg**0.5 + fveg*(1.0-fveg)*1.0 + +! +! 0.5 ~ 1.0 for the 0.5 place; 0 ~ 1.0 for the 1.0 place, adjustable empirical +! canopy roughness geometry parameter; currently fveg = 0.78 has the largest +! momentum flux; can test the fveg-based average by setting 0.5 to 1.0 and 1.0 +! to 0.0 ! see Blumel; JAM,1998 +! + + cdmn = gsigma*cdmnv + (1.0-gsigma)*cdmng + z0wrf = (zlvl - ezpd)*exp(-0.4/sqrt(cdmn)) + + kbsigmafveg = csigmafveg/log((zlvl-ezpd)/z0wrf) - log((zlvl-ezpd)/z0wrf) + z0hwrf = z0wrf/exp(kbsigmafveg) + else taux = tauxb tauy = tauyb @@ -2176,6 +2282,9 @@ subroutine energy (parameters,ice ,vegtyp ,ist ,nsnow ,nsoil , & !in tgv = tgb chv = chb z0wrf = z0mg + + z0hwrf =z0wrf/exp( csigmaf0/log((zlvl-ezpd)/z0wrf) - log((zlvl-ezpd)/z0wrf) ) + end if fire = lwdn + fira @@ -3484,13 +3593,14 @@ subroutine vege_flux(parameters,nsnow ,nsoil ,isnow ,vegtyp ,veg , & uu ,vv ,sfctmp ,thair ,qair , & !in eair ,rhoair ,snowh ,vai ,gammav ,gammag, & !in fwet ,laisun ,laisha ,cwp ,dzsnso , & !in - zlvl ,zpd ,z0m ,fveg , & !in + zlvl ,zpd ,z0m ,fveg, & !in z0mg ,emv ,emg ,canliq ,fsno, & !in canice ,stc ,df ,rssun ,rssha , & !in rsurf ,latheav ,latheag ,parsun ,parsha ,igs , & !in foln ,co2air ,o2air ,btran ,sfcprs , & !in rhsur ,iloc ,jloc ,q2 ,pahv ,pahg , & !in - eah ,tah ,tv ,tg ,cm , & !inout + thsfc_loc, prslkix,prsik1x,prslk1x, garea1, & !in + eah ,tah ,tv ,tg ,cm,ustarx,& !inout #ifdef CCPP ch ,dx ,dz8w ,errmsg ,errflg , & !inout #else @@ -3498,7 +3608,7 @@ subroutine vege_flux(parameters,nsnow ,nsoil ,isnow ,vegtyp ,veg , & #endif tauxv ,tauyv ,irg ,irc ,shg , & !out shc ,evg ,evc ,tr ,gh , & !out - t2mv ,psnsun ,psnsha , & !out + t2mv ,psnsun ,psnsha ,csigmaf1, & !out qc ,qsfc ,psfc , & !in q2v ,cah2 ,chleaf ,chuc ) !inout @@ -3536,6 +3646,12 @@ subroutine vege_flux(parameters,nsnow ,nsoil ,isnow ,vegtyp ,veg , & real (kind=kind_phys), intent(in) :: dt !time step (s) real (kind=kind_phys), intent(in) :: fsno !snow fraction + logical , intent(in) :: thsfc_loc + real (kind=kind_phys) , intent(in) :: prslkix ! in exner function + real (kind=kind_phys) , intent(in) :: prsik1x ! in exner function + real (kind=kind_phys) , intent(in) :: prslk1x ! in exner function + real (kind=kind_phys) , intent(in) :: garea1 ! + real (kind=kind_phys), intent(in) :: snowh !actual snow depth [m] real (kind=kind_phys), intent(in) :: fwet !wetted fraction of canopy real (kind=kind_phys), intent(in) :: cwp !canopy wind parameter @@ -3588,6 +3704,7 @@ subroutine vege_flux(parameters,nsnow ,nsoil ,isnow ,vegtyp ,veg , & real (kind=kind_phys), intent(inout) :: tg !ground temperature (k) real (kind=kind_phys), intent(inout) :: cm !momentum drag coefficient real (kind=kind_phys), intent(inout) :: ch !sensible heat exchange coefficient + real (kind=kind_phys), intent(inout) :: ustarx !< friction velocity #ifdef CCPP character(len=*), intent(inout) :: errmsg @@ -3609,6 +3726,7 @@ subroutine vege_flux(parameters,nsnow ,nsoil ,isnow ,vegtyp ,veg , & real (kind=kind_phys), intent(out) :: t2mv !2 m height air temperature (k) real (kind=kind_phys), intent(out) :: psnsun !sunlit leaf photosynthesis (umolco2/m2/s) real (kind=kind_phys), intent(out) :: psnsha !shaded leaf photosynthesis (umolco2/m2/s) + real (kind=kind_phys), intent(out) :: csigmaf1 real (kind=kind_phys), intent(out) :: chleaf !leaf exchange coefficient real (kind=kind_phys), intent(out) :: chuc !under canopy exchange coefficient @@ -3681,6 +3799,22 @@ subroutine vege_flux(parameters,nsnow ,nsoil ,isnow ,vegtyp ,veg , & real (kind=kind_phys) :: ch2 !surface exchange at 2m real (kind=kind_phys) :: thstar !surface exchange at 2m + real (kind=kind_phys) :: dlf ! leaf dimension + real(kind=kind_phys) :: sigmaa ! momentum partition parameter + real(kind=kind_phys) :: kbsigmaf1 ! kb^-1 for fully convered by vegetation + real(kind=kind_phys) :: kbsigmafc ! kb^-1 under canopy ground + + real (kind=kind_phys) :: fm10 !monin-obukhov momentum adjustment at 10m + real (kind=kind_phys) :: rb1v !Bulk Richardson # over vegetation + real (kind=kind_phys) :: stress1v !Stress over vegetation + real (kind=kind_phys) :: snwd + real (kind=kind_phys) :: virtfacv + real (kind=kind_phys) :: thv1v + real (kind=kind_phys) :: tvsv + real (kind=kind_phys) :: tv1v + real (kind=kind_phys) :: zlvlv + + real (kind=kind_phys) :: thvair real (kind=kind_phys) :: thah real (kind=kind_phys) :: rahc2 !aerodynamic resistance for sensible heat (s/m) @@ -3697,6 +3831,9 @@ subroutine vege_flux(parameters,nsnow ,nsoil ,isnow ,vegtyp ,veg , & real (kind=kind_phys) :: laisune !sunlit leaf area index, one-sided (m2/m2),effective real (kind=kind_phys) :: laishae !shaded leaf area index, one-sided (m2/m2),effective + real(kind=kind_phys) :: tem1,tem2,zvfun1,gdx + real(kind=kind_phys), parameter :: z0lo=0.1, z0up=1.0 + integer :: k !index integer :: iter !iteration index @@ -3709,6 +3846,8 @@ subroutine vege_flux(parameters,nsnow ,nsoil ,isnow ,vegtyp ,veg , & integer :: liter !last iteration + integer :: niter !for sfcdiff3 + real (kind=kind_phys) :: t, tdc !kelvin to degree celsius with limit -50 to +50 @@ -3719,7 +3858,11 @@ subroutine vege_flux(parameters,nsnow ,nsoil ,isnow ,vegtyp ,veg , & mpe = 1e-6 liter = 0 - fv = 0.1 + + fv = ustarx + + niter = 1 + if (ur < 2.0) niter = 2 ! --------------------------------------------------------------------------------------------- ! initialization variables that do not depend on stability iteration @@ -3734,12 +3877,30 @@ subroutine vege_flux(parameters,nsnow ,nsoil ,isnow ,vegtyp ,veg , & h = 0. qfx = 0. + csigmaf1 = 0. + ! limit lai vaie = min(6.,vai ) laisune = min(6.,laisun) laishae = min(6.,laisha) +! for sfcdiff3 + + snwd = snowh*1000.0 + zlvlv = zlvl - zpd + + virtfacv = 1.0 + 0.61 * max(qair, 1.e-8) + tv1v = sfctmp * virtfacv + + if(thsfc_loc) then ! Use local potential temperature + thv1v = sfctmp * prslkix * virtfacv + else ! Use potential temperature reference to 1000 hPa + thv1v = sfctmp / prslk1x * virtfacv + endif +! + + ! saturation vapor pressure at ground temperature t = tdc(tg) @@ -3754,6 +3915,8 @@ subroutine vege_flux(parameters,nsnow ,nsoil ,isnow ,vegtyp ,veg , & qsfc = 0.622*eair/(psfc-0.378*eair) + dlf = parameters%dleaf !leaf dimension + ! canopy height hcan = parameters%hvt @@ -3801,13 +3964,27 @@ subroutine vege_flux(parameters,nsnow ,nsoil ,isnow ,vegtyp ,veg , & air = -emv*(1.+(1.-emv)*(1.-emg))*lwdn - emv*emg*sb*tg**4 cir = (2.-emv*(1.-emg))*emv*sb ! --------------------------------------------------------------------------------------------- + + sigmaa = 1.0 - (0.5/(0.5+vaie))*exp(-vaie**2/8.0) + kbsigmaf1 = 16.4*(sigmaa*vaie**3)**(-0.25)*sqrt(dlf*ur/log((zlvl-zpd)/z0m)) + z0h = z0m/exp(kbsigmaf1) + csigmaf1 = log((zlvl-zpd)/z0m)*(log((zlvl-zpd)/z0m)+kbsigmaf1) ! for output for interpolation + +! -- + tem1 = (z0m - z0lo) / (z0up - z0lo) + tem1 = min(max(tem1, 0.0_kind_phys), 1.0_kind_phys) + tem2 = max(fveg, 0.1_kind_phys) + zvfun1= sqrt(tem1 * tem2) + gdx=sqrt(garea1) + if(opt_sfc == 1 .or. opt_sfc == 2) then + loop1: do iter = 1, niterc ! begin stability iteration +! use newly derived z0m/z0h + if(iter == 1) then - z0h = z0m z0hg = z0mg else - z0h = z0m !* exp(-czil*0.4*258.2*sqrt(fv*z0m)) z0hg = z0mg !* exp(-czil*0.4*258.2*sqrt(fv*z0mg)) end if @@ -3954,6 +4131,135 @@ subroutine vege_flux(parameters,nsnow ,nsoil ,isnow ,vegtyp ,veg , & end do loop1 ! end stability iteration + endif !opt_sfc 1 or 2 +! +! sfcdiff3 +! + if (opt_sfc == 3) then + + z0hg = z0mg + + do iter = 1, niter !1 or 2; depending on ur + + if(thsfc_loc) then ! Use local potential temperature + tvsv = tah * virtfacv + else ! Use potential temperature referenced to 1000 hPa + tvsv = tah/prsik1x * virtfacv + endif + + call stability & + (zlvlv, zvfun1, gdx,tv1v,thv1v, ur, z0m, z0h, tvsv, grav,thsfc_loc, & + rb1v, fm,fh,fm10,fh2,cm,ch,stress1v,fv) + + ramc = max(1.,1./(cm*ur)) + rahc = max(1.,1./(ch*ur)) + rawc = rahc + +! aerodyn resistance between heights z0g and d+z0v, rag, and leaf +! boundary layer resistance, rb + + call ragrb(parameters,iter ,vaie ,rhoair ,hg ,tah , & !in + zpd ,z0mg ,z0hg ,hcan ,uc , & !in + z0h ,fv ,cwp ,vegtyp ,mpe , & !in + tv ,mozg ,fhg ,iloc ,jloc , & !inout + ramg ,rahg ,rawg ,rb ) !out + +! es and d(es)/dt evaluated at tv + + t = tdc(tv) + call esat(t, esatw, esati, dsatw, dsati) + if (t .gt. 0.) then + estv = esatw + destv = dsatw + else + estv = esati + destv = dsati + end if + +! stomatal resistance + + if(iter == 1) then + if (opt_crs == 1) then ! ball-berry + call stomata (parameters,vegtyp,mpe ,parsun ,foln ,iloc , jloc , & !in + tv ,estv ,eah ,sfctmp,sfcprs, & !in + o2air ,co2air,igs ,btran ,rb , & !in + rssun ,psnsun) !out + + call stomata (parameters,vegtyp,mpe ,parsha ,foln ,iloc , jloc , & !in + tv ,estv ,eah ,sfctmp,sfcprs, & !in + o2air ,co2air,igs ,btran ,rb , & !in + rssha ,psnsha) !out + end if + + if (opt_crs == 2) then ! jarvis + call canres (parameters,parsun,tv ,btran ,eah ,sfcprs, & !in + rssun ,psnsun,iloc ,jloc ) !out + + call canres (parameters,parsha,tv ,btran ,eah ,sfcprs, & !in + rssha ,psnsha,iloc ,jloc ) !out + end if + end if + +! prepare for sensible heat flux above veg. + + cah = 1./rahc + cvh = 2.*vaie/rb + cgh = 1./rahg + cond = cah + cvh + cgh + ata = (sfctmp*cah + tg*cgh) / cond + bta = cvh/cond + csh = (1.-bta)*rhoair*cpair*cvh + +! prepare for latent heat flux above veg. + + caw = 1./rawc + cew = fwet*vaie/rb + ctw = (1.-fwet)*(laisune/(rb+rssun) + laishae/(rb+rssha)) + cgw = 1./(rawg+rsurf) + cond = caw + cew + ctw + cgw + aea = (eair*caw + estg*cgw) / cond + bea = (cew+ctw)/cond + cev = (1.-bea)*cew*rhoair*cpair/gammav ! barlage: change to vegetation v3.6 + ctr = (1.-bea)*ctw*rhoair*cpair/gammav + +! evaluate surface fluxes with current temperature and solve for dts + + tah = ata + bta*tv ! canopy air t. + eah = aea + bea*estv ! canopy air e + + irc = fveg*(air + cir*tv**4) + 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 + evc = min(canliq*latheav/dt,evc) ! barlage: add if block for canice in v3.6 + else + evc = min(canice*latheav/dt,evc) + end if + + b = sav-irc-shc-evc-tr+pahv !additional w/m2 + a = fveg*(4.*cir*tv**3 + csh + (cev+ctr)*destv) !volumetric heat capacity + dtv = b/a + + irc = irc + fveg*4.*cir*tv**3*dtv + shc = shc + fveg*csh*dtv + evc = evc + fveg*cev*destv*dtv + tr = tr + fveg*ctr*destv*dtv + +! update vegetation surface temperature + tv = tv + dtv +! 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 + hg = rhoair*cpair*(tg - tah) /rahg + +! consistent specific humidity from canopy air vapor pressure + qsfc = (0.622*eah)/(sfcprs-0.378*eah) + + enddo ! iteration + endif ! sfcdiff3 + ! under-canopy fluxes and tg air = - emg*(1.-emv)*lwdn - emg*emv*sb*tv**4 @@ -4019,7 +4325,7 @@ subroutine vege_flux(parameters,nsnow ,nsoil ,isnow ,vegtyp ,veg , & ! qfx = (qsfc-qair)*rhoair*caw !*cpair/gammag ! 2m temperature over vegetation ( corrected for low cq2v values ) - if (opt_sfc == 1 .or. opt_sfc == 2) then + if (opt_sfc == 1 .or. opt_sfc == 2 .or. opt_sfc ==3 ) then ! cah2 = fv*1./vkc*log((2.+z0h)/z0h) cah2 = fv*vkc/log((2.+z0h)/z0h) cah2 = fv*vkc/(log((2.+z0h)/z0h)-fh2) @@ -4053,12 +4359,13 @@ subroutine bare_flux (parameters,nsnow ,nsoil ,isnow ,dt ,sag , & dzsnso ,zlvl ,zpd ,z0m ,fsno , & !in emg ,stc ,df ,rsurf ,lathea , & !in gamma ,rhsur ,iloc ,jloc ,q2 ,pahb , & !in + thsfc_loc, prslkix,prsik1x,prslk1x,fveg,garea1, & !in #ifdef CCPP - tgb ,cm ,ch ,errmsg ,errflg , & !inout + tgb ,cm ,ch,ustarx,errmsg ,errflg , & !inout #else - tgb ,cm ,ch , & !inout + tgb ,cm ,ch,ustarx, & !inout #endif - tauxb ,tauyb ,irb ,shb ,evb , & !out + tauxb ,tauyb ,irb ,shb ,evb,csigmaf0,& !out ghb ,t2mb ,dx ,dz8w ,ivgtyp , & !out qc ,qsfc ,psfc , & !in sfcprs ,q2b ,ehb2 ) !in @@ -4104,6 +4411,13 @@ subroutine bare_flux (parameters,nsnow ,nsoil ,isnow ,dt ,sag , & real (kind=kind_phys), intent(in) :: rhsur !raltive humidity in surface soil/snow air space (-) real (kind=kind_phys), intent(in) :: fsno !snow fraction + logical , intent(in) :: thsfc_loc + real (kind=kind_phys) , intent(in) :: prslkix ! in exner function + real (kind=kind_phys) , intent(in) :: prsik1x ! in exner function + real (kind=kind_phys) , intent(in) :: prslk1x ! in exner function + real (kind=kind_phys) , intent(in) :: fveg + real (kind=kind_phys) , intent(in) :: garea1 + !jref:start; in integer , intent(in) :: ivgtyp real (kind=kind_phys) , intent(in) :: qc !cloud water mixing ratio @@ -4120,6 +4434,7 @@ subroutine bare_flux (parameters,nsnow ,nsoil ,isnow ,dt ,sag , & real (kind=kind_phys), intent(inout) :: tgb !ground temperature (k) real (kind=kind_phys), intent(inout) :: cm !momentum drag coefficient real (kind=kind_phys), intent(inout) :: ch !sensible heat exchange coefficient + real (kind=kind_phys), intent(inout) :: ustarx !friction velocity #ifdef CCPP character(len=*), intent(inout) :: errmsg integer, intent(inout) :: errflg @@ -4135,6 +4450,7 @@ subroutine bare_flux (parameters,nsnow ,nsoil ,isnow ,dt ,sag , & real (kind=kind_phys), intent(out) :: evb !latent heat flux (w/m2) [+ to atm] real (kind=kind_phys), intent(out) :: ghb !ground heat flux (w/m2) [+ to soil] real (kind=kind_phys), intent(out) :: t2mb !2 m height air temperature (k) + real (kind=kind_phys), intent(out) :: csigmaf0 ! !jref:start real (kind=kind_phys), intent(out) :: q2b !bare ground heat conductance real (kind=kind_phys) :: ehb !bare ground heat conductance @@ -4145,6 +4461,17 @@ subroutine bare_flux (parameters,nsnow ,nsoil ,isnow ,dt ,sag , & ! local variables + real (kind=kind_phys) :: rb1b !Bulk Richardson # over bare soil + real (kind=kind_phys) :: stress1b !Stress over bare soil + real (kind=kind_phys) :: snwd + real (kind=kind_phys) :: virtfacb + real (kind=kind_phys) :: thv1b + real (kind=kind_phys) :: tvsb + real (kind=kind_phys) :: tv1b + real (kind=kind_phys) :: zlvlb + + real (kind=kind_phys) :: fm10 + real (kind=kind_phys) :: taux !wind stress: e-w (n/m2) real (kind=kind_phys) :: tauy !wind stress: n-s (n/m2) real (kind=kind_phys) :: fira !total net longwave rad (w/m2) [+ to atm] @@ -4171,6 +4498,9 @@ subroutine bare_flux (parameters,nsnow ,nsoil ,isnow ,dt ,sag , & real (kind=kind_phys) :: cev !coefficients for ev as function of esat[ts] real (kind=kind_phys) :: cgh !coefficients for st as function of ts + real(kind=kind_phys) :: kbsigmaf0 + real(kind=kind_phys) :: reynb + !jref:start real (kind=kind_phys) :: rahb2 !aerodynamic resistance for sensible heat 2m (s/m) real (kind=kind_phys) :: rawb2 !aerodynamic resistance for water vapor 2m (s/m) @@ -4205,8 +4535,13 @@ subroutine bare_flux (parameters,nsnow ,nsoil ,isnow ,dt ,sag , & real (kind=kind_phys) :: fh2 !monin-obukhov heat adjustment at 2m real (kind=kind_phys) :: ch2 !surface exchange at 2m + real(kind=kind_phys) :: tem1,tem2,zvfun1,gdx + real(kind=kind_phys), parameter :: z0lo=0.1, z0up=1.0 + integer :: iter !iteration index integer :: niterb !number of iterations for surface temperature + integer :: niter + real (kind=kind_phys) :: mpe !prevents overflow error if division by zero !jref:start ! data niterb /3/ @@ -4226,19 +4561,62 @@ subroutine bare_flux (parameters,nsnow ,nsoil ,isnow ,dt ,sag , & fh2 = 0. h = 0. qfx = 0. - fv = 0.1 + + csigmaf0 = 0. + kbsigmaf0 = 0. + + niter = 1 + if (ur < 2.0) niter = 2 + + fv = ustarx + +! fv = ur*vkc/log((zlvl-zpd)/z0m) + + reynb = fv*z0m/(1.5e-05) + + if (reynb .gt. 2.0) then + kbsigmaf0 = 2.46*reynb**0.25 - log(7.4) + else + kbsigmaf0 = - log(0.397) + endif + + csigmaf0 = log((zlvl-zpd)/z0m)*(log((zlvl-zpd)/z0m) + kbsigmaf0) + + z0h = max(z0m/exp(kbsigmaf0),1.0e-6) +! +! for sfcdiff3; maybe should move to inside the option +! + snwd = snowh*1000.0 + zlvlb = zlvl - zpd + + virtfacb = 1.0 + 0.61 * max(qair, 1.e-8) + tv1b = sfctmp * virtfacb + + if(thsfc_loc) then ! Use local potential temperature + thv1b = sfctmp * prslkix * virtfacb + else ! Use potential temperature reference to 1000 hPa + thv1b = sfctmp / prslk1x * virtfacb + endif cir = emg*sb cgh = 2.*df(isnow+1)/dzsnso(isnow+1) ! ----------------------------------------------------------------- + tem1 = (z0m - z0lo) / (z0up - z0lo) + tem1 = min(max(tem1, 0.0_kind_phys), 1.0_kind_phys) + tem2 = max(fveg, 0.1_kind_phys) + zvfun1= sqrt(tem1 * tem2) + gdx=sqrt(garea1) + + if (opt_sfc == 1 .or. opt_sfc == 2) then + loop3: do iter = 1, niterb ! begin stability iteration - if(iter == 1) then - z0h = z0m - else - z0h = z0m !* exp(-czil*0.4*258.2*sqrt(fv*z0m)) - end if +! if(iter == 1) then +! z0h = z0m +! else +! z0h = z0m !* exp(-czil*0.4*258.2*sqrt(fv*z0m)) +! end if if(opt_sfc == 1) then call sfcdif1(parameters,iter ,sfctmp ,rhoair ,h ,qair , & !in @@ -4328,8 +4706,83 @@ subroutine bare_flux (parameters,nsnow ,nsoil ,isnow ,dt ,sag , & qfx = (qsfc-qair)*cev*gamma/cpair end do loop3 ! end stability iteration + endif ! opt_sfc 1/2 ! ----------------------------------------------------------------- + if (opt_sfc == 3) then + + do iter = 1, niter !1 or 2; depending on ur + + if(thsfc_loc) then ! Use local potential temperature + tvsb = tgb * virtfacb + else ! Use potential temperature referenced to 1000 hPa + tvsb = tgb/prsik1x * virtfacb + endif + + call stability & + (zlvlb, zvfun1, gdx,tv1b,thv1b, ur, z0m, z0h, tvsb, grav,thsfc_loc, & + rb1b, fm,fh,fm10,fh2,cm,ch,stress1b,fv) + + + ramb = max(1.,1./(cm*ur)) + rahb = max(1.,1./(ch*ur)) + rawb = rahb + +!jref - variables for diagnostics + emb = 1./ramb + ehb = 1./rahb + +! es and d(es)/dt evaluated at tg + + t = tdc(tgb) + call esat(t, esatw, esati, dsatw, dsati) + if (t .gt. 0.) then + estg = esatw + destg = dsatw + else + estg = esati + destg = dsati + end if + + csh = rhoair*cpair/rahb + cev = rhoair*cpair/gamma/(rsurf+rawb) + +! surface fluxes and dtg + + irb = cir * tgb**4 - emg*lwdn + shb = csh * (tgb - sfctmp ) + evb = cev * (estg*rhsur - eair ) + ghb = cgh * (tgb - stc(isnow+1)) + + b = sag-irb-shb-evb-ghb+pahb + a = 4.*cir*tgb**3 + csh + cev*destg + cgh + dtg = b/a + + irb = irb + 4.*cir*tgb**3*dtg + shb = shb + csh*dtg + evb = evb + cev*destg*dtg + ghb = ghb + cgh*dtg + +! update ground surface temperature + tgb = tgb + dtg + +! for m-o length +! h = csh * (tgb - sfctmp) + + t = tdc(tgb) + call esat(t, esatw, esati, dsatw, dsati) + if (t .gt. 0.) then + estg = esatw + else + estg = esati + end if + qsfc = 0.622*(estg*rhsur)/(psfc-0.378*(estg*rhsur)) + + qfx = (qsfc-qair)*cev*gamma/cpair + + end do ! end stability iteration + endif ! sfcdiff3 + ! if snow on ground and tg > tfrz: reset tg = tfrz. reevaluate ground fluxes. if(opt_stc == 1 .or. opt_stc == 3) then @@ -4350,7 +4803,7 @@ subroutine bare_flux (parameters,nsnow ,nsoil ,isnow ,dt ,sag , & !jref:start; errors in original equation corrected. ! 2m air temperature - if(opt_sfc == 1 .or. opt_sfc ==2) then + if(opt_sfc == 1 .or. opt_sfc ==2 .or. opt_sfc == 3) then ehb2 = fv*vkc/log((2.+z0h)/z0h) ehb2 = fv*vkc/(log((2.+z0h)/z0h)-fh2) cq2b = ehb2 @@ -6403,8 +6856,10 @@ subroutine snowwater (parameters,nsnow ,nsoil ,imelt ,dt ,zsoil , & !in if(isnow < 0) then ! mb: only do for multi-layer sneqv = 0. + snowh = 0. do iz = isnow+1,0 sneqv = sneqv + snice(iz) + snliq(iz) + snowh = snowh + dzsnso(iz) enddo end if diff --git a/physics/module_sf_ruclsm.F90 b/physics/module_sf_ruclsm.F90 index b5238f366..a2b0f398a 100644 --- a/physics/module_sf_ruclsm.F90 +++ b/physics/module_sf_ruclsm.F90 @@ -6278,10 +6278,10 @@ SUBROUTINE SOILPROP( debug_print, & if((ws-a).lt.0.12)then diffu(K)=0. else - H=max(0.,(soilmoism(K)+qmin-a)/(max(1.e-8,(dqm-a)))) + H=max(0.,(soilmoism(K)+qmin-a)/(max(1.e-8,(ws-a)))) facd=1. if(a.ne.0.)facd=1.-a/max(1.e-8,soilmoism(K)) - ame=max(1.e-8,dqm-riw*soilicem(K)) + ame=max(1.e-8,ws-riw*soilicem(K)) !--- DIFFU is diffusional conductivity of soil water diffu(K)=-BCLH*KSAT*PSIS/ame* & (ws/ame)**3. & diff --git a/physics/moninedmf.meta b/physics/moninedmf.meta index f07e1916f..1bb6847eb 100644 --- a/physics/moninedmf.meta +++ b/physics/moninedmf.meta @@ -526,7 +526,7 @@ [dtend] standard_name = cumulative_change_of_state_variables long_name = diagnostic tendencies for state variables - units = various + units = mixed dimensions = (horizontal_loop_extent,vertical_layer_dimension,cumulative_change_of_state_variables_outer_index_max) type = real kind = kind_phys diff --git a/physics/moninshoc.meta b/physics/moninshoc.meta index 4acfe1001..ab4103891 100644 --- a/physics/moninshoc.meta +++ b/physics/moninshoc.meta @@ -452,7 +452,7 @@ [dtend] standard_name = cumulative_change_of_state_variables long_name = diagnostic tendencies for state variables - units = various + units = mixed dimensions = (horizontal_loop_extent,vertical_layer_dimension,cumulative_change_of_state_variables_outer_index_max) type = real kind = kind_phys diff --git a/physics/mp_fer_hires.meta b/physics/mp_fer_hires.meta index 6cf457063..08c6d939a 100644 --- a/physics/mp_fer_hires.meta +++ b/physics/mp_fer_hires.meta @@ -274,7 +274,7 @@ [rhgrd] standard_name = relative_humidity_threshold_for_condensation long_name = relative humidity threshold parameter for condensation for FA scheme - units = none + units = frac dimensions = () type = real kind = kind_phys diff --git a/physics/mp_thompson.F90 b/physics/mp_thompson.F90 index d5a1fcaad..e96f0e112 100644 --- a/physics/mp_thompson.F90 +++ b/physics/mp_thompson.F90 @@ -302,8 +302,7 @@ subroutine mp_thompson_run(ncol, nlev, con_g, con_rd, & is_aerosol_aware, nc, nwfa, nifa, & nwfa2d, nifa2d, & tgrs, prsl, phii, omega, & - sedi_semi, sedi_semi_update, & - sedi_semi_decfl, dtp, dt_inner, & + sedi_semi, decfl, dtp, dt_inner, & first_time_step, istep, nsteps, & prcp, rain, graupel, ice, snow, sr, & refl_10cm, reset_dBZ, do_radar_ref, & @@ -359,8 +358,7 @@ subroutine mp_thompson_run(ncol, nlev, con_g, con_rd, & real(kind_phys), intent(inout) :: refl_10cm(:,:) logical, intent(in ) :: do_radar_ref logical, intent(in) :: sedi_semi - logical, intent(in) :: sedi_semi_update - logical, intent(in) :: sedi_semi_decfl + integer, intent(in) :: decfl ! MPI and block information integer, intent(in) :: blkno integer, intent(in) :: mpicomm @@ -472,7 +470,7 @@ subroutine mp_thompson_run(ncol, nlev, con_g, con_rd, & dtstep = dtp end if if (first_time_step .and. istep==1 .and. mpirank==mpiroot .and. blkno==1) then - write(*,'(a,i0,a,a,f6.2,a)') 'Thompson MP is using ', nsteps, ' substep(s) per time step', & + write(*,'(a,i0,a,a,f8.2,a)') 'Thompson MP is using ', nsteps, ' substep(s) per time step', & ' with an effective time step of ', dtstep, ' seconds' end if @@ -618,8 +616,7 @@ subroutine mp_thompson_run(ncol, nlev, con_g, con_rd, & 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, & - sedi_semi=sedi_semi, sedi_semi_update=sedi_semi_update, & - sedi_semi_decfl=sedi_semi_decfl, & + sedi_semi=sedi_semi, decfl=decfl, & rainnc=rain_mp, rainncv=delta_rain_mp, & snownc=snow_mp, snowncv=delta_snow_mp, & icenc=ice_mp, icencv=delta_ice_mp, & @@ -658,8 +655,7 @@ subroutine mp_thompson_run(ncol, nlev, con_g, con_rd, & 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, & - sedi_semi=sedi_semi, sedi_semi_update=sedi_semi_update, & - sedi_semi_decfl=sedi_semi_decfl, & + sedi_semi=sedi_semi, decfl=decfl, & rainnc=rain_mp, rainncv=delta_rain_mp, & snownc=snow_mp, snowncv=delta_snow_mp, & icenc=ice_mp, icencv=delta_ice_mp, & diff --git a/physics/mp_thompson.meta b/physics/mp_thompson.meta index 25efcf953..248b76cc9 100644 --- a/physics/mp_thompson.meta +++ b/physics/mp_thompson.meta @@ -474,19 +474,12 @@ dimensions = () type = logical intent = in -[sedi_semi_update] - standard_name = flag_for_v_update_in_semi_Lagrangian_sedi - long_name = flag for v update in semi Lagrangian sedi of rain - units = flag +[decfl] + standard_name = deformed_CFL_factor + long_name = deformed CFL factor + units = count dimensions = () - type = logical - intent = in -[sedi_semi_decfl] - standard_name = flag_for_iteration_with_semi_Lagrangian_sedi - long_name = flag for interation with semi Lagrangian sedi of rain - units = flag - dimensions = () - type = logical + type = integer intent = in [dtp] standard_name = timestep_for_physics diff --git a/physics/ozne_def.meta b/physics/ozne_def.meta index 8776b9f80..3cad9c14d 100644 --- a/physics/ozne_def.meta +++ b/physics/ozne_def.meta @@ -21,8 +21,8 @@ type = integer [oz_pres] standard_name = natural_log_of_ozone_forcing_data_pressure_levels - long_name = natural log of ozone forcing data pressure levels - units = log(Pa) + long_name = natural log of ozone forcing data pressure levels in Pa + units = 1 dimensions = (vertical_dimension_of_ozone_forcing_data) type = real kind = kind_phys diff --git a/physics/ozphys.meta b/physics/ozphys.meta index aa50a2b81..5d6a9fff7 100644 --- a/physics/ozphys.meta +++ b/physics/ozphys.meta @@ -82,7 +82,7 @@ [po3] standard_name = natural_log_of_ozone_forcing_data_pressure_levels long_name = natural log of ozone forcing data pressure levels - units = log(Pa) + units = 1 dimensions = (vertical_dimension_of_ozone_forcing_data) type = real kind = kind_phys @@ -98,7 +98,7 @@ [prdout] standard_name = ozone_forcing long_name = ozone forcing coefficients - units = various + units = mixed dimensions = (horizontal_loop_extent,vertical_dimension_of_ozone_forcing_data,number_of_coefficients_in_ozone_forcing_data) type = real kind = kind_phys @@ -128,7 +128,7 @@ [dtend] standard_name = cumulative_change_of_state_variables long_name = diagnostic tendencies for state variables - units = various + units = mixed dimensions = (horizontal_loop_extent,vertical_layer_dimension,cumulative_change_of_state_variables_outer_index_max) type = real kind = kind_phys diff --git a/physics/ozphys_2015.meta b/physics/ozphys_2015.meta index b122fc4d9..070e57e54 100644 --- a/physics/ozphys_2015.meta +++ b/physics/ozphys_2015.meta @@ -82,7 +82,7 @@ [po3] standard_name = natural_log_of_ozone_forcing_data_pressure_levels long_name = natural log of ozone forcing data pressure levels - units = log(Pa) + units = 1 dimensions = (vertical_dimension_of_ozone_forcing_data) type = real kind = kind_phys @@ -98,7 +98,7 @@ [prdout] standard_name = ozone_forcing long_name = ozone forcing data - units = various + units = mixed dimensions = (horizontal_loop_extent,vertical_dimension_of_ozone_forcing_data,number_of_coefficients_in_ozone_forcing_data) type = real kind = kind_phys @@ -128,7 +128,7 @@ [dtend] standard_name = cumulative_change_of_state_variables long_name = diagnostic tendencies for state variables - units = various + units = mixed dimensions = (horizontal_loop_extent,vertical_layer_dimension,cumulative_change_of_state_variables_outer_index_max) type = real kind = kind_phys diff --git a/physics/phys_tend.meta b/physics/phys_tend.meta index 9660d5c90..ffb9c0b12 100644 --- a/physics/phys_tend.meta +++ b/physics/phys_tend.meta @@ -17,7 +17,7 @@ [dtend] standard_name = cumulative_change_of_state_variables long_name = diagnostic tendencies for state variables - units = various + units = mixed dimensions = (horizontal_loop_extent,vertical_layer_dimension,cumulative_change_of_state_variables_outer_index_max) type = real kind = kind_phys diff --git a/physics/radiation_clouds.f b/physics/radiation_clouds.f index dacf6e38e..f58ec8d11 100644 --- a/physics/radiation_clouds.f +++ b/physics/radiation_clouds.f @@ -59,7 +59,7 @@ ! ! ! 'progcld4o' --- inactive ! ! ! -! 'progcld5' --- thompson/wsm6 cloud microphysics ! +! 'progcld5' --- wsm6 cloud microphysics ! ! inputs: ! ! (plyr,plvl,tlyr,qlyr,qstl,rhly,clw, ! ! xlat,xlon,slmsk, dz, delp, ! @@ -258,8 +258,28 @@ module module_radiation_clouds integer :: llyr = 2 !< upper limit of boundary layer clouds + ! Default ice crystal sizes vs. temperature following Kristjansson and Mitchell + real (kind=kind_phys), dimension(95), parameter :: retab =(/ & + & 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/) + public progcld1, progcld2, progcld3, progcld4, progclduni, & - & cld_init, progcld5, progcld6, progcld4o, cal_cldfra3, & + & cld_init, progcld5, progcld4o, & + & progcld6, progcld_thompson, cal_cldfra3, & & find_cloudLayers, adjust_cloudIce, adjust_cloudH2O, & & adjust_cloudFinal, gethml @@ -934,7 +954,7 @@ subroutine progcld2 & ! ================= subprogram documentation block ================ ! ! ! ! subprogram: progcld2 computes cloud related quantities using ! -! Thompson/WSM6 cloud microphysics scheme. ! +! WSM6 cloud microphysics scheme. ! ! ! ! abstract: this program computes cloud fractions from cloud ! ! condensates, ! @@ -2644,8 +2664,8 @@ subroutine progcld5 & enddo !mz* if (uni_cld) then ! use unified sgs clouds generated outside -!mz* use unified sgs or thompson clouds generated outside - if (uni_cld .or. icloud == 3) then +!mz* use unified sgs clouds generated outside + if (uni_cld) then do k = 1, NLAY do i = 1, IX cldtot(i,k) = cldcov(i,k) @@ -2797,7 +2817,7 @@ subroutine progcld5 & clouds(i,k,3) = rew(i,k) clouds(i,k,4) = cip(i,k) clouds(i,k,5) = rei(i,k) - clouds(i,k,6) = crp(i,k) ! added for Thompson + clouds(i,k,6) = crp(i,k) clouds(i,k,7) = rer(i,k) !mz inflg .ne.5 clouds(i,k,8) = 0. @@ -2863,6 +2883,7 @@ subroutine progcld6 & & IX, NLAY, NLP1, & & uni_cld, lmfshal, lmfdeep2, cldcov, & & re_cloud,re_ice,re_snow, & + & lwp_ex, iwp_ex, lwp_fc, iwp_fc, & & dzlay, latdeg, julian, yearlen, & & clouds,clds,mtop,mbot,de_lgth,alpha & ! --- outputs: & ) @@ -2956,6 +2977,8 @@ subroutine progcld6 & real (kind=kind_phys), dimension(:,:), intent(in) :: plvl, plyr, & & tlyr, qlyr, qstl, rhly, cldcov, delp, dz, dzlay, & & re_cloud, re_ice, re_snow + real (kind=kind_phys), dimension(:), intent(inout) :: & + & lwp_ex, iwp_ex, lwp_fc, iwp_fc real (kind=kind_phys), dimension(:,:,:), intent(in) :: clw @@ -3063,7 +3086,7 @@ subroutine progcld6 & !> - Compute cloud liquid/ice condensate path in \f$ g/m^2 \f$ . - do k = 1, NLAY + do k = 1, NLAY-1 do i = 1, IX cwp(i,k) = max(0.0, clw(i,k,ntcw) * gfac * delp(i,k)) cip(i,k) = max(0.0, clw(i,k,ntiw) * gfac * delp(i,k)) @@ -3073,6 +3096,21 @@ subroutine progcld6 & enddo enddo +!> - Sum the liquid water and ice paths that come from explicit micro + + do i = 1, IX + lwp_ex(i) = 0.0 + iwp_ex(i) = 0.0 + lwp_fc(i) = 0.0 + iwp_fc(i) = 0.0 + do k = 1, NLAY-1 + lwp_ex(i) = lwp_ex(i) + cwp(i,k) + iwp_ex(i) = iwp_ex(i) + cip(i,k) + csp(i,k) + enddo + lwp_ex(i) = lwp_ex(i)*1.E-3 + iwp_ex(i) = iwp_ex(i)*1.E-3 + enddo + if (uni_cld) then ! use unified sgs clouds generated outside do k = 1, NLAY do i = 1, IX @@ -3085,54 +3123,32 @@ subroutine progcld6 & !> - Calculate layer cloud fraction. clwmin = 0.0 - if (.not. lmfshal) then - do k = 1, NLAY - do i = 1, IX - clwt = 1.0e-6 * (plyr(i,k)*0.001) -! clwt = 2.0e-6 * (plyr(i,k)*0.001) - - if (clwf(i,k) > clwt) then + do k = 1, NLAY-1 + do i = 1, IX + clwt = 1.0e-6 * (plyr(i,k)*0.001) - onemrh= max( 1.e-10, 1.0-rhly(i,k) ) - clwm = clwmin / max( 0.01, plyr(i,k)*0.001 ) + if (clwf(i,k) > clwt) then + onemrh= max( 1.e-10, 1.0-rhly(i,k) ) + clwm = clwmin / max( 0.01, plyr(i,k)*0.001 ) + if (.not. lmfshal) then tem1 = min(max(sqrt(sqrt(onemrh*qstl(i,k))),0.0001),1.0) tem1 = 2000.0 / tem1 - -! tem1 = 1000.0 / tem1 - - value = max( min( tem1*(clwf(i,k)-clwm), 50.0 ), 0.0 ) - tem2 = sqrt( sqrt(rhly(i,k)) ) - - cldtot(i,k) = max( tem2*(1.0-exp(-value)), 0.0 ) - endif - enddo - enddo - else - do k = 1, NLAY - do i = 1, IX - clwt = 1.0e-6 * (plyr(i,k)*0.001) -! clwt = 2.0e-6 * (plyr(i,k)*0.001) - - if (clwf(i,k) > clwt) then - onemrh= max( 1.e-10, 1.0-rhly(i,k) ) - clwm = clwmin / max( 0.01, plyr(i,k)*0.001 ) -! + else tem1 = min(max((onemrh*qstl(i,k))**0.49,0.0001),1.0) !jhan if (lmfdeep2) then tem1 = xrc3 / tem1 else tem1 = 100.0 / tem1 endif -! - value = max( min( tem1*(clwf(i,k)-clwm), 50.0 ), 0.0 ) - tem2 = sqrt( sqrt(rhly(i,k)) ) - - cldtot(i,k) = max( tem2*(1.0-exp(-value)), 0.0 ) endif - enddo - enddo - endif + + value = max( min( tem1*(clwf(i,k)-clwm), 50.0 ), 0.0 ) + tem2 = sqrt( sqrt(rhly(i,k)) ) + cldtot(i,k) = max( tem2*(1.0-exp(-value)), 0.0 ) + endif + enddo + enddo endif ! if (uni_cld) then @@ -3148,6 +3164,18 @@ subroutine progcld6 & enddo enddo + ! What portion of water and ice contents is associated with the partly cloudy boxes + do i = 1, IX + do k = 1, NLAY-1 + if (cldtot(i,k).ge.climit .and. cldtot(i,k).lt.ovcst) then + lwp_fc(i) = lwp_fc(i) + cwp(i,k) + iwp_fc(i) = iwp_fc(i) + cip(i,k) + csp(i,k) + endif + enddo + lwp_fc(i) = lwp_fc(i)*1.E-3 + iwp_fc(i) = iwp_fc(i)*1.E-3 + enddo + if ( lcnorm ) then do k = 1, NLAY do i = 1, IX @@ -3222,6 +3250,374 @@ end subroutine progcld6 !mz + +! This subroutine added by G. Thompson specifically to account for +! explicit (microphysics-produced) cloud liquid water, cloud ice, and +! snow with 100% cloud fraction. Also, a parameterization for cloud +! fraction less than 1.0 but greater than 0.0 follows Mocko and Cotton +! (1996) from Sundqvist et al. (1989) with cloud fraction increasing +! as RH increases above a critical value. In locations with non-zero +! (but less than 1.0) cloud fraction, there MUST be a value assigned +! to cloud liquid water and ice or else there is zero impact in the +! RRTMG radiation scheme. + subroutine progcld_thompson & + & ( plyr,plvl,tlyr,qlyr,qstl,rhly,clw, & ! --- inputs: + & xlat,xlon,slmsk,dz,delp, & + & ntrac,ntcw,ntiw,ntrw,ntsw,ntgl, & + & IX, NLAY, NLP1, & + & uni_cld, lmfshal, lmfdeep2, cldcov, & + & re_cloud,re_ice,re_snow, & + & lwp_ex, iwp_ex, lwp_fc, iwp_fc, & + & dzlay, latdeg, julian, yearlen, gridkm, & + & clouds,clds,mtop,mbot,de_lgth,alpha & ! --- outputs: + & ) + +! ================= subprogram documentation block ================ ! +! ! +! subprogram: progcld_thompson computes cloud related quantities ! +! using Thompson cloud microphysics scheme. ! +! ! +! abstract: this program computes cloud fractions from cloud ! +! condensates, ! +! and computes the low, mid, high, total and boundary layer cloud ! +! fractions and the vertical indices of low, mid, and high cloud ! +! top and base. the three vertical cloud domains are set up in the ! +! initial subroutine "cld_init". ! +! ! +! usage: call progcld_thompson ! +! ! +! subprograms called: gethml ! +! ! +! attributes: ! +! language: fortran 90 ! +! machine: ibm-sp, sgi ! +! ! +! ! +! ==================== definition of variables ==================== ! +! ! +! ! +! input variables: ! +! plyr (IX,NLAY) : model layer mean pressure in mb (100Pa) ! +! plvl (IX,NLP1) : model level pressure in mb (100Pa) ! +! tlyr (IX,NLAY) : model layer mean temperature in k ! +! tvly (IX,NLAY) : model layer virtual temperature in k ! +! qlyr (IX,NLAY) : layer specific humidity in gm/gm ! +! qstl (IX,NLAY) : layer saturate humidity in gm/gm ! +! rhly (IX,NLAY) : layer relative humidity (=qlyr/qstl) ! +! clw (IX,NLAY,ntrac) : layer cloud condensate amount ! +! xlat (IX) : grid latitude in radians, default to pi/2 -> -pi/2! +! range, otherwise see in-line comment ! +! xlon (IX) : grid longitude in radians (not used) ! +! slmsk (IX) : sea/land mask array (sea:0,land:1,sea-ice:2) ! +! dz (ix,nlay) : layer thickness (km) ! +! delp (ix,nlay) : model layer pressure thickness in mb (100Pa) ! +! gridkm : grid length in km ! +! IX : horizontal dimention ! +! NLAY,NLP1 : vertical layer/level dimensions ! +! uni_cld : logical - true for cloud fraction from shoc ! +! lmfshal : logical - true for mass flux shallow convection ! +! lmfdeep2 : logical - true for mass flux deep convection ! +! cldcov : layer cloud fraction (used when uni_cld=.true. ! +! ! +! output variables: ! +! clouds(IX,NLAY,NF_CLDS) : cloud profiles ! +! clouds(:,:,1) - layer total cloud fraction ! +! clouds(:,:,2) - layer cloud liq water path (g/m**2) ! +! clouds(:,:,3) - mean eff radius for liq cloud (micron) ! +! clouds(:,:,4) - layer cloud ice water path (g/m**2) ! +! clouds(:,:,5) - mean eff radius for ice cloud (micron) ! +! clouds(:,:,6) - layer rain drop water path not assigned ! +! clouds(:,:,7) - mean eff radius for rain drop (micron) ! +! clouds(:,:,8) - layer snow flake water path not assigned ! +! clouds(:,:,9) - mean eff radius for snow flake (micron) ! +! *** fu's scheme need to be normalized by snow density (g/m**3/1.0e6) ! +! clds (IX,5) : fraction of clouds for low, mid, hi, tot, bl ! +! mtop (IX,3) : vertical indices for low, mid, hi cloud tops ! +! mbot (IX,3) : vertical indices for low, mid, hi cloud bases ! +! de_lgth(ix) : clouds decorrelation length (km) ! +! ! +! module variables: ! +! ivflip : control flag of vertical index direction ! +! =0: index from toa to surface ! +! =1: index from surface to toa ! +! lmfshal : mass-flux shallow conv scheme flag ! +! lmfdeep2 : scale-aware mass-flux deep conv scheme flag ! +! lcrick : control flag for eliminating CRICK ! +! =t: apply layer smoothing to eliminate CRICK ! +! =f: do not apply layer smoothing ! +! lcnorm : control flag for in-cld condensate ! +! =t: normalize cloud condensate ! +! =f: not normalize cloud condensate ! +! ! +! ==================== end of description ===================== ! +! + implicit none + +! --- inputs + integer, intent(in) :: IX, NLAY, NLP1 + integer, intent(in) :: ntrac, ntcw, ntiw, ntrw, ntsw, ntgl + + logical, intent(in) :: uni_cld, lmfshal, lmfdeep2 + + real (kind=kind_phys), dimension(:,:), intent(in) :: plvl, plyr, & + & tlyr, qlyr, qstl, rhly, cldcov, delp, dz, dzlay, & + & re_cloud, re_ice, re_snow + real (kind=kind_phys), dimension(:), intent(inout) :: & + & lwp_ex, iwp_ex, lwp_fc, iwp_fc + + real (kind=kind_phys), dimension(:,:,:), intent(in) :: clw + + real (kind=kind_phys), dimension(:), intent(in) :: xlat, xlon, & + & slmsk + + real(kind=kind_phys), dimension(:), intent(in) :: latdeg + real(kind=kind_phys), intent(in) :: julian, gridkm + integer, intent(in) :: yearlen + +! --- outputs + real (kind=kind_phys), dimension(:,:,:), intent(out) :: clouds + + real (kind=kind_phys), dimension(:,:), intent(out) :: clds + real (kind=kind_phys), dimension(:), intent(out) :: de_lgth + real (kind=kind_phys), dimension(:,:), intent(out) :: alpha + + integer, dimension(:,:), intent(out) :: mtop,mbot + +! --- local variables: + real (kind=kind_phys), dimension(IX,NLAY) :: cldtot, cldcnv, & + & cwp, cip, crp, csp, rew, rei, res, rer + + real (kind=kind_phys), dimension(NLAY) :: cldfra1d, qv1d, & + & qc1d, qi1d, qs1d, dz1d, p1d, t1d + + real (kind=kind_phys) :: ptop1(IX,NK_CLDS+1), rxlat(ix) + + real (kind=kind_phys) :: clwmin, tem1 + real (kind=kind_phys) :: corr, xland, snow_mass_factor + real (kind=kind_phys), parameter :: max_relh = 1.5 + real (kind=kind_phys), parameter :: snow_max_radius = 130.0 + + integer :: i, k, k2, id, nf, idx_rei +! +!===> ... begin here +! + + clwmin = 1.0E-9 + + do nf=1,nf_clds + do k=1,nlay + do i=1,ix + clouds(i,k,nf) = 0.0 + enddo + enddo + enddo + + do k = 1, NLAY + do i = 1, IX + cldtot(i,k) = 0.0 + cldcnv(i,k) = 0.0 + cwp (i,k) = 0.0 + cip (i,k) = 0.0 + crp (i,k) = 0.0 + csp (i,k) = 0.0 + rew (i,k) = re_cloud(i,k) + rei (i,k) = re_ice(i,k) + rer (i,k) = rrain_def ! default rain radius to 1000 micron + res (i,k) = re_snow(i,K) + enddo + enddo + +!> - Find top pressure for each cloud domain for given latitude. +!! ptopc(k,i): top presure of each cld domain (k=1-4 are sfc,L,m,h; +!! i=1,2 are low-lat (<45 degree) and pole regions) + + do i =1, IX + rxlat(i) = abs( xlat(i) / con_pi ) ! if xlat in pi/2 -> -pi/2 range +! rxlat(i) = abs(0.5 - xlat(i)/con_pi) ! if xlat in 0 -> pi range + enddo + + do id = 1, 4 + tem1 = ptopc(id,2) - ptopc(id,1) + + do i =1, IX + ptop1(i,id) = ptopc(id,1) + tem1*max( 0.0, 4.0*rxlat(i)-1.0 ) + enddo + enddo + +!> - Compute cloud liquid/ice condensate path in \f$ g/m^2 \f$ . +!> - Since using Thompson MP, assume 20 percent of snow is actually in +!! ice sizes. + + do k = 1, NLAY-1 + do i = 1, IX + cwp(i,k) = max(0.0, clw(i,k,ntcw) * dz(i,k)*1.E6) + crp(i,k) = 0.0 + snow_mass_factor = 0.85 + cip(i,k) = max(0.0, (clw(i,k,ntiw) & + & + (1.0-snow_mass_factor)*clw(i,k,ntsw))*dz(i,k)*1.E6) + if (re_snow(i,k) .gt. snow_max_radius)then + snow_mass_factor = min(snow_mass_factor, & + & (snow_max_radius/re_snow(i,k)) & + & *(snow_max_radius/re_snow(i,k))) + res(i,k) = snow_max_radius + endif + csp(i,k) = max(0.,snow_mass_factor*clw(i,k,ntsw)*dz(i,k)*1.E6) + enddo + enddo + +!> - Sum the liquid water and ice paths that come from explicit micro + + do i = 1, IX + lwp_ex(i) = 0.0 + iwp_ex(i) = 0.0 + do k = 1, NLAY-1 + lwp_ex(i) = lwp_ex(i) + cwp(i,k) + iwp_ex(i) = iwp_ex(i) + cip(i,k) + csp(i,k) + enddo + enddo + +!> - Now determine the cloud fraction. Here, we will use the scheme of +!! G. Thompson that implements a variannt of Mocko and Cotton (1995) +!! based on work within HWRF and WRF. Where the bulk microphysics +!! scheme already has explicit clouds, assume cloud fraction of one, +!! but, otherwise, use a Sundqvist et al (1989) scheme and RH-critical +!! to account for sub-grid-scale clouds, include those in the water +!! and ice paths _seen_ by the radiation scheme, but do not actually +!! include these fake clouds into anything other than radiation. + + do i = 1, IX + if (slmsk(i)-0.5 .gt. 0.5 .and. slmsk(i)+0.5 .lt. 1.5) then + xland = 1.0 + else + xland = 2.0 + endif + + cldfra1d(:) = 0.0 + + if (ivflip .eq. 1) then + do k = 1, NLAY + qv1d(k) = qlyr(i,k) + qc1d(k) = max(0.0, clw(i,k,ntcw)) + qi1d(k) = max(0.0, clw(i,k,ntiw)) + qs1d(k) = max(0.0, clw(i,k,ntsw)) + dz1d(k) = dz(i,k)*1.E3 + p1d(k) = plyr(i,k)*100.0 + t1d(k) = tlyr(i,k) + enddo + else + do k = NLAY, 1, -1 + k2 = NLAY - k + 1 + qv1d(k2) = qlyr(i,k) + qc1d(k2) = max(0.0, clw(i,k,ntcw)) + qi1d(k2) = max(0.0, clw(i,k,ntiw)) + qs1d(k2) = max(0.0, clw(i,k,ntsw)) + dz1d(k2) = dz(i,k)*1.E3 + p1d(k2) = plyr(i,k)*100.0 + t1d(k2) = tlyr(i,k) + enddo + endif + + call cal_cldfra3(cldfra1d, qv1d, qc1d, qi1d, qs1d, dz1d, & + & p1d, t1d, xland, gridkm, & + & .false., max_relh, 1, nlay, .false.) + + do k = 1, NLAY + cldtot(i,k) = cldfra1d(k) + if (qc1d(k).gt.clwmin .and. cldfra1d(k).lt.ovcst) then + cwp(i,k) = qc1d(k) * dz1d(k)*1000. + if ((xland-1.5).GT.0.) then !--- Ocean + rew(i,k) = 9.5 + else !--- Land + rew(i,k) = 5.5 + endif + endif + if (qi1d(k).gt.clwmin .and. cldfra1d(k).lt.ovcst) then + cip(i,k) = qi1d(k) * dz1d(k)*1000. + idx_rei = int(t1d(k)-179.) + idx_rei = min(max(idx_rei,1),75) + corr = t1d(k) - int(t1d(k)) + rei(i,K) = max(5.0, retab(idx_rei)*(1.-corr) + & + & retab(idx_rei+1)*corr) + endif + enddo + enddo + + do k = 1, NLAY + do i = 1, IX + clouds(i,k,1) = cldtot(i,k) + clouds(i,k,2) = cwp(i,k) + clouds(i,k,3) = rew(i,k) + clouds(i,k,4) = cip(i,k) + clouds(i,k,5) = rei(i,k) + clouds(i,k,6) = crp(i,k) + clouds(i,k,7) = rer(i,k) + clouds(i,k,8) = csp(i,k) + clouds(i,k,9) = res(i,k) + enddo + enddo + +!> - Sum the liquid water and ice paths that come from fractional clouds + + do i = 1, IX + lwp_fc(i) = 0.0 + iwp_fc(i) = 0.0 + do k = 1, NLAY + lwp_fc(i) = lwp_fc(i) + cwp(i,k) + iwp_fc(i) = iwp_fc(i) + cip(i,k) + csp(i,k) + enddo + lwp_fc(i) = MAX(0.0, lwp_fc(i) - lwp_ex(i)) + iwp_fc(i) = MAX(0.0, iwp_fc(i) - iwp_ex(i)) + lwp_fc(i) = lwp_fc(i)*1.E-3 + iwp_fc(i) = iwp_fc(i)*1.E-3 + lwp_ex(i) = lwp_ex(i)*1.E-3 + iwp_ex(i) = iwp_ex(i)*1.E-3 + enddo + + ! Compute cloud decorrelation length + if (idcor == 1) then + call cmp_dcorr_lgth(ix, xlat, con_pi, de_lgth) + endif + if (idcor == 2) then + call cmp_dcorr_lgth(ix, latdeg, julian, yearlen, de_lgth) + endif + if (idcor == 0) then + de_lgth(:) = decorr_con + endif + + ! Call subroutine get_alpha_exp to define alpha parameter for exponential cloud overlap options + if ( iovr == 3 .or. iovr == 4 .or. iovr == 5) then + call get_alpha_exp(ix, nLay, dzlay, de_lgth, alpha) + else + de_lgth(:) = 0. + alpha(:,:) = 0. + endif + +!> - Call gethml() to compute low,mid,high,total, and boundary layer +!! cloud fractions and clouds top/bottom layer indices for low, mid, +!! and high clouds. +! --- compute low, mid, high, total, and boundary layer cloud fractions +! and clouds top/bottom layer indices for low, mid, and high clouds. +! The three cloud domain boundaries are defined by ptopc. The cloud +! overlapping method is defined by control flag 'iovr', which may +! be different for lw and sw radiation programs. + + call gethml & +! --- inputs: + & ( plyr, ptop1, cldtot, cldcnv, dz, de_lgth, alpha, & + & IX,NLAY, & +! --- outputs: + & clds, mtop, mbot & + & ) + +! + return + +!............................................ + end subroutine progcld_thompson +!............................................ +!mz + + !> \ingroup module_radiation_clouds !> This subroutine computes cloud related quantities using !! for unified cloud microphysics scheme. @@ -4050,6 +4446,7 @@ subroutine gethml & end subroutine gethml !----------------------------------- !! @} + !+---+-----------------------------------------------------------------+ !..Cloud fraction scheme by G. Thompson (NCAR-RAL), not intended for !.. combining with any cumulus or shallow cumulus parameterization @@ -4065,249 +4462,252 @@ end subroutine gethml ! !+---+-----------------------------------------------------------------+ - SUBROUTINE cal_cldfra3(CLDFRA, qv, qc, qi, qs, & - & p,t,rho, XLAND, gridkm, & -! & rand_perturb_on, kme_stoch, rand_pert, & - & ids,ide, jds,jde, kds,kde, & - & ims,ime, jms,jme, kms,kme, & - & its,ite, jts,jte, kts,kte) + SUBROUTINE cal_cldfra3(CLDFRA, qv, qc, qi, qs, dz, & + & p, t, XLAND, gridkm, & + & modify_qvapor, max_relh, & + & kts,kte, debug_flag) ! USE module_mp_thompson , ONLY : rsif, rslf IMPLICIT NONE ! - INTEGER, INTENT(IN):: ids,ide, jds,jde, kds,kde, & - & ims,ime, jms,jme, kms,kme, & -! & kme_stoch, & - & its,ite, jts,jte, kts,kte - -! INTEGER, INTENT(IN):: rand_perturb_on - REAL, DIMENSION(ims:ime,kms:kme,jms:jme), INTENT(IN):: qv,p,t,rho - REAL, DIMENSION(ims:ime,kms:kme,jms:jme), INTENT(INOUT):: qc,qi,qs -! REAL, DIMENSION(ims:ime,kms:kme_stoch,jms:jme), INTENT(IN):: rand_pert - REAL, DIMENSION(ims:ime,jms:jme), INTENT(IN):: XLAND - - REAL, DIMENSION(ims:ime,kms:kme,jms:jme), INTENT(INOUT):: cldfra - REAL, INTENT(IN):: gridkm + INTEGER, INTENT(IN):: kts, kte + LOGICAL, INTENT(IN):: modify_qvapor + REAL, DIMENSION(kts:kte), INTENT(INOUT):: qv, qc, qi, cldfra + REAL, DIMENSION(kts:kte), INTENT(IN):: p, t, dz, qs + REAL, INTENT(IN):: gridkm, XLAND, max_relh + LOGICAL, INTENT(IN):: debug_flag !..Local vars. - REAL:: RH_00L, RH_00O, RH_00, RHI_max, entrmnt - REAL, DIMENSION(ims:ime,kms:kme,jms:jme):: qvsat - INTEGER:: i,j,k - REAL:: TK, TC, qvsi, qvsw, RHUM, xx, yy - REAL, DIMENSION(kts:kte):: qvs1d, cfr1d, T1d, & - & P1d, R1d, qc1d, qi1d, qs1d + REAL:: RH_00L, RH_00O, RH_00 + REAL:: entrmnt=0.5 + INTEGER:: k + REAL:: TC, qvsi, qvsw, RHUM, delz + REAL, DIMENSION(kts:kte):: qvs, rh, rhoa + integer:: ndebug = 0 character*512 dbg_msg - LOGICAL:: debug_flag !+---+ +!..Initialize cloud fraction, compute RH, and rho-air. + + DO k = kts,kte + CLDFRA(K) = 0.0 + + qvsw = rslf(P(k), t(k)) + qvsi = rsif(P(k), t(k)) + + tc = t(k) - 273.15 + if (tc .ge. -12.0) then + qvs(k) = qvsw + elseif (tc .lt. -35.0) then + qvs(k) = qvsi + else + qvs(k) = qvsw - (qvsw-qvsi)*(-12.0-tc)/(-12.0+35.) + endif + + if (modify_qvapor) then + if (qc(k).gt.1.E-8) then + qv(k) = MAX(qv(k), qvsw) + qvs(k) = qvsw + endif + if (qc(k).le.1.E-8 .and. qi(k).ge.1.E-9) then + qv(k) = MAX(qv(k), qvsi*1.005) !..To ensure a tiny bit ice supersaturated + qvs(k) = qvsi + endif + endif + + rh(k) = MAX(0.01, qv(k)/qvs(k)) + rhoa(k) = p(k)/(287.0*t(k)) + + ENDDO + + !..First cut scale-aware. Higher resolution should require closer to !.. saturated grid box for higher cloud fraction. Simple functions !.. chosen based on Mocko and Cotton (1995) starting point and desire !.. to get near 100% RH as grid spacing moves toward 1.0km, but higher !.. RH over ocean required as compared to over land. - RH_00L = 0.7 + SQRT(1./(25.0+gridkm*gridkm*gridkm)) - RH_00O = 0.81 + SQRT(1./(50.0+gridkm*gridkm*gridkm)) - - DO j = jts,jte DO k = kts,kte - DO i = its,ite - RHI_max = 0.0 - CLDFRA(I,K,J) = 0.0 - - if (qc(i,k,j).gt.1.E-6 .or. qi(i,k,j).ge.1.E-7 .or.qs(i,k,j) & - & .gt.1.E-5) then - CLDFRA(I,K,J) = 1.0 - qvsat(i,k,j) = qv(i,k,j) - else - TK = t(i,k,j) - TC = TK - 273.16 - - qvsw = rslf(P(i,k,j), TK) - qvsi = rsif(P(i,k,j), TK) - if (tc .ge. -12.0) then - qvsat(i,k,j) = qvsw - elseif (tc .lt. -20.0) then - qvsat(i,k,j) = qvsi - else - qvsat(i,k,j) = qvsw - (qvsw-qvsi)*(-12.0-tc)/(-12.0+20.) - endif - RHUM = MAX(0.01, MIN(qv(i,k,j)/qvsat(i,k,j), 0.9999)) + delz = MAX(100., dz(k)) + RH_00L = 0.74+MIN(0.25,SQRT(1./(50.0+gridkm*gridkm*delz*0.01))) + RH_00O = 0.82+MIN(0.17,SQRT(1./(50.0+gridkm*gridkm*delz*0.01))) + RHUM = rh(k) + + if (qc(k).ge.1.E-5 .or. qi(k).ge.1.E-5 & + & .or. (qs(k).gt.1.E-5 .and. t(k).lt.273.)) then + CLDFRA(K) = 1.0 + elseif (((qc(k)+qi(k)).gt.1.E-10) .and. & + & ((qc(k)+qi(k)).lt.1.E-5)) then + CLDFRA(K) = MIN(0.99, 0.20*(10.0 + log10(qc(k)+qi(k)))) + else - IF ((XLAND(I,J)-1.5).GT.0.) THEN !--- Ocean + IF ((XLAND-1.5).GT.0.) THEN !--- Ocean RH_00 = RH_00O - ELSE !--- Land + ELSE !--- Land RH_00 = RH_00L ENDIF - if (tc .ge. -12.0) then - RHUM = MIN(0.999, RHUM) - CLDFRA(I,K,J) = MAX(0.0, 1.0-SQRT((1.0-RHUM)/(1.-RH_00))) - elseif (tc.lt.-12..and.tc.gt.-70. .and. RHUM.gt.RH_00L) then - RHUM = MAX(0.01, MIN(qv(i,k,j)/qvsat(i,k,j), 1.0 - 1.E-6)) - CLDFRA(I,K,J) = MAX(0., 1.0-SQRT((1.0-RHUM)/(1.0-RH_00L))) + tc = t(k) - 273.15 + if (tc .lt. -12.0) RH_00 = RH_00L + + if (tc .gt. 20.0) then + CLDFRA(K) = 0.0 + elseif (tc .ge. -12.0) then + RHUM = MIN(rh(k), 1.0) + CLDFRA(K) = MAX(0., 1.0-SQRT((1.001-RHUM)/(1.001-RH_00))) + else + if (max_relh.gt.1.12 .or. (.NOT.(modify_qvapor)) ) then +!..For HRRR model, the following look OK. + RHUM = MIN(rh(k), 1.45) + RH_00 = RH_00 + (1.45-RH_00)*(-12.0-tc)/(-12.0+112.) + CLDFRA(K) = MAX(0.,1.0-SQRT((1.46-RHUM)/(1.46-RH_00))) + else +!..but for the GFS model, RH is way lower. + RHUM = MIN(rh(k), 1.05) + RH_00 = RH_00 + (1.05-RH_00)*(-12.0-tc)/(-12.0+112.) + CLDFRA(K) = MAX(0.,1.0-SQRT((1.06-RHUM)/(1.06-RH_00))) + endif endif - CLDFRA(I,K,J) = MIN(0.90, CLDFRA(I,K,J)) + if (CLDFRA(K).gt.0.) CLDFRA(K)=MAX(0.01,MIN(CLDFRA(K),0.99)) endif + if (cldfra(k).gt.0.0 .and. p(k).lt.7000.0) CLDFRA(K) = 0.0 ENDDO - ENDDO - ENDDO - -!..Prepare for a 1-D column to find various cloud layers. + call find_cloudLayers(qvs, cldfra, T, P, Dz, entrmnt, & + & debug_flag, qc, qi, qs, kts,kte) - DO j = jts,jte - DO i = its,ite -! if (i.gt.10.and.i.le.20 .and. j.gt.10.and.j.le.20) then -! debug_flag = .true. -! else -! debug_flag = .false. -! endif +!..Do a final total column adjustment since we may have added more than 1 mm +!.. LWP/IWP for multiple cloud decks. -! if (rand_perturb_on .eq. 1) then -! entrmnt = MAX(0.01, MIN(0.99, 0.5 + rand_pert(i,1,j)*0.5)) -! else - entrmnt = 0.5 -! endif + call adjust_cloudFinal(cldfra, qc, qi, rhoa, dz, kts,kte) - DO k = kts,kte - qvs1d(k) = qvsat(i,k,j) - cfr1d(k) = cldfra(i,k,j) - T1d(k) = t(i,k,j) - P1d(k) = p(i,k,j) - R1d(k) = rho(i,k,j) - qc1d(k) = qc(i,k,j) - qi1d(k) = qi(i,k,j) - qs1d(k) = qs(i,k,j) - ENDDO + if (debug_flag .and. ndebug.lt.25) then + do k = kts,kte + write(6,'(a,i3,f9.2,f7.1,f7.2,f6.1,f6.3,f12.7,f12.7,f12.7)') & + & ' DEBUG-GT: ', k, p(k)*0.01, dz(k), t(k)-273.15, & + & rh(k)*100., cldfra(k), qc(k)*1.E3, qi(k)*1.E3, qs(k)*1.E3 + enddo + ndebug = ndebug + 1 + endif -! if (debug_flag) then -! WRITE (dbg_msg,*) 'DEBUG-GT: finding cloud layers at point (', i, ', ', j, ')' -! CALL wrf_debug (150, dbg_msg) -! endif - call find_cloudLayers(qvs1d, cfr1d, T1d, P1d, R1d, entrmnt, & - & debug_flag, qc1d, qi1d, qs1d, kts,kte) +!..Intended for cold start model runs, we use modify_qvapor to ensure that cloudy +!.. areas are actually saturated such that the inserted clouds do not evaporate a +!.. timestep later. + if (modify_qvapor) then DO k = kts,kte - cldfra(i,k,j) = cfr1d(k) - qc(i,k,j) = qc1d(k) - qi(i,k,j) = qi1d(k) + if (cldfra(k).gt.0.2 .and. cldfra(k).lt.1.0) then + qv(k) = MAX(qv(k),qvs(k)) + endif ENDDO - ENDDO - ENDDO + endif END SUBROUTINE cal_cldfra3 + !+---+-----------------------------------------------------------------+ !..From cloud fraction array, find clouds of multi-level depth and compute !.. a reasonable value of LWP or IWP that might be contained in that depth, !.. unless existing LWC/IWC is already there. - SUBROUTINE find_cloudLayers(qvs1d, cfr1d, T1d, P1d, R1d, entrmnt, & + SUBROUTINE find_cloudLayers(qvs1d, cfr1d, T1d, P1d, Dz1d, entrmnt,& & debugfl, qc1d, qi1d, qs1d, kts,kte) ! IMPLICIT NONE - +! INTEGER, INTENT(IN):: kts, kte LOGICAL, INTENT(IN):: debugfl REAL, INTENT(IN):: entrmnt - REAL, DIMENSION(kts:kte), INTENT(IN):: qvs1d,T1d,P1d,R1d - REAL, DIMENSION(kts:kte), INTENT(INOUT):: cfr1d - REAL, DIMENSION(kts:kte), INTENT(INOUT):: qc1d, qi1d, qs1d + REAL, DIMENSION(kts:kte), INTENT(IN):: qs1d,qvs1d,T1d,P1d,Dz1d + REAL, DIMENSION(kts:kte), INTENT(INOUT):: cfr1d, qc1d, qi1d !..Local vars. - REAL, DIMENSION(kts:kte):: theta, dz - REAL:: Z1, Z2, theta1, theta2, ht1, ht2 - INTEGER:: k, k2, k_tropo, k_m12C, k_m40C, k_cldb, k_cldt, kbot + REAL, DIMENSION(kts:kte):: theta + REAL:: theta1, theta2, delz + INTEGER:: k, k2, k_tropo, k_m12C, k_cldb, k_cldt, kbot, k_p200 LOGICAL:: in_cloud character*512 dbg_msg +!+---+ k_m12C = 0 - k_m40C = 0 + k_p200 = 0 DO k = kte, kts, -1 theta(k) = T1d(k)*((100000.0/P1d(k))**(287.05/1004.)) - if (T1d(k)-273.16 .gt. -40.0 .and. P1d(k).gt.7000.0) k_m40C = & - & MAX(k_m40C, k) - if (T1d(k)-273.16 .gt. -12.0 .and. P1d(k).gt.10000.0) k_m12C = & - & MAX(k_m12C, k) + if (T1d(k)-273.16 .gt. -12.0 .and. P1d(k).gt.10100.0) & + & k_m12C = MAX(k_m12C, k) + if (P1d(k).gt.19999.0 .and. k_p200.eq.0) k_p200 = k ENDDO - if (k_m40C .le. kts) k_m40C = kts if (k_m12C .le. kts) k_m12C = kts - Z2 = 44307.692 * (1.0 - (P1d(kte)/101325.)**0.190) - DO k = kte-1, kts, -1 - Z1 = 44307.692 * (1.0 - (P1d(k)/101325.)**0.190) - dz(k+1) = Z2 - Z1 - Z2 = Z1 - ENDDO - dz(kts) = dz(kts+1) - !..Find tropopause height, best surrogate, because we would not really !.. wish to put fake clouds into the stratosphere. The 10/1500 ratio !.. d(Theta)/d(Z) approximates a vertical line on typical SkewT chart !.. near typical (mid-latitude) tropopause height. Since messy data -!.. could give us a false signal of such a transition, do the check over +!.. could give us a false signal of such a transition, do the check over !.. three K-level change, not just a level-to-level check. This method !.. has potential failure in arctic-like conditions with extremely low !.. tropopause height, as would any other diagnostic, so ensure resulting -!.. k_tropo level is above 4km. +!.. k_tropo level is above 700hPa. - DO k = kte-3, kts, -1 + if ( (kte-k_p200) .lt. 3) k_p200 = kte-3 + DO k = k_p200-2, kts, -1 theta1 = theta(k) theta2 = theta(k+2) - ht1 = 44307.692 * (1.0 - (P1d(k)/101325.)**0.190) - ht2 = 44307.692 * (1.0 - (P1d(k+2)/101325.)**0.190) - if ( (((theta2-theta1)/(ht2-ht1)) .lt. 10./1500. ) .AND. & - & (ht1.lt.19000.) .and. (ht1.gt.4000.) ) then - goto 86 - endif + delz = 0.5*dz1d(k) + dz1d(k+1) + 0.5*dz1d(k+2) + if ( (((theta2-theta1)/delz).lt.10./1500.) .OR. & + & P1d(k).gt.70000.) EXIT ENDDO - 86 continue - k_tropo = MAX(kts+2, k+2) - -! if (debugfl) then -! print*, ' FOUND TROPOPAUSE ', k_tropo, ' near ', ht2, ' m' -! WRITE (dbg_msg,*) 'DEBUG-GT: FOUND TROPOPAUSE ', k_tropo, ' near ', ht2, ' m' -! CALL wrf_debug (150, dbg_msg) -! endif + k_tropo = MAX(kts+2, MIN(k+2, kte-1)) + + if (k_tropo .gt. k_p200) then + DO k = kte-3, k_p200-2, -1 + theta1 = theta(k) + theta2 = theta(k+2) + delz = 0.5*dz1d(k) + dz1d(k+1) + 0.5*dz1d(k+2) + if ( (((theta2-theta1)/delz).lt.10./1500.) .AND. & + & P1d(k).gt.9000.) EXIT + ENDDO + k_tropo = MAX(k_p200-1, MIN(k+2, kte-1)) + endif !..Eliminate possible fractional clouds above supposed tropopause. DO k = k_tropo+1, kte - if (cfr1d(k).gt.0.0 .and. cfr1d(k).lt.0.999) then + if (cfr1d(k).gt.0.0 .and. cfr1d(k).lt.1.0) then cfr1d(k) = 0. endif ENDDO -!..We would like to prevent fractional clouds below LCL in idealized -!.. situation with deep well-mixed convective PBL, that otherwise is -!.. likely to get clouds in more realistic capping inversion layer. +!..Be a bit more conservative with lower cloud fraction in scenario with +!.. well-mixed convective boundary layer below LCL. - kbot = kts+2 + kbot = kts+1 DO k = kbot, k_m12C - if ( (theta(k)-theta(k-1)) .gt. 0.05E-3*dz(k)) EXIT + if ( (theta(k)-theta(k-1)) .gt. 0.010E-3*Dz1d(k)) EXIT ENDDO kbot = MAX(kts+1, k-2) DO k = kts, kbot - if (cfr1d(k).gt.0.0 .and. cfr1d(k).lt.0.999) cfr1d(k) = 0. + if (cfr1d(k).gt.0.0 .and. cfr1d(k).lt.1.0) & + & cfr1d(k) = MAX(0.01,0.33*cfr1d(k)) + ENDDO + DO k = kts,k_tropo + if (cfr1d(k).gt.0.0) kbot = MIN(k,kbot) ENDDO - !..Starting below tropo height, if cloud fraction greater than 1 percent, -!.. compute an approximate total layer depth of cloud, determine a total -!.. liquid water/ice path (LWP/IWP), then reduce that amount with tuning +!.. compute an approximate total layer depth of cloud, determine a total +!.. liquid water/ice path (LWP/IWP), then reduce that amount with tuning !.. parameter to represent entrainment factor, then divide up LWP/IWP -!.. into delta-Z weighted amounts for individual levels per cloud layer. - +!.. into delta-Z weighted amounts for individual levels per cloud layer. k_cldb = k_tropo in_cloud = .false. k = k_tropo - DO WHILE (.not. in_cloud .AND. k.gt.k_m12C) + DO WHILE (.not. in_cloud .AND. k.gt.k_m12C+1) k_cldt = 0 if (cfr1d(k).ge.0.01) then in_cloud = .true. @@ -4324,30 +4724,20 @@ SUBROUTINE find_cloudLayers(qvs1d, cfr1d, T1d, P1d, R1d, entrmnt, & in_cloud = .false. endif if ((k_cldt - k_cldb + 1) .ge. 2) then -! if (debugfl) then -! print*, 'An ice cloud layer is found between ', k_cldt, -! k_cldb, P1d(k_cldt)*0.01, P1d(k_cldb)*0.01 -! WRITE (dbg_msg,*) 'DEBUG-GT: An ice cloud layer is found between -! ', k_cldt, k_cldb, P1d(k_cldt)*0.01, P1d(k_cldb)*0.01 -! CALL wrf_debug (150, dbg_msg) -! endif - call adjust_cloudIce(cfr1d, qi1d, qs1d, qvs1d, T1d,R1d,dz, & + call adjust_cloudIce(cfr1d, qi1d, qs1d, qvs1d, T1d, Dz1d, & & entrmnt, k_cldb,k_cldt,kts,kte) k = k_cldb - else - if (cfr1d(k_cldb).gt.0.and.qi1d(k_cldb).lt.1.E-6) & - & qi1d(k_cldb)=1.E-5*cfr1d(k_cldb) + elseif ((k_cldt - k_cldb + 1) .eq. 1) then + if (cfr1d(k_cldb).gt.0.and.cfr1d(k_cldb).lt.1.) & + & qi1d(k_cldb)=qi1d(k_cldb)+0.05*qvs1d(k_cldb)*cfr1d(k_cldb) + k = k_cldb endif - - k = k - 1 ENDDO - - - k_cldb = k_tropo + k_cldb = k_m12C + 5 in_cloud = .false. - k = k_m12C + 2 + k = k_m12C + 4 DO WHILE (.not. in_cloud .AND. k.gt.kbot) k_cldt = 0 if (cfr1d(k).ge.0.01) then @@ -4365,78 +4755,43 @@ SUBROUTINE find_cloudLayers(qvs1d, cfr1d, T1d, P1d, R1d, entrmnt, & in_cloud = .false. endif if ((k_cldt - k_cldb + 1) .ge. 2) then -! if (debugfl) then -! print*, 'A water cloud layer is found between ', k_cldt, -! k_cldb, P1d(k_cldt)*0.01, P1d(k_cldb)*0.01 -! WRITE (dbg_msg,*) 'DEBUG-GT: A water cloud layer is found -! between ', k_cldt, k_cldb, P1d(k_cldt)*0.01, P1d(k_cldb)*0.01 -! CALL wrf_debug (150, dbg_msg) -! endif - call adjust_cloudH2O(cfr1d, qc1d, qvs1d, T1d,R1d,dz, & + call adjust_cloudH2O(cfr1d, qc1d, qvs1d, T1d, Dz1d, & & entrmnt, k_cldb,k_cldt,kts,kte) k = k_cldb - else - if (cfr1d(k_cldb).gt.0.and.qc1d(k_cldb).lt.1.E-6) & - & qc1d(k_cldb)=1.E-5*cfr1d(k_cldb) + elseif ((k_cldt - k_cldb + 1) .eq. 1) then + if (cfr1d(k_cldb).gt.0.and.cfr1d(k_cldb).lt.1.) & + & qc1d(k_cldb)=qc1d(k_cldb)+0.05*qvs1d(k_cldb)*cfr1d(k_cldb) + k = k_cldb endif k = k - 1 ENDDO -!..Do a final total column adjustment since we may have added more than -!1mm -!.. LWP/IWP for multiple cloud decks. - - call adjust_cloudFinal(cfr1d, qc1d, qi1d, R1d,dz, kts,kte,k_tropo) - -! if (debugfl) then -! print*, ' Made-up fake profile of clouds' -! do k = kte, kts, -1 -! write(*,'(i3, 2x, f8.2, 2x, f9.2, 2x, f6.2, 2x, f15.7, 2x, -! f15.7)') & -! & K, T1d(k)-273.15, P1d(k)*0.01, cfr1d(k)*100., -! qc1d(k)*1000.,qi1d(k)*1000. -! enddo -! WRITE (dbg_msg,*) 'DEBUG-GT: Made-up fake profile of clouds' -! CALL wrf_debug (150, dbg_msg) -! do k = kte, kts, -1 -! write(dbg_msg,'(f8.2, 2x, f9.2, 2x, f6.2, 2x, f15.7, 2x, -! f15.7)') & -! & T1d(k)-273.15, P1d(k)*0.01, cfr1d(k)*100., -! qc1d(k)*1000.,qi1d(k)*1000. -! CALL wrf_debug (150, dbg_msg) -! enddo -! endif - END SUBROUTINE find_cloudLayers !+---+-----------------------------------------------------------------+ - SUBROUTINE adjust_cloudIce(cfr,qi,qs,qvs, T,Rho,dz, entr, k1,k2, & - & kts,kte) + SUBROUTINE adjust_cloudIce(cfr,qi,qs,qvs,T,dz,entr, k1,k2,kts,kte) ! IMPLICIT NONE ! INTEGER, INTENT(IN):: k1,k2, kts,kte REAL, INTENT(IN):: entr - REAL, DIMENSION(kts:kte), INTENT(IN):: cfr, qvs, T, Rho, dz - REAL, DIMENSION(kts:kte), INTENT(INOUT):: qi, qs - REAL:: iwc, max_iwc, tdz, this_iwc, this_dz, iwp_exists - INTEGER:: k, kmid + REAL, DIMENSION(kts:kte), INTENT(IN):: cfr, qs, qvs, T, dz + REAL, DIMENSION(kts:kte), INTENT(INOUT):: qi + REAL:: iwc, max_iwc, tdz, this_iwc, this_dz + INTEGER:: k tdz = 0. do k = k1, k2 tdz = tdz + dz(k) enddo - kmid = NINT(0.5*(k1+k2)) - max_iwc = ABS(qvs(k2-1)-qvs(k1)) -! print*, ' max_iwc = ', max_iwc, ' over DZ=',tdz + max_iwc = ABS(qvs(k2)-qvs(k1)) - iwp_exists = 0. do k = k1, k2 - iwp_exists = iwp_exists + (qi(k)+qs(k))*Rho(k)*dz(k) + max_iwc = MAX(1.E-5, max_iwc - (qi(k)+qs(k))) enddo - if (iwp_exists .gt. 1.0) RETURN + max_iwc = MIN(2.E-3, max_iwc) this_dz = 0.0 do k = k1, k2 @@ -4446,12 +4801,9 @@ SUBROUTINE adjust_cloudIce(cfr,qi,qs,qvs, T,Rho,dz, entr, k1,k2, & this_dz = this_dz + dz(k) endif this_iwc = max_iwc*this_dz/tdz - iwc = MAX(1.E-6, this_iwc*(1.-entr)) - if (cfr(k).gt.0.01.and.cfr(k).lt.0.99.and.T(k).ge.203.16) then - qi(k) = qi(k) + 0.1*cfr(k)*iwc - elseif (qi(k).lt.1.E-5.and.cfr(k).ge.0.99.and.T(k).ge.203.16) & - & then - qi(k) = qi(k) + 0.01*iwc + iwc = MAX(5.E-6, this_iwc*(1.-entr)) + if (cfr(k).gt.0.0.and.cfr(k).lt.1.0.and.T(k).ge.203.16) then + qi(k) = qi(k) + cfr(k)*cfr(k)*iwc endif enddo @@ -4459,30 +4811,28 @@ END SUBROUTINE adjust_cloudIce !+---+-----------------------------------------------------------------+ - SUBROUTINE adjust_cloudH2O(cfr, qc, qvs, T,Rho,dz, entr, k1,k2, & - & kts,kte) + SUBROUTINE adjust_cloudH2O(cfr, qc, qvs,T,dz,entr, k1,k2,kts,kte) ! IMPLICIT NONE ! INTEGER, INTENT(IN):: k1,k2, kts,kte REAL, INTENT(IN):: entr - REAL, DIMENSION(kts:kte):: cfr, qc, qvs, T, Rho, dz - REAL:: lwc, max_lwc, tdz, this_lwc, this_dz, lwp_exists - INTEGER:: k, kmid + REAL, DIMENSION(kts:kte), INTENT(IN):: cfr, qvs, T, dz + REAL, DIMENSION(kts:kte), INTENT(INOUT):: qc + REAL:: lwc, max_lwc, tdz, this_lwc, this_dz + INTEGER:: k tdz = 0. do k = k1, k2 tdz = tdz + dz(k) enddo - kmid = NINT(0.5*(k1+k2)) - max_lwc = ABS(qvs(k2-1)-qvs(k1)) + max_lwc = ABS(qvs(k2)-qvs(k1)) ! print*, ' max_lwc = ', max_lwc, ' over DZ=',tdz - lwp_exists = 0. do k = k1, k2 - lwp_exists = lwp_exists + qc(k)*Rho(k)*dz(k) + max_lwc = MAX(1.E-5, max_lwc - qc(k)) enddo - if (lwp_exists .gt. 1.0) RETURN + max_lwc = MIN(2.E-3, max_lwc) this_dz = 0.0 do k = k1, k2 @@ -4492,68 +4842,58 @@ SUBROUTINE adjust_cloudH2O(cfr, qc, qvs, T,Rho,dz, entr, k1,k2, & this_dz = this_dz + dz(k) endif this_lwc = max_lwc*this_dz/tdz - lwc = MAX(1.E-6, this_lwc*(1.-entr)) - if (cfr(k).gt.0.01.and.cfr(k).lt.0.99.and.T(k).lt.298.16.and. & - & T(k).ge.253.16) then + lwc = MAX(5.E-6, this_lwc*(1.-entr)) + if (cfr(k).gt.0.0.and.cfr(k).lt.1.0.and.T(k).ge.253.16) then qc(k) = qc(k) + cfr(k)*cfr(k)*lwc - elseif (cfr(k).ge.0.99.and.qc(k).lt.1.E-5.and.T(k).lt.298.16 & - & .and.T(k).ge.253.16) then - qc(k) = qc(k) + 0.1*lwc endif enddo END SUBROUTINE adjust_cloudH2O - !+---+-----------------------------------------------------------------+ !..Do not alter any grid-explicitly resolved hydrometeors, rather only !.. the supposed amounts due to the cloud fraction scheme. - SUBROUTINE adjust_cloudFinal(cfr, qc, qi, Rho,dz, kts,kte,k_tropo) + SUBROUTINE adjust_cloudFinal(cfr, qc, qi, Rho,dz, kts,kte) ! IMPLICIT NONE ! - INTEGER, INTENT(IN):: kts,kte,k_tropo + INTEGER, INTENT(IN):: kts,kte REAL, DIMENSION(kts:kte), INTENT(IN):: cfr, Rho, dz REAL, DIMENSION(kts:kte), INTENT(INOUT):: qc, qi REAL:: lwp, iwp, xfac INTEGER:: k lwp = 0. - do k = kts, k_tropo - if (cfr(k).gt.0.0) then - lwp = lwp + qc(k)*Rho(k)*dz(k) - endif - enddo - iwp = 0. - do k = kts, k_tropo - if (cfr(k).gt.0.01 .and. cfr(k).lt.0.99) then + do k = kts, kte + if (cfr(k).gt.0.0 .and. cfr(k).lt.1.0) then + lwp = lwp + qc(k)*Rho(k)*dz(k) iwp = iwp + qi(k)*Rho(k)*dz(k) endif enddo - if (lwp .gt. 1.5) then - xfac = 1./lwp - do k = kts, k_tropo - if (cfr(k).gt.0.01 .and. cfr(k).lt.0.99) then + if (lwp .gt. 1.0) then + xfac = 1.0/lwp + do k = kts, kte + if (cfr(k).gt.0.0 .and. cfr(k).lt.1.0) then qc(k) = qc(k)*xfac endif enddo endif - if (iwp .gt. 1.5) then - xfac = 1./iwp - do k = kts, k_tropo - if (cfr(k).gt.0.01 .and. cfr(k).lt.0.99) then + if (iwp .gt. 1.0) then + xfac = 1.0/iwp + do k = kts, kte + if (cfr(k).gt.0.0 .and. cfr(k).lt.1.0) then qi(k) = qi(k)*xfac endif enddo endif END SUBROUTINE adjust_cloudFinal -! + !........................................! end module module_radiation_clouds ! !! @} diff --git a/physics/rayleigh_damp.meta b/physics/rayleigh_damp.meta index 4a08a1d64..568cb9486 100644 --- a/physics/rayleigh_damp.meta +++ b/physics/rayleigh_damp.meta @@ -133,7 +133,7 @@ [dtend] standard_name = cumulative_change_of_state_variables long_name = diagnostic tendencies for state variables - units = various + units = mixed dimensions = (horizontal_loop_extent,vertical_layer_dimension,cumulative_change_of_state_variables_outer_index_max) type = real kind = kind_phys diff --git a/physics/rrtmgp_lw_aerosol_optics.F90 b/physics/rrtmgp_lw_aerosol_optics.F90 index df0e77163..de42db1cd 100644 --- a/physics/rrtmgp_lw_aerosol_optics.F90 +++ b/physics/rrtmgp_lw_aerosol_optics.F90 @@ -2,7 +2,7 @@ module rrtmgp_lw_aerosol_optics use machine, only: kind_phys use mo_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp use mo_optical_props, only: ty_optical_props_1scl - use radiation_tools, only: check_error_msg + use radiation_tools, only: check_error_msg use rrtmgp_sw_gas_optics, only: sw_gas_props use rrtmgp_lw_gas_optics, only: lw_gas_props use module_radiation_aerosols, only: & @@ -30,9 +30,9 @@ end subroutine rrtmgp_lw_aerosol_optics_init !! \section arg_table_rrtmgp_lw_aerosol_optics_run !! \htmlinclude rrtmgp_lw_aerosol_optics.html !! - subroutine rrtmgp_lw_aerosol_optics_run(doLWrad, nCol, nLev, nTracer, nTracerAer,& - p_lev, p_lay, p_lk, tv_lay, relhum, lsmask, tracer, aerfld, lon, lat, & - aerodp, lw_optical_props_aerosol, errmsg, errflg) + subroutine rrtmgp_lw_aerosol_optics_run(doLWrad, nCol, nLev, nspc, nTracer, nTracerAer, & + p_lev, p_lay, p_lk, tv_lay, relhum, lsmask, tracer, aerfld, lon, lat, & + lw_optical_props_aerosol, errmsg, errflg) ! Inputs logical, intent(in) :: & @@ -40,6 +40,7 @@ subroutine rrtmgp_lw_aerosol_optics_run(doLWrad, nCol, nLev, nTracer, nTracerAer integer, intent(in) :: & nCol, & ! Number of horizontal grid points nLev, & ! Number of vertical layers + nspc, & ! Number of aerosol optical-depths nTracer, & ! Number of tracers nTracerAer ! Number of aerosol tracers real(kind_phys), dimension(:), intent(in) :: & @@ -59,8 +60,6 @@ subroutine rrtmgp_lw_aerosol_optics_run(doLWrad, nCol, nLev, nTracer, nTracerAer p_lev ! Pressure @ layer-interfaces (Pa) ! Outputs - real(kind_phys), dimension(:,:), intent(inout) :: & - aerodp ! Vertical integrated optical depth for various aerosol species type(ty_optical_props_1scl),intent(inout) :: & lw_optical_props_aerosol ! RRTMGP DDT: Longwave aerosol optical properties (tau) integer, intent(out) :: & @@ -73,6 +72,7 @@ subroutine rrtmgp_lw_aerosol_optics_run(doLWrad, nCol, nLev, nTracer, nTracerAer aerosolslw ! real(kind_phys), dimension(nCol, nLev, sw_gas_props%get_nband(), NF_AESW) :: & aerosolssw + real(kind_phys), dimension(nCol,nspc) :: aerodp integer :: iBand ! Initialize CCPP error handling variables diff --git a/physics/rrtmgp_lw_aerosol_optics.meta b/physics/rrtmgp_lw_aerosol_optics.meta index 843688266..875143df1 100644 --- a/physics/rrtmgp_lw_aerosol_optics.meta +++ b/physics/rrtmgp_lw_aerosol_optics.meta @@ -28,6 +28,13 @@ dimensions = () type = integer intent = in +[nspc] + 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 [nTracer] standard_name = number_of_tracers long_name = number of tracers @@ -122,14 +129,6 @@ 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 = inout [lw_optical_props_aerosol] standard_name = longwave_optical_properties_for_aerosols long_name = Fortran DDT containing RRTMGP optical properties diff --git a/physics/rrtmgp_lw_cloud_optics.F90 b/physics/rrtmgp_lw_cloud_optics.F90 index 7be8f7865..5ddcec078 100644 --- a/physics/rrtmgp_lw_cloud_optics.F90 +++ b/physics/rrtmgp_lw_cloud_optics.F90 @@ -5,7 +5,7 @@ module rrtmgp_lw_cloud_optics use mo_optical_props, only: ty_optical_props_1scl, ty_optical_props_2str use mo_rrtmg_lw_cloud_optics, only: rrtmg_lw_cloud_optics use rrtmgp_lw_gas_optics, only: lw_gas_props - use radiation_tools, only: check_error_msg + use radiation_tools, only: check_error_msg use netcdf #ifdef MPI use mpi diff --git a/physics/rrtmgp_lw_cloud_sampling.F90 b/physics/rrtmgp_lw_cloud_sampling.F90 index 8702c20d7..d8d499577 100644 --- a/physics/rrtmgp_lw_cloud_sampling.F90 +++ b/physics/rrtmgp_lw_cloud_sampling.F90 @@ -4,7 +4,7 @@ module rrtmgp_lw_cloud_sampling use mo_optical_props, only: ty_optical_props_2str use rrtmgp_sampling, only: sampled_mask, draw_samples use mersenne_twister, only: random_setseed, random_number, random_stat - use radiation_tools, only: check_error_msg + use radiation_tools, only: check_error_msg use rrtmgp_lw_gas_optics, only: lw_gas_props use netcdf @@ -149,6 +149,7 @@ subroutine rrtmgp_lw_cloud_sampling_run(doLWrad, nCol, nLev, icseed_lw, iovr, ! #################################################################################### ! Next sample the precipitation... + ! (Use same RNGs as was used by the clouds.) ! #################################################################################### lw_optical_props_precip%band2gpt = lw_gas_props%get_band_lims_gpoint() lw_optical_props_precip%band_lims_wvn = lw_gas_props%get_band_lims_wavenumber() @@ -156,26 +157,6 @@ subroutine rrtmgp_lw_cloud_sampling_run(doLWrad, nCol, nLev, icseed_lw, iovr, lw_optical_props_precip%gpt2band(lw_optical_props_precip%band2gpt(1,iBand):lw_optical_props_precip%band2gpt(2,iBand)) = iBand end do - ! Change random number seed value for each radiation invocation (isubc_lw =1 or 2). - if(isubc_lw == 1) then ! advance prescribed permutation seed - do iCol = 1, ncol - ipseed_lw(iCol) = lw_gas_props%get_ngpt() + iCol - enddo - elseif (isubc_lw == 2) then ! use input array of permutaion seeds - do iCol = 1, ncol - ipseed_lw(iCol) = icseed_lw(iCol) - enddo - endif - - ! No need to call RNG second time for now, just use the same seeds for precip as clouds. - !! Call RNG. Mersennse Twister accepts 1D array, so loop over columns and collapse along G-points - !! and layers. ([nGpts,nLev,nColumn]-> [nGpts*nLev]*nColumn) - !do iCol=1,ncol - ! call random_setseed(ipseed_lw(icol),rng_stat) - ! call random_number(rng1D,rng_stat) - ! rng3D(:,:,iCol) = reshape(source = rng1D,shape=[lw_gas_props%get_ngpt(),nLev]) - !enddo - ! Precipitation overlap. ! Maximum-random, random or maximum. if (iovr == iovr_maxrand .or. iovr == iovr_rand .or. iovr == iovr_max) then @@ -183,13 +164,6 @@ subroutine rrtmgp_lw_cloud_sampling_run(doLWrad, nCol, nLev, icseed_lw, iovr, endif ! Exponential decorrelation length overlap if (iovr == iovr_dcorr) then - ! No need to call RNG second time for now, just use the same seeds for precip as clouds. - !! Generate second RNG - !do iCol=1,ncol - ! call random_setseed(ipseed_lw(icol),rng_stat) - ! call random_number(rng1D,rng_stat) - ! rng3D2(:,:,iCol) = reshape(source = rng1D,shape=[lw_gas_props%get_ngpt(),nLev]) - !enddo call sampled_mask(rng3D, precip_frac, precipfracSAMP, & overlap_param = precip_overlap_param(:,1:nLev-1), & randoms2 = rng3D2) diff --git a/physics/rrtmgp_lw_cloud_sampling.meta b/physics/rrtmgp_lw_cloud_sampling.meta index c9fbee800..2571e7295 100644 --- a/physics/rrtmgp_lw_cloud_sampling.meta +++ b/physics/rrtmgp_lw_cloud_sampling.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = rrtmgp_lw_cloud_sampling type = scheme - dependencies = machine.F,mersenne_twister.f,physparam.f,rrtmgp_sampling.F90,radiation_tools.F90 + dependencies = machine.F,mersenne_twister.f,rrtmgp_sampling.F90,radiation_tools.F90 ###################################################### [ccpp-arg-table] diff --git a/physics/rrtmgp_lw_gas_optics.F90 b/physics/rrtmgp_lw_gas_optics.F90 index 738ff5b30..67a888911 100644 --- a/physics/rrtmgp_lw_gas_optics.F90 +++ b/physics/rrtmgp_lw_gas_optics.F90 @@ -466,8 +466,7 @@ end subroutine rrtmgp_lw_gas_optics_init !! \htmlinclude rrtmgp_lw_gas_optics_run.html !! subroutine rrtmgp_lw_gas_optics_run(doLWrad, nCol, nLev, p_lay, p_lev, t_lay, t_lev, tsfg, & - active_gases_array, gas_concentrations, lw_optical_props_clrsky, sources, & - errmsg, errflg) + gas_concentrations, lw_optical_props_clrsky, sources, errmsg, errflg) ! Inputs logical, intent(in) :: & @@ -483,10 +482,8 @@ subroutine rrtmgp_lw_gas_optics_run(doLWrad, nCol, nLev, p_lay, p_lev, t_lay, t_ t_lev ! Temperature @ model levels real(kind_phys), dimension(ncol), intent(in) :: & tsfg ! Surface ground temperature (K) - type(ty_gas_concs),intent(inout) :: & + type(ty_gas_concs),intent(in) :: & gas_concentrations ! RRTMGP DDT: trace gas concentrations (vmr) - character(len=*), dimension(:), intent(in) :: & - active_gases_array ! List of active gases from namelist as array ! Output character(len=*), intent(out) :: & @@ -507,8 +504,6 @@ subroutine rrtmgp_lw_gas_optics_run(doLWrad, nCol, nLev, p_lay, p_lev, t_lay, t_ if (.not. doLWrad) return - gas_concentrations%gas_name(:) = active_gases_array(:) - ! Copy spectral information into GP DDTs. lw_optical_props_clrsky%band2gpt = lw_gas_props%get_band_lims_gpoint() sources%band2gpt = lw_gas_props%get_band_lims_gpoint() diff --git a/physics/rrtmgp_lw_gas_optics.meta b/physics/rrtmgp_lw_gas_optics.meta index 7a3d86eb8..2024df664 100644 --- a/physics/rrtmgp_lw_gas_optics.meta +++ b/physics/rrtmgp_lw_gas_optics.meta @@ -165,21 +165,13 @@ type = real kind = kind_phys intent = in -[active_gases_array] - standard_name = list_of_active_gases_used_by_RRTMGP - long_name = list of active gases used by RRTMGP - units = none - dimensions = (number_of_active_gases_used_by_RRTMGP) - type = character - kind = len=* - intent = in [gas_concentrations] standard_name = Gas_concentrations_for_RRTMGP_suite long_name = DDT containing gas concentrations for RRTMGP radiation scheme units = DDT dimensions = () type = ty_gas_concs - intent = inout + intent = in [lw_optical_props_clrsky] standard_name = longwave_optical_properties_for_clear_sky long_name = Fortran DDT containing RRTMGP optical properties diff --git a/physics/rrtmgp_lw_pre.meta b/physics/rrtmgp_lw_pre.meta index be8a48a88..8a8b15467 100644 --- a/physics/rrtmgp_lw_pre.meta +++ b/physics/rrtmgp_lw_pre.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = rrtmgp_lw_pre type = scheme - dependencies = iounitdef.f,machine.F,physparam.f + dependencies = iounitdef.f,machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/rrtmgp_lw_rte.F90 b/physics/rrtmgp_lw_rte.F90 index d2878598d..aed4f0027 100644 --- a/physics/rrtmgp_lw_rte.F90 +++ b/physics/rrtmgp_lw_rte.F90 @@ -2,14 +2,11 @@ ! ########################################################################################### module rrtmgp_lw_rte use machine, only: kind_phys - use mo_rte_kind, only: wl - use mo_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp - use mo_cloud_optics, only: ty_cloud_optics use mo_optical_props, only: ty_optical_props_1scl, ty_optical_props_2str use mo_rte_lw, only: rte_lw use mo_fluxes_byband, only: ty_fluxes_byband use mo_source_functions, only: ty_source_func_lw - use radiation_tools, only: check_error_msg + use radiation_tools, only: check_error_msg use rrtmgp_lw_gas_optics, only: lw_gas_props implicit none @@ -29,12 +26,14 @@ end subroutine rrtmgp_lw_rte_init !! \htmlinclude rrtmgp_lw_rte_run.html !! subroutine rrtmgp_lw_rte_run(doLWrad, doLWclrsky, use_LW_jacobian, doGP_lwscat, nCol, & - nLev, p_lev, sfc_emiss_byband, sources, lw_optical_props_clrsky, & + nLev, top_at_1, sfc_emiss_byband, sources, lw_optical_props_clrsky, & lw_optical_props_clouds, lw_optical_props_aerosol, nGauss_angles, fluxlwUP_allsky, & - fluxlwDOWN_allsky, fluxlwUP_clrsky, fluxlwDOWN_clrsky, fluxlwUP_jac, errmsg, errflg) + fluxlwDOWN_allsky, fluxlwUP_clrsky, fluxlwDOWN_clrsky, fluxlwUP_jac, & + fluxlwUP_radtime, fluxlwDOWN_radtime, errmsg, errflg) ! Inputs logical, intent(in) :: & + top_at_1, & ! Vertical ordering flag doLWrad, & ! Logical flag for longwave radiation call doLWclrsky, & ! Compute clear-sky fluxes for clear-sky heating-rate? use_LW_jacobian, & ! Compute Jacobian of LW to update radiative fluxes between radiation calls? @@ -43,8 +42,6 @@ subroutine rrtmgp_lw_rte_run(doLWrad, doLWclrsky, use_LW_jacobian, doGP_lwscat, nCol, & ! Number of horizontal gridpoints nLev, & ! Number of vertical levels nGauss_angles ! Number of angles used in Gaussian quadrature - real(kind_phys), dimension(ncol,nLev+1), intent(in) :: & - p_lev ! Pressure @ model layer-interfaces (Pa) real(kind_phys), dimension(lw_gas_props%get_nband(),ncol), intent(in) :: & sfc_emiss_byband ! Surface emissivity in each band type(ty_source_func_lw),intent(in) :: & @@ -61,7 +58,9 @@ subroutine rrtmgp_lw_rte_run(doLWrad, doLWclrsky, use_LW_jacobian, doGP_lwscat, fluxlwUP_allsky, & ! All-sky flux (W/m2) fluxlwDOWN_allsky, & ! All-sky flux (W/m2) fluxlwUP_clrsky, & ! Clear-sky flux (W/m2) - fluxlwDOWN_clrsky ! All-sky flux (W/m2) + fluxlwDOWN_clrsky, & ! All-sky flux (W/m2) + fluxlwUP_radtime, & ! Copy of fluxes (Used for coupling) + fluxlwDOWN_radtime character(len=*), intent(out) :: & errmsg ! CCPP error message integer, intent(out) :: & @@ -72,9 +71,6 @@ subroutine rrtmgp_lw_rte_run(doLWrad, doLWclrsky, use_LW_jacobian, doGP_lwscat, flux_allsky, flux_clrsky real(kind_phys), dimension(ncol,nLev+1,lw_gas_props%get_nband()),target :: & fluxLW_up_allsky, fluxLW_up_clrsky, fluxLW_dn_allsky, fluxLW_dn_clrsky - logical :: & - top_at_1 - integer :: iSFC, iTOA real(kind_phys), dimension(nCol,lw_gas_props%get_ngpt()) :: lw_Ds ! Initialize CCPP error handling variables @@ -83,16 +79,6 @@ subroutine rrtmgp_lw_rte_run(doLWrad, doLWclrsky, use_LW_jacobian, doGP_lwscat, if (.not. doLWrad) return - ! Vertical ordering? - top_at_1 = (p_lev(1,1) .lt. p_lev(1, nLev)) - if (top_at_1) then - iSFC = nLev+1 - iTOA = 1 - else - iSFC = 1 - iTOA = nLev+1 - endif - ! Initialize RRTMGP DDT containing 2D(3D) fluxes flux_allsky%bnd_flux_up => fluxLW_up_allsky flux_allsky%bnd_flux_dn => fluxLW_dn_allsky @@ -192,6 +178,10 @@ subroutine rrtmgp_lw_rte_run(doLWrad, doLWclrsky, use_LW_jacobian, doGP_lwscat, fluxlwUP_allsky = sum(flux_allsky%bnd_flux_up,dim=3) fluxlwDOWN_allsky = sum(flux_allsky%bnd_flux_dn,dim=3) + ! Save fluxes for coupling + fluxlwUP_radtime = fluxlwUP_allsky + fluxlwDOWN_radtime = fluxlwDOWN_allsky + end subroutine rrtmgp_lw_rte_run ! ######################################################################################### diff --git a/physics/rrtmgp_lw_rte.meta b/physics/rrtmgp_lw_rte.meta index bbf1bc62f..752251c43 100644 --- a/physics/rrtmgp_lw_rte.meta +++ b/physics/rrtmgp_lw_rte.meta @@ -2,7 +2,7 @@ name = rrtmgp_lw_rte type = scheme dependencies = machine.F,rte-rrtmgp/rte/mo_rte_lw.F90,rte-rrtmgp/rte/mo_fluxes.F90,rte-rrtmgp/rte/kernels/mo_fluxes_broadband_kernels.F90,radiation_tools.F90 - dependencies = rte-rrtmgp/rte/kernels/mo_rte_solver_kernels.F90,rte-rrtmgp/extensions/mo_fluxes_byband.F90,rte-rrtmgp/extensions/mo_fluxes_byband_kernels.F90 + dependencies = rte-rrtmgp/rte/kernels/mo_rte_solver_kernels.F90,rte-rrtmgp/extensions/mo_fluxes_byband.F90 ######################################################################## [ccpp-arg-table] @@ -57,13 +57,12 @@ dimensions = () type = integer intent = in -[p_lev] - standard_name = air_pressure_at_interface_for_RRTMGP - long_name = air pressure level - units = Pa - dimensions = (horizontal_loop_extent,vertical_interface_dimension) - type = real - kind = kind_phys +[top_at_1] + standard_name = flag_for_vertical_ordering_in_RRTMGP + long_name = flag for vertical ordering in RRTMGP + units = flag + dimensions = () + type = logical intent = in [sfc_emiss_byband] standard_name = surface_emissivity_in_each_RRTMGP_LW_band @@ -101,6 +100,22 @@ dimensions = () type = ty_source_func_lw intent = in +[fluxlwUP_radtime] + standard_name = RRTMGP_lw_flux_profile_upward_allsky_on_radiation_timestep + 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 = inout +[fluxlwDOWN_radtime] + standard_name = RRTMGP_lw_flux_profile_downward_allsky_on_radiation_timestep + 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 = inout [fluxlwUP_allsky] standard_name = RRTMGP_lw_flux_profile_upward_allsky long_name = RRTMGP upward longwave all-sky flux profile diff --git a/physics/rrtmgp_sw_aerosol_optics.F90 b/physics/rrtmgp_sw_aerosol_optics.F90 index 3a74771b7..afd039249 100644 --- a/physics/rrtmgp_sw_aerosol_optics.F90 +++ b/physics/rrtmgp_sw_aerosol_optics.F90 @@ -2,7 +2,7 @@ module rrtmgp_sw_aerosol_optics use machine, only: kind_phys use mo_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp use mo_optical_props, only: ty_optical_props_2str - use radiation_tools, only: check_error_msg + use radiation_tools, only: check_error_msg use rrtmgp_sw_gas_optics, only: sw_gas_props use rrtmgp_lw_gas_optics, only: lw_gas_props use module_radiation_aerosols, only: & @@ -62,7 +62,7 @@ subroutine rrtmgp_sw_aerosol_optics_run(doSWrad, nCol, nLev, nTracer, nTracerAer p_lev ! Pressure @ layer-interfaces (Pa) ! Outputs - real(kind_phys), dimension(:,:), intent(inout) :: & + real(kind_phys), dimension(:,:), intent(out) :: & aerodp ! Vertical integrated optical depth for various aerosol species type(ty_optical_props_2str),intent(out) :: & sw_optical_props_aerosol ! RRTMGP DDT: Longwave aerosol optical properties (tau) @@ -82,12 +82,12 @@ subroutine rrtmgp_sw_aerosol_optics_run(doSWrad, nCol, nLev, nTracer, nTracerAer errflg = 0 if (.not. doSWrad) return - if (nDay .gt. 0) then - ! Call module_radiation_aerosols::setaer(),to setup aerosols property profile - call setaer(p_lev/100., p_lay/100., p_lk, tv_lay, relhum, lsmask, tracer, aerfld, lon, lat, nCol, nLev, & - nLev+1, .true., .true., aerosolssw2, aerosolslw, aerodp) + ! Call module_radiation_aerosols::setaer(),to setup aerosols property profile + call setaer(p_lev/100., p_lay/100., p_lk, tv_lay, relhum, lsmask, tracer, aerfld, lon, lat, nCol, nLev, & + nLev+1, .true., .true., aerosolssw2, aerosolslw, aerodp) + if (nDay .gt. 0) then ! Store aerosol optical properties ! SW. ! For RRTMGP SW the bands are now ordered from [IR(band) -> nIR -> UV], in RRTMG the diff --git a/physics/rrtmgp_sw_aerosol_optics.meta b/physics/rrtmgp_sw_aerosol_optics.meta index 606b122b5..f56a54467 100644 --- a/physics/rrtmgp_sw_aerosol_optics.meta +++ b/physics/rrtmgp_sw_aerosol_optics.meta @@ -143,7 +143,7 @@ dimensions = (horizontal_loop_extent,number_of_species_for_aerosol_optical_depth) type = real kind = kind_phys - intent = inout + intent = out [sw_optical_props_aerosol] standard_name = shortwave_optical_properties_for_aerosols long_name = Fortran DDT containing RRTMGP optical properties diff --git a/physics/rrtmgp_sw_cloud_optics.F90 b/physics/rrtmgp_sw_cloud_optics.F90 index 0ab0c3361..f80440522 100644 --- a/physics/rrtmgp_sw_cloud_optics.F90 +++ b/physics/rrtmgp_sw_cloud_optics.F90 @@ -5,7 +5,7 @@ module rrtmgp_sw_cloud_optics use mo_optical_props, only: ty_optical_props_2str use mo_rrtmg_sw_cloud_optics, only: rrtmg_sw_cloud_optics use rrtmgp_sw_gas_optics, only: sw_gas_props - use radiation_tools, only: check_error_msg + use radiation_tools, only: check_error_msg use netcdf #ifdef MPI use mpi @@ -534,7 +534,7 @@ subroutine rrtmgp_sw_cloud_optics_run(doSWrad, doG_cldoptics, icliq_sw, icice_sw tau_cld, ssa_cld, asy_cld, & tau_precip, ssa_precip, asy_precip) - ! Cloud-optics (Need to reorder from G->GP band conventions) + ! Cloud-optics (Need to reorder from G->GP band conventions) sw_optical_props_cloudsByBand%tau(:,:,1) = tau_cld(:,:,sw_gas_props%get_nband()) sw_optical_props_cloudsByBand%ssa(:,:,1) = ssa_cld(:,:,sw_gas_props%get_nband()) sw_optical_props_cloudsByBand%g(:,:,1) = asy_cld(:,:,sw_gas_props%get_nband()) diff --git a/physics/rrtmgp_sw_cloud_optics.meta b/physics/rrtmgp_sw_cloud_optics.meta index eabd6fa7a..4856d44d5 100644 --- a/physics/rrtmgp_sw_cloud_optics.meta +++ b/physics/rrtmgp_sw_cloud_optics.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = rrtmgp_sw_cloud_optics type = scheme - dependencies = machine.F,physparam.f,rrtmg_sw_cloud_optics.F90,radiation_tools.F90 + dependencies = machine.F,rrtmg_sw_cloud_optics.F90,radiation_tools.F90 ######################################################################## [ccpp-arg-table] diff --git a/physics/rrtmgp_sw_cloud_sampling.F90 b/physics/rrtmgp_sw_cloud_sampling.F90 index b234ce41a..3172ae315 100644 --- a/physics/rrtmgp_sw_cloud_sampling.F90 +++ b/physics/rrtmgp_sw_cloud_sampling.F90 @@ -31,13 +31,13 @@ subroutine rrtmgp_sw_cloud_sampling_run(doSWrad, nCol, nDay, nLev, idxday, iovr, nCol, & ! Number of horizontal gridpoints nDay, & ! Number of daylit points. nLev, & ! Number of vertical layers - iovr, & ! Choice of cloud-overlap method - iovr_max, & ! Flag for maximum cloud overlap method - iovr_maxrand, & ! Flag for maximum-random cloud overlap method - iovr_rand, & ! Flag for random 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 + iovr, & ! Choice of cloud-overlap method + iovr_max, & ! Flag for maximum cloud overlap method + iovr_maxrand, & ! Flag for maximum-random cloud overlap method + iovr_rand, & ! Flag for random 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 isubc_sw integer,intent(in),dimension(ncol) :: & idxday ! Indices for daylit points. @@ -54,7 +54,7 @@ subroutine rrtmgp_sw_cloud_sampling_run(doSWrad, nCol, nDay, nLev, idxday, iovr, precip_overlap_param ! Precipitation overlap parameter type(ty_optical_props_2str),intent(in) :: & sw_optical_props_cloudsByBand, & ! RRTMGP DDT: Shortwave optical properties in each band (clouds) - sw_optical_props_precipByBand ! RRTMGP DDT: Shortwave optical properties in each band (precipitation) + sw_optical_props_precipByBand ! RRTMGP DDT: Shortwave optical properties in each band (precipitation) ! Outputs character(len=*), intent(out) :: & @@ -88,9 +88,6 @@ subroutine rrtmgp_sw_cloud_sampling_run(doSWrad, nCol, nDay, nLev, idxday, iovr, ! Allocate space RRTMGP DDTs [nday,nLev,nGpt] call check_error_msg('rrtmgp_sw_cloud_sampling_run', & sw_optical_props_clouds%alloc_2str(nday, nLev, sw_gas_props)) - sw_optical_props_clouds%tau(:,:,:) = 0._kind_phys - sw_optical_props_clouds%ssa(:,:,:) = 1._kind_phys - sw_optical_props_clouds%g(:,:,:) = 0._kind_phys ! Change random number seed value for each radiation invocation (isubc_sw =1 or 2). if(isubc_sw == 1) then ! advance prescribed permutation seed @@ -99,7 +96,7 @@ subroutine rrtmgp_sw_cloud_sampling_run(doSWrad, nCol, nDay, nLev, idxday, iovr, enddo elseif (isubc_sw == 2) then ! use input array of permutaion seeds do iday = 1, nday - ipseed_sw(iday) = icseed_sw(iday) + ipseed_sw(iday) = icseed_sw(idxday(iday)) enddo endif @@ -121,12 +118,6 @@ subroutine rrtmgp_sw_cloud_sampling_run(doSWrad, nCol, nDay, nLev, idxday, iovr, endif enddo - do iday=1,nday - call random_setseed(ipseed_sw(iday),rng_stat) - call random_number(rng2D,rng_stat) - rng3D(:,:,iday) = reshape(source = rng2D,shape=[sw_gas_props%get_ngpt(),nLev]) - enddo - ! Cloud overlap. ! Maximum-random, random, or maximum cloud overlap if (iovr == iovr_maxrand .or. iovr == iovr_max .or. iovr == iovr_rand) then @@ -164,26 +155,6 @@ subroutine rrtmgp_sw_cloud_sampling_run(doSWrad, nCol, nDay, nLev, idxday, iovr, ! Allocate space RRTMGP DDTs [nday,nLev,nGpt] call check_error_msg('rrtmgp_sw_cloud_sampling_run', & sw_optical_props_precip%alloc_2str( nday, nLev, sw_gas_props)) - - ! Change random number seed value for each radiation invocation (isubc_sw =1 or 2). - if(isubc_sw == 1) then ! advance prescribed permutation seed - do iday = 1, nday - ipseed_sw(iday) = sw_gas_props%get_ngpt() + iday - enddo - elseif (isubc_sw == 2) then ! use input array of permutaion seeds - do iday = 1, nday - ipseed_sw(iday) = icseed_sw(iday) - enddo - endif - - ! No need to call RNG second time for now, just use the same seeds for precip as clouds. - !! Call RNG. Mersennse Twister accepts 1D array, so loop over columns and collapse along G-points - !! and layers. ([nGpts,nLev,nDay]-> [nGpts*nLev]*nDay) - !do iday=1,nday - ! call random_setseed(ipseed_sw(iday),rng_stat) - ! call random_number(rng1D,rng_stat) - ! rng3D(:,:,iday) = reshape(source = rng1D,shape=[sw_gas_props%get_ngpt(),nLev]) - !enddo ! Precipitation overlap ! Maximum-random, random or maximum precipitation overlap @@ -192,12 +163,6 @@ subroutine rrtmgp_sw_cloud_sampling_run(doSWrad, nCol, nDay, nLev, idxday, iovr, endif ! Exponential decorrelation length overlap if (iovr == iovr_dcorr) then - !! Generate second RNG - !do iday=1,nday - ! call random_setseed(ipseed_sw(iday),rng_stat) - ! call random_number(rng1D,rng_stat) - ! rng3D2(:,:,iday) = reshape(source = rng1D,shape=[sw_gas_props%get_ngpt(),nLev]) - !enddo call sampled_mask(rng3D, precip_frac(idxday(1:nDay),:), precipfracSAMP, & overlap_param = precip_overlap_param(idxday(1:nDay),1:nLev-1),& randoms2 = rng3D2) diff --git a/physics/rrtmgp_sw_cloud_sampling.meta b/physics/rrtmgp_sw_cloud_sampling.meta index 6c24b39bc..23f8fa031 100644 --- a/physics/rrtmgp_sw_cloud_sampling.meta +++ b/physics/rrtmgp_sw_cloud_sampling.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = rrtmgp_sw_cloud_sampling type = scheme - dependencies = machine.F,mersenne_twister.f,physparam.f,rrtmgp_sampling.F90,radiation_tools.F90 + dependencies = machine.F,mersenne_twister.f,rrtmgp_sampling.F90,radiation_tools.F90 ###################################################### [ccpp-arg-table] diff --git a/physics/rrtmgp_sw_gas_optics.F90 b/physics/rrtmgp_sw_gas_optics.F90 index 146d87191..260f65fe7 100644 --- a/physics/rrtmgp_sw_gas_optics.F90 +++ b/physics/rrtmgp_sw_gas_optics.F90 @@ -79,17 +79,14 @@ module rrtmgp_sw_gas_optics !! \section arg_table_rrtmgp_sw_gas_optics_init !! \htmlinclude rrtmgp_sw_gas_optics.html !! - subroutine rrtmgp_sw_gas_optics_init(nCol, nLev, nThreads, rrtmgp_root_dir, & - rrtmgp_sw_file_gas, active_gases_array, mpicomm, mpirank, mpiroot, errmsg, errflg) + 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 coefficients used to compute gaseous optical properties integer,intent(in) :: & - nCol, & ! Number of horizontal gridpoints. - nLev, & ! Number of vertical levels. - nThreads, & ! Number of openMP threads mpicomm, & ! MPI communicator mpirank, & ! Current MPI rank mpiroot ! Master MPI rank @@ -543,7 +540,6 @@ subroutine rrtmgp_sw_gas_optics_run(doSWrad, nCol, nLev, ngptsGPsw, nday, idxday toa_src_sw(:,:) = 0._kind_phys if (nDay .gt. 0) then - !active_gases = gas_concentrations%get_gas_names() ! Allocate space call check_error_msg('rrtmgp_sw_gas_optics_run_alloc_2str',& sw_optical_props_clrsky%alloc_2str(nday, nLev, sw_gas_props)) diff --git a/physics/rrtmgp_sw_gas_optics.meta b/physics/rrtmgp_sw_gas_optics.meta index 36b1c9325..5bcfe6cb2 100644 --- a/physics/rrtmgp_sw_gas_optics.meta +++ b/physics/rrtmgp_sw_gas_optics.meta @@ -7,27 +7,6 @@ [ccpp-arg-table] name = rrtmgp_sw_gas_optics_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 -[nThreads] - standard_name = number_of_openmp_threads - long_name = number of OpenMP threads available to scheme - units = count - dimensions = () - type = integer - intent = in [rrtmgp_root_dir] standard_name = directory_for_rte_rrtmgp_source_code long_name = directory for rte+rrtmgp source code diff --git a/physics/rrtmgp_sw_rte.F90 b/physics/rrtmgp_sw_rte.F90 index f28e94b0f..1726d4bbd 100644 --- a/physics/rrtmgp_sw_rte.F90 +++ b/physics/rrtmgp_sw_rte.F90 @@ -1,14 +1,10 @@ module rrtmgp_sw_rte use machine, only: kind_phys - use mo_rte_kind, only: wl - use mo_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp - use mo_cloud_optics, only: ty_cloud_optics use mo_optical_props, only: ty_optical_props_2str use mo_rte_sw, only: rte_sw - use mo_gas_concentrations, only: ty_gas_concs use mo_fluxes_byband, only: ty_fluxes_byband use module_radsw_parameters, only: cmpfsw_type - use radiation_tools, only: check_error_msg + use radiation_tools, only: check_error_msg use rrtmgp_sw_gas_optics, only: sw_gas_props implicit none @@ -29,19 +25,21 @@ end subroutine rrtmgp_sw_rte_init !! \htmlinclude rrtmgp_sw_rte.html !! subroutine rrtmgp_sw_rte_run(doSWrad, doSWclrsky, nCol, nLev, nDay, idxday, coszen, p_lay, & - t_lay, p_lev, sw_optical_props_clrsky, sfc_alb_nir_dir, sfc_alb_nir_dif, & + t_lay, top_at_1, iSFC, sw_optical_props_clrsky, sfc_alb_nir_dir, sfc_alb_nir_dif, & sfc_alb_uvvis_dir, sfc_alb_uvvis_dif, toa_src_sw, sw_optical_props_clouds, & sw_optical_props_aerosol, scmpsw, fluxswUP_allsky, fluxswDOWN_allsky, fluxswUP_clrsky,& fluxswDOWN_clrsky, errmsg, errflg) ! Inputs logical, intent(in) :: & + top_at_1, & ! Vertical ordering flag doSWrad, & ! Flag to calculate SW irradiances doSWclrsky ! Compute clear-sky fluxes? integer, intent(in) :: & nCol, & ! Number of horizontal gridpoints nday, & ! Number of daytime points - nLev ! Number of vertical levels + nLev, & ! Number of vertical levels + iSFC ! Vertical index for surface-level integer, intent(in), dimension(ncol) :: & idxday ! Index array for daytime points real(kind_phys),intent(in), dimension(ncol) :: & @@ -49,8 +47,6 @@ subroutine rrtmgp_sw_rte_run(doSWrad, doSWclrsky, nCol, nLev, nDay, idxday, cosz real(kind_phys), dimension(ncol,NLev), intent(in) :: & p_lay, & ! Pressure @ model layer-centers (Pa) t_lay ! Temperature (K) - real(kind_phys), dimension(ncol,NLev+1), intent(in) :: & - p_lev ! Pressure @ model layer-interfaces (Pa) type(ty_optical_props_2str),intent(inout) :: & sw_optical_props_clrsky ! RRTMGP DDT: shortwave clear-sky radiative properties type(ty_optical_props_2str),intent(in) :: & @@ -74,9 +70,7 @@ subroutine rrtmgp_sw_rte_run(doSWrad, doSWclrsky, nCol, nLev, nDay, idxday, cosz fluxswDOWN_allsky, & ! RRTMGP downward all-sky flux profiles (W/m2) fluxswUP_clrsky, & ! RRTMGP upward clear-sky flux profiles (W/m2) fluxswDOWN_clrsky ! RRTMGP downward clear-sky flux profiles (W/m2) - - ! Outputs (optional) - type(cmpfsw_type), dimension(ncol), intent(inout),optional :: & + type(cmpfsw_type), dimension(ncol), intent(inout) :: & scmpsw ! 2D surface fluxes, components: ! uvbfc - total sky downward uv-b flux (W/m2) ! uvbf0 - clear sky downward uv-b flux (W/m2) @@ -94,8 +88,7 @@ subroutine rrtmgp_sw_rte_run(doSWrad, doSWclrsky, nCol, nLev, nDay, idxday, cosz real(kind_phys), dimension(nday,NLev+1,sw_gas_props%get_nband()),target :: & fluxSW_up_allsky, fluxSW_up_clrsky, fluxSW_dn_allsky, fluxSW_dn_clrsky, fluxSW_dn_dir_allsky real(kind_phys), dimension(ncol,NLev) :: vmrTemp - logical :: l_scmpsw=.false., top_at_1 - integer :: iGas,iSFC,iTOA,iBand + integer :: iBand ! Initialize CCPP error handling variables errmsg = '' @@ -103,36 +96,9 @@ subroutine rrtmgp_sw_rte_run(doSWrad, doSWclrsky, nCol, nLev, nDay, idxday, cosz if (.not. doSWrad) return - ! Initialize output fluxes - fluxswUP_allsky(:,:) = 0._kind_phys - fluxswDOWN_allsky(:,:) = 0._kind_phys - fluxswUP_clrsky(:,:) = 0._kind_phys - fluxswDOWN_clrsky(:,:) = 0._kind_phys - if (nDay .gt. 0) then - ! Vertical ordering? - top_at_1 = (p_lev(1,1) .lt. p_lev(1, NLev)) - if (top_at_1) then - iSFC = NLev+1 - iTOA = 1 - else - iSFC = 1 - iTOA = NLev+1 - endif - - ! Are any optional outputs requested? Need to know now to compute correct fluxes. - l_scmpsw = present(scmpsw) - if ( l_scmpsw ) then - scmpsw = cmpfsw_type (0., 0., 0., 0., 0., 0.) - endif - ! Initialize RRTMGP DDT containing 2D(3D) fluxes - 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 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 @@ -190,11 +156,15 @@ subroutine rrtmgp_sw_rte_run(doSWrad, doSWclrsky, nCol, nLev, nDay, idxday, cosz ! Store fluxes fluxswUP_allsky(idxday(1:nday),:) = sum(flux_allsky%bnd_flux_up,dim=3) fluxswDOWN_allsky(idxday(1:nday),:) = sum(flux_allsky%bnd_flux_dn,dim=3) - if ( l_scmpsw ) then - scmpsw(idxday(1:nday))%nirbm = sum(flux_allsky%bnd_flux_dn_dir(1:nday,iSFC,:),dim=2) - scmpsw(idxday(1:nday))%nirdf = sum(flux_allsky%bnd_flux_dn(1:nday,iSFC,:),dim=2) - & - sum(flux_allsky%bnd_flux_dn_dir(1:nday,iSFC,:),dim=2) - endif + scmpsw(idxday(1:nday))%nirbm = sum(flux_allsky%bnd_flux_dn_dir(1:nday,iSFC,:),dim=2) + scmpsw(idxday(1:nday))%nirdf = sum(flux_allsky%bnd_flux_dn( 1:nday,iSFC,:),dim=2) - & + sum(flux_allsky%bnd_flux_dn_dir(1:nday,iSFC,:),dim=2) + else + fluxswUP_allsky(:,:) = 0._kind_phys + fluxswDOWN_allsky(:,:) = 0._kind_phys + fluxswUP_clrsky(:,:) = 0._kind_phys + fluxswDOWN_clrsky(:,:) = 0._kind_phys + scmpsw = cmpfsw_type( 0.0, 0.0, 0.0, 0.0, 0.0, 0.0 ) endif end subroutine rrtmgp_sw_rte_run diff --git a/physics/rrtmgp_sw_rte.meta b/physics/rrtmgp_sw_rte.meta index 0fefc39c7..995a5626a 100644 --- a/physics/rrtmgp_sw_rte.meta +++ b/physics/rrtmgp_sw_rte.meta @@ -2,7 +2,7 @@ name = rrtmgp_sw_rte type = scheme dependencies = machine.F,radsw_param.f,rte-rrtmgp/rte/mo_rte_sw.F90,rte-rrtmgp/rte/mo_fluxes.F90,rte-rrtmgp/rte/kernels/mo_fluxes_broadband_kernels.F90,radiation_tools.F90 - dependencies = rte-rrtmgp/rte/kernels/mo_rte_solver_kernels.F90,rte-rrtmgp/extensions/mo_fluxes_byband.F90,rte-rrtmgp/extensions/mo_fluxes_byband_kernels.F90 + dependencies = rte-rrtmgp/rte/kernels/mo_rte_solver_kernels.F90,rte-rrtmgp/extensions/mo_fluxes_byband.F90 ######################################################################## [ccpp-arg-table] @@ -66,13 +66,19 @@ type = real kind = kind_phys intent = in -[p_lev] - standard_name = air_pressure_at_interface_for_RRTMGP - long_name = air pressure level - units = Pa - dimensions = (horizontal_loop_extent,vertical_interface_dimension) - type = real - kind = kind_phys +[top_at_1] + standard_name = flag_for_vertical_ordering_in_RRTMGP + long_name = flag for vertical ordering in RRTMGP + units = flag + dimensions = () + type = logical + 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 [t_lay] standard_name = air_temperature_at_layer_for_RRTMGP @@ -120,7 +126,7 @@ kind = kind_phys intent = in [sfc_alb_uvvis_dir] - standard_name = surface_albedo_uvvis_dir + standard_name = surface_albedo_uvvis_direct long_name = UVVIS (direct) surface albedo (sfc_alb_uvvis_dir) units = none dimensions = (number_of_shortwave_bands,horizontal_loop_extent) @@ -128,7 +134,7 @@ kind = kind_phys intent = in [sfc_alb_uvvis_dif] - standard_name = surface_albedo_uvvis_dif + standard_name = surface_albedo_uvvis_diffuse long_name = UVVIS (diffuse) surface albedo (sfc_alb_uvvis_dif) units = none dimensions = (number_of_shortwave_bands,horizontal_loop_extent) diff --git a/physics/rte-rrtmgp b/physics/rte-rrtmgp index 9c51cb7c3..cec1e8e12 160000 --- a/physics/rte-rrtmgp +++ b/physics/rte-rrtmgp @@ -1 +1 @@ -Subproject commit 9c51cb7c3e227c9e84c2bff29ce4f438c7a54ae6 +Subproject commit cec1e8e12d969c3c8c76574dbe4f40b366419cc7 diff --git a/physics/satmedmfvdif.meta b/physics/satmedmfvdif.meta index be9aa23fe..9eff692d8 100644 --- a/physics/satmedmfvdif.meta +++ b/physics/satmedmfvdif.meta @@ -499,7 +499,7 @@ [dtend] standard_name = cumulative_change_of_state_variables long_name = diagnostic tendencies for state variables - units = various + units = mixed dimensions = (horizontal_loop_extent,vertical_layer_dimension,cumulative_change_of_state_variables_outer_index_max) type = real kind = kind_phys diff --git a/physics/satmedmfvdifq.meta b/physics/satmedmfvdifq.meta index 153a81bd4..d6fb95715 100644 --- a/physics/satmedmfvdifq.meta +++ b/physics/satmedmfvdifq.meta @@ -583,7 +583,7 @@ [dtend] standard_name = cumulative_change_of_state_variables long_name = diagnostic tendencies for state variables - units = various + units = mixed dimensions = (horizontal_loop_extent,vertical_layer_dimension,cumulative_change_of_state_variables_outer_index_max) type = real kind = kind_phys diff --git a/physics/sfc_diag_post.F90 b/physics/sfc_diag_post.F90 index 1bf3e7e67..6f14fe93d 100644 --- a/physics/sfc_diag_post.F90 +++ b/physics/sfc_diag_post.F90 @@ -16,7 +16,7 @@ end subroutine sfc_diag_post_finalize !! #endif subroutine sfc_diag_post_run (im, lsm, lsm_noahmp, dry, lssav, dtf, con_eps, con_epsm1, pgr,& - t2mmp, q2mp, t2m, q2m, u10m, v10m, tmpmin, tmpmax, spfhmin, spfhmax,& + t2m, q2m, u10m, v10m, tmpmin, tmpmax, spfhmin, spfhmax, & wind10mmax, u10mmax, v10mmax, dpt2m, errmsg, errflg) use machine, only: kind_phys @@ -28,7 +28,6 @@ subroutine sfc_diag_post_run (im, lsm, lsm_noahmp, dry, lssav, dtf, con_eps, con 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(in) :: t2mmp, q2mp real(kind=kind_phys), dimension(:), intent(inout) :: t2m, q2m, tmpmin, tmpmax, spfhmin, spfhmax real(kind=kind_phys), dimension(:), intent(inout) :: wind10mmax, u10mmax, v10mmax, dpt2m @@ -42,15 +41,6 @@ subroutine sfc_diag_post_run (im, lsm, lsm_noahmp, dry, lssav, dtf, con_eps, con errmsg = '' errflg = 0 - if (lsm == lsm_noahmp) then - do i=1,im - if(dry(i)) then - t2m(i) = t2mmp(i) - q2m(i) = q2mp(i) - endif - enddo - endif - if (lssav) then do i=1,im tmpmax(i) = max(tmpmax(i),t2m(i)) diff --git a/physics/sfc_diag_post.meta b/physics/sfc_diag_post.meta index d66a468fa..21d76a147 100644 --- a/physics/sfc_diag_post.meta +++ b/physics/sfc_diag_post.meta @@ -74,22 +74,6 @@ type = real kind = kind_phys intent = in -[t2mmp] - standard_name = temperature_at_2m_from_noahmp - long_name = 2 meter temperature from noahmp - units = K - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in -[q2mp] - standard_name = specific_humidity_at_2m_from_noahmp - long_name = 2 meter specific humidity from noahmp - units = kg kg-1 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in [t2m] standard_name = air_temperature_at_2m long_name = 2 meter temperature diff --git a/physics/sfc_noahmp_drv.F90 b/physics/sfc_noahmp_drv.F90 index 3ac72a4fa..7ef542f42 100644 --- a/physics/sfc_noahmp_drv.F90 +++ b/physics/sfc_noahmp_drv.F90 @@ -107,18 +107,19 @@ subroutine noahmpdrv_run & ! --- inputs: ( im, km, lsnowl, itime, ps, u1, v1, t1, q1, soiltyp, & vegtype, sigmaf, dlwflx, dswsfc, snet, delt, tg3, cm, ch, & - prsl1, prslki, zf, dry, wind, slopetyp, & - shdmin, shdmax, snoalb, sfalb, flag_iter, flag_guess, & + prsl1, prslk1, prslki, prsik1, zf, dry, wind, slopetyp, & + shdmin, shdmax, snoalb, sfalb, flag_iter,con_g, & idveg, iopt_crs, iopt_btr, iopt_run, iopt_sfc, iopt_frz, & iopt_inf, iopt_rad, iopt_alb, iopt_snf, iopt_tbot, & - iopt_stc, xlatin, xcoszin, iyrlen, julian, & + iopt_stc, xlatin, xcoszin, iyrlen, julian, garea, & rainn_mp, rainc_mp, snow_mp, graupel_mp, ice_mp, & con_hvap, con_cp, con_jcal, rhoh2o, con_eps, con_epsm1, & - con_fvirt, con_rd, con_hfus, & + con_fvirt, con_rd, con_hfus, thsfc_loc, & ! --- in/outs: weasd, snwdph, tskin, tprcp, srflag, smc, stc, slc, & - canopy, trans, tsurf, zorl, & + canopy, trans, zorl, & + rb1, fm1, fh1, ustar1, stress1, fm101, fh21, & ! --- Noah MP specific @@ -131,30 +132,33 @@ subroutine noahmpdrv_run & ! --- outputs: sncovr1, qsurf, gflux, drain, evap, hflx, ep, runoff, & - cmm, chh, evbs, evcw, sbsno, snowc, stm, snohf, & - smcwlt2, smcref2, wet1, t2mmp, q2mp, errmsg, errflg) + cmm, chh, evbs, evcw, sbsno, pah, ecan, etran, edir, snowc,& + stm, snohf,smcwlt2, smcref2, wet1, t2mmp, q2mp,zvfun, & + errmsg, errflg) use machine , only : kind_phys use funcphys, only : fpvs + use sfc_diff, only : stability use module_sf_noahmplsm use module_sf_noahmp_glacier - use noahmp_tables, only : isice_table, co2_table, o2_table, & - isurban_table,smcref_table,smcdry_table, & - smcmax_table,co2_table,o2_table, & - saim_table,laim_table + use noahmp_tables, only : isice_table, co2_table, o2_table, & + isurban_table, smcref_table, smcdry_table, & + smcmax_table, co2_table, o2_table, & + saim_table, laim_table implicit none - real(kind=kind_phys), parameter :: a2 = 17.2693882 - real(kind=kind_phys), parameter :: a3 = 273.16 - real(kind=kind_phys), parameter :: a4 = 35.86 - real(kind=kind_phys), parameter :: a23m4 = a2*(a3-a4) + real(kind=kind_phys), parameter :: a2 = 17.2693882 + real(kind=kind_phys), parameter :: a3 = 273.16 + real(kind=kind_phys), parameter :: a4 = 35.86 + real(kind=kind_phys), parameter :: a23m4 = a2*(a3-a4) + real(kind=kind_phys), intent(in) :: con_g - real, parameter :: undefined = 9.99e20_kind_phys + real, parameter :: undefined = 9.99e20_kind_phys - integer, parameter :: nsoil = 4 ! hardwired to Noah - integer, parameter :: nsnow = 3 ! max. snow layers + integer, parameter :: nsoil = 4 ! hardwired to Noah + integer, parameter :: nsnow = 3 ! max. snow layers real(kind=kind_phys), save :: zsoil(nsoil) data zsoil / -0.1, -0.4, -1.0, -2.0 / @@ -180,10 +184,14 @@ subroutine noahmpdrv_run & real(kind=kind_phys), dimension(:) , intent(in) :: snet ! total sky sfc netsw flx into ground[W/m2] real(kind=kind_phys) , intent(in) :: delt ! time interval [s] real(kind=kind_phys), dimension(:) , intent(in) :: tg3 ! deep soil temperature [K] - real(kind=kind_phys), dimension(:) , intent(in) :: cm ! surface exchange coeff for momentum [-] - real(kind=kind_phys), dimension(:) , intent(in) :: ch ! surface exchange coeff heat & moisture[-] + real(kind=kind_phys), dimension(:) , intent(inout) :: cm ! surface exchange coeff for momentum [-] + real(kind=kind_phys), dimension(:) , intent(inout) :: ch ! surface exchange coeff heat & moisture[-] real(kind=kind_phys), dimension(:) , intent(in) :: prsl1 ! sfc layer 1 mean pressure [Pa] - real(kind=kind_phys), dimension(:) , intent(in) :: prslki ! to calculate potential temperature + real(kind=kind_phys), dimension(:) , intent(in) :: prslk1 ! exner_function_at lowest model layer + + real(kind=kind_phys), dimension(:) , intent(in) :: prslki ! Exner function bt midlayer and interface at 1st layer + real(kind=kind_phys), dimension(:) , intent(in) :: prsik1 ! Exner function at the ground surfac + real(kind=kind_phys), dimension(:) , intent(in) :: zf ! height of bottom layer [m] logical , dimension(:) , intent(in) :: dry ! = T if a point with any land real(kind=kind_phys), dimension(:) , intent(in) :: wind ! wind speed [m/s] @@ -193,7 +201,6 @@ subroutine noahmpdrv_run & real(kind=kind_phys), dimension(:) , intent(in) :: snoalb ! upper bound on max albedo over deep snow real(kind=kind_phys), dimension(:) , intent(inout) :: sfalb ! mean surface albedo [fraction] logical , dimension(:) , intent(in) :: flag_iter ! - logical , dimension(:) , intent(in) :: flag_guess ! integer , intent(in) :: idveg ! option for dynamic vegetation integer , intent(in) :: iopt_crs ! option for canopy stomatal resistance integer , intent(in) :: iopt_btr ! option for soil moisture factor for stomatal resistance @@ -210,6 +217,7 @@ subroutine noahmpdrv_run & real(kind=kind_phys), dimension(:) , intent(in) :: xcoszin ! cosine of zenith angle integer , intent(in) :: iyrlen ! year length [days] real(kind=kind_phys) , intent(in) :: julian ! julian day of year + real(kind=kind_phys), dimension(:) , intent(in) :: garea ! area of the grid cell real(kind=kind_phys), dimension(:) , intent(in) :: rainn_mp ! microphysics non-convective precipitation [mm] real(kind=kind_phys), dimension(:) , intent(in) :: rainc_mp ! microphysics convective precipitation [mm] real(kind=kind_phys), dimension(:) , intent(in) :: snow_mp ! microphysics snow [mm] @@ -224,6 +232,9 @@ subroutine noahmpdrv_run & real(kind=kind_phys) , intent(in) :: con_fvirt ! Rv/Rd - 1 real(kind=kind_phys) , intent(in) :: con_rd ! gas constant air [J/kg/K] real(kind=kind_phys) , intent(in) :: con_hfus ! lat heat H2O fusion [J/kg] + + logical , intent(in) :: thsfc_loc ! Flag for reference pressure in theta calculation + real(kind=kind_phys), dimension(:) , intent(inout) :: weasd ! water equivalent accumulated snow depth [mm] real(kind=kind_phys), dimension(:) , intent(inout) :: snwdph ! snow depth [mm] real(kind=kind_phys), dimension(:) , intent(inout) :: tskin ! ground surface skin temperature [K] @@ -234,8 +245,16 @@ subroutine noahmpdrv_run & real(kind=kind_phys), dimension(:,:) , intent(inout) :: slc ! liquid soil moisture [m3/m3] real(kind=kind_phys), dimension(:) , intent(inout) :: canopy ! canopy moisture content [mm] real(kind=kind_phys), dimension(:) , intent(inout) :: trans ! total plant transpiration [m/s] - real(kind=kind_phys), dimension(:) , intent(inout) :: tsurf ! surface skin temperature [after iteration] real(kind=kind_phys), dimension(:) , intent(inout) :: zorl ! surface roughness [cm] + + real(kind=kind_phys), dimension(:) , intent(inout) :: rb1 ! bulk richardson # + real(kind=kind_phys), dimension(:) , intent(inout) :: fm1 ! Monin_Obukhov_silarity_function for momentum + real(kind=kind_phys), dimension(:) , intent(inout) :: fh1 ! Monin_Obukhov_silarity_function for heat + real(kind=kind_phys), dimension(:) , intent(inout) :: ustar1 ! friction velocity m s-1 + real(kind=kind_phys), dimension(:) , intent(inout) :: stress1 ! Wind stress m2 S-2 + real(kind=kind_phys), dimension(:) , intent(inout) :: fm101 ! MOS function for momentum evaulated @ 10 m + real(kind=kind_phys), dimension(:) , intent(inout) :: fh21 ! MOS function for heat evaulated @ 2m + real(kind=kind_phys), dimension(:) , intent(inout) :: snowxy ! actual no. of snow layers real(kind=kind_phys), dimension(:) , intent(inout) :: tvxy ! vegetation leaf temperature [K] real(kind=kind_phys), dimension(:) , intent(inout) :: tgxy ! bulk ground surface temperature [K] @@ -288,6 +307,10 @@ subroutine noahmpdrv_run & real(kind=kind_phys), dimension(:) , intent(out) :: evbs ! direct soil evaporation [m/s] real(kind=kind_phys), dimension(:) , intent(out) :: evcw ! canopy water evaporation [m/s] real(kind=kind_phys), dimension(:) , intent(out) :: sbsno ! sublimation/deposit from snopack [W/m2] + real(kind=kind_phys), dimension(:) , intent(out) :: pah ! precipitation advected heat - total (w/m2) + real(kind=kind_phys), dimension(:) , intent(out) :: ecan ! evaporation of intercepted water (mm/s) + real(kind=kind_phys), dimension(:) , intent(out) :: etran ! transpiration rate (mm/s) + real(kind=kind_phys), dimension(:) , intent(out) :: edir ! soil surface evaporation rate (mm/s) real(kind=kind_phys), dimension(:) , intent(out) :: snowc ! fractional snow cover [-] real(kind=kind_phys), dimension(:) , intent(out) :: stm ! total soil column moisture content [mm] real(kind=kind_phys), dimension(:) , intent(out) :: snohf ! snow/freezing-rain latent heat flux [W/m2] @@ -296,6 +319,7 @@ subroutine noahmpdrv_run & real(kind=kind_phys), dimension(:) , intent(out) :: wet1 ! normalized surface soil saturated fraction real(kind=kind_phys), dimension(:) , intent(out) :: t2mmp ! combined T2m from tiles real(kind=kind_phys), dimension(:) , intent(out) :: q2mp ! combined q2m from tiles + real(kind=kind_phys), dimension(:) , intent(out) :: zvfun ! character(len=*) , intent(out) :: errmsg integer , intent(out) :: errflg @@ -309,53 +333,6 @@ subroutine noahmpdrv_run & integer :: iopt_crop = 0 ! option for crop model integer :: iopt_gla = 2 ! option for glacier treatment -! -! --- guess iteration fields - target for removal -! - - real(kind=kind_phys), dimension(im) :: weasd_old - real(kind=kind_phys), dimension(im) :: snwdph_old - real(kind=kind_phys), dimension(im) :: tskin_old - real(kind=kind_phys), dimension(im) :: canopy_old - real(kind=kind_phys), dimension(im) :: tprcp_old - real(kind=kind_phys), dimension(im) :: srflag_old - real(kind=kind_phys), dimension(im) :: snow_old - real(kind=kind_phys), dimension(im) :: tv_old - real(kind=kind_phys), dimension(im) :: tg_old - real(kind=kind_phys), dimension(im) :: canice_old - real(kind=kind_phys), dimension(im) :: canliq_old - real(kind=kind_phys), dimension(im) :: eah_old - real(kind=kind_phys), dimension(im) :: tah_old - real(kind=kind_phys), dimension(im) :: fwet_old - real(kind=kind_phys), dimension(im) :: sneqvo_old - real(kind=kind_phys), dimension(im) :: albold_old - real(kind=kind_phys), dimension(im) :: qsnow_old - real(kind=kind_phys), dimension(im) :: wslake_old - real(kind=kind_phys), dimension(im) :: zwt_old - real(kind=kind_phys), dimension(im) :: wa_old - real(kind=kind_phys), dimension(im) :: wt_old - real(kind=kind_phys), dimension(im) :: lfmass_old - real(kind=kind_phys), dimension(im) :: rtmass_old - real(kind=kind_phys), dimension(im) :: stmass_old - real(kind=kind_phys), dimension(im) :: wood_old - real(kind=kind_phys), dimension(im) :: stblcp_old - real(kind=kind_phys), dimension(im) :: fastcp_old - real(kind=kind_phys), dimension(im) :: xlai_old - real(kind=kind_phys), dimension(im) :: xsai_old - real(kind=kind_phys), dimension(im) :: tauss_old - real(kind=kind_phys), dimension(im) :: smcwtd_old - real(kind=kind_phys), dimension(im) :: rech_old - real(kind=kind_phys), dimension(im) :: deeprech_old - real(kind=kind_phys), dimension(im, km) :: smc_old - real(kind=kind_phys), dimension(im, km) :: stc_old - real(kind=kind_phys), dimension(im, km) :: slc_old - real(kind=kind_phys), dimension(im, km) :: smoiseq_old - real(kind=kind_phys), dimension(im,lsnowl: 0) :: tsno_old - real(kind=kind_phys), dimension(im,lsnowl: 0) :: snice_old - real(kind=kind_phys), dimension(im,lsnowl: 0) :: snliq_old - real(kind=kind_phys), dimension(im,lsnowl:km) :: zsnso_old - real(kind=kind_phys), dimension(im,lsnowl:km) :: tsnso_old - ! ! --- local inputs to noah-mp and glacier subroutines; listed in order in noah-mp call ! @@ -373,6 +350,7 @@ subroutine noahmpdrv_run & real (kind=kind_phys), dimension( 1:nsoil) :: soil_interface_depth ! in | soil layer-bottom depth from surface [m] integer :: max_snow_levels ! in | maximum number of snow levels real (kind=kind_phys) :: vegetation_frac ! in | vegetation fraction [0.0-1.0] + real (kind=kind_phys) :: area_grid ! in | real (kind=kind_phys) :: max_vegetation_frac ! in | annual maximum vegetation fraction [0.0-1.0] integer :: vegetation_category ! in | vegetation category integer :: ice_flag ! in | ice flag (1->ice) @@ -406,6 +384,9 @@ subroutine noahmpdrv_run & real (kind=kind_phys), dimension(-nsnow+1:nsoil) :: temperature_snow_soil ! inout | snow/soil temperature [K] real (kind=kind_phys), dimension( 1:nsoil) :: soil_liquid_vol ! inout | volumetric liquid soil moisture [m3/m3] real (kind=kind_phys), dimension( 1:nsoil) :: soil_moisture_vol ! inout | volumetric soil moisture (ice + liq.) [m3/m3] + + real (kind=kind_phys) :: surface_temperature ! out | surface aerodynamic temp + real (kind=kind_phys) :: temperature_canopy_air! inout | canopy air tmeperature [K] real (kind=kind_phys) :: vapor_pres_canopy_air ! inout | canopy air vapor pressure [Pa] real (kind=kind_phys) :: canopy_wet_fraction ! inout | wetted or snowed fraction of canopy (-) @@ -444,6 +425,8 @@ subroutine noahmpdrv_run & real (kind=kind_phys) :: deep_recharge ! inout | (opt_run=5) recharge to or from the water table when deep [m] real (kind=kind_phys) :: recharge ! inout | (opt_run=5) recharge to or from the water table when shallow [m] (diagnostic) real (kind=kind_phys) :: z0_total ! out | weighted z0 sent to coupled model [m] + real (kind=kind_phys) :: z0h_total ! out | weighted z0h sent to coupled model [m] + real (kind=kind_phys) :: sw_absorbed_total ! out | total absorbed solar radiation [W/m2] real (kind=kind_phys) :: sw_reflected_total ! out | total reflected solar radiation [W/m2] real (kind=kind_phys) :: lw_absorbed_total ! out | total net lw rad [W/m2] [+ to atm] @@ -515,6 +498,11 @@ subroutine noahmpdrv_run & real (kind=kind_phys) :: lai_shaded ! out | shaded leaf area index [m2/m2] real (kind=kind_phys) :: leaf_air_resistance ! out | leaf boundary layer resistance [s/m] + 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 + real (kind=kind_phys) :: prslk1x ! in exner function + ! ! --- local variable ! @@ -534,6 +522,13 @@ subroutine noahmpdrv_run & real (kind=kind_phys) :: dqsdt ! used for penman calculation real (kind=kind_phys) :: precip_freeze_frac_in ! used for penman calculation + real (kind=kind_phys) :: virtfac1 ! virtual factor + real (kind=kind_phys) :: tvs1 ! surface virtual temp + real (kind=kind_phys) :: vptemp ! virtual potential temp + + real(kind=kind_phys) :: tem1,tem2,gdx + real(kind=kind_phys), parameter :: z0lo=0.1, z0up=1.0 + logical :: is_snowing ! used for penman calculation logical :: is_freeze_rain ! used for penman calculation integer :: i, k @@ -554,67 +549,7 @@ subroutine noahmpdrv_run & errmsg = '' errflg = 0 -! -! --- save land-related prognostic fields for guess run TARGET FOR REMOVAL -! - do i = 1, im - if (dry(i) .and. flag_guess(i)) then - weasd_old(i) = weasd(i) - snwdph_old(i) = snwdph(i) - tskin_old(i) = tskin(i) - canopy_old(i) = canopy(i) - tprcp_old(i) = tprcp(i) - srflag_old(i) = srflag(i) - snow_old(i) = snowxy(i) - tv_old(i) = tvxy(i) - tg_old(i) = tgxy(i) - canice_old(i) = canicexy(i) - canliq_old(i) = canliqxy(i) - eah_old(i) = eahxy(i) - tah_old(i) = tahxy(i) - fwet_old(i) = fwetxy(i) - sneqvo_old(i) = sneqvoxy(i) - albold_old(i) = alboldxy(i) - qsnow_old(i) = qsnowxy(i) - wslake_old(i) = wslakexy(i) - zwt_old(i) = zwtxy(i) - wa_old(i) = waxy(i) - wt_old(i) = wtxy(i) - lfmass_old(i) = lfmassxy(i) - rtmass_old(i) = rtmassxy(i) - stmass_old(i) = stmassxy(i) - wood_old(i) = woodxy(i) - stblcp_old(i) = stblcpxy(i) - fastcp_old(i) = fastcpxy(i) - xlai_old(i) = xlaixy(i) - xsai_old(i) = xsaixy(i) - tauss_old(i) = taussxy(i) - smcwtd_old(i) = smcwtdxy(i) - rech_old(i) = rechxy(i) - deeprech_old(i) = deeprechxy(i) - - do k = 1, km - smc_old(i,k) = smc(i,k) - stc_old(i,k) = stc(i,k) - slc_old(i,k) = slc(i,k) - smoiseq_old(i,k) = smoiseq(i,k) - end do - - do k = -2, 0 - tsno_old(i,k) = tsnoxy(i,k) - snice_old(i,k) = snicexy(i,k) - snliq_old(i,k) = snliqxy(i,k) - end do - - do k = -2, km - zsnso_old (i,k) = zsnsoxy(i,k) - end do - - end if ! dry(i) .and. flag_guess(i) - - end do ! im _old loop - - do i = 1, im +do i = 1, im if (flag_iter(i) .and. dry(i)) then @@ -655,6 +590,11 @@ subroutine noahmpdrv_run & air_pressure_forcing = prsl1(i) uwind_forcing = u1(i) vwind_forcing = v1(i) + area_grid = garea(i) + + prslkix = prslki(i) + prsik1x = prsik1(i) + prslk1x = prslk1(i) spec_humidity_forcing = max(q1(i), 1.e-8) ! specific humidity at level 1 (kg/kg) virtual_temperature = temperature_forcing * & @@ -732,6 +672,8 @@ subroutine noahmpdrv_run & deep_recharge = deeprechxy(i) recharge = rechxy(i) + ustarx = ustar1(i) + snow_ice_frac_old = 0.0 do k = snow_levels+1, 0 if(snow_level_ice(k) > 0.0 ) & @@ -752,8 +694,8 @@ subroutine noahmpdrv_run & slope_category = slopetyp(i) soil_color_category = 4 - call transfer_mp_parameters(vegetation_category,soil_category, & - slope_category,soil_color_category,crop_type,parameters) + call transfer_mp_parameters(vegetation_category, soil_category, & + slope_category, soil_color_category, crop_type,parameters) call noahmp_options(idveg ,iopt_crs, iopt_btr , iopt_run, iopt_sfc, & iopt_frz, iopt_inf , iopt_rad, iopt_alb, & @@ -771,7 +713,7 @@ subroutine noahmpdrv_run & ice_flag = -1 temperature_soil_bot = min(temperature_soil_bot,263.15) - call noahmp_options_glacier(iopt_alb, iopt_snf, iopt_tbot, iopt_stc, iopt_gla ) + call noahmp_options_glacier(iopt_alb, iopt_snf, iopt_tbot, iopt_stc, iopt_gla, iopt_sfc ) call noahmp_glacier ( & i_location ,1 ,cosine_zenith ,nsnow , & @@ -779,6 +721,8 @@ subroutine noahmpdrv_run & temperature_forcing ,air_pressure_forcing ,uwind_forcing ,vwind_forcing , & spec_humidity_forcing,sw_radiation_forcing ,precipitation_forcing,radiation_lw_forcing , & temperature_soil_bot ,forcing_height ,snow_ice_frac_old ,zsoil , & + thsfc_loc ,prslkix ,prsik1x ,prslk1x , & + vegetation_frac ,area_grid , & snowfall ,snow_water_equiv_old ,snow_albedo_old , & cm_noahmp ,ch_noahmp ,snow_levels ,snow_water_equiv , & soil_moisture_vol ,interface_depth ,snow_depth ,snow_level_ice , & @@ -788,11 +732,12 @@ subroutine noahmpdrv_run & temperature_radiative,evaporation_soil ,runoff_surface ,runoff_baseflow , & sw_absorbed_ground ,albedo_total ,snowmelt_out ,snowmelt_shallow , & snowmelt_shallow_1 ,snowmelt_shallow_2 ,temperature_bare_2m ,spec_humidity_bare_2m, & + z0h_total , & emissivity_total ,precip_frozen_frac ,ch_bare_ground_2m ,snow_sublimation , & #ifdef CCPP - albedo_direct ,albedo_diffuse ,errmsg ,errflg ) + albedo_direct ,albedo_diffuse, errmsg ,errflg ) #else - albedo_direct ,albedo_diffuse ) + albedo_direct ,albedo_diffuse) #endif #ifdef CCPP @@ -822,6 +767,10 @@ subroutine noahmpdrv_run & 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 soil_moisture_wtd = 0.0 recharge = 0.0 deep_recharge = 0.0 @@ -833,6 +782,9 @@ subroutine noahmpdrv_run & t2mmp(i) = temperature_bare_2m q2mp(i) = spec_humidity_bare_2m + tskin(i) = temperature_ground + vegetation_fraction = vegetation_frac + else ! not glacier ice_flag = 0 @@ -846,12 +798,14 @@ subroutine noahmpdrv_run & ice_flag ,surface_type ,crop_type , & eq_soil_water_vol ,temperature_forcing ,air_pressure_forcing , & air_pressure_surface ,uwind_forcing ,vwind_forcing , & - spec_humidity_forcing ,cloud_water_forcing ,sw_radiation_forcing , & - radiation_lw_forcing ,precip_convective , & + spec_humidity_forcing ,area_grid ,cloud_water_forcing , & + sw_radiation_forcing ,radiation_lw_forcing ,thsfc_loc , & + prslkix ,prsik1x ,prslk1x , & + precip_convective , & precip_non_convective ,precip_sh_convective ,precip_snow , & precip_graupel ,precip_hail ,temperature_soil_bot , & co2_air ,o2_air ,foliage_nitrogen , & - snow_ice_frac_old , & + snow_ice_frac_old , & forcing_height ,snow_albedo_old ,snow_water_equiv_old , & temperature_snow_soil ,soil_liquid_vol ,soil_moisture_vol , & temperature_canopy_air,vapor_pres_canopy_air ,canopy_wet_fraction , & @@ -866,8 +820,9 @@ subroutine noahmpdrv_run & soil_carbon_fast ,leaf_area_index ,stem_area_index , & cm_noahmp ,ch_noahmp ,snow_age , & grain_carbon ,growing_deg_days ,plant_growth_stage , & - soil_moisture_wtd ,deep_recharge ,recharge , & - z0_total ,sw_absorbed_total ,sw_reflected_total , & + soil_moisture_wtd ,deep_recharge ,recharge,ustarx , & + z0_total ,z0h_total ,surface_temperature , & + sw_absorbed_total ,sw_reflected_total , & lw_absorbed_total ,sensible_heat_total ,ground_heat_total , & latent_heat_canopy ,latent_heat_ground ,transpiration_heat , & evaporation_canopy ,transpiration ,evaporation_soil , & @@ -880,7 +835,8 @@ subroutine noahmpdrv_run & albedo_total ,snowmelt_out ,snowmelt_shallow , & snowmelt_shallow_1 ,snowmelt_shallow_2 ,rs_sunlit , & rs_shaded ,albedo_direct ,albedo_diffuse , & - albedo_direct_snow ,albedo_diffuse_snow ,canopy_gap_fraction , & + albedo_direct_snow ,albedo_diffuse_snow , & + canopy_gap_fraction , & incanopy_gap_fraction ,ch_vegetated ,ch_bare_ground , & emissivity_total ,sensible_heat_grd_veg ,sensible_heat_leaf , & sensible_heat_grd_bar ,latent_heat_grd_veg ,latent_heat_grd_bare , & @@ -903,10 +859,12 @@ subroutine noahmpdrv_run & latent_heat_total = latent_heat_canopy + latent_heat_ground + transpiration_heat - t2mmp(i) = temperature_veg_2m * vegetation_fraction + & - temperature_bare_2m * (1-vegetation_fraction) - q2mp(i) = spec_humidity_veg_2m * vegetation_fraction + & - spec_humidity_bare_2m * (1-vegetation_fraction) + t2mmp(i) = temperature_veg_2m * vegetation_fraction + & + temperature_bare_2m * (1-vegetation_fraction) + q2mp(i) = spec_humidity_veg_2m * vegetation_fraction + & + spec_humidity_bare_2m * (1-vegetation_fraction) + + tskin(i) = surface_temperature endif ! glacial split ends @@ -924,6 +882,7 @@ subroutine noahmpdrv_run & gflux (i) = -1.0*ground_heat_total ! opposite sign to be consistent with noah snohf (i) = snowmelt_out * con_hfus ! only snow that exits pack sbsno (i) = snow_sublimation + pah (i) = precip_adv_heat_total cmxy (i) = cm_noahmp chxy (i) = ch_noahmp @@ -943,6 +902,9 @@ subroutine noahmpdrv_run & waxy (i) = aquifer_water wtxy (i) = saturated_water qsnowxy (i) = snowfall + ecan (i) = evaporation_canopy + etran (i) = transpiration + edir (i) = evaporation_soil drain (i) = runoff_baseflow runoff (i) = runoff_surface @@ -957,9 +919,9 @@ subroutine noahmpdrv_run & snowc (i) = snow_cover_fraction sncovr1 (i) = snow_cover_fraction - qsurf (i) = q1(i) + evap(i) / (con_hvap / con_cp * density * ch(i) * wind(i)) - tskin (i) = temperature_radiative - tsurf (i) = temperature_radiative + +! qsurf (i) = spec_humidity_surface + tvxy (i) = temperature_leaf tgxy (i) = temperature_ground tahxy (i) = temperature_canopy_air @@ -996,6 +958,44 @@ subroutine noahmpdrv_run & smcwlt2(i) = smcdry_table(soil_category(1)) !!!change to wilt? smcref2(i) = smcref_table(soil_category(1)) + virtfac1 = 1.0 + con_fvirt * max(q1(i), 1.e-8) !from forcing + + if(thsfc_loc) then ! Use local potential temperature + vptemp =temperature_forcing * prslki(i)*virtfac1 !virtual potential temperature @zlvl 1 + else ! Use potential temperature reference to 1000 hPa + vptemp =temperature_forcing /prslk1(i) * virtfac1 + endif + + if(thsfc_loc) then ! Use local potential temperature + tvs1 = tskin(i) * virtfac1 + else ! Use potential temperature referenced to 1000 hPa + tvs1 = tskin(i)/prsik1(i) * virtfac1 + endif + + z0_total = max(min(z0_total,forcing_height),1.0e-6) + z0h_total = max(z0h_total,1.0e-6) + + + tem1 = (z0_total - z0lo) / (z0up - z0lo) + tem1 = min(max(tem1, 0.0_kind_phys), 1.0_kind_phys) + tem2 = max(vegetation_fraction, 0.1_kind_phys) + zvfun(i) = sqrt(tem1 * tem2) + gdx=sqrt(garea(i)) + + call stability & + (zf(i), zvfun(i), gdx, virtual_temperature, vptemp,wind(i), z0_total, z0h_total, & + tvs1, con_g, thsfc_loc, & + rb1(i), fm1(i), fh1(i), fm101(i), fh21(i), cm(i), ch(i), stress1(i), ustar1(i)) + + cmxy(i) = cm(i) + chxy(i) = ch(i) + + chh (i) = chxy(i) * wind(i) * density + cmm (i) = cmxy(i) * wind(i) + + snwdph (i) = snow_depth * 1000.0 ! convert from m to mm; wait after the stability call + qsurf (i) = q1(i) + evap(i)/(con_hvap*density*ch(i)*wind(i)) + ! ! --- change units for output ! @@ -1020,6 +1020,11 @@ subroutine noahmpdrv_run & if (temperature_forcing <= 275.15) is_freeze_rain = .true. end if end if + +! +! using new combined ch output to compute ep +! + ch_noahmp = chxy(i) * wind(i) call penman (temperature_forcing, air_pressure_forcing , ch_noahmp , & virtual_temperature, potential_temperature, precipitation_forcing, & @@ -1034,69 +1039,6 @@ subroutine noahmpdrv_run & end do ! im loop -! -! --- restore land-related prognostic fields for guess run TARGET FOR REMOVAL -! - - do i = 1, im - if (dry(i) .and. flag_guess(i)) then - weasd(i) = weasd_old(i) - snwdph(i) = snwdph_old(i) - tskin(i) = tskin_old(i) - canopy(i) = canopy_old(i) - tprcp(i) = tprcp_old(i) - srflag(i) = srflag_old(i) - snowxy(i) = snow_old(i) - tvxy(i) = tv_old(i) - tgxy(i) = tg_old(i) - canicexy(i) = canice_old(i) - canliqxy(i) = canliq_old(i) - eahxy(i) = eah_old(i) - tahxy(i) = tah_old(i) - fwetxy(i) = fwet_old(i) - sneqvoxy(i) = sneqvo_old(i) - alboldxy(i) = albold_old(i) - qsnowxy(i) = qsnow_old(i) - wslakexy(i) = wslake_old(i) - zwtxy(i) = zwt_old(i) - waxy(i) = wa_old(i) - wtxy(i) = wt_old(i) - lfmassxy(i) = lfmass_old(i) - rtmassxy(i) = rtmass_old(i) - stmassxy(i) = stmass_old(i) - woodxy(i) = wood_old(i) - stblcpxy(i) = stblcp_old(i) - fastcpxy(i) = fastcp_old(i) - xlaixy(i) = xlai_old(i) - xsaixy(i) = xsai_old(i) - taussxy(i) = tauss_old(i) - smcwtdxy(i) = smcwtd_old(i) - rechxy(i) = rech_old(i) - deeprechxy(i) = deeprech_old(i) - - do k = 1, km - smc(i,k) = smc_old(i,k) - stc(i,k) = stc_old(i,k) - slc(i,k) = slc_old(i,k) - smoiseq(i,k) = smoiseq_old(i,k) - end do - - do k = -2,0 - tsnoxy(i,k) = tsno_old(i,k) - snicexy(i,k) = snice_old(i,k) - snliqxy(i,k) = snliq_old(i,k) - end do - - do k = -2, km - zsnsoxy(i,k) = zsnso_old(i,k) - end do - - else - tskin(i) = tsurf(i) - - end if - end do - return end subroutine noahmpdrv_run diff --git a/physics/sfc_noahmp_drv.meta b/physics/sfc_noahmp_drv.meta index 52b354739..c9a6c0258 100644 --- a/physics/sfc_noahmp_drv.meta +++ b/physics/sfc_noahmp_drv.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = noahmpdrv type = scheme - dependencies = funcphys.f90,machine.F,module_sf_noahmp_glacier.f90,module_sf_noahmplsm.f90,noahmp_tables.f90,set_soilveg.f + dependencies = funcphys.f90,machine.F,sfc_diff.f,module_sf_noahmp_glacier.f90,module_sf_noahmplsm.f90,noahmp_tables.f90,set_soilveg.f ######################################################################## [ccpp-arg-table] @@ -222,7 +222,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - intent = in + intent = inout [ch] standard_name = surface_drag_coefficient_for_heat_and_moisture_in_air_over_land long_name = surface exchange coeff heat & moisture over land @@ -230,7 +230,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - intent = in + intent = inout [prsl1] standard_name = air_pressure_at_surface_adjacent_layer long_name = mean pressure at lowest model layer @@ -239,6 +239,14 @@ type = real kind = kind_phys intent = in +[prslk1] + standard_name = dimensionless_exner_function_at_surface_adjacent_layer + long_name = dimensionless Exner function at the lowest model layer + units = none + 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 @@ -247,6 +255,14 @@ type = real kind = kind_phys intent = in +[prsik1] + standard_name = surface_dimensionless_exner_function + long_name = dimensionless Exner function at the ground surface + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in [zf] standard_name = height_above_ground_at_lowest_model_layer long_name = layer 1 height above ground (not MSL) @@ -316,12 +332,13 @@ dimensions = (horizontal_loop_extent) type = logical intent = in -[flag_guess] - standard_name = flag_for_guess_run - long_name = flag for guess run - units = flag - dimensions = (horizontal_loop_extent) - type = logical +[con_g] + standard_name = gravitational_acceleration + long_name = gravitational acceleration + units = m s-2 + dimensions = () + type = real + kind = kind_phys intent = in [idveg] standard_name = control_for_land_surface_scheme_dynamic_vegetation @@ -438,6 +455,14 @@ type = real kind = kind_phys intent = in +[garea] + standard_name = cell_area + long_name = area of the grid cell + units = m2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in [rainn_mp] standard_name = explicit_precipitation_rate_on_previous_timestep long_name = explicit rainfall rate previous timestep @@ -550,6 +575,13 @@ type = real kind = kind_phys intent = in +[thsfc_loc] + standard_name = flag_for_reference_pressure_theta + long_name = flag for reference pressure in theta calculation + units = flag + dimensions = () + type = logical + intent = in [weasd] standard_name = water_equivalent_accumulated_snow_depth_over_land long_name = water equiv of acc snow depth over land @@ -630,14 +662,6 @@ type = real kind = kind_phys intent = inout -[tsurf] - standard_name = surface_skin_temperature_after_iteration_over_land - long_name = surface skin temperature after iteration over land - units = K - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = inout [zorl] standard_name = surface_roughness_length_over_land long_name = surface roughness length over land (temporary use as interstitial) @@ -646,6 +670,62 @@ type = real kind = kind_phys intent = inout +[rb1] + standard_name = bulk_richardson_number_at_lowest_model_level_over_land + long_name = bulk Richardson number at the surface over land + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout +[fm1] + standard_name = Monin_Obukhov_similarity_function_for_momentum_over_land + long_name = Monin-Obukhov similarity function for momentum over land + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout +[fh1] + standard_name = Monin_Obukhov_similarity_function_for_heat_over_land + long_name = Monin-Obukhov similarity function for heat over land + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout +[ustar1] + standard_name = surface_friction_velocity_over_land + long_name = surface friction velocity over land + units = m s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout +[stress1] + standard_name = surface_wind_stress_over_land + long_name = surface wind stress over land + units = m2 s-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout +[fm101] + standard_name = Monin_Obukhov_similarity_function_for_momentum_at_10m_over_land + long_name = Monin-Obukhov similarity parameter for momentum at 10m over land + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout +[fh21] + standard_name = Monin_Obukhov_similarity_function_for_heat_at_2m_over_land + long_name = Monin-Obukhov similarity parameter for heat at 2m over land + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout [snowxy] standard_name = number_of_snow_layers long_name = number of snow layers @@ -1062,6 +1142,38 @@ type = real kind = kind_phys intent = out +[pah] + standard_name = total_precipitation_advected_heat + long_name = precipitation advected heat - total + units = W m-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = out +[ecan] + standard_name = evaporation_of_intercepted_water + long_name = evaporation of intercepted water + units = kg m-2 s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = out +[etran] + standard_name = transpiration_rate + long_name = transpiration rate + units = kg m-2 s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = out +[edir] + standard_name = soil_surface_evaporation_rate + long_name = soil surface evaporation rate + units = kg m-2 s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = out [snowc] standard_name = surface_snow_area_fraction long_name = surface snow area fraction @@ -1126,6 +1238,14 @@ type = real kind = kind_phys intent = out +[zvfun] + standard_name = function_of_surface_roughness_length_and_green_vegetation_fraction + long_name = function of surface roughness length and green vegetation fraction + units = none + 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/sfcsub.F b/physics/sfcsub.F index 53a907cc0..e8b61f083 100644 --- a/physics/sfcsub.F +++ b/physics/sfcsub.F @@ -5753,63 +5753,63 @@ subroutine qcmxmn(ttl,fld,slimsk,sno,iceflg, & per = float(kmaxl)/float(len)*100. print 9002,fldlmx,kmaxl,per 9002 format(' bare land max check. modified to ',f8.1, & - & ' at ',i5,' points ',f4.1,'percent') + & ' at ',i5,' points ',f5.1,'percent') if(per.gt.permax) permax=per endif if(kmino > 0) then per = float(kmino)/float(len)*100. print 9003,fldomn,kmino,per 9003 format(' open ocean min check. modified to ',f8.1, & - & ' at ',i5,' points ',f4.1,'percent') + & ' at ',i5,' points ',f5.1,'percent') if(per.gt.permax) permax=per endif if(kmaxo > 0) then per = float(kmaxo)/float(len)*100. print 9004,fldomx,kmaxo,per 9004 format(' open sea max check. modified to ',f8.1, & - & ' at ',i5,' points ',f4.1,'percent') + & ' at ',i5,' points ',f5.1,'percent') if(per.gt.permax) permax=per endif if(kmins >.0) then per = float(kmins)/float(len)*100. print 9009,fldsmn,kmins,per 9009 format(' snow covered land min check. modified to ',f8.1, & - & ' at ',i5,' points ',f4.1,'percent') + & ' at ',i5,' points ',f5.1,'percent') if(per.gt.permax) permax=per endif if(kmaxs > 0) then per = float(kmaxs)/float(len)*100. print 9010,fldsmx,kmaxs,per 9010 format(' snow covered land max check. modified to ',f8.1, & - & ' at ',i5,' points ',f4.1,'percent') + & ' at ',i5,' points ',f5.1,'percent') if(per.gt.permax) permax=per endif if(kmini > 0) then per = float(kmini)/float(len)*100. print 9005,fldimn,kmini,per 9005 format(' bare ice min check. modified to ',f8.1, & - & ' at ',i5,' points ',f4.1,'percent') + & ' at ',i5,' points ',f5.1,'percent') if(per.gt.permax) permax=per endif if(kmaxi > 0) then per = float(kmaxi)/float(len)*100. print 9006,fldimx,kmaxi,per 9006 format(' bare ice max check. modified to ',f8.1, & - & ' at ',i5,' points ',f4.1,'percent') + & ' at ',i5,' points ',f5.1,'percent') if(per > permax) permax=per endif if(kminj > 0) then per = float(kminj)/float(len)*100. print 9007,fldjmn,kminj,per 9007 format(' snow covered ice min check. modified to ',f8.1, & - & ' at ',i5,' points ',f4.1,'percent') + & ' at ',i5,' points ',f5.1,'percent') if(per.gt.permax) permax=per endif if(kmaxj > 0) then per = float(kmaxj)/float(len)*100. print 9008,fldjmx,kmaxj,per 9008 format(' snow covered ice max check. modified to ',f8.1, & - & ' at ',i5,' points ',f4.1,'percent') + & ' at ',i5,' points ',f5.1,'percent') if(per > permax) permax=per endif ! commented on 06/30/99 -- moorthi diff --git a/physics/sflx.f b/physics/sflx.f index 56bfc04c9..61fe015cc 100644 --- a/physics/sflx.f +++ b/physics/sflx.f @@ -1432,9 +1432,9 @@ subroutine nopac & zsoil, slope, frzx, bexp, dksat, dwsat, shdfac, & & edir1, ec1, et1, & ! --- input/outputs: - & cmc, sh2o, & + & cmc, sh2o, smc, & ! --- outputs: - & smc, runoff1, runoff2, runoff3, drip & + & runoff1, runoff2, runoff3, drip & & ) else @@ -1455,9 +1455,9 @@ subroutine nopac & zsoil, slope, frzx, bexp, dksat, dwsat, shdfac, & & edir1, ec1, et1, & ! --- input/outputs: - & cmc, sh2o, & + & cmc, sh2o, smc, & ! --- outputs: - & smc, runoff1, runoff2, runoff3, drip & + & runoff1, runoff2, runoff3, drip & & ) endif ! end if_etp_block @@ -2722,9 +2722,9 @@ subroutine snopac & zsoil, slope, frzx, bexp, dksat, dwsat, shdfac, & & edir1, ec1, et1, & ! --- input/outputs: - & cmc, sh2o, & + & cmc, sh2o, smc, & ! --- outputs: - & smc, runoff1, runoff2, runoff3, drip & + & runoff1, runoff2, runoff3, drip & & ) endif @@ -3447,9 +3447,9 @@ subroutine smflx & & zsoil, slope, frzx, bexp, dksat, dwsat, shdfac, & & edir1, ec1, et1, & ! --- input/outputs: - & cmc, sh2o, & + & cmc, sh2o, smc, & ! --- outputs: - & smc, runoff1, runoff2, runoff3, drip & + & runoff1, runoff2, runoff3, drip & & ) ! ===================================================================== ! @@ -3488,9 +3488,9 @@ subroutine smflx & ! input/outputs: ! ! cmc - real, canopy moisture content 1 ! ! sh2o - real, unfrozen soil moisture nsoil ! +! smc - real, total soil moisture nsoil ! ! ! ! outputs: ! -! smc - real, total soil moisture nsoil ! ! runoff1 - real, surface runoff not infiltrating sfc 1 ! ! runoff2 - real, sub surface runoff (baseflow) 1 ! ! runoff3 - real, excess of porosity 1 ! @@ -3506,11 +3506,12 @@ subroutine smflx & & edir1, ec1, et1(nsoil), zsoil(nsoil) ! --- input/outputs: - real (kind=kind_phys), intent(inout) :: cmc, sh2o(nsoil) + real (kind=kind_phys), intent(inout) :: cmc, sh2o(nsoil), & + & smc(nsoil) ! --- outputs: - real (kind=kind_phys), intent(out) :: smc(nsoil), runoff1, & - & runoff2, runoff3, drip + real (kind=kind_phys), intent(out) :: runoff1, runoff2, & + & runoff3, drip ! --- locals: real (kind=kind_phys) :: dummy, excess, pcpdrp, rhsct, trhsct, & diff --git a/physics/shinhongvdif.meta b/physics/shinhongvdif.meta index 7e160c8a2..8d0dac7db 100644 --- a/physics/shinhongvdif.meta +++ b/physics/shinhongvdif.meta @@ -439,7 +439,7 @@ [dtend] standard_name = cumulative_change_of_state_variables long_name = diagnostic tendencies for state variables - units = various + units = mixed dimensions = (horizontal_loop_extent,vertical_layer_dimension,cumulative_change_of_state_variables_outer_index_max) type = real kind = kind_phys diff --git a/physics/ugwpv1_gsldrag.meta b/physics/ugwpv1_gsldrag.meta index 64d6b0d64..ab54f458a 100644 --- a/physics/ugwpv1_gsldrag.meta +++ b/physics/ugwpv1_gsldrag.meta @@ -595,8 +595,8 @@ kind = kind_phys intent = in [rain] - standard_name = lwe_thickness_of_precipitation_amount_on_dynamics_timestep - long_name = total rain at this time step + standard_name = nonnegative_lwe_thickness_of_precipitation_amount_on_dynamics_timestep + long_name = total precipitation amount in each time step units = m dimensions = (horizontal_loop_extent) type = real @@ -716,7 +716,7 @@ [tau_amf] standard_name = absolute_momentum_flux_due_to_nonorographic_gravity_wave_drag long_name = ngw_absolute_momentum_flux - units = various + units = mixed dimensions = (horizontal_loop_extent) type = real kind = kind_phys @@ -1021,7 +1021,7 @@ [dtend] standard_name = cumulative_change_of_state_variables long_name = diagnostic tendencies for state variables - units = various + units = mixed dimensions = (horizontal_loop_extent,vertical_layer_dimension,cumulative_change_of_state_variables_outer_index_max) type = real kind = kind_phys diff --git a/physics/unified_ugwp.meta b/physics/unified_ugwp.meta index 547256681..fbdf3d00e 100644 --- a/physics/unified_ugwp.meta +++ b/physics/unified_ugwp.meta @@ -1014,8 +1014,8 @@ kind = kind_phys intent = in [rain] - standard_name = lwe_thickness_of_precipitation_amount_on_dynamics_timestep - long_name = total rain at this time step + standard_name = nonnegative_lwe_thickness_of_precipitation_amount_on_dynamics_timestep + long_name = total precipitation amount in each time step units = m dimensions = (horizontal_loop_extent) type = real @@ -1068,7 +1068,7 @@ [dtend] standard_name = cumulative_change_of_state_variables long_name = diagnostic tendencies for state variables - units = various + units = mixed dimensions = (horizontal_loop_extent,vertical_layer_dimension,cumulative_change_of_state_variables_outer_index_max) type = real kind = kind_phys diff --git a/physics/ysuvdif.meta b/physics/ysuvdif.meta index 6585fae13..f28ef3eff 100644 --- a/physics/ysuvdif.meta +++ b/physics/ysuvdif.meta @@ -462,7 +462,7 @@ [dtend] standard_name = cumulative_change_of_state_variables long_name = diagnostic tendencies for state variables - units = various + units = mixed dimensions = (horizontal_loop_extent,vertical_layer_dimension,cumulative_change_of_state_variables_outer_index_max) type = real kind = kind_phys