diff --git a/CMakeLists.txt b/CMakeLists.txt index af33fb1ee..b8d3c3e18 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -97,51 +97,107 @@ list(APPEND LIBS "ccpp") #------------------------------------------------------------------------------ # Set the sources: physics schemes -include(./CCPP_SCHEMES.cmake) +set(SCHEMES $ENV{CCPP_SCHEMES}) +if(SCHEMES) + message(INFO "Got CCPP_SCHEMES from environment variable: ${SCHEMES}") +else(SCHEMES) + include(./CCPP_SCHEMES.cmake) + message(INFO "Got SCHEMES from cmakefile include file: ${SCHEMES}") +endif(SCHEMES) + # Set the sources: physics scheme caps -include(./CCPP_CAPS.cmake) -# Create empty lists for schemes with special compiler flags -set(SCHEMES_SFX "") +set(CAPS $ENV{CCPP_CAPS}) +if(CAPS) + message(INFO "Got CAPS from environment variable: ${CAPS}") +else(CAPS) + include(./CCPP_CAPS.cmake) + message(INFO "Got CAPS from cmakefile include file: ${CAPS}") +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}) #------------------------------------------------------------------------------ if (${CMAKE_Fortran_COMPILER_ID} STREQUAL "GNU") set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -ffree-line-length-none") - SET_SOURCE_FILES_PROPERTIES(./physics/module_bfmicrophysics.f ./physics/sflx.f ./physics/sfc_diff.f ./physics/sfc_diag.f PROPERTIES COMPILE_FLAGS -fdefault-real-8) - SET_SOURCE_FILES_PROPERTIES(./physics/module_nst_model.f90 ./physics/calpreciptype.f90 PROPERTIES COMPILE_FLAGS "-fdefault-real-8 -ffree-form") - SET_SOURCE_FILES_PROPERTIES(./physics/mersenne_twister.f PROPERTIES COMPILE_FLAGS "-fdefault-real-8 -fno-range-check") - SET_SOURCE_FILES_PROPERTIES(./physics/module_nst_water_prop.f90 PROPERTIES COMPILE_FLAGS "-ffree-line-length-none -fdefault-real-8 -ffree-form") - SET_SOURCE_FILES_PROPERTIES(./physics/aer_cloud.F ./physics/wv_saturation.F ./physics/cldwat2m_micro.F ./physics/surface_perturbation.F90 PROPERTIES COMPILE_FLAGS "-fdefault-real-8 -fdefault-double-8") - SET_SOURCE_FILES_PROPERTIES(./physics/module_mp_thompson_make_number_concentrations.F90 PROPERTIES COMPILE_FLAGS "-fdefault-real-8 -fdefault-double-8") + SET_SOURCE_FILES_PROPERTIES(${CMAKE_CURRENT_SOURCE_DIR}/physics/module_bfmicrophysics.f + ${CMAKE_CURRENT_SOURCE_DIR}/physics/sflx.f + ${CMAKE_CURRENT_SOURCE_DIR}/physics/sfc_diff.f + ${CMAKE_CURRENT_SOURCE_DIR}/physics/sfc_diag.f + PROPERTIES COMPILE_FLAGS -fdefault-real-8) + SET_SOURCE_FILES_PROPERTIES(${CMAKE_CURRENT_SOURCE_DIR}/physics/module_nst_model.f90 + ${CMAKE_CURRENT_SOURCE_DIR}/physics/calpreciptype.f90 + PROPERTIES COMPILE_FLAGS "-fdefault-real-8 -ffree-form") + SET_SOURCE_FILES_PROPERTIES(${CMAKE_CURRENT_SOURCE_DIR}/physics/mersenne_twister.f + PROPERTIES COMPILE_FLAGS "-fdefault-real-8 -fno-range-check") + SET_SOURCE_FILES_PROPERTIES(${CMAKE_CURRENT_SOURCE_DIR}/physics/module_nst_water_prop.f90 + PROPERTIES COMPILE_FLAGS "-ffree-line-length-none -fdefault-real-8 -ffree-form") + SET_SOURCE_FILES_PROPERTIES(${CMAKE_CURRENT_SOURCE_DIR}/physics/aer_cloud.F + ${CMAKE_CURRENT_SOURCE_DIR}/physics/wv_saturation.F + ${CMAKE_CURRENT_SOURCE_DIR}/physics/cldwat2m_micro.F + ${CMAKE_CURRENT_SOURCE_DIR}/physics/surface_perturbation.F90 + PROPERTIES COMPILE_FLAGS "-fdefault-real-8 -fdefault-double-8") + SET_SOURCE_FILES_PROPERTIES(${CMAKE_CURRENT_SOURCE_DIR}/physics/module_mp_thompson_make_number_concentrations.F90 + PROPERTIES COMPILE_FLAGS "-fdefault-real-8 -fdefault-double-8") + SET_SOURCE_FILES_PROPERTIES(${CMAKE_CURRENT_SOURCE_DIR}/physics/module_SF_JSFC.F90 + ${CMAKE_CURRENT_SOURCE_DIR}/physics/module_BL_MYJPBL.F90 + PROPERTIES COMPILE_FLAGS "-fdefault-real-8 -fdefault-double-8") 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) - message (FATAL_ERROR "The current build system does not allow building fast physics with 32-bit precision when the GNU compilers are used") + # 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 ${CMAKE_CURRENT_SOURCE_DIR}/physics/gfdl_fv_sat_adj.F90 + APPEND_STRING PROPERTY COMPILE_FLAGS " ${CMAKE_Fortran_FLAGS_PREC32} ") + # Add all of the above files to the list of schemes with special floating point precision flags + list(APPEND SCHEMES_SFX_PREC ${CMAKE_CURRENT_SOURCE_DIR}/physics/gfdl_fv_sat_adj.F90) endif (DYN32) + + # 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) + # 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} ") 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") - SET_SOURCE_FILES_PROPERTIES(./physics/module_bfmicrophysics.f - ./physics/sflx.f - ./physics/sfc_diff.f - ./physics/sfc_diag.f - ./physics/module_nst_model.f90 - ./physics/calpreciptype.f90 - ./physics/mersenne_twister.f - ./physics/module_nst_water_prop.f90 - ./physics/aer_cloud.F - ./physics/wv_saturation.F - ./physics/cldwat2m_micro.F - ./physics/surface_perturbation.F90 - ./physics/radiation_aerosols.f - ./physics/cu_gf_deep.F90 - ./physics/cu_gf_sh.F90 - ./physics/module_bl_mynn.F90 - ./physics/module_MYNNPBL_wrapper.F90 - ./physics/module_sf_mynn.F90 - ./physics/module_MYNNSFC_wrapper.F90 - ./physics/module_MYNNrad_pre.F90 - ./physics/module_MYNNrad_post.F90 - ./physics/module_mp_thompson_make_number_concentrations.F90 + SET_SOURCE_FILES_PROPERTIES(${CMAKE_CURRENT_SOURCE_DIR}/physics/module_bfmicrophysics.f + ${CMAKE_CURRENT_SOURCE_DIR}/physics/sflx.f + ${CMAKE_CURRENT_SOURCE_DIR}/physics/sfc_diff.f + ${CMAKE_CURRENT_SOURCE_DIR}/physics/sfc_diag.f + ${CMAKE_CURRENT_SOURCE_DIR}/physics/module_nst_model.f90 + ${CMAKE_CURRENT_SOURCE_DIR}/physics/calpreciptype.f90 + ${CMAKE_CURRENT_SOURCE_DIR}/physics/mersenne_twister.f + ${CMAKE_CURRENT_SOURCE_DIR}/physics/module_nst_water_prop.f90 + ${CMAKE_CURRENT_SOURCE_DIR}/physics/aer_cloud.F + ${CMAKE_CURRENT_SOURCE_DIR}/physics/wv_saturation.F + ${CMAKE_CURRENT_SOURCE_DIR}/physics/cldwat2m_micro.F + ${CMAKE_CURRENT_SOURCE_DIR}/physics/surface_perturbation.F90 + ${CMAKE_CURRENT_SOURCE_DIR}/physics/radiation_aerosols.f + ${CMAKE_CURRENT_SOURCE_DIR}/physics/cu_gf_deep.F90 + ${CMAKE_CURRENT_SOURCE_DIR}/physics/cu_gf_sh.F90 + ${CMAKE_CURRENT_SOURCE_DIR}/physics/module_bl_mynn.F90 + ${CMAKE_CURRENT_SOURCE_DIR}/physics/module_MYNNPBL_wrapper.F90 + ${CMAKE_CURRENT_SOURCE_DIR}/physics/module_sf_mynn.F90 + ${CMAKE_CURRENT_SOURCE_DIR}/physics/module_MYNNSFC_wrapper.F90 + ${CMAKE_CURRENT_SOURCE_DIR}/physics/module_MYNNrad_pre.F90 + ${CMAKE_CURRENT_SOURCE_DIR}/physics/module_MYNNrad_post.F90 + ${CMAKE_CURRENT_SOURCE_DIR}/physics/module_mp_thompson_make_number_concentrations.F90 + ${CMAKE_CURRENT_SOURCE_DIR}/physics/module_SF_JSFC.F90 + ${CMAKE_CURRENT_SOURCE_DIR}/physics/module_BL_MYJPBL.F90 PROPERTIES COMPILE_FLAGS "-r8 -ftz") # Replace -xHost or -xCORE-AVX2 with -xCORE-AVX-I for certain files @@ -155,87 +211,109 @@ elseif (${CMAKE_Fortran_COMPILER_ID} STREQUAL "Intel") string(REPLACE "-axSSE4.2,AVX,CORE-AVX2,CORE-AVX512" "-axSSE4.2,AVX,CORE-AVX-I" CMAKE_Fortran_FLAGS_LOPT1 "${CMAKE_Fortran_FLAGS_LOPT1}") - SET_SOURCE_FILES_PROPERTIES(./physics/radiation_aerosols.f + SET_SOURCE_FILES_PROPERTIES(${CMAKE_CURRENT_SOURCE_DIR}/physics/radiation_aerosols.f PROPERTIES COMPILE_FLAGS "${CMAKE_Fortran_FLAGS_LOPT1}") # Add all of the above files to the list of schemes with special compiler flags - list(APPEND SCHEMES_SFX ./physics/radiation_aerosols.f) - - # Force consistent results of math calculations for MG microphysics; - # in Debug/Bitforbit mode; without this flag, the results of the - # intrinsic gamma function are different for the non-CCPP and CCPP - # version (on Theia with Intel 18). Note this is only required for - # the dynamic CCPP build, not for the static CCPP build. - if (TRANSITION) - # Replace -xHost or -xCORE-AVX2 with -xCORE-AVX-I, -no-prec-div with -prec-div, and - # -no-prec-sqrt with -prec-sqrt for certain files for bit-for-bit reproducibility - # with non-CCPP builds. These may go in the future once the CCPP solution is fully accepted. - set(CMAKE_Fortran_FLAGS_LOPT2 ${CMAKE_Fortran_FLAGS_OPT}) - string(REPLACE "-no-prec-div" "-prec-div" - CMAKE_Fortran_FLAGS_LOPT2 - "${CMAKE_Fortran_FLAGS_LOPT2}") - string(REPLACE "-no-prec-sqrt" "-prec-sqrt" - CMAKE_Fortran_FLAGS_LOPT2 - "${CMAKE_Fortran_FLAGS_LOPT2}") - string(REPLACE "-xCORE-AVX2" "-xCORE-AVX-I" - CMAKE_Fortran_FLAGS_LOPT2 - "${CMAKE_Fortran_FLAGS_LOPT2}") - string(REPLACE "-axSSE4.2,AVX,CORE-AVX2" "-axSSE4.2,AVX,CORE-AVX-I" - CMAKE_Fortran_FLAGS_LOPT2 - "${CMAKE_Fortran_FLAGS_LOPT2}") - SET_SOURCE_FILES_PROPERTIES(./physics/micro_mg2_0.F90 - ./physics/micro_mg3_0.F90 - ./physics/aer_cloud.F - ./physics/cldmacro.F - ./physics/gfdl_fv_sat_adj.F90 - ./physics/module_gfdl_cloud_microphys.F90 - ./physics/sflx.f - ./physics/satmedmfvdif.F - ./physics/cs_conv.F90 - ./physics/gcm_shoc.F90 - PROPERTIES COMPILE_FLAGS "${CMAKE_Fortran_FLAGS_LOPT2}") - # Add all of the above files to the list of schemes with special compiler flags - list(APPEND SCHEMES_SFX ./physics/micro_mg2_0.F90 - ./physics/micro_mg3_0.F90 - ./physics/aer_cloud.F - ./physics/cldmacro.F - ./physics/module_gfdl_cloud_microphys.F90 - ./physics/sflx.f - ./physics/satmedmfvdif.F - ./physics/cs_conv.F90 - ./physics/gcm_shoc.F90 - ./physics/gfdl_fv_sat_adj.F90) - endif (TRANSITION) + list(APPEND SCHEMES_SFX_OPT ${CMAKE_CURRENT_SOURCE_DIR}/physics/radiation_aerosols.f) # Remove files with special compiler flags from list of files with standard compiler flags - list(REMOVE_ITEM SCHEMES ${SCHEMES_SFX}) + list(REMOVE_ITEM SCHEMES ${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}") - # This has to come last: append 32-bit dynamics flags to certain files that are executed - # in the dynamics (fast physics part); this will overwrite any preceding -real-size 64 + # Set 32-bit floating point precision flags for certain files + # that are executed in the dynamics (fast physics part) if (DYN32) - SET_PROPERTY(SOURCE ./physics/gfdl_fv_sat_adj.F90 APPEND_STRING PROPERTY COMPILE_FLAGS " -real-size 32 ") + # 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 ${CMAKE_CURRENT_SOURCE_DIR}/physics/gfdl_fv_sat_adj.F90 + APPEND_STRING PROPERTY COMPILE_FLAGS " ${CMAKE_Fortran_FLAGS_PREC32} ") + # Add all of the above files to the list of schemes with special floating point precision flags + list(APPEND SCHEMES_SFX_PREC ${CMAKE_CURRENT_SOURCE_DIR}/physics/gfdl_fv_sat_adj.F90) endif (DYN32) + # 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) + # 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} ") + else (PROJECT STREQUAL "CCPP-FV3") - SET_SOURCE_FILES_PROPERTIES(./physics/module_bfmicrophysics.f ./physics/sflx.f ./physics/sfc_diff.f ./physics/sfc_diag.f PROPERTIES COMPILE_FLAGS -r8) - SET_SOURCE_FILES_PROPERTIES(./physics/module_nst_model.f90 ./physics/calpreciptype.f90 PROPERTIES COMPILE_FLAGS "-r8 -free") - SET_SOURCE_FILES_PROPERTIES(./physics/mersenne_twister.f PROPERTIES COMPILE_FLAGS "-r8 -ftz") - SET_SOURCE_FILES_PROPERTIES(./physics/module_nst_water_prop.f90 PROPERTIES COMPILE_FLAGS "-extend-source 132 -r8 -free") - SET_SOURCE_FILES_PROPERTIES(./physics/aer_cloud.F ./physics/wv_saturation.F ./physics/cldwat2m_micro.F ./physics/surface_perturbation.F90 PROPERTIES COMPILE_FLAGS "-r8") + SET_SOURCE_FILES_PROPERTIES(${CMAKE_CURRENT_SOURCE_DIR}/physics/module_bfmicrophysics.f + ${CMAKE_CURRENT_SOURCE_DIR}/physics/sflx.f + ${CMAKE_CURRENT_SOURCE_DIR}/physics/sfc_diff.f + ${CMAKE_CURRENT_SOURCE_DIR}/physics/sfc_diag.f + PROPERTIES COMPILE_FLAGS -r8) + SET_SOURCE_FILES_PROPERTIES(${CMAKE_CURRENT_SOURCE_DIR}/physics/module_nst_model.f90 + ${CMAKE_CURRENT_SOURCE_DIR}/physics/calpreciptype.f90 + PROPERTIES COMPILE_FLAGS "-r8 -free") + SET_SOURCE_FILES_PROPERTIES(${CMAKE_CURRENT_SOURCE_DIR}/physics/mersenne_twister.f + PROPERTIES COMPILE_FLAGS "-r8 -ftz") + SET_SOURCE_FILES_PROPERTIES(${CMAKE_CURRENT_SOURCE_DIR}/physics/module_nst_water_prop.f90 + PROPERTIES COMPILE_FLAGS "-extend-source 132 -r8 -free") + SET_SOURCE_FILES_PROPERTIES(${CMAKE_CURRENT_SOURCE_DIR}/physics/aer_cloud.F + ${CMAKE_CURRENT_SOURCE_DIR}/physics/wv_saturation.F + ${CMAKE_CURRENT_SOURCE_DIR}/physics/cldwat2m_micro.F + ${CMAKE_CURRENT_SOURCE_DIR}/physics/surface_perturbation.F90 + PROPERTIES COMPILE_FLAGS "-r8") + SET_SOURCE_FILES_PROPERTIES(${CMAKE_CURRENT_SOURCE_DIR}/physics/module_mp_thompson_make_number_concentrations.F90 + PROPERTIES COMPILE_FLAGS "-r8") + SET_SOURCE_FILES_PROPERTIES(${CMAKE_CURRENT_SOURCE_DIR}/physics/module_SF_JSFC.F90 + ${CMAKE_CURRENT_SOURCE_DIR}/physics/module_BL_MYJPBL.F90 + PROPERTIES COMPILE_FLAGS "-r8") endif (PROJECT STREQUAL "CCPP-FV3") elseif (${CMAKE_Fortran_COMPILER_ID} STREQUAL "PGI") - SET_SOURCE_FILES_PROPERTIES(./physics/module_bfmicrophysics.f ./physics/sflx.f ./physics/sfc_diff.f ./physics/sfc_diag.f PROPERTIES COMPILE_FLAGS -r8) - SET_SOURCE_FILES_PROPERTIES(./physics/module_nst_model.f90 ./physics/calpreciptype.f90 PROPERTIES COMPILE_FLAGS "-r8 -Mfree") - SET_SOURCE_FILES_PROPERTIES(./physics/mersenne_twister.f PROPERTIES COMPILE_FLAGS "-r8 -Mnofptrap") - SET_SOURCE_FILES_PROPERTIES(./physics/module_nst_water_prop.f90 PROPERTIES COMPILE_FLAGS "-r8 -Mfree") - SET_SOURCE_FILES_PROPERTIES(./physics/aer_cloud.F ./physics/wv_saturation.F ./physics/cldwat2m_micro.F ./physics/surface_perturbation.F90 PROPERTIES COMPILE_FLAGS "-r8") - SET_SOURCE_FILES_PROPERTIES(./physics/module_mp_thompson_make_number_concentrations.F90 PROPERTIES COMPILE_FLAGS "-r8") + SET_SOURCE_FILES_PROPERTIES(${CMAKE_CURRENT_SOURCE_DIR}/physics/module_bfmicrophysics.f + ${CMAKE_CURRENT_SOURCE_DIR}/physics/sflx.f + ${CMAKE_CURRENT_SOURCE_DIR}/physics/sfc_diff.f + ${CMAKE_CURRENT_SOURCE_DIR}/physics/sfc_diag.f + PROPERTIES COMPILE_FLAGS -r8) + SET_SOURCE_FILES_PROPERTIES(${CMAKE_CURRENT_SOURCE_DIR}/physics/module_nst_model.f90 + ${CMAKE_CURRENT_SOURCE_DIR}/physics/calpreciptype.f90 + PROPERTIES COMPILE_FLAGS "-r8 -Mfree") + SET_SOURCE_FILES_PROPERTIES(${CMAKE_CURRENT_SOURCE_DIR}/physics/mersenne_twister.f + PROPERTIES COMPILE_FLAGS "-r8 -Mnofptrap") + SET_SOURCE_FILES_PROPERTIES(${CMAKE_CURRENT_SOURCE_DIR}/physics/module_nst_water_prop.f90 + PROPERTIES COMPILE_FLAGS "-r8 -Mfree") + SET_SOURCE_FILES_PROPERTIES(${CMAKE_CURRENT_SOURCE_DIR}/physics/aer_cloud.F + ${CMAKE_CURRENT_SOURCE_DIR}/physics/wv_saturation.F + ${CMAKE_CURRENT_SOURCE_DIR}/physics/cldwat2m_micro.F + ${CMAKE_CURRENT_SOURCE_DIR}/physics/surface_perturbation.F90 + PROPERTIES COMPILE_FLAGS "-r8") + SET_SOURCE_FILES_PROPERTIES(${CMAKE_CURRENT_SOURCE_DIR}/physics/module_mp_thompson_make_number_concentrations.F90 + PROPERTIES COMPILE_FLAGS "-r8") + SET_SOURCE_FILES_PROPERTIES(${CMAKE_CURRENT_SOURCE_DIR}/physics/module_SF_JSFC.F90 + ${CMAKE_CURRENT_SOURCE_DIR}/physics/module_BL_MYJPBL.F90 + PROPERTIES COMPILE_FLAGS "-r8") 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) - SET_PROPERTY(SOURCE ./physics/gfdl_fv_sat_adj.F90 APPEND_STRING PROPERTY COMPILE_FLAGS " -r4 ") + # Reduce floating point precision from 64-bit to 32-bit, if necessary + set(CMAKE_Fortran_FLAGS_PREC32 ${CMAKE_Fortran_FLAGS_DEFAULT_PREC}) + string(REPLACE "-r8" "-r4" + CMAKE_Fortran_FLAGS_PREC32 "${CMAKE_Fortran_FLAGS_PREC32}") + SET_PROPERTY(SOURCE ${CMAKE_CURRENT_SOURCE_DIR}/physics/gfdl_fv_sat_adj.F90 + APPEND_STRING PROPERTY COMPILE_FLAGS " ${CMAKE_Fortran_FLAGS_PREC32} ") + # Add all of the above files to the list of schemes with special floating point precision flags + list(APPEND SCHEMES_SFX_PREC ${CMAKE_CURRENT_SOURCE_DIR}/physics/gfdl_fv_sat_adj.F90) endif (DYN32) + + # 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) + # 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} ") + endif (PROJECT STREQUAL "CCPP-FV3") else (${CMAKE_Fortran_COMPILER_ID} STREQUAL "GNU") message ("CMAKE_Fortran_COMPILER full path: " ${CMAKE_Fortran_COMPILER}) @@ -252,14 +330,14 @@ endif (${CMAKE_Fortran_COMPILER_ID} STREQUAL "GNU") # physics schemes, these checks can and should remain enabled. Overwriting # the pointer check flags explicitly works for Intel and GNU, but not for PGI. if (${CMAKE_Fortran_COMPILER_ID} STREQUAL "GNU") - set_property(SOURCE ${CAPS} PROPERTY COMPILE_FLAGS "-fcheck=no-pointer,no-bounds") + set_property(SOURCE ${CAPS} APPEND_STRING PROPERTY COMPILE_FLAGS " -fcheck=no-pointer,no-bounds ") elseif (${CMAKE_Fortran_COMPILER_ID} STREQUAL "Intel") - set_property(SOURCE ${CAPS} PROPERTY COMPILE_FLAGS "-check nopointers,nobounds") + set_property(SOURCE ${CAPS} APPEND_STRING PROPERTY COMPILE_FLAGS " -check nopointers,nobounds ") elseif (${CMAKE_Fortran_COMPILER_ID} STREQUAL "PGI") if (CMAKE_Fortran_FLAGS MATCHES ".*chkptr.*") message (FATAL_ERROR "PGI compiler option chkptr cannot be used for CCPP physics") endif (CMAKE_Fortran_FLAGS MATCHES ".*chkptr.*") - set_property(SOURCE ${CAPS} PROPERTY COMPILE_FLAGS "-Mnobounds") + set_property(SOURCE ${CAPS} APPEND_STRING PROPERTY COMPILE_FLAGS " -Mnobounds ") endif (${CMAKE_Fortran_COMPILER_ID} STREQUAL "GNU") if (PROJECT STREQUAL "CCPP-SCM") @@ -269,15 +347,16 @@ endif (PROJECT STREQUAL "CCPP-SCM") #------------------------------------------------------------------------------ if(STATIC) - add_library(ccppphys STATIC ${SCHEMES} ${SCHEMES_SFX} ${CAPS}) + add_library(ccppphys STATIC ${SCHEMES} ${SCHEMES_SFX_OPT} ${CAPS}) # Generate list of Fortran modules from defined sources foreach(source_f90 ${CAPS}) - string(REGEX REPLACE ".F90" ".mod" tmp_module_f90 ${source_f90}) + get_filename_component(tmp_source_f90 ${source_f90} NAME) + string(REGEX REPLACE ".F90" ".mod" tmp_module_f90 ${tmp_source_f90}) string(TOLOWER ${tmp_module_f90} module_f90) - list(APPEND MODULES_F90 ${CMAKE_CURRENT_BINARY_DIR}/../${module_f90}) + list(APPEND MODULES_F90 ${CMAKE_CURRENT_BINARY_DIR}/${module_f90}) endforeach() else(STATIC) - add_library(ccppphys SHARED ${SCHEMES} ${SCHEMES_SFX} ${CAPS}) + add_library(ccppphys SHARED ${SCHEMES} ${SCHEMES_SFX_OPT} ${CAPS}) endif(STATIC) if (NOT STATIC) diff --git a/CODEOWNERS b/CODEOWNERS index d7c3658fd..0d5230f89 100644 --- a/CODEOWNERS +++ b/CODEOWNERS @@ -3,7 +3,7 @@ # These owners will be the default owners for everything in the repo. #* @defunkt -* @climbfuji @llpcarson @grantfirl +* @climbfuji @llpcarson @grantfirl @JulieSchramm # 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.F90 b/physics/GFS_DCNV_generic.F90 index 8f52fb550..d7305cbe5 100644 --- a/physics/GFS_DCNV_generic.F90 +++ b/physics/GFS_DCNV_generic.F90 @@ -14,39 +14,20 @@ end subroutine GFS_DCNV_generic_pre_finalize #if 0 !> \brief Interstitial scheme called prior to any deep convective scheme to save state variables for calculating tendencies after the deep convective scheme is executed !! \section arg_table_GFS_DCNV_generic_pre_run Argument Table -!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | -!! |-----------------|--------------------------------------------------------|---------------------------------------------------------------------------|---------|------|-----------|-----------|--------|----------| -!! | im | horizontal_loop_extent | horizontal loop extent | count | 0 | integer | | in | F | -!! | levs | vertical_dimension | vertical layer dimension | count | 0 | integer | | in | F | -!! | ldiag3d | flag_diagnostics_3D | flag for 3d diagnostic fields | flag | 0 | logical | | in | F | -!! | cnvgwd | flag_convective_gravity_wave_drag | flag for conv gravity wave drag | flag | 0 | logical | | in | F | -!! | lgocart | flag_gocart | flag for 3d diagnostic fields for gocart 1 | flag | 0 | logical | | in | F | -!! | do_ca | flag_for_cellular_automata | cellular automata main switch | flag | 0 | logical | | in | F | -!! | isppt_deep | flag_for_combination_of_sppt_with_isppt_deep | switch for combination with isppt_deep. | flag | 0 | logical | | in | F | -!! | gu0 | x_wind_updated_by_physics | zonal wind updated by physics | m s-1 | 2 | real | kind_phys | in | F | -!! | gv0 | y_wind_updated_by_physics | meridional wind updated by physics | m s-1 | 2 | real | kind_phys | in | F | -!! | gt0 | air_temperature_updated_by_physics | temperature updated by physics | K | 2 | real | kind_phys | in | F | -!! | gq0_water_vapor | water_vapor_specific_humidity_updated_by_physics | water vapor specific humidity updated by physics | kg kg-1 | 2 | real | kind_phys | inout | F | -!! | save_u | x_wind_save | x-wind before entering a physics scheme | m s-1 | 2 | real | kind_phys | inout | F | -!! | save_v | y_wind_save | y-wind before entering a physics scheme | m s-1 | 2 | real | kind_phys | inout | F | -!! | save_t | air_temperature_save | air temperature before entering a physics scheme | K | 2 | real | kind_phys | inout | F | -!! | save_qv | water_vapor_specific_humidity_save | water vapor specific humidity before entering a physics scheme | kg kg-1 | 2 | real | kind_phys | inout | F | -!! | ca_deep | fraction_of_cellular_automata_for_deep_convection | fraction of cellular automata for deep convection | frac | 1 | real | kind_phys | in | F | -!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | -!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | +!! \htmlinclude GFS_DCNV_generic_pre_run.html !! #endif - subroutine GFS_DCNV_generic_pre_run (im, levs, ldiag3d, cnvgwd, lgocart, do_ca, & - isppt_deep, gu0, gv0, gt0, gq0_water_vapor, & - save_u, save_v, save_t, save_qv, ca_deep, & - errmsg, errflg) + subroutine GFS_DCNV_generic_pre_run (im, levs, ldiag3d, do_cnvgwd, do_ca, cplchm,& + isppt_deep, gu0, gv0, gt0, gq0_water_vapor, & + save_u, save_v, save_t, save_qv, ca_deep, & + dqdti, errmsg, errflg) - use machine, only: kind_phys + use machine, only: kind_phys implicit none integer, intent(in) :: im, levs - logical, intent(in) :: ldiag3d, cnvgwd, lgocart, do_ca, isppt_deep + logical, intent(in) :: ldiag3d, do_cnvgwd, do_ca, cplchm, isppt_deep real(kind=kind_phys), dimension(im,levs), intent(in) :: gu0 real(kind=kind_phys), dimension(im,levs), intent(in) :: gv0 real(kind=kind_phys), dimension(im,levs), intent(in) :: gt0 @@ -56,9 +37,12 @@ subroutine GFS_DCNV_generic_pre_run (im, levs, ldiag3d, cnvgwd, lgocart, do_ca, real(kind=kind_phys), dimension(im,levs), intent(inout) :: save_t real(kind=kind_phys), dimension(im,levs), intent(inout) :: save_qv real(kind=kind_phys), dimension(im), intent(in) :: ca_deep + ! dqdti only allocated if cplchm is .true. + real(kind=kind_phys), dimension(:,:), intent(inout) :: dqdti character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg + real(kind=kind_phys), parameter :: zero = 0.0d0 integer :: i, k ! Initialize CCPP error handling variables @@ -81,13 +65,25 @@ subroutine GFS_DCNV_generic_pre_run (im, levs, ldiag3d, cnvgwd, lgocart, do_ca, save_v(i,k) = gv0(i,k) enddo enddo - elseif (cnvgwd) then - save_t(1:im,:) = gt0(1:im,:) - endif ! end if_ldiag3d/cnvgwd + elseif (do_cnvgwd) then + do k=1,levs + do i=1,im + save_t(i,k) = gt0(i,k) + enddo + enddo + endif - if (ldiag3d .or. lgocart .or. isppt_deep) then - save_qv(1:im,:) = gq0_water_vapor(1:im,:) - endif ! end if_ldiag3d/lgocart + if (ldiag3d .or. cplchm .or. isppt_deep) then + do k=1,levs + do i=1,im + save_qv(i,k) = gq0_water_vapor(i,k) + enddo + enddo + endif + + if (cplchm) then + dqdti = zero + endif end subroutine GFS_DCNV_generic_pre_run @@ -103,74 +99,14 @@ end subroutine GFS_DCNV_generic_post_init subroutine GFS_DCNV_generic_post_finalize () end subroutine GFS_DCNV_generic_post_finalize -#if 0 !> \section arg_table_GFS_DCNV_generic_post_run Argument Table -!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | -!! |-----------------|---------------------------------------------------------------------------------------------|----------------------------------------------------------------------|---------------|------|-------------------|-----------|--------|----------| -!! | im | horizontal_loop_extent | horizontal loop extent | count | 0 | integer | | in | F | -!! | levs | vertical_dimension | vertical layer dimension | count | 0 | integer | | in | F | -!! | lssav | flag_diagnostics | logical flag for storing diagnostics | flag | 0 | logical | | in | F | -!! | ldiag3d | flag_diagnostics_3D | flag for 3d diagnostic fields | flag | 0 | logical | | in | F | -!! | lgocart | flag_gocart | flag for 3d diagnostic fields for gocart 1 | flag | 0 | logical | | in | F | -!! | ras | flag_for_ras_deep_convection | flag for ras convection scheme | flag | 0 | logical | | in | F | -!! | cscnv | flag_for_Chikira_Sugiyama_deep_convection | flag for Chikira-Sugiyama convection | flag | 0 | logical | | in | F | -!! | do_ca | flag_for_cellular_automata | cellular automata main switch | flag | 0 | logical | | in | F | -!! | isppt_deep | flag_for_combination_of_sppt_with_isppt_deep | switch for combination with isppt_deep. | flag | 0 | logical | | in | F | -!! | frain | dynamics_to_physics_timestep_ratio | ratio of dynamics timestep to physics timestep | none | 0 | real | kind_phys | in | F | -!! | rain1 | lwe_thickness_of_deep_convective_precipitation_amount | deep convective rainfall amount on physics timestep | m | 1 | real | kind_phys | in | F | -!! | dtf | time_step_for_dynamics | dynamics timestep | s | 0 | real | kind_phys | in | F | -!! | cld1d | cloud_work_function | cloud work function | m2 s-2 | 1 | real | kind_phys | in | F | -!! | save_u | x_wind_save | x-wind before entering a physics scheme | m s-1 | 2 | real | kind_phys | in | F | -!! | save_v | y_wind_save | y-wind before entering a physics scheme | m s-1 | 2 | real | kind_phys | in | F | -!! | save_t | air_temperature_save | air temperature before entering a physics scheme | K | 2 | real | kind_phys | in | F | -!! | save_qv | water_vapor_specific_humidity_save | water vapor specific humidity before entering a physics scheme | kg kg-1 | 2 | real | kind_phys | in | F | -!! | gu0 | x_wind_updated_by_physics | zonal wind updated by physics | m s-1 | 2 | real | kind_phys | in | F | -!! | gv0 | y_wind_updated_by_physics | meridional wind updated by physics | m s-1 | 2 | real | kind_phys | in | F | -!! | gt0 | air_temperature_updated_by_physics | temperature updated by physics | K | 2 | real | kind_phys | in | F | -!! | gq0_water_vapor | water_vapor_specific_humidity_updated_by_physics | water vapor specific humidity updated by physics | kg kg-1 | 2 | real | kind_phys | in | F | -!! | ud_mf | instantaneous_atmosphere_updraft_convective_mass_flux | (updraft mass flux) * delt | kg m-2 | 2 | real | kind_phys | in | F | -!! | dd_mf | instantaneous_atmosphere_downdraft_convective_mass_flux | (downdraft mass flux) * delt | kg m-2 | 2 | real | kind_phys | in | F | -!! | dt_mf | instantaneous_atmosphere_detrainment_convective_mass_flux | (detrainment mass flux) * delt | kg m-2 | 2 | real | kind_phys | in | F | -!! | con_g | gravitational_acceleration | gravitational acceleration | m s-2 | 0 | real | kind_phys | in | F | -!! | clw_ice | ice_water_mixing_ratio_convective_transport_tracer | moist (dry+vapor, no condensates) mixing ratio of ice water in the convectively transported tracer array | kg kg-1 | 2 | real | kind_phys | in | F | -!! | clw_liquid | cloud_condensed_water_mixing_ratio_convective_transport_tracer | moist (dry+vapor, no condensates) mixing ratio of cloud water (condensate) in the convectively transported tracer array | kg kg-1 | 2 | real | kind_phys | in | F | -!! | npdf3d | number_of_3d_arrays_associated_with_pdf-based_clouds | number of 3d arrays associated with pdf based clouds/mp | count | 0 | integer | | in | F | -!! | num_p3d | array_dimension_of_3d_arrays_for_microphysics | number of 3D arrays needed for microphysics | count | 0 | integer | | in | F | -!! | ncnvcld3d | number_of_convective_3d_cloud_fields | number of convective 3d clouds fields | count | 0 | integer | | in | F | -!! | rainc | lwe_thickness_of_convective_precipitation_amount_on_dynamics_timestep | convective rain at this time step | m | 1 | real | kind_phys | inout | F | -!! | cldwrk | cumulative_cloud_work_function | cumulative cloud work function (valid only with sas) | m2 s-1 | 1 | real | kind_phys | inout | F | -!! | cnvprcp | cumulative_lwe_thickness_of_convective_precipitation_amount | cumulative convective precipitation | m | 1 | real | kind_phys | inout | F | -!! | cnvprcpb | cumulative_lwe_thickness_of_convective_precipitation_amount_in_bucket | cumulative convective precipitation in bucket | m | 1 | real | kind_phys | inout | F | -!! | dt3dt | cumulative_change_in_temperature_due_to_deep_convection | cumulative change in temperature due to deep conv. | K | 2 | real | kind_phys | inout | F | -!! | dq3dt | cumulative_change_in_water_vapor_specific_humidity_due_to_deep_convection | cumulative change in water vapor specific humidity due to deep conv. | kg kg-1 | 2 | real | kind_phys | inout | F | -!! | du3dt | cumulative_change_in_x_wind_due_to_deep_convection | cumulative change in x wind due to deep convection | m s-1 | 2 | real | kind_phys | inout | F | -!! | dv3dt | cumulative_change_in_y_wind_due_to_deep_convection | cumulative change in y wind due to deep convection | m s-1 | 2 | real | kind_phys | inout | F | -!! | upd_mf | cumulative_atmosphere_updraft_convective_mass_flux | cumulative updraft mass flux | Pa | 2 | real | kind_phys | inout | F | -!! | dwn_mf | cumulative_atmosphere_downdraft_convective_mass_flux | cumulative downdraft mass flux | Pa | 2 | real | kind_phys | inout | F | -!! | det_mf | cumulative_atmosphere_detrainment_convective_mass_flux | cumulative detrainment mass flux | Pa | 2 | real | kind_phys | inout | F | -!! | dqdti | instantaneous_water_vapor_specific_humidity_tendency_due_to_convection | instantaneous moisture tendency due to convection | kg kg-1 s-1 | 2 | real | kind_phys | inout | F | -!! | cnvqci | instantaneous_deep_convective_cloud_condensate_mixing_ratio_on_dynamics_time_step | instantaneous total convective condensate mixing ratio | kg kg-1 | 2 | real | kind_phys | inout | F | -!! | upd_mfi | instantaneous_atmosphere_updraft_convective_mass_flux_on_dynamics_timestep | (updraft mass flux) * delt | kg m-2 | 2 | real | kind_phys | inout | F | -!! | dwn_mfi | instantaneous_atmosphere_downdraft_convective_mass_flux_on_dynamics_timestep | (downdraft mass flux) * delt | kg m-2 | 2 | real | kind_phys | inout | F | -!! | det_mfi | instantaneous_atmosphere_detrainment_convective_mass_flux_on_dynamics_timestep | (detrainment mass flux) * delt | kg m-2 | 2 | real | kind_phys | inout | F | -!! | cnvw | convective_cloud_water_mixing_ratio | moist convective cloud water mixing ratio | kg kg-1 | 2 | real | kind_phys | inout | F | -!! | cnvc | convective_cloud_cover | convective cloud cover | frac | 2 | real | kind_phys | inout | F | -!! | cnvw_phy_f3d | convective_cloud_water_mixing_ratio_in_phy_f3d | convective cloud water mixing ratio in the phy_f3d array | kg kg-1 | 2 | real | kind_phys | inout | F | -!! | cnvc_phy_f3d | convective_cloud_cover_in_phy_f3d | convective cloud cover in the phy_f3d array | frac | 2 | real | kind_phys | inout | F | -!! | cape | convective_available_potential_energy_for_coupling | convective available potential energy for coupling DH* CHECK THIS DOESN'T MAKE SENSE!!! *DH | m2 s-2 | 1 | real | kind_phys | inout | F | -!! | tconvtend | tendency_of_air_temperature_due_to_deep_convection_for_coupling_on_physics_timestep | tendency of air temperature due to deep convection | K | 2 | real | kind_phys | inout | F | -!! | qconvtend | tendency_of_water_vapor_specific_humidity_due_to_deep_convection_for_coupling_on_physics_timestep | tendency of specific humidity due to deep convection | kg kg-1 | 2 | real | kind_phys | inout | F | -!! | uconvtend | tendency_of_x_wind_due_to_deep_convection_for_coupling_on_physics_timestep | tendency_of_x_wind_due_to_deep_convection | m s-1 | 2 | real | kind_phys | inout | F | -!! | vconvtend | tendency_of_y_wind_due_to_deep_convection_for_coupling_on_physics_timestep | tendency_of_y_wind_due_to_deep_convection | m s-1 | 2 | real | kind_phys | inout | F | -!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | -!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | +!! \htmlinclude GFS_DCNV_generic_post_run.html !! -#endif - subroutine GFS_DCNV_generic_post_run (im, levs, lssav, ldiag3d, lgocart, ras, cscnv, do_ca, & + subroutine GFS_DCNV_generic_post_run (im, levs, lssav, ldiag3d, ras, cscnv, do_ca, & isppt_deep, frain, rain1, dtf, cld1d, save_u, save_v, save_t, save_qv, gu0, gv0, gt0, & - gq0_water_vapor, ud_mf, dd_mf, dt_mf, con_g, clw_ice, clw_liquid, npdf3d, num_p3d, ncnvcld3d, & - rainc, cldwrk, cnvprcp, cnvprcpb, dt3dt, dq3dt, du3dt, dv3dt, upd_mf, dwn_mf, det_mf, dqdti, & - cnvqci, upd_mfi, dwn_mfi, det_mfi, cnvw, cnvc, cnvw_phy_f3d, cnvc_phy_f3d, & + gq0_water_vapor, ud_mf, dd_mf, dt_mf, con_g, npdf3d, num_p3d, ncnvcld3d, & + rainc, cldwrk, dt3dt, dq3dt, du3dt, dv3dt, upd_mf, dwn_mf, det_mf, & + cnvw, cnvc, cnvw_phy_f3d, cnvc_phy_f3d, & cape, tconvtend, qconvtend, uconvtend, vconvtend, errmsg, errflg) use machine, only: kind_phys @@ -178,7 +114,7 @@ subroutine GFS_DCNV_generic_post_run (im, levs, lssav, ldiag3d, lgocart, ras, cs implicit none integer, intent(in) :: im, levs - logical, intent(in) :: lssav, ldiag3d, lgocart, ras, cscnv, do_ca, isppt_deep + logical, intent(in) :: lssav, ldiag3d, ras, cscnv, do_ca, isppt_deep real(kind=kind_phys), intent(in) :: frain, dtf real(kind=kind_phys), dimension(im), intent(in) :: rain1, cld1d @@ -186,22 +122,19 @@ subroutine GFS_DCNV_generic_post_run (im, levs, lssav, ldiag3d, lgocart, ras, cs real(kind=kind_phys), dimension(im,levs), intent(in) :: gu0, gv0, gt0, gq0_water_vapor real(kind=kind_phys), dimension(im,levs), intent(in) :: ud_mf, dd_mf, dt_mf real(kind=kind_phys), intent(in) :: con_g - real(kind=kind_phys), dimension(im,levs), intent(in) :: clw_ice, clw_liquid integer, intent(in) :: npdf3d, num_p3d, ncnvcld3d - real(kind=kind_phys), dimension(im), intent(inout) :: rainc, cldwrk, cnvprcp, cnvprcpb + real(kind=kind_phys), dimension(im), intent(inout) :: rainc, cldwrk ! dt3dt, dq3dt, du3dt, dv3dt upd_mf, dwn_mf, det_mf only allocated if ldiag3d == .true. real(kind=kind_phys), dimension(:,:), intent(inout) :: dt3dt, dq3dt, du3dt, dv3dt real(kind=kind_phys), dimension(:,:), intent(inout) :: upd_mf, dwn_mf, det_mf - ! dqdti, cnvqci, upd_mfi, dwn_mfi, det_mfi only allocated if ldiag3d == .true. or lgocart == .true. - real(kind=kind_phys), dimension(:,:), intent(inout) :: dqdti, cnvqci, upd_mfi, dwn_mfi, det_mfi real(kind=kind_phys), dimension(im,levs), intent(inout) :: cnvw, cnvc - ! DH* The following arrays may not be allocated, depending on certain flags and microphysics schemes. + ! The following arrays may not be allocated, depending on certain flags and microphysics schemes. ! Since Intel 15 crashes when passing unallocated arrays to arrays defined with explicit shape, ! use assumed-shape arrays. Note that Intel 18 and GNU 6.2.0-8.1.0 tolerate explicit-shape arrays ! as long as these do not get used when not allocated (it is still invalid Fortran code, though). real(kind=kind_phys), dimension(:,:), intent(inout) :: cnvw_phy_f3d, cnvc_phy_f3d - ! *DH + real(kind=kind_phys), dimension(im), intent(inout) :: cape real(kind=kind_phys), dimension(im,levs), intent(inout) :: tconvtend, qconvtend, uconvtend, vconvtend @@ -217,7 +150,7 @@ subroutine GFS_DCNV_generic_post_run (im, levs, lssav, ldiag3d, lgocart, ras, cs if (.not. ras .and. .not. cscnv) then if(do_ca) then do i=1,im - cape(i)=cld1d(i) + cape(i) = cld1d(i) enddo endif if (npdf3d == 3 .and. num_p3d == 4) then @@ -246,45 +179,35 @@ subroutine GFS_DCNV_generic_post_run (im, levs, lssav, ldiag3d, lgocart, ras, cs if (lssav) then do i=1,im cldwrk (i) = cldwrk (i) + cld1d(i) * dtf - cnvprcp(i) = cnvprcp(i) + rainc(i) - cnvprcpb(i) = cnvprcpb(i) + rainc(i) enddo if (ldiag3d) then do k=1,levs do i=1,im dt3dt(i,k) = dt3dt(i,k) + (gt0(i,k)-save_t(i,k)) * frain -! dq3dt(i,k) = dq3dt(i,k) + (gq0_water_vapor(i,k)-save_qv(i,k)) * frain +! dq3dt(i,k) = dq3dt(i,k) + (gq0_water_vapor(i,k)-save_qv(i,k)) * frain du3dt(i,k) = du3dt(i,k) + (gu0(i,k)-save_u(i,k)) * frain dv3dt(i,k) = dv3dt(i,k) + (gv0(i,k)-save_v(i,k)) * frain -! upd_mf(i,k) = upd_mf(i,k) + ud_mf(i,k) * (con_g*frain) -! dwn_mf(i,k) = dwn_mf(i,k) + dd_mf(i,k) * (con_g*frain) -! det_mf(i,k) = det_mf(i,k) + dt_mf(i,k) * (con_g*frain) +! upd_mf(i,k) = upd_mf(i,k) + ud_mf(i,k) * (con_g*frain) +! dwn_mf(i,k) = dwn_mf(i,k) + dd_mf(i,k) * (con_g*frain) +! det_mf(i,k) = det_mf(i,k) + dt_mf(i,k) * (con_g*frain) enddo enddo endif ! if (ldiag3d) endif ! if (lssav) - !update dqdt_v to include moisture tendency due to deep convection -! if (lgocart) then -! do k=1,levs -! do i=1,im -! dqdti (i,k) = (gq0_water_vapor(i,k) - save_qv(i,k)) * frain -! upd_mfi(i,k) = upd_mfi(i,k) + ud_mf(i,k) * frain -! dwn_mfi(i,k) = dwn_mfi(i,k) + dd_mf(i,k) * frain -! det_mfi(i,k) = det_mfi(i,k) + dt_mf(i,k) * frain -! cnvqci (i,k) = cnvqci (i,k) + (clw_ice(i,k)+clw_liquid(i,k))*frain -! enddo -! enddo -! endif ! if (lgocart) if (isppt_deep) then - tconvtend = gt0 - save_t - qconvtend = gq0_water_vapor - save_qv - uconvtend = gu0 - save_u - vconvtend = gv0 - save_v + do k=1,levs + do i=1,im + tconvtend(i,k) = gt0(i,k) - save_t(i,k) + qconvtend(i,k) = gq0_water_vapor(i,k) - save_qv(i,k) + uconvtend(i,k) = gu0(i,k) - save_u(i,k) + vconvtend(i,k) = gv0(i,k) - save_v(i,k) + enddo + enddo endif end subroutine GFS_DCNV_generic_post_run diff --git a/physics/GFS_DCNV_generic.meta b/physics/GFS_DCNV_generic.meta new file mode 100644 index 000000000..07c75eafc --- /dev/null +++ b/physics/GFS_DCNV_generic.meta @@ -0,0 +1,582 @@ +[ccpp-arg-table] + name = GFS_DCNV_generic_pre_run + type = scheme +[im] + standard_name = horizontal_loop_extent + long_name = horizontal loop extent + units = count + dimensions = () + type = integer + intent = in + optional = F +[levs] + standard_name = vertical_dimension + long_name = vertical layer dimension + units = count + dimensions = () + type = integer + intent = in + optional = F +[ldiag3d] + standard_name = flag_diagnostics_3D + long_name = flag for 3d diagnostic fields + units = flag + dimensions = () + type = logical + intent = in + optional = F +[do_cnvgwd] + standard_name = flag_for_convective_gravity_wave_drag + long_name = flag for convective gravity wave drag (gwd) + units = flag + dimensions = () + type = logical + intent = in + optional = F +[do_ca] + standard_name = flag_for_cellular_automata + long_name = cellular automata main switch + units = flag + dimensions = () + type = logical + intent = in + optional = F +[cplchm] + standard_name = flag_for_chemistry_coupling + long_name = flag controlling cplchm collection (default off) + units = flag + dimensions = () + type = logical + intent = in + optional = F +[isppt_deep] + standard_name = flag_for_combination_of_sppt_with_isppt_deep + long_name = switch for combination with isppt_deep. + units = flag + dimensions = () + type = logical + intent = in + optional = F +[gu0] + standard_name = x_wind_updated_by_physics + long_name = zonal wind updated by physics + units = m s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[gv0] + standard_name = y_wind_updated_by_physics + long_name = meridional wind updated by physics + units = m s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[gt0] + standard_name = air_temperature_updated_by_physics + long_name = temperature updated by physics + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[gq0_water_vapor] + standard_name = water_vapor_specific_humidity_updated_by_physics + long_name = water vapor specific humidity updated by physics + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[save_u] + standard_name = x_wind_save + long_name = x-wind before entering a physics scheme + units = m s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[save_v] + standard_name = y_wind_save + long_name = y-wind before entering a physics scheme + units = m s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[save_t] + standard_name = air_temperature_save + long_name = air temperature before entering a physics scheme + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[save_qv] + standard_name = water_vapor_specific_humidity_save + long_name = water vapor specific humidity before entering a physics scheme + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[ca_deep] + standard_name = fraction_of_cellular_automata_for_deep_convection + long_name = fraction of cellular automata for deep convection + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[dqdti] + standard_name = instantaneous_water_vapor_specific_humidity_tendency_due_to_convection + long_name = instantaneous moisture tendency due to convection + units = kg kg-1 s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F + +######################################################################## +[ccpp-arg-table] + name = GFS_DCNV_generic_post_run + type = scheme +[im] + standard_name = horizontal_loop_extent + long_name = horizontal loop extent + units = count + dimensions = () + type = integer + intent = in + optional = F +[levs] + standard_name = vertical_dimension + long_name = vertical layer dimension + units = count + dimensions = () + type = integer + intent = in + optional = F +[lssav] + standard_name = flag_diagnostics + long_name = logical flag for storing diagnostics + units = flag + dimensions = () + type = logical + intent = in + optional = F +[ldiag3d] + standard_name = flag_diagnostics_3D + long_name = flag for 3d diagnostic fields + units = flag + dimensions = () + type = logical + intent = in + optional = F +[ras] + standard_name = flag_for_ras_deep_convection + long_name = flag for ras convection scheme + units = flag + dimensions = () + type = logical + intent = in + optional = F +[cscnv] + standard_name = flag_for_Chikira_Sugiyama_deep_convection + long_name = flag for Chikira-Sugiyama convection + units = flag + dimensions = () + type = logical + intent = in + optional = F +[do_ca] + standard_name = flag_for_cellular_automata + long_name = cellular automata main switch + units = flag + dimensions = () + type = logical + intent = in + optional = F +[isppt_deep] + standard_name = flag_for_combination_of_sppt_with_isppt_deep + long_name = switch for combination with isppt_deep. + units = flag + dimensions = () + type = logical + intent = in + optional = F +[frain] + standard_name = dynamics_to_physics_timestep_ratio + long_name = ratio of dynamics timestep to physics timestep + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[rain1] + standard_name = lwe_thickness_of_deep_convective_precipitation_amount + long_name = deep convective rainfall amount on physics timestep + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[dtf] + standard_name = time_step_for_dynamics + long_name = dynamics timestep + units = s + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[cld1d] + standard_name = cloud_work_function + long_name = cloud work function + units = m2 s-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[save_u] + standard_name = x_wind_save + long_name = x-wind before entering a physics scheme + units = m s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[save_v] + standard_name = y_wind_save + long_name = y-wind before entering a physics scheme + units = m s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[save_t] + standard_name = air_temperature_save + long_name = air temperature before entering a physics scheme + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[save_qv] + standard_name = water_vapor_specific_humidity_save + long_name = water vapor specific humidity before entering a physics scheme + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[gu0] + standard_name = x_wind_updated_by_physics + long_name = zonal wind updated by physics + units = m s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[gv0] + standard_name = y_wind_updated_by_physics + long_name = meridional wind updated by physics + units = m s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[gt0] + standard_name = air_temperature_updated_by_physics + long_name = temperature updated by physics + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[gq0_water_vapor] + standard_name = water_vapor_specific_humidity_updated_by_physics + long_name = water vapor specific humidity updated by physics + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[ud_mf] + standard_name = instantaneous_atmosphere_updraft_convective_mass_flux + long_name = (updraft mass flux) * delt + units = kg m-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[dd_mf] + standard_name = instantaneous_atmosphere_downdraft_convective_mass_flux + long_name = (downdraft mass flux) * delt + units = kg m-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[dt_mf] + standard_name = instantaneous_atmosphere_detrainment_convective_mass_flux + long_name = (detrainment mass flux) * delt + units = kg m-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[con_g] + standard_name = gravitational_acceleration + long_name = gravitational acceleration + units = m s-2 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[npdf3d] + standard_name = number_of_3d_arrays_associated_with_pdf_based_clouds + long_name = number of 3d arrays associated with pdf based clouds/mp + units = count + dimensions = () + type = integer + intent = in + optional = F +[num_p3d] + standard_name = array_dimension_of_3d_arrays_for_microphysics + long_name = number of 3D arrays needed for microphysics + units = count + dimensions = () + type = integer + intent = in + optional = F +[ncnvcld3d] + standard_name = number_of_convective_3d_cloud_fields + long_name = number of convective 3d clouds fields + units = count + dimensions = () + type = integer + intent = in + optional = F +[rainc] + standard_name = lwe_thickness_of_convective_precipitation_amount_on_dynamics_timestep + long_name = convective rain at this time step + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[cldwrk] + standard_name = cumulative_cloud_work_function + long_name = cumulative cloud work function (valid only with sas) + units = m2 s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[dt3dt] + standard_name = cumulative_change_in_temperature_due_to_deep_convection + long_name = cumulative change in temperature due to deep conv. + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[dq3dt] + standard_name = cumulative_change_in_water_vapor_specific_humidity_due_to_deep_convection + long_name = cumulative change in water vapor specific humidity due to deep conv. + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[du3dt] + standard_name = cumulative_change_in_x_wind_due_to_deep_convection + long_name = cumulative change in x wind due to deep convection + units = m s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[dv3dt] + standard_name = cumulative_change_in_y_wind_due_to_deep_convection + long_name = cumulative change in y wind due to deep convection + units = m s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[upd_mf] + standard_name = cumulative_atmosphere_updraft_convective_mass_flux + long_name = cumulative updraft mass flux + units = Pa + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[dwn_mf] + standard_name = cumulative_atmosphere_downdraft_convective_mass_flux + long_name = cumulative downdraft mass flux + units = Pa + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[det_mf] + standard_name = cumulative_atmosphere_detrainment_convective_mass_flux + long_name = cumulative detrainment mass flux + units = Pa + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[cnvw] + standard_name = convective_cloud_water_mixing_ratio + long_name = moist convective cloud water mixing ratio + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[cnvc] + standard_name = convective_cloud_cover + long_name = convective cloud cover + units = frac + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[cnvw_phy_f3d] + standard_name = convective_cloud_water_mixing_ratio_in_phy_f3d + long_name = convective cloud water mixing ratio in the phy_f3d array + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[cnvc_phy_f3d] + standard_name = convective_cloud_cover_in_phy_f3d + long_name = convective cloud cover in the phy_f3d array + units = frac + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[cape] + standard_name = convective_available_potential_energy_for_coupling + long_name = convective available potential energy for coupling + units = m2 s-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[tconvtend] + standard_name = tendency_of_air_temperature_due_to_deep_convection_for_coupling_on_physics_timestep + long_name = tendency of air temperature due to deep convection + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[qconvtend] + standard_name = tendency_of_water_vapor_specific_humidity_due_to_deep_convection_for_coupling_on_physics_timestep + long_name = tendency of specific humidity due to deep convection + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[uconvtend] + standard_name = tendency_of_x_wind_due_to_deep_convection_for_coupling_on_physics_timestep + long_name = tendency_of_x_wind_due_to_deep_convection + units = m s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[vconvtend] + standard_name = tendency_of_y_wind_due_to_deep_convection_for_coupling_on_physics_timestep + long_name = tendency_of_y_wind_due_to_deep_convection + units = m s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F diff --git a/physics/GFS_GWD_generic.F90 b/physics/GFS_GWD_generic.F90 new file mode 100644 index 000000000..0915dd170 --- /dev/null +++ b/physics/GFS_GWD_generic.F90 @@ -0,0 +1,166 @@ +!> \file GFS_GWD_generic.f +!! This file contains the CCPP-compliant orographic gravity wave +!! drag pre interstitial codes. + +module GFS_GWD_generic_pre + +contains + + subroutine GFS_GWD_generic_pre_init() + end subroutine GFS_GWD_generic_pre_init + +!! \section arg_table_GFS_GWD_generic_pre_run Argument Table +!! \htmlinclude GFS_GWD_generic_pre_run.html +!! +!! \section general General Algorithm +!! \section detailed Detailed Algorithm +!! @{ + subroutine GFS_GWD_generic_pre_run( & + & im, levs, nmtvr, mntvar, & + & oc, oa4, clx, theta, & + & sigma, gamma, elvmax, lssav, ldiag3d, & + & dtdt, dt3dt, dtf, errmsg, errflg) + + use machine, only : kind_phys + implicit none + + integer, intent(in) :: im, levs, nmtvr + real(kind=kind_phys), intent(in) :: mntvar(im,nmtvr) + + real(kind=kind_phys), intent(out) :: & + & oc(im), oa4(im,4), clx(im,4), & + & theta(im), sigma(im), gamma(im), elvmax(im) + + logical, intent(in) :: lssav, ldiag3d + real(kind=kind_phys), intent(in) :: dtdt(im,levs) + ! dt3dt only allocated only if ldiag3d is .true. + real(kind=kind_phys), intent(inout) :: dt3dt(:,:) + real(kind=kind_phys), intent(in) :: dtf + + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + integer :: i, k + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + if (nmtvr == 14) then ! current operational - as of 2014 + oc(:) = mntvar(:,2) + oa4(:,1) = mntvar(:,3) + oa4(:,2) = mntvar(:,4) + oa4(:,3) = mntvar(:,5) + oa4(:,4) = mntvar(:,6) + clx(:,1) = mntvar(:,7) + clx(:,2) = mntvar(:,8) + clx(:,3) = mntvar(:,9) + clx(:,4) = mntvar(:,10) + theta(:) = mntvar(:,11) + gamma(:) = mntvar(:,12) + sigma(:) = mntvar(:,13) + elvmax(:) = mntvar(:,14) + elseif (nmtvr == 10) then + oc(:) = mntvar(:,2) + oa4(:,1) = mntvar(:,3) + oa4(:,2) = mntvar(:,4) + oa4(:,3) = mntvar(:,5) + oa4(:,4) = mntvar(:,6) + clx(:,1) = mntvar(:,7) + clx(:,2) = mntvar(:,8) + clx(:,3) = mntvar(:,9) + clx(:,4) = mntvar(:,10) + elseif (nmtvr == 6) then + oc(:) = mntvar(:,2) + oa4(:,1) = mntvar(:,3) + oa4(:,2) = mntvar(:,4) + oa4(:,3) = mntvar(:,5) + oa4(:,4) = mntvar(:,6) + clx(:,1) = 0.0 + clx(:,2) = 0.0 + clx(:,3) = 0.0 + clx(:,4) = 0.0 + else + oc = 0 + oa4 = 0 + clx = 0 + theta = 0 + gamma = 0 + sigma = 0 + elvmax = 0 + endif ! end if_nmtvr + + if (lssav) then + if (ldiag3d) then + do k=1,levs + do i=1,im + dt3dt(i,k) = dt3dt(i,k) - dtdt(i,k)*dtf + enddo + enddo + endif + endif + + end subroutine GFS_GWD_generic_pre_run +!> @} + + subroutine GFS_GWD_generic_pre_finalize() + end subroutine GFS_GWD_generic_pre_finalize + +end module GFS_GWD_generic_pre + +!> This module contains the CCPP-compliant orographic gravity wave drag post +!! interstitial codes. +module GFS_GWD_generic_post + +contains + + + subroutine GFS_GWD_generic_post_init() + end subroutine GFS_GWD_generic_post_init + +!! \section arg_table_GFS_GWD_generic_post_run Argument Table +!! \htmlinclude GFS_GWD_generic_post_run.html +!! +!! \section general General Algorithm +!! \section detailed Detailed Algorithm +!! @{ + subroutine GFS_GWD_generic_post_run(lssav, ldiag3d, dtf, dusfcg, dvsfcg, dudt, dvdt, dtdt, & + & dugwd, dvgwd, du3dt, dv3dt, dt3dt, errmsg, errflg) + + use machine, only : kind_phys + implicit none + + logical, intent(in) :: lssav, ldiag3d + + real(kind=kind_phys), intent(in) :: dusfcg(:), dvsfcg(:) + real(kind=kind_phys), intent(in) :: dudt(:,:), dvdt(:,:), dtdt(:,:) + real(kind=kind_phys), intent(in) :: dtf + + real(kind=kind_phys), intent(inout) :: dugwd(:), dvgwd(:) + real(kind=kind_phys), intent(inout) :: du3dt(:,:), dv3dt(:,:), dt3dt(:,:) + + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + if (lssav) then + dugwd(:) = dugwd(:) + dusfcg(:)*dtf + dvgwd(:) = dvgwd(:) + dvsfcg(:)*dtf + + if (ldiag3d) then + du3dt(:,:) = du3dt(:,:) + dudt(:,:) * dtf + dv3dt(:,:) = dv3dt(:,:) + dvdt(:,:) * dtf + dt3dt(:,:) = dt3dt(:,:) + dtdt(:,:) * dtf + endif + endif + + end subroutine GFS_GWD_generic_post_run +!> @} + + subroutine GFS_GWD_generic_post_finalize() + end subroutine GFS_GWD_generic_post_finalize + +end module GFS_GWD_generic_post diff --git a/physics/GFS_GWD_generic.meta b/physics/GFS_GWD_generic.meta new file mode 100644 index 000000000..94a4abab1 --- /dev/null +++ b/physics/GFS_GWD_generic.meta @@ -0,0 +1,306 @@ +[ccpp-arg-table] + name = GFS_GWD_generic_pre_init + type = scheme + +######################################################################## +[ccpp-arg-table] + name = GFS_GWD_generic_pre_run + type = scheme +[im] + standard_name = horizontal_loop_extent + long_name = horizontal dimension + units = count + dimensions = () + type = integer + intent = in + optional = F +[levs] + standard_name = vertical_dimension + long_name = vertical layer dimension + units = count + dimensions = () + type = integer + intent = in + optional = F +[nmtvr] + standard_name = number_of_statistical_measures_of_subgrid_orography + long_name = number of statistical measures of subgrid orography + units = count + dimensions = () + type = integer + intent = in + optional = F +[mntvar] + standard_name = statistical_measures_of_subgrid_orography + long_name = array of statistical measures of subgrid orography + units = various + dimensions = (horizontal_dimension,number_of_statistical_measures_of_subgrid_orography) + type = real + kind = kind_phys + intent = in + optional = F +[oc] + standard_name = convexity_of_subgrid_orography + long_name = convexity of subgrid orography + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[oa4] + standard_name = asymmetry_of_subgrid_orography + long_name = asymmetry of subgrid orography + units = none + dimensions = (horizontal_dimension,4) + type = real + kind = kind_phys + intent = out + optional = F +[clx] + standard_name = fraction_of_grid_box_with_subgrid_orography_higher_than_critical_height + long_name = horizontal fraction of grid box covered by subgrid orography higher than critical height + units = frac + dimensions = (horizontal_dimension,4) + type = real + kind = kind_phys + intent = out + optional = F +[theta] + standard_name = angle_from_east_of_maximum_subgrid_orographic_variations + long_name = angle with_respect to east of maximum subgrid orographic variations + units = degrees + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[sigma] + standard_name = slope_of_subgrid_orography + long_name = slope of subgrid orography + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[gamma] + standard_name = anisotropy_of_subgrid_orography + long_name = anisotropy of subgrid orography + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[elvmax] + standard_name = maximum_subgrid_orography + long_name = maximum of subgrid orography + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[lssav] + standard_name = flag_diagnostics + long_name = logical flag for storing diagnostics + units = flag + dimensions = () + type = logical + intent = in + optional = F +[ldiag3d] + standard_name = flag_diagnostics_3D + long_name = flag for 3d diagnostic fields + units = flag + dimensions = () + type = logical + intent = in + optional = F +[dtdt] + standard_name = tendency_of_air_temperature_due_to_model_physics + long_name = updated tendency of the temperature + units = K s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[dt3dt] + standard_name = cumulative_change_in_temperature_due_to_orographic_gravity_wave_drag + long_name = cumulative change in temperature due to orographic gravity wave drag + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[dtf] + standard_name = time_step_for_dynamics + long_name = dynamics timestep + units = s + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F + +######################################################################## +[ccpp-arg-table] + name = GFS_GWD_generic_pre_finalize + type = scheme + +######################################################################## +[ccpp-arg-table] + name = GFS_GWD_generic_post_run + type = scheme +[lssav] + standard_name = flag_diagnostics + long_name = flag for calculating diagnostic fields + units = flag + dimensions = () + type = logical + intent = in + optional = F +[ldiag3d] + standard_name = flag_diagnostics_3D + long_name = flag for calculating 3-D diagnostic fields + units = flag + dimensions = () + type = logical + intent = in + optional = F +[dtf] + standard_name = time_step_for_dynamics + long_name = dynamics time step + units = s + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[dusfcg] + standard_name = instantaneous_x_stress_due_to_gravity_wave_drag + long_name = zonal surface stress due to orographic gravity wave drag + units = Pa + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[dvsfcg] + standard_name = instantaneous_y_stress_due_to_gravity_wave_drag + long_name = meridional surface stress due to orographic gravity wave drag + units = Pa + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[dudt] + standard_name = tendency_of_x_wind_due_to_model_physics + long_name = zonal wind tendency due to model physics + units = m s-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[dvdt] + standard_name = tendency_of_y_wind_due_to_model_physics + long_name = meridional wind tendency due to model physics + units = m s-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[dtdt] + standard_name = tendency_of_air_temperature_due_to_model_physics + long_name = air temperature tendency due to model physics + units = K s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[dugwd] + standard_name = time_integral_of_x_stress_due_to_gravity_wave_drag + long_name = integral over time of zonal stress due to gravity wave drag + units = Pa s + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[dvgwd] + standard_name = time_integral_of_y_stress_due_to_gravity_wave_drag + long_name = integral over time of meridional stress due to gravity wave drag + units = Pa s + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[du3dt] + standard_name = cumulative_change_in_x_wind_due_to_orographic_gravity_wave_drag + long_name = cumulative change in zonal wind due to orographic gravity wave drag + units = m s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[dv3dt] + standard_name = cumulative_change_in_y_wind_due_to_orographic_gravity_wave_drag + long_name = cumulative change in meridional wind due to orographic gravity wave drag + units = m s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[dt3dt] + standard_name = cumulative_change_in_temperature_due_to_orographic_gravity_wave_drag + long_name = cumulative change in temperature due to orographic gravity wave drag + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F diff --git a/physics/GFS_MP_generic.F90 b/physics/GFS_MP_generic.F90 index 0aeada850..f72f9405a 100644 --- a/physics/GFS_MP_generic.F90 +++ b/physics/GFS_MP_generic.F90 @@ -14,21 +14,7 @@ end subroutine GFS_MP_generic_pre_init !> \section arg_table_GFS_MP_generic_pre_run Argument Table -!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | -!! |----------------|--------------------------------------------------------|---------------------------------------------------------------------------|-------------|------|-----------|-----------|--------|----------| -!! | im | horizontal_loop_extent | horizontal loop extent | count | 0 | integer | | in | F | -!! | levs | vertical_dimension | vertical layer dimension | count | 0 | integer | | in | F | -!! | ldiag3d | flag_diagnostics_3D | logical flag for 3D diagnostics | flag | 0 | logical | | in | F | -!! | do_aw | flag_for_Arakawa_Wu_adjustment | flag for Arakawa Wu scale-aware adjustment | flag | 0 | logical | | in | F | -!! | ntcw | index_for_liquid_cloud_condensate | tracer index for cloud condensate (or liquid water) | index | 0 | integer | | in | F | -!! | nncl | number_of_tracers_for_cloud_condensate | number of tracers for cloud condensate | count | 0 | integer | | in | F | -!! | ntrac | number_of_tracers | number of tracers | count | 0 | integer | | in | F | -!! | gt0 | air_temperature_updated_by_physics | temperature updated by physics | K | 2 | real | kind_phys | in | F | -!! | gq0 | tracer_concentration_updated_by_physics | tracer concentration updated by physics | kg kg-1 | 3 | real | kind_phys | in | F | -!! | save_t | air_temperature_save | air temperature before entering a physics scheme | K | 2 | real | kind_phys | inout | F | -!! | save_q | tracer_concentration_save | tracer concentration before entering a physics scheme | kg kg-1 | 3 | real | kind_phys | inout | F | -!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | -!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | +!! \htmlinclude GFS_MP_generic_pre_run.html !! subroutine GFS_MP_generic_pre_run(im, levs, ldiag3d, do_aw, ntcw, nncl, ntrac, gt0, gq0, save_t, save_q, errmsg, errflg) ! @@ -84,107 +70,30 @@ module GFS_MP_generic_post subroutine GFS_MP_generic_post_init end subroutine GFS_MP_generic_post_init -!>\defgroup gfs_calpreciptype GFS/GFDL calpreciptype Main +!>\defgroup gfs_calpreciptype GFS Precipitation Type Diagnostics Module !! \brief If dominant precip type is requested (i.e., Zhao-Carr MP scheme), 4 more algorithms in calpreciptype() !! will be called. the tallies are then summed in calwxt_dominant(). For GFDL cloud MP scheme, determine convective !! rain/snow by surface temperature; and determine explicit rain/snow by rain/snow coming out directly from MP. !! !! \section arg_table_GFS_MP_generic_post_run Argument Table -!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | -!! |------------------|-------------------------------------------------------------------------|-------------------------------------------------------------------------|-------------|------|------------|-----------|--------|----------| -!! | im | horizontal_loop_extent | horizontal loop extent | count | 0 | integer | | in | F | -!! | ix | horizontal_dimension | horizontal dimension | count | 0 | integer | | in | F | -!! | levs | vertical_dimension | vertical layer dimension | count | 0 | integer | | in | F | -!! | kdt | index_of_time_step | current time step index | index | 0 | integer | | in | F | -!! | nrcm | array_dimension_of_random_number | second dimension of random number stream for RAS | count | 0 | integer | | in | F | -!! | ncld | number_of_hydrometeors | choice of cloud scheme / number of hydrometeors | count | 0 | integer | | in | F | -!! | nncl | number_of_tracers_for_cloud_condensate | number of tracers for cloud condensate | count | 0 | integer | | in | F | -!! | ntcw | index_for_liquid_cloud_condensate | tracer index for cloud condensate (or liquid water) | index | 0 | integer | | in | F | -!! | ntrac | number_of_tracers | number of tracers | count | 0 | integer | | in | F | -!! | imp_physics | flag_for_microphysics_scheme | choice of microphysics scheme | flag | 0 | integer | | in | F | -!! | imp_physics_gfdl | flag_for_gfdl_microphysics_scheme | choice of GFDL microphysics scheme | flag | 0 | integer | | in | F | -!! | imp_physics_thompson | flag_for_thompson_microphysics_scheme | choice of Thompson microphysics scheme | flag | 0 | integer | | in | F | -!! | cal_pre | flag_for_precipitation_type_algorithm | flag controls precip type algorithm | flag | 0 | logical | | in | F | -!! | lssav | flag_diagnostics | logical flag for storing diagnostics | flag | 0 | logical | | in | F | -!! | ldiag3d | flag_diagnostics_3D | flag for 3d diagnostic fields | flag | 0 | logical | | in | F | -!! | cplflx | flag_for_flux_coupling | flag controlling cplflx collection (default off) | flag | 0 | logical | | in | F | -!! | cplchm | flag_for_chemistry_coupling | flag controlling cplchm collection (default off) | flag | 0 | logical | | in | F | -!! | con_g | gravitational_acceleration | gravitational acceleration | m s-2 | 0 | real | kind_phys | in | F | -!! | dtf | time_step_for_dynamics | dynamics timestep | s | 0 | real | kind_phys | in | F | -!! | frain | dynamics_to_physics_timestep_ratio | ratio of dynamics timestep to physics timestep | none | 0 | real | kind_phys | in | F | -!! | rainc | lwe_thickness_of_convective_precipitation_amount_on_dynamics_timestep | convective rain at this time step | m | 1 | real | kind_phys | in | F | -!! | rain1 | lwe_thickness_of_explicit_precipitation_amount | explicit rainfall amount on physics timestep | m | 1 | real | kind_phys | in | F | -!! | rann | random_number_array | random number array (0-1) | none | 2 | real | kind_phys | in | F | -!! | xlat | latitude | latitude | radians | 1 | real | kind_phys | in | F | -!! | xlon | longitude | longitude | radians | 1 | real | kind_phys | in | F | -!! | gt0 | air_temperature_updated_by_physics | temperature updated by physics | K | 2 | real | kind_phys | in | F | -!! | gq0 | tracer_concentration_updated_by_physics | tracer concentration updated by physics | kg kg-1 | 3 | real | kind_phys | in | F | -!! | prsl | air_pressure | layer mean pressure | Pa | 2 | real | kind_phys | in | F | -!! | prsi | air_pressure_at_interface | pressure at layer interface | Pa | 2 | real | kind_phys | in | F | -!! | phii | geopotential_at_interface | geopotential at model layer interfaces | m2 s-2 | 2 | real | kind_phys | in | F | -!! | tsfc | surface_skin_temperature | surface skin temperature | K | 1 | real | kind_phys | in | F | -!! | ice | lwe_thickness_of_ice_amount_on_dynamics_timestep | ice fall at this time step | m | 1 | real | kind_phys | inout | F | -!! | snow | lwe_thickness_of_snow_amount_on_dynamics_timestep | snow fall at this time step | m | 1 | real | kind_phys | inout | F | -!! | graupel | lwe_thickness_of_graupel_amount_on_dynamics_timestep | graupel fall at this time step | m | 1 | real | kind_phys | inout | F | -!! | save_t | air_temperature_save | air temperature before entering a physics scheme | K | 2 | real | kind_phys | in | F | -!! | save_qv | water_vapor_specific_humidity_save | water vapor specific humidity before entering a physics scheme | kg kg-1 | 2 | real | kind_phys | in | F | -!! | rain0 | lwe_thickness_of_explicit_rain_amount | explicit rain on physics timestep | m | 1 | real | kind_phys | in | F | -!! | ice0 | lwe_thickness_of_ice_amount | ice fall on physics timestep | m | 1 | real | kind_phys | in | F | -!! | snow0 | lwe_thickness_of_snow_amount | snow fall on physics timestep | m | 1 | real | kind_phys | in | F | -!! | graupel0 | lwe_thickness_of_graupel_amount | graupel fall on physics timestep | m | 1 | real | kind_phys | in | F | -!! | del | air_pressure_difference_between_midlayers | air pressure difference between midlayers | Pa | 2 | real | kind_phys | in | F | -!! | rain | lwe_thickness_of_precipitation_amount_on_dynamics_timestep | total rain at this time step | m | 1 | real | kind_phys | inout | F | -!! | domr_diag | dominant_rain_type | dominant rain type | none | 1 | real | kind_phys | inout | F | -!! | domzr_diag | dominant_freezing_rain_type | dominant freezing rain type | none | 1 | real | kind_phys | inout | F | -!! | domip_diag | dominant_sleet_type | dominant sleet type | none | 1 | real | kind_phys | inout | F | -!! | doms_diag | dominant_snow_type | dominant snow type | none | 1 | real | kind_phys | inout | F | -!! | tprcp | nonnegative_lwe_thickness_of_precipitation_amount_on_dynamics_timestep | total precipitation amount in each time step | m | 1 | real | kind_phys | inout | F | -!! | srflag | flag_for_precipitation_type | snow/rain flag for precipitation | flag | 1 | real | kind_phys | inout | F | -!! | totprcp | accumulated_lwe_thickness_of_precipitation_amount | accumulated total precipitation | m | 1 | real | kind_phys | inout | F | -!! | totice | accumulated_lwe_thickness_of_ice_amount | accumulated ice precipitation | kg m-2 | 1 | real | kind_phys | inout | F | -!! | totsnw | accumulated_lwe_thickness_of_snow_amount | accumulated snow precipitation | kg m-2 | 1 | real | kind_phys | inout | F | -!! | totgrp | accumulated_lwe_thickness_of_graupel_amount | accumulated graupel precipitation | kg m-2 | 1 | real | kind_phys | inout | F | -!! | totprcpb | accumulated_lwe_thickness_of_precipitation_amount_in_bucket | accumulated total precipitation in bucket | m | 1 | real | kind_phys | inout | F | -!! | toticeb | accumulated_lwe_thickness_of_ice_amount_in_bucket | accumulated ice precipitation in bucket | kg m-2 | 1 | real | kind_phys | inout | F | -!! | totsnwb | accumulated_lwe_thickness_of_snow_amount_in_bucket | accumulated snow precipitation in bucket | kg m-2 | 1 | real | kind_phys | inout | F | -!! | totgrpb | accumulated_lwe_thickness_of_graupel_amount_in_bucket | accumulated graupel precipitation in bucket | kg m-2 | 1 | real | kind_phys | inout | F | -!! | dt3dt | cumulative_change_in_temperature_due_to_microphysics | cumulative change in temperature due to microphysics | K | 2 | real | kind_phys | inout | F | -!! | dq3dt | cumulative_change_in_water_vapor_specific_humidity_due_to_microphysics | cumulative change in water vapor specific humidity due to microphysics | kg kg-1 | 2 | real | kind_phys | inout | F | -!! | rain_cpl | lwe_thickness_of_precipitation_amount_for_coupling | total rain precipitation | m | 1 | real | kind_phys | inout | F | -!! | rainc_cpl | lwe_thickness_of_convective_precipitation_amount_for_coupling | total convective precipitation | m | 1 | real | kind_phys | inout | F | -!! | snow_cpl | lwe_thickness_of_snow_amount_for_coupling | total snow precipitation | m | 1 | real | kind_phys | inout | F | -!! | pwat | column_precipitable_water | precipitable water | kg m-2 | 1 | real | kind_phys | inout | F | -!! | do_sppt | flag_for_stochastic_surface_physics_perturbations | flag for stochastic surface physics perturbations | flag | 0 | logical | | in | F | -!! | dtdtr | tendency_of_air_temperature_due_to_radiative_heating_on_physics_time_step| temp. change due to radiative heating per time step | K | 2 | real | kind_phys | inout | F | -!! | dtdtc | tendency_of_air_temperature_due_to_radiative_heating_assuming_clear_sky | clear sky radiative (shortwave + longwave) heating rate at current time | K s-1 | 2 | real | kind_phys | in | F | -!! | drain_cpl | tendency_of_lwe_thickness_of_precipitation_amount_for_coupling | change in rain_cpl (coupling_type) | m | 1 | real | kind_phys | inout | F | -!! | dsnow_cpl | tendency_of_lwe_thickness_of_snow_amount_for_coupling | change in show_cpl (coupling_type) | m | 1 | real | kind_phys | inout | F | -!! | lsm | flag_for_land_surface_scheme | flag for land surface model | flag | 0 | integer | | in | F | -!! | lsm_ruc | flag_for_ruc_land_surface_scheme | flag for RUC land surface model | flag | 0 | integer | | in | F | -!! | raincprv | lwe_thickness_of_explicit_rainfall_amount_from_previous_timestep | explicit rainfall from previous timestep | m | 1 | real | kind_phys | inout | F | -!! | rainncprv | lwe_thickness_of_convective_precipitation_amount_from_previous_timestep | convective_precipitation_amount from previous timestep | m | 1 | real | kind_phys | inout | F | -!! | iceprv | lwe_thickness_of_ice_amount_from_previous_timestep | ice amount from previous timestep | m | 1 | real | kind_phys | inout | F | -!! | snowprv | lwe_thickness_of_snow_amount_from_previous_timestep | snow amount from previous timestep | m | 1 | real | kind_phys | inout | F | -!! | graupelprv | lwe_thickness_of_graupel_amount_from_previous_timestep | graupel amount from previous timestep | m | 1 | real | kind_phys | inout | F | -!! | dtp | time_step_for_physics | physics timestep | s | 0 | real | kind_phys | in | F | -!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | -!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | +!! \htmlinclude GFS_MP_generic_post_run.html !! !> \section gfs_mp_gen GFS MP Generic Post General Algorithm !> @{ subroutine GFS_MP_generic_post_run(im, ix, levs, kdt, nrcm, ncld, nncl, ntcw, ntrac, imp_physics, imp_physics_gfdl, & - imp_physics_thompson, cal_pre, lssav, ldiag3d, cplflx, cplchm, con_g, dtf, frain, rainc, rain1, rann, xlat, xlon, & - gt0, gq0, prsl, prsi, phii, tsfc, ice, snow, graupel, save_t, save_qv, rain0, ice0, snow0, graupel0, del, & - rain, domr_diag, domzr_diag, domip_diag, doms_diag, tprcp, srflag, totprcp, totice, totsnw, & - totgrp, totprcpb, toticeb, totsnwb, totgrpb, dt3dt, dq3dt, rain_cpl, rainc_cpl, snow_cpl, pwat, & - do_sppt, dtdtr, dtdtc, drain_cpl, dsnow_cpl, lsm, lsm_ruc, raincprv, rainncprv, iceprv, snowprv, graupelprv, & - dtp, errmsg, errflg) + imp_physics_thompson, imp_physics_mg, imp_physics_fer_hires, cal_pre, lssav, ldiag3d, cplflx, cplchm, con_g, dtf, frain, rainc, rain1, & + rann, xlat, xlon, gt0, gq0, prsl, prsi, phii, tsfc, ice, snow, graupel, save_t, save_qv, rain0, ice0, snow0, & + graupel0, del, rain, domr_diag, domzr_diag, domip_diag, doms_diag, tprcp, srflag, sr, cnvprcp, totprcp, totice, & + totsnw, totgrp, cnvprcpb, totprcpb, toticeb, totsnwb, totgrpb, dt3dt, dq3dt, rain_cpl, rainc_cpl, snow_cpl, pwat, & + do_sppt, dtdtr, dtdtc, drain_cpl, dsnow_cpl, lsm, lsm_ruc, lsm_noahmp, raincprv, rainncprv, iceprv, snowprv, & + graupelprv, draincprv, drainncprv, diceprv, dsnowprv, dgraupelprv, dtp, errmsg, errflg) ! use machine, only: kind_phys implicit none - integer, intent(in) :: im, ix, levs, kdt, nrcm, ncld, nncl, ntcw, ntrac, imp_physics, imp_physics_gfdl, imp_physics_thompson + integer, intent(in) :: im, ix, levs, kdt, nrcm, ncld, nncl, ntcw, ntrac + integer, intent(in) :: imp_physics, imp_physics_gfdl, imp_physics_thompson, imp_physics_mg, imp_physics_fer_hires logical, intent(in) :: cal_pre, lssav, ldiag3d, cplflx, cplchm real(kind=kind_phys), intent(in) :: dtf, frain, con_g @@ -196,9 +105,13 @@ subroutine GFS_MP_generic_post_run(im, ix, levs, kdt, nrcm, ncld, nncl, ntcw, nt real(kind=kind_phys), dimension(im,levs+1), intent(in) :: prsi, phii real(kind=kind_phys), dimension(im,levs,ntrac), intent(in) :: gq0 - real(kind=kind_phys), dimension(im), intent(inout) :: rain, domr_diag, domzr_diag, domip_diag, doms_diag, tprcp, & - srflag, totprcp, totice, totsnw, totgrp, totprcpb, toticeb, totsnwb, totgrpb, rain_cpl, rainc_cpl, snow_cpl, pwat - real(kind=kind_phys), dimension(im,levs), intent(inout) :: dt3dt, dq3dt + real(kind=kind_phys), dimension(im), intent(in ) :: sr + real(kind=kind_phys), dimension(im), intent(inout) :: rain, domr_diag, domzr_diag, domip_diag, doms_diag, tprcp, & + srflag, cnvprcp, totprcp, totice, totsnw, totgrp, cnvprcpb, & + totprcpb, toticeb, totsnwb, totgrpb, rain_cpl, rainc_cpl, & + snow_cpl, pwat + ! These arrays are only allocated if ldiag3d is .true. + real(kind=kind_phys), dimension(:,:), intent(inout) :: dt3dt, dq3dt ! Stochastic physics / surface perturbations logical, intent(in) :: do_sppt @@ -207,13 +120,18 @@ subroutine GFS_MP_generic_post_run(im, ix, levs, kdt, nrcm, ncld, nncl, ntcw, nt real(kind=kind_phys), dimension(im), intent(inout) :: drain_cpl real(kind=kind_phys), dimension(im), intent(inout) :: dsnow_cpl - ! Rainfall variables previous time step (update for RUC LSM) - integer, intent(in) :: lsm, lsm_ruc + ! Rainfall variables previous time step + integer, intent(in) :: lsm, lsm_ruc, lsm_noahmp real(kind=kind_phys), dimension(im), intent(inout) :: raincprv real(kind=kind_phys), dimension(im), intent(inout) :: rainncprv real(kind=kind_phys), dimension(im), intent(inout) :: iceprv real(kind=kind_phys), dimension(im), intent(inout) :: snowprv real(kind=kind_phys), dimension(im), intent(inout) :: graupelprv + real(kind=kind_phys), dimension(im), intent(inout) :: draincprv + real(kind=kind_phys), dimension(im), intent(inout) :: drainncprv + real(kind=kind_phys), dimension(im), intent(inout) :: diceprv + real(kind=kind_phys), dimension(im), intent(inout) :: dsnowprv + real(kind=kind_phys), dimension(im), intent(inout) :: dgraupelprv real(kind=kind_phys), intent(in) :: dtp @@ -223,16 +141,14 @@ subroutine GFS_MP_generic_post_run(im, ix, levs, kdt, nrcm, ncld, nncl, ntcw, nt ! DH* TODO: CLEANUP, all of these should be coming in through the argument list real(kind=kind_phys), parameter :: con_p001= 0.001d0 - real(kind=kind_phys), parameter :: con_day = 86400.d0 -#ifdef TRANSITION + real(kind=kind_phys), parameter :: con_day = 86400.0d0 real(kind=kind_phys), parameter :: rainmin = 1.0d-13 -#else - real(kind=kind_phys), parameter :: rainmin = 1.0e-13 -#endif - real(kind=kind_phys), parameter :: p850 = 85000.0 + real(kind=kind_phys), parameter :: p850 = 85000.0d0 ! *DH integer :: i, k, ic + + real(kind=kind_phys), parameter :: zero = 0.0d0, one = 1.0d0 real(kind=kind_phys) :: crain, csnow, onebg, tem, total_precip real(kind=kind_phys), dimension(im) :: domr, domzr, domip, doms, t850, work1 @@ -240,10 +156,10 @@ subroutine GFS_MP_generic_post_run(im, ix, levs, kdt, nrcm, ncld, nncl, ntcw, nt errmsg = '' errflg = 0 - onebg = 1.0d0/con_g - + onebg = one/con_g + do i = 1, im - rain(i) = rainc(i) + frain * rain1(i) ! time-step convective plus explicit + rain(i) = rainc(i) + frain * rain1(i) ! time-step convective plus explicit enddo !> - If requested (e.g. Zhao-Carr MP scheme), call calpreciptype() to calculate dominant @@ -253,7 +169,7 @@ subroutine GFS_MP_generic_post_run(im, ix, levs, kdt, nrcm, ncld, nncl, ntcw, nt ! put ice, snow, graupel on dynamics timestep. The way the code in ! GFS_physics_driver is written, Diag%{graupel,ice,snow} are on the ! physics timestep, while Diag%{rain,rainc} and all totprecip etc - ! are on the dynamics timestep. Totally confusing and wrong. *DH + ! are on the dynamics timestep. Confusing, but works if frain=1. *DH if (imp_physics == imp_physics_gfdl) then tprcp = max(0., rain) ! clu: rain -> tprcp !graupel = frain*graupel0 @@ -268,34 +184,39 @@ subroutine GFS_MP_generic_post_run(im, ix, levs, kdt, nrcm, ncld, nncl, ntcw, nt graupel = frain*graupel0 ! time-step graupel ice = frain*ice0 ! time-step ice snow = frain*snow0 ! time-step snow - end if - if (lsm==lsm_ruc) then - if (imp_physics == imp_physics_gfdl .or. imp_physics == imp_physics_thompson) then + else if (imp_physics == imp_physics_fer_hires) then + tprcp = max (0.,rain) ! time-step convective and explicit precip + ice = frain*rain1*sr ! time-step ice + end if + + if (lsm==lsm_ruc .or. lsm==lsm_noahmp) then raincprv(:) = rainc(:) rainncprv(:) = frain * rain1(:) iceprv(:) = ice(:) snowprv(:) = snow(:) graupelprv(:) = graupel(:) + !for NoahMP, calculate precipitation rates from liquid water equivalent thickness for use in next time step + !Note (GJF): Precipitation LWE thicknesses are multiplied by the frain factor, and are thus on the dynamics time step, but the conversion as written + ! (with dtp in the denominator) assumes the rate is calculated on the physics time step. This only works as expected when dtf=dtp (i.e. when frain=1). + if (lsm == lsm_noahmp) then + tem = 1.0 / (dtp*con_p001) !GJF: This conversion was taken from GFS_physics_driver.F90, but should denominator also have the frain factor? + draincprv(:) = tem * raincprv(:) + drainncprv(:) = tem * rainncprv(:) + dsnowprv(:) = tem * snowprv(:) + dgraupelprv(:) = tem * graupelprv(:) + diceprv(:) = tem * iceprv(:) end if end if if (cal_pre) then ! hchuang: add dominant precipitation type algorithm ! - call calpreciptype (kdt, nrcm, im, ix, levs, levs+1, & - rann, xlat, xlon, gt0, & - gq0(:,:,1), prsl, prsi, & - rain, phii, tsfc, & !input - domr, domzr, domip, doms) ! output + call calpreciptype (kdt, nrcm, im, ix, levs, levs+1, & + rann, xlat, xlon, gt0, & + gq0(:,:,1), prsl, prsi, & + rain, phii, tsfc, & ! input + domr, domzr, domip, doms) ! output ! -! if (lprnt) print*,'debug calpreciptype: DOMR,DOMZR,DOMIP,DOMS ' -! &,DOMR(ipr),DOMZR(ipr),DOMIP(ipr),DOMS(ipr) -! do i=1,im -! if (abs(xlon(i)*57.29578-114.0) .lt. 0.2 .and. -! & abs(xlat(i)*57.29578-40.0) .lt. 0.2) -! & print*,'debug calpreciptype: DOMR,DOMZR,DOMIP,DOMS ', -! & DOMR(i),DOMZR(i),DOMIP(i),DOMS(i) -! end do ! HCHUANG: use new precipitation type to decide snow flag for LSM snow accumulation if (imp_physics /= imp_physics_gfdl .and. imp_physics /= imp_physics_thompson) then @@ -308,6 +229,14 @@ subroutine GFS_MP_generic_post_run(im, ix, levs, kdt, nrcm, ncld, nncl, ntcw, nt end if enddo endif + if (lssav) then + do i=1,im + domr_diag(i) = domr_diag(i) + domr(i) * dtf + domzr_diag(i) = domzr_diag(i) + domzr(i) * dtf + domip_diag(i) = domip_diag(i) + domip(i) * dtf + doms_diag(i) = doms_diag(i) + doms(i) * dtf + enddo + endif endif @@ -316,28 +245,24 @@ subroutine GFS_MP_generic_post_run(im, ix, levs, kdt, nrcm, ncld, nncl, ntcw, nt ! 'totprcpb=', Diag%totprcpb(1),'totprcp=',Diag%totprcp(1), & ! 'rain=',Diag%rain(1) do i=1,im + cnvprcp (i) = cnvprcp (i) + rainc(i) totprcp (i) = totprcp (i) + rain(i) totice (i) = totice (i) + ice(i) totsnw (i) = totsnw (i) + snow(i) totgrp (i) = totgrp (i) + graupel(i) + + cnvprcpb(i) = cnvprcpb(i) + rainc(i) totprcpb(i) = totprcpb(i) + rain(i) toticeb (i) = toticeb (i) + ice(i) totsnwb (i) = totsnwb (i) + snow(i) totgrpb (i) = totgrpb (i) + graupel(i) -! - if (cal_pre) then - domr_diag(i) = domr_diag(i) + domr(i) * dtf - domzr_diag(i) = domzr_diag(i) + domzr(i) * dtf - domip_diag(i) = domip_diag(i) + domip(i) * dtf - doms_diag(i) = doms_diag(i) + doms(i) * dtf - endif enddo if (ldiag3d) then do k=1,levs do i=1,im dt3dt(i,k) = dt3dt(i,k) + (gt0(i,k)-save_t(i,k)) * frain -! dq3dt(i,k) = dq3dt(i,k) + (gq0(i,k,1)-save_qv(i,k)) * frain +! dq3dt(i,k) = dq3dt(i,k) + (gq0(i,k,1)-save_qv(i,k)) * frain enddo enddo endif @@ -348,13 +273,16 @@ subroutine GFS_MP_generic_post_run(im, ix, levs, kdt, nrcm, ncld, nncl, ntcw, nt do k = 1, levs-1 do i = 1, im if (prsl(i,k) > p850 .and. prsl(i,k+1) <= p850) then - t850(i) = gt0(i,k) - (prsl(i,k)-p850) / & + t850(i) = gt0(i,k) - (prsl(i,k)-p850) / & (prsl(i,k)-prsl(i,k+1)) * & (gt0(i,k)-gt0(i,k+1)) endif enddo enddo + ! Conversion factor from mm per day to m per physics timestep + tem = dtp * con_p001 / con_day + !> - For GFDL and Thompson MP scheme, determine convective snow by surface temperature; !! and determine explicit rain/snow by snow/ice/graupel coming out directly from MP !! and convective rainfall from the cumulus scheme if the surface temperature is below @@ -362,50 +290,65 @@ subroutine GFS_MP_generic_post_run(im, ix, levs, kdt, nrcm, ncld, nncl, ntcw, nt if (imp_physics == imp_physics_gfdl .or. imp_physics == imp_physics_thompson) then ! determine convective rain/snow by surface temperature ! determine large-scale rain/snow by rain/snow coming out directly from MP - tem = dtp * con_p001 / con_day - do i = 1, im - !tprcp(i) = max(0.0, rain(i) )! clu: rain -> tprcp ! DH now lines 245-250 - srflag(i) = 0. ! clu: default srflag as 'rain' (i.e. 0) - if (tsfc(i) >= 273.15) then - crain = rainc(i) - csnow = 0.0 - else - crain = 0.0 - csnow = rainc(i) - endif -! if (snow0(i,1)+ice0(i,1)+graupel0(i,1)+csnow > rain0(i,1)+crain) then -! if (snow0(i)+ice0(i)+graupel0(i)+csnow > 0.0) then -! Sfcprop%srflag(i) = 1. ! clu: set srflag to 'snow' (i.e. 1) -! endif -! compute fractional srflag - total_precip = snow0(i)+ice0(i)+graupel0(i)+rain0(i)+rainc(i) - if (total_precip > rainmin) then - srflag(i) = (snow0(i)+ice0(i)+graupel0(i)+csnow)/total_precip - endif - enddo + + if (lsm /= lsm_ruc) then + do i = 1, im + !tprcp(i) = max(0.0, rain(i) )! clu: rain -> tprcp ! DH now lines 245-250 + srflag(i) = 0. ! clu: default srflag as 'rain' (i.e. 0) + if (tsfc(i) >= 273.15) then + crain = rainc(i) + csnow = 0.0 + else + crain = 0.0 + csnow = rainc(i) + endif +! if (snow0(i,1)+ice0(i,1)+graupel0(i,1)+csnow > rain0(i,1)+crain) then +! if (snow0(i)+ice0(i)+graupel0(i)+csnow > 0.0) then +! Sfcprop%srflag(i) = 1. ! clu: set srflag to 'snow' (i.e. 1) +! endif + total_precip = snow0(i)+ice0(i)+graupel0(i)+rain0(i)+rainc(i) + if (total_precip > rainmin) then + srflag(i) = (snow0(i)+ice0(i)+graupel0(i)+csnow)/total_precip + endif + enddo + else + ! only for RUC LSM + do i=1,im + srflag(i) = sr(i) + enddo + endif ! lsm==lsm_ruc elseif( .not. cal_pre) then - do i = 1, im - tprcp(i) = max(0.0, rain(i) )! clu: rain -> tprcp - srflag(i) = 0. ! clu: default srflag as 'rain' (i.e. 0) - if (t850(i) <= 273.16) then - srflag(i) = 1. ! clu: set srflag to 'snow' (i.e. 1) - endif - enddo + if (imp_physics == imp_physics_mg) then ! MG microphysics + tem = con_day / (dtp * con_p001) ! mm / day + do i=1,im + tprcp(i) = max(0.0, rain(i) ) ! clu: rain -> tprcp + if (rain(i)*tem > rainmin) then + srflag(i) = max(zero, min(one, (rain(i)-rainc(i))*sr(i)/rain(i))) + else + srflag(i) = 0.0 + endif + enddo + else + do i = 1, im + tprcp(i) = max(0.0, rain(i) ) ! clu: rain -> tprcp + srflag(i) = 0.0 ! clu: default srflag as 'rain' (i.e. 0) + if (t850(i) <= 273.16) then + srflag(i) = 1.0 ! clu: set srflag to 'snow' (i.e. 1) + endif + enddo + endif endif if (cplflx .or. cplchm) then do i = 1, im - if (t850(i) > 273.16) then - rain_cpl(i) = rain_cpl(i) + rain(i) - else - snow_cpl(i) = snow_cpl(i) + rain(i) - endif + rain_cpl(i) = rain_cpl(i) + rain(i) * (one-srflag(i)) + snow_cpl(i) = snow_cpl(i) + rain(i) * srflag(i) enddo endif if (cplchm) then do i = 1, im - rainc_cpl(i) = rainc_cpl(i) + rainc(i) + rainc_cpl(i) = rainc_cpl(i) + rainc(i) enddo endif @@ -424,8 +367,6 @@ subroutine GFS_MP_generic_post_run(im, ix, levs, kdt, nrcm, ncld, nncl, ntcw, nt do i=1,im pwat(i) = pwat(i) + del(i,k)*(gq0(i,k,1)+work1(i)) enddo -! if (lprnt .and. i == ipr) write(0,*)' gq0=', -! &gq0(i,k,1),' qgrs=',qgrs(i,k,1),' work2=',work2(i),' k=',k enddo do i=1,im pwat(i) = pwat(i) * onebg diff --git a/physics/GFS_MP_generic.meta b/physics/GFS_MP_generic.meta new file mode 100644 index 000000000..ddf8cb813 --- /dev/null +++ b/physics/GFS_MP_generic.meta @@ -0,0 +1,905 @@ +[ccpp-arg-table] + name = GFS_MP_generic_pre_init + type = scheme + +######################################################################## +[ccpp-arg-table] + name = GFS_MP_generic_pre_run + type = scheme +[im] + standard_name = horizontal_loop_extent + long_name = horizontal loop extent + units = count + dimensions = () + type = integer + intent = in + optional = F +[levs] + standard_name = vertical_dimension + long_name = vertical layer dimension + units = count + dimensions = () + type = integer + intent = in + optional = F +[ldiag3d] + standard_name = flag_diagnostics_3D + long_name = logical flag for 3D diagnostics + units = flag + dimensions = () + type = logical + intent = in + optional = F +[do_aw] + standard_name = flag_for_Arakawa_Wu_adjustment + long_name = flag for Arakawa Wu scale-aware adjustment + units = flag + dimensions = () + type = logical + intent = in + optional = F +[ntcw] + standard_name = index_for_liquid_cloud_condensate + long_name = tracer index for cloud condensate (or liquid water) + units = index + dimensions = () + type = integer + intent = in + optional = F +[nncl] + standard_name = number_of_tracers_for_cloud_condensate + long_name = number of tracers for cloud condensate + units = count + dimensions = () + type = integer + intent = in + optional = F +[ntrac] + standard_name = number_of_tracers + long_name = number of tracers + units = count + dimensions = () + type = integer + intent = in + optional = F +[gt0] + standard_name = air_temperature_updated_by_physics + long_name = temperature updated by physics + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[gq0] + standard_name = tracer_concentration_updated_by_physics + long_name = tracer concentration updated by physics + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension,number_of_tracers) + type = real + kind = kind_phys + intent = in + optional = F +[save_t] + standard_name = air_temperature_save + long_name = air temperature before entering a physics scheme + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[save_q] + standard_name = tracer_concentration_save + long_name = tracer concentration before entering a physics scheme + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension,number_of_tracers) + type = real + kind = kind_phys + intent = inout + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F + +######################################################################## +[ccpp-arg-table] + name = GFS_MP_generic_pre_finalize + type = scheme + +######################################################################## +[ccpp-arg-table] + name = GFS_MP_generic_post_init + type = scheme + +######################################################################## +[ccpp-arg-table] + name = GFS_MP_generic_post_run + type = scheme +[im] + standard_name = horizontal_loop_extent + long_name = horizontal loop extent + units = count + dimensions = () + type = integer + intent = in + optional = F +[ix] + standard_name = horizontal_dimension + long_name = horizontal dimension + units = count + dimensions = () + type = integer + intent = in + optional = F +[levs] + standard_name = vertical_dimension + long_name = vertical layer dimension + units = count + dimensions = () + type = integer + intent = in + optional = F +[kdt] + standard_name = index_of_time_step + long_name = current time step index + units = index + dimensions = () + type = integer + intent = in + optional = F +[nrcm] + standard_name = array_dimension_of_random_number + long_name = second dimension of random number stream for RAS + units = count + dimensions = () + type = integer + intent = in + optional = F +[ncld] + standard_name = number_of_hydrometeors + long_name = choice of cloud scheme / number of hydrometeors + units = count + dimensions = () + type = integer + intent = in + optional = F +[nncl] + standard_name = number_of_tracers_for_cloud_condensate + long_name = number of tracers for cloud condensate + units = count + dimensions = () + type = integer + intent = in + optional = F +[ntcw] + standard_name = index_for_liquid_cloud_condensate + long_name = tracer index for cloud condensate (or liquid water) + units = index + dimensions = () + type = integer + intent = in + optional = F +[ntrac] + standard_name = number_of_tracers + long_name = number of tracers + units = count + dimensions = () + type = integer + intent = in + optional = F +[imp_physics] + standard_name = flag_for_microphysics_scheme + long_name = choice of microphysics scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F +[imp_physics_gfdl] + standard_name = flag_for_gfdl_microphysics_scheme + long_name = choice of GFDL microphysics scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F +[imp_physics_thompson] + standard_name = flag_for_thompson_microphysics_scheme + long_name = choice of Thompson microphysics scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F +[imp_physics_mg] + standard_name = flag_for_morrison_gettelman_microphysics_scheme + long_name = choice of Morrison-Gettelman microphysics scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F +[imp_physics_fer_hires] + standard_name = flag_for_fer_hires_microphysics_scheme + long_name = choice of Ferrier-Aligo microphysics scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F +[cal_pre] + standard_name = flag_for_precipitation_type_algorithm + long_name = flag controls precip type algorithm + units = flag + dimensions = () + type = logical + intent = in + optional = F +[lssav] + standard_name = flag_diagnostics + long_name = logical flag for storing diagnostics + units = flag + dimensions = () + type = logical + intent = in + optional = F +[ldiag3d] + standard_name = flag_diagnostics_3D + long_name = flag for 3d diagnostic fields + units = flag + dimensions = () + type = logical + intent = in + optional = F +[cplflx] + standard_name = flag_for_flux_coupling + long_name = flag controlling cplflx collection (default off) + units = flag + dimensions = () + type = logical + intent = in + optional = F +[cplchm] + standard_name = flag_for_chemistry_coupling + long_name = flag controlling cplchm collection (default off) + units = flag + dimensions = () + type = logical + intent = in + optional = F +[con_g] + standard_name = gravitational_acceleration + long_name = gravitational acceleration + units = m s-2 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[dtf] + standard_name = time_step_for_dynamics + long_name = dynamics timestep + units = s + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[frain] + standard_name = dynamics_to_physics_timestep_ratio + long_name = ratio of dynamics timestep to physics timestep + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[rainc] + standard_name = lwe_thickness_of_convective_precipitation_amount_on_dynamics_timestep + long_name = convective rain at this time step + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[rain1] + standard_name = lwe_thickness_of_explicit_precipitation_amount + long_name = explicit rainfall amount on physics timestep + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[rann] + standard_name = random_number_array + long_name = random number array (0-1) + units = none + dimensions = (horizontal_dimension,array_dimension_of_random_number) + type = real + kind = kind_phys + intent = in + optional = F +[xlat] + standard_name = latitude + long_name = latitude + units = radians + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[xlon] + standard_name = longitude + long_name = longitude + units = radians + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[gt0] + standard_name = air_temperature_updated_by_physics + long_name = temperature updated by physics + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[gq0] + standard_name = tracer_concentration_updated_by_physics + long_name = tracer concentration updated by physics + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension,number_of_tracers) + type = real + kind = kind_phys + intent = in + optional = F +[prsl] + standard_name = air_pressure + long_name = layer mean pressure + units = Pa + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[prsi] + standard_name = air_pressure_at_interface + long_name = pressure at layer interface + units = Pa + dimensions = (horizontal_dimension,vertical_dimension_plus_one) + type = real + kind = kind_phys + intent = in + optional = F +[phii] + standard_name = geopotential_at_interface + long_name = geopotential at model layer interfaces + units = m2 s-2 + dimensions = (horizontal_dimension,vertical_dimension_plus_one) + type = real + kind = kind_phys + intent = in + optional = F +[tsfc] + standard_name = surface_skin_temperature + long_name = surface skin temperature + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[ice] + standard_name = lwe_thickness_of_ice_amount_on_dynamics_timestep + long_name = ice fall at this time step + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[snow] + standard_name = lwe_thickness_of_snow_amount_on_dynamics_timestep + long_name = snow fall at this time step + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[graupel] + standard_name = lwe_thickness_of_graupel_amount_on_dynamics_timestep + long_name = graupel fall at this time step + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[save_t] + standard_name = air_temperature_save + long_name = air temperature before entering a physics scheme + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[save_qv] + standard_name = water_vapor_specific_humidity_save + long_name = water vapor specific humidity before entering a physics scheme + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[rain0] + standard_name = lwe_thickness_of_explicit_rain_amount + long_name = explicit rain on physics timestep + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[ice0] + standard_name = lwe_thickness_of_ice_amount + long_name = ice fall on physics timestep + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[snow0] + standard_name = lwe_thickness_of_snow_amount + long_name = snow fall on physics timestep + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[graupel0] + standard_name = lwe_thickness_of_graupel_amount + long_name = graupel fall on physics timestep + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[del] + standard_name = air_pressure_difference_between_midlayers + long_name = air pressure difference between midlayers + units = Pa + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[rain] + standard_name = lwe_thickness_of_precipitation_amount_on_dynamics_timestep + long_name = total rain at this time step + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[domr_diag] + standard_name = dominant_rain_type + long_name = dominant rain type + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[domzr_diag] + standard_name = dominant_freezing_rain_type + long_name = dominant freezing rain type + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[domip_diag] + standard_name = dominant_sleet_type + long_name = dominant sleet type + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[doms_diag] + standard_name = dominant_snow_type + long_name = dominant snow type + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[tprcp] + standard_name = nonnegative_lwe_thickness_of_precipitation_amount_on_dynamics_timestep + long_name = total precipitation amount in each time step + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[srflag] + standard_name = flag_for_precipitation_type + long_name = snow/rain flag for precipitation + units = flag + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[sr] + standard_name = ratio_of_snowfall_to_rainfall + long_name = snow ratio: ratio of snow to total precipitation + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[cnvprcp] + standard_name = cumulative_lwe_thickness_of_convective_precipitation_amount + long_name = cumulative convective precipitation + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[totprcp] + standard_name = accumulated_lwe_thickness_of_precipitation_amount + long_name = accumulated total precipitation + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[totice] + standard_name = accumulated_lwe_thickness_of_ice_amount + long_name = accumulated ice precipitation + units = kg m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[totsnw] + standard_name = accumulated_lwe_thickness_of_snow_amount + long_name = accumulated snow precipitation + units = kg m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[totgrp] + standard_name = accumulated_lwe_thickness_of_graupel_amount + long_name = accumulated graupel precipitation + units = kg m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[cnvprcpb] + standard_name = cumulative_lwe_thickness_of_convective_precipitation_amount_in_bucket + long_name = cumulative convective precipitation in bucket + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[totprcpb] + standard_name = accumulated_lwe_thickness_of_precipitation_amount_in_bucket + long_name = accumulated total precipitation in bucket + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[toticeb] + standard_name = accumulated_lwe_thickness_of_ice_amount_in_bucket + long_name = accumulated ice precipitation in bucket + units = kg m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[totsnwb] + standard_name = accumulated_lwe_thickness_of_snow_amount_in_bucket + long_name = accumulated snow precipitation in bucket + units = kg m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[totgrpb] + standard_name = accumulated_lwe_thickness_of_graupel_amount_in_bucket + long_name = accumulated graupel precipitation in bucket + units = kg m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[dt3dt] + standard_name = cumulative_change_in_temperature_due_to_microphysics + long_name = cumulative change in temperature due to microphysics + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[dq3dt] + standard_name = cumulative_change_in_water_vapor_specific_humidity_due_to_microphysics + long_name = cumulative change in water vapor specific humidity due to microphysics + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[rain_cpl] + standard_name = lwe_thickness_of_precipitation_amount_for_coupling + long_name = total rain precipitation + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[rainc_cpl] + standard_name = lwe_thickness_of_convective_precipitation_amount_for_coupling + long_name = total convective precipitation + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[snow_cpl] + standard_name = lwe_thickness_of_snow_amount_for_coupling + long_name = total snow precipitation + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[pwat] + standard_name = column_precipitable_water + long_name = precipitable water + units = kg m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[do_sppt] + standard_name = flag_for_stochastic_surface_physics_perturbations + long_name = flag for stochastic surface physics perturbations + units = flag + dimensions = () + type = logical + intent = in + optional = F +[dtdtr] + standard_name = tendency_of_air_temperature_due_to_radiative_heating_on_physics_time_step + long_name = temp. change due to radiative heating per time step + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[dtdtc] + standard_name = tendency_of_air_temperature_due_to_radiative_heating_assuming_clear_sky + long_name = clear sky radiative (shortwave + longwave) heating rate at current time + units = K s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[drain_cpl] + standard_name = tendency_of_lwe_thickness_of_precipitation_amount_for_coupling + long_name = change in rain_cpl (coupling_type) + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[dsnow_cpl] + standard_name = tendency_of_lwe_thickness_of_snow_amount_for_coupling + long_name = change in show_cpl (coupling_type) + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[lsm] + standard_name = flag_for_land_surface_scheme + long_name = flag for land surface model + units = flag + dimensions = () + type = integer + intent = in + optional = F +[lsm_ruc] + standard_name = flag_for_ruc_land_surface_scheme + long_name = flag for RUC land surface model + units = flag + dimensions = () + type = integer + intent = in + optional = F +[lsm_noahmp] + standard_name = flag_for_noahmp_land_surface_scheme + long_name = flag for NOAH MP land surface model + units = flag + dimensions = () + type = integer + intent = in + optional = F +[raincprv] + standard_name = lwe_thickness_of_convective_precipitation_amount_from_previous_timestep + long_name = convective_precipitation_amount from previous timestep + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[rainncprv] + standard_name = lwe_thickness_of_explicit_rainfall_amount_from_previous_timestep + long_name = explicit rainfall from previous timestep + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[iceprv] + standard_name = lwe_thickness_of_ice_amount_from_previous_timestep + long_name = ice amount from previous timestep + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[snowprv] + standard_name = lwe_thickness_of_snow_amount_from_previous_timestep + long_name = snow amount from previous timestep + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[graupelprv] + standard_name = lwe_thickness_of_graupel_amount_from_previous_timestep + long_name = graupel amount from previous timestep + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[draincprv] + standard_name = convective_precipitation_rate_from_previous_timestep + long_name = convective precipitation rate from previous timestep + units = mm s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[drainncprv] + standard_name = explicit_rainfall_rate_from_previous_timestep + long_name = explicit rainfall rate previous timestep + units = mm s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[diceprv] + standard_name = ice_precipitation_rate_from_previous_timestep + long_name = ice precipitation rate from previous timestep + units = mm s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[dsnowprv] + standard_name = snow_precipitation_rate_from_previous_timestep + long_name = snow precipitation rate from previous timestep + units = mm s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[dgraupelprv] + standard_name = graupel_precipitation_rate_from_previous_timestep + long_name = graupel precipitation rate from previous timestep + units = mm s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[dtp] + standard_name = time_step_for_physics + long_name = physics timestep + units = s + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F + +######################################################################## +[ccpp-arg-table] + name = GFS_MP_generic_post_finalize + type = scheme diff --git a/physics/GFS_PBL_generic.F90 b/physics/GFS_PBL_generic.F90 index 9731a6309..a440836e1 100644 --- a/physics/GFS_PBL_generic.F90 +++ b/physics/GFS_PBL_generic.F90 @@ -1,6 +1,70 @@ !> \file GFS_PBL_generic.F90 !! Contains code related to PBL schemes to be used within the GFS physics suite. + module GFS_PBL_generic_common + + implicit none + + private + + public :: set_aerosol_tracer_index + + contains + + subroutine set_aerosol_tracer_index(imp_physics, imp_physics_wsm6, & + imp_physics_thompson, ltaerosol, & + imp_physics_mg, ntgl, imp_physics_gfdl, & + imp_physics_zhao_carr, kk, & + errmsg, errflg) + implicit none + ! + integer, intent(in ) :: imp_physics, imp_physics_wsm6, & + imp_physics_thompson, & + imp_physics_mg, ntgl, imp_physics_gfdl, & + imp_physics_zhao_carr + logical, intent(in ) :: ltaerosol + integer, intent(out) :: kk + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + errflg = 0 + +! Set Interstitial%kk = last index in diffused tracer array before chemistry-aerosol tracers + if (imp_physics == imp_physics_wsm6) then +! WSM6 + kk = 4 + elseif (imp_physics == imp_physics_thompson) then +! Thompson + if(ltaerosol) then + kk = 10 + else + kk = 7 + endif +! MG + elseif (imp_physics == imp_physics_mg) then + if (ntgl > 0) then + kk = 12 + else + kk = 10 + endif + elseif (imp_physics == imp_physics_gfdl) then +! GFDL MP + kk = 7 + elseif (imp_physics == imp_physics_zhao_carr) then +! Zhao/Carr/Sundqvist + kk = 3 + else + write(errmsg,'(*(a))') 'Logic error: unknown microphysics option in set_aerosol_tracer_index' + kk = -999 + errflg = 1 + return + endif + + end subroutine set_aerosol_tracer_index + + end module GFS_PBL_generic_common + + module GFS_PBL_generic_pre contains @@ -12,67 +76,37 @@ subroutine GFS_PBL_generic_pre_finalize() end subroutine GFS_PBL_generic_pre_finalize !> \brief This scheme sets up the vertically diffused tracer array for any PBL scheme based on the microphysics scheme chosen -#if 0 !! \section arg_table_GFS_PBL_generic_pre_run Argument Table -!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | -!! |------------------------------|--------------------------------------------------------|-------------------------------------------------------------------------------------|---------------|------|-----------|-----------|--------|----------| -!! | im | horizontal_loop_extent | horizontal loop extent | count | 0 | integer | | in | F | -!! | levs | vertical_dimension | vertical layer dimension | count | 0 | integer | | in | F | -!! | nvdiff | number_of_vertical_diffusion_tracers | number of tracers to diffuse vertically | count | 0 | integer | | in | F | -!! | ntrac | number_of_tracers | number of tracers | count | 0 | integer | | in | F | -!! | ntqv | index_for_water_vapor | tracer index for water vapor (specific humidity) | index | 0 | integer | | in | F | -!! | ntcw | index_for_liquid_cloud_condensate | tracer index for cloud condensate (or liquid water) | index | 0 | integer | | in | F | -!! | ntiw | index_for_ice_cloud_condensate | tracer index for ice water | index | 0 | integer | | in | F | -!! | ntrw | index_for_rain_water | tracer index for rain water | index | 0 | integer | | in | F | -!! | ntsw | index_for_snow_water | tracer index for snow water | index | 0 | integer | | in | F | -!! | ntlnc | index_for_liquid_cloud_number_concentration | tracer index for liquid number concentration | index | 0 | integer | | in | F | -!! | ntinc | index_for_ice_cloud_number_concentration | tracer index for ice number concentration | index | 0 | integer | | in | F | -!! | ntwa | index_for_water_friendly_aerosols | tracer index for water friendly aerosol | index | 0 | integer | | in | F | -!! | ntia | index_for_ice_friendly_aerosols | tracer index for ice friendly aerosol | index | 0 | integer | | in | F | -!! | ntgl | index_for_graupel | tracer index for graupel | index | 0 | integer | | in | F | -!! | ntoz | index_for_ozone | tracer index for ozone mixing ratio | index | 0 | integer | | in | F | -!! | ntke | index_for_turbulent_kinetic_energy | tracer index for turbulent kinetic energy | index | 0 | integer | | in | F | -!! | ntkev | index_for_turbulent_kinetic_energy_vertical_diffusion_tracer | index for turbulent kinetic energy in the vertically diffused tracer array | index | 0 | integer | | in | F | -!! | imp_physics | flag_for_microphysics_scheme | choice of microphysics scheme | flag | 0 | integer | | in | F | -!! | imp_physics_gfdl | flag_for_gfdl_microphysics_scheme | choice of GFDL microphysics scheme | flag | 0 | integer | | in | F | -!! | imp_physics_thompson | flag_for_thompson_microphysics_scheme | choice of Thompson microphysics scheme | flag | 0 | integer | | in | F | -!! | imp_physics_wsm6 | flag_for_wsm6_microphysics_scheme | choice of WSM6 microphysics scheme | flag | 0 | integer | | in | F | -!! | imp_physics_zhao_carr | flag_for_zhao_carr_microphysics_scheme | choice of Zhao-Carr microphysics scheme | flag | 0 | integer | | in | F | -!! | cplchm | flag_for_chemistry_coupling | flag controlling cplchm collection (default off) | flag | 0 | logical | | in | F | -!! | ltaerosol | flag_for_aerosol_physics | flag for aerosol physics | flag | 0 | logical | | in | F | -!! | hybedmf | flag_for_hedmf | flag for hybrid edmf pbl scheme (moninedmf) | flag | 0 | logical | | in | F | -!! | do_shoc | flag_for_shoc | flag for SHOC | flag | 0 | logical | | in | F | -!! | satmedmf | flag_for_scale_aware_TKE_moist_EDMF_PBL | flag for scale-aware TKE moist EDMF PBL scheme | flag | 0 | logical | | in | F | -!! | qgrs | tracer_concentration | model layer mean tracer concentration | kg kg-1 | 3 | real | kind_phys | in | F | -!! | vdftra | vertically_diffused_tracer_concentration | tracer concentration diffused by PBL scheme | kg kg-1 | 3 | real | kind_phys | inout | F | -!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | -!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | +!! \htmlinclude GFS_PBL_generic_pre_run.html !! -#endif subroutine GFS_PBL_generic_pre_run (im, levs, nvdiff, ntrac, & - ntqv, ntcw, ntiw, ntrw, ntsw, ntlnc, ntinc, ntwa, ntia, ntgl, ntoz, ntke, ntkev, & + ntqv, ntcw, ntiw, ntrw, ntsw, ntlnc, ntinc, ntrnc, ntsnc, ntgnc, & + ntwa, ntia, ntgl, ntoz, ntke, ntkev, nqrimef, trans_aero, ntchs, ntchm, & imp_physics, imp_physics_gfdl, imp_physics_thompson, imp_physics_wsm6, & - imp_physics_zhao_carr, cplchm, ltaerosol, hybedmf, do_shoc, satmedmf, & - qgrs, vdftra, errmsg, errflg) + imp_physics_zhao_carr, imp_physics_mg, imp_physics_fer_hires, cplchm, ltaerosol, & + hybedmf, do_shoc, satmedmf, qgrs, vdftra, errmsg, errflg) - use machine, only : kind_phys + use machine, only : kind_phys + use GFS_PBL_generic_common, only : set_aerosol_tracer_index implicit none integer, intent(in) :: im, levs, nvdiff, ntrac - integer, intent(in) :: ntqv, ntcw, ntiw, ntrw, ntsw, ntlnc, ntinc, ntwa, ntia, ntgl, ntoz, ntke, ntkev + integer, intent(in) :: ntqv, ntcw, ntiw, ntrw, ntsw, ntlnc, ntinc, ntrnc, ntsnc, ntgnc + integer, intent(in) :: ntwa, ntia, ntgl, ntoz, ntke, ntkev, nqrimef,ntchs, ntchm + logical, intent(in) :: trans_aero integer, intent(in) :: imp_physics, imp_physics_gfdl, imp_physics_thompson, imp_physics_wsm6 - integer, intent(in) :: imp_physics_zhao_carr + integer, intent(in) :: imp_physics_zhao_carr, imp_physics_mg, imp_physics_fer_hires logical, intent(in) :: cplchm, ltaerosol, hybedmf, do_shoc, satmedmf - real(kind=kind_phys), dimension(im, levs, ntrac), intent(in) :: qgrs + real(kind=kind_phys), dimension(im, levs, ntrac), intent(in) :: qgrs real(kind=kind_phys), dimension(im, levs, nvdiff), intent(inout) :: vdftra character(len=*), intent(out) :: errmsg - integer, intent(out) :: errflg + integer, intent(out) :: errflg !local variables - integer :: i, k + integer :: i, k, kk, k1, n ! Initialize CCPP error handling variables errmsg = '' @@ -92,20 +126,35 @@ subroutine GFS_PBL_generic_pre_run (im, levs, nvdiff, ntrac, vdftra(i,k,4) = qgrs(i,k,ntoz) enddo enddo + + ! Ferrier-Aligo + elseif (imp_physics == imp_physics_fer_hires) then + do k=1,levs + do i=1,im + vdftra(i,k,1) = qgrs(i,k,ntqv) + vdftra(i,k,2) = qgrs(i,k,ntcw) + vdftra(i,k,3) = qgrs(i,k,ntiw) + vdftra(i,k,4) = qgrs(i,k,ntrw) + vdftra(i,k,5) = qgrs(i,k,nqrimef) + vdftra(i,k,6) = qgrs(i,k,ntoz) + enddo + enddo + elseif (imp_physics == imp_physics_thompson) then ! Thompson - ! DH* Thompson ntrw and ntsw? if(ltaerosol) then do k=1,levs do i=1,im - vdftra(i,k,1) = qgrs(i,k,ntqv) - vdftra(i,k,2) = qgrs(i,k,ntcw) - vdftra(i,k,3) = qgrs(i,k,ntiw) - vdftra(i,k,4) = qgrs(i,k,ntlnc) - vdftra(i,k,5) = qgrs(i,k,ntinc) - vdftra(i,k,6) = qgrs(i,k,ntoz) - vdftra(i,k,7) = qgrs(i,k,ntwa) - vdftra(i,k,8) = qgrs(i,k,ntia) + vdftra(i,k,1) = qgrs(i,k,ntqv) + vdftra(i,k,2) = qgrs(i,k,ntcw) + vdftra(i,k,3) = qgrs(i,k,ntiw) + vdftra(i,k,4) = qgrs(i,k,ntrw) + vdftra(i,k,5) = qgrs(i,k,ntsw) + vdftra(i,k,6) = qgrs(i,k,ntlnc) + vdftra(i,k,7) = qgrs(i,k,ntinc) + vdftra(i,k,8) = qgrs(i,k,ntoz) + vdftra(i,k,9) = qgrs(i,k,ntwa) + vdftra(i,k,10) = qgrs(i,k,ntia) enddo enddo else @@ -114,12 +163,48 @@ subroutine GFS_PBL_generic_pre_run (im, levs, nvdiff, ntrac, vdftra(i,k,1) = qgrs(i,k,ntqv) vdftra(i,k,2) = qgrs(i,k,ntcw) vdftra(i,k,3) = qgrs(i,k,ntiw) - vdftra(i,k,4) = qgrs(i,k,ntinc) - vdftra(i,k,5) = qgrs(i,k,ntoz) + vdftra(i,k,4) = qgrs(i,k,ntrw) + vdftra(i,k,5) = qgrs(i,k,ntsw) + vdftra(i,k,6) = qgrs(i,k,ntinc) + vdftra(i,k,7) = qgrs(i,k,ntoz) + enddo + enddo + endif + ! MG + elseif (imp_physics == imp_physics_mg) then ! MG3/2 + if (ntgl > 0) then ! MG3 + do k=1,levs + do i=1,im + vdftra(i,k,1) = qgrs(i,k,ntqv) + vdftra(i,k,2) = qgrs(i,k,ntcw) + vdftra(i,k,3) = qgrs(i,k,ntiw) + vdftra(i,k,4) = qgrs(i,k,ntrw) + vdftra(i,k,5) = qgrs(i,k,ntsw) + vdftra(i,k,6) = qgrs(i,k,ntgl) + vdftra(i,k,7) = qgrs(i,k,ntlnc) + vdftra(i,k,8) = qgrs(i,k,ntinc) + vdftra(i,k,9) = qgrs(i,k,ntrnc) + vdftra(i,k,10) = qgrs(i,k,ntsnc) + vdftra(i,k,11) = qgrs(i,k,ntgnc) + vdftra(i,k,12) = qgrs(i,k,ntoz) + enddo + enddo + else ! MG2 + do k=1,levs + do i=1,im + vdftra(i,k,1) = qgrs(i,k,ntqv) + vdftra(i,k,2) = qgrs(i,k,ntcw) + vdftra(i,k,3) = qgrs(i,k,ntiw) + vdftra(i,k,4) = qgrs(i,k,ntrw) + vdftra(i,k,5) = qgrs(i,k,ntsw) + vdftra(i,k,6) = qgrs(i,k,ntlnc) + vdftra(i,k,7) = qgrs(i,k,ntinc) + vdftra(i,k,8) = qgrs(i,k,ntrnc) + vdftra(i,k,9) = qgrs(i,k,ntsnc) + vdftra(i,k,10) = qgrs(i,k,ntoz) enddo enddo endif - ! elseif (imp_physics == imp_physics_gfdl) then ! GFDL MP do k=1,levs @@ -135,31 +220,49 @@ subroutine GFS_PBL_generic_pre_run (im, levs, nvdiff, ntrac, enddo elseif (imp_physics == imp_physics_zhao_carr) then ! Zhao/Carr/Sundqvist - if (cplchm) then + do k=1,levs + do i=1,im + vdftra(i,k,1) = qgrs(i,k,ntqv) + vdftra(i,k,2) = qgrs(i,k,ntcw) + vdftra(i,k,3) = qgrs(i,k,ntoz) + enddo + enddo + endif +! + if (trans_aero) then + call set_aerosol_tracer_index(imp_physics, imp_physics_wsm6, & + imp_physics_thompson, ltaerosol, & + imp_physics_mg, ntgl, imp_physics_gfdl, & + imp_physics_zhao_carr, kk, & + errmsg, errflg) + if (.not.errflg==1) return + ! + k1 = kk + do n=ntchs,ntchm+ntchs-1 + k1 = k1 + 1 do k=1,levs do i=1,im - vdftra(i,k,1) = qgrs(i,k,ntqv) - vdftra(i,k,2) = qgrs(i,k,ntcw) - vdftra(i,k,3) = qgrs(i,k,ntoz) + vdftra(i,k,k1) = qgrs(i,k,n) enddo enddo - endif + enddo endif - - if (satmedmf) then +! + if (ntke>0) then do k=1,levs do i=1,im vdftra(i,k,ntkev) = qgrs(i,k,ntke) enddo enddo endif - +! endif end subroutine GFS_PBL_generic_pre_run end module GFS_PBL_generic_pre + module GFS_PBL_generic_post contains @@ -170,126 +273,67 @@ end subroutine GFS_PBL_generic_post_init subroutine GFS_PBL_generic_post_finalize () end subroutine GFS_PBL_generic_post_finalize - -#if 0 !> \section arg_table_GFS_PBL_generic_post_run Argument Table -!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | -!! |------------------------------|-----------------------------------------------------------------------------------|---------------------------------------------------------------------------------------------|---------------|------|-----------|-----------|--------|----------| -!! | im | horizontal_loop_extent | horizontal loop extent | count | 0 | integer | | in | F | -!! | levs | vertical_dimension | vertical layer dimension | count | 0 | integer | | in | F | -!! | nvdiff | number_of_vertical_diffusion_tracers | number of tracers to diffuse vertically | count | 0 | integer | | in | F | -!! | ntrac | number_of_tracers | number of tracers | count | 0 | integer | | in | F | -!! | ntqv | index_for_water_vapor | tracer index for water vapor (specific humidity) | index | 0 | integer | | in | F | -!! | ntcw | index_for_liquid_cloud_condensate | tracer index for cloud condensate (or liquid water) | index | 0 | integer | | in | F | -!! | ntiw | index_for_ice_cloud_condensate | tracer index for ice water | index | 0 | integer | | in | F | -!! | ntrw | index_for_rain_water | tracer index for rain water | index | 0 | integer | | in | F | -!! | ntsw | index_for_snow_water | tracer index for snow water | index | 0 | integer | | in | F | -!! | ntlnc | index_for_liquid_cloud_number_concentration | tracer index for liquid number concentration | index | 0 | integer | | in | F | -!! | ntinc | index_for_ice_cloud_number_concentration | tracer index for ice number concentration | index | 0 | integer | | in | F | -!! | ntwa | index_for_water_friendly_aerosols | tracer index for water friendly aerosol | index | 0 | integer | | in | F | -!! | ntia | index_for_ice_friendly_aerosols | tracer index for ice friendly aerosol | index | 0 | integer | | in | F | -!! | ntgl | index_for_graupel | tracer index for graupel | index | 0 | integer | | in | F | -!! | ntoz | index_for_ozone | tracer index for ozone mixing ratio | index | 0 | integer | | in | F | -!! | ntke | index_for_turbulent_kinetic_energy | tracer index for turbulent kinetic energy | index | 0 | integer | | in | F | -!! | ntkev | index_for_turbulent_kinetic_energy_vertical_diffusion_tracer | index for turbulent kinetic energy in the vertically diffused tracer array | index | 0 | integer | | in | F | -!! | imp_physics | flag_for_microphysics_scheme | choice of microphysics scheme | flag | 0 | integer | | in | F | -!! | imp_physics_gfdl | flag_for_gfdl_microphysics_scheme | choice of GFDL microphysics scheme | flag | 0 | integer | | in | F | -!! | imp_physics_thompson | flag_for_thompson_microphysics_scheme | choice of Thompson microphysics scheme | flag | 0 | integer | | in | F | -!! | imp_physics_wsm6 | flag_for_wsm6_microphysics_scheme | choice of WSM6 microphysics scheme | flag | 0 | integer | | in | F | -!! | imp_physics_zhao_carr | flag_for_zhao_carr_microphysics_scheme | choice of Zhao-Carr microphysics scheme | flag | 0 | integer | | in | F | -!! | ltaerosol | flag_for_aerosol_physics | flag for aerosol physics | flag | 0 | logical | | in | F | -!! | cplflx | flag_for_flux_coupling | flag controlling cplflx collection (default off) | flag | 0 | logical | | in | F | -!! | cplchm | flag_for_chemistry_coupling | flag controlling cplchm collection (default off) | flag | 0 | logical | | in | F | -!! | lssav | flag_diagnostics | logical flag for storing diagnostics | flag | 0 | logical | | in | F | -!! | ldiag3d | flag_diagnostics_3D | flag for 3d diagnostic fields | flag | 0 | logical | | in | F | -!! | lsidea | flag_idealized_physics | flag for idealized physics | flag | 0 | logical | | in | F | -!! | hybedmf | flag_for_hedmf | flag for hybrid edmf pbl scheme (moninedmf) | flag | 0 | logical | | in | F | -!! | do_shoc | flag_for_shoc | flag for SHOC | flag | 0 | logical | | in | F | -!! | satmedmf | flag_for_scale_aware_TKE_moist_EDMF_PBL | flag for scale-aware TKE moist EDMF PBL scheme | flag | 0 | logical | | in | F | -!! | shinhong | flag_for_scale_aware_Shinhong_PBL | flag for scale-aware Shinhong PBL scheme | flag | 0 | logical | | in | F | -!! | do_ysu | flag_for_ysu | flag for YSU PBL scheme | flag | 0 | logical | | in | F | -!! | dvdftra | tendency_of_vertically_diffused_tracer_concentration | updated tendency of the tracers due to vertical diffusion in PBL scheme | kg kg-1 s-1 | 3 | real | kind_phys | in | F | -!! | dusfc1 | instantaneous_surface_x_momentum_flux | surface momentum flux in the x-direction valid for current call | Pa | 1 | real | kind_phys | in | F | -!! | dvsfc1 | instantaneous_surface_y_momentum_flux | surface momentum flux in the y-direction valid for current call | Pa | 1 | real | kind_phys | in | F | -!! | dtsfc1 | instantaneous_surface_upward_sensible_heat_flux | surface upward sensible heat flux valid for current call | W m-2 | 1 | real | kind_phys | in | F | -!! | dqsfc1 | instantaneous_surface_upward_latent_heat_flux | surface upward latent heat flux valid for current call | W m-2 | 1 | real | kind_phys | in | F | -!! | dtf | time_step_for_dynamics | dynamics timestep | s | 0 | real | kind_phys | in | F | -!! | dudt | tendency_of_x_wind_due_to_model_physics | updated tendency of the x wind | m s-2 | 2 | real | kind_phys | in | F | -!! | dvdt | tendency_of_y_wind_due_to_model_physics | updated tendency of the y wind | m s-2 | 2 | real | kind_phys | in | F | -!! | dtdt | tendency_of_air_temperature_due_to_model_physics | updated tendency of the temperature | K s-1 | 2 | real | kind_phys | in | F | -!! | htrsw | tendency_of_air_temperature_due_to_shortwave_heating_on_radiation_timestep | total sky sw heating rate | K s-1 | 2 | real | kind_phys | in | F | -!! | htrlw | tendency_of_air_temperature_due_to_longwave_heating_on_radiation_timestep | total sky lw heating rate | K s-1 | 2 | real | kind_phys | in | F | -!! | xmu | zenith_angle_temporal_adjustment_factor_for_shortwave_fluxes | zenith angle temporal adjustment factor for shortwave | none | 1 | real | kind_phys | in | F | -!! | dqdt | tendency_of_tracers_due_to_model_physics | updated tendency of the tracers due to model physics | kg kg-1 s-1 | 3 | real | kind_phys | inout | F | -!! | dusfc_cpl | cumulative_surface_x_momentum_flux_for_coupling_multiplied_by_timestep | cumulative sfc u momentum flux multiplied by timestep | Pa s | 1 | real | kind_phys | inout | F | -!! | dvsfc_cpl | cumulative_surface_y_momentum_flux_for_coupling_multiplied_by_timestep | cumulative sfc v momentum flux multiplied by timestep | Pa s | 1 | real | kind_phys | inout | F | -!! | dtsfc_cpl | cumulative_surface_upward_sensible_heat_flux_for_coupling_multiplied_by_timestep | cumulative sfc sensible heat flux multiplied by timestep | W m-2 s | 1 | real | kind_phys | inout | F | -!! | dqsfc_cpl | cumulative_surface_upward_latent_heat_flux_for_coupling_multiplied_by_timestep | cumulative sfc latent heat flux multiplied by timestep | W m-2 s | 1 | real | kind_phys | inout | F | -!! | dusfci_cpl | instantaneous_surface_x_momentum_flux_for_coupling | instantaneous sfc u momentum flux | Pa | 1 | real | kind_phys | inout | F | -!! | dvsfci_cpl | instantaneous_surface_y_momentum_flux_for_coupling | instantaneous sfc v momentum flux | Pa | 1 | real | kind_phys | inout | F | -!! | dtsfci_cpl | instantaneous_surface_upward_sensible_heat_flux_for_coupling | instantaneous sfc sensible heat flux | W m-2 | 1 | real | kind_phys | inout | F | -!! | dqsfci_cpl | instantaneous_surface_upward_latent_heat_flux_for_coupling | instantaneous sfc latent heat flux | W m-2 | 1 | real | kind_phys | inout | F | -!! | dusfc_diag | cumulative_surface_x_momentum_flux_for_diag_multiplied_by_timestep | cumulative sfc x momentum flux multiplied by timestep | Pa s | 1 | real | kind_phys | inout | F | -!! | dvsfc_diag | cumulative_surface_y_momentum_flux_for_diag_multiplied_by_timestep | cumulative sfc y momentum flux multiplied by timestep | Pa s | 1 | real | kind_phys | inout | F | -!! | dtsfc_diag | cumulative_surface_upward_sensible_heat_flux_for_diag_multiplied_by_timestep | cumulative sfc sensible heat flux multiplied by timestep | W m-2 s | 1 | real | kind_phys | inout | F | -!! | dqsfc_diag | cumulative_surface_upward_latent_heat_flux_for_diag_multiplied_by_timestep | cumulative sfc latent heat flux multiplied by timestep | W m-2 s | 1 | real | kind_phys | inout | F | -!! | dusfci_diag | instantaneous_surface_x_momentum_flux_for_diag | instantaneous sfc x momentum flux multiplied by timestep | Pa | 1 | real | kind_phys | inout | F | -!! | dvsfci_diag | instantaneous_surface_y_momentum_flux_for_diag | instantaneous sfc y momentum flux multiplied by timestep | Pa | 1 | real | kind_phys | inout | F | -!! | dtsfci_diag | instantaneous_surface_upward_sensible_heat_flux_for_diag | instantaneous sfc sensible heat flux multiplied by timestep | W m-2 | 1 | real | kind_phys | inout | F | -!! | dqsfci_diag | instantaneous_surface_upward_latent_heat_flux_for_diag | instantaneous sfc latent heat flux multiplied by timestep | W m-2 | 1 | real | kind_phys | inout | F | -!! | dt3dt | cumulative_change_in_temperature_due_to_PBL | cumulative change in temperature due to PBL | K | 2 | real | kind_phys | inout | F | -!! | du3dt_PBL | cumulative_change_in_x_wind_due_to_PBL | cumulative change in x wind due to PBL | m s-1 | 2 | real | kind_phys | inout | F | -!! | du3dt_OGWD | cumulative_change_in_x_wind_due_to_orographic_gravity_wave_drag | cumulative change in x wind due to orographic gravity wave drag | m s-1 | 2 | real | kind_phys | inout | F | -!! | dv3dt_PBL | cumulative_change_in_y_wind_due_to_PBL | cumulative change in y wind due to PBL | m s-1 | 2 | real | kind_phys | inout | F | -!! | dv3dt_OGWD | cumulative_change_in_y_wind_due_to_orographic_gravity_wave_drag | cumulative change in y wind due to orographic gravity wave drag | m s-1 | 2 | real | kind_phys | inout | F | -!! | dq3dt | cumulative_change_in_water_vapor_specific_humidity_due_to_PBL | cumulative change in water vapor specific humidity due to PBL | kg kg-1 | 2 | real | kind_phys | inout | F | -!! | dq3dt_ozone | cumulative_change_in_ozone_mixing_ratio_due_to_PBL | cumulative change in ozone mixing ratio due to PBL | kg kg-1 | 2 | real | kind_phys | inout | F | -!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | -!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | +!! \htmlinclude GFS_PBL_generic_post_run.html !! -#endif subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac, & - ntqv, ntcw, ntiw, ntrw, ntsw, ntlnc, ntinc, ntwa, ntia, ntgl, ntoz, ntke, ntkev, & - imp_physics, imp_physics_gfdl, imp_physics_thompson, imp_physics_wsm6, imp_physics_zhao_carr, & + ntqv, ntcw, ntiw, ntrw, ntsw, ntlnc, ntinc, ntrnc, ntsnc, ntgnc, ntwa, ntia, ntgl, ntoz, ntke, ntkev,nqrimef, & + trans_aero, ntchs, ntchm, & + imp_physics, imp_physics_gfdl, imp_physics_thompson, imp_physics_wsm6, imp_physics_zhao_carr, imp_physics_mg, & + imp_physics_fer_hires, & ltaerosol, cplflx, cplchm, lssav, ldiag3d, lsidea, hybedmf, do_shoc, satmedmf, shinhong, do_ysu, & dvdftra, dusfc1, dvsfc1, dtsfc1, dqsfc1, dtf, dudt, dvdt, dtdt, htrsw, htrlw, xmu, & dqdt, dusfc_cpl, dvsfc_cpl, dtsfc_cpl, & dqsfc_cpl, dusfci_cpl, dvsfci_cpl, dtsfci_cpl, dqsfci_cpl, dusfc_diag, dvsfc_diag, dtsfc_diag, dqsfc_diag, & dusfci_diag, dvsfci_diag, dtsfci_diag, dqsfci_diag, dt3dt, du3dt_PBL, du3dt_OGWD, dv3dt_PBL, dv3dt_OGWD, dq3dt, & - dq3dt_ozone, errmsg, errflg) + dq3dt_ozone, rd, cp,fvirt, hvap, t1, q1, prsl, hflx, ushfsfci, oceanfrac, fice, dusfc_cice, dvsfc_cice, dtsfc_cice, & + dqsfc_cice, wet, dry, icy, wind, stress_ocn, hflx_ocn, evap_ocn, ugrs1, vgrs1, dkt_cpl, dkt, errmsg, errflg) - use machine, only: kind_phys + use machine, only : kind_phys + use GFS_PBL_generic_common, only : set_aerosol_tracer_index implicit none - integer, intent(in) :: im, levs, nvdiff, ntrac - integer, intent(in) :: ntqv, ntcw, ntiw, ntrw, ntsw, ntlnc, ntinc, ntwa, ntia, ntgl, ntoz, ntke, ntkev + integer, intent(in) :: im, levs, nvdiff, ntrac, ntchs, ntchm + integer, intent(in) :: ntqv, ntcw, ntiw, ntrw, ntsw, ntlnc, ntinc, ntrnc, ntsnc, ntgnc, ntwa, ntia, ntgl, ntoz, ntke, ntkev, nqrimef + logical, intent(in) :: trans_aero integer, intent(in) :: imp_physics, imp_physics_gfdl, imp_physics_thompson, imp_physics_wsm6 - integer, intent(in) :: imp_physics_zhao_carr + integer, intent(in) :: imp_physics_zhao_carr, imp_physics_mg, imp_physics_fer_hires logical, intent(in) :: ltaerosol, cplflx, cplchm, lssav, ldiag3d, lsidea logical, intent(in) :: hybedmf, do_shoc, satmedmf, shinhong, do_ysu real(kind=kind_phys), intent(in) :: dtf + real(kind=kind_phys), intent(in) :: rd, cp, fvirt, hvap + real(kind=kind_phys), dimension(:), intent(in) :: t1, q1, hflx, oceanfrac, fice + real(kind=kind_phys), dimension(:,:), intent(in) :: prsl + real(kind=kind_phys), dimension(:), intent(in) :: dusfc_cice, dvsfc_cice, dtsfc_cice, dqsfc_cice, & + wind, stress_ocn, hflx_ocn, evap_ocn, ugrs1, vgrs1 real(kind=kind_phys), dimension(im, levs, nvdiff), intent(in) :: dvdftra real(kind=kind_phys), dimension(im), intent(in) :: dusfc1, dvsfc1, dtsfc1, dqsfc1, xmu real(kind=kind_phys), dimension(im, levs), intent(in) :: dudt, dvdt, dtdt, htrsw, htrlw real(kind=kind_phys), dimension(im, levs, ntrac), intent(inout) :: dqdt - ! DH* The following arrays may not be allocated, depending on certain flags (cplflx, ...). + ! The following arrays may not be allocated, depending on certain flags (cplflx, ...). ! Since Intel 15 crashes when passing unallocated arrays to arrays defined with explicit shape, ! use assumed-shape arrays. Note that Intel 18 and GNU 6.2.0-8.1.0 tolerate explicit-shape arrays ! as long as these do not get used when not allocated. real(kind=kind_phys), dimension(:,:), intent(inout) :: dt3dt, du3dt_PBL, du3dt_OGWD, dv3dt_PBL, dv3dt_OGWD, dq3dt, dq3dt_ozone real(kind=kind_phys), dimension(:), intent(inout) :: dusfc_cpl, dvsfc_cpl, dtsfc_cpl, dqsfc_cpl, dusfci_cpl, dvsfci_cpl, & dtsfci_cpl, dqsfci_cpl, dusfc_diag, dvsfc_diag, dtsfc_diag, dqsfc_diag, dusfci_diag, dvsfci_diag, dtsfci_diag, dqsfci_diag - ! *DH + + logical, dimension(:),intent(in) :: wet, dry, icy + real(kind=kind_phys), dimension(:), intent(out) :: ushfsfci + + real(kind=kind_phys), dimension(:,:), intent(inout) :: dkt_cpl + real(kind=kind_phys), dimension(:,:), intent(in) :: dkt character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg - integer :: i, k - real(kind=kind_phys) :: tem + real(kind=kind_phys), parameter :: huge=1.0d30, epsln = 1.0d-10 + integer :: i, k, kk, k1, n + real(kind=kind_phys) :: tem, tem1, rho ! Initialize CCPP error handling variables errmsg = '' @@ -298,6 +342,35 @@ subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac, if (nvdiff == ntrac .and. (hybedmf .or. do_shoc .or. satmedmf)) then dqdt = dvdftra elseif (nvdiff /= ntrac .and. .not. shinhong .and. .not. do_ysu) then +! + if (ntke>0) then + do k=1,levs + do i=1,im + dqdt(i,k,ntke) = dvdftra(i,k,ntkev) + enddo + enddo + endif +! + if (trans_aero) then + ! Set kk if chemistry-aerosol tracers are diffused + call set_aerosol_tracer_index(imp_physics, imp_physics_wsm6, & + imp_physics_thompson, ltaerosol, & + imp_physics_mg, ntgl, imp_physics_gfdl, & + imp_physics_zhao_carr, kk, & + errmsg, errflg) + if (.not.errflg==1) return + ! + k1 = kk + do n=ntchs,ntchm+ntchs-1 + k1 = k1 + 1 + do k=1,levs + do i=1,im + dqdt(i,k,n) = dvdftra(i,k,k1) + enddo + enddo + enddo + endif +! if (imp_physics == imp_physics_wsm6) then ! WSM6 do k=1,levs @@ -308,20 +381,35 @@ subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac, dqdt(i,k,ntoz) = dvdftra(i,k,4) enddo enddo + + elseif (imp_physics == imp_physics_fer_hires) then + ! Ferrier-Aligo + do k=1,levs + do i=1,im + dqdt(i,k,ntqv) = dvdftra(i,k,1) + dqdt(i,k,ntcw) = dvdftra(i,k,2) + dqdt(i,k,ntiw) = dvdftra(i,k,3) + dqdt(i,k,ntrw) = dvdftra(i,k,4) + dqdt(i,k,nqrimef) = dvdftra(i,k,5) + dqdt(i,k,ntoz) = dvdftra(i,k,6) + enddo + enddo + elseif (imp_physics == imp_physics_thompson) then ! Thompson - ! DH* - Thompson ntrw, ntsw? if(ltaerosol) then do k=1,levs do i=1,im dqdt(i,k,ntqv) = dvdftra(i,k,1) dqdt(i,k,ntcw) = dvdftra(i,k,2) dqdt(i,k,ntiw) = dvdftra(i,k,3) - dqdt(i,k,ntlnc) = dvdftra(i,k,4) - dqdt(i,k,ntinc) = dvdftra(i,k,5) - dqdt(i,k,ntoz) = dvdftra(i,k,6) - dqdt(i,k,ntwa) = dvdftra(i,k,7) - dqdt(i,k,ntia) = dvdftra(i,k,8) + dqdt(i,k,ntrw) = dvdftra(i,k,4) + dqdt(i,k,ntsw) = dvdftra(i,k,5) + dqdt(i,k,ntlnc) = dvdftra(i,k,6) + dqdt(i,k,ntinc) = dvdftra(i,k,7) + dqdt(i,k,ntoz) = dvdftra(i,k,8) + dqdt(i,k,ntwa) = dvdftra(i,k,9) + dqdt(i,k,ntia) = dvdftra(i,k,10) enddo enddo else @@ -330,13 +418,48 @@ subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac, dqdt(i,k,ntqv) = dvdftra(i,k,1) dqdt(i,k,ntcw) = dvdftra(i,k,2) dqdt(i,k,ntiw) = dvdftra(i,k,3) - dqdt(i,k,ntinc) = dvdftra(i,k,4) - dqdt(i,k,ntoz) = dvdftra(i,k,5) + dqdt(i,k,ntrw) = dvdftra(i,k,4) + dqdt(i,k,ntsw) = dvdftra(i,k,5) + dqdt(i,k,ntinc) = dvdftra(i,k,6) + dqdt(i,k,ntoz) = dvdftra(i,k,7) enddo enddo endif - elseif (imp_physics == imp_physics_gfdl) then - ! GFDL MP + elseif (imp_physics == imp_physics_mg) then ! MG3/2 + if (ntgl > 0) then ! MG + do k=1,levs + do i=1,im + dqdt(i,k,1) = dvdftra(i,k,1) + dqdt(i,k,ntcw) = dvdftra(i,k,2) + dqdt(i,k,ntiw) = dvdftra(i,k,3) + dqdt(i,k,ntrw) = dvdftra(i,k,4) + dqdt(i,k,ntsw) = dvdftra(i,k,5) + dqdt(i,k,ntgl) = dvdftra(i,k,6) + dqdt(i,k,ntlnc) = dvdftra(i,k,7) + dqdt(i,k,ntinc) = dvdftra(i,k,8) + dqdt(i,k,ntrnc) = dvdftra(i,k,9) + dqdt(i,k,ntsnc) = dvdftra(i,k,10) + dqdt(i,k,ntgnc) = dvdftra(i,k,11) + dqdt(i,k,ntoz) = dvdftra(i,k,12) + enddo + enddo + else ! MG2 + do k=1,levs + do i=1,im + dqdt(i,k,1) = dvdftra(i,k,1) + dqdt(i,k,ntcw) = dvdftra(i,k,2) + dqdt(i,k,ntiw) = dvdftra(i,k,3) + dqdt(i,k,ntrw) = dvdftra(i,k,4) + dqdt(i,k,ntsw) = dvdftra(i,k,5) + dqdt(i,k,ntlnc) = dvdftra(i,k,6) + dqdt(i,k,ntinc) = dvdftra(i,k,7) + dqdt(i,k,ntrnc) = dvdftra(i,k,8) + dqdt(i,k,ntsnc) = dvdftra(i,k,9) + dqdt(i,k,ntoz) = dvdftra(i,k,10) + enddo + enddo + endif + elseif (imp_physics == imp_physics_gfdl) then ! GFDL MP do k=1,levs do i=1,im dqdt(i,k,ntqv) = dvdftra(i,k,1) @@ -349,66 +472,73 @@ subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac, enddo enddo elseif (imp_physics == imp_physics_zhao_carr) then - if (cplchm) then - do k=1,levs - do i=1,im - dqdt(i,k,1) = dvdftra(i,k,1) - dqdt(i,k,ntcw) = dvdftra(i,k,2) - dqdt(i,k,ntoz) = dvdftra(i,k,3) - enddo - enddo - endif - endif - - if (satmedmf) then do k=1,levs do i=1,im - dqdt(i,k,ntke) = dvdftra(i,k,ntkev) + dqdt(i,k,1) = dvdftra(i,k,1) + dqdt(i,k,ntcw) = dvdftra(i,k,2) + dqdt(i,k,ntoz) = dvdftra(i,k,3) enddo enddo endif endif ! nvdiff == ntrac + if (cplchm) then + do i = 1, im + tem1 = max(q1(i), 1.e-8) + tem = prsl(i,1) / (rd*t1(i)*(1.0+fvirt*tem1)) + ushfsfci(i) = -cp * tem * hflx(i) ! upward sensible heat flux + enddo + ! dkt_cpl has dimensions (1:im,1:levs), but dkt has (1:im,1:levs-1) + dkt_cpl(1:im,1:levs-1) = dkt(1:im,1:levs-1) + endif + + ! --- ... coupling insertion -! ### GJF ### the following section needs to be made CCPP-compliant when cplflx = T -! if (cplflx) then -! do i=1,im -! if (ocean(i)) then ! Ocean only, NO LAKES -! if (flag_cice(i)) cice(i) = fice_cice(i) -! if (cice(i) == 1.) then ! use results from CICE -! Coupling%dusfci_cpl(i) = dusfc_cice(i) -! Coupling%dvsfci_cpl(i) = dvsfc_cice(i) -! Coupling%dtsfci_cpl(i) = dtsfc_cice(i) -! Coupling%dqsfci_cpl(i) = dqsfc_cice(i) -! elseif (dry(i) .or. icy(i)) then ! use stress_ocean from sfc_diff for opw component at mixed point -! tem1 = max(Diag%q1(i), 1.e-8) -! rho = Statein%prsl(i,1) / (con_rd*Diag%t1(i)*(1.0+con_fvirt*tem1)) -! if (wind(i) > 0.) then -! Coupling%dusfci_cpl(i) = -rho * stress_ocean(i) * Statein%ugrs(i,1) / wind(i) ! U-momentum flux -! Coupling%dvsfci_cpl(i) = -rho * stress_ocean(i) * Statein%vgrs(i,1) / wind(i) ! V-momentum flux -! else -! Coupling%dusfci_cpl(i) = 0. -! Coupling%dvsfci_cpl(i) = 0. -! end if -! Coupling%dtsfci_cpl(i) = con_cp * rho * hflx_ocean(i) !sensible heat flux over open ocean -! Coupling%dqsfci_cpl(i) = con_hvap * rho * evap_ocean(i) ! latent heat flux over open ocean -! else ! use results from PBL scheme for 100% open ocean -! Coupling%dusfci_cpl(i) = dusfc1(i) -! Coupling%dvsfci_cpl(i) = dvsfc1(i) -! Coupling%dtsfci_cpl(i) = dtsfc1(i) -! Coupling%dqsfci_cpl(i) = dqsfc1(i) -! endif -! -! Coupling%dusfc_cpl (i) = Coupling%dusfc_cpl(i) + Coupling%dusfci_cpl(i) * dtf -! Coupling%dvsfc_cpl (i) = Coupling%dvsfc_cpl(i) + Coupling%dvsfci_cpl(i) * dtf -! Coupling%dtsfc_cpl (i) = Coupling%dtsfc_cpl(i) + Coupling%dtsfci_cpl(i) * dtf -! Coupling%dqsfc_cpl (i) = Coupling%dqsfc_cpl(i) + Coupling%dqsfci_cpl(i) * dtf -! ! -! endif ! Ocean only, NO LAKES -! enddo -! endif + if (cplflx) then + do i=1,im + if (oceanfrac(i) > 0.0) then ! Ocean only, NO LAKES + if (fice(i) > 1.-epsln) then ! no open water, use results from CICE + dusfci_cpl(i) = dusfc_cice(i) + dvsfci_cpl(i) = dvsfc_cice(i) + dtsfci_cpl(i) = dtsfc_cice(i) + dqsfci_cpl(i) = dqsfc_cice(i) + elseif (dry(i) .or. icy(i)) then ! use stress_ocean from sfc_diff for opw component at mixed point + tem1 = max(q1(i), 1.e-8) + rho = prsl(i,1) / (rd*t1(i)*(1.0+fvirt*tem1)) + if (wind(i) > 0.0) then + tem = - rho * stress_ocn(i) / wind(i) + dusfci_cpl(i) = tem * ugrs1(i) ! U-momentum flux + dvsfci_cpl(i) = tem * vgrs1(i) ! V-momentum flux + else + dusfci_cpl(i) = 0.0 + dvsfci_cpl(i) = 0.0 + endif + dtsfci_cpl(i) = cp * rho * hflx_ocn(i) ! sensible heat flux over open ocean + dqsfci_cpl(i) = hvap * rho * evap_ocn(i) ! latent heat flux over open ocean + else ! use results from PBL scheme for 100% open ocean + dusfci_cpl(i) = dusfc1(i) + dvsfci_cpl(i) = dvsfc1(i) + dtsfci_cpl(i) = dtsfc1(i) + dqsfci_cpl(i) = dqsfc1(i) + endif +! + dusfc_cpl (i) = dusfc_cpl(i) + dusfci_cpl(i) * dtf + dvsfc_cpl (i) = dvsfc_cpl(i) + dvsfci_cpl(i) * dtf + dtsfc_cpl (i) = dtsfc_cpl(i) + dtsfci_cpl(i) * dtf + dqsfc_cpl (i) = dqsfc_cpl(i) + dqsfci_cpl(i) * dtf +! + else + dusfc_cpl(i) = huge + dvsfc_cpl(i) = huge + dtsfc_cpl(i) = huge + dqsfc_cpl(i) = huge +!! + endif ! Ocean only, NO LAKES + enddo + endif + !-------------------------------------------------------lssav if loop ---------- if (lssav) then do i=1,im @@ -421,10 +551,6 @@ subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac, dtsfci_diag(i) = dtsfc1(i) dqsfci_diag(i) = dqsfc1(i) enddo - ! if (lprnt) then - ! write(0,*)' dusfc=',dusfc(ipr),' dusfc1=',dusfc1(ipr),' dtf=', - ! & dtf,' kdt=',kdt,' lat=',lat - ! endif if (ldiag3d) then if (lsidea) then @@ -439,33 +565,12 @@ subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac, endif do k=1,levs do i=1,im - du3dt_PBL(i,k) = du3dt_PBL(i,k) + dudt(i,k) * dtf + du3dt_PBL(i,k) = du3dt_PBL(i,k) + dudt(i,k) * dtf du3dt_OGWD(i,k) = du3dt_OGWD(i,k) - dudt(i,k) * dtf - dv3dt_PBL(i,k) = dv3dt_PBL(i,k) + dvdt(i,k) * dtf + dv3dt_PBL(i,k) = dv3dt_PBL(i,k) + dvdt(i,k) * dtf dv3dt_OGWD(i,k) = dv3dt_OGWD(i,k) - dvdt(i,k) * dtf enddo enddo - ! update dqdt_v to include moisture tendency due to vertical diffusion - ! if (lgocart) then - ! do k=1,levs - ! do i=1,im - ! dqdt_v(i,k) = dqdt(i,k,1) * dtf - ! enddo - ! enddo - ! endif -! do k=1,levs -! do i=1,im -! tem = dqdt(i,k,ntqv) * dtf -! dq3dt(i,k) = dq3dt(i,k) + tem -! enddo -! enddo -! if (ntoz > 0) then -! do k=1,levs -! do i=1,im -! dq3dt_ozone(i,k) = dq3dt_ozone(i,k) + dqdt(i,k,ntoz) * dtf -! enddo -! enddo -! endif endif endif ! end if_lssav diff --git a/physics/GFS_PBL_generic.meta b/physics/GFS_PBL_generic.meta new file mode 100644 index 000000000..51764e04d --- /dev/null +++ b/physics/GFS_PBL_generic.meta @@ -0,0 +1,1239 @@ +[ccpp-arg-table] + name = GFS_PBL_generic_pre_run + type = scheme +[im] + standard_name = horizontal_loop_extent + long_name = horizontal loop extent + units = count + dimensions = () + type = integer + intent = in + optional = F +[levs] + standard_name = vertical_dimension + long_name = vertical layer dimension + units = count + dimensions = () + type = integer + intent = in + optional = F +[nvdiff] + standard_name = number_of_vertical_diffusion_tracers + long_name = number of tracers to diffuse vertically + units = count + dimensions = () + type = integer + intent = in + optional = F +[ntrac] + standard_name = number_of_tracers + long_name = number of tracers + units = count + dimensions = () + type = integer + intent = in + optional = F +[ntqv] + standard_name = index_for_water_vapor + long_name = tracer index for water vapor (specific humidity) + units = index + dimensions = () + type = integer + intent = in + optional = F +[ntcw] + standard_name = index_for_liquid_cloud_condensate + long_name = tracer index for cloud condensate (or liquid water) + units = index + dimensions = () + type = integer + intent = in + optional = F +[ntiw] + standard_name = index_for_ice_cloud_condensate + long_name = tracer index for ice water + units = index + dimensions = () + type = integer + intent = in + optional = F +[ntrw] + standard_name = index_for_rain_water + long_name = tracer index for rain water + units = index + dimensions = () + type = integer + intent = in + optional = F +[ntsw] + standard_name = index_for_snow_water + long_name = tracer index for snow water + units = index + dimensions = () + type = integer + intent = in + optional = F +[ntlnc] + standard_name = index_for_liquid_cloud_number_concentration + long_name = tracer index for liquid number concentration + units = index + dimensions = () + type = integer + intent = in + optional = F +[ntinc] + standard_name = index_for_ice_cloud_number_concentration + long_name = tracer index for ice number concentration + units = index + dimensions = () + type = integer + intent = in + optional = F +[ntrnc] + standard_name = index_for_rain_number_concentration + long_name = tracer index for rain number concentration + units = index + dimensions = () + type = integer + intent = in + optional = F +[ntsnc] + standard_name = index_for_snow_number_concentration + long_name = tracer index for snow number concentration + units = index + dimensions = () + type = integer + intent = in + optional = F +[ntgnc] + standard_name = index_for_graupel_number_concentration + long_name = tracer index for graupel number concentration + units = index + dimensions = () + type = integer + intent = in + optional = F +[ntwa] + standard_name = index_for_water_friendly_aerosols + long_name = tracer index for water friendly aerosol + units = index + dimensions = () + type = integer + intent = in + optional = F +[ntia] + standard_name = index_for_ice_friendly_aerosols + long_name = tracer index for ice friendly aerosol + units = index + dimensions = () + type = integer + intent = in + optional = F +[ntgl] + standard_name = index_for_graupel + long_name = tracer index for graupel + units = index + dimensions = () + type = integer + intent = in + optional = F +[ntoz] + standard_name = index_for_ozone + long_name = tracer index for ozone mixing ratio + units = index + dimensions = () + type = integer + intent = in + optional = F +[ntke] + standard_name = index_for_turbulent_kinetic_energy + long_name = tracer index for turbulent kinetic energy + units = index + dimensions = () + type = integer + intent = in + optional = F +[ntkev] + standard_name = index_for_turbulent_kinetic_energy_vertical_diffusion_tracer + long_name = index for turbulent kinetic energy in the vertically diffused tracer array + units = index + dimensions = () + type = integer + intent = in + optional = F +[nqrimef] + standard_name = index_for_mass_weighted_rime_factor + long_name = tracer index for mass weighted rime factor + units = index + dimensions = () + type = integer + intent = in + optional = F +[trans_aero] + standard_name = flag_for_aerosol_convective_transport_and_PBL_diffusion + long_name = flag for aerosol convective transport and PBL diffusion + units = flag + dimensions = () + type = logical + intent = in + optional = F +[ntchs] + standard_name = index_for_first_chemical_tracer + long_name = tracer index for first chemical tracer + units = index + dimensions = () + type = integer + intent = in + optional = F +[ntchm] + standard_name = number_of_chemical_tracers + long_name = number of chemical tracers + units = count + dimensions = () + type = integer + intent = in + optional = F +[imp_physics] + standard_name = flag_for_microphysics_scheme + long_name = choice of microphysics scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F +[imp_physics_gfdl] + standard_name = flag_for_gfdl_microphysics_scheme + long_name = choice of GFDL microphysics scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F +[imp_physics_thompson] + standard_name = flag_for_thompson_microphysics_scheme + long_name = choice of Thompson microphysics scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F +[imp_physics_wsm6] + standard_name = flag_for_wsm6_microphysics_scheme + long_name = choice of WSM6 microphysics scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F +[imp_physics_zhao_carr] + standard_name = flag_for_zhao_carr_microphysics_scheme + long_name = choice of Zhao-Carr microphysics scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F +[imp_physics_mg] + standard_name = flag_for_morrison_gettelman_microphysics_scheme + long_name = choice of Morrison-Gettelman microphysics scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F +[imp_physics_fer_hires] + standard_name = flag_for_fer_hires_microphysics_scheme + long_name = choice of Ferrier-Aligo microphysics scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F +[cplchm] + standard_name = flag_for_chemistry_coupling + long_name = flag controlling cplchm collection (default off) + units = flag + dimensions = () + type = logical + intent = in + optional = F +[ltaerosol] + standard_name = flag_for_aerosol_physics + long_name = flag for aerosol physics + units = flag + dimensions = () + type = logical + intent = in + optional = F +[hybedmf] + standard_name = flag_for_hedmf + long_name = flag for hybrid edmf pbl scheme (moninedmf) + units = flag + dimensions = () + type = logical + intent = in + optional = F +[do_shoc] + standard_name = flag_for_shoc + long_name = flag for SHOC + units = flag + dimensions = () + type = logical + intent = in + optional = F +[satmedmf] + standard_name = flag_for_scale_aware_TKE_moist_EDMF_PBL + long_name = flag for scale-aware TKE moist EDMF PBL scheme + units = flag + dimensions = () + type = logical + intent = in + optional = F +[qgrs] + standard_name = tracer_concentration + long_name = model layer mean tracer concentration + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension,number_of_tracers) + type = real + kind = kind_phys + intent = in + optional = F +[vdftra] + standard_name = vertically_diffused_tracer_concentration + long_name = tracer concentration diffused by PBL scheme + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension,number_of_vertical_diffusion_tracers) + type = real + kind = kind_phys + intent = inout + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F + +######################################################################## +[ccpp-arg-table] + name = GFS_PBL_generic_post_run + type = scheme +[im] + standard_name = horizontal_loop_extent + long_name = horizontal loop extent + units = count + dimensions = () + type = integer + intent = in + optional = F +[levs] + standard_name = vertical_dimension + long_name = vertical layer dimension + units = count + dimensions = () + type = integer + intent = in + optional = F +[nvdiff] + standard_name = number_of_vertical_diffusion_tracers + long_name = number of tracers to diffuse vertically + units = count + dimensions = () + type = integer + intent = in + optional = F +[ntrac] + standard_name = number_of_tracers + long_name = number of tracers + units = count + dimensions = () + type = integer + intent = in + optional = F +[ntqv] + standard_name = index_for_water_vapor + long_name = tracer index for water vapor (specific humidity) + units = index + dimensions = () + type = integer + intent = in + optional = F +[ntcw] + standard_name = index_for_liquid_cloud_condensate + long_name = tracer index for cloud condensate (or liquid water) + units = index + dimensions = () + type = integer + intent = in + optional = F +[ntiw] + standard_name = index_for_ice_cloud_condensate + long_name = tracer index for ice water + units = index + dimensions = () + type = integer + intent = in + optional = F +[ntrw] + standard_name = index_for_rain_water + long_name = tracer index for rain water + units = index + dimensions = () + type = integer + intent = in + optional = F +[ntsw] + standard_name = index_for_snow_water + long_name = tracer index for snow water + units = index + dimensions = () + type = integer + intent = in + optional = F +[ntlnc] + standard_name = index_for_liquid_cloud_number_concentration + long_name = tracer index for liquid number concentration + units = index + dimensions = () + type = integer + intent = in + optional = F +[ntinc] + standard_name = index_for_ice_cloud_number_concentration + long_name = tracer index for ice number concentration + units = index + dimensions = () + type = integer + intent = in + optional = F +[ntrnc] + standard_name = index_for_rain_number_concentration + long_name = tracer index for rain number concentration + units = index + dimensions = () + type = integer + intent = in + optional = F +[ntsnc] + standard_name = index_for_snow_number_concentration + long_name = tracer index for snow number concentration + units = index + dimensions = () + type = integer + intent = in + optional = F +[ntgnc] + standard_name = index_for_graupel_number_concentration + long_name = tracer index for graupel number concentration + units = index + dimensions = () + type = integer + intent = in + optional = F +[ntwa] + standard_name = index_for_water_friendly_aerosols + long_name = tracer index for water friendly aerosol + units = index + dimensions = () + type = integer + intent = in + optional = F +[ntia] + standard_name = index_for_ice_friendly_aerosols + long_name = tracer index for ice friendly aerosol + units = index + dimensions = () + type = integer + intent = in + optional = F +[ntgl] + standard_name = index_for_graupel + long_name = tracer index for graupel + units = index + dimensions = () + type = integer + intent = in + optional = F +[ntoz] + standard_name = index_for_ozone + long_name = tracer index for ozone mixing ratio + units = index + dimensions = () + type = integer + intent = in + optional = F +[ntke] + standard_name = index_for_turbulent_kinetic_energy + long_name = tracer index for turbulent kinetic energy + units = index + dimensions = () + type = integer + intent = in + optional = F +[ntkev] + standard_name = index_for_turbulent_kinetic_energy_vertical_diffusion_tracer + long_name = index for turbulent kinetic energy in the vertically diffused tracer array + units = index + dimensions = () + type = integer + intent = in + optional = F +[nqrimef] + standard_name = index_for_mass_weighted_rime_factor + long_name = tracer index for mass weighted rime factor + units = index + dimensions = () + type = integer + intent = in + optional = F +[trans_aero] + standard_name = flag_for_aerosol_convective_transport_and_PBL_diffusion + long_name = flag for aerosol convective transport and PBL diffusion + units = flag + dimensions = () + type = logical + intent = in + optional = F +[ntchs] + standard_name = index_for_first_chemical_tracer + long_name = tracer index for first chemical tracer + units = index + dimensions = () + type = integer + intent = in + optional = F +[ntchm] + standard_name = number_of_chemical_tracers + long_name = number of chemical tracers + units = count + dimensions = () + type = integer + intent = in + optional = F +[imp_physics] + standard_name = flag_for_microphysics_scheme + long_name = choice of microphysics scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F +[imp_physics_gfdl] + standard_name = flag_for_gfdl_microphysics_scheme + long_name = choice of GFDL microphysics scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F +[imp_physics_thompson] + standard_name = flag_for_thompson_microphysics_scheme + long_name = choice of Thompson microphysics scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F +[imp_physics_wsm6] + standard_name = flag_for_wsm6_microphysics_scheme + long_name = choice of WSM6 microphysics scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F +[imp_physics_zhao_carr] + standard_name = flag_for_zhao_carr_microphysics_scheme + long_name = choice of Zhao-Carr microphysics scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F +[imp_physics_mg] + standard_name = flag_for_morrison_gettelman_microphysics_scheme + long_name = choice of Morrison-Gettelman microphysics scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F +[imp_physics_fer_hires] + standard_name = flag_for_fer_hires_microphysics_scheme + long_name = choice of Ferrier-Aligo microphysics scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F +[ltaerosol] + standard_name = flag_for_aerosol_physics + long_name = flag for aerosol physics + units = flag + dimensions = () + type = logical + intent = in + optional = F +[cplflx] + standard_name = flag_for_flux_coupling + long_name = flag controlling cplflx collection (default off) + units = flag + dimensions = () + type = logical + intent = in + optional = F +[cplchm] + standard_name = flag_for_chemistry_coupling + long_name = flag controlling cplchm collection (default off) + units = flag + dimensions = () + type = logical + intent = in + optional = F +[lssav] + standard_name = flag_diagnostics + long_name = logical flag for storing diagnostics + units = flag + dimensions = () + type = logical + intent = in + optional = F +[ldiag3d] + standard_name = flag_diagnostics_3D + long_name = flag for 3d diagnostic fields + units = flag + dimensions = () + type = logical + intent = in + optional = F +[lsidea] + standard_name = flag_idealized_physics + long_name = flag for idealized physics + units = flag + dimensions = () + type = logical + intent = in + optional = F +[hybedmf] + standard_name = flag_for_hedmf + long_name = flag for hybrid edmf pbl scheme (moninedmf) + units = flag + dimensions = () + type = logical + intent = in + optional = F +[do_shoc] + standard_name = flag_for_shoc + long_name = flag for SHOC + units = flag + dimensions = () + type = logical + intent = in + optional = F +[satmedmf] + standard_name = flag_for_scale_aware_TKE_moist_EDMF_PBL + long_name = flag for scale-aware TKE moist EDMF PBL scheme + units = flag + dimensions = () + type = logical + intent = in + optional = F +[shinhong] + standard_name = flag_for_scale_aware_Shinhong_PBL + long_name = flag for scale-aware Shinhong PBL scheme + units = flag + dimensions = () + type = logical + intent = in + optional = F +[do_ysu] + standard_name = flag_for_ysu + long_name = flag for YSU PBL scheme + units = flag + dimensions = () + type = logical + intent = in + optional = F +[dvdftra] + standard_name = tendency_of_vertically_diffused_tracer_concentration + long_name = updated tendency of the tracers due to vertical diffusion in PBL scheme + units = kg kg-1 s-1 + dimensions = (horizontal_dimension,vertical_dimension,number_of_vertical_diffusion_tracers) + type = real + kind = kind_phys + intent = in + optional = F +[dusfc1] + standard_name = instantaneous_surface_x_momentum_flux + long_name = surface momentum flux in the x-direction valid for current call + units = Pa + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[dvsfc1] + standard_name = instantaneous_surface_y_momentum_flux + long_name = surface momentum flux in the y-direction valid for current call + units = Pa + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[dtsfc1] + standard_name = instantaneous_surface_upward_sensible_heat_flux + long_name = surface upward sensible heat flux valid for current call + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[dqsfc1] + standard_name = instantaneous_surface_upward_latent_heat_flux + long_name = surface upward latent heat flux valid for current call + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[dtf] + standard_name = time_step_for_dynamics + long_name = dynamics timestep + units = s + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[dudt] + standard_name = tendency_of_x_wind_due_to_model_physics + long_name = updated tendency of the x wind + units = m s-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[dvdt] + standard_name = tendency_of_y_wind_due_to_model_physics + long_name = updated tendency of the y wind + units = m s-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[dtdt] + standard_name = tendency_of_air_temperature_due_to_model_physics + long_name = updated tendency of the temperature + units = K s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[htrsw] + standard_name = tendency_of_air_temperature_due_to_shortwave_heating_on_radiation_timestep + long_name = total sky sw heating rate + units = K s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[htrlw] + standard_name = tendency_of_air_temperature_due_to_longwave_heating_on_radiation_timestep + long_name = total sky lw heating rate + units = K s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[xmu] + standard_name = zenith_angle_temporal_adjustment_factor_for_shortwave_fluxes + long_name = zenith angle temporal adjustment factor for shortwave + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[dqdt] + standard_name = tendency_of_tracers_due_to_model_physics + long_name = updated tendency of the tracers due to model physics + units = kg kg-1 s-1 + dimensions = (horizontal_dimension,vertical_dimension,number_of_tracers) + type = real + kind = kind_phys + intent = inout + optional = F +[dusfc_cpl] + standard_name = cumulative_surface_x_momentum_flux_for_coupling_multiplied_by_timestep + long_name = cumulative sfc u momentum flux multiplied by timestep + units = Pa s + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[dvsfc_cpl] + standard_name = cumulative_surface_y_momentum_flux_for_coupling_multiplied_by_timestep + long_name = cumulative sfc v momentum flux multiplied by timestep + units = Pa s + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[dtsfc_cpl] + standard_name = cumulative_surface_upward_sensible_heat_flux_for_coupling_multiplied_by_timestep + long_name = cumulative sfc sensible heat flux multiplied by timestep + units = W m-2 s + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[dqsfc_cpl] + standard_name = cumulative_surface_upward_latent_heat_flux_for_coupling_multiplied_by_timestep + long_name = cumulative sfc latent heat flux multiplied by timestep + units = W m-2 s + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[dusfci_cpl] + standard_name = instantaneous_surface_x_momentum_flux_for_coupling + long_name = instantaneous sfc u momentum flux + units = Pa + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[dvsfci_cpl] + standard_name = instantaneous_surface_y_momentum_flux_for_coupling + long_name = instantaneous sfc v momentum flux + units = Pa + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[dtsfci_cpl] + standard_name = instantaneous_surface_upward_sensible_heat_flux_for_coupling + long_name = instantaneous sfc sensible heat flux + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[dqsfci_cpl] + standard_name = instantaneous_surface_upward_latent_heat_flux_for_coupling + long_name = instantaneous sfc latent heat flux + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[dusfc_diag] + standard_name = cumulative_surface_x_momentum_flux_for_diag_multiplied_by_timestep + long_name = cumulative sfc x momentum flux multiplied by timestep + units = Pa s + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[dvsfc_diag] + standard_name = cumulative_surface_y_momentum_flux_for_diag_multiplied_by_timestep + long_name = cumulative sfc y momentum flux multiplied by timestep + units = Pa s + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[dtsfc_diag] + standard_name = cumulative_surface_upward_sensible_heat_flux_for_diag_multiplied_by_timestep + long_name = cumulative sfc sensible heat flux multiplied by timestep + units = W m-2 s + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[dqsfc_diag] + standard_name = cumulative_surface_upward_latent_heat_flux_for_diag_multiplied_by_timestep + long_name = cumulative sfc latent heat flux multiplied by timestep + units = W m-2 s + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[dusfci_diag] + standard_name = instantaneous_surface_x_momentum_flux_for_diag + long_name = instantaneous sfc x momentum flux multiplied by timestep + units = Pa + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[dvsfci_diag] + standard_name = instantaneous_surface_y_momentum_flux_for_diag + long_name = instantaneous sfc y momentum flux multiplied by timestep + units = Pa + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[dtsfci_diag] + standard_name = instantaneous_surface_upward_sensible_heat_flux_for_diag + long_name = instantaneous sfc sensible heat flux multiplied by timestep + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[dqsfci_diag] + standard_name = instantaneous_surface_upward_latent_heat_flux_for_diag + long_name = instantaneous sfc latent heat flux multiplied by timestep + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[dt3dt] + standard_name = cumulative_change_in_temperature_due_to_PBL + long_name = cumulative change in temperature due to PBL + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[du3dt_PBL] + standard_name = cumulative_change_in_x_wind_due_to_PBL + long_name = cumulative change in x wind due to PBL + units = m s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[du3dt_OGWD] + standard_name = cumulative_change_in_x_wind_due_to_orographic_gravity_wave_drag + long_name = cumulative change in x wind due to orographic gravity wave drag + units = m s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[dv3dt_PBL] + standard_name = cumulative_change_in_y_wind_due_to_PBL + long_name = cumulative change in y wind due to PBL + units = m s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[dv3dt_OGWD] + standard_name = cumulative_change_in_y_wind_due_to_orographic_gravity_wave_drag + long_name = cumulative change in y wind due to orographic gravity wave drag + units = m s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[dq3dt] + standard_name = cumulative_change_in_water_vapor_specific_humidity_due_to_PBL + long_name = cumulative change in water vapor specific humidity due to PBL + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[dq3dt_ozone] + standard_name = cumulative_change_in_ozone_mixing_ratio_due_to_PBL + long_name = cumulative change in ozone mixing ratio due to PBL + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[rd] + standard_name = gas_constant_dry_air + long_name = ideal gas constant for dry air + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[cp] + standard_name = specific_heat_of_dry_air_at_constant_pressure + long_name = specific heat of dry air at constant pressure + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[fvirt] + standard_name = ratio_of_vapor_to_dry_air_gas_constants_minus_one + long_name = (rv/rd) - 1 (rv = ideal gas constant for water vapor) + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[hvap] + standard_name = latent_heat_of_vaporization_of_water_at_0C + long_name = latent heat of evaporation/sublimation + units = J kg-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[t1] + standard_name = air_temperature_at_lowest_model_layer_for_diag + long_name = layer 1 temperature for diag + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[q1] + standard_name = water_vapor_specific_humidity_at_lowest_model_layer_for_diag + long_name = layer 1 specific humidity for diag + units = kg kg-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[prsl] + standard_name = air_pressure + long_name = mean layer pressure + units = Pa + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[hflx] + standard_name = kinematic_surface_upward_sensible_heat_flux + long_name = kinematic surface upward sensible heat flux + units = K m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[ushfsfci] + standard_name = instantaneous_surface_upward_sensible_heat_flux_for_chemistry_coupling + long_name = instantaneous upward sensible heat flux for chemistry coupling + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[oceanfrac] + standard_name = sea_area_fraction + long_name = fraction of horizontal grid area occupied by ocean + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[fice] + standard_name = sea_ice_concentration + long_name = ice fraction over open water + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[dusfc_cice] + standard_name = surface_x_momentum_flux_for_coupling_interstitial + long_name = sfc x momentum flux for coupling interstitial + units = Pa + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[dvsfc_cice] + standard_name = surface_y_momentum_flux_for_coupling_interstitial + long_name = sfc y momentum flux for coupling interstitial + units = Pa + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[dtsfc_cice] + standard_name = surface_upward_sensible_heat_flux_for_coupling_interstitial + long_name = sfc sensible heat flux for coupling interstitial + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[dqsfc_cice] + standard_name = surface_upward_latent_heat_flux_for_coupling_interstitial + long_name = sfc latent heat flux for coupling interstitial + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[wet] + standard_name = flag_nonzero_wet_surface_fraction + long_name = flag indicating presence of some ocean or lake surface area fraction + units = flag + dimensions = (horizontal_dimension) + type = logical + intent = in + optional = F +[dry] + standard_name = flag_nonzero_land_surface_fraction + long_name = flag indicating presence of some land surface area fraction + units = flag + dimensions = (horizontal_dimension) + type = logical + intent = in + optional = F +[icy] + standard_name = flag_nonzero_sea_ice_surface_fraction + long_name = flag indicating presence of some sea ice surface area fraction + units = flag + dimensions = (horizontal_dimension) + type = logical + intent = in + optional = F +[wind] + standard_name = wind_speed_at_lowest_model_layer + long_name = wind speed at lowest model level + units = m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[stress_ocn] + standard_name = surface_wind_stress_over_ocean + long_name = surface wind stress over ocean + units = m2 s-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[hflx_ocn] + standard_name = kinematic_surface_upward_sensible_heat_flux_over_ocean + long_name = kinematic surface upward sensible heat flux over ocean + units = K m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[evap_ocn] + standard_name = kinematic_surface_upward_latent_heat_flux_over_ocean + long_name = kinematic surface upward latent heat flux over ocean + units = kg kg-1 m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[ugrs1] + standard_name = x_wind_at_lowest_model_layer + long_name = zonal wind at lowest model layer + units = m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[vgrs1] + standard_name = y_wind_at_lowest_model_layer + long_name = meridional wind at lowest model layer + units = m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[dkt_cpl] + standard_name = instantaneous_atmosphere_heat_diffusivity + long_name = instantaneous atmospheric heat diffusivity + units = m2 s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[dkt] + standard_name = atmosphere_heat_diffusivity + long_name = diffusivity for heat + units = m2 s-1 + dimensions = (horizontal_dimension,vertical_dimension_minus_one) + type = real + kind = kind_phys + intent = in + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F diff --git a/physics/GFS_SCNV_generic.F90 b/physics/GFS_SCNV_generic.F90 index 5cb2fc798..d8784dc62 100644 --- a/physics/GFS_SCNV_generic.F90 +++ b/physics/GFS_SCNV_generic.F90 @@ -12,20 +12,9 @@ subroutine GFS_SCNV_generic_pre_finalize() end subroutine GFS_SCNV_generic_pre_finalize !> \section arg_table_GFS_SCNV_generic_pre_run Argument Table -!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | -!! |-----------------|--------------------------------------------------------|-----------------------------------------------------------------------|---------------|------|-----------------------|-----------|--------|----------| -!! | im | horizontal_loop_extent | horizontal loop extent | count | 0 | integer | | in | F | -!! | levs | vertical_dimension | vertical layer dimension | count | 0 | integer | | in | F | -!! | ldiag3d | flag_diagnostics_3D | flag for 3d diagnostic fields | flag | 0 | logical | | in | F | -!! | lgocart | flag_gocart | flag for 3d diagnostic fields for gocart 1 | flag | 0 | logical | | in | F | -!! | gt0 | air_temperature_updated_by_physics | temperature updated by physics | K | 2 | real | kind_phys | in | F | -!! | gq0_water_vapor | water_vapor_specific_humidity_updated_by_physics | water vapor specific humidity updated by physics | kg kg-1 | 2 | real | kind_phys | in | F | -!! | save_t | air_temperature_save | air temperature before entering a physics scheme | K | 2 | real | kind_phys | inout | F | -!! | save_qv | water_vapor_specific_humidity_save | water vapor specific humidity before entering a physics scheme | kg kg-1 | 2 | real | kind_phys | inout | F | -!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | -!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | +!! \htmlinclude GFS_SCNV_generic_pre_run.html !! - subroutine GFS_SCNV_generic_pre_run (im, levs, ldiag3d, lgocart, gt0, gq0_water_vapor, & + subroutine GFS_SCNV_generic_pre_run (im, levs, ldiag3d, gt0, gq0_water_vapor, & save_t, save_qv, errmsg, errflg) use machine, only: kind_phys @@ -33,7 +22,7 @@ subroutine GFS_SCNV_generic_pre_run (im, levs, ldiag3d, lgocart, gt0, gq0_water_ implicit none integer, intent(in) :: im, levs - logical, intent(in) :: ldiag3d, lgocart + logical, intent(in) :: ldiag3d real(kind=kind_phys), dimension(im,levs), intent(in) :: gt0, gq0_water_vapor real(kind=kind_phys), dimension(im,levs), intent(inout) :: save_t, save_qv @@ -53,7 +42,7 @@ subroutine GFS_SCNV_generic_pre_run (im, levs, ldiag3d, lgocart, gt0, gq0_water_ enddo enddo endif -! if (ldiag3d .or. lgocart) then +! if (ldiag3d) then ! do k=1,levs ! do i=1,im ! save_qv(i,k) = gq0_water_vapor(i,k) @@ -63,6 +52,7 @@ subroutine GFS_SCNV_generic_pre_run (im, levs, ldiag3d, lgocart, gt0, gq0_water_ end subroutine GFS_SCNV_generic_pre_run + end module GFS_SCNV_generic_pre module GFS_SCNV_generic_post @@ -76,45 +66,42 @@ subroutine GFS_SCNV_generic_post_finalize () end subroutine GFS_SCNV_generic_post_finalize !> \section arg_table_GFS_SCNV_generic_post_run Argument Table -!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | -!! |-----------------|---------------------------------------------------------------------------------------------|----------------------------------------------------------------------|---------------|------|-------------|-----------|--------|----------| -!! | im | horizontal_loop_extent | horizontal loop extent | count | 0 | integer | | in | F | -!! | levs | vertical_dimension | vertical layer dimension | count | 0 | integer | | in | F | -!! | nn | number_of_tracers_for_convective_transport | number of tracers for convective transport | count | 0 | integer | | in | F | -!! | lssav | flag_diagnostics | logical flag for storing diagnostics | flag | 0 | logical | | in | F | -!! | ldiag3d | flag_diagnostics_3D | flag for 3d diagnostic fields | flag | 0 | logical | | in | F | -!! | lgocart | flag_gocart | flag for 3d diagnostic fields for gocart 1 | flag | 0 | logical | | in | F | -!! | frain | dynamics_to_physics_timestep_ratio | ratio of dynamics timestep to physics timestep | none | 0 | real | kind_phys | in | F | -!! | gt0 | air_temperature_updated_by_physics | temperature updated by physics | K | 2 | real | kind_phys | in | F | -!! | gq0_water_vapor | water_vapor_specific_humidity_updated_by_physics | water vapor specific humidity updated by physics | kg kg-1 | 2 | real | kind_phys | in | F | -!! | save_t | air_temperature_save | air temperature before entering a physics scheme | K | 2 | real | kind_phys | in | F | -!! | save_qv | water_vapor_specific_humidity_save | water vapor specific humidity before entering a physics scheme | kg kg-1 | 2 | real | kind_phys | in | F | -!! | dqdti | instantaneous_water_vapor_specific_humidity_tendency_due_to_convection | instantaneous moisture tendency due to convection | kg kg-1 s-1 | 2 | real | kind_phys | inout | F | -!! | dt3dt | cumulative_change_in_temperature_due_to_shal_convection | cumulative change in temperature due to shal conv. | K | 2 | real | kind_phys | inout | F | -!! | dq3dt | cumulative_change_in_water_vapor_specific_humidity_due_to_shal_convection | cumulative change in water vapor specific humidity due to shal conv. | kg kg-1 | 2 | real | kind_phys | inout | F | -!! | clw | convective_transportable_tracers | array to contain cloud water and other convective trans. tracers | kg kg-1 | 3 | real | kind_phys | inout | F | -!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | -!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | +!! \htmlinclude GFS_SCNV_generic_post_run.html !! - subroutine GFS_SCNV_generic_post_run (im, levs, nn, lssav, ldiag3d, lgocart, frain, gt0, gq0_water_vapor, & - save_t, save_qv, dqdti, dt3dt, dq3dt, clw, errmsg, errflg) + subroutine GFS_SCNV_generic_post_run (im, levs, nn, lssav, ldiag3d, cplchm, & + frain, gt0, gq0_water_vapor, save_t, save_qv, dqdti, dt3dt, dq3dt, clw, & + shcnvcw, rain1, npdf3d, num_p3d, ncnvcld3d, cnvc, cnvw, & + rainc, cnvprcp, cnvprcpb, cnvw_phy_f3d, cnvc_phy_f3d, & + imfshalcnv, imfshalcnv_sas, imfshalcnv_samf, errmsg, errflg) use machine, only: kind_phys implicit none integer, intent(in) :: im, levs, nn - logical, intent(in) :: lssav, ldiag3d, lgocart + logical, intent(in) :: lssav, ldiag3d, cplchm real(kind=kind_phys), intent(in) :: frain real(kind=kind_phys), dimension(im,levs), intent(in) :: gt0, gq0_water_vapor real(kind=kind_phys), dimension(im,levs), intent(in) :: save_t, save_qv - ! dqdti only allocated if ldiag3d == .true. or lgocart == .true. + ! dqdti, dt3dt, dq3dt, only allocated if ldiag3d == .true. real(kind=kind_phys), dimension(:,:), intent(inout) :: dqdti - ! dt3dt, dq3dt, only allocated if ldiag3d == .true. real(kind=kind_phys), dimension(:,:), intent(inout) :: dt3dt, dq3dt real(kind=kind_phys), dimension(im,levs,nn), intent(inout) :: clw + ! Post code for SAS/SAMF + integer, intent(in) :: npdf3d, num_p3d, ncnvcld3d + logical, intent(in) :: shcnvcw + real(kind=kind_phys), dimension(im), intent(in) :: rain1 + real(kind=kind_phys), dimension(im,levs), intent(in) :: cnvw, cnvc + real(kind=kind_phys), dimension(im), intent(inout) :: rainc, cnvprcp, cnvprcpb + ! The following arrays may not be allocated, depending on certain flags and microphysics schemes. + ! Since Intel 15 crashes when passing unallocated arrays to arrays defined with explicit shape, + ! use assumed-shape arrays. Note that Intel 18 and GNU 6.2.0-8.1.0 tolerate explicit-shape arrays + ! as long as these do not get used when not allocated. + real(kind=kind_phys), dimension(:,:), intent(inout) :: cnvw_phy_f3d, cnvc_phy_f3d + integer, intent(in) :: imfshalcnv, imfshalcnv_sas, imfshalcnv_samf + character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -125,16 +112,28 @@ subroutine GFS_SCNV_generic_post_run (im, levs, nn, lssav, ldiag3d, lgocart, fra errmsg = '' errflg = 0 - if (lssav) then -! update dqdt_v to include moisture tendency due to shallow convection - if (lgocart) then + if (imfshalcnv==imfshalcnv_sas .or. imfshalcnv==imfshalcnv_samf) then + do i=1,im + rainc(i) = rainc(i) + frain * rain1(i) + enddo +! 'cnvw' and 'cnvc' are set to zero before computation starts: + if (shcnvcw .and. num_p3d == 4 .and. npdf3d == 3) then + do k=1,levs + do i=1,im + cnvw_phy_f3d(i,k) = cnvw_phy_f3d(i,k) + cnvw(i,k) + cnvc_phy_f3d(i,k) = cnvc_phy_f3d(i,k) + cnvc(i,k) + enddo + enddo + elseif (npdf3d == 0 .and. ncnvcld3d == 1) then do k=1,levs do i=1,im - tem = (gq0_water_vapor(i,k)-save_qv(i,k)) * frain - dqdti(i,k) = dqdti(i,k) + tem + cnvw_phy_f3d(i,k) = cnvw_phy_f3d(i,k) + cnvw(i,k) enddo enddo endif + endif + + if (lssav) then if (ldiag3d) then do k=1,levs do i=1,im @@ -144,6 +143,15 @@ subroutine GFS_SCNV_generic_post_run (im, levs, nn, lssav, ldiag3d, lgocart, fra enddo endif endif ! end if_lssav +! + if (cplchm) then + do k=1,levs + do i=1,im + tem = (gq0_water_vapor(i,k)-save_qv(i,k)) * frain + dqdti(i,k) = dqdti(i,k) + tem + enddo + enddo + endif ! do k=1,levs do i=1,im diff --git a/physics/GFS_SCNV_generic.meta b/physics/GFS_SCNV_generic.meta new file mode 100644 index 000000000..79f4eab11 --- /dev/null +++ b/physics/GFS_SCNV_generic.meta @@ -0,0 +1,359 @@ +[ccpp-arg-table] + name = GFS_SCNV_generic_pre_run + type = scheme +[im] + standard_name = horizontal_loop_extent + long_name = horizontal loop extent + units = count + dimensions = () + type = integer + intent = in + optional = F +[levs] + standard_name = vertical_dimension + long_name = vertical layer dimension + units = count + dimensions = () + type = integer + intent = in + optional = F +[ldiag3d] + standard_name = flag_diagnostics_3D + long_name = flag for 3d diagnostic fields + units = flag + dimensions = () + type = logical + intent = in + optional = F +[gt0] + standard_name = air_temperature_updated_by_physics + long_name = temperature updated by physics + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[gq0_water_vapor] + standard_name = water_vapor_specific_humidity_updated_by_physics + long_name = water vapor specific humidity updated by physics + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[save_t] + standard_name = air_temperature_save + long_name = air temperature before entering a physics scheme + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[save_qv] + standard_name = water_vapor_specific_humidity_save + long_name = water vapor specific humidity before entering a physics scheme + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F + +######################################################################## +[ccpp-arg-table] + name = GFS_SCNV_generic_post_run + type = scheme +[im] + standard_name = horizontal_loop_extent + long_name = horizontal loop extent + units = count + dimensions = () + type = integer + intent = in + optional = F +[levs] + standard_name = vertical_dimension + long_name = vertical layer dimension + units = count + dimensions = () + type = integer + intent = in + optional = F +[nn] + standard_name = number_of_tracers_for_convective_transport + long_name = number of tracers for convective transport + units = count + dimensions = () + type = integer + intent = in + optional = F +[lssav] + standard_name = flag_diagnostics + long_name = logical flag for storing diagnostics + units = flag + dimensions = () + type = logical + intent = in + optional = F +[ldiag3d] + standard_name = flag_diagnostics_3D + long_name = flag for 3d diagnostic fields + units = flag + dimensions = () + type = logical + intent = in + optional = F +[cplchm] + standard_name = flag_for_chemistry_coupling + long_name = flag controlling cplchm collection (default off) + units = flag + dimensions = () + type = logical + intent = in + optional = F +[frain] + standard_name = dynamics_to_physics_timestep_ratio + long_name = ratio of dynamics timestep to physics timestep + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[gt0] + standard_name = air_temperature_updated_by_physics + long_name = temperature updated by physics + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[gq0_water_vapor] + standard_name = water_vapor_specific_humidity_updated_by_physics + long_name = water vapor specific humidity updated by physics + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[save_t] + standard_name = air_temperature_save + long_name = air temperature before entering a physics scheme + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[save_qv] + standard_name = water_vapor_specific_humidity_save + long_name = water vapor specific humidity before entering a physics scheme + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[dqdti] + standard_name = instantaneous_water_vapor_specific_humidity_tendency_due_to_convection + long_name = instantaneous moisture tendency due to convection + units = kg kg-1 s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[dt3dt] + standard_name = cumulative_change_in_temperature_due_to_shal_convection + long_name = cumulative change in temperature due to shal conv. + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[dq3dt] + standard_name = cumulative_change_in_water_vapor_specific_humidity_due_to_shal_convection + long_name = cumulative change in water vapor specific humidity due to shal conv. + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[clw] + standard_name = convective_transportable_tracers + long_name = array to contain cloud water and other convective trans. tracers + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension,number_of_tracers_for_convective_transport) + type = real + kind = kind_phys + intent = inout + optional = F +[shcnvcw] + standard_name = flag_shallow_convective_cloud + long_name = flag for shallow convective cloud + units = + dimensions = () + type = logical + intent = in + optional = F +[rain1] + standard_name = lwe_thickness_of_shallow_convective_precipitation_amount + long_name = shallow convective rainfall amount on physics timestep + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[npdf3d] + standard_name = number_of_3d_arrays_associated_with_pdf_based_clouds + long_name = number of 3d arrays associated with pdf based clouds/mp + units = count + dimensions = () + type = integer + intent = in + optional = F +[num_p3d] + standard_name = array_dimension_of_3d_arrays_for_microphysics + long_name = number of 3D arrays needed for microphysics + units = count + dimensions = () + type = integer + intent = in + optional = F +[ncnvcld3d] + standard_name = number_of_convective_3d_cloud_fields + long_name = number of convective 3d clouds fields + units = count + dimensions = () + type = integer + intent = in + optional = F +[cnvc] + standard_name = convective_cloud_cover + long_name = convective cloud cover + units = frac + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[cnvw] + standard_name = convective_cloud_water_mixing_ratio + long_name = moist convective cloud water mixing ratio + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[rainc] + standard_name = lwe_thickness_of_convective_precipitation_amount_on_dynamics_timestep + long_name = convective rain at this time step + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[cnvprcp] + standard_name = cumulative_lwe_thickness_of_convective_precipitation_amount + long_name = cumulative convective precipitation + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[cnvprcpb] + standard_name = cumulative_lwe_thickness_of_convective_precipitation_amount_in_bucket + long_name = cumulative convective precipitation in bucket + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[cnvw_phy_f3d] + standard_name = convective_cloud_water_mixing_ratio_in_phy_f3d + long_name = convective cloud water mixing ratio in the phy_f3d array + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[cnvc_phy_f3d] + standard_name = convective_cloud_cover_in_phy_f3d + long_name = convective cloud cover in the phy_f3d array + units = frac + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[imfshalcnv] + standard_name = flag_for_mass_flux_shallow_convection_scheme + long_name = flag for mass-flux shallow convection scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F +[imfshalcnv_sas] + standard_name = flag_for_sas_shallow_convection_scheme + long_name = flag for SAS shallow convection scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F +[imfshalcnv_samf] + standard_name = flag_for_samf_shallow_convection_scheme + long_name = flag for SAMF shallow convection scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F diff --git a/physics/GFS_debug.F90 b/physics/GFS_debug.F90 index 9ed719d76..df56cc069 100644 --- a/physics/GFS_debug.F90 +++ b/physics/GFS_debug.F90 @@ -3,10 +3,10 @@ module GFS_diagtoscreen private - + public GFS_diagtoscreen_init, GFS_diagtoscreen_run, GFS_diagtoscreen_finalize - public print_my_stuff, chksum_int, chksum_real + public print_my_stuff, chksum_int, chksum_real, print_var ! Calculating the checksum leads to segmentation faults with gfortran (bug in malloc?), ! thus print the sum of the array instead of the checksum. @@ -41,23 +41,7 @@ subroutine GFS_diagtoscreen_finalize () end subroutine GFS_diagtoscreen_finalize !> \section arg_table_GFS_diagtoscreen_run Argument Table -!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | -!! |----------------|--------------------------------------------------------|---------------------------------------------------------|---------------|------|-----------------------|-----------|--------|----------| -!! | Model | GFS_control_type_instance | instance of derived type GFS_control_type in FV3 | DDT | 0 | GFS_control_type | | in | F | -!! | Statein | GFS_statein_type_instance | instance of derived type GFS_statein_type in FV3 | DDT | 0 | GFS_statein_type | | in | F | -!! | Stateout | GFS_stateout_type_instance | instance of derived type GFS_stateout_type | DDT | 0 | GFS_stateout_type | | in | F | -!! | Sfcprop | GFS_sfcprop_type_instance | instance of type GFS_sfcprop_type in FV3 | DDT | 0 | GFS_sfcprop_type | | in | F | -!! | Coupling | GFS_coupling_type_instance | instance of type GFS_coupling_type in FV3 | DDT | 0 | GFS_coupling_type | | in | F | -!! | Grid | GFS_grid_type_instance | instance of type GFS_grid_type in FV3 | DDT | 0 | GFS_grid_type | | in | F | -!! | Tbd | GFS_tbd_type_instance | instance of type GFS_tbd_type in FV3 | DDT | 0 | GFS_tbd_type | | in | F | -!! | Cldprop | GFS_cldprop_type_instance | instance of type GFS_cldprop_type in FV3 | DDT | 0 | GFS_cldprop_type | | in | F | -!! | Radtend | GFS_radtend_type_instance | instance of type GFS_radtend_type in FV3 | DDT | 0 | GFS_radtend_type | | in | F | -!! | Diag | GFS_diag_type_instance | instance of type GFS_diag_type in FV3 | DDT | 0 | GFS_diag_type | | in | F | -!! | Interstitial | GFS_interstitial_type_instance | instance of type GFS_interstitial_type in FV3 | DDT | 0 | GFS_interstitial_type | | in | F | -!! | nthreads | omp_threads | number of OpenMP threads or fast physics schemes | count | 0 | integer | | in | F | -!! | blkno | ccpp_block_number | number of block for explicit data blocking in CCPP | index | 0 | integer | | in | F | -!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | -!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | +!! \htmlinclude GFS_diagtoscreen_run.html !! subroutine GFS_diagtoscreen_run (Model, Statein, Stateout, Sfcprop, Coupling, & Grid, Tbd, Cldprop, Radtend, Diag, Interstitial, & @@ -146,7 +130,6 @@ subroutine GFS_diagtoscreen_run (Model, Statein, Stateout, Sfcprop, Coupling, call print_var(mpirank,omprank, blkno, 'Sfcprop%zorlo' , Sfcprop%zorlo) call print_var(mpirank,omprank, blkno, 'Sfcprop%zorll' , Sfcprop%zorll) call print_var(mpirank,omprank, blkno, 'Sfcprop%fice' , Sfcprop%fice) - call print_var(mpirank,omprank, blkno, 'Sfcprop%hprim' , Sfcprop%hprim) call print_var(mpirank,omprank, blkno, 'Sfcprop%hprime' , Sfcprop%hprime) call print_var(mpirank,omprank, blkno, 'Sfcprop%sncovr' , Sfcprop%sncovr) call print_var(mpirank,omprank, blkno, 'Sfcprop%snoalb' , Sfcprop%snoalb) @@ -174,7 +157,6 @@ subroutine GFS_diagtoscreen_run (Model, Statein, Stateout, Sfcprop, Coupling, call print_var(mpirank,omprank, blkno, 'Sfcprop%f10m' , Sfcprop%f10m) call print_var(mpirank,omprank, blkno, 'Sfcprop%tprcp' , Sfcprop%tprcp) call print_var(mpirank,omprank, blkno, 'Sfcprop%srflag' , Sfcprop%srflag) - call print_var(mpirank,omprank, blkno, 'Sfcprop%sr' , Sfcprop%sr) call print_var(mpirank,omprank, blkno, 'Sfcprop%slc' , Sfcprop%slc) call print_var(mpirank,omprank, blkno, 'Sfcprop%smc' , Sfcprop%smc) call print_var(mpirank,omprank, blkno, 'Sfcprop%stc' , Sfcprop%stc) @@ -250,7 +232,9 @@ subroutine GFS_diagtoscreen_run (Model, Statein, Stateout, Sfcprop, Coupling, call print_var(mpirank,omprank, blkno, 'Tbd%drain_cpl' , Tbd%drain_cpl) call print_var(mpirank,omprank, blkno, 'Tbd%dsnow_cpl' , Tbd%dsnow_cpl) end if - call print_var(mpirank,omprank, blkno, 'Tbd%phy_fctd' , Tbd%phy_fctd) + if (Model%nctp > 0 .and. Model%cscnv) then + call print_var(mpirank,omprank, blkno, 'Tbd%phy_fctd' , Tbd%phy_fctd) + end if call print_var(mpirank,omprank, blkno, 'Tbd%phy_f2d' , Tbd%phy_f2d) call print_var(mpirank,omprank, blkno, 'Tbd%phy_f3d' , Tbd%phy_f3d) do n=1,size(Tbd%phy_f3d(1,1,:)) @@ -260,10 +244,10 @@ subroutine GFS_diagtoscreen_run (Model, Statein, Stateout, Sfcprop, Coupling, call print_var(mpirank,omprank, blkno, 'Tbd%ccn_nm' , Tbd%ccn_nm) call print_var(mpirank,omprank, blkno, 'Tbd%aer_nm' , Tbd%aer_nm) ! Diag - call print_var(mpirank,omprank, blkno, 'Diag%fluxr ', Diag%fluxr) - do n=1,size(Diag%fluxr(1,:)) - call print_var(mpirank,omprank, blkno, 'Diag%fluxr_n ', Diag%fluxr(:,n)) - end do + !call print_var(mpirank,omprank, blkno, 'Diag%fluxr ', Diag%fluxr) + !do n=1,size(Diag%fluxr(1,:)) + ! call print_var(mpirank,omprank, blkno, 'Diag%fluxr_n ', Diag%fluxr(:,n)) + !end do call print_var(mpirank,omprank, blkno, 'Diag%srunoff ', Diag%srunoff) call print_var(mpirank,omprank, blkno, 'Diag%evbsa ', Diag%evbsa) call print_var(mpirank,omprank, blkno, 'Diag%evcwa ', Diag%evcwa) @@ -321,10 +305,16 @@ subroutine GFS_diagtoscreen_run (Model, Statein, Stateout, Sfcprop, Coupling, call print_var(mpirank,omprank, blkno, 'Diag%epi ', Diag%epi) call print_var(mpirank,omprank, blkno, 'Diag%smcwlt2 ', Diag%smcwlt2) call print_var(mpirank,omprank, blkno, 'Diag%smcref2 ', Diag%smcref2) + call print_var(mpirank,omprank, blkno, 'Diag%sr ', Diag%sr) call print_var(mpirank,omprank, blkno, 'Diag%tdomr ', Diag%tdomr) call print_var(mpirank,omprank, blkno, 'Diag%tdomzr ', Diag%tdomzr) call print_var(mpirank,omprank, blkno, 'Diag%tdomip ', Diag%tdomip) call print_var(mpirank,omprank, blkno, 'Diag%tdoms ', Diag%tdoms) + if (Model%lsm == Model%lsm_ruc) then + call print_var(mpirank,omprank, blkno, 'Diag%wet1 ', Sfcprop%wetness) + else + call print_var(mpirank,omprank, blkno, 'Diag%wet1 ', Diag%wet1) + end if call print_var(mpirank,omprank, blkno, 'Diag%skebu_wts ', Diag%skebu_wts) call print_var(mpirank,omprank, blkno, 'Diag%skebv_wts ', Diag%skebv_wts) call print_var(mpirank,omprank, blkno, 'Diag%sppt_wts ', Diag%sppt_wts) @@ -408,7 +398,7 @@ subroutine GFS_diagtoscreen_run (Model, Statein, Stateout, Sfcprop, Coupling, call print_var(mpirank,omprank, blkno, 'Coupling%sfcdsw ', Coupling%sfcdsw ) call print_var(mpirank,omprank, blkno, 'Coupling%sfcnsw ', Coupling%sfcnsw ) call print_var(mpirank,omprank, blkno, 'Coupling%sfcdlw ', Coupling%sfcdlw ) - if (Model%cplflx .or. Model%do_sppt) then + if (Model%cplflx .or. Model%do_sppt .or. Model%cplchm) then call print_var(mpirank,omprank, blkno, 'Coupling%rain_cpl', Coupling%rain_cpl) call print_var(mpirank,omprank, blkno, 'Coupling%snow_cpl', Coupling%snow_cpl) end if @@ -464,10 +454,10 @@ subroutine GFS_diagtoscreen_run (Model, Statein, Stateout, Sfcprop, Coupling, call print_var(mpirank,omprank, blkno, 'Coupling%psurfi_cpl ', Coupling%psurfi_cpl ) end if if (Model%cplchm) then - call print_var(mpirank,omprank, blkno, 'Coupling%rain_cpl ', Coupling%rain_cpl ) call print_var(mpirank,omprank, blkno, 'Coupling%rainc_cpl', Coupling%rainc_cpl) call print_var(mpirank,omprank, blkno, 'Coupling%ushfsfci ', Coupling%ushfsfci ) call print_var(mpirank,omprank, blkno, 'Coupling%dkt ', Coupling%dkt ) + call print_var(mpirank,omprank, blkno, 'Coupling%dqdti ', Coupling%dqdti ) end if if (Model%do_sppt) then call print_var(mpirank,omprank, blkno, 'Coupling%sppt_wts', Coupling%sppt_wts) @@ -482,14 +472,6 @@ subroutine GFS_diagtoscreen_run (Model, Statein, Stateout, Sfcprop, Coupling, if (Model%do_sfcperts) then call print_var(mpirank,omprank, blkno, 'Coupling%sfc_wts', Coupling%sfc_wts) end if - if (Model%lgocart .or. Model%ldiag3d) then - call print_var(mpirank,omprank, blkno, 'Coupling%dqdti ', Coupling%dqdti ) - call print_var(mpirank,omprank, blkno, 'Coupling%cnvqci ', Coupling%cnvqci ) - call print_var(mpirank,omprank, blkno, 'Coupling%upd_mfi', Coupling%upd_mfi) - call print_var(mpirank,omprank, blkno, 'Coupling%dwn_mfi', Coupling%dwn_mfi) - call print_var(mpirank,omprank, blkno, 'Coupling%det_mfi', Coupling%det_mfi) - call print_var(mpirank,omprank, blkno, 'Coupling%cldcovi', Coupling%cldcovi) - end if if(Model%imp_physics == Model%imp_physics_thompson .and. Model%ltaerosol) then call print_var(mpirank,omprank, blkno, 'Coupling%nwfa2d', Coupling%nwfa2d) call print_var(mpirank,omprank, blkno, 'Coupling%nifa2d', Coupling%nifa2d) @@ -628,7 +610,7 @@ subroutine print_real_2d(mpirank,omprank,blkno,name,var) integer, intent(in) :: mpirank, omprank, blkno character(len=*), intent(in) :: name real(kind_phys), intent(in) :: var(:,:) - + integer :: k, i #ifdef PRINT_SUM @@ -755,7 +737,7 @@ end module GFS_diagtoscreen module GFS_interstitialtoscreen private - + public GFS_interstitialtoscreen_init, GFS_interstitialtoscreen_run, GFS_interstitialtoscreen_finalize contains @@ -767,23 +749,7 @@ subroutine GFS_interstitialtoscreen_finalize () end subroutine GFS_interstitialtoscreen_finalize !> \section arg_table_GFS_interstitialtoscreen_run Argument Table -!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | -!! |----------------|--------------------------------------------------------|---------------------------------------------------------|---------------|------|-----------------------|-----------|--------|----------| -!! | Model | GFS_control_type_instance | instance of derived type GFS_control_type | DDT | 0 | GFS_control_type | | in | F | -!! | Statein | GFS_statein_type_instance | instance of derived type GFS_statein_type | DDT | 0 | GFS_statein_type | | in | F | -!! | Stateout | GFS_stateout_type_instance | instance of derived type GFS_stateout_type | DDT | 0 | GFS_stateout_type | | in | F | -!! | Sfcprop | GFS_sfcprop_type_instance | instance of derived type GFS_sfcprop_type | DDT | 0 | GFS_sfcprop_type | | in | F | -!! | Coupling | GFS_coupling_type_instance | instance of derived type GFS_coupling_type | DDT | 0 | GFS_coupling_type | | in | F | -!! | Grid | GFS_grid_type_instance | instance of derived type GFS_grid_type | DDT | 0 | GFS_grid_type | | in | F | -!! | Tbd | GFS_tbd_type_instance | instance of derived type GFS_tbd_type | DDT | 0 | GFS_tbd_type | | in | F | -!! | Cldprop | GFS_cldprop_type_instance | instance of derived type GFS_cldprop_type | DDT | 0 | GFS_cldprop_type | | in | F | -!! | Radtend | GFS_radtend_type_instance | instance of derived type GFS_radtend_type | DDT | 0 | GFS_radtend_type | | in | F | -!! | Diag | GFS_diag_type_instance | instance of derived type GFS_diag_type | DDT | 0 | GFS_diag_type | | in | F | -!! | Interstitial | GFS_interstitial_type_instance | instance of derived type GFS_interstitial_type | DDT | 0 | GFS_interstitial_type | | in | F | -!! | nthreads | omp_threads | number of OpenMP threads or fast physics schemes | count | 0 | integer | | in | F | -!! | blkno | ccpp_block_number | number of block for explicit data blocking in CCPP | index | 0 | integer | | in | F | -!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | -!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | +!! \htmlinclude GFS_interstitialtoscreen_run.html !! subroutine GFS_interstitialtoscreen_run (Model, Statein, Stateout, Sfcprop, Coupling, & Grid, Tbd, Cldprop, Radtend, Diag, Interstitial, & @@ -883,7 +849,7 @@ end module GFS_interstitialtoscreen module GFS_abort private - + public GFS_abort_init, GFS_abort_run, GFS_abort_finalize contains @@ -895,12 +861,7 @@ subroutine GFS_abort_finalize () end subroutine GFS_abort_finalize !> \section arg_table_GFS_abort_run Argument Table -!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | -!! |----------------|--------------------------------------------------------|---------------------------------------------------------|---------------|------|-----------------------|-----------|--------|----------| -!! | Model | GFS_control_type_instance | instance of derived type GFS_control_type | DDT | 0 | GFS_control_type | | in | F | -!! | blkno | ccpp_block_number | number of block for explicit data blocking in CCPP | index | 0 | integer | | in | F | -!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | -!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | +!! \htmlinclude GFS_abort_run.html !! subroutine GFS_abort_run (Model, blkno, errmsg, errflg) @@ -928,3 +889,107 @@ subroutine GFS_abort_run (Model, blkno, errmsg, errflg) end subroutine GFS_abort_run end module GFS_abort + + module GFS_checkland + + private + + public GFS_checkland_init, GFS_checkland_run, GFS_checkland_finalize + + contains + + subroutine GFS_checkland_init () + end subroutine GFS_checkland_init + + subroutine GFS_checkland_finalize () + end subroutine GFS_checkland_finalize + +!> \section arg_table_GFS_checkland_run Argument Table +!! \htmlinclude GFS_checkland_run.html +!! + subroutine GFS_checkland_run (me, master, blkno, im, kdt, iter, flag_iter, flag_guess, & + flag_init, flag_restart, frac_grid, isot, ivegsrc, stype, vtype, slope, & + soiltyp, vegtype, slopetyp, dry, icy, wet, lake, ocean, & + oceanfrac, landfrac, lakefrac, slmsk, islmsk, errmsg, errflg ) + + use machine, only: kind_phys + + implicit none + + ! Interface variables + integer, intent(in ) :: me + integer, intent(in ) :: master + integer, intent(in ) :: blkno + integer, intent(in ) :: im + integer, intent(in ) :: kdt + integer, intent(in ) :: iter + logical, intent(in ) :: flag_iter(im) + logical, intent(in ) :: flag_guess(im) + logical, intent(in ) :: flag_init + logical, intent(in ) :: flag_restart + logical, intent(in ) :: frac_grid + integer, intent(in ) :: isot + integer, intent(in ) :: ivegsrc + real(kind_phys), intent(in ) :: stype(im) + real(kind_phys), intent(in ) :: vtype(im) + real(kind_phys), intent(in ) :: slope(im) + integer, intent(in ) :: soiltyp(im) + integer, intent(in ) :: vegtype(im) + integer, intent(in ) :: slopetyp(im) + logical, intent(in ) :: dry(im) + logical, intent(in ) :: icy(im) + logical, intent(in ) :: wet(im) + logical, intent(in ) :: lake(im) + logical, intent(in ) :: ocean(im) + real(kind_phys), intent(in ) :: oceanfrac(im) + real(kind_phys), intent(in ) :: landfrac(im) + real(kind_phys), intent(in ) :: lakefrac(im) + real(kind_phys), intent(in ) :: slmsk(im) + integer, intent(in ) :: islmsk(im) + character(len=*), intent( out) :: errmsg + integer, intent( out) :: errflg + + ! Local variables + integer :: i + + errflg = 0 + errmsg = '' + + write(0,'(a,i5)') 'YYY: me :', me + write(0,'(a,i5)') 'YYY: master :', master + write(0,'(a,i5)') 'YYY: blkno :', blkno + write(0,'(a,i5)') 'YYY: im :', im + write(0,'(a,i5)') 'YYY: kdt :', kdt + write(0,'(a,i5)') 'YYY: iter :', iter + write(0,'(a,1x,l)') 'YYY: flag_init :', flag_init + write(0,'(a,1x,l)') 'YYY: flag_restart :', flag_restart + write(0,'(a,1x,l)') 'YYY: frac_grid :', frac_grid + write(0,'(a,i5)') 'YYY: isot :', isot + write(0,'(a,i5)') 'YYY: ivegsrc :', ivegsrc + + do i=1,im + !if (vegtype(i)==15) then + write(0,'(a,2i5,1x,1x,l)') 'YYY: i, blk, flag_iter(i) :', i, blkno, flag_iter(i) + write(0,'(a,2i5,1x,1x,l)') 'YYY: i, blk, flag_guess(i) :', i, blkno, flag_guess(i) + write(0,'(a,2i5,1x,e16.7)')'YYY: i, blk, stype(i) :', i, blkno, stype(i) + write(0,'(a,2i5,1x,e16.7)')'YYY: i, blk, vtype(i) :', i, blkno, vtype(i) + write(0,'(a,2i5,1x,e16.7)')'YYY: i, blk, slope(i) :', i, blkno, slope(i) + write(0,'(a,2i5,1x,i5)') 'YYY: i, blk, soiltyp(i) :', i, blkno, soiltyp(i) + write(0,'(a,2i5,1x,i5)') 'YYY: i, blk, vegtype(i) :', i, blkno, vegtype(i) + write(0,'(a,2i5,1x,i5)') 'YYY: i, blk, slopetyp(i) :', i, blkno, slopetyp(i) + write(0,'(a,2i5,1x,1x,l)') 'YYY: i, blk, dry(i) :', i, blkno, dry(i) + write(0,'(a,2i5,1x,1x,l)') 'YYY: i, blk, icy(i) :', i, blkno, icy(i) + write(0,'(a,2i5,1x,1x,l)') 'YYY: i, blk, wet(i) :', i, blkno, wet(i) + write(0,'(a,2i5,1x,1x,l)') 'YYY: i, blk, lake(i) :', i, blkno, lake(i) + write(0,'(a,2i5,1x,1x,l)') 'YYY: i, blk, ocean(i) :', i, blkno, ocean(i) + write(0,'(a,2i5,1x,e16.7)')'YYY: i, blk, oceanfrac(i) :', i, blkno, oceanfrac(i) + write(0,'(a,2i5,1x,e16.7)')'YYY: i, blk, landfrac(i) :', i, blkno, landfrac(i) + write(0,'(a,2i5,1x,e16.7)')'YYY: i, blk, lakefrac(i) :', i, blkno, lakefrac(i) + write(0,'(a,2i5,1x,e16.7)')'YYY: i, blk, slmsk(i) :', i, blkno, slmsk(i) + write(0,'(a,2i5,1x,i5)') 'YYY: i, blk, islmsk(i) :', i, blkno, islmsk(i) + !end if + end do + + end subroutine GFS_checkland_run + + end module GFS_checkland diff --git a/physics/GFS_debug.meta b/physics/GFS_debug.meta new file mode 100644 index 000000000..24d26be7e --- /dev/null +++ b/physics/GFS_debug.meta @@ -0,0 +1,549 @@ +[ccpp-arg-table] + name = GFS_diagtoscreen_run + type = scheme +[Model] + standard_name = GFS_control_type_instance + long_name = instance of derived type GFS_control_type in FV3 + units = DDT + dimensions = () + type = GFS_control_type + intent = in + optional = F +[Statein] + standard_name = GFS_statein_type_instance + long_name = instance of derived type GFS_statein_type in FV3 + units = DDT + dimensions = () + type = GFS_statein_type + intent = in + optional = F +[Stateout] + standard_name = GFS_stateout_type_instance + long_name = instance of derived type GFS_stateout_type + units = DDT + dimensions = () + type = GFS_stateout_type + intent = in + optional = F +[Sfcprop] + standard_name = GFS_sfcprop_type_instance + long_name = instance of type GFS_sfcprop_type in FV3 + units = DDT + dimensions = () + type = GFS_sfcprop_type + intent = in + optional = F +[Coupling] + standard_name = GFS_coupling_type_instance + long_name = instance of type GFS_coupling_type in FV3 + units = DDT + dimensions = () + type = GFS_coupling_type + intent = in + optional = F +[Grid] + standard_name = GFS_grid_type_instance + long_name = instance of type GFS_grid_type in FV3 + units = DDT + dimensions = () + type = GFS_grid_type + intent = in + optional = F +[Tbd] + standard_name = GFS_tbd_type_instance + long_name = instance of type GFS_tbd_type in FV3 + units = DDT + dimensions = () + type = GFS_tbd_type + intent = in + optional = F +[Cldprop] + standard_name = GFS_cldprop_type_instance + long_name = instance of type GFS_cldprop_type in FV3 + units = DDT + dimensions = () + type = GFS_cldprop_type + intent = in + optional = F +[Radtend] + standard_name = GFS_radtend_type_instance + long_name = instance of type GFS_radtend_type in FV3 + units = DDT + dimensions = () + type = GFS_radtend_type + intent = in + optional = F +[Diag] + standard_name = GFS_diag_type_instance + long_name = instance of type GFS_diag_type in FV3 + units = DDT + dimensions = () + type = GFS_diag_type + intent = in + optional = F +[Interstitial] + standard_name = GFS_interstitial_type_instance + long_name = instance of type GFS_interstitial_type in FV3 + units = DDT + dimensions = () + type = GFS_interstitial_type + intent = in + optional = F +[nthreads] + standard_name = omp_threads + long_name = number of OpenMP threads or fast physics schemes + units = count + dimensions = () + type = integer + intent = in + optional = F +[blkno] + standard_name = ccpp_block_number + long_name = number of block for explicit data blocking in CCPP + units = index + dimensions = () + type = integer + intent = in + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F + +######################################################################## +[ccpp-arg-table] + name = GFS_interstitialtoscreen_run + type = scheme +[Model] + standard_name = GFS_control_type_instance + long_name = instance of derived type GFS_control_type + units = DDT + dimensions = () + type = GFS_control_type + intent = in + optional = F +[Statein] + standard_name = GFS_statein_type_instance + long_name = instance of derived type GFS_statein_type + units = DDT + dimensions = () + type = GFS_statein_type + intent = in + optional = F +[Stateout] + standard_name = GFS_stateout_type_instance + long_name = instance of derived type GFS_stateout_type + units = DDT + dimensions = () + type = GFS_stateout_type + intent = in + optional = F +[Sfcprop] + standard_name = GFS_sfcprop_type_instance + long_name = instance of derived type GFS_sfcprop_type + units = DDT + dimensions = () + type = GFS_sfcprop_type + intent = in + optional = F +[Coupling] + standard_name = GFS_coupling_type_instance + long_name = instance of derived type GFS_coupling_type + units = DDT + dimensions = () + type = GFS_coupling_type + intent = in + optional = F +[Grid] + standard_name = GFS_grid_type_instance + long_name = instance of derived type GFS_grid_type + units = DDT + dimensions = () + type = GFS_grid_type + intent = in + optional = F +[Tbd] + standard_name = GFS_tbd_type_instance + long_name = instance of derived type GFS_tbd_type + units = DDT + dimensions = () + type = GFS_tbd_type + intent = in + optional = F +[Cldprop] + standard_name = GFS_cldprop_type_instance + long_name = instance of derived type GFS_cldprop_type + units = DDT + dimensions = () + type = GFS_cldprop_type + intent = in + optional = F +[Radtend] + standard_name = GFS_radtend_type_instance + long_name = instance of derived type GFS_radtend_type + units = DDT + dimensions = () + type = GFS_radtend_type + intent = in + optional = F +[Diag] + standard_name = GFS_diag_type_instance + long_name = instance of derived type GFS_diag_type + units = DDT + dimensions = () + type = GFS_diag_type + intent = in + optional = F +[Interstitial] + standard_name = GFS_interstitial_type_instance + long_name = instance of derived type GFS_interstitial_type + units = DDT + dimensions = () + type = GFS_interstitial_type + intent = in + optional = F +[nthreads] + standard_name = omp_threads + long_name = number of OpenMP threads or fast physics schemes + units = count + dimensions = () + type = integer + intent = in + optional = F +[blkno] + standard_name = ccpp_block_number + long_name = number of block for explicit data blocking in CCPP + units = index + dimensions = () + type = integer + intent = in + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F + +######################################################################## +[ccpp-arg-table] + name = GFS_abort_run + type = scheme +[Model] + standard_name = GFS_control_type_instance + long_name = instance of derived type GFS_control_type + units = DDT + dimensions = () + type = GFS_control_type + intent = in + optional = F +[blkno] + standard_name = ccpp_block_number + long_name = number of block for explicit data blocking in CCPP + units = index + dimensions = () + type = integer + intent = in + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F + +######################################################################## +[ccpp-arg-table] + name = GFS_checkland_run + type = scheme +[me] + standard_name = mpi_rank + long_name = current MPI-rank + units = index + dimensions = () + type = integer + intent = in + optional = F +[master] + standard_name = mpi_root + long_name = master MPI-rank + units = index + dimensions = () + type = integer + intent = in + optional = F +[blkno] + standard_name = ccpp_block_number + long_name = number of block for explicit data blocking in CCPP + units = index + dimensions = () + type = integer + intent = in + optional = F +[im] + standard_name = horizontal_loop_extent + long_name = horizontal loop extent + units = count + dimensions = () + type = integer + intent = in + optional = F +[kdt] + standard_name = index_of_time_step + long_name = current number of time steps + units = index + dimensions = () + type = integer + intent = in + optional = F +[iter] + standard_name = ccpp_loop_counter + long_name = loop counter for subcycling loops in CCPP + units = index + dimensions = () + type = integer + intent = in + optional = F +[flag_iter] + standard_name = flag_for_iteration + long_name = flag for iteration + units = flag + dimensions = (horizontal_dimension) + type = logical + intent = in + optional = F +[flag_guess] + standard_name = flag_for_guess_run + long_name = flag for guess run + units = flag + dimensions = (horizontal_dimension) + type = logical + intent = in + optional = F +[flag_init] + standard_name = flag_for_first_time_step + long_name = flag signaling first time step for time integration loop + units = flag + dimensions = () + type = logical + intent = in + optional = F +[flag_restart] + standard_name = flag_for_restart + long_name = flag for restart (warmstart) or coldstart + units = flag + dimensions = () + type = logical + intent = in + optional = F +[frac_grid] + standard_name = flag_for_fractional_grid + long_name = flag for fractional grid + units = flag + dimensions = () + type = logical + intent = in + optional = F +[isot] + standard_name = soil_type_dataset_choice + long_name = soil type dataset choice + units = index + dimensions = () + type = integer + intent = in + optional = F +[ivegsrc] + standard_name = vegetation_type_dataset_choice + long_name = land use dataset choice + units = index + dimensions = () + type = integer + intent = in + optional = F +[stype] + standard_name = soil_type_classification_real + long_name = soil type for lsm + units = index + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[vtype] + standard_name = vegetation_type_classification_real + long_name = vegetation type for lsm + units = index + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[slope] + standard_name = surface_slope_classification_real + long_name = sfc slope type for lsm + units = index + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[soiltyp] + standard_name = soil_type_classification + long_name = soil type at each grid cell + units = index + dimensions = (horizontal_dimension) + type = integer + intent = in + optional = F +[vegtype] + standard_name = vegetation_type_classification + long_name = vegetation type at each grid cell + units = index + dimensions = (horizontal_dimension) + type = integer + intent = in + optional = F +[slopetyp] + standard_name = surface_slope_classification + long_name = surface slope type at each grid cell + units = index + dimensions = (horizontal_dimension) + type = integer + intent = in + optional = F +[dry] + standard_name = flag_nonzero_land_surface_fraction + long_name = flag indicating some land surface area fraction + units = flag + dimensions = (horizontal_dimension) + type = logical + intent = in + optional = F +[icy] + standard_name = flag_nonzero_sea_ice_surface_fraction + long_name = flag indicating some sea ice surface area fraction + units = flag + dimensions = (horizontal_dimension) + type = logical + intent = in + optional = F +[wet] + standard_name = flag_nonzero_wet_surface_fraction + long_name = flag indicating some ocean or lake surface area fraction + units = flag + dimensions = (horizontal_dimension) + type = logical + intent = in + optional = F +[lake] + standard_name = flag_nonzero_lake_surface_fraction + long_name = flag indicating some lake surface area fraction + units = flag + dimensions = (horizontal_dimension) + type = logical + intent = in + optional = F +[ocean] + standard_name = flag_nonzero_ocean_surface_fraction + long_name = flag indicating some ocean surface area fraction + units = flag + dimensions = (horizontal_dimension) + type = logical + intent = in + optional = F +[oceanfrac] + standard_name = sea_area_fraction + long_name = fraction of horizontal grid area occupied by ocean + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[landfrac] + standard_name = land_area_fraction + long_name = fraction of horizontal grid area occupied by land + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[lakefrac] + standard_name = lake_area_fraction + long_name = fraction of horizontal grid area occupied by lake + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[slmsk] + standard_name = sea_land_ice_mask_real + long_name = landmask: sea/land/ice=0/1/2 + units = flag + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[islmsk] + standard_name = sea_land_ice_mask + long_name = sea/land/ice mask (=0/1/2) + units = flag + dimensions = (horizontal_dimension) + type = integer + intent = in + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F diff --git a/physics/GFS_phys_time_vary.fv3.F90 b/physics/GFS_phys_time_vary.fv3.F90 index b8823fac6..0303248b7 100644 --- a/physics/GFS_phys_time_vary.fv3.F90 +++ b/physics/GFS_phys_time_vary.fv3.F90 @@ -2,8 +2,9 @@ !! Contains code related to GFS physics suite setup (physics part of time_vary_step) !>\defgroup mod_GFS_phys_time_vary GFS Physics Time Update -!! This module contains GFS physics time vary subroutines including ozone, h2o, i -!! aerosol and IN&CCN updates. +!! This module contains GFS physics time vary subroutines including ozone, stratospheric water vapor, +!! aerosol, IN&CCN and surface properties updates. +!> @{ module GFS_phys_time_vary #ifdef OPENMP @@ -22,6 +23,11 @@ module GFS_phys_time_vary use iccn_def, only : ciplin, ccnin, ci_pres use iccninterp, only : read_cidata, setindxci, ciinterpol +#if 0 + !--- variables needed for calculating 'sncovr' + use namelist_soilveg, only: salp_data, snupx +#endif + implicit none private @@ -33,15 +39,10 @@ module GFS_phys_time_vary contains !> \section arg_table_GFS_phys_time_vary_init Argument Table -!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | -!! |----------------|--------------------------------------------------------|-------------------------------------------------------------------------|----------|------|-----------------------|-----------|--------|----------| -!! | Data | GFS_data_type_instance_all_blocks | Fortran DDT containing FV3-GFS data | DDT | 1 | GFS_data_type | | inout | F | -!! | Model | GFS_control_type_instance | Fortran DDT containing FV3-GFS model control parameters | DDT | 0 | GFS_control_type | | inout | F | -!! | Interstitial | GFS_interstitial_type_instance_all_threads | Fortran DDT containing FV3-GFS interstitial data | DDT | 1 | GFS_interstitial_type | | inout | F | -!! | nthrds | omp_threads | number of OpenMP threads available for physics schemes | count | 0 | integer | | in | F | -!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | -!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | +!! \htmlinclude GFS_phys_time_vary_init.html !! +!>\section gen_GFS_phys_time_vary_init GFS_phys_time_vary_init General Algorithm +!! @{ subroutine GFS_phys_time_vary_init (Data, Model, Interstitial, nthrds, errmsg, errflg) use GFS_typedefs, only: GFS_control_type, GFS_data_type, GFS_interstitial_type @@ -111,6 +112,7 @@ subroutine GFS_phys_time_vary_init (Data, Model, Interstitial, nthrds, errmsg, e !$OMP sections !$OMP section +!> - Call read_o3data() to read ozone data call read_o3data (Model%ntoz, Model%me, Model%master) ! Consistency check that the hardcoded values for levozp and @@ -130,6 +132,7 @@ subroutine GFS_phys_time_vary_init (Data, Model, Interstitial, nthrds, errmsg, e end if !$OMP section +!> - Call read_h2odata() to read stratospheric water vapor data call read_h2odata (Model%h2o_phys, Model%me, Model%master) ! Consistency check that the hardcoded values for levh2o and @@ -149,6 +152,7 @@ subroutine GFS_phys_time_vary_init (Data, Model, Interstitial, nthrds, errmsg, e end if !$OMP section +!> - Call read_aerdata() to read aerosol climatology if (Model%aero_in) then ! Consistency check that the value for ntrcaerm set in GFS_typedefs.F90 ! and used to allocate Tbd%aer_nm matches the value defined in aerclm_def @@ -173,6 +177,7 @@ subroutine GFS_phys_time_vary_init (Data, Model, Interstitial, nthrds, errmsg, e endif !$OMP section +!> - Call read_cidata() to read IN and CCN data if (Model%iccn) then call read_cidata ( Model%me, Model%master) ! No consistency check needed for in/ccn data, all values are @@ -204,7 +209,7 @@ subroutine GFS_phys_time_vary_init (Data, Model, Interstitial, nthrds, errmsg, e end if - !--- read in and initialize ozone +!> - Call setindxoz() to initialize ozone data if (Model%ntoz > 0) then !$OMP do schedule (dynamic,1) do nb = 1, nblks @@ -214,7 +219,7 @@ subroutine GFS_phys_time_vary_init (Data, Model, Interstitial, nthrds, errmsg, e !$OMP end do endif - !--- read in and initialize stratospheric water +!> - Call setindxh2o() to initialize stratospheric water vapor data if (Model%h2o_phys) then !$OMP do schedule (dynamic,1) do nb = 1, nblks @@ -224,7 +229,7 @@ subroutine GFS_phys_time_vary_init (Data, Model, Interstitial, nthrds, errmsg, e !$OMP end do endif - !--- read in and initialize aerosols +!> - Call setindxaer() to initialize aerosols data if (Model%aero_in) then !$OMP do schedule (dynamic,1) do nb = 1, nblks @@ -236,7 +241,7 @@ subroutine GFS_phys_time_vary_init (Data, Model, Interstitial, nthrds, errmsg, e !$OMP end do endif - !--- read in and initialize IN and CCN +!> - Call setindxci() to initialize IN and CCN data if (Model%iccn) then !$OMP do schedule (dynamic,1) do nb = 1, nblks @@ -255,7 +260,7 @@ subroutine GFS_phys_time_vary_init (Data, Model, Interstitial, nthrds, errmsg, e do j = 1,Model%ny do i = 1,Model%nx ix = ix + 1 - if (ix .gt. Model%blksz(nb)) then + if (ix > Model%blksz(nb)) then ix = 1 nb = nb + 1 endif @@ -267,13 +272,11 @@ subroutine GFS_phys_time_vary_init (Data, Model, Interstitial, nthrds, errmsg, e is_initialized = .true. end subroutine GFS_phys_time_vary_init +!! @} !> \section arg_table_GFS_phys_time_vary_finalize Argument Table -!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | -!! |----------------|--------------------------------------------------------|-------------------------------------------------------------------------|----------|------|-----------------------|-----------|--------|----------| -!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | -!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | +!! \htmlinclude GFS_phys_time_vary_finalize.html !! subroutine GFS_phys_time_vary_finalize(errmsg, errflg) @@ -316,15 +319,11 @@ end subroutine GFS_phys_time_vary_finalize !> \section arg_table_GFS_phys_time_vary_run Argument Table -!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | -!! |----------------|--------------------------------------------------------|-------------------------------------------------------------------------|----------|------|-----------------------|-----------|--------|----------| -!! | Data | GFS_data_type_instance_all_blocks | Fortran DDT containing FV3-GFS data | DDT | 1 | GFS_data_type | | inout | F | -!! | Model | GFS_control_type_instance | Fortran DDT containing FV3-GFS model control parameters | DDT | 0 | GFS_control_type | | inout | F | -!! | nthrds | omp_threads | number of OpenMP threads available for physics schemes | count | 0 | integer | | in | F | -!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | -!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | +!! \htmlinclude GFS_phys_time_vary_run.html !! - subroutine GFS_phys_time_vary_run (Data, Model, nthrds, errmsg, errflg) +!>\section gen_GFS_phys_time_vary_run GFS_phys_time_vary_run General Algorithm +!> @{ + subroutine GFS_phys_time_vary_run (Data, Model, nthrds, first_time_step, errmsg, errflg) use mersenne_twister, only: random_setseed, random_number use machine, only: kind_phys @@ -333,9 +332,10 @@ subroutine GFS_phys_time_vary_run (Data, Model, nthrds, errmsg, errflg) implicit none ! Interface variables - type(GFS_data_type), intent(in) :: Data(:) + type(GFS_data_type), intent(inout) :: Data(:) type(GFS_control_type), intent(inout) :: Model integer, intent(in) :: nthrds + logical, intent(in) :: first_time_step character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -344,7 +344,8 @@ subroutine GFS_phys_time_vary_run (Data, Model, nthrds, errmsg, errflg) real(kind=kind_phys), parameter :: con_99 = 99.0_kind_phys real(kind=kind_phys), parameter :: con_100 = 100.0_kind_phys - integer :: i, j, k, iseed, iskip, ix, nb, nblks + integer :: i, j, k, iseed, iskip, ix, nb, nblks, kdt_rad, vegtyp + real(kind=kind_phys) :: sec_zero, rsnow real(kind=kind_phys) :: wrk(1) real(kind=kind_phys) :: rannie(Model%cny) real(kind=kind_phys) :: rndval(Model%cnx*Model%cny*Model%nrcm) @@ -412,7 +413,7 @@ subroutine GFS_phys_time_vary_run (Data, Model, nthrds, errmsg, errflg) enddo endif ! imfdeepcnv, cal_re, random_clds - !--- o3 interpolation +!> - Call ozinterpol() to make ozone interpolation if (Model%ntoz > 0) then !$OMP do schedule (dynamic,1) do nb = 1, nblks @@ -423,7 +424,7 @@ subroutine GFS_phys_time_vary_run (Data, Model, nthrds, errmsg, errflg) !$OMP end do endif - !--- h2o interpolation +!> - Call h2ointerpol() to make stratospheric water vapor data interpolation if (Model%h2o_phys) then !$OMP do schedule (dynamic,1) do nb = 1, nblks @@ -434,7 +435,7 @@ subroutine GFS_phys_time_vary_run (Data, Model, nthrds, errmsg, errflg) !$OMP end do endif - !--- aerosol interpolation +!> - Call aerinterpol() to make aerosol interpolation if (Model%aero_in) then !$OMP do schedule (dynamic,1) do nb = 1, nblks @@ -449,7 +450,7 @@ subroutine GFS_phys_time_vary_run (Data, Model, nthrds, errmsg, errflg) !$OMP end do endif - !--- ICCN interpolation +!> - Call ciinterpol() to make IN and CCN data interpolation if (Model%iccn) then !$OMP do schedule (dynamic,1) do nb = 1, nblks @@ -465,7 +466,7 @@ subroutine GFS_phys_time_vary_run (Data, Model, nthrds, errmsg, errflg) !$OMP end parallel - !--- repopulate specific time-varying sfc properties for AMIP/forecast runs +!> - Call gcycle() to repopulate specific time-varying surface properties for AMIP/forecast runs if (Model%nscyc > 0) then if (mod(Model%kdt,Model%nscyc) == 1) THEN call gcycle (nblks, Model, Data(:)%Grid, Data(:)%Sfcprop, Data(:)%Cldprop) @@ -473,14 +474,58 @@ subroutine GFS_phys_time_vary_run (Data, Model, nthrds, errmsg, errflg) endif !--- determine if diagnostics buckets need to be cleared - if (mod(Model%kdt,Model%nszero) == 1) then - do nb = 1,nblks - call Data(nb)%Intdiag%rad_zero (Model) - call Data(nb)%Intdiag%phys_zero (Model) + sec_zero = nint(Model%fhzero*con_hr) + if (sec_zero >= nint(max(Model%fhswr,Model%fhlwr))) then + if (mod(Model%kdt,Model%nszero) == 1) then + do nb = 1,nblks + call Data(nb)%Intdiag%rad_zero (Model) + call Data(nb)%Intdiag%phys_zero (Model) !!!! THIS IS THE POINT AT WHICH DIAG%ZHOUR NEEDS TO BE UPDATED - enddo + enddo + endif + else + if (mod(Model%kdt,Model%nszero) == 1) then + do nb = 1,nblks + call Data(nb)%Intdiag%phys_zero (Model) + !!!! THIS IS THE POINT AT WHICH DIAG%ZHOUR NEEDS TO BE UPDATED + enddo + endif + kdt_rad = nint(min(Model%fhswr,Model%fhlwr)/Model%dtp) + if (mod(Model%kdt, kdt_rad) == 1) then + do nb = 1,nblks + call Data(nb)%Intdiag%rad_zero (Model) + !!!! THIS IS THE POINT AT WHICH DIAG%ZHOUR NEEDS TO BE UPDATED + enddo + endif endif +#if 0 + !Calculate sncovr if it was read in but empty (from FV3/io/FV3GFS_io.F90/sfc_prop_restart_read) + if (first_time_step) then + if (nint(Data(1)%Sfcprop%sncovr(1)) == -9999) then + !--- compute sncovr from existing variables + !--- code taken directly from read_fix.f + do nb = 1, nblks + do ix = 1, Model%blksz(nb) + Data(nb)%Sfcprop%sncovr(ix) = 0.0 + if (Data(nb)%Sfcprop%slmsk(ix) > 0.001) then + vegtyp = Data(nb)%Sfcprop%vtype(ix) + if (vegtyp == 0) vegtyp = 7 + rsnow = 0.001*Data(nb)%Sfcprop%weasd(ix)/snupx(vegtyp) + if (0.001*Data(nb)%Sfcprop%weasd(ix) < snupx(vegtyp)) then + Data(nb)%Sfcprop%sncovr(ix) = 1.0 - (exp(-salp_data*rsnow) - rsnow*exp(-salp_data)) + else + Data(nb)%Sfcprop%sncovr(ix) = 1.0 + endif + endif + enddo + enddo + endif + endif +#endif + end subroutine GFS_phys_time_vary_run +!> @} end module GFS_phys_time_vary +!> @} diff --git a/physics/GFS_phys_time_vary.fv3.meta b/physics/GFS_phys_time_vary.fv3.meta new file mode 100644 index 000000000..ac2ccbf3c --- /dev/null +++ b/physics/GFS_phys_time_vary.fv3.meta @@ -0,0 +1,128 @@ +[ccpp-arg-table] + name = GFS_phys_time_vary_init + type = scheme +[Data] + standard_name = GFS_data_type_instance_all_blocks + long_name = Fortran DDT containing FV3-GFS data + units = DDT + dimensions = (ccpp_block_number) + type = GFS_data_type + intent = inout + optional = F +[Model] + standard_name = GFS_control_type_instance + long_name = Fortran DDT containing FV3-GFS model control parameters + units = DDT + dimensions = () + type = GFS_control_type + intent = inout + optional = F +[Interstitial] + standard_name = GFS_interstitial_type_instance_all_threads + long_name = Fortran DDT containing FV3-GFS interstitial data + units = DDT + dimensions = (ccpp_thread_number) + type = GFS_interstitial_type + intent = inout + optional = F +[nthrds] + standard_name = omp_threads + long_name = number of OpenMP threads available for physics schemes + units = count + dimensions = () + type = integer + intent = in + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F + +######################################################################## +[ccpp-arg-table] + name = GFS_phys_time_vary_finalize + type = scheme +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F + +######################################################################## +[ccpp-arg-table] + name = GFS_phys_time_vary_run + type = scheme +[Data] + standard_name = GFS_data_type_instance_all_blocks + long_name = Fortran DDT containing FV3-GFS data + units = DDT + dimensions = (ccpp_block_number) + type = GFS_data_type + intent = inout + optional = F +[Model] + standard_name = GFS_control_type_instance + long_name = Fortran DDT containing FV3-GFS model control parameters + units = DDT + dimensions = () + type = GFS_control_type + intent = inout + optional = F +[nthrds] + standard_name = omp_threads + long_name = number of OpenMP threads available for physics schemes + units = count + dimensions = () + type = integer + intent = in + optional = F +[first_time_step] + standard_name = flag_for_first_time_step + long_name = flag for first time step for time integration loop (cold/warmstart) + units = flag + dimensions = () + type = logical + intent = in + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F diff --git a/physics/GFS_phys_time_vary.scm.F90 b/physics/GFS_phys_time_vary.scm.F90 index 714713f78..3b4bbaf77 100644 --- a/physics/GFS_phys_time_vary.scm.F90 +++ b/physics/GFS_phys_time_vary.scm.F90 @@ -15,6 +15,11 @@ module GFS_phys_time_vary use iccn_def, only : ciplin, ccnin, ci_pres use iccninterp, only : read_cidata, setindxci, ciinterpol +#if 0 + !--- variables needed for calculating 'sncovr' + use namelist_soilveg, only: salp_data, snupx +#endif + implicit none private @@ -26,14 +31,7 @@ module GFS_phys_time_vary contains !> \section arg_table_GFS_phys_time_vary_init Argument Table -!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | -!! |----------------|--------------------------------------------------------|-------------------------------------------------------------------------|----------|------|-----------------------|-----------|--------|----------| -!! | Grid | GFS_grid_type_instance | Fortran DDT containing FV3-GFS grid and interpolation related data | DDT | 0 | GFS_grid_type | | inout | F | -!! | Model | GFS_control_type_instance | Fortran DDT containing FV3-GFS model control parameters | DDT | 0 | GFS_control_type | | in | F | -!! | Interstitial | GFS_interstitial_type_instance | Fortran DDT containing FV3-GFS interstitial data | DDT | 0 | GFS_interstitial_type | | inout | F | -!! | Tbd | GFS_tbd_type_instance | Fortran DDT containing FV3-GFS miscellaneous data | DDT | 0 | GFS_tbd_type | | in | F | -!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | -!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | +!! \htmlinclude GFS_phys_time_vary_init.html !! subroutine GFS_phys_time_vary_init (Grid, Model, Interstitial, Tbd, errmsg, errflg) @@ -184,10 +182,7 @@ subroutine GFS_phys_time_vary_init (Grid, Model, Interstitial, Tbd, errmsg, errf end subroutine GFS_phys_time_vary_init !> \section arg_table_GFS_phys_time_vary_finalize Argument Table -!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | -!! |----------------|--------------------------------------------------------|-------------------------------------------------------------------------|----------|------|-----------------------|-----------|--------|----------| -!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | -!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | +!! \htmlinclude GFS_phys_time_vary_finalize.html !! subroutine GFS_phys_time_vary_finalize(errmsg, errflg) implicit none @@ -224,22 +219,13 @@ subroutine GFS_phys_time_vary_finalize(errmsg, errflg) if (allocated(ci_pres) ) deallocate(ci_pres) is_initialized = .false. + end subroutine GFS_phys_time_vary_finalize !> \section arg_table_GFS_phys_time_vary_run Argument Table -!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | -!! |----------------|--------------------------------------------------------|-------------------------------------------------------------------------|---------------|------|-------------------------------|-----------|--------|----------| -!! | Grid | GFS_grid_type_instance | Fortran DDT containing FV3-GFS grid and interpolation related data | DDT | 0 | GFS_grid_type | | in | F | -!! | Statein | GFS_statein_type_instance | instance of derived type GFS_statein_type | DDT | 0 | GFS_statein_type | | in | F | -!! | Model | GFS_control_type_instance | Fortran DDT containing FV3-GFS model control parameters | DDT | 0 | GFS_control_type | | inout | F | -!! | Tbd | GFS_tbd_type_instance | Fortran DDT containing FV3-GFS miscellaneous data | DDT | 0 | GFS_tbd_type | | inout | F | -!! | Sfcprop | GFS_sfcprop_type_instance | Fortran DDT containing FV3-GFS surface fields | DDT | 0 | GFS_sfcprop_type | | inout | F | -!! | Cldprop | GFS_cldprop_type_instance | Fortran DDT containing FV3-GFS cloud fields | DDT | 0 | GFS_cldprop_type | | inout | F | -!! | Diag | GFS_diag_type_instance | Fortran DDT containing FV3-GFS fields targeted for diagnostic output | DDT | 0 | GFS_diag_type | | inout | F | -!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | -!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | +!! \htmlinclude GFS_phys_time_vary_run.html !! - subroutine GFS_phys_time_vary_run (Grid, Statein, Model, Tbd, Sfcprop, Cldprop, Diag, errmsg, errflg) + subroutine GFS_phys_time_vary_run (Grid, Statein, Model, Tbd, Sfcprop, Cldprop, Diag, first_time_step, errmsg, errflg) use mersenne_twister, only: random_setseed, random_number use machine, only: kind_phys @@ -257,6 +243,7 @@ subroutine GFS_phys_time_vary_run (Grid, Statein, Model, Tbd, Sfcprop, Cldprop, type(GFS_sfcprop_type), intent(inout) :: Sfcprop type(GFS_cldprop_type), intent(inout) :: Cldprop type(GFS_diag_type), intent(inout) :: Diag + logical, intent(in) :: first_time_step character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -264,7 +251,8 @@ subroutine GFS_phys_time_vary_run (Grid, Statein, Model, Tbd, Sfcprop, Cldprop, real(kind=kind_phys), parameter :: con_99 = 99.0_kind_phys real(kind=kind_phys), parameter :: con_100 = 100.0_kind_phys - integer :: i, j, k, iseed, iskip, ix, nb + integer :: i, j, k, iseed, iskip, ix, nb, kdt_rad, vegtyp + real(kind=kind_phys) :: sec_zero, rsnow real(kind=kind_phys) :: wrk(1) real(kind=kind_phys) :: rannie(Model%cny) real(kind=kind_phys) :: rndval(Model%cnx*Model%cny*Model%nrcm) @@ -362,11 +350,47 @@ subroutine GFS_phys_time_vary_run (Grid, Statein, Model, Tbd, Sfcprop, Cldprop, !endif !--- determine if diagnostics buckets need to be cleared - if (mod(Model%kdt,Model%nszero) == 1) then - call Diag%rad_zero (Model) - call Diag%phys_zero (Model) + sec_zero = nint(Model%fhzero*con_hr) + if (sec_zero >= nint(max(Model%fhswr,Model%fhlwr))) then + if (mod(Model%kdt,Model%nszero) == 1) then + call Diag%rad_zero (Model) + call Diag%phys_zero (Model) + !!!! THIS IS THE POINT AT WHICH DIAG%ZHOUR NEEDS TO BE UPDATED + endif + else + if (mod(Model%kdt,Model%nszero) == 1) then + call Diag%phys_zero (Model) !!!! THIS IS THE POINT AT WHICH DIAG%ZHOUR NEEDS TO BE UPDATED + endif + kdt_rad = nint(min(Model%fhswr,Model%fhlwr)/Model%dtp) + if (mod(Model%kdt, kdt_rad) == 1) then + call Diag%rad_zero (Model) + !!!! THIS IS THE POINT AT WHICH DIAG%ZHOUR NEEDS TO BE UPDATED + endif + endif + +#if 0 + !Calculate sncovr if it was read in but empty (from FV3/io/FV3GFS_io.F90/sfc_prop_restart_read) + if (first_time_step) then + if (nint(Sfcprop%sncovr(1)) == -9999) then + !--- compute sncovr from existing variables + !--- code taken directly from read_fix.f + do ix = 1, Model%blksz(nb) + Sfcprop%sncovr(ix) = 0.0 + if (Sfcprop%slmsk(ix) > 0.001) then + vegtyp = Sfcprop%vtype(ix) + if (vegtyp == 0) vegtyp = 7 + rsnow = 0.001*Sfcprop%weasd(ix)/snupx(vegtyp) + if (0.001*Sfcprop%weasd(ix) < snupx(vegtyp)) then + Sfcprop%sncovr(ix) = 1.0 - (exp(-salp_data*rsnow) - rsnow*exp(-salp_data)) + else + Sfcprop%sncovr(ix) = 1.0 + endif + endif + enddo + endif endif +#endif end subroutine GFS_phys_time_vary_run diff --git a/physics/GFS_phys_time_vary.scm.meta b/physics/GFS_phys_time_vary.scm.meta new file mode 100644 index 000000000..57a82ecb0 --- /dev/null +++ b/physics/GFS_phys_time_vary.scm.meta @@ -0,0 +1,160 @@ +[ccpp-arg-table] + name = GFS_phys_time_vary_init + type = scheme +[Grid] + standard_name = GFS_grid_type_instance + long_name = Fortran DDT containing FV3-GFS grid and interpolation related data + units = DDT + dimensions = () + type = GFS_grid_type + intent = inout + optional = F +[Model] + standard_name = GFS_control_type_instance + long_name = Fortran DDT containing FV3-GFS model control parameters + units = DDT + dimensions = () + type = GFS_control_type + intent = in + optional = F +[Interstitial] + standard_name = GFS_interstitial_type_instance + long_name = Fortran DDT containing FV3-GFS interstitial data + units = DDT + dimensions = () + type = GFS_interstitial_type + intent = inout + optional = F +[Tbd] + standard_name = GFS_tbd_type_instance + long_name = Fortran DDT containing FV3-GFS miscellaneous data + units = DDT + dimensions = () + type = GFS_tbd_type + intent = in + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F + +######################################################################## +[ccpp-arg-table] + name = GFS_phys_time_vary_finalize + type = scheme +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F + +######################################################################## +[ccpp-arg-table] + name = GFS_phys_time_vary_run + type = scheme +[Grid] + standard_name = GFS_grid_type_instance + long_name = Fortran DDT containing FV3-GFS grid and interpolation related data + units = DDT + dimensions = () + type = GFS_grid_type + intent = in + optional = F +[Statein] + standard_name = GFS_statein_type_instance + long_name = instance of derived type GFS_statein_type + units = DDT + dimensions = () + type = GFS_statein_type + intent = in + optional = F +[Model] + standard_name = GFS_control_type_instance + long_name = Fortran DDT containing FV3-GFS model control parameters + units = DDT + dimensions = () + type = GFS_control_type + intent = inout + optional = F +[Tbd] + standard_name = GFS_tbd_type_instance + long_name = Fortran DDT containing FV3-GFS miscellaneous data + units = DDT + dimensions = () + type = GFS_tbd_type + intent = inout + optional = F +[Sfcprop] + standard_name = GFS_sfcprop_type_instance + long_name = Fortran DDT containing FV3-GFS surface fields + units = DDT + dimensions = () + type = GFS_sfcprop_type + intent = inout + optional = F +[Cldprop] + standard_name = GFS_cldprop_type_instance + long_name = Fortran DDT containing FV3-GFS cloud fields + units = DDT + dimensions = () + type = GFS_cldprop_type + intent = inout + optional = F +[Diag] + standard_name = GFS_diag_type_instance + long_name = Fortran DDT containing FV3-GFS fields targeted for diagnostic output + units = DDT + dimensions = () + type = GFS_diag_type + intent = inout + optional = F +[first_time_step] + standard_name = flag_for_first_time_step + long_name = flag for first time step for time integration loop (cold/warmstart) + units = flag + dimensions = () + type = logical + intent = in + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F diff --git a/physics/GFS_rad_time_vary.fv3.F90 b/physics/GFS_rad_time_vary.fv3.F90 index ac96e78d0..9a4583dc4 100644 --- a/physics/GFS_rad_time_vary.fv3.F90 +++ b/physics/GFS_rad_time_vary.fv3.F90 @@ -10,22 +10,15 @@ module GFS_rad_time_vary contains -!>\defgroup GFS_rad_time_vary GFS RRTMG Update -!!\ingroup RRTMG -!! @{ !! \section arg_table_GFS_rad_time_vary_init Argument Table !! subroutine GFS_rad_time_vary_init end subroutine GFS_rad_time_vary_init +!>\defgroup mod_GFS_rad_time_vary GFS Radiation Time Update +!> @{ !> \section arg_table_GFS_rad_time_vary_run Argument Table -!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | -!! |-------------------|--------------------------------------------------------|-------------------------------------------------------------------------------|----------|------|-----------------------|-----------|--------|----------| -!! | Model | GFS_control_type_instance | Fortran DDT containing FV3-GFS model control parameters | DDT | 0 | GFS_control_type | | inout | F | -!! | Data | GFS_data_type_instance_all_blocks | Fortran DDT containing FV3-GFS data | DDT | 1 | GFS_data_type | | inout | F | -!! | nthrds | omp_threads | number of OpenMP threads available for physics schemes | count | 0 | integer | | in | F | -!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | -!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | +!! \htmlinclude GFS_rad_time_vary_run.html !! subroutine GFS_rad_time_vary_run (Model, Data, nthrds, errmsg, errflg) @@ -105,10 +98,10 @@ subroutine GFS_rad_time_vary_run (Model, Data, nthrds, errmsg, errflg) endif end subroutine GFS_rad_time_vary_run +!> @} !> \section arg_table_GFS_rad_time_vary_finalize Argument Table !! subroutine GFS_rad_time_vary_finalize() end subroutine GFS_rad_time_vary_finalize -!! @} end module GFS_rad_time_vary diff --git a/physics/GFS_rad_time_vary.fv3.meta b/physics/GFS_rad_time_vary.fv3.meta new file mode 100644 index 000000000..c86c81f18 --- /dev/null +++ b/physics/GFS_rad_time_vary.fv3.meta @@ -0,0 +1,54 @@ +[ccpp-arg-table] + name = GFS_rad_time_vary_init + type = scheme + +######################################################################## +[ccpp-arg-table] + name = GFS_rad_time_vary_run + type = scheme +[Model] + standard_name = GFS_control_type_instance + long_name = Fortran DDT containing FV3-GFS model control parameters + units = DDT + dimensions = () + type = GFS_control_type + intent = inout + optional = F +[Data] + standard_name = GFS_data_type_instance_all_blocks + long_name = Fortran DDT containing FV3-GFS data + units = DDT + dimensions = (ccpp_block_number) + type = GFS_data_type + intent = inout + optional = F +[nthrds] + standard_name = omp_threads + long_name = number of OpenMP threads available for physics schemes + units = count + dimensions = () + type = integer + intent = in + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F + +######################################################################## +[ccpp-arg-table] + name = GFS_rad_time_vary_finalize + type = scheme diff --git a/physics/GFS_rad_time_vary.scm.F90 b/physics/GFS_rad_time_vary.scm.F90 index 4ea13a416..13ae5e14b 100644 --- a/physics/GFS_rad_time_vary.scm.F90 +++ b/physics/GFS_rad_time_vary.scm.F90 @@ -19,13 +19,7 @@ subroutine GFS_rad_time_vary_init end subroutine GFS_rad_time_vary_init !> \section arg_table_GFS_rad_time_vary_run Argument Table -!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | -!! |-------------------|--------------------------------------------------------|-------------------------------------------------------------------------------|----------|------|-----------------------|-----------|--------|----------| -!! | Model | GFS_control_type_instance | Fortran DDT containing FV3-GFS model control parameters | DDT | 0 | GFS_control_type | | inout | F | -!! | Statein | GFS_statein_type_instance | Fortran DDT containing FV3-GFS prognostic state data in from dycore | DDT | 0 | GFS_statein_type | | in | F | -!! | Tbd | GFS_tbd_type_instance | Fortran DDT containing FV3-GFS data not yet assigned to a defined container | DDT | 0 | GFS_tbd_type | | inout | F | -!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | -!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | +!! \htmlinclude GFS_rad_time_vary_run.html !! subroutine GFS_rad_time_vary_run (Model, Statein, Tbd, errmsg, errflg) diff --git a/physics/GFS_rad_time_vary.scm.meta b/physics/GFS_rad_time_vary.scm.meta new file mode 100644 index 000000000..7e87f1f8a --- /dev/null +++ b/physics/GFS_rad_time_vary.scm.meta @@ -0,0 +1,54 @@ +[ccpp-arg-table] + name = GFS_rad_time_vary_init + type = scheme + +######################################################################## +[ccpp-arg-table] + name = GFS_rad_time_vary_run + type = scheme +[Model] + standard_name = GFS_control_type_instance + long_name = Fortran DDT containing FV3-GFS model control parameters + units = DDT + dimensions = () + type = GFS_control_type + intent = inout + optional = F +[Statein] + standard_name = GFS_statein_type_instance + long_name = Fortran DDT containing FV3-GFS prognostic state data in from dycore + units = DDT + dimensions = () + type = GFS_statein_type + intent = in + optional = F +[Tbd] + standard_name = GFS_tbd_type_instance + long_name = Fortran DDT containing FV3-GFS data not yet assigned to a defined container + units = DDT + dimensions = () + type = GFS_tbd_type + intent = inout + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F + +######################################################################## +[ccpp-arg-table] + name = GFS_rad_time_vary_finalize + type = scheme diff --git a/physics/GFS_rrtmg_post.F90 b/physics/GFS_rrtmg_post.F90 index 4454998e5..db3de4f44 100644 --- a/physics/GFS_rrtmg_post.F90 +++ b/physics/GFS_rrtmg_post.F90 @@ -11,35 +11,11 @@ subroutine GFS_rrtmg_post_init () end subroutine GFS_rrtmg_post_init !> \section arg_table_GFS_rrtmg_post_run Argument Table -!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | -!! |----------------|---------------------------------------------------------------|-------------------------------------------------------------------------------|----------|------|-------------------|-----------|--------|----------| -!! | Model | GFS_control_type_instance | Fortran DDT containing FV3-GFS model control parameters | DDT | 0 | GFS_control_type | | in | F | -!! | Grid | GFS_grid_type_instance | Fortran DDT containing FV3-GFS grid and interpolation related data | DDT | 0 | GFS_grid_type | | in | F | -!! | Diag | GFS_diag_type_instance | Fortran DDT containing FV3-GFS diagnotics data | DDT | 0 | GFS_diag_type | | inout | F | -!! | Radtend | GFS_radtend_type_instance | Fortran DDT containing FV3-GFS radiation tendencies | DDT | 0 | GFS_radtend_type | | in | F | -!! | Statein | GFS_statein_type_instance | Fortran DDT containing FV3-GFS prognostic state data in from dycore | DDT | 0 | GFS_statein_type | | in | F | -!! | Coupling | GFS_coupling_type_instance | Fortran DDT containing FV3-GFS fields to/from coupling with other components | DDT | 0 | GFS_coupling_type | | inout | F | -!! | scmpsw | components_of_surface_downward_shortwave_fluxes | derived type for special components of surface downward shortwave fluxes | W m-2 | 1 | cmpfsw_type | | in | F | -!! | im | horizontal_loop_extent | horizontal loop extent | count | 0 | integer | | in | F | -!! | lm | vertical_layer_dimension_for_radiation | number of vertical layers for radiation calculation | count | 0 | integer | | in | F | -!! | ltp | extra_top_layer | extra top layers | none | 0 | integer | | in | F | -!! | kt | vertical_index_difference_between_layer_and_upper_bound | vertical index difference between layer and upper bound | index | 0 | integer | | in | F | -!! | kb | vertical_index_difference_between_layer_and_lower_bound | vertical index difference between layer and lower bound | index | 0 | integer | | in | F | -!! | kd | vertical_index_difference_between_inout_and_local | vertical index difference between in/out and local | index | 0 | integer | | in | F | -!! | raddt | time_step_for_radiation | radiation time step | s | 0 | real | kind_phys | in | F | -!! | aerodp | atmosphere_optical_thickness_due_to_ambient_aerosol_particles | vertical integrated optical depth for various aerosol species | none | 2 | real | kind_phys | in | F | -!! | cldsa | cloud_area_fraction_for_radiation | fraction of clouds for low, middle, high, total and BL | frac | 2 | real | kind_phys | in | F | -!! | mtopa | model_layer_number_at_cloud_top | vertical indices for low, middle and high cloud tops | index | 2 | integer | | in | F | -!! | mbota | model_layer_number_at_cloud_base | vertical indices for low, middle and high cloud bases | index | 2 | integer | | in | F | -!! | clouds1 | total_cloud_fraction | layer total cloud fraction | frac | 2 | real | kind_phys | in | F | -!! | cldtaulw | cloud_optical_depth_layers_at_10mu_band | approx 10mu band layer cloud optical depth | none | 2 | real | kind_phys | in | F | -!! | cldtausw | cloud_optical_depth_layers_at_0.55mu_band | approx .55mu band layer cloud optical depth | none | 2 | real | kind_phys | in | F | -!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | -!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | +!! \htmlinclude GFS_rrtmg_post_run.html !! subroutine GFS_rrtmg_post_run (Model, Grid, Diag, Radtend, Statein, & Coupling, scmpsw, im, lm, ltp, kt, kb, kd, raddt, aerodp, & - cldsa, mtopa, mbota, clouds1, cldtaulw, cldtausw, & + cldsa, mtopa, mbota, clouds1, cldtaulw, cldtausw, nday, & errmsg, errflg) use machine, only: kind_phys @@ -65,7 +41,7 @@ subroutine GFS_rrtmg_post_run (Model, Grid, Diag, Radtend, Statein, & type(GFS_diag_type), intent(inout) :: Diag type(cmpfsw_type), dimension(size(Grid%xlon,1)), intent(in) :: scmpsw - integer, intent(in) :: im, lm, ltp, kt, kb, kd + integer, intent(in) :: im, lm, ltp, kt, kb, kd, nday real(kind=kind_phys), intent(in) :: raddt real(kind=kind_phys), dimension(size(Grid%xlon,1),NSPC1), intent(in) :: aerodp @@ -176,27 +152,42 @@ subroutine GFS_rrtmg_post_run (Model, Grid, Diag, Radtend, Statein, & Diag%fluxr(i,11-j) = Diag%fluxr(i,11-j) + tem0d * Statein%prsi(i,itop+kt) Diag%fluxr(i,14-j) = Diag%fluxr(i,14-j) + tem0d * Statein%prsi(i,ibtc+kb) Diag%fluxr(i,17-j) = Diag%fluxr(i,17-j) + tem0d * Statein%tgrs(i,itop) + enddo + enddo ! Anning adds optical depth and emissivity output - tem1 = 0. - tem2 = 0. - do k=ibtc,itop - tem1 = tem1 + cldtausw(i,k) ! approx .55 mu channel - tem2 = tem2 + cldtaulw(i,k) ! approx 10. mu channel + if (Model%lsswr .and. (nday > 0)) then + do j = 1, 3 + do i = 1, IM + tem0d = raddt * cldsa(i,j) + itop = mtopa(i,j) - kd + ibtc = mbota(i,j) - kd + tem1 = 0. + do k=ibtc,itop + tem1 = tem1 + cldtausw(i,k) ! approx .55 um channel + enddo + Diag%fluxr(i,43-j) = Diag%fluxr(i,43-j) + tem0d * tem1 enddo - Diag%fluxr(i,43-j) = Diag%fluxr(i,43-j) + tem0d * tem1 - Diag%fluxr(i,46-j) = Diag%fluxr(i,46-j) + tem0d * (1.0-exp(-tem2)) enddo - enddo - endif + endif + + if (Model%lslwr) then + do j = 1, 3 + do i = 1, IM + tem0d = raddt * cldsa(i,j) + itop = mtopa(i,j) - kd + ibtc = mbota(i,j) - kd + tem2 = 0. + do k=ibtc,itop + tem2 = tem2 + cldtaulw(i,k) ! approx 10. um channel + enddo + Diag%fluxr(i,46-j) = Diag%fluxr(i,46-j) + tem0d * (1.0-exp(-tem2)) + enddo + enddo + endif -! if (.not. Model%uni_cld) then - if (Model%lgocart .or. Model%ldiag3d) then - do k = 1, LM - k1 = k + kd - Coupling%cldcovi(1:im,k) = clouds1(1:im,k1) - enddo endif + endif ! end_if_lssav ! end subroutine GFS_rrtmg_post_run diff --git a/physics/GFS_rrtmg_post.meta b/physics/GFS_rrtmg_post.meta new file mode 100644 index 000000000..61e89098d --- /dev/null +++ b/physics/GFS_rrtmg_post.meta @@ -0,0 +1,212 @@ +[ccpp-arg-table] + name = GFS_rrtmg_post_init + type = scheme + +######################################################################## +[ccpp-arg-table] + name = GFS_rrtmg_post_run + type = scheme +[Model] + standard_name = GFS_control_type_instance + long_name = Fortran DDT containing FV3-GFS model control parameters + units = DDT + dimensions = () + type = GFS_control_type + intent = in + optional = F +[Grid] + standard_name = GFS_grid_type_instance + long_name = Fortran DDT containing FV3-GFS grid and interpolation related data + units = DDT + dimensions = () + type = GFS_grid_type + intent = in + optional = F +[Diag] + standard_name = GFS_diag_type_instance + long_name = Fortran DDT containing FV3-GFS diagnotics data + units = DDT + dimensions = () + type = GFS_diag_type + intent = inout + optional = F +[Radtend] + standard_name = GFS_radtend_type_instance + long_name = Fortran DDT containing FV3-GFS radiation tendencies + units = DDT + dimensions = () + type = GFS_radtend_type + intent = in + optional = F +[Statein] + standard_name = GFS_statein_type_instance + long_name = Fortran DDT containing FV3-GFS prognostic state data in from dycore + units = DDT + dimensions = () + type = GFS_statein_type + intent = in + optional = F +[Coupling] + standard_name = GFS_coupling_type_instance + long_name = Fortran DDT containing FV3-GFS fields to/from coupling with other components + units = DDT + dimensions = () + type = GFS_coupling_type + intent = inout + optional = F +[scmpsw] + standard_name = components_of_surface_downward_shortwave_fluxes + long_name = derived type for special components of surface downward shortwave fluxes + units = W m-2 + dimensions = (horizontal_dimension) + type = cmpfsw_type + intent = in + optional = F +[im] + standard_name = horizontal_loop_extent + long_name = horizontal loop extent + units = count + dimensions = () + type = integer + intent = in + optional = F +[lm] + standard_name = number_of_vertical_layers_for_radiation_calculations + long_name = number of vertical layers for radiation calculation + units = count + dimensions = () + type = integer + intent = in + optional = F +[ltp] + standard_name = extra_top_layer + long_name = extra top layers + units = none + dimensions = () + type = integer + intent = in + optional = F +[kt] + standard_name = vertical_index_difference_between_layer_and_upper_bound + long_name = vertical index difference between layer and upper bound + units = index + dimensions = () + type = integer + intent = in + optional = F +[kb] + standard_name = vertical_index_difference_between_layer_and_lower_bound + long_name = vertical index difference between layer and lower bound + units = index + dimensions = () + type = integer + intent = in + optional = F +[kd] + standard_name = vertical_index_difference_between_inout_and_local + long_name = vertical index difference between in/out and local + units = index + dimensions = () + type = integer + intent = in + optional = F +[raddt] + standard_name = time_step_for_radiation + long_name = radiation time step + units = s + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[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_dimension,number_of_species_for_aerosol_optical_depth) + type = real + kind = kind_phys + intent = in + optional = F +[cldsa] + standard_name = cloud_area_fraction_for_radiation + long_name = fraction of clouds for low, middle, high, total and BL + units = frac + dimensions = (horizontal_dimension,5) + type = real + kind = kind_phys + intent = in + optional = F +[mtopa] + standard_name = model_layer_number_at_cloud_top + long_name = vertical indices for low, middle and high cloud tops + units = index + dimensions = (horizontal_dimension,3) + type = integer + intent = in + optional = F +[mbota] + standard_name = model_layer_number_at_cloud_base + long_name = vertical indices for low, middle and high cloud bases + units = index + dimensions = (horizontal_dimension,3) + type = integer + intent = in + optional = F +[clouds1] + standard_name = total_cloud_fraction + long_name = layer total cloud fraction + units = frac + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[cldtaulw] + standard_name = cloud_optical_depth_layers_at_10mu_band + long_name = approx 10mu band layer cloud optical depth + units = none + dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + type = real + kind = kind_phys + intent = in + optional = F +[cldtausw] + standard_name = cloud_optical_depth_layers_at_0p55mu_band + long_name = approx .55mu band layer cloud optical depth + units = none + dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + type = real + kind = kind_phys + intent = in + optional = F +[nday] + standard_name = daytime_points_dimension + long_name = daytime points dimension + units = count + dimensions = () + type = integer + intent = in + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F + +######################################################################## +[ccpp-arg-table] + name = GFS_rrtmg_post_finalize + type = scheme diff --git a/physics/GFS_rrtmg_pre.F90 b/physics/GFS_rrtmg_pre.F90 index 137d14576..aa1ea039e 100644 --- a/physics/GFS_rrtmg_pre.F90 +++ b/physics/GFS_rrtmg_pre.F90 @@ -14,73 +14,14 @@ subroutine GFS_rrtmg_pre_init () end subroutine GFS_rrtmg_pre_init !> \section arg_table_GFS_rrtmg_pre_run Argument Table -!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | -!! |-------------------|---------------------------------------------------------------|-------------------------------------------------------------------------------|----------|------|------------------|-----------|--------|----------| -!! | Model | GFS_control_type_instance | Fortran DDT containing FV3-GFS model control parameters | DDT | 0 | GFS_control_type | | in | F | -!! | Grid | GFS_grid_type_instance | Fortran DDT containing FV3-GFS grid and interpolation related data | DDT | 0 | GFS_grid_type | | in | F | -!! | Sfcprop | GFS_sfcprop_type_instance | Fortran DDT containing FV3-GFS surface fields | DDT | 0 | GFS_sfcprop_type | | in | F | -!! | Statein | GFS_statein_type_instance | Fortran DDT containing FV3-GFS prognostic state data in from dycore | DDT | 0 | GFS_statein_type | | in | F | -!! | Tbd | GFS_tbd_type_instance | Fortran DDT containing FV3-GFS data not yet assigned to a defined container | DDT | 0 | GFS_tbd_type | | in | F | -!! | Cldprop | GFS_cldprop_type_instance | Fortran DDT containing FV3-GFS cloud fields needed by radiation from physics | DDT | 0 | GFS_cldprop_type | | in | F | -!! | Coupling | GFS_coupling_type_instance | Fortran DDT containing FV3-GFS fields needed for coupling | DDT | 0 | GFS_coupling_type| | in | F | -!! | Radtend | GFS_radtend_type_instance | Fortran DDT containing FV3-GFS radiation tendencies | DDT | 0 | GFS_radtend_type | | inout | F | -!! | lm | vertical_layer_dimension_for_radiation | number of vertical layers for radiation calculation | count | 0 | integer | | in | F | -!! | im | horizontal_loop_extent | horizontal loop extent | count | 0 | integer | | in | F | -!! | lmk | adjusted_vertical_layer_dimension_for_radiation | number of vertical layers for radiation | count | 0 | integer | | in | F | -!! | lmp | adjusted_vertical_level_dimension_for_radiation | number of vertical levels for radiation | count | 0 | integer | | in | F | -!! | kd | vertical_index_difference_between_inout_and_local | vertical index difference between in/out and local | index | 0 | integer | | out | F | -!! | kt | vertical_index_difference_between_layer_and_upper_bound | vertical index difference between layer and upper bound | index | 0 | integer | | out | F | -!! | kb | vertical_index_difference_between_layer_and_lower_bound | vertical index difference between layer and lower bound | index | 0 | integer | | out | F | -!! | raddt | time_step_for_radiation | radiation time step | s | 0 | real | kind_phys | out | F | -!! | delp | layer_pressure_thickness_for_radiation | layer pressure thickness on radiation levels | hPa | 2 | real | kind_phys | out | F | -!! | dz | layer_thickness_for_radiation | layer thickness on radiation levels | km | 2 | real | kind_phys | out | F | -!! | plvl | air_pressure_at_interface_for_radiation_in_hPa | air pressure at vertical interface for radiation calculation | hPa | 2 | real | kind_phys | out | F | -!! | plyr | air_pressure_at_layer_for_radiation_in_hPa | air pressure at vertical layer for radiation calculation | hPa | 2 | real | kind_phys | out | F | -!! | tlvl | air_temperature_at_interface_for_radiation | air temperature at vertical interface for radiation calculation | K | 2 | real | kind_phys | out | F | -!! | tlyr | air_temperature_at_layer_for_radiation | air temperature at vertical layer for radiation calculation | K | 2 | real | kind_phys | out | F | -!! | tsfg | surface_ground_temperature_for_radiation | surface ground temperature for radiation | K | 1 | real | kind_phys | out | F | -!! | tsfa | surface_air_temperature_for_radiation | lowest model layer air temperature for radiation | K | 1 | real | kind_phys | out | F | -!! | qlyr | water_vapor_specific_humidity_at_layer_for_radiation | water vapor specific humidity at vertical layer for radiation calculation | kg kg-1 | 2 | real | kind_phys | out | F | -!! | olyr | ozone_concentration_at_layer_for_radiation | ozone concentration | kg kg-1 | 2 | real | kind_phys | out | F | -!! | gasvmr_co2 | volume_mixing_ratio_co2 | CO2 volume mixing ratio | kg kg-1 | 2 | real | kind_phys | out | F | -!! | gasvmr_n2o | volume_mixing_ratio_n2o | N2O volume mixing ratio | kg kg-1 | 2 | real | kind_phys | out | F | -!! | gasvmr_ch4 | volume_mixing_ratio_ch4 | CH4 volume mixing ratio | kg kg-1 | 2 | real | kind_phys | out | F | -!! | gasvmr_o2 | volume_mixing_ratio_o2 | O2 volume mixing ratio | kg kg-1 | 2 | real | kind_phys | out | F | -!! | gasvmr_co | volume_mixing_ratio_co | CO volume mixing ratio | kg kg-1 | 2 | real | kind_phys | out | F | -!! | gasvmr_cfc11 | volume_mixing_ratio_cfc11 | CFC11 volume mixing ratio | kg kg-1 | 2 | real | kind_phys | out | F | -!! | gasvmr_cfc12 | volume_mixing_ratio_cfc12 | CFC12 volume mixing ratio | kg kg-1 | 2 | real | kind_phys | out | F | -!! | gasvmr_cfc22 | volume_mixing_ratio_cfc22 | CFC22 volume mixing ratio | kg kg-1 | 2 | real | kind_phys | out | F | -!! | gasvmr_ccl4 | volume_mixing_ratio_ccl4 | CCL4 volume mixing ratio | kg kg-1 | 2 | real | kind_phys | out | F | -!! | gasvmr_cfc113 | volume_mixing_ratio_cfc113 | CFC113 volume mixing ratio | kg kg-1 | 2 | real | kind_phys | out | F | -!! | faersw1 | aerosol_optical_depth_for_shortwave_bands_01-16 | aerosol optical depth for shortwave bands 01-16 | none | 3 | real | kind_phys | out | F | -!! | faersw2 | aerosol_single_scattering_albedo_for_shortwave_bands_01-16 | aerosol single scattering albedo for shortwave bands 01-16 | frac | 3 | real | kind_phys | out | F | -!! | faersw3 | aerosol_asymmetry_parameter_for_shortwave_bands_01-16 | aerosol asymmetry parameter for shortwave bands 01-16 | none | 3 | real | kind_phys | out | F | -!! | faerlw1 | aerosol_optical_depth_for_longwave_bands_01-16 | aerosol optical depth for longwave bands 01-16 | none | 3 | real | kind_phys | out | F | -!! | faerlw2 | aerosol_single_scattering_albedo_for_longwave_bands_01-16 | aerosol single scattering albedo for longwave bands 01-16 | frac | 3 | real | kind_phys | out | F | -!! | faerlw3 | aerosol_asymmetry_parameter_for_longwave_bands_01-16 | aerosol asymmetry parameter for longwave bands 01-16 | none | 3 | real | kind_phys | out | F | -!! | aerodp | atmosphere_optical_thickness_due_to_ambient_aerosol_particles | vertical integrated optical depth for various aerosol species | none | 2 | real | kind_phys | out | F | -!! | clouds1 | total_cloud_fraction | layer total cloud fraction | frac | 2 | real | kind_phys | out | F | -!! | clouds2 | cloud_liquid_water_path | layer cloud liquid water path | g m-2 | 2 | real | kind_phys | out | F | -!! | clouds3 | mean_effective_radius_for_liquid_cloud | mean effective radius for liquid cloud | micron | 2 | real | kind_phys | out | F | -!! | clouds4 | cloud_ice_water_path | layer cloud ice water path | g m-2 | 2 | real | kind_phys | out | F | -!! | clouds5 | mean_effective_radius_for_ice_cloud | mean effective radius for ice cloud | micron | 2 | real | kind_phys | out | F | -!! | clouds6 | cloud_rain_water_path | cloud rain water path | g m-2 | 2 | real | kind_phys | out | F | -!! | clouds7 | mean_effective_radius_for_rain_drop | mean effective radius for rain drop | micron | 2 | real | kind_phys | out | F | -!! | clouds8 | cloud_snow_water_path | cloud snow water path | g m-2 | 2 | real | kind_phys | out | F | -!! | clouds9 | mean_effective_radius_for_snow_flake | mean effective radius for snow flake | micron | 2 | real | kind_phys | out | F | -!! | cldsa | cloud_area_fraction_for_radiation | fraction of clouds for low, middle,high, total and BL | frac | 2 | real | kind_phys | out | F | -!! | mtopa | model_layer_number_at_cloud_top | vertical indices for low, middle and high cloud tops | index | 2 | integer | | out | F | -!! | mbota | model_layer_number_at_cloud_base | vertical indices for low, middle and high cloud bases | index | 2 | integer | | out | F | -!! | de_lgth | cloud_decorrelation_length | cloud decorrelation length | km | 1 | real | kind_phys | out | F | -!! | alb1d | surface_albedo_perturbation | surface albedo perturbation | frac | 1 | real | kind_phys | out | F | -!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | -!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | +!! \htmlinclude GFS_rrtmg_pre_run.html !! ! Attention - the output arguments lm, im, lmk, lmp must not be set ! in the CCPP version - they are defined in the interstitial_create routine subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input Tbd, Cldprop, Coupling, & Radtend, & ! input/output + f_ice, f_rain, f_rimef, flgmin, cwm, & ! F-A mp scheme only lm, im, lmk, lmp, & ! input kd, kt, kb, raddt, delp, dz, plvl, plyr, & ! output tlvl, tlyr, tsfg, tsfa, qlyr, olyr, & @@ -120,6 +61,7 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input & NSPC1 use module_radiation_clouds, only: NF_CLDS, & ! cld_init & progcld1, progcld3, & + & progcld2, & & progcld4, progcld5, & & progclduni use module_radsw_parameters, only: topfsw_type, sfcfsw_type, & @@ -141,8 +83,16 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input integer, intent(in) :: im, lm, lmk, lmp integer, intent(out) :: kd, kt, kb + +! F-A mp scheme only + real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP), intent(in) :: f_ice + real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP), intent(in) :: f_rain + real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP), intent(in) :: f_rimef + real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP), intent(out) :: cwm + real(kind=kind_phys), dimension(size(Grid%xlon,1)), intent(in) :: flgmin real(kind=kind_phys), intent(out) :: raddt + real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP), intent(out) :: delp real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP), intent(out) :: dz real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+1+LTP), intent(out) :: plvl @@ -192,7 +142,7 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input integer, intent(out) :: errflg ! Local variables - integer :: me, nfxr, ntrac, ntcw, ntiw, ncld, ntrw, ntsw, ntgl + integer :: me, nfxr, ntrac, ntcw, ntiw, ncld, ntrw, ntsw, ntgl, ncndl integer :: i, j, k, k1, k2, lsk, lv, n, itop, ibtc, LP1, lla, llb, lya, lyb @@ -209,7 +159,7 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP+1) :: tem2db ! real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP+1) :: hz - real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP,Model%ncnd) :: ccnd + real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP,min(4,Model%ncnd)) :: ccnd real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP,2:Model%ntrac) :: tracer1 real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP,NF_CLDS) :: clouds real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP,NF_VGAS) :: gasvmr @@ -234,6 +184,7 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input ntrw = Model%ntrw ntsw = Model%ntsw ntgl = Model%ntgl + ncndl = min(Model%ncnd,4) LP1 = LM + 1 ! num of in/out levels @@ -578,7 +529,7 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input ccnd(i,k,1) = tracer1(i,k,ntcw) ! liquid water/ice enddo enddo - elseif (Model%ncnd == 2) then ! MG + elseif (Model%ncnd == 2) then ! MG or F-A do k=1,LMK do i=1,IM ccnd(i,k,1) = tracer1(i,k,ntcw) ! liquid water @@ -604,7 +555,7 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input enddo enddo endif - do n=1,Model%ncnd + do n=1,ncndl do k=1,LMK do i=1,IM if (ccnd(i,k,n) < epsq) ccnd(i,k,n) = 0.0 @@ -748,7 +699,7 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input ! or unified cloud and/or with MG microphysics if (Model%uni_cld .and. Model%ncld >= 2) then - call progclduni (plyr, plvl, tlyr, tvly, ccnd, Model%ncnd, & ! --- inputs + call progclduni (plyr, plvl, tlyr, tvly, ccnd, ncndl, & ! --- inputs Grid%xlat, Grid%xlon, Sfcprop%slmsk,dz,delp, & IM, LMK, LMP, cldcov, & effrl, effri, effrr, effrs, Model%effr_in, & @@ -772,6 +723,7 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input Model%sup, Model%kdt, me, & clouds, cldsa, mtopa, mbota, de_lgth) ! --- outputs + elseif (Model%imp_physics == 11) then ! GFDL cloud scheme if (.not.Model%lgfdlmprad) then @@ -782,7 +734,7 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input clouds, cldsa, mtopa, mbota, de_lgth) ! --- outputs else - call progclduni (plyr, plvl, tlyr, tvly, ccnd, Model%ncnd, & ! --- inputs + call progclduni (plyr, plvl, tlyr, tvly, ccnd, ncndl, & ! --- inputs Grid%xlat, Grid%xlon, Sfcprop%slmsk, dz,delp, & IM, LMK, LMP, cldcov, & effrl, effri, effrr, effrs, Model%effr_in, & @@ -796,12 +748,12 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input ! clouds, cldsa, mtopa, mbota, de_lgth) ! --- outputs endif - elseif(Model%imp_physics == 8 .or. Model%imp_physics == 6) then ! Thompson / WSM6 cloud micrphysics scheme - + elseif(Model%imp_physics == 8 .or. Model%imp_physics == 6 .or. & + Model%imp_physics == 15) then if (Model%kdt == 1) then - Tbd%phy_f3d(:,:,1) = 10. - Tbd%phy_f3d(:,:,2) = 50. - Tbd%phy_f3d(:,:,3) = 250. + Tbd%phy_f3d(:,:,Model%nleffr) = 10. + Tbd%phy_f3d(:,:,Model%nieffr) = 50. + Tbd%phy_f3d(:,:,Model%nseffr) = 250. endif call progcld5 (plyr,plvl,tlyr,qlyr,qstl,rhly,tracer1, & ! --- inputs @@ -818,7 +770,6 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input ! endif ! end_if_ntcw -! CCPP do k = 1, LMK do i = 1, IM clouds1(i,k) = clouds(i,k,1) diff --git a/physics/GFS_rrtmg_pre.meta b/physics/GFS_rrtmg_pre.meta new file mode 100644 index 000000000..7b40e2c1d --- /dev/null +++ b/physics/GFS_rrtmg_pre.meta @@ -0,0 +1,571 @@ +[ccpp-arg-table] + name = GFS_rrtmg_pre_init + type = scheme + +######################################################################## +[ccpp-arg-table] + name = GFS_rrtmg_pre_run + type = scheme +[Model] + standard_name = GFS_control_type_instance + long_name = Fortran DDT containing FV3-GFS model control parameters + units = DDT + dimensions = () + type = GFS_control_type + intent = in + optional = F +[Grid] + standard_name = GFS_grid_type_instance + long_name = Fortran DDT containing FV3-GFS grid and interpolation related data + units = DDT + dimensions = () + type = GFS_grid_type + intent = in + optional = F +[Sfcprop] + standard_name = GFS_sfcprop_type_instance + long_name = Fortran DDT containing FV3-GFS surface fields + units = DDT + dimensions = () + type = GFS_sfcprop_type + intent = in + optional = F +[Statein] + standard_name = GFS_statein_type_instance + long_name = Fortran DDT containing FV3-GFS prognostic state data in from dycore + units = DDT + dimensions = () + type = GFS_statein_type + intent = in + optional = F +[Tbd] + standard_name = GFS_tbd_type_instance + long_name = Fortran DDT containing FV3-GFS data not yet assigned to a defined container + units = DDT + dimensions = () + type = GFS_tbd_type + intent = in + optional = F +[Cldprop] + standard_name = GFS_cldprop_type_instance + long_name = Fortran DDT containing FV3-GFS cloud fields needed by radiation from physics + units = DDT + dimensions = () + type = GFS_cldprop_type + intent = in + optional = F +[Coupling] + standard_name = GFS_coupling_type_instance + long_name = Fortran DDT containing FV3-GFS fields needed for coupling + units = DDT + dimensions = () + type = GFS_coupling_type + intent = in + optional = F +[Radtend] + standard_name = GFS_radtend_type_instance + long_name = Fortran DDT containing FV3-GFS radiation tendencies + units = DDT + dimensions = () + type = GFS_radtend_type + intent = inout + optional = F +[f_ice] + standard_name = fraction_of_ice_water_cloud + long_name = fraction of ice water cloud + units = frac + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[f_rain] + standard_name = fraction_of_rain_water_cloud + long_name = fraction of rain water cloud + units = frac + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[f_rimef] + standard_name = rime_factor + long_name = rime factor + units = frac + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[flgmin] + standard_name = minimum_large_ice_fraction + long_name = minimum large ice fraction in F-A mp scheme + units = frac + dimensions = (2) + type = real + kind = kind_phys + intent = in + optional = F +[cwm] + standard_name = total_cloud_condensate_mixing_ratio_updated_by_physics + long_name = total cloud condensate mixing ratio (except water vapor) updated by physics + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[lm] + standard_name = number_of_vertical_layers_for_radiation_calculations + long_name = number of vertical layers for radiation calculation + units = count + dimensions = () + type = integer + intent = in + optional = F +[im] + standard_name = horizontal_loop_extent + long_name = horizontal loop extent + units = count + dimensions = () + type = integer + intent = in + optional = F +[lmk] + standard_name = adjusted_vertical_layer_dimension_for_radiation + long_name = number of vertical layers for radiation + units = count + dimensions = () + type = integer + intent = in + optional = F +[lmp] + standard_name = adjusted_vertical_level_dimension_for_radiation + long_name = number of vertical levels for radiation + units = count + dimensions = () + type = integer + intent = in + optional = F +[kd] + standard_name = vertical_index_difference_between_inout_and_local + long_name = vertical index difference between in/out and local + units = index + dimensions = () + type = integer + intent = out + optional = F +[kt] + standard_name = vertical_index_difference_between_layer_and_upper_bound + long_name = vertical index difference between layer and upper bound + units = index + dimensions = () + type = integer + intent = out + optional = F +[kb] + standard_name = vertical_index_difference_between_layer_and_lower_bound + long_name = vertical index difference between layer and lower bound + units = index + dimensions = () + type = integer + intent = out + optional = F +[raddt] + standard_name = time_step_for_radiation + long_name = radiation time step + units = s + dimensions = () + type = real + kind = kind_phys + intent = out + optional = F +[delp] + standard_name = layer_pressure_thickness_for_radiation + long_name = layer pressure thickness on radiation levels + units = hPa + dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + type = real + kind = kind_phys + intent = out + optional = F +[dz] + standard_name = layer_thickness_for_radiation + long_name = layer thickness on radiation levels + units = km + dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + type = real + kind = kind_phys + intent = out + optional = F +[plvl] + standard_name = air_pressure_at_interface_for_radiation_in_hPa + long_name = air pressure at vertical interface for radiation calculation + units = hPa + dimensions = (horizontal_dimension,adjusted_vertical_level_dimension_for_radiation) + type = real + kind = kind_phys + intent = out + optional = F +[plyr] + standard_name = air_pressure_at_layer_for_radiation_in_hPa + long_name = air pressure at vertical layer for radiation calculation + units = hPa + dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + type = real + kind = kind_phys + intent = out + optional = F +[tlvl] + standard_name = air_temperature_at_interface_for_radiation + long_name = air temperature at vertical interface for radiation calculation + units = K + dimensions = (horizontal_dimension,adjusted_vertical_level_dimension_for_radiation) + type = real + kind = kind_phys + intent = out + optional = F +[tlyr] + standard_name = air_temperature_at_layer_for_radiation + long_name = air temperature at vertical layer for radiation calculation + units = K + dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + type = real + kind = kind_phys + intent = out + optional = F +[tsfg] + standard_name = surface_ground_temperature_for_radiation + long_name = surface ground temperature for radiation + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[tsfa] + standard_name = surface_air_temperature_for_radiation + long_name = lowest model layer air temperature for radiation + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[qlyr] + standard_name = water_vapor_specific_humidity_at_layer_for_radiation + long_name = water vapor specific humidity at vertical layer for radiation calculation + units = kg kg-1 + dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + type = real + kind = kind_phys + intent = out + optional = F +[olyr] + standard_name = ozone_concentration_at_layer_for_radiation + long_name = ozone concentration + units = kg kg-1 + dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + type = real + kind = kind_phys + intent = out + optional = F +[gasvmr_co2] + standard_name = volume_mixing_ratio_co2 + long_name = CO2 volume mixing ratio + units = kg kg-1 + dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + type = real + kind = kind_phys + intent = out + optional = F +[gasvmr_n2o] + standard_name = volume_mixing_ratio_n2o + long_name = N2O volume mixing ratio + units = kg kg-1 + dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + type = real + kind = kind_phys + intent = out + optional = F +[gasvmr_ch4] + standard_name = volume_mixing_ratio_ch4 + long_name = CH4 volume mixing ratio + units = kg kg-1 + dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + type = real + kind = kind_phys + intent = out + optional = F +[gasvmr_o2] + standard_name = volume_mixing_ratio_o2 + long_name = O2 volume mixing ratio + units = kg kg-1 + dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + type = real + kind = kind_phys + intent = out + optional = F +[gasvmr_co] + standard_name = volume_mixing_ratio_co + long_name = CO volume mixing ratio + units = kg kg-1 + dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + type = real + kind = kind_phys + intent = out + optional = F +[gasvmr_cfc11] + standard_name = volume_mixing_ratio_cfc11 + long_name = CFC11 volume mixing ratio + units = kg kg-1 + dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + type = real + kind = kind_phys + intent = out + optional = F +[gasvmr_cfc12] + standard_name = volume_mixing_ratio_cfc12 + long_name = CFC12 volume mixing ratio + units = kg kg-1 + dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + type = real + kind = kind_phys + intent = out + optional = F +[gasvmr_cfc22] + standard_name = volume_mixing_ratio_cfc22 + long_name = CFC22 volume mixing ratio + units = kg kg-1 + dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + type = real + kind = kind_phys + intent = out + optional = F +[gasvmr_ccl4] + standard_name = volume_mixing_ratio_ccl4 + long_name = CCL4 volume mixing ratio + units = kg kg-1 + dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + type = real + kind = kind_phys + intent = out + optional = F +[gasvmr_cfc113] + standard_name = volume_mixing_ratio_cfc113 + long_name = CFC113 volume mixing ratio + units = kg kg-1 + dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + type = real + kind = kind_phys + intent = out + optional = F +[faersw1] + standard_name = aerosol_optical_depth_for_shortwave_bands_01_16 + long_name = aerosol optical depth for shortwave bands 01-16 + units = none + dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation,number_of_aerosol_bands_for_shortwave_radiation) + type = real + kind = kind_phys + intent = out + optional = F +[faersw2] + standard_name = aerosol_single_scattering_albedo_for_shortwave_bands_01_16 + long_name = aerosol single scattering albedo for shortwave bands 01-16 + units = frac + dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation,number_of_aerosol_bands_for_shortwave_radiation) + type = real + kind = kind_phys + intent = out + optional = F +[faersw3] + standard_name = aerosol_asymmetry_parameter_for_shortwave_bands_01_16 + long_name = aerosol asymmetry parameter for shortwave bands 01-16 + units = none + dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation,number_of_aerosol_bands_for_shortwave_radiation) + type = real + kind = kind_phys + intent = out + optional = F +[faerlw1] + standard_name = aerosol_optical_depth_for_longwave_bands_01_16 + long_name = aerosol optical depth for longwave bands 01-16 + units = none + dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation,number_of_aerosol_bands_for_longwave_radiation) + type = real + kind = kind_phys + intent = out + optional = F +[faerlw2] + standard_name = aerosol_single_scattering_albedo_for_longwave_bands_01_16 + long_name = aerosol single scattering albedo for longwave bands 01-16 + units = frac + dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation,number_of_aerosol_bands_for_longwave_radiation) + type = real + kind = kind_phys + intent = out + optional = F +[faerlw3] + standard_name = aerosol_asymmetry_parameter_for_longwave_bands_01_16 + long_name = aerosol asymmetry parameter for longwave bands 01-16 + units = none + dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation,number_of_aerosol_bands_for_longwave_radiation) + type = real + kind = kind_phys + intent = out + optional = F +[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_dimension,number_of_species_for_aerosol_optical_depth) + type = real + kind = kind_phys + intent = out + optional = F +[clouds1] + standard_name = total_cloud_fraction + long_name = layer total cloud fraction + units = frac + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[clouds2] + standard_name = cloud_liquid_water_path + long_name = layer cloud liquid water path + units = g m-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[clouds3] + standard_name = mean_effective_radius_for_liquid_cloud + long_name = mean effective radius for liquid cloud + units = micron + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[clouds4] + standard_name = cloud_ice_water_path + long_name = layer cloud ice water path + units = g m-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[clouds5] + standard_name = mean_effective_radius_for_ice_cloud + long_name = mean effective radius for ice cloud + units = micron + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[clouds6] + standard_name = cloud_rain_water_path + long_name = cloud rain water path + units = g m-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[clouds7] + standard_name = mean_effective_radius_for_rain_drop + long_name = mean effective radius for rain drop + units = micron + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[clouds8] + standard_name = cloud_snow_water_path + long_name = cloud snow water path + units = g m-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[clouds9] + standard_name = mean_effective_radius_for_snow_flake + long_name = mean effective radius for snow flake + units = micron + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[cldsa] + standard_name = cloud_area_fraction_for_radiation + long_name = fraction of clouds for low, middle,high, total and BL + units = frac + dimensions = (horizontal_dimension,5) + type = real + kind = kind_phys + intent = out + optional = F +[mtopa] + standard_name = model_layer_number_at_cloud_top + long_name = vertical indices for low, middle and high cloud tops + units = index + dimensions = (horizontal_dimension,3) + type = integer + intent = out + optional = F +[mbota] + standard_name = model_layer_number_at_cloud_base + long_name = vertical indices for low, middle and high cloud bases + units = index + dimensions = (horizontal_dimension,3) + type = integer + intent = out + optional = F +[de_lgth] + standard_name = cloud_decorrelation_length + long_name = cloud decorrelation length + units = km + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[alb1d] + standard_name = surface_albedo_perturbation + long_name = surface albedo perturbation + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F + +######################################################################## +[ccpp-arg-table] + name = GFS_rrtmg_pre_finalize + type = scheme diff --git a/physics/GFS_rrtmg_setup.F90 b/physics/GFS_rrtmg_setup.F90 index 9c99076cc..b6d86a34e 100644 --- a/physics/GFS_rrtmg_setup.F90 +++ b/physics/GFS_rrtmg_setup.F90 @@ -41,39 +41,7 @@ module GFS_rrtmg_setup !> \defgroup GFS_rrtmg_setup GFS RRTMG Scheme Setup !! @{ !! \section arg_table_GFS_rrtmg_setup_init Argument Table -!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | -!! |--------------------------|-------------------------------------------------------------------------------|---------------------------------------------------------------|---------------|------|-----------|-----------|--------|----------| -!! | si | vertical_sigma_coordinate_for_radiation_initialization | vertical sigma coordinate for radiation initialization | none | 1 | real | kind_phys | in | F | -!! | levr | number_of_vertical_layers_for_radiation_calculations | number of vertical levels for radiation calculations | count | 0 | integer | | in | F | -!! | ictm | flag_for_initial_time-date_control | flag for initial conditions and forcing | flag | 0 | integer | | in | F | -!! | isol | flag_for_solar_constant | use prescribed solar constant | flag | 0 | integer | | in | F | -!! | ico2 | flag_for_using_prescribed_global_mean_co2_value | prescribed global mean value (old opernl) | flag | 0 | integer | | in | F | -!! | iaer | flag_for_default_aerosol_effect_in_shortwave_radiation | default aerosol effect in sw only | flag | 0 | integer | | in | F | -!! | ialb | flag_for_using_climatology_albedo | flag for using climatology alb, based on sfc type | flag | 0 | integer | | in | F | -!! | iems | flag_for_surface_emissivity_control | surface emissivity control flag, use fixed value of 1 | flag | 0 | integer | | in | F | -!! | ntcw | index_for_liquid_cloud_condensate | tracer index for cloud condensate (or liquid water) | index | 0 | integer | | in | F | -!! | num_p2d | array_dimension_of_2d_arrays_for_microphysics | number of 2D arrays needed for microphysics | count | 0 | integer | | in | F | -!! | num_p3d | array_dimension_of_3d_arrays_for_microphysics | number of 3D arrays needed for microphysics | count | 0 | integer | | in | F | -!! | npdf3d | number_of_3d_arrays_associated_with_pdf-based_clouds | number of 3d arrays associated with pdf based clouds/mp | count | 0 | integer | | in | F | -!! | ntoz | index_for_ozone | tracer index for ozone mixing ratio | index | 0 | integer | | in | F | -!! | iovr_sw | flag_for_max-random_overlap_clouds_for_shortwave_radiation | sw: max-random overlap clouds | flag | 0 | integer | | in | F | -!! | iovr_lw | flag_for_max-random_overlap_clouds_for_longwave_radiation | lw: max-random overlap clouds | flag | 0 | integer | | in | F | -!! | isubc_sw | flag_for_sw_clouds_without_sub-grid_approximation | flag for sw clouds without sub-grid approximation | flag | 0 | integer | | in | F | -!! | isubc_lw | flag_for_lw_clouds_without_sub-grid_approximation | flag for lw clouds without sub-grid approximation | flag | 0 | integer | | in | F | -!! | icliq_sw | flag_for_optical_property_for_liquid_clouds_for_shortwave_radiation | sw optical property for liquid clouds | flag | 0 | integer | | in | F | -!! | crick_proof | flag_for_CRICK-proof_cloud_water | flag for CRICK-Proof cloud water | flag | 0 | logical | | in | F | -!! | ccnorm | flag_for_cloud_condensate_normalized_by_cloud_cover | flag for cloud condensate normalized by cloud cover | flag | 0 | logical | | in | F | -!! | imp_physics | flag_for_microphysics_scheme | choice of microphysics scheme | flag | 0 | integer | | in | F | -!! | norad_precip | flag_for_precipitation_effect_on_radiation | radiation precip flag for Ferrier/Moorthi | flag | 0 | logical | | in | F | -!! | idate | date_and_time_at_model_initialization_reordered | initialization date and time | none | 1 | integer | | in | F | -!! | iflip | flag_for_vertical_index_direction_control | flag for vertical index direction control | flag | 0 | integer | | in | F | -!! | im | horizontal_loop_extent | horizontal loop extent | count | 0 | integer | | in | F | -!! | faerlw | aerosol_optical_properties_for_longwave_bands_01-16 | optical properties for longwave bands 01-16 | various | 4 | real | kind_phys | in | F | -!! | faersw | aerosol_optical_properties_for_shortwave_bands_01-16 | aerosol optical properties for shortwave bands 01-16 | various | 4 | real | kind_phys | in | F | -!! | aerodp | atmosphere_optical_thickness_due_to_ambient_aerosol_particles | vertical integrated optical depth for various aerosol species | none | 2 | real | kind_phys | in | F | -!! | me | mpi_rank | current MPI-rank | index | 0 | integer | | in | F | -!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | -!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | +!! \htmlinclude GFS_rrtmg_setup_init.html !! subroutine GFS_rrtmg_setup_init ( & si, levr, ictm, isol, ico2, iaer, ialb, iems, ntcw, num_p2d, & @@ -352,20 +320,7 @@ subroutine GFS_rrtmg_setup_init ( & end subroutine GFS_rrtmg_setup_init !> \section arg_table_GFS_rrtmg_setup_run Argument Table -!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | -!! |--------------------------|-------------------------------------------------------------------------------|---------------------------------------------------------|---------------|------|-----------|-----------|--------|----------| -!! | idate | date_and_time_at_model_initialization | initialization date and time | none | 1 | integer | | in | F | -!! | jdate | forecast_date_and_time | current forecast date and time | none | 1 | integer | | in | F | -!! | deltsw | frequency_for_shortwave_radiation | frequency for shortwave radiation | s | 0 | real | kind_phys | in | F | -!! | deltim | time_step_for_dynamics | dynamics timestep | s | 0 | real | kind_phys | in | F | -!! | lsswr | flag_to_calc_sw | logical flags for sw radiation calls | flag | 0 | logical | | in | F | -!! | me | mpi_rank | current MPI-rank | index | 0 | integer | | in | F | -!! | slag | equation_of_time | equation of time (radian) | radians | 0 | real | kind_phys | out | F | -!! | sdec | sine_of_solar_declination_angle | sin of the solar declination angle | none | 0 | real | kind_phys | out | F | -!! | cdec | cosine_of_solar_declination_angle | cos of the solar declination angle | none | 0 | real | kind_phys | out | F | -!! | solcon | solar_constant | solar constant (sun-earth distant adjusted) | W m-2 | 0 | real | kind_phys | out | F | -!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | -!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | +!! \htmlinclude GFS_rrtmg_setup_run.html !! subroutine GFS_rrtmg_setup_run ( & idate, jdate, deltsw, deltim, lsswr, me, & @@ -404,10 +359,7 @@ subroutine GFS_rrtmg_setup_run ( & end subroutine GFS_rrtmg_setup_run !> \section arg_table_GFS_rrtmg_setup_finalize Argument Table -!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | -!! |--------------------------|-------------------------------------------------------------------------------|---------------------------------------------------------|---------------|------|-----------|-----------|--------|----------| -!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | -!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | +!! \htmlinclude GFS_rrtmg_setup_finalize.html !! subroutine GFS_rrtmg_setup_finalize (errmsg, errflg) diff --git a/physics/GFS_rrtmg_setup.meta b/physics/GFS_rrtmg_setup.meta new file mode 100644 index 000000000..8405d160d --- /dev/null +++ b/physics/GFS_rrtmg_setup.meta @@ -0,0 +1,386 @@ +[ccpp-arg-table] + name = GFS_rrtmg_setup_init + type = scheme +[si] + standard_name = vertical_sigma_coordinate_for_radiation_initialization + long_name = vertical sigma coordinate for radiation initialization + units = none + dimensions = (number_of_vertical_layers_for_radiation_calculations_plus_one) + type = real + kind = kind_phys + intent = in + optional = F +[levr] + standard_name = number_of_vertical_layers_for_radiation_calculations + long_name = number of vertical levels for radiation calculations + units = count + dimensions = () + type = integer + intent = in + optional = F +[ictm] + standard_name = flag_for_initial_time_date_control + long_name = flag for initial conditions and forcing + units = flag + dimensions = () + type = integer + intent = in + optional = F +[isol] + standard_name = flag_for_solar_constant + long_name = use prescribed solar constant + units = flag + dimensions = () + type = integer + intent = in + optional = F +[ico2] + standard_name = flag_for_using_prescribed_global_mean_co2_value + long_name = prescribed global mean value (old opernl) + units = flag + dimensions = () + type = integer + intent = in + optional = F +[iaer] + standard_name = flag_for_default_aerosol_effect_in_shortwave_radiation + long_name = default aerosol effect in sw only + units = flag + dimensions = () + type = integer + intent = in + optional = F +[ialb] + standard_name = flag_for_using_climatology_albedo + long_name = flag for using climatology alb, based on sfc type + units = flag + dimensions = () + type = integer + intent = in + optional = F +[iems] + standard_name = flag_for_surface_emissivity_control + long_name = surface emissivity control flag, use fixed value of 1 + units = flag + dimensions = () + type = integer + intent = in + optional = F +[ntcw] + standard_name = index_for_liquid_cloud_condensate + long_name = tracer index for cloud condensate (or liquid water) + units = index + dimensions = () + type = integer + intent = in + optional = F +[num_p2d] + standard_name = array_dimension_of_2d_arrays_for_microphysics + long_name = number of 2D arrays needed for microphysics + units = count + dimensions = () + type = integer + intent = in + optional = F +[num_p3d] + standard_name = array_dimension_of_3d_arrays_for_microphysics + long_name = number of 3D arrays needed for microphysics + units = count + dimensions = () + type = integer + intent = in + optional = F +[npdf3d] + standard_name = number_of_3d_arrays_associated_with_pdf_based_clouds + long_name = number of 3d arrays associated with pdf based clouds/mp + units = count + dimensions = () + type = integer + intent = in + optional = F +[ntoz] + standard_name = index_for_ozone + long_name = tracer index for ozone mixing ratio + units = index + dimensions = () + type = integer + intent = in + optional = F +[iovr_sw] + standard_name = flag_for_max_random_overlap_clouds_for_shortwave_radiation + long_name = sw: max-random overlap clouds + units = flag + dimensions = () + type = integer + intent = in + optional = F +[iovr_lw] + standard_name = flag_for_max_random_overlap_clouds_for_longwave_radiation + long_name = lw: max-random overlap clouds + units = flag + dimensions = () + type = integer + intent = in + optional = F +[isubc_sw] + standard_name = flag_for_sw_clouds_without_sub_grid_approximation + long_name = flag for sw clouds without sub-grid approximation + units = flag + dimensions = () + type = integer + intent = in + optional = F +[isubc_lw] + standard_name = flag_for_lw_clouds_without_sub_grid_approximation + long_name = flag for lw clouds without sub-grid approximation + units = flag + dimensions = () + type = integer + intent = in + optional = F +[icliq_sw] + standard_name = flag_for_optical_property_for_liquid_clouds_for_shortwave_radiation + long_name = sw optical property for liquid clouds + units = flag + dimensions = () + type = integer + intent = in + optional = F +[crick_proof] + standard_name = flag_for_CRICK_proof_cloud_water + long_name = flag for CRICK-Proof cloud water + units = flag + dimensions = () + type = logical + intent = in + optional = F +[ccnorm] + standard_name = flag_for_cloud_condensate_normalized_by_cloud_cover + long_name = flag for cloud condensate normalized by cloud cover + units = flag + dimensions = () + type = logical + intent = in + optional = F +[imp_physics] + standard_name = flag_for_microphysics_scheme + long_name = choice of microphysics scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F +[norad_precip] + standard_name = flag_for_precipitation_effect_on_radiation + long_name = radiation precip flag for Ferrier/Moorthi + units = flag + dimensions = () + type = logical + intent = in + optional = F +[idate] + standard_name = date_and_time_at_model_initialization_reordered + long_name = initialization date and time + units = none + dimensions = (4) + type = integer + intent = in + optional = F +[iflip] + standard_name = flag_for_vertical_index_direction_control + long_name = flag for vertical index direction control + units = flag + dimensions = () + type = integer + intent = in + optional = F +[im] + standard_name = horizontal_loop_extent + long_name = horizontal loop extent + units = count + dimensions = () + type = integer + intent = in + optional = F +[faerlw] + standard_name = aerosol_optical_properties_for_longwave_bands_01_16 + long_name = optical properties for longwave bands 01-16 + units = various + dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation,number_of_aerosol_bands_for_longwave_radiation,number_of_aerosol_output_fields_for_longwave_radiation) + type = real + kind = kind_phys + intent = in + optional = F +[faersw] + standard_name = aerosol_optical_properties_for_shortwave_bands_01_16 + long_name = aerosol optical properties for shortwave bands 01-16 + units = various + dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation,number_of_aerosol_bands_for_shortwave_radiation,number_of_aerosol_output_fields_for_shortwave_radiation) + type = real + kind = kind_phys + intent = in + optional = F +[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_dimension,number_of_species_for_aerosol_optical_depth) + type = real + kind = kind_phys + intent = in + optional = F +[me] + standard_name = mpi_rank + long_name = current MPI-rank + units = index + dimensions = () + type = integer + intent = in + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F + +######################################################################## +[ccpp-arg-table] + name = GFS_rrtmg_setup_run + type = scheme +[idate] + standard_name = date_and_time_at_model_initialization + long_name = initialization date and time + units = none + dimensions = (8) + type = integer + intent = in + optional = F +[jdate] + standard_name = forecast_date_and_time + long_name = current forecast date and time + units = none + dimensions = (8) + type = integer + intent = in + optional = F +[deltsw] + standard_name = frequency_for_shortwave_radiation + long_name = frequency for shortwave radiation + units = s + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[deltim] + standard_name = time_step_for_dynamics + long_name = dynamics timestep + units = s + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[lsswr] + standard_name = flag_to_calc_sw + long_name = logical flags for sw radiation calls + units = flag + dimensions = () + type = logical + intent = in + optional = F +[me] + standard_name = mpi_rank + long_name = current MPI-rank + units = index + dimensions = () + type = integer + intent = in + optional = F +[slag] + standard_name = equation_of_time + long_name = equation of time (radian) + units = radians + dimensions = () + type = real + kind = kind_phys + intent = out + optional = F +[sdec] + standard_name = sine_of_solar_declination_angle + long_name = sin of the solar declination angle + units = none + dimensions = () + type = real + kind = kind_phys + intent = out + optional = F +[cdec] + standard_name = cosine_of_solar_declination_angle + long_name = cos of the solar declination angle + units = none + dimensions = () + type = real + kind = kind_phys + intent = out + optional = F +[solcon] + standard_name = solar_constant + long_name = solar constant (sun-earth distant adjusted) + units = W m-2 + dimensions = () + type = real + kind = kind_phys + intent = out + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F + +######################################################################## +[ccpp-arg-table] + name = GFS_rrtmg_setup_finalize + type = scheme +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F diff --git a/physics/GFS_stochastics.F90 b/physics/GFS_stochastics.F90 index 7fa2e256b..2a6552f18 100644 --- a/physics/GFS_stochastics.F90 +++ b/physics/GFS_stochastics.F90 @@ -16,47 +16,7 @@ end subroutine GFS_stochastics_finalize !! This module !> @{ !> \section arg_table_GFS_stochastics_run Argument Table -!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | -!! |----------------|---------------------------------------------------------------------------|--------------------------------------------------------------|---------|------|-----------|-----------|--------|----------| -!! | im | horizontal_loop_extent | horizontal loop extent | count | 0 | integer | | in | F | -!! | km | vertical_dimension | number of vertical levels | count | 0 | integer | | in | F | -!! | do_sppt | flag_for_stochastic_surface_physics_perturbations | flag for stochastic surface physics perturbations | flag | 0 | logical | | in | F | -!! | use_zmtnblck | flag_for_mountain_blocking | flag for mountain blocking | flag | 0 | logical | | in | F | -!! | do_shum | flag_for_stochastic_shum_option | flag for stochastic shum option | flag | 0 | logical | | in | F | -!! | do_skeb | flag_for_stochastic_skeb_option | flag for stochastic skeb option | flag | 0 | logical | | in | F | -!! | zmtnblck | level_of_dividing_streamline | level of the dividing streamline | none | 1 | real | kind_phys | in | F | -!! | sppt_wts | weights_for_stochastic_sppt_perturbation | weights for stochastic sppt perturbation | none | 2 | real | kind_phys | inout | F | -!! | skebu_wts | weights_for_stochastic_skeb_perturbation_of_x_wind | weights for stochastic skeb perturbation of x wind | none | 2 | real | kind_phys | in | F | -!! | skebv_wts | weights_for_stochastic_skeb_perturbation_of_y_wind | weights for stochastic skeb perturbation of y wind | none | 2 | real | kind_phys | in | F | -!! | shum_wts | weights_for_stochastic_shum_perturbation | weights for stochastic shum perturbation | none | 2 | real | kind_phys | in | F | -!! | sppt_wts_inv | weights_for_stochastic_sppt_perturbation_flipped | weights for stochastic sppt perturbation, flipped | none | 2 | real | kind_phys | inout | F | -!! | skebu_wts_inv | weights_for_stochastic_skeb_perturbation_of_x_wind_flipped | weights for stochastic skeb perturbation of x wind, flipped | none | 2 | real | kind_phys | inout | F | -!! | skebv_wts_inv | weights_for_stochastic_skeb_perturbation_of_y_wind_flipped | weights for stochastic skeb perturbation of y wind, flipped | none | 2 | real | kind_phys | inout | F | -!! | shum_wts_inv | weights_for_stochastic_shum_perturbation_flipped | weights for stochastic shum perturbation, flipped | none | 2 | real | kind_phys | inout | F | -!! | diss_est | dissipation_estimate_of_air_temperature_at_model_layers | dissipation estimate model layer mean temperature | K | 2 | real | kind_phys | in | F | -!! | ugrs | x_wind | zonal wind | m s-1 | 2 | real | kind_phys | in | F | -!! | vgrs | y_wind | meridional wind | m s-1 | 2 | real | kind_phys | in | F | -!! | tgrs | air_temperature | model layer mean temperature | K | 2 | real | kind_phys | in | F | -!! | qgrs | water_vapor_specific_humidity | water vapor specific humidity | kg kg-1 | 2 | real | kind_phys | in | F | -!! | gu0 | x_wind_updated_by_physics | zonal wind updated by physics | m s-1 | 2 | real | kind_phys | inout | F | -!! | gv0 | y_wind_updated_by_physics | meridional wind updated by physics | m s-1 | 2 | real | kind_phys | inout | F | -!! | gt0 | air_temperature_updated_by_physics | temperature updated by physics | K | 2 | real | kind_phys | inout | F | -!! | gq0 | water_vapor_specific_humidity_updated_by_physics | water vapor specific humidity updated by physics | kg kg-1 | 2 | real | kind_phys | inout | F | -!! | dtdtr | tendency_of_air_temperature_due_to_radiative_heating_on_physics_time_step | temp. change due to radiative heating per time step | K | 2 | real | kind_phys | in | F | -!! | rain | lwe_thickness_of_precipitation_amount_on_dynamics_timestep | total rain at this time step | m | 1 | real | kind_phys | in | F | -!! | rainc | lwe_thickness_of_convective_precipitation_amount_on_dynamics_timestep | convective rain at this time step | m | 1 | real | kind_phys | in | F | -!! | tprcp | nonnegative_lwe_thickness_of_precipitation_amount_on_dynamics_timestep | total precipitation amount in each time step | m | 1 | real | kind_phys | inout | F | -!! | totprcp | accumulated_lwe_thickness_of_precipitation_amount | accumulated total precipitation | m | 1 | real | kind_phys | inout | F | -!! | cnvprcp | cumulative_lwe_thickness_of_convective_precipitation_amount | cumulative convective precipitation | m | 1 | real | kind_phys | inout | F | -!! | totprcpb | accumulated_lwe_thickness_of_precipitation_amount_in_bucket | accumulated total precipitation in bucket | m | 1 | real | kind_phys | inout | F | -!! | cnvprcpb | cumulative_lwe_thickness_of_convective_precipitation_amount_in_bucket | cumulative convective precipitation in bucket | m | 1 | real | kind_phys | inout | F | -!! | cplflx | flag_for_flux_coupling | flag controlling cplflx collection (default off) | flag | 0 | logical | | in | F | -!! | rain_cpl | lwe_thickness_of_precipitation_amount_for_coupling | total rain precipitation | m | 1 | real | kind_phys | inout | F | -!! | snow_cpl | lwe_thickness_of_snow_amount_for_coupling | total snow precipitation | m | 1 | real | kind_phys | inout | F | -!! | drain_cpl | tendency_of_lwe_thickness_of_precipitation_amount_for_coupling | change in rain_cpl (coupling_type) | m | 1 | real | kind_phys | in | F | -!! | dsnow_cpl | tendency_of_lwe_thickness_of_snow_amount_for_coupling | change in show_cpl (coupling_type) | m | 1 | real | kind_phys | in | F | -!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | -!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | +!! \htmlinclude GFS_stochastics_run.html !! !>\section gfs_stochy_general GFS_stochastics_run General Algorithm !! This is the GFS stochastic physics driver. @@ -164,7 +124,7 @@ subroutine GFS_stochastics_run (im, km, do_sppt, use_zmtnblck, do_shum, do_skeb, if (use_zmtnblck)then sppt_wts(i,k)=(sppt_wts(i,k)-1)*sppt_vwt+1.0 endif - sppt_wts_inv(i,km-k+1)=sppt_wts(i,k) + sppt_wts_inv(i,k)=sppt_wts(i,k) !if(isppt_deep)then @@ -230,7 +190,7 @@ subroutine GFS_stochastics_run (im, km, do_sppt, use_zmtnblck, do_shum, do_skeb, if (do_shum) then do k=1,km gq0(:,k) = gq0(:,k)*(1.0 + shum_wts(:,k)) - shum_wts_inv(:,km-k+1) = shum_wts(:,k) + shum_wts_inv(:,k) = shum_wts(:,k) end do endif @@ -238,8 +198,8 @@ subroutine GFS_stochastics_run (im, km, do_sppt, use_zmtnblck, do_shum, do_skeb, do k=1,km gu0(:,k) = gu0(:,k)+skebu_wts(:,k)*(diss_est(:,k)) gv0(:,k) = gv0(:,k)+skebv_wts(:,k)*(diss_est(:,k)) - skebu_wts_inv(:,km-k+1) = skebu_wts(:,k) - skebv_wts_inv(:,km-k+1) = skebv_wts(:,k) + skebu_wts_inv(:,k) = skebu_wts(:,k) + skebv_wts_inv(:,k) = skebv_wts(:,k) enddo endif diff --git a/physics/GFS_stochastics.meta b/physics/GFS_stochastics.meta new file mode 100644 index 000000000..9232c8d6a --- /dev/null +++ b/physics/GFS_stochastics.meta @@ -0,0 +1,346 @@ +[ccpp-arg-table] + name = GFS_stochastics_run + type = scheme +[im] + standard_name = horizontal_loop_extent + long_name = horizontal loop extent + units = count + dimensions = () + type = integer + intent = in + optional = F +[km] + standard_name = vertical_dimension + long_name = number of vertical levels + units = count + dimensions = () + type = integer + intent = in + optional = F +[do_sppt] + standard_name = flag_for_stochastic_surface_physics_perturbations + long_name = flag for stochastic surface physics perturbations + units = flag + dimensions = () + type = logical + intent = in + optional = F +[use_zmtnblck] + standard_name = flag_for_mountain_blocking + long_name = flag for mountain blocking + units = flag + dimensions = () + type = logical + intent = in + optional = F +[do_shum] + standard_name = flag_for_stochastic_shum_option + long_name = flag for stochastic shum option + units = flag + dimensions = () + type = logical + intent = in + optional = F +[do_skeb] + standard_name = flag_for_stochastic_skeb_option + long_name = flag for stochastic skeb option + units = flag + dimensions = () + type = logical + intent = in + optional = F +[zmtnblck] + standard_name = level_of_dividing_streamline + long_name = level of the dividing streamline + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[sppt_wts] + standard_name = weights_for_stochastic_sppt_perturbation + long_name = weights for stochastic sppt perturbation + units = none + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[skebu_wts] + standard_name = weights_for_stochastic_skeb_perturbation_of_x_wind + long_name = weights for stochastic skeb perturbation of x wind + units = none + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[skebv_wts] + standard_name = weights_for_stochastic_skeb_perturbation_of_y_wind + long_name = weights for stochastic skeb perturbation of y wind + units = none + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[shum_wts] + standard_name = weights_for_stochastic_shum_perturbation + long_name = weights for stochastic shum perturbation + units = none + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[sppt_wts_inv] + standard_name = weights_for_stochastic_sppt_perturbation_flipped + long_name = weights for stochastic sppt perturbation, flipped + units = none + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[skebu_wts_inv] + standard_name = weights_for_stochastic_skeb_perturbation_of_x_wind_flipped + long_name = weights for stochastic skeb perturbation of x wind, flipped + units = none + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[skebv_wts_inv] + standard_name = weights_for_stochastic_skeb_perturbation_of_y_wind_flipped + long_name = weights for stochastic skeb perturbation of y wind, flipped + units = none + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[shum_wts_inv] + standard_name = weights_for_stochastic_shum_perturbation_flipped + long_name = weights for stochastic shum perturbation, flipped + units = none + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[diss_est] + standard_name = dissipation_estimate_of_air_temperature_at_model_layers + long_name = dissipation estimate model layer mean temperature + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[ugrs] + standard_name = x_wind + long_name = zonal wind + units = m s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[vgrs] + standard_name = y_wind + long_name = meridional wind + units = m s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[tgrs] + standard_name = air_temperature + long_name = model layer mean temperature + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[qgrs] + standard_name = water_vapor_specific_humidity + long_name = water vapor specific humidity + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[gu0] + standard_name = x_wind_updated_by_physics + long_name = zonal wind updated by physics + units = m s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[gv0] + standard_name = y_wind_updated_by_physics + long_name = meridional wind updated by physics + units = m s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[gt0] + standard_name = air_temperature_updated_by_physics + long_name = temperature updated by physics + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[gq0] + standard_name = water_vapor_specific_humidity_updated_by_physics + long_name = water vapor specific humidity updated by physics + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[dtdtr] + standard_name = tendency_of_air_temperature_due_to_radiative_heating_on_physics_time_step + long_name = temp. change due to radiative heating per time step + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[rain] + standard_name = lwe_thickness_of_precipitation_amount_on_dynamics_timestep + long_name = total rain at this time step + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[rainc] + standard_name = lwe_thickness_of_convective_precipitation_amount_on_dynamics_timestep + long_name = convective rain at this time step + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[tprcp] + standard_name = nonnegative_lwe_thickness_of_precipitation_amount_on_dynamics_timestep + long_name = total precipitation amount in each time step + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[totprcp] + standard_name = accumulated_lwe_thickness_of_precipitation_amount + long_name = accumulated total precipitation + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[cnvprcp] + standard_name = cumulative_lwe_thickness_of_convective_precipitation_amount + long_name = cumulative convective precipitation + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[totprcpb] + standard_name = accumulated_lwe_thickness_of_precipitation_amount_in_bucket + long_name = accumulated total precipitation in bucket + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[cnvprcpb] + standard_name = cumulative_lwe_thickness_of_convective_precipitation_amount_in_bucket + long_name = cumulative convective precipitation in bucket + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[cplflx] + standard_name = flag_for_flux_coupling + long_name = flag controlling cplflx collection (default off) + units = flag + dimensions = () + type = logical + intent = in + optional = F +[rain_cpl] + standard_name = lwe_thickness_of_precipitation_amount_for_coupling + long_name = total rain precipitation + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[snow_cpl] + standard_name = lwe_thickness_of_snow_amount_for_coupling + long_name = total snow precipitation + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[drain_cpl] + standard_name = tendency_of_lwe_thickness_of_precipitation_amount_for_coupling + long_name = change in rain_cpl (coupling_type) + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[dsnow_cpl] + standard_name = tendency_of_lwe_thickness_of_snow_amount_for_coupling + long_name = change in show_cpl (coupling_type) + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F diff --git a/physics/GFS_suite_init_finalize_test.F90 b/physics/GFS_suite_init_finalize_test.F90 index efd0530e2..0a958d2fc 100644 --- a/physics/GFS_suite_init_finalize_test.F90 +++ b/physics/GFS_suite_init_finalize_test.F90 @@ -3,10 +3,7 @@ module GFS_suite_ini_fini_test contains !> \section arg_table_GFS_suite_ini_fini_test_init Argument Table -!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | -!! |----------------|--------------------------------------------------------|---------------------------------------------------------|---------------|------|-----------------------|-----------|--------|----------| -!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | -!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | +!! \htmlinclude GFS_suite_ini_fini_test_init.html !! subroutine GFS_suite_ini_fini_test_init (errmsg, errflg) @@ -24,10 +21,7 @@ subroutine GFS_suite_ini_fini_test_init (errmsg, errflg) end subroutine GFS_suite_ini_fini_test_init !> \section arg_table_GFS_suite_ini_fini_test_finalize Argument Table -!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | -!! |----------------|--------------------------------------------------------|---------------------------------------------------------|---------------|------|-----------------------|-----------|--------|----------| -!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | -!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | +!! \htmlinclude GFS_suite_ini_fini_test_finalize.html !! subroutine GFS_suite_ini_fini_test_finalize(errmsg, errflg) @@ -45,10 +39,7 @@ subroutine GFS_suite_ini_fini_test_finalize(errmsg, errflg) end subroutine GFS_suite_ini_fini_test_finalize !> \section arg_table_GFS_suite_ini_fini_test_run Argument Table -!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | -!! |----------------|--------------------------------------------------------|---------------------------------------------------------|---------------|------|-----------------------|-----------|--------|----------| -!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | -!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | +!! \htmlinclude GFS_suite_ini_fini_test_run.html !! subroutine GFS_suite_ini_fini_test_run (errmsg, errflg) diff --git a/physics/GFS_suite_init_finalize_test.meta b/physics/GFS_suite_init_finalize_test.meta new file mode 100644 index 000000000..cdca8b0e0 --- /dev/null +++ b/physics/GFS_suite_init_finalize_test.meta @@ -0,0 +1,64 @@ +[ccpp-arg-table] + name = GFS_suite_ini_fini_test_init + type = scheme +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F + +######################################################################## +[ccpp-arg-table] + name = GFS_suite_ini_fini_test_finalize + type = scheme +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F + +######################################################################## +[ccpp-arg-table] + name = GFS_suite_ini_fini_test_run + type = scheme +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F diff --git a/physics/GFS_suite_interstitial.F90 b/physics/GFS_suite_interstitial.F90 index eb1e2e2b4..8abaf24b7 100644 --- a/physics/GFS_suite_interstitial.F90 +++ b/physics/GFS_suite_interstitial.F90 @@ -12,27 +12,24 @@ subroutine GFS_suite_interstitial_rad_reset_finalize() end subroutine GFS_suite_interstitial_rad_reset_finalize !> \section arg_table_GFS_suite_interstitial_rad_reset_run Argument Table -!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | -!! |----------------|--------------------------------------------------------|---------------------------------------------------------|---------------|------|-----------------------|-----------|--------|----------| -!! | Interstitial | GFS_interstitial_type_instance | derived type GFS_interstitial_type in FV3 | DDT | 0 | GFS_interstitial_type | | inout | F | -!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | -!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | +!! \htmlinclude GFS_suite_interstitial_rad_reset_run.html !! - subroutine GFS_suite_interstitial_rad_reset_run (Interstitial, errmsg, errflg) + subroutine GFS_suite_interstitial_rad_reset_run (Interstitial, Model, errmsg, errflg) - use GFS_typedefs, only: GFS_interstitial_type + use GFS_typedefs, only: GFS_control_type,GFS_interstitial_type implicit none ! interface variables type(GFS_interstitial_type), intent(inout) :: Interstitial + type(GFS_control_type), intent(in) :: Model character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg errmsg = '' errflg = 0 - call Interstitial%rad_reset() + call Interstitial%rad_reset(Model) end subroutine GFS_suite_interstitial_rad_reset_run @@ -50,12 +47,7 @@ subroutine GFS_suite_interstitial_phys_reset_finalize() end subroutine GFS_suite_interstitial_phys_reset_finalize !> \section arg_table_GFS_suite_interstitial_phys_reset_run Argument Table -!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | -!! |----------------|--------------------------------------------------------|---------------------------------------------------------|---------------|------|-----------------------|-----------|--------|----------| -!! | Interstitial | GFS_interstitial_type_instance | derived type GFS_interstitial_type in FV3 | DDT | 0 | GFS_interstitial_type | | inout | F | -!! | Model | GFS_control_type_instance | Fortran DDT containing FV3-GFS model control parameters | DDT | 0 | GFS_control_type | | in | F | -!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | -!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | +!! \htmlinclude GFS_suite_interstitial_phys_reset_run.html !! subroutine GFS_suite_interstitial_phys_reset_run (Interstitial, Model, errmsg, errflg) @@ -90,41 +82,10 @@ subroutine GFS_suite_interstitial_1_finalize() end subroutine GFS_suite_interstitial_1_finalize !> \section arg_table_GFS_suite_interstitial_1_run Argument Table -!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | -!! |----------------|---------------------------------------------------------------------------|-------------------------------------------------------------------------|---------------|------|------------|-----------|--------|----------| -!! | im | horizontal_loop_extent | horizontal loop extent | count | 0 | integer | | in | F | -!! | levs | vertical_dimension | vertical layer dimension | count | 0 | integer | | in | F | -!! | ntrac | number_of_tracers | number of tracers | count | 0 | integer | | in | F | -!! | crtrh | critical_relative_humidity_at_sfc_pbltop_toa | critical relative humidity at SFC, PBL top and TOA | frac | 1 | real | kind_phys | in | F | -!! | dtf | time_step_for_dynamics | dynamics timestep | s | 0 | real | kind_phys | in | F | -!! | dtp | time_step_for_physics | physics timestep | s | 0 | real | kind_phys | in | F | -!! | slmsk | sea_land_ice_mask_real | landmask: sea/land/ice=0/1/2 | flag | 1 | real | kind_phys | in | F | -!! | area | cell_area | area of the grid cell | m2 | 1 | real | kind_phys | in | F | -!! | dxmin | minimum_scaling_factor_for_critical_relative_humidity | minimum scaling factor for critical relative humidity | m2 rad-2 | 0 | real | kind_phys | in | F | -!! | dxinv | inverse_scaling_factor_for_critical_relative_humidity | inverse scaling factor for critical relative humidity | rad2 m-2 | 0 | real | kind_phys | in | F | -!! | pgr | surface_air_pressure | surface pressure | Pa | 1 | real | kind_phys | in | F | -!! | rhbbot | critical_relative_humidity_at_surface | critical relative humidity at the surface | frac | 0 | real | kind_phys | out | F | -!! | rhpbl | critical_relative_humidity_at_PBL_top | critical relative humidity at the PBL top | frac | 0 | real | kind_phys | out | F | -!! | rhbtop | critical_relative_humidity_at_top_of_atmosphere | critical relative humidity at the top of atmosphere | frac | 0 | real | kind_phys | out | F | -!! | frain | dynamics_to_physics_timestep_ratio | ratio of dynamics timestep to physics timestep | none | 0 | real | kind_phys | out | F | -!! | islmsk | sea_land_ice_mask | landmask: sea/land/ice=0/1/2 | flag | 1 | integer | | out | F | -!! | frland | land_area_fraction_for_microphysics | land area fraction used in microphysics schemes | frac | 1 | real | kind_phys | out | F | -!! | work1 | grid_size_related_coefficient_used_in_scale-sensitive_schemes | grid size related coefficient used in scale-sensitive schemes | none | 1 | real | kind_phys | out | F | -!! | work2 | grid_size_related_coefficient_used_in_scale-sensitive_schemes_complement | complement to work1 | none | 1 | real | kind_phys | out | F | -!! | psurf | surface_air_pressure_diag | surface air pressure diagnostic | Pa | 1 | real | kind_phys | out | F | -!! | dudt | tendency_of_x_wind_due_to_model_physics | updated tendency of the x wind | m s-2 | 2 | real | kind_phys | out | F | -!! | dvdt | tendency_of_y_wind_due_to_model_physics | updated tendency of the y wind | m s-2 | 2 | real | kind_phys | out | F | -!! | dtdt | tendency_of_air_temperature_due_to_model_physics | updated tendency of the temperature | K s-1 | 2 | real | kind_phys | out | F | -!! | dtdtc | tendency_of_air_temperature_due_to_radiative_heating_assuming_clear_sky | clear sky radiative (shortwave + longwave) heating rate at current time | K s-1 | 2 | real | kind_phys | out | F | -!! | dqdt | tendency_of_tracers_due_to_model_physics | updated tendency of the tracers | kg kg-1 s-1 | 3 | real | kind_phys | out | F | -!! | tisfc | sea_ice_temperature | sea ice surface skin temperature | K | 1 | real | kind_phys | in | F | -!! | tice | sea_ice_temperature_interstitial | sea ice surface skin temperature use as interstitial | K | 1 | real | kind_phys | out | F | -!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | -!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | +!! \htmlinclude GFS_suite_interstitial_1_run.html !! - subroutine GFS_suite_interstitial_1_run (im, levs, ntrac, crtrh, dtf, dtp, slmsk, area, dxmin, dxinv, pgr, & - rhbbot, rhpbl, rhbtop, frain, islmsk, frland, work1, work2, psurf, dudt, dvdt, dtdt, dtdtc, dqdt, & - tisfc, tice, errmsg, errflg) + subroutine GFS_suite_interstitial_1_run (im, levs, ntrac, dtf, dtp, slmsk, area, dxmin, dxinv, pgr, & + islmsk, work1, work2, psurf, dudt, dvdt, dtdt, dtdtc, dqdt, errmsg, errflg) use machine, only: kind_phys @@ -133,16 +94,12 @@ subroutine GFS_suite_interstitial_1_run (im, levs, ntrac, crtrh, dtf, dtp, slmsk ! interface variables integer, intent(in) :: im, levs, ntrac real(kind=kind_phys), intent(in) :: dtf, dtp, dxmin, dxinv - real(kind=kind_phys), intent(in), dimension(3) :: crtrh real(kind=kind_phys), intent(in), dimension(im) :: slmsk, area, pgr - real(kind=kind_phys), intent(out) :: rhbbot, rhpbl, rhbtop, frain integer, intent(out), dimension(im) :: islmsk - real(kind=kind_phys), intent(out), dimension(im) :: frland, work1, work2, psurf + real(kind=kind_phys), intent(out), dimension(im) :: work1, work2, psurf real(kind=kind_phys), intent(out), dimension(im,levs) :: dudt, dvdt, dtdt, dtdtc real(kind=kind_phys), intent(out), dimension(im,levs,ntrac) :: dqdt - real(kind=kind_phys), intent(in), dimension(im) :: tisfc - real(kind=kind_phys), intent(out), dimension(im) :: tice character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -153,26 +110,13 @@ subroutine GFS_suite_interstitial_1_run (im, levs, ntrac, crtrh, dtf, dtp, slmsk errmsg = '' errflg = 0 - rhbbot = crtrh(1) - rhpbl = crtrh(2) - rhbtop = crtrh(3) - - frain = dtf / dtp - do i = 1, im islmsk(i) = nint(slmsk(i)) - if (islmsk(i) == 1) then - frland(i) = 1.0 - else - frland(i) = 0.0 - endif + work1(i) = (log(area(i)) - dxmin) * dxinv work1(i) = max(0.0, min(1.0,work1(i))) work2(i) = 1.0 - work1(i) psurf(i) = pgr(i) - ! DH* 20190507 - assign sea ice temperature to interstitial variable - tice(i) = tisfc(i) - ! *DH end do do k=1,levs @@ -198,6 +142,9 @@ end module GFS_suite_interstitial_1 module GFS_suite_interstitial_2 + use machine, only: kind_phys + real(kind=kind_phys), parameter :: one = 1.0d0 + contains subroutine GFS_suite_interstitial_2_init () @@ -207,84 +154,42 @@ subroutine GFS_suite_interstitial_2_finalize() end subroutine GFS_suite_interstitial_2_finalize #if 0 !> \section arg_table_GFS_suite_interstitial_2_run Argument Table -!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | -!! |------------------|----------------------------------------------------------------------------|-----------------------------------------------------------------------------|---------------|------|------------|-----------|--------|----------| -!! | im | horizontal_loop_extent | horizontal loop extent | count | 0 | integer | | in | F | -!! | levs | vertical_dimension | vertical layer dimension | count | 0 | integer | | in | F | -!! | lssav | flag_diagnostics | logical flag for storing diagnostics | flag | 0 | logical | | in | F | -!! | ldiag3d | flag_diagnostics_3D | flag for 3d diagnostic fields | flag | 0 | logical | | in | F | -!! | lsidea | flag_idealized_physics | flag for idealized physics | flag | 0 | logical | | in | F | -!! | cplflx | flag_for_flux_coupling | flag controlling cplflx collection (default off) | flag | 0 | logical | | in | F | -!! | flag_cice | flag_for_cice | flag for cice | flag | 1 | logical | | in | F | -!! | shal_cnv | flag_for_shallow_convection | flag for calling shallow convection | flag | 0 | logical | | in | F | -!! | old_monin | flag_for_old_PBL_scheme | flag for using old PBL schemes | flag | 0 | logical | | in | F | -!! | mstrat | flag_for_moorthi_stratus | flag for moorthi approach for stratus | flag | 0 | logical | | in | F | -!! | do_shoc | flag_for_shoc | flag for SHOC | flag | 0 | logical | | in | F | -!! | imfshalcnv | flag_for_mass_flux_shallow_convection_scheme | flag for mass-flux shallow convection scheme | flag | 0 | integer | | in | F | -!! | dtf | time_step_for_dynamics | dynamics timestep | s | 0 | real | kind_phys | in | F | -!! | xcosz | instantaneous_cosine_of_zenith_angle | cosine of zenith angle at current time | none | 1 | real | kind_phys | in | F | -!! | adjsfcdsw | surface_downwelling_shortwave_flux | surface downwelling shortwave flux at current time | W m-2 | 1 | real | kind_phys | in | F | -!! | adjsfcdlw | surface_downwelling_longwave_flux | surface downwelling longwave flux at current time | W m-2 | 1 | real | kind_phys | in | F | -!! | pgr | surface_air_pressure | surface pressure | Pa | 1 | real | kind_phys | in | F | -!! | ulwsfc_cice | surface_upwelling_longwave_flux_for_cice | surface upwelling longwave flux for cice | W m-2 | 1 | real | kind_phys | in | F | -!! | lwhd | tendency_of_air_temperature_due_to_longwave_heating_for_idea | idea sky lw heating rates | K s-1 | 3 | real | kind_phys | in | F | -!! | htrsw | tendency_of_air_temperature_due_to_shortwave_heating_on_radiation_timestep | total sky sw heating rate | K s-1 | 2 | real | kind_phys | in | F | -!! | htrlw | tendency_of_air_temperature_due_to_longwave_heating_on_radiation_timestep | total sky lw heating rate | K s-1 | 2 | real | kind_phys | in | F | -!! | xmu | zenith_angle_temporal_adjustment_factor_for_shortwave_fluxes | zenith angle temporal adjustment factor for shortwave fluxes | none | 1 | real | kind_phys | in | F | -!! | ctei_rm | critical_cloud_top_entrainment_instability_criteria | critical cloud top entrainment instability criteria | none | 1 | real | kind_phys | in | F | -!! | work1 | grid_size_related_coefficient_used_in_scale-sensitive_schemes | grid size related coefficient used in scale-sensitive schemes | none | 1 | real | kind_phys | in | F | -!! | work2 | grid_size_related_coefficient_used_in_scale-sensitive_schemes_complement | complement to work1 | none | 1 | real | kind_phys | in | F | -!! | prsi | air_pressure_at_interface | air pressure at model layer interfaces | Pa | 2 | real | kind_phys | in | F | -!! | tgrs | air_temperature | model layer mean temperature | K | 2 | real | kind_phys | in | F | -!! | prsl | air_pressure | mean layer pressure | Pa | 2 | real | kind_phys | in | F | -!! | qgrs_water_vapor | water_vapor_specific_humidity | water vapor specific humidity | kg kg-1 | 2 | real | kind_phys | in | F | -!! | qgrs_cloud_water | cloud_condensed_water_mixing_ratio | moist (dry+vapor, no condensates) mixing ratio of cloud water (condensate) | kg kg-1 | 2 | real | kind_phys | in | F | -!! | cp | specific_heat_of_dry_air_at_constant_pressure | specific heat of dry air at constant pressure | J kg-1 K-1 | 0 | real | kind_phys | in | F | -!! | hvap | latent_heat_of_vaporization_of_water_at_0C | latent heat of evaporation/sublimation | J kg-1 | 0 | real | kind_phys | in | F | -!! | prslk | dimensionless_exner_function_at_model_layers | dimensionless Exner function at model layer centers | none | 2 | real | kind_phys | in | F | -!! | suntim | duration_of_sunshine | sunshine duration time | s | 1 | real | kind_phys | inout | F | -!! | adjsfculw | surface_upwelling_longwave_flux | surface upwelling longwave flux at current time | W m-2 | 1 | real | kind_phys | inout | F | -!! | dlwsfc | cumulative_surface_downwelling_longwave_flux_multiplied_by_timestep | cumulative surface downwelling LW flux multiplied by timestep | W m-2 s | 1 | real | kind_phys | inout | F | -!! | ulwsfc | cumulative_surface_upwelling_longwave_flux_multiplied_by_timestep | cumulative surface upwelling LW flux multiplied by timestep | W m-2 s | 1 | real | kind_phys | inout | F | -!! | psmean | cumulative_surface_pressure_multiplied_by_timestep | cumulative surface pressure multiplied by timestep | Pa s | 1 | real | kind_phys | inout | F | -!! | dt3dt_lw | cumulative_change_in_temperature_due_to_longwave_radiation | cumulative change in temperature due to longwave radiation | K | 2 | real | kind_phys | inout | F | -!! | dt3dt_sw | cumulative_change_in_temperature_due_to_shortwave_radiation | cumulative change in temperature due to shortwave radiation | K | 2 | real | kind_phys | inout | F | -!! | dt3dt_pbl | cumulative_change_in_temperature_due_to_PBL | cumulative change in temperature due to PBL | K | 2 | real | kind_phys | inout | F | -!! | dt3dt_dcnv | cumulative_change_in_temperature_due_to_deep_convection | cumulative change in temperature due to deep conv. | K | 2 | real | kind_phys | inout | F | -!! | dt3dt_scnv | cumulative_change_in_temperature_due_to_shal_convection | cumulative change in temperature due to shal conv. | K | 2 | real | kind_phys | inout | F | -!! | dt3dt_mp | cumulative_change_in_temperature_due_to_microphysics | cumulative change in temperature due to microphysics | K | 2 | real | kind_phys | inout | F | -!! | ctei_rml | grid_sensitive_critical_cloud_top_entrainment_instability_criteria | grid sensitive critical cloud top entrainment instability criteria | none | 1 | real | kind_phys | inout | F | -!! | ctei_r | cloud_top_entrainment_instability_value | cloud top entrainment instability value | none | 1 | real | kind_phys | inout | F | -!! | kinver | index_of_highest_temperature_inversion | index of highest temperature inversion | index | 1 | integer | | inout | F | -!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | -!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | +!! \htmlinclude GFS_suite_interstitial_2_run.html !! #endif - subroutine GFS_suite_interstitial_2_run (im, levs, lssav, ldiag3d, lsidea, cplflx, flag_cice, shal_cnv, old_monin, mstrat, & - do_shoc, imfshalcnv, dtf, xcosz, adjsfcdsw, adjsfcdlw, pgr, ulwsfc_cice, lwhd, htrsw, htrlw, xmu, ctei_rm, work1, work2, & - prsi, tgrs, prsl, qgrs_water_vapor, qgrs_cloud_water, cp, hvap, prslk, & - suntim, adjsfculw, dlwsfc, ulwsfc, psmean, dt3dt_lw, dt3dt_sw, dt3dt_pbl, dt3dt_dcnv, dt3dt_scnv, dt3dt_mp, ctei_rml, & - ctei_r, kinver, errmsg, errflg) - - use machine, only: kind_phys + subroutine GFS_suite_interstitial_2_run (im, levs, lssav, ldiag3d, lsidea, cplflx, flag_cice, shal_cnv, old_monin, mstrat, & + do_shoc, frac_grid, imfshalcnv, dtf, xcosz, adjsfcdsw, adjsfcdlw, cice, pgr, ulwsfc_cice, lwhd, htrsw, htrlw, xmu, ctei_rm, & + work1, work2, prsi, tgrs, prsl, qgrs_water_vapor, qgrs_cloud_water, cp, hvap, prslk, suntim, adjsfculw, adjsfculw_lnd, & + adjsfculw_ice, adjsfculw_ocn, dlwsfc, ulwsfc, psmean, dt3dt_lw, dt3dt_sw, dt3dt_pbl, dt3dt_dcnv, dt3dt_scnv, dt3dt_mp, & + ctei_rml, ctei_r, kinver, dry, icy, wet, frland, huge, errmsg, errflg) implicit none ! interface variables - integer, intent(in) :: im, levs, imfshalcnv - logical, intent(in) :: lssav, ldiag3d, lsidea, cplflx, shal_cnv, old_monin, mstrat, do_shoc - real(kind=kind_phys), intent(in) :: dtf, cp, hvap - - logical, intent(in), dimension(im) :: flag_cice - real(kind=kind_phys), intent(in), dimension(2) :: ctei_rm - real(kind=kind_phys), intent(in), dimension(im) :: xcosz, adjsfcdsw, adjsfcdlw, pgr, xmu, ulwsfc_cice, work1, work2 - real(kind=kind_phys), intent(in), dimension(im, levs) :: htrsw, htrlw, tgrs, prsl, qgrs_water_vapor, qgrs_cloud_water, prslk - real(kind=kind_phys), intent(in), dimension(im, levs+1) :: prsi - real(kind=kind_phys), intent(in), dimension(im, levs, 6) :: lwhd + integer, intent(in ) :: im, levs, imfshalcnv + logical, intent(in ) :: lssav, ldiag3d, lsidea, cplflx, shal_cnv + logical, intent(in ) :: old_monin, mstrat, do_shoc, frac_grid + real(kind=kind_phys), intent(in ) :: dtf, cp, hvap + + logical, intent(in ), dimension(im) :: flag_cice + real(kind=kind_phys), intent(in ), dimension(2) :: ctei_rm + real(kind=kind_phys), intent(in ), dimension(im) :: xcosz, adjsfcdsw, adjsfcdlw, pgr, xmu, ulwsfc_cice, work1, work2 + real(kind=kind_phys), intent(in ), dimension(im) :: cice + real(kind=kind_phys), intent(in ), dimension(im, levs) :: htrsw, htrlw, tgrs, prsl, qgrs_water_vapor, qgrs_cloud_water, prslk + real(kind=kind_phys), intent(in ), dimension(im, levs+1) :: prsi + real(kind=kind_phys), intent(in ), dimension(im, levs, 6) :: lwhd integer, intent(inout), dimension(im) :: kinver - real(kind=kind_phys), intent(inout), dimension(im) :: suntim, dlwsfc, ulwsfc, psmean, adjsfculw, ctei_rml, ctei_r - real(kind=kind_phys), intent(inout), dimension(im, levs) :: dt3dt_lw, dt3dt_sw, dt3dt_pbl, dt3dt_dcnv, dt3dt_scnv, dt3dt_mp + real(kind=kind_phys), intent(inout), dimension(im) :: suntim, dlwsfc, ulwsfc, psmean, ctei_rml, ctei_r + real(kind=kind_phys), intent(in ), dimension(im) :: adjsfculw_lnd, adjsfculw_ice, adjsfculw_ocn + real(kind=kind_phys), intent( out), dimension(im) :: adjsfculw + + ! These arrays are only allocated if ldiag3d is .true. + real(kind=kind_phys), intent(inout), dimension(:,:) :: dt3dt_lw, dt3dt_sw, dt3dt_pbl, dt3dt_dcnv, dt3dt_scnv, dt3dt_mp + + logical, intent(in ), dimension(im) :: dry, icy, wet + real(kind=kind_phys), intent(in ), dimension(im) :: frland + real(kind=kind_phys), intent(in ) :: huge character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -296,7 +201,7 @@ subroutine GFS_suite_interstitial_2_run (im, levs, lssav, ldiag3d, lsidea, cplfl logical, dimension(im) :: invrsn real(kind=kind_phys), dimension(im) :: tx1, tx2 - real(kind=kind_phys), parameter :: qmin = 1.0e-10 + real(kind=kind_phys), parameter :: qmin = 1.0d-10 ! Initialize CCPP error handling variables errmsg = '' @@ -320,29 +225,63 @@ subroutine GFS_suite_interstitial_2_run (im, levs, lssav, ldiag3d, lsidea, cplfl enddo ! --- ... sfc lw fluxes used by atmospheric model are saved for output - if (cplflx) then + + if (frac_grid) then do i=1,im - if (flag_cice(i)) adjsfculw(i) = ulwsfc_cice(i) + tem = one - cice(i) - frland(i) + if (flag_cice(i)) then + adjsfculw(i) = adjsfculw_lnd(i) * frland(i) & + + ulwsfc_cice(i) * cice(i) & + + adjsfculw_ocn(i) * tem + else + adjsfculw(i) = adjsfculw_lnd(i) * frland(i) & + + adjsfculw_ice(i) * cice(i) & + + adjsfculw_ocn(i) * tem + endif + enddo + else + do i=1,im + if (dry(i)) then ! all land + adjsfculw(i) = adjsfculw_lnd(i) + elseif (icy(i)) then ! ice (and water) + tem = one - cice(i) + if (flag_cice(i)) then + if (wet(i) .and. adjsfculw_ocn(i) /= huge) then + adjsfculw(i) = ulwsfc_cice(i)*cice(i) + adjsfculw_ocn(i)*tem + else + adjsfculw(i) = ulwsfc_cice(i) + endif + else + if (wet(i) .and. adjsfculw_ocn(i) /= huge) then + adjsfculw(i) = adjsfculw_ice(i)*cice(i) + adjsfculw_ocn(i)*tem + else + adjsfculw(i) = adjsfculw_ice(i) + endif + endif + else ! all water + adjsfculw(i) = adjsfculw_ocn(i) + endif enddo endif + do i=1,im - dlwsfc(i) = dlwsfc(i) + adjsfcdlw(i)*dtf - ulwsfc(i) = ulwsfc(i) + adjsfculw(i)*dtf - psmean(i) = psmean(i) + pgr(i)*dtf ! mean surface pressure + dlwsfc(i) = dlwsfc(i) + adjsfcdlw(i)*dtf + ulwsfc(i) = ulwsfc(i) + adjsfculw(i)*dtf + psmean(i) = psmean(i) + pgr(i)*dtf ! mean surface pressure end do if (ldiag3d) then if (lsidea) then do k=1,levs do i=1,im - dt3dt_lw(i,k) = dt3dt_lw(i,k) + lwhd(i,k,1)*dtf - dt3dt_sw(i,k) = dt3dt_sw(i,k) + lwhd(i,k,2)*dtf - dt3dt_pbl(i,k) = dt3dt_pbl(i,k) + lwhd(i,k,3)*dtf + dt3dt_lw(i,k) = dt3dt_lw(i,k) + lwhd(i,k,1)*dtf + dt3dt_sw(i,k) = dt3dt_sw(i,k) + lwhd(i,k,2)*dtf + dt3dt_pbl(i,k) = dt3dt_pbl(i,k) + lwhd(i,k,3)*dtf dt3dt_dcnv(i,k) = dt3dt_dcnv(i,k) + lwhd(i,k,4)*dtf dt3dt_scnv(i,k) = dt3dt_scnv(i,k) + lwhd(i,k,5)*dtf - dt3dt_mp(i,k) = dt3dt_mp(i,k) + lwhd(i,k,6)*dtf - end do - end do + dt3dt_mp(i,k) = dt3dt_mp(i,k) + lwhd(i,k,6)*dtf + enddo + enddo else do k=1,levs do i=1,im @@ -356,10 +295,10 @@ subroutine GFS_suite_interstitial_2_run (im, levs, lssav, ldiag3d, lsidea, cplfl do i=1, im invrsn(i) = .false. - tx1(i) = 0.0 - tx2(i) = 10.0 + tx1(i) = 0.0 + tx2(i) = 10.0 ctei_r(i) = 10.0 - end do + enddo if ((((imfshalcnv == 0 .and. shal_cnv) .or. old_monin) .and. mstrat) & .or. do_shoc) then @@ -418,21 +357,7 @@ subroutine GFS_suite_stateout_reset_finalize() end subroutine GFS_suite_stateout_reset_finalize !> \section arg_table_GFS_suite_stateout_reset_run Argument Table -!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | -!! |----------------|--------------------------------------------------------------|-----------------------------------------------------------------------|---------------|------|------------|-----------|--------|----------| -!! | im | horizontal_loop_extent | horizontal loop extent | count | 0 | integer | | in | F | -!! | levs | vertical_dimension | vertical layer dimension | count | 0 | integer | | in | F | -!! | ntrac | number_of_tracers | number of tracers | count | 0 | integer | | in | F | -!! | tgrs | air_temperature | model layer mean temperature | K | 2 | real | kind_phys | in | F | -!! | ugrs | x_wind | zonal wind | m s-1 | 2 | real | kind_phys | in | F | -!! | vgrs | y_wind | meridional wind | m s-1 | 2 | real | kind_phys | in | F | -!! | qgrs | tracer_concentration | model layer mean tracer concentration | kg kg-1 | 3 | real | kind_phys | in | F | -!! | gt0 | air_temperature_updated_by_physics | temperature updated by physics | K | 2 | real | kind_phys | out | F | -!! | gu0 | x_wind_updated_by_physics | zonal wind updated by physics | m s-1 | 2 | real | kind_phys | out | F | -!! | gv0 | y_wind_updated_by_physics | meridional wind updated by physics | m s-1 | 2 | real | kind_phys | out | F | -!! | gq0 | tracer_concentration_updated_by_physics | tracer concentration updated by physics | kg kg-1 | 3 | real | kind_phys | out | F | -!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | -!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | +!! \htmlinclude GFS_suite_stateout_reset_run.html !! subroutine GFS_suite_stateout_reset_run (im, levs, ntrac, & tgrs, ugrs, vgrs, qgrs, & @@ -480,26 +405,7 @@ subroutine GFS_suite_stateout_update_finalize() end subroutine GFS_suite_stateout_update_finalize !> \section arg_table_GFS_suite_stateout_update_run Argument Table -!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | -!! |----------------|--------------------------------------------------------------|-----------------------------------------------------------------------|---------------|------|------------|-----------|--------|----------| -!! | im | horizontal_loop_extent | horizontal loop extent | count | 0 | integer | | in | F | -!! | levs | vertical_dimension | vertical layer dimension | count | 0 | integer | | in | F | -!! | ntrac | number_of_tracers | number of tracers | count | 0 | integer | | in | F | -!! | dtp | time_step_for_physics | physics timestep | s | 0 | real | kind_phys | in | F | -!! | tgrs | air_temperature | model layer mean temperature | K | 2 | real | kind_phys | in | F | -!! | ugrs | x_wind | zonal wind | m s-1 | 2 | real | kind_phys | in | F | -!! | vgrs | y_wind | meridional wind | m s-1 | 2 | real | kind_phys | in | F | -!! | qgrs | tracer_concentration | model layer mean tracer concentration | kg kg-1 | 3 | real | kind_phys | in | F | -!! | dudt | tendency_of_x_wind_due_to_model_physics | updated tendency of the x wind | m s-2 | 2 | real | kind_phys | in | F | -!! | dvdt | tendency_of_y_wind_due_to_model_physics | updated tendency of the y wind | m s-2 | 2 | real | kind_phys | in | F | -!! | dtdt | tendency_of_air_temperature_due_to_model_physics | updated tendency of the temperature | K s-1 | 2 | real | kind_phys | in | F | -!! | dqdt | tendency_of_tracers_due_to_model_physics | updated tendency of the tracers | kg kg-1 s-1 | 3 | real | kind_phys | in | F | -!! | gt0 | air_temperature_updated_by_physics | temperature updated by physics | K | 2 | real | kind_phys | out | F | -!! | gu0 | x_wind_updated_by_physics | zonal wind updated by physics | m s-1 | 2 | real | kind_phys | out | F | -!! | gv0 | y_wind_updated_by_physics | meridional wind updated by physics | m s-1 | 2 | real | kind_phys | out | F | -!! | gq0 | tracer_concentration_updated_by_physics | tracer concentration updated by physics | kg kg-1 | 3 | real | kind_phys | out | F | -!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | -!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | +!! \htmlinclude GFS_suite_stateout_update_run.html !! subroutine GFS_suite_stateout_update_run (im, levs, ntrac, dtp, & tgrs, ugrs, vgrs, qgrs, dudt, dvdt, dtdt, dqdt, & @@ -551,76 +457,36 @@ end subroutine GFS_suite_interstitial_3_finalize #if 0 !> \section arg_table_GFS_suite_interstitial_3_run Argument Table -!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | -!! |----------------------------|-----------------------------------------------------------------------------------------------|-------------------------------------------------------------------|---------------|------|------------|-----------|--------|----------| -!! | im | horizontal_loop_extent | horizontal loop extent | count | 0 | integer | | in | F | -!! | levs | vertical_dimension | vertical layer dimension | count | 0 | integer | | in | F | -!! | nn | number_of_tracers_for_convective_transport | number of tracers for convective transport | count | 0 | integer | | in | F | -!! | cscnv | flag_for_Chikira_Sugiyama_deep_convection | flag for Chikira-Sugiyama convection | flag | 0 | logical | | in | F | -!! | satmedmf | flag_for_scale_aware_TKE_moist_EDMF_PBL | flag for scale-aware TKE moist EDMF PBL scheme | flag | 0 | logical | | in | F | -!! | trans_trac | flag_for_convective_transport_of_tracers | flag for convective transport of tracers | flag | 0 | logical | | in | F | -!! | do_shoc | flag_for_shoc | flag for SHOC | flag | 0 | logical | | in | F | -!! | ltaerosol | flag_for_aerosol_physics | flag for aerosol physics | flag | 0 | logical | | in | F | -!! | ntrac | number_of_tracers | number of tracers | count | 0 | integer | | in | F | -!! | ntcw | index_for_liquid_cloud_condensate | tracer index for cloud condensate (or liquid water) | index | 0 | integer | | in | F | -!! | ntiw | index_for_ice_cloud_condensate | tracer index for ice water | index | 0 | integer | | in | F | -!! | ntclamt | index_for_cloud_amount | tracer index for cloud amount integer | index | 0 | integer | | in | F | -!! | ntrw | index_for_rain_water | tracer index for rain water | index | 0 | integer | | in | F | -!! | ntsw | index_for_snow_water | tracer index for snow water | index | 0 | integer | | in | F | -!! | ntrnc | index_for_rain_number_concentration | tracer index for rain number concentration | index | 0 | integer | | in | F | -!! | ntsnc | index_for_snow_number_concentration | tracer index for snow number concentration | index | 0 | integer | | in | F | -!! | ntgl | index_for_graupel | tracer index for graupel | index | 0 | integer | | in | F | -!! | ntgnc | index_for_graupel_number_concentration | tracer index for graupel number concentration | index | 0 | integer | | in | F | -!! | xlat | latitude | latitude | radians | 1 | real | kind_phys | in | F | -!! | gq0 | tracer_concentration_updated_by_physics | tracer concentration updated by physics | kg kg-1 | 3 | real | kind_phys | in | F | -!! | imp_physics | flag_for_microphysics_scheme | choice of microphysics scheme | flag | 0 | integer | | in | F | -!! | imp_physics_mg | flag_for_morrison_gettelman_microphysics_scheme | choice of Morrison-Gettelman rmicrophysics scheme | flag | 0 | integer | | in | F | -!! | imp_physics_zhao_carr | flag_for_zhao_carr_microphysics_scheme | choice of Zhao-Carr microphysics scheme | flag | 0 | integer | | in | F | -!! | imp_physics_zhao_carr_pdf | flag_for_zhao_carr_pdf_microphysics_scheme | choice of Zhao-Carr microphysics scheme with PDF clouds | flag | 0 | integer | | in | F | -!! | imp_physics_gfdl | flag_for_gfdl_microphysics_scheme | choice of GFDL microphysics scheme | flag | 0 | integer | | in | F | -!! | imp_physics_thompson | flag_for_thompson_microphysics_scheme | choice of Thompson microphysics scheme | flag | 0 | integer | | in | F | -!! | imp_physics_wsm6 | flag_for_wsm6_microphysics_scheme | choice of WSM6 microphysics scheme | flag | 0 | integer | | in | F | -!! | prsi | air_pressure_at_interface | air pressure at model layer interfaces | Pa | 2 | real | kind_phys | in | F | -!! | prsl | air_pressure | mean layer pressure | Pa | 2 | real | kind_phys | in | F | -!! | prslk | dimensionless_exner_function_at_model_layers | dimensionless Exner function at model layer centers | none | 2 | real | kind_phys | in | F | -!! | rhcbot | critical_relative_humidity_at_surface | critical relative humidity at the surface | frac | 0 | real | kind_phys | in | F | -!! | rhcpbl | critical_relative_humidity_at_PBL_top | critical relative humidity at the PBL top | frac | 0 | real | kind_phys | in | F | -!! | rhctop | critical_relative_humidity_at_top_of_atmosphere | critical relative humidity at the top of atmosphere | frac | 0 | real | kind_phys | in | F | -!! | rhcmax | maximum_critical_relative_humidity | maximum critical relative humidity | frac | 0 | real | kind_phys | in | F | -!! | islmsk | sea_land_ice_mask | sea/land/ice mask (=0/1/2) | flag | 1 | integer | | in | F | -!! | work1 | grid_size_related_coefficient_used_in_scale-sensitive_schemes | grid size related coefficient used in scale-sensitive schemes | none | 1 | real | kind_phys | in | F | -!! | work2 | grid_size_related_coefficient_used_in_scale-sensitive_schemes_complement | complement to work1 | none | 1 | real | kind_phys | in | F | -!! | kpbl | vertical_index_at_top_of_atmosphere_boundary_layer | vertical index at top atmospheric boundary layer | index | 1 | integer | | in | F | -!! | clw | convective_transportable_tracers | array to contain cloud water and other convective trans. tracers | kg kg-1 | 3 | real | kind_phys | inout | F | -!! | rhc | critical_relative_humidity | critical relative humidity | frac | 2 | real | kind_phys | inout | F | -!! | save_qc | cloud_condensed_water_mixing_ratio_save | moist (dry+vapor, no condensates) mixing ratio of cloud water (condensate) before entering a physics scheme | kg kg-1 | 2 | real | kind_phys | inout | F | -!! | save_qi | ice_water_mixing_ratio_save | cloud ice water mixing ratio before entering a physics scheme | kg kg-1 | 2 | real | kind_phys | inout | F | -!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | -!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | +!! \htmlinclude GFS_suite_interstitial_3_run.html !! #endif - subroutine GFS_suite_interstitial_3_run (im, levs, nn, cscnv, satmedmf, trans_trac, do_shoc, ltaerosol, ntrac, ntcw, & - ntiw, ntclamt, ntrw, ntsw, ntrnc, ntsnc, ntgl, ntgnc, xlat, gq0, imp_physics, imp_physics_mg, imp_physics_zhao_carr,& - imp_physics_zhao_carr_pdf, imp_physics_gfdl, imp_physics_thompson, imp_physics_wsm6, prsi, prsl, prslk, rhcbot, & - rhcpbl, rhctop, rhcmax, islmsk, work1, work2, kpbl, & - clw, rhc, save_qc, save_qi, errmsg, errflg) + subroutine GFS_suite_interstitial_3_run (im, levs, nn, cscnv, & + satmedmf, trans_trac, do_shoc, ltaerosol, ntrac, ntcw, & + ntiw, ntlnc, ntinc, ntclamt, ntrw, ntsw, ntrnc, ntsnc, & + ntgl, ntgnc, xlon, xlat, gq0, imp_physics, imp_physics_mg, & + imp_physics_zhao_carr, imp_physics_zhao_carr_pdf, & + imp_physics_gfdl, imp_physics_thompson, & + imp_physics_wsm6, imp_physics_fer_hires, prsi, & + prsl, prslk, rhcbot,rhcpbl, rhctop, rhcmax, islmsk, & + work1, work2, kpbl, kinver, ras, me, & + clw, rhc, save_qc, save_qi, errmsg, errflg) use machine, only: kind_phys implicit none ! interface variables - integer, intent(in) :: im, levs, nn, ntrac, ntcw, ntiw, ntclamt, ntrw, & - ntsw, ntrnc, ntsnc, ntgl, ntgnc, imp_physics, imp_physics_mg, imp_physics_zhao_carr, imp_physics_zhao_carr_pdf, & - imp_physics_gfdl, imp_physics_thompson, imp_physics_wsm6 - integer, dimension(im), intent(in) :: islmsk, kpbl - logical, intent(in) :: cscnv, satmedmf, trans_trac, do_shoc, ltaerosol + integer, intent(in) :: im, levs, nn, ntrac, ntcw, ntiw, ntlnc, ntinc, & + ntclamt, ntrw, ntsw, ntrnc, ntsnc, ntgl, ntgnc, imp_physics, imp_physics_mg, imp_physics_zhao_carr, & + imp_physics_zhao_carr_pdf, imp_physics_gfdl, imp_physics_thompson, imp_physics_wsm6,imp_physics_fer_hires, me + integer, dimension(im), intent(in) :: islmsk, kpbl, kinver + logical, intent(in) :: cscnv, satmedmf, trans_trac, do_shoc, ltaerosol, ras real(kind=kind_phys), intent(in) :: rhcbot, rhcmax, rhcpbl, rhctop real(kind=kind_phys), dimension(im), intent(in) :: work1, work2 real(kind=kind_phys), dimension(im, levs), intent(in) :: prsl, prslk real(kind=kind_phys), dimension(im, levs+1), intent(in) :: prsi - real(kind=kind_phys), dimension(im), intent(in) :: xlat + real(kind=kind_phys), dimension(im), intent(in) :: xlon, xlat real(kind=kind_phys), dimension(im, levs, ntrac), intent(in) :: gq0 real(kind=kind_phys), dimension(im, levs), intent(inout) :: rhc, save_qc @@ -629,52 +495,57 @@ subroutine GFS_suite_interstitial_3_run (im, levs, nn, cscnv, satmedmf, trans_tr real(kind=kind_phys), dimension(im, levs, nn), intent(inout) :: clw character(len=*), intent(out) :: errmsg - integer, intent(out) :: errflg + integer, intent(out) :: errflg ! local variables integer :: i,k,n,tracers,kk real(kind=kind_phys) :: tem, tem1, tem2 - real(kind=kind_phys), dimension(im) :: tx1, tx2 + real(kind=kind_phys), dimension(im) :: tx1, tx2, tx3, tx4 - real(kind=kind_phys),parameter :: slope_mg = 0.02, slope_upmg = 0.04, & - turnrhcrit = 0.900, turnrhcrit_upper = 0.150 + !real(kind=kind_phys),parameter :: slope_mg = 0.02, slope_upmg = 0.04, & + ! turnrhcrit = 0.900, turnrhcrit_upper = 0.150 + ! in the following inverse of slope_mg and slope_upmg are specified + real(kind=kind_phys),parameter :: slope_mg = 50.0_kind_phys, & + slope_upmg = 25.0_kind_phys ! Initialize CCPP error handling variables errmsg = '' errflg = 0 - !GF* The following section (initializing convective variables) is already executed in GFS_typedefs%interstitial_phys_reset - ! do k=1,levs - ! do i=1,im - ! clw(i,k,1) = 0.0 - ! clw(i,k,2) = -999.9 - ! enddo - ! enddo - ! if (Model%imfdeepcnv >= 0 .or. Model%imfshalcnv > 0 .or. & - ! (Model%npdf3d == 3 .and. Model%num_p3d == 4) .or. & - ! (Model%npdf3d == 0 .and. Model%ncnvcld3d == 1) ) then - ! do k=1,levs - ! do i=1,im - ! cnvc(i,k) = 0.0 - ! cnvw(i,k) = 0.0 - ! enddo - ! enddo - ! endif - ! if(imp_physics == 8) then - ! if(Model%ltaerosol) then - ! ice00 (:,:) = 0.0 - ! liq0 (:,:) = 0.0 - ! else - ! ice00 (:,:) = 0.0 - ! endif - ! endif - !*GF - - if (cscnv .or. satmedmf .or. trans_trac ) then +! +!GF* The following section (initializing convective variables) is already executed in GFS_typedefs%interstitial_phys_reset +! do k=1,levs +! do i=1,im +! clw(i,k,1) = 0.0 +! clw(i,k,2) = -999.9 +! enddo +! enddo +! if (Model%imfdeepcnv >= 0 .or. Model%imfshalcnv > 0 .or. & +! (Model%npdf3d == 3 .and. Model%num_p3d == 4) .or. & +! (Model%npdf3d == 0 .and. Model%ncnvcld3d == 1) ) then +! do k=1,levs +! do i=1,im +! cnvc(i,k) = 0.0 +! cnvw(i,k) = 0.0 +! enddo +! enddo +! endif +! if(imp_physics == Model%imp_physics_thompson) then +! if(Model%ltaerosol) then +! ice00 (:,:) = 0.0 +! liq0 (:,:) = 0.0 +! else +! ice00 (:,:) = 0.0 +! endif +! endif +!*GF + + if (cscnv .or. satmedmf .or. trans_trac .or. ras) then tracers = 2 do n=2,ntrac if ( n /= ntcw .and. n /= ntiw .and. n /= ntclamt .and. & n /= ntrw .and. n /= ntsw .and. n /= ntrnc .and. & +! n /= ntlnc .and. n /= ntinc .and. & n /= ntsnc .and. n /= ntgl .and. n /= ntgnc) then tracers = tracers + 1 do k=1,levs @@ -687,17 +558,22 @@ subroutine GFS_suite_interstitial_3_run (im, levs, nn, cscnv, satmedmf, trans_tr endif ! end if_ras or cfscnv or samf if (ntcw > 0) then - if (imp_physics == imp_physics_mg) then ! compute rhc for GMAO macro physics cloud pdf + if (imp_physics == imp_physics_mg .and. rhcpbl < 0.5) then ! compute rhc for GMAO macro physics cloud pdf do i=1,im tx1(i) = 1.0 / prsi(i,1) - tx2(i) = 1.0 - rhcmax * work1(i)-rhcbot*work2(i) + tx2(i) = 1.0 - rhcmax*work1(i)-rhcbot*work2(i) + + kk = min(kinver(i), max(2,kpbl(i))) + tx3(i) = prsi(i,kk)*tx1(i) + tx4(i) = rhcpbl - rhctop*abs(cos(xlat(i))) enddo do k = 1, levs do i = 1, im - kk = max(2,kpbl(i)) tem = prsl(i,k) * tx1(i) - tem1 = min(max((tem-prsi(i,kk)*tx1(i))/slope_mg, -20.0), 20.0) - tem2 = min(max((0.3-0.2*abs(cos(xlat(i)))-tem)/slope_upmg, -20.0), 20.0) ! Anning + tem1 = min(max((tem-tx3(i))*slope_mg, -20.0), 20.0) + ! Using rhcpbl and rhctop from the namelist instead of 0.3 and 0.2 + ! and rhcbot represents pbl top critical relative humidity + tem2 = min(max((tx4(i)-tem)*slope_upmg, -20.0), 20.0) ! Anning if (islmsk(i) > 0) then tem1 = 1.0 / (1.0+exp(tem1+tem1)) else @@ -706,7 +582,6 @@ subroutine GFS_suite_interstitial_3_run (im, levs, nn, cscnv, satmedmf, trans_tr tem2 = 1.0 / (1.0+exp(tem2)) rhc(i,k) = min(rhcmax, max(0.7, 1.0-tx2(i)*tem1*tem2)) -! rhc(i,k) = min(rhcmax, rhcmax*work1(i) + (1.0-tx2(i)*tem1*tem2)*work2(i)) enddo enddo else @@ -714,11 +589,9 @@ subroutine GFS_suite_interstitial_3_run (im, levs, nn, cscnv, satmedmf, trans_tr do i=1,im kk = max(10,kpbl(i)) if (k < kk) then - tem = rhcbot - (rhcbot-rhcpbl) * (1.0-prslk(i,k)) & - / (1.0-prslk(i,kk)) + tem = rhcbot - (rhcbot-rhcpbl) * (1.0-prslk(i,k)) / (1.0-prslk(i,kk)) else - tem = rhcpbl - (rhcpbl-rhctop) * (prslk(i,kk)-prslk(i,k)) & - / prslk(i,kk) + tem = rhcpbl - (rhcpbl-rhctop) * (prslk(i,kk)-prslk(i,k)) / prslk(i,kk) endif tem = rhcmax * work1(i) + tem * work2(i) rhc(i,k) = max(0.0, min(1.0,tem)) @@ -750,11 +623,11 @@ subroutine GFS_suite_interstitial_3_run (im, levs, nn, cscnv, satmedmf, trans_tr enddo if(ltaerosol) then save_qi(:,:) = clw(:,:,1) - save_qc(:,:) = clw(:,:,2) + save_qc(:,:) = clw(:,:,2) else save_qi(:,:) = clw(:,:,1) endif - elseif (imp_physics == imp_physics_wsm6 .or. imp_physics == imp_physics_mg) then + elseif (imp_physics == imp_physics_wsm6 .or. imp_physics == imp_physics_mg .or. imp_physics == imp_physics_fer_hires) then do k=1,levs do i=1,im clw(i,k,1) = gq0(i,k,ntiw) ! ice @@ -786,45 +659,12 @@ subroutine GFS_suite_interstitial_4_finalize() end subroutine GFS_suite_interstitial_4_finalize !> \section arg_table_GFS_suite_interstitial_4_run Argument Table -!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | -!! |----------------------------|-------------------------------------------------------------------------------|-------------------------------------------------------------------|---------------|------|------------------|-----------|--------|----------| -!! | im | horizontal_loop_extent | horizontal loop extent | count | 0 | integer | | in | F | -!! | levs | vertical_dimension | vertical layer dimension | count | 0 | integer | | in | F | -!! | ltaerosol | flag_for_aerosol_physics | flag for aerosol physics | flag | 0 | logical | | in | F | -!! | lgocart | flag_gocart | flag for 3d diagnostic fields for gocart 1 | flag | 0 | logical | | in | F | -!! | tracers_total | number_of_total_tracers | total number of tracers | count | 0 | integer | | in | F | -!! | ntrac | number_of_tracers | number of tracers | count | 0 | integer | | in | F | -!! | ntcw | index_for_liquid_cloud_condensate | tracer index for cloud condensate (or liquid water) | index | 0 | integer | | in | F | -!! | ntiw | index_for_ice_cloud_condensate | tracer index for ice water | index | 0 | integer | | in | F | -!! | ntclamt | index_for_cloud_amount | tracer index for cloud amount integer | index | 0 | integer | | in | F | -!! | ntrw | index_for_rain_water | tracer index for rain water | index | 0 | integer | | in | F | -!! | ntsw | index_for_snow_water | tracer index for snow water | index | 0 | integer | | in | F | -!! | ntrnc | index_for_rain_number_concentration | tracer index for rain number concentration | index | 0 | integer | | in | F | -!! | ntsnc | index_for_snow_number_concentration | tracer index for snow number concentration | index | 0 | integer | | in | F | -!! | ntgl | index_for_graupel | tracer index for graupel | index | 0 | integer | | in | F | -!! | ntgnc | index_for_graupel_number_concentration | tracer index for graupel number concentration | index | 0 | integer | | in | F | -!! | ntlnc | index_for_liquid_cloud_number_concentration | tracer index for liquid number concentration | index | 0 | integer | | in | F | -!! | ntinc | index_for_ice_cloud_number_concentration | tracer index for ice number concentration | index | 0 | integer | | in | F | -!! | nn | number_of_tracers_for_convective_transport | number of tracers for convective transport | count | 0 | integer | | in | F | -!! | imp_physics | flag_for_microphysics_scheme | choice of microphysics scheme | flag | 0 | integer | | in | F | -!! | imp_physics_gfdl | flag_for_gfdl_microphysics_scheme | choice of GFDL microphysics scheme | flag | 0 | integer | | in | F | -!! | imp_physics_thompson | flag_for_thompson_microphysics_scheme | choice of Thompson microphysics scheme | flag | 0 | integer | | in | F | -!! | imp_physics_zhao_carr | flag_for_zhao_carr_microphysics_scheme | choice of Zhao-Carr microphysics scheme | flag | 0 | integer | | in | F | -!! | imp_physics_zhao_carr_pdf | flag_for_zhao_carr_pdf_microphysics_scheme | choice of Zhao-Carr microphysics scheme with PDF clouds | flag | 0 | integer | | in | F | -!! | dtf | time_step_for_dynamics | dynamics timestep | s | 0 | real | kind_phys | in | F | -!! | save_qc | cloud_condensed_water_mixing_ratio_save | moist (dry+vapor, no condensates) mixing ratio of cloud water (condensate) before entering a physics scheme | kg kg-1 | 2 | real | kind_phys | in | F | -!! | save_qi | ice_water_mixing_ratio_save | cloud ice water mixing ratio before entering a physics scheme | kg kg-1 | 2 | real | kind_phys | in | F | -!! | con_pi | pi | ratio of a circle's circumference to its diameter | radians | 0 | real | kind_phys | in | F | -!! | gq0 | tracer_concentration_updated_by_physics | tracer concentration updated by physics | kg kg-1 | 3 | real | kind_phys | inout | F | -!! | clw | convective_transportable_tracers | array to contain cloud water and other convective trans. tracers | kg kg-1 | 3 | real | kind_phys | inout | F | -!! | dqdti | instantaneous_water_vapor_specific_humidity_tendency_due_to_convection | instantaneous moisture tendency due to convection | kg kg-1 s-1 | 2 | real | kind_phys | inout | F | -!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | -!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | +!! \htmlinclude GFS_suite_interstitial_4_run.html !! - subroutine GFS_suite_interstitial_4_run (im, levs, ltaerosol, lgocart, tracers_total, ntrac, ntcw, ntiw, ntclamt, & - ntrw, ntsw, ntrnc, ntsnc, ntgl, ntgnc, ntlnc, ntinc, nn, imp_physics, imp_physics_gfdl, imp_physics_thompson, & - imp_physics_zhao_carr, imp_physics_zhao_carr_pdf, dtf, save_qc, save_qi, con_pi, & - gq0, clw, dqdti, errmsg, errflg) + subroutine GFS_suite_interstitial_4_run (im, levs, ltaerosol, cplchm, tracers_total, ntrac, ntcw, ntiw, ntclamt, & + ntrw, ntsw, ntrnc, ntsnc, ntgl, ntgnc, ntlnc, ntinc, nn, imp_physics, imp_physics_gfdl, imp_physics_thompson, & + imp_physics_zhao_carr, imp_physics_zhao_carr_pdf, dtf, save_qc, save_qi, con_pi, & + gq0, clw, gt0, dqdti, imfdeepcnv, imfdeepcnv_gf, errmsg, errflg) use machine, only: kind_phys @@ -834,18 +674,20 @@ subroutine GFS_suite_interstitial_4_run (im, levs, ltaerosol, lgocart, tracers_t integer, intent(in) :: im, levs, tracers_total, ntrac, ntcw, ntiw, ntclamt, ntrw, & ntsw, ntrnc, ntsnc, ntgl, ntgnc, ntlnc, ntinc, nn, imp_physics, imp_physics_gfdl, imp_physics_thompson, & - imp_physics_zhao_carr, imp_physics_zhao_carr_pdf + imp_physics_zhao_carr, imp_physics_zhao_carr_pdf, imfdeepcnv, imfdeepcnv_gf - logical, intent(in) :: ltaerosol, lgocart + logical, intent(in) :: ltaerosol, cplchm real(kind=kind_phys), intent(in) :: con_pi, dtf - real(kind=kind_phys), dimension(im,levs), intent(in) :: save_qc + real(kind=kind_phys), dimension(im,levs), intent(in) :: save_qc, gt0 ! save_qi is not allocated for Zhao-Carr MP real(kind=kind_phys), dimension(:, :), intent(in) :: save_qi real(kind=kind_phys), dimension(im,levs,ntrac), intent(inout) :: gq0 real(kind=kind_phys), dimension(im,levs,nn), intent(inout) :: clw - real(kind=kind_phys), dimension(im,levs), intent(inout) :: dqdti + ! dqdti may not be allocated + real(kind=kind_phys), dimension(:,:), intent(inout) :: dqdti + character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -871,6 +713,7 @@ subroutine GFS_suite_interstitial_4_run (im, levs, ltaerosol, lgocart, tracers_t ! if ( n /= ntcw .and. n /= ntiw .and. n /= ntclamt) then if ( n /= ntcw .and. n /= ntiw .and. n /= ntclamt .and. & n /= ntrw .and. n /= ntsw .and. n /= ntrnc .and. & +! n /= ntlnc .and. n /= ntinc .and. & n /= ntsnc .and. n /= ntgl .and. n /= ntgnc ) then tracers = tracers + 1 do k=1,levs @@ -885,8 +728,9 @@ subroutine GFS_suite_interstitial_4_run (im, levs, ltaerosol, lgocart, tracers_t if (ntcw > 0) then ! for microphysics - if (imp_physics == imp_physics_zhao_carr_pdf .or. imp_physics == imp_physics_zhao_carr & - .or. imp_physics == imp_physics_gfdl) then + if (imp_physics == imp_physics_zhao_carr .or. & + imp_physics == imp_physics_zhao_carr_pdf .or. & + imp_physics == imp_physics_gfdl) then gq0(1:im,:,ntcw) = clw(1:im,:,1) + clw(1:im,:,2) elseif (ntiw > 0) then do k=1,levs @@ -895,25 +739,27 @@ subroutine GFS_suite_interstitial_4_run (im, levs, ltaerosol, lgocart, tracers_t gq0(i,k,ntcw) = clw(i,k,2) ! water enddo enddo - if (imp_physics == imp_physics_thompson) then +! if (imp_physics == imp_physics_thompson) then + if (imp_physics == imp_physics_thompson .and. imfdeepcnv /= imfdeepcnv_gf) then if (ltaerosol) then do k=1,levs do i=1,im gq0(i,k,ntlnc) = gq0(i,k,ntlnc) & - + max(0.0, (clw(i,k,2)-save_qc(i,k))) / liqm + + max(0.0, (clw(i,k,2)-save_qc(i,k))) / liqm gq0(i,k,ntinc) = gq0(i,k,ntinc) & - + max(0.0, (clw(i,k,1)-save_qi(i,k))) / icem + + max(0.0, (clw(i,k,1)-save_qi(i,k))) / icem enddo enddo else do k=1,levs do i=1,im gq0(i,k,ntinc) = gq0(i,k,ntinc) & - + max(0.0, (clw(i,k,1)-save_qi(i,k))) / icem + + max(0.0, (clw(i,k,1)-save_qi(i,k))) / icem enddo enddo endif endif + else do k=1,levs do i=1,im @@ -930,7 +776,7 @@ subroutine GFS_suite_interstitial_4_run (im, levs, ltaerosol, lgocart, tracers_t endif ! end if_ntcw ! dqdt_v : instaneous moisture tendency (kg/kg/sec) - if (lgocart) then + if (cplchm) then do k=1,levs do i=1,im dqdti(i,k) = dqdti(i,k) * (1.0 / dtf) @@ -941,3 +787,53 @@ subroutine GFS_suite_interstitial_4_run (im, levs, ltaerosol, lgocart, tracers_t end subroutine GFS_suite_interstitial_4_run end module GFS_suite_interstitial_4 + + module GFS_suite_interstitial_5 + + contains + + subroutine GFS_suite_interstitial_5_init () + end subroutine GFS_suite_interstitial_5_init + + subroutine GFS_suite_interstitial_5_finalize() + end subroutine GFS_suite_interstitial_5_finalize + +#if 0 +!> \section arg_table_GFS_suite_interstitial_5_run Argument Table +!! \htmlinclude GFS_suite_interstitial_5_run.html +!! +#endif + subroutine GFS_suite_interstitial_5_run (im, levs, ntrac, ntcw, ntiw, nn, gq0, clw, errmsg, errflg) + + use machine, only: kind_phys + + implicit none + + ! interface variables + integer, intent(in) :: im, levs, ntrac, ntcw, ntiw, nn + + real(kind=kind_phys), dimension(im, levs, ntrac), intent(in) :: gq0 + + real(kind=kind_phys), dimension(im, levs, nn), intent(out) :: clw + + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! local variables + integer :: i,k + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + do k=1,levs + do i=1,im + clw(i,k,1) = gq0(i,k,ntiw) ! ice + clw(i,k,2) = gq0(i,k,ntcw) ! water + enddo + enddo + + end subroutine GFS_suite_interstitial_5_run + + end module GFS_suite_interstitial_5 + diff --git a/physics/GFS_suite_interstitial.meta b/physics/GFS_suite_interstitial.meta new file mode 100644 index 000000000..9cda625ab --- /dev/null +++ b/physics/GFS_suite_interstitial.meta @@ -0,0 +1,1874 @@ +[ccpp-arg-table] + name = GFS_suite_interstitial_rad_reset_run + type = scheme +[Interstitial] + standard_name = GFS_interstitial_type_instance + long_name = derived type GFS_interstitial_type in FV3 + units = DDT + dimensions = () + type = GFS_interstitial_type + intent = inout + optional = F +[Model] + standard_name = GFS_control_type_instance + long_name = Fortran DDT containing FV3-GFS model control parameters + units = DDT + dimensions = () + type = GFS_control_type + intent = in + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F + +######################################################################## +[ccpp-arg-table] + name = GFS_suite_interstitial_phys_reset_run + type = scheme +[Interstitial] + standard_name = GFS_interstitial_type_instance + long_name = derived type GFS_interstitial_type in FV3 + units = DDT + dimensions = () + type = GFS_interstitial_type + intent = inout + optional = F +[Model] + standard_name = GFS_control_type_instance + long_name = Fortran DDT containing FV3-GFS model control parameters + units = DDT + dimensions = () + type = GFS_control_type + intent = in + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F + +######################################################################## +[ccpp-arg-table] + name = GFS_suite_interstitial_1_run + type = scheme +[im] + standard_name = horizontal_loop_extent + long_name = horizontal loop extent + units = count + dimensions = () + type = integer + intent = in + optional = F +[levs] + standard_name = vertical_dimension + long_name = vertical layer dimension + units = count + dimensions = () + type = integer + intent = in + optional = F +[ntrac] + standard_name = number_of_tracers + long_name = number of tracers + units = count + dimensions = () + type = integer + intent = in + optional = F +[dtf] + standard_name = time_step_for_dynamics + long_name = dynamics timestep + units = s + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[dtp] + standard_name = time_step_for_physics + long_name = physics timestep + units = s + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[slmsk] + standard_name = sea_land_ice_mask_real + long_name = landmask: sea/land/ice=0/1/2 + units = flag + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[area] + standard_name = cell_area + long_name = area of the grid cell + units = m2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[dxmin] + standard_name = minimum_scaling_factor_for_critical_relative_humidity + long_name = minimum scaling factor for critical relative humidity + units = m2 rad-2 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[dxinv] + standard_name = inverse_scaling_factor_for_critical_relative_humidity + long_name = inverse scaling factor for critical relative humidity + units = rad2 m-2 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[pgr] + standard_name = surface_air_pressure + long_name = surface pressure + units = Pa + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[islmsk] + standard_name = sea_land_ice_mask + long_name = landmask: sea/land/ice=0/1/2 + units = flag + dimensions = (horizontal_dimension) + type = integer + intent = out + optional = F +[work1] + standard_name = grid_size_related_coefficient_used_in_scale_sensitive_schemes + long_name = grid size related coefficient used in scale-sensitive schemes + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[work2] + standard_name = grid_size_related_coefficient_used_in_scale_sensitive_schemes_complement + long_name = complement to work1 + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[psurf] + standard_name = surface_air_pressure_diag + long_name = surface air pressure diagnostic + units = Pa + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[dudt] + standard_name = tendency_of_x_wind_due_to_model_physics + long_name = updated tendency of the x wind + units = m s-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[dvdt] + standard_name = tendency_of_y_wind_due_to_model_physics + long_name = updated tendency of the y wind + units = m s-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[dtdt] + standard_name = tendency_of_air_temperature_due_to_model_physics + long_name = updated tendency of the temperature + units = K s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[dtdtc] + standard_name = tendency_of_air_temperature_due_to_radiative_heating_assuming_clear_sky + long_name = clear sky radiative (shortwave + longwave) heating rate at current time + units = K s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[dqdt] + standard_name = tendency_of_tracers_due_to_model_physics + long_name = updated tendency of the tracers + units = kg kg-1 s-1 + dimensions = (horizontal_dimension,vertical_dimension,number_of_tracers) + type = real + kind = kind_phys + intent = out + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F + +######################################################################## +[ccpp-arg-table] + name = GFS_suite_interstitial_2_run + type = scheme +[im] + standard_name = horizontal_loop_extent + long_name = horizontal loop extent + units = count + dimensions = () + type = integer + intent = in + optional = F +[levs] + standard_name = vertical_dimension + long_name = vertical layer dimension + units = count + dimensions = () + type = integer + intent = in + optional = F +[lssav] + standard_name = flag_diagnostics + long_name = logical flag for storing diagnostics + units = flag + dimensions = () + type = logical + intent = in + optional = F +[ldiag3d] + standard_name = flag_diagnostics_3D + long_name = flag for 3d diagnostic fields + units = flag + dimensions = () + type = logical + intent = in + optional = F +[lsidea] + standard_name = flag_idealized_physics + long_name = flag for idealized physics + units = flag + dimensions = () + type = logical + intent = in + optional = F +[cplflx] + standard_name = flag_for_flux_coupling + long_name = flag controlling cplflx collection (default off) + units = flag + dimensions = () + type = logical + intent = in + optional = F +[flag_cice] + standard_name = flag_for_cice + long_name = flag for cice + units = flag + dimensions = (horizontal_dimension) + type = logical + intent = in + optional = F +[shal_cnv] + standard_name = flag_for_shallow_convection + long_name = flag for calling shallow convection + units = flag + dimensions = () + type = logical + intent = in + optional = F +[old_monin] + standard_name = flag_for_old_PBL_scheme + long_name = flag for using old PBL schemes + units = flag + dimensions = () + type = logical + intent = in + optional = F +[mstrat] + standard_name = flag_for_moorthi_stratus + long_name = flag for moorthi approach for stratus + units = flag + dimensions = () + type = logical + intent = in + optional = F +[do_shoc] + standard_name = flag_for_shoc + long_name = flag for SHOC + units = flag + dimensions = () + type = logical + intent = in + optional = F +[frac_grid] + standard_name = flag_for_fractional_grid + long_name = flag for fractional grid + units = flag + dimensions = () + type = logical + intent = in + optional = F +[imfshalcnv] + standard_name = flag_for_mass_flux_shallow_convection_scheme + long_name = flag for mass-flux shallow convection scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F +[dtf] + standard_name = time_step_for_dynamics + long_name = dynamics timestep + units = s + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[xcosz] + standard_name = instantaneous_cosine_of_zenith_angle + long_name = cosine of zenith angle at current time + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[adjsfcdsw] + standard_name = surface_downwelling_shortwave_flux + long_name = surface downwelling shortwave flux at current time + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[adjsfcdlw] + standard_name = surface_downwelling_longwave_flux + long_name = surface downwelling longwave flux at current time + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[cice] + standard_name = sea_ice_concentration + long_name = ice fraction over open water + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[pgr] + standard_name = surface_air_pressure + long_name = surface pressure + units = Pa + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[ulwsfc_cice] + standard_name = surface_upwelling_longwave_flux_for_coupling + long_name = surface upwelling longwave flux for coupling + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[lwhd] + standard_name = tendency_of_air_temperature_due_to_longwave_heating_for_idea + long_name = idea sky lw heating rates + units = K s-1 + dimensions = (horizontal_dimension,vertical_dimension,6) + type = real + kind = kind_phys + intent = in + optional = F +[htrsw] + standard_name = tendency_of_air_temperature_due_to_shortwave_heating_on_radiation_timestep + long_name = total sky sw heating rate + units = K s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[htrlw] + standard_name = tendency_of_air_temperature_due_to_longwave_heating_on_radiation_timestep + long_name = total sky lw heating rate + units = K s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[xmu] + standard_name = zenith_angle_temporal_adjustment_factor_for_shortwave_fluxes + long_name = zenith angle temporal adjustment factor for shortwave fluxes + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[ctei_rm] + standard_name = critical_cloud_top_entrainment_instability_criteria + long_name = critical cloud top entrainment instability criteria + units = none + dimensions = (2) + type = real + kind = kind_phys + intent = in + optional = F +[work1] + standard_name = grid_size_related_coefficient_used_in_scale_sensitive_schemes + long_name = grid size related coefficient used in scale-sensitive schemes + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[work2] + standard_name = grid_size_related_coefficient_used_in_scale_sensitive_schemes_complement + long_name = complement to work1 + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[prsi] + standard_name = air_pressure_at_interface + long_name = air pressure at model layer interfaces + units = Pa + dimensions = (horizontal_dimension,vertical_dimension_plus_one) + type = real + kind = kind_phys + intent = in + optional = F +[tgrs] + standard_name = air_temperature + long_name = model layer mean temperature + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[prsl] + standard_name = air_pressure + long_name = mean layer pressure + units = Pa + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[qgrs_water_vapor] + standard_name = water_vapor_specific_humidity + long_name = water vapor specific humidity + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[qgrs_cloud_water] + standard_name = cloud_condensed_water_mixing_ratio + long_name = ratio of mass of cloud water to mass of dry air plus vapor (without condensates) + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[cp] + standard_name = specific_heat_of_dry_air_at_constant_pressure + long_name = specific heat of dry air at constant pressure + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[hvap] + standard_name = latent_heat_of_vaporization_of_water_at_0C + long_name = latent heat of evaporation/sublimation + units = J kg-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[prslk] + standard_name = dimensionless_exner_function_at_model_layers + long_name = dimensionless Exner function at model layer centers + units = none + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[suntim] + standard_name = duration_of_sunshine + long_name = sunshine duration time + units = s + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[adjsfculw] + standard_name = surface_upwelling_longwave_flux + long_name = surface upwelling longwave flux at current time + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[adjsfculw_lnd] + standard_name = surface_upwelling_longwave_flux_over_land_interstitial + long_name = surface upwelling longwave flux at current time over land (temporary use as interstitial) + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[adjsfculw_ice] + standard_name = surface_upwelling_longwave_flux_over_ice_interstitial + long_name = surface upwelling longwave flux at current time over ice (temporary use as interstitial) + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[adjsfculw_ocn] + standard_name = surface_upwelling_longwave_flux_over_ocean_interstitial + long_name = surface upwelling longwave flux at current time over ocean (temporary use as interstitial) + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[dlwsfc] + standard_name = cumulative_surface_downwelling_longwave_flux_multiplied_by_timestep + long_name = cumulative surface downwelling LW flux multiplied by timestep + units = W m-2 s + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[ulwsfc] + standard_name = cumulative_surface_upwelling_longwave_flux_multiplied_by_timestep + long_name = cumulative surface upwelling LW flux multiplied by timestep + units = W m-2 s + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[psmean] + standard_name = cumulative_surface_pressure_multiplied_by_timestep + long_name = cumulative surface pressure multiplied by timestep + units = Pa s + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[dt3dt_lw] + standard_name = cumulative_change_in_temperature_due_to_longwave_radiation + long_name = cumulative change in temperature due to longwave radiation + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[dt3dt_sw] + standard_name = cumulative_change_in_temperature_due_to_shortwave_radiation + long_name = cumulative change in temperature due to shortwave radiation + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[dt3dt_pbl] + standard_name = cumulative_change_in_temperature_due_to_PBL + long_name = cumulative change in temperature due to PBL + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[dt3dt_dcnv] + standard_name = cumulative_change_in_temperature_due_to_deep_convection + long_name = cumulative change in temperature due to deep conv. + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[dt3dt_scnv] + standard_name = cumulative_change_in_temperature_due_to_shal_convection + long_name = cumulative change in temperature due to shal conv. + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[dt3dt_mp] + standard_name = cumulative_change_in_temperature_due_to_microphysics + long_name = cumulative change in temperature due to microphysics + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[ctei_rml] + standard_name = grid_sensitive_critical_cloud_top_entrainment_instability_criteria + long_name = grid sensitive critical cloud top entrainment instability criteria + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[ctei_r] + standard_name = cloud_top_entrainment_instability_value + long_name = cloud top entrainment instability value + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[kinver] + standard_name = index_of_highest_temperature_inversion + long_name = index of highest temperature inversion + units = index + dimensions = (horizontal_dimension) + type = integer + intent = inout + optional = F +[dry] + standard_name = flag_nonzero_land_surface_fraction + long_name = flag indicating presence of some land surface area fraction + units = flag + dimensions = (horizontal_dimension) + type = logical + intent = in + optional = F +[icy] + standard_name = flag_nonzero_sea_ice_surface_fraction + long_name = flag indicating presence of some sea ice surface area fraction + units = flag + dimensions = (horizontal_dimension) + type = logical + intent = in + optional = F +[wet] + standard_name = flag_nonzero_wet_surface_fraction + long_name = flag indicating presence of some ocean or lake surface area fraction + units = flag + dimensions = (horizontal_dimension) + type = logical + intent = in + optional = F +[frland] + standard_name = land_area_fraction_for_microphysics + long_name = land area fraction used in microphysics schemes + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[huge] + standard_name = netcdf_float_fillvalue + long_name = definition of NetCDF float FillValue + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F + +######################################################################## +[ccpp-arg-table] + name = GFS_suite_stateout_reset_run + type = scheme +[im] + standard_name = horizontal_loop_extent + long_name = horizontal loop extent + units = count + dimensions = () + type = integer + intent = in + optional = F +[levs] + standard_name = vertical_dimension + long_name = vertical layer dimension + units = count + dimensions = () + type = integer + intent = in + optional = F +[ntrac] + standard_name = number_of_tracers + long_name = number of tracers + units = count + dimensions = () + type = integer + intent = in + optional = F +[tgrs] + standard_name = air_temperature + long_name = model layer mean temperature + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[ugrs] + standard_name = x_wind + long_name = zonal wind + units = m s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[vgrs] + standard_name = y_wind + long_name = meridional wind + units = m s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[qgrs] + standard_name = tracer_concentration + long_name = model layer mean tracer concentration + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension,number_of_tracers) + type = real + kind = kind_phys + intent = in + optional = F +[gt0] + standard_name = air_temperature_updated_by_physics + long_name = temperature updated by physics + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[gu0] + standard_name = x_wind_updated_by_physics + long_name = zonal wind updated by physics + units = m s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[gv0] + standard_name = y_wind_updated_by_physics + long_name = meridional wind updated by physics + units = m s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[gq0] + standard_name = tracer_concentration_updated_by_physics + long_name = tracer concentration updated by physics + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension,number_of_tracers) + type = real + kind = kind_phys + intent = out + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F + +######################################################################## +[ccpp-arg-table] + name = GFS_suite_stateout_update_run + type = scheme +[im] + standard_name = horizontal_loop_extent + long_name = horizontal loop extent + units = count + dimensions = () + type = integer + intent = in + optional = F +[levs] + standard_name = vertical_dimension + long_name = vertical layer dimension + units = count + dimensions = () + type = integer + intent = in + optional = F +[ntrac] + standard_name = number_of_tracers + long_name = number of tracers + units = count + dimensions = () + type = integer + intent = in + optional = F +[dtp] + standard_name = time_step_for_physics + long_name = physics timestep + units = s + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[tgrs] + standard_name = air_temperature + long_name = model layer mean temperature + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[ugrs] + standard_name = x_wind + long_name = zonal wind + units = m s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[vgrs] + standard_name = y_wind + long_name = meridional wind + units = m s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[qgrs] + standard_name = tracer_concentration + long_name = model layer mean tracer concentration + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension,number_of_tracers) + type = real + kind = kind_phys + intent = in + optional = F +[dudt] + standard_name = tendency_of_x_wind_due_to_model_physics + long_name = updated tendency of the x wind + units = m s-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[dvdt] + standard_name = tendency_of_y_wind_due_to_model_physics + long_name = updated tendency of the y wind + units = m s-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[dtdt] + standard_name = tendency_of_air_temperature_due_to_model_physics + long_name = updated tendency of the temperature + units = K s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[dqdt] + standard_name = tendency_of_tracers_due_to_model_physics + long_name = updated tendency of the tracers + units = kg kg-1 s-1 + dimensions = (horizontal_dimension,vertical_dimension,number_of_tracers) + type = real + kind = kind_phys + intent = in + optional = F +[gt0] + standard_name = air_temperature_updated_by_physics + long_name = temperature updated by physics + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[gu0] + standard_name = x_wind_updated_by_physics + long_name = zonal wind updated by physics + units = m s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[gv0] + standard_name = y_wind_updated_by_physics + long_name = meridional wind updated by physics + units = m s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[gq0] + standard_name = tracer_concentration_updated_by_physics + long_name = tracer concentration updated by physics + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension,number_of_tracers) + type = real + kind = kind_phys + intent = out + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F + +######################################################################## +[ccpp-arg-table] + name = GFS_suite_interstitial_3_run + type = scheme +[im] + standard_name = horizontal_loop_extent + long_name = horizontal loop extent + units = count + dimensions = () + type = integer + intent = in + optional = F +[levs] + standard_name = vertical_dimension + long_name = vertical layer dimension + units = count + dimensions = () + type = integer + intent = in + optional = F +[nn] + standard_name = number_of_tracers_for_convective_transport + long_name = number of tracers for convective transport + units = count + dimensions = () + type = integer + intent = in + optional = F +[cscnv] + standard_name = flag_for_Chikira_Sugiyama_deep_convection + long_name = flag for Chikira-Sugiyama convection + units = flag + dimensions = () + type = logical + intent = in + optional = F +[satmedmf] + standard_name = flag_for_scale_aware_TKE_moist_EDMF_PBL + long_name = flag for scale-aware TKE moist EDMF PBL scheme + units = flag + dimensions = () + type = logical + intent = in + optional = F +[trans_trac] + standard_name = flag_for_convective_transport_of_tracers + long_name = flag for convective transport of tracers + units = flag + dimensions = () + type = logical + intent = in + optional = F +[do_shoc] + standard_name = flag_for_shoc + long_name = flag for SHOC + units = flag + dimensions = () + type = logical + intent = in + optional = F +[ltaerosol] + standard_name = flag_for_aerosol_physics + long_name = flag for aerosol physics + units = flag + dimensions = () + type = logical + intent = in + optional = F +[ntrac] + standard_name = number_of_tracers + long_name = number of tracers + units = count + dimensions = () + type = integer + intent = in + optional = F +[ntcw] + standard_name = index_for_liquid_cloud_condensate + long_name = tracer index for cloud condensate (or liquid water) + units = index + dimensions = () + type = integer + intent = in + optional = F +[ntiw] + standard_name = index_for_ice_cloud_condensate + long_name = tracer index for ice water + units = index + dimensions = () + type = integer + intent = in + optional = F +[ntlnc] + standard_name = index_for_liquid_cloud_number_concentration + long_name = tracer index for liquid number concentration + units = index + dimensions = () + type = integer + intent = in + optional = F +[ntinc] + standard_name = index_for_ice_cloud_number_concentration + long_name = tracer index for ice number concentration + units = index + dimensions = () + type = integer + intent = in + optional = F +[ntclamt] + standard_name = index_for_cloud_amount + long_name = tracer index for cloud amount integer + units = index + dimensions = () + type = integer + intent = in + optional = F +[ntrw] + standard_name = index_for_rain_water + long_name = tracer index for rain water + units = index + dimensions = () + type = integer + intent = in + optional = F +[ntsw] + standard_name = index_for_snow_water + long_name = tracer index for snow water + units = index + dimensions = () + type = integer + intent = in + optional = F +[ntrnc] + standard_name = index_for_rain_number_concentration + long_name = tracer index for rain number concentration + units = index + dimensions = () + type = integer + intent = in + optional = F +[ntsnc] + standard_name = index_for_snow_number_concentration + long_name = tracer index for snow number concentration + units = index + dimensions = () + type = integer + intent = in + optional = F +[ntgl] + standard_name = index_for_graupel + long_name = tracer index for graupel + units = index + dimensions = () + type = integer + intent = in + optional = F +[ntgnc] + standard_name = index_for_graupel_number_concentration + long_name = tracer index for graupel number concentration + units = index + dimensions = () + type = integer + intent = in + optional = F +[xlon] + standard_name = longitude + long_name = longitude + units = radians + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[xlat] + standard_name = latitude + long_name = latitude + units = radians + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[gq0] + standard_name = tracer_concentration_updated_by_physics + long_name = tracer concentration updated by physics + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension,number_of_tracers) + type = real + kind = kind_phys + intent = in + optional = F +[imp_physics] + standard_name = flag_for_microphysics_scheme + long_name = choice of microphysics scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F +[imp_physics_mg] + standard_name = flag_for_morrison_gettelman_microphysics_scheme + long_name = choice of Morrison-Gettelman microphysics scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F +[imp_physics_zhao_carr] + standard_name = flag_for_zhao_carr_microphysics_scheme + long_name = choice of Zhao-Carr microphysics scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F +[imp_physics_zhao_carr_pdf] + standard_name = flag_for_zhao_carr_pdf_microphysics_scheme + long_name = choice of Zhao-Carr microphysics scheme with PDF clouds + units = flag + dimensions = () + type = integer + intent = in + optional = F +[imp_physics_gfdl] + standard_name = flag_for_gfdl_microphysics_scheme + long_name = choice of GFDL microphysics scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F +[imp_physics_thompson] + standard_name = flag_for_thompson_microphysics_scheme + long_name = choice of Thompson microphysics scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F +[imp_physics_wsm6] + standard_name = flag_for_wsm6_microphysics_scheme + long_name = choice of WSM6 microphysics scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F +[imp_physics_fer_hires] + standard_name = flag_for_fer_hires_microphysics_scheme + long_name = choice of Ferrier-Aligo microphysics scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F +[prsi] + standard_name = air_pressure_at_interface + long_name = air pressure at model layer interfaces + units = Pa + dimensions = (horizontal_dimension,vertical_dimension_plus_one) + type = real + kind = kind_phys + intent = in + optional = F +[prsl] + standard_name = air_pressure + long_name = mean layer pressure + units = Pa + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[prslk] + standard_name = dimensionless_exner_function_at_model_layers + long_name = dimensionless Exner function at model layer centers + units = none + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[rhcbot] + standard_name = critical_relative_humidity_at_surface + long_name = critical relative humidity at the surface + units = frac + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[rhcpbl] + standard_name = critical_relative_humidity_at_PBL_top + long_name = critical relative humidity at the PBL top + units = frac + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[rhctop] + standard_name = critical_relative_humidity_at_top_of_atmosphere + long_name = critical relative humidity at the top of atmosphere + units = frac + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[rhcmax] + standard_name = maximum_critical_relative_humidity + long_name = maximum critical relative humidity + units = frac + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[islmsk] + standard_name = sea_land_ice_mask + long_name = sea/land/ice mask (=0/1/2) + units = flag + dimensions = (horizontal_dimension) + type = integer + intent = in + optional = F +[work1] + standard_name = grid_size_related_coefficient_used_in_scale_sensitive_schemes + long_name = grid size related coefficient used in scale-sensitive schemes + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[work2] + standard_name = grid_size_related_coefficient_used_in_scale_sensitive_schemes_complement + long_name = complement to work1 + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[kpbl] + standard_name = vertical_index_at_top_of_atmosphere_boundary_layer + long_name = vertical index at top atmospheric boundary layer + units = index + dimensions = (horizontal_dimension) + type = integer + intent = in + optional = F +[kinver] + standard_name = index_of_highest_temperature_inversion + long_name = index of highest temperature inversion + units = index + dimensions = (horizontal_dimension) + type = integer + intent = in + optional = F +[ras] + standard_name = flag_for_ras_deep_convection + long_name = flag for ras convection scheme + units = flag + dimensions = () + type = logical + intent = in + optional = F +[me] + standard_name = mpi_rank + long_name = current MPI-rank + units = index + dimensions = () + type = integer + intent = in + optional = F +[clw] + standard_name = convective_transportable_tracers + long_name = array to contain cloud water and other convective trans. tracers + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension,number_of_tracers_for_convective_transport) + type = real + kind = kind_phys + intent = inout + optional = F +[rhc] + standard_name = critical_relative_humidity + long_name = critical relative humidity + units = frac + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[save_qc] + standard_name = cloud_condensed_water_mixing_ratio_save + long_name = ratio of mass of cloud water to mass of dry air plus vapor (without condensates) before entering a physics scheme + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[save_qi] + standard_name = ice_water_mixing_ratio_save + long_name = cloud ice water mixing ratio before entering a physics scheme + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F + +######################################################################## +[ccpp-arg-table] + name = GFS_suite_interstitial_4_run + type = scheme +[im] + standard_name = horizontal_loop_extent + long_name = horizontal loop extent + units = count + dimensions = () + type = integer + intent = in + optional = F +[levs] + standard_name = vertical_dimension + long_name = vertical layer dimension + units = count + dimensions = () + type = integer + intent = in + optional = F +[ltaerosol] + standard_name = flag_for_aerosol_physics + long_name = flag for aerosol physics + units = flag + dimensions = () + type = logical + intent = in + optional = F +[cplchm] + standard_name = flag_for_chemistry_coupling + long_name = flag controlling cplchm collection (default off) + units = flag + dimensions = () + type = logical + intent = in + optional = F +[tracers_total] + standard_name = number_of_total_tracers + long_name = total number of tracers + units = count + dimensions = () + type = integer + intent = in + optional = F +[ntrac] + standard_name = number_of_tracers + long_name = number of tracers + units = count + dimensions = () + type = integer + intent = in + optional = F +[ntcw] + standard_name = index_for_liquid_cloud_condensate + long_name = tracer index for cloud condensate (or liquid water) + units = index + dimensions = () + type = integer + intent = in + optional = F +[ntiw] + standard_name = index_for_ice_cloud_condensate + long_name = tracer index for ice water + units = index + dimensions = () + type = integer + intent = in + optional = F +[ntclamt] + standard_name = index_for_cloud_amount + long_name = tracer index for cloud amount integer + units = index + dimensions = () + type = integer + intent = in + optional = F +[ntrw] + standard_name = index_for_rain_water + long_name = tracer index for rain water + units = index + dimensions = () + type = integer + intent = in + optional = F +[ntsw] + standard_name = index_for_snow_water + long_name = tracer index for snow water + units = index + dimensions = () + type = integer + intent = in + optional = F +[ntrnc] + standard_name = index_for_rain_number_concentration + long_name = tracer index for rain number concentration + units = index + dimensions = () + type = integer + intent = in + optional = F +[ntsnc] + standard_name = index_for_snow_number_concentration + long_name = tracer index for snow number concentration + units = index + dimensions = () + type = integer + intent = in + optional = F +[ntgl] + standard_name = index_for_graupel + long_name = tracer index for graupel + units = index + dimensions = () + type = integer + intent = in + optional = F +[ntgnc] + standard_name = index_for_graupel_number_concentration + long_name = tracer index for graupel number concentration + units = index + dimensions = () + type = integer + intent = in + optional = F +[ntlnc] + standard_name = index_for_liquid_cloud_number_concentration + long_name = tracer index for liquid number concentration + units = index + dimensions = () + type = integer + intent = in + optional = F +[ntinc] + standard_name = index_for_ice_cloud_number_concentration + long_name = tracer index for ice number concentration + units = index + dimensions = () + type = integer + intent = in + optional = F +[nn] + standard_name = number_of_tracers_for_convective_transport + long_name = number of tracers for convective transport + units = count + dimensions = () + type = integer + intent = in + optional = F +[imp_physics] + standard_name = flag_for_microphysics_scheme + long_name = choice of microphysics scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F +[imp_physics_gfdl] + standard_name = flag_for_gfdl_microphysics_scheme + long_name = choice of GFDL microphysics scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F +[imp_physics_thompson] + standard_name = flag_for_thompson_microphysics_scheme + long_name = choice of Thompson microphysics scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F +[imp_physics_zhao_carr] + standard_name = flag_for_zhao_carr_microphysics_scheme + long_name = choice of Zhao-Carr microphysics scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F +[imp_physics_zhao_carr_pdf] + standard_name = flag_for_zhao_carr_pdf_microphysics_scheme + long_name = choice of Zhao-Carr microphysics scheme with PDF clouds + units = flag + dimensions = () + type = integer + intent = in + optional = F +[dtf] + standard_name = time_step_for_dynamics + long_name = dynamics timestep + units = s + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[save_qc] + standard_name = cloud_condensed_water_mixing_ratio_save + long_name = ratio of mass of cloud water to mass of dry air plus vapor (without condensates) before entering a physics scheme + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[save_qi] + standard_name = ice_water_mixing_ratio_save + long_name = cloud ice water mixing ratio before entering a physics scheme + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[con_pi] + standard_name = pi + long_name = ratio of a circle's circumference to its diameter + units = radians + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[gq0] + standard_name = tracer_concentration_updated_by_physics + long_name = tracer concentration updated by physics + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension,number_of_tracers) + type = real + kind = kind_phys + intent = inout + optional = F +[clw] + standard_name = convective_transportable_tracers + long_name = array to contain cloud water and other convective trans. tracers + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension,number_of_tracers_for_convective_transport) + type = real + kind = kind_phys + intent = inout + optional = F +[gt0] + standard_name = air_temperature_updated_by_physics + long_name = temperature updated by physics + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[dqdti] + standard_name = instantaneous_water_vapor_specific_humidity_tendency_due_to_convection + long_name = instantaneous moisture tendency due to convection + units = kg kg-1 s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[imfdeepcnv] + standard_name = flag_for_mass_flux_deep_convection_scheme + long_name = flag for mass-flux deep convection scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F +[imfdeepcnv_gf] + standard_name = flag_for_gf_deep_convection_scheme + long_name = flag for Grell-Freitas deep convection scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F + +######################################################################## +[ccpp-arg-table] + name = GFS_suite_interstitial_5_run + type = scheme +[im] + standard_name = horizontal_loop_extent + long_name = horizontal loop extent + units = count + dimensions = () + type = integer + intent = in + optional = F +[levs] + standard_name = vertical_dimension + long_name = vertical layer dimension + units = count + dimensions = () + type = integer + intent = in + optional = F +[ntrac] + standard_name = number_of_tracers + long_name = number of tracers + units = count + dimensions = () + type = integer + intent = in + optional = F +[ntcw] + standard_name = index_for_liquid_cloud_condensate + long_name = tracer index for cloud condensate (or liquid water) + units = index + dimensions = () + type = integer + intent = in + optional = F +[ntiw] + standard_name = index_for_ice_cloud_condensate + long_name = tracer index for ice water + units = index + dimensions = () + type = integer + intent = in + optional = F +[nn] + standard_name = number_of_tracers_for_convective_transport + long_name = number of tracers for convective transport + units = count + dimensions = () + type = integer + intent = in + optional = F +[gq0] + standard_name = tracer_concentration_updated_by_physics + long_name = tracer concentration updated by physics + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension,number_of_tracers) + type = real + kind = kind_phys + intent = in + optional = F +[clw] + standard_name = convective_transportable_tracers + long_name = array to contain cloud water and other convective trans. tracers + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension,number_of_tracers_for_convective_transport) + type = real + kind = kind_phys + intent = inout + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F diff --git a/physics/GFS_surface_composites.F90 b/physics/GFS_surface_composites.F90 index e5ca18683..6cca60ccf 100644 --- a/physics/GFS_surface_composites.F90 +++ b/physics/GFS_surface_composites.F90 @@ -11,6 +11,8 @@ module GFS_surface_composites_pre public GFS_surface_composites_pre_init, GFS_surface_composites_pre_finalize, GFS_surface_composites_pre_run + real(kind=kind_phys), parameter :: zero = 0.0d0, one = 1.0d0, epsln = 1.0d-10 + contains subroutine GFS_surface_composites_pre_init () @@ -19,135 +21,162 @@ end subroutine GFS_surface_composites_pre_init subroutine GFS_surface_composites_pre_finalize() end subroutine GFS_surface_composites_pre_finalize -#if 0 !> \section arg_table_GFS_surface_composites_pre_run Argument Table -!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | -!! |----------------|-----------------------------------------------------------------------------------|----------------------------------------------------------------------|------------|------|-----------|-----------|--------|----------| -!! | im | horizontal_loop_extent | horizontal loop extent | count | 0 | integer | | in | F | -!! | cplflx | flag_for_flux_coupling | flag controlling cplflx collection (default off) | flag | 0 | logical | | in | F | -!! | landfrac | land_area_fraction | fraction of horizontal grid area occupied by land | frac | 1 | real | kind_phys | in | F | -!! | lakefrac | lake_area_fraction | fraction of horizontal grid area occupied by lake | frac | 1 | real | kind_phys | in | F | -!! | oceanfrac | sea_area_fraction | fraction of horizontal grid area occupied by ocean | frac | 1 | real | kind_phys | in | F | -!! | dry | flag_nonzero_land_surface_fraction | flag indicating presence of some land surface area fraction | flag | 1 | logical | | inout | F | -!! | icy | flag_nonzero_sea_ice_surface_fraction | flag indicating presence of some sea ice surface area fraction | flag | 1 | logical | | inout | F | -!! | lake | flag_nonzero_lake_surface_fraction | flag indicating presence of some lake surface area fraction | flag | 1 | logical | | inout | F | -!! | ocean | flag_nonzero_ocean_surface_fraction | flag indicating presence of some ocean surface area fraction | flag | 1 | logical | | inout | F | -!! | wet | flag_nonzero_wet_surface_fraction | flag indicating presence of some ocean or lake surface area fraction | flag | 1 | logical | | inout | F | -!! | fice | sea_ice_concentration | ice fraction over open water | frac | 1 | real | kind_phys | in | F | -!! | cimin | minimum_sea_ice_concentration | minimum sea ice concentration | frac | 0 | real | kind_phys | in | F | -!! | zorl | surface_roughness_length | surface roughness length | cm | 1 | real | kind_phys | in | F | -!! | zorlo | surface_roughness_length_over_ocean | surface roughness length over ocean | cm | 1 | real | kind_phys | inout | F | -!! | zorll | surface_roughness_length_over_land | surface roughness length over land | cm | 1 | real | kind_phys | inout | F | -!! | zorl_ocn | surface_roughness_length_over_ocean_interstitial | surface roughness length over ocean (temporary use as interstitial) | cm | 1 | real | kind_phys | inout | F | -!! | zorl_lnd | surface_roughness_length_over_land_interstitial | surface roughness length over land (temporary use as interstitial) | cm | 1 | real | kind_phys | inout | F | -!! | zorl_ice | surface_roughness_length_over_ice_interstitial | surface roughness length over ice (temporary use as interstitial) | cm | 1 | real | kind_phys | inout | F | -!! | snowd | surface_snow_thickness_water_equivalent | water equivalent snow depth | mm | 1 | real | kind_phys | in | F | -!! | snowd_ocn | surface_snow_thickness_water_equivalent_over_ocean | water equivalent snow depth over ocean | mm | 1 | real | kind_phys | inout | F | -!! | snowd_lnd | surface_snow_thickness_water_equivalent_over_land | water equivalent snow depth over land | mm | 1 | real | kind_phys | inout | F | -!! | snowd_ice | surface_snow_thickness_water_equivalent_over_ice | water equivalent snow depth over ice | mm | 1 | real | kind_phys | inout | F | -!! | tprcp | nonnegative_lwe_thickness_of_precipitation_amount_on_dynamics_timestep | total precipitation amount in each time step | m | 1 | real | kind_phys | in | F | -!! | tprcp_ocn | nonnegative_lwe_thickness_of_precipitation_amount_on_dynamics_timestep_over_ocean | total precipitation amount in each time step over ocean | m | 1 | real | kind_phys | inout | F | -!! | tprcp_lnd | nonnegative_lwe_thickness_of_precipitation_amount_on_dynamics_timestep_over_land | total precipitation amount in each time step over land | m | 1 | real | kind_phys | inout | F | -!! | tprcp_ice | nonnegative_lwe_thickness_of_precipitation_amount_on_dynamics_timestep_over_ice | total precipitation amount in each time step over ice | m | 1 | real | kind_phys | inout | F | -!! | uustar | surface_friction_velocity | boundary layer parameter | m s-1 | 1 | real | kind_phys | in | F | -!! | uustar_lnd | surface_friction_velocity_over_land | surface friction velocity over land | m s-1 | 1 | real | kind_phys | inout | F | -!! | uustar_ice | surface_friction_velocity_over_ice | surface friction velocity over ice | m s-1 | 1 | real | kind_phys | inout | F | -!! | weasd | water_equivalent_accumulated_snow_depth | water equiv of acc snow depth over land and sea ice | mm | 1 | real | kind_phys | in | F | -!! | weasd_lnd | water_equivalent_accumulated_snow_depth_over_land | water equiv of acc snow depth over land | mm | 1 | real | kind_phys | inout | F | -!! | weasd_ice | water_equivalent_accumulated_snow_depth_over_ice | water equiv of acc snow depth over ice | mm | 1 | real | kind_phys | inout | F | -!! | ep1d_ice | surface_upward_potential_latent_heat_flux_over_ice | surface upward potential latent heat flux over ice | W m-2 | 1 | real | kind_phys | inout | F | -!! | tsfc | surface_skin_temperature | surface skin temperature | K | 1 | real | kind_phys | in | F | -!! | tsfco | sea_surface_temperature | sea surface temperature | K | 1 | real | kind_phys | inout | F | -!! | tsfcl | surface_skin_temperature_over_land | surface skin temperature over land | K | 1 | real | kind_phys | inout | F | -!! | tsfc_ocn | surface_skin_temperature_over_ocean_interstitial | surface skin temperature over ocean (temporary use as interstitial) | K | 1 | real | kind_phys | inout | F | -!! | tsfc_lnd | surface_skin_temperature_over_land_interstitial | surface skin temperature over land (temporary use as interstitial) | K | 1 | real | kind_phys | inout | F | -!! | tsfc_ice | surface_skin_temperature_over_ice_interstitial | surface skin temperature over ice (temporary use as interstitial) | K | 1 | real | kind_phys | inout | F | -!! | tisfc | sea_ice_temperature | sea ice surface skin temperature | K | 1 | real | kind_phys | inout | F | -!! | tsurf | surface_skin_temperature_after_iteration | surface skin temperature after iteration | K | 1 | real | kind_phys | inout | F | -!! | tsurf_ocn | surface_skin_temperature_after_iteration_over_ocean | surface skin temperature after iteration over ocean | K | 1 | real | kind_phys | inout | F | -!! | tsurf_lnd | surface_skin_temperature_after_iteration_over_land | surface skin temperature after iteration over land | K | 1 | real | kind_phys | inout | F | -!! | tsurf_ice | surface_skin_temperature_after_iteration_over_ice | surface skin temperature after iteration over ice | K | 1 | real | kind_phys | inout | F | -!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | -!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | +!! \htmlinclude GFS_surface_composites_pre_run.html !! -#endif - subroutine GFS_surface_composites_pre_run (im, cplflx, landfrac, lakefrac, oceanfrac, & - dry, icy, lake, ocean, wet, fice, cimin, zorl, zorlo, zorll, zorl_ocn, & - zorl_lnd, zorl_ice, snowd, snowd_ocn, snowd_lnd, snowd_ice, tprcp, tprcp_ocn, & - tprcp_lnd, tprcp_ice, uustar, uustar_lnd, uustar_ice, weasd, weasd_lnd, & - weasd_ice, ep1d_ice, tsfc, tsfco, tsfcl, tsfc_ocn, tsfc_lnd, tsfc_ice, tisfc, & - tsurf, tsurf_ocn, tsurf_lnd, tsurf_ice, errmsg, errflg) - - use machine, only: kind_phys + subroutine GFS_surface_composites_pre_run (im, frac_grid, flag_cice, cplflx, cplwav2atm, & + landfrac, lakefrac, oceanfrac, & + frland, dry, icy, lake, ocean, wet, cice, cimin, zorl, zorlo, zorll, zorl_ocn, & + zorl_lnd, zorl_ice, snowd, snowd_ocn, snowd_lnd, snowd_ice, tprcp, tprcp_ocn, & + tprcp_lnd, tprcp_ice, uustar, uustar_lnd, uustar_ice, weasd, weasd_ocn, & + weasd_lnd, weasd_ice, ep1d_ice, tsfc, tsfco, tsfcl, tsfc_ocn, tsfc_lnd, & + tsfc_ice, tisfc, tice, tsurf, tsurf_ocn, tsurf_lnd, tsurf_ice, gflx_ice, & + tgice, islmsk, semis_rad, semis_ocn, semis_lnd, semis_ice, & + min_lakeice, min_seaice, errmsg, errflg) implicit none ! Interface variables - integer, intent(in) :: im - logical, intent(in) :: cplflx + integer, intent(in ) :: im + logical, intent(in ) :: frac_grid, cplflx, cplwav2atm + logical, dimension(im), intent(in ) :: flag_cice logical, dimension(im), intent(inout) :: dry, icy, lake, ocean, wet - real(kind=kind_phys), intent(in) :: cimin - real(kind=kind_phys), dimension(im), intent(in) :: landfrac, lakefrac, oceanfrac, fice - real(kind=kind_phys), dimension(im), intent(in) :: zorl, snowd, tprcp, uustar, weasd, tsfc + real(kind=kind_phys), intent(in ) :: cimin + real(kind=kind_phys), dimension(im), intent(in ) :: landfrac, lakefrac, oceanfrac + real(kind=kind_phys), dimension(im), intent(inout) :: cice + real(kind=kind_phys), dimension(im), intent( out) :: frland + real(kind=kind_phys), dimension(im), intent(in ) :: zorl, snowd, tprcp, uustar, weasd - real(kind=kind_phys), dimension(im), intent(inout) :: zorlo, zorll, tsfco, tsfcl, tisfc, tsurf + real(kind=kind_phys), dimension(im), intent(inout) :: zorlo, zorll, tsfc, tsfco, tsfcl, tisfc, tsurf real(kind=kind_phys), dimension(im), intent(inout) :: snowd_ocn, snowd_lnd, snowd_ice, tprcp_ocn, & tprcp_lnd, tprcp_ice, zorl_ocn, zorl_lnd, zorl_ice, tsfc_ocn, tsfc_lnd, tsfc_ice, tsurf_ocn, & - tsurf_lnd, tsurf_ice, uustar_lnd, uustar_ice, weasd_lnd, weasd_ice, ep1d_ice + tsurf_lnd, tsurf_ice, uustar_lnd, uustar_ice, weasd_ocn, weasd_lnd, weasd_ice, ep1d_ice, gflx_ice + real(kind=kind_phys), dimension(im), intent( out) :: tice + real(kind=kind_phys), intent(in ) :: tgice + integer, dimension(im), intent(in ) :: islmsk + real(kind=kind_phys), dimension(im), intent(in ) :: semis_rad + real(kind=kind_phys), dimension(im), intent(inout) :: semis_ocn, semis_lnd, semis_ice + real(kind=kind_phys), intent(in ) :: min_lakeice, min_seaice ! CCPP error handling character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg ! Local variables + real(kind=kind_phys) :: tem integer :: i ! Initialize CCPP error handling variables errmsg = '' errflg = 0 - do i = 1, im - if(oceanfrac(i)>0.) ocean(i) = .true. - if(landfrac(i) >0.) dry(i) = .true. - if(lakefrac(i) >0.) lake(i) = .true. - if(ocean(i) .or. lake(i)) wet(i) = .true. - if(wet(i) .and. fice(i) >= cimin*max(oceanfrac(i),lakefrac(i))) icy(i) = .true. - enddo + if (frac_grid) then ! cice is ice fraction wrt water area + do i=1,im + frland(i) = landfrac(i) + if (frland(i) > zero) dry(i) = .true. + if (frland(i) < one) then + if (flag_cice(i)) then + if (cice(i) >= min_seaice) then + icy(i) = .true. + else + cice(i) = zero + endif + else + if (cice(i) >= min_lakeice) then + icy(i) = .true. + else + cice(i) = zero + endif + endif + if (cice(i) < one ) then + wet(i)=.true. !there is some open ocean/lake water! + if (.not. cplflx) tsfco(i) = max(tsfco(i), tisfc(i), tgice) + end if + else + cice(i) = zero + endif + enddo + + else + + do i = 1, IM + frland(i) = zero + if (islmsk(i) == 0) then + ! tsfco(i) = Sfcprop%tsfc(i) + wet(i) = .true. + cice(i) = zero + elseif (islmsk(i) == 1) then + ! Sfcprop%tsfcl(i) = Sfcprop%tsfc(i) + dry(i) = .true. + frland(i) = one + cice(i) = zero + else + icy(i) = .true. + if (cice(i) < one) then + wet(i) = .true. + ! tsfco(i) = tgice + if (.not. cplflx) tsfco(i) = max(tisfc(i), tgice) + ! if (.not. cplflx .or. lakefrac(i) > zero) tsfco(i) = max(tsfco(i), tisfc(i), tgice) + ! tsfco(i) = max((tsfc(i) - cice(i)*tisfc(i)) & + ! / (one - cice(i)), tgice) + endif + endif + enddo + + endif + + if (.not. cplflx .or. .not. frac_grid) then + if (cplwav2atm) then + do i=1,im + zorll(i) = zorl(i) + enddo + else + do i=1,im + zorll(i) = zorl(i) + zorlo(i) = zorl(i) + enddo + endif + endif do i=1,im - if (.not. cplflx) then - zorll(i) = zorl(i) - zorlo(i) = zorl(i) - tsfcl(i) = tsfc(i) - tsfco(i) = tsfc(i) - tisfc(i) = tsfc(i) - end if - if(wet(i)) then - snowd_ocn(i) = snowd(i) - tprcp_ocn(i) = tprcp(i) - zorl_ocn(i) = zorlo(i) - tsfc_ocn(i) = tsfco(i) - tsurf_ocn(i)= tsfco(i) + tprcp_ocn(i) = tprcp(i) + tprcp_lnd(i) = tprcp(i) + tprcp_ice(i) = tprcp(i) + if (wet(i)) then ! Water + zorl_ocn(i) = zorlo(i) + tsfc_ocn(i) = tsfco(i) + tsurf_ocn(i) = tsfco(i) +! weasd_ocn(i) = weasd(i) +! snowd_ocn(i) = snowd(i) + weasd_ocn(i) = zero + snowd_ocn(i) = zero + semis_ocn(i) = 0.984d0 endif - if (dry(i)) then + if (dry(i)) then ! Land uustar_lnd(i) = uustar(i) - weasd_lnd(i) = weasd(i) - tprcp_lnd(i) = tprcp(i) - zorl_lnd(i) = zorll(i) - tsfc_lnd(i) = tsfcl(i) - tsurf_lnd(i) = tsfcl(i) - snowd_lnd(i) = snowd(i) + weasd_lnd(i) = weasd(i) + zorl_lnd(i) = zorll(i) + tsfc_lnd(i) = tsfcl(i) + tsurf_lnd(i) = tsfcl(i) + snowd_lnd(i) = snowd(i) + semis_lnd(i) = semis_rad(i) end if - if (icy(i)) then + if (icy(i)) then ! Ice uustar_ice(i) = uustar(i) - weasd_ice(i) = weasd(i) - tprcp_ice(i) = tprcp(i) - zorl_ice(i) = zorll(i) - tsfc_ice(i) = tisfc(i) - tsurf_ice(i)= tisfc(i) - snowd_ice(i) = snowd(i) - ep1d_ice(i) = 0. - end if + weasd_ice(i) = weasd(i) + zorl_ice(i) = zorll(i) + tsfc_ice(i) = tisfc(i) + tsurf_ice(i) = tisfc(i) + snowd_ice(i) = snowd(i) + ep1d_ice(i) = zero + gflx_ice(i) = zero + semis_ice(i) = 0.95d0 + endif + enddo + + ! Assign sea ice temperature to interstitial variable + do i = 1, im + tice(i) = tisfc(i) enddo end subroutine GFS_surface_composites_pre_run @@ -155,6 +184,82 @@ end subroutine GFS_surface_composites_pre_run end module GFS_surface_composites_pre +module GFS_surface_composites_inter + + use machine, only: kind_phys + + implicit none + + private + + public GFS_surface_composites_inter_init, GFS_surface_composites_inter_finalize, GFS_surface_composites_inter_run + +contains + + subroutine GFS_surface_composites_inter_init () + end subroutine GFS_surface_composites_inter_init + + subroutine GFS_surface_composites_inter_finalize() + end subroutine GFS_surface_composites_inter_finalize + +!> \section arg_table_GFS_surface_composites_inter_run Argument Table +!! \htmlinclude GFS_surface_composites_inter_run.html +!! + subroutine GFS_surface_composites_inter_run (im, dry, icy, wet, semis_ocn, semis_lnd, semis_ice, adjsfcdlw, & + gabsbdlw_lnd, gabsbdlw_ice, gabsbdlw_ocn, & + adjsfcusw, adjsfcdsw, adjsfcnsw, errmsg, errflg) + + implicit none + + ! Interface variables + integer, intent(in ) :: im + logical, dimension(im), intent(in ) :: dry, icy, wet + real(kind=kind_phys), dimension(im), intent(in ) :: semis_ocn, semis_lnd, semis_ice, adjsfcdlw, & + adjsfcdsw, adjsfcnsw + real(kind=kind_phys), dimension(im), intent(inout) :: gabsbdlw_lnd, gabsbdlw_ice, gabsbdlw_ocn + real(kind=kind_phys), dimension(im), intent(out) :: adjsfcusw + + ! CCPP error handling + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! Local variables + integer :: i + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + ! --- convert lw fluxes for land/ocean/sea-ice models - requires dcyc2t3 to set adjsfcdlw + ! note: for sw: adjsfcdsw and adjsfcnsw are zenith angle adjusted downward/net fluxes. + ! for lw: adjsfcdlw is (sfc temp adjusted) downward fluxe with no emiss effect. + ! adjsfculw is (sfc temp adjusted) upward fluxe including emiss effect. + ! one needs to be aware that that the absorbed downward lw flux (used by land/ocean + ! models as downward flux) is not the same as adjsfcdlw but a value reduced by + ! the factor of emissivity. however, the net effects are the same when seeing + ! it either above the surface interface or below. + ! + ! - flux above the interface used by atmosphere model: + ! down: adjsfcdlw; up: adjsfculw = sfcemis*sigma*T**4 + (1-sfcemis)*adjsfcdlw + ! net = up - down = sfcemis * (sigma*T**4 - adjsfcdlw) + ! - flux below the interface used by lnd/oc/ice models: + ! down: sfcemis*adjsfcdlw; up: sfcemis*sigma*T**4 + ! net = up - down = sfcemis * (sigma*T**4 - adjsfcdlw) + ! surface upwelling shortwave flux at current time is in adjsfcusw + + ! --- ... define the downward lw flux absorbed by ground + do i=1,im + if (dry(i)) gabsbdlw_lnd(i) = semis_lnd(i) * adjsfcdlw(i) + if (icy(i)) gabsbdlw_ice(i) = semis_ice(i) * adjsfcdlw(i) + if (wet(i)) gabsbdlw_ocn(i) = semis_ocn(i) * adjsfcdlw(i) + adjsfcusw(i) = adjsfcdsw(i) - adjsfcnsw(i) + enddo + + end subroutine GFS_surface_composites_inter_run + +end module GFS_surface_composites_inter + + module GFS_surface_composites_post use machine, only: kind_phys @@ -165,6 +270,8 @@ module GFS_surface_composites_post public GFS_surface_composites_post_init, GFS_surface_composites_post_finalize, GFS_surface_composites_post_run + real(kind=kind_phys), parameter :: zero = 0.0d0, one = 1.0d0 + contains subroutine GFS_surface_composites_post_init () @@ -175,147 +282,46 @@ end subroutine GFS_surface_composites_post_finalize #if 0 !> \section arg_table_GFS_surface_composites_post_run Argument Table -!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | -!! |----------------|---------------------------------------------------------------------------------------------------------------------|-------------------------------------------------------------------------------------|-------------|------|------------|-----------|--------|----------| -!! | im | horizontal_loop_extent | horizontal loop extent | count | 0 | integer | | in | F | -!! | cplflx | flag_for_flux_coupling | flag controlling cplflx collection (default off) | flag | 0 | logical | | in | F | -!! | flag_cice | flag_for_cice | flag for cice | flag | 1 | logical | | in | F | -!! | dry | flag_nonzero_land_surface_fraction | flag indicating presence of some land surface area fraction | flag | 1 | logical | | in | F | -!! | wet | flag_nonzero_wet_surface_fraction | flag indicating presence of some ocean or lake surface area fraction | flag | 1 | logical | | in | F | -!! | icy | flag_nonzero_sea_ice_surface_fraction | flag indicating presence of some sea ice surface area fraction | flag | 1 | logical | | in | F | -!! | lndfrac | land_area_fraction | fraction of horizontal grid area occupied by land | frac | 1 | real | kind_phys | in | F | -!! | lakfrac | lake_area_fraction | fraction of horizontal grid area occupied by lake | frac | 1 | real | kind_phys | in | F | -!! | ocnfrac | sea_area_fraction | fraction of horizontal grid area occupied by ocean | frac | 1 | real | kind_phys | in | F | -!! | cice | sea_ice_concentration | ice fraction over open water | frac | 1 | real | kind_phys | in | F | -!! | zorl | surface_roughness_length | surface roughness length | cm | 1 | real | kind_phys | inout | F | -!! | zorlo | surface_roughness_length_over_ocean | surface roughness length over ocean | cm | 1 | real | kind_phys | inout | F | -!! | zorll | surface_roughness_length_over_land | surface roughness length over land | cm | 1 | real | kind_phys | inout | F | -!! | zorl_ocn | surface_roughness_length_over_ocean_interstitial | surface roughness length over ocean (temporary use as interstitial) | cm | 1 | real | kind_phys | in | F | -!! | zorl_lnd | surface_roughness_length_over_land_interstitial | surface roughness length over land (temporary use as interstitial) | cm | 1 | real | kind_phys | in | F | -!! | zorl_ice | surface_roughness_length_over_ice_interstitial | surface roughness length over ice (temporary use as interstitial) | cm | 1 | real | kind_phys | in | F | -!! | cd | surface_drag_coefficient_for_momentum_in_air | surface exchange coeff for momentum | none | 1 | real | kind_phys | inout | F | -!! | cd_ocn | surface_drag_coefficient_for_momentum_in_air_over_ocean | surface exchange coeff for momentum over ocean | none | 1 | real | kind_phys | in | F | -!! | cd_lnd | surface_drag_coefficient_for_momentum_in_air_over_land | surface exchange coeff for momentum over land | none | 1 | real | kind_phys | in | F | -!! | cd_ice | surface_drag_coefficient_for_momentum_in_air_over_ice | surface exchange coeff for momentum over ice | none | 1 | real | kind_phys | in | F | -!! | cdq | surface_drag_coefficient_for_heat_and_moisture_in_air | surface exchange coeff heat & moisture | none | 1 | real | kind_phys | inout | F | -!! | cdq_ocn | surface_drag_coefficient_for_heat_and_moisture_in_air_over_ocean | surface exchange coeff heat & moisture over ocean | none | 1 | real | kind_phys | in | F | -!! | cdq_lnd | surface_drag_coefficient_for_heat_and_moisture_in_air_over_land | surface exchange coeff heat & moisture over land | none | 1 | real | kind_phys | in | F | -!! | cdq_ice | surface_drag_coefficient_for_heat_and_moisture_in_air_over_ice | surface exchange coeff heat & moisture over ice | none | 1 | real | kind_phys | in | F | -!! | rb | bulk_richardson_number_at_lowest_model_level | bulk Richardson number at the surface | none | 1 | real | kind_phys | inout | F | -!! | rb_ocn | bulk_richardson_number_at_lowest_model_level_over_ocean | bulk Richardson number at the surface over ocean | none | 1 | real | kind_phys | in | F | -!! | rb_lnd | bulk_richardson_number_at_lowest_model_level_over_land | bulk Richardson number at the surface over land | none | 1 | real | kind_phys | in | F | -!! | rb_ice | bulk_richardson_number_at_lowest_model_level_over_ice | bulk Richardson number at the surface over ice | none | 1 | real | kind_phys | in | F | -!! | stress | surface_wind_stress | surface wind stress | m2 s-2 | 1 | real | kind_phys | inout | F | -!! | stress_ocn | surface_wind_stress_over_ocean | surface wind stress over ocean | m2 s-2 | 1 | real | kind_phys | in | F | -!! | stress_lnd | surface_wind_stress_over_land | surface wind stress over land | m2 s-2 | 1 | real | kind_phys | in | F | -!! | stress_ice | surface_wind_stress_over_ice | surface wind stress over ice | m2 s-2 | 1 | real | kind_phys | in | F | -!! | ffmm | Monin-Obukhov_similarity_function_for_momentum | Monin-Obukhov similarity function for momentum | none | 1 | real | kind_phys | inout | F | -!! | ffmm_ocn | Monin-Obukhov_similarity_function_for_momentum_over_ocean | Monin-Obukhov similarity function for momentum over ocean | none | 1 | real | kind_phys | in | F | -!! | ffmm_lnd | Monin-Obukhov_similarity_function_for_momentum_over_land | Monin-Obukhov similarity function for momentum over land | none | 1 | real | kind_phys | in | F | -!! | ffmm_ice | Monin-Obukhov_similarity_function_for_momentum_over_ice | Monin-Obukhov similarity function for momentum over ice | none | 1 | real | kind_phys | in | F | -!! | ffhh | Monin-Obukhov_similarity_function_for_heat | Monin-Obukhov similarity function for heat | none | 1 | real | kind_phys | inout | F | -!! | ffhh_ocn | Monin-Obukhov_similarity_function_for_heat_over_ocean | Monin-Obukhov similarity function for heat over ocean | none | 1 | real | kind_phys | in | F | -!! | ffhh_lnd | Monin-Obukhov_similarity_function_for_heat_over_land | Monin-Obukhov similarity function for heat over land | none | 1 | real | kind_phys | in | F | -!! | ffhh_ice | Monin-Obukhov_similarity_function_for_heat_over_ice | Monin-Obukhov similarity function for heat over ice | none | 1 | real | kind_phys | in | F | -!! | uustar | surface_friction_velocity | boundary layer parameter | m s-1 | 1 | real | kind_phys | inout | F | -!! | uustar_ocn | surface_friction_velocity_over_ocean | surface friction velocity over ocean | m s-1 | 1 | real | kind_phys | in | F | -!! | uustar_lnd | surface_friction_velocity_over_land | surface friction velocity over land | m s-1 | 1 | real | kind_phys | in | F | -!! | uustar_ice | surface_friction_velocity_over_ice | surface friction velocity over ice | m s-1 | 1 | real | kind_phys | in | F | -!! | fm10 | Monin-Obukhov_similarity_function_for_momentum_at_10m | Monin-Obukhov similarity parameter for momentum at 10m | none | 1 | real | kind_phys | inout | F | -!! | fm10_ocn | Monin-Obukhov_similarity_function_for_momentum_at_10m_over_ocean | Monin-Obukhov similarity parameter for momentum at 10m over ocean | none | 1 | real | kind_phys | in | F | -!! | fm10_lnd | Monin-Obukhov_similarity_function_for_momentum_at_10m_over_land | Monin-Obukhov similarity parameter for momentum at 10m over land | none | 1 | real | kind_phys | in | F | -!! | fm10_ice | Monin-Obukhov_similarity_function_for_momentum_at_10m_over_ice | Monin-Obukhov similarity parameter for momentum at 10m over ice | none | 1 | real | kind_phys | in | F | -!! | fh2 | Monin-Obukhov_similarity_function_for_heat_at_2m | Monin-Obukhov similarity parameter for heat at 2m | none | 1 | real | kind_phys | inout | F | -!! | fh2_ocn | Monin-Obukhov_similarity_function_for_heat_at_2m_over_ocean | Monin-Obukhov similarity parameter for heat at 2m over ocean | none | 1 | real | kind_phys | in | F | -!! | fh2_lnd | Monin-Obukhov_similarity_function_for_heat_at_2m_over_land | Monin-Obukhov similarity parameter for heat at 2m over land | none | 1 | real | kind_phys | in | F | -!! | fh2_ice | Monin-Obukhov_similarity_function_for_heat_at_2m_over_ice | Monin-Obukhov similarity parameter for heat at 2m over ice | none | 1 | real | kind_phys | in | F | -!! | tsurf | surface_skin_temperature_after_iteration | surface skin temperature after iteration | K | 1 | real | kind_phys | inout | F | -!! | tsurf_ocn | surface_skin_temperature_after_iteration_over_ocean | surface skin temperature after iteration over ocean | K | 1 | real | kind_phys | in | F | -!! | tsurf_lnd | surface_skin_temperature_after_iteration_over_land | surface skin temperature after iteration over land | K | 1 | real | kind_phys | in | F | -!! | tsurf_ice | surface_skin_temperature_after_iteration_over_ice | surface skin temperature after iteration over ice | K | 1 | real | kind_phys | in | F | -!! | cmm | surface_drag_wind_speed_for_momentum_in_air | momentum exchange coefficient | m s-1 | 1 | real | kind_phys | inout | F | -!! | cmm_ocn | surface_drag_wind_speed_for_momentum_in_air_over_ocean | momentum exchange coefficient over ocean | m s-1 | 1 | real | kind_phys | in | F | -!! | cmm_lnd | surface_drag_wind_speed_for_momentum_in_air_over_land | momentum exchange coefficient over land | m s-1 | 1 | real | kind_phys | in | F | -!! | cmm_ice | surface_drag_wind_speed_for_momentum_in_air_over_ice | momentum exchange coefficient over ice | m s-1 | 1 | real | kind_phys | in | F | -!! | chh | surface_drag_mass_flux_for_heat_and_moisture_in_air | thermal exchange coefficient | kg m-2 s-1 | 1 | real | kind_phys | inout | F | -!! | chh_ocn | surface_drag_mass_flux_for_heat_and_moisture_in_air_over_ocean | thermal exchange coefficient over ocean | kg m-2 s-1 | 1 | real | kind_phys | in | F | -!! | chh_lnd | surface_drag_mass_flux_for_heat_and_moisture_in_air_over_land | thermal exchange coefficient over land | kg m-2 s-1 | 1 | real | kind_phys | in | F | -!! | chh_ice | surface_drag_mass_flux_for_heat_and_moisture_in_air_over_ice | thermal exchange coefficient over ice | kg m-2 s-1 | 1 | real | kind_phys | in | F | -!! | gflx | upward_heat_flux_in_soil | soil heat flux | W m-2 | 1 | real | kind_phys | inout | F | -!! | gflx_ocn | upward_heat_flux_in_soil_over_ocean | soil heat flux over ocean | W m-2 | 1 | real | kind_phys | in | F | -!! | gflx_lnd | upward_heat_flux_in_soil_over_land | soil heat flux over land | W m-2 | 1 | real | kind_phys | in | F | -!! | gflx_ice | upward_heat_flux_in_soil_over_ice | soil heat flux over ice | W m-2 | 1 | real | kind_phys | in | F | -!! | ep1d | surface_upward_potential_latent_heat_flux | surface upward potential latent heat flux | W m-2 | 1 | real | kind_phys | inout | F | -!! | ep1d_ocn | surface_upward_potential_latent_heat_flux_over_ocean | surface upward potential latent heat flux over ocean | W m-2 | 1 | real | kind_phys | in | F | -!! | ep1d_lnd | surface_upward_potential_latent_heat_flux_over_land | surface upward potential latent heat flux over land | W m-2 | 1 | real | kind_phys | in | F | -!! | ep1d_ice | surface_upward_potential_latent_heat_flux_over_ice | surface upward potential latent heat flux over ice | W m-2 | 1 | real | kind_phys | in | F | -!! | weasd | water_equivalent_accumulated_snow_depth | water equiv of acc snow depth over land and sea ice | mm | 1 | real | kind_phys | inout | F | -!! | weasd_lnd | water_equivalent_accumulated_snow_depth_over_land | water equiv of acc snow depth over land | mm | 1 | real | kind_phys | in | F | -!! | weasd_ice | water_equivalent_accumulated_snow_depth_over_ice | water equiv of acc snow depth over ice | mm | 1 | real | kind_phys | in | F | -!! | snowd | surface_snow_thickness_water_equivalent | water equivalent snow depth | mm | 1 | real | kind_phys | inout | F | -!! | snowd_ocn | surface_snow_thickness_water_equivalent_over_ocean | water equivalent snow depth over ocean | mm | 1 | real | kind_phys | in | F | -!! | snowd_lnd | surface_snow_thickness_water_equivalent_over_land | water equivalent snow depth over land | mm | 1 | real | kind_phys | in | F | -!! | snowd_ice | surface_snow_thickness_water_equivalent_over_ice | water equivalent snow depth over ice | mm | 1 | real | kind_phys | in | F | -!! | tprcp | nonnegative_lwe_thickness_of_precipitation_amount_on_dynamics_timestep | total precipitation amount in each time step | m | 1 | real | kind_phys | inout | F | -!! | tprcp_ocn | nonnegative_lwe_thickness_of_precipitation_amount_on_dynamics_timestep_over_ocean | total precipitation amount in each time step over ocean | m | 1 | real | kind_phys | in | F | -!! | tprcp_lnd | nonnegative_lwe_thickness_of_precipitation_amount_on_dynamics_timestep_over_land | total precipitation amount in each time step over land | m | 1 | real | kind_phys | in | F | -!! | tprcp_ice | nonnegative_lwe_thickness_of_precipitation_amount_on_dynamics_timestep_over_ice | total precipitation amount in each time step over ice | m | 1 | real | kind_phys | in | F | -!! | evap | kinematic_surface_upward_latent_heat_flux | kinematic surface upward latent heat flux | kg kg-1 m s-1 | 1 | real | kind_phys | inout | F | -!! | evap_ocn | kinematic_surface_upward_latent_heat_flux_over_ocean | kinematic surface upward latent heat flux over ocean | kg kg-1 m s-1 | 1 | real | kind_phys | in | F | -!! | evap_lnd | kinematic_surface_upward_latent_heat_flux_over_land | kinematic surface upward latent heat flux over land | kg kg-1 m s-1 | 1 | real | kind_phys | in | F | -!! | evap_ice | kinematic_surface_upward_latent_heat_flux_over_ice | kinematic surface upward latent heat flux over ice | kg kg-1 m s-1 | 1 | real | kind_phys | in | F | -!! | hflx | kinematic_surface_upward_sensible_heat_flux | kinematic surface upward sensible heat flux | K m s-1 | 1 | real | kind_phys | inout | F | -!! | hflx_ocn | kinematic_surface_upward_sensible_heat_flux_over_ocean | kinematic surface upward sensible heat flux over ocean | K m s-1 | 1 | real | kind_phys | in | F | -!! | hflx_lnd | kinematic_surface_upward_sensible_heat_flux_over_land | kinematic surface upward sensible heat flux over land | K m s-1 | 1 | real | kind_phys | in | F | -!! | hflx_ice | kinematic_surface_upward_sensible_heat_flux_over_ice | kinematic surface upward sensible heat flux over ice | K m s-1 | 1 | real | kind_phys | in | F | -!! | qss | surface_specific_humidity | surface air saturation specific humidity | kg kg-1 | 1 | real | kind_phys | inout | F | -!! | qss_ocn | surface_specific_humidity_over_ocean | surface air saturation specific humidity over ocean | kg kg-1 | 1 | real | kind_phys | in | F | -!! | qss_lnd | surface_specific_humidity_over_land | surface air saturation specific humidity over land | kg kg-1 | 1 | real | kind_phys | in | F | -!! | qss_ice | surface_specific_humidity_over_ice | surface air saturation specific humidity over ice | kg kg-1 | 1 | real | kind_phys | in | F | -!! | tsfc | surface_skin_temperature | surface skin temperature | K | 1 | real | kind_phys | inout | F | -!! | tsfco | sea_surface_temperature | sea surface temperature | K | 1 | real | kind_phys | inout | F | -!! | tsfcl | surface_skin_temperature_over_land | surface skin temperature over land | K | 1 | real | kind_phys | inout | F | -!! | tsfc_ocn | surface_skin_temperature_over_ocean_interstitial | surface skin temperature over ocean (temporary use as interstitial) | K | 1 | real | kind_phys | in | F | -!! | tsfc_lnd | surface_skin_temperature_over_land_interstitial | surface skin temperature over land (temporary use as interstitial) | K | 1 | real | kind_phys | in | F | -!! | tsfc_ice | surface_skin_temperature_over_ice_interstitial | surface skin temperature over ice (temporary use as interstitial) | K | 1 | real | kind_phys | in | F | -!! | tisfc | sea_ice_temperature | sea ice surface skin temperature | K | 1 | real | kind_phys | inout | F | -!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | -!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | +!! \htmlinclude GFS_surface_composites_post_run.html !! #endif - subroutine GFS_surface_composites_post_run ( & - im, cplflx, flag_cice, dry, wet, icy, lndfrac, lakfrac, ocnfrac, cice, zorl, zorlo, zorll, zorl_ocn, zorl_lnd, zorl_ice, & + subroutine GFS_surface_composites_post_run ( & + im, cplflx, cplwav2atm, frac_grid, flag_cice, islmsk, dry, wet, icy, landfrac, lakefrac, oceanfrac, & + zorl, zorlo, zorll, zorl_ocn, zorl_lnd, zorl_ice, & cd, cd_ocn, cd_lnd, cd_ice, cdq, cdq_ocn, cdq_lnd, cdq_ice, rb, rb_ocn, rb_lnd, rb_ice, stress, stress_ocn, stress_lnd, & stress_ice, ffmm, ffmm_ocn, ffmm_lnd, ffmm_ice, ffhh, ffhh_ocn, ffhh_lnd, ffhh_ice, uustar, uustar_ocn, uustar_lnd, & uustar_ice, fm10, fm10_ocn, fm10_lnd, fm10_ice, fh2, fh2_ocn, fh2_lnd, fh2_ice, tsurf, tsurf_ocn, tsurf_lnd, tsurf_ice, & cmm, cmm_ocn, cmm_lnd, cmm_ice, chh, chh_ocn, chh_lnd, chh_ice, gflx, gflx_ocn, gflx_lnd, gflx_ice, ep1d, ep1d_ocn, & - ep1d_lnd, ep1d_ice, weasd, weasd_lnd, weasd_ice, snowd, snowd_ocn, snowd_lnd, snowd_ice, tprcp, tprcp_ocn, tprcp_lnd, & - tprcp_ice, evap, evap_ocn, evap_lnd, evap_ice, hflx, hflx_ocn, hflx_lnd, hflx_ice, qss, qss_ocn, qss_lnd, qss_ice, & - tsfc, tsfco, tsfcl, tsfc_ocn, tsfc_lnd, tsfc_ice, tisfc, errmsg, errflg) - - use machine, only: kind_phys + ep1d_lnd, ep1d_ice, weasd, weasd_ocn, weasd_lnd, weasd_ice, snowd, snowd_ocn, snowd_lnd, snowd_ice, tprcp, tprcp_ocn, & + tprcp_lnd, tprcp_ice, evap, evap_ocn, evap_lnd, evap_ice, hflx, hflx_ocn, hflx_lnd, hflx_ice, qss, qss_ocn, qss_lnd, & + qss_ice, tsfc, tsfco, tsfcl, tsfc_ocn, tsfc_lnd, tsfc_ice, tisfc, tice, hice, cice, errmsg, errflg) implicit none integer, intent(in) :: im - logical, intent(in) :: cplflx + logical, intent(in) :: cplflx, frac_grid, cplwav2atm logical, dimension(im), intent(in) :: flag_cice, dry, wet, icy - - real(kind=kind_phys), dimension(im), intent(in) :: lndfrac, lakfrac, ocnfrac, cice, & + integer, dimension(im), intent(in) :: islmsk + real(kind=kind_phys), dimension(im), intent(in) :: landfrac, lakefrac, oceanfrac, & zorl_ocn, zorl_lnd, zorl_ice, cd_ocn, cd_lnd, cd_ice, cdq_ocn, cdq_lnd, cdq_ice, rb_ocn, rb_lnd, rb_ice, stress_ocn, & stress_lnd, stress_ice, ffmm_ocn, ffmm_lnd, ffmm_ice, ffhh_ocn, ffhh_lnd, ffhh_ice, uustar_ocn, uustar_lnd, uustar_ice, & fm10_ocn, fm10_lnd, fm10_ice, fh2_ocn, fh2_lnd, fh2_ice, tsurf_ocn, tsurf_lnd, tsurf_ice, cmm_ocn, cmm_lnd, cmm_ice, & - chh_ocn, chh_lnd, chh_ice, gflx_ocn, gflx_lnd, gflx_ice, ep1d_ocn, ep1d_lnd, ep1d_ice, weasd_lnd, weasd_ice, snowd_ocn, & - snowd_lnd, snowd_ice,tprcp_ocn, tprcp_lnd, tprcp_ice, evap_ocn, evap_lnd, evap_ice, hflx_ocn, hflx_lnd, hflx_ice, & - qss_ocn, qss_lnd, qss_ice, tsfc_ocn, tsfc_lnd, tsfc_ice + chh_ocn, chh_lnd, chh_ice, gflx_ocn, gflx_lnd, gflx_ice, ep1d_ocn, ep1d_lnd, ep1d_ice, weasd_ocn, weasd_lnd, weasd_ice, & + snowd_ocn, snowd_lnd, snowd_ice,tprcp_ocn, tprcp_lnd, tprcp_ice, evap_ocn, evap_lnd, evap_ice, hflx_ocn, hflx_lnd, & + hflx_ice, qss_ocn, qss_lnd, qss_ice, tsfc_ocn, tsfc_lnd, tsfc_ice real(kind=kind_phys), dimension(im), intent(inout) :: zorl, zorlo, zorll, cd, cdq, rb, stress, ffmm, ffhh, uustar, fm10, & fh2, tsurf, cmm, chh, gflx, ep1d, weasd, snowd, tprcp, evap, hflx, qss, tsfc, tsfco, tsfcl, tisfc + real(kind=kind_phys), dimension(im), intent(in ) :: tice ! interstitial sea ice temperature + real(kind=kind_phys), dimension(im), intent(inout) :: hice, cice + character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg + ! Local variables integer :: i + real(kind=kind_phys) :: txl, txi, txo, tem ! Initialize CCPP error handling variables errmsg = '' @@ -323,155 +329,175 @@ subroutine GFS_surface_composites_post_run ( ! --- generate ocean/land/ice composites - ! DH* - !write(0,*) "DH DEBUG composites: i, cplflx, flag_cice, dry, wet, icy, ocnfrac, lndfrac, lakfrac, cice, tsfc_{lnd,ocn,ice}, tsfc, tsfcl, tsfco, tisfc" - ! *DH - - do i=1, im - - ! --- three-way composites (fields from sfc_diff) - zorl(i) = cmposit3(ocnfrac(i), lndfrac(i), & - lakfrac(i),cice(i), & - zorl_ocn(i), zorl_lnd(i), zorl_ice(i)) - cd(i) = cmposit3(ocnfrac(i),lndfrac(i), & - lakfrac(i),cice(i), & - cd_ocn(i), cd_lnd(i), cd_ice(i)) - cdq(i) = cmposit3(ocnfrac(i),lndfrac(i), & - lakfrac(i),cice(i), & - cdq_ocn(i), cdq_lnd(i), cdq_ice(i)) - rb(i) = cmposit3(ocnfrac(i),lndfrac(i), & - lakfrac(i),cice(i), & - rb_ocn(i), rb_lnd(i), rb_ice(i)) - stress(i) = cmposit3(ocnfrac(i),lndfrac(i), & - lakfrac(i),cice(i), & - stress_ocn(i),stress_lnd(i),stress_ice(i)) - ffmm(i) = cmposit3(ocnfrac(i),lndfrac(i), & - lakfrac(i),cice(i), & - ffmm_ocn(i), ffmm_lnd(i), ffmm_ice(i)) - ffhh(i) = cmposit3(ocnfrac(i),lndfrac(i), & - lakfrac(i),cice(i), & - ffhh_ocn(i), ffhh_lnd(i), ffhh_ice(i)) - uustar(i) = cmposit3(ocnfrac(i),lndfrac(i), & - lakfrac(i),cice(i), & - uustar_ocn(i),uustar_lnd(i),uustar_ice(i)) - fm10(i) = cmposit3(ocnfrac(i),lndfrac(i), & - lakfrac(i),cice(i), & - fm10_ocn(i), fm10_lnd(i), fm10_ice(i)) - fh2(i) = cmposit3(ocnfrac(i),lndfrac(i), & - lakfrac(i),cice(i), & - fh2_ocn(i), fh2_lnd(i), fh2_ice(i)) - tsurf(i) = cmposit3(ocnfrac(i),lndfrac(i), & - lakfrac(i),cice(i), & - tsurf_ocn(i), tsurf_lnd(i), tsurf_ice(i)) - cmm(i) = cmposit3(ocnfrac(i),lndfrac(i), & - lakfrac(i),cice(i), & - cmm_ocn(i), cmm_lnd(i), cmm_ice(i)) - chh(i) = cmposit3(ocnfrac(i),lndfrac(i), & - lakfrac(i),cice(i), & - chh_ocn(i), chh_lnd(i), chh_ice(i)) - gflx(i) = cmposit3(ocnfrac(i),lndfrac(i), & - lakfrac(i),cice(i), & - gflx_ocn(i), gflx_lnd(i), gflx_ice(i)) - ep1d(i) = cmposit3(ocnfrac(i),lndfrac(i), & - lakfrac(i),cice(i), & - ep1d_ocn(i), ep1d_lnd(i), ep1d_ice(i)) - weasd(i) = cmposit3(ocnfrac(i),lndfrac(i), & - lakfrac(i),cice(i), & - weasd(i), weasd_lnd(i), weasd_ice(i)) - snowd(i) = cmposit3(ocnfrac(i),lndfrac(i), & - lakfrac(i),cice(i), & - snowd_ocn(i), snowd_lnd(i), snowd_ice(i)) - tprcp(i) = cmposit3(ocnfrac(i),lndfrac(i), & - lakfrac(i),cice(i), & - tprcp_ocn(i), tprcp_lnd(i), tprcp_ice(i)) - - if(cplflx .and. flag_cice(i)) then ! 3-way when sfc_cice is used - evap(i) = cmposit3(ocnfrac(i),lndfrac(i), & - lakfrac(i),cice(i), & - evap_ocn(i), evap_lnd(i), evap_ice(i)) - hflx(i) = cmposit3(ocnfrac(i),lndfrac(i), & - lakfrac(i),cice(i), & - hflx_ocn(i), hflx_lnd(i), hflx_ice(i)) - qss(i) = cmposit3(ocnfrac(i),lndfrac(i), & - lakfrac(i),cice(i), & - qss_ocn(i), qss_lnd(i), qss_ice(i)) - tsfc(i) = cmposit3(ocnfrac(i),lndfrac(i), & - lakfrac(i),cice(i), & - tsfc_ocn(i), tsfc_lnd(i), tsfc_ice(i)) - else ! 2-way when sfc_sice used (fields already composited in sfc_sice) - evap(i) = cmposit2(ocnfrac(i),lndfrac(i), & - lakfrac(i),cice(i), & - evap_ocn(i), evap_lnd(i), evap_ice(i)) - hflx(i) = cmposit2(ocnfrac(i),lndfrac(i), & - lakfrac(i),cice(i), & - hflx_ocn(i), hflx_lnd(i), hflx_ice(i)) - qss(i) = cmposit2(ocnfrac(i),lndfrac(i), & - lakfrac(i),cice(i), & - qss_ocn(i), qss_lnd(i), qss_ice(i)) - tsfc(i) = cmposit2(ocnfrac(i),lndfrac(i), & - lakfrac(i),cice(i), & - tsfc_ocn(i), tsfc_lnd(i), tsfc_ice(i)) - if(icy(i)) then - cmm(i) = cmm_ice(i) - chh(i) = chh_ice(i) - gflx(i) = gflx_ice(i) - ep1d(i) = ep1d_ice(i) - weasd(i) = weasd_ice(i) - snowd(i) = snowd_ice(i) - end if - endif ! cplflx .and. flag_cice - - zorll(i) = zorl_lnd(i) - zorlo(i) = zorl_ocn(i) - - if (dry(i)) tsfcl(i) = tsfc_lnd(i) - if (wet(i)) then - tsfco(i) = tsfc_ocn(i) - tisfc(i) = tsfc_ice(i) - end if + if (frac_grid) then + + do i=1, im + + ! Three-way composites (fields from sfc_diff) + txl = landfrac(i) + txi = cice(i)*(one - txl) ! txi = ice fraction wrt whole cell + txo = max(zero, one - txl - txi) + + zorl(i) = txl*zorl_lnd(i) + txi*zorl_ice(i) + txo*zorl_ocn(i) + cd(i) = txl*cd_lnd(i) + txi*cd_ice(i) + txo*cd_ocn(i) + cdq(i) = txl*cdq_lnd(i) + txi*cdq_ice(i) + txo*cdq_ocn(i) + rb(i) = txl*rb_lnd(i) + txi*rb_ice(i) + txo*rb_ocn(i) + stress(i) = txl*stress_lnd(i) + txi*stress_ice(i) + txo*stress_ocn(i) + ffmm(i) = txl*ffmm_lnd(i) + txi*ffmm_ice(i) + txo*ffmm_ocn(i) + ffhh(i) = txl*ffhh_lnd(i) + txi*ffhh_ice(i) + txo*ffhh_ocn(i) + uustar(i) = txl*uustar_lnd(i) + txi*uustar_ice(i) + txo*uustar_ocn(i) + fm10(i) = txl*fm10_lnd(i) + txi*fm10_ice(i) + txo*fm10_ocn(i) + fh2(i) = txl*fh2_lnd(i) + txi*fh2_ice(i) + txo*fh2_ocn(i) + !tsurf(i) = txl*tsurf_lnd(i) + txi*tice(i) + txo*tsurf_ocn(i) + !tsurf(i) = txl*tsurf_lnd(i) + txi*tsurf_ice(i) + txo*tsurf_ocn(i) ! not used again! Moorthi + cmm(i) = txl*cmm_lnd(i) + txi*cmm_ice(i) + txo*cmm_ocn(i) + chh(i) = txl*chh_lnd(i) + txi*chh_ice(i) + txo*chh_ocn(i) + !gflx(i) = txl*gflx_lnd(i) + txi*gflx_ice(i) + txo*gflx_ocn(i) + ep1d(i) = txl*ep1d_lnd(i) + txi*ep1d_ice(i) + txo*ep1d_ocn(i) + !weasd(i) = txl*weasd_lnd(i) + txi*weasd_ice(i) + txo*weasd_ocn(i) + !snowd(i) = txl*snowd_lnd(i) + txi*snowd_ice(i) + txo*snowd_ocn(i) + weasd(i) = txl*weasd_lnd(i) + txi*weasd_ice(i) + snowd(i) = txl*snowd_lnd(i) + txi*snowd_ice(i) + !tprcp(i) = txl*tprcp_lnd(i) + txi*tprcp_ice(i) + txo*tprcp_ocn(i) + + if (.not. flag_cice(i) .and. islmsk(i) == 2) then + tem = one - txl + evap(i) = txl*evap_lnd(i) + tem*evap_ice(i) + hflx(i) = txl*hflx_lnd(i) + tem*hflx_ice(i) + qss(i) = txl*qss_lnd(i) + tem*qss_ice(i) + gflx(i) = txl*gflx_lnd(i) + tem*gflx_ice(i) + else + evap(i) = txl*evap_lnd(i) + tem*evap_ice(i) + txo*evap_ocn(i) + hflx(i) = txl*hflx_lnd(i) + tem*hflx_ice(i) + txo*hflx_ocn(i) + qss(i) = txl*qss_lnd(i) + tem*qss_ice(i) + txo*qss_ocn(i) + gflx(i) = txl*gflx_lnd(i) + tem*gflx_ice(i) + txo*gflx_ocn(i) + endif + tsfc(i) = txl*tsfc_lnd(i) + txi*tice(i) + txo*tsfc_ocn(i) + + zorll(i) = zorl_lnd(i) + zorlo(i) = zorl_ocn(i) + + if (dry(i)) tsfcl(i) = tsfc_lnd(i) ! over land + if (wet(i)) tsfco(i) = tsfc_ocn(i) ! over lake or ocean when uncoupled + ! for coupled model ocean will replace this +! if (icy(i)) tisfc(i) = tsfc_ice(i) ! over ice when uncoupled +! if (icy(i)) tisfc(i) = tice(i) ! over ice when uncoupled + +! if (wet(i) .and. .not. cplflx) then +! tsfco(i) = tsfc_ocn(i) ! over lake or ocean when uncoupled +! tisfc(i) = tsfc_ice(i) ! over ice when uncoupled +! endif + + if (.not. flag_cice(i)) then + if (islmsk(i) == 2) then ! return updated lake ice thickness & concentration to global array + tisfc(i) = tice(i) + else ! this would be over open ocean or land (no ice fraction) + hice(i) = zero + cice(i) = zero + tisfc(i) = tsfc(i) + endif + endif + enddo - ! DH* - !write(0,'(i5,5(1x,l),11e16.7)') i, cplflx, flag_cice(i), dry(i), wet(i), icy(i), & - ! ocnfrac(i), lndfrac(i), lakfrac(i), & - ! cice(i), tsfc_lnd(i), tsfc_ocn(i), tsfc_ice(i), & - ! tsfc(i), tsfcl(i), tsfco(i), tisfc(i) - ! *DH + else - end do + do i=1,im + if (islmsk(i) == 1) then + zorl(i) = zorl_lnd(i) + cd(i) = cd_lnd(i) + cdq(i) = cdq_lnd(i) + rb(i) = rb_lnd(i) + stress(i) = stress_lnd(i) + ffmm(i) = ffmm_lnd(i) + ffhh(i) = ffhh_lnd(i) + uustar(i) = uustar_lnd(i) + fm10(i) = fm10_lnd(i) + fh2(i) = fh2_lnd(i) + !tsurf(i) = tsurf_lnd(i) + tsfcl(i) = tsfc_lnd(i) + cmm(i) = cmm_lnd(i) + chh(i) = chh_lnd(i) + gflx(i) = gflx_lnd(i) + ep1d(i) = ep1d_lnd(i) + weasd(i) = weasd_lnd(i) + snowd(i) = snowd_lnd(i) + !tprcp(i) = tprcp_lnd(i) + evap(i) = evap_lnd(i) + hflx(i) = hflx_lnd(i) + qss(i) = qss_lnd(i) + tsfc(i) = tsfc_lnd(i) + hice(i) = zero + cice(i) = zero + tisfc(i) = tsfc(i) + elseif (islmsk(i) == 0) then + zorl(i) = zorl_ocn(i) + cd(i) = cd_ocn(i) + cdq(i) = cdq_ocn(i) + rb(i) = rb_ocn(i) + stress(i) = stress_ocn(i) + ffmm(i) = ffmm_ocn(i) + ffhh(i) = ffhh_ocn(i) + uustar(i) = uustar_ocn(i) + fm10(i) = fm10_ocn(i) + fh2(i) = fh2_ocn(i) + !tsurf(i) = tsurf_ocn(i) + tsfco(i) = tsfc_ocn(i) + cmm(i) = cmm_ocn(i) + chh(i) = chh_ocn(i) + gflx(i) = gflx_ocn(i) + ep1d(i) = ep1d_ocn(i) + weasd(i) = weasd_ocn(i) + snowd(i) = snowd_ocn(i) + !tprcp(i) = tprcp_ocn(i) + evap(i) = evap_ocn(i) + hflx(i) = hflx_ocn(i) + qss(i) = qss_ocn(i) + tsfc(i) = tsfc_ocn(i) + hice(i) = zero + cice(i) = zero + tisfc(i) = tsfc(i) + else + zorl(i) = zorl_ice(i) + cd(i) = cd_ice(i) + cdq(i) = cdq_ice(i) + rb(i) = rb_ice(i) + stress(i) = cice(i)*stress_ice(i) + (one-cice(i))*stress_ocn(i) + ffmm(i) = ffmm_ice(i) + ffhh(i) = ffhh_ice(i) + uustar(i) = uustar_ice(i) + fm10(i) = fm10_ice(i) + fh2(i) = fh2_ice(i) + !tsurf(i) = tsurf_ice(i) + cmm(i) = cmm_ice(i) + chh(i) = chh_ice(i) + gflx(i) = gflx_ice(i) + ep1d(i) = ep1d_ice(i) + weasd(i) = weasd_ice(i) + snowd(i) = snowd_ice(i) + qss(i) = qss_ice(i) + if (flag_cice(i)) then ! this was already done for lake ice in sfc_sice + txi = cice(i) + txo = one - txi + evap(i) = txi * evap_ice(i) + txo * evap_ocn(i) + hflx(i) = txi * hflx_ice(i) + txo * hflx_ocn(i) + tsfc(i) = txi * tsfc_ice(i) + txo * tsfc_ocn(i) + else + evap(i) = evap_ice(i) + hflx(i) = hflx_ice(i) + tsfc(i) = tsfc_ice(i) + tisfc(i) = tice(i) + endif + endif + + zorll(i) = zorl_lnd(i) + zorlo(i) = zorl_ocn(i) + + enddo + + endif ! if (frac_grid) ! --- compositing done end subroutine GFS_surface_composites_post_run - - real function cmposit2(frac_ocean,frac_dry,frac_lake,frac_ice,oceanval,landval,iceval) -! --- 2-way compositing (use with ice/non-ice composited variables) - implicit none - real(kind=kind_phys),intent(IN) :: frac_ocean,frac_dry,frac_lake,frac_ice,oceanval,landval,iceval - real(kind=kind_phys) :: frac_wet - - frac_wet=max(frac_lake,frac_ocean) - if (frac_ice.eq.0.) then - cmposit2 = frac_dry*landval + frac_wet*oceanval - else - cmposit2 = frac_dry*landval + frac_wet*iceval - end if - return - end function cmposit2 - - - real function cmposit3(frac_ocean,frac_dry,frac_lake,frac_ice,oceanval,landval,iceval) -! --- 3-way compositing - implicit none - real(kind=kind_phys),intent(IN) :: frac_ocean,frac_dry,frac_lake,frac_ice,oceanval,landval,iceval - - if (frac_dry == 0.0 .and. iceval == oceanval) then - cmposit3 = oceanval - else - cmposit3 = frac_dry*landval + frac_ice*iceval + (1.-frac_dry-frac_ice)*oceanval - endif - - return - end function cmposit3 - end module GFS_surface_composites_post diff --git a/physics/GFS_surface_composites.meta b/physics/GFS_surface_composites.meta new file mode 100644 index 000000000..832d9227e --- /dev/null +++ b/physics/GFS_surface_composites.meta @@ -0,0 +1,1669 @@ +[ccpp-arg-table] + name = GFS_surface_composites_pre_run + type = scheme +[im] + standard_name = horizontal_loop_extent + long_name = horizontal loop extent + units = count + dimensions = () + type = integer + intent = in + optional = F +[frac_grid] + standard_name = flag_for_fractional_grid + long_name = flag for fractional grid + units = flag + dimensions = () + type = logical + intent = in + optional = F +[flag_cice] + standard_name = flag_for_cice + long_name = flag for cice + units = flag + dimensions = (horizontal_dimension) + type = logical + intent = in + optional = F +[cplflx] + standard_name = flag_for_flux_coupling + long_name = flag controlling cplflx collection (default off) + units = flag + dimensions = () + type = logical + intent = in + optional = F +[cplwav2atm] + standard_name = flag_for_wave_coupling_to_atm + long_name = flag controlling ocean wave coupling to the atmosphere (default off) + units = flag + dimensions = () + type = logical + intent = in + optional = F +[landfrac] + standard_name = land_area_fraction + long_name = fraction of horizontal grid area occupied by land + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[lakefrac] + standard_name = lake_area_fraction + long_name = fraction of horizontal grid area occupied by lake + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[oceanfrac] + standard_name = sea_area_fraction + long_name = fraction of horizontal grid area occupied by ocean + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[frland] + standard_name = land_area_fraction_for_microphysics + long_name = land area fraction used in microphysics schemes + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[dry] + standard_name = flag_nonzero_land_surface_fraction + long_name = flag indicating presence of some land surface area fraction + units = flag + dimensions = (horizontal_dimension) + type = logical + intent = inout + optional = F +[icy] + standard_name = flag_nonzero_sea_ice_surface_fraction + long_name = flag indicating presence of some sea ice surface area fraction + units = flag + dimensions = (horizontal_dimension) + type = logical + intent = inout + optional = F +[lake] + standard_name = flag_nonzero_lake_surface_fraction + long_name = flag indicating presence of some lake surface area fraction + units = flag + dimensions = (horizontal_dimension) + type = logical + intent = inout + optional = F +[ocean] + standard_name = flag_nonzero_ocean_surface_fraction + long_name = flag indicating presence of some ocean surface area fraction + units = flag + dimensions = (horizontal_dimension) + type = logical + intent = inout + optional = F +[wet] + standard_name = flag_nonzero_wet_surface_fraction + long_name = flag indicating presence of some ocean or lake surface area fraction + units = flag + dimensions = (horizontal_dimension) + type = logical + intent = inout + optional = F +[cice] + standard_name = sea_ice_concentration + long_name = ice fraction over open water + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[cimin] + standard_name = minimum_sea_ice_concentration + long_name = minimum sea ice concentration + units = frac + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[zorl] + standard_name = surface_roughness_length + long_name = surface roughness length + units = cm + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[zorlo] + standard_name = surface_roughness_length_over_ocean + long_name = surface roughness length over ocean + units = cm + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[zorll] + standard_name = surface_roughness_length_over_land + long_name = surface roughness length over land + units = cm + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[zorl_ocn] + standard_name = surface_roughness_length_over_ocean_interstitial + long_name = surface roughness length over ocean (temporary use as interstitial) + units = cm + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[zorl_lnd] + standard_name = surface_roughness_length_over_land_interstitial + long_name = surface roughness length over land (temporary use as interstitial) + units = cm + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[zorl_ice] + standard_name = surface_roughness_length_over_ice_interstitial + long_name = surface roughness length over ice (temporary use as interstitial) + units = cm + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[snowd] + standard_name = surface_snow_thickness_water_equivalent + long_name = water equivalent snow depth + units = mm + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[snowd_ocn] + standard_name = surface_snow_thickness_water_equivalent_over_ocean + long_name = water equivalent snow depth over ocean + units = mm + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[snowd_lnd] + standard_name = surface_snow_thickness_water_equivalent_over_land + long_name = water equivalent snow depth over land + units = mm + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[snowd_ice] + standard_name = surface_snow_thickness_water_equivalent_over_ice + long_name = water equivalent snow depth over ice + units = mm + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[tprcp] + standard_name = nonnegative_lwe_thickness_of_precipitation_amount_on_dynamics_timestep + long_name = total precipitation amount in each time step + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[tprcp_ocn] + standard_name = nonnegative_lwe_thickness_of_precipitation_amount_on_dynamics_timestep_over_ocean + long_name = total precipitation amount in each time step over ocean + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[tprcp_lnd] + standard_name = nonnegative_lwe_thickness_of_precipitation_amount_on_dynamics_timestep_over_land + long_name = total precipitation amount in each time step over land + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[tprcp_ice] + standard_name = nonnegative_lwe_thickness_of_precipitation_amount_on_dynamics_timestep_over_ice + long_name = total precipitation amount in each time step over ice + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[uustar] + standard_name = surface_friction_velocity + long_name = boundary layer parameter + units = m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[uustar_lnd] + standard_name = surface_friction_velocity_over_land + long_name = surface friction velocity over land + units = m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[uustar_ice] + standard_name = surface_friction_velocity_over_ice + long_name = surface friction velocity over ice + units = m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[weasd] + standard_name = water_equivalent_accumulated_snow_depth + long_name = water equiv of acc snow depth over land and sea ice + units = mm + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[weasd_ocn] + standard_name = water_equivalent_accumulated_snow_depth_over_ocean + long_name = water equiv of acc snow depth over ocean + units = mm + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[weasd_lnd] + standard_name = water_equivalent_accumulated_snow_depth_over_land + long_name = water equiv of acc snow depth over land + units = mm + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[weasd_ice] + standard_name = water_equivalent_accumulated_snow_depth_over_ice + long_name = water equiv of acc snow depth over ice + units = mm + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[ep1d_ice] + standard_name = surface_upward_potential_latent_heat_flux_over_ice + long_name = surface upward potential latent heat flux over ice + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[tsfc] + standard_name = surface_skin_temperature + long_name = surface skin temperature + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[tsfco] + standard_name = sea_surface_temperature + long_name = sea surface temperature + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[tsfcl] + standard_name = surface_skin_temperature_over_land + long_name = surface skin temperature over land + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[tsfc_ocn] + standard_name = surface_skin_temperature_over_ocean_interstitial + long_name = surface skin temperature over ocean (temporary use as interstitial) + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[tsfc_lnd] + standard_name = surface_skin_temperature_over_land_interstitial + long_name = surface skin temperature over land (temporary use as interstitial) + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[tsfc_ice] + standard_name = surface_skin_temperature_over_ice_interstitial + long_name = surface skin temperature over ice (temporary use as interstitial) + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[tisfc] + standard_name = sea_ice_temperature + long_name = sea ice surface skin temperature + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[tice] + standard_name = sea_ice_temperature_interstitial + long_name = sea ice surface skin temperature use as interstitial + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[tsurf] + standard_name = surface_skin_temperature_after_iteration + long_name = surface skin temperature after iteration + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[tsurf_ocn] + standard_name = surface_skin_temperature_after_iteration_over_ocean + long_name = surface skin temperature after iteration over ocean + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[tsurf_lnd] + standard_name = surface_skin_temperature_after_iteration_over_land + long_name = surface skin temperature after iteration over land + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[tsurf_ice] + standard_name = surface_skin_temperature_after_iteration_over_ice + long_name = surface skin temperature after iteration over ice + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[gflx_ice] + standard_name = upward_heat_flux_in_soil_over_ice + long_name = soil heat flux over ice + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[tgice] + standard_name = freezing_point_temperature_of_seawater + long_name = freezing point temperature of seawater + units = K + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[islmsk] + standard_name = sea_land_ice_mask + long_name = sea/land/ice mask (=0/1/2) + units = flag + dimensions = (horizontal_dimension) + type = integer + intent = in + optional = F +[semis_rad] + standard_name = surface_longwave_emissivity + long_name = surface lw emissivity in fraction + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[semis_ocn] + standard_name = surface_longwave_emissivity_over_ocean_interstitial + long_name = surface lw emissivity in fraction over ocean (temporary use as interstitial) + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[semis_lnd] + standard_name = surface_longwave_emissivity_over_land_interstitial + long_name = surface lw emissivity in fraction over land (temporary use as interstitial) + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[semis_ice] + standard_name = surface_longwave_emissivity_over_ice_interstitial + long_name = surface lw emissivity in fraction over ice (temporary use as interstitial) + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[min_lakeice] + standard_name = lake_ice_minimum + long_name = minimum lake ice value + units = ??? + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[min_seaice] + standard_name = sea_ice_minimum + long_name = minimum sea ice value + units = ??? + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F + +######################################################################## +[ccpp-arg-table] + name = GFS_surface_composites_inter_run + type = scheme +[im] + standard_name = horizontal_loop_extent + long_name = horizontal loop extent + units = count + dimensions = () + type = integer + intent = in + optional = F +[dry] + standard_name = flag_nonzero_land_surface_fraction + long_name = flag indicating presence of some land surface area fraction + units = flag + dimensions = (horizontal_dimension) + type = logical + intent = in + optional = F +[icy] + standard_name = flag_nonzero_sea_ice_surface_fraction + long_name = flag indicating presence of some sea ice surface area fraction + units = flag + dimensions = (horizontal_dimension) + type = logical + intent = in + optional = F +[wet] + standard_name = flag_nonzero_wet_surface_fraction + long_name = flag indicating presence of some ocean or lake surface area fraction + units = flag + dimensions = (horizontal_dimension) + type = logical + intent = in + optional = F +[semis_ocn] + standard_name = surface_longwave_emissivity_over_ocean_interstitial + long_name = surface lw emissivity in fraction over ocean (temporary use as interstitial) + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[semis_lnd] + standard_name = surface_longwave_emissivity_over_land_interstitial + long_name = surface lw emissivity in fraction over land (temporary use as interstitial) + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[semis_ice] + standard_name = surface_longwave_emissivity_over_ice_interstitial + long_name = surface lw emissivity in fraction over ice (temporary use as interstitial) + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[adjsfcdlw] + standard_name = surface_downwelling_longwave_flux + long_name = surface downwelling longwave flux at current time + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[gabsbdlw_lnd] + standard_name = surface_downwelling_longwave_flux_absorbed_by_ground_over_land + long_name = total sky surface downward longwave flux absorbed by the ground over land + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[gabsbdlw_ice] + standard_name = surface_downwelling_longwave_flux_absorbed_by_ground_over_ice + long_name = total sky surface downward longwave flux absorbed by the ground over ice + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[gabsbdlw_ocn] + standard_name = surface_downwelling_longwave_flux_absorbed_by_ground_over_ocean + long_name = total sky surface downward longwave flux absorbed by the ground over ocean + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[adjsfcdsw] + standard_name = surface_downwelling_shortwave_flux + long_name = surface downwelling shortwave flux at current time + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[adjsfcnsw] + standard_name = surface_net_downwelling_shortwave_flux + long_name = surface net downwelling shortwave flux at current time + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[adjsfcusw] + standard_name = surface_upwelling_shortwave_flux + long_name = surface upwelling shortwave flux at current time + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F + +######################################################################## +[ccpp-arg-table] + name = GFS_surface_composites_post_run + type = scheme +[im] + standard_name = horizontal_loop_extent + long_name = horizontal loop extent + units = count + dimensions = () + type = integer + intent = in + optional = F +[cplflx] + standard_name = flag_for_flux_coupling + long_name = flag controlling cplflx collection (default off) + units = flag + dimensions = () + type = logical + intent = in + optional = F +[cplwav2atm] + standard_name = flag_for_wave_coupling_to_atm + long_name = flag controlling ocean wave coupling to the atmosphere (default off) + units = flag + dimensions = () + type = logical + intent = in + optional = F +[frac_grid] + standard_name = flag_for_fractional_grid + long_name = flag for fractional grid + units = flag + dimensions = () + type = logical + intent = in + optional = F +[flag_cice] + standard_name = flag_for_cice + long_name = flag for cice + units = flag + dimensions = (horizontal_dimension) + type = logical + intent = in + optional = F +[islmsk] + standard_name = sea_land_ice_mask + long_name = sea/land/ice mask (=0/1/2) + units = flag + dimensions = (horizontal_dimension) + type = integer + intent = in + optional = F +[dry] + standard_name = flag_nonzero_land_surface_fraction + long_name = flag indicating presence of some land surface area fraction + units = flag + dimensions = (horizontal_dimension) + type = logical + intent = in + optional = F +[wet] + standard_name = flag_nonzero_wet_surface_fraction + long_name = flag indicating presence of some ocean or lake surface area fraction + units = flag + dimensions = (horizontal_dimension) + type = logical + intent = in + optional = F +[icy] + standard_name = flag_nonzero_sea_ice_surface_fraction + long_name = flag indicating presence of some sea ice surface area fraction + units = flag + dimensions = (horizontal_dimension) + type = logical + intent = in + optional = F +[landfrac] + standard_name = land_area_fraction + long_name = fraction of horizontal grid area occupied by land + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[lakefrac] + standard_name = lake_area_fraction + long_name = fraction of horizontal grid area occupied by lake + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[oceanfrac] + standard_name = sea_area_fraction + long_name = fraction of horizontal grid area occupied by ocean + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[zorl] + standard_name = surface_roughness_length + long_name = surface roughness length + units = cm + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[zorlo] + standard_name = surface_roughness_length_over_ocean + long_name = surface roughness length over ocean + units = cm + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[zorll] + standard_name = surface_roughness_length_over_land + long_name = surface roughness length over land + units = cm + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[zorl_ocn] + standard_name = surface_roughness_length_over_ocean_interstitial + long_name = surface roughness length over ocean (temporary use as interstitial) + units = cm + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[zorl_lnd] + standard_name = surface_roughness_length_over_land_interstitial + long_name = surface roughness length over land (temporary use as interstitial) + units = cm + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[zorl_ice] + standard_name = surface_roughness_length_over_ice_interstitial + long_name = surface roughness length over ice (temporary use as interstitial) + units = cm + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[cd] + standard_name = surface_drag_coefficient_for_momentum_in_air + long_name = surface exchange coeff for momentum + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[cd_ocn] + standard_name = surface_drag_coefficient_for_momentum_in_air_over_ocean + long_name = surface exchange coeff for momentum over ocean + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[cd_lnd] + standard_name = surface_drag_coefficient_for_momentum_in_air_over_land + long_name = surface exchange coeff for momentum over land + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[cd_ice] + standard_name = surface_drag_coefficient_for_momentum_in_air_over_ice + long_name = surface exchange coeff for momentum over ice + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[cdq] + standard_name = surface_drag_coefficient_for_heat_and_moisture_in_air + long_name = surface exchange coeff heat & moisture + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[cdq_ocn] + standard_name = surface_drag_coefficient_for_heat_and_moisture_in_air_over_ocean + long_name = surface exchange coeff heat & moisture over ocean + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[cdq_lnd] + standard_name = surface_drag_coefficient_for_heat_and_moisture_in_air_over_land + long_name = surface exchange coeff heat & moisture over land + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[cdq_ice] + standard_name = surface_drag_coefficient_for_heat_and_moisture_in_air_over_ice + long_name = surface exchange coeff heat & moisture over ice + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[rb] + standard_name = bulk_richardson_number_at_lowest_model_level + long_name = bulk Richardson number at the surface + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[rb_ocn] + standard_name = bulk_richardson_number_at_lowest_model_level_over_ocean + long_name = bulk Richardson number at the surface over ocean + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[rb_lnd] + 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_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[rb_ice] + standard_name = bulk_richardson_number_at_lowest_model_level_over_ice + long_name = bulk Richardson number at the surface over ice + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[stress] + standard_name = surface_wind_stress + long_name = surface wind stress + units = m2 s-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[stress_ocn] + standard_name = surface_wind_stress_over_ocean + long_name = surface wind stress over ocean + units = m2 s-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[stress_lnd] + standard_name = surface_wind_stress_over_land + long_name = surface wind stress over land + units = m2 s-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[stress_ice] + standard_name = surface_wind_stress_over_ice + long_name = surface wind stress over ice + units = m2 s-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[ffmm] + standard_name = Monin_Obukhov_similarity_function_for_momentum + long_name = Monin-Obukhov similarity function for momentum + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[ffmm_ocn] + standard_name = Monin_Obukhov_similarity_function_for_momentum_over_ocean + long_name = Monin-Obukhov similarity function for momentum over ocean + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[ffmm_lnd] + standard_name = Monin_Obukhov_similarity_function_for_momentum_over_land + long_name = Monin-Obukhov similarity function for momentum over land + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[ffmm_ice] + standard_name = Monin_Obukhov_similarity_function_for_momentum_over_ice + long_name = Monin-Obukhov similarity function for momentum over ice + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[ffhh] + standard_name = Monin_Obukhov_similarity_function_for_heat + long_name = Monin-Obukhov similarity function for heat + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[ffhh_ocn] + standard_name = Monin_Obukhov_similarity_function_for_heat_over_ocean + long_name = Monin-Obukhov similarity function for heat over ocean + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[ffhh_lnd] + standard_name = Monin_Obukhov_similarity_function_for_heat_over_land + long_name = Monin-Obukhov similarity function for heat over land + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[ffhh_ice] + standard_name = Monin_Obukhov_similarity_function_for_heat_over_ice + long_name = Monin-Obukhov similarity function for heat over ice + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[uustar] + standard_name = surface_friction_velocity + long_name = boundary layer parameter + units = m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[uustar_ocn] + standard_name = surface_friction_velocity_over_ocean + long_name = surface friction velocity over ocean + units = m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[uustar_lnd] + standard_name = surface_friction_velocity_over_land + long_name = surface friction velocity over land + units = m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[uustar_ice] + standard_name = surface_friction_velocity_over_ice + long_name = surface friction velocity over ice + units = m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[fm10] + standard_name = Monin_Obukhov_similarity_function_for_momentum_at_10m + long_name = Monin-Obukhov similarity parameter for momentum at 10m + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[fm10_ocn] + standard_name = Monin_Obukhov_similarity_function_for_momentum_at_10m_over_ocean + long_name = Monin-Obukhov similarity parameter for momentum at 10m over ocean + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[fm10_lnd] + 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_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[fm10_ice] + standard_name = Monin_Obukhov_similarity_function_for_momentum_at_10m_over_ice + long_name = Monin-Obukhov similarity parameter for momentum at 10m over ice + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[fh2] + standard_name = Monin_Obukhov_similarity_function_for_heat_at_2m + long_name = Monin-Obukhov similarity parameter for heat at 2m + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[fh2_ocn] + standard_name = Monin_Obukhov_similarity_function_for_heat_at_2m_over_ocean + long_name = Monin-Obukhov similarity parameter for heat at 2m over ocean + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[fh2_lnd] + 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_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[fh2_ice] + standard_name = Monin_Obukhov_similarity_function_for_heat_at_2m_over_ice + long_name = Monin-Obukhov similarity parameter for heat at 2m over ice + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[tsurf] + standard_name = surface_skin_temperature_after_iteration + long_name = surface skin temperature after iteration + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[tsurf_ocn] + standard_name = surface_skin_temperature_after_iteration_over_ocean + long_name = surface skin temperature after iteration over ocean + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[tsurf_lnd] + standard_name = surface_skin_temperature_after_iteration_over_land + long_name = surface skin temperature after iteration over land + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[tsurf_ice] + standard_name = surface_skin_temperature_after_iteration_over_ice + long_name = surface skin temperature after iteration over ice + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[cmm] + standard_name = surface_drag_wind_speed_for_momentum_in_air + long_name = momentum exchange coefficient + units = m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[cmm_ocn] + standard_name = surface_drag_wind_speed_for_momentum_in_air_over_ocean + long_name = momentum exchange coefficient over ocean + units = m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[cmm_lnd] + standard_name = surface_drag_wind_speed_for_momentum_in_air_over_land + long_name = momentum exchange coefficient over land + units = m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[cmm_ice] + standard_name = surface_drag_wind_speed_for_momentum_in_air_over_ice + long_name = momentum exchange coefficient over ice + units = m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[chh] + standard_name = surface_drag_mass_flux_for_heat_and_moisture_in_air + long_name = thermal exchange coefficient + units = kg m-2 s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[chh_ocn] + standard_name = surface_drag_mass_flux_for_heat_and_moisture_in_air_over_ocean + long_name = thermal exchange coefficient over ocean + units = kg m-2 s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[chh_lnd] + standard_name = surface_drag_mass_flux_for_heat_and_moisture_in_air_over_land + long_name = thermal exchange coefficient over land + units = kg m-2 s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[chh_ice] + standard_name = surface_drag_mass_flux_for_heat_and_moisture_in_air_over_ice + long_name = thermal exchange coefficient over ice + units = kg m-2 s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[gflx] + standard_name = upward_heat_flux_in_soil + long_name = soil heat flux + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[gflx_ocn] + standard_name = upward_heat_flux_in_soil_over_ocean + long_name = soil heat flux over ocean + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[gflx_lnd] + standard_name = upward_heat_flux_in_soil_over_land + long_name = soil heat flux over land + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[gflx_ice] + standard_name = upward_heat_flux_in_soil_over_ice + long_name = soil heat flux over ice + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[ep1d] + standard_name = surface_upward_potential_latent_heat_flux + long_name = surface upward potential latent heat flux + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[ep1d_ocn] + standard_name = surface_upward_potential_latent_heat_flux_over_ocean + long_name = surface upward potential latent heat flux over ocean + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[ep1d_lnd] + standard_name = surface_upward_potential_latent_heat_flux_over_land + long_name = surface upward potential latent heat flux over land + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[ep1d_ice] + standard_name = surface_upward_potential_latent_heat_flux_over_ice + long_name = surface upward potential latent heat flux over ice + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[weasd] + standard_name = water_equivalent_accumulated_snow_depth + long_name = water equiv of acc snow depth over land and sea ice + units = mm + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[weasd_ocn] + standard_name = water_equivalent_accumulated_snow_depth_over_ocean + long_name = water equiv of acc snow depth over ocean + units = mm + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[weasd_lnd] + standard_name = water_equivalent_accumulated_snow_depth_over_land + long_name = water equiv of acc snow depth over land + units = mm + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[weasd_ice] + standard_name = water_equivalent_accumulated_snow_depth_over_ice + long_name = water equiv of acc snow depth over ice + units = mm + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[snowd] + standard_name = surface_snow_thickness_water_equivalent + long_name = water equivalent snow depth + units = mm + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[snowd_ocn] + standard_name = surface_snow_thickness_water_equivalent_over_ocean + long_name = water equivalent snow depth over ocean + units = mm + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[snowd_lnd] + standard_name = surface_snow_thickness_water_equivalent_over_land + long_name = water equivalent snow depth over land + units = mm + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[snowd_ice] + standard_name = surface_snow_thickness_water_equivalent_over_ice + long_name = water equivalent snow depth over ice + units = mm + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[tprcp] + standard_name = nonnegative_lwe_thickness_of_precipitation_amount_on_dynamics_timestep + long_name = total precipitation amount in each time step + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[tprcp_ocn] + standard_name = nonnegative_lwe_thickness_of_precipitation_amount_on_dynamics_timestep_over_ocean + long_name = total precipitation amount in each time step over ocean + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[tprcp_lnd] + standard_name = nonnegative_lwe_thickness_of_precipitation_amount_on_dynamics_timestep_over_land + long_name = total precipitation amount in each time step over land + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[tprcp_ice] + standard_name = nonnegative_lwe_thickness_of_precipitation_amount_on_dynamics_timestep_over_ice + long_name = total precipitation amount in each time step over ice + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[evap] + standard_name = kinematic_surface_upward_latent_heat_flux + long_name = kinematic surface upward latent heat flux + units = kg kg-1 m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[evap_ocn] + standard_name = kinematic_surface_upward_latent_heat_flux_over_ocean + long_name = kinematic surface upward latent heat flux over ocean + units = kg kg-1 m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[evap_lnd] + standard_name = kinematic_surface_upward_latent_heat_flux_over_land + long_name = kinematic surface upward latent heat flux over land + units = kg kg-1 m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[evap_ice] + standard_name = kinematic_surface_upward_latent_heat_flux_over_ice + long_name = kinematic surface upward latent heat flux over ice + units = kg kg-1 m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[hflx] + standard_name = kinematic_surface_upward_sensible_heat_flux + long_name = kinematic surface upward sensible heat flux + units = K m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[hflx_ocn] + standard_name = kinematic_surface_upward_sensible_heat_flux_over_ocean + long_name = kinematic surface upward sensible heat flux over ocean + units = K m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[hflx_lnd] + standard_name = kinematic_surface_upward_sensible_heat_flux_over_land + long_name = kinematic surface upward sensible heat flux over land + units = K m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[hflx_ice] + standard_name = kinematic_surface_upward_sensible_heat_flux_over_ice + long_name = kinematic surface upward sensible heat flux over ice + units = K m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[qss] + standard_name = surface_specific_humidity + long_name = surface air saturation specific humidity + units = kg kg-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[qss_ocn] + standard_name = surface_specific_humidity_over_ocean + long_name = surface air saturation specific humidity over ocean + units = kg kg-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[qss_lnd] + standard_name = surface_specific_humidity_over_land + long_name = surface air saturation specific humidity over land + units = kg kg-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[qss_ice] + standard_name = surface_specific_humidity_over_ice + long_name = surface air saturation specific humidity over ice + units = kg kg-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[tsfc] + standard_name = surface_skin_temperature + long_name = surface skin temperature + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[tsfco] + standard_name = sea_surface_temperature + long_name = sea surface temperature + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[tsfcl] + standard_name = surface_skin_temperature_over_land + long_name = surface skin temperature over land + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[tsfc_ocn] + standard_name = surface_skin_temperature_over_ocean_interstitial + long_name = surface skin temperature over ocean (temporary use as interstitial) + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[tsfc_lnd] + standard_name = surface_skin_temperature_over_land_interstitial + long_name = surface skin temperature over land (temporary use as interstitial) + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[tsfc_ice] + standard_name = surface_skin_temperature_over_ice_interstitial + long_name = surface skin temperature over ice (temporary use as interstitial) + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[tisfc] + standard_name = sea_ice_temperature + long_name = sea ice surface skin temperature + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[tice] + standard_name = sea_ice_temperature_interstitial + long_name = sea ice surface skin temperature use as interstitial + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[hice] + standard_name = sea_ice_thickness + long_name = sea ice thickness + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[cice] + standard_name = sea_ice_concentration + long_name = ice fraction over open water + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F diff --git a/physics/GFS_surface_generic.F90 b/physics/GFS_surface_generic.F90 index 42fe8c646..108d3bee7 100644 --- a/physics/GFS_surface_generic.F90 +++ b/physics/GFS_surface_generic.F90 @@ -3,10 +3,17 @@ module GFS_surface_generic_pre + use machine, only: kind_phys + + implicit none + private public GFS_surface_generic_pre_init, GFS_surface_generic_pre_finalize, GFS_surface_generic_pre_run + real(kind=kind_phys), parameter :: one = 1.0d0 + real(kind=kind_phys), parameter :: zero = 0.0d0 + contains subroutine GFS_surface_generic_pre_init () @@ -15,65 +22,19 @@ end subroutine GFS_surface_generic_pre_init subroutine GFS_surface_generic_pre_finalize() end subroutine GFS_surface_generic_pre_finalize -#if 0 !> \section arg_table_GFS_surface_generic_pre_run Argument Table -!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | -!! |----------------|------------------------------------------------------------------------------|------------------------------------------------------------------|------------|------|-----------|-----------|--------|----------| -!! | im | horizontal_loop_extent | horizontal loop extent | count | 0 | integer | | in | F | -!! | levs | vertical_dimension | number of vertical levels | count | 0 | integer | | in | F | -!! | vfrac | vegetation_area_fraction | areal fractional cover of green vegetation | frac | 1 | real | kind_phys | in | F | -!! | islmsk | sea_land_ice_mask | landmask: sea/land/ice=0/1/2 | flag | 1 | integer | | in | F | -!! | isot | soil_type_dataset_choice | soil type dataset choice | index | 0 | integer | | in | F | -!! | ivegsrc | vegetation_type_dataset_choice | land use dataset choice | index | 0 | integer | | in | F | -!! | stype | soil_type_classification_real | soil type for lsm | index | 1 | real | kind_phys | in | F | -!! | vtype | vegetation_type_classification_real | vegetation type for lsm | index | 1 | real | kind_phys | in | F | -!! | slope | surface_slope_classification_real | sfc slope type for lsm | index | 1 | real | kind_phys | in | F | -!! | prsik_1 | dimensionless_exner_function_at_lowest_model_interface | dimensionless Exner function at lowest model interface | none | 1 | real | kind_phys | in | F | -!! | prslk_1 | dimensionless_exner_function_at_lowest_model_layer | dimensionless Exner function at lowest model layer | none | 1 | real | kind_phys | in | F | -!! | semis | surface_longwave_emissivity | surface lw emissivity in fraction | frac | 1 | real | kind_phys | in | F | -!! | adjsfcdlw | surface_downwelling_longwave_flux | surface downwelling longwave flux at current time | W m-2 | 1 | real | kind_phys | in | F | -!! | tsfc | surface_skin_temperature | surface skin temperature | K | 1 | real | kind_phys | in | F | -!! | phil | geopotential | geopotential at model layer centers | m2 s-2 | 2 | real | kind_phys | in | F | -!! | con_g | gravitational_acceleration | gravitational acceleration | m s-2 | 0 | real | kind_phys | in | F | -!! | sigmaf | bounded_vegetation_area_fraction | areal fractional cover of green vegetation bounded on the bottom | frac | 1 | real | kind_phys | inout | F | -!! | soiltyp | soil_type_classification | soil type at each grid cell | index | 1 | integer | | inout | F | -!! | vegtype | vegetation_type_classification | vegetation type at each grid cell | index | 1 | integer | | inout | F | -!! | slopetyp | surface_slope_classification | surface slope type at each grid cell | index | 1 | integer | | inout | F | -!! | work3 | ratio_of_exner_function_between_midlayer_and_interface_at_lowest_model_layer | Exner function ratio bt midlayer and interface at 1st layer | ratio | 1 | real | kind_phys | inout | F | -!! | gabsbdlw | surface_downwelling_longwave_flux_absorbed_by_ground | total sky surface downward longwave flux absorbed by the ground | W m-2 | 1 | real | kind_phys | inout | F | -!! | tsurf | surface_skin_temperature_after_iteration | surface skin temperature after iteration | K | 1 | real | kind_phys | inout | F | -!! | zlvl | height_above_ground_at_lowest_model_layer | layer 1 height above ground (not MSL) | m | 1 | real | kind_phys | inout | F | -!! | do_sppt | flag_for_stochastic_surface_physics_perturbations | flag for stochastic surface physics perturbations | flag | 0 | logical | | in | F | -!! | dtdtr | tendency_of_air_temperature_due_to_radiative_heating_on_physics_time_step | temp. change due to radiative heating per time step | K | 2 | real | kind_phys | out | F | -!! | drain_cpl | tendency_of_lwe_thickness_of_precipitation_amount_for_coupling | change in rain_cpl (coupling_type) | m | 1 | real | kind_phys | out | F | -!! | dsnow_cpl | tendency_of_lwe_thickness_of_snow_amount_for_coupling | change in show_cpl (coupling_type) | m | 1 | real | kind_phys | out | F | -!! | rain_cpl | lwe_thickness_of_precipitation_amount_for_coupling | total rain precipitation | m | 1 | real | kind_phys | in | F | -!! | snow_cpl | lwe_thickness_of_snow_amount_for_coupling | total snow precipitation | m | 1 | real | kind_phys | in | F | -!! | do_sfcperts | flag_for_stochastic_surface_perturbations | flag for stochastic surface perturbations option | flag | 0 | logical | | in | F | -!! | nsfcpert | number_of_surface_perturbations | number of surface perturbations | count | 0 | integer | | in | F | -!! | sfc_wts | weights_for_stochastic_surface_physics_perturbation | weights for stochastic surface physics perturbation | none | 2 | real | kind_phys | in | F | -!! | pertz0 | magnitude_of_perturbation_of_momentum_roughness_length | magnitude of perturbation of momentum roughness length | frac | 1 | real | kind_phys | in | F | -!! | pertzt | magnitude_of_perturbation_of_heat_to_momentum_roughness_length_ratio | magnitude of perturbation of heat to momentum roughness length r.| frac | 1 | real | kind_phys | in | F | -!! | pertshc | magnitude_of_perturbation_of_soil_type_b_parameter | magnitude of perturbation of soil type b parameter | frac | 1 | real | kind_phys | in | F | -!! | pertlai | magnitude_of_perturbation_of_leaf_area_index | magnitude of perturbation of leaf area index | frac | 1 | real | kind_phys | in | F | -!! | pertvegf | magnitude_of_perturbation_of_vegetation_fraction | magnitude of perturbation of vegetation fraction | frac | 1 | real | kind_phys | in | F | -!! | z01d | perturbation_of_momentum_roughness_length | perturbation of momentum roughness length | frac | 1 | real | kind_phys | out | F | -!! | zt1d | perturbation_of_heat_to_momentum_roughness_length_ratio | perturbation of heat to momentum roughness length ratio | frac | 1 | real | kind_phys | out | F | -!! | bexp1d | perturbation_of_soil_type_b_parameter | perturbation of soil type "b" parameter | frac | 1 | real | kind_phys | out | F | -!! | xlai1d | perturbation_of_leaf_area_index | perturbation of leaf area index | frac | 1 | real | kind_phys | out | F | -!! | vegf1d | perturbation_of_vegetation_fraction | perturbation of vegetation fraction | frac | 1 | real | kind_phys | out | F | -!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | -!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | +!! \htmlinclude GFS_surface_generic_pre_run.html !! -#endif subroutine GFS_surface_generic_pre_run (im, levs, vfrac, islmsk, isot, ivegsrc, stype, vtype, slope, & - prsik_1, prslk_1, semis, adjsfcdlw, tsfc, phil, con_g, sigmaf, soiltyp, vegtype, & - slopetyp, work3, gabsbdlw, tsurf, zlvl, do_sppt, dtdtr, & + prsik_1, prslk_1, tsfc, phil, con_g, & + sigmaf, soiltyp, vegtype, slopetyp, work3, tsurf, zlvl, do_sppt, dtdtr, & drain_cpl, dsnow_cpl, rain_cpl, snow_cpl, do_sfcperts, nsfcpert, sfc_wts, & pertz0, pertzt, pertshc, pertlai, pertvegf, z01d, zt1d, bexp1d, xlai1d, vegf1d, & - errmsg, errflg) + cplflx, flag_cice, islmsk_cice,slimskin_cpl, dusfcin_cpl, dvsfcin_cpl, & + dtsfcin_cpl, dqsfcin_cpl, ulwsfcin_cpl, ulwsfc_cice, dusfc_cice, dvsfc_cice, & + dtsfc_cice, dqsfc_cice, tisfc, tsfco, fice, hice, & + wind, u1, v1, cnvwind, errmsg, errflg) - use machine, only: kind_phys use surface_perturbation, only: cdfnor implicit none @@ -84,11 +45,12 @@ subroutine GFS_surface_generic_pre_run (im, levs, vfrac, islmsk, isot, ivegsrc, integer, dimension(im), intent(inout) :: soiltyp, vegtype, slopetyp real(kind=kind_phys), intent(in) :: con_g - real(kind=kind_phys), dimension(im), intent(in) :: vfrac, stype, vtype, slope, prsik_1, prslk_1, & - semis, adjsfcdlw, tsfc + real(kind=kind_phys), dimension(im), intent(in) :: vfrac, stype, vtype, slope, prsik_1, prslk_1 + + real(kind=kind_phys), dimension(im), intent(inout) :: tsfc real(kind=kind_phys), dimension(im,levs), intent(in) :: phil - real(kind=kind_phys), dimension(im), intent(inout) :: sigmaf, work3, gabsbdlw, tsurf, zlvl + real(kind=kind_phys), dimension(im), intent(inout) :: sigmaf, work3, tsurf, zlvl ! Stochastic physics / surface perturbations logical, intent(in) :: do_sppt @@ -111,6 +73,21 @@ subroutine GFS_surface_generic_pre_run (im, levs, vfrac, islmsk, isot, ivegsrc, real(kind=kind_phys), dimension(im), intent(out) :: xlai1d real(kind=kind_phys), dimension(im), intent(out) :: vegf1d + logical, intent(in) :: cplflx + real(kind=kind_phys), dimension(im), intent(in) :: slimskin_cpl + logical, dimension(im), intent(inout) :: flag_cice + integer, dimension(im), intent(out) :: islmsk_cice + real(kind=kind_phys), dimension(im), intent(in) ::ulwsfcin_cpl, & + dusfcin_cpl, dvsfcin_cpl, dtsfcin_cpl, dqsfcin_cpl, & + tisfc, tsfco, fice, hice + real(kind=kind_phys), dimension(im), intent(out) ::ulwsfc_cice, & + dusfc_cice, dvsfc_cice, dtsfc_cice, dqsfc_cice + + real(kind=kind_phys), dimension(im), intent(out) :: wind + real(kind=kind_phys), dimension(im), intent(in ) :: u1, v1 + ! surface wind enhancement due to convection + real(kind=kind_phys), dimension(im), intent(inout ) :: cnvwind + ! CCPP error handling character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -141,8 +118,8 @@ subroutine GFS_surface_generic_pre_run (im, levs, vfrac, islmsk, isot, ivegsrc, if (do_sfcperts) then if (pertz0(1) > 0.) then z01d(:) = pertz0(1) * sfc_wts(:,1) - ! if (me == 0) print*,'sfc_wts(:,1) min and max',minval(sfc_wts(:,1)),maxval(sfc_wts(:,1)) - ! if (me == 0) print*,'z01d min and max ',minval(z01d),maxval(z01d) +! if (me == 0) print*,'sfc_wts(:,1) min and max',minval(sfc_wts(:,1)),maxval(sfc_wts(:,1)) +! if (me == 0) print*,'z01d min and max ',minval(z01d),maxval(z01d) endif if (pertzt(1) > 0.) then zt1d(:) = pertzt(1) * sfc_wts(:,2) @@ -153,13 +130,13 @@ subroutine GFS_surface_generic_pre_run (im, levs, vfrac, islmsk, isot, ivegsrc, if (pertlai(1) > 0.) then xlai1d(:) = pertlai(1) * sfc_wts(:,4) endif - ! --- do the albedo percentile calculation in GFS_radiation_driver instead --- ! - ! if (pertalb(1) > 0.) then - ! do i=1,im - ! call cdfnor(sfc_wts(i,5),cdfz) - ! alb1d(i) = cdfz - ! enddo - ! endif +! --- do the albedo percentile calculation in GFS_radiation_driver instead --- ! +! if (pertalb(1) > 0.) then +! do i=1,im +! call cdfnor(sfc_wts(i,5),cdfz) +! alb1d(i) = cdfz +! enddo +! endif if (pertvegf(1) > 0.) then do i=1,im call cdfnor(sfc_wts(i,6),cdfz) @@ -188,34 +165,37 @@ subroutine GFS_surface_generic_pre_run (im, levs, vfrac, islmsk, isot, ivegsrc, soiltyp(i) = int( stype(i)+0.5 ) vegtype(i) = int( vtype(i)+0.5 ) slopetyp(i) = int( slope(i)+0.5 ) !! clu: slope -> slopetyp + if (soiltyp(i) < 1) soiltyp(i) = 14 + if (vegtype(i) < 1) vegtype(i) = 17 + if (slopetyp(i) < 1) slopetyp(i) = 1 endif work3(i) = prsik_1(i) / prslk_1(i) - end do - - ! --- convert lw fluxes for land/ocean/sea-ice models - ! note: for sw: adjsfcdsw and adjsfcnsw are zenith angle adjusted downward/net fluxes. - ! for lw: adjsfcdlw is (sfc temp adjusted) downward fluxe with no emiss effect. - ! adjsfculw is (sfc temp adjusted) upward fluxe including emiss effect. - ! one needs to be aware that that the absorbed downward lw flux (used by land/ocean - ! models as downward flux) is not the same as adjsfcdlw but a value reduced by - ! the factor of emissivity. however, the net effects are the same when seeing - ! it either above the surface interface or below. - ! - ! - flux above the interface used by atmosphere model: - ! down: adjsfcdlw; up: adjsfculw = sfcemis*sigma*T**4 + (1-sfcemis)*adjsfcdlw - ! net = up - down = sfcemis * (sigma*T**4 - adjsfcdlw) - ! - flux below the interface used by lnd/oc/ice models: - ! down: sfcemis*adjsfcdlw; up: sfcemis*sigma*T**4 - ! net = up - down = sfcemis * (sigma*T**4 - adjsfcdlw) - - ! --- ... define the downward lw flux absorbed by ground - gabsbdlw(:) = semis(:) * adjsfcdlw(:) + !tsurf(i) = tsfc(i) + zlvl(i) = phil(i,1) * onebg + wind(i) = max(sqrt(u1(i)*u1(i) + v1(i)*v1(i)) & + + max(zero, min(cnvwind(i), 30.0)), one) + !wind(i) = max(sqrt(Statein%ugrs(i,1)*Statein%ugrs(i,1) + & + ! Statein%vgrs(i,1)*Statein%vgrs(i,1)) & + ! + max(zero, min(Tbd%phy_f2d(i,Model%num_p2d), 30.0)), one) + cnvwind(i) = zero + + enddo + + if (cplflx) then do i=1,im - tsurf(i) = tsfc(i) - zlvl(i) = phil(i,1) * onebg - end do + islmsk_cice(i) = nint(slimskin_cpl(i)) + if(islmsk_cice(i) == 4)then + flag_cice(i) = .true. + ulwsfc_cice(i) = ulwsfcin_cpl(i) + dusfc_cice(i) = dusfcin_cpl(i) + dvsfc_cice(i) = dvsfcin_cpl(i) + dtsfc_cice(i) = dtsfcin_cpl(i) + dqsfc_cice(i) = dqsfcin_cpl(i) + endif + enddo + endif end subroutine GFS_surface_generic_pre_run @@ -224,10 +204,16 @@ end module GFS_surface_generic_pre module GFS_surface_generic_post + use machine, only: kind_phys + + implicit none + private public GFS_surface_generic_post_init, GFS_surface_generic_post_finalize, GFS_surface_generic_post_run + real(kind=kind_phys), parameter :: zero = 0.0, one = 1.0d0 + contains subroutine GFS_surface_generic_post_init () @@ -235,120 +221,29 @@ end subroutine GFS_surface_generic_post_init subroutine GFS_surface_generic_post_finalize() end subroutine GFS_surface_generic_post_finalize -#if 0 + !> \section arg_table_GFS_surface_generic_post_run Argument Table -!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | -!! |----------------|---------------------------------------------------------------------------------------------------------------------|-------------------------------------------------------------------------------------|-------------|------|------------|-----------|--------|----------| -!! | im | horizontal_loop_extent | horizontal loop extent | count | 0 | integer | | in | F | -!! | cplflx | flag_for_flux_coupling | flag controlling cplflx collection (default off) | flag | 0 | logical | | in | F | -!! | cplwav | flag_for_wave_coupling | flag controlling cplwav collection (default off) | flag | 0 | logical | | in | F | -!! | lssav | flag_diagnostics | logical flag for storing diagnostics | flag | 0 | logical | | in | F | -!! | lndfrac | land_area_fraction | fraction of horizontal grid area occupied by land | frac | 1 | real | kind_phys | in | F | -!! | dtf | time_step_for_dynamics | dynamics timestep | s | 0 | real | kind_phys | in | F | -!! | ep1d | surface_upward_potential_latent_heat_flux | surface upward potential latent heat flux | W m-2 | 1 | real | kind_phys | in | F | -!! | gflx | upward_heat_flux_in_soil | upward soil heat flux | W m-2 | 1 | real | kind_phys | in | F | -!! | tgrs_1 | air_temperature_at_lowest_model_layer | mean temperature at lowest model layer | K | 1 | real | kind_phys | in | F | -!! | qgrs_1 | water_vapor_specific_humidity_at_lowest_model_layer | specific humidity at lowest model layer | kg kg-1 | 1 | real | kind_phys | in | F | -!! | ugrs_1 | x_wind_at_lowest_model_layer | zonal wind at lowest model layer | m s-1 | 1 | real | kind_phys | in | F | -!! | vgrs_1 | y_wind_at_lowest_model_layer | meridional wind at lowest model layer | m s-1 | 1 | real | kind_phys | in | F | -!! | adjsfcdlw | surface_downwelling_longwave_flux | surface downwelling longwave flux at current time | W m-2 | 1 | real | kind_phys | in | F | -!! | adjsfcdsw | surface_downwelling_shortwave_flux | surface downwelling shortwave flux at current time | W m-2 | 1 | real | kind_phys | in | F | -!! | adjnirbmd | surface_downwelling_direct_near_infrared_shortwave_flux | surface downwelling beam near-infrared shortwave flux at current time | W m-2 | 1 | real | kind_phys | in | F | -!! | adjnirdfd | surface_downwelling_diffuse_near_infrared_shortwave_flux | surface downwelling diffuse near-infrared shortwave flux at current time | W m-2 | 1 | real | kind_phys | in | F | -!! | adjvisbmd | surface_downwelling_direct_ultraviolet_and_visible_shortwave_flux | surface downwelling beam ultraviolet plus visible shortwave flux at current time | W m-2 | 1 | real | kind_phys | in | F | -!! | adjvisdfd | surface_downwelling_diffuse_ultraviolet_and_visible_shortwave_flux | surface downwelling diffuse ultraviolet plus visible shortwave flux at current time | W m-2 | 1 | real | kind_phys | in | F | -!! | adjsfculw | surface_upwelling_longwave_flux | surface upwelling longwave flux at current time | W m-2 | 1 | real | kind_phys | in | F | -!! | adjnirbmu | surface_upwelling_direct_near_infrared_shortwave_flux | surface upwelling beam near-infrared shortwave flux at current time | W m-2 | 1 | real | kind_phys | in | F | -!! | adjnirdfu | surface_upwelling_diffuse_near_infrared_shortwave_flux | surface upwelling diffuse near-infrared shortwave flux at current time | W m-2 | 1 | real | kind_phys | in | F | -!! | adjvisbmu | surface_upwelling_direct_ultraviolet_and_visible_shortwave_flux | surface upwelling beam ultraviolet plus visible shortwave flux at current time | W m-2 | 1 | real | kind_phys | in | F | -!! | adjvisdfu | surface_upwelling_diffuse_ultraviolet_and_visible_shortwave_flux | surface upwelling diffuse ultraviolet plus visible shortwave flux at current time | W m-2 | 1 | real | kind_phys | in | F | -!! | t2m | temperature_at_2m | 2 meter temperature | K | 1 | real | kind_phys | in | F | -!! | q2m | specific_humidity_at_2m | 2 meter specific humidity | kg kg-1 | 1 | real | kind_phys | in | F | -!! | u10m | x_wind_at_10m | 10 meter u wind speed | m s-1 | 1 | real | kind_phys | in | F | -!! | v10m | y_wind_at_10m | 10 meter v wind speed | m s-1 | 1 | real | kind_phys | in | F | -!! | tsfc | surface_skin_temperature | surface skin temperature | K | 1 | real | kind_phys | in | F | -!! | pgr | surface_air_pressure | surface pressure | Pa | 1 | real | kind_phys | in | F | -!! | xcosz | instantaneous_cosine_of_zenith_angle | cosine of zenith angle at current time | none | 1 | real | kind_phys | in | F | -!! | evbs | soil_upward_latent_heat_flux | soil upward latent heat flux | W m-2 | 1 | real | kind_phys | in | F | -!! | evcw | canopy_upward_latent_heat_flux | canopy upward latent heat flux | W m-2 | 1 | real | kind_phys | in | F | -!! | trans | transpiration_flux | total plant transpiration rate | kg m-2 s-1 | 1 | real | kind_phys | in | F | -!! | sbsno | snow_deposition_sublimation_upward_latent_heat_flux | latent heat flux from snow depo/subl | W m-2 | 1 | real | kind_phys | in | F | -!! | snowc | surface_snow_area_fraction | surface snow area fraction | frac | 1 | real | kind_phys | in | F | -!! | snohf | snow_freezing_rain_upward_latent_heat_flux | latent heat flux due to snow and frz rain | W m-2 | 1 | real | kind_phys | in | F | -!! | epi | instantaneous_surface_potential_evaporation | instantaneous sfc potential evaporation | W m-2 | 1 | real | kind_phys | inout | F | -!! | gfluxi | instantaneous_surface_ground_heat_flux | instantaneous sfc ground heat flux | W m-2 | 1 | real | kind_phys | inout | F | -!! | t1 | air_temperature_at_lowest_model_layer_for_diag | layer 1 temperature for diag | K | 1 | real | kind_phys | inout | F | -!! | q1 | water_vapor_specific_humidity_at_lowest_model_layer_for_diag | layer 1 specific humidity for diag | kg kg-1 | 1 | real | kind_phys | inout | F | -!! | u1 | x_wind_at_lowest_model_layer_for_diag | layer 1 x wind for diag | m s-1 | 1 | real | kind_phys | inout | F | -!! | v1 | y_wind_at_lowest_model_layer_for_diag | layer 1 y wind for diag | m s-1 | 1 | real | kind_phys | inout | F | -!! | dlwsfci_cpl | instantaneous_surface_downwelling_longwave_flux_for_coupling | instantaneous sfc downward lw flux | W m-2 | 1 | real | kind_phys | inout | F | -!! | dswsfci_cpl | instantaneous_surface_downwelling_shortwave_flux_for_coupling | instantaneous sfc downward sw flux | W m-2 | 1 | real | kind_phys | inout | F | -!! | dlwsfc_cpl | cumulative_surface_downwelling_longwave_flux_for_coupling_multiplied_by_timestep | cumulative sfc downward lw flux mulitplied by timestep | W m-2 s | 1 | real | kind_phys | inout | F | -!! | dswsfc_cpl | cumulative_surface_downwelling_shortwave_flux_for_coupling_multiplied_by_timestep | cumulative sfc downward sw flux multiplied by timestep | W m-2 s | 1 | real | kind_phys | inout | F | -!! | dnirbmi_cpl | instantaneous_surface_downwelling_direct_near_infrared_shortwave_flux_for_coupling | instantaneous sfc nir beam downward sw flux | W m-2 | 1 | real | kind_phys | inout | F | -!! | dnirdfi_cpl | instantaneous_surface_downwelling_diffuse_near_infrared_shortwave_flux_for_coupling | instantaneous sfc nir diff downward sw flux | W m-2 | 1 | real | kind_phys | inout | F | -!! | dvisbmi_cpl | instantaneous_surface_downwelling_direct_ultraviolet_and_visible_shortwave_flux_for_coupling | instantaneous sfc uv+vis beam downward sw flux | W m-2 | 1 | real | kind_phys | inout | F | -!! | dvisdfi_cpl | instantaneous_surface_downwelling_diffuse_ultraviolet_and_visible_shortwave_flux_for_coupling | instantaneous sfc uv+vis diff downward sw flux | W m-2 | 1 | real | kind_phys | inout | F | -!! | dnirbm_cpl | cumulative_surface_downwelling_direct_near_infrared_shortwave_flux_for_coupling_multiplied_by_timestep | cumulative sfc nir beam downward sw flux multiplied by timestep | W m-2 s | 1 | real | kind_phys | inout | F | -!! | dnirdf_cpl | cumulative_surface_downwelling_diffuse_near_infrared_shortwave_flux_for_coupling_multiplied_by_timestep | cumulative sfc nir diff downward sw flux multiplied by timestep | W m-2 s | 1 | real | kind_phys | inout | F | -!! | dvisbm_cpl | cumulative_surface_downwelling_direct_ultraviolet_and_visible_shortwave_flux_for_coupling_multiplied_by_timestep | cumulative sfc uv+vis beam dnwd sw flux multiplied by timestep | W m-2 s | 1 | real | kind_phys | inout | F | -!! | dvisdf_cpl | cumulative_surface_downwelling_diffuse_ultraviolet_and_visible_shortwave_flux_for_coupling_multiplied_by_timestep | cumulative sfc uv+vis diff dnwd sw flux multiplied by timestep | W m-2 s | 1 | real | kind_phys | inout | F | -!! | nlwsfci_cpl | instantaneous_surface_net_downward_longwave_flux_for_coupling | instantaneous net sfc downward lw flux | W m-2 | 1 | real | kind_phys | inout | F | -!! | nlwsfc_cpl | cumulative_surface_net_downward_longwave_flux_for_coupling_multiplied_by_timestep | cumulative net downward lw flux multiplied by timestep | W m-2 s | 1 | real | kind_phys | inout | F | -!! | t2mi_cpl | instantaneous_temperature_at_2m_for_coupling | instantaneous T2m | K | 1 | real | kind_phys | inout | F | -!! | q2mi_cpl | instantaneous_specific_humidity_at_2m_for_coupling | instantaneous Q2m | kg kg-1 | 1 | real | kind_phys | inout | F | -!! | u10mi_cpl | instantaneous_x_wind_at_10m_for_coupling | instantaneous U10m | m s-1 | 1 | real | kind_phys | inout | F | -!! | v10mi_cpl | instantaneous_y_wind_at_10m_for_coupling | instantaneous V10m | m s-1 | 1 | real | kind_phys | inout | F | -!! | tsfci_cpl | instantaneous_surface_skin_temperature_for_coupling | instantaneous sfc temperature | K | 1 | real | kind_phys | inout | F | -!! | psurfi_cpl | instantaneous_surface_air_pressure_for_coupling | instantaneous sfc pressure | Pa | 1 | real | kind_phys | inout | F | -!! | nnirbmi_cpl | instantaneous_surface_net_downward_direct_near_infrared_shortwave_flux_for_coupling | instantaneous net nir beam sfc downward sw flux | W m-2 | 1 | real | kind_phys | inout | F | -!! | nnirdfi_cpl | instantaneous_surface_net_downward_diffuse_near_infrared_shortwave_flux_for_coupling | instantaneous net nir diff sfc downward sw flux | W m-2 | 1 | real | kind_phys | inout | F | -!! | nvisbmi_cpl | instantaneous_surface_net_downward_direct_ultraviolet_and_visible_shortwave_flux_for_coupling | instantaneous net uv+vis beam downward sw flux | W m-2 | 1 | real | kind_phys | inout | F | -!! | nvisdfi_cpl | instantaneous_surface_net_downward_diffuse_ultraviolet_and_visible_shortwave_flux_for_coupling | instantaneous net uv+vis diff downward sw flux | W m-2 | 1 | real | kind_phys | inout | F | -!! | nswsfci_cpl | instantaneous_surface_net_downward_shortwave_flux_for_coupling | instantaneous net sfc downward sw flux | W m-2 | 1 | real | kind_phys | inout | F | -!! | nswsfc_cpl | cumulative_surface_net_downward_shortwave_flux_for_coupling_multiplied_by_timestep | cumulative net downward sw flux multiplied by timestep | W m-2 s | 1 | real | kind_phys | inout | F | -!! | nnirbm_cpl | cumulative_surface_net_downward_direct_near_infrared_shortwave_flux_for_coupling_multiplied_by_timestep | cumulative net nir beam downward sw flux multiplied by timestep | W m-2 s | 1 | real | kind_phys | inout | F | -!! | nnirdf_cpl | cumulative_surface_net_downward_diffuse_near_infrared_shortwave_flux_for_coupling_multiplied_by_timestep | cumulative net nir diff downward sw flux multiplied by timestep | W m-2 s | 1 | real | kind_phys | inout | F | -!! | nvisbm_cpl | cumulative_surface_net_downward_direct_ultraviolet_and_visible_shortwave_flux_for_coupling_multiplied_by_timestep | cumulative net uv+vis beam downward sw rad flux multiplied by timestep | W m-2 s | 1 | real | kind_phys | inout | F | -!! | nvisdf_cpl | cumulative_surface_net_downward_diffuse_ultraviolet_and_visible_shortwave_flux_for_coupling_multiplied_by_timestep | cumulative net uv+vis diff downward sw rad flux multiplied by timestep | W m-2 s | 1 | real | kind_phys | inout | F | -!! | gflux | cumulative_surface_ground_heat_flux_multiplied_by_timestep | cumulative groud conductive heat flux multiplied by timestep | W m-2 s | 1 | real | kind_phys | inout | F | -!! | evbsa | cumulative_soil_upward_latent_heat_flux_multiplied_by_timestep | cumulative soil upward latent heat flux multiplied by timestep | W m-2 s | 1 | real | kind_phys | inout | F | -!! | evcwa | cumulative_canopy_upward_latent_heat_flu_multiplied_by_timestep | cumulative canopy upward latent heat flux multiplied by timestep | W m-2 s | 1 | real | kind_phys | inout | F | -!! | transa | cumulative_transpiration_flux_multiplied_by_timestep | cumulative total plant transpiration rate multiplied by timestep | kg m-2 | 1 | real | kind_phys | inout | F | -!! | sbsnoa | cumulative_snow_deposition_sublimation_upward_latent_heat_flux_multiplied_by_timestep | cumulative latent heat flux from snow depo/subl multiplied by timestep | W m-2 s | 1 | real | kind_phys | inout | F | -!! | snowca | cumulative_surface_snow_area_fraction_multiplied_by_timestep | cumulative surface snow area fraction multiplied by timestep | s | 1 | real | kind_phys | inout | F | -!! | snohfa | cumulative_snow_freezing_rain_upward_latent_heat_flux_multiplied_by_timestep | cumulative latent heat flux due to snow and frz rain multiplied by timestep | W m-2 s | 1 | real | kind_phys | inout | F | -!! | ep | cumulative_surface_upward_potential_latent_heat_flux_multiplied_by_timestep | cumulative surface upward potential latent heat flux multiplied by timestep | W m-2 s | 1 | real | kind_phys | inout | F | -!! | runoff | total_runoff | total water runoff | kg m-2 | 1 | real | kind_phys | inout | F | -!! | srunoff | surface_runoff | surface water runoff (from lsm) | kg m-2 | 1 | real | kind_phys | inout | F | -!! | runof | surface_runoff_flux | surface runoff flux | g m-2 s-1 | 1 | real | kind_phys | in | F | -!! | drain | subsurface_runoff_flux | subsurface runoff flux | g m-2 s-1 | 1 | real | kind_phys | in | F | -!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | -!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | +!! \htmlinclude GFS_surface_generic_post_run.html !! -#endif - subroutine GFS_surface_generic_post_run (im, cplflx, cplwav, lssav, lndfrac, dtf, ep1d, gflx, tgrs_1, qgrs_1, ugrs_1, vgrs_1, & - adjsfcdlw, adjsfcdsw, adjnirbmd, adjnirdfd, adjvisbmd, adjvisdfd, adjsfculw, adjnirbmu, adjnirdfu, adjvisbmu, adjvisdfu, & - t2m, q2m, u10m, v10m, tsfc, pgr, xcosz, evbs, evcw, trans, sbsno, snowc, snohf, & + subroutine GFS_surface_generic_post_run (im, cplflx, cplwav, lssav, icy, wet, dtf, ep1d, gflx, tgrs_1, qgrs_1, ugrs_1, vgrs_1,& + adjsfcdlw, adjsfcdsw, adjnirbmd, adjnirdfd, adjvisbmd, adjvisdfd, adjsfculw, adjsfculw_ocn, adjnirbmu, adjnirdfu, & + adjvisbmu, adjvisdfu,t2m, q2m, u10m, v10m, tsfc, tsfc_ocn, pgr, xcosz, evbs, evcw, trans, sbsno, snowc, snohf, & 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, errmsg, errflg) - use machine, only: kind_phys - implicit none - integer, intent(in) :: im - logical, intent(in) :: cplflx, cplwav, lssav - real(kind=kind_phys), dimension(im), intent(in) :: lndfrac - - real(kind=kind_phys), intent(in) :: dtf + integer, intent(in) :: im + logical, intent(in) :: cplflx, cplwav, lssav + logical, dimension(im), intent(in) :: icy, wet + real(kind=kind_phys), intent(in) :: dtf real(kind=kind_phys), dimension(im), intent(in) :: ep1d, gflx, tgrs_1, qgrs_1, ugrs_1, vgrs_1, adjsfcdlw, adjsfcdsw, & - adjnirbmd, adjnirdfd, adjvisbmd, adjvisdfd, adjsfculw, adjnirbmu, adjnirdfu, adjvisbmu, adjvisdfu, & - t2m, q2m, u10m, v10m, tsfc, pgr, xcosz, evbs, evcw, trans, sbsno, snowc, snohf + adjnirbmd, adjnirdfd, adjvisbmd, adjvisdfd, adjsfculw, adjsfculw_ocn, adjnirbmu, adjnirdfu, adjvisbmu, adjvisdfu, & + t2m, q2m, u10m, v10m, tsfc, tsfc_ocn, pgr, xcosz, evbs, evcw, trans, sbsno, snowc, snohf real(kind=kind_phys), dimension(im), 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, & @@ -362,28 +257,28 @@ subroutine GFS_surface_generic_post_run (im, cplflx, cplwav, lssav, lndfrac, dtf character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg - real(kind=kind_phys), parameter :: albdf = 0.06 + real(kind=kind_phys), parameter :: albdf = 0.06d0 integer :: i - real(kind=kind_phys) :: tem, xcosz_loc, ocalnirdf_cpl, ocalnirbm_cpl, ocalvisdf_cpl, ocalvisbm_cpl + real(kind=kind_phys) :: xcosz_loc, ocalnirdf_cpl, ocalnirbm_cpl, ocalvisdf_cpl, ocalvisbm_cpl ! Initialize CCPP error handling variables errmsg = '' errflg = 0 do i=1,im - epi(i) = ep1d(i) - gfluxi(i) = gflx(i) - t1(i) = tgrs_1(i) - q1(i) = qgrs_1(i) - u1(i) = ugrs_1(i) - v1(i) = vgrs_1(i) + epi(i) = ep1d(i) + gfluxi(i) = gflx(i) + t1(i) = tgrs_1(i) + q1(i) = qgrs_1(i) + u1(i) = ugrs_1(i) + v1(i) = vgrs_1(i) enddo if (cplflx .or. cplwav) then do i=1,im - u10mi_cpl (i) = u10m(i) - v10mi_cpl (i) = v10m(i) + u10mi_cpl(i) = u10m(i) + v10mi_cpl(i) = v10m(i) enddo endif @@ -401,20 +296,25 @@ subroutine GFS_surface_generic_post_run (im, cplflx, cplwav, lssav, lndfrac, dtf dnirdf_cpl (i) = dnirdf_cpl(i) + adjnirdfd(i)*dtf dvisbm_cpl (i) = dvisbm_cpl(i) + adjvisbmd(i)*dtf dvisdf_cpl (i) = dvisdf_cpl(i) + adjvisdfd(i)*dtf - nlwsfci_cpl (i) = adjsfcdlw(i) - adjsfculw(i) + nlwsfci_cpl (i) = adjsfcdlw(i) - adjsfculw(i) + if (wet(i)) then + nlwsfci_cpl(i) = adjsfcdlw(i) - adjsfculw_ocn(i) + endif nlwsfc_cpl (i) = nlwsfc_cpl(i) + nlwsfci_cpl(i)*dtf t2mi_cpl (i) = t2m(i) q2mi_cpl (i) = q2m(i) - tsfci_cpl (i) = tsfc(i) +! tsfci_cpl (i) = tsfc(i) + tsfci_cpl (i) = tsfc_ocn(i) psurfi_cpl (i) = pgr(i) enddo - ! --- estimate mean albedo for ocean point without ice cover and apply - ! them to net SW heat fluxes +! --- estimate mean albedo for ocean point without ice cover and apply +! them to net SW heat fluxes do i=1,im - if(lndfrac(i) < 1.) then ! Not 100% land - ! --- compute open water albedo +! if (Sfcprop%landfrac(i) < one) then ! Not 100% land + if (wet(i)) then ! some open water +! --- compute open water albedo xcosz_loc = max( 0.0, min( 1.0, xcosz(i) )) ocalnirdf_cpl = 0.06 ocalnirbm_cpl = max(albdf, 0.026/(xcosz_loc**1.7+0.065) & @@ -423,10 +323,10 @@ subroutine GFS_surface_generic_post_run (im, cplflx, cplwav, lssav, lndfrac, dtf ocalvisdf_cpl = 0.06 ocalvisbm_cpl = ocalnirbm_cpl - nnirbmi_cpl(i) = adjnirbmd(i)-adjnirbmd(i)*ocalnirbm_cpl - nnirdfi_cpl(i) = adjnirdfd(i)-adjnirdfd(i)*ocalnirdf_cpl - nvisbmi_cpl(i) = adjvisbmd(i)-adjvisbmd(i)*ocalvisbm_cpl - nvisdfi_cpl(i) = adjvisdfd(i)-adjvisdfd(i)*ocalvisdf_cpl + nnirbmi_cpl(i) = adjnirbmd(i) * (one-ocalnirbm_cpl) + nnirdfi_cpl(i) = adjnirdfd(i) * (one-ocalnirdf_cpl) + nvisbmi_cpl(i) = adjvisbmd(i) * (one-ocalvisbm_cpl) + nvisdfi_cpl(i) = adjvisdfd(i) * (one-ocalvisdf_cpl) else nnirbmi_cpl(i) = adjnirbmd(i) - adjnirbmu(i) nnirdfi_cpl(i) = adjnirdfd(i) - adjnirdfu(i) @@ -459,10 +359,9 @@ subroutine GFS_surface_generic_post_run (im, cplflx, cplwav, lssav, lndfrac, dtf ! --- ... total runoff is composed of drainage into water table and ! runoff at the surface and is accumulated in unit of meters if (lssav) then - tem = dtf * 0.001 do i=1,im - runoff(i) = runoff(i) + (drain(i)+runof(i)) * tem - srunoff(i) = srunoff(i) + runof(i) * tem + runoff(i) = runoff(i) + (drain(i)+runof(i)) * dtf + srunoff(i) = srunoff(i) + runof(i) * dtf enddo endif diff --git a/physics/GFS_surface_generic.meta b/physics/GFS_surface_generic.meta new file mode 100644 index 000000000..6bd18a3b8 --- /dev/null +++ b/physics/GFS_surface_generic.meta @@ -0,0 +1,1363 @@ +[ccpp-arg-table] + name = GFS_surface_generic_pre_run + type = scheme +[im] + standard_name = horizontal_loop_extent + long_name = horizontal loop extent + units = count + dimensions = () + type = integer + intent = in + optional = F +[levs] + standard_name = vertical_dimension + long_name = number of vertical levels + units = count + dimensions = () + type = integer + intent = in + optional = F +[vfrac] + standard_name = vegetation_area_fraction + long_name = areal fractional cover of green vegetation + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[islmsk] + standard_name = sea_land_ice_mask + long_name = landmask: sea/land/ice=0/1/2 + units = flag + dimensions = (horizontal_dimension) + type = integer + intent = in + optional = F +[isot] + standard_name = soil_type_dataset_choice + long_name = soil type dataset choice + units = index + dimensions = () + type = integer + intent = in + optional = F +[ivegsrc] + standard_name = vegetation_type_dataset_choice + long_name = land use dataset choice + units = index + dimensions = () + type = integer + intent = in + optional = F +[stype] + standard_name = soil_type_classification_real + long_name = soil type for lsm + units = index + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[vtype] + standard_name = vegetation_type_classification_real + long_name = vegetation type for lsm + units = index + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[slope] + standard_name = surface_slope_classification_real + long_name = sfc slope type for lsm + units = index + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[prsik_1] + standard_name = dimensionless_exner_function_at_lowest_model_interface + long_name = dimensionless Exner function at lowest model interface + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[prslk_1] + standard_name = dimensionless_exner_function_at_lowest_model_layer + long_name = dimensionless Exner function at lowest model layer + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[tsfc] + standard_name = surface_skin_temperature + long_name = surface skin temperature + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[phil] + standard_name = geopotential + long_name = geopotential at model layer centers + units = m2 s-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[con_g] + standard_name = gravitational_acceleration + long_name = gravitational acceleration + units = m s-2 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[sigmaf] + standard_name = bounded_vegetation_area_fraction + long_name = areal fractional cover of green vegetation bounded on the bottom + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[soiltyp] + standard_name = soil_type_classification + long_name = soil type at each grid cell + units = index + dimensions = (horizontal_dimension) + type = integer + intent = inout + optional = F +[vegtype] + standard_name = vegetation_type_classification + long_name = vegetation type at each grid cell + units = index + dimensions = (horizontal_dimension) + type = integer + intent = inout + optional = F +[slopetyp] + standard_name = surface_slope_classification + long_name = surface slope type at each grid cell + units = index + dimensions = (horizontal_dimension) + type = integer + intent = inout + optional = F +[work3] + standard_name = ratio_of_exner_function_between_midlayer_and_interface_at_lowest_model_layer + long_name = Exner function ratio bt midlayer and interface at 1st layer + units = ratio + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[tsurf] + standard_name = surface_skin_temperature_after_iteration + long_name = surface skin temperature after iteration + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[zlvl] + standard_name = height_above_ground_at_lowest_model_layer + long_name = layer 1 height above ground (not MSL) + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[do_sppt] + standard_name = flag_for_stochastic_surface_physics_perturbations + long_name = flag for stochastic surface physics perturbations + units = flag + dimensions = () + type = logical + intent = in + optional = F +[dtdtr] + standard_name = tendency_of_air_temperature_due_to_radiative_heating_on_physics_time_step + long_name = temp. change due to radiative heating per time step + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[drain_cpl] + standard_name = tendency_of_lwe_thickness_of_precipitation_amount_for_coupling + long_name = change in rain_cpl (coupling_type) + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[dsnow_cpl] + standard_name = tendency_of_lwe_thickness_of_snow_amount_for_coupling + long_name = change in show_cpl (coupling_type) + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[rain_cpl] + standard_name = lwe_thickness_of_precipitation_amount_for_coupling + long_name = total rain precipitation + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[snow_cpl] + standard_name = lwe_thickness_of_snow_amount_for_coupling + long_name = total snow precipitation + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[do_sfcperts] + standard_name = flag_for_stochastic_surface_perturbations + long_name = flag for stochastic surface perturbations option + units = flag + dimensions = () + type = logical + intent = in + optional = F +[nsfcpert] + standard_name = number_of_surface_perturbations + long_name = number of surface perturbations + units = count + dimensions = () + type = integer + intent = in + optional = F +[sfc_wts] + standard_name = weights_for_stochastic_surface_physics_perturbation + long_name = weights for stochastic surface physics perturbation + units = none + dimensions = (horizontal_dimension,number_of_surface_perturbations) + type = real + kind = kind_phys + intent = in + optional = F +[pertz0] + standard_name = magnitude_of_perturbation_of_momentum_roughness_length + long_name = magnitude of perturbation of momentum roughness length + units = frac + dimensions = (5) + type = real + kind = kind_phys + intent = in + optional = F +[pertzt] + standard_name = magnitude_of_perturbation_of_heat_to_momentum_roughness_length_ratio + long_name = magnitude of perturbation of heat to momentum roughness length r. + units = frac + dimensions = (5) + type = real + kind = kind_phys + intent = in + optional = F +[pertshc] + standard_name = magnitude_of_perturbation_of_soil_type_b_parameter + long_name = magnitude of perturbation of soil type b parameter + units = frac + dimensions = (5) + type = real + kind = kind_phys + intent = in + optional = F +[pertlai] + standard_name = magnitude_of_perturbation_of_leaf_area_index + long_name = magnitude of perturbation of leaf area index + units = frac + dimensions = (5) + type = real + kind = kind_phys + intent = in + optional = F +[pertvegf] + standard_name = magnitude_of_perturbation_of_vegetation_fraction + long_name = magnitude of perturbation of vegetation fraction + units = frac + dimensions = (5) + type = real + kind = kind_phys + intent = in + optional = F +[z01d] + standard_name = perturbation_of_momentum_roughness_length + long_name = perturbation of momentum roughness length + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[zt1d] + standard_name = perturbation_of_heat_to_momentum_roughness_length_ratio + long_name = perturbation of heat to momentum roughness length ratio + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[bexp1d] + standard_name = perturbation_of_soil_type_b_parameter + long_name = perturbation of soil type "b" parameter + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[xlai1d] + standard_name = perturbation_of_leaf_area_index + long_name = perturbation of leaf area index + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[vegf1d] + standard_name = perturbation_of_vegetation_fraction + long_name = perturbation of vegetation fraction + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[cplflx] + standard_name = flag_for_flux_coupling + long_name = flag controlling cplflx collection (default off) + units = flag + dimensions = () + type = logical + intent = in + optional = F +[flag_cice] + standard_name = flag_for_cice + long_name = flag for cice + units = flag + dimensions = (horizontal_dimension) + type = logical + intent = inout + optional = F +[islmsk_cice] + standard_name = sea_land_ice_mask_cice + long_name = sea/land/ice mask cice (=0/1/2) + units = flag + dimensions = (horizontal_dimension) + type = integer + intent = in + optional = F +[slimskin_cpl] + standard_name = sea_land_ice_mask_in + long_name = sea/land/ice mask input (=0/1/2) + units = flag + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[dusfcin_cpl] + standard_name = surface_x_momentum_flux_for_coupling + long_name = sfc x momentum flux for coupling + units = Pa + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[dvsfcin_cpl] + standard_name = surface_y_momentum_flux_for_coupling + long_name = sfc y momentum flux for coupling + units = Pa + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[dtsfcin_cpl] + standard_name = surface_upward_sensible_heat_flux_for_coupling + long_name = sfc sensible heat flux input + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[dqsfcin_cpl] + standard_name = surface_upward_latent_heat_flux_for_coupling + long_name = sfc latent heat flux input for coupling + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[ulwsfcin_cpl] + standard_name = surface_upwelling_longwave_flux_for_coupling + long_name = surface upwelling LW flux for coupling + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[ulwsfc_cice] + standard_name = surface_upwelling_longwave_flux_for_coupling_interstitial + long_name = surface upwelling longwave flux for coupling interstitial + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[dusfc_cice] + standard_name = surface_x_momentum_flux_for_coupling_interstitial + long_name = sfc x momentum flux for coupling interstitial + units = Pa + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[dvsfc_cice] + standard_name = surface_y_momentum_flux_for_coupling_interstitial + long_name = sfc y momentum flux for coupling interstitial + units = Pa + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[dtsfc_cice] + standard_name = surface_upward_sensible_heat_flux_for_coupling_interstitial + long_name = sfc sensible heat flux for coupling interstitial + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[dqsfc_cice] + standard_name = surface_upward_latent_heat_flux_for_coupling_interstitial + long_name = sfc latent heat flux for coupling interstitial + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[tisfc] + standard_name = sea_ice_temperature + long_name = sea-ice surface temperature + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[tsfco] + standard_name = sea_surface_temperature + long_name = sea surface temperature + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[fice] + standard_name = sea_ice_concentration + long_name = sea-ice concentration [0,1] + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[hice] + standard_name = sea_ice_thickness + long_name = sea-ice thickness + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[wind] + standard_name = wind_speed_at_lowest_model_layer + long_name = wind speed at lowest model level + units = m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[u1] + standard_name = x_wind_at_lowest_model_layer + long_name = zonal wind at lowest model layer + units = m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[v1] + standard_name = y_wind_at_lowest_model_layer + long_name = meridional wind at lowest model layer + units = m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[cnvwind] + standard_name = surface_wind_enhancement_due_to_convection + long_name = surface wind enhancement due to convection + units = m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F + +######################################################################## +[ccpp-arg-table] + name = GFS_surface_generic_post_run + type = scheme +[im] + standard_name = horizontal_loop_extent + long_name = horizontal loop extent + units = count + dimensions = () + type = integer + intent = in + optional = F +[cplflx] + standard_name = flag_for_flux_coupling + long_name = flag controlling cplflx collection (default off) + units = flag + dimensions = () + type = logical + intent = in + optional = F +[cplwav] + standard_name = flag_for_wave_coupling + long_name = flag controlling cplwav collection (default off) + units = flag + dimensions = () + type = logical + intent = in + optional = F +[lssav] + standard_name = flag_diagnostics + long_name = logical flag for storing diagnostics + units = flag + dimensions = () + type = logical + intent = in + optional = F +[icy] + standard_name = flag_nonzero_sea_ice_surface_fraction + long_name = flag indicating presence of some sea ice surface area fraction + units = flag + dimensions = (horizontal_dimension) + type = logical + intent = in + optional = F +[wet] + standard_name = flag_nonzero_wet_surface_fraction + long_name = flag indicating presence of some ocean or lake surface area fraction + units = flag + dimensions = (horizontal_dimension) + type = logical + intent = in + optional = F +[dtf] + standard_name = time_step_for_dynamics + long_name = dynamics timestep + units = s + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[ep1d] + standard_name = surface_upward_potential_latent_heat_flux + long_name = surface upward potential latent heat flux + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[gflx] + standard_name = upward_heat_flux_in_soil + long_name = upward soil heat flux + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[tgrs_1] + standard_name = air_temperature_at_lowest_model_layer + long_name = mean temperature at lowest model layer + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[qgrs_1] + standard_name = water_vapor_specific_humidity_at_lowest_model_layer + long_name = specific humidity at lowest model layer + units = kg kg-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[ugrs_1] + standard_name = x_wind_at_lowest_model_layer + long_name = zonal wind at lowest model layer + units = m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[vgrs_1] + standard_name = y_wind_at_lowest_model_layer + long_name = meridional wind at lowest model layer + units = m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[adjsfcdlw] + standard_name = surface_downwelling_longwave_flux + long_name = surface downwelling longwave flux at current time + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[adjsfcdsw] + standard_name = surface_downwelling_shortwave_flux + long_name = surface downwelling shortwave flux at current time + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[adjnirbmd] + standard_name = surface_downwelling_direct_near_infrared_shortwave_flux + long_name = surface downwelling beam near-infrared shortwave flux at current time + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[adjnirdfd] + standard_name = surface_downwelling_diffuse_near_infrared_shortwave_flux + long_name = surface downwelling diffuse near-infrared shortwave flux at current time + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[adjvisbmd] + standard_name = surface_downwelling_direct_ultraviolet_and_visible_shortwave_flux + long_name = surface downwelling beam ultraviolet plus visible shortwave flux at current time + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[adjvisdfd] + standard_name = surface_downwelling_diffuse_ultraviolet_and_visible_shortwave_flux + long_name = surface downwelling diffuse ultraviolet plus visible shortwave flux at current time + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[adjsfculw] + standard_name = surface_upwelling_longwave_flux + long_name = surface upwelling longwave flux at current time + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[adjsfculw_ocn] + standard_name = surface_upwelling_longwave_flux_over_ocean_interstitial + long_name = surface upwelling longwave flux at current time over ocean (temporary use as interstitial) + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[adjnirbmu] + standard_name = surface_upwelling_direct_near_infrared_shortwave_flux + long_name = surface upwelling beam near-infrared shortwave flux at current time + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[adjnirdfu] + standard_name = surface_upwelling_diffuse_near_infrared_shortwave_flux + long_name = surface upwelling diffuse near-infrared shortwave flux at current time + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[adjvisbmu] + standard_name = surface_upwelling_direct_ultraviolet_and_visible_shortwave_flux + long_name = surface upwelling beam ultraviolet plus visible shortwave flux at current time + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[adjvisdfu] + standard_name = surface_upwelling_diffuse_ultraviolet_and_visible_shortwave_flux + long_name = surface upwelling diffuse ultraviolet plus visible shortwave flux at current time + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[t2m] + standard_name = temperature_at_2m + long_name = 2 meter temperature + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[q2m] + standard_name = specific_humidity_at_2m + long_name = 2 meter specific humidity + units = kg kg-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[u10m] + standard_name = x_wind_at_10m + long_name = 10 meter u wind speed + units = m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[v10m] + standard_name = y_wind_at_10m + long_name = 10 meter v wind speed + units = m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[tsfc] + standard_name = surface_skin_temperature + long_name = surface skin temperature + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[tsfc_ocn] + standard_name = surface_skin_temperature_over_ocean_interstitial + long_name = surface skin temperature over ocean (temporary use as interstitial) + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[pgr] + standard_name = surface_air_pressure + long_name = surface pressure + units = Pa + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[xcosz] + standard_name = instantaneous_cosine_of_zenith_angle + long_name = cosine of zenith angle at current time + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[evbs] + standard_name = soil_upward_latent_heat_flux + long_name = soil upward latent heat flux + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[evcw] + standard_name = canopy_upward_latent_heat_flux + long_name = canopy upward latent heat flux + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[trans] + standard_name = transpiration_flux + long_name = total plant transpiration rate + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[sbsno] + standard_name = snow_deposition_sublimation_upward_latent_heat_flux + long_name = latent heat flux from snow depo/subl + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[snowc] + standard_name = surface_snow_area_fraction + long_name = surface snow area fraction + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[snohf] + standard_name = snow_freezing_rain_upward_latent_heat_flux + long_name = latent heat flux due to snow and frz rain + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[epi] + standard_name = instantaneous_surface_potential_evaporation + long_name = instantaneous sfc potential evaporation + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[gfluxi] + standard_name = instantaneous_surface_ground_heat_flux + long_name = instantaneous sfc ground heat flux + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[t1] + standard_name = air_temperature_at_lowest_model_layer_for_diag + long_name = layer 1 temperature for diag + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[q1] + standard_name = water_vapor_specific_humidity_at_lowest_model_layer_for_diag + long_name = layer 1 specific humidity for diag + units = kg kg-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[u1] + standard_name = x_wind_at_lowest_model_layer_for_diag + long_name = layer 1 x wind for diag + units = m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[v1] + standard_name = y_wind_at_lowest_model_layer_for_diag + long_name = layer 1 y wind for diag + units = m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[dlwsfci_cpl] + standard_name = instantaneous_surface_downwelling_longwave_flux_for_coupling + long_name = instantaneous sfc downward lw flux + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[dswsfci_cpl] + standard_name = instantaneous_surface_downwelling_shortwave_flux_for_coupling + long_name = instantaneous sfc downward sw flux + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[dlwsfc_cpl] + standard_name = cumulative_surface_downwelling_longwave_flux_for_coupling_multiplied_by_timestep + long_name = cumulative sfc downward lw flux mulitplied by timestep + units = W m-2 s + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[dswsfc_cpl] + standard_name = cumulative_surface_downwelling_shortwave_flux_for_coupling_multiplied_by_timestep + long_name = cumulative sfc downward sw flux multiplied by timestep + units = W m-2 s + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[dnirbmi_cpl] + standard_name = instantaneous_surface_downwelling_direct_near_infrared_shortwave_flux_for_coupling + long_name = instantaneous sfc nir beam downward sw flux + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[dnirdfi_cpl] + standard_name = instantaneous_surface_downwelling_diffuse_near_infrared_shortwave_flux_for_coupling + long_name = instantaneous sfc nir diff downward sw flux + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[dvisbmi_cpl] + standard_name = instantaneous_surface_downwelling_direct_ultraviolet_and_visible_shortwave_flux_for_coupling + long_name = instantaneous sfc uv+vis beam downward sw flux + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[dvisdfi_cpl] + standard_name = instantaneous_surface_downwelling_diffuse_ultraviolet_and_visible_shortwave_flux_for_coupling + long_name = instantaneous sfc uv+vis diff downward sw flux + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[dnirbm_cpl] + standard_name = cumulative_surface_downwelling_direct_near_infrared_shortwave_flux_for_coupling_multiplied_by_timestep + long_name = cumulative sfc nir beam downward sw flux multiplied by timestep + units = W m-2 s + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[dnirdf_cpl] + standard_name = cumulative_surface_downwelling_diffuse_near_infrared_shortwave_flux_for_coupling_multiplied_by_timestep + long_name = cumulative sfc nir diff downward sw flux multiplied by timestep + units = W m-2 s + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[dvisbm_cpl] + standard_name = cumulative_surface_downwelling_direct_ultraviolet_and_visible_shortwave_flux_for_coupling_multiplied_by_timestep + long_name = cumulative sfc uv+vis beam dnwd sw flux multiplied by timestep + units = W m-2 s + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[dvisdf_cpl] + standard_name = cumulative_surface_downwelling_diffuse_ultraviolet_and_visible_shortwave_flux_for_coupling_multiplied_by_timestep + long_name = cumulative sfc uv+vis diff dnwd sw flux multiplied by timestep + units = W m-2 s + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[nlwsfci_cpl] + standard_name = instantaneous_surface_net_downward_longwave_flux_for_coupling + long_name = instantaneous net sfc downward lw flux + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[nlwsfc_cpl] + standard_name = cumulative_surface_net_downward_longwave_flux_for_coupling_multiplied_by_timestep + long_name = cumulative net downward lw flux multiplied by timestep + units = W m-2 s + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[t2mi_cpl] + standard_name = instantaneous_temperature_at_2m_for_coupling + long_name = instantaneous T2m + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[q2mi_cpl] + standard_name = instantaneous_specific_humidity_at_2m_for_coupling + long_name = instantaneous Q2m + units = kg kg-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[u10mi_cpl] + standard_name = instantaneous_x_wind_at_10m_for_coupling + long_name = instantaneous U10m + units = m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[v10mi_cpl] + standard_name = instantaneous_y_wind_at_10m_for_coupling + long_name = instantaneous V10m + units = m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[tsfci_cpl] + standard_name = instantaneous_surface_skin_temperature_for_coupling + long_name = instantaneous sfc temperature + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[psurfi_cpl] + standard_name = instantaneous_surface_air_pressure_for_coupling + long_name = instantaneous sfc pressure + units = Pa + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[nnirbmi_cpl] + standard_name = instantaneous_surface_net_downward_direct_near_infrared_shortwave_flux_for_coupling + long_name = instantaneous net nir beam sfc downward sw flux + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[nnirdfi_cpl] + standard_name = instantaneous_surface_net_downward_diffuse_near_infrared_shortwave_flux_for_coupling + long_name = instantaneous net nir diff sfc downward sw flux + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[nvisbmi_cpl] + standard_name = instantaneous_surface_net_downward_direct_ultraviolet_and_visible_shortwave_flux_for_coupling + long_name = instantaneous net uv+vis beam downward sw flux + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[nvisdfi_cpl] + standard_name = instantaneous_surface_net_downward_diffuse_ultraviolet_and_visible_shortwave_flux_for_coupling + long_name = instantaneous net uv+vis diff downward sw flux + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[nswsfci_cpl] + standard_name = instantaneous_surface_net_downward_shortwave_flux_for_coupling + long_name = instantaneous net sfc downward sw flux + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[nswsfc_cpl] + standard_name = cumulative_surface_net_downward_shortwave_flux_for_coupling_multiplied_by_timestep + long_name = cumulative net downward sw flux multiplied by timestep + units = W m-2 s + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[nnirbm_cpl] + standard_name = cumulative_surface_net_downward_direct_near_infrared_shortwave_flux_for_coupling_multiplied_by_timestep + long_name = cumulative net nir beam downward sw flux multiplied by timestep + units = W m-2 s + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[nnirdf_cpl] + standard_name = cumulative_surface_net_downward_diffuse_near_infrared_shortwave_flux_for_coupling_multiplied_by_timestep + long_name = cumulative net nir diff downward sw flux multiplied by timestep + units = W m-2 s + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[nvisbm_cpl] + standard_name = cumulative_surface_net_downward_direct_ultraviolet_and_visible_shortwave_flux_for_coupling_multiplied_by_timestep + long_name = cumulative net uv+vis beam downward sw rad flux multiplied by timestep + units = W m-2 s + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[nvisdf_cpl] + standard_name = cumulative_surface_net_downward_diffuse_ultraviolet_and_visible_shortwave_flux_for_coupling_multiplied_by_timestep + long_name = cumulative net uv+vis diff downward sw rad flux multiplied by timestep + units = W m-2 s + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[gflux] + standard_name = cumulative_surface_ground_heat_flux_multiplied_by_timestep + long_name = cumulative groud conductive heat flux multiplied by timestep + units = W m-2 s + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[evbsa] + standard_name = cumulative_soil_upward_latent_heat_flux_multiplied_by_timestep + long_name = cumulative soil upward latent heat flux multiplied by timestep + units = W m-2 s + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[evcwa] + standard_name = cumulative_canopy_upward_latent_heat_flu_multiplied_by_timestep + long_name = cumulative canopy upward latent heat flux multiplied by timestep + units = W m-2 s + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[transa] + standard_name = cumulative_transpiration_flux_multiplied_by_timestep + long_name = cumulative total plant transpiration rate multiplied by timestep + units = kg m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[sbsnoa] + standard_name = cumulative_snow_deposition_sublimation_upward_latent_heat_flux_multiplied_by_timestep + long_name = cumulative latent heat flux from snow depo/subl multiplied by timestep + units = W m-2 s + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[snowca] + standard_name = cumulative_surface_snow_area_fraction_multiplied_by_timestep + long_name = cumulative surface snow area fraction multiplied by timestep + units = s + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[snohfa] + standard_name = cumulative_snow_freezing_rain_upward_latent_heat_flux_multiplied_by_timestep + long_name = cumulative latent heat flux due to snow and frz rain multiplied by timestep + units = W m-2 s + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[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 + units = W m-2 s + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[runoff] + standard_name = total_runoff + long_name = total water runoff + units = kg m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[srunoff] + standard_name = surface_runoff + long_name = surface water runoff (from lsm) + units = kg m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[runof] + standard_name = surface_runoff_flux + long_name = surface runoff flux + units = kg m-2 s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[drain] + standard_name = subsurface_runoff_flux + long_name = subsurface runoff flux + units = kg m-2 s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F diff --git a/physics/GFS_surface_loop_control.F90 b/physics/GFS_surface_loop_control.F90 index 49de8fdab..c701c523e 100644 --- a/physics/GFS_surface_loop_control.F90 +++ b/physics/GFS_surface_loop_control.F90 @@ -17,14 +17,7 @@ end subroutine GFS_surface_loop_control_part1_finalize !! #if 0 !! \section arg_table_GFS_surface_loop_control_part1_run Arguments -!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | -!! |----------------|--------------------------------------------------------|--------------------------------------------|------------|------|-----------|-----------|--------|----------| -!! | im | horizontal_loop_extent | horizontal loop extent | count | 0 | integer | | in | F | -!! | iter | ccpp_loop_counter | loop counter for subcycling loops in CCPP | index | 0 | integer | | in | F | -!! | wind | wind_speed_at_lowest_model_layer | wind speed at lowest model level | m s-1 | 1 | real | kind_phys | in | F | -!! | flag_guess | flag_for_guess_run | flag for guess run | flag | 1 | logical | | inout | F | -!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | -!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | +!! \htmlinclude GFS_surface_loop_control_part1_run.html !! #endif !! \section general General Algorithm @@ -80,19 +73,7 @@ end subroutine GFS_surface_loop_control_part2_finalize !! #if 0 !! \section arg_table_GFS_surface_loop_control_part2_run Arguments -!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | -!! |----------------|--------------------------------------------------------|----------------------------------------------------------------------|------------|------|-----------|-----------|--------|----------| -!! | im | horizontal_loop_extent | horizontal loop extent | count | 0 | integer | | in | F | -!! | iter | ccpp_loop_counter | loop counter for subcycling loops in CCPP | index | 0 | integer | | in | F | -!! | wind | wind_speed_at_lowest_model_layer | wind speed at lowest model level | m s-1 | 1 | real | kind_phys | in | F | -!! | flag_guess | flag_for_guess_run | flag for guess run | flag | 1 | logical | | inout | F | -!! | flag_iter | flag_for_iteration | flag for iteration | flag | 1 | logical | | inout | F | -!! | dry | flag_nonzero_land_surface_fraction | flag indicating presence of some land surface area fraction | flag | 1 | logical | | in | F | -!! | wet | flag_nonzero_wet_surface_fraction | flag indicating presence of some ocean or lake surface area fraction | flag | 1 | logical | | in | F | -!! | icy | flag_nonzero_sea_ice_surface_fraction | flag indicating presence of some sea ice surface area fraction | flag | 1 | logical | | in | F | -!! | nstf_name1 | flag_for_nsstm_run | NSSTM flag: off/uncoupled/coupled=0/1/2 | flag | 0 | integer | | in | F | -!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | -!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | +!! \htmlinclude GFS_surface_loop_control_part2_run.html !! #endif !! \section general General Algorithm @@ -130,7 +111,8 @@ subroutine GFS_surface_loop_control_part2_run (im, iter, wind, & flag_guess(i) = .false. if (iter == 1 .and. wind(i) < 2.0) then - if (dry(i) .or. (wet(i) .and. .not.icy(i) .and. nstf_name1 > 0)) 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 flag_iter(i) = .true. endif endif diff --git a/physics/GFS_surface_loop_control.meta b/physics/GFS_surface_loop_control.meta new file mode 100644 index 000000000..3fe5878f7 --- /dev/null +++ b/physics/GFS_surface_loop_control.meta @@ -0,0 +1,148 @@ +[ccpp-arg-table] + name = GFS_surface_loop_control_part1_run + type = scheme +[im] + standard_name = horizontal_loop_extent + long_name = horizontal loop extent + units = count + dimensions = () + type = integer + intent = in + optional = F +[iter] + standard_name = ccpp_loop_counter + long_name = loop counter for subcycling loops in CCPP + units = index + dimensions = () + type = integer + intent = in + optional = F +[wind] + standard_name = wind_speed_at_lowest_model_layer + long_name = wind speed at lowest model level + units = m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[flag_guess] + standard_name = flag_for_guess_run + long_name = flag for guess run + units = flag + dimensions = (horizontal_dimension) + type = logical + intent = inout + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F + +######################################################################## +[ccpp-arg-table] + name = GFS_surface_loop_control_part2_run + type = scheme +[im] + standard_name = horizontal_loop_extent + long_name = horizontal loop extent + units = count + dimensions = () + type = integer + intent = in + optional = F +[iter] + standard_name = ccpp_loop_counter + long_name = loop counter for subcycling loops in CCPP + units = index + dimensions = () + type = integer + intent = in + optional = F +[wind] + standard_name = wind_speed_at_lowest_model_layer + long_name = wind speed at lowest model level + units = m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[flag_guess] + standard_name = flag_for_guess_run + long_name = flag for guess run + units = flag + dimensions = (horizontal_dimension) + type = logical + intent = inout + optional = F +[flag_iter] + standard_name = flag_for_iteration + long_name = flag for iteration + units = flag + dimensions = (horizontal_dimension) + type = logical + intent = inout + optional = F +[dry] + standard_name = flag_nonzero_land_surface_fraction + long_name = flag indicating presence of some land surface area fraction + units = flag + dimensions = (horizontal_dimension) + type = logical + intent = in + optional = F +[wet] + standard_name = flag_nonzero_wet_surface_fraction + long_name = flag indicating presence of some ocean or lake surface area fraction + units = flag + dimensions = (horizontal_dimension) + type = logical + intent = in + optional = F +[icy] + standard_name = flag_nonzero_sea_ice_surface_fraction + long_name = flag indicating presence of some sea ice surface area fraction + units = flag + dimensions = (horizontal_dimension) + type = logical + intent = in + optional = F +[nstf_name1] + standard_name = flag_for_nsstm_run + long_name = NSSTM flag: off/uncoupled/coupled=0/1/2 + units = flag + dimensions = () + type = integer + intent = in + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F diff --git a/physics/GFS_time_vary_pre.fv3.F90 b/physics/GFS_time_vary_pre.fv3.F90 index 4fecabad5..46284a1bb 100644 --- a/physics/GFS_time_vary_pre.fv3.F90 +++ b/physics/GFS_time_vary_pre.fv3.F90 @@ -16,10 +16,7 @@ module GFS_time_vary_pre contains !> \section arg_table_GFS_time_vary_pre_init Argument Table -!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | -!! |----------------|--------------------------------------------------------|-------------------------------------------------------------------------|----------|------|-----------------------|-----------|--------|----------| -!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | -!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | +!! \htmlinclude GFS_time_vary_pre_init.html !! subroutine GFS_time_vary_pre_init (errmsg, errflg) @@ -33,7 +30,7 @@ subroutine GFS_time_vary_pre_init (errmsg, errflg) errflg = 0 if (is_initialized) return - + !--- Call gfuncphys (funcphys.f) to compute all physics function tables. call gfuncphys () @@ -43,10 +40,7 @@ end subroutine GFS_time_vary_pre_init !> \section arg_table_GFS_time_vary_pre_finalize Argument Table -!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | -!! |----------------|--------------------------------------------------------|-------------------------------------------------------------------------|----------|------|-----------------------|-----------|--------|----------| -!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | -!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | +!! \htmlinclude GFS_time_vary_pre_finalize.html !! subroutine GFS_time_vary_pre_finalize(errmsg, errflg) @@ -69,20 +63,30 @@ end subroutine GFS_time_vary_pre_finalize !> \section arg_table_GFS_time_vary_pre_run Argument Table -!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | -!! |----------------|--------------------------------------------------------|-------------------------------------------------------------------------|----------|------|-----------------------|-----------|--------|----------| -!! | Model | GFS_control_type_instance | Fortran DDT containing FV3-GFS model control parameters | DDT | 0 | GFS_control_type | | inout | F | -!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | -!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | +!! \htmlinclude GFS_time_vary_pre_run.html !! - subroutine GFS_time_vary_pre_run (Model, errmsg, errflg) + subroutine GFS_time_vary_pre_run (jdat, idat, dtp, lsm, lsm_noahmp, nsswr, & + nslwr, idate, debug, me, master, nscyc, sec, phour, zhour, fhour, kdt, & + julian, yearlen, ipt, lprnt, lssav, lsswr, lslwr, solhr, errmsg, errflg) use machine, only: kind_phys - use GFS_typedefs, only: GFS_control_type implicit none - type(GFS_control_type), intent(inout) :: Model + integer, intent(in) :: idate(4) + integer, intent(in) :: jdat(1:8), idat(1:8) + integer, intent(in) :: lsm, lsm_noahmp, & + nsswr, nslwr, me, & + master, nscyc + logical, intent(in) :: debug + real(kind=kind_phys), intent(in) :: dtp + + integer, intent(out) :: kdt, yearlen, ipt + logical, intent(out) :: lprnt, lssav, lsswr, & + lslwr + real(kind=kind_phys), intent(out) :: sec, phour, zhour, & + fhour, julian, solhr + character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -90,50 +94,96 @@ subroutine GFS_time_vary_pre_run (Model, errmsg, errflg) real(kind=kind_phys), parameter :: con_hr = 3600.0_kind_phys real(kind=kind_phys) :: rinc(5) + integer :: iw3jdn + integer :: jd0, jd1 + real :: fjd + ! Initialize CCPP error handling variables errmsg = '' errflg = 0 ! Check initialization status if (.not.is_initialized) then - write(errmsg,'(*(a))') "Logic error: GFS_time_vary_pre_run called before GFS_time_vary_pre_init" + write(errmsg,'(*(a))') "Logic error: GFS_time_vary_pre_run called & + &before GFS_time_vary_pre_init" errflg = 1 return end if - !--- Model%jdat is being updated directly inside of FV3GFS_cap.F90 + !--- jdat is being updated directly inside of FV3GFS_cap.F90 !--- update calendars and triggers rinc(1:5) = 0 - call w3difdat(Model%jdat,Model%idat,4,rinc) - Model%sec = rinc(4) - Model%phour = Model%sec/con_hr + call w3difdat(jdat,idat,4,rinc) + sec = rinc(4) + phour = sec/con_hr !--- set current bucket hour - Model%zhour = Model%phour - Model%fhour = (Model%sec + Model%dtp)/con_hr - Model%kdt = nint((Model%sec + Model%dtp)/Model%dtp) + zhour = phour + fhour = (sec + dtp)/con_hr + kdt = nint((sec + dtp)/dtp) + + if(lsm == lsm_noahmp) then + !GJF* These calculations were originally in GFS_physics_driver.F90 for + ! NoahMP. They were moved to this routine since they only depend + ! on time (not space). Note that this code is included as-is from + ! GFS_physics_driver.F90, but it may be simplified by using more + ! NCEP W3 library calls (e.g., see W3DOXDAT, W3FS13 for Julian day + ! of year and W3DIFDAT to determine the integer number of days in + ! a given year). *GJF + ! Julian day calculation (fcst day of the year) + ! we need yearln and julian to + ! pass to noah mp sflx, idate is init, jdat is fcst;idate = jdat when kdt=1 + ! jdat is changing + ! + + jd1 = iw3jdn(jdat(1),jdat(2),jdat(3)) + jd0 = iw3jdn(jdat(1),1,1) + fjd = float(jdat(5))/24.0 + float(jdat(6))/1440.0 + + julian = float(jd1-jd0) + fjd + + ! + ! Year length + ! + ! what if the integration goes from one year to another? + ! iyr or jyr ? from 365 to 366 or from 366 to 365 + ! + ! is this against model's noleap yr assumption? + if (mod(jdat(1),4) == 0) then + yearlen = 366 + if (mod(jdat(1),100) == 0) then + yearlen = 365 + if (mod(jdat(1),400) == 0) then + yearlen = 366 + endif + endif + endif + endif - Model%ipt = 1 - Model%lprnt = .false. - Model%lssav = .true. + ipt = 1 + lprnt = .false. + lssav = .true. !--- radiation triggers - Model%lsswr = (mod(Model%kdt, Model%nsswr) == 1) - Model%lslwr = (mod(Model%kdt, Model%nslwr) == 1) + lsswr = (mod(kdt, nsswr) == 1) + lslwr = (mod(kdt, nslwr) == 1) + !--- allow for radiation to be called on every physics time step, if needed + if (nsswr == 1) lsswr = .true. + if (nslwr == 1) lslwr = .true. !--- set the solar hour based on a combination of phour and time initial hour - Model%solhr = mod(Model%phour+Model%idate(1),con_24) - - if ((Model%debug) .and. (Model%me == Model%master)) then - print *,' sec ', Model%sec - print *,' kdt ', Model%kdt - print *,' nsswr ', Model%nsswr - print *,' nslwr ', Model%nslwr - print *,' nscyc ', Model%nscyc - print *,' lsswr ', Model%lsswr - print *,' lslwr ', Model%lslwr - print *,' fhour ', Model%fhour - print *,' phour ', Model%phour - print *,' solhr ', Model%solhr + solhr = mod(phour+idate(1),con_24) + + if ((debug) .and. (me == master)) then + print *,' sec ', sec + print *,' kdt ', kdt + print *,' nsswr ', nsswr + print *,' nslwr ', nslwr + print *,' nscyc ', nscyc + print *,' lsswr ', lsswr + print *,' lslwr ', lslwr + print *,' fhour ', fhour + print *,' phour ', phour + print *,' solhr ', solhr endif end subroutine GFS_time_vary_pre_run diff --git a/physics/GFS_time_vary_pre.fv3.meta b/physics/GFS_time_vary_pre.fv3.meta new file mode 100644 index 000000000..3dc91952e --- /dev/null +++ b/physics/GFS_time_vary_pre.fv3.meta @@ -0,0 +1,271 @@ +[ccpp-arg-table] + name = GFS_time_vary_pre_init + type = scheme +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F + +######################################################################## +[ccpp-arg-table] + name = GFS_time_vary_pre_finalize + type = scheme +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F + +######################################################################## +[ccpp-arg-table] + name = GFS_time_vary_pre_run + type = scheme +[jdat] + standard_name = forecast_date_and_time + long_name = current forecast date and time + units = none + dimensions = (8) + type = integer + intent = in + optional = F +[idat] + standard_name = date_and_time_at_model_initialization + long_name = initialization date and time + units = none + dimensions = (8) + type = integer + intent = in + optional = F +[dtp] + standard_name = time_step_for_physics + long_name = physics timestep + units = s + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[lsm] + standard_name = flag_for_land_surface_scheme + long_name = flag for land surface model + units = flag + dimensions = () + type = integer + intent = in + optional = F +[lsm_noahmp] + standard_name = flag_for_noahmp_land_surface_scheme + long_name = flag for NOAH MP land surface model + units = flag + dimensions = () + type = integer + intent = in + optional = F +[nsswr] + standard_name = number_of_timesteps_between_shortwave_radiation_calls + long_name = number of timesteps between shortwave radiation calls + units = + dimensions = () + type = integer + intent = in + optional = F +[nslwr] + standard_name = number_of_timesteps_between_longwave_radiation_calls + long_name = number of timesteps between longwave radiation calls + units = + dimensions = () + type = integer + intent = in + optional = F +[idate] + standard_name = date_and_time_at_model_initialization_reordered + long_name = initial date with different size and ordering + units = none + dimensions = (4) + type = integer + intent = in + optional = F +[debug] + standard_name = flag_debug + long_name = control flag for debug + units = flag + dimensions = () + type = logical + intent = in + optional = F +[me] + standard_name = mpi_rank + long_name = current MPI-rank + units = index + dimensions = () + type = integer + intent = in + optional = F +[master] + standard_name = mpi_root + long_name = master MPI-rank + units = index + dimensions = () + type = integer + intent = in + optional = F +[nscyc] + standard_name = number_of_timesteps_between_surface_cycling_calls + long_name = number of timesteps between surface cycling calls + units = + dimensions = () + type = integer + intent = in + optional = F +[sec] + standard_name = seconds_elapsed_since_model_initialization + long_name = seconds elapsed since model initialization + units = s + dimensions = () + type = real + kind = kind_phys + intent = out + optional = F +[phour] + standard_name = forecast_time_at_previous_timestep + long_name = forecast time at the previous timestep + units = h + dimensions = () + type = real + kind = kind_phys + intent = out + optional = F +[zhour] + standard_name = time_since_diagnostics_zeroed + long_name = time since diagnostics variables have been zeroed + units = h + dimensions = () + type = real + kind = kind_phys + intent = out + optional = F +[fhour] + standard_name = forecast_time + long_name = current forecast time + units = h + dimensions = () + type = real + kind = kind_phys + intent = out + optional = F +[kdt] + standard_name = index_of_time_step + long_name = current forecast iteration + units = index + dimensions = () + type = integer + intent = out + optional = F +[julian] + standard_name = julian_day + long_name = julian day + units = days + dimensions = () + type = real + kind = kind_phys + intent = out + optional = F +[yearlen] + standard_name = number_of_days_in_year + long_name = number of days in a year + units = days + dimensions = () + type = integer + intent = out + optional = F +[ipt] + standard_name = index_for_diagnostic_printout + long_name = horizontal index for point used for diagnostic printout + units = + dimensions = () + type = integer + intent = out + optional = F +[lprnt] + standard_name = flag_print + long_name = control flag for diagnostic print out + units = flag + dimensions = () + type = logical + intent = out + optional = F +[lssav] + standard_name = flag_diagnostics + long_name = logical flag for storing diagnostics + units = flag + dimensions = () + type = logical + intent = out + optional = F +[lsswr] + standard_name = flag_to_calc_sw + long_name = logical flags for sw radiation calls + units = flag + dimensions = () + type = logical + intent = out + optional = F +[lslwr] + standard_name = flag_to_calc_lw + long_name = logical flags for lw radiation calls + units = flag + dimensions = () + type = logical + intent = out + optional = F +[solhr] + standard_name = forecast_hour_of_the_day + long_name = time in hours after 00z at the current timestep + units = h + dimensions = () + type = real + kind = kind_phys + intent = out + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F diff --git a/physics/GFS_time_vary_pre.scm.F90 b/physics/GFS_time_vary_pre.scm.F90 index bb246cd32..2fa352710 100644 --- a/physics/GFS_time_vary_pre.scm.F90 +++ b/physics/GFS_time_vary_pre.scm.F90 @@ -16,10 +16,7 @@ module GFS_time_vary_pre contains !> \section arg_table_GFS_time_vary_pre_init Argument Table -!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | -!! |----------------|--------------------------------------------------------|-------------------------------------------------------------------------|----------|------|-----------------------|-----------|--------|----------| -!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | -!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | +!! \htmlinclude GFS_time_vary_pre_init.html !! subroutine GFS_time_vary_pre_init (errmsg, errflg) @@ -33,7 +30,7 @@ subroutine GFS_time_vary_pre_init (errmsg, errflg) errflg = 0 if (is_initialized) return - + !--- Call gfuncphys (funcphys.f) to compute all physics function tables. call gfuncphys () @@ -43,10 +40,7 @@ end subroutine GFS_time_vary_pre_init !> \section arg_table_GFS_time_vary_pre_finalize Argument Table -!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | -!! |----------------|--------------------------------------------------------|-------------------------------------------------------------------------|----------|------|-----------------------|-----------|--------|----------| -!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | -!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | +!! \htmlinclude GFS_time_vary_pre_finalize.html !! subroutine GFS_time_vary_pre_finalize(errmsg, errflg) @@ -69,26 +63,40 @@ end subroutine GFS_time_vary_pre_finalize !> \section arg_table_GFS_time_vary_pre_run Argument Table -!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | -!! |----------------|--------------------------------------------------------|-----------------------------------------------------------------------|---------------|------|-----------------------|-----------|--------|----------| -!! | Model | GFS_control_type_instance | Fortran DDT containing FV3-GFS model control parameters | DDT | 0 | GFS_control_type | | inout | F | -!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | -!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | +!! \htmlinclude GFS_time_vary_pre_run.html !! - subroutine GFS_time_vary_pre_run (Model, errmsg, errflg) + subroutine GFS_time_vary_pre_run (jdat, idat, dtp, lsm, lsm_noahmp, nsswr, & + nslwr, idate, debug, me, master, nscyc, sec, phour, zhour, fhour, kdt, & + julian, yearlen, ipt, lprnt, lssav, lsswr, lslwr, solhr, errmsg, errflg) use machine, only: kind_phys - use GFS_typedefs, only: GFS_control_type implicit none - - type(GFS_control_type), intent(inout) :: Model + + integer, intent(in) :: idate(4) + integer, intent(in) :: jdat(1:8), idat(1:8) + integer, intent(in) :: lsm, lsm_noahmp, & + nsswr, nslwr, me, & + master, nscyc + logical, intent(in) :: debug + real(kind=kind_phys), intent(in) :: dtp + + integer, intent(out) :: kdt, yearlen, ipt + logical, intent(out) :: lprnt, lssav, lsswr, & + lslwr + real(kind=kind_phys), intent(out) :: sec, phour, zhour, & + fhour, julian, solhr + character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg real(kind=kind_phys), parameter :: con_24 = 24.0_kind_phys real(kind=kind_phys), parameter :: con_hr = 3600.0_kind_phys real(kind=kind_phys) :: rinc(5) + + integer :: iw3jdn + integer :: jd0, jd1 + real :: fjd ! Initialize CCPP error handling variables errmsg = '' @@ -96,44 +104,87 @@ subroutine GFS_time_vary_pre_run (Model, errmsg, errflg) ! Check initialization status if (.not.is_initialized) then - write(errmsg,'(*(a))') "Logic error: GFS_time_vary_pre_run called before GFS_time_vary_pre_init" + write(errmsg,'(*(a))') "Logic error: GFS_time_vary_pre_run called & + &before GFS_time_vary_pre_init" errflg = 1 return end if - !--- Model%jdat is being updated directly inside of FV3GFS_cap.F90 + !--- jdat is being updated directly inside of the time integration + !--- loop of gmtb_scm.F90 !--- update calendars and triggers rinc(1:5) = 0 - call w3difdat(Model%jdat,Model%idat,4,rinc) - Model%sec = rinc(4) - Model%phour = Model%sec/con_hr + call w3difdat(jdat,idat,4,rinc) + sec = rinc(4) + phour = sec/con_hr !--- set current bucket hour - Model%zhour = Model%phour - Model%fhour = (Model%sec + Model%dtp)/con_hr - Model%kdt = nint((Model%sec + Model%dtp)/Model%dtp) - - Model%ipt = 1 - Model%lprnt = .false. - Model%lssav = .true. + zhour = phour + fhour = (sec + dtp)/con_hr + kdt = nint((sec + dtp)/dtp) + + if(lsm == lsm_noahmp) then + !GJF* These calculations were originally in GFS_physics_driver.F90 for + ! NoahMP. They were moved to this routine since they only depends + ! on time (not space). Note that this code is included as-is from + ! GFS_physics_driver.F90, but it may be simplified by using more + ! NCEP W3 library calls (e.g., see W3DOXDAT, W3FS13 for Julian day + ! of year and W3DIFDAT to determine the integer number of days in + ! a given year). *GJF + ! Julian day calculation (fcst day of the year) + ! we need yearln and julian to + ! pass to noah mp sflx, idate is init, jdat is fcst;idate = jdat when kdt=1 + ! jdat is changing + ! + + jd1 = iw3jdn(jdat(1),jdat(2),jdat(3)) + jd0 = iw3jdn(jdat(1),1,1) + fjd = float(jdat(5))/24.0 + float(jdat(6))/1440.0 + + julian = float(jd1-jd0) + fjd + + ! + ! Year length + ! + ! what if the integration goes from one year to another? + ! iyr or jyr ? from 365 to 366 or from 366 to 365 + ! + ! is this against model's noleap yr assumption? + if (mod(jdat(1),4) == 0) then + yearlen = 366 + if (mod(jdat(1),100) == 0) then + yearlen = 365 + if (mod(jdat(1),400) == 0) then + yearlen = 366 + endif + endif + endif + endif + + ipt = 1 + lprnt = .false. + lssav = .true. !--- radiation triggers - Model%lsswr = (mod(Model%kdt, Model%nsswr) == 1) - Model%lslwr = (mod(Model%kdt, Model%nslwr) == 1) + lsswr = (mod(kdt, nsswr) == 1) + lslwr = (mod(kdt, nslwr) == 1) + !--- allow for radiation to be called on every physics time step, if needed + if (nsswr == 1) lsswr = .true. + if (nslwr == 1) lslwr = .true. !--- set the solar hour based on a combination of phour and time initial hour - Model%solhr = mod(Model%phour+Model%idate(1),con_24) - - if ((Model%debug) .and. (Model%me == Model%master)) then - print *,' sec ', Model%sec - print *,' kdt ', Model%kdt - print *,' nsswr ', Model%nsswr - print *,' nslwr ', Model%nslwr - print *,' nscyc ', Model%nscyc - print *,' lsswr ', Model%lsswr - print *,' lslwr ', Model%lslwr - print *,' fhour ', Model%fhour - print *,' phour ', Model%phour - print *,' solhr ', Model%solhr + solhr = mod(phour+idate(1),con_24) + + if ((debug) .and. (me == master)) then + print *,' sec ', sec + print *,' kdt ', kdt + print *,' nsswr ', nsswr + print *,' nslwr ', nslwr + print *,' nscyc ', nscyc + print *,' lsswr ', lsswr + print *,' lslwr ', lslwr + print *,' fhour ', fhour + print *,' phour ', phour + print *,' solhr ', solhr endif end subroutine GFS_time_vary_pre_run diff --git a/physics/GFS_time_vary_pre.scm.meta b/physics/GFS_time_vary_pre.scm.meta new file mode 100644 index 000000000..3dc91952e --- /dev/null +++ b/physics/GFS_time_vary_pre.scm.meta @@ -0,0 +1,271 @@ +[ccpp-arg-table] + name = GFS_time_vary_pre_init + type = scheme +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F + +######################################################################## +[ccpp-arg-table] + name = GFS_time_vary_pre_finalize + type = scheme +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F + +######################################################################## +[ccpp-arg-table] + name = GFS_time_vary_pre_run + type = scheme +[jdat] + standard_name = forecast_date_and_time + long_name = current forecast date and time + units = none + dimensions = (8) + type = integer + intent = in + optional = F +[idat] + standard_name = date_and_time_at_model_initialization + long_name = initialization date and time + units = none + dimensions = (8) + type = integer + intent = in + optional = F +[dtp] + standard_name = time_step_for_physics + long_name = physics timestep + units = s + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[lsm] + standard_name = flag_for_land_surface_scheme + long_name = flag for land surface model + units = flag + dimensions = () + type = integer + intent = in + optional = F +[lsm_noahmp] + standard_name = flag_for_noahmp_land_surface_scheme + long_name = flag for NOAH MP land surface model + units = flag + dimensions = () + type = integer + intent = in + optional = F +[nsswr] + standard_name = number_of_timesteps_between_shortwave_radiation_calls + long_name = number of timesteps between shortwave radiation calls + units = + dimensions = () + type = integer + intent = in + optional = F +[nslwr] + standard_name = number_of_timesteps_between_longwave_radiation_calls + long_name = number of timesteps between longwave radiation calls + units = + dimensions = () + type = integer + intent = in + optional = F +[idate] + standard_name = date_and_time_at_model_initialization_reordered + long_name = initial date with different size and ordering + units = none + dimensions = (4) + type = integer + intent = in + optional = F +[debug] + standard_name = flag_debug + long_name = control flag for debug + units = flag + dimensions = () + type = logical + intent = in + optional = F +[me] + standard_name = mpi_rank + long_name = current MPI-rank + units = index + dimensions = () + type = integer + intent = in + optional = F +[master] + standard_name = mpi_root + long_name = master MPI-rank + units = index + dimensions = () + type = integer + intent = in + optional = F +[nscyc] + standard_name = number_of_timesteps_between_surface_cycling_calls + long_name = number of timesteps between surface cycling calls + units = + dimensions = () + type = integer + intent = in + optional = F +[sec] + standard_name = seconds_elapsed_since_model_initialization + long_name = seconds elapsed since model initialization + units = s + dimensions = () + type = real + kind = kind_phys + intent = out + optional = F +[phour] + standard_name = forecast_time_at_previous_timestep + long_name = forecast time at the previous timestep + units = h + dimensions = () + type = real + kind = kind_phys + intent = out + optional = F +[zhour] + standard_name = time_since_diagnostics_zeroed + long_name = time since diagnostics variables have been zeroed + units = h + dimensions = () + type = real + kind = kind_phys + intent = out + optional = F +[fhour] + standard_name = forecast_time + long_name = current forecast time + units = h + dimensions = () + type = real + kind = kind_phys + intent = out + optional = F +[kdt] + standard_name = index_of_time_step + long_name = current forecast iteration + units = index + dimensions = () + type = integer + intent = out + optional = F +[julian] + standard_name = julian_day + long_name = julian day + units = days + dimensions = () + type = real + kind = kind_phys + intent = out + optional = F +[yearlen] + standard_name = number_of_days_in_year + long_name = number of days in a year + units = days + dimensions = () + type = integer + intent = out + optional = F +[ipt] + standard_name = index_for_diagnostic_printout + long_name = horizontal index for point used for diagnostic printout + units = + dimensions = () + type = integer + intent = out + optional = F +[lprnt] + standard_name = flag_print + long_name = control flag for diagnostic print out + units = flag + dimensions = () + type = logical + intent = out + optional = F +[lssav] + standard_name = flag_diagnostics + long_name = logical flag for storing diagnostics + units = flag + dimensions = () + type = logical + intent = out + optional = F +[lsswr] + standard_name = flag_to_calc_sw + long_name = logical flags for sw radiation calls + units = flag + dimensions = () + type = logical + intent = out + optional = F +[lslwr] + standard_name = flag_to_calc_lw + long_name = logical flags for lw radiation calls + units = flag + dimensions = () + type = logical + intent = out + optional = F +[solhr] + standard_name = forecast_hour_of_the_day + long_name = time in hours after 00z at the current timestep + units = h + dimensions = () + type = real + kind = kind_phys + intent = out + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F diff --git a/physics/aer_cloud.F b/physics/aer_cloud.F index 1c6e27442..60df592b6 100644 --- a/physics/aer_cloud.F +++ b/physics/aer_cloud.F @@ -158,10 +158,6 @@ end subroutine aer_cloud_init !!\param dpre_in mass-weighted diameter of prexisting ice crystals (m) !!\param ccn_diagr8 array of supersaturations for CCN diagnostics (in-out) !!\param Ndropr8 Current droplet number concentration (\f$Kg^{-1}\f$) -!!\param qc Liquid water mixing ratio (Kg/Kg) -!!\param use_average_v .false. integrate over the updraft distribution. True: use the mean vertical velocity -!!\param CCN_param CCN activation parameterization. 1- Fountoukis and Nenes (2005), 2-Abdul_Razzak and Ghan (2002) (def = 2) -!!\param IN_param IN activation spectrum (default is 5) !!\param cdncr8 Activated cloud droplet number concentration (Kg-1) !!\param smaxliqr8 Maximum supersaturation w.r.t liquid during droplet activation !!\param incr8 Nucleated ice crystal concentration (Kg-1) @@ -172,14 +168,20 @@ end subroutine aer_cloud_init !!\param Ncdepr8 Nucleated nc by deposition ice nucleation (Kg-1) !!\param Ncdhfr8 Nucleated nc by immersion in aerosol (Kg -1) !!\param sc_icer8 Critical saturation ratio in cirrus -!!\param fdust_depr8 Fraction of deposition ice nuclei that are dust !!\param fdust_immr8 Fraction of immersion mixed-phase ice nuclei that are dust +!!\param fdust_depr8 Fraction of deposition ice nuclei that are dust !!\param fdust_dhfr8 Fraction of immersion ice nuclei that are dust (not mixed-phase) !!\param nlimr8 Limiting ice nuclei concentration (m-3) - -!=================================================================================== - - +!!\param use_average_v .false. integrate over the updraft distribution. True: use the mean vertical velocity +!!\param CCN_param CCN activation parameterization. 1- Fountoukis and Nenes (2005), 2-Abdul_Razzak and Ghan (2002) (def = 2) +!!\param IN_param IN activation spectrum (default is 5) +!!\param fd_dust +!!\param fd_soot +!!\param pfrz_inc_r8 +!!\param sigma_nuc +!!\param rhi_cell +!!\param nccn +!! subroutine aerosol_activate(tparc_in, pparc_in, sigwparc_in, & & wparc_ls, Aer_Props, npre_in, dpre_in, ccn_diagr8, Ndropr8, & & cdncr8, smaxliqr8, incr8, smaxicer8, nheticer8, INimmr8, & diff --git a/physics/cires_orowam2017.f b/physics/cires_orowam2017.f new file mode 100644 index 000000000..4170a3d79 --- /dev/null +++ b/physics/cires_orowam2017.f @@ -0,0 +1,339 @@ + subroutine oro_wam_2017(im, levs,npt,ipt, kref,kdt,me,master, + & dtp,dxres, taub, u1, v1, t1, xn, yn, bn2, rho, prsi, prsL, + & del, sigma, hprime, gamma, theta, + & sinlat, xlatd, taup, taud, pkdis) +! + USE MACHINE , ONLY : kind_phys + use ugwp_common , only : grav, omega2 +! + implicit none + + integer :: im, levs + integer :: npt + integer :: kdt, me, master + integer :: kref(im), ipt(im) + real(kind=kind_phys), intent(in) :: dtp, dxres + real(kind=kind_phys), intent(in) :: taub(im) + + real(kind=kind_phys), intent(in) :: sinlat(im), xlatd(im) + real(kind=kind_phys), intent(in), dimension(im) :: sigma, + & hprime, gamma, theta + + real(kind=kind_phys), intent(in), dimension(im) :: xn, yn + + real(kind=kind_phys), intent(in), dimension(im, levs) :: + & u1, v1, t1, bn2, rho, prsl, del + + real(kind=kind_phys), intent(in), dimension(im, levs+1) :: prsi +! +! out : taup, taud, pkdis +! + real(kind=kind_phys), intent(inout), dimension(im, levs+1) :: taup + real(kind=kind_phys), intent(inout), dimension(im, levs) :: taud + real(kind=kind_phys), intent(inout), dimension(im, levs) :: pkdis + real(kind=kind_phys) :: belps, aelps, nhills, selps +! +! multiwave oro-spectra +! locals +! + integer :: i, j, k, isp, iw + + integer, parameter :: nworo = 30 + real(kind=kind_phys), parameter :: fc_flag = 0.0 + real(kind=kind_phys), parameter :: mkzmin = 6.28e-3/50.0 + real(kind=kind_phys), parameter :: mkz2min = mkzmin* mkzmin + real(kind=kind_phys), parameter :: kedmin = 1.e-3 + real(kind=kind_phys), parameter :: kedmax = 350.,axmax=250.e-5 + real(kind=kind_phys), parameter :: rtau = 0.01 ! nonlin-OGW scale 1/10sec + real(kind=kind_phys), parameter :: Linsat2 =0.5 + real(kind=kind_phys), parameter :: kxmin = 6.28e-3/100. + real(kind=kind_phys), parameter :: kxmax = 6.28e-3/5.0 + real(kind=kind_phys), parameter :: dkx = (kxmax -kxmin)/(nworo-1) + real(kind=kind_phys), parameter :: kx_slope= -5./3. + real(kind=kind_phys), parameter :: hps =7000., rhp2 = .5/hps + real(kind=kind_phys), parameter :: cxmin=0.5, cxmin2=cxmin*cxmin + + real :: akx(nworo), cxoro(nworo), akx2(nworo) + real :: aspkx(nworo), c2f2(nworo) , cdf2(nworo) + real :: tau_sp(nworo,levs+1), wkdis(nworo, levs+1) + real :: tau_kx(nworo),taub_kx(nworo) + real, dimension(nworo, levs+1) :: wrms, akzw + + real :: tauz(levs+1), rms_wind(levs+1) + real :: wave_act(nworo,levs+1) + + real :: kxw, kzw, kzw2, kzw3, kzi, dzmet, rhoint + real :: rayf, kturb + real :: uz, bv, bv2,kxsp, fcor2, cf2 + + real :: fdis + real :: wfdm, wfdt, wfim, wfit + real :: betadis, betam, betat, kds, cx, rhofac + real :: etwk, etws, tauk, cx2sat + real :: cdf1, tau_norm +! +! mean flow +! + real, dimension(levs+1) :: uzi,rhoi,ktur, kalp, dzi + + integer :: nw, nzi, ksrc + taud (:, :) = 0.0 ; pkdis(:,:) = 0.0 ; taup (:,:) = 0.0 + tau_sp (:,:) = 0.0 ; wrms(:,:) = 0.0 + nw = nworo + nzi = levs+1 + + do iw = 1, nw +! !kxw = 0.25/(dxres)*iw + kxw = kxmin+(iw-1)*dkx + akx(iw) = kxw + akx2(iw) = kxw*kxw + aspkx(iw) = kxw ** (kx_slope) + tau_kx(iw) = aspkx(iw)*dkx + enddo + + tau_norm = sum(tau_kx) + tau_kx(:) = tau_kx(:)/tau_norm + + if (kdt == 1) then +771 format( 'vay-oro19 ', 3(2x,F8.3)) + write(6,771) + & maxval(tau_kx)*maxval(taub)*1.e3, + & minval(tau_kx), maxval(tau_kx) + endif +! +! main loop over oro-points +! + do i =1, npt + j = ipt(i) + +! +! estimate "nhills" => stochastic choices for OGWs +! + if (taub(i) > 0.) then +! +! max_kxridge =min( .5*sigma(j)/hprime(j), kmax) +! ridge-dependent dkx = (max_kxridge -kxmin)/(nw-1) +! option to make grid-box variable kx-spectra kxw = kxmin+(iw-1)*dkx +! + wave_act(1:nw, 1:levs+1) = 1.0 + ksrc = kref(i) + tauz(1:ksrc) = taub(i) + taub_kx(1:nw) = tau_kx(1:nw) * taub(i) + wkdis(:,:) = kedmin + + call oro_meanflow(levs, nzi, u1(j,:), v1(j,:), t1(j,:), + & prsi(j,:), prsL(j,:), del(j,:), rho(i,:), + & bn2(i,:), uzi, rhoi,ktur, kalp,dzi, + & xn(i), yn(i)) + + fcor2 = (omega2*sinlat(j))*(omega2*sinlat(j))*fc_flag + + k = ksrc + + bv2 = bn2(i,k) + uz = uzi(k) !u1(j,ksrc)*xn(i)+v1(j,ksrc)*yn(i)! + kturb = ktur(k) + rayf = kalp(k) + rhoint = rhoi(k) + dzmet = dzi(k) + kzw = max(sqrt(bv2)/max(cxmin, uz), mkzmin) +! +! specify oro-kx spectra and related variables k=ksrc +! + do iw = 1, nw + kxw = akx(iw) + cxoro(iw) = 0.0 - uz + c2f2(iw) = fcor2/akx2(iw) + wrms(iw,k)= taub_kx(iw)/rhoint*kzw/kxw + tau_sp(iw, k) = taub_kx(iw) +! +! + if (cxoro(iw) > cxmin) then + wave_act(iw,k:levs+1) = 0. ! crit-level + else + cdf2(iw) = cxoro(iw)*cxoro(iw) -c2f2(iw) + if ( cdf2(iw) < cxmin2) then + wave_act(iw,k:levs+1) = 0. ! coriolis cut-off + else + kzw2 = max(Bv2/Cdf2(iw) - akx2(iw), mkz2min) + kzw = sqrt(kzw2) + akzw(iw,k)= kzw + wrms(iw,k)= taub_kx(iw)/rhoint * kzw/kxw + endif + endif + enddo ! nw-spectral loop +! +! defined abobe, k = ksrc: akx(nworo), cxoro(nworo), tau_sp(ksrc, nworo) +! propagate upward multiwave-spectra are filtered by dissipation & instability +! +! tau_sp(:,ksrc+1:levs+1) = tau_sp(:, ksrc) + do k= ksrc+1, levs + uz = uzi(k) + bv2 =bn2(i,k) + bv = sqrt(bv2) + rayf = kalp(k) + rhoint= rhoi(k) + dzmet = dzi(k) + rhofac = rhoi(k-1)/rhoi(k) + + do iw = 1, nworo +! + if (wave_act(iw, k-1) <= 0.0) cycle + cxoro(iw)= 0.0 - uz + if ( cxoro(iw) > cxmin) then + wave_act(iw,k:levs+1) = 0.0 ! crit-level + else + cdf2(iw) = cxoro(iw)*cxoro(iw) -c2f2(iw) + if ( cdf2(iw) < cxmin2) wave_act(iw,k:levs+1) = 0.0 + endif + if ( wave_act(iw,k) <= 0.0) cycle +! +! upward propagation +! + kzw2 = Bv2/Cdf2(iw) - akx2(iw) + + if (kzw2 < mkz2min) then + wave_act(iw,k:levs+1) = 0.0 + else +! +! upward propagation w/o reflection +! + kxw = akx(iw) + kzw = sqrt(kzw2) + akzw(iw,k) = kzw + kzw3 = kzw2*kzw + + cx = cxoro(iw) + betadis = cdf2(iw) / (Cx*Cx+c2f2(iw)) + betaM = 1.0 / (1.0+betadis) + betaT = 1.0 - BetaM + kds = wkdis(iw,k-1) + + etws = wrms(iw,k-1)*rhofac * kzw/akzw(iw,k-1) + + kturb = ktur(k)+pkdis(j,k-1) + wfiM = kturb*kzw2 +rayf + wfiT = wfiM ! do updates with Pr-numbers Kv/Kt + cdf1 = sqrt(Cdf2(iw)) + wfdM = wfiM/(kxw*Cdf1)*BetaM + wfdT = wfiT/(kxw*Cdf1)*BetaT + kzi = 2.*kzw*(wfdM+wfdT)*dzmet + Fdis = exp(-kzi) + + etwk = etws*Fdis + Cx2sat = Linsat2*Cdf2(iw) + + if (etwk > cx2sat) then + Kds = kxw*Cdf1*rhp2/kzw3 + etwk = cx2sat + wfiM = kds*kzw2 + wfdM = wfiM/(kxw*Cdf1) + kzi = 2.*kzw*(wfdm + wfdm)*dzmet + etwk = cx2sat*exp(-kzi) + endif +! if( lat(j) eq 40.5 ) then stop + wkdis(iw,k) = kds + wrms(iw,k) = etwk + tauk = etwk*kxw/kzw + tau_sp(iw,k) = tauk *rhoint + if ( tau_sp(iw,k) > tau_sp(iw,k-1)) + & tau_sp(iw,k) = tau_sp(iw,k-1) + + ENDIF ! upward + ENDDO ! spectral + +!......... do spectral sum of rms, wkdis, tau + + tauz(k) = sum( tau_sp(:,k)*wave_act(:,k) ) + rms_wind(k) = sum( wrms(:,k)*wave_act(:,k) ) + + pkdis(j,k) = sum(wkdis(:,k)*wave_act(:,k))+rms_wind(k)*rtau + + if (pkdis(j,k) > kedmax) pkdis(j,k) = kedmax + + ENDDO ! k=ksrc+1, levs + + k = ksrc + tauz(k) = sum(tau_sp(:,k)*wave_act(:,k)) + tauz(k) = tauz(k+1) ! zero momentum dep-n at k=ksrc + + pkdis(j,k) = sum(wkdis(:,k)*wave_act(:,k)) + rms_wind(k) = sum(wrms(:,k)*wave_act(:,k)) + tauz(levs+1) = tauz(levs) + taup(i, 1:levs+1) = tauz(1:levs+1) + do k=ksrc, levs + taud(i,k) = ( tauz(k+1) - tauz(k))*grav/del(j,k) +! if (taud(i,k) .gt. 0)taud(i,k)=taud(i,k)*.01 +! if (abs(taud(i,k)).ge.axmax)taud(i,k)=sign(taud(i,k),axmax) + enddo + endif ! taub > 0 + enddo ! oro-points (i, j, ipt) +!23456 + end subroutine oro_wam_2017 +!------------------------------------------------------------- +! +! define mean flow and dissipation for OGW-kx spectrum +! +!------------------------------------------------------------- + subroutine oro_meanflow(nz, nzi, u1, v1, t1, pint, pmid, + & delp, rho, bn2, uzi, rhoi, ktur, kalp, dzi, xn, yn) + + use ugwp_common , only : grav, rgrav, rdi, velmin, dw2min + implicit none + + integer :: nz, nzi + real, dimension(nz ) :: u1, v1, t1, delp, rho, pmid + real, dimension(nz ) :: bn2 ! define at the interfaces + real, dimension(nz+1) :: pint + real :: xn, yn +! output + + real, dimension(nz+1) :: dzi, uzi, rhoi, ktur, kalp + +! locals + integer :: i, j, k + real :: ui, vi, ti, uz, vz, shr2, rdz, kamp + real :: zgrow, zmet, rdpm, ritur, kmol, w1 +! paremeters + real, parameter :: hps = 7000., rpspa = 1.e-5 + real, parameter :: rhps=1.0/hps + real, parameter :: h4= 0.25/hps + real, parameter :: rimin = 1.0/8.0, kedmin = 0.01 + real, parameter :: lturb = 30. , uturb = 150.0 + real, parameter :: lsc2 = lturb*lturb,usc2 = uturb*uturb + kalp(1:nzi) = 2.e-7 ! radiative damping + + do k=2, nz + rdpm = grav/(pmid(k-1)-pmid(k)) + ui = .5*(u1(k-1)+u1(k)) + vi = .5*(v1(k-1)+v1(k)) + uzi(k) = Ui*xn + Vi*yn + ti = .5*(t1(k-1)+t1(k)) + rhoi(k) = rdi*pint(k)/ti + rdz = rdpm *rhoi(k) + dzi(k) = 1./rdz + uz = u1(k)-u1(k-1) + vz = v1(k)-v1(k-1) + shr2 = rdz*rdz*(max(uz*uz+vz*vz, dw2min)) + zmet = -hps*alog(pint(k)*rpspa) + zgrow = exp(zmet*h4) + kmol = 2.e-5*exp(zmet*rhps)+kedmin + ritur = max(bn2(k)/shr2, rimin) + kamp = sqrt(shr2)*lsc2 *zgrow + w1 = 1./(1. + 5*ritur) + ktur(k) = kamp * w1 * w1 +kmol + enddo + + k = 1 + uzi(k) = uzi(k+1) + ktur(k) = ktur(k+1) + rhoi(k) = rdi*pint(k)/t1(k+1) + dzi(k) = rgrav*delp(k)/rhoi(k) + + k = nzi + uzi(k) = uzi(k-1) + ktur(k) = ktur(k-1) + rhoi(k) = rhoi(k-1)*.5 + dzi(k) = dzi(k-1) + + end subroutine oro_meanflow diff --git a/physics/cires_ugwp.F90 b/physics/cires_ugwp.F90 new file mode 100644 index 000000000..e0abc58ff --- /dev/null +++ b/physics/cires_ugwp.F90 @@ -0,0 +1,370 @@ +!> \file cires_ugwp.F90 +!! This file contains the Unified Gravity Wave Physics (UGWP) scheme by Valery Yudin (University of Colorado, CIRES) +!! See Valery Yudin's presentation at 2017 NGGPS PI meeting: +!! Gravity waves (GWs): Mesoscale GWs transport momentum, energy (heat) , and create eddy mixing in the whole atmosphere domain; Breaking and dissipating GWs deposit: (a) momentum; (b) heat (energy); and create (c) turbulent mixing of momentum, heat, and tracers +!! To properly incorporate GW effects (a-c) unresolved by DYCOREs we need GW physics +!! "Unified": a) all GW effects due to both dissipation/breaking; b) identical GW solvers for all GW sources; c) ability to replace solvers. +!! Unified Formalism: +!! 1. GW Sources: Stochastic and physics based mechanisms for GW-excitations in the lower atmosphere, calibrated by the high-res analyses/forecasts, and observations (3 types of GW sources: orography, convection, fronts/jets). +!! 2. GW Propagation: Unified solver for “propagation, dissipation and breaking” excited from all type of GW sources. +!! 3. GW Effects: Unified representation of GW impacts on the ‘resolved’ flow for all sources (energy-balanced schemes for momentum, heat and mixing). +!! https://www.weather.gov/media/sti/nggps/Presentations%202017/02%20NGGPS_VYUDIN_2017_.pdf + +module cires_ugwp + + use machine, only: kind_phys + + use cires_ugwp_module, only: knob_ugwp_version, cires_ugwp_mod_init, cires_ugwp_mod_finalize + + use gwdps, only: gwdps_run + + implicit none + + private + + public cires_ugwp_init, cires_ugwp_run, cires_ugwp_finalize + + logical :: is_initialized = .False. + +contains + +! ------------------------------------------------------------------------ +! CCPP entry points for CIRES Unified Gravity Wave Physics (UGWP) scheme v0 +! ------------------------------------------------------------------------ +!>@brief The subroutine initializes the CIRES UGWP +!> \section arg_table_cires_ugwp_init Argument Table +!! \htmlinclude cires_ugwp_init.html +!! +! ----------------------------------------------------------------------- +! + subroutine cires_ugwp_init (me, master, nlunit, input_nml_file, logunit, & + fn_nml2, lonr, latr, levs, ak, bk, dtp, cdmbgwd, cgwf, & + pa_rf_in, tau_rf_in, con_p0, do_ugwp, errmsg, errflg) + +!---- initialization of cires_ugwp + implicit none + + integer, intent (in) :: me + integer, intent (in) :: master + integer, intent (in) :: nlunit + character(len=*), intent (in) :: input_nml_file(:) + integer, intent (in) :: logunit + integer, intent (in) :: lonr + integer, intent (in) :: levs + integer, intent (in) :: latr + real(kind=kind_phys), intent (in) :: ak(:), bk(:) + real(kind=kind_phys), intent (in) :: dtp + real(kind=kind_phys), intent (in) :: cdmbgwd(4), cgwf(2) ! "scaling" controls for "old" GFS-GW schemes + real(kind=kind_phys), intent (in) :: pa_rf_in, tau_rf_in + real(kind=kind_phys), intent (in) :: con_p0 + logical, intent (in) :: do_ugwp + + character(len=*), intent (in) :: fn_nml2 + !character(len=*), parameter :: fn_nml='input.nml' + + integer :: ios + logical :: exists + real :: dxsg + integer :: k + + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + if (is_initialized) return + + if (do_ugwp .or. cdmbgwd(3) > 0.0) then + call cires_ugwp_mod_init (me, master, nlunit, input_nml_file, logunit, & + fn_nml2, lonr, latr, levs, ak, bk, con_p0, dtp, & + cdmbgwd(1:2), cgwf, pa_rf_in, tau_rf_in) + else + write(errmsg,'(*(a))') "Logic error: cires_ugwp_init called but do_ugwp is false and cdmbgwd(3) <= 0" + errflg = 1 + return + end if + + if (.not.knob_ugwp_version==0) then + write(errmsg,'(*(a))') 'Logic error: CCPP only supports version zero of UGWP' + errflg = 1 + return + end if + + is_initialized = .true. + + end subroutine cires_ugwp_init + + +! ----------------------------------------------------------------------- +! finalize of cires_ugwp (_finalize) +! ----------------------------------------------------------------------- + +!>@brief The subroutine finalizes the CIRES UGWP +#if 0 +!> \section arg_table_cires_ugwp_finalize Argument Table +!! \htmlinclude cires_ugwp_finalize.html +!! +#endif + subroutine cires_ugwp_finalize(errmsg, errflg) + + implicit none +! + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + +! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + if (.not.is_initialized) return + + call cires_ugwp_mod_finalize() + + is_initialized = .false. + + end subroutine cires_ugwp_finalize + + +! ----------------------------------------------------------------------- +! originally from ugwp_driver_v0.f +! driver of cires_ugwp (_driver) +! ----------------------------------------------------------------------- +! driver is called after pbl & before chem-parameterizations +! ----------------------------------------------------------------------- +! order = dry-adj=>conv=mp-aero=>radiation -sfc/land- chem -> vertdiff-> [rf-gws]=> ion-re +! ----------------------------------------------------------------------- +!>@brief These subroutines and modules execute the CIRES UGWP Version 0 +!>\defgroup cires_ugwp_run Unified Gravity Wave Physics General Algorithm +!> @{ +!! The physics of NGWs in the UGWP framework (Yudin et al. 2018 \cite yudin_et_al_2018) is represented by four GW-solvers, which is introduced in Lindzen (1981) \cite lindzen_1981, Hines (1997) \cite hines_1997, Alexander and Dunkerton (1999) \cite alexander_and_dunkerton_1999, and Scinocca (2003) \cite scinocca_2003. The major modification of these GW solvers is represented by the addition of the background dissipation of temperature and winds to the saturation criteria for wave breaking. This feature is important in the mesosphere and thermosphere for WAM applications and it considers appropriate scale-dependent dissipation of waves near the model top lid providing the momentum and energy conservation in the vertical column physics (Shaw and Shepherd 2009 \cite shaw_and_shepherd_2009). In the UGWP-v0, the modification of Scinocca (2003) \cite scinocca_2003 scheme for NGWs with non-hydrostatic and rotational effects for GW propagations and background dissipation is represented by the subroutine \ref fv3_ugwp_solv2_v0. In the next release of UGWP, additional GW-solvers will be implemented along with physics-based triggering of waves and stochastic approaches for selection of GW modes characterized by horizontal phase velocities, azimuthal directions and magnitude of the vertical momentum flux (VMF). +!! +!! In UGWP-v0, the specification for the VMF function is adopted from the GEOS-5 global atmosphere model of GMAO NASA/GSFC, as described in Molod et al. (2015) \cite molod_et_al_2015 and employed in the MERRRA-2 reanalysis (Gelaro et al., 2017 \cite gelaro_et_al_2017). The Fortran subroutine \ref slat_geos5_tamp describes the latitudinal shape of VMF-function as displayed in Figure 3 of Molod et al. (2015) \cite molod_et_al_2015. It shows that the enhanced values of VMF in the equatorial region gives opportunity to simulate the QBO-like oscillations in the equatorial zonal winds and lead to more realistic simulations of the equatorial dynamics in GEOS-5 operational and MERRA-2 reanalysis products. For the first vertically extended version of FV3GFS in the stratosphere and mesosphere, this simplified function of VMF allows us to tune the model climate and to evaluate multi-year simulations of FV3GFS with the MERRA-2 and ERA-5 reanalysis products, along with temperature, ozone, and water vapor observations of current satellite missions. After delivery of the UGWP-code, the EMC group developed and tested approach to modulate the zonal mean NGW forcing by 3D-distributions of the total precipitation as a proxy for the excitation of NGWs by convection and the vertically-integrated (surface - tropopause) Turbulent Kinetic Energy (TKE). The verification scores with updated NGW forcing, as reported elsewhere by EMC researchers, display noticeable improvements in the forecast scores produced by FV3GFS configuration extended into the mesosphere. +!! +!> \section arg_table_cires_ugwp_run Argument Table +!! \htmlinclude cires_ugwp_run.html +!! + +! subroutines original + subroutine cires_ugwp_run(do_ugwp, me, master, im, levs, ntrac, dtp, kdt, lonr, & + oro, oro_uf, hprime, nmtvr, oc, theta, sigma, gamma, elvmax, clx, oa4, & + do_tofd, ldiag_ugwp, cdmbgwd, xlat, xlat_d, sinlat, coslat, area, & + ugrs, vgrs, tgrs, qgrs, prsi, prsl, prslk, phii, phil, & + del, kpbl, dusfcg, dvsfcg, gw_dudt, gw_dvdt, gw_dtdt, gw_kdis, & + tau_tofd, tau_mtb, tau_ogw, tau_ngw, zmtb, zlwb, zogw, & + dudt_mtb,dudt_ogw, dudt_tms, du3dt_mtb, du3dt_ogw, du3dt_tms, & + dudt, dvdt, dtdt, rdxzb, con_g, con_pi, con_cp, con_rd, con_rv, con_fvirt, & + rain, ntke, q_tke, dqdt_tke, lprnt, ipr, errmsg, errflg) + + implicit none + + ! interface variables + integer, intent(in) :: me, master, im, levs, ntrac, kdt, lonr, nmtvr + integer, intent(in), dimension(im) :: kpbl + real(kind=kind_phys), intent(in), dimension(im) :: oro, oro_uf, hprime, oc, theta, sigma, gamma + ! elvmax is intent(in) for CIRES UGWP, but intent(inout) for GFS GWDPS + real(kind=kind_phys), intent(inout), dimension(im) :: elvmax + real(kind=kind_phys), intent(in), dimension(im, 4) :: clx, oa4 + real(kind=kind_phys), intent(in), dimension(im) :: xlat, xlat_d, sinlat, coslat, area + real(kind=kind_phys), intent(in), dimension(im, levs) :: del, ugrs, vgrs, tgrs, prsl, prslk, phil + real(kind=kind_phys), intent(in), dimension(im, levs+1) :: prsi, phii + real(kind=kind_phys), intent(in), dimension(im, levs, ntrac):: qgrs + real(kind=kind_phys), intent(in) :: dtp, cdmbgwd(4) + logical, intent(in) :: do_ugwp, do_tofd, ldiag_ugwp + + real(kind=kind_phys), intent(out), dimension(im) :: dusfcg, dvsfcg + real(kind=kind_phys), intent(out), dimension(im) :: zmtb, zlwb, zogw, rdxzb + real(kind=kind_phys), intent(out), dimension(im) :: tau_mtb, tau_ogw, tau_tofd, tau_ngw + real(kind=kind_phys), intent(out), dimension(im, levs):: gw_dudt, gw_dvdt, gw_dtdt, gw_kdis + real(kind=kind_phys), intent(out), dimension(im, levs):: dudt_mtb, dudt_ogw, dudt_tms + ! These arrays only allocated if ldiag_ugwp = .true. + real(kind=kind_phys), intent(out), dimension(:,:) :: du3dt_mtb, du3dt_ogw, du3dt_tms + + real(kind=kind_phys), intent(inout), dimension(im, levs):: dudt, dvdt, dtdt + + real(kind=kind_phys), intent(in) :: con_g, con_pi, con_cp, con_rd, con_rv, con_fvirt + + real(kind=kind_phys), intent(in), dimension(im) :: rain + + integer, intent(in) :: ntke + real(kind=kind_phys), intent(in), dimension(:,:) :: q_tke, dqdt_tke + + logical, intent(in) :: lprnt + integer, intent(in) :: ipr + + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! local variables + integer :: i, k + real(kind=kind_phys), dimension(im) :: sgh30 + real(kind=kind_phys), dimension(im, levs) :: Pdvdt, Pdudt + real(kind=kind_phys), dimension(im, levs) :: Pdtdt, Pkdis + real(kind=kind_phys), dimension(im, levs) :: ed_dudt, ed_dvdt, ed_dtdt + ! from ugwp_driver_v0.f -> cires_ugwp_initialize.F90 -> module ugwp_wmsdis_init + real(kind=kind_phys), parameter :: tamp_mpa=30.e-3 + ! switches that activate impact of OGWs and NGWs (WL* how to deal with them? *WL) + real(kind=kind_phys), parameter :: pogw=1., pngw=1., pked=1. + + real(kind=kind_phys), dimension(:,:), allocatable :: tke + real(kind=kind_phys), dimension(:), allocatable :: turb_fac, tem + real(kind=kind_phys) :: rfac, tx1 + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + ! 1) ORO stationary GWs + ! ------------------ + ! wrap everything in a do_ugwp 'if test' in order not to break the namelist functionality + if (do_ugwp) then ! calling revised old GFS gravity wave drag + + ! topo paras + ! w/ orographic effects + if(nmtvr == 14)then + ! calculate sgh30 for TOFD + sgh30 = abs(oro - oro_uf) + ! w/o orographic effects + else + sgh30 = 0. + endif + + zlwb(:) = 0. + + call GWDPS_V0(im, levs, lonr, do_tofd, Pdvdt, Pdudt, Pdtdt, Pkdis, & + ugrs, vgrs, tgrs, qgrs(:,:,1), kpbl, prsi,del,prsl, prslk, phii, phil, & + dtp, kdt, sgh30, hprime, oc, oa4, clx, theta, sigma, gamma, elvmax, & + dusfcg, dvsfcg, xlat_d, sinlat, coslat, area, cdmbgwd(1:2), & + me, master, rdxzb, zmtb, zogw, tau_mtb, tau_ogw, tau_tofd, & + dudt_mtb, dudt_ogw, dudt_tms) + + else ! calling old GFS gravity wave drag as is + + do k=1,levs + do i=1,im + Pdvdt(i,k) = 0.0 + Pdudt(i,k) = 0.0 + Pdtdt(i,k) = 0.0 + Pkdis(i,k) = 0.0 + enddo + enddo + + if (cdmbgwd(1) > 0.0 .or. cdmbgwd(2) > 0.0) then + call gwdps_run(im, im, levs, Pdvdt, Pdudt, Pdtdt, & + ugrs, vgrs, tgrs, qgrs, & + kpbl, prsi, del, prsl, prslk, phii, phil, dtp, kdt, & + hprime, oc, oa4, clx, theta, sigma, gamma, & + elvmax, dusfcg, dvsfcg, & + con_g, con_cp, con_rd, con_rv, lonr, & + nmtvr, cdmbgwd, me, lprnt, ipr, rdxzb, & + errmsg, errflg) + if (errflg/=0) return + endif + + tau_mtb = 0.0 ; tau_ogw = 0.0 ; tau_tofd = 0.0 + if (ldiag_ugwp) then + du3dt_mtb = 0.0 ; du3dt_ogw = 0.0 ; du3dt_tms= 0.0 + end if + + endif ! do_ugwp + + if (cdmbgwd(3) > 0.0) then + + ! 2) non-stationary GW-scheme with GMAO/MERRA GW-forcing + call slat_geos5_tamp(im, tamp_mpa, xlat_d, tau_ngw) + + if (abs(1.0-cdmbgwd(3)) > 1.0e-6) then + if (cdmbgwd(4) > 0.0) then + allocate(turb_fac(im)) + do i=1,im + turb_fac(i) = 0.0 + enddo + if (ntke > 0) then + allocate(tke(im,levs)) + allocate(tem(im)) + tke(:,:) = q_tke(:,:) + dqdt_tke(:,:) * dtp + tem(:) = 0.0 + do k=1,(levs+levs)/3 + do i=1,im + turb_fac(i) = turb_fac(i) + del(i,k) * tke(i,k) + tem(i) = tem(i) + del(i,k) + enddo + enddo + do i=1,im + turb_fac(i) = turb_fac(i) / tem(i) + enddo + deallocate(tke) + deallocate(tem) + endif + rfac = 86400000 / dtp + do i=1,im + tx1 = cdmbgwd(4)*min(10.0, max(turb_fac(i),rain(i)*rfac)) + tau_ngw(i) = tau_ngw(i) * max(0.1, min(5.0, tx1)) + enddo + deallocate(turb_fac) + endif + do i=1,im + tau_ngw(i) = tau_ngw(i) * cdmbgwd(3) + enddo + endif + + call fv3_ugwp_solv2_v0(im, levs, dtp, tgrs, ugrs, vgrs,qgrs(:,:,1), & + prsl, prsi, phil, xlat_d, sinlat, coslat, gw_dudt, gw_dvdt, gw_dtdt, gw_kdis, & + tau_ngw, me, master, kdt) + + do k=1,levs + do i=1,im + gw_dtdt(i,k) = pngw*gw_dtdt(i,k)+ pogw*Pdtdt(i,k) + gw_dudt(i,k) = pngw*gw_dudt(i,k)+ pogw*Pdudt(i,k) + gw_dvdt(i,k) = pngw*gw_dvdt(i,k)+ pogw*Pdvdt(i,k) + gw_kdis(i,k) = pngw*gw_kdis(i,k)+ pogw*Pkdis(i,k) + ! accumulation of tendencies for CCPP to replicate EMC-physics updates (!! removed in latest code commit to VLAB) + !dudt(i,k) = dudt(i,k) +gw_dudt(i,k) + !dvdt(i,k) = dvdt(i,k) +gw_dvdt(i,k) + !dtdt(i,k) = dtdt(i,k) +gw_dtdt(i,k) + enddo + enddo + + else + + do k=1,levs + do i=1,im + gw_dtdt(i,k) = Pdtdt(i,k) + gw_dudt(i,k) = Pdudt(i,k) + gw_dvdt(i,k) = Pdvdt(i,k) + gw_kdis(i,k) = Pkdis(i,k) + enddo + enddo + + endif + + if (pogw == 0.0) then + tau_mtb = 0. ; tau_ogw = 0. ; tau_tofd = 0. + dudt_mtb = 0. ; dudt_ogw = 0. ; dudt_tms = 0. + endif + + return + + !============================================================================= + ! make "ugwp eddy-diffusion" update for gw_dtdt/gw_dudt/gw_dvdt by solving + ! vert diffusion equations & update "Statein%tgrs, Statein%ugrs, Statein%vgrs" + !============================================================================= + ! 3) application of "eddy"-diffusion to "smooth" UGWP-related tendencies + !------------------------------------------------------------------------------ + do k=1,levs + do i=1,im + ed_dudt(i,k) = 0.0 ; ed_dvdt(i,k) = 0.0 ; ed_dtdt(i,k) = 0.0 + enddo + enddo + + call edmix_ugwp_v0(im, levs, dtp, tgrs, ugrs, vgrs, qgrs(:,:,1), & + del, prsl, prsi, phil, prslk, gw_dudt, gw_dvdt, gw_dtdt, gw_kdis, & + ed_dudt, ed_dvdt, ed_dtdt, me, master, kdt) + gw_dtdt = gw_dtdt*(1.-pked) + ed_dtdt*pked + gw_dvdt = gw_dvdt*(1.-pked) + ed_dvdt*pked + gw_dudt = gw_dudt*(1.-pked) + ed_dudt*pked + + end subroutine cires_ugwp_run + +end module cires_ugwp diff --git a/physics/cires_ugwp.meta b/physics/cires_ugwp.meta new file mode 100644 index 000000000..7f1118016 --- /dev/null +++ b/physics/cires_ugwp.meta @@ -0,0 +1,869 @@ +[ccpp-arg-table] + name = cires_ugwp_init + type = scheme +[me] + standard_name = mpi_rank + long_name = MPI rank of current process + units = index + dimensions = () + type = integer + intent = in + optional = F +[master] + standard_name = mpi_root + long_name = MPI rank of master process + units = index + dimensions = () + type = integer + intent = in + optional = F +[nlunit] + standard_name = iounit_namelist + long_name = fortran unit number for opening namelist file + units = none + dimensions = () + type = integer + intent = in + optional = F +[input_nml_file] + standard_name = namelist_filename_for_internal_file_reads + long_name = character string to store full namelist contents + units = none + dimensions = (number_of_lines_of_namelist_filename_for_internal_file_reads) + type = character + kind = len=* + intent = in + optional = F +[logunit] + standard_name = iounit_log + long_name = fortran unit number for writing logfile + units = none + dimensions = () + type = integer + intent = in + optional = F +[fn_nml2] + standard_name = namelist_filename + long_name = namelist filename for ugwp + units = none + dimensions = () + type = character + kind = len=* + intent = in + optional = F +[lonr] + standard_name = number_of_equatorial_longitude_points + long_name = number of global points in x-dir (i) along the equator + units = count + dimensions = () + type = integer + intent = in + optional = F +[latr] + standard_name = number_of_latitude_points + long_name = number of global points in y-dir (j) along the meridian + units = count + dimensions = () + type = integer + intent = in + optional = F +[levs] + standard_name = vertical_dimension + long_name = number of vertical levels + units = count + dimensions = () + type = integer + intent = in + optional = F +[ak] + standard_name = a_parameter_of_the_hybrid_coordinate + long_name = a parameter for sigma pressure level calculations + units = Pa + dimensions = (number_of_vertical_layers_for_radiation_calculations_plus_one) + type = real + kind = kind_phys + intent = in + optional = F +[bk] + standard_name = b_parameter_of_the_hybrid_coordinate + long_name = b parameter for sigma pressure level calculations + units = none + dimensions = (number_of_vertical_layers_for_radiation_calculations_plus_one) + type = real + kind = kind_phys + intent = in + optional = F +[dtp] + standard_name = time_step_for_physics + long_name = physics timestep + units = s + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[cdmbgwd] + standard_name = multiplication_factors_for_mountain_blocking_and_orographic_gravity_wave_drag + long_name = multiplication factors for cdmb and gwd + units = none + dimensions = (4) + type = real + kind = kind_phys + intent = in + optional = F +[cgwf] + standard_name = multiplication_factors_for_convective_gravity_wave_drag + long_name = multiplication factor for convective GWD + units = none + dimensions = (2) + type = real + kind = kind_phys + intent = in + optional = F +[pa_rf_in] + standard_name = pressure_cutoff_for_rayleigh_damping + long_name = pressure level from which Rayleigh Damping is applied + units = Pa + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[tau_rf_in] + standard_name = time_scale_for_rayleigh_damping + long_name = time scale for Rayleigh damping in days + units = d + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[con_p0] + standard_name = standard_atmospheric_pressure + long_name = standard atmospheric pressure + units = Pa + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[do_ugwp] + standard_name = do_ugwp + long_name = flag to activate CIRES UGWP + units = flag + dimensions = () + type = logical + intent = in + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F + +######################################################################## +[ccpp-arg-table] + name = cires_ugwp_finalize + type = scheme +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F + +######################################################################## +[ccpp-arg-table] + name = cires_ugwp_run + type = scheme +[do_ugwp] + standard_name = do_ugwp + long_name = flag to activate CIRES UGWP + units = flag + dimensions = () + type = logical + intent = in + optional = F +[me] + standard_name = mpi_rank + long_name = MPI rank of current process + units = index + dimensions = () + type = integer + intent = in + optional = F +[master] + standard_name = mpi_root + long_name = MPI rank of master process + units = index + dimensions = () + type = integer + intent = in + optional = F +[im] + standard_name = horizontal_loop_extent + long_name = horizontal + units = count + dimensions = () + type = integer + intent = in + optional = F +[levs] + standard_name = vertical_dimension + long_name = number of vertical levels + units = count + dimensions = () + type = integer + intent = in + optional = F +[ntrac] + standard_name = number_of_tracers + long_name = number of tracers + units = count + dimensions = () + type = integer + intent = in + optional = F +[dtp] + standard_name = time_step_for_physics + long_name = physics timestep + units = s + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[kdt] + standard_name = index_of_time_step + long_name = current forecast iteration + units = index + dimensions = () + type = integer + intent = in + optional = F +[lonr] + standard_name = number_of_equatorial_longitude_points + long_name = number of global points in x-dir (i) along the equator + units = count + dimensions = () + type = integer + intent = in + optional = F +[oro] + standard_name = orography + long_name = orography + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[oro_uf] + standard_name = orography_unfiltered + long_name = unfiltered orography + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[hprime] + standard_name = standard_deviation_of_subgrid_orography + long_name = standard deviation of subgrid orography + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[nmtvr] + standard_name = number_of_statistical_measures_of_subgrid_orography + long_name = number of topographic variables in GWD + units = count + dimensions = () + type = integer + intent = in + optional = F +[oc] + standard_name = convexity_of_subgrid_orography + long_name = convexity of subgrid orography + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[oa4] + standard_name = asymmetry_of_subgrid_orography + long_name = asymmetry of subgrid orography + units = none + dimensions = (horizontal_dimension,4) + type = real + kind = kind_phys + intent = in + optional = F +[clx] + standard_name = fraction_of_grid_box_with_subgrid_orography_higher_than_critical_height + long_name = horizontal fraction of grid box covered by subgrid orography higher than critical height + units = frac + dimensions = (horizontal_dimension,4) + type = real + kind = kind_phys + intent = in + optional = F +[theta] + standard_name = angle_from_east_of_maximum_subgrid_orographic_variations + long_name = angle with_respect to east of maximum subgrid orographic variations + units = degrees + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[sigma] + standard_name = slope_of_subgrid_orography + long_name = slope of subgrid orography + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[gamma] + standard_name = anisotropy_of_subgrid_orography + long_name = anisotropy of subgrid orography + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[elvmax] + standard_name = maximum_subgrid_orography + long_name = maximum of subgrid orography + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[do_tofd] + standard_name = turb_oro_form_drag_flag + long_name = flag for turbulent orographic form drag + units = flag + dimensions = () + type = logical + intent = in + optional = F +[ldiag_ugwp] + standard_name = diag_ugwp_flag + long_name = flag for CIRES UGWP Diagnostics + units = flag + dimensions = () + type = logical + intent = in + optional = F +[cdmbgwd] + standard_name = multiplication_factors_for_mountain_blocking_and_orographic_gravity_wave_drag + long_name = multiplication factors for cdmb and gwd + units = none + dimensions = (4) + type = real + kind = kind_phys + intent = in + optional = F +[xlat] + standard_name = latitude + long_name = grid latitude in radians + units = radians + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[xlat_d] + standard_name = latitude_degree + long_name = latitude in degrees + units = degree + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[sinlat] + standard_name = sine_of_latitude + long_name = sine of the grid latitude + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[coslat] + standard_name = cosine_of_latitude + long_name = cosine of the grid latitude + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[area] + standard_name = cell_area + long_name = area of the grid cell + units = m2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[ugrs] + standard_name = x_wind + long_name = zonal wind + units = m s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[vgrs] + standard_name = y_wind + long_name = meridional wind + units = m s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[tgrs] + standard_name = air_temperature + long_name = model layer mean temperature + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[qgrs] + standard_name = tracer_concentration + long_name = model layer mean tracer concentration + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension,number_of_tracers) + type = real + kind = kind_phys + intent = in + optional = F +[prsi] + standard_name = air_pressure_at_interface + long_name = air pressure at model layer interfaces + units = Pa + dimensions = (horizontal_dimension,vertical_dimension_plus_one) + type = real + kind = kind_phys + intent = in + optional = F +[prsl] + standard_name = air_pressure + long_name = mean layer pressure + units = Pa + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[prslk] + standard_name = dimensionless_exner_function_at_model_layers + long_name = dimensionless Exner function at model layer centers + units = none + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[phii] + standard_name = geopotential_at_interface + long_name = geopotential at model layer interfaces + units = m2 s-2 + dimensions = (horizontal_dimension,vertical_dimension_plus_one) + type = real + kind = kind_phys + intent = in + optional = F +[phil] + standard_name = geopotential + long_name = geopotential at model layer centers + units = m2 s-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[del] + standard_name = air_pressure_difference_between_midlayers + long_name = air pressure difference between midlayers + units = Pa + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[kpbl] + standard_name = vertical_index_at_top_of_atmosphere_boundary_layer + long_name = vertical index at top atmospheric boundary layer + units = index + dimensions = (horizontal_dimension) + type = integer + intent = in + optional = F +[dusfcg] + standard_name = instantaneous_x_stress_due_to_gravity_wave_drag + long_name = zonal surface stress due to orographic gravity wave drag + units = Pa + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[dvsfcg] + standard_name = instantaneous_y_stress_due_to_gravity_wave_drag + long_name = meridional surface stress due to orographic gravity wave drag + units = Pa + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[gw_dudt] + standard_name = tendency_of_x_wind_due_to_ugwp + long_name = zonal wind tendency due to UGWP + units = m s-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[gw_dvdt] + standard_name = tendency_of_y_wind_due_to_ugwp + long_name = meridional wind tendency due to UGWP + units = m s-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[gw_dtdt] + standard_name = tendency_of_air_temperature_due_to_ugwp + long_name = air temperature tendency due to UGWP + units = K s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[gw_kdis] + standard_name = eddy_mixing_due_to_ugwp + long_name = eddy mixing due to UGWP + units = m2 s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[tau_tofd] + standard_name = instantaneous_momentum_flux_due_to_turbulent_orographic_form_drag + long_name = momentum flux or stress due to TOFD + units = Pa + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[tau_mtb] + standard_name = instantaneous_momentum_flux_due_to_mountain_blocking_drag + long_name = momentum flux or stress due to mountain blocking drag + units = Pa + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[tau_ogw] + standard_name = instantaneous_momentum_flux_due_to_orographic_gravity_wave_drag + long_name = momentum flux or stress due to orographic gravity wave drag + units = Pa + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[tau_ngw] + standard_name = instantaneous_momentum_flux_due_to_nonstationary_gravity_wave + long_name = momentum flux or stress due to nonstationary gravity waves + units = Pa + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[zmtb] + standard_name = height_of_mountain_blocking + long_name = height of mountain blocking drag + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[zlwb] + standard_name = height_of_low_level_wave_breaking + long_name = height of low level wave breaking + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[zogw] + standard_name = height_of_launch_level_of_orographic_gravity_wave + long_name = height of launch level of orographic gravity wave + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[dudt_mtb] + standard_name = instantaneous_change_in_x_wind_due_to_mountain_blocking_drag + long_name = instantaneous change in x wind due to mountain blocking drag + units = m s-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[dudt_ogw] + standard_name = instantaneous_change_in_x_wind_due_to_orographic_gravity_wave_drag + long_name = instantaneous change in x wind due to orographic gw drag + units = m s-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[dudt_tms] + standard_name = instantaneous_change_in_x_wind_due_to_turbulent_orographic_form_drag + long_name = instantaneous change in x wind due to TOFD + units = m s-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[du3dt_mtb] + standard_name = time_integral_of_change_in_x_wind_due_to_mountain_blocking_drag + long_name = time integral of change in x wind due to mountain blocking drag + units = m s-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[du3dt_ogw] + standard_name = time_integral_of_change_in_x_wind_due_to_orographic_gravity_wave_drag + long_name = time integral of change in x wind due to orographic gw drag + units = m s-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[du3dt_tms] + standard_name = time_integral_of_change_in_x_wind_due_to_turbulent_orographic_form_drag + long_name = time integral of change in x wind due to TOFD + units = m s-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[dudt] + standard_name = tendency_of_x_wind_due_to_model_physics + long_name = zonal wind tendency due to model physics + units = m s-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[dvdt] + standard_name = tendency_of_y_wind_due_to_model_physics + long_name = meridional wind tendency due to model physics + units = m s-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[dtdt] + standard_name = tendency_of_air_temperature_due_to_model_physics + long_name = air temperature tendency due to model physics + units = K s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[rdxzb] + standard_name = level_of_dividing_streamline + long_name = level of the dividing streamline + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[con_g] + standard_name = gravitational_acceleration + long_name = gravitational acceleration + units = m s-2 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[con_pi] + standard_name = pi + long_name = ratio of a circle's circumference to its diameter + units = radians + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[con_cp] + standard_name = specific_heat_of_dry_air_at_constant_pressure + long_name = specific heat !of dry air at constant pressure + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[con_rd] + standard_name = gas_constant_dry_air + long_name = ideal gas constant for dry air + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[con_rv] + standard_name = gas_constant_water_vapor + long_name = ideal gas constant for water vapor + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[con_fvirt] + standard_name = ratio_of_vapor_to_dry_air_gas_constants_minus_one + long_name = rv/rd - 1 (rv = ideal gas constant for water vapor) + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[rain] + standard_name = lwe_thickness_of_precipitation_amount_on_dynamics_timestep + long_name = total rain at this time step + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[ntke] + standard_name = index_for_turbulent_kinetic_energy + long_name = tracer index for turbulent kinetic energy + units = index + dimensions = () + type = integer + intent = in + optional = F +[q_tke] + standard_name = turbulent_kinetic_energy + long_name = turbulent kinetic energy + units = J + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[dqdt_tke] + standard_name = tendency_of_turbulent_kinetic_energy_due_to_model_physics + long_name = turbulent kinetic energy tendency due to model physics + units = J s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[lprnt] + standard_name = flag_print + long_name = control flag for diagnostic print out + units = flag + dimensions = () + type = logical + intent = in + optional = F +[ipr] + standard_name = horizontal_index_of_printed_column + long_name = horizontal index of printed column + units = index + dimensions = () + type = integer + intent = in + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F diff --git a/physics/cires_ugwp_initialize.F90 b/physics/cires_ugwp_initialize.F90 new file mode 100644 index 000000000..fbcc1d205 --- /dev/null +++ b/physics/cires_ugwp_initialize.F90 @@ -0,0 +1,704 @@ +!=============================== +! cu-cires ugwp-scheme +! initialization of selected +! init gw-solvers (1,2,3,4) +! init gw-source specifications +! init gw-background dissipation +!============================== +! +! Part-0 specifications of common constants, limiters and "criiical" values + + +! module oro_state + +! integer, parameter :: kind_phys=8 +! integer, parameter :: nvaroro=14 +! real (kind=kind_phys), allocatable :: oro_stat(:, :) +! contains + +! subroutine fill_oro_stat(nx, oc, oa4, clx4, theta, gamm, sigma, elvmax, hprime) + +! real (kind=kind_phys),dimension(nx) :: oc, theta, gamm, sigma, elvmax, hprime +! real(kind=kind_phys),dimension(nx,4) :: oa4, clx4 +! integer :: i +! do i=1, nx +! oro_stat(i,1) = hprime(i) +! oro_stat(i,2) = oc(i) +! oro_stat(i,3:6) = oa4(i,1:4) +! oro_stat(i,7:10) = clx4(i,1:4) +! oro_stat(i,11) = theta(i) +! oro_stat(i,12) = gamm(i) +! oro_stat(i,13) = sigma(i) +! oro_stat(i,14) = elvmax(i) +! enddo +! end subroutine fill_oro_stat + +! end module oro_state + + module ugwp_common +! + use machine, only: kind_phys + use physcons, only : pi => con_pi, grav => con_g, rd => con_rd, & + rv => con_rv, cpd => con_cp, fv => con_fvirt,& + arad => con_rerth + implicit none + + real(kind=kind_phys), parameter :: grcp = grav/cpd, rgrav = 1.0d0/grav, & + rdi = 1.0d0/rd, & + gor = grav/rd, gr2 = grav*gor, gocp = grav/cpd, & + rcpd = 1./cpd, rcpd2 = 0.5*rcpd, & + pi2 = pi + pi, omega1 = pi2/86400.0, & + omega2 = omega1+omega1, & + rad_to_deg=180.0/pi, deg_to_rad=pi/180.0, & + dw2min=1.0, bnv2min=1.e-6, velmin=sqrt(dw2min) + + + end module ugwp_common +! +! +!=================================================== +! +!Part-1 init => wave dissipation + RFriction +! +!=================================================== + subroutine init_global_gwdis(levs, zkm, pmb, kvg, ktg, krad, kion) + implicit none + + integer :: levs + real, intent(in) :: zkm(levs), pmb(levs) + real, intent(out), dimension(levs+1) :: kvg, ktg, krad, kion +! +!locals + data +! + integer :: k + real, parameter :: vusurf = 2.e-5 + real, parameter :: musurf = vusurf/1.95 + real, parameter :: hpmol = 8.5 +! + real, parameter :: kzmin = 0.1 + real, parameter :: kturbo = 100. + real, parameter :: zturbo = 130. + real, parameter :: zturw = 30. + real, parameter :: inv_pra = 3. !kt/kv =inv_pr +! + real, parameter :: alpha = 1./86400./15. +! + real, parameter :: kdrag = 1./86400./10. + real, parameter :: zdrag = 100. + real, parameter :: zgrow = 50. +! + real :: vumol, mumol, keddy, ion_drag +! + do k=1, levs + vumol = vusurf*exp(-zkm(k)/hpmol) + mumol = musurf*exp(-zkm(k)/hpmol) + + keddy = kturbo*exp(-((zkm(k)-zturbo) /zturw)**2) + + kvg(k) = vumol + keddy + ktg(k) = mumol + keddy*inv_pra + + krad(k) = alpha +! + ion_drag = kdrag +! + kion(k) = ion_drag + enddo + + k= levs+1 + kion(k) = kion(k-1) + krad(k) = krad(k-1) + kvg(k) = kvg(k-1) + ktg(k) = ktg(k-1) +! + end subroutine init_global_gwdis +! +! + subroutine rf_damp_init(levs, pa_rf, tau_rf, dtp, pmb, rfdis, rfdist, levs_rf) + implicit none + + integer :: levs + real :: pa_rf, tau_rf + real :: dtp + + real :: pmb(levs) + real :: rfdis(levs), rfdist(levs) + integer :: levs_rf + + real :: krf, krfz + integer :: k +! + rfdis(1:levs) = 1.0 + rfdist(1:levs) = 0.0 + levs_rf = levs + if (tau_rf <= 0.0 .or. pa_rf == 0.0) return + + krf = 1.0/(tau_rf*86400.0) + + do k=levs, 1, -1 + if(pmb(k) < pa_rf ) then ! applied only on constant pressure surfaces fixed pmb in "Pa" + krfz = krf*log(pa_rf/pmb(k)) + rfdis(k) = 1.0/(1.+krfz*dtp) + rfdist(k) = (rfdis(k) -1.0)/dtp ! du/dtp + levs_rf = k + endif + enddo + + end subroutine rf_damp_init +! ======================================================================== +! Part 2 - sources +! wave sources +! ======================================================================== +! +! ugwp_oro_init +! +!========================================================================= + module ugwp_oro_init + + use ugwp_common, only : bnv2min, grav, grcp, fv, grav, cpd, grcp, pi + + implicit none +! +! constants and "crirtical" values to run oro-mtb_gw physics +! +! choice of oro-scheme: strver = 'vay_2018' , 'gfs_2018', 'kdn_2005', 'smc_2000' +! + character(len=8) :: strver = 'gfs_2018' + character(len=8) :: strbase = 'gfs_2018' + real, parameter :: rimin=-10., ric=0.25 + +! + real, parameter :: efmin=0.5, efmax=10.0 + real, parameter :: hpmax=2400.0, hpmin=25.0 + real, parameter :: sigma_std=1./100., gamm_std=1.0 + + real, parameter :: frmax=10., frc =1.0, frmin =0.01 +! + + real, parameter :: ce=0.8, ceofrc=ce/frc, cg=0.5 + real, parameter :: gmax=1.0, veleps=1.0, factop=0.5 +! + real, parameter :: rlolev=50000.0 +! + real, parameter :: hncrit=9000. ! max value in meters for elvmax + +! hncrit set to 8000m and sigfac added to enhance elvmax mtn hgt + + real, parameter :: sigfac=4.0 ! mb3a expt test for elvmax factor + real, parameter :: hminmt=50. ! min mtn height (*j*) + real, parameter :: minwnd=1.0 ! min wind component (*j*) + real, parameter :: dpmin=5000.0 ! minimum thickness of the reference layer in pa + + real, parameter :: kxoro=6.28e-3/200. ! + real, parameter :: coro = 0.0 + integer, parameter :: nridge=2 + + real :: cdmb ! scale factors for mtb + real :: cleff ! scale factors for orogw + integer :: nworo ! number of waves + integer :: nazoro ! number of azimuths + integer :: nstoro ! flag for stochastic launch above SG-peak + + integer, parameter :: mdir = 8 + real, parameter :: fdir=.5*mdir/pi + + integer nwdir(mdir) + data nwdir/6,7,5,8,2,3,1,4/ + save nwdir + + real, parameter :: odmin = 0.1, odmax = 10.0 +!------------------------------------------------------------------------------ +! small-scale orography parameters for TOFD of Beljaars et al., 2004, QJRMS +!------------------------------------------------------------------------------ + + integer, parameter :: n_tofd = 2 ! depth of SSO for TOFD compared with Zpbl + real, parameter :: const_tofd = 0.0759 ! alpha*beta*Cmd*Ccorr*2.109 = 12.*1.*0.005*0.6*2.109 = 0.0759 + real, parameter :: ze_tofd = 1500.0 ! BJ's z-decay in meters + real, parameter :: a12_tofd = 0.0002662*0.005363 ! BJ's k-spect const for sigf2 * a1*a2*exp(-[z/zdec]**1.5] + real, parameter :: ztop_tofd = 10.*ze_tofd ! no TOFD > this height too higher 15 km +!------------------------------------------------------------------------------ +! + real, parameter :: fcrit_sm = 0.7, fcrit_sm2 = fcrit_sm * fcrit_sm + real, parameter :: fcrit_gfs = 0.7 + real, parameter :: fcrit_mtb = 0.7 + + real, parameter :: lzmax = 18.e3 ! 18 km + real, parameter :: mkzmin = 6.28/lzmax + real, parameter :: mkz2min = mkzmin*mkzmin + real, parameter :: zbr_pi = (3.0/2.0)*pi + real, parameter :: zbr_ifs = 0.5*pi + + contains +! + subroutine init_oro_gws(nwaves, nazdir, nstoch, effac, & + lonr, kxw, cdmbgwd ) +! +! + integer :: nwaves, nazdir, nstoch + integer :: lonr + real :: cdmbgwd(2) ! scaling factors for MTb (1) & (2) for cleff = cleff * cdmbgwd(2) + ! high res-n "larger" MTB and "less-active" cleff in GFS-2018 + real :: cdmbX + real :: kxw + real :: effac ! it is analog of cdmbgwd(2) for GWs, off for now +!-----------------------------! GFS-setup for cdmb & cleff +! cdmb = 4.0 * (192.0/IMX) +! cleff = 0.5E-5 / SQRT(IMX/192.0) = 0.5E-5*SQRT(192./IMX) +! + real, parameter :: lonr_refmb = 4.0 * 192.0 + real, parameter :: lonr_refgw = 192.0 + +! copy to "ugwp_oro_init" => nwaves, nazdir, nstoch + + nworo = nwaves + nazoro = nazdir + nstoro = nstoch + + cdmbX = lonr_refmb/float(lonr) + cdmb = cdmbX + if (cdmbgwd(1) >= 0.0) cdmb = cdmb * cdmbgwd(1) + + cleff = 0.5e-5 * sqrt(lonr_refgw/float(lonr)) !* effac + +!!! cleff = kxw * sqrt(lonr_refgw/float(lonr)) !* effac + + if (cdmbgwd(2) >= 0.0) cleff = cleff * cdmbgwd(2) +! +!.................................................................... +! higher res => smaller h' ..&.. higher kx +! flux_gwd ~ 'u'^2*kx/kz ~kxu/n ~1/dx *u/n tau ~ h'*h'*kx*kx = const (h'-less kx-grow) +!.................................................................... +! +! print *, ' init_oro_gws 2-1cdmb', cdmbgwd(2), cdmbgwd(1) + end subroutine init_oro_gws +! + + end module ugwp_oro_init +! ========================================================================= +! +! ugwp_conv_init +! +!========================================================================= + module ugwp_conv_init + + implicit none + real :: eff_con ! scale factors for conv GWs + integer :: nwcon ! number of waves + integer :: nazcon ! number of azimuths + integer :: nstcon ! flag for stochastic choice of launch level above Conv-cloud + real :: con_dlength + real :: con_cldf + + real, parameter :: cmin = 5 !2.5 + real, parameter :: cmax = 95. !82.5 + real, parameter :: cmid = 22.5 + real, parameter :: cwid = cmid + real, parameter :: bns = 2.e-2, bns2 = bns*bns, bns4=bns2*bns2 + real, parameter :: mstar = 6.28e-3/2. ! 2km + real :: dc + + real, allocatable :: ch_conv(:), spf_conv(:) + real, allocatable :: xaz_conv(:), yaz_conv(:) + contains +! + subroutine init_conv_gws(nwaves, nazdir, nstoch, effac, & + lonr, kxw, cgwf) + use ugwp_common, only : pi2, arad + implicit none + + integer :: nwaves, nazdir, nstoch + integer :: lonr + real :: cgwf(2) + real :: kxw, effac + real :: work1 = 0.5 + real :: chk, tn4, snorm + integer :: k + + nwcon = nwaves + nazcon = nazdir + nstcon = nstoch + eff_con = effac + + con_dlength = pi2*arad/float(lonr) + con_cldf = cgwf(1) * work1 + cgwf(2) *(1.-work1) +! +! allocate & define spectra in "selected direction": "dc" "ch(nwaves)" +! + if (.not. allocated(ch_conv)) allocate (ch_conv(nwaves)) + if (.not. allocated(spf_conv)) allocate (spf_conv(nwaves)) + if (.not. allocated(xaz_conv)) allocate (xaz_conv(nazdir)) + if (.not. allocated(yaz_conv)) allocate (yaz_conv(nazdir)) + + dc = (cmax-cmin)/float(nwaves-1) +! +! we may use different spectral "shapes" +! for example FVS-93 "Desabeius" +! E(s=1, t=3,m, w, k) ~ m^s/(m*^4 + m^4) ~ m^-3 saturated tail +! + do k = 1,nwaves + chk = cmin + (k-1)*dc + tn4 = (mstar*chk)**4 + ch_conv(k) = chk + spf_conv(k) = bns4*chk/(bns4+tn4) + enddo + + snorm = sum(spf_conv) + spf_conv = spf_conv/snorm*1.5 + + call init_nazdir(nazdir, xaz_conv, yaz_conv) + end subroutine init_conv_gws + + + end module ugwp_conv_init +!========================================================================= +! +! ugwp_fjet_init +! +!========================================================================= + + module ugwp_fjet_init + implicit none + real :: eff_fj ! scale factors for conv GWs + integer :: nwfj ! number of waves + integer :: nazfj ! number of azimuths + integer :: nstfj ! flag for stochastic choice of launch level above Conv-cloud +! + real, parameter :: fjet_trig=0. ! if ( abs(frgf) > fjet_trig ) launch GW-packet + + + real, parameter :: cmin = 2.5 + real, parameter :: cmax = 67.5 + real :: dc + real, allocatable :: ch_fjet(:) , spf_fjet(:) + real, allocatable :: xaz_fjet(:), yaz_fjet(:) + contains + subroutine init_fjet_gws(nwaves, nazdir, nstoch, effac, lonr, kxw) + use ugwp_common, only : pi2, arad + implicit none + + integer :: nwaves, nazdir, nstoch + integer :: lonr + real :: kxw, effac , chk + + integer :: k + + nwfj = nwaves + nazfj = nazdir + nstfj = nstoch + eff_fj = effac + + if (.not. allocated(ch_fjet)) allocate (ch_fjet(nwaves)) + if (.not. allocated(spf_fjet)) allocate (spf_fjet(nwaves)) + if (.not. allocated(xaz_fjet)) allocate (xaz_fjet(nazdir)) + if (.not. allocated(yaz_fjet)) allocate (yaz_fjet(nazdir)) + + dc = (cmax-cmin)/float(nwaves-1) + do k = 1,nwaves + chk = cmin + (k-1)*dc + ch_fjet(k) = chk + spf_fjet(k) = 1.0 + enddo + call init_nazdir(nazdir, xaz_fjet, yaz_fjet) + + end subroutine init_fjet_gws + + end module ugwp_fjet_init +! +!========================================================================= +! +! + module ugwp_okw_init +!========================================================================= + implicit none + + real :: eff_okw ! scale factors for conv GWs + integer :: nwokw ! number of waves + integer :: nazokw ! number of azimuths + integer :: nstokw ! flag for stochastic choice of launch level above Conv-cloud +! + real, parameter :: okw_trig=0. ! if ( abs(okwp) > okw_trig ) launch GW-packet + + real, parameter :: cmin = 2.5 + real, parameter :: cmax = 67.5 + real :: dc + real, allocatable :: ch_okwp(:), spf_okwp(:) + real, allocatable :: xaz_okwp(:), yaz_okwp(:) + + contains +! + subroutine init_okw_gws(nwaves, nazdir, nstoch, effac, lonr, kxw) + + use ugwp_common, only : pi2, arad + implicit none + + integer :: nwaves, nazdir, nstoch + integer :: lonr + real :: kxw, effac , chk + + integer :: k + + nwokw = nwaves + nazokw = nazdir + nstokw = nstoch + eff_okw = effac + + if (.not. allocated(ch_okwp)) allocate (ch_okwp(nwaves)) + if (.not. allocated(spf_okwp)) allocate (spf_okwp(nwaves)) + if (.not. allocated(xaz_okwp)) allocate (xaz_okwp(nazdir)) + if (.not. allocated(yaz_okwp)) allocate (yaz_okwp(nazdir)) + dc = (cmax-cmin)/float(nwaves-1) + do k = 1,nwaves + chk = cmin + (k-1)*dc + ch_okwp(k) = chk + spf_okwp(k) = 1. + enddo + + call init_nazdir(nazdir, xaz_okwp, yaz_okwp) + + end subroutine init_okw_gws + + end module ugwp_okw_init + +!=============================== end of GW sources +! +! init specific gw-solvers (1,2,3,4) +! + +!=============================== +! Part -3 init wave solvers +!=============================== + + module ugwp_lsatdis_init + implicit none + + integer :: nwav, nazd + integer :: nst + real :: eff + integer, parameter :: incdim = 4, iazdim = 4 +! + contains + + subroutine initsolv_lsatdis(me, master, nwaves, nazdir, nstoch, effac, do_physb, kxw) + + implicit none +! + integer :: me, master + integer :: nwaves, nazdir + integer :: nstoch + real :: effac + logical :: do_physb + real :: kxw +! +!locals: define azimuths and Ch(nwaves) - domain when physics-based soureces +! are not actibve +! + integer :: inc, jk, jl, iazi, i, j, k + + if( nwaves == 0 .or. nstoch == 1 ) then +! redefine from the default + nwav = incdim + nazd = iazdim + nst = 0 + eff = 1.0 + else +! from input_nml multi-wave spectra + nwav = nwaves + nazd = nazdir + nst = nstoch + eff = effac + endif +! + end subroutine initsolv_lsatdis +! + end module ugwp_lsatdis_init +! +! + module ugwp_wmsdis_init + + use ugwp_common, only : pi, pi2 + implicit none + + real, parameter :: maxdudt = 250.e-5 + + real, parameter :: hpscale= 7000., rhp2 = 0.5/hpscale + real, parameter :: omega2 = 2.*6.28/86400 + real, parameter :: gptwo=2.0 + + real, parameter :: dked_min =0.01 + real, parameter :: gssec = (6.28/30.)**2 ! max-value for bn2 + real, parameter :: bv2min = (6.28/60./120.)**2 ! min-value for bn2 7.6(-7) 2 hrs + real, parameter :: minvel = 0.5 + +! +! make parameter list that will be passed to SOLVER +! + + real, parameter :: v_kxw = 6.28e-3/200. + real, parameter :: v_kxw2 = v_kxw*v_kxw + real, parameter :: tamp_mpa = 30.e-3 + real, parameter :: zfluxglob= 3.75e-3 + + real , parameter :: nslope=1 ! the GW sprctral slope at small-m +! integer, parameter :: klaunch=55 ! 32 - ~ 1km ;55 - 5.5 km ; 52 4.7km ; 60-7km index for selecting launch level +! integer, parameter :: ilaunch=klaunch + + integer , parameter :: iazidim=4 ! number of azimuths + integer , parameter :: incdim=25 ! number of discrete cx - spectral elements in launch spectrum + real , parameter :: ucrit2=0.5 + + real , parameter :: zcimin = ucrit2 + real , parameter :: zcimax = 125.0 + real , parameter :: zgam = 0.25 + real , parameter :: zms_l = 2000.0, zms = pi2 / zms_l, zmsi = 1.0 / zms + + integer :: ilaunch + real :: gw_eff + +!=========================================================================== + integer :: nwav, nazd, nst + real :: eff + + real :: zaz_fct + real, allocatable :: zci(:), zci4(:), zci3(:),zci2(:), zdci(:) + real, allocatable :: zcosang(:), zsinang(:) + contains +!============================================================================ + subroutine initsolv_wmsdis(me, master, nwaves, nazdir, nstoch, effac, do_physb, kxw) + +! call initsolv_wmsdis(me, master, knob_ugwp_wvspec(2), knob_ugwp_azdir(2), & +! knob_ugwp_stoch(2), knob_ugwp_effac(2), do_physb_gwsrcs, kxw) +! + implicit none +! +!input -control for solvers: +! nwaves, nazdir, nstoch, effac, do_physb, kxw +! +! + integer :: me, master, nwaves, nazdir, nstoch + real :: effac, kxw + logical :: do_physb +! +!locals +! + integer :: inc, jk, jl, iazi +! + real :: zang, zang1, znorm + real :: zx1, zx2, ztx, zdx, zxran, zxmin, zxmax, zx, zpexp + + if( nwaves == 0) then +! +! redefine from the deafault +! + nwav = incdim + nazd = iazidim + nst = 0 + eff = 1.0 + gw_eff = eff + else +! +! from input.nml +! + nwav = nwaves + nazd = nazdir + nst = nstoch + gw_eff = effac + endif + + allocate ( zci(nwav), zci4(nwav), zci3(nwav),zci2(nwav), zdci(nwav) ) + allocate ( zcosang(nazd), zsinang(nazd) ) + + if (me == master) then + print *, 'ugwp_v0: init_gw_wmsdis_control ' +! print *, 'ugwp_v0: WMSDIS launch layer ', klaunch + print *, 'ugwp_v0: WMSDIS launch layer ', ilaunch + print *, 'ugwp_v0: WMSDID tot_mflux in mpa', tamp_mpa*1000. + endif + + zpexp = gptwo * 0.5 ! gptwo=2 , zpexp = 1. + +! +! set up azimuth directions and some trig factors +! +! + zang = pi2 / float(nazd) + +! get normalization factor to ensure that the same amount of momentum +! flux is directed (n,s,e,w) no mater how many azimuths are selected. +! + znorm = 0.0 + do iazi=1, nazd + zang1 = (iazi-1)*zang + zcosang(iazi) = cos(zang1) + zsinang(iazi) = sin(zang1) + znorm = znorm + abs(zcosang(iazi)) + enddo +! zaz_fct = 1.0 + zaz_fct = 2.0 / znorm ! correction factor for azimuthal sums + +! define coordinate transform for "Ch" ....x = 1/c stretching transform +! ----------------------------------------------- +! note that this is expresed in terms of the intrinsic phase speed +! at launch ci=c-u_o so that the transformation is identical +! see eq. 28-30 of scinocca 2003. x = 1/c stretching transform +! + zxmax = 1.0 / zcimin + zxmin = 1.0 / zcimax + zxran = zxmax - zxmin + zdx = zxran / real(nwav-1) ! dkz +! + zx1 = zxran/(exp(zxran/zgam)-1.0 ) ! zgam =1./4. + zx2 = zxmin - zx1 + +! +! computations for zci =1/zx +! if(lgacalc) zgam=(zxmax-zxmin)/log(zxmax/zxmin) +! zx1=zxran/(exp(zxran/zgam)-1.0_jprb) +! zx2=zxmin-zx1 +! zms = pi2 / zms_l + do inc=1, nwav + ztx = real(inc-1)*zdx+zxmin + zx = zx1*exp((ztx-zxmin)/zgam)+zx2 !eq. 29 of scinocca 2003 + zci(inc) = 1.0 /zx !eq. 28 of scinocca 2003 + zdci(inc) = zci(inc)**2*(zx1/zgam)*exp((ztx-zxmin)/zgam)*zdx !eq. 30 of scinocca 2003 + zci4(inc) = (zms*zci(inc))**4 + zci2(inc) = (zms*zci(inc))**2 + zci3(inc) = (zms*zci(inc))**3 + enddo +! +! +! all done and print-out +! +! + if (me == master) then + print * + print *, 'ugwp_v0: zcimin=' , zcimin + print *, 'ugwp_v0: zcimax=' , zcimax + print *, 'ugwp_v0: cd_crit=', zgam ! m/s precision for crit-level + print *, 'ugwp_v0: launch_level', ilaunch + print *, ' ugwp_v0 zms_l=', zms_l + print *, ' ugwp_vgw nslope=', nslope + + print * + endif + + + end subroutine initsolv_wmsdis +! +! make a list of all-initilized parameters needed for "gw_solver_wmsdis" +! + + end module ugwp_wmsdis_init +!========================================================================= +! +! work TODO for 2-extra WAM-solvers: +! DSPDIS (Hines)+ADODIS (Alexander-Dunkerton-Ortland) +! +!========================================================================= + subroutine init_dspdis + implicit none + end subroutine init_dspdis + + subroutine init_adodis + implicit none + end subroutine init_adodis + diff --git a/physics/cires_ugwp_module.F90 b/physics/cires_ugwp_module.F90 new file mode 100644 index 000000000..51c297237 --- /dev/null +++ b/physics/cires_ugwp_module.F90 @@ -0,0 +1,674 @@ +! +module cires_ugwp_module + +! +! driver is called after pbl & before chem-parameterizations +! +!.................................................................................... +! order = dry-adj=>conv=mp-aero=>radiation -sfc/land- chem -> vertdiff-> [rf-gws]=> ion-re +!................................................................................... +! +! + implicit none + logical :: module_is_initialized +!logical :: do_ugwp = .false. ! control => true - ugwp false old gws + rayeleigh friction + + logical :: do_physb_gwsrcs = .false. ! control for physics-based GW-sources + logical :: do_rfdamp = .false. ! control for Rayleigh friction inside ugwp_driver + + real, parameter :: arad=6370.e3 + real, parameter :: pi = atan(1.0) + real, parameter :: pi2 = 2.*pi + real, parameter :: hps = 7000. + real, parameter :: hpskm = hps/1000. +! + real :: kxw = 6.28e-3/100. ! single horizontal wavenumber of ugwp schemes + real, parameter :: ricrit = 0.25 + real, parameter :: frcrit = 0.50 + real, parameter :: linsat = 1.00 + real, parameter :: linsat2 = linsat*linsat +! + + integer :: knob_ugwp_solver=1 ! 1, 2, 3, 4 - (linsat, ifs_2010, ad_gfdl, dsp_dis) + integer, dimension(4) :: knob_ugwp_source ! [1,1,1,0] - (oro, fronts, conv, imbf-owp] + integer, dimension(4) :: knob_ugwp_wvspec ! number of waves for- (oro, fronts, conv, imbf-owp] + integer, dimension(4) :: knob_ugwp_azdir ! number of wave azimuths for- (oro, fronts, conv, imbf-owp] + integer, dimension(4) :: knob_ugwp_stoch ! 1 - deterministic ; 0 - stochastic + real, dimension(4) :: knob_ugwp_effac ! efficiency factors for- (oro, fronts, conv, imbf-owp] + + integer :: knob_ugwp_doaxyz=1 ! 1 -gwdrag + integer :: knob_ugwp_doheat=1 ! 1 -gwheat + integer :: knob_ugwp_dokdis=0 ! 1 -gwmixing + integer :: knob_ugwp_ndx4lh = 2 ! n-number of "unresolved" "n*dx" for lh_gw +! + integer :: ugwp_azdir + integer :: ugwp_stoch + + integer :: ugwp_src + integer :: ugwp_nws + real :: ugwp_effac + +! + data knob_ugwp_source / 1,0, 1, 0 / ! oro-conv-fjet-okw-taub_lat: 1-active 0-off + data knob_ugwp_wvspec /1,32,32,32/ ! number of waves for- (oro, fronts, conv, imbf-owp, taulat] + data knob_ugwp_azdir /2, 4, 4,4/ ! number of wave azimuths for- (oro, fronts, conv, imbf-okwp] + data knob_ugwp_stoch /0, 0, 0,0/ ! 0 - deterministic ; 1 - stochastic, non-activated option + data knob_ugwp_effac /1.,1.,1.,1./ ! efficiency factors for- (oro, fronts, conv, imbf-owp] + integer :: knob_ugwp_version = 0 + integer :: launch_level = 55 +! + namelist /cires_ugwp_nml/ knob_ugwp_solver, knob_ugwp_source,knob_ugwp_wvspec, knob_ugwp_azdir, & + knob_ugwp_stoch, knob_ugwp_effac,knob_ugwp_doaxyz, knob_ugwp_doheat, knob_ugwp_dokdis, & + knob_ugwp_ndx4lh, knob_ugwp_version, launch_level + +!&cires_ugwp_nml +! knob_ugwp_solver=2 +! knob_ugwp_source=1,1,1,0 +! knob_ugwp_wvspec=1,32,32,32 +! knob_ugwp_azdir =2, 4, 4,4 +! knob_ugwp_stoch =0, 0, 0,0 +! knob_ugwp_effac=1, 1, 1,1 +! knob_ugwp_doaxyz=1 +! knob_ugwp_doheat=1 +! knob_ugwp_dokdis=0 +! knob_ugwp_ndx4lh=4 +!/ +! +! allocatable arrays, initilized during "cires_ugwp_init" & +! released during "cires_ugwp_finalize" +! + real, allocatable :: kvg(:), ktg(:), krad(:), kion(:) + real, allocatable :: zkm(:), pmb(:) + real, allocatable :: rfdis(:), rfdist(:) + integer :: levs_rf + real :: pa_rf, tau_rf +! +! limiters +! + real, parameter :: max_kdis = 400. ! 400 m2/s + real, parameter :: max_axyz = 400.e-5 ! 400 m/s/day + real, parameter :: max_eps = max_kdis*4.e-7 ! ~16 K/day +! +!====================================================================== + real, parameter :: F_coriol=1 ! Coriolis effects + real, parameter :: F_nonhyd=1 ! Nonhydrostatic waves + real, parameter :: F_kds =0 ! Eddy mixing due to GW-unstable below + real, parameter :: iPr_ktgw =1./3., iPr_spgw=iPr_ktgw + real, parameter :: iPr_turb =1./3., iPr_mol =1.95 + real, parameter :: rhp1=1./hps, rhp2=0.5*rhp1, rhp4 = rhp2*rhp2 + real, parameter :: khp = 0.287*rhp1 ! R/Cp/Hp + real, parameter :: cd_ulim = 1.0 ! critical level precision or Lz ~ 0 ~dz of model + + contains +! +! ----------------------------------------------------------------------- +! +! init of cires_ugwp (_init) called from GFS_driver.F90 +! +! ----------------------------------------------------------------------- + subroutine cires_ugwp_mod_init (me, master, nlunit, input_nml_file, logunit, & + fn_nml, lonr, latr, levs, ak, bk, pref, dtp, cdmvgwd, cgwf, & + pa_rf_in, tau_rf_in) + + use ugwp_oro_init, only : init_oro_gws + use ugwp_conv_init, only : init_conv_gws + use ugwp_fjet_init, only : init_fjet_gws + use ugwp_okw_init, only : init_okw_gws + use ugwp_wmsdis_init, only : initsolv_wmsdis, ilaunch + use ugwp_lsatdis_init, only : initsolv_lsatdis + implicit none + + integer, intent (in) :: me + integer, intent (in) :: master + integer, intent (in) :: nlunit + character (len = *), intent (in) :: input_nml_file(:) + integer, intent (in) :: logunit + character(len=64), intent (in) :: fn_nml + integer, intent (in) :: lonr + integer, intent (in) :: levs + integer, intent (in) :: latr + real, intent (in) :: ak(levs+1), bk(levs+1), pref + real, intent (in) :: dtp + real, intent (in) :: cdmvgwd(2), cgwf(2) ! "scaling" controls for "old" GFS-GW schemes + real, intent (in) :: pa_rf_in, tau_rf_in + +! integer, parameter :: logunit = 6 + integer :: ios + logical :: exists + real :: dxsg + integer :: k + +#ifdef INTERNAL_FILE_NML + read (input_nml_file, nml = cires_ugwp_nml) +#else + if (me == master) print *, trim (fn_nml), ' GW-namelist file ' + + inquire (file =trim (fn_nml) , exist = exists) + + if (.not. exists) then + if (me == master) & + write (6, *) 'separate ugwp :: namelist file: ', trim (fn_nml), ' does not exist' + else + open (unit = nlunit, file = trim(fn_nml), action = 'read', status = 'old', iostat = ios) + endif + rewind (nlunit) + read (nlunit, nml = cires_ugwp_nml) + close (nlunit) +#endif + + + +! + ilaunch = launch_level + pa_rf = pa_rf_in + tau_rf = tau_rf_in + +! write version number and namelist to log file + if (me == master) then + write (logunit, *) " ================================================================== " + write (logunit, *) "cires_ugwp_cires" + write (logunit, nml = cires_ugwp_nml) + endif +! +! effective kxw - resolution-aware +! + dxsg = pi2*arad/float(lonr) * knob_ugwp_ndx4lh +! +! kxw = pi2/dxsg +! +! init global background dissipation for ugwp -> 4d-variable for fv3wam linked with pbl-vert_diff +! + +! allocate(fcor(latr), fcor2(latr) ) +! + allocate( kvg(levs+1), ktg(levs+1) ) + allocate( krad(levs+1), kion(levs+1) ) + allocate( zkm(levs), pmb(levs) ) + allocate( rfdis(levs), rfdist(levs) ) +! +! ak -pa bk-dimensionless from surf => tol_lid_pressure =0 +! + do k=1, levs + pmb(k) = 1.e0*(ak(k) + pref*bk(k)) ! Pa -unit Pref = 1.e5 + zkm(k) = -hpskm*alog(pmb(k)/pref) + enddo +! +! Part-1 :init_global_gwdis +! + call init_global_gwdis(levs, zkm, pmb, kvg, ktg, krad, kion) + call rf_damp_init (levs, pa_rf, tau_rf, dtp, pmb, rfdis, rfdist, levs_rf) +! +! Part-2 :init_SOURCES_gws +! + +! +! call init-solver for "stationary" multi-wave spectra and sub-grid oro +! + call init_oro_gws( knob_ugwp_wvspec(1), knob_ugwp_azdir(1), & + knob_ugwp_stoch(1), knob_ugwp_effac(1), lonr, kxw, cdmvgwd ) +! +! call init-sources for "non-sationary" multi-wave spectra +! + do_physb_gwsrcs=.true. + + IF (do_physb_gwsrcs) THEN + + if (me == master) print *, ' do_physb_gwsrcs ', do_physb_gwsrcs, ' in cires_ugwp_init ' + if (knob_ugwp_wvspec(4) > 0) then +! okw + call init_okw_gws(knob_ugwp_wvspec(4), knob_ugwp_azdir(4), & + knob_ugwp_stoch(4), knob_ugwp_effac(4), lonr, kxw ) + if (me == master) print *, ' init_okw_gws ' + endif + + if (knob_ugwp_wvspec(3) > 0) then +! fronts + call init_fjet_gws(knob_ugwp_wvspec(3), knob_ugwp_azdir(3), & + knob_ugwp_stoch(3), knob_ugwp_effac(3), lonr, kxw ) + if (me == master) print *, ' init_fjet_gws ' + endif + + if (knob_ugwp_wvspec(2) > 0) then +! conv + call init_conv_gws(knob_ugwp_wvspec(2), knob_ugwp_azdir(2), & + knob_ugwp_stoch(2), knob_ugwp_effac(2), lonr, kxw, cgwf ) + if (me == master) & + print *, ' init_convective GWs cgwf', knob_ugwp_wvspec(2), knob_ugwp_azdir(2) + + endif + + ENDIF !IF (do_physb_gwsrcs) + +!====================== +! Part-3 :init_SOLVERS +! ===================== +! +! call init-solvers for "broad" non-stationary multi-wave spectra +! + if (knob_ugwp_solver==1) then +! + call initsolv_lsatdis(me, master, knob_ugwp_wvspec(2), knob_ugwp_azdir(2), & + knob_ugwp_stoch(2), knob_ugwp_effac(2), do_physb_gwsrcs, kxw ) + endif + if (knob_ugwp_solver==2) then + + call initsolv_wmsdis(me, master, knob_ugwp_wvspec(2), knob_ugwp_azdir(2), & + knob_ugwp_stoch(2), knob_ugwp_effac(2), do_physb_gwsrcs, kxw) + endif +! +! other solvers not yet tested for fv3gfs +! +!< if (knob_ugwp_solver==3) call init_dspdis +!< if (knob_ugwp_solver==4) call init_adodis +! + +!====================== + module_is_initialized = .true. + if (me == master) print *, ' VAY-ugwp is initialized ', module_is_initialized + + end subroutine cires_ugwp_mod_init + +! ----------------------------------------------------------------------- +! +! driver of cires_ugwp (_driver) +! called from GFS_physics_driver.F90 +! +! ----------------------------------------------------------------------- +! call cires_ugwp_driver & +! (im, levs, dtp, kdt, me, lprnt, Model%lonr, & +! Model%prslrd0, Model%ral_ts, Model%cdmbgwd, & +! Grid%xlat, Grid%xlat_d, Grid%sinlat, Grid%coslat, & +! Statein, delp_gws, Oro_stat, & +! dusfcg, dvsfcg, gw_dudt, gw_dvdt, gw_dtdt, gw_kdis, & +! Diag%gwp_ax, Diag%gwp_axo, Diag%gwp_axc, Diag%gwp_axf, & +! Diag%gwp_ay, Diag%gwp_ayo, Diag%gwp_ayc, Diag%gwp_ayf, & +! Diag%gwp_dtdt, Diag%gwp_kdis, Diag%gwp_okw, Diag%gwp_fgf, & +! Diag%gwp_dcheat, Diag%gwp_precip, Diag%gwp_klevs, & +! Diag%zmtb, Diag%gwp_scheat, dlength, cldf, & +! Diag%tau_tofd, Diag%tau_mtb, Diag%tau_ogw, Diag%tau_ngw, & +! Diag%zmtb, Diag%zlwb, Diag%zogw, Diag%du3dt_mtb, & +! Diag%du3dt_ogw, Diag%du3dt_tms ) + + subroutine cires_ugwp_driver & + (im, levs, dtp, kdt, me, lprnt, lonr, & + pa_rf, tau_rf, cdmbgwd, xlat, xlatd, sinlat, coslat, & + ugrs, vgrs, tgrs, qgrs, prsi, prsl, prslk, phii, phil, & + delp, orostat, kpbl, & + dusfc, dvsfc, dudt, dvdt, dtdt, kdis, & + axtot, axo, axc, axf, aytot, ayo, ayc, ayf, & + eps_tot, ekdis, trig_okw, trig_fgf, & + dcheat, precip, cld_klevs, zmtb, scheat, dlength, cldf, & + taus_sso, taus_ogw, tauf_ogw, tauf_ngw, & + ugw_zmtb, ugw_zlwb, ugw_zogw, ugw_axmtb, ugw_axlwb, ugw_axtms ) + +! + use machine, only: kind_phys + use physcons, only: con_cp, con_fvirt, con_g, con_rd + use ugwp_common, only: omega2 +! +! + use ugwp_okw_init, only : & + eff_okw, nstokw, nwokw, ch_okwp, nazokw, spf_okwp, xaz_okwp, yaz_okwp + use ugwp_conv_init, only : & + eff_con, nstcon, nwcon, ch_conv, nazcon, spf_conv, xaz_conv, yaz_conv + use ugwp_fjet_init, only : & + eff_fj, nstfj, nwfj, ch_fjet, nazfj, spf_fjet, xaz_fjet, yaz_fjet + +! + implicit none +! + + logical :: lprnt + integer :: me, im, levs, kdt, lonr + real(kind_phys) :: dtp + real(kind_phys) :: pa_rf, tau_rf + real(kind_phys) :: cdmbgwd(2) + + integer, intent(in) :: kpbl(im) + real(kind_phys) :: hpbl(im) + real(kind_phys), intent(in) :: orostat(im, 14) + real(kind_phys), intent(in), dimension(im,levs) :: ugrs, vgrs, & + tgrs, qgrs, prsi, prsl, prslk, phii, phil, delp +! + real(kind_phys), dimension(im) :: xlat, xlatd, sinlat, coslat + real(kind_phys), dimension(im, levs) :: trig_okw, trig_fgf + real(kind_phys), dimension(im) :: precip ! precip-n rates and + integer , dimension(im, 3) :: cld_klevs ! indices fo cloud top/bot/? + real(kind_phys), dimension(im, levs) :: dcheat, scheat ! deep and shal conv heat tend. + + + real(kind_phys), dimension(im) :: dlength ! tail-grid box scale in meters + real(kind_phys), dimension(im) :: cldf ! "bizzard" old cgwd-tuning knobs dimensionless +!=================== +! tendency + kdis +!=================== + real(kind_phys), dimension(im, levs) :: dudt, dvdt, dtdt, kdis + real(kind_phys), dimension(im, levs) :: axtot, axo, axc, axf + real(kind_phys), dimension(im, levs) :: aytot, ayo, ayc, ayf + real(kind_phys), dimension(im, levs) :: eps_tot, ekdis + +! + real(kind_phys), dimension(im, levs) :: eds_o, kdis_o + real(kind_phys), dimension(im, levs) :: eds_c, kdis_c + real(kind_phys), dimension(im, levs) :: eds_f, kdis_f + real(kind_phys), dimension(im, levs) :: ax_rf, ay_rf, eps_rf +! +!================================================================================== +! diagnostics for OGW & NGW + SSO effects axmtb, axlwb, axtms +!================================================================================== + real(kind_phys), dimension(im) :: dusfc, dvsfc + real(kind_phys), dimension(im) :: taus_sso, taus_ogw, tauf_ogw, tauf_ngw + real(kind_phys), dimension(im) :: ugw_zmtb, ugw_zlwb, ugw_zogw + real(kind_phys), dimension(im, levs) :: ugw_axmtb,ugw_axlwb, ugw_axtms + real(kind_phys), dimension(im, levs) :: tauz_ogw, tauz_ngw, wtauz + +! +! knob_ugwp_source=[ 1, 1, 1, 0 ] +! oro conv nst imbal-okw +! locals +! + integer :: i, j, k, istype, ido +! +! internal diagnostics for oro-waves, lee waves, and mtb : +! + real(kind_phys), dimension(im) :: dusfc_mb, dvsfc_mb, dusfc_ogw, dvsfc_ogw + real(kind_phys), dimension(im) :: dusfc_lwb, dvsfc_lwb + real(kind_phys), dimension(im) :: zmtb, zlwb, zogw ! GW-launch levels in "meters" +! + real(kind_phys), dimension(im) :: fcor, c2f2 +! +! three sources with different: a) spectra-content/azimuth; b) efficiency ;c) spectral shape +! + real(kind_phys), dimension(im) :: taub_con, taub_fj, taub_okw + integer , dimension(im) :: klev_okw, klev_fj, klev_con + integer , dimension(im) :: if_okw, if_con, if_fj + integer :: nf_okw, nf_con, nf_fj +! + dudt = 0. + dvdt = 0. + dtdt = 0. + kdis = 0. + axo = 0. ; axc = 0. ; axf = 0. + ayo = 0. ; ayc = 0. ; ayf = 0. + eds_o = 0. ; kdis_o = 0. ; eds_f = 0. ; kdis_f = 0. ; eds_c = 0. ; kdis_c = 0. + ax_rf = 0. ; ay_rf = 0. ; eps_rf = 0 + + hpbl(:) = 2000. ! hpbl (1:im) = phil(1:im, kpbl(1:im)) +! + + do i=1, im + fcor(i) = omega2*sinlat(i) + c2f2(i) = fcor(i)*fcor(i)/(kxw*kxw) + enddo + +! i=im +! print *, i, fcor(i), 6.28e-3/kxw, sqrt(c2f2(i)) +! print *, maxval(statein%prsl/statein%tgrs)/287. , ' density ' + +! +! +! What can be computed for ALL types of GWs? => +! "Br-Vi frequency"with "limits" in case of "conv-unstable" layers +! Background dissipation: Molecular + Eddy +! Wind projections may differ from GW-sources/propagation azimuths +! + do istype=1, size(knob_ugwp_source) + + ido = knob_ugwp_source(istype) ! 0 or 1 off or active + + ugwp_azdir = knob_ugwp_azdir(istype) + ugwp_stoch = knob_ugwp_stoch(istype) + ugwp_nws = knob_ugwp_wvspec(istype) + ugwp_effac = knob_ugwp_effac(istype) + +! +! oro-gw effects +! + if (ido == 1 .and. istype ==1 ) then +! +! 1. solve for OGW effects on the mean flow +! 2. all parts of ORO effexra inside: MTB TOFD LeeWB OGW-drag +! + call ugwp_oro(im, levs, dtp, kdt, me, lprnt, & + fcor, c2f2, ugrs, vgrs, tgrs, & + qgrs, prsi, delp, prsl, prslk, phii, phil, & + orostat, hpbl, axo, ayo, eds_o, kdis_o, & + dusfc, dvsfc, dusfc_mb, dvsfc_mb, dusfc_ogw, dvsfc_ogw, & + dusfc_lwb, dvsfc_lwb, zmtb, zlwb, zogw,tauf_ogw,tauz_ogw,& + ugw_axmtb,ugw_axlwb, ugw_axtms) +! +! taus_sso, taus_ogw, tauz_ogw, tauz_ngw, tauf_ogw, tauf_ngw, & +! ugw_zmtb, ugw_zlwb, ugw_zogw, ugw_axmtb,ugw_axlwb, ugw_axtms +! collect column-integrated "dusfc, dvsfc" only for oro-waves +! + taus_sso = dusfc_mb + dusfc_lwb + dusfc_ogw + taus_ogw = dusfc_ogw + ugw_zmtb = zmtb + ugw_zlwb = zlwb + ugw_zogw = zogw + +! tauz_ogw/tauf_ogw => output +! ugwp_azdir, ugwp_stoch, ugwp_nws ..... "multi-wave + stochastic" +! +! stationary gw-mode ch=0, with "gw_solver_linsat" +! compute column-integrated "dusfc, dvsfc" only for oro-waves +! + dudt = dudt + axo * ugwp_effac + dvdt = dvdt + ayo * ugwp_effac + dtdt = dtdt + eds_o * ugwp_effac + kdis = kdis + kdis_o* ugwp_effac +! print *, ' ido istype ORO=1 ', ido, istype, ' ugwp_oro as a solver ' + endif + + if (ido == 1 .and. istype ==2 ) then +! +! convective gw effects +! +! 1. specify spectra + forcing nstcon, nwcon, ch_conv, nazcon, spf_conv +! + call get_spectra_tau_convgw & + (nwcon, im, levs, dcheat, scheat, precip, cld_klevs, & + xlatd, sinlat, coslat, taub_con, klev_con, if_con, nf_con) +! +! 2. solve for GW effects on the mean flow +! + if ( nf_con > 0) then + + klev_con(:) = 52 ! ~5 km +! +!eff_con, nstcon, nwcon, ch_conv, nazcon, spf_conv, xaz_conv, yaz_conv +! + if (knob_ugwp_solver == 1) call gw_solver_linsatdis & + (im, levs, dtp, kdt, me, taub_con, klev_con, if_con, nf_con, & + nwcon, ch_conv, nazcon, spf_conv, xaz_conv, yaz_conv, & + fcor, c2f2, ugrs, vgrs, tgrs, qgrs, prsi, delp, & + prsl, prslk, phii, phil, & + axc, ayc, eds_c, kdis_c, wtauz) + + + if (knob_ugwp_solver == 2) then +! print *, ' before CONV-2 ', ido, istype, ' gw_solver_wmsdis ', knob_ugwp_solver + call gw_solver_wmsdis & + (im, levs, dtp, kdt, me, taub_con, klev_con, if_con, nf_con, & + nwfj, ch_fjet, nazfj, spf_fjet, xaz_fjet, yaz_fjet, & + fcor, c2f2, ugrs, vgrs, tgrs, & + qgrs, prsi, delp, prsl, prslk, phii, phil, & + axc, ayc, eds_c, kdis_c, wtauz) +! print *, ' after ido istype CONV-2 ', ido, istype, ' gw_solver_wmsdis ', knob_ugwp_solver + endif + + dudt = dudt + axc * ugwp_effac + dvdt = dvdt + ayc * ugwp_effac + dtdt = dtdt + eds_c * ugwp_effac + kdis = kdis + kdis_c * ugwp_effac + + tauz_ngw = wtauz + + endif + + endif + + if (ido == 1 .and. istype ==3 ) then +! +! nonstationary gw effects +! +! 1. specify spectra + forcing +! + call get_spectra_tau_nstgw (nwfj, im, levs, & + trig_fgf, xlatd, sinlat, coslat, taub_fj, klev_fj, if_fj, nf_fj) +! +! 2. solve for GW effects on the mean flow +! + print *, ' tau_nstgw nf_fj-GW triggers ', nf_fj, ' ugwp_solver = ', knob_ugwp_solver + if ( nf_fj > 0) then + + if (knob_ugwp_solver == 1) call gw_solver_linsatdis & + (im, levs, dtp, kdt, me, taub_fj, klev_fj, if_fj, nf_fj, & + nwfj, ch_fjet, nazfj, spf_fjet, xaz_fjet, yaz_fjet, & + fcor, c2f2, ugrs, vgrs, tgrs, & + qgrs, prsi, delp, prsl, prslk, phii, phil, & + axf, ayf, eds_f, kdis_f, wtauz) + + + + if (knob_ugwp_solver == 2) call gw_solver_wmsdis & + (im, levs, dtp, kdt, me, taub_fj, klev_fj, if_fj, nf_fj, & + nwfj, ch_fjet, nazfj, spf_fjet, xaz_fjet, yaz_fjet, & + fcor, c2f2, ugrs, vgrs, tgrs, & + qgrs, prsi, delp, prsl, prslk, phii, phil, & + axf, ayf, eds_f, kdis_f, wtauz) + + dudt = dudt + axf * ugwp_effac + dvdt = dvdt + ayf * ugwp_effac + dtdt = dtdt + eds_f * ugwp_effac + kdis = kdis + kdis_f * ugwp_effac + tauz_ngw = wtauz + print *, ' ido istype for FJ 1-4 ', ido, istype, ' gw_solver_wmsdis ', knob_ugwp_solver + + endif + endif +! print *, ' ido istype for okw 1-4 ', ido, istype + if (ido == 1 .and. istype == 4 ) then +! +! nonstationary gw effects due to both "convection +fronts/jets " = imbalance of rs-flow +! +! 1. specify spectra + forcing +! + call get_spectra_tau_okw (nwokw, im, levs,& + trig_okw, xlatd, sinlat, coslat, taub_okw, klev_okw, if_okw, nf_okw) +! +! 2. solve for GW effects on the mean flow +! + if ( nf_okw > 0) then +! + if (knob_ugwp_solver == 1) call gw_solver_linsatdis & + (im, levs, dtp, kdt, me, taub_okw, klev_okw, if_okw, nf_okw, & + nwfj, ch_fjet, nazfj, spf_fjet, xaz_fjet, yaz_fjet, & + fcor, c2f2, ugrs, vgrs, tgrs, & + qgrs, prsi, delp, prsl, prslk, phii, phil, & + axf, ayf, eds_f, kdis_f, wtauz) + + + if (knob_ugwp_solver == 2) call gw_solver_wmsdis & + (im, levs, dtp, kdt, me, taub_okw, klev_okw, if_okw, nf_okw, & + nwfj, ch_fjet, nazfj, spf_fjet, xaz_fjet, yaz_fjet, & + fcor, c2f2, ugrs, vgrs, tgrs, & + qgrs, prsi, delp, prsl, prslk, phii, phil, & + axf, ayf, eds_f, kdis_f, wtauz) + + dudt = dudt + axf * ugwp_effac + dvdt = dvdt + ayf * ugwp_effac + dtdt = dtdt + eds_f * ugwp_effac + kdis = kdis + kdis_f * ugwp_effac + tauz_ngw = wtauz + endif + endif +! +! broad gw-spectra +! + 356 continue + enddo +! +! gw-diag only +! + axtot = dudt + aytot = dvdt + eps_tot = dtdt + +! +! optional rf-damping +! + if (do_rfdamp) then +! +! + call rf_damp(im, levs, levs_rf, dtp, rfdis, rfdist, ugrs, vgrs, ax_rf, ay_rf, eps_rf) +! +! gw-diag only + rf-damping ..... now orchestrate it with FV3-dycore RF-damping +! + do k=levs_rf, levs + + dudt(:,k) = dudt(:,k) + ax_rf(:,k) + dvdt(:,k) = dvdt(:,k) + ay_rf(:,k) + dtdt(:,k) = dtdt(:,k) + eps_rf(:,k) + + enddo + + endif +!================================================================================ +! To update U-V-T STATE by [dudt dvdt dtdt kdis+rf] => Solve 3-diag VD-equation +!================================================================================ +! to do for fv3wam=> +! joint eddy+molecular viscosity/conductivity/diffusion +! requires "dqdt" + dudt_vis, dvdt_vis. dtdt_cond + +! print *, ' cires_ugwp_driver +++++++++++++++++ ' +! + end subroutine cires_ugwp_driver + + +!============================================= + + + subroutine cires_ugwp_advance +!----------------------------------------------------------------------- +! +! options for the day-to-day variable sources/spectra + diagnostics +! for stochastic "triggers" +! diagnose GW-source functions * FGF + OKWP + SGO/CONV from IAU-fields +! or use for stochastic GWP-sources "memory" +!----------------------------------------------------------------------- + implicit none +! +! update sources +! a) physics-based triggers for multi-wave +! b) stochastic-based spectra and amplitudes +! c) use "memory" on GW-spectra from previous time-step +! d) update "background" GW dissipation as needed +! + end subroutine cires_ugwp_advance + +! +! ----------------------------------------------------------------------- +! finalize of cires_ugwp (_finalize) +! ----------------------------------------------------------------------- + + + subroutine cires_ugwp_mod_finalize +! +! deallocate sources/spectra & some diagnostics need to find where "deaalocate them" +! before "end" of the FV3GFS +! + implicit none +! +! deallocate arrays employed in: +! cires_ugwp_advance / cires_ugwp_driver / cires_ugwp_init +! + deallocate( kvg, ktg ) + deallocate( krad, kion ) + deallocate( zkm, pmb ) + deallocate( rfdis, rfdist) + + end subroutine cires_ugwp_mod_finalize +! + end module cires_ugwp_module + diff --git a/physics/cires_ugwp_post.F90 b/physics/cires_ugwp_post.F90 new file mode 100755 index 000000000..2fe6ca04d --- /dev/null +++ b/physics/cires_ugwp_post.F90 @@ -0,0 +1,84 @@ +!> \file cires_ugwp_post.F90 +!! This file contains +module cires_ugwp_post + +contains + +!>\defgroup cires_ugwp_post CIRES UGWP Scheme Post +!! @{ +!> \section arg_table_cires_ugwp_post_init Argument Table +!! + subroutine cires_ugwp_post_init () + end subroutine cires_ugwp_post_init + +!>@brief The subroutine initializes the CIRES UGWP +#if 0 +!> \section arg_table_cires_ugwp_post_run Argument Table +!! \htmlinclude cires_ugwp_post_run.html +!! +#endif + + + subroutine cires_ugwp_post_run (ldiag_ugwp, dtf, im, levs, & + gw_dtdt, gw_dudt, gw_dvdt, tau_tofd, tau_mtb, tau_ogw, & + tau_ngw, zmtb, zlwb, zogw, dudt_mtb, dudt_ogw, dudt_tms, & + tot_zmtb, tot_zlwb, tot_zogw, & + tot_tofd, tot_mtb, tot_ogw, tot_ngw, & + du3dt_mtb,du3dt_ogw, du3dt_tms, du3dt_ngw, dv3dt_ngw, & + dtdt, dudt, dvdt, & + errmsg, errflg) + + use machine, only: kind_phys + + implicit none + + ! Interface variables + integer, intent(in) :: im, levs + real(kind=kind_phys), intent(in) :: dtf + logical, intent(in) :: ldiag_ugwp !< flag for CIRES UGWP Diagnostics + + real(kind=kind_phys), intent(in), dimension(:) :: zmtb, zlwb, zogw + real(kind=kind_phys), intent(in), dimension(:) :: tau_mtb, tau_ogw, tau_tofd, tau_ngw + real(kind=kind_phys), intent(inout), dimension(:) :: tot_mtb, tot_ogw, tot_tofd, tot_ngw + real(kind=kind_phys), intent(inout), dimension(:) :: tot_zmtb, tot_zlwb, tot_zogw + real(kind=kind_phys), intent(in), dimension(:,:) :: gw_dtdt, gw_dudt, gw_dvdt, dudt_mtb, dudt_ogw, dudt_tms + real(kind=kind_phys), intent(inout), dimension(:,:) :: du3dt_mtb, du3dt_ogw, du3dt_tms, du3dt_ngw, dv3dt_ngw + real(kind=kind_phys), intent(inout), dimension(:,:) :: dtdt, dudt, dvdt + + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + if (ldiag_ugwp) then + tot_zmtb = tot_zmtb + dtf *zmtb + tot_zlwb = tot_zlwb + dtf *zlwb + tot_zogw = tot_zogw + dtf *zogw + + tot_tofd = tot_tofd + dtf *tau_tofd + tot_mtb = tot_mtb + dtf *tau_mtb + tot_ogw = tot_ogw + dtf *tau_ogw + tot_ngw = tot_ngw + dtf *tau_ngw + + du3dt_mtb = du3dt_mtb + dtf *dudt_mtb + du3dt_tms = du3dt_tms + dtf *dudt_tms + du3dt_ogw = du3dt_ogw + dtf *dudt_ogw + du3dt_ngw = du3dt_ngw + dtf *gw_dudt + dv3dt_ngw = dv3dt_ngw + dtf *gw_dvdt + endif + + dtdt = dtdt + gw_dtdt + dudt = dudt + gw_dudt + dvdt = dvdt + gw_dvdt + + end subroutine cires_ugwp_post_run + +!> \section arg_table_cires_ugwp_post_finalize Argument Table +!! + subroutine cires_ugwp_post_finalize () + end subroutine cires_ugwp_post_finalize + +!! @} +end module cires_ugwp_post diff --git a/physics/cires_ugwp_post.meta b/physics/cires_ugwp_post.meta new file mode 100644 index 000000000..1f98aa8a4 --- /dev/null +++ b/physics/cires_ugwp_post.meta @@ -0,0 +1,315 @@ +[ccpp-arg-table] + name = cires_ugwp_post_init + type = scheme + +######################################################################## +[ccpp-arg-table] + name = cires_ugwp_post_run + type = scheme +[ldiag_ugwp] + standard_name = diag_ugwp_flag + long_name = flag for CIRES UGWP Diagnostics + units = flag + dimensions = () + type = logical + intent = in + optional = F +[dtf] + standard_name = time_step_for_dynamics + long_name = dynamics timestep + units = s + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[im] + standard_name = horizontal_loop_extent + long_name = horizontal loop extent + units = count + dimensions = () + type = integer + intent = in + optional = F +[levs] + standard_name = vertical_dimension + long_name = number of vertical levels + units = count + dimensions = () + type = integer + intent = in + optional = F +[gw_dtdt] + standard_name = tendency_of_air_temperature_due_to_ugwp + long_name = air temperature tendency due to UGWP + units = K s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[gw_dudt] + standard_name = tendency_of_x_wind_due_to_ugwp + long_name = zonal wind tendency due to UGWP + units = m s-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[gw_dvdt] + standard_name = tendency_of_y_wind_due_to_ugwp + long_name = meridional wind tendency due to UGWP + units = m s-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[tau_tofd] + standard_name = instantaneous_momentum_flux_due_to_turbulent_orographic_form_drag + long_name = momentum flux or stress due to TOFD + units = Pa + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[tau_mtb] + standard_name = instantaneous_momentum_flux_due_to_mountain_blocking_drag + long_name = momentum flux or stress due to mountain blocking drag + units = Pa + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[tau_ogw] + standard_name = instantaneous_momentum_flux_due_to_orographic_gravity_wave_drag + long_name = momentum flux or stress due to orographic gravity wave drag + units = Pa + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[tau_ngw] + standard_name = instantaneous_momentum_flux_due_to_nonstationary_gravity_wave + long_name = momentum flux or stress due to nonstationary gravity waves + units = Pa + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[zmtb] + standard_name = height_of_mountain_blocking + long_name = height of mountain blocking drag + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[zlwb] + standard_name = height_of_low_level_wave_breaking + long_name = height of low level wave breaking + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[zogw] + standard_name = height_of_launch_level_of_orographic_gravity_wave + long_name = height of launch level of orographic gravity wave + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[dudt_mtb] + standard_name = instantaneous_change_in_x_wind_due_to_mountain_blocking_drag + long_name = instantaneous change in x wind due to mountain blocking drag + units = m s-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[dudt_ogw] + standard_name = instantaneous_change_in_x_wind_due_to_orographic_gravity_wave_drag + long_name = instantaneous change in x wind due to orographic gw drag + units = m s-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[dudt_tms] + standard_name = instantaneous_change_in_x_wind_due_to_turbulent_orographic_form_drag + long_name = instantaneous change in x wind due to TOFD + units = m s-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[tot_zmtb] + standard_name = time_integral_of_height_of_mountain_blocking + long_name = time integral of height of mountain blocking drag + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[tot_zlwb] + standard_name = time_integral_of_height_of_low_level_wave_breaking + long_name = time integral of height of drag due to low level wave breaking + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[tot_zogw] + standard_name = time_integral_of_height_of_launch_level_of_orographic_gravity_wave + long_name = time integral of height of launch level of orographic gravity wave + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[tot_tofd] + standard_name = time_integral_of_momentum_flux_due_to_turbulent_orographic_form_drag + long_name = time integral of momentum flux due to TOFD + units = Pa + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[tot_mtb] + standard_name = time_integral_of_momentum_flux_due_to_mountain_blocking_drag + long_name = time integral of momentum flux due to mountain blocking drag + units = Pa + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[tot_ogw] + standard_name = time_integral_of_momentum_flux_due_to_orographic_gravity_wave_drag + long_name = time integral of momentum flux due to orographic gravity wave drag + units = Pa + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[tot_ngw] + standard_name = time_integral_of_momentum_flux_due_to_nonstationary_gravity_wave + long_name = time integral of momentum flux due to nonstationary gravity waves + units = Pa + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[du3dt_mtb] + standard_name = time_integral_of_change_in_x_wind_due_to_mountain_blocking_drag + long_name = time integral of change in x wind due to mountain blocking drag + units = m s-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[du3dt_ogw] + standard_name = time_integral_of_change_in_x_wind_due_to_orographic_gravity_wave_drag + long_name = time integral of change in x wind due to orographic gw drag + units = m s-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[du3dt_tms] + standard_name = time_integral_of_change_in_x_wind_due_to_turbulent_orographic_form_drag + long_name = time integral of change in x wind due to TOFD + units = m s-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[du3dt_ngw] + standard_name = time_integral_of_change_in_x_wind_due_to_nonstationary_gravity_wave + long_name = time integral of change in x wind due to NGW + units = m s-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[dv3dt_ngw] + standard_name = time_integral_of_change_in_y_wind_due_to_nonstationary_gravity_wave + long_name = time integral of change in y wind due to NGW + units = m s-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[dtdt] + standard_name = tendency_of_air_temperature_due_to_model_physics + long_name = air temperature tendency due to model physics + units = K s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[dudt] + standard_name = tendency_of_x_wind_due_to_model_physics + long_name = zonal wind tendency due to model physics + units = m s-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[dvdt] + standard_name = tendency_of_y_wind_due_to_model_physics + long_name = meridional wind tendency due to model physics + units = m s-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F + +######################################################################## +[ccpp-arg-table] + name = cires_ugwp_post_finalize + type = scheme diff --git a/physics/cires_ugwp_solvers.F90 b/physics/cires_ugwp_solvers.F90 new file mode 100644 index 000000000..6736daf6a --- /dev/null +++ b/physics/cires_ugwp_solvers.F90 @@ -0,0 +1,664 @@ +! GW SOLVERS: +!=========== SOLVER_ORODIS; SOLVER_WMSDIS, SOLVER_LSATDIS +! + RF_DAMP if it is needed along with ugwp_tofd +!=========== +! Note in contrast to dycore vertical indices: surface=1 top=levs +! +! Collection of main friction-GWD solvers +! +! subroutine ugwp_oro +! +! subroutine gw_solver_linsatdis +! subroutine gw_solver_wmsdis +! subroutine rf_damp +! +! =========== +! +! + subroutine ugwp_oro(im, levs, dtp, kdt,me, lprnt, fcor, c2f2, & + u, v, tkin, pint, delp, pmid, pexner, gzint, gzmid, orostat, & + hpbl, axz, ayz, edis, kdis, dusfc, dvsfc, & + dusfc_mb, dvsfc_mb, dusfc_ogw, dvsfc_ogw, dusfc_lwb, dvsfc_lwb, & + zmtb, zlwb, zogw, tauf_ogw, tauz_ogw, axmtb, axlwb, axtms ) +!---------------------------------------------------------------------- +! COORDE-output: 6-hour inst: U, V, T, PMSL, PS, HT (ounce) +! 3D 6-hr aver: DYN-U, SSO-U, PBL-U, AF-U1.... +! 2D 6-hr aver: tau_SSO, tau_GWD, tau_BL; & +! tau_sso = tau_mtb + tau_tofd + tau_lwb +tau_ogw +! ZM 6-hr aver: tau_RES = PS*dH/dx -zonal mean +! Experiments: Midlat 80-200km +! LR_CTL; ; LR_NOSSO with TOFD/TMS; +! LR_NOGWD (MTN+TOFD); LR_GWD4 --- 4 times taub +!---------------------------------------------------------------------- + use machine , only : kind_phys + use ugwp_oro_init, only : cdmb, cleff, sigfac, hncrit, hpmin, hminmt + use ugwp_oro_init, only : gamm_std, sigma_std + use ugwp_common , only : rgrav, grav, cpd, rd, rv, rcpd, rcpd2 + + + use ugwp_common , only : pi, rad_to_deg, deg_to_rad, pi2 + + use cires_ugwp_module, only : kxw, max_kdis, max_axyz + + implicit none + logical :: lprnt + integer :: im, levs + integer :: me + integer :: kdt + real(kind_phys) :: dtp + real(kind_phys), dimension(im) :: hpbl ! pbl-height in meters + real(kind_phys), dimension(im) :: fcor, c2f2 + real(kind_phys), dimension(im, 14) :: orostat + real(kind_phys), dimension(im, levs) :: u, v, tkin, q + + real(kind_phys), dimension(im, levs) :: pmid, pexner, gzmid, delp + real(kind_phys), dimension(im, levs+1) :: pint, gzint + + + real(kind_phys), dimension(im, levs) :: axz, ayz, edis, kdis ! total 6-hr averaged tendencies + real(kind_phys), dimension(im, levs) :: krf2d + real(kind_phys), dimension(im, levs) :: tauz_ogw, axmtb, axlwb, axtms ! 3-sub components axogw = axz-(axmtb+axlwb+axtms) + real(kind_phys), dimension(im) :: tauf_ogw ! total-source momentum flux + + real(kind_phys), dimension(im) :: zmtb, zlwb, zogw + + real(kind_phys), dimension(im) :: dusfc, dvsfc ! total tausfc_sso + real(kind_phys), dimension(im) :: dusfc_mb, dvsfc_mb ! integrated tau_mtb + real(kind_phys), dimension(im) :: dusfc_ogw, dvsfc_ogw ! integrated tau_ogw + real(kind_phys), dimension(im) :: dusfc_lwb, dvsfc_lwb ! integrated tau_lwb + real(kind_phys), dimension(im) :: dusfc_tofd, dvsfc_tofd ! integrated tau_tofd + +! +! mu=hprime gamm=a/b sigma theta +! which stand for the standard deviation, the anisotropy, the slope and the orientation of the orography. +! + real(kind_phys) :: elvmax(im) + real(kind_phys) :: hprime(im) + + real(kind_phys) :: theta !the orienatation, angle + real(kind_phys) :: sigma !the slope dh/dx + real(kind_phys) :: gamm !the anisotropy see ifs-oro + + real(kind_phys) :: oc, oa4(4), clx4(4) !kim & doyle 2005 .... attempt to do TOFD ..? +! + integer, allocatable :: k_elev(:), k_mtb(:), k_ogw(:), k_lee(:), k_tofd(:) + + real(kind_phys) wk(im) + + real(kind_phys) eng0, eng1 +! +! +! + real(kind_phys), dimension(levs) :: up, vp, tp, qp, dp, zpm, pmid1, pex + + real(kind_phys), dimension(levs+1) :: taudz, rhoi, rim_z, pint1, zpi + real(kind_phys), dimension(levs) :: drtau, kdis_oro +! + real (kind_phys) :: elvp, elvpd, dtaux, dtauy + real(kind_phys) :: loss, mtb_fric, mbx, mby + real(kind_phys) :: sigflt + + real(kind_phys) :: zpbl = 2000. ! can be passed from PBL physics as in gwdps.f +! + logical icrilv(im) +! +!---- mountain/oro gravity wave drag +TOFD +! + real(kind=kind_phys), dimension(levs) :: utofd1, vtofd1, epstofd1, krf_tofd1 +! + real(kind=kind_phys), dimension(levs) :: drlee, drmtb, drlow, drogw + real(kind_phys) :: r_cpdt, acc_lim + real(kind_phys), dimension(im) :: tautot, tauogw, taumtb, taulee, taurf + real(kind_phys) :: xn, yn, umag, kxridge, & + tx1, tx2 + real(kind=kind_phys),dimension(levs+1):: tau_src + + integer :: npt, krefj, kdswj, kotr, i, j, k + integer :: ipt(im) + +! +! copy 1D +! + do i=1, im + hprime(i) = orostat(i, 1) + elvmax(i) = orostat(i, 14) +! + tautot(i) = 0.0 + tauogw(i) = 0.0 + taumtb(i) = 0.0 + taulee(i) = 0.0 + taurf(i) = 0.0 +! + dusfc(i) = 0.0 + dvsfc(i) = 0.0 + dusfc_mb(i) = 0.0 + dvsfc_mb(i) = 0.0 + dusfc_ogw(i) = 0.0 + dvsfc_ogw(i) = 0.0 + dusfc_lwb(i) = 0.0 + dvsfc_lwb(i) = 0.0 + dusfc_tofd(i) = 0.0 + dvsfc_tofd(i) = 0.0 + tauf_ogw(i) = 0.0 +! + zmtb(i) = -99. + zlwb(i) = -99. + zogw(i) = -99. + ipt(i) = 0 + enddo +! print *, maxval(hprime), maxval(elvmax), ' check hprime -elevmax ugwp_oro' +! +! 3-part of oro-effects + ked_oro +! + do k=1, levs + do i=1, im + axz(i,k) = 0.0 + ayz(i,k) = 0.0 + edis(i,k) = 0.0 + kdis(i,k) = 0.0 + krf2d(i,k) = 0.0 + tauz_ogw(i,k) = 0.0 + axmtb(i:,k) = 0.0 + axlwb(i,k) = 0.0 + axtms(i,k) = 0.0 + enddo + enddo + +! +! optional diag 3-parts of drag: [tx_ogw, tx_mtb, tx_lee] +! +! ----do we have orography for mtb and gwd calculation points ? +! + npt = 0 + do i = 1,im + if ( (elvmax(i) > hminmt) .and. (hprime(i) > hpmin) ) then + npt = npt + 1 + ipt(npt) = i + + endif + enddo + if (npt == 0) return ! no ororgraphy ====> gwd/mb calculation done + +! allocate(iwklm(npt), idxzb(npt), kreflm(npt)) + allocate( k_elev(npt), k_mtb(npt), k_ogw(npt), k_lee(npt), k_tofd(npt)) + do i=1,npt + k_ogw (i) = 2 + k_tofd(i) = 2 + k_lee (i) = 2 + k_mtb(i) = 0 + k_elev(i) = 2 + enddo +! +! controls through: use ugwp_oro_init +! main ORO-loop sigfac = n*sigma = [1.5, 2, 2.5, 4]*hprime +! + + + do i = 1, npt +! + j = ipt(i) + + elvpd = elvmax(j) + elvp = min (elvpd + sigfac * hprime(j), hncrit) + + sigma = orostat(j,13) + gamm = orostat(j,12) + theta = orostat(j,11)*deg_to_rad + + if (sigma == 0.0 ) then + sigma = sigma_std + gamm = gamm_std + theta = 0.0 + endif + + oc = orostat(j,2) + oa4(1) = orostat(j,3) + oa4(2) = orostat(j,4) + oa4(3) = orostat(j,5) + oa4(4) = orostat(j,6) + clx4(1) = orostat(j,7) + clx4(2) = orostat(j,8) + clx4(3) = orostat(j,9) + clx4(4) = orostat(j,10) +! +! do column-based diagnostics "more-efficient" for oro-places +! + + do k=1,levs + up(k) = u(j,k) + vp(k) = v(j,k) + tp(k) = tkin(j,k) + qp(k) = q(j,k) + dp(k) = delp(j,k) + + zpm(k) = gzmid(j,k) * rgrav + pmid1(k) = pmid(j,k) + pex(k) = pexner(j,k) + enddo + do k=1,levs+1 + zpi(k) = gzint(j,k) * rgrav + pint1(k) = pint(j,k) + enddo +! +! elvp- k-index: iwklm k_elvp = index for elvmax + 4*hprime, "elevation index" +! GFS-2017 + do k=1, levs-1 + if (elvp <= zpi(k+1) .and. elvp > zpi(k)) then + k_elev(i) = k+1 !......simply k+1 next interface level + exit + endif + enddo +! if (elvp .ge. 300. ) then +! write(6,333) elvp, zpi(1), elvpd, hprime(j), sigfac, hncrit +! pause +! endif +!333 format(6(3x, F10.3)) +! +! SSO effects: TOFD-drag/friction coefficients can be calculated +! + sigflt = hprime(j)*0.01 ! turb SSo(j) ...small-scale orography < 2-5 km .... + zpbl = hpbl(j) + + call ugwp_tofd1d(levs, sigflt, elvPd, zpi(1), zpbl, up, vp, zpm, & + utofd1, vtofd1, epstofd1, krf_tofd1) + + do k=1, levs + krf2d(j,k) = krf_tofd1(k) + axtms(j,k) = utofd1(k) +!------- +! nullify ORO-tendencies +! + drmtb(k) = 0.0 + drlee(k) = 0.0 + drtau(k) = 0.0 + drlow(k) = 0.0 + enddo + +!------- +! +! levels of k_mtb(i)/mtb + kdswj/dwlee + krefj/ogwd inside next "subs" +! zmtb, zlwb, zogw +! drmtb, drlow/drlee, drogw +!------- +! +! mtb : drmtb => 1-st order friction as well as TurbulentOro-Drag +! + call ugwp_drag_mtb( k_elev(i), levs, & + elvpd, elvp, hprime(j), sigma, theta, oc, oa4, clx4, gamm, zpbl, & + up, vp, tp, qp, dp, zpm, zpi, pmid1, pint1, k_mtb(i), drmtb, taumtb(j)) + + axmtb(j,1:levs) = drmtb(1:levs)*up(1:levs) +! +! print * , k_elev(i), k_mtb(i) , taumtb(j)*1.e3, ' k_elev, k_mtb , taumtb ' +! +! tautot = taulee+tauogw + rho*drlee = -d[taulee(z)]/dz +! + + + call ugwp_taub_oro(levs, k_mtb(i), kxw, taumtb(j), fcor(j), & + hprime(j) , sigma, theta, oc, oa4, clx4, gamm, elvp, & + up, vp, tp, qp, dp, zpm, zpi, pmid1, pint1, xn, yn, umag, & + tautot(j), tauogw(j), taulee(j), drlee, tau_src, & + kxridge, kdswj, krefj, kotr) + +! print *, k_mtb(i), kxw, taumtb(j), fcor(j),hprime(j), ' af ugwp_taub_oro ' +! print *, kdswj, krefj, kotr, ' kdswj, krefj, kotr ' + + + tauf_ogw(j) = tautot(j) + axlwb(j,1:levs) = drlee(1:levs) + + if ( k_mtb(i) > 0) zmtb(j) = zpi(k_mtb(i))- zpi(1) + if ( krefj > 0) zogw(j) = zpi(krefj) - zpi(1) + if ( kdswj > 0) zlwb(j) = zpi(kdswj) - zpi(1) +! if ( k_mtb(i) > 0 .and. zmtb(j) > zogw(j)) print *, ' zmtb > zogw ', zmtb(j), zogw(j) +! +! tau: tauogw, kxw/kxridge ATTENTION c2f2(j) = fcor(j)*fcor(j)/kxridge/kxridge +! + if ( (krefj > 1) .and. ( abs(tauogw(j)) > 0.) ) then +! + call ugwp_oro_lsatdis( krefj, levs, tauogw(j), tautot(j), tau_src, kxw, & + fcor(j), kxridge, up, vp, tp, qp, dp, zpm, zpi, pmid1, pint1, & + xn, yn, umag, drtau, kdis_oro) +! + else + drtau = 0. + endif + + tauz_ogw(j,1:levs) = tau_src(1:levs) + + r_cpdt = rcpd2/dtp +! +! + do k = 1,levs +! +! project to x-dir & y=dir and do diagnostics +! & apply limiters and output separate oro-effects +! + drlow(k) = drtau(k) + drlee(k) + acc_lim = min(abs(drlow(k)), max_axyz) + drlow(k) = sign(acc_lim, drlow(k)) + + dtaux = drlow(k) * xn + utofd1(k) + dtauy = drlow(k) * yn + vtofd1(k) + + eng0 = up(k)*up(k)+vp(k)*vp(k) + eng1 = 0.0 +! + if (k < k_mtb(i) .and. drmtb(k) /= 0 ) then + loss = 1.0 / (1.0+drmtb(k)*dtp) + mtb_fric = drmtb(k)*loss +! + mbx = mtb_fric * up(k) + mby = mtb_fric * vp(k) +! + ayz(j,k) = -mby !+ ayz(j,k) + axz(j,k) = -mbx !+ axz(j,k) +! + eng1 = eng0*loss*loss +eng1 + dusfc(j) = dusfc(j) - mbx * dp(k) + dvsfc(j) = dvsfc(j) - mby * dp(k) + endif +! + ayz(j,k) = dtauy + ayz(j,k) + axz(j,k) = dtaux + axz(j,k) +! + tx1 = u(j,k) + dtaux*dtp + tx2 = v(j,k) + dtauy*dtp + eng1 = tx1*tx1 + tx2*tx2 + eng1 + + dusfc(j) = dusfc(j) + dtaux * dp(k) + dvsfc(j) = dvsfc(j) + dtauy * dp(k) + + edis(j,k) = max(eng0-eng1, 0.0) * r_cpdt !+ epstofd1(k) + kdis(j,k) = min(kdis_oro(k), max_kdis ) + + enddo +! + dusfc(j) = -rgrav * dusfc(j) + dvsfc(j) = -rgrav * dvsfc(j) +! +! oro-locations +! + enddo ! ipt - oro-loop .... "fraction of Land" in the grid box + deallocate(k_elev, k_mtb, k_ogw, k_lee, k_tofd ) +! + end subroutine ugwp_oro +! +! + subroutine gw_solver_linsatdis(im, levs, dtp, kdt, me, & + taub, klev, if_src, nf_src, nw, ch, naz, spf, xaz, yaz, & + fcor, c2f2, u, v, t, q, prsi, delp, prsl, prslk, phii, phil, & + ax, ay, eps, ked, tauz) + + use ugwp_common , only : rgrav, grav, cpd, rd, rv, rcpd, rcpd2 + use ugwp_common , only : pi, rad_to_deg, deg_to_rad, pi2 + + use cires_ugwp_module, only : kxw, max_kdis, max_axyz, max_eps + use cires_ugwp_module, only : kvg, ktg, krad, kion + + implicit none + integer :: im, levs + integer :: me, kdt, nw, naz, nf_src + real :: dtp + integer, dimension(im) :: klev, if_src + real, dimension(im) :: taub, fcor, c2f2 + + real, dimension(naz) :: xaz, yaz + real, dimension(nw ) :: ch, spf +!========================== + real, dimension(im, levs) :: u, v, t, delp, prsl, prslk, phil, q + real, dimension(im, levs+1) :: prsi , phii +!========================== + real, dimension(im, levs) :: ax, ay, eps, ked, tauz + + real, dimension(levs) :: u1, v1, t1, dp, pmid, zmid, pex1, & + q1, rho + real, dimension(levs+1) :: pint , zint, ui, vi, ti, & + bn2i, bvi, rhoi + integer :: i, j, k, ksrc + real, dimension(nw) :: taub_spect +! real, dimension(levs) :: ax1, ay1, eps1 +! real, dimension(levs+1) :: ked1, tau1 + real :: chm, ss + real, parameter :: dsp = 1./20. + logical :: pfirst=.true. + + save pfirst +128 Format (2x, I4, 4(2x, F10.3)) + +! do i=1, nw +! spf(i) = exp(-Ch(i)*dsp) +! enddo +! ss = sum(spf) +! spf(1:nw) = spf(1:nw)/ss + + if (pfirst ) then + j = 1 + ksrc = klev(j) + taub_spect(1:nw) = spf(1:nw)*taub(j) + print * + chm = 0. + do i=1, nw + write(6, 128) i, spf(i), taub_spect(i)*1.e3, ch(i), ch(i)-chm + chm = ch(i) + enddo + + print * + !pause + endif + + do j=1,im + if (if_src(j) == 1) then +! +! compute GW-effects +! prsi, delp, prsl, prslk, phii, phil +! + do k=1,levs + u1(k) = u(j,k) + v1(k) = v(j,k) + t1(k) = t(j,k) + q1(k) = q(j,k) ! H2O-index -1 in tracer-array + dp(k) = delp(j,k) + + zmid(k) = phil(j,k) * rgrav + pmid(k) = prsl(j,k) +! pex1(k) = prslk(j,k) + enddo + do k=1,levs+1 + zint(k) = phii(j,k) * rgrav + pint(k) = prsi(j,k) + enddo + + call mflow_tauz(levs, u1, v1, t1, q1, dp, zmid, zint, & + pmid, pint, rho, ui, vi, ti, bn2i, bvi, rhoi) +! + ksrc = klev(j) + taub_spect(1:nw) = spf(1:nw)*taub(j)/rhoi(ksrc) + if (pfirst .and. j ==1 ) then + + print *, maxval(taub_spect)/kxw*bvi(ksrc)/ch(1), ' Urms ' + print *, maxval(zmid), minval(zmid) , ' zmid ' + print *, maxval(zint), minval(zint) , ' zint ' + print *, maxval(rho), minval(rho) , ' rho ' + print *, maxval(rhoi), minval(rhoi) , ' rhoi ' + print *, maxval(ti), minval(ti) , ' tempi ' + print *, maxval(ui), minval(ui) , ' ui ' + print *, maxval(u1), minval(u1) , ' ++++ u1 ' + print *, maxval(vi), minval(vi) , ' vi ' + print *, maxval(v1), minval(v1) , ' ++++ v1 ' + print *, maxval(pint), minval(pint) , ' pint ' + !pause + endif +! + call ugwp_lsatdis_naz(levs, ksrc, nw, naz, kxw, taub_spect, & + ch, xaz, yaz, fcor(j), c2f2(j), dp, & + zmid, zint, pmid, pint, rho, ui, vi, ti, & + kvg, ktg, krad, kion, bn2i, bvi, rhoi, & + ax(j,1:levs), ay(j,1:levs), eps(j,1:levs), & + ked(j,1:levs), tauz(j,1:levs)) +! kvg, ktg, krad, kion, bn2i, bvi, rhoi, ax1, ay1, eps1, ked1, tau1) + + if (pfirst .and. j ==1 ) then + + print *, maxval(taub_spect)/kxw*bvi(ksrc)/ch(1), ' Urms ' + print *, maxval(zmid), minval(zmid) , ' zmid ' + print *, maxval(zint), minval(zint) , ' zint ' + print *, maxval(rho), minval(rho) , ' rho ' + print *, maxval(rhoi), minval(rhoi) , ' rhoi ' + print *, maxval(ti), minval(ti) , ' rhoi ' + print *, maxval(ui), minval(ui) , ' ui ' + print *, maxval(vi), minval(vi) , ' vi ' + print *, maxval(pint), minval(pint) , ' pint ' + !pause + endif +! +! ax(j,:) = ax1 +! ay(j,:) = ay1 +! eps(j,:) = eps1 +! ked(j,:) = ked1(1:levs) +! tauz(j,:) = tau1(1:levs) + endif + + enddo + pfirst = .false. +! +! spectral solver for discrete spectra of GWs in N-azimiths +! Linear saturation with background dissipation +! + end subroutine gw_solver_linsatdis +! + subroutine gw_solver_wmsdis(im, levs, dtp, kdt, me, & + taub, klev, if_src, nf_src, nw, ch, naz, spf, xaz, yaz, & + fcor, c2f2, u, v, t, q, prsi, delp, prsl, prslk, phii, phil, & + ax, ay, eps, ked, tauz) +! use para_taub, only : tau_ex + use ugwp_common , only : rgrav, grav, cpd, rd, rv, rcpd, rcpd2 + use ugwp_common , only : pi, rad_to_deg, deg_to_rad, pi2 + + use cires_ugwp_module, only : kxw, max_kdis, max_axyz, max_eps + use cires_ugwp_module, only : kvg, ktg, krad, kion + + implicit none + integer :: im, levs, me, kdt, nw, naz, nf_src + real :: dtp + + integer, dimension(im) :: klev, if_src + real, dimension(im) :: taub, fcor, c2f2 + + real, dimension(naz) :: xaz, yaz + real, dimension(nw ) :: ch, spf +!========================== + real, dimension(im, levs) :: u, v, t, delp, prsl, prslk, phil, q + real, dimension(im, levs+1) :: prsi , phii +!========================== + real, dimension(im, levs) :: ax, ay, eps, ked, tauz + + real, dimension(levs) :: u1, v1, t1, dp, pmid, zmid, pex1, q1, rho + real, dimension(levs+1) :: pint , zint, ui, vi, ti, bn2i, bvi, rhoi + + integer :: i, j, k, ksrc + real, dimension(nw) :: taub_spect +! real, dimension(levs) :: ax1, ay1, eps1 +! real,dimension(levs+1) :: ked1, tau1 + real :: tau_ex + +! print *, nf_src, 'nf_src ... gw_solver_wmsdis ' +! print *, if_src, 'if_src ... gw_solver_wmsdis ' + + do j=1,im + if (if_src(j) == 1) then +! +! compute gw-effects +! prsi, delp, prsl, prslk, phii, phil +! + do k=1,levs + u1(k) = u(j,k) + v1(k) = v(j,k) + t1(k) = t(j,k) + q1(k) = q(j,k) ! h2o-index -1 in tracer-array + dp(k) = delp(j,k) + + zmid(k) = phil(j,k) *rgrav + pmid(k) = prsl(j,k) +! pex1(k) = prslk(j,k) + enddo + do k=1,levs+1 + zint(k) = phii(j,k)*rgrav + pint(k) = prsi(j,k) + enddo + + call mflow_tauz(levs, u1, v1, t1, q1, dp, zmid, zint, & + pmid, pint, rho, ui, vi, ti, bn2i, bvi, rhoi) +! +! any extras bkg-arrays +! + ksrc = klev(j) +!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +! +! more work for spectral setup for different "slopes" +! +!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + tau_ex = taub(j) + taub_spect(1:nw) = spf(1:nw)/rhoi(ksrc) *tau_ex ! check it ....*tau_ex(j) + +! +! call FVS93_ugwps(nw, ch, dch, taub_spect, spnorm, nslope, bn2i(ksrc), bvi(ksrc), bnrho(ksrc)) +! +! print *, ' bf ugwp_wmsdis_naz ksrc', ksrc, zmid(ksrc) + + call ugwp_wmsdis_naz(levs, ksrc, nw, naz, kxw, tau_ex, ch, xaz, yaz, & + fcor(j), c2f2(j), dp, zmid, zint, pmid, pint, & + rho, ui, vi, ti, kvg, ktg, krad, kion, bn2i, bvi, & + rhoi, ax(j,1:levs), ay(j,1:levs), eps(j,1:levs), & + ked(j,1:levs), tauz(j,1:levs)) +! kvg, ktg, krad, kion, bn2i, bvi, rhoi, ax1, ay1, eps1, ked1, tau1) + +! print *, ' after ugwp_wmsdis_naz ksrc', ksrc, zint(ksrc) + +! subroutine ugwp_wmsdis_naz(levs, ksrc, nw, naz, kxw, taub_lat, ch, xaz, yaz, & +! fcor, c2f2, dp, zmid, zint, pmid, pint, rho, ui, vi, ti, & +! kvg, ktg, krad, kion, bn2i, bvi, rhoi, ax, ay, eps, ked) + +! ax(j,:) = ax1 +! ay(j,:) = ay1 +! eps(j,:) = eps1 +! ked(j,:) = ked1(1:levs) +! tauz(j,:) = tau1(1:levs) + + endif + + enddo +! +! ugwp_wmsdis_naz everything similar to linsat , except spectral saturation +! +! + return + end subroutine gw_solver_wmsdis +! +! + subroutine rf_damp(im, levs, levs_rf, dtp, rfdis, rfdist, u, v, ax, ay, eps) + use ugwp_common, only : rcpd2 + + implicit none + + integer :: im, levs, levs_rf + real :: dtp + real, dimension(levs) :: rfdis, rfdist + real, dimension(im, levs) :: u, v, ax, ay, eps + real :: ud, vd, rdtp + integer :: i, k + + rdtp = 1.0 / dtp + + do k= levs_rf, levs + do i=1,im + ud = rfdis(k)*u(i,k) + vd = rfdis(k)*u(i,k) + ax(i,k) = rfdist(k)*u(i,k) + ay(i,k) = rfdist(k)*v(i,k) + eps(i,k) = rcpd2*(u(i,k)*u(i,k) +v(i,k)*v(i,k) -ud*ud -vd*vd) + enddo + enddo + end subroutine rf_damp +! diff --git a/physics/cires_ugwp_triggers.F90 b/physics/cires_ugwp_triggers.F90 new file mode 100644 index 000000000..c345a8e85 --- /dev/null +++ b/physics/cires_ugwp_triggers.F90 @@ -0,0 +1,566 @@ + subroutine ugwp_triggers + implicit none + write(6,*) ' physics-based triggers for UGWP ' + end subroutine ugwp_triggers +! + SUBROUTINE subs_diag_geo(nx, ny, lat, lon, rlat, rlon, dy, dx, & + cosv, rlatc, brcos, brcos2, dlam1, dlam2, dlat, divJp, divJm) + use ugwp_common , only : deg_to_rad + + implicit none + integer :: nx, ny + real :: lon(nx), lat(ny) + real :: rlon(nx), rlat(ny) , cosv(ny), tanlat(ny) + real :: rlatc(ny-1), brcos(ny), brcos2(ny) + real :: earth_r, ra1, ra2, dx, dy, dlat + real :: dlam1(ny), dlam2(ny), divJp(ny), divJm(ny) + integer :: j +! +! specify common constants and +! geometric factors to compute deriv-es etc ... +! coriolis coslat tan etc... +! + earth_r = 6370.e3 + ra1 = 1.0 / earth_r + ra2 = ra1*ra1 +! + rlat = lat*deg_to_rad + rlon = lon*deg_to_rad + tanlat = atan(rlat) + cosv = cos(rlat) + dy = rlat(2)-rlat(1) + dx = rlon(2)-rlon(1) +! + do j=1, ny-1 + rlatc(j) = 0.5 * (rlat(j)+rlat(j+1)) + enddo +! + do j=2, ny-1 + brcos(j) = 1.0 / cos(rlat(j))*ra1 + enddo + + brcos(1) = brcos(2) + brcos(ny) = brcos(ny-1) + brcos2 = brcos*brcos +! + dlam1 = brcos / (dx+dx) + dlam2 = brcos2 / (dx*dx) + + dlat = ra1 / (dy+dy) + + divJp = dlat*cosv + divJM = dlat*cosv +! + do j=2, ny-1 + divJp(j) = dlat*cosv(j+1)/cosv(j) + divJM(j) = dlat*cosv(j-1)/cosv(j) + enddo + divJp(1) = divjp(2) !*divjp(1)/divjp(2) + divJp(ny) = divjp(1) + divJM(1) = divjM(2) !*divjM(1)/divjM(2) + divJM(ny) = divjM(1) +! + return + end SUBROUTINE subs_diag_geo +! + subroutine get_xy_pt(V, Vx, Vy, nx, ny, dlam1, dlat) +!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +! compute for each Vert-column: grad(V) +! periodic in X and central diff ... +!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + implicit none + integer :: nx, ny + real :: V(nx, ny), dlam1(ny), dlat + real :: Vx(nx, ny), Vy(nx, ny) + integer :: i, j + do i=2, nx-1 + Vx(i,:) = dlam1(:)*(V(i+1,:)-V(i-1,:)) + enddo + Vx(1,:) = dlam1(:)*(V(2,:)-V(nx,:)) + Vx(nx,:) = dlam1(:)*(V(1,:)-V(nx-1,:)) + + do j=2, ny-1 + Vy(:,j) = dlat*(V(:,j+1)-V(:, j-1)) + enddo + Vy(:, 1) = dlat*2.*(V(:,2)-V(:,1)) + Vy(:,ny) = dlat*2.*(V(:,ny)-V(:,ny-1)) + + end subroutine get_xy_pt + + subroutine get_xyd_wind( V, Vx, Vy, Vyd, nx, ny, dlam1, dlat, divJp, divJm) +! +! compute for each Vert-column: grad(V) +!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + implicit none + integer :: nx, ny + real :: V(nx, ny), dlam1(ny), dlat + real :: Divjp(ny), Divjm(ny) + real :: Vx(nx, ny), Vy(nx, ny), Vyd(nx, ny) + integer :: i, j + do i=2, nx-1 + Vx(i,:) = dlam1(:)*(V(i+1,:)-V(i-1,:)) + enddo + Vx(1,:) = dlam1(:)*(V(2,:)-V(nx,:)) + Vx(nx,:) = dlam1(:)*(V(1,:)-V(nx-1,:)) + + do j=2, ny-1 + Vy(:,j) = dlat*(V(:,j+1)-V(:, j-1)) + enddo + Vy(:, 1) = dlat*2.*(V(:,2)-V(:,1)) + Vy(:,ny) = dlat*2.*(V(:,ny)-V(:,ny-1)) +!~~~~~~~~~~~~~~~~~~~~ +! 1/cos*d(vcos)/dy +!~~~~~~~~~~~~~~~~~~~~ + do j=2, ny-1 + Vyd(:,j) = divJP(j)*V(:,j+1)-V(:, j-1)*divJM(j) + enddo + Vyd(:, 1) = Vyd(:,2) + Vyd(:,ny) = Vyd(:,ny-1) + + end subroutine get_xyd_wind + + subroutine trig3d_fjets( nx, ny, nz, U, V, T, Q, P3D, PS, delp, delz, lon, lat, pmid, trig3d_fgf) + implicit none + integer :: nx, ny, nz + real :: lon(nx), lat(ny) +! + real, dimension(nz) :: pmid + real, dimension(nx, ny, nz) :: U, V, T, Q, delp, delz, p3d + real, dimension(nx, ny ) :: PS + real, dimension(nx, ny, nz) :: trig3d_fgf +! +! locals +! + real, dimension(nx, ny) :: ux, uy, uyd, vy, vx, vyd, ptx, pty + integer :: k, i, j + + real, parameter :: cappa=2./7., pref=1.e5 + real, dimension(nx, ny) :: pt, w1, w2 + + real :: rlon(nx), rlat(ny) , cosv(ny), tanlat(ny) + real :: rlatc(ny-1), brcos(ny), brcos2(ny) + + real :: dx, dy, dlat + real :: dlam1(ny), dlam2(ny), divJp(ny), divJm(ny) + + + call subs_diag_geo(nx, ny, lat, lon, rlat, rlon, dy, dx, & + cosv, rlatc, brcos, brcos2, dlam1, dlam2, dlat, divJp, divJm) + + do k=1, nz + w1(:,:) = P3d(:,:,k) + w2(:,:) = T(:,:,k) + + pt = w2*(pref/w1)**cappa + call get_xy_pt(Pt, ptx, pty, nx, ny, dlam1, dlat) + w1(:,:) = V(:,:, K) + call get_xyd_wind( w1, Vx, Vy, Vyd, nx, ny, dlam1, dlat, divJp, divJm) + w1(:,:) = U(:,:, K) + call get_xyd_wind( w1, Ux, Uy, Uyd, nx, ny, dlam1, dlat, divJp, divJm) + + trig3d_fgf(:,:,k) = -ptx*ptx*ux - pty*pty*vy -(vx+uyd)*ptx*pty + + enddo + end subroutine trig3d_fjets + + subroutine trig3d_okubo( nx, ny, nz, U, V, T, Q, P3d, PS, delp, delz, lon, lat, pmid, trig3d_okw) + implicit none + integer :: nx, ny, nz + real :: lon(nx), lat(ny) +! + real, dimension(nz) :: pmid + real, dimension(nx, ny, nz) :: U, V, T, Q, delp, delz, p3d + real, dimension(nx, ny ) :: PS + real, dimension(nx, ny, nz) :: trig3d_okw +! +! locals +! + real, dimension(nx, ny) :: ux, uy, uyd, vy, vx, vyd, ptx, pty + integer :: k, i, j + + real, parameter :: cappa=2./7., pref=1.e5 + real, dimension(nx, ny) :: pt, w1, w2, d1 + + real :: rlon(nx), rlat(ny) , cosv(ny), tanlat(ny) + real :: rlatc(ny-1), brcos(ny), brcos2(ny) + + real :: dx, dy, dlat + real :: dlam1(ny), dlam2(ny), divJp(ny), divJm(ny) + + call subs_diag_geo(nx, ny, lat, lon, rlat, rlon, dy, dx, & + cosv, rlatc, brcos, brcos2, dlam1, dlam2, dlat, divJp, divJm) + + do k=1, nz + w1(:,:) = P3d(:,:,k) + w2(:,:) = T(:,:,k) + + pt = w2*(pref/w1)**cappa + call get_xy_pt(Pt, ptx, pty, nx, ny, dlam1, dlat) + w1(:,:) = V(:,:, K) + call get_xyd_wind( w1, Vx, Vy, Vyd, nx, ny, dlam1, dlat, divJp, divJm) + w1(:,:) = U(:,:, K) + call get_xyd_wind( w1, Ux, Uy, Uyd, nx, ny, dlam1, dlat, divJp, divJm) + + trig3d_okw(:,:,k) = -ptx*ptx*ux - pty*pty*vy -(vx+uyd)*ptx*pty + w1 = (Ux -Vy)*(Ux-Vy) + (Vx +Uy)*(Vx+Uy) ! S2 + W2 = (Vx - Uyd)*(Vx - Uyd) + D1 = Ux + Vyd + trig3d_okw(:,:,k) = W1 -W2 +! trig3d_okw(:, :, k) =S2 -W2 +! trig3d_okw(:, :, k) =D1*D1 + 4*(Vx*Uyd -Ux*Vyd) ! ocean +! trig3d_okw(:, :, k) = trig3d_okw(:,:,k) + D1*D1 + 2.*D1*sqrt(abs(W1-W2)) ! S2 =W1Ted-luk + enddo + end subroutine trig3d_okubo +! + subroutine trig3d_dconv(nx, ny, nz, U, V, T, Q, P3d, PS, delp, delz, lon, lat, pmid, trig3d_conv, & + dcheat3d, precip2d, cld_klevs2d, scheat3d) + + implicit none + integer :: nx, ny, nz + real :: lon(nx), lat(ny) +! + real, dimension(nz) :: pmid + real, dimension(nx, ny, nz) :: U, V, T, Q, delp, delz, p3d + real, dimension(nx, ny ) :: PS + real, dimension(nx, ny, nz) :: trig3d_conv + + real, dimension(nx, ny, nz) :: dcheat3d, scheat3d + real, dimension(nx, ny ) :: precip2d + integer,dimension(nx, ny, 3 ):: cld_klevs2d + integer :: k + end subroutine trig3d_dconv + + subroutine cires_3d_triggers( nx, ny, nz, lon, lat, pmid, & + U, V, W, T, Q, delp, delz, p3d, PS, HS, Hyam, Hybm, Hyai, Hybi, & + trig3d_okw, trig3d_fgf, trig3d_conv, & + dcheat3d, precip2d, cld_klevs2d, scheat3d) + + implicit none + integer :: nx, ny, nz + real :: lon(nx), lat(ny) +! +! reversed ??? Hyai, Hybi , pmid +! + real, dimension(nz+2) :: Hyai, Hybi + real, dimension(nz+1) :: Hyam, Hybm +! + real, dimension(nz) :: pmid + real, dimension(nx, ny, nz) :: U, V, W, T, Q, delp, delz, p3d + real, dimension(nx, ny ) :: PS, HS + real, dimension(nx, ny, nz) :: trig3d_okw, trig3d_fgf, trig3d_conv + real, dimension(nx, ny, nz) :: dcheat3d, scheat3d + real, dimension(nx, ny ) :: precip2d + integer,dimension(nx, ny, 3 ):: cld_klevs2d + real :: dzkm, zkm + integer :: k +!================================================================================== +! fgf and OW-triggers +! read PRECIP + SH/DC conv heating + cloud-top-bot-middle from "separate" file !!! +! +!=================================================================================== + + call trig3d_fjets( nx, ny, nz, U, V, T, Q, P3D, PS, delp, delz, lon, lat, pmid, trig3d_fgf) + call trig3d_okubo( nx, ny, nz, U, V, T, Q, P3D, PS, delp, delz, lon, lat, pmid, trig3d_okw) + call trig3d_dconv(nx, ny, nz, U, V, T, Q, P3D, PS, delp, delz, lon, lat, pmid, trig3d_conv, & + dcheat3d, precip2d, cld_klevs2d, scheat3d) +!===================================================================================================== +! output of triggers: trig3d_fgf, trig3d_okw, trig3d_conv, cheat3d, precip2d, cld_klevs2d, scheat3d +! +! Bulk momentum flux=/ 0 and levels for launches +! +!===================================================================================================== + 111 format(i6, 4(3x, F8.3), ' trigger-grid ') + + do k=1, nz-1 + zkm = -7.*alog(pmid(k)*1.e-3) + dzkm = zkm +7.*alog(pmid(k+1)*1.e-3) + write(6,111) k, hybi(k), pmid(k), zkm, dzkm !' triggers ' + enddo + + end subroutine cires_3d_triggers +!================================================================================== +! tot-flux launch 0 or 1 # of Launches +! specify time-dep bulk sources: taub, klev, if_src, nf_src +! +!================================================================================== + subroutine get_spectra_tau_convgw & + (nw, im, levs, dcheat, scheat, precip, icld, xlatd, sinlat, coslat,taub, klev, if_src, nf_src) +! +! temporarily can put GEOS-5/MERRA-2 GW-lat dependent function +! + integer :: nw, im, levs + integer,dimension(im,3) :: icld + real, dimension(im, levs) :: dcheat, scheat + real, dimension(im) :: precip, xlatd, sinlat, coslat + real, dimension(im) :: taub + integer, dimension(im) :: klev, if_src + integer :: nf_src +! +! locals + real, parameter :: precip_max = 100. ! mm/day + real, parameter :: tau_amp = 35.e-3 ! 35 mPa + + integer :: i, k, klow, ktop, kmid + real :: dtot, dmax, daver +! + nf_src = 0 + if_src(1:im) = 0 + taub(1:im) = 0.0 + do i=1, im + klow = icld(i,1) + ktop = icld(i,2) + kmid= icld(i,3) + if (klow == -99 .and. ktop == -99) then + cycle + else + klev(i) = ktop + k = klow + klev(i) = k + dmax = abs(dcheat(i,k) + scheat(i,k)) + do k=klow+1, ktop + dtot =abs(dcheat(i,k) + scheat(i,k)) + if ( dtot > dmax) then + klev(i) = k + dmax = dtot + endif + enddo +! +! klev as max( dcheat(i,k) + scheat) +! vertical width of conv-heating +! +! counts/triiger=1 & taub(i) +! + nf_src = nf_src +1 + if_src(i) = 1 + taub(i) = tau_amp* precip(i)/precip_max*coslat(i) + endif + + enddo +! +! 100 mb launch and MERRA-2 slat-forcing +! + call Slat_geos5(im, xlatd, taub) + nf_src =im + do i=1, im + if_src(i) = 1 + klev(i) = 127-45 + enddo + +! with info on precip/clouds/dc_heat create Bulk +! taub(im), klev(im) +! +! print *, ' get_spectra_tau_convgw ' + end subroutine get_spectra_tau_convgw +! + subroutine get_spectra_tau_nstgw(nw, im, levs, trig_fgf, xlatd, sinlat, coslat, taub, klev, if_src, nf_src) + integer :: nw, im, levs + real, dimension(im, levs) :: trig_fgf +! real, dimension(im, levs+1) :: pint + real, dimension(im) :: xlatd, sinlat, coslat + real, dimension(im) :: taub + integer, dimension(im) :: klev, if_src + integer :: nf_src +! locals + real, parameter :: tlim_fgf = 100. ! trig_fgf > tlim_fgf, launch waves should scale-dependent + real, parameter :: tau_amp = 35.e-3 ! 35 mPa + real, parameter :: pmax = 750.e2, pmin = 100.e2 + integer, parameter :: klow =127-92, ktop=127-45 + integer, parameter :: kwidth = ktop-klow+1 + integer :: i, k, kex + real :: dtot, dmax, daver + real :: fnorm, tau_min + nf_src = 0 + if_src(1:im) = 0 + taub(1:im) = 0.0 + fnorm = 1.0 / float(kwidth) + tau_min = tau_amp*fnorm + do i=1, im +! +! only trop-c fjets so find max(trig_fgf) => klev +! use abs-values to scale tau_amp +! + + k = klow + klev(i) = k + dmax = abs(trig_fgf(i,k)) + kex = 0 + if (dmax >= tlim_fgf) kex = kex+1 + do k=klow+1, ktop + dtot = abs(trig_fgf(i,k)) + if (dtot >= tlim_fgf) kex = kex+1 + if ( dtot > dmax) then + klev(i) = k + dmax = dtot + endif + enddo + + if (dmax .ge. tlim_fgf) then + nf_src = nf_src +1 + if_src(i) = 1 + taub(i) = tau_min*float(kex) !* precip(i)/precip_max*coslat(i) + endif + + enddo +! +! print *, ' get_spectra_tau_nstgw ' + call Slat_geos5(im, xlatd, taub) + nf_src =im + do i=1, im + if_src(i) = 1 + klev(i) = 127-45 + enddo +! + end subroutine get_spectra_tau_nstgw +! + subroutine get_spectra_tau_okw(nw, im, levs, trig_okw, xlatd, sinlat, coslat, taub, klev, if_src, nf_src) + integer :: nw, im, levs + real, dimension(im, levs) :: trig_okw +! real, dimension(im, levs+1) :: pint + real, dimension(im) :: xlatd, sinlat, coslat + real, dimension(im) :: taub + integer, dimension(im) :: klev, if_src + integer :: nf_src +! locals + real, parameter :: tlim_okw = 100. ! trig_fgf > tlim_fgf, launch waves should scale-dependent + real, parameter :: tau_amp = 35.e-3 ! 35 mPa + real, parameter :: pmax = 750.e2, pmin = 100.e2 + integer, parameter :: klow =127-92, ktop=127-45 + integer, parameter :: kwidth = ktop-klow+1 + integer :: i, k, kex + real :: dtot, dmax, daver + real :: fnorm, tau_min + + nf_src = 0 + if_src(1:im) = 0 + taub(1:im) = 0.0 + fnorm = 1./float(kwidth) + tau_min = tau_amp*fnorm + print *, ' get_spectra_tau_okwgw ' + do i=1, im + k = klow + klev(i) = k + dmax = abs(trig_okw(i,k)) + kex = 0 + if (dmax >= tlim_okw) kex = kex+1 + do k=klow+1, ktop + dtot = abs(trig_okw(i,k)) + if (dtot >= tlim_fgf ) kex = kex+1 + if ( dtot > dmax) then + klev(i) = k + dmax = dtot + endif + enddo +! + if (dmax >= tlim_okw) then + nf_src = nf_src + 1 + if_src(i) = 1 + taub(i) = tau_min*float(kex) !* precip(i)/precip_max*coslat(i) + endif + + enddo + print *, ' get_spectra_tau_okwgw ' + end subroutine get_spectra_tau_okw +! +! +! +!>\ingroup cires_ugwp_run +!> @{ +!! +!! + subroutine slat_geos5_tamp(im, tau_amp, xlatdeg, tau_gw) +!================= +! GEOS-5 & MERRA-2 lat-dependent GW-source function tau(z=Zlaunch) =rho* +!================= + implicit none + integer :: im + real :: tau_amp, xlatdeg(im), tau_gw(im) + real :: latdeg, flat_gw, tem + integer :: i + +! +! if-lat +! + do i=1, im + latdeg = abs(xlatdeg(i)) + if (latdeg < 15.3) then + tem = (latdeg-3.0) / 8.0 + flat_gw = 0.75 * exp(-tem * tem) + if (flat_gw < 1.2 .and. latdeg <= 3.0) flat_gw = 0.75 + elseif (latdeg < 31.0 .and. latdeg >= 15.3) then + flat_gw = 0.10 + elseif (latdeg < 60.0 .and. latdeg >= 31.0) then + tem = (latdeg-60.0) / 23.0 + flat_gw = 0.50 * exp(- tem * tem) + elseif (latdeg >= 60.0) then + tem = (latdeg-60.0) / 70.0 + flat_gw = 0.50 * exp(- tem * tem) + endif + tau_gw(i) = tau_amp*flat_gw + enddo +! + end subroutine slat_geos5_tamp + + subroutine slat_geos5(im, xlatdeg, tau_gw) +!================= +! GEOS-5 & MERRA-2 lat-dependent GW-source function tau(z=Zlaunch) =rho* +!================= + implicit none + integer :: im + real :: xlatdeg(im) + real :: tau_gw(im) + real :: latdeg + real, parameter :: tau_amp = 100.e-3 + real :: trop_gw, flat_gw + integer :: i +! +! if-lat +! + trop_gw = 0.75 + do i=1, im + latdeg = xlatdeg(i) + if (-15.3 < latdeg .and. latdeg < 15.3) then + flat_gw = trop_gw*exp(-( (abs(latdeg)-3.)/8.0)**2) + if (flat_gw < 1.2 .and. abs(latdeg) <= 3.) flat_gw = trop_gw + else if (latdeg > -31. .and. latdeg <= -15.3) then + flat_gw = 0.10 + else if (latdeg < 31. .and. latdeg >= 15.3) then + flat_gw = 0.10 + else if (latdeg > -60. .and. latdeg <= -31.) then + flat_gw = 0.50*exp(-((abs(latdeg)-60.)/23.)**2) + else if (latdeg < 60. .and. latdeg >= 31.) then + flat_gw = 0.50*exp(-((abs(latdeg)-60.)/23.)**2) + else if (latdeg <= -60.) then + flat_gw = 0.50*exp(-((abs(latdeg)-60.)/70.)**2) + else if (latdeg >= 60.) then + flat_gw = 0.50*exp(-((abs(latdeg)-60.)/70.)**2) + end if + tau_gw(i) = tau_amp*flat_gw + enddo +! + end subroutine slat_geos5 + subroutine init_nazdir(naz, xaz, yaz) + use ugwp_common , only : pi2 + implicit none + integer :: naz + real, dimension(naz) :: xaz, yaz + integer :: idir + real :: phic, drad + drad = pi2/float(naz) + if (naz.ne.4) then + do idir =1, naz + Phic = drad*(float(idir)-1.0) + xaz(idir) = cos(Phic) + yaz(idir) = sin(Phic) + enddo + else +! if (naz.eq.4) then + xaz(1) = 1.0 !E + yaz(1) = 0.0 + xaz(2) = 0.0 + yaz(2) = 1.0 !N + xaz(3) =-1.0 !W + yaz(3) = 0.0 + xaz(4) = 0.0 + yaz(4) =-1.0 !S + endif + end subroutine init_nazdir diff --git a/physics/cires_ugwp_utils.F90 b/physics/cires_ugwp_utils.F90 new file mode 100644 index 000000000..63a5b3238 --- /dev/null +++ b/physics/cires_ugwp_utils.F90 @@ -0,0 +1,152 @@ +! + subroutine um_flow(nz, klow, ktop, up, vp, tp, qp, dp, zpm, zpi, & + pmid, pint, bn2, uhm, vhm, bn2hm, rhohm) +! + use ugwp_common, only : bnv2min, grav, gocp, fv, rdi + implicit none +! +! mass-averaged variables between klow-ktop +! + integer, intent(in) :: nz, klow, ktop + real, dimension(nz), intent(in) :: up, vp, tp, qp, dp, zpm, pmid + real, dimension(nz+1), intent(in) :: pint, zpi + real, dimension(nz), intent(out) :: bn2 + + real :: vtj, rhok, bnv2, rdz + real :: vtkp, vtk, dzp, rhm,dphm + + real, intent(out) :: uhm, vhm, bn2hm, rhohm + + integer :: k +! + dphm = 0.0 !pint(k+1)-pint(k)) + + uhm = 0.0 ! dphm*u1(k) + vhm = 0.0 ! dphm*v1(k) + rhm = 0.0 ! + bn2hm = 0.0 ! +! + do k=klow, ktop + vtj = tp(k) * (1.+fv*qp(k)) + vtk = vtj + vtkp = tp(k+1) * (1.+fv*qp(k+1)) + rhok = rdi * pmid(k) / vtj ! density kg/m**3 + rdz = 1.0 / (zpm(k+1)-zpm(k)) +! dry +! bnv2 = grav * (rdz * ( tp(k+1)-tp(k)) +grcp) /tp(k) +! +! wet +! + bnv2 = grav * (rdz * ( vtkp- vtk) +gocp) /vtk +! if (bnv2 < 0) print *, k, bnv2, ' bnv2 < 0 ', klow, ktop + bnv2 = max(bnv2, bnv2min ) + dzp = pint(k+1)-pint(k) + + dphm = dphm + dzp + uhm = uhm + up(k)*dzp + vhm = vhm + vp(k)*dzp + rhm = rhm + rhok*dzp + bn2hm = bn2hm + bnv2 * dzp + bn2(k) = bnv2 + enddo + + uhm = uhm/dphm + vhm = vhm/dphm + rhm = rhm/dphm + bn2hm = bn2hm/dphm + rhohm = rhm/dphm +! +! print *, ' MF-BV ', bn2hm, bn2(ktop), bn2(klow) +! + end subroutine um_flow +! +! + subroutine mflow_tauz(levs, up, vp, tp, qp, dp, zpm, zpi, & + pmid, pint, rho, ui, vi, ti, bn2i, bvi, rhoi) + + use ugwp_common, only : bnv2min, grav, gocp, fv, rdi + + implicit none + + integer :: levs + real, dimension(levs) :: up, vp, tp, qp, dp, zpm, pmid + real, dimension(levs+1) :: pint, rho, zpi + real, dimension(levs) :: zdelpi, zdelpm + real :: zul, bvl + real, dimension(levs+1) :: ui, vi, bn2i, bvi, rhoi, ti, qi + + real :: vtj, rhok, bnv2, rdz + real :: vtkp, vtk, dzp + real :: vtji + integer :: k +! +! get interface values from surf to top +! + do k=2,levs + vi(k) = 0.5 *(vp(k-1) + vp(k)) + ui(k) = 0.5 *(up(k-1) + up(k)) + ti(k) = 0.5 *(tp(k-1) + tp(k)) + qi(k) = 0.5 *(qp(k-1) + qp(k)) + enddo + + k=1 + ti(k) = tp(k) + ui(k) = up(k) + vi(k) = vp(k) + qi(k) = qp(k) + k= levs + ti(k+1) = tp(k) + ui(k+1) = up(k) + vi(k+1) = vp(k) + qi(k+1)=qp(k) + + do k=1,levs-1 + vtj = tp(k) * (1.+fv*qp(k)) + vtji = ti(k) * (1.+fv*qi(k)) + rho(k) = rdi * pmid(k) / vtj ! density kg/m**3 + rhoi(k) = rdi * pint(k) / vtji + vtk = vtj + vtkp = tp(k+1) * (1.+fv*qp(k+1)) + rdz = 1. / ( zpm(k+1)-zpm(k)) + bnv2 = grav * (rdz * ( vtkp- vtk) +gocp) /vtji + bn2i(k) = max(bnv2, bnv2min ) + bvi(k) = sqrt( bn2i(k) ) + vtk = vtkp + enddo + k = levs + vtj = tp(k) ! * (1.+fv*qp(k)) + vtji = ti(k) !* (1.+fv*qi(k)) + rho(k) = rdi * pmid(k) / vtj + rhoi(k) = rdi * pint(k) / vtji + bn2i(k) = bn2i(k-1) + bvi(k) = sqrt( bn2i(k) ) + k = levs+1 + rhoi(k) = rdi * pint(k) / ti(k) + bn2i(k) = bn2i(k-1) + bvi(k) = sqrt( bn2i(k) ) +! do k=1,levs +! write(6, 121) k, zpm(k)*1.e-3, zpi(k)*1.e-3, bvi(k), rho(k), rhoi(k) +! enddo + 121 format(i5, 2x, 3(2x, F10.3), 2(2x, E10.3)) + + end subroutine mflow_tauz + +! + subroutine get_unit_vector(u, v, u_n, v_n, mag) + implicit none + real, intent(in) :: u, v + real, intent(out) :: u_n, v_n, mag +! + + mag = sqrt(u*u + v*v) + + if (mag > 0.0) then + u_n = u/mag + v_n = v/mag + else + u_n = 0. + v_n = 0. + end if + + end subroutine get_unit_vector +! diff --git a/physics/cires_vert_lsatdis.F90 b/physics/cires_vert_lsatdis.F90 new file mode 100644 index 000000000..362bed8ef --- /dev/null +++ b/physics/cires_vert_lsatdis.F90 @@ -0,0 +1,524 @@ + subroutine ugwp_lsatdis_naz(levs, ksrc, nw, naz, kxw, taub_spect, ch, xaz, yaz, & + fcor, c2f2, dp, zmid, zint, pmid, pint, rho, ui, vi, ti, & + kvg, ktg, krad, kion, bn2i, bvi, rhoi, ax, ay, eps, ked, tau1) +! +! call ugwp_lsatdis_naz(levs, ksrc, nw, naz, kxw, taub_spect, ch, xaz, yaz, & +! fcor(j), c2f2(j), dp, zmid, zint, pmid, pint, rho, ui, vi, ti, & +! kvg, ktg, krad, kion, bn2i, bvi, rhoi, ax1, ay1, eps1, ked1) + use ugwp_common, only : rcpd, grav, rgrav + implicit none +! + integer :: levs, nw, naz, ksrc + real :: kxw + real, dimension(nw) :: taub_spect, ch + real, dimension(naz) :: xaz, yaz + real, dimension(levs+1) :: ui, vi, ti, bn2i, bvi, rhoi, zint, pint + real, dimension(levs ) :: dp, rho, pmid, zmid + real :: fcor, c2f2 + real, dimension(levs+1) :: kvg, ktg, kion, krad, kmol + +! output/locals + real, dimension(levs ) :: ax, ay, eps + real, dimension(levs+1) :: ked , tau1 + + real, dimension(levs+1 ) :: uaz + real, dimension(levs, naz ) :: epsd + real, dimension(levs+1, naz ) :: atau, kedd + real, dimension(levs+1 ) :: taux, tauy + real, dimension(levs ) :: dzirho , dzpi + real :: usrc +! + integer :: iaz, k +! + atau=0.0 ; epsd=0.0 ; kedd=0.0 + + do k=1,levs + dzpi(k) = -(pint(k+1)-pint(k))/rho(k)*rgrav + dzirho(k) = 1./rho(k)/dzpi(k) ! grav/abs(dp(k)) still hydrostatic "UGWP" + enddo + + LOOP_IAZ: do iaz =1, naz + usrc = ui(ksrc)*xaz(iaz) +vi(ksrc)*yaz(iaz) + do k=1,levs+1 + uaz(k) =ui(k)*xaz(iaz) +vi(k)*yaz(iaz) -usrc + enddo +! +! if (nw .le. 4) call stochastic ..ugwp_lsatdis_az1 only 4-waves ch_ngw1, fuw_ngw1, eff_ngw1=1 +! +! multi-wave scheme +! + if (nw .gt. 4) then + call ugwp_lsatdis_az1(levs, ksrc, nw, kxw, ch, taub_spect, & + fcor, c2f2, zmid, zint, rho, uaz, ti, bn2i, bvi, rhoi, dzirho, dzpi, & + kvg, ktg, krad, kion, kmol, epsd(:, iaz), kedd(:,iaz), atau(:, iaz) ) + + endif +! + ENDDO LOOP_IAZ ! Azimuth of GW propagation directions +! +! sum over azimuth and project aTau(z, iza) =>(taux and tauy) +! for scalars for "wave-drag vector" +! + eps =0. ; ked =0. + do k=ksrc, levs + eps(k) = sum(epsd(k,:))*rcpd + enddo + + do k=ksrc, levs+1 + taux(k) = sum( atau(k,:)*xaz(:)) + tauy(k) = sum( atau(k,:)*yaz(:)) + ked(k) = sum(kedd(k,:)) + enddo + + tau1(ksrc:levs) = taux(ksrc:levs) + tau1(1:ksrc-1) = tau1(ksrc) +! +! end solver: gw_azimuth_solver_LS81 +! sign Ax in rho*dU/dt = -d(rho*tau)/dz +! [(k) - (k+1)] + ax =0. ; ay = 0. + do k=ksrc, levs + ax(k) = dzirho(k)*(taux(k)-taux(k+1)) + ay(k) = dzirho(k)*(tauy(k)-tauy(k+1)) + enddo + call ugwp_limit_1d(ax, ay, eps, ked, levs) + return + +! + print * + print *, ' Ax: ', maxval(Ax(ksrc:levs))*86400., minval(Ax(ksrc:levs))*86400. + print *, ' Ay: ', maxval(Ay(ksrc:levs))*86400., minval(Ay(ksrc:levs))*86400. + print *, 'Eps: ', maxval(Eps(ksrc:levs))*86400., minval(Eps(ksrc:levs))*86400. + print *, 'Ked: ', maxval(Ked(ksrc:levs))*1., minval(Ked(ksrc:levs))*1. +! print *, 'Atau ', maxval(atau(ksrc:levs, 1:Naz))*1.e3, minval(atau(ksrc:levs, 1:Naz))*1.e3 +! print *, 'taux_gw: ', maxval(taux( ksrc:levs))*1.e3, minval(taux( ksrc:levs))*1.e3 + print * +!----------------------------------------------------------------------- +! Here we can apply "ad-hoc" or/and "stability-based" limiters on +! (axy_gw, ked_gw and eps_gw) and check vert-inegrated conservation laws: +! energy and momentum and after that => final update gw-phys tendencies +!----------------------------------------------------------------------- + + end subroutine ugwp_lsatdis_naz +! + subroutine ugwp_lsatdis_az1(levs, ksrc, nw, kxw, ch, taub_sp, & + fcor, c2f2, zm, zi, rho, um, tm, bn2, bn, rhoi, & + dzirho, dzpi, kvg, ktg, krad, kion, kmol, eps, ked, tau ) + +! call ugwp_lsatdis_az1(levs, ksrc, nw, kxw, ch, taub_spect, & +! fcor, c2f2, zmid, zint, rho, uaz, ti, bn2i, bvi, rhoi, dzirho, dzpi, & +! kvg, ktg, krad, kion, kmol, epsd(:, iaz), kedd(:,iaz), atau(:, iaz) ) + + use cires_ugwp_module, only : F_coriol, F_nonhyd, F_kds, linsat, linsat2 + use cires_ugwp_module, only : iPr_ktgw, iPr_spgw, iPr_turb, iPr_mol + use cires_ugwp_module, only : rhp4, rhp2, rhp1, khp, cd_ulim +! + implicit NONE +! + integer, intent(in) :: nw ! number of GW modes in given direction + integer, intent(in) :: levs ! vertical layers + integer, intent(in) :: ksrc ! level of GW-launch layer + + real , intent(in) :: kxw ! horizontal wavelength + real , intent(in) :: ch(nw) ! horizontal phase velocities + real , intent(in) :: taub_sp(nw) ! spectral distribution of the mom-flux +! + real, intent(in) :: fcor, c2f2 ! Corilois factors + + real , intent(in) :: um(levs+1) + real , intent(in) :: tm(levs+1) +!in + real, intent(in), dimension(levs) :: rho, zm + real, intent(in), dimension(levs+1) :: rhoi, zi + real, intent(in), dimension(levs+1) :: bn2, bn + real, intent(in), dimension(levs) :: dzpi, dzirho + real, intent(in), dimension(levs+1) :: kvg, ktg, krad, kion, kmol +!======================================================================== +!out + real, dimension(levs+1) :: tau, ked + real, dimension(levs) :: eps + +!========================================================================= +!local + real :: Fd1, Fd2 + real, dimension(levs) :: a_mkz + real, dimension(levs+1,nw) :: sp_tau, sp_ked, sp_kth + real, dimension(levs,nw) :: sp_eps + + real, dimension(levs,nw) :: sp_mkz, sp_etot + real, dimension(levs,nw) :: sp_ek, sp_ep + + + real, dimension(levs) :: swg_ep, swg_ek, swg_et, swg_kz + + real, dimension(nw) :: rtaus ! spectral distribution at ksrc + real :: sum_rtaus ! total flux in iaz-azimuth + real :: Chnorm, Cx, Cs, Cxs, Cx2sat + real :: Fdis, Fdisat + real :: Cdf2, Cdf1 ! (Cd*cd-f*f) and sqrt +! +! two-level => upward integration for wave-filtering (dissip + breaking) +! + real :: taus, tauk, tau_lin + real :: etws, etwk, etw_lin + real :: epss, epsk + real :: kds, kdk + real :: kzw, kzw2, kzw3, kzi, kzs + real :: wfd, wfi ! +! +! for GW dissipation on the rotational sphere +! + real :: Betadis ! Ep/Ek ratio + real :: BetaM, BetaT ! 0.5 or 1./1+b and 1-1/(1+b) + real :: wfdM, wfdT, wfiM, wfiT, wdop2 + + real :: dzi, keff, keff_m, keff_t, keffs + + real :: sf2k2, cf2 + real :: Lzkm, Lzsat + + integer :: i, k, igw + integer :: ksat1, ksat2 + + real :: zsat1, zsat2 + real :: kx2_nh + + real :: rab1, rab2, rab3, rab4, cd_ulim2 + + integer :: Ind_out(nw, levs+1) + +! + logical, parameter :: dbg_print = .false. +! +!=================================================================== +! Nullify arrays +! tau, eps, ked +!==================================================================== + + tau = 0.0 + eps = 0.0 + ked = 0.0 + Ind_out(1:nw,:) = 0 +! +! GW-spectral arrays ..... sp_etot ....sp_tau +! + sp_tau = 0. + sp_eps = 0. + sp_ked = 0. + sp_mkz = -99. + sp_etot = 0. + sp_ek = 0. + sp_ep = 0. + sp_kth = 0. +! + swg_et = 0. + swg_ep = 0. + swg_ek = 0. + swg_kz = 0. + cd_ulim2 = cd_ulim*cd_ulim + cf2 = F_coriol*c2f2 + kx2_nh = F_nonhyd*kxw*kxw + + if (dbg_print) then + write(6,*) linsat , ' eff-linsat & kx ', kxw + write(6,*) maxval(ch), minval(ch), ' ch ' + write(6,*) + write(6,*) maxval(rhoi), minval(rhoi), 'rhoi ' + write(6,*) zi(ksrc) , ' zi(ksrc) ' + write(6,*) cd_ulim, ' crit-level cd_ulim ' + write(6,*) F_coriol, ' F_coriol' + write(6,*) F_nonhyd, ' F_nonhyd ' + write(6,*) maxval(Bn), minval(BN), ' BN-BV ' + write(6,*) Um(ksrc), ' Um-ksrc ', cd_ulim2 , 'cd_ulim2 ', c2f2, ' c2f2 ' + !pause + endif + +!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +! Loop_GW: over GW-spectra +! of individual non-interactive modes +!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +! + Loop_GW: do i=1, nw +! + Kds = 0.0 +! +! src-level +! + Cx = ch(i) - Um(ksrc) + Cdf2 = Cx*Cx - cf2 + taus = taub_sp(i) ! momentum flux for i-mode w/o rhoi(ksrc) + kzw = Bn(ksrc) / Ch(i) ! ch(i) > 0. Cx(i) < 0. critica + etws = taus*kzw / kxw + rtaus(i) = taus*rhoi(ksrc) +! + IF( Cx <= cd_ulim .or. Cdf2 <= cd_ulim2) THEN + Ind_out(i, ksrc) =-1 ! -1 - diagnostic index for critical levels + cycle Loop_GW ! got to the next mode of GW-spectra + ELSE +! + kzw2 = Bn2(ksrc)/Cdf2 - rhp4 - kx2_nh +! + if (kzw2 <= 0.) then + Ind_out(i, ksrc) =-2 ! -2 - diagnostic index for reflected waves + cycle Loop_GW ! no wave reflection in GW-LSD scheme + endif + + kzw = sqrt(kzw2) + kzw3 = kzw2*kzw + etws = taus*kzw/kxw +! +! Here Linsat == Fr_critical +! + Cx2sat = Linsat2*Cdf2 + if (etws >= cx2sat) then + Kds = kxw*Cx*rhp2/kzw3 + etws = cx2sat + taus = etws*kxw/kzw + Ind_out(i, ksrc) =-3 ! -3 - dignostic index for saturated waves + endif +! + betadis = cdf2/(Cx*Cx+cf2) + betaM = 1.0 /(1.0+betadis) + betaT = 1.0 - BetaM +! + Cxs = Cx + kzs = kzw +! keffs = (kvg(ksrc)+kds)*iPr_turb*.5*khp +! sp_kth(ksrc, i) = rhoi(ksrc)*keffs*(Tm(ksrc)+Tm(ksrc-1)) + rtaus(i) = taus*rhoi(ksrc) + sp_tau(ksrc, i) = rtaus(i) + sp_etot(ksrc, i) = etws + sp_mkz(ksrc, i) = kzw + sp_ek(ksrc, i) = etws*betam + sp_ep(ksrc, i) = etws*betaT ! can be transferred to (T'**2) T-rms + +! + ENDIF ! vertical propagation of i-mode to the next upper layer = (ksrc+1) +! +! Loop_Zint .................................. VERTICAL "INTERFACE" LOOP from ksrc => ktop_GW +! + Loop_Zi: do k=ksrc+1, levs +! + Cx = ch(i)-Um(k) ! Um(k) is defined at the interface pressure levels + Cdf2 = Cx*Cx -cf2 + if( Cx <= cd_ulim .or. Cdf2 <= 0.) then + Ind_out(i, k) =-1 ! 1 - diagnostic index for critical levels + ! print*,'crit level C-U ',int(Cx),int(sqrt(cf2)),' Um ',Um(k) + cycle Loop_GW + endif + + cdf1 =sqrt(Cdf2) + wdop2 = (kxw*Cx)* (kxw*Cx) + kzw2 = (Bn2(k)-wdop2)/Cdf2 - rhp4 - kx2_nh ! full lin DS-NIGW (N2-wd2)*k2=(m2+k2+[1/2H]^2)*(wd2-f2) + + if (kzw2 < 0.) then + Ind_out(i, k) =-2 ! 2 - diagnostic index for reflected waves + cycle Loop_GW + endif + kzw = sqrt(kzw2) + kzw3 =kzw2*kzw +! + keff_m = kvg(k)*kzw2 + kion(k) +! keff_t = kturb(k)*iPr_turb + kmol(k)*iPr_mol + keff_t = ktg(k)*kzw2 + krad(k) +! +! + betadis = cdf2 / (Cx*Cx+cf2) + betaM = 1.0 / (1.0+betadis) + betaT = 1.0 - BetaM + +! +!imaginary frequencies of momentum and heat with "kds at (k-1) level" +! + wfiM = kds*kzw2*F_kds + keff_m + wfiT = kds*iPr_ktgw*F_kds * kzw2 + keff_t +! + wfdM = wfiM/(kxw*Cdf1)*BetaM + wfdT = wfiT/(kxw*Cx)*BetaT +! exp-l: "kzi*dz" + kzi = 2.*kzw*(wfdM+wfdT)*dzpi(k) ! 2-factor energy-momentum (U')^2 +!------------------------------------------------------- +! dissipative factor: Fdis +! we can replace WKB-solver by Numerical integration of +! tau_gw == etot_gw/kzw*kxw +! d(rho*tau_gw) = -kdis*rho*tau_gw +! |tau_gw| <= |tau_gwsat| +! linear limit for single mode +! generalization for the "broad" spectra +! or treating single mode breaking +! over finite "vertical"-depth with "efficiency" +! Now: time-step + hor-l scale +!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + Fdis = exp(-kzi) +! +! +! dissipative "wave rms" by WKB +! + etwk = etws*rhoi(k-1)/rhoi(k)*Fdis*kzw/kzs +! + Cx2sat = Linsat2*Cdf2 +! +! Linear saturation +! + if (etwk.ge.cx2sat) then + + Ind_out(i, k) =-3 ! 3 - dignostic index for saturated waves +! ! saturate energy and "trigger" keddy + etw_lin = etwk + etwk = cx2sat + Kds = kxw*Cdf1*rhp2/kzw3 + tauk = etwk*kxw/kzw + +!=================================================================================== +! WAM/case with high Kds tau_lin = (etw_lin-etwk)*kxw/kzw !tau_loss by sat theory +! Lzsat = 6,28/kzw Zsat1 = Zi(k)-.5*Lzsat +! Zsat2 = Zi(k)+.5*Lzsat +! in WAM triggering from "kds = 0 m2/s" => "200 m2/s" for Lzw ~ 10 km +! +! call sat_domain(zi, Zsat1, Zsat2, pver, ksat1, ksat2) +! +! to avoid it do the new diss-n factor with eddy "kds" added to the +! background keff_m and keff_t +! +! can be taken out for the strato-mesosphere in GFS +! wfiM = kds*kzw2 + keff_m +! wfiT = kds*iPr_ktgw * kzw2 +keff_t +! wfdM = wfiM/(kxw*Cdf1)*BetaM +! wfdT = wfiT/(kxw*Cx)*BetaT +! kzi = 2.*kzw*(wfdM+wfdT)*dzpi(k) +! Fdisat = exp(-kzi) +! etwk = etws*rhoi(k-1)/rhoi(k)*Fdis*(kzw/Kzs) +! updated breaking in the Lzsat-domain: zsat1 < zi < zsat2 +! ================================================================================= + else + kds = 0.0 + tauk = etwk*kxw/kzw ! = Ekin*kx/kz + ENDIF +!-------------------------------------- +! +! Fill in spectral arrays(levs, nw) +! +!-------------------------------------- + sp_ked(k,i) = kds ! defined at interfaces + sp_tau(k, i) = tauk*rhoi(k) ! defined at interfaces + +! keff = (kds + kvg(k))*iPr_turb*0.5*KHP +! sp_kth(k, i) = rhoi(k)*keff*(Tm(k)+Tm(k-1)) ! defined at mid-layers + + sp_etot(k, i) = etwk ! defined at interfaces + sp_mkz(k, i) = kzw ! defined at interfaces + sp_ek(k, i) = etwk*betam ! defined at interfaces + sp_ep(k, i) = etwk*betaT ! can be transferred to (T'**2) +! +! + if (sp_tau(k,i) > sp_tau(k-1,i)) then + sp_tau(k,i) = sp_tau(k-1,i) ! prevent "possible" numerical "noise" + endif +! +! updates for "eps and keff" from +! + rab1 =.5*(cx+cxs)*dzirho(k) +! heating +! due to wave dissipation +! + sp_eps(k,i) = rab1*(sp_tau(k-1,i)- sp_tau(k,i)) ! defined at mid-layers +! +! cooling term due to eddy heat conduction =0 if Keff_cond =>0, +! usually updated by 1D-heat implict tridiagonal solver +! explicit local solver ---->sp_kth(k,i) = Kt*(dT/dz+ R/Cp*T/Hp~>g/cp) +! +! sp_eps(k,i)=sp_eps(k,i)+dzirho(k)*(sp_kth(k,i)- sp_kth(k-1,i)) +! + kzs = kzw + cxs = cX + taus = tauk + etws = etwk +! keffs = keff + + enddo Loop_Zi ! ++++++++++++++ vertical layer +! +! ................................! stop ' in solver single-mode' +! + enddo Loop_GW ! i-mode of GW-spectra +! + sum_rtaus =sum(rtaus) ! total momentum flux at k=ksrc + +! print *, sum_rtaus, ' tau-src ', nint(zi(ksrc)*1.e-3) +! print *, maxval(ch), minval(ch), ' Ch ', ngwv, ' N-modes ' +! +!============================================================================== +! Perform spectral integartion (sum) & apply "efficiency/inremittency" factors +! +! eff_factor: ~ 1./[number of modes in 1-direction of model columns] +! +!============================================================================== + do k=ksrc, levs + + ked(k) =0. + Eps(k) = 0. + Tau(k) = 0. + swg_et(k) =0. + swg_ep(k) =0. + swg_ek(k) =0. + + do i=1,nw + Ked(k) = Ked(k)+sp_ked(k,i) + Eps(k) = Eps(k)+sp_eps(k,i) + Tau(k) = Tau(k)+sp_tau(k,i) +!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +! GW-energy + GW-en flux ~ Cgz*E, diagnostics-only +!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + swg_et(k) = swg_et(k)+sp_etot(k,i) !*eff_fact + swg_ep(k) = swg_ep(k)+sp_ep(k,i) !*eff_fact + swg_ek(k) = swg_ek(k)+sp_ek(k,i) !*eff_fact + enddo + + enddo +! fill in below the "source" level ..... [1:ksrc-1] +! + do k=1, ksrc-1 +! no loss of the total momentum flux + ked(k) =0. + eps(k) = 0. + tau(k) = tau(ksrc) +! lin-theory diagnostics-only + swg_et(k) =swg_et(ksrc)*rhoi(ksrc)/rhoi(k) + swg_ep(k) =swg_ep(ksrc)*rhoi(ksrc)/rhoi(k) + swg_ek(k) =swg_ek(ksrc)*rhoi(ksrc)/rhoi(k) + enddo +! + RETURN +! +! diagnostics below +! +345 FORMAT(2x, F8.2, 4(2x, F10.3), 2x, F8.2) + if (dbg_print) then + print * + print *, ' Zkm EK m2/s2 Ked m2/s Eps m2/s3 tau-Mpa ' + do k=ksrc, levs +! Fd1 = maxval(Fdis_modes(1:nw,k)) +! Fd2 = minval(Fdis_modes(1:nw,k)) + write(6, 345) Zi(k)*1.e-3, sqrt(swg_ek(k)), Ked(k), Eps(k), Tau(k)*1.e3, Um(k) !, Fd1, Fd2 + enddo + print * + write(6,*) nw , ' nwaves-linsat ' + write(6,*) maxval(sp_ked), minval(sp_ked), 'ked ' + write(6,*) maxval(sp_tau), minval(sp_tau), 'sp_tau ' + !pause + endif + +! + end subroutine ugwp_lsatdis_az1 +! + subroutine ugwp_limit_1d(ax, ay,eps, ked, levs) + use cires_ugwp_module, only : max_kdis, max_eps, max_axyz + implicit none + integer :: levs + real, dimension(levs) :: ax, ay,eps + real, dimension(levs+1) :: ked + real, parameter :: xtiny = 1.e-30 + where (abs(ax) > max_axyz ) ax = ax/abs(ax+xtiny)*max_axyz + where (abs(ay) > max_axyz ) ay = ay/abs(ay+xtiny)*max_axyz + where (abs(eps) > max_eps ) eps = eps/abs(eps+xtiny)*max_eps + where (ked > max_kdis ) ked = max_kdis + end subroutine ugwp_limit_1d diff --git a/physics/cires_vert_orodis.F90 b/physics/cires_vert_orodis.F90 new file mode 100644 index 000000000..0d3cce194 --- /dev/null +++ b/physics/cires_vert_orodis.F90 @@ -0,0 +1,1018 @@ +! subroutine ugwp_drag_mtb +! subroutine ugwp_taub_oro +! subroutine ugwp_oro_lsatdis +! + subroutine ugwp_drag_mtb( iemax, nz, & + elvpd, elvp, hprime , sigma, theta, oc, oa4, clx4, gam, zpbl, & + up, vp, tp, qp, dp, zpm, zpi, pmid, pint, idxzb, drmtb,taumtb) + + use ugwp_common, only : bnv2min, grav, grcp, fv, rad_to_deg, dw2min, velmin, rdi + use ugwp_oro_init,only : nridge, cdmb, fcrit_mtb, frmax, frmin, strver + + implicit none +!======================== +! several versions for drmtb => high froude mountain blocking +! version 1 => vay_2018 ; +! version 2 => kdn_2005 ; Kim & Doyle in NRL-2005 +! version 3 => ncep/gfs-2017 -gfs_2017 with lm1997 +!======================== + +! character(len=8) :: strver = 'vay_2018' +! real, parameter :: Fcrit_mtb = 0.7 + + integer, intent(in) :: nz + integer, intent(in) :: iemax ! standard ktop z=elvpd + 4 * hprime + real , intent(out) :: taumtb + + integer , intent(out) :: idxzb + real, dimension(nz), intent(out) :: drmtb + + real, intent(in) :: elvp, elvpd !elvp = min (elvpd + sigfac * hprime(j), hncrit=10000meters) + real, intent(in) :: hprime , sigma, theta, oc, oa4(4), clx4(4), gam + real, intent(in) :: zpbl + + real, dimension(nz), intent(in) :: up, vp, tp, qp, dp, zpm, pmid + real, dimension(nz+1), intent(in) :: zpi, pint +! + real, dimension(nz+1) :: zpi_zero + real, dimension(nz) :: zpm_zero + real :: vtj, rhok, bnv2, rdz, vtkp, vtk, dzp + + real, dimension(nz) :: bn2, uds, umf, cosang, sinang + + integer :: k, klow, ktop, kpbl + real :: uhm, vhm, bn2hm, rhohm, & + mtb_fix, umag, bnmag, frd_src, & + zblk, who_iz_normal, rlm97, & + phiang, ang, pe, ek, & + cang, sang, ss2, cs2, zlen, dbtmp, & + hamp, bgamm, cgamm + +!================================================== +! +! elvp + hprime <=>elvp + nridge*hprime, ns =2 +! ns = sigfac +! tau_parel & tau_normal along major "axes" +! +! options to block the "flow", choices for [klow, ktop] +! +! 1-directional (normal) & 2-directional "blocking" +! +!================================================== +! no - blocking: drmtb(1:nz) = 0.0 +!================= + idxzb = -1 + drmtb(1:nz) = 0.0 + taumtb = 0.0 + klow = 2 + + ktop = iemax + hamp = nridge*hprime + +! reminder: cdmb = 4.0 * 192.0/float(imx)*cdmbgwd(1) Lellipse= a/2=sigma/hprime + + mtb_fix = cdmb*sigma/hamp !hamp ~ 2*hprime and 1/sigfac = 0.25 is inside 1/hamp + + if (mtb_fix == 0.) then + print *, cdmb, sigma, hamp + print *, ' MTB == 0' + stop + endif + + if (strver == 'vay_2018') then + + zpm_zero = zpm - zpi(1) + zpi_zero = zpi - zpi(1) + + do k=1, nz-1 + if (hamp .le. zpi_zero(k+1) .and. (hamp .gt. zpi_zero(k) ) ) then + ktop = k+1 !......simply k+1 next interface level + exit + endif + enddo +! print *, klow, ktop, ' klow-ktop ' + call um_flow(nz, klow, ktop, up, vp, tp, qp, dp, zpm, zpi, pmid, pint, & + bn2, uhm, vhm, bn2hm, rhohm) + + umag = max(sqrt(uhm*uhm + vhm*vhm), velmin) !velmin=dw2min =1.0 m/s + if (bn2hm .le. 0.0) then + print *, ' unstable MF for MTB -RETURN ' + RETURN ! unstable PBL + endif + bnmag =sqrt(bn2hm) + + frd_src = min(hamp*bnmag/umag, frmax) ! frmax =10. + +! print *, frd_src, Fcrit_mtb/frd_src, ' no-Blocking > 1 ' +! + if ( frd_src .le. Fcrit_mtb) RETURN ! no-blocking, although on small ridges with weak winds can be blocking +! +! zblk > 0 +! Fcrit_mtb > Fcrit_ogw h_clip = Fr_mtb*U/N ! h_hill minus h_clip = zblk +! + zblk = hamp*(1. - Fcrit_mtb/frd_src) + idxzb =1 + do k = 2, ktop + + if ( zblk < zpm_zero(k) .and. zblk >= zpm_zero(k-1)) then + idxzb = k + exit + endif + enddo +! + if (idxzb == 1) RETURN ! first surface level block is not "important" + + if (idxzb > 1) then ! let start with idxzb = 2....and up with LM1997 +! +! several options to compute MTB-drag: a) IFS_1997 ; b) WRF_KD05 ; c) SJM_2000 +! + bgamm = 1.0 - 0.18*gam -0.04*gam*gam + cgamm = 0.48*gam +0.3*gam*gam + + do k = 1, idxzb-1 + zlen = sqrt( (zblk - zpm_zero(k) ) / ( zpm_zero(k) +hprime )) + + umag = max(sqrt(up(k)*up(k) + vp(k)*vp(k)), velmin) + + phiang = atan(vp(k)/umag) +! theta -90/90 + ang = theta - phiang + cang = cos(ang) ; sang = sin(ang) + + who_iz_normal = max(cang, gam*sang ) !gfs-2018 + + cs2 = cang* cang ; ss2 = 1.-cs2 + + rlm97 =(gam * cs2 + ss2)/ (cs2 + gam * ss2) ! ... (cs2 + gam * ss2) / (gam * cs2 + ss2) ! check it +! + if (rlm97 > 2.0 ) rlm97 = 2.0 ! zero mtb-friction at this level +! + + who_iz_normal = bgamm*cs2 + cgamm*ss2 ! LM1997/IFS + + dbtmp = mtb_fix* max(0., 2.- rlm97)*zlen*who_iz_normal + if (dbtmp < 0) dbtmp = 0.0 +! +! several approximation can be made to implement MTB-drag +! as a "nonlinear level dependent"-drag or "constant"-drag +! uds(k) == umag = const between the 1-layer and idxzb +! + + drmtb(k) = dbtmp * abs(umag) ! full mtb-drag = -drmtb(k) * uds = -kr*u + taumtb = taumtb - drmtb(k)*umag *rdi * pmid(k)/tp(k)*(zpi(k+1)-zpi(k)) +! +! 2-wave appr for anisotropic drmtb_Bellipse(k) and drmtb_Aell(k) can be used +! with Umag-projections on A & B ellipse axes +! mtb_fix =0.25*cdmb*sigma/hprime, +! in SM-2000 mtb_fix~ 1/8*[cdmb_A, cdmb_B]*sigma/hprimesum ( A+B) = 1/4. +! +!333 format(i4, 7(2x, F10.3)) +! write(6,333) , k, zpm_zero(k), zblk, hamp*Fcrit_mtb/frd_src, taumtb*1.e3, drmtb(k) , -drmtb(k)*up(k)*1.e5 + enddo +! + endif + endif ! strver=='vay_2018' +! +! +! + if (strver == 'kdn_2005' .or. strver == 'wrf_2018' ) then + + print *, ' kdn_2005 with # of hills ' +! +! compute flow-blocking stress based on WRF 'gwdo2d' +! + endif +! +! + if (strver == 'gfs_2018') then + + ktop = iemax; klow = 2 + + call um_flow(nz, klow, ktop, up, vp, tp, qp, dp, zpm, zpi, pmid, pint, & + bn2, uhm, vhm, bn2hm, rhohm) + if (bn2hm <= 0.0) RETURN ! unstable PBL +!--------------------------------------------- +! +!'gfs_2018' .... does not rely on Fr_crit +! and Fr-regimes +!----gfs17 for mtn ignores "averaging of the flow" +! for MTB-part it is only works with "angles" +! no projections on [uhm, vhm] -direction +! kpbl can be used for getting high values of iemax-hill +!----------------------------------------------------------- + zpm_zero = zpm - zpi(1) + zpi_zero = zpi - zpi(1) + do k=1, nz-1 + if (zpbl .le. zpm_zero(k+1) .and. (zpbl .ge. zpm_zero(k) ) ) then + kpbl = k+1 + exit + endif + enddo + + do k = iemax, 1, -1 + + uds(k) = max(sqrt(up(k)*up(k) + vp(k)*vp(k)), velmin) + phiang = atan(vp(k)/uds(k)) + ang = theta - phiang + cosang(k) = cos(ang) + sinang(k) = sin(ang) + + if (idxzb == 0) then + pe = pe + bn2(k) * (elvp - zpm(k)) *(zpi(k+1) - zpi(k)) + umf(k) = uds(k) * cosang(k) ! normal to main axis + ek = 0.5 * umf(k) * umf(k) +! +! --- dividing stream lime is found when pe =>exceeds ek first from the "top" +! + if (pe >= ek) idxzb = k + exit + endif + enddo + +! idxzb = min(kpbl, idxzb) +! +! +! +! last: mtb-drag +! + if (idxzb > 1) then + zblk = zpm(idxzb) + print *, zpm(idxzb)*1.e-3, ' mtb-gfs18 block-lev km ', idxzb, iemax, int(elvp) + do k = idxzb-1, 1, -1 +! + zlen = sqrt( (zblk - zpm_zero(k) ) / ( zpm_zero(k) +hprime )) + cs2 = cosang(k)* cosang(k) + ss2 = 1.-cs2 + rlm97 =(gam * cs2 + ss2)/ (cs2 + gam * ss2) ! (cs2 + gam * ss2) / (gam * cs2 + ss2) ! check it + + who_iz_normal = max(cosang(k), gam*sinang(k)) +! +! high res-n higher mtb 0.125 => 3.5 ; (negative of db -- see sign at tendency) +! + dbtmp = mtb_fix* max(0., 2.- rlm97)*zlen*who_iz_normal + + drmtb(k) = dbtmp * abs(uds(k)) ! full mtb-drag = -drmtb(k) * uds = -kr*u +! + taumtb = taumtb - drmtb(k) * uds(k) *rdi * pmid(k)/tp(k)*(zpi(k+1)-zpi(k)) +! + enddo + endif + endif ! strver=='gfs17' +! +! + end subroutine ugwp_drag_mtb +! +! +! ugwp_taub_oro - Computes [taulin, taufrb, drlee(levs) ] +! +! + subroutine ugwp_taub_oro(levs, izb, kxw, tau_izb, fcor, & + hprime , sigma, theta, oc, oa4, clx4, gamm, & + elvp, up, vp, tp, qp, dp, zpm, zpi, pmid, pint, xn, yn, umag, & + tautot, tauogw, taulee, drlee, tau_src, kxridge, kdswj, krefj, kotr) +! + use ugwp_common, only : bnv2min, grav, pi, pi2, dw2min, velmin + use cires_ugwp_module, only : frcrit, ricrit, linsat + use ugwp_oro_init, only : hpmax, cleff, frmax + use ugwp_oro_init, only : nwdir, mdir, fdir + use ugwp_oro_init, only : efmin, efmax , gmax, cg, ceofrc + use ugwp_oro_init, only : fcrit_sm, fcrit_gfs, frmin, frmax + use ugwp_oro_init, only : coro, nridge, odmin, odmax + use ugwp_oro_init, only : strver +! + use ugwp_oro_init, only : mkz2min, lzmax, zbr_pi +! --- +! +! define oro-GW fluxes: taulin, taufrb amd if kdswj > 0 (LWB-lee wave breaking) +! approximate for drlee-momentum tendency +! --- + implicit none +! + integer, intent(in) :: levs, izb + real , intent(in) :: tau_izb ! integrated (1:izb) drag -Kr_mtb*U, or Zero + integer, intent(out) :: kdswj, krefj, kotr + integer :: klwb + real, intent(in) :: kxw, fcor + real, intent(in) :: hprime, sigma, theta, oc, gamm, elvp + +! + real, intent(in) :: oa4(4), clx4(4) + + real, dimension(levs), intent(in) :: up, vp, tp, qp, dp + real, dimension(levs+1), intent(in) :: zpi, pint + real, dimension(levs ), intent(in) :: zpm, pmid +! + real,dimension(levs), intent(out) :: drlee + real,dimension(levs+1), intent(out) :: tau_src +! + real, intent(out) :: tauogw, tautot, taulee + real :: taulin, tauhcr, taumtb + real, intent(out) :: xn, yn, umag, kxridge +! +! +! locals +! four possible versions to compute "taubase as a function of Fr-number" +! character :: strver='smc_2000' ! 'kd_2005', 'gfs_2017', 'vay_2018' +! + real, dimension(levs+1) :: zpi_zero + + real :: oa, clx, odir, cl4p(4), clxp + + real :: uhm, vhm, bn2hm, rhohm, bnv + + real :: elvpMTB, wdir + real :: tem, efact, coefm, kxlinv, gfobnv + + real :: fr, frlin, frlin2, frlin3, frlocal, dfr + real :: betamax, betaf, frlwb, frmtb + integer :: klow, ktop, kph + + integer :: i, j, k, nwd, ind4, idir + + real :: sg_ridge, kx2, umd2 + real :: mkz, mkz2, zbr_mkz, mkzi + + real :: hamp ! clipped hprime*elvmax/elv_clip > hprime + real :: hogw ! hprime or hamp for free-prop OGWs z > z(krefj) + real :: hdsw ! empirical like DNS amplitudes for Lee-dsw trapped waves + real :: hcrit + real :: hblk ! blocking div-stream height + + real :: coef_h2, frnorm + + + real, dimension(levs) :: bn2 + real :: rho(levs) + real, dimension(levs+1) :: ui, vi, ti, bn2i, bvi, rhoi + real, dimension(levs+1) :: umd, phmkz + real :: c2f2, umag2, dzwidth, udir + real :: hogwi, hdswi, hogwz, hdswz ! height*height wave-amp + real :: uogwi, udswi, uogwz, udswz ! wind2 wave-rms + real, dimension(levs+1) :: dtrans, deff + real :: pdtrans + logical :: do_klwb_phase = .false. ! phase-crireria for LLWB of SM00 + logical :: do_dtrans = .true. ! dissipative saturation to deposit momentum + ! between ZMTB => ZHILL +!----------------------------------------------------------------------------- +! +! downslope/lee/GW wave regimes kdswj: between ZMTB and ZOGW(krefj) +! ZMTB < ZOGW = ns*HPRIME < ELVP +! define krefj as a level for OGWs above ZMTB and "2-3-4*hprime" + ZMTB +! we rely on the concept of the "CLIPPED-SG" mountain above ZMTB & new +! inverse Froude number for the "mean flow" averaged from ZMTB to ZOGW +! here we can use "elvp" as only for hprime adjustment ...elvp/elvp_MTB +! +!"empirical" specification of tauwave = taulee+tauogw in [ZMTB : ns*HPRIME] +! can be based on numerical runs like WRF-model +! for Frc < Fr< [Frc : 2.5-3 Frc] +! see suggestions proposed in SM-2000 and Eckermann et al. (2010) +!----------------------------------------------------------------------------- + tautot = 0. ; taulin = 0. ; taulee = 0. ; drlee(1:levs) = 0. ; tau_src = 0.0 + krefj = 1 ; kotr = levs+1; kdswj = 1 + xn = 1.0 ; yn = 0. ; umag = velmin; kxridge = kxw + + dtrans = 0. ; deff =0. + klow = 2 + elvpMTB = elvp +! +! clipped mountain H-zmtb for estimating wave-regimes new Fr and MF above ZMTB +! + if (izb > 0 ) then + klow = izb + elvpMTB = max(elvp - zpi(izb), 0.0) + endif + if (elvpMTB <=0 ) print *, ' blocked flow ' + if (elvpMTB <=0 ) return ! "blocked flow" from the surface to elvMAX + + zpi_zero(:) = zpi(:) - zpi(1) + hblk = zpi_zero(klow) + + sg_ridge = max( nridge*hprime * (elvp/elvpMTB), hblk+hprime*0.333) + +! +! enhance sg_ridge by elvp/elvpMTB >1 and H_clip = H-hiilnew - zblk later for hamp +! + sg_ridge = min(sg_ridge, hpmax) + +! print *, 'sg_ridge ', sg_ridge + + do k=1, levs + if (sg_ridge .gt. zpi_zero(k) .and. ( sg_ridge .le. zpi_zero(k+1) ) ) then + ktop = k+1 + exit + endif + enddo + + krefj = ktop ! the mountain top index for sg_ridge = ns*hprime + +! if ( izb > 0 .and. krefj .le. izb) then +! print *, izb, krefj, sg_ridge, zpi_zero(izb), ' izb >ktop ' +! endif + +! +! here ktop displays sg_ridge-position not elvP !!!! klow =2 to avoid for 127-126L +! instability due to extreme "thin" layer...128L-model needs cruder vertical resolution +! + call um_flow(levs, klow, ktop, up, vp, tp, qp, dp, zpm, zpi, pmid, pint, & + bn2, uhm, vhm, bn2hm, rhohm) + + call get_unit_vector(uhm, vhm, xn, yn, umag) + + if (bn2hm <= 0.0) RETURN ! "unstable/neutral" hill need different treatment + bnv = sqrt(bn2hm) + hamp = sg_ridge-zpi_zero(klow) ! hamp >= nridge*hprime due higher SG-elevations - zblk or first layer + hogw = hamp + hdsw = hamp + + + fr = bnv * hamp /umag + fr = min(fr, frmax) + kxridge = max(sigma/hamp, kxw) ! to get rid from "SSO-errors" kxw-provides max-value for kx + kx2 = kxridge*kxridge + umag = max( umag, velmin) + c2f2 = fcor*fcor/kx2 + umag2 = umag*umag - c2f2 + + if (umag2 <= 0.0) RETURN ! Coriolis cut-off at high-mid latitudes for low kx + + mkz2 = bn2hm/umag2 - kx2 ! we add Coriolis corrections for crude model resolutions "low-kx" + ! and non-stationary waves coro, fcor for small umag + ! bn2hm/[(coro-umag)^2 -fc2/kx2] - kx2, cf = fc/kx => 2 m/s to 11 m/s for 60deg + IF (mkz2 < mkz2min .or. krefj <= 2 ) THEN +! +! case then no effects of wave-orography +! + krefj = 1 ; kdswj = 1; kotr = levs ; klwb = 1 + tautot = 0. + tauogw = 0. + taulee = 0. + drlee = 0. ; tau_src(1:levs+1) = 0. + return + ENDIF +!========================================================================= +! find orographic asymmetry and convexity :'oa/clx' for clipped SG-hill +! nwd 1 2 3 4 5 6 7 8 +! wd w s sw nw e n ne se +! make sure that SM_00 and KD_05 oro-characteristics can match each other +! OD-KDO5 = Gamma=a/b [0:2] ; hsg = 2.*hprime +! OC-KD05 mount sharpness sigma^4 "height to half-width"[0:1] +! alph-SM00 fraction of h2d contributed to hprime [0:1] +! +! OA-KDO5 OA > dwstream OA=0 sym OA < 0 upstram [-1. 0. 1] +! delt-SM00 dw/up asymmetry -1 < delta < 1 +! Gamma-LM97 anisotropy of the orography g2 =(dh/dx)^2/(dh/dy)^2 +!.. +!A parametrization of low-level wave breaking which includes a dependence on +!the degree of 2-dimensionality of SG; it is active over a finite range of Fr +!========================================================================= + wdir = atan2(uhm,vhm) + pi + idir = mod( int(fdir*wdir),mdir) + 1 + + nwd = nwdir(idir) + ind4 = mod(nwd-1,4) + 1 + if (ind4 < 1 ) ind4 = 1 + if (ind4 > 4 ) ind4 = 4 + + oa = ( 1-2*int( (nwd-1)/4 )) * oa4(ind4) + clx = clx4(ind4) + cl4p(1) = clx4(2) + cl4p(2) = clx4(1) + cl4p(3) = clx4(4) + cl4p(4) = clx4(3) + clxp = cl4p(ind4) + + odir = clxp/max(clx, 1.e-5) ! WRF-based definition for "odir" + + odir = min(odmax, odir) + odir = max(odmin, odir) + + + if (strver == 'smc_2000' .or. strver == 'vay_2018') then +!========================================================================= +! +! thrree-piece def-n for tautot(Fr): 0-Fr_lin - Fr_lee -Fr_mtb +! taulin/tauogw taulee taumtb +! here tau_src(levs+1): approximate wave flux from surface to LLWB +! Following attempts of Scinocca +McFarlane, 2000 & Eckermann etal.(2010) +!========================================================================= +! +! if (mkz2 < 0)... mkzi = sqrt(-mkz2) trapped wave regime don't a case in UGWP-V1 +! wave flux ~ rho_src*kx_src/mkz_src*wind_rms +! bn2, uhm, vhm, bn2hm, rhohm +! +! IF (mkz2.ge. mkz2min .and. krefj > 2 ) THEN +! +! wave regimes +! + mkz = sqrt(mkz2) + frlwb = fcrit_sm ! should be higher than LOGW to get zblk < zlwb + frlin = fcrit_sm + frlin2 = 1.5*fcrit_sm + frlin3 = 3.0*fcrit_sm + + hcrit = fcrit_sm*umag/bnv + hogw = min(hamp, hcrit) + hdsw = min(hamp, frlwb*umag/bnv) ! no trapped-wave solution + + coef_h2 = kxridge * rhohm * bnv * umag + + taulin = coef_h2 * hamp*hamp + tauhcr = coef_h2 * hcrit*hcrit + + IF (fr < frlin ) then + tauogw = taulin + taulee = 0.0 + taumtb = 0.0 + else if (fr .ge. frlin ) then + tauogw = tauhcr + taulin = coef_h2 * hamp*hamp + taumtb = tau_izb ! integrated form MTB +! +! SM-2000 approach for taulee, shall we put limits on BetaMax_max ~ 20 or Betaf ?? +! + frnorm = fr/fcrit_sm ! frnorm below [1.0 to 3.0] + BetaMax = 1.0 + 2.0*OC ! alpha of SM00 or OC-mountain sharphess KD05 OC=[10, 0] + + if ( fr <= frlin2 ) then + Betaf= 2.*BetaMax*(frNorm-1.0) + taulee = (1. + Betaf )*taulin - tauhcr + else if ( (fr > frlin2).and.(fr <= frlin3))then + Betaf=-1.+ 1./frnorm/frnorm + & + (BetaMax + 0.555556)*(2.0 - 0.666*frnorm)* (2.0 - 0.666*frnorm) + taulee = (1. + Betaf )*taulin - tauhcr +!============== +! Eck-2010 WRF-alternatve through Dp_surf = P'*grad(h(x,y)) +! 1 < Fr < 2.5 tauwave = taulee+tauogw = tau_dp*(fr)**(-0.9) +! Fr > 2.5 tauwave = tau_dp*(2.5)**(-0.9) +! to apply it need tabulated Dp(fr, Dlin) Dp=function(Dlin, U, N, h) +! +!============== + else + taulee = 0.0 + hdsw = 0.0 + endif + ENDIF + + tautot = tauogw + taulee + taumtb*0. + + IF (taulee > 0.0 ) THEN + + hdsw = sqrt(tautot/coef_h2) ! averaged value for hdsw - mixture of lee+ogw with mkz/kxridge +! +! compute vertical profile "drlee" with the low-level wave breaking & "locally" trapped waves +! make "empirical" height above elvp that may represent DSW-wave breaking & trapping +! here we will assign tau_sso(z) profile between: zblk(zsurf) - zlwb - ztop_sso = ns*sridge +! + call mflow_tauz(levs, up, vp, tp, qp, dp, zpm, zpi, & + pmid, pint, rho, ui, vi, ti, bn2i, bvi, rhoi) + + kph = max(izb, 2) ! kph marks the low-level of wave solutions + klwb = kph ! klwb above blocking marks wave-breaking + kotr = levs+1 ! kotr marks mkz2(z) <= 0., reflection level + + if (do_dtrans) pdtrans = log(tautot/tauogw)/(zpi(krefj) - zpi(kph)) + + udir = max(ui(krefj)*xn +vi(krefj)*yn, velmin) + hogwi = hogw*hogw* rhohm/rhoi(krefj) * umag/udir * bnv/bvi(krefj) + umd(krefj) = udir + + udir = max(ui(kph)*xn +vi(kph)*yn, velmin) + hdswi = hdsw*hdsw* rhohm/rhoi(kph) * umag/udir * bnv/bvi(kph) + umd(kph) = udir + ! what we can put between k =[kph:krefj] + phmkz(:) = 0.0 ! + phmkz(kph-1) = fr ! initial Phase of the low-level wave +! +! now transfer tau_layer => tau_level assuming tau_layer = tau_level +! kx*rho_layer*bn_layer*u_layer* HL*HL = kx*rho_top*bn_top*u_top * HT*HT +! apply it for both hdsw & hogw with linear saturation-solver for Cx =0 +! + loop_lwb_otr: do k=kph+1, krefj ! levs + + umd(k) = max(ui(k)*xn +vi(k)*yn, velmin) + umd2 =(coro- umd(k))*(coro- umd(k)) + umd2 = max(umd2, dw2min) -c2f2 + + + if (umd2 <= 0.0) then +! +! critical layer +! + klwb = k + kotr = k + exit loop_lwb_otr + endif + + mkz2 = bn2i(k)/umd2 - kx2 + + if ( mkz2 >= mkz2min ) then +! +! find klwb having some "kinematic" phase "break-down" crireria SM00 or LM97 +! at finest vertical resolution we can meet "abrupt" mkz +! mkzmax = 6.28/(2*dz), mkzmin = 6.28/ztrop=18km +! to regularize SG-solution mkz = max(mkzmax, min(mkz,in, mkz)) +! + mkz = sqrt(mkz2) + hdswz = hdswi* rhoi(k-1)/rhoi(k) * umd(k-1)/umd(k) * bvi(k-1)/bvi(k) + udswz = hdswz *bn2i(k) +!=========================================================================================== +!linsat wave ampl.: mkz*sqrt(hdswz) <= 1.0 or udswz <= linsat2*umd2 +! +! tautot = tausat = rhoi(k) *udswz_sat * kxridge/mkz +! by k = krefj tautot = tauogw(krefj) +!=========================================================================================== + if (do_klwb_phase) then + phmkz(k) = phmkz(k-1) + mkz*(zpm(k)-zpm(k-1)) + if( ( phmkz(k) .ge. zbr_pi).and.(klwb == kph)) then + klwb = min(k, krefj) + exit loop_lwb_otr + endif + endif + else ! mkz2 < mkz2min + kotr = k ! trapped/reflected waves / + exit loop_lwb_otr + endif + enddo loop_lwb_otr +! +! define tau_src(1:zblk:klwb) = sum(tau_oro+tau_dsw+tau_ogw) and define drlee +! tau_trapped ??? +! + if (do_klwb_phase) then + do k=kph, kotr-1 + + if (klwb > kph .and. k < klwb) then + drlee(k) = (tautot -tauogw)/(zpi(kph) - zpi(klwb)) ! negative Ax*rho + tau_src(k) = tautot + (zpi(k) - zpi(klwb))*drlee(k) + drlee(k) = drlee(k)/rho(k) + else if ( k >= klwb .and. k < kotr) then + tau_src(k) = tauogw + drlee(k) = 0.0 + endif + enddo + kdswj = klwb ! assign to the "low-level" wave breaking + endif +! +! simplest exponential transmittance d(tau)/dz = - pdtrans *tau(z) +! more complicated is dissipative saturation pdtrans =/= constant +! + if (do_dtrans) then + do k=kph, krefj + tau_src(k)= tautot*exp(-pdtrans*(zpi(k)-zpi(kph))) + drlee(k) = -tau_src(k)/rho(k) * pdtrans + enddo + endif + + + ENDIF !taulee > 0.0 + + + endif !strver +! + +!========================================================================= + if (strver == 'gfs_2018' .or. strver == 'kd_2005') then +!========================================================================= +! +! orowaves: OGW+DSW/Lee +! + efact = (oa + 2.0) ** (ceofrc*fr) + efact = min( max(efact,efmin), efmax ) + coefm = (1. + clx) ** (oa+1.) + + kxlinv = min (kxw, coefm * cleff) ! does not exceed 42km ~4*dx + kxlinv = coefm * cleff + tem = fr * fr * oc + gfobnv = gmax * tem / ((tem + cg)*bnv) ! g/n0 +!========================================================================= +! source fluxes: taulin, taufrb +!========================================================================= + tautot = kxlinv * rhohm * umag * umag *umag* gfobnv * efact + + coef_h2 = kxlinv *rhohm * bnv*umag + taulin = coef_h2 *hamp*hamp + hcrit = fcrit_gfs*umag/bnv + tauhcr = coef_h2 *hcrit*hcrit + + IF (fr <= fcrit_gfs) then + tauogw = taulin + tautot = taulin + taulee = 0. + drlee(:) = 0. + ELSE !fr > fcrit_gfs + tauogw = tauhcr + taulee = max(tautot - tauogw, 0.0) + if (taulee > 0.0 ) hdsw = sqrt(taulee/coef_h2) +! approximate drlee(k) between [izb, klwb] +! find klwb and decrease taulee(izb) => taulee(klwb) = 0. +! above izb tau + if (mkz2 > mkz2min.and. krefj > 2 .and. taulee > 0.0) then + + mkz = sqrt(mkz2) + call mflow_tauz(levs, up, vp, tp, qp, dp, zpm, zpi, & + pmid, pint, rho, ui, vi, ti, bn2i, bvi, rhoi) + + kph = max(izb, 2) + phmkz(:) = 0.0 + klwb = max(izb, 1) + kotr = levs+1 + phmkz(kph-1) = fr ! initial Phase of the Lee-OGW + + loop_lwb_gfs18: do k=kph, levs + + umd(k) = max(ui(k)*xn +vi(k)*yn, velmin) + umd2 =(coro- umd(k))*(coro- umd(k)) + umd2 = max(umd2, velmin*velmin) + mkz2 = bn2i(k)/umd2 - kx2 + if ( mkz2 > mkz2min ) then + mkz = sqrt(mkz2) + frlocal = max(hdsw*bvi(k)/umd(k), frlwb) + phmkz(k) = phmkz(k-1) + mkz*(zpm(k)-zpm(k-1)) + if( ( phmkz(k) >= zbr_pi ) .and. (frlocal > frlin)) klwb = k + else + kotr = k + exit loop_lwb_gfs18 + endif + enddo loop_lwb_gfs18 +! +! + do k=kph, kotr-1 + + if (klwb > kph .and. k < klwb) then + drlee(k) = -(tautot -tauogw)/(zpi(kph) - zpi(klwb)) + tau_src(k) = tautot + (zpi(k) - zpi(klwb))*drlee(k) + drlee(k) = drlee(k)/rho(k) + else if ( k >= klwb .and. k < kotr) then + tau_src(k) = tauogw + drlee(k) = 0.0 + endif + enddo + kdswj = klwb ! assign to the "low-level" wave breaking + endif ! mkz2 > mkz2min.and. krefj > 2 .and. taulee > 0.0 + ENDIF !fr > fcrit_gfs + + + ENDIF !strbase='gfs2017' .or. strbase='kd_2005' + + +! output : taulin, taufrb, taulee, xn, yn, umag, kxw/kxridge +! print *, krefj, levs, tauogw, tautot , ' ugwp_taub_oro ' +! + end subroutine ugwp_taub_oro +! +!-------------------------------------- +! +! call ugwp_oro_lsatdis( krefj, levs, tauogw(j), tautot(j), tau_src, kxw, & +! fcor(j), c2f2(j), up, vp, tp, qp, dp, zpm, zpi, pmid1, pint1, & +! xn, yn, umag, drtau, kdis_oro) + + subroutine ugwp_oro_lsatdis( krefj, levs, tauogw, tautot, tau_src, & + kxw, fcor, kxridge, up, vp, tp, qp, dp, zpm, zpi, pmid, pint, & + xn, yn, umag, drtau, kdis) + + use ugwp_common, only : bnv2min, grav, pi, pi2, dw2min, velmin, rgrav + use cires_ugwp_module, only : frcrit, ricrit, linsat, hps, rhp1, rhp2 + use cires_ugwp_module, only : kvg, ktg, krad, kion + use ugwp_oro_init, only : coro , fcrit_sm , fcrit_sm2 + implicit none +! + integer, intent(in) :: krefj, levs + real , intent(in) :: tauogw, tautot, kxw + real , intent(in) :: fcor + + real , dimension(levs+1) :: tau_src + + real, dimension(levs) , intent(in) :: up, vp, tp, qp, dp, zpm + real, dimension(levs+1), intent(in) :: zpi, pmid, pint + real , intent(in) :: xn, yn, umag + real , intent(in) :: kxridge + + + real, dimension(levs), intent(out) :: drtau, kdis +! +! locals +! + real :: uref, udir, uf2, ufd, uf2p + real, dimension(levs+1) :: tauz + real, dimension(levs) :: rho + real, dimension(levs+1) :: ui, vi, ti, bn2i, bvi, rhoi + + integer :: i, j, k, kcrit, kref + real :: kx2, kx2w, kxs + real :: mkzm, mkz, dkz, mkz2, ch, kzw3 + real :: wfdM, wfdT, wfiM, wfiT + real :: fdis, mkzi, keff_m, keff_t + real :: betadis, betam, betat, cdfm, cdft + real :: fsat, hsat, hsat2, kds , c2f2 + + drtau(1:levs) = 0.0 + kdis (1:levs) = 0.0 + + ch = coro + + kx2w = kxw*kxw + kx2 = kxridge*kxridge + if( kx2 < kx2w ) kx2 = kx2w + kxs = sqrt(kx2) + c2f2 = fcor*fcor/kx2 +! +! non-hydrostatic LinSatDis for Ch = 0 (with set of horizontal wavenumber kxw) +! +! print *, krefj, levs, tauogw, tautot , ' orolsatdis ' + call mflow_tauz(levs, up, vp, tp, qp, dp, zpm, zpi, & + pmid, pint, rho, ui, vi, ti, bn2i, bvi, rhoi) +!=============================================================================== +! for stationary oro-GWs only "single"-azimuth cd = 0 -(-Udir) = Udir > 0 +! rotational/non-hyrostatic effects are important only for high-res runs +! Udir = 0, Udir < 0 are not +! future"revisions" shear effects for d mkz /dt = -kxw*dU/dz +! horizontal wavelength spectra mkz2 = l2 -kxw(n)*kxw(n) +! stochastic "tauogw'-setup+ sigma_tau ; +! 3D-wave effects 1+ (k/l)^2 and NS vs EW orowaves +! target is to get "multiple"-saturation levels for OGWs +!=============================================================================== + tauz(1:krefj) = tauogw ! constant flux for OGW-packet or single mode + ! sign of tauz > 0...and its attenuate with Z + k = krefj + uref = ui(k)*xn +vi(k)*yn - ch ! stationary waves + uf2 = uref*uref - c2f2 + if (uf2 > 0) then + mkz2 = bn2i(k)/uf2 -kx2 + if (mkz2.gt.0) then + mkzm = sqrt(mkz2) + else + return ! wave reflection mkz2 <=0. + endif + else + return ! wave absorption uf2 <= 0. + endif +! +! upward solver for single "mode" with tauz(levs+1) =0. at the top +! + kds = 0.1* kvg(krefj) ! eddy wave diffusion from the previous layer + kcrit = levs + do k= krefj+1, levs +! +! 2D-wave propagation along reference-wind direction +! udir = 0 critical wind for coro =0 +! cdop = -uref .... upwind waves travel against MF +! + udir = ui(k)*xn +vi(k)*yn + uf2 = udir*udir - c2f2 + + + if (uf2 < dw2min .or. udir <= 0.0) then + kcrit =K + tauz(kcrit:levs) = 0. + exit ! vert-level loop + endif +! +! wave-based solution +! + mkz2 = bn2i(k)/uf2 -kx2 + if (mkz2 > 0) then + mkzm = sqrt(mkz2) +! +! do dissipative flux vs saturation: kvg, ktg, krad, kion +! + kzw3 = mkzm*mkz2 +! + keff_m = kvg(k)*mkz2 + kion(k) +! keff_t = kturb(k)*iPr_turb + kmol(k)*iPr_mol + keff_t = ktg(k)*mkz2 + krad(k) +! +! + uf2p = uf2 + 2.0*c2f2 + betadis = uf2/uf2p + betaM = 1.0 / (1.0+betadis) ! if c2f2 = 0. betaM = betaT =0.5 ekw = epw + betaT = 1.0- BetaM + +! +!imaginary frequencies of momentum and heat with "kds at (k-1) level" +! + wfiM = kds*mkz2 + keff_m + wfiT = kds*mkz2 + keff_t +! + cdfm = sqrt(uf2)*kxs + cdft = abs(udir)*kxs + wfdM = wfiM/cdfm *BetaM + wfdT = wfiT/Cdft *BetaT + mkzi = 2.0*mkzm*(wfdM+wfdT) + + fdis = tauz(k-1)*exp(-mkzi*(zpi(k)-zpi(k-1)) ) + tauz(k) = fdis + hsat2 = fcrit_sm2 * uf2 *bn2i(k) + fsat = rhoi(k)* hsat2 * sqrt(uf2) * bvi(k) + if (fdis > fsat) then + tauz(k) = min(fsat, tauz(k-1)) +!================================================================= +! two definitions for eddy mixing of MF: +! a) wave damping-Lindzen : Ked ~ kx/(2H)*(u-c)^4/N^3 +! b) heat-based turbulence: 4/3 Richardson Ked ~eps^1/3 *Lt^4/3 +!================================================================= + kds = rhp2*kxs*uf2*uf2/bn2i(k)/bvi(k) + kdis(k) = kds + endif + else + tauz(k:levs) = 0. ! wave is reflected above + kds = 0. + endif + enddo + + do k=krefj+1, kcrit + drtau(k) = rgrav*(tauz(k+1)-tauz(k))/dp(k) + enddo +! +! + end subroutine ugwp_oro_lsatdis +! +! + subroutine ugwp_tofd(im, levs, sigflt, elvmax, zpbl, u, v, zmid, & + utofd, vtofd, epstofd, krf_tofd) + use machine , only : kind_phys + use ugwp_common , only : rcpd2 + use ugwp_oro_init, only : n_tofd, const_tofd, ze_tofd, a12_tofd, ztop_tofd +! + implicit none +! + integer :: im, levs + real(kind_phys), dimension(im, levs) :: u, v, zmid + real(kind_phys), dimension(im) :: sigflt, elvmax, zpbl + real(kind_phys), dimension(im, levs) :: utofd, vtofd, epstofd, krf_tofd +! +! locals +! + integer :: i, k + real :: sgh = 30. + real :: sgh2, ekin, zdec, rzdec, umag, zmet, zarg, zexp, krf +! + utofd =0.0 ; vtofd = 0.0 ; epstofd =0.0 ; krf_tofd =0.0 +! + + do i=1, im + + zdec = max(n_tofd*sigflt(i), zpbl(i)) + zdec = min(ze_tofd, zdec) + rzdec = 1.0/zdec + sgh2 = max(sigflt(i)*sigflt(i), sgh*sgh) + + do k=1, levs + zmet = zmid(i,k) + if (zmet > ztop_tofd) cycle + ekin = u(i,k)*u(i,k) + v(i,k)*v(i,k) + umag = sqrt(ekin) + zarg = zmet*rzdec + zexp = exp(-zarg*sqrt(zarg)) + krf = const_tofd* a12_tofd *sgh2* zmet ** (-1.2) *zexp + utofd(i,k) = -krf*u(i,k) + vtofd(i,k) = -krf*v(i,k) + epstofd(i,k)= rcpd2*krf*ekin ! more accurate heat/mom form using "implicit tend-solver" + ! to update momentum and temp-re + krf_tofd(i,k) = krf + enddo + enddo +! + end subroutine ugwp_tofd +! +! + subroutine ugwp_tofd1d(levs, sigflt, elvmax, zsurf, zpbl, u, v, & + zmid, utofd, vtofd, epstofd, krf_tofd) + use machine , only : kind_phys + use ugwp_common , only : rcpd2 + use ugwp_oro_init, only : n_tofd, const_tofd, ze_tofd, a12_tofd, ztop_tofd +! + implicit none + integer :: levs + real(kind_phys), dimension(levs) :: u, v, zmid + real(kind_phys) :: sigflt, elvmax, zpbl, zsurf + real(kind_phys), dimension(levs) :: utofd, vtofd, epstofd, krf_tofd +! +! locals +! + integer :: i, k + real :: sghmax = 5. + real :: sgh2, ekin, zdec, rzdec, umag, zmet, zarg, ztexp, krf +! + utofd =0.0 ; vtofd = 0.0 ; epstofd =0.0 ; krf_tofd =0.0 +! + zdec = max(n_tofd*sigflt, zpbl) ! ntimes*sgh_turb or Zpbl + zdec = min(ze_tofd, zdec) ! cannot exceed 18 km + rzdec = 1.0/zdec + sgh2 = max(sigflt*sigflt, sghmax*sghmax) ! 25 meters dz-of the first layer + + do k=1, levs + zmet = zmid(k)-zsurf + if (zmet > ztop_tofd) cycle + ekin = u(k)*u(k) + v(k)*v(k) + umag = sqrt(ekin) + zarg = zmet*rzdec + ztexp = exp(-zarg*sqrt(zarg)) + krf = const_tofd* a12_tofd *sgh2* zmet ** (-1.2) *ztexp + + utofd(k) = -krf*u(k) + vtofd(k) = -krf*v(k) + epstofd(k) = rcpd2*krf*ekin ! more accurate heat/mom form using "implicit tend-solver" + ! to update momentum and temp-re; epstofd(k) can be skipped + krf_tofd(k) = krf + enddo +! + end subroutine ugwp_tofd1d diff --git a/physics/cires_vert_wmsdis.F90 b/physics/cires_vert_wmsdis.F90 new file mode 100644 index 000000000..9e0bbf37c --- /dev/null +++ b/physics/cires_vert_wmsdis.F90 @@ -0,0 +1,425 @@ + subroutine ugwp_wmsdis_naz(levs, ksrc, nw, naz, kxw, taub_lat, ch, xaz, yaz, & + fcor, c2f2, dp, zmid, zint, pmid, pint, rho, ui, vi, ti, & + kvg, ktg, krad, kion, bn2i, bvi, rhoi, ax, ay, eps, ked, tau1) +! +! +! use para_taub, only : tau_ex + use ugwp_common, only : rcpd, grav, rgrav + implicit none +! + integer :: levs + integer :: nw, naz ! # - waves for each azimuth (naz) + integer :: ksrc ! source level + real :: kxw ! horizontal wn + real :: taub_lat ! lat-dep tau_bulk N/m2 +! + real, dimension(nw) :: ch, dch, taub_spect + real, dimension(naz) :: xaz, yaz + real, dimension(levs+1) :: ui, vi, ti, bn2i, bvi, rhoi, zint, pint + real, dimension(levs ) :: dp, rho, pmid, zmid + real :: fcor, c2f2 + real, dimension(levs+1) :: kvg, ktg, kion, krad, kmol + +! output/locals + real, dimension(levs ) :: ax, ay, eps + real, dimension(levs+1) :: ked , tau1 + real, dimension(levs+1 ) :: uaz + + real, dimension(levs, naz ) :: epsd + real, dimension(levs+1, naz ) :: atau, kedd + + real, dimension(levs+1 ) :: taux, tauy, bnrho + real, dimension(levs ) :: dzirho , dzpi + +! + integer :: iaz, k , inc + real, parameter :: gcstar=1.0 + integer , parameter :: nslope=1 + real :: spnorm ! source level normalization factor for the Broad Spectra + real :: bnrhos ! sum(taub_spect*dc) = spnorm taub_sect_norm = taub_spect/spnorm +! + atau=0.0 ; epsd=0.0 ; kedd=0.0 + bnrhos = bvi(ksrc)/rhoi(ksrc) + do k=1,levs + dzpi(k) = zint(k+1)-zint(k) + dzirho(k) = 1.0 / (rho(k)*dzpi(k)) ! grav/abs(dp(k)) still hydrostatic "ugwp" + bnrho(k) = (rhoi(k)/bvi(k)) !*bnrhos * gcstar ! gcstar=1.0 and bnrho(k=ksrc) =1. + enddo + k = levs+1 + bnrho(k) = (rhoi(k)/bvi(k))*bnrhos +! +! re-define ch, dch, taub_spect, this portion can be moved to "ugwp_init" +! +! +! + call FVS93_ugwps(nw, ch, dch, taub_spect, spnorm, nslope, bn2i(ksrc), bvi(ksrc), bnrho(ksrc)) + + +! print *, ' after FVS93_ugwp ', nw, maxval(ch), minval(ch) +! +! do normaalization for the spectral element of the saturated flux +! + bnrho = bnrho *spnorm + +! print * +! do inc=1, nw +! write(6,221) inc, ch(INC),taub_lat*taub_spect(inc), spnorm, dch(inc) +!221 FORMAT( i6, 2x, F8.2, 3(2x, E10.3)) +! enddo +! pause + + loop_iaz: do iaz =1, naz + + do k=1,levs+1 + uaz(k) =ui(k)*xaz(iaz) +vi(k)*yaz(iaz) + enddo +! +! +! multi-wave broad spectrum of FVS-93 with ~scheme of WMS-IFS 2010 +! +! print *, ' iaz before ugwp_wmsdis_az1 ', iaz +! + + call ugwp_wmsdis_az1(levs, ksrc, nw, kxw, ch, dch, taub_spect, taub_lat, & + spnorm, fcor, c2f2, zmid, zint, rho, uaz, ti, bn2i, bvi, rhoi, bnrho, dzirho, dzpi, & + kvg, ktg, krad, kion, kmol, epsd(:, iaz), kedd(:,iaz), atau(:, iaz) ) + +! print *, ' iaz after ugwp_wmsdis_az1 ', iaz + +! + enddo loop_iaz ! azimuth of gw propagation directions +! +! sum over azimuth and project atau(z, iza) =>(taux and tauy) +! for scalars for "wave-drag vector" +! + eps =0. ; ked =0. + do k=ksrc, levs + eps(k) = sum(epsd(k,:))*rcpd + enddo + + do k=ksrc, levs+1 + taux(k) = sum( atau(k,:)*xaz(:)) + tauy(k) = sum( atau(k,:)*yaz(:)) + ked(k) = sum( kedd(k,:)) + enddo +! + tau1(ksrc:levs) = taux(ksrc:levs) + tau1(1:ksrc-1) = tau1(ksrc) + +! end solver: gw_azimuth_solver_ls81 +! sign ax in rho*du/dt = -d(rho*tau)/dz +! [(k) - (k+1)] +! du/dt = ax = -1/rho*d( tau) /dz +! + ax =0. ; ay = 0. + + do k=ksrc, levs + ax(k) = dzirho(k)*(taux(k)-taux(k+1)) + ay(k) = dzirho(k)*(tauy(k)-tauy(k+1)) + enddo + call ugwp_limit_1d(ax, ay, eps, ked, levs) + + return + end subroutine ugwp_wmsdis_naz + + +! ======================================================================= + subroutine ugwp_wmsdis_az1(levs, ksrc, nw, kxw, ch, dch, taub_sp, tau_bulk, & + spnorm, fcor, c2f2, zm, zi, rho, um, tm, bn2, bn, rhoi, bnrho, & + dzirho, dzpi, kvg, ktg, krad, kion, kmol, eps, ked, tau ) +! +! use para_taub, only : tau_ex, xlatdeg !for exchange src-tau +! + use cires_ugwp_module, only : f_coriol, f_nonhyd, f_kds, linsat + use cires_ugwp_module, only : ipr_ktgw, ipr_spgw, ipr_turb, ipr_mol + use cires_ugwp_module, only : rhp4, rhp2, rhp1, khp, cd_ulim +! ======================================================================= + integer :: levs, ksrc, nw + real :: fcor, c2f2, kxw +! + real, dimension(nw) :: taub_sp, ch, dch + real :: tau_bulk, spnorm + real, dimension(levs) :: zm, rho, dzirho, dzpi + real, dimension(levs+1) :: zi, um, tm, bn2, bn, rhoi, bnrho + real, dimension(levs+1) :: kvg, ktg, krad, kion, kmol + real, dimension(levs+1) :: ked, tau + real, dimension(levs ) :: eps +! +!locals + integer :: k, inc + real, dimension(levs+1) :: umi + real :: zcin, zci_min, ztmp, zcinc + real :: zcimin=0.5 ! crit-level precision, 0.5 and start of Ch_MIN + real, parameter :: Keff = 0.2 + + real, dimension(nw) :: zflux ! + real, dimension(nw) :: wzact, zacc ! =1 ..crit level change it + + real, dimension(levs) :: zcrt ! + real, dimension(nw, levs) :: zflux_z, zact + + real :: zdelp, kxw2 + real :: vu_eff, vu_lin, v_kzw, v_cdp, v_wdp, v_kzi + real :: dfsat, fdis, fsat, fmode, expdis + real :: vc_zflx_mode, vm_zflx_mode + real :: tau_g5 +! ======================================================================= +!eps, ked, tau + + eps (:) =0; ked = 0.0 ; + kxw2 = kxw*kxw +! + zcrt(1:levs) = 0.0 + umi(1:levs+1) = um +! umi(1:levs+1) = um(1:levs+1) -um(ksrc) + + zci_min = zcimin + +! CALL slat_geos5(1, xlatdeg(1), tau_g5) +! tau_bulk = tau_g5 !tau_bulk*0.75 !3.75e-2 +! + zflux(:) = taub_sp(:)*tau_bulk ! includes tau_bulk(x,y) and spectral normalization + + zflux_z(1:nw,ksrc)=zflux(:) + + tau(1:levs+1) = tau_bulk ! constant flux for all layers k0.0 ) then +! ztmp = sum( ch(:)*zacc(:)*zflux(:)*dch(:) ) +! zcrt(k)=ztmp/tau(k) +! else +! zcrt( k )=zcrt(k-1) +! endif +! --------------------------------------------------------- +! do saturation (eq. (26) and (27) of scinocca 2003) +! + add molecular/eddy dissipation od gw-spectra vay-2015 +! for each mode & direction +! x by exp(-mi*zdelp) x introduce ....... mi(nw) +! +! mode-loop + add molecular/eddy dissipation od gw-spectra vay-2015 +! + do inc=1,nw + if (zact(inc,k) == 0.0) then + zflux(inc) = 0.0 + zflux_z(inc,k) = zflux(inc) + else + vu_eff = kvg(k) ! + ktg (k) !* ipr_ktgw + vu_lin = kion(k) ! + krad(k) !* ipr_ktgw + vu_eff = 2.e-5*exp(zi(k)/7000.)+.01 + zcin= ch(inc) + +!======================================================================= +! saturated limit wfit = kzw*kzw*kt; wfdt = wfit/(kxw*cx)*betat +! & dissipative kzi = 2.*kzw*(wfdm+wfdt)*dzpi(k) +! define kxw = +!======================================================================= + v_cdp = zcin-umi(k) + v_wdp = kxw*v_cdp + if (v_wdp.gt.0) then + v_kzw = bn(k)/v_cdp !can be non-hydrostatic + v_kzi = abs(( v_kzw*v_kzw*vu_eff + vu_lin) /v_wdp*v_kzw) + expdis = exp(-2.*v_kzi*dzpi(k) ) + else + v_kzi = 0. + expdis = 1.0 + endif + fmode = zflux(inc) + fdis = fmode*expdis ! only dissipation/crit_lev degrades it +!------------------------ +! includes rho/bn /(rhos/bns) *spnorm +!------------------------ + fsat = bnrho(k)* v_cdp*v_cdp /zcin ! expression for saturated flux + ! zfluxs=gcstar*zfct( k)*(zcin-zui( k ))**2/zcin +! flux_tot - sat.flux +! + dfsat= fdis-fsat + if( dfsat > 0.0 ) then +! put sat-n limit + zflux(inc) = fsat + else +! assign dis-ve flux + zflux(inc) =fdis + endif + zflux_z(inc,k)=zflux(inc) + + if (zflux_z(inc,k) > zflux_z(inc,k-1) ) zflux_z(inc,k) = zflux_z(inc,k-1) + + endif + + enddo +! +! integrate over spectral modes zpu(y, z, azimuth) zact( inc, )*zflux( inc, )*[d("zcinc")] +! + tau(k) = sum( zflux_z(:,k)*dch(:)) +!------------------------------------------------------------------------------ +! define expressions for eps-heat + Ked, needs more work for the broad spectra +! formulation especially for Ked +! after defining Ked .....GW-eddy cooling needs to be added +! for now "only" heating here +!============================================================================== + eps(k) =0. + do inc=1, nw + if (zact(inc,k) == 0.0) cycle ! dc-integration + dtau/dz + vc_zflx_mode = zflux(inc) + + zdelp= abs(ch(inc)-umi(k)) * dch(inc) /dzpi(k) + vm_zflx_mode=zflux_z(inc,k-1) + eps(k) =eps( k ) + (vm_zflx_mode-vc_zflx_mode)*zdelp ! heating >0 + + + enddo !inc=1, nw + ked(k) = Keff*eps(k)/bn2(k) +! +! -------------- +! + enddo ! end k do-loop vertical loop do k=ksrc+1, levs + +!top lid + k =levs+1 + ked(k) = ked(k-1) +! eps(k) = eps(k-1) + tau(k) =tau(k-1)*0.933 + +! from surface to ksrc-1 +! tau(1:ksrc) = tau(ksrc) + ked(1:ksrc) = 0. + eps( 1:ksrc) = 0. + +! +! output: eps, ked, tau for given azimuth +! + end subroutine ugwp_wmsdis_az1 +! +! + subroutine FVS93_ugwps(nw, ch, dch, taub_sp, spnorm, nslope, bn2, bn, bnrhos) + implicit none + integer :: nw, nslope + real :: bn2, bn, bnrhos +!! real :: taub_lat ! bulk - lat-dep momentum flux + real, dimension (nw) :: ch, dch, taub_sp +! locals + integer :: i, inc + real, parameter :: zcimin = 0.5, zcimax = 95.0, zgam =1./4. + real, parameter :: zms = 6.28e-3/2. ! mstar Lz ~ 2km + real :: zxran, zxmax, zxmin, zx1, zx2, zdx, ztx, rch + real :: bn3, bn4, zcin, tn4, tn3, tn2, cstar + real :: spnorm ! needs to be passed for saturation flux norm-n + real :: tau_bulk +!-------------------------------------------------------------------- +! +! transforms ch -uniform => 1/ch and back to non-uniform ch, dch +! +!------------------------------------------------------------------- +! note that this is expresed in terms of the intrinsic ch or vertical wn=N/cd +! at launch cd=ch-um(ksrc), the transformation is identical for all +! levels, azimuths and horizontal pixels +! see eq. 28-30 of scinocca 2003. x = 1/c stretching transform +! + zxmax=1.0 /zcimin + zxmin=1.0 /zcimax + zxran=zxmax-zxmin + zdx=zxran/float(nw-1) ! d_kz or d_mi +! +! + zx1=zxran/(exp(zxran/zgam)-1.0 ) !zgam =1./4. + zx2=zxmin-zx1 +! +! add idl computations for zci =1/zx +! x = 1/c stretching transform to look at final ch(i), dch(i) +! + + do i=1, nw + ztx=float(i-1)*zdx+zxmin + rch=zx1*exp((ztx-zxmin)/zgam)+zx2 !eq. 29 of scinocca 2003 + ch(i)=1.0 /rch !eq. 28 of scinocca 2003 + dch(i)=ch(i)*ch(i)*(zx1/zgam)*exp((ztx-zxmin)/zgam)*zdx !eq. 30 of scinocca 2003 + enddo +! +! nslope-dependent flux taub_spect(nw) momentum flux spectral density +! need to check math....expressions +! eq. (25) of scinocca 2003 with u-uo=0 it is identical to all azimuths +! +! + cstar=bn/zms + bn4=bn2*bn2 ! four times + bn3=bn2*bn + if(nslope==1) then +! s=1 case + do inc=1, nw + zcin=ch(inc) + tn4=(zms*zcin)**4 + taub_sp(inc) =bnrhos * zcin*bn4/(bn4+tn4) + enddo +! + elseif(nslope==2) then +! s=2 case + do inc=1, nw + zcin=ch(inc) + tn4=(zms*zcin)**4 + taub_sp(inc)= bnrhos*zcin*bn4/(bn4+tn4*zcin/cstar) + enddo +! + elseif(nslope==-1) then +! s=-1 case + do inc=1, nw + zcin=ch(inc) + tn2=(zms*zcin)**2 + taub_sp(inc)=bnrhos*zcin*bn2/(bn2+tn2) + enddo +! s=0 case + elseif(nslope==0) then + + do inc=1, nw + zcin=ch(inc) + tn3=(zms*zcin)**3 + taub_sp(inc)=bnrhos*zcin*bn3/(bn3+tn3) + enddo + endif ! for n-slopes +!============================================= +! normalize launch momentum flux +! ------------------------------------ +! (rho x f^h = rho_o x f_p^total) integrate (zflux x dx) + + tau_bulk= sum(taub_sp(:)*dch(:)) + spnorm= 1./tau_bulk + + do inc=1, nw + taub_sp(inc)=spnorm*taub_sp(inc) + enddo + + end subroutine FVS93_ugwps + diff --git a/physics/cldmacro.F b/physics/cldmacro.F index 086277f0e..a2d5aeb70 100644 --- a/physics/cldmacro.F +++ b/physics/cldmacro.F @@ -625,8 +625,10 @@ subroutine fix_up_clouds_2M(QV, TE, QLC, QIC, CF, QLA, QIA, AF, & real, intent(inout) :: TE,QV,QLC,CF,QLA,AF,QIC,QIA, NL, NI ! real, parameter :: qmin = 1.0e-8, qmini = 1.0e-7 - real, parameter :: nmin = 1.0e-3, cfmin = 1.0e-5 +! real, parameter :: nmin = 1.0e-3, cfmin = 1.0e-5 + real, parameter :: nmin = 1.0, cfmin = 1.0e-5 &, RI_cub = 6.4e-14, RL_cub = 1.0e-15 + &, fourb3 = 4.0/3.0 if (AF <= cfmin) then ! Fix if Anvil cloud fraction too small QV = QV + QLA + QIA @@ -687,13 +689,13 @@ subroutine fix_up_clouds_2M(QV, TE, QLC, QIC, CF, QLA, QIA, AF, & if (QLA+QLC <= qc_min(1)) then NL = 0.0 elseif (NL <= nmin) then ! make sure NL > 0 if Q >0 - NL = max((QLA+QLC)/( 1.333 * MAPL_PI *RL_cub*997.0), nmin) + NL = max((QLA+QLC)/( fourb3 * MAPL_PI *RL_cub*997.0), nmin) endif if (QIA+QIC <= qc_min(2)) then NI = 0.0 elseif (NI <= nmin) then ! make sure NI > 0 if Q >0 - NI = max((QIA+QIC)/( 1.333 * MAPL_PI *RI_cub*500.0), nmin) + NI = max((QIA+QIC)/( fourb3 * MAPL_PI *RI_cub*500.0), nmin) endif end subroutine fix_up_clouds_2M diff --git a/physics/cnvc90.f b/physics/cnvc90.f index 08dbbbc9d..87d034b77 100644 --- a/physics/cnvc90.f +++ b/physics/cnvc90.f @@ -12,32 +12,15 @@ module cnvc90 subroutine cnvc90_init() end subroutine cnvc90_init -!>\defgroup GFS_cnvc90 GFS cnvc90 Main +!>\defgroup GFS_cnvc90 GFS Convective Cloud Diagnostics Module !> @{ !! This module contains the calculation of fraction of convective cloud, !! pressure at bottom of convective cloud and at top of convective !! cloud. !> \section arg_table_cnvc90_run Argument Table -!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | -!! |----------------|-----------------------------------------------------------------------|---------------------------------------------------------|-------|------|-----------|-----------|--------|----------| -!! | clstp | convective_cloud_switch | switch for saving convective clouds | none | 0 | real | kind_phys | in | F | -!! | im | horizontal_loop_extent | horizontal loop extent | count | 0 | integer | | in | F | -!! | ix | horizontal_dimension | horizontal dimension | count | 0 | integer | | in | F | -!! | rn | lwe_thickness_of_convective_precipitation_amount_on_dynamics_timestep | convective rainfall amount on dynamics timestep | m | 1 | real | kind_phys | in | F | -!! | kbot | vertical_index_at_cloud_base | vertical index at cloud base | index | 1 | integer | | in | F | -!! | ktop | vertical_index_at_cloud_top | vertical index at cloud top | index | 1 | integer | | in | F | -!! | km | vertical_dimension | number of vertical layers | count | 0 | integer | | in | F | -!! | prsi | air_pressure_at_interface | interface pressure | Pa | 2 | real | kind_phys | in | F | -!! | acv | accumulated_lwe_thickness_of_convective_precipitation_amount_cnvc90 | accumulated convective rainfall amount for cnvc90 only | m | 1 | real | kind_phys | inout | F | -!! | acvb | smallest_cloud_base_vertical_index_encountered_thus_far | smallest cloud base vertical index encountered thus far | index | 1 | real | kind_phys | inout | F | -!! | acvt | largest_cloud_top_vertical_index_encountered_thus_far | largest cloud top vertical index encountered thus far | index | 1 | real | kind_phys | inout | F | -!! | cv | fraction_of_convective_cloud | fraction of convective cloud | frac | 1 | real | kind_phys | inout | F | -!! | cvb | pressure_at_bottom_of_convective_cloud | pressure at bottom of convective cloud | Pa | 1 | real | kind_phys | inout | F | -!! | cvt | pressure_at_top_of_convective_cloud | pressure at top of convective cloud | Pa | 1 | real | kind_phys | inout | F | -!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | -!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | +!! \htmlinclude cnvc90_run.html !! -!>\section gen_cnvc90_run GFS cnvc90_run General Algorithm +! \section gen_cnvc_run GFS cnvc90_run General Algorithm SUBROUTINE cnvc90_run(CLSTP,IM,IX,RN,KBOT,KTOP,KM,PRSI, & & ACV,ACVB,ACVT,CV,CVB,CVT,errmsg,errflg) diff --git a/physics/cnvc90.meta b/physics/cnvc90.meta new file mode 100644 index 000000000..57290c9c5 --- /dev/null +++ b/physics/cnvc90.meta @@ -0,0 +1,151 @@ +[ccpp-arg-table] + name = cnvc90_init + type = scheme + +######################################################################## +[ccpp-arg-table] + name = cnvc90_run + type = scheme +[clstp] + standard_name = convective_cloud_switch + long_name = switch for saving convective clouds + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[im] + standard_name = horizontal_loop_extent + long_name = horizontal loop extent + units = count + dimensions = () + type = integer + intent = in + optional = F +[ix] + standard_name = horizontal_dimension + long_name = horizontal dimension + units = count + dimensions = () + type = integer + intent = in + optional = F +[rn] + standard_name = lwe_thickness_of_convective_precipitation_amount_on_dynamics_timestep + long_name = convective rainfall amount on dynamics timestep + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[kbot] + standard_name = vertical_index_at_cloud_base + long_name = vertical index at cloud base + units = index + dimensions = (horizontal_dimension) + type = integer + intent = in + optional = F +[ktop] + standard_name = vertical_index_at_cloud_top + long_name = vertical index at cloud top + units = index + dimensions = (horizontal_dimension) + type = integer + intent = in + optional = F +[km] + standard_name = vertical_dimension + long_name = number of vertical layers + units = count + dimensions = () + type = integer + intent = in + optional = F +[prsi] + standard_name = air_pressure_at_interface + long_name = interface pressure + units = Pa + dimensions = (horizontal_dimension,vertical_dimension_plus_one) + type = real + kind = kind_phys + intent = in + optional = F +[acv] + standard_name = accumulated_lwe_thickness_of_convective_precipitation_amount_cnvc90 + long_name = accumulated convective rainfall amount for cnvc90 only + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[acvb] + standard_name = smallest_cloud_base_vertical_index_encountered_thus_far + long_name = smallest cloud base vertical index encountered thus far + units = index + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[acvt] + standard_name = largest_cloud_top_vertical_index_encountered_thus_far + long_name = largest cloud top vertical index encountered thus far + units = index + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[cv] + standard_name = fraction_of_convective_cloud + long_name = fraction of convective cloud + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[cvb] + standard_name = pressure_at_bottom_of_convective_cloud + long_name = pressure at bottom of convective cloud + units = Pa + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[cvt] + standard_name = pressure_at_top_of_convective_cloud + long_name = pressure at top of convective cloud + units = Pa + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F + +######################################################################## +[ccpp-arg-table] + name = cnvc90_finalize + type = scheme diff --git a/physics/cs_conv.F90 b/physics/cs_conv.F90 index d5c2e1011..956d5a1d0 100644 --- a/physics/cs_conv.F90 +++ b/physics/cs_conv.F90 @@ -16,27 +16,7 @@ end subroutine cs_conv_pre_finalize #if 0 !! \section arg_table_cs_conv_pre_run Argument Table -!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | -!! |-----------------|---------------------------------------------------------------|-------------------------------------------------------------------------------------------------------------------------|---------|------|-----------|-----------|--------|----------| -!! | im | horizontal_dimension | horizontal dimension | count | 0 | integer | | in | F | -!! | levs | vertical_dimension | number of veritcal levels | count | 0 | integer | | in | F | -!! | ntrac | number_of_tracers | number of tracers | count | 0 | integer | | in | F | -!! | ncld | number_of_hydrometeors | number of hydrometeors | count | 0 | integer | | in | F | -!! | q | water_vapor_specific_humidity_updated_by_physics | water vapor specific humidity updated by physics | kg kg-1 | 2 | real | kind_phys | in | F | -!! | clw1 | ice_water_mixing_ratio_convective_transport_tracer | moist (dry+vapor, no condensates) mixing ratio of ice water in the convectively transported tracer array | kg kg-1 | 2 | real | kind_phys | in | F | -!! | clw2 | cloud_condensed_water_mixing_ratio_convective_transport_tracer| moist (dry+vapor, no condensates) mixing ratio of cloud water (condensate) in the convectively transported tracer array | kg kg-1 | 2 | real | kind_phys | in | F | -!! | work1 | grid_size_related_coefficient_used_in_scale-sensitive_schemes | grid size related coefficient used in scale-sensitive schemes | none | 1 | real | kind_phys | in | F | -!! | work2 | grid_size_related_coefficient_used_in_scale-sensitive_schemes_complement | complement to work1 | none | 1 | real | kind_phys | in | F | -!! | cs_parm1 | updraft_velocity_tunable_parameter_1_CS | tunable parameter 1 for Chikira-Sugiyama convection | m s-1 | 0 | real | kind_phys | in | F | -!! | cs_parm2 | updraft_velocity_tunable_parameter_2_CS | tunable parameter 2 for Chikira-Sugiyama convection | m s-1 | 0 | real | kind_phys | in | F | -!! | wcbmax | maximum_updraft_velocity_at_cloud_base | maximum updraft velocity at cloud base | m s-1 | 1 | real | kind_phys | out | F | -!! | fswtr | fraction_of_cloud_top_water_scavenged | fraction of the tracer (cloud top water) that is scavenged by convection | km-1 | 1 | real | kind_phys | out | F | -!! | fscav | fraction_of_tracer_scavenged | fraction of the tracer (aerosols) that is scavenged by convection | km-1 | 1 | real | kind_phys | out | F | -!! | save_q1 | water_vapor_specific_humidity_save | water vapor specific humidity before entering a physics scheme | kg kg-1 | 2 | real | kind_phys | out | F | -!! | save_q2 | cloud_condensed_water_mixing_ratio_save | moist (dry+vapor, no condensates) mixing ratio of cloud water (condensate) before entering a physics scheme | kg kg-1 | 2 | real | kind_phys | out | F | -!! | save_q3 | ice_water_mixing_ratio_save | cloud ice water mixing ratio before entering a physics scheme | kg kg-1 | 2 | real | kind_phys | out | F | -!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | -!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | +!! \htmlinclude cs_conv_pre_run.html !! #endif subroutine cs_conv_pre_run(im, levs, ntrac, ncld, q, clw1, clw2, & @@ -110,15 +90,7 @@ end subroutine cs_conv_post_finalize !! !! \section arg_table_cs_conv_post_run Argument Table -!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | -!! |------------|-----------------------------------------------------------------|--------------------------------------------------------------------------|------------|------|-----------|-----------|--------|----------| -!! | im | horizontal_dimension | horizontal dimension | count | 0 | integer | | in | F | -!! | kmax | vertical_dimension | number of veritcal levels | count | 0 | integer | | in | F | -!! | do_aw | flag_for_Arakawa_Wu_adjustment | flag for Arakawa Wu scale-aware adjustment | flag | 0 | logical | | in | F | -!! | sigmatot | convective_updraft_area_fraction_at_model_interfaces | convective updraft area fraction at model interfaces | frac | 2 | real | kind_phys | in | F | -!! | sigmafrac | convective_updraft_area_fraction | convective updraft area fraction | frac | 2 | real | kind_phys | out | F | -!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | -!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | +!! \htmlinclude cs_conv_post_run.html !! subroutine cs_conv_post_run(im, kmax, do_aw, sigmatot, sigmafrac, errmsg, errflg) @@ -209,9 +181,9 @@ module cs_conv ! spblcrit=0.03, & !< minimum cloudbase height in p/ps ! spblcrit=0.035,& !< minimum cloudbase height in p/ps ! spblcrit=0.025,& !< minimum cloudbase height in p/ps - cincrit=-150.0 -! cincrit=-120.0 -! cincrit=-100.0 + cincrit= -150.0 +! cincrit= -120.0 +! cincrit= -100.0 !DD precz0 and preczh control partitioning of water between detrainment !DD and precipitation. Decrease for more precip @@ -256,7 +228,7 @@ end subroutine cs_conv_init subroutine cs_conv_finalize() end subroutine cs_conv_finalize -!>\defgroup cs_scheme CPT Chikira-Sugiyama Cumulus Scheme Module +!>\defgroup cs_scheme Chikira-Sugiyama Cumulus Scheme Module !> \brief The subroutine contains the main driver for Chikira-Sugiyama convective scheme. !! !! \author Minoru Chikira @@ -313,61 +285,7 @@ end subroutine cs_conv_finalize !! and long_name as the other convective schemes, where the units are in kg/m2. (Aug 2018) !! !! \section arg_table_cs_conv_run Argument Table -!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | -!! |------------|-----------------------------------------------------------|-------------------------------------------------------------------------------------------------------|------------|------|-----------|-----------|--------|----------| -!! | im | horizontal_dimension | horizontal dimension | count | 0 | integer | | in | F | -!! | ijsdim | horizontal_loop_extent | horizontal loop extent | count | 0 | integer | | in | F | -!! | kmax | vertical_dimension | number of veritcal levels | count | 0 | integer | | in | F | -!! | ntracp1 | number_of_tracers_plus_one | number of tracers plus one | count | 0 | integer | | in | F | -!! | nn | number_of_tracers_for_convective_transport | number of tracers for convective transport (used to dimension clw) | count | 0 | integer | | in | F | -!! | ntr | number_of_tracers_for_CS | number of convectively transported tracers in Chikira-Sugiyama deep conv. scheme | count | 0 | integer | | in | F | -!! | nctp | number_of_cloud_types_CS | number of cloud types in Chikira-Sugiyama scheme | count | 0 | integer | | in | F | -!! | otspt | flag_convective_tracer_transport | flag to enable tracer transport by updrafts/downdrafts[(:,1)] or subsidence [(:,2)] | flag | 2 | logical | | in | F | -!! | lat | latitude_index_in_debug_printouts | latitude index in debug printouts | index | 0 | integer | | in | F | -!! | kdt | index_of_time_step | current forecast iteration | index | 0 | integer | | in | F | -!! | t | air_temperature_updated_by_physics | mid-layer temperature | K | 2 | real | kind_phys | inout | F | -!! | q | water_vapor_specific_humidity_updated_by_physics | mid-layer specific humidity of water vapor | kg kg-1 | 2 | real | kind_phys | inout | F | -!! | rain1 | lwe_thickness_of_deep_convective_precipitation_amount | deep convective rainfall amount on physics timestep | m | 1 | real | kind_phys | out | F | -!! | clw | convective_transportable_tracers | array to contain cloud water and other convective trans. tracers | kg kg-1 | 3 | real | kind_phys | inout | F | -!! | zm | geopotential | mid-layer geopotential | m2 s-2 | 2 | real | kind_phys | in | F | -!! | zi | geopotential_at_interface | interface geopotential | m2 s-2 | 2 | real | kind_phys | in | F | -!! | pap | air_pressure | mid-layer pressure | Pa | 2 | real | kind_phys | in | F | -!! | paph | air_pressure_at_interface | interface pressure | Pa | 2 | real | kind_phys | in | F | -!! | delta | time_step_for_physics | physics time step | s | 0 | real | kind_phys | in | F | -!! | delti | time_step_for_dynamics | dynamics time step | s | 0 | real | kind_phys | in | F | -!! | ud_mf | instantaneous_atmosphere_updraft_convective_mass_flux | (updraft mass flux) * delt | kg m-2 | 2 | real | kind_phys | inout | F | -!! | dd_mf | instantaneous_atmosphere_downdraft_convective_mass_flux | (downdraft mass flux) * delt | kg m-2 | 2 | real | kind_phys | inout | F | -!! | dt_mf | instantaneous_atmosphere_detrainment_convective_mass_flux | (detrainment mass flux) * delt | kg m-2 | 2 | real | kind_phys | inout | F | -!! | u | x_wind_updated_by_physics | mid-layer zonal wind | m s-1 | 2 | real | kind_phys | inout | F | -!! | v | y_wind_updated_by_physics | mid-layer meridional wind | m s-1 | 2 | real | kind_phys | inout | F | -!! | fscav | fraction_of_tracer_scavenged | fraction of the tracer (aerosols) that is scavenged by convection | km-1 | 1 | real | kind_phys | in | F | -!! | fswtr | fraction_of_cloud_top_water_scavenged | fraction of the tracer (cloud top water) that is scavenged by convection | km-1 | 1 | real | kind_phys | in | F | -!! | cbmfx | cloud_base_mass_flux | cloud base mass flux | kg m-2 s-1 | 2 | real | kind_phys | inout | F | -!! | mype | mpi_rank | current MPI rank | index | 0 | integer | | in | F | -!! | wcbmaxm | maximum_updraft_velocity_at_cloud_base | maximum updraft velocity at cloud base | m s-1 | 1 | real | kind_phys | in | F | -!! | precz0in | detrainment_and_precipitation_tunable_parameter_3_CS | partition water between detrainment and precipitation (decrease for more precipitation) | m | 0 | real | kind_phys | in | F | -!! | preczhin | detrainment_and_precipitation_tunable_parameter_4_CS | partition water between detrainment and precipitation (decrease for more precipitation) | m | 0 | real | kind_phys | in | F | -!! | clmdin | entrainment_efficiency_tunable_parameter_9_CS | entrainment efficiency | none | 0 | real | kind_phys | in | F | -!! | sigma | convective_updraft_area_fraction_at_model_interfaces | convective updraft area fraction at model interfaces | frac | 2 | real | kind_phys | out | F | -!! | do_aw | flag_for_Arakawa_Wu_adjustment | flag for Arakawa Wu scale-aware adjustment | flag | 0 | logical | | in | F | -!! | do_awdd | flag_arakawa_wu_downdraft | flag to enable treating convective tendencies following Arakwaw-Wu for downdrafts (2013) | flag | 0 | logical | | in | F | -!! | flx_form | flag_flux_form_CS | flag to enable using the flux form of the equations in CS scheme | flag | 0 | logical | | in | F | -!! | lprnt | flag_print | control flag for diagnostic print out | flag | 0 | logical | | in | F | -!! | ipr | horizontal_index_of_printed_column | horizontal index of printed column | index | 0 | integer | | in | F | -!! | kcnv | flag_deep_convection | flag indicating whether convection occurs in column | flag | 1 | integer | | inout | F | -!! | qlcn | mass_fraction_of_convective_cloud_liquid_water | mass fraction of convective cloud liquid water | kg kg-1 | 2 | real | kind_phys | out | F | -!! | qicn | mass_fraction_of_convective_cloud_ice | mass fraction of convective cloud ice water | kg kg-1 | 2 | real | kind_phys | out | F | -!! | w_upi | vertical_velocity_for_updraft | vertical velocity for updraft | m s-1 | 2 | real | kind_phys | out | F | -!! | cf_upi | convective_cloud_fraction_for_microphysics | convective cloud fraction for microphysics | frac | 2 | real | kind_phys | out | F | -!! | cnv_mfd | detrained_mass_flux | detrained mass flux | kg m-2 s-1 | 2 | real | kind_phys | out | F | -!! | cnv_dqldt | tendency_of_cloud_water_due_to_convective_microphysics | tendency of cloud water due to convective microphysics | kg m-2 s-1 | 2 | real | kind_phys | out | F | -!! | clcn | convective_cloud_volume_fraction | convective cloud volume fraction | frac | 2 | real | kind_phys | out | F | -!! | cnv_fice | ice_fraction_in_convective_tower | ice fraction in convective tower | frac | 2 | real | kind_phys | out | F | -!! | cnv_ndrop | number_concentration_of_cloud_liquid_water_particles_for_detrainment | droplet number concentration in convective detrainment | m-3 | 2 | real | kind_phys | out | F | -!! | cnv_nice | number_concentration_of_ice_crystals_for_detrainment | crystal number concentration in convective detrainment | m-3 | 2 | real | kind_phys | out | F | -!! | mp_phys | flag_for_microphysics_scheme | flag for microphysics scheme | flag | 0 | integer | | in | F | -!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | -!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | +!! \htmlinclude cs_conv_run.html !! !! \section general_cs_conv CS Convection Scheme General Algorithm !> @{ @@ -390,15 +308,15 @@ subroutine cs_conv_run(IM , IJSDIM , KMAX , ntracp1 , NN, & ! ! input arguments ! - INTEGER, INTENT(IN) :: IM,IJSDIM, KMAX, ntracp1, NN, NTR, mype, nctp, mp_phys, kdt, lat !! DD, for GFS, pass in - logical, intent(in) :: otspt(ntracp1,2) ! otspt(:,1) - on/off switch for tracer transport by updraft and - ! downdraft. should not include subgrid PDF and turbulence - ! otspt(:,2) - on/off switch for tracer transport by subsidence - ! should include subgrid PDF and turbulence + INTEGER, INTENT(IN) :: IM,IJSDIM, KMAX, ntracp1, nn, NTR, mype, nctp, mp_phys, kdt, lat !! DD, for GFS, pass in + logical, intent(in) :: otspt(1:ntracp1,1:2)! otspt(:,1) - on/off switch for tracer transport by updraft and + ! downdraft. should not include subgrid PDF and turbulence + ! otspt(:,2) - on/off switch for tracer transport by subsidence + ! should include subgrid PDF and turbulence real(r8), intent(inout) :: t(IM,KMAX) ! temperature at mid-layer (K) real(r8), intent(inout) :: q(IM,KMAX) ! water vapor array including moisture (kg/kg) - real(r8), intent(inout) :: clw(IM,KMAX,NN) ! tracer array including cloud condensate (kg/kg) + real(r8), intent(inout) :: clw(IM,KMAX,nn) ! tracer array including cloud condensate (kg/kg) real(r8), intent(in) :: pap(IM,KMAX) ! pressure at mid-layer (Pa) real(r8), intent(in) :: paph(IM,KMAX+1) ! pressure at boundaries (Pa) real(r8), intent(in) :: zm(IM,KMAX) ! geopotential at mid-layer (m) @@ -408,7 +326,7 @@ subroutine cs_conv_run(IM , IJSDIM , KMAX , ntracp1 , NN, & ! added for cs_convr real(r8), intent(inout) :: u(IM,KMAX) ! zonal wind at mid-layer (m/s) real(r8), intent(inout) :: v(IM,KMAX) ! meridional wind at mid-layer (m/s) - + real(r8), intent(in) :: DELTA ! physics time step real(r8), intent(in) :: DELTI ! dynamics time step (model time increment in seconds) logical, intent(in) :: do_aw, do_awdd, flx_form @@ -423,9 +341,13 @@ subroutine cs_conv_run(IM , IJSDIM , KMAX , ntracp1 , NN, & real(r8), intent(inout), dimension(IJSDIM,KMAX) :: ud_mf, dd_mf, dt_mf real(r8), intent(out) :: rain1(IJSDIM) ! lwe thickness of deep convective precipitation amount (m) - real(r8), intent(out), dimension(ijsdim,kmax) :: qlcn, qicn, w_upi,cnv_mfd, & +! GJF* These variables are conditionally allocated depending on whether the +! Morrison-Gettelman microphysics is used, so they must be declared +! using assumed shape. + real(r8), intent(out), dimension(:,:) :: qlcn, qicn, w_upi,cnv_mfd, & cnv_dqldt, clcn, cnv_fice, & cnv_ndrop, cnv_nice, cf_upi +! *GJF integer, intent(inout) :: kcnv(im) ! zero if no deep convection and 1 otherwise character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -531,13 +453,15 @@ subroutine cs_conv_run(IM , IJSDIM , KMAX , ntracp1 , NN, & enddo !DD following adapted from ras -!> -# Following RAS, separate total condensate to ice/water separately -!! - The ratio of ice cloud to cloud water is determined by a linear function +!> -# Following the Relaxed Arakawa Schubert Scheme (RAS; +!! Moorthi and Suarez 1992 \cite moorthi_and_suarez_1992 ), +!! separate total condensate between ice and water. +!! The ratio of cloud ice to cloud water is determined by a linear function !! of temperature: !!\f[ !! F_i(T)= (T_2-T)/(T_2-T_1) !!\f] -!! where T is temperature; \f$T_1\f$ and \f$T_2\f$ are set as tcf=263.16 +!! where T is temperature, and\f$T_1\f$ and \f$T_2\f$ are set as tcf=263.16 !! and tf= 233.16 if (clw(1,1,2) <= -999.0) then ! input ice/water are together do k=1,kmax @@ -572,7 +496,7 @@ subroutine cs_conv_run(IM , IJSDIM , KMAX , ntracp1 , NN, & ! !*************************************************************************************** ! -!> -# Calculate temperature at interfaces. +!> -# Calculate temperature at interfaces ! DO K=2,KMAX @@ -589,7 +513,7 @@ subroutine cs_conv_run(IM , IJSDIM , KMAX , ntracp1 , NN, & GDTM(I,1) = GDT(I,1) ! Is this a good approximation ? - Moorthi ENDDO -!> -# Initialize the sigma diagnostics. +!> -# Initialize the sigma diagnostics do n=1,nctp do k=1,kmax do i=ists,iens @@ -603,7 +527,7 @@ subroutine cs_conv_run(IM , IJSDIM , KMAX , ntracp1 , NN, & enddo enddo ! -!> -# Call cs_cumlus() for CS cumulus parameterization. +!> -# Call cs_cumlus() for the main CS cumulus parameterization call CS_CUMLUS (im , IJSDIM, KMAX , NTR , & !DD dimensions otspt(1:ntr,1), otspt(1:ntr,2), & lprnt , ipr , & @@ -736,7 +660,7 @@ subroutine cs_conv_run(IM , IJSDIM , KMAX , ntracp1 , NN, & endif enddo -!> -# Multiplying mass fluxes by the time step +!> -# Multiply mass fluxes by the time step do k=1,kmax do i=1,ijsdim @@ -768,7 +692,7 @@ end subroutine cs_conv_run !************************************************************************ !>\ingroup cs_scheme -!! This subroutine includes cumulus parameterization with +!! Main subroutine for the cumulus parameterization with !! state-dependent entrainment rate developed by Minoru Chikira. !! !! - This routine works as the prognostic Arakawa-Schubert scheme @@ -777,7 +701,7 @@ end subroutine cs_conv_run !! - Specify OPT_CUMBGT to check water and energy budget. !! - Specify OPT_CUMCHK to check range of output values. !! -!! History: +!! History(yy/mm/dd): !! - 08/09/19(chikira) MIROC4.1 !! - 08/10/30(hiro) CMT modified !! - 08/11/11(chikira) Neggers et al. (2002) @@ -1102,8 +1026,8 @@ SUBROUTINE CS_CUMLUS (im , IJSDIM, KMAX , NTR , & !DD dimensions enddo enddo !> -# Compute layer saturate moisture \f$Q_i\f$(GDQS) and -!! saturate moist static energy GDHS (see appendix B in -!! Chirika and Sugiyama (2010) \cite Chikira_2010) +!! saturate moist static energy (GDHS; see Appendix B in +!! Chikira and Sugiyama (2010) \cite Chikira_2010) DO K=1,KMAX DO I=ISTS,IENS esat = min(gdp(i,k), fpvs(gdt(i,k))) @@ -1137,7 +1061,7 @@ SUBROUTINE CS_CUMLUS (im , IJSDIM, KMAX , NTR , & !DD dimensions !DDsigma - arguments added to get subcloud profiles in updraft ! so AW eddy flux tendencies can be computed -!> -# Call cumbas() to compute cloud base properties. +!> -# Call cumbas() to compute cloud base properties CALL CUMBAS(IJSDIM, KMAX , & !DD dimensions KB , GCYM(1,1,1) , KBMX , & ! output ntr , ntrq , & @@ -1150,7 +1074,7 @@ SUBROUTINE CS_CUMLUS (im , IJSDIM, KMAX , NTR , & !DD dimensions ISTS , IENS , & !) ! input gctbl, gcqbl,gdq,gcwbl, gcqlbl, gcqibl, gctrbl) ! sub cloud tendencies ! -!> -# Compute CAPE and CIN. +!> -# Compute CAPE and CIN ! DO I=ISTS,IENS CAPE(i) = zero @@ -1165,12 +1089,12 @@ SUBROUTINE CS_CUMLUS (im , IJSDIM, KMAX , NTR , & !DD dimensions ELSE BUOY = (GDS(I,1)-GDS(I,K)) / (CP*GDT(I,K)) END IF - IF (BUOY > zero .AND. JBUOY(I) /= 0) THEN + IF (BUOY > zero .AND. JBUOY(I) >= -1) THEN CAPE(I) = CAPE(I) + BUOY * GRAV * (GDZM(I,K+1) - GDZM(I,K)) JBUOY(I) = 2 ELSEIF (BUOY < zero .AND. JBUOY(I) /= 2) THEN CIN(I) = CIN(I) - BUOY * GRAV * (GDZM(I,K+1) - GDZM(I,K)) - JBUOY(I) = 1 + JBUOY(I) = -1 ENDIF endif ENDDO @@ -1181,7 +1105,7 @@ SUBROUTINE CS_CUMLUS (im , IJSDIM, KMAX , NTR , & !DD dimensions ENDDO !DDsigma some initialization before summing over cloud type -!> -# Initialization before summing over cloud type +!> -# Initialize variables before summing over cloud types do k=1,kmax ! Moorthi do i=1,ijsdim lamdaprod(i,k) = one @@ -1221,7 +1145,7 @@ SUBROUTINE CS_CUMLUS (im , IJSDIM, KMAX , NTR , & !DD dimensions ! before and after CUMUP (i.e. here), and inside the routine, in ! particular: gctm, gcqm, gcwm, gchm, gcwt, gclm, gcim,gctrm ! also, inside, check that no reads/writes out of bounds occur *DH -!> -# Call cumup() to compute in-cloud properties. +!> -# Call cumup() to compute in-cloud properties CALL CUMUP(IJSDIM, KMAX, NTR, ntrq, & !DD dimensions ACWF , & ! output GCLZ , GCIZ , GPRCIZ , GSNWIZ, & ! output @@ -1242,7 +1166,7 @@ SUBROUTINE CS_CUMLUS (im , IJSDIM, KMAX , NTR , & !DD dimensions gctm , gcqm, gcwm, gchm, gcwt, gclm, gcim, gctrm, & ! additional incloud profiles and cloud top total water lprnt , ipr ) ! -!> -# Call cumbmx() to compute cloud base mass flux. +!> -# Call cumbmx() to compute cloud base mass flux CALL CUMBMX(IJSDIM, KMAX, & !DD dimensions CBMFX(1,CTP), & ! modified ACWF , GCYT(1,CTP), GDZM , & ! input @@ -1255,7 +1179,7 @@ SUBROUTINE CS_CUMLUS (im , IJSDIM, KMAX , NTR , & !DD dimensions do i=ISTS,IENS if (flx_form) then -!> -# Initialize eddy fluxes for cloud type ctp +!> -# Initialize eddy fluxes for cloud types do k=1,kmax+1 sfluxtem(k) = zero qvfluxtem(k) = zero @@ -1278,7 +1202,7 @@ SUBROUTINE CS_CUMLUS (im , IJSDIM, KMAX , NTR , & !DD dimensions km1 = k - 1 rhs_h = zero rhs_q = zero -!> -# Get environment variables interpolated to layer interface +!> -# Interpolate environment variables to layer interface GDQM = half * (GDQ(I,K,1) + GDQ(I,KM1,1)) ! as computed in cumup ! GDwM = half * (GDw(I,K) + GDw(I,KM1 )) GDlM = half * (GDQ(I,K,3) + GDQ(I,KM1,3)) @@ -1290,9 +1214,9 @@ SUBROUTINE CS_CUMLUS (im , IJSDIM, KMAX , NTR , & !DD dimensions if (do_aw) then -!> -# Compute lamda for a cloud type (eqn 23 of Arakawa and Wu (2013)), -!! and then updraft area fraction -!! (sigmai, eqn 12 of Arakawa and We (2013)) +!> -# Compute lamda for a cloud type and then updraft area fraction +!! (sigmai) following Equations 23 and 12 of +!! Arakawa and Wu (2013) \cite arakawa_and_wu_2013 , respectively lamdai = mflx_e * rair * gdtm(i,k)*(one+epsvt*gdqm) & / (gdpm(i,k)*wcv(i,k)) @@ -1314,7 +1238,7 @@ SUBROUTINE CS_CUMLUS (im , IJSDIM, KMAX , NTR , & !DD dimensions ! fsigma = 1.0 ! no aw effect, comment following lines to undo AW fsigma = one - sigma(i,k) -!> -# Compute tendencies based on mass flux, and tendencies based on condensation +!> -# Compute tendencies based on mass flux and condensation ! fsigma is the AW reduction of flux tendencies if(k == kbi) then @@ -1424,8 +1348,8 @@ SUBROUTINE CS_CUMLUS (im , IJSDIM, KMAX , NTR , & !DD dimensions ! rhs_q = cbmfl*((gcwt(i)-gcqt(i,ctp)) - (gcym(i,k-1)*(gcwm(i,k-1)-gcqm(i,k-1)) + (GDw( I,K-1 )-gdq(i,k-1,1))*(gcyt(i,ctp)-gcym(i,k-1))) ) ! endif -!> -# Compute condesation, total precip production, frozen precip production, -!! heating due to freezing and total temperature tendency due to in cloud microphysics +!> -# Compute condensation, total precipitation production, frozen precipitation production, +!! heating due to freezing, and total temperature tendency due to in-cloud microphysics dqcondtem(i,km1) = -rhs_q ! condensation ! dqprectem(i,km1) = cbmfl * (GPRCIZ(i,k) + GSNWIZ(i,k)) dqprectem(i,km1) = tem * (GPRCIZ(i,k) + GSNWIZ(i,k)) ! total precip production @@ -1453,7 +1377,7 @@ SUBROUTINE CS_CUMLUS (im , IJSDIM, KMAX , NTR , & !DD dimensions prectermfrz(i,k) = prectermfrz(i,k) + dfrzprectem(i,k) * delpinv frzterm(i,k) = frzterm(i,k) + dtfrztem(i,k) * delpinv -!> -# Compute flux tendencies - compute the vertical flux divergence +!> -# Compute flux tendencies and vertical flux divergence sfluxterm(i,k) = sfluxterm(i,k) - (sfluxtem(k+1) - sfluxtem(k)) * delpinv qvfluxterm(i,k) = qvfluxterm(i,k) - (qvfluxtem(k+1) - qvfluxtem(k)) * delpinv qlfluxterm(i,k) = qlfluxterm(i,k) - (qlfluxtem(k+1) - qlfluxtem(k)) * delpinv @@ -1501,7 +1425,7 @@ SUBROUTINE CS_CUMLUS (im , IJSDIM, KMAX , NTR , & !DD dimensions enddo ! -!> -# Call cumflx() to compute Cloud Mass Flux & Precip. +!> -# Call cumflx() to compute cloud mass flux and precipitation CALL CUMFLX(IM , IJSDIM, KMAX , & !DD dimensions GMFX0 , GPRCI , GSNWI , CMDET, & ! output QLIQ , QICE , GTPRC0, & ! output @@ -1561,7 +1485,8 @@ SUBROUTINE CS_CUMLUS (im , IJSDIM, KMAX , NTR , & !DD dimensions enddo enddo -!> -# Call cumdwn() to compute cumulus downdraft - Melt & Freeze & Evaporation. +!> -# Call cumdwn() to compute cumulus downdraft and assocated melt, freeze +!! and evaporation CALL CUMDWN(IM , IJSDIM, KMAX , NTR , ntrq , & ! DD dimensions GTT , GTQ , GTU , GTV , & ! modified GMFLX , & ! modified updraft+downdraft flux @@ -1585,7 +1510,7 @@ SUBROUTINE CS_CUMLUS (im , IJSDIM, KMAX , NTR , & !DD dimensions ! enddo ! enddo -!> -# Call cumsbw() to compute cloud subsidence heating. +!> -# Call cumsbw() to compute cloud subsidence heating if (.not. flx_form) then ! Cloud Subsidence Heating ! -----------------------= @@ -1655,7 +1580,7 @@ SUBROUTINE CS_CUMLUS (im , IJSDIM, KMAX , NTR , & !DD dimensions ENDDO ! if(do_aw .and. flx_form) then ! compute AW tendencies -!> -# Compute AW tendencies of T/ql/qi +!> -# Compute AW tendencies of T, ql and qi if(flx_form) then ! compute AW tendencies ! AW lump all heating together, compute qv term do k=1,kmax @@ -1733,7 +1658,7 @@ SUBROUTINE CS_CUMLUS (im , IJSDIM, KMAX , NTR , & !DD dimensions ! enddo ! enddo ! -!> -# Call cumfxr() for tracer mass fixer without detrainment. +!> -# Call cumfxr() for tracer mass fixer without detrainment CALL CUMFXR(IM , IJSDIM, KMAX , NTR , & !DD dimensions GTQ , & ! modified GDQ , DELP , DELTA , KTMXT , IMFXR, & ! input @@ -1856,7 +1781,7 @@ END SUBROUTINE CS_CUMLUS !*********************************************************************** !>\ingroup cs_scheme !! This subroutine calculates cloud base properties. - SUBROUTINE CUMBAS & !< cloud base + SUBROUTINE CUMBAS & ! cloud base ( IJSDIM, KMAX , & !DD dimensions KB , GCYM , KBMX , & ! output ntr , ntrq , & @@ -1878,15 +1803,15 @@ SUBROUTINE CUMBAS & !< cloud base logical lprnt ! ! [OUTPUT] - INTEGER KB (IJSDIM) !< cloud base - REAL(r8) GCYM (IJSDIM, KMAX) !< norm. mass flux (half lev) + INTEGER KB (IJSDIM) ! cloud base + REAL(r8) GCYM (IJSDIM, KMAX) ! norm. mass flux (half lev) INTEGER KBMX - REAL(r8) GCHB (IJSDIM) !< cloud base MSE - REAL(r8) GCWB (IJSDIM) !< cloud base total water - REAL(r8) GCUB (IJSDIM) !< cloud base U - REAL(r8) GCVB (IJSDIM) !< cloud base V - REAL(r8) GCIB (IJSDIM) !< cloud base ice - REAL(r8) GCtrB (IJSDIM,ntrq:ntr) !< cloud base tracer + REAL(r8) GCHB (IJSDIM) ! cloud base MSE + REAL(r8) GCWB (IJSDIM) ! cloud base total water + REAL(r8) GCUB (IJSDIM) ! cloud base U + REAL(r8) GCVB (IJSDIM) ! cloud base V + REAL(r8) GCIB (IJSDIM) ! cloud base ice + REAL(r8) GCtrB (IJSDIM,ntrq:ntr) ! cloud base tracer !DDsigma added to arglist for AW, subcloud updraft profiles: temperature, water vapor ! total water, cloud water, and cloud ice respectively @@ -1894,22 +1819,22 @@ SUBROUTINE CUMBAS & !< cloud base REAL(r8), dimension(ijsdim,kmax,ntrq:ntr) :: gctrbl !DDsigmadiag ! ! [INPUT] - REAL(r8) GDH (IJSDIM, KMAX) !< moist static energy - REAL(r8) GDW (IJSDIM, KMAX) !< total water - REAL(r8) GDq (IJSDIM, KMAX, ntr) !< water vapor and tracer - REAL(r8) GDHS (IJSDIM, KMAX) !< saturate MSE - REAL(r8) GDQS (IJSDIM, KMAX) !< saturate humidity - REAL(r8) GDQI (IJSDIM, KMAX) !< cloud ice - REAL(r8) GDU (IJSDIM, KMAX) !< u-velocity - REAL(r8) GDV (IJSDIM, KMAX) !< v-velocity - REAL(r8) GDZM (IJSDIM, KMAX+1) !< Altitude (half lev) - REAL(r8) GDPM (IJSDIM, KMAX+1) !< pressure (half lev) + REAL(r8) GDH (IJSDIM, KMAX) ! moist static energy + REAL(r8) GDW (IJSDIM, KMAX) ! total water + REAL(r8) GDq (IJSDIM, KMAX, ntr) ! water vapor and tracer + REAL(r8) GDHS (IJSDIM, KMAX) ! saturate MSE + REAL(r8) GDQS (IJSDIM, KMAX) ! saturate humidity + REAL(r8) GDQI (IJSDIM, KMAX) ! cloud ice + REAL(r8) GDU (IJSDIM, KMAX) ! u-velocity + REAL(r8) GDV (IJSDIM, KMAX) ! v-velocity + REAL(r8) GDZM (IJSDIM, KMAX+1) ! Altitude (half lev) + REAL(r8) GDPM (IJSDIM, KMAX+1) ! pressure (half lev) REAL(r8) FDQS (IJSDIM, KMAX) REAL(r8) GAM (IJSDIM, KMAX) INTEGER ISTS, IENS ! ! [INTERNAL WORK] - REAL(r8) CBASE (IJSDIM) !< one over cloud base height + REAL(r8) CBASE (IJSDIM) ! one over cloud base height ! REAL(r8) CBASEP(IJSDIM) ! cloud base pressure REAL(r8) DELZ, GAMX, wrk ! REAL(r8) DELZ, QSL, GAMX, wrk @@ -3932,7 +3857,7 @@ SUBROUTINE CUMSBR & !! Tracer Subsidence END SUBROUTINE CUMSBR !********************************************************************* !>\ingroup cs_scheme -!! This subroutine calculates tracer mass fixer without deterainment +!! This subroutine calculates tracer mass fixer without detrainment. SUBROUTINE CUMFXR & ! Tracer mass fixer ( IM , IJSDIM, KMAX , NTR , & !DD dimensions GTR , & ! modified diff --git a/physics/cs_conv.meta b/physics/cs_conv.meta new file mode 100644 index 000000000..d499885c7 --- /dev/null +++ b/physics/cs_conv.meta @@ -0,0 +1,726 @@ +[ccpp-arg-table] + name = cs_conv_pre_init + type = scheme + +######################################################################## +[ccpp-arg-table] + name = cs_conv_pre_finalize + type = scheme + +######################################################################## +[ccpp-arg-table] + name = cs_conv_pre_run + type = scheme +[im] + standard_name = horizontal_dimension + long_name = horizontal dimension + units = count + dimensions = () + type = integer + intent = in + optional = F +[levs] + standard_name = vertical_dimension + long_name = number of veritcal levels + units = count + dimensions = () + type = integer + intent = in + optional = F +[ntrac] + standard_name = number_of_tracers + long_name = number of tracers + units = count + dimensions = () + type = integer + intent = in + optional = F +[ncld] + standard_name = number_of_hydrometeors + long_name = number of hydrometeors + units = count + dimensions = () + type = integer + intent = in + optional = F +[q] + standard_name = water_vapor_specific_humidity_updated_by_physics + long_name = water vapor specific humidity updated by physics + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[clw1] + standard_name = ice_water_mixing_ratio_convective_transport_tracer + long_name = ratio of mass of ice water to mass of dry air plus vapor (without condensates) in the convectively transported tracer array + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[clw2] + standard_name = cloud_condensed_water_mixing_ratio_convective_transport_tracer + long_name = ratio of mass of cloud water to mass of dry air plus vapor (without condensates) in the convectively transported tracer array + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[work1] + standard_name = grid_size_related_coefficient_used_in_scale_sensitive_schemes + long_name = grid size related coefficient used in scale-sensitive schemes + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[work2] + standard_name = grid_size_related_coefficient_used_in_scale_sensitive_schemes_complement + long_name = complement to work1 + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[cs_parm1] + standard_name = updraft_velocity_tunable_parameter_1_CS + long_name = tunable parameter 1 for Chikira-Sugiyama convection + units = m s-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[cs_parm2] + standard_name = updraft_velocity_tunable_parameter_2_CS + long_name = tunable parameter 2 for Chikira-Sugiyama convection + units = m s-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[wcbmax] + standard_name = maximum_updraft_velocity_at_cloud_base + long_name = maximum updraft velocity at cloud base + units = m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[fswtr] + standard_name = fraction_of_cloud_top_water_scavenged + long_name = fraction of the tracer (cloud top water) that is scavenged by convection + units = km-1 + dimensions = (number_of_tracers_scavenged) + type = real + kind = kind_phys + intent = out + optional = F +[fscav] + standard_name = fraction_of_tracer_scavenged + long_name = fraction of the tracer (aerosols) that is scavenged by convection + units = km-1 + dimensions = (number_of_tracers_scavenged) + type = real + kind = kind_phys + intent = out + optional = F +[save_q1] + standard_name = water_vapor_specific_humidity_save + long_name = water vapor specific humidity before entering a physics scheme + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[save_q2] + standard_name = cloud_condensed_water_mixing_ratio_save + long_name = ratio of mass of cloud water to mass of dry air plus vapor (without condensates) before entering a physics scheme + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[save_q3] + standard_name = ice_water_mixing_ratio_save + long_name = cloud ice water mixing ratio before entering a physics scheme + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F + +######################################################################## +[ccpp-arg-table] + name = cs_conv_post_init + type = scheme + +######################################################################## +[ccpp-arg-table] + name = cs_conv_post_finalize + type = scheme + +######################################################################## +[ccpp-arg-table] + name = cs_conv_post_run + type = scheme +[im] + standard_name = horizontal_dimension + long_name = horizontal dimension + units = count + dimensions = () + type = integer + intent = in + optional = F +[kmax] + standard_name = vertical_dimension + long_name = number of veritcal levels + units = count + dimensions = () + type = integer + intent = in + optional = F +[do_aw] + standard_name = flag_for_Arakawa_Wu_adjustment + long_name = flag for Arakawa Wu scale-aware adjustment + units = flag + dimensions = () + type = logical + intent = in + optional = F +[sigmatot] + standard_name = convective_updraft_area_fraction_at_model_interfaces + long_name = convective updraft area fraction at model interfaces + units = frac + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[sigmafrac] + standard_name = convective_updraft_area_fraction + long_name = convective updraft area fraction + units = frac + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F + +######################################################################## +[ccpp-arg-table] + name = cs_conv_init + type = scheme + +######################################################################## +[ccpp-arg-table] + name = cs_conv_finalize + type = scheme + +######################################################################## +[ccpp-arg-table] + name = cs_conv_run + type = scheme +[im] + standard_name = horizontal_dimension + long_name = horizontal dimension + units = count + dimensions = () + type = integer + intent = in + optional = F +[ijsdim] + standard_name = horizontal_loop_extent + long_name = horizontal loop extent + units = count + dimensions = () + type = integer + intent = in + optional = F +[kmax] + standard_name = vertical_dimension + long_name = number of veritcal levels + units = count + dimensions = () + type = integer + intent = in + optional = F +[ntracp1] + standard_name = number_of_tracers_plus_one + long_name = number of tracers plus one + units = count + dimensions = () + type = integer + intent = in + optional = F +[nn] + standard_name = number_of_tracers_for_convective_transport + long_name = number of tracers for convective transport (used to dimension clw) + units = count + dimensions = () + type = integer + intent = in + optional = F +[ntr] + standard_name = number_of_tracers_for_CS + long_name = number of convectively transported tracers in Chikira-Sugiyama deep conv. scheme + units = count + dimensions = () + type = integer + intent = in + optional = F +[nctp] + standard_name = number_of_cloud_types_CS + long_name = number of cloud types in Chikira-Sugiyama scheme + units = count + dimensions = () + type = integer + intent = in + optional = F +[otspt] + standard_name = flag_convective_tracer_transport + long_name = flag to enable tracer transport by updrafts/downdrafts[(:,1)] or subsidence [(:,2)] + units = flag + dimensions = (number_of_tracers_plus_one,2) + type = logical + intent = in + optional = F +[lat] + standard_name = latitude_index_in_debug_printouts + long_name = latitude index in debug printouts + units = index + dimensions = () + type = integer + intent = in + optional = F +[kdt] + standard_name = index_of_time_step + long_name = current forecast iteration + units = index + dimensions = () + type = integer + intent = in + optional = F +[t] + standard_name = air_temperature_updated_by_physics + long_name = mid-layer temperature + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[q] + standard_name = water_vapor_specific_humidity_updated_by_physics + long_name = mid-layer specific humidity of water vapor + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[rain1] + standard_name = lwe_thickness_of_deep_convective_precipitation_amount + long_name = deep convective rainfall amount on physics timestep + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[clw] + standard_name = convective_transportable_tracers + long_name = array to contain cloud water and other convective trans. tracers + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension,number_of_tracers_for_convective_transport) + type = real + kind = kind_phys + intent = inout + optional = F +[zm] + standard_name = geopotential + long_name = mid-layer geopotential + units = m2 s-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[zi] + standard_name = geopotential_at_interface + long_name = interface geopotential + units = m2 s-2 + dimensions = (horizontal_dimension,vertical_dimension_plus_one) + type = real + kind = kind_phys + intent = in + optional = F +[pap] + standard_name = air_pressure + long_name = mid-layer pressure + units = Pa + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[paph] + standard_name = air_pressure_at_interface + long_name = interface pressure + units = Pa + dimensions = (horizontal_dimension,vertical_dimension_plus_one) + type = real + kind = kind_phys + intent = in + optional = F +[delta] + standard_name = time_step_for_physics + long_name = physics time step + units = s + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[delti] + standard_name = time_step_for_dynamics + long_name = dynamics time step + units = s + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[ud_mf] + standard_name = instantaneous_atmosphere_updraft_convective_mass_flux + long_name = (updraft mass flux) * delt + units = kg m-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[dd_mf] + standard_name = instantaneous_atmosphere_downdraft_convective_mass_flux + long_name = (downdraft mass flux) * delt + units = kg m-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[dt_mf] + standard_name = instantaneous_atmosphere_detrainment_convective_mass_flux + long_name = (detrainment mass flux) * delt + units = kg m-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[u] + standard_name = x_wind_updated_by_physics + long_name = mid-layer zonal wind + units = m s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[v] + standard_name = y_wind_updated_by_physics + long_name = mid-layer meridional wind + units = m s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[fscav] + standard_name = fraction_of_tracer_scavenged + long_name = fraction of the tracer (aerosols) that is scavenged by convection + units = km-1 + dimensions = (number_of_tracers_scavenged) + type = real + kind = kind_phys + intent = in + optional = F +[fswtr] + standard_name = fraction_of_cloud_top_water_scavenged + long_name = fraction of the tracer (cloud top water) that is scavenged by convection + units = km-1 + dimensions = (number_of_tracers_scavenged) + type = real + kind = kind_phys + intent = in + optional = F +[cbmfx] + standard_name = cloud_base_mass_flux + long_name = cloud base mass flux + units = kg m-2 s-1 + dimensions = (horizontal_dimension,number_of_cloud_types_CS) + type = real + kind = kind_phys + intent = inout + optional = F +[mype] + standard_name = mpi_rank + long_name = current MPI rank + units = index + dimensions = () + type = integer + intent = in + optional = F +[wcbmaxm] + standard_name = maximum_updraft_velocity_at_cloud_base + long_name = maximum updraft velocity at cloud base + units = m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[precz0in] + standard_name = detrainment_and_precipitation_tunable_parameter_3_CS + long_name = partition water between detrainment and precipitation (decrease for more precipitation) + units = m + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[preczhin] + standard_name = detrainment_and_precipitation_tunable_parameter_4_CS + long_name = partition water between detrainment and precipitation (decrease for more precipitation) + units = m + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[clmdin] + standard_name = entrainment_efficiency_tunable_parameter_9_CS + long_name = entrainment efficiency + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[sigma] + standard_name = convective_updraft_area_fraction_at_model_interfaces + long_name = convective updraft area fraction at model interfaces + units = frac + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[do_aw] + standard_name = flag_for_Arakawa_Wu_adjustment + long_name = flag for Arakawa Wu scale-aware adjustment + units = flag + dimensions = () + type = logical + intent = in + optional = F +[do_awdd] + standard_name = flag_arakawa_wu_downdraft + long_name = flag to enable treating convective tendencies following Arakwaw-Wu for downdrafts (2013) + units = flag + dimensions = () + type = logical + intent = in + optional = F +[flx_form] + standard_name = flag_flux_form_CS + long_name = flag to enable using the flux form of the equations in CS scheme + units = flag + dimensions = () + type = logical + intent = in + optional = F +[lprnt] + standard_name = flag_print + long_name = control flag for diagnostic print out + units = flag + dimensions = () + type = logical + intent = in + optional = F +[ipr] + standard_name = horizontal_index_of_printed_column + long_name = horizontal index of printed column + units = index + dimensions = () + type = integer + intent = in + optional = F +[kcnv] + standard_name = flag_deep_convection + long_name = flag indicating whether convection occurs in column + units = flag + dimensions = (horizontal_dimension) + type = integer + intent = inout + optional = F +[qlcn] + standard_name = mass_fraction_of_convective_cloud_liquid_water + long_name = mass fraction of convective cloud liquid water + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[qicn] + standard_name = mass_fraction_of_convective_cloud_ice + long_name = mass fraction of convective cloud ice water + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[w_upi] + standard_name = vertical_velocity_for_updraft + long_name = vertical velocity for updraft + units = m s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[cf_upi] + standard_name = convective_cloud_fraction_for_microphysics + long_name = convective cloud fraction for microphysics + units = frac + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[cnv_mfd] + standard_name = detrained_mass_flux + long_name = detrained mass flux + units = kg m-2 s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[cnv_dqldt] + standard_name = tendency_of_cloud_water_due_to_convective_microphysics + long_name = tendency of cloud water due to convective microphysics + units = kg m-2 s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[clcn] + standard_name = convective_cloud_volume_fraction + long_name = convective cloud volume fraction + units = frac + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[cnv_fice] + standard_name = ice_fraction_in_convective_tower + long_name = ice fraction in convective tower + units = frac + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[cnv_ndrop] + standard_name = number_concentration_of_cloud_liquid_water_particles_for_detrainment + long_name = droplet number concentration in convective detrainment + units = m-3 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[cnv_nice] + standard_name = number_concentration_of_ice_crystals_for_detrainment + long_name = crystal number concentration in convective detrainment + units = m-3 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[mp_phys] + standard_name = flag_for_microphysics_scheme + long_name = flag for microphysics scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F diff --git a/physics/cs_conv_aw_adj.F90 b/physics/cs_conv_aw_adj.F90 index 08d3f4516..756161d8c 100644 --- a/physics/cs_conv_aw_adj.F90 +++ b/physics/cs_conv_aw_adj.F90 @@ -1,7 +1,7 @@ !> \file cs_conv_aw_adj.F90 !! This file contains a subroutine to adjusts surface rainrate for conservation for CSAW. -!>\defgroup mod_cs_conv_aw_adj CPT cs_conv_aw_adj Module +!>\defgroup mod_cs_conv_aw_adj CSAW adjustment Module !! This module adjusts surface rainrate for conservation. !> @{ module cs_conv_aw_adj @@ -23,36 +23,13 @@ end subroutine cs_conv_aw_adj_finalize !>\ingroup cs_scheme !> This subroutine adjusts surface rainrate for conservation. !> \section arg_table_cs_conv_aw_adj_run Argument Table -!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | -!! |-----------------|---------------------------------------------------------------|----------------------------------------------------------------------------------|---------|------|-----------|-----------|--------|----------| -!! | im | horizontal_dimension | horizontal dimension | count | 0 | integer | | in | F | -!! | levs | vertical_dimension | number of veritcal levels | count | 0 | integer | | in | F | -!! | do_cscnv | flag_for_Chikira_Sugiyama_deep_convection | flag for Chikira-Sugiyama convection | flag | 0 | logical | | in | F | -!! | do_aw | flag_for_Arakawa_Wu_adjustment | flag for Arakawa Wu scale-aware adjustment | flag | 0 | logical | | in | F | -!! | do_shoc | flag_for_shoc | flag for SHOC | flag | 0 | logical | | in | F | -!! | ntrac | number_of_tracers | number of tracers | count | 0 | integer | | in | F | -!! | ncld | number_of_hydrometeors | number of hydrometeors | count | 0 | integer | | in | F | -!! | ntcw | index_for_liquid_cloud_condensate | tracer index for cloud condensate (or liquid water) | index | 0 | integer | | in | F | -!! | ntclamt | index_for_cloud_amount | tracer index for cloud amount integer | index | 0 | integer | | in | F | -!! | nncl | number_of_tracers_for_cloud_condensate | number of tracers for cloud condensate | count | 0 | integer | | in | F | -!! | con_g | gravitational_acceleration | gravitational acceleration | m s-2 | 0 | real | kind_phys | in | F | -!! | sigmafrac | convective_updraft_area_fraction | convective updraft area fraction | frac | 2 | real | kind_phys | in | F | -!! | gt0 | air_temperature_updated_by_physics | temperature updated by physics | K | 2 | real | kind_phys | inout | F | -!! | gq0 | tracer_concentration_updated_by_physics | tracer concentration updated by physics | kg kg-1 | 3 | real | kind_phys | inout | F | -!! | save_t | air_temperature_save | air temperature before entering a physics scheme | K | 2 | real | kind_phys | in | F | -!! | save_q | tracer_concentration_save | tracer concentration before entering a physics scheme | kg kg-1 | 3 | real | kind_phys | in | F | -!! | prsi | air_pressure_at_interface | air pressure at model layer interfaces | Pa | 2 | real | kind_phys | in | F | -!! | cldfrac | cloud_fraction_for_MG | cloud fraction used by Morrison-Gettelman MP | frac | 2 | real | kind_phys | inout | F | -!! | subcldfrac | subgrid_scale_cloud_fraction_from_shoc | subgrid-scale cloud fraction from the SHOC scheme | frac | 2 | real | kind_phys | inout | F | -!! | prcp | lwe_thickness_of_explicit_precipitation_amount | explicit precipitation (rain, ice, snow, graupel, ...) on physics timestep | m | 1 | real | kind_phys | inout | F | -!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | -!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | +!! \htmlinclude cs_conv_aw_adj_run.html !! -!>\section gen_cs_conv_aw_adj_run CPT cs_conv_aw_adj_run General Algorithm +!\section gen_cs_conv_aw_adj_run CPT cs_conv_aw_adj_run General Algorithm subroutine cs_conv_aw_adj_run(im, levs, do_cscnv, do_aw, do_shoc, & ntrac, ncld, ntcw, ntclamt, nncl, con_g, sigmafrac, & gt0, gq0, save_t, save_q, prsi, cldfrac, subcldfrac, & - prcp, errmsg, errflg) + prcp, imp_physics, imp_physics_mg, errmsg, errflg) use machine, only: kind_phys @@ -72,6 +49,7 @@ subroutine cs_conv_aw_adj_run(im, levs, do_cscnv, do_aw, do_shoc, & real(kind_phys), dimension(im,levs), intent(inout) :: cldfrac real(kind_phys), dimension(im,levs), intent(inout) :: subcldfrac real(kind_phys), dimension(im), intent(inout) :: prcp + integer, intent(in ) :: imp_physics, imp_physics_mg character(len=*), intent( out) :: errmsg integer, intent( out) :: errflg @@ -109,6 +87,14 @@ subroutine cs_conv_aw_adj_run(im, levs, do_cscnv, do_aw, do_shoc, & temrain1(i) = temrain1(i) - (prsi(i,k)-prsi(i,k+1)) * tem2 * onebg enddo enddo +! add convective clouds if shoc is true and not MG microphysics + if (do_shoc .and. imp_physics /= imp_physics_mg) then + do k = 1,levs + do i = 1,im + subcldfrac(i,k) = min(1.0, subcldfrac(i,k) + sigmafrac(i,k)) + enddo + enddo + endif ! do n=ntcw,ntcw+nncl-1 do k = 1,levs diff --git a/physics/cs_conv_aw_adj.meta b/physics/cs_conv_aw_adj.meta new file mode 100644 index 000000000..1e744bdd3 --- /dev/null +++ b/physics/cs_conv_aw_adj.meta @@ -0,0 +1,206 @@ +[ccpp-arg-table] + name = cs_conv_aw_adj_run + type = scheme +[im] + standard_name = horizontal_dimension + long_name = horizontal dimension + units = count + dimensions = () + type = integer + intent = in + optional = F +[levs] + standard_name = vertical_dimension + long_name = number of veritcal levels + units = count + dimensions = () + type = integer + intent = in + optional = F +[do_cscnv] + standard_name = flag_for_Chikira_Sugiyama_deep_convection + long_name = flag for Chikira-Sugiyama convection + units = flag + dimensions = () + type = logical + intent = in + optional = F +[do_aw] + standard_name = flag_for_Arakawa_Wu_adjustment + long_name = flag for Arakawa Wu scale-aware adjustment + units = flag + dimensions = () + type = logical + intent = in + optional = F +[do_shoc] + standard_name = flag_for_shoc + long_name = flag for SHOC + units = flag + dimensions = () + type = logical + intent = in + optional = F +[ntrac] + standard_name = number_of_tracers + long_name = number of tracers + units = count + dimensions = () + type = integer + intent = in + optional = F +[ncld] + standard_name = number_of_hydrometeors + long_name = number of hydrometeors + units = count + dimensions = () + type = integer + intent = in + optional = F +[ntcw] + standard_name = index_for_liquid_cloud_condensate + long_name = tracer index for cloud condensate (or liquid water) + units = index + dimensions = () + type = integer + intent = in + optional = F +[ntclamt] + standard_name = index_for_cloud_amount + long_name = tracer index for cloud amount integer + units = index + dimensions = () + type = integer + intent = in + optional = F +[nncl] + standard_name = number_of_tracers_for_cloud_condensate + long_name = number of tracers for cloud condensate + units = count + dimensions = () + type = integer + intent = in + optional = F +[con_g] + standard_name = gravitational_acceleration + long_name = gravitational acceleration + units = m s-2 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[sigmafrac] + standard_name = convective_updraft_area_fraction + long_name = convective updraft area fraction + units = frac + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[gt0] + standard_name = air_temperature_updated_by_physics + long_name = temperature updated by physics + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[gq0] + standard_name = tracer_concentration_updated_by_physics + long_name = tracer concentration updated by physics + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension,number_of_tracers) + type = real + kind = kind_phys + intent = inout + optional = F +[save_t] + standard_name = air_temperature_save + long_name = air temperature before entering a physics scheme + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[save_q] + standard_name = tracer_concentration_save + long_name = tracer concentration before entering a physics scheme + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension,number_of_tracers) + type = real + kind = kind_phys + intent = in + optional = F +[prsi] + standard_name = air_pressure_at_interface + long_name = air pressure at model layer interfaces + units = Pa + dimensions = (horizontal_dimension,vertical_dimension_plus_one) + type = real + kind = kind_phys + intent = in + optional = F +[cldfrac] + standard_name = cloud_fraction_for_MG + long_name = cloud fraction used by Morrison-Gettelman MP + units = frac + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[subcldfrac] + standard_name = subgrid_scale_cloud_fraction_from_shoc + long_name = subgrid-scale cloud fraction from the SHOC scheme + units = frac + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[prcp] + standard_name = lwe_thickness_of_explicit_precipitation_amount + long_name = explicit precipitation (rain, ice, snow, graupel, ...) on physics timestep + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[imp_physics] + standard_name = flag_for_microphysics_scheme + long_name = choice of microphysics scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F +[imp_physics_mg] + standard_name = flag_for_morrison_gettelman_microphysics_scheme + long_name = choice of Morrison-Gettelman microphysics scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F diff --git a/physics/cu_gf_deep.F90 b/physics/cu_gf_deep.F90 index 338bf4cb1..4afad80d1 100644 --- a/physics/cu_gf_deep.F90 +++ b/physics/cu_gf_deep.F90 @@ -1,8 +1,9 @@ !>\file cu_gf_deep.F90 !! This file is the Grell-Freitas deep convection scheme. -!>\defgroup cu_gf_deep_group GSD Grell-Freitas Deep Convection Main +!>\defgroup cu_gf_deep_group Grell-Freitas Deep Convection Module !>\ingroup cu_gf_group +!! This is Grell-Freitas deep convection scheme module module cu_gf_deep use machine , only : kind_phys real(kind=kind_phys), parameter::g=9.81 @@ -13,7 +14,7 @@ module cu_gf_deep !> tuning constant for cloudwater/ice detrainment real(kind=kind_phys), parameter:: c1= 0.003 !.002 ! .0005 !> parameter to turn on or off evaporation of rainwater as done in sas - integer, parameter :: irainevap=0 + integer, parameter :: irainevap=1 !> max allowed fractional coverage (frh_thresh) real(kind=kind_phys), parameter::frh_thresh = .9 !> rh threshold. if fractional coverage ~ frh_thres, do not use cupa any further @@ -51,57 +52,57 @@ module cu_gf_deep !> @{ subroutine cu_gf_deep_run( & itf,ktf,its,ite, kts,kte & - ,dicycle & !< diurnal cycle flag - ,ichoice & !< choice of closure, use "0" for ensemble average - ,ipr & !< this flag can be used for debugging prints - ,ccn & !< not well tested yet - ,dtime & !< - ,imid & !< flag to turn on mid level convection - ,kpbl & !< level of boundary layer height - ,dhdt & !< boundary layer forcing (one closure for shallow) - ,xland & !< land mask - ,zo & !< heights above surface - ,forcing & !< only diagnostic - ,t & !< t before forcing - ,q & !< q before forcing - ,z1 & !< terrain - ,tn & !< t including forcing - ,qo & !< q including forcing - ,po & !< pressure (mb) - ,psur & !< surface pressure (mb) - ,us & !< u on mass points - ,vs & !< v on mass points - ,rho & !< density - ,hfx & !< w/m2, positive upward - ,qfx & !< w/m2, positive upward - ,dx & !< dx is grid point dependent here - ,mconv & !< integrated vertical advection of moisture - ,omeg & !< omega (pa/s) - ,csum & !< used to implement memory, set to zero if not avail - ,cnvwt & !< gfs needs this - ,zuo & !< nomalized updraft mass flux - ,zdo & !< nomalized downdraft mass flux - ,zdm & !< nomalized downdraft mass flux from mid scheme - ,edto & !< - ,edtm & !< - ,xmb_out & !< the xmb's may be needed for dicycle - ,xmbm_in & !< - ,xmbs_in & !< - ,pre & !< - ,outu & !< momentum tendencies at mass points - ,outv & !< - ,outt & !< temperature tendencies - ,outq & !< q tendencies - ,outqc & !< ql/qice tendencies - ,kbcon & !< - ,ktop & !< - ,cupclw & !< used for direct coupling to radiation, but with tuning factors - ,ierr & !< ierr flags are error flags, used for debugging - ,ierrc & ! - Call cup_env() to calculate moist static energy, heights, qes ! call cup_env(z,qes,he,hes,t,q,po,z1, & psur,ierr,tcrit,-1, & @@ -558,7 +559,7 @@ subroutine cu_gf_deep_run( & its,ite, kts,kte) ! -!--- environmental values on cloud levels +!> - Call cup_env_clev() to calculate environmental values on cloud levels ! call cup_env_clev(t,qes,q,he,hes,z,po,qes_cup,q_cup,he_cup, & hes_cup,z_cup,p_cup,gamma_cup,t_cup,psur, & @@ -571,7 +572,7 @@ subroutine cu_gf_deep_run( & itf,ktf, & its,ite, kts,kte) !---meltglac------------------------------------------------- -!--- partition between liq/ice cloud contents +!> - Call get_partition_liq_ice() to calculate partition between liq/ice cloud contents call get_partition_liq_ice(ierr,tn,po_cup,p_liq_ice,melting_layer,& itf,ktf,its,ite,kts,kte,cumulus) !---meltglac------------------------------------------------- @@ -596,7 +597,7 @@ subroutine cu_gf_deep_run( & enddo 25 continue ! -!--- level where detrainment for downdraft starts +!> - Compute the level where detrainment for downdraft starts (\p kdet) ! do k=kts,ktf if(zo_cup(i,k).gt.z_detr+z1(i))then @@ -611,7 +612,7 @@ subroutine cu_gf_deep_run( & ! ! ! -!------- determine level with highest moist static energy content - k22 +!> - Determine level with highest moist static energy content (\p k22) ! start_k22=2 do 36 i=its,itf @@ -627,7 +628,8 @@ subroutine cu_gf_deep_run( & endif 36 continue ! -!--- determine the level of convective cloud base - kbcon +!> - call get_cloud_bc() and cup_kbcon() to determine the +!! level of convective cloud base (\p kbcon) ! do i=its,itf @@ -720,7 +722,7 @@ subroutine cu_gf_deep_run( & endif enddo ! -!-- get normalized mass flux, entrainment and detrainmentrates for updraft +!> - Call rates_up_pdf() to get normalized mass flux, entrainment and detrainmentrates for updraft ! i=0 !- for mid level clouds we do not allow clouds taller than where stability @@ -757,7 +759,7 @@ subroutine cu_gf_deep_run( & endif enddo ! -! calculate mass entrainment and detrainment +!> - Call get_lateral_massflux() to calculate mass entrainment and detrainment ! if(imid.eq.1)then call get_lateral_massflux(itf,ktf, its,ite, kts,kte & @@ -930,7 +932,7 @@ subroutine cu_gf_deep_run( & enddo enddo ! - !--- calculate moisture properties of updraft +!> - Call cup_up_moisture() to calculate moisture properties of updraft ! if(imid.eq.1)then call cup_up_moisture('mid',ierr,zo_cup,qco,qrco,pwo,pwavo, & @@ -1250,7 +1252,7 @@ subroutine cu_gf_deep_run( & endif enddo ! -!--- calculate moisture properties of downdraft +!> - Call cup_dd_moisture() to calculate moisture properties of downdraft ! call cup_dd_moisture(ierrc,zdo,hcdo,heso_cup,qcdo,qeso_cup, & pwdo,qo_cup,zo_cup,dd_massentro,dd_massdetro,jmin,ierr,gammao_cup, & @@ -1286,7 +1288,7 @@ subroutine cu_gf_deep_run( & enddo enddo ! -!--- calculate workfunctions for updrafts +!> - Call cup_up_aa0() to calculate workfunctions for updrafts ! call cup_up_aa0(aa0,z,zu,dby,gamma_cup,t_cup, & kbcon,ktop,ierr, & @@ -1353,6 +1355,7 @@ subroutine cu_gf_deep_run( & t_star=1. !-- calculate pcape from bl forcing only +!> - Call cup_up_aa1bl() to calculate ECMWF version diurnal cycle closure call cup_up_aa1bl(aa1_bl,t,tn,q,qo,dtime, & zo_cup,zuo,dbyo_bl,gammao_cup_bl,tn_cup_bl, & kbcon,ktop,ierr, & @@ -1463,7 +1466,7 @@ subroutine cu_gf_deep_run( & axx(:)=aa1(:) ! -!--- determine downdraft strength in terms of windshear +!> - Call cup_dd_edt() to determine downdraft strength in terms of windshear ! call cup_dd_edt(ierr,us,vs,zo,ktop,kbcon,edt,po,pwavo, & pwo,ccn,pwevo,edtmax,edtmin,edtc,psum,psumh, & @@ -1473,7 +1476,8 @@ subroutine cu_gf_deep_run( & if(ierr(i)/=0)cycle edto(i)=edtc(i,1) enddo - !--- get melting profile + +!> - Call get_melting_profile() to get melting profile call get_melting_profile(ierr,tn_cup,po_cup, p_liq_ice,melting_layer,qrco & ,pwo,edto,pwdo,melting & ,itf,ktf,its,ite, kts,kte, cumulus ) @@ -1919,6 +1923,13 @@ subroutine cu_gf_deep_run( & ichoice,imid,ipr,itf,ktf, & its,ite, kts,kte, & dicycle,xf_dicycle ) + +!---------------evap below cloud base + + call rain_evap_below_cloudbase(itf,ktf,its,ite, & + kts,kte,ierr,kbcon,xmb,psur,xland,qo_cup, & + po_cup,qes_cup,pwavo,edto,pwevo,pre,outt,outq) !,outbuoy) + k=1 do i=its,itf if(ierr(i).eq.0 .and.pre(i).gt.0.) then @@ -1967,7 +1978,7 @@ subroutine cu_gf_deep_run( & do k = ktop(i), 1, -1 rain = pwo(i,k) + edto(i) * pwdo(i,k) rn(i) = rn(i) + rain * xmb(i) * .001 * dtime - !if(po(i,k).gt.700.)then + if(po(i,k).gt.400.)then if(flg(i))then q1=qo(i,k)+(outq(i,k))*dtime t1=tn(i,k)+(outt(i,k))*dtime @@ -1992,7 +2003,7 @@ subroutine cu_gf_deep_run( & pre(i)=max(pre(i),0.) delqev(i) = delqev(i) + .001*dp*qevap(i)/g endif - !endif ! 700mb + endif ! 400mb endif enddo ! pre(i)=1000.*rn(i)/dtime @@ -2031,7 +2042,271 @@ end subroutine cu_gf_deep_run !> @} !>\ingroup cu_gf_deep_group -!> This subroutine calculates + + + subroutine fct1d3 (ktop,n,dt,z,tracr,massflx,trflx_in,dellac,g) + +! --- modify a 1-D array of tracer fluxes for the purpose of maintaining +! --- monotonicity (including positive-definiteness) in the tracer field +! --- during tracer transport. + +! --- the underlying transport equation is (d tracr/dt) = - (d trflx/dz) +! --- where dz = |z(k+1)-z(k)| (k=1,...,n) and trflx = massflx * tracr +! --- physical dimensions of tracr,trflx,dz are arbitrary to some extent +! --- but are subject to the constraint dim[trflx] = dim[tracr*(dz/dt)]. + +! --- note: tracr is carried in grid cells while z and fluxes are carried on +! --- interfaces. interface variables at index k are at grid location k-1/2. +! --- sign convention: mass fluxes are considered positive in +k direction. + +! --- massflx and trflx_in must be provided independently to allow the +! --- algorithm to generate an auxiliary low-order (diffusive) tracer flux +! --- as a stepping stone toward the final product trflx_out. + + implicit none + integer,intent(in) :: n,ktop ! number of grid cells + real(kind=kind_phys) ,intent(in) :: dt,g ! transport time step + real(kind=kind_phys) ,intent(in) :: z(n+0) ! location of cell interfaces + real(kind=kind_phys) ,intent(in) :: tracr(n) ! the transported variable + real(kind=kind_phys) ,intent(in) :: massflx(n+0) ! mass flux across interfaces + real(kind=kind_phys) ,intent(in) :: trflx_in(n+0) ! original tracer flux + real(kind=kind_phys) ,intent(out):: dellac(n+0) ! modified tracr flux + real(kind=kind_phys) :: trflx_out(n+0) ! modified tracr flux + integer k,km1,kp1 + logical :: NaN, error=.false., vrbos=.true. + real(kind=kind_phys) dtovdz(n),trmax(n),trmin(n),flx_lo(n+0),antifx(n+0),clipped(n+0), & + soln_hi(n),totlin(n),totlout(n),soln_lo(n),clipin(n),clipout(n),arg + real(kind=kind_phys),parameter :: epsil=1.e-22 ! prevent division by zero + real(kind=kind_phys),parameter :: damp=1. ! damper of antidff flux (1=no damping) + NaN(arg) = .not. (arg.ge.0. .or. arg.le.0.) ! NaN detector + dtovdz(:)=0. + soln_lo(:)=0. + antifx(:)=0. + clipin(:)=0. + totlin(:)=0. + totlout(:)=0. + clipout(:)=0. + flx_lo(:)=0. + trmin(:)=0. + trmax(:)=0. + clipped(:)=0. + trflx_out(:)=0. + do k=1,ktop + dtovdz(k)=.01*dt/abs(z(k+1)-z(k))*g ! time step / grid spacing + if (z(k).eq.z(k+1)) error=.true. + end do +! if (vrbos .or. error) print '(a/(8es10.3))','(fct1d) dtovdz =',dtovdz + + do k=2,ktop + if (massflx(k).ge.0.) then + flx_lo(k)=massflx(k)*tracr(k-1) ! low-order flux, upstream + else + flx_lo(k)=massflx(k)*tracr(k) ! low-order flux, upstream + end if + antifx(k)=trflx_in(k)-flx_lo(k) ! antidiffusive flux + end do + flx_lo( 1)=trflx_in( 1) + flx_lo(ktop+1)=trflx_in(ktop+1) + antifx( 1)=0. + antifx(ktop+1)=0. +! --- clip low-ord fluxes to make sure they don't violate positive-definiteness + do k=1,ktop + totlout(k)=max(0.,flx_lo(k+1))-min(0.,flx_lo(k )) ! total flux out + clipout(k)=min(1.,tracr(k)/max(epsil,totlout(k))/ (1.0001*dtovdz(k))) + end do + + do k=2,ktop + if (massflx(k).ge.0.) then + flx_lo(k)=flx_lo(k)*clipout(k-1) + else + flx_lo(k)=flx_lo(k)*clipout(k) + end if + end do + if (massflx( 1).lt.0.) flx_lo( 1)=flx_lo( 1)*clipout(1) + if (massflx(ktop+1).gt.0.)flx_lo(ktop+1)=flx_lo(ktop+1)*clipout(ktop) + +! --- a positive-definite low-order (diffusive) solution can now be constructed + + do k=1,ktop + soln_lo(k)=tracr(k)-(flx_lo(k+1)-flx_lo(k))*dtovdz(k) ! low-ord solutn + dellac(k)=-(flx_lo(k+1)-flx_lo(k))*dtovdz(k)/dt + !dellac(k)=soln_lo(k) + end do + return + do k=1,ktop + km1=max(1,k-1) + kp1=min(ktop,k+1) + trmax(k)= max(soln_lo(km1),soln_lo(k),soln_lo(kp1), & + tracr (km1),tracr (k),tracr (kp1)) ! upper bound + trmin(k)=max(0.,min(soln_lo(km1),soln_lo(k),soln_lo(kp1), & + tracr (km1),tracr (k),tracr (kp1))) ! lower bound + end do + + do k=1,ktop + totlin (k)=max(0.,antifx(k ))-min(0.,antifx(k+1)) ! total flux in + totlout(k)=max(0.,antifx(k+1))-min(0.,antifx(k )) ! total flux out + + clipin (k)=min(damp,(trmax(k)-soln_lo(k))/max(epsil,totlin (k)) & + / (1.0001*dtovdz(k))) + clipout(k)=min(damp,(soln_lo(k)-trmin(k))/max(epsil,totlout(k)) & + / (1.0001*dtovdz(k))) + + if (NaN(clipin(k))) print *,'(fct1d) error: clipin is NaN, k=',k + if (NaN(clipout(k))) print *,'(fct1d) error: clipout is NaN, k=',k + + if (clipin(k).lt.0.) then +! print 100,'(fct1d) error: clipin < 0 at k =',k, & +! 'clipin',clipin(k),'trmax',trmax(k),'soln_lo',soln_lo(k), & +! 'totlin',totlin(k),'dt/dz',dtovdz(k) + error=.true. + end if + if (clipout(k).lt.0.) then +! print 100,'(fct1d) error: clipout < 0 at k =',k, & +! 'clipout',clipout(k),'trmin',trmin(k),'soln_lo',soln_lo(k), & +! 'totlout',totlout(k),'dt/dz',dtovdz(k) + error=.true. + end if +! 100 format (a,i3/(4(a10,"=",es9.2))) + end do + + do k=2,ktop + if (antifx(k).gt.0.) then + clipped(k)=antifx(k)*min(clipout(k-1),clipin(k)) + else + clipped(k)=antifx(k)*min(clipout(k),clipin(k-1)) + end if + trflx_out(k)=flx_lo(k)+clipped(k) + if (NaN(trflx_out(k))) then + print *,'(fct1d) error: trflx_out is NaN, k=',k + error=.true. + end if + end do + trflx_out( 1)=trflx_in( 1) + trflx_out(ktop+1)=trflx_in(ktop+1) + do k=1,ktop + soln_hi(k)=tracr(k)-(trflx_out(k+1)-trflx_out(k))*dtovdz(k) + dellac(k)=-g*(trflx_out(k+1)-trflx_out(k))*dtovdz(k)/dt + !dellac(k)=soln_hi(k) + end do + + if (vrbos .or. error) then +! do k=2,ktop +! write(32,99)k, & +! 'tracr(k)', tracr(k), & +! 'flx_in(k)', trflx_in(k), & +! 'flx_in(k+1)', trflx_in(k+1), & +! 'flx_lo(k)', flx_lo(k), & +! 'flx_lo(k+1)', flx_lo(k+1), & +! 'soln_lo(k)', soln_lo(k), & +! 'trmin(k)', trmin(k), & +! 'trmax(k)', trmax(k), & +! 'totlin(k)', totlin(k), & +! 'totlout(k)', totlout(k), & +! 'clipin(k-1)', clipin(k-1), & +! 'clipin(k)', clipin(k), & +! 'clipout(k-1)', clipout(k-1), & +! 'clipout(k)', clipout(k), & +! 'antifx(k)', antifx(k), & +! 'antifx(k+1)', antifx(k+1), & +! 'clipped(k)', clipped(k), & +! 'clipped(k+1)', clipped(k+1), & +! 'flx_out(k)', trflx_out(k), & +! 'flx_out(k+1)', trflx_out(k+1), & +! 'dt/dz(k)', dtovdz(k), & +! 'final', tracr(k)-(trflx_out(k+1)-trflx_out(k))*dtovdz(k) +! 99 format ('(trc1d) k =',i4/(3(a13,'=',es13.6))) +! end do + if (error) stop '(fct1d error)' + end if + + return + end subroutine fct1d3 + + subroutine rain_evap_below_cloudbase(itf,ktf, its,ite, kts,kte,ierr, & + kbcon,xmb,psur,xland,qo_cup, & + po_cup,qes_cup,pwavo,edto,pwevo,pre,outt,outq) !,outbuoy) + + implicit none + real(kind=kind_phys), parameter :: alp1=5.44e-4 & !1/sec + ,alp2=5.09e-3 & !unitless + ,alp3=0.5777 & !unitless + ,c_conv=0.05 !conv fraction area, unitless + + + integer ,intent(in) :: itf,ktf, its,ite, kts,kte + integer, dimension(its:ite) ,intent(in) :: ierr,kbcon + real(kind=kind_phys), dimension(its:ite) ,intent(in) ::psur,xland,pwavo,edto,pwevo,xmb + real(kind=kind_phys), dimension(its:ite,kts:kte),intent(in) :: po_cup,qo_cup,qes_cup + real(kind=kind_phys), dimension(its:ite) ,intent(inout) :: pre + real(kind=kind_phys), dimension(its:ite,kts:kte),intent(inout) :: outt,outq !,outbuoy + + !real, dimension(its:ite) ,intent(out) :: tot_evap_bcb + !real, dimension(its:ite,kts:kte),intent(out) :: evap_bcb,net_prec_bcb + + !-- locals + integer :: i,k + real(kind=kind_phys) :: RH_cr , del_t,del_q,dp,q_deficit + real(kind=kind_phys), dimension(its:ite,kts:kte) :: evap_bcb,net_prec_bcb + real(kind=kind_phys), dimension(its:ite) :: tot_evap_bcb + + do i=its,itf + evap_bcb (i,:)= 0.0 + net_prec_bcb(i,:)= 0.0 + tot_evap_bcb(i) = 0.0 + if(ierr(i) /= 0) cycle + + !-- critical rel humidity + RH_cr=0.9*xland(i)+0.7*(1-xland(i)) + !RH_cr=1. + + !-- net precipitation (after downdraft evap) at cloud base, available to + !evap + k=kbcon(i) + !net_prec_bcb(i,k) = xmb(i)*(pwavo(i)+edto(i)*pwevo(i)) !-- pwevo<0. + net_prec_bcb(i,k) = pre(i) + + do k=kbcon(i)-1, kts, -1 + + q_deficit = max(0.,(RH_cr*qes_cup(i,k) -qo_cup(i,k))) + + if(q_deficit < 1.e-6) then + net_prec_bcb(i,k)= net_prec_bcb(i,k+1) + cycle + endif + + dp = 100.*(po_cup(i,k)-po_cup(i,k+1)) + + !--units here: kg[water]/kg[air}/sec + evap_bcb(i,k) = c_conv * alp1 * q_deficit * & + ( sqrt(po_cup(i,k)/psur(i))/alp2 *net_prec_bcb(i,k+1)/c_conv )**alp3 + + !--units here: kg[water]/kg[air}/sec * kg[air]/m3 * m = kg[water]/m2/sec + evap_bcb(i,k)= evap_bcb(i,k)*dp/g + + if((net_prec_bcb(i,k+1) - evap_bcb(i,k)).lt.0.) cycle + if((pre(i) - evap_bcb(i,k)).lt.0.) cycle + net_prec_bcb(i,k)= net_prec_bcb(i,k+1) - evap_bcb(i,k) + + tot_evap_bcb(i) = tot_evap_bcb(i)+evap_bcb(i,k) + + !-- feedback + del_q = evap_bcb(i,k)*g/dp ! > 0., units: kg[water]/kg[air}/sec + del_t = -evap_bcb(i,k)*g/dp*(xlv/cp) ! < 0., units: K/sec + +! print*,"ebcb2",k,del_q*86400,del_t*86400 + + outq (i,k) = outq (i,k) + del_q + outt (i,k) = outt (i,k) + del_t + !outbuoy(i,k) = outbuoy(i,k) + cp*del_t+xlv*del_q + + pre(i) = pre(i) - evap_bcb(i,k) + enddo + enddo + + end subroutine rain_evap_below_cloudbase + + + subroutine cup_dd_edt(ierr,us,vs,z,ktop,kbcon,edt,p,pwav, & pw,ccn,pwev,edtmax,edtmin,edtc,psum2,psumh, & rho,aeroevap,itf,ktf, & @@ -2157,9 +2432,6 @@ subroutine cup_dd_edt(ierr,us,vs,z,ktop,kbcon,edt,p,pwav, & end subroutine cup_dd_edt !>\ingroup cu_gf_deep_group -!> This subroutine calculates -!!\param ierrc -!!\param zd subroutine cup_dd_moisture(ierrc,zd,hcd,hes_cup,qcd,qes_cup, & pwd,q_cup,z_cup,dd_massentr,dd_massdetr,jmin,ierr, & gamma_cup,pwev,bu,qrcd, & @@ -2306,8 +2578,24 @@ subroutine cup_dd_moisture(ierrc,zd,hcd,hes_cup,qcd,qes_cup, & end subroutine cup_dd_moisture !>\ingroup cu_gf_deep_group -!> This subroutine calculates -!!\param +!!\param z environmental heights +!!\param qes environmental saturation mixing ratio +!!\param he environmental moist static energy +!!\param hes environmental saturation moist static energy +!!\param t environmental temperature +!!\param q environmental mixing ratio +!!\param p environmental pressure +!!\param z1 terrain elevation +!!\param psur surface pressure +!!\param ierr error value, maybe modified in this routine +!!\param tcrit 258.K +!!\param itest +!!\param itf +!!\param ktf +!!\param its +!!\param ite +!!\param kts +!!\param kte subroutine cup_env(z,qes,he,hes,t,q,p,z1, & psur,ierr,tcrit,itest, & itf,ktf, & @@ -2320,18 +2608,6 @@ subroutine cup_env(z,qes,he,hes,t,q,p,z1, & itf,ktf, & its,ite, kts,kte ! - ! ierr error value, maybe modified in this routine - ! q = environmental mixing ratio - ! qes = environmental saturation mixing ratio - ! t = environmental temp - ! tv = environmental virtual temp - ! p = environmental pressure - ! z = environmental heights - ! he = environmental moist static energy - ! hes = environmental saturation moist static energy - ! psur = surface pressure - ! z1 = terrain elevation - ! ! real(kind=kind_phys), dimension (its:ite,kts:kte) & ,intent (in ) :: & @@ -2439,8 +2715,25 @@ subroutine cup_env(z,qes,he,hes,t,q,p,z1, & end subroutine cup_env !>\ingroup cu_gf_deep_group -!> This subroutine calculates -!>\param +!!\param t environmental temperature +!!\param qes environmental saturation mixing ratio +!!\param q environmental mixing ratio +!!\param he environmental moist static energy +!!\param hes environmental saturation moist static energy +!!\param z environmental heights +!!\param p environmental pressure +!!\param qes_cup environmental saturation mixing ratio on cloud levels +!!\param q_cup environmental mixing ratio on cloud levels +!!\param he_cup environmental moist static energy on cloud levels +!!\param hes_cup environmental saturation moist static energy on cloud levels +!!\param z_cup environmental heights on cloud levels +!!\param p_cup environmental pressure on cloud levels +!!\param gamma_cup gamma on cloud levels +!!\param t_cup environmental temperature on cloud levels +!!\param psur surface pressure +!!\param ierr error value, maybe modified in this routine +!!\param z1 terrain elevation +!!\param itf,ktf,its,ite,kts,kte horizontal and vertical dimension subroutine cup_env_clev(t,qes,q,he,hes,z,p,qes_cup,q_cup, & he_cup,hes_cup,z_cup,p_cup,gamma_cup,t_cup,psur, & ierr,z1, & @@ -2453,26 +2746,6 @@ subroutine cup_env_clev(t,qes,q,he,hes,z,p,qes_cup,q_cup, & ,intent (in ) :: & itf,ktf, & its,ite, kts,kte - ! - ! ierr error value, maybe modified in this routine - ! q = environmental mixing ratio - ! q_cup = environmental mixing ratio on cloud levels - ! qes = environmental saturation mixing ratio - ! qes_cup = environmental saturation mixing ratio on cloud levels - ! t = environmental temp - ! t_cup = environmental temp on cloud levels - ! p = environmental pressure - ! p_cup = environmental pressure on cloud levels - ! z = environmental heights - ! z_cup = environmental heights on cloud levels - ! he = environmental moist static energy - ! he_cup = environmental moist static energy on cloud levels - ! hes = environmental saturation moist static energy - ! hes_cup = environmental saturation moist static energy on cloud levels - ! gamma_cup = gamma on cloud levels - ! psur = surface pressure - ! z1 = terrain elevation - ! ! real(kind=kind_phys), dimension (its:ite,kts:kte) & ,intent (in ) :: & @@ -2543,8 +2816,6 @@ subroutine cup_env_clev(t,qes,q,he,hes,z,p,qes_cup,q_cup, & end subroutine cup_env_clev !>\ingroup cu_gf_deep_group -!> This subroutine calculates -!>\param subroutine cup_forcing_ens_3d(closure_n,xland,aa0,aa1,xaa0,mbdt,dtime,ierr,ierr2,ierr3,& xf_ens,axx,forcing,maxens3,mconv,rand_clos, & p_cup,ktop,omeg,zd,zdm,k22,zu,pr_ens,edt,edtm,kbcon, & @@ -2748,9 +3019,8 @@ subroutine cup_forcing_ens_3d(closure_n,xland,aa0,aa1,xaa0,mbdt,dtime,ierr,ierr2 xff_ens3(12)=0. xff_ens3(13)= 0. xff_ens3(16)= 0. -! closure_n(i)=12. -! hli 05/01/2018 closure_n(i)=12. -! xff_dicycle = 0. +! closure_n(i)=12. +! xff_dicycle = 0. endif !xff0 endif ! ichoice @@ -2927,8 +3197,6 @@ subroutine cup_forcing_ens_3d(closure_n,xland,aa0,aa1,xaa0,mbdt,dtime,ierr,ierr2 end subroutine cup_forcing_ens_3d !>\ingroup cu_gf_deep_group -!> This subroutine calculates -!>\param subroutine cup_kbcon(ierrc,cap_inc,iloop_in,k22,kbcon,he_cup,hes_cup, & hkb,ierr,kbmax,p_cup,cap_max, & ztexec,zqexec, & @@ -3068,8 +3336,6 @@ subroutine cup_kbcon(ierrc,cap_inc,iloop_in,k22,kbcon,he_cup,hes_cup, & end subroutine cup_kbcon !>\ingroup cu_gf_deep_group -!> This subroutine calculates -!>\param subroutine cup_maximi(array,ks,ke,maxx,ierr, & itf,ktf, & its,ite, kts,kte ) @@ -3126,8 +3392,6 @@ subroutine cup_maximi(array,ks,ke,maxx,ierr, & end subroutine cup_maximi !>\ingroup cu_gf_deep_group -!> This subroutine calculates -!>\param subroutine cup_minimi(array,ks,kend,kt,ierr, & itf,ktf, & its,ite, kts,kte ) @@ -3179,8 +3443,6 @@ subroutine cup_minimi(array,ks,kend,kt,ierr, & end subroutine cup_minimi !>\ingroup cu_gf_deep_group -!> This subroutine calculates -!>\param subroutine cup_up_aa0(aa0,z,zu,dby,gamma_cup,t_cup, & kbcon,ktop,ierr, & itf,ktf, & @@ -3236,9 +3498,9 @@ subroutine cup_up_aa0(aa0,z,zu,dby,gamma_cup,t_cup, & enddo do k=kts+1,ktf do i=its,itf - if(ierr(i).ne.0) exit - if(k.lt.kbcon(i)) exit - if(k.gt.ktop(i)) exit + if(ierr(i).ne.0) cycle + if(k.lt.kbcon(i)) cycle + if(k.gt.ktop(i)) cycle dz=z(i,k)-z(i,k-1) da=zu(i,k)*dz*(9.81/(1004.*( & (t_cup(i,k)))))*dby(i,k-1)/ & @@ -3253,8 +3515,6 @@ end subroutine cup_up_aa0 !==================================================================== !>\ingroup cu_gf_deep_group -!> This subroutine calculates -!>\param subroutine neg_check(name,j,dt,q,outq,outt,outu,outv, & outqc,pret,its,ite,kts,kte,itf,ktf,ktop) @@ -3603,8 +3863,6 @@ subroutine cup_output_ens_3d(xff_mid,xf_ens,ierr,dellat,dellaq,dellaqc, & end subroutine cup_output_ens_3d !------------------------------------------------------- !>\ingroup cu_gf_deep_group -!> This subroutine calculates -!>\param subroutine cup_up_moisture(name,ierr,z_cup,qc,qrc,pw,pwav, & p_cup,kbcon,ktop,dby,clw_all,xland1, & q,gamma_cup,zu,qes_cup,k22,qe_cup, & @@ -3695,7 +3953,7 @@ subroutine cup_up_moisture(name,ierr,z_cup,qc,qrc,pw,pwav, & prop_b(kts:kte)=0 iall=0 c0=.002 - clwdet=100. + clwdet=50. bdsp=bdispm ! !--- no precip for small clouds @@ -3916,8 +4174,6 @@ end subroutine cup_up_moisture !-------------------------------------------------------------------- !>\ingroup cu_gf_deep_group -!> This function calculates -!>\param real function satvap(temp2) implicit none real(kind=kind_phys) :: temp2, temp, toot, toto, eilog, tsot, & @@ -3943,8 +4199,6 @@ real function satvap(temp2) end function !-------------------------------------------------------------------- !>\ingroup cu_gf_deep_group -!> This subroutine calcualtes -!>\param subroutine get_cloud_bc(mzp,array,x_aver,k22,add) implicit none integer, intent(in) :: mzp,k22 @@ -3971,8 +4225,6 @@ subroutine get_cloud_bc(mzp,array,x_aver,k22,add) end subroutine get_cloud_bc !======================================================================================== !>\ingroup cu_gf_deep_group -!> This subroutine calculates -!>\param subroutine rates_up_pdf(rand_vmas,ipr,name,ktop,ierr,p_cup,entr_rate_2d,hkbo,heo,heso_cup,z_cup, & xland,kstabi,k22,kbcon,its,ite,itf,kts,kte,ktf,zuo,kpbl,ktopdby,csum,pmin_lev) implicit none @@ -4086,8 +4338,6 @@ subroutine rates_up_pdf(rand_vmas,ipr,name,ktop,ierr,p_cup,entr_rate_2d,hkbo,heo end subroutine rates_up_pdf !------------------------------------------------------------------------- !>\ingroup cu_gf_deep_group -!> This subroutine calculates -!>\param subroutine get_zu_zd_pdf_fim(kklev,p,rand_vmas,zubeg,ipr,xland,zuh2,draft,ierr,kb,kt,zu,kts,kte,ktf,max_mass,kpbli,csum,pmin_lev) implicit none @@ -4400,8 +4650,8 @@ subroutine cup_up_aa1bl(aa0,t,tn,q,qo,dtime, & enddo do i=its,itf do k=kts,kbcon(i) - if(ierr(i).ne.0 ) exit -! if(k.gt.kbcon(i)) exit + if(ierr(i).ne.0 ) cycle +! if(k.gt.kbcon(i)) cycle dz = (z_cup (i,k+1)-z_cup (i,k))*g da = dz*(tn(i,k)*(1.+0.608*qo(i,k))-t(i,k)*(1.+0.608*q(i,k)))/dtime @@ -4595,7 +4845,6 @@ function deriv3(xx, xi, yi, ni, m) end function deriv3 !============================================================================================= !>\ingroup cu_gf_deep_group -!> This subroutine calcualtes subroutine get_lateral_massflux(itf,ktf, its,ite, kts,kte & ,ierr,ktop,zo_cup,zuo,cd,entr_rate_2d & ,up_massentro, up_massdetro ,up_massentr, up_massdetr & @@ -4713,7 +4962,6 @@ end subroutine get_lateral_massflux !---meltglac------------------------------------------------- !------------------------------------------------------------------------------------ !>\ingroup cu_gf_deep_group -!> This subroutine calculates subroutine get_partition_liq_ice(ierr,tn,po_cup, p_liq_ice,melting_layer & ,itf,ktf,its,ite, kts,kte, cumulus ) implicit none @@ -4805,7 +5053,6 @@ end subroutine get_partition_liq_ice !------------------------------------------------------------------------------------ !>\ingroup cu_gf_deep_group -!> This subroutine calculates subroutine get_melting_profile(ierr,tn_cup,po_cup, p_liq_ice,melting_layer,qrco & ,pwo,edto,pwdo,melting & ,itf,ktf,its,ite, kts,kte, cumulus ) @@ -4880,7 +5127,6 @@ end subroutine get_melting_profile !---meltglac------------------------------------------------- !-----srf-08aug2017-----begin !>\ingroup cu_gf_deep_group -!> This subroutine calculates subroutine get_cloud_top(name,ktop,ierr,p_cup,entr_rate_2d,hkbo,heo,heso_cup,z_cup, & kstabi,k22,kbcon,its,ite,itf,kts,kte,ktf,zuo,kpbl,klcl,hcot) implicit none diff --git a/physics/cu_gf_driver.F90 b/physics/cu_gf_driver.F90 index 30fe5b8f5..53e26fb46 100644 --- a/physics/cu_gf_driver.F90 +++ b/physics/cu_gf_driver.F90 @@ -1,13 +1,15 @@ !>\file cu_gf_driver.F90 -!! This file is Grell-Freitas cumulus scheme driver. +!! This file is scale-aware Grell-Freitas cumulus scheme driver. + module cu_gf_driver ! DH* TODO: replace constants with arguments to cu_gf_driver_run use physcons , g => con_g, cp => con_cp, xlv => con_hvap, r_v => con_rv use machine , only: kind_phys - use cu_gf_deep, only: cu_gf_deep_run,neg_check,autoconv,aeroevap + use cu_gf_deep, only: cu_gf_deep_run,neg_check,autoconv,aeroevap,fct1d3 use cu_gf_sh , only: cu_gf_sh_run + use module_mp_thompson_make_number_concentrations, only: make_IceNumber, make_DropletNumber implicit none @@ -20,12 +22,7 @@ module cu_gf_driver !> \brief Brief description of the subroutine !! !! \section arg_table_cu_gf_driver_init Argument Table -!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | -!! |----------------------|--------------------|------------------------------------------|-------|------|-----------|-----------|--------|----------| -!! | mpirank | mpi_rank | current MPI-rank | index | 0 | integer | | in | F | -!! | mpiroot | mpi_root | master MPI-rank | index | 0 | integer | | in | F | -!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | -!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | +!! \htmlinclude cu_gf_driver_init.html !! subroutine cu_gf_driver_init(mpirank, mpiroot, errmsg, errflg) @@ -62,58 +59,23 @@ end subroutine cu_gf_driver_finalize ! t = current temp (t2di + physics up to now) !=================== -!> \defgroup cu_gf_group GSD Scale-Aware Grell-Freitas Convection Scheme Module -!>\defgroup cu_gf_driver GSD Grell-Freitas Convection Scheme Driver +!> \defgroup cu_gf_group Grell-Freitas Convection Scheme Module +!! This is the Grell-Freitas scale and aerosol aware scheme. +!>\defgroup cu_gf_driver Grell-Freitas Convection Scheme Driver Module !> \ingroup cu_gf_group +!! This is the Grell-Freitas convection scheme driver module. !! \section arg_table_cu_gf_driver_run Argument Table -!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | -!! |----------------|-----------------------------------------------------------|-----------------------------------------------------|---------------|------|-----------|-----------|--------|----------| -!! | tottracer | number_of_total_tracers | number of total tracers | count | 0 | integer | | in | F | -!! | ntrac | number_of_vertical_diffusion_tracers | number of tracers to diffuse vertically | count | 0 | integer | | in | F | -!! | garea | cell_area | grid cell area | m2 | 1 | real | kind_phys | in | F | -!! | im | horizontal_loop_extent | horizontal loop extent | count | 0 | integer | | in | F | -!! | ix | horizontal_dimension | horizontal dimension | count | 0 | integer | | in | F | -!! | km | vertical_dimension | vertical layer dimension | count | 0 | integer | | in | F | -!! | dt | time_step_for_physics | physics time step | s | 0 | real | kind_phys | in | F | -!! | cactiv | conv_activity_counter | convective activity memory | none | 1 | integer | | inout | F | -!! | forcet | temperature_tendency_due_to_dynamics | temperature tendency due to dynamics only | K s-1 | 2 | real | kind_phys | in | F | -!! | forceqv_spechum| moisture_tendency_due_to_dynamics | moisture tendency due to dynamics only | kg kg-1 s-1 | 2 | real | kind_phys | in | F | -!! | phil | geopotential | layer geopotential | m2 s-2 | 2 | real | kind_phys | in | F | -!! | raincv | lwe_thickness_of_deep_convective_precipitation_amount | deep convective rainfall amount on physics timestep | m | 1 | real | kind_phys | out | F | -!! | qv_spechum | water_vapor_specific_humidity_updated_by_physics | water vapor specific humidity updated by physics | kg kg-1 | 2 | real | kind_phys | inout | F | -!! | t | air_temperature_updated_by_physics | updated temperature | K | 2 | real | kind_phys | inout | F | -!! | cld1d | cloud_work_function | cloud work function | m2 s-2 | 1 | real | kind_phys | out | F | -!! | us | x_wind_updated_by_physics | updated x-direction wind | m s-1 | 2 | real | kind_phys | inout | F | -!! | vs | y_wind_updated_by_physics | updated y-direction wind | m s-1 | 2 | real | kind_phys | inout | F | -!! | t2di | air_temperature | mid-layer temperature | K | 2 | real | kind_phys | in | F | -!! | w | omega | layer mean vertical velocity | Pa s-1 | 2 | real | kind_phys | in | F | -!! | qv2di_spechum | water_vapor_specific_humidity | water vapor specific humidity | kg kg-1 | 2 | real | kind_phys | in | F | -!! | p2di | air_pressure | mean layer pressure | Pa | 2 | real | kind_phys | in | F | -!! | psuri | surface_air_pressure | surface pressure | Pa | 1 | real | kind_phys | in | F | -!! | hbot | vertical_index_at_cloud_base | index for cloud base | index | 1 | integer | | out | F | -!! | htop | vertical_index_at_cloud_top | index for cloud top | index | 1 | integer | | out | F | -!! | kcnv | flag_deep_convection | deep convection: 0=no, 1=yes | flag | 1 | integer | | out | F | -!! | xland | sea_land_ice_mask | landmask: sea/land/ice=0/1/2 | flag | 1 | integer | | in | F | -!! | hfx2 | kinematic_surface_upward_sensible_heat_flux | kinematic surface upward sensible heat flux | K m s-1 | 1 | real | kind_phys | in | F | -!! | qfx2 | kinematic_surface_upward_latent_heat_flux | kinematic surface upward latent heat flux | kg kg-1 m s-1 | 1 | real | kind_phys | in | F | -!! | clw | convective_transportable_tracers | cloud water and other convective trans. tracers | kg kg-1 | 3 | real | kind_phys | inout | F | -!! | pbl | atmosphere_boundary_layer_thickness | PBL thickness | m | 1 | real | kind_phys | in | F | -!! | ud_mf | instantaneous_atmosphere_updraft_convective_mass_flux | (updraft mass flux) * delt | kg m-2 | 2 | real | kind_phys | out | F | -!! | dd_mf | instantaneous_atmosphere_downdraft_convective_mass_flux | (downdraft mass flux) * delt | kg m-2 | 2 | real | kind_phys | out | F | -!! | dt_mf | instantaneous_atmosphere_detrainment_convective_mass_flux | (detrainment mass flux) * delt | kg m-2 | 2 | real | kind_phys | out | F | -!! | cnvw_moist | convective_cloud_water_mixing_ratio | moist convective cloud water mixing ratio | kg kg-1 | 2 | real | kind_phys | out | F | -!! | cnvc | convective_cloud_cover | convective cloud cover | frac | 2 | real | kind_phys | out | F | -!! | imfshalcnv | flag_for_mass_flux_shallow_convection_scheme | flag for mass-flux shallow convection scheme | flag | 0 | integer | | in | F | -!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | -!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | +!! \htmlinclude cu_gf_driver_run.html !! !>\section gen_gf_driver GSD GF Cumulus Scheme General Algorithm !> @{ - subroutine cu_gf_driver_run(tottracer,ntrac,garea,im,ix,km,dt,cactiv, & - forcet,forceqv_spechum,phil,raincv,qv_spechum,t,cld1d, & - us,vs,t2di,w,qv2di_spechum,p2di,psuri, & - hbot,htop,kcnv,xland,hfx2,qfx2,clw, & - pbl,ud_mf,dd_mf,dt_mf,cnvw_moist,cnvc,imfshalcnv,errmsg,errflg) + subroutine cu_gf_driver_run(ntracer,garea,im,ix,km,dt,cactiv, & + forcet,forceqv_spechum,phil,raincv,qv_spechum,t,cld1d, & + us,vs,t2di,w,qv2di_spechum,p2di,psuri, & + hbot,htop,kcnv,xland,hfx2,qfx2,cliw,clcw, & + pbl,ud_mf,dd_mf,dt_mf,cnvw_moist,cnvc,imfshalcnv, & + nwfa,con_rd,gq0,ntinc,ntlnc,imp_physics,imp_physics_thompson, & + errmsg,errflg) !------------------------------------------------------------- implicit none integer, parameter :: maxiens=1 @@ -134,7 +96,7 @@ subroutine cu_gf_driver_run(tottracer,ntrac,garea,im,ix,km,dt,cactiv, & integer :: ishallow_g3 ! depend on imfshalcnv !------------------------------------------------------------- integer :: its,ite, jts,jte, kts,kte - integer, intent(in ) :: im,ix,km,ntrac,tottracer + integer, intent(in ) :: im,ix,km,ntracer real(kind=kind_phys), dimension( ix , km ), intent(in ) :: forcet,forceqv_spechum,w,phil real(kind=kind_phys), dimension( ix , km ), intent(inout ) :: t,us,vs @@ -142,18 +104,18 @@ subroutine cu_gf_driver_run(tottracer,ntrac,garea,im,ix,km,dt,cactiv, & real(kind=kind_phys), dimension( ix,4 ) :: rand_clos real(kind=kind_phys), dimension( ix , km, 11 ) :: gdc,gdc2 real(kind=kind_phys), dimension( ix , km ), intent(out ) :: cnvw_moist,cnvc - real(kind=kind_phys), dimension( ix , km,tottracer+2 ), intent(inout ) :: clw + real(kind=kind_phys), dimension( ix , km ), intent(inout ) :: cliw, clcw -!hj change from ix to im +! change from ix to im integer, dimension (im), intent(inout) :: hbot,htop,kcnv integer, dimension (im), intent(in) :: xland real(kind=kind_phys), dimension (im), intent(in) :: pbl integer, dimension (ix) :: tropics -! ruc variable +! ruc variable real(kind=kind_phys), dimension (im) :: hfx2,qfx2,psuri real(kind=kind_phys), dimension (im,km) :: ud_mf,dd_mf,dt_mf real(kind=kind_phys), dimension (im), intent(inout) :: raincv,cld1d -!hj end change ix to im +! end change ix to im real(kind=kind_phys), dimension (ix,km) :: t2di,p2di ! Specific humidity from FV3 real(kind=kind_phys), dimension (ix,km), intent(in) :: qv2di_spechum @@ -163,80 +125,76 @@ subroutine cu_gf_driver_run(tottracer,ntrac,garea,im,ix,km,dt,cactiv, & ! real(kind=kind_phys), dimension( im ),intent(in) :: garea real(kind=kind_phys), intent(in ) :: dt + +! additional variables for number concentrations + real(kind=kind_phys), intent(in) :: nwfa(1:im,1:km) + real(kind=kind_phys), intent(in) :: con_rd + real(kind=kind_phys), dimension(im,km,ntracer), intent(inout) :: gq0 + integer, intent(in) :: imp_physics,imp_physics_thompson,ntlnc,ntinc + integer, intent(in ) :: imfshalcnv character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg -!hj define locally for now. - integer, dimension(im),intent(inout) :: cactiv ! hli for gf -!hj change from ix to im +! define locally for now. + integer, dimension(im),intent(inout) :: cactiv integer, dimension(im) :: k22_shallow,kbcon_shallow,ktop_shallow real(kind=kind_phys), dimension(im) :: ht -!hj change -! -!+lxz -!hj real(kind=kind_phys) :: dx real(kind=kind_phys), dimension(im) :: dx -! local vars -!hj change ix to im - real(kind=kind_phys), dimension (im,km) :: outt,outq,outqc,phh,subm,cupclw,cupclws - real(kind=kind_phys), dimension (im,km) :: dhdt,zu,zus,zd,phf,zum,zdm,outum,outvm - real(kind=kind_phys), dimension (im,km) :: outts,outqs,outqcs,outu,outv,outus,outvs - real(kind=kind_phys), dimension (im,km) :: outtm,outqm,outqcm,submm,cupclwm - real(kind=kind_phys), dimension (im,km) :: cnvwt,cnvwts,cnvwtm - real(kind=kind_phys), dimension (im,km) :: hco,hcdo,zdo,zdd,hcom,hcdom,zdom - real(kind=kind_phys), dimension (km) :: zh - real(kind=kind_phys), dimension (im) :: tau_ecmwf,edt,edtm,edtd,ter11,aa0,xlandi - real(kind=kind_phys), dimension (im) :: pret,prets,pretm,hexec - real(kind=kind_phys), dimension (im,10) :: forcing,forcing2 -!+lxz - integer, dimension (im) :: kbcon, ktop,ierr,ierrs,ierrm,kpbli - integer, dimension (im) :: k22s,kbcons,ktops,k22,jmin,jminm - integer, dimension (im) :: kbconm,ktopm,k22m -!hj end change ix to im -!.lxz - integer :: iens,ibeg,iend,jbeg,jend,n - integer :: ibegh,iendh,jbegh,jendh - integer :: ibegc,iendc,jbegc,jendc,kstop - real(kind=kind_phys) :: rho_dryar,temp - real(kind=kind_phys) :: pten,pqen,paph,zrho,pahfs,pqhfl,zkhvfl,pgeoh -!hj 10/11/2016: ipn is an input in fim. set it to zero here. - integer, parameter :: ipn = 0 + real(kind=kind_phys), dimension (im,km) :: outt,outq,outqc,phh,subm,cupclw,cupclws + real(kind=kind_phys), dimension (im,km) :: dhdt,zu,zus,zd,phf,zum,zdm,outum,outvm + real(kind=kind_phys), dimension (im,km) :: outts,outqs,outqcs,outu,outv,outus,outvs + real(kind=kind_phys), dimension (im,km) :: outtm,outqm,outqcm,submm,cupclwm + real(kind=kind_phys), dimension (im,km) :: cnvwt,cnvwts,cnvwtm + real(kind=kind_phys), dimension (im,km) :: hco,hcdo,zdo,zdd,hcom,hcdom,zdom + real(kind=kind_phys), dimension (km) :: zh + real(kind=kind_phys), dimension (im) :: tau_ecmwf,edt,edtm,edtd,ter11,aa0,xlandi + real(kind=kind_phys), dimension (im) :: pret,prets,pretm,hexec + real(kind=kind_phys), dimension (im,10) :: forcing,forcing2 + + integer, dimension (im) :: kbcon, ktop,ierr,ierrs,ierrm,kpbli + integer, dimension (im) :: k22s,kbcons,ktops,k22,jmin,jminm + integer, dimension (im) :: kbconm,ktopm,k22m + + integer :: iens,ibeg,iend,jbeg,jend,n + integer :: ibegh,iendh,jbegh,jendh + integer :: ibegc,iendc,jbegc,jendc,kstop + real(kind=kind_phys), dimension(im,km) :: rho_dryar + real(kind=kind_phys) :: pten,pqen,paph,zrho,pahfs,pqhfl,zkhvfl,pgeoh + integer, parameter :: ipn = 0 ! ! basic environmental input includes moisture convergence (mconv) ! omega (omeg), windspeed (us,vs), and a flag (ierr) to turn off ! convection for this call only and at that particular gridpoint ! -!hj 10/11/2016: change ix to im. - real(kind=kind_phys), dimension (im,km) :: qcheck,zo,t2d,q2d,po,p2d,rhoi - real(kind=kind_phys), dimension (im,km) :: tn,qo,tshall,qshall,dz8w,omeg - real(kind=kind_phys), dimension (im) :: ccn,z1,psur,cuten,cutens,cutenm - real(kind=kind_phys), dimension (im) :: umean,vmean,pmean - real(kind=kind_phys), dimension (im) :: xmbs,xmbs2,xmb,xmbm,xmb_dumm,mconv -!hj end change ix to im - - integer :: i,j,k,icldck,ipr,jpr,jpr_deep,ipr_deep - integer :: itf,jtf,ktf,iss,jss,nbegin,nend - integer :: high_resolution - real(kind=kind_phys) :: clwtot,clwtot1,excess,tcrit,tscl_kf,dp,dq,sub_spread,subcenter - real(kind=kind_phys) :: dsubclw,dsubclws,dsubclwm,ztm,ztq,hfm,qfm,rkbcon,rktop !-lxz -!hj change ix to im - real(kind=kind_phys), dimension (im) :: flux_tun,tun_rad_mid,tun_rad_shall,tun_rad_deep - character*50 :: ierrc(im),ierrcm(im) - character*50 :: ierrcs(im) -!hj end change ix to im -! ruc variable -!hj hfx2 -- sensible heat flux (k m/s), positive upward from sfc -!hj qfx2 -- latent heat flux (kg/kg m/s), positive upward from sfc -!hj gf needs them in w/m2. define hfx and qfx after simple unit conversion - real(kind=kind_phys), dimension (im) :: hfx,qfx - real(kind=kind_phys) tem,tem1,tf,tcr,tcrf - - parameter (tf=243.16, tcr=270.16, tcrf=1.0/(tcr-tf)) - !parameter (tf=263.16, tcr=273.16, tcrf=1.0/(tcr-tf)) - !parameter (tf=233.16, tcr=263.16, tcrf=1.0/(tcr-tf)) - !parameter (tf=258.16, tcr=273.16, tcrf=1.0/(tcr-tf)) ! as fim - ! initialize ccpp error handling variables + real(kind=kind_phys), dimension (im,km) :: qcheck,zo,t2d,q2d,po,p2d,rhoi + real(kind=kind_phys), dimension (im,km) :: tn,qo,tshall,qshall,dz8w,omeg + real(kind=kind_phys), dimension (im) :: ccn,z1,psur,cuten,cutens,cutenm + real(kind=kind_phys), dimension (im) :: umean,vmean,pmean + real(kind=kind_phys), dimension (im) :: xmbs,xmbs2,xmb,xmbm,xmb_dumm,mconv + + integer :: i,j,k,icldck,ipr,jpr,jpr_deep,ipr_deep + integer :: itf,jtf,ktf,iss,jss,nbegin,nend + integer :: high_resolution + real(kind=kind_phys) :: clwtot,clwtot1,excess,tcrit,tscl_kf,dp,dq,sub_spread,subcenter + real(kind=kind_phys) :: dsubclw,dsubclws,dsubclwm,dtime_max,ztm,ztq,hfm,qfm,rkbcon,rktop + real(kind=kind_phys), dimension(km) :: massflx,trcflx_in1,clw_in1,clw_ten1,po_cup +! real(kind=kind_phys), dimension(km) :: trcflx_in2,clw_in2,clw_ten2 + real(kind=kind_phys), dimension (im) :: flux_tun,tun_rad_mid,tun_rad_shall,tun_rad_deep + character*50 :: ierrc(im),ierrcm(im) + character*50 :: ierrcs(im) +! ruc variable +! hfx2 -- sensible heat flux (k m/s), positive upward from sfc +! qfx2 -- latent heat flux (kg/kg m/s), positive upward from sfc +! gf needs them in w/m2. define hfx and qfx after simple unit conversion + real(kind=kind_phys), dimension (im) :: hfx,qfx + real(kind=kind_phys) tem,tem1,tf,tcr,tcrf + + parameter (tf=243.16, tcr=270.16, tcrf=1.0/(tcr-tf)) + !parameter (tf=263.16, tcr=273.16, tcrf=1.0/(tcr-tf)) + !parameter (tf=233.16, tcr=263.16, tcrf=1.0/(tcr-tf)) + !parameter (tf=258.16, tcr=273.16, tcrf=1.0/(tcr-tf)) ! as fim + ! initialize ccpp error handling variables errmsg = '' errflg = 0 ! @@ -252,132 +210,132 @@ subroutine cu_gf_driver_run(tottracer,ntrac,garea,im,ix,km,dt,cactiv, & ! ! these should be coming in from outside ! -! print*,'hli in gf cactiv',cactiv -! cactiv(:) = 0 +! cactiv(:) = 0 rand_mom(:) = 0. rand_vmas(:) = 0. rand_clos(:,:) = 0. +! its=1 ite=im + itf=ite jts=1 jte=1 + jtf=jte kts=1 kte=km ktf=kte-1 ! tropics(:)=0 ! -!> - tuning constants for radiation coupling +!> - Set tuning constants for radiation coupling ! - tun_rad_shall(:)=.02 - tun_rad_mid(:)=.15 - tun_rad_deep(:)=.13 - edt(:)=0. - edtm(:)=0. - edtd(:)=0. - zdd(:,:)=0. - flux_tun(:)=5. -!hj 10/11/2016 dx and tscl_kf are replaced with input dx(i), is dlength. - ! dx for scale awareness -!hj dx=40075000./float(lonf) -!hj tscl_kf=dx/25000. - ccn(its:ite)=150. - ! - if (imfshalcnv == 3) then - ishallow_g3 = 1 - else - ishallow_g3 = 0 - end if - high_resolution=0 - subcenter=0. - iens=1 + tun_rad_shall(:)=.02 + tun_rad_mid(:)=.15 + tun_rad_deep(:)=.13 + edt(:)=0. + edtm(:)=0. + edtd(:)=0. + zdd(:,:)=0. + flux_tun(:)=5. +! 10/11/2016 dx and tscl_kf are replaced with input dx(i), is dlength. +! dx for scale awareness +! dx=40075000./float(lonf) +! tscl_kf=dx/25000. + ccn(its:ite)=150. + + if (imfshalcnv == 3) then + ishallow_g3 = 1 + else + ishallow_g3 = 0 + end if + high_resolution=0 + subcenter=0. + iens=1 ! ! these can be set for debugging ! - ipr=0 - jpr=0 - ipr_deep=0 - jpr_deep= 0 !53322 ! 528196 !0 ! 1136 !0 !421755 !3536 + ipr=0 + jpr=0 + ipr_deep=0 + jpr_deep= 0 !53322 ! 528196 !0 ! 1136 !0 !421755 !3536 ! ! - ibeg=its - iend=ite - tcrit=258. - - itf=ite - ktf=kte-1 - jtf=jte - ztm=0. - ztq=0. - hfm=0. - qfm=0. - ud_mf =0. - dd_mf =0. - dt_mf =0. - tau_ecmwf(:)=0. -! - j=1 - ht(:)=phil(:,1)/g - do i=its,ite - cld1d(i)=0. - zo(i,:)=phil(i,:)/g - dz8w(i,1)=zo(i,2)-zo(i,1) - zh(1)=0. - kpbli(i)=2 - do k=kts+1,ktf - dz8w(i,k)=zo(i,k+1)-zo(i,k) - enddo - do k=kts+1,ktf - zh(k)=zh(k-1)+dz8w(i,k-1) - if(zh(k).gt.pbl(i))then - kpbli(i)=max(2,k) - exit - endif - enddo - enddo - do i= its,itf - forcing(i,:)=0. - forcing2(i,:)=0. - ccn(i)=100. - hbot(i) =kte - htop(i) =kts - raincv(i)=0. - xlandi(i)=real(xland(i)) -! if(abs(xlandi(i)-1.).le.1.e-3) tun_rad_shall(i)=.15 -! if(abs(xlandi(i)-1.).le.1.e-3) flux_tun(i)=1.5 + ibeg=its + iend=ite + tcrit=258. + + ztm=0. + ztq=0. + hfm=0. + qfm=0. + ud_mf =0. + dd_mf =0. + dt_mf =0. + tau_ecmwf(:)=0. +! + j=1 + ht(:)=phil(:,1)/g + do i=its,ite + cld1d(i)=0. + zo(i,:)=phil(i,:)/g + dz8w(i,1)=zo(i,2)-zo(i,1) + zh(1)=0. + kpbli(i)=2 + do k=kts+1,ktf + dz8w(i,k)=zo(i,k+1)-zo(i,k) + enddo + do k=kts+1,ktf + zh(k)=zh(k-1)+dz8w(i,k-1) + if(zh(k).gt.pbl(i))then + kpbli(i)=max(2,k) + exit + endif + enddo enddo + do i= its,itf - mconv(i)=0. + forcing(i,:)=0. + forcing2(i,:)=0. + ccn(i)=100. + hbot(i) =kte + htop(i) =kts + raincv(i)=0. + xlandi(i)=real(xland(i)) +! if(abs(xlandi(i)-1.).le.1.e-3) tun_rad_shall(i)=.15 +! if(abs(xlandi(i)-1.).le.1.e-3) flux_tun(i)=1.5 enddo - do k=kts,kte do i= its,itf - omeg(i,k)=0. - zu(i,k)=0. - zum(i,k)=0. - zus(i,k)=0. - zd(i,k)=0. - zdm(i,k)=0. + mconv(i)=0. enddo + do k=kts,kte + do i= its,itf + omeg(i,k)=0. + zu(i,k)=0. + zum(i,k)=0. + zus(i,k)=0. + zd(i,k)=0. + zdm(i,k)=0. + enddo enddo psur(:)=0.01*psuri(:) do i=its,itf - ter11(i)=max(0.,ht(i)) + ter11(i)=max(0.,ht(i)) enddo do k=kts,kte - do i=its,ite - cnvw(i,k)=0. - cnvc(i,k)=0. - gdc(i,k,1)=0. - gdc(i,k,2)=0. - gdc(i,k,3)=0. - gdc(i,k,4)=0. - gdc(i,k,7)=0. - gdc(i,k,8)=0. - gdc(i,k,9)=0. - gdc(i,k,10)=0. - gdc2(i,k,1)=0. - enddo + do i=its,ite + cnvw(i,k)=0. + cnvc(i,k)=0. + gdc(i,k,1)=0. + gdc(i,k,2)=0. + gdc(i,k,3)=0. + gdc(i,k,4)=0. + gdc(i,k,7)=0. + gdc(i,k,8)=0. + gdc(i,k,9)=0. + gdc(i,k,10)=0. + gdc2(i,k,1)=0. + enddo enddo ierr(:)=0 ierrm(:)=0 @@ -450,88 +408,80 @@ subroutine cu_gf_driver_run(tottracer,ntrac,garea,im,ix,km,dt,cactiv, & subm(:,:)=0. dhdt(:,:)=0. - !print*,'hli t2di',t2di - !print*,'hli forcet',forcet do k=kts,ktf - do i=its,itf - p2d(i,k)=0.01*p2di(i,k) - po(i,k)=p2d(i,k) !*.01 - rhoi(i,k) = 100.*p2d(i,k)/(287.04*(t2di(i,k)*(1.+0.608*qv2di(i,k)))) - qcheck(i,k)=qv(i,k) - tn(i,k)=t(i,k)!+forcet(i,k)*dt - qo(i,k)=max(1.e-16,qv(i,k))!+forceqv(i,k)*dt - t2d(i,k)=t2di(i,k)-forcet(i,k)*dt - !print*,'hli t2di(i,k),forcet(i,k),dt,t2d(i,k)',t2di(i,k),forcet(i,k),dt,t2d(i,k) - q2d(i,k)=max(1.e-16,qv2di(i,k)-forceqv(i,k)*dt) - if(qo(i,k).lt.1.e-16)qo(i,k)=1.e-16 - tshall(i,k)=t2d(i,k) - qshall(i,k)=q2d(i,k) -!hj if(ipn.eq.jpr_deep)then -!hj write(12,123)k,dt,p2d(i,k),t2d(i,k),tn(i,k),q2d(i,k),qo(i,k),forcet(i,k) -!hj endif - enddo + do i=its,itf + p2d(i,k)=0.01*p2di(i,k) + po(i,k)=p2d(i,k) !*.01 + rhoi(i,k) = 100.*p2d(i,k)/(287.04*(t2di(i,k)*(1.+0.608*qv2di(i,k)))) + qcheck(i,k)=qv(i,k) + tn(i,k)=t(i,k)!+forcet(i,k)*dt + qo(i,k)=max(1.e-16,qv(i,k))!+forceqv(i,k)*dt + t2d(i,k)=t2di(i,k)-forcet(i,k)*dt + q2d(i,k)=max(1.e-16,qv2di(i,k)-forceqv(i,k)*dt) + if(qo(i,k).lt.1.e-16)qo(i,k)=1.e-16 + tshall(i,k)=t2d(i,k) + qshall(i,k)=q2d(i,k) + enddo enddo 123 format(1x,i2,1x,2(1x,f8.0),1x,2(1x,f8.3),3(1x,e13.5)) do i=its,itf - do k=kts,kpbli(i) + do k=kts,kpbli(i) tshall(i,k)=t(i,k) qshall(i,k)=max(1.e-16,qv(i,k)) - enddo + enddo enddo ! -!hj converting hfx2 and qfx2 to w/m2 -!hj hfx=cp*rho*hfx2 -!hj qfx=xlv*qfx2 +! converting hfx2 and qfx2 to w/m2 +! hfx=cp*rho*hfx2 +! qfx=xlv*qfx2 do i=its,itf - hfx(i)=hfx2(i)*cp*rhoi(i,1) - qfx(i)=qfx2(i)*xlv*rhoi(i,1) - dx(i) = sqrt(garea(i)) - !print*,'hli dx', dx(i) + hfx(i)=hfx2(i)*cp*rhoi(i,1) + qfx(i)=qfx2(i)*xlv*rhoi(i,1) + dx(i) = sqrt(garea(i)) enddo -!hj write(0,*),'hfx',hfx(3),qfx(3),rhoi(3,1) -!hj + do i=its,itf - do k=kts,kpbli(i) - tn(i,k)=t(i,k) - qo(i,k)=max(1.e-16,qv(i,k)) - enddo + do k=kts,kpbli(i) + tn(i,k)=t(i,k) + qo(i,k)=max(1.e-16,qv(i,k)) + enddo enddo nbegin=0 nend=0 - do i=its,itf - do k=kts,kpbli(i) - dhdt(i,k)=cp*(forcet(i,k)+(t(i,k)-t2di(i,k))/dt) + & - xlv*(forceqv(i,k)+(qv(i,k)-qv2di(i,k))/dt) -! tshall(i,k)=t(i,k) -! qshall(i,k)=qv(i,k) - enddo - enddo - do k= kts+1,ktf-1 - do i = its,itf - if((p2d(i,1)-p2d(i,k)).gt.150.and.p2d(i,k).gt.300)then - dp=-.5*(p2d(i,k+1)-p2d(i,k-1)) - umean(i)=umean(i)+us(i,k)*dp - vmean(i)=vmean(i)+vs(i,k)*dp - pmean(i)=pmean(i)+dp - endif - enddo + do i=its,itf + do k=kts,kpbli(i) + dhdt(i,k)=cp*(forcet(i,k)+(t(i,k)-t2di(i,k))/dt) + & + xlv*(forceqv(i,k)+(qv(i,k)-qv2di(i,k))/dt) +! tshall(i,k)=t(i,k) +! qshall(i,k)=qv(i,k) enddo - do k=kts,ktf-1 + enddo + do k= kts+1,ktf-1 do i = its,itf - omeg(i,k)= w(i,k) !-g*rhoi(i,k)*w(i,k) -! dq=(q2d(i,k+1)-q2d(i,k)) -! mconv(i)=mconv(i)+omeg(i,k)*dq/g - enddo + if((p2d(i,1)-p2d(i,k)).gt.150.and.p2d(i,k).gt.300)then + dp=-.5*(p2d(i,k+1)-p2d(i,k-1)) + umean(i)=umean(i)+us(i,k)*dp + vmean(i)=vmean(i)+vs(i,k)*dp + pmean(i)=pmean(i)+dp + endif enddo + enddo + do k=kts,ktf-1 do i = its,itf - if(mconv(i).lt.0.)mconv(i)=0. + omeg(i,k)= w(i,k) !-g*rhoi(i,k)*w(i,k) +! dq=(q2d(i,k+1)-q2d(i,k)) +! mconv(i)=mconv(i)+omeg(i,k)*dq/g enddo + enddo + do i = its,itf + if(mconv(i).lt.0.)mconv(i)=0. + enddo ! !---- call cumulus parameterization ! if(ishallow_g3.eq.1)then -! + do i=its,ite ierrs(i)=0 ierrm(i)=0 @@ -539,14 +489,13 @@ subroutine cu_gf_driver_run(tottracer,ntrac,garea,im,ix,km,dt,cactiv, & ! !> - Call shallow: cu_gf_sh_run() ! - ! print*,'hli bf shallow t2d',t2d call cu_gf_sh_run (us,vs, & ! input variables, must be supplied zo,t2d,q2d,ter11,tshall,qshall,p2d,psur,dhdt,kpbli, & - rhoi,hfx,qfx,xlandi,ichoice_s,tcrit,dt, & + rhoi,hfx,qfx,xlandi,ichoice_s,tcrit,dt, & ! input variables. ierr should be initialized to zero or larger than zero for ! turning off shallow convection for grid points - zus,xmbs,kbcons,ktops,k22s,ierrs,ierrcs, & + zus,xmbs,kbcons,ktops,k22s,ierrs,ierrcs, & ! output tendencies outts,outqs,outqcs,outus,outvs,cnvwt,prets,cupclws, & ! dimesnional variables @@ -556,6 +505,7 @@ subroutine cu_gf_driver_run(tottracer,ntrac,garea,im,ix,km,dt,cactiv, & do i=its,itf if(xmbs(i).gt.0.)cutens(i)=1. enddo +!> - Call neg_check() for GF shallow convection call neg_check('shallow',ipn,dt,qcheck,outqs,outts,outus,outvs, & outqcs,prets,its,ite,kts,kte,itf,ktf,ktops) endif @@ -563,8 +513,8 @@ subroutine cu_gf_driver_run(tottracer,ntrac,garea,im,ix,km,dt,cactiv, & ipr=0 jpr_deep=0 !340765 !> - Call cu_gf_deep_run() for middle GF convection - if(imid_gf == 1)then - call cu_gf_deep_run( & + if(imid_gf == 1)then + call cu_gf_deep_run( & itf,ktf,its,ite, kts,kte & ,dicycle_m & ,ichoicem & @@ -633,15 +583,16 @@ subroutine cu_gf_driver_run(tottracer,ntrac,garea,im,ix,km,dt,cactiv, & ,jminm,tropics) do i=its,itf - do k=kts,ktf + do k=kts,ktf qcheck(i,k)=qv(i,k) +outqs(i,k)*dt + enddo enddo - enddo +!> - Call neg_check() for middle GF convection call neg_check('mid',ipn,dt,qcheck,outqm,outtm,outum,outvm, & outqcm,pretm,its,ite,kts,kte,itf,ktf,ktopm) - endif + endif !> - Call cu_gf_deep_run() for deep GF convection - if(ideep.eq.1)then + if(ideep.eq.1)then call cu_gf_deep_run( & itf,ktf,its,ite, kts,kte & @@ -711,14 +662,15 @@ subroutine cu_gf_driver_run(tottracer,ntrac,garea,im,ix,km,dt,cactiv, & #endif ,k22 & ,jmin,tropics) - jpr=0 - ipr=0 - do i=its,itf - do k=kts,ktf - qcheck(i,k)=qv(i,k) +(outqs(i,k)+outqm(i,k))*dt - enddo - enddo - call neg_check('deep',ipn,dt,qcheck,outq,outt,outu,outv, & + jpr=0 + ipr=0 + do i=its,itf + do k=kts,ktf + qcheck(i,k)=qv(i,k) +(outqs(i,k)+outqm(i,k))*dt + enddo + enddo +!> - Call neg_check() for deep GF convection + call neg_check('deep',ipn,dt,qcheck,outq,outt,outu,outv, & outqc,pret,its,ite,kts,kte,itf,ktf,ktop) ! endif @@ -767,6 +719,11 @@ subroutine cu_gf_driver_run(tottracer,ntrac,garea,im,ix,km,dt,cactiv, & enddo ! do i=its,itf + massflx(:)=0. + trcflx_in1(:)=0. + clw_in1(:)=0. + clw_ten1(:)=0. + po_cup(:)=0. kstop=kts if(ktopm(i).gt.kts .or. ktop(i).gt.kts)kstop=max(ktopm(i),ktop(i)) if(ktops(i).gt.kts)kstop=max(kstop,ktops(i)) @@ -775,7 +732,8 @@ subroutine cu_gf_driver_run(tottracer,ntrac,garea,im,ix,km,dt,cactiv, & if(kbcon(i).gt.2 .or. kbconm(i).gt.2)then hbot(i)=max(kbconm(i),kbcon(i)) !jmin(i) endif -!kbcon(i) + + dtime_max=dt do k=kts,kstop cnvc(i,k) = 0.04 * log(1. + 675. * zu(i,k) * xmb(i)) + & 0.04 * log(1. + 675. * zum(i,k) * xmbm(i)) + & @@ -791,66 +749,117 @@ subroutine cu_gf_driver_run(tottracer,ntrac,garea,im,ix,km,dt,cactiv, & us(i,k)=us(i,k)+outu(i,k)*cuten(i)*dt +outum(i,k)*cutenm(i)*dt +outus(i,k)*cutens(i)*dt vs(i,k)=vs(i,k)+outv(i,k)*cuten(i)*dt +outvm(i,k)*cutenm(i)*dt +outvs(i,k)*cutens(i)*dt -!hj 10/11/2016: don't need gdc and gdc2 yet for gsm. -!hli 08/18/2017: couple gdc to radiation - gdc(i,k,1)= max(0.,tun_rad_shall(i)*cupclws(i,k)*cutens(i)) ! my mod + gdc(i,k,1)= max(0.,tun_rad_shall(i)*cupclws(i,k)*cutens(i)) ! my mod gdc2(i,k,1)=max(0.,tun_rad_deep(i)*(cupclwm(i,k)*cutenm(i)+cupclw(i,k)*cuten(i))) gdc(i,k,2)=(outt(i,k))*86400. gdc(i,k,3)=(outtm(i,k))*86400. gdc(i,k,4)=(outts(i,k))*86400. gdc(i,k,7)=-(gdc(i,k,7)-sqrt(us(i,k)**2 +vs(i,k)**2))/dt - !gdc(i,k,8)=(outq(i,k))*86400.*xlv/cp + !gdc(i,k,8)=(outq(i,k))*86400.*xlv/cp gdc(i,k,8)=(outqm(i,k)+outqs(i,k)+outq(i,k))*86400.*xlv/cp gdc(i,k,9)=gdc(i,k,2)+gdc(i,k,3)+gdc(i,k,4) - if((gdc(i,k,1).ge.0.5).or.(gdc2(i,k,1).ge.0.5))then - print*,'hli gdc(i,k,1),gdc2(i,k,1)',gdc(i,k,1),gdc2(i,k,1) - endif ! !> - Calculate subsidence effect on clw ! - dsubclw=0. - dsubclwm=0. - dsubclws=0. +! dsubclw=0. +! dsubclwm=0. +! dsubclws=0. +! dp=100.*(p2d(i,k)-p2d(i,k+1)) +! if (clcw(i,k) .gt. -999.0 .and. clcw(i,k+1) .gt. -999.0 )then +! clwtot = cliw(i,k) + clcw(i,k) +! clwtot1= cliw(i,k+1) + clcw(i,k+1) +! dsubclw=((-edt(i)*zd(i,k+1)+zu(i,k+1))*clwtot1 & +! -(-edt(i)*zd(i,k) +zu(i,k)) *clwtot )*g/dp +! dsubclwm=((-edtm(i)*zdm(i,k+1)+zum(i,k+1))*clwtot1 & +! -(-edtm(i)*zdm(i,k) +zum(i,k)) *clwtot )*g/dp +! dsubclws=(zus(i,k+1)*clwtot1-zus(i,k)*clwtot)*g/dp +! dsubclw=dsubclw+(zu(i,k+1)*clwtot1-zu(i,k)*clwtot)*g/dp +! dsubclwm=dsubclwm+(zum(i,k+1)*clwtot1-zum(i,k)*clwtot)*g/dp +! dsubclws=dsubclws+(zus(i,k+1)*clwtot1-zus(i,k)*clwtot)*g/dp +! endif +! tem = dt*(outqcs(i,k)*cutens(i)+outqc(i,k)*cuten(i) & +! +outqcm(i,k)*cutenm(i) & +! +dsubclw*xmb(i)+dsubclws*xmbs(i)+dsubclwm*xmbm(i) & +! ) +! tem1 = max(0.0, min(1.0, (tcr-t(i,k))*tcrf)) +! if (clcw(i,k) .gt. -999.0) then +! cliw(i,k) = max(0.,cliw(i,k) + tem * tem1) ! ice +! clcw(i,k) = max(0.,clcw(i,k) + tem *(1.0-tem1)) ! water +! else +! cliw(i,k) = max(0.,cliw(i,k) + tem) +! endif +! +! enddo + +!> - FCT treats subsidence effect to cloud ice/water (begin) dp=100.*(p2d(i,k)-p2d(i,k+1)) - if (clw(i,k,2) .gt. -999.0 .and. clw(i,k+1,2) .gt. -999.0 )then - clwtot = clw(i,k,1) + clw(i,k,2) - clwtot1= clw(i,k+1,1) + clw(i,k+1,2) - dsubclw=((-edt(i)*zd(i,k+1)+zu(i,k+1))*clwtot1 & - -(-edt(i)*zd(i,k) +zu(i,k)) *clwtot )*g/dp - dsubclwm=((-edtm(i)*zdm(i,k+1)+zum(i,k+1))*clwtot1 & - -(-edtm(i)*zdm(i,k) +zum(i,k)) *clwtot )*g/dp - dsubclws=(zus(i,k+1)*clwtot1-zus(i,k)*clwtot)*g/dp - dsubclw=dsubclw+(zu(i,k+1)*clwtot1-zu(i,k)*clwtot)*g/dp - dsubclwm=dsubclwm+(zum(i,k+1)*clwtot1-zum(i,k)*clwtot)*g/dp - dsubclws=dsubclws+(zus(i,k+1)*clwtot1-zus(i,k)*clwtot)*g/dp + dtime_max=min(dtime_max,.5*dp) + po_cup(k)=.5*(p2d(i,k)+p2d(i,k+1)) + if (clcw(i,k) .gt. -999.0 .and. clcw(i,k+1) .gt. -999.0 )then + clwtot = cliw(i,k) + clcw(i,k) + if(clwtot.lt.1.e-32)clwtot=0. + clwtot1= cliw(i,k+1) + clcw(i,k+1) + if(clwtot1.lt.1.e-32)clwtot1=0. + clw_in1(k)=clwtot + massflx(k)=-(xmb(i) *( zu(i,k)- edt(i)* zd(i,k))) & + -(xmbm(i)*(zdm(i,k)-edtm(i)*zdm(i,k))) & + -(xmbs(i)*zus(i,k)) + trcflx_in1(k)=massflx(k)*.5*(clwtot+clwtot1) endif - tem = dt*(outqcs(i,k)*cutens(i)+outqc(i,k)*cuten(i) & + enddo + + massflx (1)=0. + trcflx_in1(1)=0. + call fct1d3 (kstop,kte,dtime_max,po_cup, & + clw_in1,massflx,trcflx_in1,clw_ten1,g) + + do k=1,kstop + tem = dt*(outqcs(i,k)*cutens(i)+outqc(i,k)*cuten(i) & +outqcm(i,k)*cutenm(i) & -! +dsubclw*xmb(i)+dsubclws*xmbs(i)+dsubclwm*xmbm(i) & - ) + +clw_ten1(k) & + ) tem1 = max(0.0, min(1.0, (tcr-t(i,k))*tcrf)) - if (clw(i,k,2) .gt. -999.0) then - clw(i,k,1) = max(0.,clw(i,k,1) + tem * tem1) ! ice - clw(i,k,2) = max(0.,clw(i,k,2) + tem *(1.0-tem1)) ! water - else - clw(i,k,1) = max(0.,clw(i,k,1) + tem) - endif + if (clcw(i,k) .gt. -999.0) then + cliw(i,k) = max(0.,cliw(i,k) + tem * tem1) ! ice + clcw(i,k) = max(0.,clcw(i,k) + tem *(1.0-tem1)) ! water + else + cliw(i,k) = max(0.,cliw(i,k) + tem) + endif - enddo - gdc(i,1,10)=forcing(i,1) - gdc(i,2,10)=forcing(i,2) - gdc(i,3,10)=forcing(i,3) - gdc(i,4,10)=forcing(i,4) - gdc(i,5,10)=forcing(i,5) - gdc(i,6,10)=forcing(i,6) - gdc(i,7,10)=forcing(i,7) - gdc(i,8,10)=forcing(i,8) - gdc(i,10,10)=xmb(i) - gdc(i,11,10)=xmbm(i) - gdc(i,12,10)=xmbs(i) - gdc(i,13,10)=hfx(i) - gdc(i,15,10)=qfx(i) - gdc(i,16,10)=pret(i)*3600. +! +!> calculate cloud water and cloud ice number concentrations +! + rho_dryar(i,k) = p2di(i,k)/(con_rd*t(i,k)) ! Density of dry air in kg m-3 + if (imp_physics == imp_physics_thompson) then + if ((tem*tem1)>1.e-5) then + gq0(i,k,ntinc) = max(0., gq0(i,k,ntinc) + & + make_IceNumber(tem*tem1*rho_dryar(i,k), t(i,k)) * & + (1/rho_dryar(i,k))) + end if + if ((tem*(1-tem1))>1.e-5) then + gq0(i,k,ntlnc) = max(0., gq0(i,k,ntlnc) + & + make_DropletNumber(tem*(1-tem1)*rho_dryar(i,k), nwfa(i,k)) & + * (1/rho_dryar(i,k))) + end if + end if + + enddo + + + gdc(i,1,10)=forcing(i,1) + gdc(i,2,10)=forcing(i,2) + gdc(i,3,10)=forcing(i,3) + gdc(i,4,10)=forcing(i,4) + gdc(i,5,10)=forcing(i,5) + gdc(i,6,10)=forcing(i,6) + gdc(i,7,10)=forcing(i,7) + gdc(i,8,10)=forcing(i,8) + gdc(i,10,10)=xmb(i) + gdc(i,11,10)=xmbm(i) + gdc(i,12,10)=xmbs(i) + gdc(i,13,10)=hfx(i) + gdc(i,15,10)=qfx(i) + gdc(i,16,10)=pret(i)*3600. if(ktop(i).gt.2 .and.pret(i).gt.0.)dt_mf(i,ktop(i)-1)=ud_mf(i,ktop(i)) endif enddo diff --git a/physics/cu_gf_driver.meta b/physics/cu_gf_driver.meta new file mode 100644 index 000000000..cce69c43b --- /dev/null +++ b/physics/cu_gf_driver.meta @@ -0,0 +1,436 @@ +[ccpp-arg-table] + name = cu_gf_driver_init + type = scheme +[mpirank] + standard_name = mpi_rank + long_name = current MPI-rank + units = index + dimensions = () + type = integer + intent = in + optional = F +[mpiroot] + standard_name = mpi_root + long_name = master MPI-rank + units = index + dimensions = () + type = integer + intent = in + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F + +######################################################################## +[ccpp-arg-table] + name = cu_gf_driver_finalize + type = scheme + +######################################################################## +[ccpp-arg-table] + name = cu_gf_driver_run + type = scheme +[ntracer] + standard_name = number_of_tracers + long_name = number of tracers + units = count + dimensions = () + type = integer + intent = in + optional = F +[garea] + standard_name = cell_area + long_name = grid cell area + units = m2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[im] + standard_name = horizontal_loop_extent + long_name = horizontal loop extent + units = count + dimensions = () + type = integer + intent = in + optional = F +[ix] + standard_name = horizontal_dimension + long_name = horizontal dimension + units = count + dimensions = () + type = integer + intent = in + optional = F +[km] + standard_name = vertical_dimension + long_name = vertical layer dimension + units = count + dimensions = () + type = integer + intent = in + optional = F +[dt] + standard_name = time_step_for_physics + long_name = physics time step + units = s + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[cactiv] + standard_name = conv_activity_counter + long_name = convective activity memory + units = none + dimensions = (horizontal_dimension) + type = integer + intent = inout + optional = F +[forcet] + standard_name = temperature_tendency_due_to_dynamics + long_name = temperature tendency due to dynamics only + units = K s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[forceqv_spechum] + standard_name = moisture_tendency_due_to_dynamics + long_name = moisture tendency due to dynamics only + units = kg kg-1 s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[phil] + standard_name = geopotential + long_name = layer geopotential + units = m2 s-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[raincv] + standard_name = lwe_thickness_of_deep_convective_precipitation_amount + long_name = deep convective rainfall amount on physics timestep + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[qv_spechum] + standard_name = water_vapor_specific_humidity_updated_by_physics + long_name = water vapor specific humidity updated by physics + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[t] + standard_name = air_temperature_updated_by_physics + long_name = updated temperature + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[cld1d] + standard_name = cloud_work_function + long_name = cloud work function + units = m2 s-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[us] + standard_name = x_wind_updated_by_physics + long_name = updated x-direction wind + units = m s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[vs] + standard_name = y_wind_updated_by_physics + long_name = updated y-direction wind + units = m s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[t2di] + standard_name = air_temperature + long_name = mid-layer temperature + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[w] + standard_name = omega + long_name = layer mean vertical velocity + units = Pa s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[qv2di_spechum] + standard_name = water_vapor_specific_humidity + long_name = water vapor specific humidity + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[p2di] + standard_name = air_pressure + long_name = mean layer pressure + units = Pa + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[psuri] + standard_name = surface_air_pressure + long_name = surface pressure + units = Pa + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[hbot] + standard_name = vertical_index_at_cloud_base + long_name = index for cloud base + units = index + dimensions = (horizontal_dimension) + type = integer + intent = out + optional = F +[htop] + standard_name = vertical_index_at_cloud_top + long_name = index for cloud top + units = index + dimensions = (horizontal_dimension) + type = integer + intent = out + optional = F +[kcnv] + standard_name = flag_deep_convection + long_name = deep convection: 0=no, 1=yes + units = flag + dimensions = (horizontal_dimension) + type = integer + intent = out + optional = F +[xland] + standard_name = sea_land_ice_mask + long_name = landmask: sea/land/ice=0/1/2 + units = flag + dimensions = (horizontal_dimension) + type = integer + intent = in + optional = F +[hfx2] + standard_name = kinematic_surface_upward_sensible_heat_flux + long_name = kinematic surface upward sensible heat flux + units = K m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[qfx2] + standard_name = kinematic_surface_upward_latent_heat_flux + long_name = kinematic surface upward latent heat flux + units = kg kg-1 m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[cliw] + standard_name = ice_water_mixing_ratio_convective_transport_tracer + long_name = ratio of mass of ice water to mass of dry air plus vapor (without condensates) in the convectively transported tracer array + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[clcw] + standard_name = cloud_condensed_water_mixing_ratio_convective_transport_tracer + long_name = ratio of mass of cloud water to mass of dry air plus vapor (without condensates) in the convectively transported tracer array + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[pbl] + standard_name = atmosphere_boundary_layer_thickness + long_name = PBL thickness + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[ud_mf] + standard_name = instantaneous_atmosphere_updraft_convective_mass_flux + long_name = (updraft mass flux) * delt + units = kg m-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[dd_mf] + standard_name = instantaneous_atmosphere_downdraft_convective_mass_flux + long_name = (downdraft mass flux) * delt + units = kg m-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[dt_mf] + standard_name = instantaneous_atmosphere_detrainment_convective_mass_flux + long_name = (detrainment mass flux) * delt + units = kg m-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[cnvw_moist] + standard_name = convective_cloud_water_mixing_ratio + long_name = moist convective cloud water mixing ratio + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[cnvc] + standard_name = convective_cloud_cover + long_name = convective cloud cover + units = frac + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[imfshalcnv] + standard_name = flag_for_mass_flux_shallow_convection_scheme + long_name = flag for mass-flux shallow convection scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F +[nwfa] + standard_name = water_friendly_aerosol_number_concentration + long_name = number concentration of water-friendly aerosols + units = kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[con_rd] + standard_name = gas_constant_dry_air + long_name = ideal gas constant for dry air + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[gq0] + standard_name = tracer_concentration_updated_by_physics + long_name = tracer concentration updated by physics + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension,number_of_tracers) + type = real + kind = kind_phys + intent = inout + optional = F +[ntinc] + standard_name = index_for_ice_cloud_number_concentration + long_name = tracer index for ice number concentration + units = index + dimensions = () + type = integer + intent = in + optional = F +[ntlnc] + standard_name = index_for_liquid_cloud_number_concentration + long_name = tracer index for liquid number concentration + units = index + dimensions = () + type = integer + intent = in + optional = F +[imp_physics] + standard_name = flag_for_microphysics_scheme + long_name = choice of microphysics scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F +[imp_physics_thompson] + standard_name = flag_for_thompson_microphysics_scheme + long_name = choice of Thompson microphysics scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F diff --git a/physics/cu_gf_driver_post.F90 b/physics/cu_gf_driver_post.F90 index d2423de55..4e172ed5a 100644 --- a/physics/cu_gf_driver_post.F90 +++ b/physics/cu_gf_driver_post.F90 @@ -18,17 +18,7 @@ subroutine cu_gf_driver_post_finalize() end subroutine cu_gf_driver_post_finalize !> \section arg_table_cu_gf_driver_post_run Argument Table -!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | -!! |----------------|--------------------------------------------------------|--------------------------------------------------|---------|------|-----------|-----------|--------|----------| -!! | im | horizontal_loop_extent | horizontal loop extent | count | 0 | integer | | in | F | -!! | t | air_temperature_updated_by_physics | temperature updated by physics | K | 2 | real | kind_phys | in | F | -!! | q | water_vapor_specific_humidity_updated_by_physics | water vapor specific humidity updated by physics | kg kg-1 | 2 | real | kind_phys | in | F | -!! | prevst | temperature_from_previous_timestep | temperature from previous time step | K | 2 | real | kind_phys | out | F | -!! | prevsq | moisture_from_previous_timestep | moisture from previous time step | kg kg-1 | 2 | real | kind_phys | out | F | -!! | cactiv | conv_activity_counter | convective activity memory | none | 1 | integer | | in | F | -!! | conv_act | gf_memory_counter | Memory counter for GF | none | 1 | real | kind_phys | out | F | -!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | -!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | +!! \htmlinclude cu_gf_driver_post_run.html !! subroutine cu_gf_driver_post_run (im, t, q, prevst, prevsq, cactiv, conv_act, errmsg, errflg) diff --git a/physics/cu_gf_driver_post.meta b/physics/cu_gf_driver_post.meta new file mode 100644 index 000000000..9a28bc719 --- /dev/null +++ b/physics/cu_gf_driver_post.meta @@ -0,0 +1,81 @@ +[ccpp-arg-table] + name = cu_gf_driver_post_run + type = scheme +[im] + standard_name = horizontal_loop_extent + long_name = horizontal loop extent + units = count + dimensions = () + type = integer + intent = in + optional = F +[t] + standard_name = air_temperature_updated_by_physics + long_name = temperature updated by physics + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[q] + standard_name = water_vapor_specific_humidity_updated_by_physics + long_name = water vapor specific humidity updated by physics + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[prevst] + standard_name = temperature_from_previous_timestep + long_name = temperature from previous time step + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[prevsq] + standard_name = moisture_from_previous_timestep + long_name = moisture from previous time step + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[cactiv] + standard_name = conv_activity_counter + long_name = convective activity memory + units = none + dimensions = (horizontal_dimension) + type = integer + intent = in + optional = F +[conv_act] + standard_name = gf_memory_counter + long_name = Memory counter for GF + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F diff --git a/physics/cu_gf_driver_pre.F90 b/physics/cu_gf_driver_pre.F90 index dfaad6bf6..3512f65f9 100644 --- a/physics/cu_gf_driver_pre.F90 +++ b/physics/cu_gf_driver_pre.F90 @@ -18,23 +18,7 @@ subroutine cu_gf_driver_pre_finalize() end subroutine cu_gf_driver_pre_finalize !> \section arg_table_cu_gf_driver_pre_run Argument Table -!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | -!! |----------------|--------------------------------------------------------|--------------------------------------------------|---------------|------|-----------|-----------|--------|----------| -!! | flag_init | flag_for_first_time_step | flag signaling first time step for time integration loop | flag | 0 | logical | | in | F | -!! | flag_restart | flag_for_restart | flag for restart (warmstart) or coldstart | flag | 0 | logical | | in | F | -!! | kdt | index_of_time_step | current forecast iteration | index | 0 | integer | | in | F | -!! | fhour | forecast_time | curent forecast time | h | 0 | real | kind_phys | in | F | -!! | dtp | time_step_for_physics | physics timestep | s | 0 | real | kind_phys | in | F | -!! | t | air_temperature | model layer mean temperature | K | 2 | real | kind_phys | in | F | -!! | q | water_vapor_specific_humidity | water vapor specific humidity | kg kg-1 | 2 | real | kind_phys | in | F | -!! | prevst | temperature_from_previous_timestep | temperature from previous time step | K | 2 | real | kind_phys | in | F | -!! | prevsq | moisture_from_previous_timestep | moisture from previous time step | kg kg-1 | 2 | real | kind_phys | in | F | -!! | forcet | temperature_tendency_due_to_dynamics | temperature tendency due to dynamics only | K s-1 | 2 | real | kind_phys | out | F | -!! | forceq | moisture_tendency_due_to_dynamics | moisture tendency due to dynamics only | kg kg-1 s-1 | 2 | real | kind_phys | out | F | -!! | cactiv | conv_activity_counter | convective activity memory | none | 1 | integer | | out | F | -!! | conv_act | gf_memory_counter | Memory counter for GF | none | 1 | real | kind_phys | in | F | -!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | -!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | +!! \htmlinclude cu_gf_driver_pre_run.html !! subroutine cu_gf_driver_pre_run (flag_init, flag_restart, kdt, fhour, dtp, t, q, prevst, prevsq, & forcet, forceq, cactiv, conv_act, errmsg, errflg) diff --git a/physics/cu_gf_driver_pre.meta b/physics/cu_gf_driver_pre.meta new file mode 100644 index 000000000..353bbe889 --- /dev/null +++ b/physics/cu_gf_driver_pre.meta @@ -0,0 +1,133 @@ +[ccpp-arg-table] + name = cu_gf_driver_pre_run + type = scheme +[flag_init] + standard_name = flag_for_first_time_step + long_name = flag signaling first time step for time integration loop + units = flag + dimensions = () + type = logical + intent = in + optional = F +[flag_restart] + standard_name = flag_for_restart + long_name = flag for restart (warmstart) or coldstart + units = flag + dimensions = () + type = logical + intent = in + optional = F +[kdt] + standard_name = index_of_time_step + long_name = current forecast iteration + units = index + dimensions = () + type = integer + intent = in + optional = F +[fhour] + standard_name = forecast_time + long_name = curent forecast time + units = h + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[dtp] + standard_name = time_step_for_physics + long_name = physics timestep + units = s + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[t] + standard_name = air_temperature + long_name = model layer mean temperature + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[q] + standard_name = water_vapor_specific_humidity + long_name = water vapor specific humidity + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[prevst] + standard_name = temperature_from_previous_timestep + long_name = temperature from previous time step + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[prevsq] + standard_name = moisture_from_previous_timestep + long_name = moisture from previous time step + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[forcet] + standard_name = temperature_tendency_due_to_dynamics + long_name = temperature tendency due to dynamics only + units = K s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[forceq] + standard_name = moisture_tendency_due_to_dynamics + long_name = moisture tendency due to dynamics only + units = kg kg-1 s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[cactiv] + standard_name = conv_activity_counter + long_name = convective activity memory + units = none + dimensions = (horizontal_dimension) + type = integer + intent = out + optional = F +[conv_act] + standard_name = gf_memory_counter + long_name = Memory counter for GF + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F diff --git a/physics/cu_gf_sh.F90 b/physics/cu_gf_sh.F90 index faca8839f..7f88d0c14 100644 --- a/physics/cu_gf_sh.F90 +++ b/physics/cu_gf_sh.F90 @@ -1,26 +1,44 @@ !>\file cu_gf_sh.F90 -!! This file contains +!! This file contains Grell-Freitas shallow convection scheme. -!>\defgroup cu_gf_sh_group GSD Grell-Freitas Shallow Convection Main +!>\defgroup cu_gf_sh_group Grell-Freitas Shallow Convection Module !> \ingroup cu_gf_group -!! module cup_gf_sh will call shallow convection as described in Grell and +module cu_gf_sh + use machine , only : kind_phys + !real(kind=kind_phys), parameter:: c1_shal=0.0015! .0005 + real(kind=kind_phys), parameter:: c1_shal=0. !0.005! .0005 + real(kind=kind_phys), parameter:: g =9.81 + real(kind=kind_phys), parameter:: cp =1004. + real(kind=kind_phys), parameter:: xlv=2.5e6 + real(kind=kind_phys), parameter:: r_v=461. + real(kind=kind_phys), parameter:: c0_shal=.001 + real(kind=kind_phys), parameter:: fluxtune=1.5 + +contains + +!>\ingroup cu_gf_sh_group +!> GF shallow convection as described in Grell and !! Freitas (2014) \cite grell_and_freitas_2014. input variables are: +!!\param us x wind updated by physics +!!\param vs y wind updated by physics !!\param zo height at model levels !!\param t,tn temperature without and with forcing at model levels !!\param q,qo mixing ratio without and with forcing at model levels !!\param po pressure at model levels (mb) !!\param psur surface pressure (mb) !!\param z1 surface height -!!\param dhdt forcing for boundary layer equilibrium +!!\param dhdt forcing for boundary layer equilibrium !!\param hfx,qfx in w/m2 (positive, if upward from sfc) !!\param kpbl level of boundaty layer height +!!\param rho moist air density !!\param xland land mask (1. for land) -!!\param ichoice which closure to choose +!!\param ichoice which closure to choose !!\n 1: old g !!\n 2: zws !!\n 3: dhdt !!\n 0: average !!\param tcrit parameter for water/ice conversion (258) +!!\param dtime physics time step !!\param zuo normalized mass flux profile !!\param xmb_out base mass flux !!\param kbcon convective cloud base @@ -31,27 +49,18 @@ !!\param outt temperature tendency (k/s) !!\param outq mixing ratio tendency (kg/kg/s) !!\param outqc cloud water/ice tendency (kg/kg/s) +!!\param outu x wind tendency +!!\param outv y wind tendency !!\param pre precip rate (mm/s) !!\param cupclw incloud mixing ratio of cloudwater/ice (for radiation) !! this needs heavy tuning factors, since cloud fraction is -!! not included (kg/kg) +!! not included (kg/kg) !!\param cnvwt required for gfs physics !!\param itf,ktf,its,ite, kts,kte are dimensions -!!\param ztexec,zqexec excess temperature and moisture for updraft -module cu_gf_sh - use machine , only : kind_phys - !real(kind=kind_phys), parameter:: c1_shal=0.0015! .0005 - real(kind=kind_phys), parameter:: c1_shal=0. !0.005! .0005 - real(kind=kind_phys), parameter:: g =9.81 - real(kind=kind_phys), parameter:: cp =1004. - real(kind=kind_phys), parameter:: xlv=2.5e6 - real(kind=kind_phys), parameter:: r_v=461. - real(kind=kind_phys), parameter:: c0_shal=.001 - real(kind=kind_phys), parameter:: fluxtune=1.5 - -contains - +!!\param ipr horizontal index of printed column +!!\param tropics =0 !>\section gen_cu_gf_sh_run GSD cu_gf_sh_run General Algorithm +!> @{ subroutine cu_gf_sh_run ( & us,vs,zo,t,q,z1,tn,qo,po,psur,dhdt,kpbl,rho, & ! input variables, must be supplied hfx,qfx,xland,ichoice,tcrit,dtime, & @@ -276,7 +285,7 @@ subroutine cu_gf_sh_run ( & !- moisture excess zqexec(i) = max(flux_tun(i)*qfx(i)/xlv/(rho(i,1)*zws(i)),0.) endif - !- zws for shallow convection closure (grant 2001) + !> - Calculate zws for shallow convection closure (grant 2001) !- height of the pbl zws(i) = max(0.,flux_tun(i)*0.41*buo_flux*zo(i,kpbl(i))*g/t(i,kpbl(i))) zws(i) = 1.2*zws(i)**.3333 @@ -285,11 +294,11 @@ subroutine cu_gf_sh_run ( & enddo ! -!--- max height(m) above ground where updraft air can originate +!> - Determin max height(m) above ground where updraft air can originate ! zkbmax=3000. ! -!--- calculate moist static energy, heights, qes +!> - Call cup_env() to calculate moist static energy, heights, qes ! call cup_env(z,qes,he,hes,t,q,po,z1, & psur,ierr,tcrit,-1, & @@ -301,7 +310,7 @@ subroutine cu_gf_sh_run ( & its,ite, kts,kte) ! -!--- environmental values on cloud levels +!> - Call cup_env_clev() to calculate environmental values on cloud levels ! call cup_env_clev(t,qes,q,he,hes,z,po,qes_cup,q_cup,he_cup, & hes_cup,z_cup,p_cup,gamma_cup,t_cup,psur, & @@ -342,7 +351,7 @@ subroutine cu_gf_sh_run ( & ! ! ! -!------- determine level with highest moist static energy content - k22 +!> - Determine level with highest moist static energy content (\p k22) ! do 36 i=its,itf if(kpbl(i).gt.3)cap_max(i)=po_cup(i,kpbl(i)) @@ -359,7 +368,8 @@ subroutine cu_gf_sh_run ( & endif 36 continue ! -!--- determine the level of convective cloud base - kbcon +!> - Call get_cloud_bc() and cup_kbcon() to determine the level of +!! convective cloud base (\p kbcon) ! do i=its,itf if(ierr(i).eq.0)then @@ -383,7 +393,8 @@ subroutine cu_gf_sh_run ( & 0,itf,ktf, & its,ite, kts,kte, & z_cup,entr_rate,heo,0) -!--- get inversion layers for cloud tops + +!> - Call cup_minimi() and get_inversion_layers() to get inversion layers for cloud tops call cup_minimi(heso_cup,kbcon,kbmax,kstabi,ierr, & itf,ktf, & its,ite, kts,kte) @@ -427,7 +438,7 @@ subroutine cu_gf_sh_run ( & endif endif enddo -! get normalized mass flux profile +!> - Call rates_up_pdf() to get normalized mass flux profile call rates_up_pdf(rand_vmas,ipr,'shallow',ktop,ierr,po_cup,entr_rate_2d,hkbo,heo,heso_cup,zo_cup, & xland1,kstabi,k22,kbcon,its,ite,itf,kts,kte,ktf,zuo,kpbl,ktopx,kbcon,pmin_lev) do i=its,itf @@ -465,7 +476,7 @@ subroutine cu_gf_sh_run ( & endif enddo ! -! calculate mass entrainment and detrainment +!> - Call get_lateral_massflux() to calculate mass entrainment and detrainment ! call get_lateral_massflux(itf,ktf, its,ite, kts,kte & ,ierr,ktop,zo_cup,zuo,cd,entr_rate_2d & @@ -929,4 +940,5 @@ subroutine cu_gf_sh_run ( & ! enddo end subroutine cu_gf_sh_run +!> @} end module cu_gf_sh diff --git a/physics/cu_ntiedtke.F90 b/physics/cu_ntiedtke.F90 index 954c4a65f..156e75c70 100644 --- a/physics/cu_ntiedtke.F90 +++ b/physics/cu_ntiedtke.F90 @@ -104,12 +104,7 @@ module cu_ntiedtke !> \brief Brief description of the subroutine !! !! \section arg_table_cu_ntiedtke_init Argument Table -!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | -!! |----------------------|--------------------|------------------------------------------|-------|------|-----------|-----------|--------|----------| -!! | mpirank | mpi_rank | current MPI-rank | index | 0 | integer | | in | F | -!! | mpiroot | mpi_root | master MPI-rank | index | 0 | integer | | in | F | -!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | -!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | +!! \htmlinclude cu_ntiedtke_init.html !! subroutine cu_ntiedtke_init(mpirank, mpiroot, errmsg, errflg) @@ -148,45 +143,12 @@ end subroutine cu_ntiedtke_finalize ! !! !! \section arg_table_cu_ntiedtke_run Argument Table -!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | -!! |----------------|-----------------------------------------------------------|----------------------------------------------------------|---------------|------|-----------|-----------|--------|----------| -!! | pu | x_wind_updated_by_physics | updated x-direction wind | m s-1 | 2 | real | kind_phys | inout | F | -!! | pv | y_wind_updated_by_physics | updated y-direction wind | m s-1 | 2 | real | kind_phys | inout | F | -!! | pt | air_temperature_updated_by_physics | updated temperature | K | 2 | real | kind_phys | inout | F | -!! | pqv | water_vapor_specific_humidity_updated_by_physics | water vapor specific humidity | kg kg-1 | 2 | real | kind_phys | inout | F | -!! | pqvf | moisture_tendency_due_to_dynamics | moisture tendency due to dynamics only | kg kg-1 s-1 | 2 | real | kind_phys | in | F | -!! | ptf | temperature_tendency_due_to_dynamics | temperature tendency due to dynamics only | K s-1 | 2 | real | kind_phys | in | F | -!! | clw | convective_transportable_tracers | array to contain cloud water and other tracers | kg kg-1 | 3 | real | kind_phys | inout | F | -!! | poz | geopotential | geopotential at model layer centers | m2 s-2 | 2 | real | kind_phys | in | F | -!! | pzz | geopotential_at_interface | geopotential at model layer interfaces | m2 s-2 | 2 | real | kind_phys | in | F | -!! | prsl | air_pressure | mean layer pressure | Pa | 2 | real | kind_phys | in | F | -!! | prsi | air_pressure_at_interface | air pressure at model layer interfaces | Pa | 2 | real | kind_phys | in | F | -!! | pomg | omega | layer mean vertical velocity | Pa s-1 | 2 | real | kind_phys | in | F | -!! | evap | kinematic_surface_upward_latent_heat_flux | kinematic surface upward latent heat flux | kg kg-1 m s-1 | 1 | real | kind_phys | in | F | -!! | hfx | kinematic_surface_upward_sensible_heat_flux | kinematic surface upward sensible heat flux | K m s-1 | 1 | real | kind_phys | in | F | -!! | zprecc | lwe_thickness_of_deep_convective_precipitation_amount | deep convective rainfall amount on physics timestep | m | 1 | real | kind_phys | out | F | -!! | lmask | sea_land_ice_mask | landmask: sea/land/ice=0/1/2 | flag | 1 | integer | | in | F | -!! | lq | horizontal_loop_extent | horizontal loop extent | count | 0 | integer | | in | F | -!! | ix | horizontal_dimension | horizontal dimension | count | 0 | integer | | in | F | -!! | km | vertical_dimension | vertical layer dimension | count | 0 | integer | | in | F | -!! | dt | time_step_for_physics | physics time step | s | 0 | real | kind_phys | in | F | -!! | dx | cell_size | size of the grid cell | m | 1 | real | kind_phys | in | F | -!! | kbot | vertical_index_at_cloud_base | index for cloud base | index | 1 | integer | | out | F | -!! | ktop | vertical_index_at_cloud_top | index for cloud top | index | 1 | integer | | out | F | -!! | kcnv | flag_deep_convection | deep convection: 0=no, 1=yes | flag | 1 | integer | | out | F | -!! | ktrac | number_of_total_tracers | number of total tracers | count | 0 | integer | | in | F | -!! | ud_mf | instantaneous_atmosphere_updraft_convective_mass_flux | (updraft mass flux) * delt | kg m-2 | 2 | real | kind_phys | out | F | -!! | dd_mf | instantaneous_atmosphere_downdraft_convective_mass_flux | (downdraft mass flux) * delt | kg m-2 | 2 | real | kind_phys | out | F | -!! | dt_mf | instantaneous_atmosphere_detrainment_convective_mass_flux | (detrainment mass flux) * delt | kg m-2 | 2 | real | kind_phys | out | F | -!! | cnvw | convective_cloud_water_mixing_ratio | convective cloud water | kg kg-1 | 2 | real | kind_phys | out | F | -!! | cnvc | convective_cloud_cover | convective cloud cover | frac | 2 | real | kind_phys | out | F | -!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | -!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | +!! \htmlinclude cu_ntiedtke_run.html !! !----------------------------------------------------------------------- ! level 1 subroutine 'tiecnvn' !----------------------------------------------------------------- - subroutine cu_ntiedtke_run(pu,pv,pt,pqv,pqvf,ptf,clw,poz,pzz,prsl,prsi,pomg, & + subroutine cu_ntiedtke_run(pu,pv,pt,pqv,tdi,qvdi,pqvf,ptf,clw,poz,pzz,prsl,prsi,pomg, & evap,hfx,zprecc,lmask,lq,ix,km,dt,dx,kbot,ktop,kcnv,& ktrac,ud_mf,dd_mf,dt_mf,cnvw,cnvc,errmsg,errflg) !----------------------------------------------------------------- @@ -200,9 +162,9 @@ subroutine cu_ntiedtke_run(pu,pv,pt,pqv,pqvf,ptf,clw,poz,pzz,prsl,prsi,pomg, & integer, dimension( lq ), intent(in) :: lmask real(kind=kind_phys), dimension( lq ), intent(in ) :: evap, hfx, dx real(kind=kind_phys), dimension( ix , km ), intent(inout) :: pu, pv, pt, pqv - real(kind=kind_phys), dimension( ix , km ), intent(in ) :: poz, prsl, pomg, pqvf, ptf + real(kind=kind_phys), dimension( ix , km ), intent(in ) :: tdi, qvdi, poz, prsl, pomg, pqvf, ptf real(kind=kind_phys), dimension( ix , km+1 ), intent(in ) :: pzz, prsi - real(kind=kind_phys), dimension( ix , km, ktrac+2 ), intent(inout ) :: clw + real(kind=kind_phys), dimension( ix , km, ktrac ), intent(inout ) :: clw integer, dimension( lq ), intent(out) :: kbot, ktop, kcnv real(kind=kind_phys), dimension( lq ), intent(out) :: zprecc @@ -222,13 +184,13 @@ subroutine cu_ntiedtke_run(pu,pv,pt,pqv,pqvf,ptf,clw,poz,pzz,prsl,prsi,pomg, & real(kind=kind_phys) ztp1(lq,km), zqp1(lq,km), ztu(lq,km), zqu(lq,km),& & zlu(lq,km), zlude(lq,km), zmfu(lq,km), zmfd(lq,km), zmfude_rate(lq,km),& & zqsat(lq,km), zrain(lq) - real(kind=kind_phys) pcen(lq,km,ktrac),ptenc(lq,km,ktrac) + real(kind=kind_phys),allocatable :: pcen(:,:,:),ptenc(:,:,:) integer icbot(lq), ictop(lq), ktype(lq), lndj(lq) logical locum(lq) ! real(kind=kind_phys) ztmst,fliq,fice,ztc,zalf,tt - integer i,j,k,k1,n,km1 + integer i,j,k,k1,n,km1,ktracer real(kind=kind_phys) ztpp1 real(kind=kind_phys) zew,zqs,zcor ! @@ -280,9 +242,9 @@ subroutine cu_ntiedtke_run(pu,pv,pt,pqv,pqvf,ptf,clw,poz,pzz,prsl,prsi,pomg, & zqs = min(0.5,zqs) zcor = 1./(1.-vtmpc1*zqs) zqsat(j,k1)=zqs*zcor - pqte(j,k1)=pqvf(j,k) + pqte(j,k1)=pqvf(j,k)+(pqv(j,k)-qvdi(j,k))/ztmst zqq(j,k1) =pqte(j,k1) - ptte(j,k1)=ptf(j,k) + ptte(j,k1)=ptf(j,k)+(pt(j,k)-tdi(j,k))/ztmst ztt(j,k1) =ptte(j,k1) ud_mf(j,k1)=0. dd_mf(j,k1)=0. @@ -292,16 +254,33 @@ subroutine cu_ntiedtke_run(pu,pv,pt,pqv,pqvf,ptf,clw,poz,pzz,prsl,prsi,pomg, & end do end do - do n=1,ktrac - do k=1,km - k1=km-k+1 - do j=1,lq - pcen(j,k1,n) = clw(j,k,n+2) - ptenc(j,k1,n)= 0. + if(ktrac > 2) then + ktracer = ktrac - 2 + allocate(pcen(lq,km,ktracer)) + allocate(ptenc(lq,km,ktracer)) + do n=1,ktracer + do k=1,km + k1=km-k+1 + do j=1,lq + pcen(j,k1,n) = clw(j,k,n+2) + ptenc(j,k1,n)= 0. + end do end do end do - end do - + else + ktracer = 2 + allocate(pcen(lq,km,ktracer)) + allocate(ptenc(lq,km,ktracer)) + do n=1,ktracer + do k=1,km + do j=1,lq + pcen(j,k,n) = 0. + ptenc(j,k,n)= 0. + end do + end do + end do + end if + ! print *, "pgeo=",pgeo(1,:) ! print *, "pgeoh=",pgeoh(1,:) ! print *, "pap=",pap(1,:) @@ -323,7 +302,7 @@ subroutine cu_ntiedtke_run(pu,pv,pt,pqv,pqvf,ptf,clw,poz,pzz,prsl,prsi,pomg, & & zqp1, pum1, pvm1, pverv, zqsat,& & pqhfl, ztmst, pap, paph, pgeo, & & ptte, pqte, pvom, pvol, prsfc,& - & pssfc, locum, ktrac, pcen, ptenc,& + & pssfc, locum, ktracer, pcen, ptenc,& & ktype, icbot, ictop, ztu, zqu, & & zlu, zlude, zmfu, zmfd, zrain,& & pcte, phhfl, lndj, pgeoh, zmfude_rate, dx) @@ -348,7 +327,7 @@ subroutine cu_ntiedtke_run(pu,pv,pt,pqv,pqvf,ptf,clw,poz,pzz,prsl,prsi,pomg, & pt(j,k) = ztp1(j,k1)+(ptte(j,k1)-ztt(j,k1))*ztmst pqv(j,k)= zqp1(j,k1)+(pqte(j,k1)-zqq(j,k1))*ztmst ud_mf(j,k)= zmfu(j,k1)*ztmst - dd_mf(j,k)= zmfd(j,k1)*ztmst + dd_mf(j,k)= -zmfd(j,k1)*ztmst dt_mf(j,k)= zmfude_rate(j,k1)*ztmst cnvw(j,k) = zlude(j,k1)*ztmst*g/(prsi(j,k)-prsi(j,k+1)) cnvc(j,k) = 0.04 * log(1. + 675. * ud_mf(j,k)) @@ -377,17 +356,21 @@ subroutine cu_ntiedtke_run(pu,pv,pt,pqv,pqvf,ptf,clw,poz,pzz,prsl,prsi,pomg, & end do end do endif + ! - if (ktrac > 0) then - do n=1,ktrac - do k=1,km - k1=km-k+1 - do j=1,lq - clw(j,k,n+2)=pcen(j,k,n)+ptenc(j,k1,n)*ztmst - end do - end do - end do - end if +! Currently, vertical mixing of tracers are turned off +! if(ktrac > 2) then +! do n=1,ktrac-2 +! do k=1,km +! k1=km-k+1 +! do j=1,lq +! clw(j,k,n+2)=pcen(j,k,n)+ptenc(j,k1,n)*ztmst +! end do +! end do +! end do +! end if + deallocate(pcen) + deallocate(ptenc) ! return end subroutine cu_ntiedtke_run diff --git a/physics/cu_ntiedtke.meta b/physics/cu_ntiedtke.meta new file mode 100644 index 000000000..4208b6e46 --- /dev/null +++ b/physics/cu_ntiedtke.meta @@ -0,0 +1,343 @@ +[ccpp-arg-table] + name = cu_ntiedtke_init + type = scheme +[mpirank] + standard_name = mpi_rank + long_name = current MPI-rank + units = index + dimensions = () + type = integer + intent = in + optional = F +[mpiroot] + standard_name = mpi_root + long_name = master MPI-rank + units = index + dimensions = () + type = integer + intent = in + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F + +######################################################################## +[ccpp-arg-table] + name = cu_ntiedtke_finalize + type = scheme + +######################################################################## +[ccpp-arg-table] + name = cu_ntiedtke_run + type = scheme +[pu] + standard_name = x_wind_updated_by_physics + long_name = updated x-direction wind + units = m s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[pv] + standard_name = y_wind_updated_by_physics + long_name = updated y-direction wind + units = m s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[pt] + standard_name = air_temperature_updated_by_physics + long_name = updated temperature + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[pqv] + standard_name = water_vapor_specific_humidity_updated_by_physics + long_name = water vapor specific humidity + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[tdi] + standard_name = air_temperature + long_name = mid-layer temperature + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[qvdi] + standard_name = water_vapor_specific_humidity + long_name = water vapor specific humidity + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[pqvf] + standard_name = moisture_tendency_due_to_dynamics + long_name = moisture tendency due to dynamics only + units = kg kg-1 s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[ptf] + standard_name = temperature_tendency_due_to_dynamics + long_name = temperature tendency due to dynamics only + units = K s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[clw] + standard_name = convective_transportable_tracers + long_name = array to contain cloud water and other tracers + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension,number_of_tracers_for_convective_transport) + type = real + kind = kind_phys + intent = inout + optional = F +[poz] + standard_name = geopotential + long_name = geopotential at model layer centers + units = m2 s-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[pzz] + standard_name = geopotential_at_interface + long_name = geopotential at model layer interfaces + units = m2 s-2 + dimensions = (horizontal_dimension,vertical_dimension_plus_one) + type = real + kind = kind_phys + intent = in + optional = F +[prsl] + standard_name = air_pressure + long_name = mean layer pressure + units = Pa + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[prsi] + standard_name = air_pressure_at_interface + long_name = air pressure at model layer interfaces + units = Pa + dimensions = (horizontal_dimension,vertical_dimension_plus_one) + type = real + kind = kind_phys + intent = in + optional = F +[pomg] + standard_name = omega + long_name = layer mean vertical velocity + units = Pa s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[evap] + standard_name = kinematic_surface_upward_latent_heat_flux + long_name = kinematic surface upward latent heat flux + units = kg kg-1 m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[hfx] + standard_name = kinematic_surface_upward_sensible_heat_flux + long_name = kinematic surface upward sensible heat flux + units = K m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[zprecc] + standard_name = lwe_thickness_of_deep_convective_precipitation_amount + long_name = deep convective rainfall amount on physics timestep + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[lmask] + standard_name = sea_land_ice_mask + long_name = landmask: sea/land/ice=0/1/2 + units = flag + dimensions = (horizontal_dimension) + type = integer + intent = in + optional = F +[lq] + standard_name = horizontal_loop_extent + long_name = horizontal loop extent + units = count + dimensions = () + type = integer + intent = in + optional = F +[ix] + standard_name = horizontal_dimension + long_name = horizontal dimension + units = count + dimensions = () + type = integer + intent = in + optional = F +[km] + standard_name = vertical_dimension + long_name = vertical layer dimension + units = count + dimensions = () + type = integer + intent = in + optional = F +[dt] + standard_name = time_step_for_physics + long_name = physics time step + units = s + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[dx] + standard_name = cell_size + long_name = size of the grid cell + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[kbot] + standard_name = vertical_index_at_cloud_base + long_name = index for cloud base + units = index + dimensions = (horizontal_dimension) + type = integer + intent = out + optional = F +[ktop] + standard_name = vertical_index_at_cloud_top + long_name = index for cloud top + units = index + dimensions = (horizontal_dimension) + type = integer + intent = out + optional = F +[kcnv] + standard_name = flag_deep_convection + long_name = deep convection: 0=no, 1=yes + units = flag + dimensions = (horizontal_dimension) + type = integer + intent = out + optional = F +[ktrac] + standard_name = number_of_tracers_for_convective_transport + long_name = number of tracers for convective transport + units = count + dimensions = () + type = integer + intent = in + optional = F +[ud_mf] + standard_name = instantaneous_atmosphere_updraft_convective_mass_flux + long_name = (updraft mass flux) * delt + units = kg m-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[dd_mf] + standard_name = instantaneous_atmosphere_downdraft_convective_mass_flux + long_name = (downdraft mass flux) * delt + units = kg m-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[dt_mf] + standard_name = instantaneous_atmosphere_detrainment_convective_mass_flux + long_name = (detrainment mass flux) * delt + units = kg m-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[cnvw] + standard_name = convective_cloud_water_mixing_ratio + long_name = convective cloud water + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[cnvc] + standard_name = convective_cloud_cover + long_name = convective cloud cover + units = frac + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F diff --git a/physics/cu_ntiedtke_post.F90 b/physics/cu_ntiedtke_post.F90 index fdc0b8b0f..5db6ab0af 100644 --- a/physics/cu_ntiedtke_post.F90 +++ b/physics/cu_ntiedtke_post.F90 @@ -18,14 +18,7 @@ subroutine cu_ntiedtke_post_finalize() end subroutine cu_ntiedtke_post_finalize !> \section arg_table_cu_ntiedtke_post_run Argument Table -!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | -!! |----------------|--------------------------------------------------------|--------------------------------------------------|---------|------|-----------|-----------|--------|----------| -!! | t | air_temperature_updated_by_physics | temperature updated by physics | K | 2 | real | kind_phys | in | F | -!! | q | water_vapor_specific_humidity_updated_by_physics | water vapor specific humidity updated by physics | kg kg-1 | 2 | real | kind_phys | in | F | -!! | prevst | temperature_from_previous_timestep | temperature from previous time step | K | 2 | real | kind_phys | out | F | -!! | prevsq | moisture_from_previous_timestep | moisture from previous time step | kg kg-1 | 2 | real | kind_phys | out | F | -!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | -!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | +!! \htmlinclude cu_ntiedtke_post_run.html !! subroutine cu_ntiedtke_post_run (t, q, prevst, prevsq, errmsg, errflg) diff --git a/physics/cu_ntiedtke_post.meta b/physics/cu_ntiedtke_post.meta new file mode 100644 index 000000000..a4fea92b3 --- /dev/null +++ b/physics/cu_ntiedtke_post.meta @@ -0,0 +1,56 @@ +[ccpp-arg-table] + name = cu_ntiedtke_post_run + type = scheme +[t] + standard_name = air_temperature_updated_by_physics + long_name = temperature updated by physics + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[q] + standard_name = water_vapor_specific_humidity_updated_by_physics + long_name = water vapor specific humidity updated by physics + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[prevst] + standard_name = temperature_from_previous_timestep + long_name = temperature from previous time step + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[prevsq] + standard_name = moisture_from_previous_timestep + long_name = moisture from previous time step + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F diff --git a/physics/cu_ntiedtke_pre.F90 b/physics/cu_ntiedtke_pre.F90 index 725b4a351..95e4bccf8 100644 --- a/physics/cu_ntiedtke_pre.F90 +++ b/physics/cu_ntiedtke_pre.F90 @@ -18,21 +18,7 @@ subroutine cu_ntiedtke_pre_finalize() end subroutine cu_ntiedtke_pre_finalize !> \section arg_table_cu_ntiedtke_pre_run Argument Table -!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | -!! |----------------|--------------------------------------------------------|--------------------------------------------------|---------------|------|-----------|-----------|--------|----------| -!! | flag_init | flag_for_first_time_step | flag signaling first time step for time integration loop | flag | 0 | logical | | in | F | -!! | flag_restart | flag_for_restart | flag for restart (warmstart) or coldstart | flag | 0 | logical | | in | F | -!! | kdt | index_of_time_step | current forecast iteration | index | 0 | integer | | in | F | -!! | fhour | forecast_time | curent forecast time | h | 0 | real | kind_phys | in | F | -!! | dtp | time_step_for_physics | physics timestep | s | 0 | real | kind_phys | in | F | -!! | t | air_temperature | model layer mean temperature | K | 2 | real | kind_phys | in | F | -!! | q | water_vapor_specific_humidity | water vapor specific humidity | kg kg-1 | 2 | real | kind_phys | in | F | -!! | prevst | temperature_from_previous_timestep | temperature from previous time step | K | 2 | real | kind_phys | in | F | -!! | prevsq | moisture_from_previous_timestep | moisture from previous time step | kg kg-1 | 2 | real | kind_phys | in | F | -!! | forcet | temperature_tendency_due_to_dynamics | temperature tendency due to dynamics only | K s-1 | 2 | real | kind_phys | out | F | -!! | forceq | moisture_tendency_due_to_dynamics | moisture tendency due to dynamics only | kg kg-1 s-1 | 2 | real | kind_phys | out | F | -!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | -!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | +!! \htmlinclude cu_ntiedtke_pre_run.html !! subroutine cu_ntiedtke_pre_run (flag_init, flag_restart, kdt, fhour, dtp, t, q, prevst, prevsq, & forcet, forceq, errmsg, errflg) diff --git a/physics/cu_ntiedtke_pre.meta b/physics/cu_ntiedtke_pre.meta new file mode 100644 index 000000000..8fd2448a9 --- /dev/null +++ b/physics/cu_ntiedtke_pre.meta @@ -0,0 +1,116 @@ +[ccpp-arg-table] + name = cu_ntiedtke_pre_run + type = scheme +[flag_init] + standard_name = flag_for_first_time_step + long_name = flag signaling first time step for time integration loop + units = flag + dimensions = () + type = logical + intent = in + optional = F +[flag_restart] + standard_name = flag_for_restart + long_name = flag for restart (warmstart) or coldstart + units = flag + dimensions = () + type = logical + intent = in + optional = F +[kdt] + standard_name = index_of_time_step + long_name = current forecast iteration + units = index + dimensions = () + type = integer + intent = in + optional = F +[fhour] + standard_name = forecast_time + long_name = curent forecast time + units = h + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[dtp] + standard_name = time_step_for_physics + long_name = physics timestep + units = s + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[t] + standard_name = air_temperature + long_name = model layer mean temperature + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[q] + standard_name = water_vapor_specific_humidity + long_name = water vapor specific humidity + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[prevst] + standard_name = temperature_from_previous_timestep + long_name = temperature from previous time step + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[prevsq] + standard_name = moisture_from_previous_timestep + long_name = moisture from previous time step + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[forcet] + standard_name = temperature_tendency_due_to_dynamics + long_name = temperature tendency due to dynamics only + units = K s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[forceq] + standard_name = moisture_tendency_due_to_dynamics + long_name = moisture tendency due to dynamics only + units = kg kg-1 s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F diff --git a/physics/dcyc2.f b/physics/dcyc2.f index a6f699fa2..c7a1ddd59 100644 --- a/physics/dcyc2.f +++ b/physics/dcyc2.f @@ -47,15 +47,18 @@ end subroutine dcyc2t3_finalize ! call dcyc2t3 ! ! inputs: ! ! ( solhr,slag,sdec,cdec,sinlat,coslat, ! -! xlon,coszen,tsea,tf,tsflw,sfcemis, ! +! xlon,coszen,tsfc_lnd,tsfc_ice,tsfc_ocn, ! +! tf,tsflw,sfcemis_lnd,sfcemis_ice,sfcemis_ocn, ! ! sfcdsw,sfcnsw,sfcdlw,swh,swhc,hlw,hlwc, ! ! sfcnirbmu,sfcnirdfu,sfcvisbmu,sfcvisdfu, ! ! sfcnirbmd,sfcnirdfd,sfcvisbmd,sfcvisdfd, ! -! ix, im, levs, ! +! ix, im, levs, deltim, fhswr, ! +! dry, icy, wet ! ! input/output: ! ! dtdt,dtdtc, ! ! outputs: ! -! adjsfcdsw,adjsfcnsw,adjsfcdlw,adjsfculw,xmu,xcosz, ! +! adjsfcdsw,adjsfcnsw,adjsfcdlw, ! +! adjsfculw_lnd,adjsfculw_ice,adjsfculw_ocn,xmu,xcosz, ! ! adjnirbmu,adjnirdfu,adjvisbmu,adjvisdfu, ! ! adjdnnbmd,adjdnndfd,adjdnvbmd,adjdnvdfd) ! ! ! @@ -69,9 +72,13 @@ end subroutine dcyc2t3_finalize ! - real, sin and cos of latitude ! ! xlon (im) - real, longitude in radians ! ! coszen (im) - real, avg of cosz over daytime sw call interval ! -! tsea (im) - real, ground surface temperature (k) ! +! tsfc_lnd (im) - real, bottom surface temperature over land (k) ! +! tsfc_ice (im) - real, bottom surface temperature over ice (k) ! +! tsfc_ocn (im) - real, bottom surface temperature over ocean (k) ! ! tf (im) - real, surface air (layer 1) temperature (k) ! -! sfcemis(im) - real, surface emissivity (fraction) ! +! sfcemis_lnd(im) - real, surface emissivity (fraction) o. land (k) ! +! sfcemis_ice(im) - real, surface emissivity (fraction) o. ice (k) ! +! sfcemis_ocn(im) - real, surface emissivity (fraction) o. ocean (k)! ! tsflw (im) - real, sfc air (layer 1) temp in k saved in lw call ! ! sfcdsw (im) - real, total sky sfc downward sw flux ( w/m**2 ) ! ! sfcnsw (im) - real, total sky sfc net sw into ground (w/m**2) ! @@ -90,6 +97,11 @@ end subroutine dcyc2t3_finalize ! sfcvisdfd(im)- real, tot sky sfc uv+vis-diff sw dnward flux (w/m2)! ! ix, im - integer, horiz. dimention and num of used points ! ! levs - integer, vertical layer dimension ! +! deltim - real, physics time step in seconds ! +! fhswr - real, Short wave radiation time step in seconds ! +! dry - logical, true over land ! +! icy - logical, true over ice ! +! wet - logical, true over water ! ! ! ! input/output: ! ! dtdt(im,levs)- real, model time step adjusted total radiation ! @@ -101,7 +113,9 @@ end subroutine dcyc2t3_finalize ! adjsfcdsw(im)- real, time step adjusted sfc dn sw flux (w/m**2) ! ! adjsfcnsw(im)- real, time step adj sfc net sw into ground (w/m**2)! ! adjsfcdlw(im)- real, time step adjusted sfc dn lw flux (w/m**2) ! -! adjsfculw(im)- real, sfc upward lw flux at current time (w/m**2) ! +! adjsfculw_lnd(im)- real, sfc upw. lw flux at current time (w/m**2)! +! adjsfculw_ice(im)- real, sfc upw. lw flux at current time (w/m**2)! +! adjsfculw_ocn(im)- real, sfc upw. lw flux at current time (w/m**2)! ! adjnirbmu(im)- real, t adj sfc nir-beam sw upward flux (w/m2) ! ! adjnirdfu(im)- real, t adj sfc nir-diff sw upward flux (w/m2) ! ! adjvisbmu(im)- real, t adj sfc uv+vis-beam sw upward flux (w/m2) ! @@ -154,70 +168,30 @@ end subroutine dcyc2t3_finalize !! spectral component fluxes !!- Oct 2014 y. hous s. moorthi - add emissivity contribution to !! upward longwave flux +!!- Mar 2019 s. moorthi - modify xmu calculation in a time centered +!! way and add more accuracy when physics +!! time step is close to radiation time step !> \section arg_table_dcyc2t3_run Argument Table -!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | -!! |----------------|------------------------------------------------------------------------------------------------|------------------------------------------------------------------------------------------------------|---------|------|-----------|-----------|--------|----------| -!! | solhr | forecast_hour | forecast time in 24-hour form | h | 0 | real | kind_phys | in | F | -!! | slag | equation_of_time | equation of time | radians | 0 | real | kind_phys | in | F | -!! | sdec | sine_of_solar_declination_angle | sine of solar declination angle | none | 0 | real | kind_phys | in | F | -!! | cdec | cosine_of_solar_declination_angle | cosine of solar declination angle | none | 0 | real | kind_phys | in | F | -!! | sinlat | sine_of_latitude | sine of latitude | none | 1 | real | kind_phys | in | F | -!! | coslat | cosine_of_latitude | cosine of latitude | none | 1 | real | kind_phys | in | F | -!! | xlon | longitude | longitude of grid box | radians | 1 | real | kind_phys | in | F | -!! | coszen | cosine_of_zenith_angle | average of cosine of zenith angle over daytime shortwave call time interval | none | 1 | real | kind_phys | in | F | -!! | tsea | surface_skin_temperature | surface skin temperature | K | 1 | real | kind_phys | in | F | -!! | tf | air_temperature_at_lowest_model_layer | air temperature at lowest model layer | K | 1 | real | kind_phys | in | F | -!! | tsflw | surface_midlayer_air_temperature_in_longwave_radiation | surface (first layer) air temperature saved in longwave radiation call | K | 1 | real | kind_phys | in | F | -!! | sfcemis | surface_longwave_emissivity | surface emissivity | frac | 1 | real | kind_phys | in | F | -!! | sfcdsw | surface_downwelling_shortwave_flux_on_radiation_time_step | total sky surface downwelling shortwave flux on radiation time step | W m-2 | 1 | real | kind_phys | in | F | -!! | sfcnsw | surface_net_downwelling_shortwave_flux_on_radiation_time_step | total sky surface net downwelling shortwave flux on radiation time step | W m-2 | 1 | real | kind_phys | in | F | -!! | sfcdlw | surface_downwelling_longwave_flux_on_radiation_time_step | total sky surface downwelling longwave flux on radiation time step | W m-2 | 1 | real | kind_phys | in | F | -!! | swh | tendency_of_air_temperature_due_to_shortwave_heating_on_radiation_time_step | total sky shortwave heating rate on radiation time step | K s-1 | 2 | real | kind_phys | in | F | -!! | swhc | tendency_of_air_temperature_due_to_shortwave_heating_assuming_clear_sky_on_radiation_time_step | clear sky shortwave heating rate on radiation time step | K s-1 | 2 | real | kind_phys | in | F | -!! | hlw | tendency_of_air_temperature_due_to_longwave_heating_on_radiation_time_step | total sky longwave heating rate on radiation time step | K s-1 | 2 | real | kind_phys | in | F | -!! | hlwc | tendency_of_air_temperature_due_to_longwave_heating_assuming_clear_sky_on_radiation_time_step | clear sky longwave heating rate on radiation time step | K s-1 | 2 | real | kind_phys | in | F | -!! | sfcnirbmu | surface_upwelling_direct_near_infrared_shortwave_flux_on_radiation_time_step | total sky surface upwelling beam near-infrared shortwave flux on radiation time step | W m-2 | 1 | real | kind_phys | in | F | -!! | sfcnirdfu | surface_upwelling_diffuse_near_infrared_shortwave_flux_on_radiation_time_step | total sky surface upwelling diffuse near-infrared shortwave flux on radiation time step | W m-2 | 1 | real | kind_phys | in | F | -!! | sfcvisbmu | surface_upwelling_direct_ultraviolet_and_visible_shortwave_flux_on_radiation_time_step | total sky surface upwelling beam ultraviolet plus visible shortwave flux on radiation time step | W m-2 | 1 | real | kind_phys | in | F | -!! | sfcvisdfu | surface_upwelling_diffuse_ultraviolet_and_visible_shortwave_flux_on_radiation_time_step | total sky surface upwelling diffuse ultraviolet plus visible shortwave flux on radiation time step | W m-2 | 1 | real | kind_phys | in | F | -!! | sfcnirbmd | surface_downwelling_direct_near_infrared_shortwave_flux_on_radiation_time_step | total sky surface downwelling beam near-infrared shortwave flux on radiation time step | W m-2 | 1 | real | kind_phys | in | F | -!! | sfcnirdfd | surface_downwelling_diffuse_near_infrared_shortwave_flux_on_radiation_time_step | total sky surface downwelling diffuse near-infrared shortwave flux on radiation time step | W m-2 | 1 | real | kind_phys | in | F | -!! | sfcvisbmd | surface_downwelling_direct_ultraviolet_and_visible_shortwave_flux_on_radiation_time_step | total sky surface downwelling beam ultraviolet plus visible shortwave flux on radiation time step | W m-2 | 1 | real | kind_phys | in | F | -!! | sfcvisdfd | surface_downwelling_diffuse_ultraviolet_and_visible_shortwave_flux_on_radiation_time_step | total sky surface downwelling diffuse ultraviolet plus visible shortwave flux on radiation time step | W m-2 | 1 | real | kind_phys | in | F | -!! | ix | horizontal_dimension | horizontal dimension | count | 0 | integer | | in | F | -!! | im | horizontal_loop_extent | horizontal loop extent | count | 0 | integer | | in | F | -!! | levs | vertical_dimension | number of vertical layers | count | 0 | integer | | in | F | -!! | deltim | time_step_for_dynamics | dynamics timestep | s | 0 | real | kind_phys | in | F | -!! | dtdt | tendency_of_air_temperature_due_to_model_physics | total radiative heating rate at current time | K s-1 | 2 | real | kind_phys | inout | F | -!! | dtdtc | tendency_of_air_temperature_due_to_radiative_heating_assuming_clear_sky | clear sky radiative (shortwave + longwave) heating rate at current time | K s-1 | 2 | real | kind_phys | inout | F | -!! | adjsfcdsw | surface_downwelling_shortwave_flux | surface downwelling shortwave flux at current time | W m-2 | 1 | real | kind_phys | out | F | -!! | adjsfcnsw | surface_net_downwelling_shortwave_flux | surface net downwelling shortwave flux at current time | W m-2 | 1 | real | kind_phys | out | F | -!! | adjsfcdlw | surface_downwelling_longwave_flux | surface downwelling longwave flux at current time | W m-2 | 1 | real | kind_phys | out | F | -!! | adjsfculw | surface_upwelling_longwave_flux | surface upwelling longwave flux at current time | W m-2 | 1 | real | kind_phys | out | F | -!! | xmu | zenith_angle_temporal_adjustment_factor_for_shortwave_fluxes | zenith angle temporal adjustment factor for shortwave fluxes | none | 1 | real | kind_phys | out | F | -!! | xcosz | instantaneous_cosine_of_zenith_angle | cosine of zenith angle at current time | none | 1 | real | kind_phys | out | F | -!! | adjnirbmu | surface_upwelling_direct_near_infrared_shortwave_flux | surface upwelling beam near-infrared shortwave flux at current time | W m-2 | 1 | real | kind_phys | out | F | -!! | adjnirdfu | surface_upwelling_diffuse_near_infrared_shortwave_flux | surface upwelling diffuse near-infrared shortwave flux at current time | W m-2 | 1 | real | kind_phys | out | F | -!! | adjvisbmu | surface_upwelling_direct_ultraviolet_and_visible_shortwave_flux | surface upwelling beam ultraviolet plus visible shortwave flux at current time | W m-2 | 1 | real | kind_phys | out | F | -!! | adjvisdfu | surface_upwelling_diffuse_ultraviolet_and_visible_shortwave_flux | surface upwelling diffuse ultraviolet plus visible shortwave flux at current time | W m-2 | 1 | real | kind_phys | out | F | -!! | adjnirbmd | surface_downwelling_direct_near_infrared_shortwave_flux | surface downwelling beam near-infrared shortwave flux at current time | W m-2 | 1 | real | kind_phys | out | F | -!! | adjnirdfd | surface_downwelling_diffuse_near_infrared_shortwave_flux | surface downwelling diffuse near-infrared shortwave flux at current time | W m-2 | 1 | real | kind_phys | out | F | -!! | adjvisbmd | surface_downwelling_direct_ultraviolet_and_visible_shortwave_flux | surface downwelling beam ultraviolet plus visible shortwave flux at current time | W m-2 | 1 | real | kind_phys | out | F | -!! | adjvisdfd | surface_downwelling_diffuse_ultraviolet_and_visible_shortwave_flux | surface downwelling diffuse ultraviolet plus visible shortwave flux at current time | W m-2 | 1 | real | kind_phys | out | F | -!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | -!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | +!! \htmlinclude dcyc2t3_run.html !! !!\section dcyc2t3_general RRTMG dcyc2t3 General Algorithm !> @{ subroutine dcyc2t3_run & - & ( solhr,slag,sdec,cdec,sinlat,coslat, & ! --- inputs: - & xlon,coszen,tsea,tf,tsflw,sfcemis, & +! --- inputs: + & ( solhr,slag,sdec,cdec,sinlat,coslat, & + & xlon,coszen,tsfc_lnd,tsfc_ice,tsfc_ocn,tf,tsflw, & + & sfcemis_lnd, sfcemis_ice, sfcemis_ocn, & & sfcdsw,sfcnsw,sfcdlw,swh,swhc,hlw,hlwc, & & sfcnirbmu,sfcnirdfu,sfcvisbmu,sfcvisdfu, & & sfcnirbmd,sfcnirdfd,sfcvisbmd,sfcvisdfd, & - & ix, im, levs, deltim, & - & dtdt,dtdtc, & ! --- input/output: - & adjsfcdsw,adjsfcnsw,adjsfcdlw,adjsfculw,xmu,xcosz, & ! --- outputs: + & ix, im, levs, deltim, fhswr, & + & dry, icy, wet, & +! & dry, icy, wet, lprnt, ipr, & +! --- input/output: + & dtdt,dtdtc, & +! --- outputs: + & adjsfcdsw,adjsfcnsw,adjsfcdlw, & + & adjsfculw_lnd,adjsfculw_ice,adjsfculw_ocn,xmu,xcosz, & & adjnirbmu,adjnirdfu,adjvisbmu,adjvisdfu, & & adjnirbmd,adjnirdfd,adjvisbmd,adjvisdfd, & & errmsg,errflg & @@ -229,19 +203,31 @@ subroutine dcyc2t3_run & implicit none ! ! --- constant parameters: - real(kind=kind_phys), parameter :: f_eps = 0.0001, hour12 = 12.0,& - & f7200 = 1.0/7200.0, & + real(kind=kind_phys), parameter :: f_eps = 0.0001_kind_phys, & + & zero = 0.0d0, one = 1.0d0, & + & hour12 = 12.0_kind_phys, & + & f3600 = one/3600.0_kind_phys, & + & f7200 = one/7200.0_kind_phys, & + & czlimt = 0.0001_kind_phys, & ! ~ cos(89.99427) & pid12 = con_pi / hour12 ! --- inputs: integer, intent(in) :: ix, im, levs - real(kind=kind_phys), intent(in) :: solhr, slag, cdec, sdec, & - & deltim +! integer, intent(in) :: ipr +! logical lprnt + logical, dimension(im), intent(in) :: dry, icy, wet + real(kind=kind_phys), intent(in) :: solhr, slag, cdec, sdec, & + & deltim, fhswr real(kind=kind_phys), dimension(im), intent(in) :: & - & sinlat, coslat, xlon, coszen, tsea, tf, tsflw, sfcdlw, & - & sfcdsw, sfcnsw, sfcemis + & sinlat, coslat, xlon, coszen, tf, tsflw, sfcdlw, & + & sfcdsw, sfcnsw + + real(kind=kind_phys), dimension(im), intent(in) :: & + & tsfc_lnd, tsfc_ice, tsfc_ocn, & + & sfcemis_lnd, sfcemis_ice, sfcemis_ocn + real(kind=kind_phys), dimension(im), intent(in) :: & & sfcnirbmu, sfcnirdfu, sfcvisbmu, sfcvisdfu, & & sfcnirbmd, sfcnirdfd, sfcvisbmd, sfcvisdfd @@ -255,23 +241,62 @@ subroutine dcyc2t3_run & ! --- outputs: real(kind=kind_phys), dimension(im), intent(out) :: & - & adjsfcdsw, adjsfcnsw, adjsfcdlw, adjsfculw, xmu, xcosz, & + & adjsfcdsw, adjsfcnsw, adjsfcdlw, xmu, xcosz, & & adjnirbmu, adjnirdfu, adjvisbmu, adjvisdfu, & & adjnirbmd, adjnirdfd, adjvisbmd, adjvisdfd + + real(kind=kind_phys), dimension(im), intent(out) :: & + & adjsfculw_lnd, adjsfculw_ice, adjsfculw_ocn + character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg ! --- locals: - integer :: i, k - real(kind=kind_phys) :: cns, ss, cc, ch, tem1, tem2 + integer :: i, k, nstp, nstl, it, istsun(im) + real(kind=kind_phys) :: cns, coszn, tem1, tem2, anginc, & + & rstl, solang ! !===> ... begin here ! ! Initialize CCPP error handling variables errmsg = '' errflg = 0 + + tem1 = fhswr / deltim + nstp = max(6, nint(tem1)) + nstl = max(1, nint(nstp/tem1)) ! - cns = pid12 * (solhr + deltim*f7200 - hour12) + slag +! --- ... sw time-step adjustment for current cosine of zenith angle +! ---------------------------------------------------------- + if (nstl == 1) then + cns = pid12 * (solhr + deltim*f7200 - hour12) + slag + do i = 1, IM + xcosz(i) = sdec*sinlat(i) + cdec*coslat(i)*cos(cns+xlon(i)) + enddo + elseif (nstl == nstp) then + do i = 1, IM + xcosz(i) = coszen(i) + enddo + else + rstl = one / float(nstl) + solang = pid12 * (solhr - hour12) + anginc = pid12 * deltim * f3600 * rstl + do i = 1, im + xcosz(i) = zero + istsun(i) = zero + enddo + do it=1,nstl + cns = solang + (float(it)-0.5)*anginc + slag + do i = 1, IM + coszn = sdec*sinlat(i) + cdec*coslat(i)*cos(cns+xlon(i)) + xcosz(i) = xcosz(i) + max(0.0, coszn) + if (coszn > czlimt) istsun(i) = istsun(i) + 1 + enddo + enddo + do i = 1, IM + if (istsun(i) > 0) xcosz(i) = xcosz(i) / istsun(i) ! mean cosine of solar zenith angle at current time + enddo + endif ! do i = 1, im @@ -285,19 +310,27 @@ subroutine dcyc2t3_run & !! - compute \a sfc upward LW flux from current \a sfc temperature. ! note: sfc emiss effect is not appied here, and will be dealt in other place - tem2 = tsea(i) * tsea(i) - adjsfculw(i) = sfcemis(i) * con_sbc * tem2 * tem2 - & + (1.0 - sfcemis(i)) * adjsfcdlw(i) + if (dry(i)) then + tem2 = tsfc_lnd(i) * tsfc_lnd(i) + adjsfculw_lnd(i) = sfcemis_lnd(i) * con_sbc * tem2 * tem2 + & + (one - sfcemis_lnd(i)) * adjsfcdlw(i) + endif + if (icy(i)) then + tem2 = tsfc_ice(i) * tsfc_ice(i) + adjsfculw_ice(i) = sfcemis_ice(i) * con_sbc * tem2 * tem2 + & + (one - sfcemis_ice(i)) * adjsfcdlw(i) + endif + if (wet(i)) then + tem2 = tsfc_ocn(i) * tsfc_ocn(i) + adjsfculw_ocn(i) = sfcemis_ocn(i) * con_sbc * tem2 * tem2 + & + (one - sfcemis_ocn(i)) * adjsfcdlw(i) + endif +! if (lprnt .and. i == ipr) write(0,*)' in dcyc3: dry==',dry(i) +! &,' wet=',wet(i),' icy=',icy(i),' tsfc3=',tsfc3(i,:) +! &,' sfcemis=',sfcemis(i,:),' adjsfculw=',adjsfculw(i,:) ! -!> - SW time-step adjustment: - - ss = sinlat(i) * sdec - cc = coslat(i) * cdec - ch = cc * cos( xlon(i)+cns ) - xcosz(i) = ch + ss ! cosine of solar zenith angle at current time !> - normalize by average value over radiation period for daytime. - if ( xcosz(i) > f_eps .and. coszen(i) > f_eps ) then xmu(i) = xcosz(i) / coszen(i) else @@ -337,67 +370,3 @@ end subroutine dcyc2t3_run !> @} !----------------------------------- end module dcyc2t3 - - - - module dcyc2t3_post - - implicit none - - private - - public :: dcyc2t3_post_init,dcyc2t3_post_run,dcyc2t3_post_finalize - - contains - -!! \section arg_table_dcyc2t3_post_init Argument Table -!! - subroutine dcyc2t3_post_init() - end subroutine dcyc2t3_post_init - -!! \section arg_table_dcyc2t3_post_finalize Argument Table -!! - subroutine dcyc2t3_post_finalize() - end subroutine dcyc2t3_post_finalize - - -!> This subroutine contains CCPP-compliant dcyc2t3 that calulates -!! surface upwelling shortwave flux at current time. -!! -!! \section arg_table_dcyc2t3_post_run Argument Table -!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | -!! |----------------|----------------------------------------|--------------------------------------------------------|---------|------|-----------------------|-----------|--------|----------| -!! | im | horizontal_loop_extent | horizontal loop extent | count | 0 | integer | | in | F | -!! | adjsfcdsw | surface_downwelling_shortwave_flux | surface downwelling shortwave flux at current time | W m-2 | 1 | real | kind_phys | in | F | -!! | adjsfcnsw | surface_net_downwelling_shortwave_flux | surface net downwelling shortwave flux at current time | W m-2 | 1 | real | kind_phys | in | F | -!! | adjsfcusw | surface_upwelling_shortwave_flux | surface upwelling shortwave flux at current time | W m-2 | 1 | real | kind_phys | out | F | -!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | -!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | -!! - subroutine dcyc2t3_post_run( & - & im, adjsfcdsw, adjsfcnsw, adjsfcusw, & - & errmsg, errflg) - - use GFS_typedefs, only: GFS_diag_type - use machine, only: kind_phys - - implicit none - - integer, intent(in) :: im - real(kind=kind_phys), dimension(im), intent(in) :: adjsfcdsw - real(kind=kind_phys), dimension(im), intent(in) :: adjsfcnsw - real(kind=kind_phys), dimension(im), intent(out) :: adjsfcusw - character(len=*), intent(out) :: errmsg - integer, intent(out) :: errflg - - ! Initialize CCPP error handling variables - errmsg = '' - errflg = 0 - - adjsfcusw(:) = adjsfcdsw(:) - adjsfcnsw(:) - - return - end subroutine dcyc2t3_post_run - - end module dcyc2t3_post - diff --git a/physics/dcyc2.meta b/physics/dcyc2.meta new file mode 100644 index 000000000..2fa998781 --- /dev/null +++ b/physics/dcyc2.meta @@ -0,0 +1,604 @@ +[ccpp-arg-table] + name = dcyc2t3_init + type = scheme + +######################################################################## +[ccpp-arg-table] + name = dcyc2t3_finalize + type = scheme + +######################################################################## +[ccpp-arg-table] + name = dcyc2t3_run + type = scheme +[solhr] + standard_name = forecast_hour_of_the_day + long_name = time in hours after 00z at the current timestep + units = h + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[slag] + standard_name = equation_of_time + long_name = equation of time + units = radians + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[sdec] + standard_name = sine_of_solar_declination_angle + long_name = sine of solar declination angle + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[cdec] + standard_name = cosine_of_solar_declination_angle + long_name = cosine of solar declination angle + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[sinlat] + standard_name = sine_of_latitude + long_name = sine of latitude + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[coslat] + standard_name = cosine_of_latitude + long_name = cosine of latitude + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[xlon] + standard_name = longitude + long_name = longitude of grid box + units = radians + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[coszen] + standard_name = cosine_of_zenith_angle + long_name = average of cosine of zenith angle over daytime shortwave call time interval + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[tsfc_lnd] + standard_name = surface_skin_temperature_over_land_interstitial + long_name = surface skin temperature over land (temporary use as interstitial) + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[tsfc_ocn] + standard_name = surface_skin_temperature_over_ocean_interstitial + long_name = surface skin temperature over ocean (temporary use as interstitial) + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[tsfc_ice] + standard_name = surface_skin_temperature_over_ice_interstitial + long_name = surface skin temperature over ice (temporary use as interstitial) + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[tf] + standard_name = air_temperature_at_lowest_model_layer + long_name = air temperature at lowest model layer + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[tsflw] + standard_name = surface_midlayer_air_temperature_in_longwave_radiation + long_name = surface (first layer) air temperature saved in longwave radiation call + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[sfcemis_lnd] + standard_name = surface_longwave_emissivity_over_land_interstitial + long_name = surface lw emissivity in fraction over land (temporary use as interstitial) + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[sfcemis_ice] + standard_name = surface_longwave_emissivity_over_ice_interstitial + long_name = surface lw emissivity in fraction over ice (temporary use as interstitial) + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[sfcemis_ocn] + standard_name = surface_longwave_emissivity_over_ocean_interstitial + long_name = surface lw emissivity in fraction over ocean (temporary use as interstitial) + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[sfcdsw] + standard_name = surface_downwelling_shortwave_flux_on_radiation_time_step + long_name = total sky surface downwelling shortwave flux on radiation time step + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[sfcnsw] + standard_name = surface_net_downwelling_shortwave_flux_on_radiation_time_step + long_name = total sky surface net downwelling shortwave flux on radiation time step + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[sfcdlw] + standard_name = surface_downwelling_longwave_flux_on_radiation_time_step + long_name = total sky surface downwelling longwave flux on radiation time step + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[swh] + standard_name = tendency_of_air_temperature_due_to_shortwave_heating_on_radiation_timestep + long_name = total sky shortwave heating rate on radiation time step + units = K s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[swhc] + standard_name = tendency_of_air_temperature_due_to_shortwave_heating_assuming_clear_sky_on_radiation_timestep + long_name = clear sky shortwave heating rate on radiation time step + units = K s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[hlw] + standard_name = tendency_of_air_temperature_due_to_longwave_heating_on_radiation_timestep + long_name = total sky longwave heating rate on radiation time step + units = K s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[hlwc] + standard_name = tendency_of_air_temperature_due_to_longwave_heating_assuming_clear_sky_on_radiation_timestep + long_name = clear sky longwave heating rate on radiation time step + units = K s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[sfcnirbmu] + standard_name = surface_upwelling_direct_near_infrared_shortwave_flux_on_radiation_time_step + long_name = total sky surface upwelling beam near-infrared shortwave flux on radiation time step + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[sfcnirdfu] + standard_name = surface_upwelling_diffuse_near_infrared_shortwave_flux_on_radiation_time_step + long_name = total sky surface upwelling diffuse near-infrared shortwave flux on radiation time step + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[sfcvisbmu] + standard_name = surface_upwelling_direct_ultraviolet_and_visible_shortwave_flux_on_radiation_time_step + long_name = total sky surface upwelling beam ultraviolet plus visible shortwave flux on radiation time step + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[sfcvisdfu] + standard_name = surface_upwelling_diffuse_ultraviolet_and_visible_shortwave_flux_on_radiation_time_step + long_name = total sky surface upwelling diffuse ultraviolet plus visible shortwave flux on radiation time step + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[sfcnirbmd] + standard_name = surface_downwelling_direct_near_infrared_shortwave_flux_on_radiation_time_step + long_name = total sky surface downwelling beam near-infrared shortwave flux on radiation time step + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[sfcnirdfd] + standard_name = surface_downwelling_diffuse_near_infrared_shortwave_flux_on_radiation_time_step + long_name = total sky surface downwelling diffuse near-infrared shortwave flux on radiation time step + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[sfcvisbmd] + standard_name = surface_downwelling_direct_ultraviolet_and_visible_shortwave_flux_on_radiation_time_step + long_name = total sky surface downwelling beam ultraviolet plus visible shortwave flux on radiation time step + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[sfcvisdfd] + standard_name = surface_downwelling_diffuse_ultraviolet_and_visible_shortwave_flux_on_radiation_time_step + long_name = total sky surface downwelling diffuse ultraviolet plus visible shortwave flux on radiation time step + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[ix] + standard_name = horizontal_dimension + long_name = horizontal dimension + units = count + dimensions = () + type = integer + intent = in + optional = F +[im] + standard_name = horizontal_loop_extent + long_name = horizontal loop extent + units = count + dimensions = () + type = integer + intent = in + optional = F +[levs] + standard_name = vertical_dimension + long_name = number of vertical layers + units = count + dimensions = () + type = integer + intent = in + optional = F +[deltim] + standard_name = time_step_for_dynamics + long_name = dynamics timestep + units = s + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[fhswr] + standard_name = frequency_for_shortwave_radiation + long_name = frequency for shortwave radiation + units = s + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[dry] + standard_name = flag_nonzero_land_surface_fraction + long_name = flag indicating presence of some land surface area fraction + units = flag + dimensions = (horizontal_dimension) + type = logical + intent = in + optional = F +[icy] + standard_name = flag_nonzero_sea_ice_surface_fraction + long_name = flag indicating presence of some sea ice surface area fraction + units = flag + dimensions = (horizontal_dimension) + type = logical + intent = in + optional = F +[wet] + standard_name = flag_nonzero_wet_surface_fraction + long_name = flag indicating presence of some ocean or lake surface area fraction + units = flag + dimensions = (horizontal_dimension) + type = logical + intent = in + optional = F +[dtdt] + standard_name = tendency_of_air_temperature_due_to_model_physics + long_name = total radiative heating rate at current time + units = K s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[dtdtc] + standard_name = tendency_of_air_temperature_due_to_radiative_heating_assuming_clear_sky + long_name = clear sky radiative (shortwave + longwave) heating rate at current time + units = K s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[adjsfcdsw] + standard_name = surface_downwelling_shortwave_flux + long_name = surface downwelling shortwave flux at current time + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[adjsfcnsw] + standard_name = surface_net_downwelling_shortwave_flux + long_name = surface net downwelling shortwave flux at current time + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[adjsfcdlw] + standard_name = surface_downwelling_longwave_flux + long_name = surface downwelling longwave flux at current time + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[adjsfculw_lnd] + standard_name = surface_upwelling_longwave_flux_over_land_interstitial + long_name = surface upwelling longwave flux at current time over land (temporary use as interstitial) + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[adjsfculw_ice] + standard_name = surface_upwelling_longwave_flux_over_ice_interstitial + long_name = surface upwelling longwave flux at current time over ice (temporary use as interstitial) + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[adjsfculw_ocn] + standard_name = surface_upwelling_longwave_flux_over_ocean_interstitial + long_name = surface upwelling longwave flux at current time over ocean (temporary use as interstitial) + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[xmu] + standard_name = zenith_angle_temporal_adjustment_factor_for_shortwave_fluxes + long_name = zenith angle temporal adjustment factor for shortwave fluxes + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[xcosz] + standard_name = instantaneous_cosine_of_zenith_angle + long_name = cosine of zenith angle at current time + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[adjnirbmu] + standard_name = surface_upwelling_direct_near_infrared_shortwave_flux + long_name = surface upwelling beam near-infrared shortwave flux at current time + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[adjnirdfu] + standard_name = surface_upwelling_diffuse_near_infrared_shortwave_flux + long_name = surface upwelling diffuse near-infrared shortwave flux at current time + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[adjvisbmu] + standard_name = surface_upwelling_direct_ultraviolet_and_visible_shortwave_flux + long_name = surface upwelling beam ultraviolet plus visible shortwave flux at current time + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[adjvisdfu] + standard_name = surface_upwelling_diffuse_ultraviolet_and_visible_shortwave_flux + long_name = surface upwelling diffuse ultraviolet plus visible shortwave flux at current time + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[adjnirbmd] + standard_name = surface_downwelling_direct_near_infrared_shortwave_flux + long_name = surface downwelling beam near-infrared shortwave flux at current time + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[adjnirdfd] + standard_name = surface_downwelling_diffuse_near_infrared_shortwave_flux + long_name = surface downwelling diffuse near-infrared shortwave flux at current time + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[adjvisbmd] + standard_name = surface_downwelling_direct_ultraviolet_and_visible_shortwave_flux + long_name = surface downwelling beam ultraviolet plus visible shortwave flux at current time + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[adjvisdfd] + standard_name = surface_downwelling_diffuse_ultraviolet_and_visible_shortwave_flux + long_name = surface downwelling diffuse ultraviolet plus visible shortwave flux at current time + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F + +######################################################################## +[ccpp-arg-table] + name = dcyc2t3_post_init + type = scheme + +######################################################################## +[ccpp-arg-table] + name = dcyc2t3_post_finalize + type = scheme + +######################################################################## +[ccpp-arg-table] + name = dcyc2t3_post_run + type = scheme +[im] + standard_name = horizontal_loop_extent + long_name = horizontal loop extent + units = count + dimensions = () + type = integer + intent = in + optional = F +[adjsfcdsw] + standard_name = surface_downwelling_shortwave_flux + long_name = surface downwelling shortwave flux at current time + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[adjsfcnsw] + standard_name = surface_net_downwelling_shortwave_flux + long_name = surface net downwelling shortwave flux at current time + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[adjsfcusw] + standard_name = surface_upwelling_shortwave_flux + long_name = surface upwelling shortwave flux at current time + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F diff --git a/physics/docs/ccpp_doxyfile b/physics/docs/ccpp_doxyfile new file mode 100644 index 000000000..339ddb3f8 --- /dev/null +++ b/physics/docs/ccpp_doxyfile @@ -0,0 +1,463 @@ +# Doxyfile 1.8.11 +DOXYFILE_ENCODING = UTF-8 +PROJECT_NAME = "Common Community Physics Package (CCPP) Scientific Documentation" +PROJECT_NUMBER = "" +PROJECT_BRIEF = " " +PROJECT_LOGO = img/dtc_logo.png +OUTPUT_DIRECTORY = doc +CREATE_SUBDIRS = NO +ALLOW_UNICODE_NAMES = NO +OUTPUT_LANGUAGE = English +BRIEF_MEMBER_DESC = YES +REPEAT_BRIEF = NO +ABBREVIATE_BRIEF = +ALWAYS_DETAILED_SEC = NO +INLINE_INHERITED_MEMB = NO +FULL_PATH_NAMES = NO +STRIP_FROM_PATH = +STRIP_FROM_INC_PATH = +SHORT_NAMES = NO +JAVADOC_AUTOBRIEF = NO +QT_AUTOBRIEF = NO +MULTILINE_CPP_IS_BRIEF = NO +INHERIT_DOCS = YES +SEPARATE_MEMBER_PAGES = YES +TAB_SIZE = 4 +ALIASES = +TCL_SUBST = +OPTIMIZE_OUTPUT_FOR_C = NO +OPTIMIZE_OUTPUT_JAVA = NO +OPTIMIZE_FOR_FORTRAN = YES +OPTIMIZE_OUTPUT_VHDL = NO +EXTENSION_MAPPING = .f=Fortranfixed \ + .F=Fortranfixed \ + .F90=FortranFree \ + .f90=FortranFree +MARKDOWN_SUPPORT = YES +AUTOLINK_SUPPORT = YES +BUILTIN_STL_SUPPORT = NO +CPP_CLI_SUPPORT = NO +SIP_SUPPORT = NO +IDL_PROPERTY_SUPPORT = YES +DISTRIBUTE_GROUP_DOC = YES +GROUP_NESTED_COMPOUNDS = NO +SUBGROUPING = YES +INLINE_GROUPED_CLASSES = NO +INLINE_SIMPLE_STRUCTS = NO +TYPEDEF_HIDES_STRUCT = YES +LOOKUP_CACHE_SIZE = 0 +EXTRACT_ALL = YES +EXTRACT_PRIVATE = YES +EXTRACT_PACKAGE = YES +EXTRACT_STATIC = YES +EXTRACT_LOCAL_CLASSES = YES +EXTRACT_LOCAL_METHODS = YES +EXTRACT_ANON_NSPACES = YES +HIDE_UNDOC_MEMBERS = NO +HIDE_UNDOC_CLASSES = NO +HIDE_FRIEND_COMPOUNDS = NO +HIDE_IN_BODY_DOCS = NO +INTERNAL_DOCS = YES + +CASE_SENSE_NAMES = NO + +HIDE_SCOPE_NAMES = NO + +HIDE_COMPOUND_REFERENCE= NO + +SHOW_INCLUDE_FILES = NO + +SHOW_GROUPED_MEMB_INC = NO + +FORCE_LOCAL_INCLUDES = NO + +INLINE_INFO = YES + +SORT_MEMBER_DOCS = NO + +SORT_BRIEF_DOCS = NO +SORT_MEMBERS_CTORS_1ST = NO +SORT_GROUP_NAMES = NO +SORT_BY_SCOPE_NAME = NO +STRICT_PROTO_MATCHING = NO +GENERATE_TODOLIST = YES +GENERATE_TESTLIST = YES +GENERATE_BUGLIST = YES +GENERATE_DEPRECATEDLIST= YES +ENABLED_SECTIONS = YES +MAX_INITIALIZER_LINES = 30 +SHOW_USED_FILES = YES +SHOW_FILES = YES +SHOW_NAMESPACES = YES +FILE_VERSION_FILTER = +LAYOUT_FILE = ccpp_dox_layout.xml +CITE_BIB_FILES = library.bib +QUIET = NO +WARNINGS = YES +WARN_IF_UNDOCUMENTED = NO +WARN_IF_DOC_ERROR = YES +WARN_NO_PARAMDOC = NO +WARN_AS_ERROR = NO +WARN_FORMAT = +WARN_LOGFILE = +INPUT = pdftxt/mainpage.txt \ + pdftxt/all_shemes_list.txt \ + pdftxt/GFSv15_suite.txt \ + pdftxt/GFSv15_suite_TKEEDMF.txt \ + pdftxt/CPT_adv_suite.txt \ + pdftxt/GSD_adv_suite.txt \ + pdftxt/GFS_RRTMG.txt \ + pdftxt/GFS_SFCLYR.txt \ + pdftxt/GFS_NSST.txt \ + pdftxt/GFS_NOAH.txt \ + pdftxt/GFS_SFCSICE.txt \ + pdftxt/GFS_HEDMF.txt \ + pdftxt/GFS_SATMEDMF.txt \ + pdftxt/GFS_SATMEDMFVDIFQ.txt \ + pdftxt/GFS_GWDPS.txt \ + pdftxt/GFS_OZPHYS.txt \ + pdftxt/GFS_H2OPHYS.txt \ + pdftxt/GFS_RAYLEIGH.txt \ + pdftxt/GFS_SAMF.txt \ + pdftxt/GFS_SAMFdeep.txt \ + pdftxt/GFS_GWDC.txt \ + pdftxt/UGWPv0.txt \ + pdftxt/GFS_SAMFshal.txt \ + pdftxt/GFDL_cloud.txt \ +### pdftxt/GFS_SURFACE_PERT.txt \ + pdftxt/GFS_CALPRECIPTYPE.txt \ +### pdftxt/rad_cld.txt \ + pdftxt/CPT_CSAW.txt \ + pdftxt/CPT_MG3.txt \ + pdftxt/GSD_MYNN_EDMF.txt \ + pdftxt/GSD_CU_GF_deep.txt \ + pdftxt/GSD_RUCLSM.txt \ + pdftxt/GSD_THOMPSON.txt \ +### pdftxt/GFSphys_namelist.txt \ +### pdftxt/GFS_STOCHY_PHYS.txt \ + pdftxt/suite_input.nml.txt \ + pdftxt/NoahMP.txt \ +### in-core MP + ../gfdl_fv_sat_adj.F90 \ +### time_vary + ../GFS_phys_time_vary.fv3.F90 \ + ../GFS_rad_time_vary.fv3.F90 \ + ../ozne_def.f \ + ../ozinterp.f90 \ + ../h2o_def.f \ + ../h2ointerp.f90 \ + ../aerclm_def.F \ + ../aerinterp.F90 \ + ../iccn_def.F \ + ../iccninterp.F90 \ + ../sfcsub.F \ + ../gcycle.F90 \ +### Radiation + ../radlw_main.f \ + ../radsw_main.f \ + ../radiation_aerosols.f \ + ../radiation_astronomy.f \ + ../radiation_clouds.f \ + ../radiation_gases.f \ + ../radiation_surface.f \ + ../radlw_param.f \ + ../radlw_datatb.f \ + ../radsw_param.f \ + ../radsw_datatb.f \ + ../dcyc2.f \ +### Land Surface + ../sfc_diff.f \ + ../sfc_nst.f \ + ../module_nst_model.f90 \ + ../module_nst_parameters.f90 \ + ../module_nst_water_prop.f90 \ + ../sfc_drv.f \ + ../sflx.f \ + ../namelist_soilveg.f \ + ../set_soilveg.f \ + ../sfc_noahmp_drv.f \ + ../module_sf_noahmplsm.f90 \ + ../module_sf_noahmp_glacier.f90 \ + ../noahmp_tables.f90 \ +### Sea Ice Surface + ../sfc_sice.f \ +### PBL + ../moninedmf.f \ + ../mfpbl.f \ + ../tridi.f \ +### satmedmf + ../satmedmfvdif.F \ + ../mfpblt.f \ + ../mfscu.f \ + ../tridi.f \ +### satmedmfvdifq + ../satmedmfvdifq.F \ + ../mfpbltq.f \ + ../mfscuq.f \ + ../tridi.f \ +### Orographic Gravity Wave + ../gwdps.f \ +### Rayleigh Dampling + ../rayleigh_damp.f \ +### Prognostic Ozone + ../ozphys_2015.f \ +### ../ozphys.f \ +### stratospheric h2o + ../h2ophys.f \ +### Deep Convection + ../samfdeepcnv.f \ +### Convective Gravity Wave + ../gwdc.f \ +### Shallow Convection + ../samfshalcnv.f \ + ../cnvc90.f \ +### Unified Gravity Wave + ../cires_ugwp.F90 \ + ../ugwp_driver_v0.F \ + ../cires_ugwp_triggers.F90 \ +### Microphysics +### ../gscond.f \ +### ../precpd.f \ + ../module_bfmicrophysics.f \ +### GFDL cloud MP + ../gfdl_cloud_microphys.F90 \ + ../module_gfdl_cloud_microphys.F90 \ +### + ../GFS_MP_generic.F90 \ + ../calpreciptype.f90 \ +### stochy +### ../GFS_stochastics.F90 \ +### ../surface_perturbation.F90 \ +### ../../stochastic_physics/stochastic_physics.F90 \ +### CPT + ../m_micro.F90 \ +### ../micro_mg2_0.F90 \ + ../micro_mg3_0.F90 \ + ../micro_mg_utils.F90 \ + ../cldmacro.F \ + ../aer_cloud.F \ + ../cldwat2m_micro.F \ + ../wv_saturation.F \ + ../cs_conv_aw_adj.F90 \ + ../cs_conv.F90 \ +### GSD + ../cu_gf_driver.F90 \ + ../cu_gf_deep.F90 \ + ../cu_gf_sh.F90 \ + ../module_MYNNrad_pre.F90 \ + ../module_MYNNrad_post.F90 \ + ../module_MYNNPBL_wrapper.F90 \ + ../module_bl_mynn.F90 \ +### ../module_MYNNSFC_wrapper.F90 \ +### ../module_sf_mynn.F90 \ + ../sfc_drv_ruc.F90 \ + ../module_sf_ruclsm.F90 \ + ../namelist_soilveg_ruc.F90 \ + ../set_soilveg_ruc.F90 \ + ../module_soil_pre.F90 \ + ../mp_thompson_pre.F90 \ + ../module_mp_thompson_make_number_concentrations.F90 \ + ../mp_thompson.F90 \ + ../module_mp_thompson.F90 \ + ../module_mp_radar.F90 \ + ../mp_thompson_post.F90 \ +### HAFS + ../module_MP_FER_HIRES.F90 \ + ../mp_fer_hires.F90 \ + ../module_mp_fer_hires_pre.F90 \ +### utils + ../funcphys.f90 \ + ../physparam.f \ + ../physcons.F90 \ + ../radcons.f90 \ + ../mersenne_twister.f \ + compns_stochy.F90 + + +INPUT_ENCODING = UTF-8 +FILE_PATTERNS = *.f \ + *.F \ + *.F90 \ + *.f90 \ + *.nml \ + *.txt +RECURSIVE = YES +EXCLUDE = +EXCLUDE_SYMLINKS = NO +EXCLUDE_PATTERNS = +EXCLUDE_SYMBOLS = +EXAMPLE_PATH = ./ +EXAMPLE_PATTERNS = +EXAMPLE_RECURSIVE = NO +IMAGE_PATH = img +INPUT_FILTER = +FILTER_PATTERNS = +FILTER_SOURCE_FILES = NO +FILTER_SOURCE_PATTERNS = +USE_MDFILE_AS_MAINPAGE = +SOURCE_BROWSER = NO +INLINE_SOURCES = NO +STRIP_CODE_COMMENTS = YES +REFERENCED_BY_RELATION = YES +REFERENCES_RELATION = YES +REFERENCES_LINK_SOURCE = YES +SOURCE_TOOLTIPS = YES +USE_HTAGS = NO +VERBATIM_HEADERS = YES +#CLANG_ASSISTED_PARSING = NO +#CLANG_OPTIONS = +ALPHABETICAL_INDEX = NO +COLS_IN_ALPHA_INDEX = 5 +IGNORE_PREFIX = +GENERATE_HTML = YES +HTML_OUTPUT = html +HTML_FILE_EXTENSION = .html +HTML_HEADER = +HTML_FOOTER = +HTML_STYLESHEET = +HTML_EXTRA_STYLESHEET = ccpp_dox_extra_style.css +HTML_EXTRA_FILES = +HTML_COLORSTYLE_HUE = 220 +HTML_COLORSTYLE_SAT = 100 +HTML_COLORSTYLE_GAMMA = 80 +HTML_TIMESTAMP = NO +HTML_DYNAMIC_SECTIONS = NO +HTML_INDEX_NUM_ENTRIES = 100 +GENERATE_DOCSET = NO +DOCSET_FEEDNAME = "Doxygen generated docs" +DOCSET_BUNDLE_ID = org.doxygen.Project +DOCSET_PUBLISHER_ID = org.doxygen.Publisher +DOCSET_PUBLISHER_NAME = Publisher +GENERATE_HTMLHELP = NO +CHM_FILE = +HHC_LOCATION = +GENERATE_CHI = NO +CHM_INDEX_ENCODING = +BINARY_TOC = NO +TOC_EXPAND = NO +GENERATE_QHP = NO +QCH_FILE = +QHP_NAMESPACE = org.doxygen.Project +QHP_VIRTUAL_FOLDER = doc +QHP_CUST_FILTER_NAME = +QHP_CUST_FILTER_ATTRS = +QHP_SECT_FILTER_ATTRS = +QHG_LOCATION = +GENERATE_ECLIPSEHELP = NO +ECLIPSE_DOC_ID = org.doxygen.Project +DISABLE_INDEX = YES +GENERATE_TREEVIEW = YES +ENUM_VALUES_PER_LINE = 4 +TREEVIEW_WIDTH = 250 +EXT_LINKS_IN_WINDOW = NO +FORMULA_FONTSIZE = 10 +FORMULA_TRANSPARENT = YES +USE_MATHJAX = YES +MATHJAX_FORMAT = HTML-CSS +MATHJAX_RELPATH = https://cdnjs.cloudflare.com/ajax/libs/mathjax/2.7.2 +MATHJAX_EXTENSIONS = +MATHJAX_CODEFILE = +SEARCHENGINE = YES +SERVER_BASED_SEARCH = NO +EXTERNAL_SEARCH = NO +SEARCHENGINE_URL = +SEARCHDATA_FILE = searchdata.xml +EXTERNAL_SEARCH_ID = +EXTRA_SEARCH_MAPPINGS = +GENERATE_LATEX = YES +LATEX_OUTPUT = latex +LATEX_CMD_NAME = latex +MAKEINDEX_CMD_NAME = makeindex +COMPACT_LATEX = YES +PAPER_TYPE = a4 +EXTRA_PACKAGES = amsmath +LATEX_HEADER = +LATEX_FOOTER = +LATEX_EXTRA_STYLESHEET = +LATEX_EXTRA_FILES = +PDF_HYPERLINKS = YES +USE_PDFLATEX = YES +LATEX_BATCHMODE = NO +LATEX_HIDE_INDICES = YES +LATEX_SOURCE_CODE = NO + +LATEX_BIB_STYLE = plainnat + +LATEX_TIMESTAMP = NO + +GENERATE_RTF = NO + +RTF_OUTPUT = rtf +COMPACT_RTF = NO +RTF_HYPERLINKS = NO +RTF_STYLESHEET_FILE = +RTF_EXTENSIONS_FILE = +RTF_SOURCE_CODE = NO +GENERATE_MAN = NO +MAN_OUTPUT = man +MAN_EXTENSION = .3 +MAN_SUBDIR = +MAN_LINKS = NO +GENERATE_XML = NO +XML_OUTPUT = xml +XML_PROGRAMLISTING = YES +GENERATE_DOCBOOK = NO +DOCBOOK_OUTPUT = docbook +DOCBOOK_PROGRAMLISTING = NO +GENERATE_AUTOGEN_DEF = NO +GENERATE_PERLMOD = NO +PERLMOD_LATEX = NO +PERLMOD_PRETTY = YES +PERLMOD_MAKEVAR_PREFIX = +ENABLE_PREPROCESSING = NO +MACRO_EXPANSION = NO +EXPAND_ONLY_PREDEF = NO +SEARCH_INCLUDES = YES +INCLUDE_PATH = +INCLUDE_FILE_PATTERNS = +PREDEFINED = CCPP \ + MULTI_GASES \ + 0 +EXPAND_AS_DEFINED = +SKIP_FUNCTION_MACROS = YES +TAGFILES = +GENERATE_TAGFILE = +ALLEXTERNALS = NO +EXTERNAL_GROUPS = YES +EXTERNAL_PAGES = YES +PERL_PATH = /usr/bin/perl +CLASS_DIAGRAMS = YES +MSCGEN_PATH = +DIA_PATH = +HIDE_UNDOC_RELATIONS = NO +HAVE_DOT = YES +DOT_NUM_THREADS = 0 +DOT_FONTNAME = Helvetica +DOT_FONTSIZE = 10 +DOT_FONTPATH = +CLASS_GRAPH = NO +COLLABORATION_GRAPH = NO +GROUP_GRAPHS = YES +UML_LOOK = YES +UML_LIMIT_NUM_FIELDS = 10 +TEMPLATE_RELATIONS = NO +INCLUDE_GRAPH = YES +INCLUDED_BY_GRAPH = NO +CALL_GRAPH = YES +CALLER_GRAPH = NO +GRAPHICAL_HIERARCHY = YES +DIRECTORY_GRAPH = YES +DOT_IMAGE_FORMAT = svg +INTERACTIVE_SVG = NO +DOT_PATH = +DOTFILE_DIRS = +MSCFILE_DIRS = +DIAFILE_DIRS = +PLANTUML_JAR_PATH = +PLANTUML_INCLUDE_PATH = +DOT_GRAPH_MAX_NODES = 200 +MAX_DOT_GRAPH_DEPTH = 0 +DOT_TRANSPARENT = NO +DOT_MULTI_TARGETS = YES +GENERATE_LEGEND = YES +DOT_CLEANUP = YES diff --git a/physics/docs/ccpplatex_dox b/physics/docs/ccpplatex_dox index 0dd432cd1..5d0e68ae0 100644 --- a/physics/docs/ccpplatex_dox +++ b/physics/docs/ccpplatex_dox @@ -29,7 +29,8 @@ OPTIMIZE_OUTPUT_FOR_C = NO OPTIMIZE_OUTPUT_JAVA = NO OPTIMIZE_FOR_FORTRAN = YES OPTIMIZE_OUTPUT_VHDL = NO -EXTENSION_MAPPING = .f=FortranFree \ +EXTENSION_MAPPING = .F=FortranFree \ + .f=FortranFree \ .F90=FortranFree \ .f90=FortranFree MARKDOWN_SUPPORT = YES @@ -175,7 +176,8 @@ INPUT = pdftxt/mainpage.txt \ ../funcphys.f90 \ ../physparam.f \ ../physcons.f90 \ - ../radcons.f90 + ../radcons.f90 \ + ../machine.F INPUT_ENCODING = UTF-8 FILE_PATTERNS = *.f \ @@ -187,7 +189,7 @@ EXCLUDE = EXCLUDE_SYMLINKS = NO EXCLUDE_PATTERNS = EXCLUDE_SYMBOLS = -EXAMPLE_PATH = +EXAMPLE_PATH = . EXAMPLE_PATTERNS = EXAMPLE_RECURSIVE = NO IMAGE_PATH = img diff --git a/physics/docs/ccppv3_doxyfile b/physics/docs/ccppv3_doxyfile index fbd18f515..6933751a4 100644 --- a/physics/docs/ccppv3_doxyfile +++ b/physics/docs/ccppv3_doxyfile @@ -120,7 +120,7 @@ INPUT = pdftxt/mainpage.txt \ pdftxt/GFS_GWDC.txt \ pdftxt/GFS_SAMFshal.txt \ pdftxt/GFDL_cloud.txt \ - pdftxt/GFS_SURFACE_PERT.txt \ +### pdftxt/GFS_SURFACE_PERT.txt \ pdftxt/GFS_CALPRECIPTYPE.txt \ ### pdftxt/rad_cld.txt \ pdftxt/CPT_CSAW.txt \ @@ -130,7 +130,7 @@ INPUT = pdftxt/mainpage.txt \ pdftxt/GSD_RUCLSM.txt \ pdftxt/GSD_THOMPSON.txt \ ### pdftxt/GFSphys_namelist.txt \ - pdftxt/GFS_STOCHY_PHYS.txt \ +### pdftxt/GFS_STOCHY_PHYS.txt \ pdftxt/suite_input.nml.txt \ ### in-core MP ../gfdl_fv_sat_adj.F90 \ @@ -207,12 +207,12 @@ INPUT = pdftxt/mainpage.txt \ ../GFS_MP_generic.F90 \ ../calpreciptype.f90 \ ### stochy - ../GFS_stochastics.F90 \ - ../surface_perturbation.F90 \ +### ../GFS_stochastics.F90 \ +### ../surface_perturbation.F90 \ ### ../../stochastic_physics/stochastic_physics.F90 \ ### CPT ../m_micro.F90 \ - ../micro_mg2_0.F90 \ +### ../micro_mg2_0.F90 \ ../micro_mg3_0.F90 \ ../micro_mg_utils.F90 \ ../cldmacro.F \ @@ -392,7 +392,8 @@ SEARCH_INCLUDES = YES INCLUDE_PATH = INCLUDE_FILE_PATTERNS = PREDEFINED = CCPP \ - GEOS5 + MULTI_GASES \ + 0 EXPAND_AS_DEFINED = SKIP_FUNCTION_MACROS = YES TAGFILES = diff --git a/physics/docs/ccppv3_fv3_doxyfile b/physics/docs/ccppv3_fv3_doxyfile new file mode 100644 index 000000000..b2b896b9e --- /dev/null +++ b/physics/docs/ccppv3_fv3_doxyfile @@ -0,0 +1,441 @@ +# Doxyfile 1.8.11 +DOXYFILE_ENCODING = UTF-8 +PROJECT_NAME = "Common Community Physics Package (CCPP) Scientific Documentation" +PROJECT_NUMBER = "Version 3.0" +PROJECT_BRIEF = " " +PROJECT_LOGO = img/dtc_logo.png +OUTPUT_DIRECTORY = doc +CREATE_SUBDIRS = NO +ALLOW_UNICODE_NAMES = NO +OUTPUT_LANGUAGE = English +BRIEF_MEMBER_DESC = YES +REPEAT_BRIEF = NO +ABBREVIATE_BRIEF = +ALWAYS_DETAILED_SEC = NO +INLINE_INHERITED_MEMB = NO +FULL_PATH_NAMES = NO +STRIP_FROM_PATH = +STRIP_FROM_INC_PATH = +SHORT_NAMES = NO +JAVADOC_AUTOBRIEF = NO +QT_AUTOBRIEF = NO +MULTILINE_CPP_IS_BRIEF = NO +INHERIT_DOCS = YES +SEPARATE_MEMBER_PAGES = YES +TAB_SIZE = 4 +ALIASES = +TCL_SUBST = +OPTIMIZE_OUTPUT_FOR_C = NO +OPTIMIZE_OUTPUT_JAVA = NO +OPTIMIZE_FOR_FORTRAN = YES +OPTIMIZE_OUTPUT_VHDL = NO +EXTENSION_MAPPING = .f=FortranFree \ + .F90=FortranFree \ + .f90=FortranFree +MARKDOWN_SUPPORT = YES +AUTOLINK_SUPPORT = YES +BUILTIN_STL_SUPPORT = NO +CPP_CLI_SUPPORT = NO +SIP_SUPPORT = NO +IDL_PROPERTY_SUPPORT = YES +DISTRIBUTE_GROUP_DOC = YES +GROUP_NESTED_COMPOUNDS = NO +SUBGROUPING = YES +INLINE_GROUPED_CLASSES = NO +INLINE_SIMPLE_STRUCTS = NO +TYPEDEF_HIDES_STRUCT = YES +LOOKUP_CACHE_SIZE = 0 +EXTRACT_ALL = YES +EXTRACT_PRIVATE = YES +EXTRACT_PACKAGE = YES +EXTRACT_STATIC = YES +EXTRACT_LOCAL_CLASSES = YES +EXTRACT_LOCAL_METHODS = YES +EXTRACT_ANON_NSPACES = YES +HIDE_UNDOC_MEMBERS = NO +HIDE_UNDOC_CLASSES = NO +HIDE_FRIEND_COMPOUNDS = NO +HIDE_IN_BODY_DOCS = NO +INTERNAL_DOCS = YES + +CASE_SENSE_NAMES = NO + +HIDE_SCOPE_NAMES = NO + +HIDE_COMPOUND_REFERENCE= NO + +SHOW_INCLUDE_FILES = NO + +SHOW_GROUPED_MEMB_INC = NO + +FORCE_LOCAL_INCLUDES = NO + +INLINE_INFO = YES + +SORT_MEMBER_DOCS = NO + +SORT_BRIEF_DOCS = NO +SORT_MEMBERS_CTORS_1ST = NO +SORT_GROUP_NAMES = NO +SORT_BY_SCOPE_NAME = NO +STRICT_PROTO_MATCHING = NO +GENERATE_TODOLIST = YES +GENERATE_TESTLIST = YES +GENERATE_BUGLIST = YES +GENERATE_DEPRECATEDLIST= YES +ENABLED_SECTIONS = YES +MAX_INITIALIZER_LINES = 30 +SHOW_USED_FILES = YES +SHOW_FILES = YES +SHOW_NAMESPACES = YES +FILE_VERSION_FILTER = +LAYOUT_FILE = ccpp_dox_layout.xml +CITE_BIB_FILES = library.bib +QUIET = NO +WARNINGS = YES +WARN_IF_UNDOCUMENTED = NO +WARN_IF_DOC_ERROR = YES +WARN_NO_PARAMDOC = NO +WARN_AS_ERROR = NO +WARN_FORMAT = +WARN_LOGFILE = +INPUT = pdftxt/mainpage.txt \ + pdftxt/all_shemes_list.txt \ + pdftxt/GFSv15_suite.txt \ + pdftxt/GFSv15_suite_TKEEDMF.txt \ + pdftxt/CPT_adv_suite.txt \ + pdftxt/GSD_adv_suite.txt \ + pdftxt/GFS_RRTMG.txt \ + pdftxt/GFS_SFCLYR.txt \ + pdftxt/GFS_NSST.txt \ + pdftxt/GFS_NOAH.txt \ + pdftxt/GFS_SFCSICE.txt \ + pdftxt/GFS_HEDMF.txt \ + pdftxt/GFS_SATMEDMF.txt \ + pdftxt/GFS_GWDPS.txt \ + pdftxt/GFS_OZPHYS.txt \ + pdftxt/GFS_H2OPHYS.txt \ + pdftxt/GFS_RAYLEIGH.txt \ + pdftxt/GFS_SAMF.txt \ + pdftxt/GFS_SAMFdeep.txt \ + pdftxt/GFS_GWDC.txt \ + pdftxt/GFS_SAMFshal.txt \ + pdftxt/GFDL_cloud.txt \ +### pdftxt/GFS_SURFACE_PERT.txt \ + pdftxt/GFS_CALPRECIPTYPE.txt \ +### pdftxt/rad_cld.txt \ + pdftxt/CPT_CSAW.txt \ + pdftxt/CPT_MG3.txt \ + pdftxt/GSD_MYNN_EDMF.txt \ + pdftxt/GSD_CU_GF_deep.txt \ + pdftxt/GSD_RUCLSM.txt \ + pdftxt/GSD_THOMPSON.txt \ +### pdftxt/GFSphys_namelist.txt \ +### pdftxt/GFS_STOCHY_PHYS.txt \ + pdftxt/suite_input.nml.txt \ +### in-core MP + ../gfdl_fv_sat_adj.F90 \ +### time_vary + ../GFS_phys_time_vary.fv3.F90 \ + ../GFS_rad_time_vary.fv3.F90 \ + ../ozne_def.f \ + ../ozinterp.f90 \ + ../h2o_def.f \ + ../h2ointerp.f90 \ + ../aerclm_def.F \ + ../aerinterp.F90 \ + ../iccn_def.F \ + ../iccninterp.F90 \ + ../sfcsub.F \ + ../gcycle.F90 \ +### Radiation + ../radlw_main.f \ + ../radsw_main.f \ + ../radiation_aerosols.f \ + ../radiation_astronomy.f \ + ../radiation_clouds.f \ + ../radiation_gases.f \ + ../radiation_surface.f \ + ../radlw_param.f \ + ../radlw_datatb.f \ + ../radsw_param.f \ + ../radsw_datatb.f \ + ../dcyc2.f \ +### Land Surface + ../sfc_diff.f \ + ../sfc_nst.f \ + ../module_nst_model.f90 \ + ../module_nst_parameters.f90 \ + ../module_nst_water_prop.f90 \ + ../sfc_drv.f \ + ../sflx.f \ + ../namelist_soilveg.f \ + ../set_soilveg.f \ +### Sea Ice Surface + ../sfc_sice.f \ +### PBL + ../moninedmf.f \ + ../mfpbl.f \ + ../tridi.f \ +### satmedmf + ../satmedmfvdif.F \ + ../mfpblt.f \ + ../mfscu.f \ + ../tridi.f \ +### Orographic Gravity Wave + ../gwdps.f \ +### Rayleigh Dampling + ../rayleigh_damp.f \ +### Prognostic Ozone + ../ozphys_2015.f \ +### ../ozphys.f \ +### stratospheric h2o + ../h2ophys.f \ +### Deep Convection + ../samfdeepcnv.f \ +### Convective Gravity Wave + ../gwdc.f \ +### Shallow Convection + ../samfshalcnv.f \ + ../cnvc90.f \ +### Microphysics +### ../gscond.f \ +### ../precpd.f \ + ../module_bfmicrophysics.f \ +### GFDL cloud MP + ../gfdl_cloud_microphys.F90 \ + ../module_gfdl_cloud_microphys.F90 \ +### + ../GFS_MP_generic.F90 \ + ../calpreciptype.f90 \ +### stochy +### ../GFS_stochastics.F90 \ +### ../surface_perturbation.F90 \ +### ../../stochastic_physics/stochastic_physics.F90 \ +### CPT + ../m_micro.F90 \ +### ../micro_mg2_0.F90 \ + ../micro_mg3_0.F90 \ + ../micro_mg_utils.F90 \ + ../cldmacro.F \ + ../aer_cloud.F \ + ../cldwat2m_micro.F \ + ../wv_saturation.F \ + ../cs_conv_aw_adj.F90 \ + ../cs_conv.F90 \ +### GSD + ../cu_gf_driver.F90 \ + ../cu_gf_deep.F90 \ + ../cu_gf_sh.F90 \ + ../module_MYNNrad_pre.F90 \ + ../module_MYNNrad_post.F90 \ + ../module_MYNNPBL_wrapper.F90 \ + ../module_bl_mynn.F90 \ +### ../module_MYNNSFC_wrapper.F90 \ +### ../module_sf_mynn.F90 \ + ../sfc_drv_ruc.F90 \ + ../module_sf_ruclsm.F90 \ + ../namelist_soilveg_ruc.F90 \ + ../set_soilveg_ruc.F90 \ + ../module_soil_pre.F90 \ + ../mp_thompson_pre.F90 \ + ../module_mp_thompson_make_number_concentrations.F90 \ + ../mp_thompson.F90 \ + ../module_mp_thompson.F90 \ + ../module_mp_radar.F90 \ + ../mp_thompson_post.F90 \ +### utils + ../funcphys.f90 \ + ../physparam.f \ + ../physcons.F90 \ + ../radcons.f90 \ + ../mersenne_twister.f \ + compns_stochy.F90 + + +INPUT_ENCODING = UTF-8 +FILE_PATTERNS = *.f \ + *.F90 \ + *.f90 \ + *.nml \ + *.txt +RECURSIVE = YES +EXCLUDE = +EXCLUDE_SYMLINKS = NO +EXCLUDE_PATTERNS = +EXCLUDE_SYMBOLS = +EXAMPLE_PATH = +EXAMPLE_PATTERNS = +EXAMPLE_RECURSIVE = NO +IMAGE_PATH = img +INPUT_FILTER = +FILTER_PATTERNS = +FILTER_SOURCE_FILES = NO +FILTER_SOURCE_PATTERNS = +USE_MDFILE_AS_MAINPAGE = +SOURCE_BROWSER = NO +INLINE_SOURCES = NO +STRIP_CODE_COMMENTS = YES +REFERENCED_BY_RELATION = YES +REFERENCES_RELATION = YES +REFERENCES_LINK_SOURCE = YES +SOURCE_TOOLTIPS = YES +USE_HTAGS = NO +VERBATIM_HEADERS = YES +#CLANG_ASSISTED_PARSING = NO +#CLANG_OPTIONS = +ALPHABETICAL_INDEX = NO +COLS_IN_ALPHA_INDEX = 5 +IGNORE_PREFIX = +GENERATE_HTML = YES +HTML_OUTPUT = html +HTML_FILE_EXTENSION = .html +HTML_HEADER = +HTML_FOOTER = +HTML_STYLESHEET = +HTML_EXTRA_STYLESHEET = ccpp_dox_extra_style.css +HTML_EXTRA_FILES = +HTML_COLORSTYLE_HUE = 220 +HTML_COLORSTYLE_SAT = 100 +HTML_COLORSTYLE_GAMMA = 80 +HTML_TIMESTAMP = NO +HTML_DYNAMIC_SECTIONS = NO +HTML_INDEX_NUM_ENTRIES = 100 +GENERATE_DOCSET = NO +DOCSET_FEEDNAME = "Doxygen generated docs" +DOCSET_BUNDLE_ID = org.doxygen.Project +DOCSET_PUBLISHER_ID = org.doxygen.Publisher +DOCSET_PUBLISHER_NAME = Publisher +GENERATE_HTMLHELP = NO +CHM_FILE = +HHC_LOCATION = +GENERATE_CHI = NO +CHM_INDEX_ENCODING = +BINARY_TOC = NO +TOC_EXPAND = NO +GENERATE_QHP = NO +QCH_FILE = +QHP_NAMESPACE = org.doxygen.Project +QHP_VIRTUAL_FOLDER = doc +QHP_CUST_FILTER_NAME = +QHP_CUST_FILTER_ATTRS = +QHP_SECT_FILTER_ATTRS = +QHG_LOCATION = +GENERATE_ECLIPSEHELP = NO +ECLIPSE_DOC_ID = org.doxygen.Project +DISABLE_INDEX = YES +GENERATE_TREEVIEW = YES +ENUM_VALUES_PER_LINE = 4 +TREEVIEW_WIDTH = 250 +EXT_LINKS_IN_WINDOW = NO +FORMULA_FONTSIZE = 10 +FORMULA_TRANSPARENT = YES +USE_MATHJAX = YES +MATHJAX_FORMAT = HTML-CSS +MATHJAX_RELPATH = https://cdnjs.cloudflare.com/ajax/libs/mathjax/2.7.2 +MATHJAX_EXTENSIONS = +MATHJAX_CODEFILE = +SEARCHENGINE = YES +SERVER_BASED_SEARCH = NO +EXTERNAL_SEARCH = NO +SEARCHENGINE_URL = +SEARCHDATA_FILE = searchdata.xml +EXTERNAL_SEARCH_ID = +EXTRA_SEARCH_MAPPINGS = +GENERATE_LATEX = YES +LATEX_OUTPUT = latex +LATEX_CMD_NAME = latex +MAKEINDEX_CMD_NAME = makeindex +COMPACT_LATEX = YES +PAPER_TYPE = a4 +EXTRA_PACKAGES = amsmath +LATEX_HEADER = +LATEX_FOOTER = +LATEX_EXTRA_STYLESHEET = +LATEX_EXTRA_FILES = +PDF_HYPERLINKS = YES +USE_PDFLATEX = YES +LATEX_BATCHMODE = NO +LATEX_HIDE_INDICES = YES +LATEX_SOURCE_CODE = NO + +LATEX_BIB_STYLE = plainnat + +LATEX_TIMESTAMP = NO + +GENERATE_RTF = NO + +RTF_OUTPUT = rtf +COMPACT_RTF = NO +RTF_HYPERLINKS = NO +RTF_STYLESHEET_FILE = +RTF_EXTENSIONS_FILE = +RTF_SOURCE_CODE = NO +GENERATE_MAN = NO +MAN_OUTPUT = man +MAN_EXTENSION = .3 +MAN_SUBDIR = +MAN_LINKS = NO +GENERATE_XML = NO +XML_OUTPUT = xml +XML_PROGRAMLISTING = YES +GENERATE_DOCBOOK = NO +DOCBOOK_OUTPUT = docbook +DOCBOOK_PROGRAMLISTING = NO +GENERATE_AUTOGEN_DEF = NO +GENERATE_PERLMOD = NO +PERLMOD_LATEX = NO +PERLMOD_PRETTY = YES +PERLMOD_MAKEVAR_PREFIX = +ENABLE_PREPROCESSING = NO +MACRO_EXPANSION = NO +EXPAND_ONLY_PREDEF = NO +SEARCH_INCLUDES = YES +INCLUDE_PATH = +INCLUDE_FILE_PATTERNS = +PREDEFINED = CCPP \ + MULTI_GASES \ + 0 +EXPAND_AS_DEFINED = +SKIP_FUNCTION_MACROS = YES +TAGFILES = +GENERATE_TAGFILE = +ALLEXTERNALS = NO +EXTERNAL_GROUPS = YES +EXTERNAL_PAGES = YES +PERL_PATH = /usr/bin/perl +CLASS_DIAGRAMS = YES +MSCGEN_PATH = +DIA_PATH = +HIDE_UNDOC_RELATIONS = NO +HAVE_DOT = YES +DOT_NUM_THREADS = 0 +DOT_FONTNAME = Helvetica +DOT_FONTSIZE = 10 +DOT_FONTPATH = +CLASS_GRAPH = NO +COLLABORATION_GRAPH = NO +GROUP_GRAPHS = YES +UML_LOOK = YES +UML_LIMIT_NUM_FIELDS = 10 +TEMPLATE_RELATIONS = NO +INCLUDE_GRAPH = YES +INCLUDED_BY_GRAPH = NO +CALL_GRAPH = YES +CALLER_GRAPH = NO +GRAPHICAL_HIERARCHY = YES +DIRECTORY_GRAPH = YES +DOT_IMAGE_FORMAT = svg +INTERACTIVE_SVG = NO +DOT_PATH = +DOTFILE_DIRS = +MSCFILE_DIRS = +DIAFILE_DIRS = +PLANTUML_JAR_PATH = +PLANTUML_INCLUDE_PATH = +DOT_GRAPH_MAX_NODES = 200 +MAX_DOT_GRAPH_DEPTH = 0 +DOT_TRANSPARENT = NO +DOT_MULTI_TARGETS = YES +GENERATE_LEGEND = YES +DOT_CLEANUP = YES diff --git a/physics/docs/library.bib b/physics/docs/library.bib index 4836aceba..7384e08a0 100644 --- a/physics/docs/library.bib +++ b/physics/docs/library.bib @@ -1,13 +1,131 @@ %% This BibTeX bibliography file was created using BibDesk. -%% http://bibdesk.sourceforge.net/ +%% https://bibdesk.sourceforge.io/ -%% Created for Man Zhang at 2019-05-24 12:46:55 -0600 +%% Created for Grant Firl at 2019-10-25 16:36:06 -0600 %% Saved with string encoding Unicode (UTF-8) +@article{niu_and_yang_2006, + Abstract = { Abstract The presence of ice in soil dramatically alters soil hydrologic and thermal properties. Despite this important role, many recent studies show that explicitly including the hydrologic effects of soil ice in land surface models degrades the simulation of runoff in cold regions. This paper addresses this dilemma by employing the Community Land Model version 2.0 (CLM2.0) developed at the National Center for Atmospheric Research (NCAR) and a simple TOPMODEL-based runoff scheme (SIMTOP). CLM2.0/SIMTOP explicitly computes soil ice content and its modifications to soil hydrologic and thermal properties. However, the frozen soil scheme has a tendency to produce a completely frozen soil (100\% ice content) whenever the soil temperature is below 0$\,^{\circ}$C. The frozen ground prevents infiltration of snowmelt or rainfall, thereby resulting in earlier- and higher-than-observed springtime runoff. This paper presents modifications to the above-mentioned frozen soil scheme that produce more accurate magnitude and seasonality of runoff and soil water storage. These modifications include 1) allowing liquid water to coexist with ice in the soil over a wide range of temperatures below 0$\,^{\circ}$C by using the freezing-point depression equation, 2) computing the vertical water fluxes by introducing the concept of a fractional permeable area, which partitions the model grid into an impermeable part (no vertical water flow) and a permeable part, and 3) using the total soil moisture (liquid water and ice) to calculate the soil matric potential and hydraulic conductivity. The performance of CLM2.0/SIMTOP with these changes has been tested using observed data in cold-region river basins of various spatial scales. Compared to the CLM2.0/SIMTOP frozen soil scheme, the modified scheme produces monthly runoff that compares more favorably with that estimated by the University of New Hampshire--Global Runoff Data Center and a terrestrial water storage change that is in closer agreement with that measured by the Gravity Recovery and Climate Experiment (GRACE) satellites. }, + Author = {Niu, Guo-Yue and Yang, Zong-Liang}, + Date-Added = {2019-10-25 22:35:50 +0000}, + Date-Modified = {2019-10-25 22:36:03 +0000}, + Doi = {10.1175/JHM538.1}, + Eprint = {https://doi.org/10.1175/JHM538.1}, + Journal = {Journal of Hydrometeorology}, + Number = {5}, + Pages = {937-952}, + Title = {Effects of Frozen Soil on Snowmelt Runoff and Soil Water Storage at a Continental Scale}, + Url = {https://doi.org/10.1175/JHM538.1}, + Volume = {7}, + Year = {2006}, + Bdsk-Url-1 = {https://doi.org/10.1175/JHM538.1}} + +@article{niu_et_al_2007, + Abstract = {Groundwater interacts with soil moisture through the exchanges of water between the unsaturated soil and its underlying aquifer under gravity and capillary forces. Despite its importance, groundwater is not explicitly represented in climate models. This paper developed a simple groundwater model (SIMGM) by representing recharge and discharge processes of the water storage in an unconfined aquifer, which is added as a single integration element below the soil of a land surface model. We evaluated the model against the Gravity Recovery and Climate Experiment (GRACE) terrestrial water storage change (ΔS) data. The modeled total water storage (including unsaturated soil water and groundwater) change agrees fairly well with GRACE estimates. The anomaly of the modeled groundwater storage explains most of the GRACE ΔS anomaly in most river basins where the water storage is not affected by snow water or frozen soil. For this reason, the anomaly of the modeled water table depth agrees well with that converted from the GRACE ΔS in most of the river basins. We also investigated the impacts of groundwater dynamics on soil moisture and evapotranspiration through the comparison of SIMGM to an additional model run using gravitational free drainage (FD) as the model's lower boundary condition. SIMGM produced much wetter soil profiles globally and up to 16\% more annual evapotranspiration than FD, most obviously in arid-to-wet transition regions.}, + Author = {Niu, Guo-Yue and Yang, Zong-Liang and Dickinson, Robert E. and Gulden, Lindsey E. and Su, Hua}, + Date-Added = {2019-10-25 22:31:30 +0000}, + Date-Modified = {2019-10-25 22:31:41 +0000}, + Doi = {10.1029/2006JD007522}, + Eprint = {https://agupubs.onlinelibrary.wiley.com/doi/pdf/10.1029/2006JD007522}, + Journal = {Journal of Geophysical Research: Atmospheres}, + Keywords = {Groundwater recharge, groundwater discharge, climate models}, + Number = {D7}, + Title = {Development of a simple groundwater model for use in climate models and evaluation with Gravity Recovery and Climate Experiment data}, + Url = {https://agupubs.onlinelibrary.wiley.com/doi/abs/10.1029/2006JD007522}, + Volume = {112}, + Year = {2007}, + Bdsk-Url-1 = {https://agupubs.onlinelibrary.wiley.com/doi/abs/10.1029/2006JD007522}, + Bdsk-Url-2 = {https://doi.org/10.1029/2006JD007522}} + +@article{niu_et_al_2011, + Abstract = {This first paper of the two-part series describes the objectives of the community efforts in improving the Noah land surface model (LSM), documents, through mathematical formulations, the augmented conceptual realism in biophysical and hydrological processes, and introduces a framework for multiple options to parameterize selected processes (Noah-MP). The Noah-MP's performance is evaluated at various local sites using high temporal frequency data sets, and results show the advantages of using multiple optional schemes to interpret the differences in modeling simulations. The second paper focuses on ensemble evaluations with long-term regional (basin) and global scale data sets. The enhanced conceptual realism includes (1) the vegetation canopy energy balance, (2) the layered snowpack, (3) frozen soil and infiltration, (4) soil moisture-groundwater interaction and related runoff production, and (5) vegetation phenology. Sample local-scale validations are conducted over the First International Satellite Land Surface Climatology Project (ISLSCP) Field Experiment (FIFE) site, the W3 catchment of Sleepers River, Vermont, and a French snow observation site. Noah-MP shows apparent improvements in reproducing surface fluxes, skin temperature over dry periods, snow water equivalent (SWE), snow depth, and runoff over Noah LSM version 3.0. Noah-MP improves the SWE simulations due to more accurate simulations of the diurnal variations of the snow skin temperature, which is critical for computing available energy for melting. Noah-MP also improves the simulation of runoff peaks and timing by introducing a more permeable frozen soil and more accurate simulation of snowmelt. We also demonstrate that Noah-MP is an effective research tool by which modeling results for a given process can be interpreted through multiple optional parameterization schemes in the same model framework.}, + Author = {Niu, Guo-Yue and Yang, Zong-Liang and Mitchell, Kenneth E. and Chen, Fei and Ek, Michael B. and Barlage, Michael and Kumar, Anil and Manning, Kevin and Niyogi, Dev and Rosero, Enrique and Tewari, Mukul and Xia, Youlong}, + Date-Added = {2019-10-25 21:50:31 +0000}, + Date-Modified = {2019-10-25 21:50:40 +0000}, + Doi = {10.1029/2010JD015139}, + Eprint = {https://agupubs.onlinelibrary.wiley.com/doi/pdf/10.1029/2010JD015139}, + Journal = {Journal of Geophysical Research: Atmospheres}, + Keywords = {Noah, land surface model, local scale, multiphysics, evaluation, validation}, + Number = {D12}, + Title = {The community Noah land surface model with multiparameterization options (Noah-MP): 1. Model description and evaluation with local-scale measurements}, + Url = {https://agupubs.onlinelibrary.wiley.com/doi/abs/10.1029/2010JD015139}, + Volume = {116}, + Year = {2011}, + Bdsk-Url-1 = {https://agupubs.onlinelibrary.wiley.com/doi/abs/10.1029/2010JD015139}, + Bdsk-Url-2 = {https://doi.org/10.1029/2010JD015139}} + +@article{bechtold_et_al_2014, + Author = {P. Bechtold and N. Semane and P. Lopez and J-P Chaboureau and A. Beljaars and N. Bormann}, + Date-Added = {2019-06-13 14:29:21 -0600}, + Date-Modified = {2019-06-13 14:38:38 -0600}, + Journal = {J. Atmos. Sci.}, + Pages = {734-753}, + Title = {Representing equilibrium and nonequilibrium convection in large-scale models}, + Volume = {71}, + Year = {2014}} + +@article{freitas_et_al_2018, + Author = {S.R. Freitas and G.A. Grell and A. Molod and M. A. Thompson and W.M. Putman and C. M. Santos e Silva and E. P. Souza}, + Date-Added = {2019-06-13 13:51:50 -0600}, + Date-Modified = {2019-06-13 14:07:37 -0600}, + Journal = {Journal of Advances in Modeling Earth Systems}, + Pages = {1266-1289}, + Title = {Assessing the Grell-Freitas convection parameterization in the NASA GEOS modeling system}, + Volume = {10}, + Year = {2018}} + +@article{qu_and_hall_2005, + Author = {X. Qu and A. Hall}, + Date-Added = {2019-06-10 16:41:01 -0600}, + Date-Modified = {2019-06-10 16:42:55 -0600}, + Journal = {J. Climate}, + Pages = {5239-5252}, + Title = {Surface contribution to planetary albedo variability in cryosphere regions}, + Volume = {18}, + Year = {2005}} + +@article{grant_et_al_2000, + Author = {I.F. Grant and A. J. Prata and R. P.Cechet}, + Date-Added = {2019-06-10 16:30:06 -0600}, + Date-Modified = {2019-06-10 16:33:28 -0600}, + Journal = {Journal of Applied Meteorology}, + Pages = {231-244}, + Title = {The impact of the diurnal variation of albedo on the remote sensing of the daily mean albedo of grassland}, + Volume = {39}, + Year = {2000}} + +@article{moorthi_and_suarez_1992, + Author = {S. Moorthi and M.J. Suarez}, + Date-Added = {2019-06-06 17:51:50 +0000}, + Date-Modified = {2019-06-06 17:56:00 +0000}, + Journal = {Monthly Weather Review}, + Pages = {978-1002}, + Title = {Relaxed Arakawa-Schubert. A parameterization of moist convection for general circulation models}, + Volume = {120}, + Year = {1992}} + +@article{Gettelman_et_al_2019, + Author = {A. Gettelman and H. Morrison and K. Thayer-Calder and C. M. Zarzycki}, + Date-Added = {2019-06-05 16:32:22 +0000}, + Date-Modified = {2019-06-05 16:34:07 +0000}, + Journal = {Journal of Advances in Modeling Earth Systems}, + Title = {The impact of rimed ice hydrometeors on global and regional climate}, + Year = {2019}} + +@article{nakanishi_2000, + Author = {M. Nakanishi}, + Date-Added = {2019-05-31 14:46:02 -0600}, + Date-Modified = {2019-05-31 14:47:32 -0600}, + Journal = {Boundary-Layer Meteorology}, + Pages = {461-493}, + Title = {Large-eddy simulation of radiation fog}, + Volume = {94}, + Year = {2000}} + @article{Gehne_2019, Author = {Gehne, Maria and Hamill, Thomas M. and Bates, Gary T. and Pegion, Philip and Kolczynski, Walter}, Date-Added = {2019-05-24 12:46:43 -0600}, @@ -63,16 +181,11 @@ @article{HOBBS_1974 @article{Pichugina_2008, Author = {Pichugina, Yelena L. and Tucker, Sara C. and Banta, Robert M. and Brewer, W. Alan and Kelley, Neil D. and Jonkman, Bonnie J. and Newsom, Rob K.}, Date-Added = {2019-05-22 11:25:17 -0600}, - Date-Modified = {2019-05-22 11:25:17 -0600}, - Doi = {10.1175/2008jtecha988.1}, - Issn = {1520-0426}, + Date-Modified = {2019-06-05 15:59:49 +0000}, Journal = {Journal of Atmospheric and Oceanic Technology}, - Month = {Aug}, Number = {8}, Pages = {1307--1327}, - Publisher = {American Meteorological Society}, Title = {Horizontal-Velocity and Variance Measurements in the Stable Boundary Layer Using Doppler Lidar: Sensitivity to Averaging Procedures}, - Url = {http://dx.doi.org/10.1175/2008JTECHA988.1}, Volume = {25}, Year = {2008}, Bdsk-Url-1 = {http://dx.doi.org/10.1175/2008JTECHA988.1}, @@ -81,16 +194,11 @@ @article{Pichugina_2008 @article{Nielsen_Gammon_2008, Author = {Nielsen-Gammon, John W. and Powell, Christina L. and Mahoney, M. J. and Angevine, Wayne M. and Senff, Christoph and White, Allen and Berkowitz, Carl and Doran, Christopher and Knupp, Kevin}, Date-Added = {2019-05-22 11:19:45 -0600}, - Date-Modified = {2019-05-22 11:19:45 -0600}, - Doi = {10.1175/2007jamc1503.1}, - Issn = {1558-8432}, + Date-Modified = {2019-06-05 15:31:19 +0000}, Journal = {Journal of Applied Meteorology and Climatology}, - Month = {Jan}, Number = {1}, Pages = {27--43}, - Publisher = {American Meteorological Society}, Title = {Multisensor Estimation of Mixing Heights over a Coastal City}, - Url = {http://dx.doi.org/10.1175/2007JAMC1503.1}, Volume = {47}, Year = {2008}, Bdsk-Url-1 = {http://dx.doi.org/10.1175/2007JAMC1503.1}, @@ -276,15 +384,11 @@ @article{Rutter_2009 @article{Essery_2009, Author = {Essery, Richard and Rutter, Nick and Pomeroy, John and Baxter, Robert and St{\"a}hli, Manfred and Gustafsson, David and Barr, Alan and Bartlett, Paul and Elder, Kelly}, Date-Added = {2019-05-06 14:20:27 -0600}, - Date-Modified = {2019-05-20 16:04:05 -0600}, - Doi = {10.1175/2009bams2629.1}, - Issn = {1520-0477}, + Date-Modified = {2019-06-05 16:01:14 +0000}, Journal = {Bulletin of the American Meteorological Society}, Number = {8}, Pages = {1120-1136}, - Publisher = {American Meteorological Society}, Title = {SNOWMIP2: An Evaluation of Forest Snow Process Simulations}, - Url = {http://dx.doi.org/10.1175/2009BAMS2629.1}, Volume = {90}, Year = {2009}, Bdsk-Url-1 = {http://dx.doi.org/10.1175/2009BAMS2629.1}, @@ -426,15 +530,11 @@ @article{Benjamin_2004a @article{Smirnova_2000, Author = {Smirnova, Tatiana G. and Brown, John M. and Benjamin, Stanley G. and Kim, Dongsoo}, - Doi = {10.1029/1999jd901047}, - Issn = {0148-0227}, + Date-Modified = {2019-06-05 15:32:20 +0000}, Journal = {Journal of Geophysical Research: Atmospheres}, - Month = {Feb}, Number = {D3}, Pages = {4077--4086}, - Publisher = {American Geophysical Union (AGU)}, Title = {Parameterization of cold-season processes in the MAPS land-surface scheme}, - Url = {http://dx.doi.org/10.1029/1999JD901047}, Volume = {105}, Year = {2000}, Bdsk-Url-1 = {http://dx.doi.org/10.1029/1999JD901047}} @@ -879,16 +979,11 @@ @article{Thompson_2004 @article{Abdul_Razzak_2000, Author = {Abdul-Razzak, Hayder and Ghan, Steven J.}, Date-Added = {2019-01-22 11:02:36 -0700}, - Date-Modified = {2019-05-20 16:02:47 -0600}, - Doi = {10.1029/1999jd901161}, - Issn = {0148-0227}, + Date-Modified = {2019-06-05 15:28:16 +0000}, Journal = {Journal of Geophysical Research: Atmospheres}, - Month = {Mar}, Number = {D5}, Pages = {6837-6844}, - Publisher = {American Geophysical Union (AGU)}, Title = {A parameterization of aerosol activation: 2. Multiple aerosol types}, - Url = {http://dx.doi.org/10.1029/1999JD901161}, Volume = {105}, Year = {2000}, Bdsk-Url-1 = {http://dx.doi.org/10.1029/1999JD901161}} @@ -1085,16 +1180,11 @@ @article{Lewis_2005 @article{Zhu_2018, Author = {Zhu, Yuejian and Zhou, Xiaqiong and Li, Wei and Hou, Dingchen and Melhauser, Christopher and Sinsky, Eric and Pe{\~n}a, Malaquias and Fu, Bing and Guan, Hong and Kolczynski, Walter and et al.}, Date-Added = {2018-09-07 11:48:50 -0600}, - Date-Modified = {2018-09-07 11:48:50 -0600}, - Doi = {10.1029/2018jd028506}, - Issn = {2169-897X}, + Date-Modified = {2019-06-05 15:33:03 +0000}, Journal = {Journal of Geophysical Research: Atmospheres}, - Month = {Jul}, Number = {13}, Pages = {6732--6745}, - Publisher = {American Geophysical Union (AGU)}, Title = {Toward the Improvement of Subseasonal Prediction in the National Centers for Environmental Prediction Global Ensemble Forecast System}, - Url = {http://dx.doi.org/10.1029/2018JD028506}, Volume = {123}, Year = {2018}, Bdsk-Url-1 = {http://dx.doi.org/10.1029/2018JD028506}, @@ -1769,12 +1859,12 @@ @article{zeng_and_dickinson_1998 @conference{zheng_et_al_2009, Address = {Omaha, Nebraska}, Author = {W. Zheng and H. Wei and J. Meng and M. Ek and K. Mitchell and J. Derber and X. Zeng and Z. Wang}, + Bdsk-File-1 = {YnBsaXN0MDDSAQIDBFxyZWxhdGl2ZVBhdGhZYWxpYXNEYXRhXxBWLi4vLi4vLi4vLi4vLi4vRGVza3RvcC9OT0FIX0xTTS9JbXByb3ZlbWVudF9vZl9MYW5kX1N1cmZhY2VfU2tpbl9UZW1wZXJhdHVyZV9pbl9OQy5wZGZPEQIgAAAAAAIgAAIAAAxNYWNpbnRvc2ggSEQAAAAAAAAAAAAAAAAAAADT4djXSCsAAANl5rUfSW1wcm92ZW1lbnRfb2ZfTGFuZCMzNjVGRjBGLnBkZgAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA2X/D9aQ780AAAAAAAAAAAAFAAMAAAkgAAAAAAAAAAAAAAAAAAAACE5PQUhfTFNNABAACAAA0+ItNwAAABEACAAA1pFSPQAAAAEAEANl5rUAD8YgAA/GDwAGL94AAgBRTWFjaW50b3NoIEhEOlVzZXJzOgBtYW4uemhhbmc6AERlc2t0b3A6AE5PQUhfTFNNOgBJbXByb3ZlbWVudF9vZl9MYW5kIzM2NUZGMEYucGRmAAAOAG4ANgBJAG0AcAByAG8AdgBlAG0AZQBuAHQAXwBvAGYAXwBMAGEAbgBkAF8AUwB1AHIAZgBhAGMAZQBfAFMAawBpAG4AXwBUAGUAbQBwAGUAcgBhAHQAdQByAGUAXwBpAG4AXwBOAEMALgBwAGQAZgAPABoADABNAGEAYwBpAG4AdABvAHMAaAAgAEgARAASAFdVc2Vycy9tYW4uemhhbmcvRGVza3RvcC9OT0FIX0xTTS9JbXByb3ZlbWVudF9vZl9MYW5kX1N1cmZhY2VfU2tpbl9UZW1wZXJhdHVyZV9pbl9OQy5wZGYAABMAAS8AABUAAgAQ//8AAAAIAA0AGgAkAH0AAAAAAAACAQAAAAAAAAAFAAAAAAAAAAAAAAAAAAACoQ==}, Date-Added = {2018-01-26 22:19:06 +0000}, Date-Modified = {2018-01-29 23:51:37 +0000}, Organization = {The 23rd Conference on Weather Analysis and Forecasting (WAF)/19th Conference on Numerical Weather Prediction(NWP)}, Title = {Improvement of land surface skin temperature in NCEP Operational NWP models and its impact on satellite Data Assimilation}, - Year = {2009}, - Bdsk-File-1 = {YnBsaXN0MDDSAQIDBFxyZWxhdGl2ZVBhdGhZYWxpYXNEYXRhXxBWLi4vLi4vLi4vLi4vLi4vRGVza3RvcC9OT0FIX0xTTS9JbXByb3ZlbWVudF9vZl9MYW5kX1N1cmZhY2VfU2tpbl9UZW1wZXJhdHVyZV9pbl9OQy5wZGZPEQIgAAAAAAIgAAIAAAxNYWNpbnRvc2ggSEQAAAAAAAAAAAAAAAAAAADT4djXSCsAAANl5rUfSW1wcm92ZW1lbnRfb2ZfTGFuZCMzNjVGRjBGLnBkZgAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA2X/D9aQ780AAAAAAAAAAAAFAAMAAAkgAAAAAAAAAAAAAAAAAAAACE5PQUhfTFNNABAACAAA0+ItNwAAABEACAAA1pFSPQAAAAEAEANl5rUAD8YgAA/GDwAGL94AAgBRTWFjaW50b3NoIEhEOlVzZXJzOgBtYW4uemhhbmc6AERlc2t0b3A6AE5PQUhfTFNNOgBJbXByb3ZlbWVudF9vZl9MYW5kIzM2NUZGMEYucGRmAAAOAG4ANgBJAG0AcAByAG8AdgBlAG0AZQBuAHQAXwBvAGYAXwBMAGEAbgBkAF8AUwB1AHIAZgBhAGMAZQBfAFMAawBpAG4AXwBUAGUAbQBwAGUAcgBhAHQAdQByAGUAXwBpAG4AXwBOAEMALgBwAGQAZgAPABoADABNAGEAYwBpAG4AdABvAHMAaAAgAEgARAASAFdVc2Vycy9tYW4uemhhbmcvRGVza3RvcC9OT0FIX0xTTS9JbXByb3ZlbWVudF9vZl9MYW5kX1N1cmZhY2VfU2tpbl9UZW1wZXJhdHVyZV9pbl9OQy5wZGYAABMAAS8AABUAAgAQ//8AAAAIAA0AGgAkAH0AAAAAAAACAQAAAAAAAAAFAAAAAAAAAAAAAAAAAAACoQ==}} + Year = {2009}} @article{chen_et_al_1997, Author = {F. Chen and Z. Janjic and K. Mitchell}, @@ -2013,6 +2103,7 @@ @article{iacono_et_al_2008 @article{grant_2001, Abstract = {A closure for the fluxes of mass, heat, and moisture at cloud base in the cumulus-capped boundary layer is developed. The cloud-base mass flux is obtained from a simplifed turbulence kinetic energy (TKE) budget for the sub-cloud layer, in which cumulus convection is assumed to be associated with a transport of TKE from the sub-cloud layer to the cloud layer.The heat and moisture fluxes are obtained from a jump model based on the virtual-potential-temperature equation. A key part of this parametrization is the parametrization of the virtual-temperature flux at the top of the transition zone between the sub-cloud and cloud layers.It is argued that pressure fluctuations must be responsible for the transport of TKE from the cloud layer to the sub-cloud layer.}, Author = {A. L. M. Grant}, + Bdsk-File-1 = {YnBsaXN0MDDSAQIDBFxyZWxhdGl2ZVBhdGhZYWxpYXNEYXRhXxBBLi4vLi4vQ2xvdWRTdGF0aW9uL2ZpcmxfbGlicmFyeS9maXJsX2xpYnJhcnlfZmlsZXMvR3JhbnQvMjAwMS5wZGZPEQHEAAAAAAHEAAIAAAxNYWNpbnRvc2ggSEQAAAAAAAAAAAAAAAAAAADR5yRSSCsAAAAoiV4IMjAwMS5wZGYAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAARgJuNOHLk4AAAAAAAAAAAACAAUAAAkgAAAAAAAAAAAAAAAAAAAABUdyYW50AAAQAAgAANHneLIAAAARAAgAANOHgq4AAAABABgAKIleAChslgAobIsAKGd7ABteBwACmFwAAgBbTWFjaW50b3NoIEhEOlVzZXJzOgBncmFudGY6AENsb3VkU3RhdGlvbjoAZmlybF9saWJyYXJ5OgBmaXJsX2xpYnJhcnlfZmlsZXM6AEdyYW50OgAyMDAxLnBkZgAADgASAAgAMgAwADAAMQAuAHAAZABmAA8AGgAMAE0AYQBjAGkAbgB0AG8AcwBoACAASABEABIASFVzZXJzL2dyYW50Zi9DbG91ZFN0YXRpb24vZmlybF9saWJyYXJ5L2ZpcmxfbGlicmFyeV9maWxlcy9HcmFudC8yMDAxLnBkZgATAAEvAAAVAAIADf//AAAACAANABoAJABoAAAAAAAAAgEAAAAAAAAABQAAAAAAAAAAAAAAAAAAAjA=}, Date-Added = {2016-06-15 22:11:22 +0000}, Date-Modified = {2018-07-06 19:02:34 +0000}, Doi = {10.1002/qj.49712757209}, @@ -2026,13 +2117,13 @@ @article{grant_2001 Url = {http://dx.doi.org/10.1002/qj.49712757209}, Volume = {127}, Year = {2001}, - Bdsk-File-1 = {YnBsaXN0MDDSAQIDBFxyZWxhdGl2ZVBhdGhZYWxpYXNEYXRhXxBBLi4vLi4vQ2xvdWRTdGF0aW9uL2ZpcmxfbGlicmFyeS9maXJsX2xpYnJhcnlfZmlsZXMvR3JhbnQvMjAwMS5wZGZPEQHEAAAAAAHEAAIAAAxNYWNpbnRvc2ggSEQAAAAAAAAAAAAAAAAAAADR5yRSSCsAAAAoiV4IMjAwMS5wZGYAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAARgJuNOHLk4AAAAAAAAAAAACAAUAAAkgAAAAAAAAAAAAAAAAAAAABUdyYW50AAAQAAgAANHneLIAAAARAAgAANOHgq4AAAABABgAKIleAChslgAobIsAKGd7ABteBwACmFwAAgBbTWFjaW50b3NoIEhEOlVzZXJzOgBncmFudGY6AENsb3VkU3RhdGlvbjoAZmlybF9saWJyYXJ5OgBmaXJsX2xpYnJhcnlfZmlsZXM6AEdyYW50OgAyMDAxLnBkZgAADgASAAgAMgAwADAAMQAuAHAAZABmAA8AGgAMAE0AYQBjAGkAbgB0AG8AcwBoACAASABEABIASFVzZXJzL2dyYW50Zi9DbG91ZFN0YXRpb24vZmlybF9saWJyYXJ5L2ZpcmxfbGlicmFyeV9maWxlcy9HcmFudC8yMDAxLnBkZgATAAEvAAAVAAIADf//AAAACAANABoAJABoAAAAAAAAAgEAAAAAAAAABQAAAAAAAAAAAAAAAAAAAjA=}, Bdsk-Url-1 = {http://dx.doi.org/10.1002/qj.49712757209}} @article{zhang_and_wu_2003, Abstract = {Abstract This study uses a 2D cloud-resolving model to investigate the vertical transport of horizontal momentum and to understand the role of a convection-generated perturbation pressure field in the momentum transport by convective systems during part of the Tropical Ocean and Global Atmosphere Coupled Ocean?Atmosphere Response Experiment (TOGA COARE) Intensive Observation Period. It shows that convective updrafts transport a significant amount of momentum vertically. This transport is downgradient in the easterly wind regime, but upgradient during a westerly wind burst. The differences in convective momentum transport between easterly and westerly wind regimes are examined. The perturbation pressure gradient accounts for an important part of the apparent momentum source. In general it is opposite in sign to the product of cloud mass flux and the vertical wind shear, with smaller magnitude. Examination of the dynamic forcing to the pressure field demonstrates that the linear forcing representing the interaction between the convective updrafts and the large-scale wind shear is the dominant term, while the nonlinear forcing is of secondary importance. Thus, parameterization schemes taking into account the linear interaction between the convective updrafts and the large-scale wind shear can capture the essential features of the perturbation pressure field. The parameterization scheme for momentum transport by Zhang and Cho is evaluated using the model simulation data. The parameterized pressure gradient force using the scheme is in excellent agreement with the simulated one. The parameterized apparent momentum source is also in good agreement with the model simulation. Other parameterization methods for the pressure gradient are also discussed.}, Annote = {doi: 10.1175/1520-0469(2003)060<1120:CMTAPP>2.0.CO;2}, Author = {Zhang, Guang J. and Wu, Xiaoqing}, + Bdsk-File-1 = {YnBsaXN0MDDSAQIDBFxyZWxhdGl2ZVBhdGhZYWxpYXNEYXRhXxBBLi4vLi4vQ2xvdWRTdGF0aW9uL2ZpcmxfbGlicmFyeS9maXJsX2xpYnJhcnlfZmlsZXMvWmhhbmcvMjAwMy5wZGZPEQHEAAAAAAHEAAIAAAxNYWNpbnRvc2ggSEQAAAAAAAAAAAAAAAAAAADR5yRSSCsAAAAqjuYIMjAwMy5wZGYAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAFrUP9K0L8MAAAAAAAAAAAACAAUAAAkgAAAAAAAAAAAAAAAAAAAABVpoYW5nAAAQAAgAANHneLIAAAARAAgAANK0kjMAAAABABgAKo7mAChslgAobIsAKGd7ABteBwACmFwAAgBbTWFjaW50b3NoIEhEOlVzZXJzOgBncmFudGY6AENsb3VkU3RhdGlvbjoAZmlybF9saWJyYXJ5OgBmaXJsX2xpYnJhcnlfZmlsZXM6AFpoYW5nOgAyMDAzLnBkZgAADgASAAgAMgAwADAAMwAuAHAAZABmAA8AGgAMAE0AYQBjAGkAbgB0AG8AcwBoACAASABEABIASFVzZXJzL2dyYW50Zi9DbG91ZFN0YXRpb24vZmlybF9saWJyYXJ5L2ZpcmxfbGlicmFyeV9maWxlcy9aaGFuZy8yMDAzLnBkZgATAAEvAAAVAAIADf//AAAACAANABoAJABoAAAAAAAAAgEAAAAAAAAABQAAAAAAAAAAAAAAAAAAAjA=}, Booktitle = {Journal of the Atmospheric Sciences}, Da = {2003/05/01}, Date-Added = {2016-06-14 23:39:50 +0000}, @@ -2051,13 +2142,13 @@ @article{zhang_and_wu_2003 Url = {http://dx.doi.org/10.1175/1520-0469(2003)060<1120:CMTAPP>2.0.CO;2}, Volume = {60}, Year = {2003}, - Bdsk-File-1 = {YnBsaXN0MDDSAQIDBFxyZWxhdGl2ZVBhdGhZYWxpYXNEYXRhXxBBLi4vLi4vQ2xvdWRTdGF0aW9uL2ZpcmxfbGlicmFyeS9maXJsX2xpYnJhcnlfZmlsZXMvWmhhbmcvMjAwMy5wZGZPEQHEAAAAAAHEAAIAAAxNYWNpbnRvc2ggSEQAAAAAAAAAAAAAAAAAAADR5yRSSCsAAAAqjuYIMjAwMy5wZGYAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAFrUP9K0L8MAAAAAAAAAAAACAAUAAAkgAAAAAAAAAAAAAAAAAAAABVpoYW5nAAAQAAgAANHneLIAAAARAAgAANK0kjMAAAABABgAKo7mAChslgAobIsAKGd7ABteBwACmFwAAgBbTWFjaW50b3NoIEhEOlVzZXJzOgBncmFudGY6AENsb3VkU3RhdGlvbjoAZmlybF9saWJyYXJ5OgBmaXJsX2xpYnJhcnlfZmlsZXM6AFpoYW5nOgAyMDAzLnBkZgAADgASAAgAMgAwADAAMwAuAHAAZABmAA8AGgAMAE0AYQBjAGkAbgB0AG8AcwBoACAASABEABIASFVzZXJzL2dyYW50Zi9DbG91ZFN0YXRpb24vZmlybF9saWJyYXJ5L2ZpcmxfbGlicmFyeV9maWxlcy9aaGFuZy8yMDAzLnBkZgATAAEvAAAVAAIADf//AAAACAANABoAJABoAAAAAAAAAgEAAAAAAAAABQAAAAAAAAAAAAAAAAAAAjA=}, Bdsk-Url-1 = {http://dx.doi.org/10.1175/1520-0469(2003)060%3C1120:CMTAPP%3E2.0.CO;2}} @article{fritsch_and_chappell_1980, Abstract = {Abstract A parameterization formulation for incorporating the effects of midlatitude deep convection into mesoscale-numerical models is presented. The formulation is based on the hypothesis that the buoyant energy available to a parcel, in combination with a prescribed period of time for the convection to remove that energy, can be used to regulate the amount of convection in a mesoscale numerical model grid element. Individual clouds are represented as entraining moist updraft and downdraft plumes. The fraction of updraft condensate evaporated in moist downdrafts is determined from an empirical relationship between the vertical shear of the horizontal wind and precipitation efficiency. Vertical transports of horizontal momentum and warming by compensating subsidence are included in the parameterization. Since updraft and downdraft areas are sometimes a substantial fraction of mesoscale model grid-element areas, grid-point temperatures (adjusted for convection) are an area-weighted mean of updraft, downdraft and environmental temperatures.}, Annote = {doi: 10.1175/1520-0469(1980)037<1722:NPOCDM>2.0.CO;2}, Author = {Fritsch, J. M. and Chappell, C. F.}, + Bdsk-File-1 = {YnBsaXN0MDDSAQIDBFxyZWxhdGl2ZVBhdGhZYWxpYXNEYXRhXxBDLi4vLi4vQ2xvdWRTdGF0aW9uL2ZpcmxfbGlicmFyeS9maXJsX2xpYnJhcnlfZmlsZXMvRnJpdHNjaC8xOTgwLnBkZk8RAcoAAAAAAcoAAgAADE1hY2ludG9zaCBIRAAAAAAAAAAAAAAAAAAAANHnJFJIKwAAARCuMwgxOTgwLnBkZgAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAABEKs103xvpgAAAAAAAAAAAAIABQAACSAAAAAAAAAAAAAAAAAAAAAHRnJpdHNjaAAAEAAIAADR53iyAAAAEQAIAADTfMQGAAAAAQAYARCuMwAobJYAKGyLAChnewAbXgcAAphcAAIAXU1hY2ludG9zaCBIRDpVc2VyczoAZ3JhbnRmOgBDbG91ZFN0YXRpb246AGZpcmxfbGlicmFyeToAZmlybF9saWJyYXJ5X2ZpbGVzOgBGcml0c2NoOgAxOTgwLnBkZgAADgASAAgAMQA5ADgAMAAuAHAAZABmAA8AGgAMAE0AYQBjAGkAbgB0AG8AcwBoACAASABEABIASlVzZXJzL2dyYW50Zi9DbG91ZFN0YXRpb24vZmlybF9saWJyYXJ5L2ZpcmxfbGlicmFyeV9maWxlcy9Gcml0c2NoLzE5ODAucGRmABMAAS8AABUAAgAN//8AAAAIAA0AGgAkAGoAAAAAAAACAQAAAAAAAAAFAAAAAAAAAAAAAAAAAAACOA==}, Booktitle = {Journal of the Atmospheric Sciences}, Da = {1980/08/01}, Date = {1980/08/01}, @@ -2078,12 +2169,12 @@ @article{fritsch_and_chappell_1980 Volume = {37}, Year = {1980}, Year1 = {1980}, - Bdsk-File-1 = {YnBsaXN0MDDSAQIDBFxyZWxhdGl2ZVBhdGhZYWxpYXNEYXRhXxBDLi4vLi4vQ2xvdWRTdGF0aW9uL2ZpcmxfbGlicmFyeS9maXJsX2xpYnJhcnlfZmlsZXMvRnJpdHNjaC8xOTgwLnBkZk8RAcoAAAAAAcoAAgAADE1hY2ludG9zaCBIRAAAAAAAAAAAAAAAAAAAANHnJFJIKwAAARCuMwgxOTgwLnBkZgAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAABEKs103xvpgAAAAAAAAAAAAIABQAACSAAAAAAAAAAAAAAAAAAAAAHRnJpdHNjaAAAEAAIAADR53iyAAAAEQAIAADTfMQGAAAAAQAYARCuMwAobJYAKGyLAChnewAbXgcAAphcAAIAXU1hY2ludG9zaCBIRDpVc2VyczoAZ3JhbnRmOgBDbG91ZFN0YXRpb246AGZpcmxfbGlicmFyeToAZmlybF9saWJyYXJ5X2ZpbGVzOgBGcml0c2NoOgAxOTgwLnBkZgAADgASAAgAMQA5ADgAMAAuAHAAZABmAA8AGgAMAE0AYQBjAGkAbgB0AG8AcwBoACAASABEABIASlVzZXJzL2dyYW50Zi9DbG91ZFN0YXRpb24vZmlybF9saWJyYXJ5L2ZpcmxfbGlicmFyeV9maWxlcy9Gcml0c2NoLzE5ODAucGRmABMAAS8AABUAAgAN//8AAAAIAA0AGgAkAGoAAAAAAAACAQAAAAAAAAAFAAAAAAAAAAAAAAAAAAACOA==}, Bdsk-Url-1 = {http://dx.doi.org/10.1175/1520-0469(1980)037%3C1722:NPOCDM%3E2.0.CO;2}} @article{bechtold_et_al_2008, Abstract = {Advances in simulating atmospheric variability with the ECMWF model are presented that stem from revisions of the convection and diffusion parametrizations. The revisions concern in particular the introduction of a variable convective adjustment time-scale, a convective entrainment rate proportional to the environmental relative humidity, as well as free tropospheric diffusion coefficients for heat and momentum based on Monin--Obukhov functional dependencies.The forecasting system is evaluated against analyses and observations using high-resolution medium-range deterministic and ensemble forecasts, monthly and seasonal integrations, and decadal integrations with coupled atmosphere-ocean models. The results show a significantly higher and more realistic level of model activity in terms of the amplitude of tropical and extratropical mesoscale, synoptic and planetary perturbations. Importantly, with the higher variability and reduced bias not only the probabilistic scores are improved, but also the midlatitude deterministic scores in the short and medium ranges. Furthermore, for the first time the model is able to represent a realistic spectrum of convectively coupled equatorial Kelvin and Rossby waves, and maintains a realistic amplitude of the Madden--Julian oscillation (MJO) during monthly forecasts. However, the propagation speed of the MJO is slower than observed. The higher tropical tropospheric wave activity also results in better stratospheric temperatures and winds through the deposition of momentum.The partitioning between convective and resolved precipitation is unaffected by the model changes with roughly 62% of the total global precipitation being of the convective type. Finally, the changes in convection and diffusion parametrizations resulted in a larger spread of the ensemble forecasts, which allowed the amplitude of the initial perturbations in the ensemble prediction system to decrease by 30%. Copyright {\copyright} 2008 Royal Meteorological Society}, Author = {Bechtold, Peter and K{\"o}hler, Martin and Jung, Thomas and Doblas-Reyes, Francisco and Leutbecher, Martin and Rodwell, Mark J. and Vitart, Frederic and Balsamo, Gianpaolo}, + Bdsk-File-1 = {YnBsaXN0MDDSAQIDBFxyZWxhdGl2ZVBhdGhZYWxpYXNEYXRhXxBELi4vLi4vQ2xvdWRTdGF0aW9uL2ZpcmxfbGlicmFyeS9maXJsX2xpYnJhcnlfZmlsZXMvQmVjaHRvbGQvMjAwOC5wZGZPEQHMAAAAAAHMAAIAAAxNYWNpbnRvc2ggSEQAAAAAAAAAAAAAAAAAAADR5yRSSCsAAAAobfkIMjAwOC5wZGYAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAARZce9OEjEwAAAAAAAAAAAACAAUAAAkgAAAAAAAAAAAAAAAAAAAACEJlY2h0b2xkABAACAAA0ed4sgAAABEACAAA04TgrAAAAAEAGAAobfkAKGyWAChsiwAoZ3sAG14HAAKYXAACAF5NYWNpbnRvc2ggSEQ6VXNlcnM6AGdyYW50ZjoAQ2xvdWRTdGF0aW9uOgBmaXJsX2xpYnJhcnk6AGZpcmxfbGlicmFyeV9maWxlczoAQmVjaHRvbGQ6ADIwMDgucGRmAA4AEgAIADIAMAAwADgALgBwAGQAZgAPABoADABNAGEAYwBpAG4AdABvAHMAaAAgAEgARAASAEtVc2Vycy9ncmFudGYvQ2xvdWRTdGF0aW9uL2ZpcmxfbGlicmFyeS9maXJsX2xpYnJhcnlfZmlsZXMvQmVjaHRvbGQvMjAwOC5wZGYAABMAAS8AABUAAgAN//8AAAAIAA0AGgAkAGsAAAAAAAACAQAAAAAAAAAFAAAAAAAAAAAAAAAAAAACOw==}, Date-Added = {2016-06-14 23:11:58 +0000}, Date-Modified = {2016-06-14 23:11:58 +0000}, Doi = {10.1002/qj.289}, @@ -2097,12 +2188,12 @@ @article{bechtold_et_al_2008 Url = {http://dx.doi.org/10.1002/qj.289}, Volume = {134}, Year = {2008}, - Bdsk-File-1 = {YnBsaXN0MDDSAQIDBFxyZWxhdGl2ZVBhdGhZYWxpYXNEYXRhXxBELi4vLi4vQ2xvdWRTdGF0aW9uL2ZpcmxfbGlicmFyeS9maXJsX2xpYnJhcnlfZmlsZXMvQmVjaHRvbGQvMjAwOC5wZGZPEQHMAAAAAAHMAAIAAAxNYWNpbnRvc2ggSEQAAAAAAAAAAAAAAAAAAADR5yRSSCsAAAAobfkIMjAwOC5wZGYAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAARZce9OEjEwAAAAAAAAAAAACAAUAAAkgAAAAAAAAAAAAAAAAAAAACEJlY2h0b2xkABAACAAA0ed4sgAAABEACAAA04TgrAAAAAEAGAAobfkAKGyWAChsiwAoZ3sAG14HAAKYXAACAF5NYWNpbnRvc2ggSEQ6VXNlcnM6AGdyYW50ZjoAQ2xvdWRTdGF0aW9uOgBmaXJsX2xpYnJhcnk6AGZpcmxfbGlicmFyeV9maWxlczoAQmVjaHRvbGQ6ADIwMDgucGRmAA4AEgAIADIAMAAwADgALgBwAGQAZgAPABoADABNAGEAYwBpAG4AdABvAHMAaAAgAEgARAASAEtVc2Vycy9ncmFudGYvQ2xvdWRTdGF0aW9uL2ZpcmxfbGlicmFyeS9maXJsX2xpYnJhcnlfZmlsZXMvQmVjaHRvbGQvMjAwOC5wZGYAABMAAS8AABUAAgAN//8AAAAIAA0AGgAkAGsAAAAAAAACAQAAAAAAAAAFAAAAAAAAAAAAAAAAAAACOw==}, Bdsk-Url-1 = {http://dx.doi.org/10.1002/qj.289}} @article{han_and_pan_2011, Annote = {doi: 10.1175/WAF-D-10-05038.1}, Author = {Han, Jongil and Pan, Hua-Lu}, + Bdsk-File-1 = {YnBsaXN0MDDSAQIDBFxyZWxhdGl2ZVBhdGhZYWxpYXNEYXRhXxA/Li4vLi4vQ2xvdWRTdGF0aW9uL2ZpcmxfbGlicmFyeS9maXJsX2xpYnJhcnlfZmlsZXMvSGFuLzIwMTEucGRmTxEBvgAAAAABvgACAAAMTWFjaW50b3NoIEhEAAAAAAAAAAAAAAAAAAAA0eckUkgrAAAAWsT5CDIwMTEucGRmAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAADC1cfTGvlvAAAAAAAAAAAAAgAFAAAJIAAAAAAAAAAAAAAAAAAAAANIYW4AABAACAAA0ed4sgAAABEACAAA0xtNzwAAAAEAGABaxPkAKGyWAChsiwAoZ3sAG14HAAKYXAACAFlNYWNpbnRvc2ggSEQ6VXNlcnM6AGdyYW50ZjoAQ2xvdWRTdGF0aW9uOgBmaXJsX2xpYnJhcnk6AGZpcmxfbGlicmFyeV9maWxlczoASGFuOgAyMDExLnBkZgAADgASAAgAMgAwADEAMQAuAHAAZABmAA8AGgAMAE0AYQBjAGkAbgB0AG8AcwBoACAASABEABIARlVzZXJzL2dyYW50Zi9DbG91ZFN0YXRpb24vZmlybF9saWJyYXJ5L2ZpcmxfbGlicmFyeV9maWxlcy9IYW4vMjAxMS5wZGYAEwABLwAAFQACAA3//wAAAAgADQAaACQAZgAAAAAAAAIBAAAAAAAAAAUAAAAAAAAAAAAAAAAAAAIo}, Booktitle = {Weather and Forecasting}, Da = {2011/08/01}, Date = {2011/08/01}, @@ -2123,22 +2214,22 @@ @article{han_and_pan_2011 Volume = {26}, Year = {2011}, Year1 = {2011}, - Bdsk-File-1 = {YnBsaXN0MDDSAQIDBFxyZWxhdGl2ZVBhdGhZYWxpYXNEYXRhXxA/Li4vLi4vQ2xvdWRTdGF0aW9uL2ZpcmxfbGlicmFyeS9maXJsX2xpYnJhcnlfZmlsZXMvSGFuLzIwMTEucGRmTxEBvgAAAAABvgACAAAMTWFjaW50b3NoIEhEAAAAAAAAAAAAAAAAAAAA0eckUkgrAAAAWsT5CDIwMTEucGRmAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAADC1cfTGvlvAAAAAAAAAAAAAgAFAAAJIAAAAAAAAAAAAAAAAAAAAANIYW4AABAACAAA0ed4sgAAABEACAAA0xtNzwAAAAEAGABaxPkAKGyWAChsiwAoZ3sAG14HAAKYXAACAFlNYWNpbnRvc2ggSEQ6VXNlcnM6AGdyYW50ZjoAQ2xvdWRTdGF0aW9uOgBmaXJsX2xpYnJhcnk6AGZpcmxfbGlicmFyeV9maWxlczoASGFuOgAyMDExLnBkZgAADgASAAgAMgAwADEAMQAuAHAAZABmAA8AGgAMAE0AYQBjAGkAbgB0AG8AcwBoACAASABEABIARlVzZXJzL2dyYW50Zi9DbG91ZFN0YXRpb24vZmlybF9saWJyYXJ5L2ZpcmxfbGlicmFyeV9maWxlcy9IYW4vMjAxMS5wZGYAEwABLwAAFQACAA3//wAAAAgADQAaACQAZgAAAAAAAAIBAAAAAAAAAAUAAAAAAAAAAAAAAAAAAAIo}, Bdsk-Url-1 = {http://dx.doi.org/10.1175/WAF-D-10-05038.1}} @article{pan_and_wu_1995, Author = {Pan, H. -L. and W.-S. Wu}, + Bdsk-File-1 = {YnBsaXN0MDDSAQIDBFxyZWxhdGl2ZVBhdGhZYWxpYXNEYXRhXxA/Li4vLi4vQ2xvdWRTdGF0aW9uL2ZpcmxfbGlicmFyeS9maXJsX2xpYnJhcnlfZmlsZXMvUGFuLzE5OTUucGRmTxEBvgAAAAABvgACAAAMTWFjaW50b3NoIEhEAAAAAAAAAAAAAAAAAAAA0eckUkgrAAAAwtTNCDE5OTUucGRmAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAADCtU/TGvMJAAAAAAAAAAAAAgAFAAAJIAAAAAAAAAAAAAAAAAAAAANQYW4AABAACAAA0ed4sgAAABEACAAA0xtHaQAAAAEAGADC1M0AKGyWAChsiwAoZ3sAG14HAAKYXAACAFlNYWNpbnRvc2ggSEQ6VXNlcnM6AGdyYW50ZjoAQ2xvdWRTdGF0aW9uOgBmaXJsX2xpYnJhcnk6AGZpcmxfbGlicmFyeV9maWxlczoAUGFuOgAxOTk1LnBkZgAADgASAAgAMQA5ADkANQAuAHAAZABmAA8AGgAMAE0AYQBjAGkAbgB0AG8AcwBoACAASABEABIARlVzZXJzL2dyYW50Zi9DbG91ZFN0YXRpb24vZmlybF9saWJyYXJ5L2ZpcmxfbGlicmFyeV9maWxlcy9QYW4vMTk5NS5wZGYAEwABLwAAFQACAA3//wAAAAgADQAaACQAZgAAAAAAAAIBAAAAAAAAAAUAAAAAAAAAAAAAAAAAAAIo}, Date-Added = {2016-06-14 23:06:41 +0000}, Date-Modified = {2016-06-14 23:06:41 +0000}, Journal = {NMC Office Note, No. 409}, Pages = {40pp}, Title = {Implementing a Mass Flux Convection Parameterization Package for the NMC Medium-Range Forecast Model}, - Year = {1995}, - Bdsk-File-1 = {YnBsaXN0MDDSAQIDBFxyZWxhdGl2ZVBhdGhZYWxpYXNEYXRhXxA/Li4vLi4vQ2xvdWRTdGF0aW9uL2ZpcmxfbGlicmFyeS9maXJsX2xpYnJhcnlfZmlsZXMvUGFuLzE5OTUucGRmTxEBvgAAAAABvgACAAAMTWFjaW50b3NoIEhEAAAAAAAAAAAAAAAAAAAA0eckUkgrAAAAwtTNCDE5OTUucGRmAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAADCtU/TGvMJAAAAAAAAAAAAAgAFAAAJIAAAAAAAAAAAAAAAAAAAAANQYW4AABAACAAA0ed4sgAAABEACAAA0xtHaQAAAAEAGADC1M0AKGyWAChsiwAoZ3sAG14HAAKYXAACAFlNYWNpbnRvc2ggSEQ6VXNlcnM6AGdyYW50ZjoAQ2xvdWRTdGF0aW9uOgBmaXJsX2xpYnJhcnk6AGZpcmxfbGlicmFyeV9maWxlczoAUGFuOgAxOTk1LnBkZgAADgASAAgAMQA5ADkANQAuAHAAZABmAA8AGgAMAE0AYQBjAGkAbgB0AG8AcwBoACAASABEABIARlVzZXJzL2dyYW50Zi9DbG91ZFN0YXRpb24vZmlybF9saWJyYXJ5L2ZpcmxfbGlicmFyeV9maWxlcy9QYW4vMTk5NS5wZGYAEwABLwAAFQACAA3//wAAAAgADQAaACQAZgAAAAAAAAIBAAAAAAAAAAUAAAAAAAAAAAAAAAAAAAIo}} + Year = {1995}} @article{grell_1993, Annote = {doi: 10.1175/1520-0493(1993)121<0764:PEOAUB>2.0.CO;2}, Author = {Grell, Georg A.}, + Bdsk-File-1 = {YnBsaXN0MDDSAQIDBFxyZWxhdGl2ZVBhdGhZYWxpYXNEYXRhXxBBLi4vLi4vQ2xvdWRTdGF0aW9uL2ZpcmxfbGlicmFyeS9maXJsX2xpYnJhcnlfZmlsZXMvR3JlbGwvMTk5My5wZGZPEQHEAAAAAAHEAAIAAAxNYWNpbnRvc2ggSEQAAAAAAAAAAAAAAAAAAADR5yRSSCsAAAAoie0IMTk5My5wZGYAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAMK4dtMa9LMAAAAAAAAAAAACAAUAAAkgAAAAAAAAAAAAAAAAAAAABUdyZWxsAAAQAAgAANHneLIAAAARAAgAANMbSRMAAAABABgAKIntAChslgAobIsAKGd7ABteBwACmFwAAgBbTWFjaW50b3NoIEhEOlVzZXJzOgBncmFudGY6AENsb3VkU3RhdGlvbjoAZmlybF9saWJyYXJ5OgBmaXJsX2xpYnJhcnlfZmlsZXM6AEdyZWxsOgAxOTkzLnBkZgAADgASAAgAMQA5ADkAMwAuAHAAZABmAA8AGgAMAE0AYQBjAGkAbgB0AG8AcwBoACAASABEABIASFVzZXJzL2dyYW50Zi9DbG91ZFN0YXRpb24vZmlybF9saWJyYXJ5L2ZpcmxfbGlicmFyeV9maWxlcy9HcmVsbC8xOTkzLnBkZgATAAEvAAAVAAIADf//AAAACAANABoAJABoAAAAAAAAAgEAAAAAAAAABQAAAAAAAAAAAAAAAAAAAjA=}, Booktitle = {Monthly Weather Review}, Da = {1993/03/01}, Date = {1993/03/01}, @@ -2159,11 +2250,11 @@ @article{grell_1993 Volume = {121}, Year = {1993}, Year1 = {1993}, - Bdsk-File-1 = {YnBsaXN0MDDSAQIDBFxyZWxhdGl2ZVBhdGhZYWxpYXNEYXRhXxBBLi4vLi4vQ2xvdWRTdGF0aW9uL2ZpcmxfbGlicmFyeS9maXJsX2xpYnJhcnlfZmlsZXMvR3JlbGwvMTk5My5wZGZPEQHEAAAAAAHEAAIAAAxNYWNpbnRvc2ggSEQAAAAAAAAAAAAAAAAAAADR5yRSSCsAAAAoie0IMTk5My5wZGYAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAMK4dtMa9LMAAAAAAAAAAAACAAUAAAkgAAAAAAAAAAAAAAAAAAAABUdyZWxsAAAQAAgAANHneLIAAAARAAgAANMbSRMAAAABABgAKIntAChslgAobIsAKGd7ABteBwACmFwAAgBbTWFjaW50b3NoIEhEOlVzZXJzOgBncmFudGY6AENsb3VkU3RhdGlvbjoAZmlybF9saWJyYXJ5OgBmaXJsX2xpYnJhcnlfZmlsZXM6AEdyZWxsOgAxOTkzLnBkZgAADgASAAgAMQA5ADkAMwAuAHAAZABmAA8AGgAMAE0AYQBjAGkAbgB0AG8AcwBoACAASABEABIASFVzZXJzL2dyYW50Zi9DbG91ZFN0YXRpb24vZmlybF9saWJyYXJ5L2ZpcmxfbGlicmFyeV9maWxlcy9HcmVsbC8xOTkzLnBkZgATAAEvAAAVAAIADf//AAAACAANABoAJABoAAAAAAAAAgEAAAAAAAAABQAAAAAAAAAAAAAAAAAAAjA=}, Bdsk-Url-1 = {http://dx.doi.org/10.1175/1520-0493(1993)121%3C0764:PEOAUB%3E2.0.CO;2}} @article{arakawa_and_schubert_1974, Author = {Arakawa, A and Schubert, WH}, + Bdsk-File-1 = {YnBsaXN0MDDSAQIDBFxyZWxhdGl2ZVBhdGhZYWxpYXNEYXRhXxBDLi4vLi4vQ2xvdWRTdGF0aW9uL2ZpcmxfbGlicmFyeS9maXJsX2xpYnJhcnlfZmlsZXMvQXJha2F3YS8xOTc0LnBkZk8RAcoAAAAAAcoAAgAADE1hY2ludG9zaCBIRAAAAAAAAAAAAAAAAAAAANHnJFJIKwAAAChtVQgxOTc0LnBkZgAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAKG1ctM8h9AAAAAAAAAAAAAIABQAACSAAAAAAAAAAAAAAAAAAAAAHQXJha2F3YQAAEAAIAADR53iyAAAAEQAIAAC0z4RkAAAAAQAYAChtVQAobJYAKGyLAChnewAbXgcAAphcAAIAXU1hY2ludG9zaCBIRDpVc2VyczoAZ3JhbnRmOgBDbG91ZFN0YXRpb246AGZpcmxfbGlicmFyeToAZmlybF9saWJyYXJ5X2ZpbGVzOgBBcmFrYXdhOgAxOTc0LnBkZgAADgASAAgAMQA5ADcANAAuAHAAZABmAA8AGgAMAE0AYQBjAGkAbgB0AG8AcwBoACAASABEABIASlVzZXJzL2dyYW50Zi9DbG91ZFN0YXRpb24vZmlybF9saWJyYXJ5L2ZpcmxfbGlicmFyeV9maWxlcy9BcmFrYXdhLzE5NzQucGRmABMAAS8AABUAAgAN//8AAAAIAA0AGgAkAGoAAAAAAAACAQAAAAAAAAAFAAAAAAAAAAAAAAAAAAACOA==}, Date-Added = {2016-06-14 23:04:30 +0000}, Date-Modified = {2018-07-18 19:00:17 +0000}, Isi = {A1974S778800004}, @@ -2176,7 +2267,6 @@ @article{arakawa_and_schubert_1974 Title = {Interaction of a cumulus cloud ensemble with the large-scale environment, Part I}, Volume = {31}, Year = {1974}, - Bdsk-File-1 = {YnBsaXN0MDDSAQIDBFxyZWxhdGl2ZVBhdGhZYWxpYXNEYXRhXxBDLi4vLi4vQ2xvdWRTdGF0aW9uL2ZpcmxfbGlicmFyeS9maXJsX2xpYnJhcnlfZmlsZXMvQXJha2F3YS8xOTc0LnBkZk8RAcoAAAAAAcoAAgAADE1hY2ludG9zaCBIRAAAAAAAAAAAAAAAAAAAANHnJFJIKwAAAChtVQgxOTc0LnBkZgAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAKG1ctM8h9AAAAAAAAAAAAAIABQAACSAAAAAAAAAAAAAAAAAAAAAHQXJha2F3YQAAEAAIAADR53iyAAAAEQAIAAC0z4RkAAAAAQAYAChtVQAobJYAKGyLAChnewAbXgcAAphcAAIAXU1hY2ludG9zaCBIRDpVc2VyczoAZ3JhbnRmOgBDbG91ZFN0YXRpb246AGZpcmxfbGlicmFyeToAZmlybF9saWJyYXJ5X2ZpbGVzOgBBcmFrYXdhOgAxOTc0LnBkZgAADgASAAgAMQA5ADcANAAuAHAAZABmAA8AGgAMAE0AYQBjAGkAbgB0AG8AcwBoACAASABEABIASlVzZXJzL2dyYW50Zi9DbG91ZFN0YXRpb24vZmlybF9saWJyYXJ5L2ZpcmxfbGlicmFyeV9maWxlcy9BcmFrYXdhLzE5NzQucGRmABMAAS8AABUAAgAN//8AAAAIAA0AGgAkAGoAAAAAAAACAQAAAAAAAAAFAAAAAAAAAAAAAAAAAAACOA==}, Bdsk-Url-1 = {http://ws.isiknowledge.com/cps/openurl/service?url_ver=Z39.88-2004&rft_id=info:ut/A1974S778800004}} @article{harshvardhan_et_al_1989, @@ -2410,6 +2500,7 @@ @article{akmaev_1991 @article{siebesma_et_al_2007, Abstract = {A better conceptual understanding and more realistic parameterizations of convective boundary layers in climate and weather prediction models have been major challenges in meteorological research. In particular, parameterizations of the dry convective boundary layer, in spite of the absence of water phase-changes and its consequent simplicity as compared to moist convection, typically suffer from problems in attempting to represent realistically the boundary layer growth and what is often referred to as countergradient fluxes. The eddy-diffusivity (ED) approach has been relatively successful in representing some characteristics of neutral boundary layers and surface layers in general. The mass-flux (MF) approach, on the other hand, has been used for the parameterization of shallow and deep moist convection. In this paper, a new approach that relies on a combination of the ED and MF parameterizations (EDMF) is proposed for the dry convective boundary layer. It is shown that the EDMF approach follows naturally from a decomposition of the turbulent fluxes into 1) a part that includes strong organized updrafts, and 2) a remaining turbulent field. At the basis of the EDMF approach is the concept that nonlocal subgrid transport due to the strong updrafts is taken into account by the MF approach, while the remaining transport is taken into account by an ED closure. Large-eddy simulation (LES) results of the dry convective boundary layer are used to support the theoretical framework of this new approach and to determine the parameters of the EDMF model. The performance of the new formulation is evaluated against LES results, and it is shown that the EDMF closure is able to reproduce the main properties of dry convective boundary layers in a realistic manner. Furthermore, it will be shown that this approach has strong advantages over the more traditional countergradient approach, especially in the entrainment layer. As a result, this EDMF approach opens the way to parameterize the clear and cumulus-topped boundary layer in a simple and unified way.}, Author = {Siebesma, A. Pier and Soares, Pedro M. M. and Teixeira, Joao}, + Bdsk-File-1 = {YnBsaXN0MDDSAQIDBFxyZWxhdGl2ZVBhdGhZYWxpYXNEYXRhXxBELi4vLi4vQ2xvdWRTdGF0aW9uL2ZpcmxfbGlicmFyeS9maXJsX2xpYnJhcnlfZmlsZXMvU2llYmVzbWEvMjAwNy5wZGZPEQHMAAAAAAHMAAIAAAxNYWNpbnRvc2ggSEQAAAAAAAAAAAAAAAAAAADR5yRSSCsAAAAqYEwIMjAwNy5wZGYAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACphyMc7+4hQREYgQ0FSTwACAAUAAAkgAAAAAAAAAAAAAAAAAAAACFNpZWJlc21hABAACAAA0ed4sgAAABEACAAAxzxd+AAAAAEAGAAqYEwAKGyWAChsiwAoZ3sAG14HAAKYXAACAF5NYWNpbnRvc2ggSEQ6VXNlcnM6AGdyYW50ZjoAQ2xvdWRTdGF0aW9uOgBmaXJsX2xpYnJhcnk6AGZpcmxfbGlicmFyeV9maWxlczoAU2llYmVzbWE6ADIwMDcucGRmAA4AEgAIADIAMAAwADcALgBwAGQAZgAPABoADABNAGEAYwBpAG4AdABvAHMAaAAgAEgARAASAEtVc2Vycy9ncmFudGYvQ2xvdWRTdGF0aW9uL2ZpcmxfbGlicmFyeS9maXJsX2xpYnJhcnlfZmlsZXMvU2llYmVzbWEvMjAwNy5wZGYAABMAAS8AABUAAgAN//8AAAAIAA0AGgAkAGsAAAAAAAACAQAAAAAAAAAFAAAAAAAAAAAAAAAAAAACOw==}, Date-Added = {2016-05-20 17:17:49 +0000}, Date-Modified = {2016-05-20 17:17:49 +0000}, Doi = {DOI 10.1175/JAS3888.1}, @@ -2423,12 +2514,12 @@ @article{siebesma_et_al_2007 Title = {A combined eddy-diffusivity mass-flux approach for the convective boundary layer}, Volume = {64}, Year = {2007}, - Bdsk-File-1 = {YnBsaXN0MDDSAQIDBFxyZWxhdGl2ZVBhdGhZYWxpYXNEYXRhXxBELi4vLi4vQ2xvdWRTdGF0aW9uL2ZpcmxfbGlicmFyeS9maXJsX2xpYnJhcnlfZmlsZXMvU2llYmVzbWEvMjAwNy5wZGZPEQHMAAAAAAHMAAIAAAxNYWNpbnRvc2ggSEQAAAAAAAAAAAAAAAAAAADR5yRSSCsAAAAqYEwIMjAwNy5wZGYAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACphyMc7+4hQREYgQ0FSTwACAAUAAAkgAAAAAAAAAAAAAAAAAAAACFNpZWJlc21hABAACAAA0ed4sgAAABEACAAAxzxd+AAAAAEAGAAqYEwAKGyWAChsiwAoZ3sAG14HAAKYXAACAF5NYWNpbnRvc2ggSEQ6VXNlcnM6AGdyYW50ZjoAQ2xvdWRTdGF0aW9uOgBmaXJsX2xpYnJhcnk6AGZpcmxfbGlicmFyeV9maWxlczoAU2llYmVzbWE6ADIwMDcucGRmAA4AEgAIADIAMAAwADcALgBwAGQAZgAPABoADABNAGEAYwBpAG4AdABvAHMAaAAgAEgARAASAEtVc2Vycy9ncmFudGYvQ2xvdWRTdGF0aW9uL2ZpcmxfbGlicmFyeS9maXJsX2xpYnJhcnlfZmlsZXMvU2llYmVzbWEvMjAwNy5wZGYAABMAAS8AABUAAgAN//8AAAAIAA0AGgAkAGsAAAAAAAACAQAAAAAAAAAFAAAAAAAAAAAAAAAAAAACOw==}, Bdsk-Url-1 = {http://ws.isiknowledge.com/cps/openurl/service?url_ver=Z39.88-2004&rft_id=info:ut/000245742600011}} @article{soares_et_al_2004, Abstract = {Recently, a new consistent way of parametrizing simultaneously local and non-local turbulent transport for the convective atmospheric boundary layer has been proposed and tested for the clear boundary layer. This approach assumes that in the convective boundary layer the subgrid-scale fluxes result from two different mixing scales: small eddies, that are parametrized by an eddy-diffusivity approach, and thermals, which are represented by a mass-flux contribution. Since the interaction between the cloud layer and the underlying sub-cloud layer predominantly takes place through strong updraughts, this approach offers an interesting avenue of establishing a unified description of the turbulent transport in the cumulus-topped boundary layer. This paper explores the possibility of such a new approach for the cumulus-topped boundary layer. In the sub-cloud and cloud layers, the mass-flux term represents the effect of strong updraughts. These are modelled by a simple entraining parcel, which determines the mean properties of the strong updraughts, the boundary-layer height, the lifting condensation level and cloud top. The residual smaller-scale turbulent transport is parametrized with an eddy-diffusivity approach that uses a turbulent kinetic energy closure. The new scheme is implemented and tested in the research model MesoNH. Copyright {\copyright} 2004 Royal Meteorological Society}, Author = {Soares, P. M. M. and Miranda, P. M. A. and Siebesma, A. P. and Teixeira, J.}, + Bdsk-File-1 = {YnBsaXN0MDDSAQIDBFxyZWxhdGl2ZVBhdGhZYWxpYXNEYXRhXxBCLi4vLi4vQ2xvdWRTdGF0aW9uL2ZpcmxfbGlicmFyeS9maXJsX2xpYnJhcnlfZmlsZXMvU29hcmVzLzIwMDQucGRmTxEBxgAAAAABxgACAAAMTWFjaW50b3NoIEhEAAAAAAAAAAAAAAAAAAAA0eckUkgrAAAAWIC2CDIwMDQucGRmAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAABYf6DSsqNwAAAAAAAAAAAAAgAFAAAJIAAAAAAAAAAAAAAAAAAAAAZTb2FyZXMAEAAIAADR53iyAAAAEQAIAADSswXgAAAAAQAYAFiAtgAobJYAKGyLAChnewAbXgcAAphcAAIAXE1hY2ludG9zaCBIRDpVc2VyczoAZ3JhbnRmOgBDbG91ZFN0YXRpb246AGZpcmxfbGlicmFyeToAZmlybF9saWJyYXJ5X2ZpbGVzOgBTb2FyZXM6ADIwMDQucGRmAA4AEgAIADIAMAAwADQALgBwAGQAZgAPABoADABNAGEAYwBpAG4AdABvAHMAaAAgAEgARAASAElVc2Vycy9ncmFudGYvQ2xvdWRTdGF0aW9uL2ZpcmxfbGlicmFyeS9maXJsX2xpYnJhcnlfZmlsZXMvU29hcmVzLzIwMDQucGRmAAATAAEvAAAVAAIADf//AAAACAANABoAJABpAAAAAAAAAgEAAAAAAAAABQAAAAAAAAAAAAAAAAAAAjM=}, Date-Added = {2016-05-20 17:17:49 +0000}, Date-Modified = {2016-05-20 17:17:49 +0000}, Doi = {10.1256/qj.03.223}, @@ -2442,11 +2533,11 @@ @article{soares_et_al_2004 Url = {http://dx.doi.org/10.1256/qj.03.223}, Volume = {130}, Year = {2004}, - Bdsk-File-1 = {YnBsaXN0MDDSAQIDBFxyZWxhdGl2ZVBhdGhZYWxpYXNEYXRhXxBCLi4vLi4vQ2xvdWRTdGF0aW9uL2ZpcmxfbGlicmFyeS9maXJsX2xpYnJhcnlfZmlsZXMvU29hcmVzLzIwMDQucGRmTxEBxgAAAAABxgACAAAMTWFjaW50b3NoIEhEAAAAAAAAAAAAAAAAAAAA0eckUkgrAAAAWIC2CDIwMDQucGRmAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAABYf6DSsqNwAAAAAAAAAAAAAgAFAAAJIAAAAAAAAAAAAAAAAAAAAAZTb2FyZXMAEAAIAADR53iyAAAAEQAIAADSswXgAAAAAQAYAFiAtgAobJYAKGyLAChnewAbXgcAAphcAAIAXE1hY2ludG9zaCBIRDpVc2VyczoAZ3JhbnRmOgBDbG91ZFN0YXRpb246AGZpcmxfbGlicmFyeToAZmlybF9saWJyYXJ5X2ZpbGVzOgBTb2FyZXM6ADIwMDQucGRmAA4AEgAIADIAMAAwADQALgBwAGQAZgAPABoADABNAGEAYwBpAG4AdABvAHMAaAAgAEgARAASAElVc2Vycy9ncmFudGYvQ2xvdWRTdGF0aW9uL2ZpcmxfbGlicmFyeS9maXJsX2xpYnJhcnlfZmlsZXMvU29hcmVzLzIwMDQucGRmAAATAAEvAAAVAAIADf//AAAACAANABoAJABpAAAAAAAAAgEAAAAAAAAABQAAAAAAAAAAAAAAAAAAAjM=}, Bdsk-Url-1 = {http://dx.doi.org/10.1256/qj.03.223}} @article{troen_and_mahrt_1986, Author = {Troen, IB and Mahrt, L.}, + Bdsk-File-1 = {YnBsaXN0MDDSAQIDBFxyZWxhdGl2ZVBhdGhZYWxpYXNEYXRhXxBBLi4vLi4vQ2xvdWRTdGF0aW9uL2ZpcmxfbGlicmFyeS9maXJsX2xpYnJhcnlfZmlsZXMvVHJvZW4vMTk4Ni5wZGZPEQHEAAAAAAHEAAIAAAxNYWNpbnRvc2ggSEQAAAAAAAAAAAAAAAAAAADR5yRSSCsAAABNeegIMTk4Ni5wZGYAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAE13kNKUWwUAAAAAAAAAAAACAAUAAAkgAAAAAAAAAAAAAAAAAAAABVRyb2VuAAAQAAgAANHneLIAAAARAAgAANKUvXUAAAABABgATXnoAChslgAobIsAKGd7ABteBwACmFwAAgBbTWFjaW50b3NoIEhEOlVzZXJzOgBncmFudGY6AENsb3VkU3RhdGlvbjoAZmlybF9saWJyYXJ5OgBmaXJsX2xpYnJhcnlfZmlsZXM6AFRyb2VuOgAxOTg2LnBkZgAADgASAAgAMQA5ADgANgAuAHAAZABmAA8AGgAMAE0AYQBjAGkAbgB0AG8AcwBoACAASABEABIASFVzZXJzL2dyYW50Zi9DbG91ZFN0YXRpb24vZmlybF9saWJyYXJ5L2ZpcmxfbGlicmFyeV9maWxlcy9Ucm9lbi8xOTg2LnBkZgATAAEvAAAVAAIADf//AAAACAANABoAJABoAAAAAAAAAgEAAAAAAAAABQAAAAAAAAAAAAAAAAAAAjA=}, Date-Added = {2016-05-20 17:17:49 +0000}, Date-Modified = {2016-05-20 17:17:49 +0000}, Doi = {10.1007/BF00122760}, @@ -2460,13 +2551,13 @@ @article{troen_and_mahrt_1986 Url = {http://dx.doi.org/10.1007/BF00122760}, Volume = {37}, Year = {1986}, - Bdsk-File-1 = {YnBsaXN0MDDSAQIDBFxyZWxhdGl2ZVBhdGhZYWxpYXNEYXRhXxBBLi4vLi4vQ2xvdWRTdGF0aW9uL2ZpcmxfbGlicmFyeS9maXJsX2xpYnJhcnlfZmlsZXMvVHJvZW4vMTk4Ni5wZGZPEQHEAAAAAAHEAAIAAAxNYWNpbnRvc2ggSEQAAAAAAAAAAAAAAAAAAADR5yRSSCsAAABNeegIMTk4Ni5wZGYAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAE13kNKUWwUAAAAAAAAAAAACAAUAAAkgAAAAAAAAAAAAAAAAAAAABVRyb2VuAAAQAAgAANHneLIAAAARAAgAANKUvXUAAAABABgATXnoAChslgAobIsAKGd7ABteBwACmFwAAgBbTWFjaW50b3NoIEhEOlVzZXJzOgBncmFudGY6AENsb3VkU3RhdGlvbjoAZmlybF9saWJyYXJ5OgBmaXJsX2xpYnJhcnlfZmlsZXM6AFRyb2VuOgAxOTg2LnBkZgAADgASAAgAMQA5ADgANgAuAHAAZABmAA8AGgAMAE0AYQBjAGkAbgB0AG8AcwBoACAASABEABIASFVzZXJzL2dyYW50Zi9DbG91ZFN0YXRpb24vZmlybF9saWJyYXJ5L2ZpcmxfbGlicmFyeV9maWxlcy9Ucm9lbi8xOTg2LnBkZgATAAEvAAAVAAIADf//AAAACAANABoAJABoAAAAAAAAAgEAAAAAAAAABQAAAAAAAAAAAAAAAAAAAjA=}, Bdsk-Url-1 = {http://dx.doi.org/10.1007/BF00122760}} @article{macvean_and_mason_1990, Abstract = {Abstract In a recent paper, Kuo and Schubert demonstrated the lack of observational support for the relevance of the criterion for cloud-top entrainment instability proposed by Randall and by Deardorff. Here we derive a new criterion, based on a model of the instability as resulting from the energy released close to cloud top, by Mixing between saturated boundary-layer air and unsaturated air from above the capping inversion. The condition is derived by considering the net conversion from potential to kinetic energy in a system consisting of two layers of fluid straddling cloud-top, when a small amount of mixing occurs between these layers. This contrasts with previous analyses, which only considered the change in buoyancy of the cloud layer when unsaturated air is mixed into it. In its most general form, this new criterion depends on the ratio of the depths of the layers involved in the mixing. It is argued that, for a self-sustaining instability, there must be a net release of kinetic energy on the same depth and time scales as the entrainment process itself. There are two plausible ways in which this requirement may be satisfied. Either one takes the depths of the layers involved in the mixing to each be comparable to the vertical scale of the entrainment process, which is typically of order tens of meters or less, or alternatively, one must allow for the efficiency with which energy released by mixing through a much deeper lower layer becomes available to initiate further entrainment. In both cases the same criterion for instability results. This criterion is much more restrictive than that proposed by Randall and by Deardorff; furthermore, the observational data is then consistent with the predictions of the current theory. Further analysis provides estimates of the turbulent fluxes associated with cloud-top entrainment instability. This analysis effectively constitutes an energetically consistent turbulence closure for models of boundary layers with cloud. The implications for such numerical models are discussed. Comparisons are also made with other possible criteria for cloud-top entrainment instability which have recently been suggested.}, Annote = {doi: 10.1175/1520-0469(1990)047<1012:CTEITS>2.0.CO;2}, Author = {MacVean, M. K. and Mason, P. J.}, + Bdsk-File-1 = {YnBsaXN0MDDSAQIDBFxyZWxhdGl2ZVBhdGhZYWxpYXNEYXRhXxBDLi4vLi4vQ2xvdWRTdGF0aW9uL2ZpcmxfbGlicmFyeS9maXJsX2xpYnJhcnlfZmlsZXMvTWFjVmVhbi8xOTkwLnBkZk8RAcoAAAAAAcoAAgAADE1hY2ludG9zaCBIRAAAAAAAAAAAAAAAAAAAANHnJFJIKwAAAFx8zwgxOTkwLnBkZgAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAXHyn0rkkRQAAAAAAAAAAAAIABQAACSAAAAAAAAAAAAAAAAAAAAAHTWFjVmVhbgAAEAAIAADR53iyAAAAEQAIAADSuYa1AAAAAQAYAFx8zwAobJYAKGyLAChnewAbXgcAAphcAAIAXU1hY2ludG9zaCBIRDpVc2VyczoAZ3JhbnRmOgBDbG91ZFN0YXRpb246AGZpcmxfbGlicmFyeToAZmlybF9saWJyYXJ5X2ZpbGVzOgBNYWNWZWFuOgAxOTkwLnBkZgAADgASAAgAMQA5ADkAMAAuAHAAZABmAA8AGgAMAE0AYQBjAGkAbgB0AG8AcwBoACAASABEABIASlVzZXJzL2dyYW50Zi9DbG91ZFN0YXRpb24vZmlybF9saWJyYXJ5L2ZpcmxfbGlicmFyeV9maWxlcy9NYWNWZWFuLzE5OTAucGRmABMAAS8AABUAAgAN//8AAAAIAA0AGgAkAGoAAAAAAAACAQAAAAAAAAAFAAAAAAAAAAAAAAAAAAACOA==}, Booktitle = {Journal of the Atmospheric Sciences}, Da = {1990/04/01}, Date-Added = {2016-05-20 17:16:05 +0000}, @@ -2485,11 +2576,11 @@ @article{macvean_and_mason_1990 Url = {http://dx.doi.org/10.1175/1520-0469(1990)047<1012:CTEITS>2.0.CO;2}, Volume = {47}, Year = {1990}, - Bdsk-File-1 = {YnBsaXN0MDDSAQIDBFxyZWxhdGl2ZVBhdGhZYWxpYXNEYXRhXxBDLi4vLi4vQ2xvdWRTdGF0aW9uL2ZpcmxfbGlicmFyeS9maXJsX2xpYnJhcnlfZmlsZXMvTWFjVmVhbi8xOTkwLnBkZk8RAcoAAAAAAcoAAgAADE1hY2ludG9zaCBIRAAAAAAAAAAAAAAAAAAAANHnJFJIKwAAAFx8zwgxOTkwLnBkZgAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAXHyn0rkkRQAAAAAAAAAAAAIABQAACSAAAAAAAAAAAAAAAAAAAAAHTWFjVmVhbgAAEAAIAADR53iyAAAAEQAIAADSuYa1AAAAAQAYAFx8zwAobJYAKGyLAChnewAbXgcAAphcAAIAXU1hY2ludG9zaCBIRDpVc2VyczoAZ3JhbnRmOgBDbG91ZFN0YXRpb246AGZpcmxfbGlicmFyeToAZmlybF9saWJyYXJ5X2ZpbGVzOgBNYWNWZWFuOgAxOTkwLnBkZgAADgASAAgAMQA5ADkAMAAuAHAAZABmAA8AGgAMAE0AYQBjAGkAbgB0AG8AcwBoACAASABEABIASlVzZXJzL2dyYW50Zi9DbG91ZFN0YXRpb24vZmlybF9saWJyYXJ5L2ZpcmxfbGlicmFyeV9maWxlcy9NYWNWZWFuLzE5OTAucGRmABMAAS8AABUAAgAN//8AAAAIAA0AGgAkAGoAAAAAAAACAQAAAAAAAAAFAAAAAAAAAAAAAAAAAAACOA==}, Bdsk-Url-1 = {http://dx.doi.org/10.1175/1520-0469(1990)047%3C1012:CTEITS%3E2.0.CO;2}} @article{louis_1979, Author = {Louis, JF}, + Bdsk-File-1 = {YnBsaXN0MDDSAQIDBFxyZWxhdGl2ZVBhdGhZYWxpYXNEYXRhXxBBLi4vLi4vQ2xvdWRTdGF0aW9uL2ZpcmxfbGlicmFyeS9maXJsX2xpYnJhcnlfZmlsZXMvTG91aXMvMTk3OS5wZGZPEQHEAAAAAAHEAAIAAAxNYWNpbnRvc2ggSEQAAAAAAAAAAAAAAAAAAADR5yRSSCsAAAAonogIMTk3OS5wZGYAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACiej8FuU4pQREYgQ0FSTwACAAUAAAkgAAAAAAAAAAAAAAAAAAAABUxvdWlzAAAQAAgAANHneLIAAAARAAgAAMFutfoAAAABABgAKJ6IAChslgAobIsAKGd7ABteBwACmFwAAgBbTWFjaW50b3NoIEhEOlVzZXJzOgBncmFudGY6AENsb3VkU3RhdGlvbjoAZmlybF9saWJyYXJ5OgBmaXJsX2xpYnJhcnlfZmlsZXM6AExvdWlzOgAxOTc5LnBkZgAADgASAAgAMQA5ADcAOQAuAHAAZABmAA8AGgAMAE0AYQBjAGkAbgB0AG8AcwBoACAASABEABIASFVzZXJzL2dyYW50Zi9DbG91ZFN0YXRpb24vZmlybF9saWJyYXJ5L2ZpcmxfbGlicmFyeV9maWxlcy9Mb3Vpcy8xOTc5LnBkZgATAAEvAAAVAAIADf//AAAACAANABoAJABoAAAAAAAAAgEAAAAAAAAABQAAAAAAAAAAAAAAAAAAAjA=}, Date-Added = {2016-05-20 17:15:52 +0000}, Date-Modified = {2016-05-20 17:15:52 +0000}, Isi = {A1979HT69700004}, @@ -2502,12 +2593,12 @@ @article{louis_1979 Title = {A PARAMETRIC MODEL OF VERTICAL EDDY FLUXES IN THE ATMOSPHERE}, Volume = {17}, Year = {1979}, - Bdsk-File-1 = {YnBsaXN0MDDSAQIDBFxyZWxhdGl2ZVBhdGhZYWxpYXNEYXRhXxBBLi4vLi4vQ2xvdWRTdGF0aW9uL2ZpcmxfbGlicmFyeS9maXJsX2xpYnJhcnlfZmlsZXMvTG91aXMvMTk3OS5wZGZPEQHEAAAAAAHEAAIAAAxNYWNpbnRvc2ggSEQAAAAAAAAAAAAAAAAAAADR5yRSSCsAAAAonogIMTk3OS5wZGYAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACiej8FuU4pQREYgQ0FSTwACAAUAAAkgAAAAAAAAAAAAAAAAAAAABUxvdWlzAAAQAAgAANHneLIAAAARAAgAAMFutfoAAAABABgAKJ6IAChslgAobIsAKGd7ABteBwACmFwAAgBbTWFjaW50b3NoIEhEOlVzZXJzOgBncmFudGY6AENsb3VkU3RhdGlvbjoAZmlybF9saWJyYXJ5OgBmaXJsX2xpYnJhcnlfZmlsZXM6AExvdWlzOgAxOTc5LnBkZgAADgASAAgAMQA5ADcAOQAuAHAAZABmAA8AGgAMAE0AYQBjAGkAbgB0AG8AcwBoACAASABEABIASFVzZXJzL2dyYW50Zi9DbG91ZFN0YXRpb24vZmlybF9saWJyYXJ5L2ZpcmxfbGlicmFyeV9maWxlcy9Mb3Vpcy8xOTc5LnBkZgATAAEvAAAVAAIADf//AAAACAANABoAJABoAAAAAAAAAgEAAAAAAAAABQAAAAAAAAAAAAAAAAAAAjA=}, Bdsk-Url-1 = {http://ws.isiknowledge.com/cps/openurl/service?url_ver=Z39.88-2004&rft_id=info:ut/A1979HT69700004}} @article{lock_et_al_2000, Abstract = {A new boundary layer turbulent mixing scheme has been developed for use in the UKMO weather forecasting and climate prediction models. This includes a representation of nonlocal mixing (driven by both surface fluxes and cloud-top processes) in unstable layers, either coupled to or decoupled from the surface, and an explicit entrainment parameterization. The scheme is formulated in moist conserved variables so that it can treat both dry and cloudy layers. Details of the scheme and examples of its performance in single-column model tests are presented.}, Author = {Lock, AP and Brown, AR and Bush, MR and Martin, GM and Smith, RNB}, + Bdsk-File-1 = {YnBsaXN0MDDSAQIDBFxyZWxhdGl2ZVBhdGhZYWxpYXNEYXRhXxBALi4vLi4vQ2xvdWRTdGF0aW9uL2ZpcmxfbGlicmFyeS9maXJsX2xpYnJhcnlfZmlsZXMvTG9jay8yMDAwLnBkZk8RAcAAAAAAAcAAAgAADE1hY2ludG9zaCBIRAAAAAAAAAAAAAAAAAAAANHnJFJIKwAAACibewgyMDAwLnBkZgAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAKJuLywPrPAAAAAAAAAAAAAIABQAACSAAAAAAAAAAAAAAAAAAAAAETG9jawAQAAgAANHneLIAAAARAAgAAMsETawAAAABABgAKJt7AChslgAobIsAKGd7ABteBwACmFwAAgBaTWFjaW50b3NoIEhEOlVzZXJzOgBncmFudGY6AENsb3VkU3RhdGlvbjoAZmlybF9saWJyYXJ5OgBmaXJsX2xpYnJhcnlfZmlsZXM6AExvY2s6ADIwMDAucGRmAA4AEgAIADIAMAAwADAALgBwAGQAZgAPABoADABNAGEAYwBpAG4AdABvAHMAaAAgAEgARAASAEdVc2Vycy9ncmFudGYvQ2xvdWRTdGF0aW9uL2ZpcmxfbGlicmFyeS9maXJsX2xpYnJhcnlfZmlsZXMvTG9jay8yMDAwLnBkZgAAEwABLwAAFQACAA3//wAAAAgADQAaACQAZwAAAAAAAAIBAAAAAAAAAAUAAAAAAAAAAAAAAAAAAAIr}, Date-Added = {2016-05-20 17:15:36 +0000}, Date-Modified = {2016-05-20 17:15:36 +0000}, Isi = {000089461100008}, @@ -2520,13 +2611,13 @@ @article{lock_et_al_2000 Title = {A new boundary layer mixing scheme. {P}art {I}: Scheme description and single-column model tests}, Volume = {128}, Year = {2000}, - Bdsk-File-1 = {YnBsaXN0MDDSAQIDBFxyZWxhdGl2ZVBhdGhZYWxpYXNEYXRhXxBALi4vLi4vQ2xvdWRTdGF0aW9uL2ZpcmxfbGlicmFyeS9maXJsX2xpYnJhcnlfZmlsZXMvTG9jay8yMDAwLnBkZk8RAcAAAAAAAcAAAgAADE1hY2ludG9zaCBIRAAAAAAAAAAAAAAAAAAAANHnJFJIKwAAACibewgyMDAwLnBkZgAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAKJuLywPrPAAAAAAAAAAAAAIABQAACSAAAAAAAAAAAAAAAAAAAAAETG9jawAQAAgAANHneLIAAAARAAgAAMsETawAAAABABgAKJt7AChslgAobIsAKGd7ABteBwACmFwAAgBaTWFjaW50b3NoIEhEOlVzZXJzOgBncmFudGY6AENsb3VkU3RhdGlvbjoAZmlybF9saWJyYXJ5OgBmaXJsX2xpYnJhcnlfZmlsZXM6AExvY2s6ADIwMDAucGRmAA4AEgAIADIAMAAwADAALgBwAGQAZgAPABoADABNAGEAYwBpAG4AdABvAHMAaAAgAEgARAASAEdVc2Vycy9ncmFudGYvQ2xvdWRTdGF0aW9uL2ZpcmxfbGlicmFyeS9maXJsX2xpYnJhcnlfZmlsZXMvTG9jay8yMDAwLnBkZgAAEwABLwAAFQACAA3//wAAAAgADQAaACQAZwAAAAAAAAIBAAAAAAAAAAUAAAAAAAAAAAAAAAAAAAIr}, Bdsk-Url-1 = {http://ws.isiknowledge.com/cps/openurl/service?url_ver=Z39.88-2004&rft_id=info:ut/000089461100008}} @article{hong_and_pan_1996, Abstract = {Abstract In this paper, the incorporation of a simple atmospheric boundary layer diffusion scheme into the NCEP Medium-Range Forecast Model is described. A boundary layer diffusion package based on the Troen and Mahrt nonlocal diffusion concept has been tested for possible operational implementation. The results from this approach are compared with those from the local diffusion approach, which is the current operational scheme, and verified against FIFE observations during 9?10 August 1987. The comparisons between local and nonlocal approaches are extended to the forecast for a heavy rain case of 15?17 May 1995. The sensitivity of both the boundary layer development and the precipitation forecast to the tuning parameters in the nonlocal diffusion scheme is also investigated. Special attention is given to the interaction of boundary layer processes with precipitation physics. Some results of parallel runs during August 1995 are also presented.}, Annote = {doi: 10.1175/1520-0493(1996)124<2322:NBLVDI>2.0.CO;2}, Author = {Hong, Song-You and Pan, Hua-Lu}, + Bdsk-File-1 = {YnBsaXN0MDDSAQIDBFxyZWxhdGl2ZVBhdGhZYWxpYXNEYXRhXxBALi4vLi4vQ2xvdWRTdGF0aW9uL2ZpcmxfbGlicmFyeS9maXJsX2xpYnJhcnlfZmlsZXMvSG9uZy8xOTk2LnBkZk8RAcAAAAAAAcAAAgAADE1hY2ludG9zaCBIRAAAAAAAAAAAAAAAAAAAANHnJFJIKwAAAE18FggxOTk2LnBkZgAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAATXvY0pRb8QAAAAAAAAAAAAIABQAACSAAAAAAAAAAAAAAAAAAAAAESG9uZwAQAAgAANHneLIAAAARAAgAANKUvmEAAAABABgATXwWAChslgAobIsAKGd7ABteBwACmFwAAgBaTWFjaW50b3NoIEhEOlVzZXJzOgBncmFudGY6AENsb3VkU3RhdGlvbjoAZmlybF9saWJyYXJ5OgBmaXJsX2xpYnJhcnlfZmlsZXM6AEhvbmc6ADE5OTYucGRmAA4AEgAIADEAOQA5ADYALgBwAGQAZgAPABoADABNAGEAYwBpAG4AdABvAHMAaAAgAEgARAASAEdVc2Vycy9ncmFudGYvQ2xvdWRTdGF0aW9uL2ZpcmxfbGlicmFyeS9maXJsX2xpYnJhcnlfZmlsZXMvSG9uZy8xOTk2LnBkZgAAEwABLwAAFQACAA3//wAAAAgADQAaACQAZwAAAAAAAAIBAAAAAAAAAAUAAAAAAAAAAAAAAAAAAAIr}, Booktitle = {Monthly Weather Review}, Da = {1996/10/01}, Date = {1996/10/01}, @@ -2547,13 +2638,13 @@ @article{hong_and_pan_1996 Volume = {124}, Year = {1996}, Year1 = {1996}, - Bdsk-File-1 = {YnBsaXN0MDDSAQIDBFxyZWxhdGl2ZVBhdGhZYWxpYXNEYXRhXxBALi4vLi4vQ2xvdWRTdGF0aW9uL2ZpcmxfbGlicmFyeS9maXJsX2xpYnJhcnlfZmlsZXMvSG9uZy8xOTk2LnBkZk8RAcAAAAAAAcAAAgAADE1hY2ludG9zaCBIRAAAAAAAAAAAAAAAAAAAANHnJFJIKwAAAE18FggxOTk2LnBkZgAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAATXvY0pRb8QAAAAAAAAAAAAIABQAACSAAAAAAAAAAAAAAAAAAAAAESG9uZwAQAAgAANHneLIAAAARAAgAANKUvmEAAAABABgATXwWAChslgAobIsAKGd7ABteBwACmFwAAgBaTWFjaW50b3NoIEhEOlVzZXJzOgBncmFudGY6AENsb3VkU3RhdGlvbjoAZmlybF9saWJyYXJ5OgBmaXJsX2xpYnJhcnlfZmlsZXM6AEhvbmc6ADE5OTYucGRmAA4AEgAIADEAOQA5ADYALgBwAGQAZgAPABoADABNAGEAYwBpAG4AdABvAHMAaAAgAEgARAASAEdVc2Vycy9ncmFudGYvQ2xvdWRTdGF0aW9uL2ZpcmxfbGlicmFyeS9maXJsX2xpYnJhcnlfZmlsZXMvSG9uZy8xOTk2LnBkZgAAEwABLwAAFQACAA3//wAAAAgADQAaACQAZwAAAAAAAAIBAAAAAAAAAAUAAAAAAAAAAAAAAAAAAAIr}, Bdsk-Url-1 = {http://dx.doi.org/10.1175/1520-0493(1996)124%3C2322:NBLVDI%3E2.0.CO;2}} @article{han_and_pan_2006, Abstract = {Abstract A parameterization of the convection-induced pressure gradient force (PGF) in convective momentum transport (CMT) is tested for hurricane intensity forecasting using NCEP's operational Global Forecast System (GFS) and its nested Regional Spectral Model (RSM). In the parameterization the PGF is assumed to be proportional to the product of the cloud mass flux and vertical wind shear. Compared to control forecasts using the present operational GFS and RSM where the PGF effect in CMT is taken into account empirically, the new PGF parameterization helps increase hurricane intensity by reducing the vertical momentum exchange, giving rise to a closer comparison to the observations. In addition, the new PGF parameterization forecasts not only show more realistically organized precipitation patterns with enhanced hurricane intensity but also reduce the forecast track error. Nevertheless, the model forecasts with the new PGF parameterization still largely underpredict the observed intensity. One of the many possible reasons for the large underprediction may be the absence of hurricane initialization in the models.}, Annote = {doi: 10.1175/MWR3090.1}, Author = {Han, Jongil and Pan, Hua-Lu}, + Bdsk-File-1 = {YnBsaXN0MDDSAQIDBFxyZWxhdGl2ZVBhdGhZYWxpYXNEYXRhXxA/Li4vLi4vQ2xvdWRTdGF0aW9uL2ZpcmxfbGlicmFyeS9maXJsX2xpYnJhcnlfZmlsZXMvSGFuLzIwMDYucGRmTxEBvgAAAAABvgACAAAMTWFjaW50b3NoIEhEAAAAAAAAAAAAAAAAAAAA0eckUkgrAAAAWsT5CDIwMDYucGRmAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAABazFjStCvVAAAAAAAAAAAAAgAFAAAJIAAAAAAAAAAAAAAAAAAAAANIYW4AABAACAAA0ed4sgAAABEACAAA0rSORQAAAAEAGABaxPkAKGyWAChsiwAoZ3sAG14HAAKYXAACAFlNYWNpbnRvc2ggSEQ6VXNlcnM6AGdyYW50ZjoAQ2xvdWRTdGF0aW9uOgBmaXJsX2xpYnJhcnk6AGZpcmxfbGlicmFyeV9maWxlczoASGFuOgAyMDA2LnBkZgAADgASAAgAMgAwADAANgAuAHAAZABmAA8AGgAMAE0AYQBjAGkAbgB0AG8AcwBoACAASABEABIARlVzZXJzL2dyYW50Zi9DbG91ZFN0YXRpb24vZmlybF9saWJyYXJ5L2ZpcmxfbGlicmFyeV9maWxlcy9IYW4vMjAwNi5wZGYAEwABLwAAFQACAA3//wAAAAgADQAaACQAZgAAAAAAAAIBAAAAAAAAAAUAAAAAAAAAAAAAAAAAAAIo}, Booktitle = {Monthly Weather Review}, Da = {2006/02/01}, Date-Added = {2016-05-20 17:11:17 +0000}, @@ -2572,11 +2663,11 @@ @article{han_and_pan_2006 Url = {http://dx.doi.org/10.1175/MWR3090.1}, Volume = {134}, Year = {2006}, - Bdsk-File-1 = {YnBsaXN0MDDSAQIDBFxyZWxhdGl2ZVBhdGhZYWxpYXNEYXRhXxA/Li4vLi4vQ2xvdWRTdGF0aW9uL2ZpcmxfbGlicmFyeS9maXJsX2xpYnJhcnlfZmlsZXMvSGFuLzIwMDYucGRmTxEBvgAAAAABvgACAAAMTWFjaW50b3NoIEhEAAAAAAAAAAAAAAAAAAAA0eckUkgrAAAAWsT5CDIwMDYucGRmAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAABazFjStCvVAAAAAAAAAAAAAgAFAAAJIAAAAAAAAAAAAAAAAAAAAANIYW4AABAACAAA0ed4sgAAABEACAAA0rSORQAAAAEAGABaxPkAKGyWAChsiwAoZ3sAG14HAAKYXAACAFlNYWNpbnRvc2ggSEQ6VXNlcnM6AGdyYW50ZjoAQ2xvdWRTdGF0aW9uOgBmaXJsX2xpYnJhcnk6AGZpcmxfbGlicmFyeV9maWxlczoASGFuOgAyMDA2LnBkZgAADgASAAgAMgAwADAANgAuAHAAZABmAA8AGgAMAE0AYQBjAGkAbgB0AG8AcwBoACAASABEABIARlVzZXJzL2dyYW50Zi9DbG91ZFN0YXRpb24vZmlybF9saWJyYXJ5L2ZpcmxfbGlicmFyeV9maWxlcy9IYW4vMjAwNi5wZGYAEwABLwAAFQACAA3//wAAAAgADQAaACQAZgAAAAAAAAIBAAAAAAAAAAUAAAAAAAAAAAAAAAAAAAIo}, Bdsk-Url-1 = {http://dx.doi.org/10.1175/MWR3090.1}} @article{businger_et_al_1971, Author = {Businger, JA and Wyngaard, JC and Izumi, Y and Bradley, EF}, + Bdsk-File-1 = {YnBsaXN0MDDSAQIDBFxyZWxhdGl2ZVBhdGhZYWxpYXNEYXRhXxBELi4vLi4vQ2xvdWRTdGF0aW9uL2ZpcmxfbGlicmFyeS9maXJsX2xpYnJhcnlfZmlsZXMvQnVzaW5nZXIvMTk3MS5wZGZPEQHMAAAAAAHMAAIAAAxNYWNpbnRvc2ggSEQAAAAAAAAAAAAAAAAAAADR5yRSSCsAAAAodUUIMTk3MS5wZGYAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACh1cbTPIxwAAAAAAAAAAAACAAUAAAkgAAAAAAAAAAAAAAAAAAAACEJ1c2luZ2VyABAACAAA0ed4sgAAABEACAAAtM+FjAAAAAEAGAAodUUAKGyWAChsiwAoZ3sAG14HAAKYXAACAF5NYWNpbnRvc2ggSEQ6VXNlcnM6AGdyYW50ZjoAQ2xvdWRTdGF0aW9uOgBmaXJsX2xpYnJhcnk6AGZpcmxfbGlicmFyeV9maWxlczoAQnVzaW5nZXI6ADE5NzEucGRmAA4AEgAIADEAOQA3ADEALgBwAGQAZgAPABoADABNAGEAYwBpAG4AdABvAHMAaAAgAEgARAASAEtVc2Vycy9ncmFudGYvQ2xvdWRTdGF0aW9uL2ZpcmxfbGlicmFyeS9maXJsX2xpYnJhcnlfZmlsZXMvQnVzaW5nZXIvMTk3MS5wZGYAABMAAS8AABUAAgAN//8AAAAIAA0AGgAkAGsAAAAAAAACAQAAAAAAAAAFAAAAAAAAAAAAAAAAAAACOw==}, Date-Added = {2016-05-20 17:10:50 +0000}, Date-Modified = {2018-07-18 18:58:08 +0000}, Isi = {A1971I822800004}, @@ -2589,7 +2680,6 @@ @article{businger_et_al_1971 Title = {Flux-profile relationships in the atmospheric surface layer}, Volume = {28}, Year = {1971}, - Bdsk-File-1 = {YnBsaXN0MDDSAQIDBFxyZWxhdGl2ZVBhdGhZYWxpYXNEYXRhXxBELi4vLi4vQ2xvdWRTdGF0aW9uL2ZpcmxfbGlicmFyeS9maXJsX2xpYnJhcnlfZmlsZXMvQnVzaW5nZXIvMTk3MS5wZGZPEQHMAAAAAAHMAAIAAAxNYWNpbnRvc2ggSEQAAAAAAAAAAAAAAAAAAADR5yRSSCsAAAAodUUIMTk3MS5wZGYAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACh1cbTPIxwAAAAAAAAAAAACAAUAAAkgAAAAAAAAAAAAAAAAAAAACEJ1c2luZ2VyABAACAAA0ed4sgAAABEACAAAtM+FjAAAAAEAGAAodUUAKGyWAChsiwAoZ3sAG14HAAKYXAACAF5NYWNpbnRvc2ggSEQ6VXNlcnM6AGdyYW50ZjoAQ2xvdWRTdGF0aW9uOgBmaXJsX2xpYnJhcnk6AGZpcmxfbGlicmFyeV9maWxlczoAQnVzaW5nZXI6ADE5NzEucGRmAA4AEgAIADEAOQA3ADEALgBwAGQAZgAPABoADABNAGEAYwBpAG4AdABvAHMAaAAgAEgARAASAEtVc2Vycy9ncmFudGYvQ2xvdWRTdGF0aW9uL2ZpcmxfbGlicmFyeS9maXJsX2xpYnJhcnlfZmlsZXMvQnVzaW5nZXIvMTk3MS5wZGYAABMAAS8AABUAAgAN//8AAAAIAA0AGgAkAGsAAAAAAAACAQAAAAAAAAAFAAAAAAAAAAAAAAAAAAACOw==}, Bdsk-Url-1 = {http://ws.isiknowledge.com/cps/openurl/service?url_ver=Z39.88-2004&rft_id=info:ut/A1971I822800004}} @article{xu_and_randall_1996, @@ -2780,17 +2870,18 @@ @article{kim_and_arakawa_1995 @techreport{hou_et_al_2002, Author = {Y. Hou and S. Moorthi and K. Campana}, + Bdsk-File-1 = {YnBsaXN0MDDSAQIDBFxyZWxhdGl2ZVBhdGhZYWxpYXNEYXRhXxAiLi4vLi4vemhhbmctbGliL2hvdV9ldF9hbF8yMDAyLnBkZk8RAdwAAAAAAdwAAgAADE1hY2ludG9zaCBIRAAAAAAAAAAAAAAAAAAAAM/T1mZIKwAAAFKkjRJob3VfZXRfYWxfMjAwMi5wZGYAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAUqai02OGCgAAAAAAAAAAAAIAAgAACSAAAAAAAAAAAAAAAAAAAAAJemhhbmctbGliAAAQAAgAAM/UKsYAAAARAAgAANNj2moAAAABABgAUqSNAE1lSgAj19QACTbFAAk2xAACZvkAAgBbTWFjaW50b3NoIEhEOlVzZXJzOgBtYW56aGFuZzoARG9jdW1lbnRzOgBNYW4uWmhhbmc6AGdtdGItZG9jOgB6aGFuZy1saWI6AGhvdV9ldF9hbF8yMDAyLnBkZgAADgAmABIAaABvAHUAXwBlAHQAXwBhAGwAXwAyADAAMAAyAC4AcABkAGYADwAaAAwATQBhAGMAaQBuAHQAbwBzAGgAIABIAEQAEgBIVXNlcnMvbWFuemhhbmcvRG9jdW1lbnRzL01hbi5aaGFuZy9nbXRiLWRvYy96aGFuZy1saWIvaG91X2V0X2FsXzIwMDIucGRmABMAAS8AABUAAgAP//8AAAAIAA0AGgAkAEkAAAAAAAACAQAAAAAAAAAFAAAAAAAAAAAAAAAAAAACKQ==}, Date-Added = {2016-05-19 19:52:22 +0000}, Date-Modified = {2016-05-20 15:14:59 +0000}, Institution = {NCEP}, Number = {441}, Title = {Parameterization of Solar Radiation Transfer}, Type = {office note}, - Year = {2002}, - Bdsk-File-1 = {YnBsaXN0MDDSAQIDBFxyZWxhdGl2ZVBhdGhZYWxpYXNEYXRhXxAiLi4vLi4vemhhbmctbGliL2hvdV9ldF9hbF8yMDAyLnBkZk8RAdwAAAAAAdwAAgAADE1hY2ludG9zaCBIRAAAAAAAAAAAAAAAAAAAAM/T1mZIKwAAAFKkjRJob3VfZXRfYWxfMjAwMi5wZGYAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAUqai02OGCgAAAAAAAAAAAAIAAgAACSAAAAAAAAAAAAAAAAAAAAAJemhhbmctbGliAAAQAAgAAM/UKsYAAAARAAgAANNj2moAAAABABgAUqSNAE1lSgAj19QACTbFAAk2xAACZvkAAgBbTWFjaW50b3NoIEhEOlVzZXJzOgBtYW56aGFuZzoARG9jdW1lbnRzOgBNYW4uWmhhbmc6AGdtdGItZG9jOgB6aGFuZy1saWI6AGhvdV9ldF9hbF8yMDAyLnBkZgAADgAmABIAaABvAHUAXwBlAHQAXwBhAGwAXwAyADAAMAAyAC4AcABkAGYADwAaAAwATQBhAGMAaQBuAHQAbwBzAGgAIABIAEQAEgBIVXNlcnMvbWFuemhhbmcvRG9jdW1lbnRzL01hbi5aaGFuZy9nbXRiLWRvYy96aGFuZy1saWIvaG91X2V0X2FsXzIwMDIucGRmABMAAS8AABUAAgAP//8AAAAIAA0AGgAkAEkAAAAAAAACAQAAAAAAAAAFAAAAAAAAAAAAAAAAAAACKQ==}} + Year = {2002}} @article{hu_and_stamnes_1993, Author = {Y.X. Hu and K. Stamnes}, + Bdsk-File-1 = {YnBsaXN0MDDSAQIDBFxyZWxhdGl2ZVBhdGhZYWxpYXNEYXRhXxAnLi4vLi4vemhhbmctbGliL2h1X2FuZF9zdGFtbmVzXzE5OTMucGRmTxEB8AAAAAAB8AACAAAMTWFjaW50b3NoIEhEAAAAAAAAAAAAAAAAAAAAz9PWZkgrAAAAUqSNF2h1X2FuZF9zdGFtbmVzXzE5OTMucGRmAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAABSpJHTY3R+AAAAAAAAAAAAAgACAAAJIAAAAAAAAAAAAAAAAAAAAAl6aGFuZy1saWIAABAACAAAz9QqxgAAABEACAAA02PI3gAAAAEAGABSpI0ATWVKACPX1AAJNsUACTbEAAJm+QACAGBNYWNpbnRvc2ggSEQ6VXNlcnM6AG1hbnpoYW5nOgBEb2N1bWVudHM6AE1hbi5aaGFuZzoAZ210Yi1kb2M6AHpoYW5nLWxpYjoAaHVfYW5kX3N0YW1uZXNfMTk5My5wZGYADgAwABcAaAB1AF8AYQBuAGQAXwBzAHQAYQBtAG4AZQBzAF8AMQA5ADkAMwAuAHAAZABmAA8AGgAMAE0AYQBjAGkAbgB0AG8AcwBoACAASABEABIATVVzZXJzL21hbnpoYW5nL0RvY3VtZW50cy9NYW4uWmhhbmcvZ210Yi1kb2MvemhhbmctbGliL2h1X2FuZF9zdGFtbmVzXzE5OTMucGRmAAATAAEvAAAVAAIAD///AAAACAANABoAJABOAAAAAAAAAgEAAAAAAAAABQAAAAAAAAAAAAAAAAAAAkI=}, Date-Added = {2016-05-19 19:31:56 +0000}, Date-Modified = {2016-05-20 15:13:12 +0000}, Journal = {J. Climate}, @@ -2798,5 +2889,276 @@ @article{hu_and_stamnes_1993 Pages = {728-742}, Title = {An accurate parameterization of the radiative properties of water clouds suitable for use in climate models}, Volume = {6}, - Year = {1993}, - Bdsk-File-1 = {YnBsaXN0MDDSAQIDBFxyZWxhdGl2ZVBhdGhZYWxpYXNEYXRhXxAnLi4vLi4vemhhbmctbGliL2h1X2FuZF9zdGFtbmVzXzE5OTMucGRmTxEB8AAAAAAB8AACAAAMTWFjaW50b3NoIEhEAAAAAAAAAAAAAAAAAAAAz9PWZkgrAAAAUqSNF2h1X2FuZF9zdGFtbmVzXzE5OTMucGRmAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAABSpJHTY3R+AAAAAAAAAAAAAgACAAAJIAAAAAAAAAAAAAAAAAAAAAl6aGFuZy1saWIAABAACAAAz9QqxgAAABEACAAA02PI3gAAAAEAGABSpI0ATWVKACPX1AAJNsUACTbEAAJm+QACAGBNYWNpbnRvc2ggSEQ6VXNlcnM6AG1hbnpoYW5nOgBEb2N1bWVudHM6AE1hbi5aaGFuZzoAZ210Yi1kb2M6AHpoYW5nLWxpYjoAaHVfYW5kX3N0YW1uZXNfMTk5My5wZGYADgAwABcAaAB1AF8AYQBuAGQAXwBzAHQAYQBtAG4AZQBzAF8AMQA5ADkAMwAuAHAAZABmAA8AGgAMAE0AYQBjAGkAbgB0AG8AcwBoACAASABEABIATVVzZXJzL21hbnpoYW5nL0RvY3VtZW50cy9NYW4uWmhhbmcvZ210Yi1kb2MvemhhbmctbGliL2h1X2FuZF9zdGFtbmVzXzE5OTMucGRmAAATAAEvAAAVAAIAD///AAAACAANABoAJABOAAAAAAAAAgEAAAAAAAAABQAAAAAAAAAAAAAAAAAAAkI=}} + Year = {1993}} + +@article{alexander_et_al_2010, + author = {Alexander, M. J. and Geller, M. and McLandress, C. and Polavarapu, S. and Preusse, P. and Sassi, F. and Sato, K. and Eckermann, S. and Ern, M. and Hertzog, A. and Kawatani, Y. and Pulido, M. and Shaw, T. A. and Sigmond, M. and Vincent, R. and Watanabe, S.}, + title = {Recent developments in gravity-wave effects in climate models and the global distribution of gravity-wave momentum flux from observations and models}, + journal = {Quarterly Journal of the Royal Meteorological Society}, + volume = {136}, + number = {650}, + pages = {1103-1124}, + keywords = {atmosphere, gravity wave, momentum flux, drag, force, wind tendency, climate, global model}, + doi = {10.1002/qj.637}, + url = {https://rmets.onlinelibrary.wiley.com/doi/abs/10.1002/qj.637}, + eprint = {https://rmets.onlinelibrary.wiley.com/doi/pdf/10.1002/qj.637}, + year = {2010}} + +@article{plougonven_and_zhang_2014, + author = {Plougonven, R. and Zhang, F.}, + title = {Internal gravity waves from atmospheric jets and fronts}, + journal = {Reviews of Geophysics}, + volume = {52}, + number = {1}, + pages = {33-76}, + keywords = {gravity waves, stratosphere, atmosphere, jets, fronts, weather}, + doi = {10.1002/2012RG000419}, + url = {https://agupubs.onlinelibrary.wiley.com/doi/abs/10.1002/2012RG000419}, + eprint = {https://agupubs.onlinelibrary.wiley.com/doi/pdf/10.1002/2012RG000419}, + year = {2014}} + +@article{weinstock_1984, + author = {Weinstock, J.}, + title = {Simplified derivation of an algorithm for nonlinear gravity waves}, + journal = {Journal of Geophysical Research: Space Physics}, + volume = {89}, + number = {A1}, + pages = {345-350}, + doi = {10.1029/JA089iA01p00345}, + url = {https://agupubs.onlinelibrary.wiley.com/doi/abs/10.1029/JA089iA01p00345}, + eprint = {https://agupubs.onlinelibrary.wiley.com/doi/pdf/10.1029/JA089iA01p00345}, + year = {1984}} + +@article{holton_1983, + author = {Holton, James R.}, + title = {The Influence of Gravity Wave Breaking on the General Circulation of the Middle Atmosphere}, + journal = {Journal of the Atmospheric Sciences}, + volume = {40}, + number = {10}, + pages = {2497-2507}, + year = {1983}, + doi = {10.1175/1520-0469(1983)040<2497:TIOGWB>2.0.CO;2}, + URL = {https://doi.org/10.1175/1520-0469(1983)040<2497:TIOGWB>2.0.CO;2}, + eprint = {https://doi.org/10.1175/1520-0469(1983)040<2497:TIOGWB>2.0.CO;2}} + +@article{geller_et_al_2013, + author = {Geller, M. A. and Alexander, M. Joan and Love, P. T. and Bacmeister, J. and Ern, M. and Hertzog, A. and Manzini, E. and Preusse, P. and Sato, K. and Scaife, A. A. and Zhou, T.}, + title = {A Comparison between Gravity Wave Momentum Fluxes in Observations and Climate Models}, + journal = {Journal of Climate}, + volume = {26}, + number = {17}, + pages = {6383-6405}, + year = {2013}, + doi = {10.1175/JCLI-D-12-00545.1}, + URL = {https://doi.org/10.1175/JCLI-D-12-00545.1}, + eprint = {https://doi.org/10.1175/JCLI-D-12-00545.1}} + +@article{garcia_et_al_2017, + author = {Garcia, R. R. and Smith, A. K. and Kinnison, D. E. and Cámara, Á. and Murphy, D. J.}, + title = {Modification of the Gravity Wave Parameterization in the Whole Atmosphere Community Climate Model: Motivation and Results}, + journal = {Journal of the Atmospheric Sciences}, + volume = {74}, + number = {1}, + pages = {275-291}, + year = {2017}, + doi = {10.1175/JAS-D-16-0104.1}, + URL = {https://doi.org/10.1175/JAS-D-16-0104.1}, + eprint = {https://doi.org/10.1175/JAS-D-16-0104.1}} + +@inproceedings{yudin_et_al_2016, + title={Gravity wave physics in the NOAA Environmental Modeling System}, + author={Yudin, V.A. and Akmaev, R.A. and Fuller-Rowell, T.J. and Alpert, J.C.}, + booktitle={International SPARC Gravity Wave Symposium}, + volume={48}, + number={1}, + pages={012024}, + year={2016}, + organization={}} + +@inproceedings{alpert_et_al_2018, + title={Integrating Unified Gravity Wave Physics Research into the Next Generation Global Prediction System for NCEP Research to Operations}, + author={Alpert, Jordan C and Yudin, Valery and Fuller-Rowell, Tim and Akmaev, Rashid A}, + booktitle={98th American Meteorological Society Annual Meeting}, + year={2018}, + organization={AMS}} + +@article{eckermann_2011, + author = {Eckermann, Stephen D.}, + title = {Explicitly Stochastic Parameterization of Nonorographic Gravity Wave Drag}, + journal = {Journal of the Atmospheric Sciences}, + volume = {68}, + number = {8}, + pages = {1749-1765}, + year = {2011}, + doi = {10.1175/2011JAS3684.1}, + URL = {https://doi.org/10.1175/2011JAS3684.1}, + eprint = {https://doi.org/10.1175/2011JAS3684.1}} + +@article{lott_et_al_2012, + author = {Lott, F. and Guez, L. and Maury, P.}, + title = {A stochastic parameterization of non-orographic gravity waves: Formalism and impact on the equatorial stratosphere}, + journal = {Geophysical Research Letters}, + volume = {39}, + number = {6}, + pages = {}, + keywords = {Quasi-Biennial Oscillation, Rossby-gravity waves, gravity waves, stochastic parameterization, stratospheric dynamics}, + doi = {10.1029/2012GL051001}, + url = {https://agupubs.onlinelibrary.wiley.com/doi/abs/10.1029/2012GL051001}, + eprint = {https://agupubs.onlinelibrary.wiley.com/doi/pdf/10.1029/2012GL051001}, + year = {2012}} + +@conference{yudin_et_al_2018, + author = {Yudin, V. A and Akmaev, R. A. and Alpert, J. C. and Fuller-Rowell T. J., and Karol S. I.}, + Booktitle = {25th Conference on Numerical Weather Prediction}, + Date-Added = {2018-06-04 10:50:44 -0600}, + Date-Modified = {2018-06-04 10:54:39 -0600}, + Editor = {Am. Meteorol. Soc.}, + Title = {Gravity Wave Physics and Dynamics in the FV3-based Atmosphere Models Extended into the Mesosphere}, + Year = {2018}} + +@article{hines_1997, + title = "Doppler-spread parameterization of gravity-wave momentum deposition in the middle atmosphere. Part 2: Broad and quasi monochromatic spectra, and implementation", + journal = "Journal of Atmospheric and Solar-Terrestrial Physics", + volume = "59", + number = "4", + pages = "387 - 400", + year = "1997", + issn = "1364-6826", + doi = "https://doi.org/10.1016/S1364-6826(96)00080-6", + url = "http://www.sciencedirect.com/science/article/pii/S1364682696000806", + author = "Colin O. Hines"} + +@article{alexander_and_dunkerton_1999, + author = {Alexander, M. J. and Dunkerton, T. J.}, + title = {A Spectral Parameterization of Mean-Flow Forcing due to Breaking Gravity Waves}, + journal = {Journal of the Atmospheric Sciences}, + volume = {56}, + number = {24}, + pages = {4167-4182}, + year = {1999}, + doi = {10.1175/1520-0469(1999)056<4167:ASPOMF>2.0.CO;2}, + URL = {https://doi.org/10.1175/1520-0469(1999)056<4167:ASPOMF>2.0.CO;2}, + eprint = {https://doi.org/10.1175/1520-0469(1999)056<4167:ASPOMF>2.0.CO;2}} + +@article{scinocca_2003, + author = {Scinocca, John F.}, + title = {An Accurate Spectral Nonorographic Gravity Wave Drag Parameterization for General Circulation Models}, + journal = {Journal of the Atmospheric Sciences}, + volume = {60}, + number = {4}, + pages = {667-682}, + year = {2003}, + doi = {10.1175/1520-0469(2003)060<0667:AASNGW>2.0.CO;2}, + URL = {https://doi.org/10.1175/1520-0469(2003)060<0667:AASNGW>2.0.CO;2}, + eprint = {https://doi.org/10.1175/1520-0469(2003)060<0667:AASNGW>2.0.CO;2}} + +@article{shaw_and_shepherd_2009, + author = {Shaw, Tiffany A. and Shepherd, Theodore G.}, + title = {A Theoretical Framework for Energy and Momentum Consistency in Subgrid-Scale Parameterization for Climate Models}, + journal = {Journal of the Atmospheric Sciences}, + volume = {66}, + number = {10}, + pages = {3095-3114}, + year = {2009}, + doi = {10.1175/2009JAS3051.1}, + URL = {https://doi.org/10.1175/2009JAS3051.1}, + eprint = {https://doi.org/10.1175/2009JAS3051.1}} + +@Article{molod_et_al_2015, + AUTHOR = {Molod, A. and Takacs, L. and Suarez, M. and Bacmeister, J.}, + TITLE = {Development of the GEOS-5 atmospheric general circulation model: evolution from MERRA to MERRA2}, + JOURNAL = {Geoscientific Model Development}, + VOLUME = {8}, + YEAR = {2015}, + NUMBER = {5}, + PAGES = {1339--1356}, + URL = {https://www.geosci-model-dev.net/8/1339/2015/}, + DOI = {10.5194/gmd-8-1339-2015}} + +@article{richter_et_al_2010, + author = {Richter, Jadwiga H. and Sassi, Fabrizio and Garcia, Rolando R.}, + title = {Toward a Physically Based Gravity Wave Source Parameterization in a General Circulation Model}, + journal = {Journal of the Atmospheric Sciences}, + volume = {67}, + number = {1}, + pages = {136-156}, + year = {2010}, + doi = {10.1175/2009JAS3112.1}, + URL = {https://doi.org/10.1175/2009JAS3112.1}, + eprint = {https://doi.org/10.1175/2009JAS3112.1}} + +@article{richter_et_al_2014, + author = {Richter, Jadwiga H. and Solomon, Abraham and Bacmeister, Julio T.}, + title = {Effects of vertical resolution and nonorographic gravity wave drag on the simulated climate in the Community Atmosphere Model, version 5}, + journal = {Journal of Advances in Modeling Earth Systems}, + volume = {6}, + number = {2}, + pages = {357-383}, + keywords = {climate modeling, vertical resolution, modeling, climate, global circulation model, general circulation model}, + doi = {10.1002/2013MS000303}, + url = {https://agupubs.onlinelibrary.wiley.com/doi/abs/10.1002/2013MS000303}, + eprint = {https://agupubs.onlinelibrary.wiley.com/doi/pdf/10.1002/2013MS000303}, + year = {2014}} + +@article{gelaro_et_al_2017, + author = {Gelaro, et al.}, + title = {The Modern-Era Retrospective Analysis for Research and Applications, Version 2 (MERRA-2)}, + journal = {Journal of Climate}, + volume = {30}, + number = {14}, + pages = {5419-5454}, + year = {2017}, + doi = {10.1175/JCLI-D-16-0758.1}, + URL = {https://doi.org/10.1175/JCLI-D-16-0758.1}, + eprint = {https://doi.org/10.1175/JCLI-D-16-0758.1}} + +@article{garcia_et_al_2007, + author = {Garcia, R. R. and Marsh, D. R. and Kinnison, D. E. and Boville, B. A. and Sassi, F.}, + title = {Simulation of secular trends in the middle atmosphere, 1950–2003}, + journal = {Journal of Geophysical Research: Atmospheres}, + volume = {112}, + number = {D9}, + pages = {}, + keywords = {global change, ozone depletion, water vapor trends, temperature trends}, + doi = {10.1029/2006JD007485}, + url = {https://agupubs.onlinelibrary.wiley.com/doi/abs/10.1029/2006JD007485}, + eprint = {https://agupubs.onlinelibrary.wiley.com/doi/pdf/10.1029/2006JD007485}, + year = {2007}} + +@article{eckermann_et_al_2009, + title = "High-altitude data assimilation system experiments for the northern summer mesosphere season of 2007", + journal = "Journal of Atmospheric and Solar-Terrestrial Physics", + volume = "71", + number = "3", + pages = "531 - 551", + year = "2009", + note = "Global Perspectives on the Aeronomy of the Summer Mesopause Region", + issn = "1364-6826", + doi = "https://doi.org/10.1016/j.jastp.2008.09.036", + url = "http://www.sciencedirect.com/science/article/pii/S1364682608002575", + author = "Stephen D. Eckermann and Karl W. Hoppel and Lawrence Coy and John P. McCormack and David E. Siskind and Kim Nielsen and Andrew Kochenash and Michael H. Stevens and Christoph R. Englert and Werner Singer and Mark Hervig", + keywords = "Data assimilation, Polar mesospheric cloud, Tide, Planetary wave, Mesosphere",} + +@inproceedings{alpert_et_al_2019, + title={Atmospheric Gravity Wave Sources Correlated with Resolved-scale GW Activity and Sub-grid Scale Parameterization in the FV3gfs Model}, + author={Alpert, Jordan C and Yudin, Valery A and Strobach, Edward}, + booktitle={AGU Fall Meeting 2019}, + year={2019}, + organization={AGU}} + +@Article{ern_et_al_2018, + AUTHOR = {Ern, M. and Trinh, Q. T. and Preusse, P. and Gille, J. C. and Mlynczak, M. G. and Russell III, J. M. and Riese, M.}, + TITLE = {GRACILE: a comprehensive climatology of atmospheric gravity wave parameters based on satellite limb soundings}, + JOURNAL = {Earth System Science Data}, + VOLUME = {10}, + YEAR = {2018}, + NUMBER = {2}, + PAGES = {857--892}, + URL = {https://www.earth-syst-sci-data.net/10/857/2018/}, + DOI = {10.5194/essd-10-857-2018}} + +@inproceedings{yudin_et_al_2019, + title={Longitudinal Variability of Wave Dynamics in Weather Models Extended into the Mesosphere and Thermosphere}, + author={Yudin V.A. , S. I. Karol, R.A. Akmaev, T. Fuller-Rowell, D. Kleist, A. Kubaryk, and C. Thompson}, + booktitle={Space Weather Workshop}, + year={2019},} diff --git a/physics/docs/pdftxt/CPT_CSAW.txt b/physics/docs/pdftxt/CPT_CSAW.txt index 09b81fa10..723e65b20 100644 --- a/physics/docs/pdftxt/CPT_CSAW.txt +++ b/physics/docs/pdftxt/CPT_CSAW.txt @@ -1,13 +1,14 @@ /** -\page CSAW_scheme CPT Scale-Aware Chikira-Sugiyama Scale-aware Convection Scheme with Arakawa-Wu Extension +\page CSAW_scheme Chikira-Sugiyama Scale-Aware Convection Scheme with Arakawa-Wu Extension \section cs_descrip Description -Chikira-Sugiyama cumulus scheme (Chikira and Sugiyama (2010) \cite Chikira_2010) with prognostic closure and +The Chikira-Sugiyama cumulus scheme (Chikira and Sugiyama (2010) \cite Chikira_2010) with prognostic closure and Arakawa-Wu Scale-Aware extension \cite Arakawa_2013 is an offshoot of the prognostic Arakawa-Schubert scheme. -It is characterized by lateral entrainment rates that vertically varies depending on buoyancy and vertical -velocity of updraft air parcel following Gregory (2001) \cite Gregory_2001 and spectral representation of -cloud types according to updraft velocity at cloud base. Cloud base mass flux is determined by convective -kinetic energy closure. The entrainment rate tends to be large near cloud base because of the small updraft +It is characterized by a spectral representation of cloud types according to updraft velocity at cloud base, a level +at which the mass flux is determined by a convective kinetic energy closure. The +lateral entrainment rate vertically varies depending on the buoyancy and vertical +velocity of the updraft air parcel following Gregory (2001) \cite Gregory_2001 . + The entrainment rate tends to be large near cloud base because of the small updraft velocity near that level. Deep convection tends to be suppressed when convective available potential energy is small because of upward reduction of in-cloud moist static energy. Dry environment air significantly reduces in-cloud humidity mainly because of the large entrainment rate in the lower troposphere, which leads to suppression diff --git a/physics/docs/pdftxt/CPT_MG3.txt b/physics/docs/pdftxt/CPT_MG3.txt index 04d5d0a33..3dc3fece4 100644 --- a/physics/docs/pdftxt/CPT_MG3.txt +++ b/physics/docs/pdftxt/CPT_MG3.txt @@ -1,9 +1,8 @@ /** -\page CPT_MG3 CPT MG3 Cloud Microphysics Scheme +\page CPT_MG3 Morrison-Gettelman Cloud Microphysics Scheme \section des_MG3_cloud Description -MG3 microphysics (MP) scheme is a six-category double momentum bulk scheme. It forecasts mass of ten -hydrometeors (cloud water, cloud ice, rain, snow and graupel) and their number concentrations in addition to mass of water vapor. -Physics processes of MG3 cloud MP are described in Figure 1. +The Morrison-Gettelman Version 3 (MG3) microphysics scheme is a six-category double momentum bulk scheme. It forecasts mass +and number concentration of five hydrometeors (cloud water, cloud ice, rain, snow and graupel) in addition to mass of water vapor. # Morrison Gettelman Advancements - MG1: Morrison and Gettelman (2008) \cite Morrison_2008 (CESM1, CAM5) @@ -13,33 +12,28 @@ Physics processes of MG3 cloud MP are described in Figure 1. - MG2: Gettelman and Morrison (2015) \cite Gettelman_2015_1 \cite Gettelman_2015_2 (CESM2, CAM6) - Prognostic precipitation (rain and snow) - Sub-stepping and sub-column capable -- MG3: Gettelman et al. 2019 (accepted by JAMES) - - Rimed hydrometeors (graupel or hail) are added to stratiform cloud scheme for global models. - - Global climate impacts are limited to small increased in ice mass. - - High (14 km) resolution similations show local production of rimed ice (graupel) can affect regional precipitation amounts and intensity. +- MG3: Gettelman et al. (2019) \cite Gettelman_et_al_2019 + - Rimed hydrometeors (graupel or hail) are added to stratiform cloud scheme for global models + - Global climate impacts are limited to small increased in ice mass + - High (14 km) resolution simulations show local production of rimed ice (graupel) can affect regional +precipitation amounts and intensity A schematic of the MG3 scheme is shown in Figure 1. MG3 starts with MG2 \cite Gettelman_2015_1 \cite Gettelman_2015_2 and adds a series of processes (in red). One rimed hydrometeor category is added. Both mass and number are prognosed. Rimed ice has the -"character" of hail or graupel by pre-selecting density and fall speed paramters. +"character" of hail or graupel by pre-selecting density and fall speed parameters. \image html MG3_MP_diagram.png "Figure 1: A schematic of the MG3 scheme (Courtesy of A. Gettleman )" width=10cm - - Some unique attributes of MG3 cloud microphysics include: -# Consistent treatment of cloud fraction in cloud macrophysics and radiation -# Subgrid-scale microphysics --# Max-overlap and in-cloud precipitation fraction area +-# Maximum-overlap and in-cloud precipitation fraction area -# Options for subcolumn microphysics --# Options to run MG2 using the same code as MG3 --# Options to run MG1 --# Completely aerosol awareness with 1) 1) constant aerosol mixing ratio, 2) climatology IN/CCN from CAM5, 3) climatology aerosol from MERRA2 , 4) GOCART, and 5) MAM7 --# Options to call fast physics as GFDL microphysics --# Number concentration of all species forcasted and has local storage +-# Options for running with fewer species and processes, simulating MG1 and MG2 codes +-# Completely aerosol awareness with 1) constant aerosol mixing ratio, 2) climatology IN/CCN from CAM5 (default; \c cam5_4_143_NAAI_monclimo2.nc), 3) climatology aerosol from MERRA2 , 4) GOCART, and 5) MAM7 -# Sub-step semi-implicit sedimentation - - +-# Can be used along with the FV in-core saturation adjustment \section intra_mg3 Intraphysics Communication \ref arg_table_m_micro_run diff --git a/physics/docs/pdftxt/CPT_adv_suite.txt b/physics/docs/pdftxt/CPT_adv_suite.txt index fa9801e07..132d8bd11 100644 --- a/physics/docs/pdftxt/CPT_adv_suite.txt +++ b/physics/docs/pdftxt/CPT_adv_suite.txt @@ -1,10 +1,9 @@ /** -\page suite3_page FV3_CPT_v0 +\page csawmg_page csawmg Suite -\section CPT_suite_overview Overview +\section csawmg_suite_overview Overview -The advanced CPT physics suite uses the parameterizations in the following order: - - \ref fast_sat_adj +The advanced csawmg physics suite uses the parameterizations in the following order: - \ref GFS_RRTMG - \ref GFS_SFCLYR - \ref GFS_NSST @@ -21,29 +20,21 @@ The advanced CPT physics suite uses the parameterizations in the following order - \ref CPT_MG3 - \ref mod_cs_conv_aw_adj - \ref GFS_CALPRECIPTYPE - - \ref STOCHY_PHYS \section sdf_cpt_suite Suite Definition File -The advanced CPT physics suite uses the parameterizations in the following order, as defined in \c FV3_CPT : +The advanced csawmg physics suite uses the parameterizations in the following order, as defined in \c SCM_csawmg : \code - + - - - fv_sat_adj - - GFS_time_vary_pre GFS_rrtmg_setup GFS_rad_time_vary GFS_phys_time_vary - stochastic_physics - stochastic_physics_sfc @@ -67,11 +58,12 @@ The advanced CPT physics suite uses the parameterizations in the following order GFS_suite_interstitial_1 dcyc2t3 GFS_surface_generic_pre + GFS_surface_composites_pre GFS_suite_interstitial_2 - sfc_ex_coef + sfc_diff GFS_surface_loop_control_part1 sfc_nst_pre sfc_nst @@ -82,6 +74,7 @@ The advanced CPT physics suite uses the parameterizations in the following order + GFS_surface_composites_post dcyc2t3_post sfc_diag sfc_diag_post @@ -89,7 +82,7 @@ The advanced CPT physics suite uses the parameterizations in the following order GFS_PBL_generic_pre hedmf GFS_PBL_generic_post - gwdps_pre + GFS_GWD_generic_pre gwdps gwdps_post rayleigh_damp @@ -119,98 +112,99 @@ The advanced CPT physics suite uses the parameterizations in the following order cs_conv_aw_adj GFS_MP_generic_post sfc_sice_post - - - - - GFS_stochastics + maximum_hourly_diagnostics + \endcode \section cpt_nml_option Namelist Option \code - fhzero = 6 - h2o_phys = .true. - oz_phys = .false. - oz_phys_2015 = .true. - ldiag3d = .false. - fhcyc = 24 - use_ufo = .true. - pre_rad = .false. - crtrh = 0.95,0.95,0.90 - ncld = 2 - imp_physics = 10 - pdfcld = .false. - fhswr = 3600. - fhlwr = 3600. - ialb = 1 - iems = 1 - iaer = 111 - ico2 = 2 - isubc_sw = 2 - isubc_lw = 2 - isol = 2 - lwhtr = .true. - swhtr = .true. - cnvgwd = .true. - shal_cnv = .true. - cal_pre = .false. - redrag = .true. - dspheat = .true. - hybedmf = .true. - random_clds = .false. - trans_trac = .true. - cnvcld = .true. - imfshalcnv = 2 - imfdeepcnv = -1 - cdmbgwd = 3.5,0.25 - prslrd0 = 0. - ivegsrc = 1 - isot = 1 - debug = .false. - ras = .false. - cscnv = .true. - do_shoc = .false. - do_aw = .true. - shoc_cld = .false. - h2o_phys = .true. - shcnvcw = .false. - xkzm_h = 0.5 - xkzm_m = 0.5 - xkzm_s = 1.0 - nstf_name = 2,1,0,0 - nst_anl = .true. - psautco = 0.0008,0.0005 - prautco = 0.00015,0.00015 - microp_uniform = .false. - mg_do_ice_gmao = .true. - mg_do_liq_liu = .true. - mg_dcs = 100.00 - mg_alf = 1.2 - mg_ts_auto_ice = 500.,2000. - mg_qcvar = 0.5 - fprcp = 2 - cs_parm = 2.6,1.0,0.05e3,2.0e3,50.0,1.0,-999.,1.,0.6,0. - shoc_parm = 7000.0,1.0,4.2857143,0.7,-999.0 - iccn = .false. - aero_in = .false. - ctei_rm = 10.0,10.0 - max_lon = 8000 - max_lat = 4000 - rhcmax = 0.9999999 - effr_in = .true. - ltaerosol = .false. - lradar = .false. - cplflx = .false. - iau_delthrs = 6 - iaufhrs = 30 - iau_inc_files = '' - +&gfs_physics_nml + fhzero = 6. + ldiag3d = .true. + fhcyc = 24. + use_ufo = .true. + pre_rad = .false. + crtrh = 0.93,0.90,0.95 + ncld = 2 + imp_physics = 10 + pdfcld = .false. + fhswr = 3600. + fhlwr = 3600. + ialb = 1 + iems = 1 + IAER = 111 + ico2 = 2 + isubc_sw = 2 + isubc_lw = 2 + isol = 2 + lwhtr = .true. + swhtr = .true. + cnvgwd = .true. + shal_cnv = .true. + cal_pre = .false. + redrag = .true. + dspheat = .true. + hybedmf = .true. + satmedmf = .false. + lheatstrg = .true. + random_clds = .true. + trans_trac = .true. + cnvcld = .true. + imfshalcnv = 2 + imfdeepcnv = -1 + cdmbgwd = 3.5,0.25 + prslrd0 = 0. + ivegsrc = 1 + isot = 1 + oz_phys = .false. + oz_phys_2015 = .true. + debug = .false. + ras = .false. + cscnv = .true. + do_shoc = .false. + do_aw = .true. + shoc_cld = .false. + h2o_phys = .true. + shcnvcw = .false. + xkzm_h = 0.5 + xkzm_m = 0.5 + xkzm_s = 1.0 + nstf_name = 2,1,1,0,5 + nst_anl = .true. + ccwf = 1.0,1.0 + dlqf = 0.25,0.05 + mg_dcs = 200.0 + mg_ts_auto_ice = 180.0,900.0 + mg_qcvar = 1.0 + fprcp = 2 + pdfflag = 4 + iccn = .false. + aero_in = .false. + mg_do_graupel = .true. + mg_do_hail = .false. + do_sb_physics = .true. + mg_do_ice_gmao = .false. + mg_do_liq_liu = .true. + cs_parm = 8.0,4.0,1.0e3,3.5e3,20.0,1.0,0.0,1.0,0.6,0.0 + shoc_parm = 7000.0,1.0,2.0,0.7,-999.0 + ctei_rm = 0.60,0.23 + max_lon = 8000 + max_lat = 4000 + rhcmax = 0.9999999 + effr_in = .true. + ltaerosol = .false. + lradar = .false. + cplflx = .false. + iau_delthrs = 6 + iaufhrs = 30 + iau_inc_files = "''" +/ \endcode -- \ref gfs_physics_nml -- \ref cpt_physics_nml + + */ diff --git a/physics/docs/pdftxt/GFDL_cloud.txt b/physics/docs/pdftxt/GFDL_cloud.txt index c3933f156..6240a259e 100644 --- a/physics/docs/pdftxt/GFDL_cloud.txt +++ b/physics/docs/pdftxt/GFDL_cloud.txt @@ -4,15 +4,16 @@ GFDL cloud microphysics (MP) scheme is a six-category MP scheme to replace Zhao-Carr MP scheme, and moves the GFS from a total cloud water variable to five predicted hydrometeors (cloud water, cloud ice, rain, snow and graupel). This scheme utilizes the "bulk water" microphysical parameterization technique in Lin et al. (1983) \cite lin_et_al_1983 -and has been significantly improved over years at GFDL (Lord et al.(1984) \cite lord_et_al_1984, -Krueger et al.(1995) \cite krueger_et_al_1995, Chen and Lin (2011) \cite chen_and_lin_2011, Chen and Lin (2013) \cite chen_and_lin_2013). +and has been significantly improved over years at GFDL (Lord et al. (1984) \cite lord_et_al_1984, +Krueger et al. (1995) \cite krueger_et_al_1995, Chen and Lin (2011) \cite chen_and_lin_2011, Chen and Lin (2013) \cite chen_and_lin_2013). Physics processes of GFDL cloud MP are described in Figure 1 (also see warm_rain() and icloud()) and are feature with time-split between warm-rain (faster) and ice-phase (slower) processes (see 'conversion time scale' in gfdl_cloud_microphys.F90 for default values). \image html gfdl_cloud_mp_diagram.png "Figure 1: GFDL MP at a glance (Courtesy of S.J. Lin at GFDL)" width=10cm Some unique attributes of GFDL cloud microphysics include: -\section fast_phys Fast Physics in FV3 Dynamical Solver +# Precipitation and Cloud Effects on Dynamics + \image html FV3_structure.png "Figure 1: FV3 structure; Yellow represents external API routines, called once per physics time step; Green are called once per remapping time step; Blue are called once per acoustic time step. " width=10cm The leftmost column of Figure 1 shows the external API calls used during a typical process-split model integration procedure. First, the solver is called, which advances the solver a full "physics" time step. This updated state is then passed to the physical parameterization @@ -27,9 +28,17 @@ done independently within each layer to maintain local (within each layer) stabi This loop is typically performed once per call to the solver, although it is possible to improve the model's stability by executing the loop (and thereby the vertical remapping) multiple times per solver call. -In current fv3gfs, the fast physics (phase-changes only) is called after the "Lagrangian-to-Eulerain" remapping. When \ref fast_sat_adj is activated (do_sat_adj=.true. in \b fv_core_nml block), it adjusts cloud water evaporation (cloud water\f$\rightarrow\f$water vapor), cloud water freezing (cloud water\f$\rightarrow\f$cloud ice), and cloud ice deposition (water vapor\f$\rightarrow\f$cloud ice). The process of condensation is an interesting and well known example. Say dynamics lifts a column of air above saturation, then an adjustment is made to temperature and moisture in order to reach saturation. The tendency of the dynamics has been included in this procedure in order to have the correct balance. -\section gfdl_fast Horizontal Sub-grid Variability ("Scale-aware") +At grid spacing of less than ~10 km, model dynamics should be able to "see" and "feel" the cloud and precipitation condensate; heat content, +heat exchange with the environment, and momentum of condensate should be accounted for. The GFDL microphysics scheme is formulated to +accomplish this through strict moist energy conservation during phase changes, and keeping heat and momentum budgets for all condensate. +This results in thermodynamic consistency between the FV3 microphysics scheme and FV3 dyanmics. + +In current fv3gfs, GFDL in-core fast saturation adjustment (phase-changes only) is called after the "Lagrangian-to-Eulerain" remapping. When \ref fast_sat_adj is activated (do_sat_adj=.true. in \b fv_core_nml block), it adjusts cloud water evaporation (cloud water\f$\rightarrow\f$water vapor), cloud water freezing (cloud water\f$\rightarrow\f$cloud ice), and cloud ice deposition (water vapor\f$\rightarrow\f$cloud ice). The process of condensation is an interesting and well known example. Say dynamics lifts a column of air above saturation, then an adjustment is made to temperature and moisture in order to reach saturation. The tendency of the dynamics has been included in this procedure in order to have the correct balance. + +# Scale-awareness + +Scale-awareness provided by assumed subgrid variability that is directly proportional to grid spacing. Horizontal sub-grid variability is a function of cell area: - Over land: \f[ @@ -43,18 +52,15 @@ h_{var}=\min \left\{0.2,\max\left[0.01, D_{ocean}(\frac{A_{r}}{10^{10}})^{0.25}\ Where \f$A_{r}\f$ is cell area, \f$D_{land}\f$ and \f$D_{ocean}\f$ are base values for sub-grid variability over land and ocean (larger sub-grid variability appears in larger area). Horizontal sub-grid variability is used in cloud fraction, relative humidity calculation, evaporation and condensation processes. Scale-awareness is achieved by this horizontal subgrid variability and a \f$2^{nd}\f$ -order FV-type vertical reconstruction (Lin et al.(1994) \cite lin_et_al_1994). - -\section nml_opt Namelist Option -\ref gfdl_cloud_microphysics_nml +order FV-type vertical reconstruction (Lin et al. (1994) \cite lin_et_al_1994). \section intro_GFDL_cloud Intraphysics Communication - + For GFDL Cloud MP: \ref arg_table_gfdl_cloud_microphys_run - + For GFDL Fast Physics: \ref arg_table_fv_sat_adj_run + + GFDL Cloud MP: \ref arg_table_gfdl_cloud_microphys_run + + GFDL In-core Fast Saturation Adjustment: \ref arg_table_fv_sat_adj_run \section Gen_GFDL_cloud General Algorithm - + For GFDL Cloud MP: mpdrv() - + For GFDL Fast Physics: fv_sat_adj_work() + + GFDL Cloud MP: mpdrv() + + GFDL In-core Fast Saturation Ajustment: fv_sat_adj_work() */ diff --git a/physics/docs/pdftxt/GFS_GWDC.txt b/physics/docs/pdftxt/GFS_GWDC.txt index 53e9cc1cb..c8fb70afa 100644 --- a/physics/docs/pdftxt/GFS_GWDC.txt +++ b/physics/docs/pdftxt/GFS_GWDC.txt @@ -13,7 +13,7 @@ The importance of convectively-generated tropical waves in driving the equatorial stratospheric semi-annual oscillation (SAO) and quasi-biennial oscillation (QBO) has been appreciated for many years. - In a review paper on gravity waves in the middle atmosphere, Fritts(1984) \cite fritts_1984 + In a review paper on gravity waves in the middle atmosphere, Fritts (1984) \cite fritts_1984 showed that a large portion of observed gravity wave momentum flux has higher frequencies than those of stationary mountain waves. This phenomenon was explained by cumulus @@ -22,7 +22,7 @@ wind and stability are weak, the magnitude of the surface drag and the resultant influence of orographically-induced gravity wave drag on the large-scale flow are relatively small compared with those in - wintertime (Palmer et al.(1986) \cite palmer_et_al_1986). In this + wintertime (Palmer et al. (1986) \cite palmer_et_al_1986). In this situation, the relative importance of cumulus convection as a source of gravity waves is larger. In addition, in the tropical regions where persistent convection exists, deep cumulus clouds impinging on @@ -34,7 +34,7 @@ Compared with orographic gravitity waves, it has proven more difficult to model the way in which gravity waves are generated by various convective sources; The simplest situation is depicted in Figure 1. There are several proposed generation mechanisms in the literature (see section 3b in - Kim et al.(2003) \cite kim_et_al_2003). Amongst, Chun and Baik (1998) \cite chun_and_baik_1998 + Kim et al. (2003) \cite kim_et_al_2003). Amongst, Chun and Baik (1998) \cite chun_and_baik_1998 proposed a way for parameterizing convection-induced subgrid-scale gravity wave momentum flux in large-scale models. For the momentum flux profile up to the cloud-top height, use of the linear diff --git a/physics/docs/pdftxt/GFS_H2OPHYS.txt b/physics/docs/pdftxt/GFS_H2OPHYS.txt index ca3cd2041..efd38065f 100644 --- a/physics/docs/pdftxt/GFS_H2OPHYS.txt +++ b/physics/docs/pdftxt/GFS_H2OPHYS.txt @@ -3,7 +3,7 @@ \section des_h2o Description To improve the treatment of stratospheric water vapor in the global model, NCEP implemented a parameterization of photochemical production and loss (P-L) of water vapor through methane oxidation and photolysis of H2O in the upper mesosphere due to solar Lyman alpha absorption is implemented in GFS. -The Navy Research Laboratory (NRL) linearized parameterization of stratospheric and mesospheric water vapor photochemistry (McCormack at al.(2008) +The Navy Research Laboratory (NRL) linearized parameterization of stratospheric and mesospheric water vapor photochemistry (McCormack at al. (2008) \cite mccormack_et_al_2008) applies a linearized photochemical tendency to specific humidity q in the form \f[ \frac{dq}{dt}=(P-L)_{0}+\frac{\partial (P-L)}{\partial q}\mid_{0}(q-q_{0}) diff --git a/physics/docs/pdftxt/GFS_NOAH.txt b/physics/docs/pdftxt/GFS_NOAH.txt index d6928b38a..19360d092 100644 --- a/physics/docs/pdftxt/GFS_NOAH.txt +++ b/physics/docs/pdftxt/GFS_NOAH.txt @@ -7,26 +7,26 @@ predictability on daily to seasonal timescale (Betts et al. (2017) \cite betts_et_al_2017), but also in terms of influencing extremes such as drought and heatwaves (Paimazumder and Done (2016) \cite paimazumder_and_done_2016), PBL evolution and cloud - formation (Milovac et al.(2016) \cite milovac_et_al_2016) and afternoon + formation (Milovac et al. (2016) \cite milovac_et_al_2016) and afternoon convection (Guillod et al. (2015) \cite guillod_et_al_2015), and tropical cyclone re-intensification (Andersen and Shepherd (2014) \cite andersen_and_shepherd_2014). Other linkages, such as the role of soil moisture (SM) or vegetation heterogeneity in mesoscale circulation - (Hsu et al.(2017) \cite hsu_et_al_2017) and planetary waves (Koster et al.(2014) \cite koster_et_al_2014), + (Hsu et al. (2017) \cite hsu_et_al_2017) and planetary waves (Koster et al. (2014) \cite koster_et_al_2014), and those driven by land use and land cover change or management (Hirsch et al. (2015) \cite hirsch_et_al_2015; - Findell et al.(2017) \cite findell_et_al_2017) are topics of active research. + Findell et al. (2017) \cite findell_et_al_2017) are topics of active research. Figure 1 is a schematic of local land-atmosphere interactions in a quiescent synoptic regime, including the soil moisture-precipitation - (SM-P) feedback pathways. Solid arrows indicate a positive feedback + (SM-P) feedback pathways (Ek and Mahrt (1994) \cite ek_and_mahrt_1994; Ek and Holtslag (2004) \cite ek_and_holtslag_2004 ). Solid arrows indicate a positive feedback pathway, and large dashed arrows represent a negative feedback, while red indicates radiative, black indicates surface layer and PBL, and brown indicates land surface processes. Thin red and grey dashed lines with arrows also represent positive feedbacks. The single horizontal gay-dotted line (no arrows) indicates the top of the PBL, and the seven small vertical dashed lines (no arrows) represent precipitation - \image html Noah_LA_interaction.png "Figure 1: Local Land-atmosphere Interaction (courtesy of Michael Ek, Ek and Mahrt (1994), Ek and Holtslag (2004))" width=10cm + \image html Noah_LA_interaction.png "Figure 1: Local Land-atmosphere Interaction (courtesy of Michael Ek)" width=10cm Recently, the land surface updates in 2017 GFS operational physics includes: - IGBP 20-type 1-km land classification - STASGO 19-type 1-km soil classification diff --git a/physics/docs/pdftxt/GFS_SAMF.txt b/physics/docs/pdftxt/GFS_SAMF.txt new file mode 100644 index 000000000..192f1f9a1 --- /dev/null +++ b/physics/docs/pdftxt/GFS_SAMF.txt @@ -0,0 +1,9 @@ +/** +\page GFS_SAMF GFS Scale-Aware Simplified Arakawa-Schubert (sa-SAS) Convection Scheme + +\section des_samf Description + +\section intra_samf Intraphysics Communication + + +*/ diff --git a/physics/docs/pdftxt/GFS_SATMEDMF.txt b/physics/docs/pdftxt/GFS_SATMEDMF.txt index 3dd9eb17e..22e73a458 100644 --- a/physics/docs/pdftxt/GFS_SATMEDMF.txt +++ b/physics/docs/pdftxt/GFS_SATMEDMF.txt @@ -8,7 +8,7 @@ counter-gradient(EDCG) scheme is used for the weakly unstable PBL. The new TKE-E -# Eddy diffusivity (K) is now a function of TKE which is prognostically predicted --# EDMF approach is appled for all the unstable PBL +-# EDMF approach is applied for all the unstable PBL -# EDMF approach is also applied to the stratocumulus-top-driven turbulence mixing diff --git a/physics/docs/pdftxt/GFS_SATMEDMFVDIFQ.txt b/physics/docs/pdftxt/GFS_SATMEDMFVDIFQ.txt new file mode 100644 index 000000000..de543fe6c --- /dev/null +++ b/physics/docs/pdftxt/GFS_SATMEDMFVDIFQ.txt @@ -0,0 +1,35 @@ +/** +\page GFS_SATMEDMFVDIFQ GFS Scale-aware TKE-based Moist Eddy-Diffusion Mass-Flux (EDMF) PBL and Free Atmospheric Turbulence Scheme +\section des_satmedmfvdifq Description + +The current operational \ref GFS_HEDMF uses a hybrid EDMF parameterization for the convective PBL (Han et al. 2016 \cite Han_2016; +Han et al. 2017 \cite han_et_al_2017), where the EDMF scheme is applied only for the strongly unstable PBL, while the eddy-diffusivity +counter-gradient(EDCG) scheme is used for the weakly unstable PBL. The new TKE-EDMF is an extended version of \ref GFS_HEDMF with below enhancement: + +-# Eddy diffusivity (K) is now a function of TKE which is prognostically predicted + +-# EDMF approach is applied for all the unstable PBL + +-# EDMF approach is also applied to the stratocumulus-top-driven turbulence mixing + +-# It includes a moist-adiabatic process when updraft thermal becomes saturated + +-# Scale-aware capability + +-# It includes interaction between TKE and cumulus convection + +The CCPP-compliant subroutine satmedmfvdifq_run() computes subgrid vertical turbulence mixing using scale-aware +TKE-based moist eddy-diffusion mass-flux paramterization (Han et al. 2019 \cite Han_2019) +- For the convective boundary layer, the scheme adopts EDMF parameterization (Siebesma et al. (2007)\cite Siebesma_2007) +to take into account nonlocal transport by large eddies(mfpbltq.f) +- A new mass-flux paramterization for stratocumulus-top-induced turbulence mixing has been introduced (mfscuq.f; previously, +it was an eddy diffusion form) +- For local turbulence mixing, a TKE closure model is used. + +\section intra_satmedmfvdifq Intraphysics Communication +\ref arg_table_satmedmfvdifq_run + +\section gen_pbl_satmedmfvdifq General Algorithm +\ref gen_satmedmfvdifq + +*/ diff --git a/physics/docs/pdftxt/GFS_SFCLYR.txt b/physics/docs/pdftxt/GFS_SFCLYR.txt index 6ed7ed3c2..60d804a01 100644 --- a/physics/docs/pdftxt/GFS_SFCLYR.txt +++ b/physics/docs/pdftxt/GFS_SFCLYR.txt @@ -12,7 +12,7 @@ in the very stable and very unstable situations. \ref Noah_LSM are largely responsible for the quality of model forecasts produced for near-surface weather parameters, such as 2-meter air temperature (\f$T_{2m}\f$) and surface skin temperature - (\f$LST\f$). \f$LST\f$ is derived from the surface energy budget, and is + (\f$LST\f$). \f$LST\f$ is derived from the surface energy budget, and is particularly important to remote sensing and data assimilation. How precise these two parameters can be simulated by the model strongly depends on how accurate the surface heat fluxes are parameterized, @@ -31,10 +31,10 @@ in the very stable and very unstable situations. In May 2011, the new vegetation-dependent formulations of thermal roughness formulation ( - Zheng et al.(2012) \cite zheng_et_al_2012) + Zheng et al. (2012) \cite zheng_et_al_2012) was implemented to deal with the cold \f$LST\f$ bias over the arid western continental United States - (CONUS) during daytime. The thermal roughness length \f$Z_{0H}\f$ is derived by a + (CONUS) during daytime. The thermal roughness length \f$Z_{0H}\f$ is derived by a seasonlly varying formulation dependent on the seasonal cycle of green vegetation fraction. In this \f$Z_{0H}\f$ formulation, a key parameter known as \f$C_{zil}\f$ is specified according to a dependence on canopy height. @@ -43,7 +43,7 @@ The NCEP GFS global prediction model has experienced a longstanding problem of s cold bias in the \f$T_{2m}\f$ forecasts over land in the late afternoon and nighttime during moist seasons. This cold bias is closely associated with the nocturnal stable boundary layer and is accompanied by a corresponding warm air temperature bias in the first -model level above the ground. In 2017, Zheng et al.(2017) \cite zheng_et_al_2017 identified the +model level above the ground. In 2017, Zheng et al. (2017) \cite zheng_et_al_2017 identified the bias and introduced a stability parameter constraint \f$(z/L)_{lim}\f$ to prevent the land-atmosphere system from fully decoupling: \f[ (z/L)_{lim}=\frac{ln(\frac{z}{z_{0M}})}{2\alpha(1-\frac{z_{0M}}{z})} @@ -51,11 +51,11 @@ bias and introduced a stability parameter constraint \f$(z/L)_{lim}\f$ to preven Here \f$z\f$ is the height, \f$L\f$ is the Obukhov length, \f$z_{0M}\f$ is the momentum roughness length, and \f$\alpha = 5\f$. -The pertinent features of the GFS stable surface layer parameterization scheme are described in the appendix of Zheng et al.(2017) +The pertinent features of the GFS stable surface layer parameterization scheme are described in the appendix of Zheng et al. (2017) \cite zheng_et_al_2017. \section intra_rough Intraphysics Communication -\ref arg_table_sfc_ex_coef_run +\ref arg_table_sfc_diff_run \section gen_rough General Algorithm \ref general_diff diff --git a/physics/docs/pdftxt/GFS_SFCSICE.txt b/physics/docs/pdftxt/GFS_SFCSICE.txt index 8f39c5eef..b7b3c38f3 100644 --- a/physics/docs/pdftxt/GFS_SFCSICE.txt +++ b/physics/docs/pdftxt/GFS_SFCSICE.txt @@ -25,13 +25,13 @@ A sea ice model, in general, may contain subcomponents treating 1) dynamics (ice motion), 2) ice transport, 3) multiple ice thickness categories (including leads), 4) surface albedo, and 5) vertical thermodynamics. GFS sea ice scheme is concerned with a scheme for the - last of these processes. A three-layer thermodynamic sea ice model (Winton(2000) \cite winton_2000) + last of these processes. A three-layer thermodynamic sea ice model (Winton (2000) \cite winton_2000) has been coupled to GFS. It predicts sea ice/snow thickness, the surface temperature and ice temperature structure. In each model grid box, the heat and moisture fluxes and albedo are treated separately for the ice and the open water. \section intra_sice Intraphysics Communication -+ GFS Sea Ice Driver(\ref arg_table_sfc_sice_run) ++ GFS Sea Ice Driver (\ref arg_table_sfc_sice_run) + Three-layer Thermodynamics Sea Ice Model (ice3lay()) \cite winton_2000 \section gen_sice General Algorithm diff --git a/physics/docs/pdftxt/GFS_SURFACE_PERT.txt b/physics/docs/pdftxt/GFS_SURFACE_PERT.txt index 480946b57..1ecdfaa34 100644 --- a/physics/docs/pdftxt/GFS_SURFACE_PERT.txt +++ b/physics/docs/pdftxt/GFS_SURFACE_PERT.txt @@ -1,16 +1,28 @@ /** \page surf_pert GFS Surface Parameter Perturbation \section des_sfcpert Description -Parameterizations of physical process include a number of tunable -Land surface perturbation (Gehne et al.(2019) \cite Gehne_2019) has been recently introduced +Land surface perturbation (Gehne et al. (2019) \cite Gehne_2019) has been recently introduced into FV3GFS. This treatment is based on the hypothesis that one of the major causes of the insufficient spread in current global NWP model,especially near the surface, is a lack of treatment of uncertainty in the soil state and in the associated model parameters. It allows for land surface parameters such as surface albedo, -vegetation fraction,soil hydraulic conductivity,leaf area index (LAI),surface roughness lengths for heat and momentom to vary in space. -These parameters and variables have been shown to impact forecasts of 2m temperature,10m wind and precipitation.Based on the parameter +vegetation fraction, soil hydraulic conductivity, leaf area index (LAI), surface roughness lengths for heat and momentom to vary in space. +These parameters and variables have been shown to impact forecasts of 2m temperature, 10m wind and precipitation. Based on the parameter or variable,different strategies to perturb are necessary. +Table 1 presents a summary of the uncertainty or range of values associated with the parameters and variables that are considered. + +\section table Uncertainty or range of values identified for the perturbed parameters (Gehne et al. (2019)) +| Parameter or variable | Estimated uncertainty or range | Reference | +|-----------------------------------|---------------------------------------|------------------------------------| +| Albedo | 2\%-12\% of Albedo | Grant et al. (2000) \cite grant_et_al_2000 ; Qu and Hall (2005) \cite qu_and_hall_2005 | +| Vegetation fraction | 20\%-30\% of Vegetation fraction | Computed from MODIS vegetation fraction data | +| Momentum roughness length + + + + + Momentum roughness length (\f$Z_{0}\f$),heat/momentum roughness length ratio (\f$Z_{t}/Z_{0}\f$), Albedo and vegetation fraction perturbation are applied by percentile matching of the normal distribution with the beta distribution diff --git a/physics/docs/pdftxt/GFSv14_suite.txt b/physics/docs/pdftxt/GFSv14_suite.txt index 138de59e6..23f611a25 100644 --- a/physics/docs/pdftxt/GFSv14_suite.txt +++ b/physics/docs/pdftxt/GFSv14_suite.txt @@ -82,7 +82,7 @@ The GFS v14 suite uses the parameterizations in the following order, as defined GFS_PBL_generic_pre hedmf GFS_PBL_generic_post - gwdps_pre + GFS_GWD_generic_pre gwdps gwdps_post rayleigh_damp @@ -106,7 +106,6 @@ The GFS v14 suite uses the parameterizations in the following order, as defined zhaocarr_gscond zhaocarr_precpd GFS_MP_generic_post - sfc_sice_post maximum_hourly_diagnostics diff --git a/physics/docs/pdftxt/GFSv15_suite.txt b/physics/docs/pdftxt/GFSv15_suite.txt index cf7e68068..6b5fddcf8 100644 --- a/physics/docs/pdftxt/GFSv15_suite.txt +++ b/physics/docs/pdftxt/GFSv15_suite.txt @@ -1,25 +1,20 @@ /** -\page suite1_page FV3_GFS_v15 +\page GFS_v15_page GFS_v15 Suite \section gfs1_suite_overview Overview -Effective on or about Wednesday, June 12, 2019, begining with the 1200 -Coordinated Universal Time (UTC) run, the National Centers for Environmental -Prediction (NCEP) will upgrade the Global Forecast Systems (GFS) from version 14 to 15.1. +Version 15 of the Global Forecast System (GFS) was implemented operationally by the NOAA +National Centers for Environmental Prediction (NCEP) on June 12, 2019. +GFS v15 uses the Finite-Volume Cubed-Sphere (FV3) dynamical core +and a revised physics suite when compared to GFS v14. -NOAA/NWS selected the finite-volume cubed-sphere (FV3) dynamical core as the Next -Generation Global Prediction System (NGGPS). The FV3 was developed by the Geophysical -Fluid Dynamics Laboratory (GFDL) under NOAA's Office of Atmospheric Research (OAR). -The GFS version 15.1 uses the FV3 dynamical core and improved physics parameterizations. Compared -to version 14, the GFS version 15.1 uses the same physics package except for: -- Replacement of \ref GFS_ZHAOC with the more advanced \ref GFDL_cloud -- Updated paramterization of ozone photochemistry with additional production and loss terms -- Newly introduced parameterization of middle atmospheric water vapor photochemistry (\ref GFS_H2OPHYS) +- Replacement of the Zhao-Carr microphysics with the more advanced \ref GFDL_cloud +- Updated parameterization of ozone photochemistry with additional production and loss terms +- Newly introduced parameterization of middle atmospheric water vapor photochemistry - Revised bare soil evaporation scheme - Modified convective parameterization scheme to reduce excessive cloud top cooling -The GFSv15 physics suite uses the parameterizations in the following order: - - \ref fast_sat_adj +The GFS v15 physics suite uses the parameterizations in the following order: - \ref GFS_RRTMG - \ref GFS_SFCLYR - \ref GFS_NSST @@ -35,29 +30,21 @@ The GFSv15 physics suite uses the parameterizations in the following order: - \ref GFS_SAMFshal - \ref GFDL_cloud - \ref GFS_CALPRECIPTYPE - - \ref STOCHY_PHYS \section sdf_gfsv15 Suite Definition File -The GFSv15 suite uses the parameterizations in the following order, as defined in \c FV3_GFS_v15 : +The GFS v15 suite uses the parameterizations in the following order, as defined in \c SCM_GFS_v15: \code - + - - - fv_sat_adj - - GFS_time_vary_pre GFS_rrtmg_setup GFS_rad_time_vary GFS_phys_time_vary - stochastic_physics - stochastic_physics_sfc @@ -81,11 +68,12 @@ The GFSv15 suite uses the parameterizations in the following order, as defined i GFS_suite_interstitial_1 dcyc2t3 GFS_surface_generic_pre + GFS_surface_composites_pre GFS_suite_interstitial_2 - sfc_ex_coef + sfc_diff GFS_surface_loop_control_part1 sfc_nst_pre sfc_nst @@ -96,6 +84,7 @@ The GFSv15 suite uses the parameterizations in the following order, as defined i + GFS_surface_composites_post dcyc2t3_post sfc_diag sfc_diag_post @@ -103,12 +92,13 @@ The GFSv15 suite uses the parameterizations in the following order, as defined i GFS_PBL_generic_pre hedmf GFS_PBL_generic_post - gwdps_pre + GFS_GWD_generic_pre gwdps gwdps_post rayleigh_damp GFS_suite_stateout_update ozphys_2015 + h2ophys GFS_DCNV_generic_pre get_phi_fv3 GFS_suite_interstitial_3 @@ -126,114 +116,119 @@ The GFSv15 suite uses the parameterizations in the following order, as defined i GFS_MP_generic_pre gfdl_cloud_microphys GFS_MP_generic_post - sfc_sice_post maximum_hourly_diagnostics - - - GFS_stochastics - - \endcode \section gfs15_nml_opt_des Namelist Option \code - fhzero = 6 - h2o_phys = .true. - oz_phys = .false. - oz_phys_2015 = .true. - ldiag3d = .false. - fhcyc = 24 - use_ufo = .true. - pre_rad = .false. - ncld = 5 - imp_physics = 11 - pdfcld = .false. - fhswr = 3600. - fhlwr = 3600. - ialb = 1 - iems = 1 - iaer = 111 - ico2 = 2 - isubc_sw = 2 - isubc_lw = 2 - isol = 2 - lwhtr = .true. - swhtr = .true. - cnvgwd = .true. - shal_cnv = .true. - cal_pre = .false. - redrag = .true. - dspheat = .true. - hybedmf = .true. - random_clds = .false. - trans_trac = .true. - cnvcld = .true. - imfshalcnv = 2 - imfdeepcnv = 2 - cdmbgwd = 3.5,0.25 - prslrd0 = 0. - ivegsrc = 1 - isot = 1 - debug = .false. - nstf_name = 2,0,0,0,0 - nst_anl = .true. - psautco = 0.0008,0.0005 - prautco = 0.00015,0.00015 -\endcode -check \ref gfs_physics_nml for description +&gfs_physics_nml + fhzero = 6. + ldiag3d = .true. + fhcyc = 24. + nst_anl = .true. + use_ufo = .true. + pre_rad = .false. + ncld = 5 + imp_physics = 11 + pdfcld = .false. + fhswr = 3600. + fhlwr = 3600. + ialb = 1 + iems = 1 + IAER = 111 + ico2 = 2 + isubc_sw = 2 + isubc_lw = 2 + isol = 2 + lwhtr = .true. + swhtr = .true. + cnvgwd = .true. + shal_cnv = .true. + cal_pre = .false. + redrag = .true. + dspheat = .true. + hybedmf = .true. + satmedmf = .false. + shinhong = .false. + do_ysu = .false. + lheatstrg = .false. + lgfdlmprad = .false. + effr_in = .false. + random_clds = .false. + trans_trac = .false. + cnvcld = .true. + imfshalcnv = 2 + imfdeepcnv = 2 + cdmbgwd = 3.5,0.25 + prslrd0 = 0. + ivegsrc = 1 + isot = 1 + debug = .false. + oz_phys = .false. + oz_phys_2015 = .true. + h2o_phys = .true. + nstf_name = 2,1,1,0,5 + xkzminv = 0.3 + xkzm_m = 1.0 + xkzm_h = 1.0 + do_sppt = .false. + do_shum = .false. + do_skeb = .false. + do_sfcperts = .false. +/ -\code - sedi_transport = .true. - do_sedi_heat = .false. - rad_snow = .true. - rad_graupel = .true. - rad_rain = .true. - const_vi = .F. - const_vs = .F. - const_vg = .F. - const_vr = .F. - vi_max = 1. - vs_max = 2. - vg_max = 12. - vr_max = 12. - qi_lim = 1. - prog_ccn = .false. - do_qa = .true. - fast_sat_adj = .true. - tau_l2v = 225. - tau_v2l = 150. - tau_g2v = 900. - rthresh = 10.e-6 - dw_land = 0.16 - dw_ocean = 0.10 - ql_gen = 1.0e-3 - ql_mlt = 1.0e-3 - qi0_crt = 8.0E-5 - qs0_crt = 1.0e-3 - tau_i2s = 1000. - c_psaci = 0.05 - c_pgacs = 0.01 - rh_inc = 0.30 - rh_inr = 0.30 - rh_ins = 0.30 - ccn_l = 300. - ccn_o = 100. - c_paut = 0.5 - c_cracw = 0.8 - use_ppm = .false. - use_ccn = .true. - mono_prof = .true. - z_slope_liq = .true. - z_slope_ice = .true. - de_ice = .false. - fix_negative = .true. - icloud_f = 1 - mp_time = 150. +&gfdl_cloud_microphysics_nml + sedi_transport = .true. + do_sedi_heat = .false. + rad_snow = .true. + rad_graupel = .true. + rad_rain = .true. + const_vi = .F. + const_vs = .F. + const_vg = .F. + const_vr = .F. + vi_max = 1. + vs_max = 2. + vg_max = 12. + vr_max = 12. + qi_lim = 1. + prog_ccn = .false. + do_qa = .false. + fast_sat_adj = .false. + tau_l2v = 225. + tau_v2l = 150. + tau_g2v = 900. + rthresh = 10.e-6 + dw_land = 0.16 + dw_ocean = 0.10 + ql_gen = 1.0e-3 + ql_mlt = 1.0e-3 + qi0_crt = 8.0E-5 + qs0_crt = 1.0e-3 + tau_i2s = 1000. + c_psaci = 0.05 + c_pgacs = 0.01 + rh_inc = 0.30 + rh_inr = 0.30 + rh_ins = 0.30 + ccn_l = 300. + ccn_o = 100. + c_paut = 0.5 + c_cracw = 0.8 + use_ppm = .false. + use_ccn = .true. + mono_prof = .true. + z_slope_liq = .true. + z_slope_ice = .true. + de_ice = .false. + fix_negative = .true. + icloud_f = 1 + mp_time = 150. +/ \endcode -check \ref gfdl_cloud_microphysics_nml for description */ diff --git a/physics/docs/pdftxt/GFSv15_suite_TKEEDMF.txt b/physics/docs/pdftxt/GFSv15_suite_TKEEDMF.txt index 3b0868cec..56a1f97f5 100644 --- a/physics/docs/pdftxt/GFSv15_suite_TKEEDMF.txt +++ b/physics/docs/pdftxt/GFSv15_suite_TKEEDMF.txt @@ -1,11 +1,10 @@ /** -\page suite2_page FV3_GFS_v15plus +\page GFS_v15plus_page GFS_v15plus Suite \section gfs2p_suite_overview Overview -This physics suite is the same as GFSv15 physics suite with \ref GFS_SATMEDMF replace of \ref GFS_HEDMF . +This physics suite is the same as GFS v15 physics suite with \ref GFS_SATMEDMF replace of \ref GFS_HEDMF . - - \ref fast_sat_adj - \ref GFS_RRTMG - \ref GFS_SFCLYR - \ref GFS_NSST @@ -21,30 +20,22 @@ This physics suite is the same as GFSv15 physics suite with \ref GFS_SATMEDMF r - \ref GFS_SAMFshal - \ref GFDL_cloud - \ref GFS_CALPRECIPTYPE - - \ref STOCHY_PHYS \section sdf_gfsv15p Suite Definition File -The GFSv15plus suite uses the parameterizations in the following order, as defined in \c FV3_GFS_v15plus : +The GFS v15plus suite uses the parameterizations in the following order, as defined in \c SCM_GFS_v15plus : \code - + - - - fv_sat_adj - - GFS_time_vary_pre GFS_rrtmg_setup GFS_rad_time_vary GFS_phys_time_vary - stochastic_physics - stochastic_physics_sfc @@ -68,11 +59,12 @@ The GFSv15plus suite uses the parameterizations in the following order, as defin GFS_suite_interstitial_1 dcyc2t3 GFS_surface_generic_pre + GFS_surface_composites_pre GFS_suite_interstitial_2 - sfc_ex_coef + sfc_diff GFS_surface_loop_control_part1 sfc_nst_pre sfc_nst @@ -83,19 +75,21 @@ The GFSv15plus suite uses the parameterizations in the following order, as defin + GFS_surface_composites_post dcyc2t3_post sfc_diag sfc_diag_post GFS_surface_generic_post GFS_PBL_generic_pre - hedmf + satmedmfvdif GFS_PBL_generic_post - gwdps_pre + GFS_GWD_generic_pre gwdps gwdps_post rayleigh_damp GFS_suite_stateout_update ozphys_2015 + h2ophys GFS_DCNV_generic_pre get_phi_fv3 GFS_suite_interstitial_3 @@ -113,115 +107,119 @@ The GFSv15plus suite uses the parameterizations in the following order, as defin GFS_MP_generic_pre gfdl_cloud_microphys GFS_MP_generic_post - sfc_sice_post maximum_hourly_diagnostics - - - GFS_stochastics - - \endcode \section gfs15p_nml_opt_des Namelist Option \code - fhzero = 6 - h2o_phys = .true. - oz_phys = .false. - oz_phys_2015 = .true. - ldiag3d = .false. - fhcyc = 24 - use_ufo = .true. - pre_rad = .false. - ncld = 5 - imp_physics = 11 - pdfcld = .false. - fhswr = 3600. - fhlwr = 3600. - ialb = 1 - iems = 1 - iaer = 111 - ico2 = 2 - isubc_sw = 2 - isubc_lw = 2 - isol = 2 - lwhtr = .true. - swhtr = .true. - cnvgwd = .true. - shal_cnv = .true. - cal_pre = .false. - redrag = .true. - dspheat = .true. - hybedmf = .false. - satmedmf = .true. - random_clds = .false. - trans_trac = .true. - cnvcld = .true. - imfshalcnv = 2 - imfdeepcnv = 2 - cdmbgwd = 3.5,0.25 - prslrd0 = 0. - ivegsrc = 1 - isot = 1 - debug = .false. - nstf_name = 2,0,0,0,0 - nst_anl = .true. - psautco = 0.0008,0.0005 - prautco = 0.00015,0.00015 -\endcode -check \ref gfs_physics_nml for description +&gfs_physics_nml + fhzero = 6. + ldiag3d = .true. + fhcyc = 24. + nst_anl = .true. + use_ufo = .true. + pre_rad = .false. + ncld = 5 + imp_physics = 11 + pdfcld = .false. + fhswr = 3600. + fhlwr = 3600. + ialb = 1 + iems = 1 + IAER = 111 + ico2 = 2 + isubc_sw = 2 + isubc_lw = 2 + isol = 2 + lwhtr = .true. + swhtr = .true. + cnvgwd = .true. + shal_cnv = .true. + cal_pre = .false. + redrag = .true. + dspheat = .true. + hybedmf = .false. + satmedmf = .true. + shinhong = .false. + do_ysu = .false. + lheatstrg = .false. + lgfdlmprad = .false. + effr_in = .false. + random_clds = .false. + trans_trac = .false. + cnvcld = .true. + imfshalcnv = 2 + imfdeepcnv = 2 + cdmbgwd = 3.5,0.25 + prslrd0 = 0. + ivegsrc = 1 + isot = 1 + debug = .false. + oz_phys = .false. + oz_phys_2015 = .true. + h2o_phys = .true. + nstf_name = 2,1,1,0,5 + xkzminv = 0.3 + xkzm_m = 1.0 + xkzm_h = 1.0 + do_sppt = .false. + do_shum = .false. + do_skeb = .false. + do_sfcperts = .false. +/ -\code - sedi_transport = .true. - do_sedi_heat = .false. - rad_snow = .true. - rad_graupel = .true. - rad_rain = .true. - const_vi = .F. - const_vs = .F. - const_vg = .F. - const_vr = .F. - vi_max = 1. - vs_max = 2. - vg_max = 12. - vr_max = 12. - qi_lim = 1. - prog_ccn = .false. - do_qa = .true. - fast_sat_adj = .true. - tau_l2v = 225. - tau_v2l = 150. - tau_g2v = 900. - rthresh = 10.e-6 - dw_land = 0.16 - dw_ocean = 0.10 - ql_gen = 1.0e-3 - ql_mlt = 1.0e-3 - qi0_crt = 8.0E-5 - qs0_crt = 1.0e-3 - tau_i2s = 1000. - c_psaci = 0.05 - c_pgacs = 0.01 - rh_inc = 0.30 - rh_inr = 0.30 - rh_ins = 0.30 - ccn_l = 300. - ccn_o = 100. - c_paut = 0.5 - c_cracw = 0.8 - use_ppm = .false. - use_ccn = .true. - mono_prof = .true. - z_slope_liq = .true. - z_slope_ice = .true. - de_ice = .false. - fix_negative = .true. - icloud_f = 1 - mp_time = 150. +&gfdl_cloud_microphysics_nml + sedi_transport = .true. + do_sedi_heat = .false. + rad_snow = .true. + rad_graupel = .true. + rad_rain = .true. + const_vi = .F. + const_vs = .F. + const_vg = .F. + const_vr = .F. + vi_max = 1. + vs_max = 2. + vg_max = 12. + vr_max = 12. + qi_lim = 1. + prog_ccn = .false. + do_qa = .false. + fast_sat_adj = .false. + tau_l2v = 225. + tau_v2l = 150. + tau_g2v = 900. + rthresh = 10.e-6 + dw_land = 0.16 + dw_ocean = 0.10 + ql_gen = 1.0e-3 + ql_mlt = 1.0e-3 + qi0_crt = 8.0E-5 + qs0_crt = 1.0e-3 + tau_i2s = 1000. + c_psaci = 0.05 + c_pgacs = 0.01 + rh_inc = 0.30 + rh_inr = 0.30 + rh_ins = 0.30 + ccn_l = 300. + ccn_o = 100. + c_paut = 0.5 + c_cracw = 0.8 + use_ppm = .false. + use_ccn = .true. + mono_prof = .true. + z_slope_liq = .true. + z_slope_ice = .true. + de_ice = .false. + fix_negative = .true. + icloud_f = 1 + mp_time = 150. +/ \endcode -check \ref gfdl_cloud_microphysics_nml for description */ diff --git a/physics/docs/pdftxt/GSD_CU_GF_deep.txt b/physics/docs/pdftxt/GSD_CU_GF_deep.txt index 6d97a716c..05e3cf39e 100644 --- a/physics/docs/pdftxt/GSD_CU_GF_deep.txt +++ b/physics/docs/pdftxt/GSD_CU_GF_deep.txt @@ -1,35 +1,34 @@ /** -\page GSD_CU_GF GSD Grell-Freitas Scale and Aerosol Aware Convection Scheme +\page GSD_CU_GF Grell-Freitas Scale and Aerosol Aware Convection Scheme \section gfcu_descrip Description -The Rapid Refresh (RAP) uses the Grell-Freitas (GF) convective scheme, while the HRRR allows direct prediction -of convection at its 3-km horizontal scale. In the RAP, the Grell-Freitas parameterization removes convective -instability so that the gridscale precipitation scheme does not "convect", convective precipitation is a scheme -byproduct. Grell-Freitas is an Arakawa-Schubert mass flux type scheme, and is both aerosol and model scale aware. -Aerosol awareness (emulating the impact of aerosols on precipitation processes) is obtained through changing the rate of -converstion from cloud droplets to raindrops (Berry 1968 \cite berry_1968 ), and by modifying the precipitation efficiency of the -raindrops (the fraction of total condensed water volume in the cloud's lifetime reaching the ground (Jiang et al.(2010) \cite Jiang_2010) ) -Scale awareness comes through the use of an empirical formula for the fractional area (\f$\sigma\f$) of the model grid column -containing updrafts and downdrafts (Arakawa et al. (2011) \cite Arakawa_2011 ). The entrainment rate for the updrafts is an inverse function -of \f$\sigma\f$. As the fractional coverage become large, the resolved motion takes over convective processes (why the HRRR is called -"convection allowing") and the Grell-Freitas scheme becomes a shallow convection scheme, simulating the effects of unresolved fair weather -and towering cumulus on the forecast variables. - -The GF scheme still uses an ensemble of convective schemes, but is now limited to options that modulate closure and capping -inversion thresholds for convection. After calculations for each member of the cloud ensemble in the convective scheme, the ensemble -mean time tendency for temperature, moisture, and cloud and precipitation hydrometeors is passed to the rest of the model -(Grell and \f$D\acute{e}v\acute{e}nyi\f$, 2002 \cite Grell_2002 ). Additionally, the upward mass flux from parameterized convective updrafts is balanced by -subsidence in adjacent grid columns, if horizontal resolution of the model using the parameterization is less than 10 km. - -# Operational Impacts in RAP/HRRR +The Grell-Freitas (GF) scheme as described in Grell and Freitas (2014, GF1) \cite grell_and_freitas_2014 and +Freitas et al. (2018, FG) \cite freitas_et_al_2018 follow the mass flux approach published by Grell (1993) \cite grell_1993. +Further developments by Grell and \f$D\acute{e}v\acute{e}nyi\f$ (2002) \cite Grell_2002 included implementing +stochastics through allowing parameter perturbations. In GF1 scale awareness, and the aerosol dependence through rain generation (following +Berry (1968) \cite berry_1968 and evaporation formulations (following Jiang et al. (2010) \cite Jiang_2010 ), depending on the +cloud concentration nuclei at cloud base were added. FG included mixed phase physics impact, momentum transport (as in ECMWF), + a diurnal cycle closure (Bechtold et al. (2014) \cite bechtold_et_al_2014 ), and a trimodal spectral size to simulate the interaction +and transition from shallow, congestus and deep convection regimes. The vertical massflux distribution of shallow, congestus and +deep convection regimes is characterized by Probability Density Functions (PDF's). The three PDF's are meant to represent the average +statistical mass flux characteristic of deep, congestus, and shallow (respectively) plumes in the grid area. Each PDF therefore represents +a spectrum of plumes within the grid box. Forcing is different for each characteristic type. Entrainment and detrainment are derived +from the PDF's. The deep convection considers scale awareness (Arakawa et al. (2011) \cite Arakawa_2011 ), the congestus type convection +as well as the shallow convection are not scale-aware. Aerosol dependence is implemented through dependence of rain generation and +evaporation formulations depending on the cloud concentration nuclei at cloud base. Aerosol dependence is considered experimental and +is turned off at this point. GF is able to transport tracers. + +A paper describing the latest changes and modifications is in progress and will be submitted to GMD. + +\b Operational \b Impacts \b in \b RAP/HRRR - Uses mass-flux schemes, which are more physically realistic than (sounding) adjustment schemes - - Takes parameterization uncertainty into account by using multiple convective schemes, using variations on scheme parameters - - For higher resolutions (less than 10 km), transitions as grid spacing decreases into a shallow convection scheme, as the grid scale motions begin to handle convective processes. This makes the scheme "scale aware". - - Scheme is aerosol-aware, driven by aerosol relationship to concentration of condensation nuclei. + - Takes parameterization uncertainty into account by allowing parameters from multiple convective schemes which can be perturbed +internally or with temporal and spatial correlation patterns + - For higher resolutions (less than 10 km), in addition to scale awareness as in Arakawa et al. (2011) \cite Arakawa_2011 GF can +transition as grid spacing decreases into a shallow convection scheme - Coupled to the grid scale precipitation and radiation schemes through passing of diagnosed cloud liquid and ice from simulated -precipitating convective cloud and shallow convective clouds, - +precipitating convective cloud and shallow convective clouds \section intra_rough_gf Intraphysics Communication The GF scheme passes cloud hydrometeors to the grid-scale microphysics scheme (\ref GSD_THOMPSON ) through detrainment from each diff --git a/physics/docs/pdftxt/GSD_THOMPSON.txt b/physics/docs/pdftxt/GSD_THOMPSON.txt index d3ef00dd4..525d3bedc 100644 --- a/physics/docs/pdftxt/GSD_THOMPSON.txt +++ b/physics/docs/pdftxt/GSD_THOMPSON.txt @@ -1,6 +1,6 @@ /** \page GSD_THOMPSON Thompson Aerosol-Aware Microphysics Scheme -\section thompson_descrp Description +\section thompson_descrp Description The GSD RAP/HRRR microphysics implementation represents the most aggressive attempt to include explicit prediction of diff --git a/physics/docs/pdftxt/GSD_adv_suite.txt b/physics/docs/pdftxt/GSD_adv_suite.txt index 7850c8631..fb662bc22 100644 --- a/physics/docs/pdftxt/GSD_adv_suite.txt +++ b/physics/docs/pdftxt/GSD_adv_suite.txt @@ -1,10 +1,8 @@ /** -\page suite4_page FV3_GSD_v0 +\page GSD_v0_page GSD_v0 Suite \section gsd_suite_overview Overview -# History of RUC, RAP/HRRR model development at NOAA/GSD - The original Rapid Update Cycle (RUC), implemented in 1994, was designed to provide accurate short-range (0 to 12-hr) numerical forecast guidance for weather-sensitive users, including those in the U.S. aviation community. The RUC started to run every hour starting in 1998. Significant weather forecasting problems that occur in the 0- to @@ -36,15 +34,14 @@ The advanced GSD RAP/HRRR physics suite uses the parameterizations in the follow - \ref GFS_GWDC - \ref GSD_THOMPSON - \ref GFS_CALPRECIPTYPE - - \ref STOCHY_PHYS \section sdf_gsdsuite Suite Definition File -The GSD RAP/HRRR physics suite uses the parameterizations in the following order, as defined in \c FV3_GSD: +The GSD RAP/HRRR physics suite uses the parameterizations in the following order, as defined in \c SCM_GSD_v0: \code - + @@ -52,8 +49,6 @@ The GSD RAP/HRRR physics suite uses the parameterizations in the following order GFS_rrtmg_setup GFS_rad_time_vary GFS_phys_time_vary - stochastic_physics - stochastic_physics_sfc @@ -79,11 +74,12 @@ The GSD RAP/HRRR physics suite uses the parameterizations in the following order GFS_suite_interstitial_1 dcyc2t3 GFS_surface_generic_pre + GFS_surface_composites_pre GFS_suite_interstitial_2 - sfc_ex_coef + sfc_diff GFS_surface_loop_control_part1 sfc_nst_pre sfc_nst @@ -93,12 +89,13 @@ The GSD RAP/HRRR physics suite uses the parameterizations in the following order + GFS_surface_composites_post dcyc2t3_post sfc_diag sfc_diag_post GFS_surface_generic_post mynnedmf_wrapper - gwdps_pre + GFS_GWD_generic_pre gwdps gwdps_post rayleigh_damp @@ -124,11 +121,7 @@ The GSD RAP/HRRR physics suite uses the parameterizations in the following order mp_thompson_post GFS_MP_generic_post cu_gf_driver_post - - - - - GFS_stochastics + maximum_hourly_diagnostics @@ -138,72 +131,70 @@ The GSD RAP/HRRR physics suite uses the parameterizations in the following order \section gsd_nml_option Namelist Option \code - fhzero = 6 - h2o_phys = .true. - oz_phys = .false. - oz_phys_2015 = .true. - ldiag3d = .false. - fhcyc = 24 - use_ufo = .true. - pre_rad = .false. - ncld = 5 - imp_physics = 8 - ltaerosol = .true. - lradar = .false. - pdfcld = .false. - fhswr = 3600. - fhlwr = 3600. - ialb = 1 - iems = 1 - iaer = 111 - ico2 = 2 - isubc_sw = 2 - isubc_lw = 2 - isol = 2 - lwhtr = .true. - swhtr = .true. - cnvgwd = .true. - shal_cnv = .true. - cal_pre = .false. - redrag = .true. - dspheat = .true. - hybedmf = .false. - satmedmf = .false. - do_mynnedmf = .true. - do_mynnsfclay = .false. - random_clds = .false. - trans_trac = .true. - cnvcld = .true. - imfshalcnv = 3 - imfdeepcnv = 3 - force_lmfshal = .true. - lmfshal = .false. - force_lmfdeep2 = .false. - cdmbgwd = 3.5,0.25 - prslrd0 = 0. - ivegsrc = 1 - isot = 1 - debug = .false. - oz_phys = .false. - oz_phys_2015 = .true. - nstf_name = 2,0,0,0,0 - nst_anl = .true. - psautco = 0.0008,0.0005 - prautco = 0.00015,0.00015 - do_sppt = .false. - do_shum = .false. - do_skeb = .false. - do_sfcperts = .false. - lsm = 2 - lsoil_lsm = 9 - icloud_bl = 1 - bl_mynn_tkeadvect = .true. - bl_mynn_edmf = 1 - bl_mynn_edmf_mom = 1 +&gfs_physics_nml + fhzero = 6. + h2o_phys = .true. + ldiag3d = .true. + fhcyc = 0. + nst_anl = .true. + use_ufo = .true. + pre_rad = .false. + ncld = 5 + imp_physics = 8 + ltaerosol = .true. + lradar = .true. + ttendlim = -999. + pdfcld = .false. + fhswr = 3600. + fhlwr = 3600. + ialb = 1 + iems = 1 + iaer = 111 + ico2 = 2 + isubc_sw = 2 + isubc_lw = 2 + isol = 2 + lwhtr = .true. + swhtr = .true. + cnvgwd = .true. + shal_cnv = .true. + cal_pre = .false. + redrag = .true. + dspheat = .true. + hybedmf = .false. + satmedmf = .false. + lheatstrg = .false. + do_mynnedmf = .true. + do_mynnsfclay = .false. + random_clds = .false. + trans_trac = .true. + cnvcld = .true. + imfshalcnv = 3 + imfdeepcnv = 3 + cdmbgwd = 3.5,0.25 + prslrd0 = 0. + ivegsrc = 1 + isot = 1 + debug = .false. + oz_phys = .false. + oz_phys_2015 = .true. + nstf_name = 2,1,1,0,5 + cplflx = .false. + iau_delthrs = 6 + iaufhrs = 30 + iau_inc_files = "''" + do_sppt = .false. + do_shum = .false. + do_skeb = .false. + do_sfcperts = .false. + lsm = 2 + lsoil_lsm = 9 + icloud_bl = 1 + bl_mynn_tkeadvect = .true. + bl_mynn_edmf = 1 + bl_mynn_edmf_mom = 1 +/ \endcode -Check NML option description at: -- \ref gfs_physics_nml -- \ref gsd_hrrr_nml */ diff --git a/physics/docs/pdftxt/NoahMP.txt b/physics/docs/pdftxt/NoahMP.txt new file mode 100644 index 000000000..f42aaaa00 --- /dev/null +++ b/physics/docs/pdftxt/NoahMP.txt @@ -0,0 +1,41 @@ +/** +\page NoahMP GFS NoahMP Land Surface Model +\section des_noahmp Description + +This implementation of the NoahMP Land Surface Model (LSM) is adapted from the version implemented in WRF v3.7 with additions by NOAA EMC staff to work with the UFS Atmosphere model. Authoritative documentation of the NoahMP scheme can be accessed at the following links: + +[University of Texas at Austin NoahMP Documentation](http://www.jsg.utexas.edu/noah-mp "University of Texas at Austin NoahMP Documentation") + +[NCAR Research Application Laboratory NoahMP Documentation](https://ral.ucar.edu/solutions/products/noah-multiparameterization-land-surface-model-noah-mp-lsm "NCAR RAL NoahMP Documentation") + +A primary reference for the NoahMP LSM is Niu et al. (2011) \cite niu_et_al_2011. + +The CCPP interface to the NoahMP LSM is a driving software layer on top of the actual NoahMP LSM. During the run sequence, code organization is as follows: ++ \ref noahmpdrv_run() calls + + \ref transfer_mp_parameters() + + \ref noahmp_options() + + \ref noahmp_options_glacier() and noahmp_glacier() if over the ice vegetation type (glacier) + + \ref noahmp_sflx() if over other vegetation types + + \ref penman() + +Note that noahmp_glacer() and noahmp_sflx() are the actual NoahMP codes. + +\section Default NoahMP LSM Options used in UFS atmosphere ++ Dynamic Vegetation (opt_dveg): 2 [On] ++ Canopy Stomatal Resistance (opt_crs): 1 [Ball-Berry] ++ Soil Moisture Factor for Stomatal Resistance (opt_btr): 1 [Noah soil moisture] ++ Runoff and Groundwater (opt_run): 1 [topmodel with groundwater (Niu et al. 2007 \cite niu_et_al_2007)] ++ Surface Layer Drag Coeff (opt_sfc): 1 [Monin-Obukhov] ++ Supercooled Liquid Water or Ice Fraction (opt_frz): 1 [no iteration (Niu and Yang, 2006 \cite niu_and_yang_2006)] ++ Frozen Soil Permeability (opt_inf): 1 [linear effects, more permeable (Niu and Yang, 2006, \cite niu_and_yang_2006)] ++ Radiation Transfer (opt_rad): 1 [modified two-stream (gap = f(solar angle, 3d structure ...)<1-fveg)] ++ Ground Snow Surface Albedo (opt_alb): 2 [class] ++ Partitioning Precipitation into Rainfall & Snowfall (opt_snf): 4 [use microphysics output] ++ Lower Boundary Condition of Soil Temperature (opt_tbot): 2 [tbot at zbot (8m) read from a file (original Noah)] ++ Snow/Soil Temperature Time Scheme (only layer 1) (opt_stc): 1 [semi-implicit; flux top boundary condition] + +\section intra_noahmp Intraphysics Communication + + GFS NoahMP LSM Driver (\ref arg_table_noahmpdrv_run) +\section gen_al_noahmp General Algorithm of Driver ++ \ref general_noahmpdrv +*/ diff --git a/physics/docs/pdftxt/UGWPv0.txt b/physics/docs/pdftxt/UGWPv0.txt new file mode 100644 index 000000000..da7009b79 --- /dev/null +++ b/physics/docs/pdftxt/UGWPv0.txt @@ -0,0 +1,21 @@ +/** +\page UGWPv0 Unified Gravity Wave Physics Version 0 +\section des_UGWP Description + +Gravity waves (GWs) are generated by a variety of sources in the atmosphere including orographic GWs (OGWs; quasi-stationary waves) and non-orographic GWs (NGWs; non-stationary oscillations). The subgrid scale parameterization scheme for OGWs can be found in Section \ref GFS_GWDPS. This scheme represents the operational version of the subgrid scale orography effects in Version 15 of Global Forecast System (GFS). + +The NGW physics scheme parameterizes the effects of non-stationary subgrid-scale waves in the global atmosphere models extended into the stratosphere, mesosphere, and thermosphere. These non-stationary oscillations with periods bounded by Coriolis and Brunt-Väisälä frequencies and typical horizontal scales from tens to several hundreds of kilometers are forced by the imbalance of convective and frontal/jet dynamics in the troposphere and lower stratosphere (Fritts 1984 \cite fritts_1984; Alexander et al. 2010 \cite alexander_et_al_2010; Plougonven and Zhang 2014 \cite plougonven_and_zhang_2014). The NGWs propagate upwards and the amplitudes exponentially grow with altitude until instability and breaking of waves occur. Convective and dynamical instability induced by GWs with large amplitudes can trigger production of small-scale turbulence and self-destruction of waves. The latter process in the theory of atmospheric GWs is frequently referred as the wave saturation (Lindzen 1981 \cite lindzen_1981; Weinstock 1984 \cite weinstock_1984; Fritts 1984 \cite fritts_1984). Herein, “saturation” or "breaking" refers to any processes that act to reduce wave amplitudes due to instabilities and/or interactions arising from large-amplitude perturbations limiting the exponential growth of GWs with height. Background dissipation processes such as molecular diffusion and radiative cooling, in contrast, act independently of GW amplitudes. In the middle atmosphere, impacts of NGW saturation (or breaking) and dissipation on the large-scale circulation, mixing, and transport have been acknowledged in the physics of global weather and climate models after pioneering studies by Lindzen 1981 \cite lindzen_1981 and Holton 1983 \cite holton_1983. Comprehensive reviews on the physics of NGWs and OGWs in the climate research and weather forecasting highlighted the variety of parameterization schemes for NGWs （Alexander et al. 2010 \cite alexander_et_al_2010; Geller et al. 2013 \cite geller_et_al_2013; Garcia et al. 2017 \cite garcia_et_al_2017). They are formulated using different aspects of the nonlinear and linear propagation, instability, breaking and dissipation of waves along with different specifications of GW sources (Garcia et al. 2007 \cite garcia_et_al_2007; Richter et al 2010 \cite richter_et_al_2010; Eckermann et al. 2009 \cite eckermann_et_al_2009; Eckermann 2011 \cite eckermann_2011; Lott et al. 2012 \cite lott_et_al_2012). + +The current operational GFS physics parameterizes effects of stationary OGWs and convective GWs, neglecting the impacts of non-stationary subgrid scale GW physics. This leads to well-known shortcomings in the global model predictions in the stratosphere and upper atmosphere (Alexander et al. 2010 \cite alexander_et_al_2010; Geller et al. 2013). In order to describe the effects of unresolved GWs by dynamical cores in global forecast models, subgrid scales physics of stationary and non-stationary GWs needs to be implemented in the self-consistent manner under the Unified Gravity Wave Physics (UGWP) framework. + +The concept of UGWP and the related programming architecture implemented in FV3GFS was first proposed by CU-CIRES, NOAA Space Weather Prediction Center (SWPC) and Environmental Modeling Center (EMC) for the Unified Forecast System (UFS) with variable positions of the model top lids (Alpert et al. 2019 \cite alpert_et_al_2019; Yudin et al. 2016 \cite yudin_et_al_2016; Yudin et al. 2018 \cite yudin_et_al_2018). As above, the UGWP considers identical GW propagation solvers for OGWs and NGWs with different approaches for specification of subgrid wave sources. The current set of the input and control parameters for UGWP version 0 (UGWP-v0) can select different options for GW effects including momentum deposition (also called GW drag), heat deposition, and mixing by eddy viscosity, conductivity and diffusion. The input GW parameters can control the number of directional azimuths in which waves can propagate, number of waves in single direction, and the interface model layer from the surface at which NGWs can be launched. Among the input parameters, the GW efficiency factors reflect intermittency of wave excitation. They can vary with horizontal resolutions, reflecting capability of the FV3 dynamical core to resolve mesoscale wave activity with the enhancement of model resolution. The prescribed distributions for vertical momentum flux (VMF) of NGWs have been employed in the global forecast models of NWP centers and reanalysis projects to ease tuning of GW schemes to the climatology of the middle atmosphere dynamics in the absence of the global wind data above about 35 km (Eckermann et al. 2009 \cite eckermann_et_al_2009; Molod et al. 2015 \cite molod_et_al_2015). These distributions of VMF qualitatively describe the general features of the latitudinal and seasonal variations of the global GW activity in the lower stratosphere, observed from the ground and space (Ern et al. 2018 \cite ern_et_al_2018). For the long-term climate projections, global models seek to establish communication between model physics and dynamics. This provides variable in time and space excitation of subgrid GWs under year-to-year variations of solar input and anthropogenic emissions (Richter et al 2010 \cite richter_et_al_2010; 2014 \cite richter_et_al_2014). + +Note that in the first release of UGWP (UGWP-v0), the momentum and heat deposition due to GW breaking and dissipation have been tested in the multi-year simulations and medium-range forecasts using FV3GFS-L127 configuration with top lid at about 80 km. In addition, the eddy mixing effects induced by instability of GWs are not activated in this version. Along with the GW heat and momentum depositions, GW eddy mixing is an important element of the Whole Atmosphere Model (WAM) physics, as shown in WAM simulations with the spectral dynamics (Yudin et al. 2018 \cite yudin_et_al_2018). The additional impact of eddy mixing effects in the middle and upper atmosphere need to be further tested, evaluated, and orchestrated with the subgrid turbulent diffusion of the GFS physics (work in progress). In UFS, the WAM with FV3 dynamics (FV3-WAM) will represent the global atmosphere model configuration extended into the thermosphere (top lid at ~600 km). In the mesosphere and thermosphere, the background attenuation of subgrid waves due to molecular and turbulent diffusion, radiative damping and ion drag will be the additional mechanism of NGW and OGW dissipation along with convective and dynamical instability of waves described by the linear (Lindzen 1981 \cite lindzen_1981) and nonlinear (Weinstock 1984 \cite weinstock_1984; Hines 1997 \cite hines_1997) saturation theories. + +\section intra_UGWPv0 Intraphysics Communication +\ref arg_table_cires_ugwp_run + +\section gen_al_ugwpv0 General Algorithm +\ref cires_ugwp_run + +*/ diff --git a/physics/docs/pdftxt/all_shemes_list.txt b/physics/docs/pdftxt/all_shemes_list.txt index 97f5fbb22..7e5e3298e 100644 --- a/physics/docs/pdftxt/all_shemes_list.txt +++ b/physics/docs/pdftxt/all_shemes_list.txt @@ -8,21 +8,22 @@ In the CCPP-Physics v3.0 release, each parameterization is in its own modern For code maintenance. While some individual parameterization can be invoked for the GMTB SCM, most users will assemble the parameterizations in suites. -- Radiation: +- \b Radiation - \subpage GFS_RRTMG -- PBL and turbulence: +- \b PBL \b and \b Turbulence - \subpage GFS_HEDMF - \subpage GFS_SATMEDMF + - \subpage GFS_SATMEDMFVDIFQ - \subpage GSD_MYNNEDMF -- Land surface model: +- \b Land \b Surface \b Model - \subpage GFS_NOAH - - \subpage surf_pert - \subpage GSD_RUCLSM + - \subpage NoahMP -# Cumulus parameterizations: - - GFS Simplified Arakawa Schubert (SAS) +- \b Cumulus \b Parameterizations + - \subpage GFS_SAMF - \subpage GFS_SAMFdeep - \subpage GFS_SAMFshal - \subpage CSAW_scheme @@ -30,35 +31,29 @@ parameterizations in suites. - \ref cu_gf_deep_group - \ref cu_gf_sh_group -- Microphysics: +- \b Microphysics - \subpage GFDL_cloud - - \subpage fast_sat_adj - \subpage CPT_MG3 - \subpage GSD_THOMPSON -- Stochastic: - - \subpage STOCHY_PHYS - - \subpage surf_pert - -- Ozone: +- \b Ozone \b Photochemical \b Production \b and \b Loss - \subpage GFS_OZPHYS - - \ref GFS_ozphys - \ref GFS_ozphys_2015 -- Water Vapor Photochemical Production and Loss: +- \b Water \b Vapor \b Photochemical \b Production \b and \b Loss - \subpage GFS_H2OPHYS -- Gravity Wave Drag: +- \b Gravity \b Wave \b Drag - \subpage GFS_GWDPS - \subpage GFS_GWDC + - \subpage UGWPv0 - -- Surface layer/Sea Ice/NSST: +- \b Surface \b Layer \b and \b Simplified \b Ocean \b and \b Sea \b Ice \b Representation - \subpage GFS_SFCLYR - \subpage GFS_NSST - \subpage GFS_SFCSICE -- Others: +- \b Others - \subpage GFS_RAYLEIGH - \subpage GFS_CALPRECIPTYPE @@ -69,57 +64,37 @@ In addition to the physical schemes themselves, this scientific documentation al - \ref radcons The input information for the physics include the values of the gridbox mean prognostic variables (wind components, temperature, -specific humidity, cloud fraction, vater contents for cloud liquid, cloud ice, rain, snow, graupel, and ozone concentration), the provisional +specific humidity, cloud fraction, water contents for cloud liquid, cloud ice, rain, snow, graupel, and ozone concentration), the provisional dynamical tendencies for the same variables and various surface fields, both fixed and variable. -The time integration of the GFS physics suite is based on the following: -- The tendencies from the different physical processes are computed by the parameterizations or derived in separate interstitial routines; +The time integration of the physics suites is based on the following: +- The tendencies from the different physical processes are computed by the parameterizations or derived in separate interstitial routines - The first part of the suite, comprised of the parameterizations for radiation, surface layer, surface (land, ocean, and sea ice), boundary layer, -orographic gravity wave drag, and Rayleigh damping, is computed using a hybrid of parallel and sequential splitting (Donahue and Caldwell(2018) -\cite donahue_and_caldwell_2018), a method in which the various parameterizations use the same model state as input but feel the effect of the preceding +orographic gravity wave drag, and Rayleigh damping, is computed using a hybrid of parallel and sequential splitting described in Donahue and Caldwell(2018) +\cite donahue_and_caldwell_2018, a method in which the various parameterizations use the same model state as input but are impacted by the preceding parameterizations. The tendencies from the various parameterizations are then added together and used to update the model state. -- The second part of the physics suite, comprised of the parameterizations of ozone, stratospheric \f$H_2O\f$, deep convection, convective gravity wave drag, +- The surface parameterizations (land, ocean and sea ice) are invoked twice in a loop, with the first time to create a guess, and the second time to +produce the tendencies. +- The second part of the physics suite, comprised of the parameterizations of ozone, stratospheric water vapor, deep convection, convective gravity wave drag, shallow convection, and microphysics, is computed using sequential splitting in the order listed above, in which the model state is updated between calls to the parameterization. +- If the in-core saturation adjustment is used (\p do_sat_adj=.true.), it is invoked at shorter timesteps along with the dynamical solver. \section allsuite_overview Physics Suites -With funding from the Next Generation Global Prediction System (NGGPS) initiative and broad support from the community NCEP/EMC recently -replaced the dynamic core in its flagship operational model, the GFS. Version 15 of the GFS (GFSv15), schedule for implementation in -middle 2019, will include the Finite-volume Cubed-Sphere (FV3) non-hydrostatic dynamic core in place of the long-running spectral Gaussian -hydrostatic core. - -The next major upgrade of the GFS is expected to be in the area of model physics.Physics upgrades are particular challenging.But community -support, enhanced collaborations, and the CCPP framework are now making it feasible to accelerate advancements in operational model physics -through wholesale replacement of individual parameterizations or even entire parameterizations suites. - -Current plans call for major changes to the GFSv15 parameterization suite in anticipation of the GFSv16 implementaion, schedule for FY2021. -Several parameterizations have been identified as likely new components of the \b GFSv16 suite, including: -- The \b RRTMGP radiation parameterization, developed by Robert Pincus and colleagues, is scheduled to replace the current \ref GFS_RRTMG -- The \b Noah-MP land-surface parameterization is expected to replace the current \ref GFS_NOAH -- A unified gravity-wave-drag (\b UGWD) parameterization, developed by Valery Yudin and collaborators, will replace the separate -\ref GFS_GWDPS and \ref GFS_GWDC currently being used. -- Fresh-water lake (\b FLAKE) and multi-layer snow parameterizations will be introduced to enhance the representation of earth-atmosphere -interactions. - -In addition, new parameterizations for deep and shallow moist convection (CP), cloud microphysics (MP), and planetary boundary layer (PBLP)/ -turbulence are being considered. Unlike the parameterizations mentioned above, there are multiple viable options for parameterizing these -processes in GFSv16, including the schemes currently used in GFSv15. The "suite" approach is being taken for this subset of all model -parameterizations because the individual parameterizations within each candidate CP-MP-PBLP suite are highly interdependent. Thus, optimal -performance typically has been achieved within the candidate suites through collective tuning of individual parameterizations. Developers -have been invited to contribute their parameterizations as members of pre-tuned suites in hopes of optimizing performance in the GFS. This -approach is one way of "leveling the playing field" so that parameterizations developed outside the GFS framework are not unduly handicapped -by sub-optimal interactions with other GFS parameterizations. - - -Two suites of CP-MP-PBLP parameterizations have been identified as possible replacements for the current GFSv15 suite. \b GSD suite is -derived from the operational Rapid Refresh (RAP) and High-Resolution Rapid Refresh (HRRR) modeling system \cite Benjamin_2016 and was developed largely at NOAA/OAR/ESRL/GSD for mesoscale applications, while the second candidate, i.e., the \b CPT \b (Climate Process Team) suite, has components that were -developed at multiple ressearch centers and universities, including Colorado State, Utah, NASA, NCAR, and EMC. Its individual -parameterizations have been applied primarily to medium-range and longer prediction scales. For the GFSv15 suite, a very similar suite, but -with TKE-EDMF in repace of K-EDMF have been developed at EMC (Han et al. 2019 \cite Han_2019). - -Table 1. physics-suite options included in this documentation. + +The CCPP v3 includes the suite used in the GFS v15 implemented operationally in June 2019 (suite GFS_v15). Additionally, it includes three +developmental suites which are undergoing testing for possible future implementation in the UFS. Suite GFS_v15plus is identical to suite +GFS_v15 except for a replacement in the PBL parameterization (Han et al. 2019 \cite Han_2019 ). Suite csawmg differs from GFS_v15 as it +contains different convection and microphysics schemes made available through a NOAA Climate Process Team (CPT) with components developed +at multiple research centers and universities, including Colorado State, Utah, NASA, NCAR, and EMC. Suite GSD_v0 differs from GFS_v15 as it +uses the convection, microphysics, and boundary layer schemes employed in the Rapid Refresh (RAP) and High-Resolution Rapid Refresh (HRRR \cite Benjamin_2016 ) +operational models and was assembled by NOAA/GSD. An assessment of an earlier version of these suites can be found in + the UFS portal +and in the GMTB website . + +Table 1. Physics suite options included in this documentation. \tableofcontents -| Phys suites | FV3_GFS_v15 | FV3_GFS_v15plus | FV3_CPT_v0 | FV3_GSD_v0 | +| Phys suites | GFS_v15 | GFS_v15plus | csawmg | GSD_v0 | |------------------|----------------------|----------------------|---------------------|----------------------| | Deep Cu | \ref GFS_SAMFdeep | \ref GFS_SAMFdeep | \ref CSAW_scheme | \ref GSD_CU_GF | | Shallow Cu | \ref GFS_SAMFshal | \ref GFS_SAMFshal | \ref GFS_SAMFshal | \ref GSD_MYNNEDMF and \ref cu_gf_sh_group | diff --git a/physics/docs/pdftxt/all_shemes_list.txt.FV3 b/physics/docs/pdftxt/all_shemes_list.txt.FV3 new file mode 100644 index 000000000..9294027dd --- /dev/null +++ b/physics/docs/pdftxt/all_shemes_list.txt.FV3 @@ -0,0 +1,110 @@ +/** +\page allscheme_page Parameterizations and Suites Overview + +\section allscheme_overview Physics Parameterizations + +In the CCPP-Physics v3.0 release, each parameterization is in its own modern Fortran module, + which facilitates model development and +code maintenance. While some individual parameterization can be invoked for the GMTB SCM, most users will assemble the +parameterizations in suites. + +- Radiation + - \subpage GFS_RRTMG + +- PBL and Turbulence + - \subpage GFS_HEDMF + - \subpage GFS_SATMEDMF + - \subpage GSD_MYNNEDMF + +- Land Surface Model + - \subpage GFS_NOAH + - \subpage surf_pert + - \subpage GSD_RUCLSM + +- Cumulus Parameterizations + - GFS Scale-Aware Arakawa Schubert (SAS) Scheme + - \subpage GFS_SAMFdeep + - \subpage GFS_SAMFshal + - \subpage CSAW_scheme + - \subpage GSD_CU_GF + - \ref cu_gf_deep_group + - \ref cu_gf_sh_group + +- Microphysics + - \subpage GFDL_cloud + - \subpage fast_sat_adj (not available for the GMTB SCM) + - \subpage CPT_MG3 + - \subpage GSD_THOMPSON + +- Stochastic (not available for the GMTB SCM) + - \subpage STOCHY_PHYS + - \subpage surf_pert (only applicable to \ref GFS_NOAH ) + +- Ozone + - \subpage GFS_OZPHYS + - \ref GFS_ozphys_2015 + +- Water Vapor Photochemical Production and Loss + - \subpage GFS_H2OPHYS + +- Gravity Wave Drag + - \subpage GFS_GWDPS + - \subpage GFS_GWDC + +- Surface Layer and Simplified Ocean and Sea Ice Representation + - \subpage GFS_SFCLYR + - \subpage GFS_NSST + - \subpage GFS_SFCSICE + +- Others + - \subpage GFS_RAYLEIGH + - \subpage GFS_CALPRECIPTYPE + +In addition to the physical schemes themselves, this scientific documentation also covers four modules that define physics/radiation functions, parameters and constants: + - \ref func_phys + - \ref phy_sparam + - \ref physcons + - \ref radcons + +The input information for the physics include the values of the gridbox mean prognostic variables (wind components, temperature, +specific humidity, cloud fraction, water contents for cloud liquid, cloud ice, rain, snow, graupel, and ozone concentration), the provisional + dynamical tendencies for the same variables and various surface fields, both fixed and variable. + +The time integration of the physics suites is based on the following: +- The tendencies from the different physical processes are computed by the parameterizations or derived in separate interstitial routines +- The first part of the suite, comprised of the parameterizations for radiation, surface layer, surface (land, ocean, and sea ice), boundary layer, +orographic gravity wave drag, and Rayleigh damping, is computed using a hybrid of parallel and sequential splitting described in Donahue and Caldwell(2018) +\cite donahue_and_caldwell_2018, a method in which the various parameterizations use the same model state as input but are impacted by the preceding +parameterizations. The tendencies from the various parameterizations are then added together and used to update the model state. +- The surface parameterizations (land, ocean and sea ice) are invoked twice in a loop, with the first time to create a guess, and the second time to +produce the tendencies. +- The second part of the physics suite, comprised of the parameterizations of ozone, stratospheric water vapor, deep convection, convective gravity wave drag, +shallow convection, and microphysics, is computed using sequential splitting in the order listed above, in which the model state is updated between calls +to the parameterization. +- If the in-core saturation adjustment is used (\p do_sat_adj=.true.), it is invoked at shorter timesteps along with the dynamical solver. + +\section allsuite_overview Physics Suites + +The CCPP v3 includes the suite used in the GFS v15 implemented operationally in June 2019 (suite GFS_v15). Additionally, it includes three +developmental suites which are undergoing testing for possible future implementation in the UFS. Suite GFS_v15plus is identical to suite +GFS_v15 except for a replacement in the PBL parameterization (Han et al. 2019 \cite Han_2019 ). Suite MGCSAW differs from GFS_v15 as it +contains different convection and microphysics schemes made available through a NOAA Climate Process Team (CPT) with components developed +at multiple research centers and universities, including Colorado State, Utah, NASA, NCAR, and EMC. Suite GSD_v0 differs from GFS_v15 as it +uses the convection, microphysics, and boundary layer schemes employed in the Rapid Refresh (RAP) and High-Resolution Rapid Refresh (HRRR \cite Benjamin_2016 ) +operational models and was assembled by NOAA/GSD. An assessment of an earlier version of these suites can be found in + the UFS portal +and in the GMTB website . + +Table 1. Physics suite options included in this documentation. +\tableofcontents +| Phys suites | GFS_v15 | GFS_v15plus | MGCSAW | GSD_v0 | +|------------------|----------------------|----------------------|---------------------|----------------------| +| Deep Cu | \ref GFS_SAMFdeep | \ref GFS_SAMFdeep | \ref CSAW_scheme | \ref GSD_CU_GF | +| Shallow Cu | \ref GFS_SAMFshal | \ref GFS_SAMFshal | \ref GFS_SAMFshal | \ref GSD_MYNNEDMF and \ref cu_gf_sh_group | +| Microphysics | \ref GFDL_cloud | \ref GFDL_cloud | \ref CPT_MG3 | \ref GSD_THOMPSON | +| PBL/TURB | \ref GFS_HEDMF | \ref GFS_SATMEDMF | \ref GFS_HEDMF | \ref GSD_MYNNEDMF | +| Land | \ref GFS_NOAH | \ref GFS_NOAH | \ref GFS_NOAH | \ref GSD_RUCLSM | +\tableofcontents + + +*/ diff --git a/physics/docs/pdftxt/suite_input.nml.txt b/physics/docs/pdftxt/suite_input.nml.txt index 6e90827b7..fcb55d84f 100644 --- a/physics/docs/pdftxt/suite_input.nml.txt +++ b/physics/docs/pdftxt/suite_input.nml.txt @@ -1,235 +1,438 @@ /** -\page GFSsuite_nml Namelist Option Description +\page GFSsuite_nml Namelist Options Description + +At runtime, the SCM and the UFS Atmosphere access runtime configurations from file \c input.nml. This file contains +various namelists that control aspects of the I/O, dynamics, physics etc. Most physics-related options are grouped into +two namelists:\b &gfs_physics_nml and \b &gfdl_cloud_microphysics_nml, with additional specifications for stochastic physics in +namelists \b &stochy_nam and \b &nam_sfcperts. + +- Namelist \b &gfdl_cloud_microphysics_nml is only relevant when the GFDL microphysics is used, and its variables are defined in +module_gfdl_cloud_microphys.F90. + +- Namelist \b &gfs_physics_nml pertains to all of the suites used, but some of the variables are only relevant for specific +parameterizations. Its variables are defined in file GFS_typedefs.F90 in the host model. + +- Namelist \b &stochy_nam specifies options for the use of SPPT, SKEB and SHUM, while namelist \b &nam_sfcperts specifies whether +and how stochastic perturbations are used in the Noah Land Surface Model. -\section gfs_physics_nml GFS Physics Parameters -The namelist variable description is provided in host-model side: GFS_typedefs.F90 +
NML Description
option DDT in Host Model Description Default Value -
\b &gfs_physics_nml +
\b &gfs_physics_nml
fhzero gfs_control_type hour between clearing of diagnostic buckets 0.0
h2o_phys gfs_control_type flag for stratosphere h2o scheme .false.
ldiag3d gfs_control_type flag for 3D diagnostic fields .false. +
lssav gfs_control_type logical flag for storing diagnostics .false. +
cplflx gfs_control_type logical flag for cplflx collection .false. +
cplwav gfs_control_type logical flag for cplwav collection .false. +
cplchm gfs_control_type logical flag for chemistry collection .false. +
lsidea gfs_control_type logical flag for idealized physics .false.
oz_phys gfs_control_type flag for old (2006) ozone physics .true.
oz_phys_2015 gfs_control_type flag for new (2015) ozone physics .false. - fhcyc | gfs_typedefs::gfs_control_type | frequency for surface data cycling in hours | 0.0 | - use_ufo | gfs_typedefs::gfs_control_type | flag for using unfiltered orography surface option | .false. | - pre_rad | gfs_typedefs::gfs_control_type | flag for testing purpose | .false. | - ncld | gfs_typedefs::gfs_control_type | number of hydrometeors | 1 | - +
fhcyc gfs_control_type frequency for surface data cycling in hours 0.0 +
use_ufo gfs_control_type flag for using unfiltered orography surface option .false. +
pre_rad gfs_control_type flag for testing purpose .false. +
ncld gfs_control_type number of hydrometeors 1 +
imp_physics gfs_control_type choice of microphysics scheme: \n +
    +
  • 11: GFDL microphysics scheme +
  • 8: Thompson microphysics scheme +
  • 10: Morrison-Gettelman microphysics scheme +
+ 		99 +
pdfcld gfs_control_type flag for PDF clouds .false. +
fhswr gfs_control_type frequency for shortwave radiation (secs) 3600. +
fhlwr gfs_control_type frequency for longwave radiation (secs) 3600. +
levr gfs_control_type number of vertical levels for radiation calculations -99 +
nfxr gfs_control_type second dimension of radiation input/output array fluxr 39+6 +
iflip gfs_control_type control flag for vertical index direction \n +
    +
  • 0: index from TOA to surface +
  • 1: index from surface to TOA +
+ 		1 +
icliq_sw gfs_control_type sw optical property for liquid clouds \n +
    +
  • 0: input cloud optical depth, ignoring iswcice setting +
  • 1: cloud optical property scheme based on Hu and Stamnes (1993) \cite hu_and_stamnes_1993 method +
  • 2: cloud optical property scheme based on Hu and Stamnes (1993) \cite hu_and_stamnes_1993 - updated +
+ 		1 +
iovr_sw gfs_control_type control flag for cloud overlap in SW radiation \n +
    +
  • 0: random overlapping clouds +
  • 1: max/ran overlapping clouds +
  • 2: maximum overlap clouds (mcica only) +
  • 3: decorrelation-length overlap (mcica only) +
+ 		1 +
iovr_lw gfs_control_type control flag for cloud overlap in LW radiation \n +
    +
  • 0: random overlapping clouds +
  • 1: max/ran overlapping clouds +
  • 2: maximum overlap clouds (mcica only) +
  • 3: decorrelation-length overlap (mcica only) +
+ 		1 +
ictm gfs_control_type external data time/date control flag \n +
    +
  • -2: same as 0, but superimpose seasonal cycle from climatology data set +
  • -1: use user provided external data for the forecast time, no extrapolation +
  • 0: use data at initial condition time, if not available, use latest, no extrapolation +
  • 1: use data at the forecast time, if not available, use latest and extrapolation +
  • yyyy0: use yyyy data for the forecast time, no further data extrapolation +
  • yyyy1: use yyyy data for the forecast. if needed, do extrapolation to match the fcst time +
+ 		1 +
crick_proof gfs_control_type control flag for eliminating CRICK \n +
    +
  • .true.: apply layer smoothing to eliminate CRICK +
  • .false.: do not apply layer smoothing +
+ 		.false. +
ccnorm gfs_control_type control flag for in-cloud condensate mixing ratio \n +
    +
  • .true.: normalize cloud condensate +
  • .false.: not normalize cloud condensate +
+ 		.false. +
norad_precip gfs_control_type control flag for not using precip in radiation (Ferrier scheme) \n +
    +
  • .true.: snow/rain has no impact on radiation +
  • .false.: snow/rain has impact on radiation +
+ 		.false. +
ialb gfs_control_type SW surface albedo control flag: \n +
    +
  • 0: using climatology surface albedo scheme for SW +
  • 1: using MODIS based land surface albedo for SW +
+ 		0 +
iems gfs_control_type LW surface emissivity control flag (ab 2-digit integer) : \n +
    +
  • a: =0 set surface air/ground t same for LW radiation +
  • =1 set surface air/ground t diff for LW radiation +
  • b: =0 use fixed surface emissivity = 1.0 (black-body) +
  • =1 use varying climatology surface emissivity (veg based) +
  • =2 future development (not yet) +
+ 		0 +
iaer gfs_control_type aerosol flag "abc" (volcanic, LW, SW): \n +
    +
  • a: stratospheric volcanic aerosols +
  • b: tropospheric aerosols for LW +
  • c: tropospheric aerosols for SW \n + 0: aerosol effect is not included; \n + 1: aerosol effect is included +
+ 		1 +
ico2 gfs_control_type \f$CO_2\f$ data source control flag:\n +
    +
  • 0: prescribed value (380 ppmv) +
  • 1: yearly global averaged annual mean from observations +
  • 2: monthly 15 degree horizontal resolution from observations +
+ 		0 +
isubc_sw gfs_control_type subgrid cloud approximation control flag in SW radiation: \n +
    +
  • 0: no McICA approximation in SW radiation +
  • 1: use McICA with prescribed permutation seeds (test mode) +
  • 2: use McICA with randomly generated permutation seeds +
+ 		0 +
isubc_lw gfs_control_type subgrid cloud approximation control flag in LW radiation: \n +
    +
  • 0: no McICA approximation in LW radiation +
  • 1: use McICA with prescribed permutatition seeds (test mode) +
  • 2: use McICA with randomly generated permutation seeds +
+ 		0 +
isol gfs_control_type solar constant scheme control flag: \n +
    +
  • 0: fixed value = 1366.0 \f$W m^{-2}\f$ (old standard) +
  • 10: fixed value = 1360.8 \f$W m^{-2}\f$ (new standard) +
  • 1: NOAA ABS-scale TSI table (yearly) with 11-yr cycle approximation +
  • 2: NOAA TIM-scale TSI table (yearly) with 11-yr cycle approximation +
  • 3: CMIP5 TIM-scale TSI table (yearly) with 11-yr cycle approximation +
  • 4: CMIP5 TIM-scale TSI table (monthly) with 11-yr cycle approximation +
+ 		0 +
lwhtr gfs_control_type logical flag for output of longwave heating rate .true. +
swhtr gfs_control_type logical flag for output of shortwave heating rate .true. +
cnvgwd gfs_control_type logical flag for convective gravity wave drag scheme .false. +
shal_cnv gfs_control_type logical flag for calling shallow convection .false. +
lmfshal gfs_control_type flag for mass-flux shallow convection scheme in the cloud fraction calculation shal_cnv .and. (imfshalcnv > 0) +
lmfdeep2 gfs_control_type flag for mass-flux deep convection scheme in the cloud fraction calculation imfdeepcnv == 2 .or. 3 .or.4 +
cal_pre gfs_control_type logical flag for calling precipitation type algorithm .false. +
redrag gfs_control_type logical flag for applying reduced drag coefficient for high wind over sea in GFS surface layer scheme .false. +
dspheat gfs_control_type logical flag for using TKE dissipative heating to temperature tendency in hybrid EDMF and TKE-EDMF schemes .false. +
hybedmf gfs_control_type logical flag for calling hybrid EDMF PBL scheme .false. +
satmedmf gfs_control_type logical flag for calling TKE EDMF PBL scheme .false. +
do_mynnedmf gfs_control_type flag to activate MYNN-EDMF scheme .false. +
random_clds gfs_control_type logical flag for whether clouds are random .false. +
trans_trac gfs_control_type logical flag for convective transport of tracers .false. +
lheatstrg gfs_control_type logical flag for canopy heat storage parameterization .false. +
shinhong gfs_control_type flag for scale-aware Shinhong PBL scheme .false. +
do_ysu gfs_control_type flag for YSU PBL scheme .false. +
cnvcld gfs_control_type logical flag for convective cloud .false. +
imfshalcnv gfs_control_type flag for mass flux shallow convective scheme:\n +
    +
  • 1:July 2010 version of mass-flux shallow convective scheme (operational as of 2016) +
  • 2: scale- & aerosol-aware mass-flux shallow convective scheme (2017) +
  • 3: scale- & aerosol-aware Grell-Freitas scheme (GSD) +
  • 4: new Tiedtke scheme (CAPS) +
  • 0: modified Tiedtke's eddy-diffusion shallow convective scheme +
  • -1: no shallow convection used +
+ 		1 +
imfdeepcnv gfs_control_type flag for mass-flux deep convective scheme:\n +
    +
  • 1: July 2010 version of SAS convective scheme (operational version as of 2016) +
  • 2: scale- & aerosol-aware mass-flux deep convective scheme (2017) +
  • 3: scale- & aerosol-aware Grell-Freitas scheme (GSD) +
  • 4: new Tiedtke scheme (CAPS) +
+ 		1 +
lgfdlmprad gfs_control_type flag for GFDL mp scheme and radiation consistency .false. +
cdmbgwd(2) gfs_control_type multiplication factors for mountain blocking and orographic gravity wave drag 2.0,0.25 +
prslrd0 gfs_control_type pressure level above which to apply Rayleigh damping 0.0d0 +
lsm gfs_control_type flag for land surface model to use \n +
    +
  • 0: OSU LSM +
  • 1: NOAH LSM +
  • 2: RUC LSM +
+ 		1 +
lsoil gfs_control_type number of soil layers 4 +
ivegsrc gfs_control_type flag for vegetation type dataset choice: \n +
    +
  • 0: USGS +
  • 1: IGBP(20 category) +
  • 2: UMD (13 category) +
+ 		2 +
isot gfs_control_type flag for soil type dataset choice:\n +
    +
  • 0: Zobler soil type (9 category) +
  • 1: STATSGO soil type (19 category) +
+ 		0 +
mom4ice gfs_control_type flag controls mom4 sea ice .false. +
debug gfs_control_type flag for debug printout .false. +
nstf_name(5) gfs_control_type NSST related paramters:\n +
    +
  • nstf_name(1): 0=NSSTM off, 1= NSSTM on but uncoupled, 2= NSSTM on and coupled +
  • nstf_name(2): 1=NSSTM spin up on, 0=NSSTM spin up off +
  • nstf_name(3): 1=NSST analysis on, 0=NSSTM analysis off +
  • nstf_name(4): zsea1 in mm +
  • nstf_name(5): zesa2 in mm +
+ 		/0,0,1,0,5/ +
nst_anl gfs_control_type flag for NSSTM analysis in gcycle/sfcsub .false. +
effr_in gfs_control_type logical flag for using input cloud effective radii calculation .false. +
aero_in gfs_control_type logical flag for using aerosols in Morrison-Gettelman microphysics .false. +
iau_delthrs gfs_control_type incremental analysis update (IAU) time interval in hours 6 +
iaufhrs gfs_control_type forecast hours associated with increment files -1 +
\b Parameters \b Specific \b to \b csawmg \b Suite +
crtrh(3) gfs_control_type critical relative humidity at the surface, PBL top and at the top of the atmosphere 0.90,0.90,0.90 +
cscnv gfs_control_type logical flag for Chikira-Sugiyama deep convection .false. +
do_aw gfs_control_type flag for Arakawa-Wu scale-awere adjustment .false. +
do_awdd gfs_control_type flag to enable treating convective tendencies following Arakwaw-Wu for downdrafts (2013) .false. +
do_sb_physics gfs_control_type logical flag for SB2001 autoconversion or accretion .true. +
do_cldice gfs_control_type flag for cloud ice processes for MG microphysics .true. +
hetfrz_classnuc gfs_control_type flag for heterogeneous freezing for MG microphysics .false. +
mg_nccons gfs_control_type flag for constant droplet concentration for MG microphysics .false. +
mg_nicons gfs_control_type flag for constant ice concentration for MG microphysics .false. +
mg_ngcons gfs_control_type flag for constant graupel concentration for MG microphysics .false. +
sed_supersat gfs_control_type flag for allowing supersaturation after sedimentation for MG microphysics .true. +
mg_do_graupel gfs_control_type flag for turning on prognostic graupel (with fprcp=2) .true. +
mg_do_hail gfs_control_type flag for turning on prognostic hail (with fprcp=2) .false. +
shcnvcw gfs_control_type logical flag for shallow convective cloud .false. +
xkzm_h gfs_control_type background vertical diffusion for heat and q 1.0d0 +
xkzm_m gfs_control_type background vertical diffusion for momentum 1.0d0 +
xkzm_s gfs_control_type sigma threshold for background mom. diffusion 1.0d0 +
xkzminv gfs_control_type maximum background value of heat diffusivity in the inversion layer 0.3 +
microp_uniform gfs_control_type logical flag for uniform subcolumns for MG microphysics .true. +
mg_do_ice_gmao gfs_control_type logical flag for turning on gmao ice autoconversion in MG microphysics .false. +
mg_do_liq_liu gfs_control_type logical flag for turning on Liu liquid treatment in MG microphysics .true. +
mg_dcs gfs_control_type autoconversion size threshold for cloud ice to snow in MG microphysics 200.0 +
mg_alf gfs_control_type tuning factor for alphas (alpha = 1 - critical relative humidity) 1.0 +
mg_ts_auto_ice(2) gfs_control_type autoconversion time scale for ice in MG microphysics 180.0,180.0 +
mg_qcvar gfs_control_type cloud water relative variance in MG microphysics 1.0 +
mg_rhmini gfs_control_type relative humidity threshold parameter for nucleating ice 1.01 +
mg_ncnst gfs_control_type constant droplet num concentration \f$m^{-3}\f$ 100.e6 +
mg_ninst gfs_control_type constant ice num concentration \f$m^{-3}\f$ 0.15e6 +
mg_ngnst gfs_control_type constant graupel/hail num concertration \f$m^{-3}\f$ 0.10e6 +
mg_berg_eff_factor gfs_control_type berg efficiency factor 2.0 +
mg_qcmin(2) gfs_control_type min liquid and ice mixing ratio in MG macro clouds 1.0d-9, 1.0d-9 +
mg_precip_frac_method gfs_control_type type of precipitation fraction method 'max_overlap' +
fprcp gfs_control_type number of frozen precipitation species in MG microphysics \n +
    +
  • 0: no prognostic rain and snow +
  • 1: MG2 +
  • 2: MG3 +
+ 		0 +
pdfflag gfs_control_type pdf flag for MG macro physics 4 +
cs_parm(10) gfs_control_type tunable parameters for Chikira-Sugiyama convection 8.0,4.0,1.0e3,3.5e3,20.0,1.0,-999.,1.,0.6,0. +
iccn gfs_control_type flag for using IN and CCN forcing in MG2/3 microphysics .false. +
rhcmax gfs_control_type maximum critical relative humidity 0.9999999 +
\b Parameters \b Specific \b to \b GSD_v0 \b Suite +
ltaerosol gfs_control_type logical flag for using aerosol climotology in Thompson MP scheme .false. +
lradar gfs_control_type logical flag for computing radar reflectivity in Thompson MP scheme .false. +
ttendlim gfs_control_type temperature tendency limiter per time step in K/s, set to < 0 to deactivate -999.0 +
do_mynnsfclay gfs_control_type flag to activate MYNN-SFCLAY scheme .false. +
grav_settling gfs_control_type flag to activate gravitational settling of cloud droplets as described in Nakanishi (2000) \cite nakanishi_2000 0 +
bl_mynn_mixlength gfs_control_type flag for different version of mixing length formulation \n +
    +
  • 0: Original form from Nakanishi and Niino (2009) \cite NAKANISHI_2009 . NO scale-awareness is applied to the master mixing length, regardless of "scaleware" setting +
  • 1: HRRR operational form 201609-201807. Designed to work without the mass-flux scheme. Uses BouLac mixing length in free atmosphere. +
  • 2: HRRR operational form 201807-present. Designed to be compatible with mass-flux scheme activated (default) +
+ 		2 +
bl_mynn_edmf gfs_control_type flag to activate the mass-flux scheme \n +
    +
  • 0: deactivate mass-flux scheme +
  • 1: activate dynamic multiplume mass-flux scheme +
+ 		0 +
bl_mynn_edmf_mom gfs_control_type flag to activate the transport of momentum \n +
    +
  • 0: deactivate momentum transport in mass-flux scheme +
  • 1: activate momentum transport in dynamic multiplume mass-flux scheme. \p bl_mynn_edmf must be set to 1 +
+ 		1 +
bl_mynn_edmf_tke gfs_control_type flag to activate the transport of TKE \n +
    +
  • 0: deactivate TKE transport in mass-flux scheme +
  • 1: activate TKE transport in dynamic multiplume mass-flux scheme. \p bl_mynn_edmf must be set to 1 +
+ 		0 +
bl_mynn_edmf_part gfs_control_type flag to partitioning the MF and ED areas 0 +
bl_mynn_edmf_tkeadvect gfs_control_type activate computation of TKE advection (not yet in use for FV3) \n +
    +
  • false: deactivate TKE advection +
  • true: activate TKE advection +
+ 		.false. +
bl_mynn_edmf_tkebudget gfs_control_type flag to activate TKE budget 0 +
bl_mynn_edmf_cloudpdf gfs_control_type flag to determine which cloud PDF to use \n +
    +
  • 0: use Sommeria-Deardorff subgrid cloud PDF +
  • 1: use Kuwano-Yoshida subgrid cloud PDF +
  • 2: use modified Chaboureau-Bechtold subgrid cloud PDF +
+ 		2 +
bl_mynn_edmf_cloudmix gfs_control_type flag to activate mixing of cloud species \n +
    +
  • 0: deactivate the mixing of any water species mixing ratios +
  • 1: activate the mixing of all water species mixing ratios +
+ 		1 +
bl_mynn_mixqt gfs_control_type flag to mix total water or individual species \n +
    +
  • 0: mix individual water species separately +
  • 1: DO NOT USE +
+ 		0 +
icloud_bl gfs_control_type flag to coupling SGS clouds to radiation \n +
    +
  • 0: deactivate coupling subgrid clouds to radiation +
  • 1: activate subgrid cloud coupling to radiation (highly suggested) +
+ 		1 +
lsoil_lsm gfs_control_type number of soil layers internal to land surface model -1 +
\b Stochastic \b Physics \b Specific \b Parameters +
do_sppt gfs_control_type flag for stochastic SPPT option .false. +
do_shum gfs_control_type flag for stochastic SHUM option .false. +
do_skeb gfs_control_type flag for stochastic SKEB option .false. +
do_sfcperts gfs_control_type flag for stochastic surface perturbations option .false. +
\b &nam_sfcperts +
nsfcpert gfs_control_type number of weights for stochastic surface perturbation 0 +
pertz0 gfs_control_type magnitude of perturbation of momentum roughness length -999. +
pertzt gfs_control_type magnitude of perturbation of heat to momentum roughness length ratio -999. +
pertshc gfs_control_type magnitude of perturbation of soil hydraulic conductivity -999. +
pertlai gfs_control_type magnitude of perturbation of leaf area index -999. +
pertalb gfs_control_type magnitude of surface albedo perturbation -999. +
pertvegf gfs_control_type magnitude of perturbation of vegetation fraction -999. +
iseed_sfc compns_stochy_mod random seeds (if 0 use system clock) 0 +
sfc_tau compns_stochy_mod time scales -999. +
sfc_lscale compns_stochy_mod length scales -999. +
sppt_land compns_stochy_mod .false. +
\b &stochy_nam +
use_zmtnblck compns_stochy_mod flag for mountain blocking. .T. = do not apply perturbations below the dividing streamline that is diagnosed by the gravity wave drag, mountain blocking scheme .false. +
ntrunc compns_stochy_mod spectral resolution (e.g. T126) of random patterns -999 +
lon_s, lat_s compns_stochy_mod number of longitude and latitude point for the Gaussian grid -999 +
fhstoch compns_stochy_mod forecast hour to write out random pattern in order to restart the pattern for a different forecast (used in DA), file is stoch_out.F -999.0 +
stochini compns_stochy_mod set to true if wanting to read in a previous random pattern (input file need to be named \c stoch_ini) .false. +
sppt compns_stochy_mod amplitude of random patterns -999. +
sppt_tau compns_stochy_mod decorrelation timescales in seconds -999. +
sppt_lscale compns_stochy_mod decorrelation spatial scales in meters -999. +
sppt_logit compns_stochy_mod logit transform for SPPT to bounded interval [-1,+1] .false. +
iseed_sppt compns_stochy_mod seeds for setting the random number sequence (ignored if \c stochini is true) 0 +
sppt_sigtop1, sppt_sigtop2 compns_stochy_mod sigma levels to taper perturbations to zeros 0.1, 0.025 +
sppt_sfclimit compns_stochy_mod reduce amplitude of SPPT near surface (lowest 2 levels) .false. +
shum compns_stochy_mod amplitude of stochastic boundary layer specific humidity perturbations -999. +
shum_tau compns_stochy_mod decorrelation time scales in seconds -999. +
shum_lscale compns_stochy_mod decorrelation spatial scales in meters -999. +
shum_sigefold compns_stochy_mod e-folding lengthscale (in units of sigma) of specific humidity perturbations 0.2 +
skeb compns_stochy_mod stochastic KE backscatter amplitude -999. +
skeb_tau compns_stochy_mod decorrelation timescales in seconds -999. +
skeb_lscale compns_stochy_mod decorrelation spatial scales in meter -999. +
iseed_skeb compns_stochy_mod seeds for setting the random number sequnce (ignored if \c stochini is true) 0 +
skeb_vfilt compns_stochy_mod 0 +
skebnorm compns_stochy_mod 0: random pattern is stream function,1: pattern is kenorm, 2: pattern is vorticity 0 +
skeb_varspect_opt compns_stochy_mod Gaussian or power law variance spectrum for SKEB (0: Gaussian, 1: power law) 0 +
skeb_npass compns_stochy_mod number of passes of smoother for dissipation estimate 11 +
skeb_vdof compns_stochy_mod the number of degrees of freedom in the vertical for the SKEB random pattern 5 +
skeb_sigtop1, skeb_sigtop2 compns_stochy_mod sigma levels to taper perturbations to zeros 0.1, 0.025 +
skebint compns_stochy_mod 0 +
\b &gfdl_cloud_microphysics_nml +
sedi_transport gfdl_cloud_microphys_mod logical flag for turning on horizontal momentum transport during sedimentation .true. +
do_sedi_heat gfdl_cloud_microphys_mod logical flag for turning on horizontal heat transport during sedimentation .true. +
rad_snow gfdl_cloud_microphys_mod logical flag for considering snow in cloud fraction calculation .true. +
rad_graupel gfdl_cloud_microphys_mod logical flag for considering graupel in cloud fraction calculation .true. +
rad_rain gfdl_cloud_microphys_mod logical flag for considering rain in cloud fraction calculation .true. +
const_vi gfdl_cloud_microphys_mod logical flag for using constant cloud ice fall speed .false. +
const_vs gfdl_cloud_microphys_mod logical flag for using constant snow fall speed .false. +
const_vg gfdl_cloud_microphys_mod logical flag for using constant graupel fall speed .false. +
const_vr gfdl_cloud_microphys_mod logical flag for using constant rain fall speed .false. +
vi_max gfdl_cloud_microphys_mod maximum fall speed for cloud ice 0.5 +
vs_max gfdl_cloud_microphys_mod maximum fall speed for snow 5.0 +
vg_max gfdl_cloud_microphys_mod maximum fall speed for graupel 8.0 +
vr_max gfdl_cloud_microphys_mod maximum fall speed for rain 12.0 +
qi_lim gfdl_cloud_microphys_mod cloud ice limiter to prevent large ice built up in cloud ice freezing and deposition 1. +
prog_ccn gfdl_cloud_microphys_mod logical flag for activating prognostic CCN (not supported in GFS Physics) .false. +
do_qa gfdl_cloud_microphys_mod logical flag for activating inline cloud fraction diagnosis in fast saturation adjustment .true. +
fast_sat_adj gfdl_cloud_microphys_mod logical flag for adjusting cloud water evaporation/freezing, cloud ice deposition when fast saturation adjustment is activated .true. +
tau_l2v gfdl_cloud_microphys_mod time scale for evaporation of cloud water to water vapor. Increasing(decreasing) \p tau_l2v can decrease(boost) deposition of cloud water to water vapor 300. +
tau_v2l gfdl_cloud_microphys_mod time scale for condensation of water vapor to cloud water. Increasing(decreasing) \p tau_v2l can decrease(boost) condensation of water vapor to cloud water 150. +
tau_g2v gfdl_cloud_microphys_mod time scale for sublimation of graupel to water vapor. Increasing(decreasing) \p tau_g2v can decrease(boost) sublimation of graupel to water vapor 900. +
rthresh gfdl_cloud_microphys_mod critical cloud water radius for autoconversion (cloud water -> rain). Increasing(decreasing) of \p rthresh makes the autoconversion harder(easier) 10.0e-6 +
dw_land gfdl_cloud_microphys_mod base value for subgrid deviation/variability over land 0.20 +
dw_ocean gfdl_cloud_microphys_mod base value for subgrid deviation/variability over ocean 0.10 +
ql_gen gfdl_cloud_microphys_mod maximum value for cloud water generated from condensation of water vapor (water vapor-> cloud water) 1.0e-3 +
ql_mlt gfdl_cloud_microphys_mod maximum value of cloud water allowed from melted cloud ice (cloud ice -> cloud water or rain) 2.0e-3 +
qi0_crt gfdl_cloud_microphys_mod threshold of cloud ice to snow autoconversion (cloud ice -> snow) 1.0e-4 +
qs0_crt gfdl_cloud_microphys_mod threshold of snow to graupel autoconversion (snow -> graupel) 1.0e-3 +
tau_i2s gfdl_cloud_microphys_mod time scale for autoconversion of cloud ice to snow 1000. +
c_psaci gfdl_cloud_microphys_mod accretion efficiency of cloud ice to snow 0.02 +
c_pgacs gfdl_cloud_microphys_mod accretion efficiency of snow to graupel 2.0e-3 +
rh_inc gfdl_cloud_microphys_mod relative humidity increment for complete evaporation of cloud water and cloud ice 0.25 +
rh_inr gfdl_cloud_microphys_mod relative humidity increment for sublimation of snow 0.25 +
rh_ins gfdl_cloud_microphys_mod relative humidity increment for minimum evaporation of rain 0.25 +
ccn_l gfdl_cloud_microphys_mod base CCN over land \f$cm^{-3}\f$ 270. +
ccn_o gfdl_cloud_microphys_mod base CCN over ocean \f$cm^{-3}\f$ 90. +
c_paut gfdl_cloud_microphys_mod autoconversion efficiency of cloud water to rain 0.55 +
c_cracw gfdl_cloud_microphys_mod accretion efficiency of cloud water to rain 0.9 +
use_ppm gfdl_cloud_microphys_mod \e true to use PPM fall scheme; \e false to use time-implicit monotonic fall scheme .false. +
use_ccn gfdl_cloud_microphys_mod \e true to compute prescribed CCN. It should be .true. when \p prog_ccn = .false. .false. +
mono_prof gfdl_cloud_microphys_mod \e true to turn on terminal fall with monotonic PPM scheme. This is used together with \p use_ppm=.true. .true. +
z_slope_liq gfdl_cloud_microphys_mod \e true to turn on vertically subgrid linear monotonic slope for autoconversion of cloud water to rain .true. +
z_slope_ice gfdl_cloud_microphys_mod \e true to turn on vertically subgrid linear monotonic slope for autoconversion of cloud ice to snow .false. +
de_ice gfdl_cloud_microphys_mod \e true to convert excessive cloud ice to snow to prevent ice over-built from other sources like convection scheme (not supported in GFS physics) .false. +
fix_negative gfdl_cloud_microphys_mod \e true to fix negative water species using nearby points .false. +
icloud_f gfdl_cloud_microphys_mod flag (0,1,or 2) for cloud fraction diagnostic scheme 0 +
mp_time gfdl_cloud_microphys_mod time step of GFDL cloud microphysics 150.
- - - -\section gfs_physics_nml GFS Physics Parameters - option | DDT in Host Model | Description | Default Value | --------------------|---------------------------------|----------------------------------------------------|---------------| - fhzero | gfs_typedefs::gfs_control_type | hour between clearing of diagnostic buckets | 0.0 | - h2o_phys | gfs_typedefs::gfs_control_type | flag for stratosphere h2o scheme | .false. | - ldiag3d | gfs_typedefs::gfs_control_type | flag for 3D diagnostic fields | .false. | - oz_phys | gfs_typedefs::gfs_control_type | flag for old (2006) ozone physics | .true. | - oz_phys_2015 | gfs_typedefs::gfs_control_type | flag for new (2015) ozone physics | .false. | - fhcyc | gfs_typedefs::gfs_control_type | frequency for surface data cycling in hours | 0.0 | - use_ufo | gfs_typedefs::gfs_control_type | flag for using unfiltered orography surface option | .false. | - pre_rad | gfs_typedefs::gfs_control_type | flag for testing purpose | .false. | - ncld | gfs_typedefs::gfs_control_type | number of hydrometeors | 1 | - imp_physics | gfs_typedefs::gfs_control_type | choice of microphysics scheme: \n 11: GFDL microphysics scheme \n 8: GSD Thompson microphysics scheme \n 6: WSMG microphysics scheme \n 10: Morrison-Gettelman microphysics scheme | 99 | - pdfcld | gfs_typedefs::gfs_control_type | flag for PDF clouds | .false. | - fhswr | gfs_typedefs::gfs_control_type | frequency for shortwave radiation (secs) | 3600. | - fhlwr | gfs_typedefs::gfs_control_type | frequency for longwave radiation (secs) | 3600. | - ialb | gfs_typedefs::gfs_control_type | SW surface albedo control flag: \n 0: using climatology surface albedo scheme for SW \n 1: using MODIS based land surface albedo for SW | 0 | - iems | gfs_typedefs::gfs_control_type | LW surface emissivity control flag: \n 0: black-body emissivity \n 1:surface type based climatology in 1 degree horizontal resolution | 0 | - iaer | gfs_typedefs::gfs_control_type | aerosol flag "abc" (volcanic, LW, SW): \n a: stratospheric volcanic aerosols \n b: tropospheric aerosols for LW \n c: tropospheric aerosols for SW.\n 0: aerosol effect is not included; 1: aerosol effect is included | 1 | - ico2 | gfs_typedefs::gfs_control_type | \f$CO_2\f$ data source control flag:\n 0: prescribed value (380 ppmv) \n 1: yearly global averaged annual mean from observations \n 2: monthly 15 degree horizontal resolution from observations| 0 | - isubc_sw | gfs_typedefs::gfs_control_type | subgrid cloud approximation control flag in SW radiation: \n 0: no McICA approximation in SW radiation \n 1: use McICA with prescribed permutation seeds (test mode) \n 2: use McICA with randomly generated permutation seeds | 0 | - isubc_lw | gfs_typedefs::gfs_control_type | subgrid cloud approximation control flag in LW radiation: \n 0: no McICA approximation in LW radiation \n 1: use McICA with prescribed permutation seeds (test mode) \n 2: use McICA with randomly generated permutation seeds | 0 | - isol | gfs_typedefs::gfs_control_type | solar constant scheme control flag: \n 0: fixed value = 1366.0 \f$W m^{-2}\f$ (old standard) \n 10: fixed value =1360.8 \f$W m^{-2}\f$ (new standard) \n 1: NOAA ABS-scale TSI table (yearly) with 11-yr cycle approximation \n 2: NOAA TIM-scale TSI table(yearly) with 11-yr cycle approximation \n 3: CMIP5 TIM-scale TSI table (yearly) with 11-yr cycle approximation \n 4: CMIP5 TIM-scale TSI table (monthly) with 11-yr cycle approximation | 0 | - lwhtr | gfs_typedefs::gfs_control_type | logical flag for output of longwave heating rate | .true. | - swhtr | gfs_typedefs::gfs_control_type | logical flag for output of shortwave heating rate | .true. | - cnvgwd | gfs_typedefs::gfs_control_type | logical flag for convective gravity wave drag scheme | .false. | - shal_cnv | gfs_typedefs::gfs_control_type | logical flag for calling shallow convection | .false. | - cal_pre | gfs_typedefs::gfs_control_type | logical flag for calling precipitation type algorithm | .false. | - redrag | gfs_typedefs::gfs_control_type | logical flag for applying reduced drag coefficient for high wind over sea in GFS surface layer scheme | .false. | - dspheat | gfs_typedefs::gfs_control_type | logical flag for using TKE dissipative heating to temperature tendency in hybrid EDMF and TKE-EDMF schemes | .false. | - hybedmf | gfs_typedefs::gfs_control_type | logical flag for calling hybrid EDMF PBL scheme | .false. | - random_clds | gfs_typedefs::gfs_control_type | logical flag for whether clouds are random | .false. | - trans_trac | gfs_typedefs::gfs_control_type | logical flag for convective transport of tracers | .false. | - cnvcld | gfs_typedefs::gfs_control_type | logical flag for convective cloud | .false. | - imfshalcnv | gfs_typedefs::gfs_control_type | flag for mass flux shallow convective scheme:\n 1:July 2010 version of mass-flux shallow convective scheme (operational as of 2016) \n 2: scale- & aerosol- aware mass-flux shallow convective scheme (2017) \n 0: modified Tiedtke's eddy-diffusion shallow convective scheme \n -1: no shallow convection used | 1 | - imfdeepcnv | gfs_typedefs::gfs_control_type | flag for mass-flux deep convective scheme:\n 1: July 2010 version of SAS convective scheme (operational version as of 2016) \n 2: scale- & aerosol-aware mass-flux deep convective scheme (2017) \n 0: old SAS convective scheme before July 2010 | 1 | - cdmbgwd(2) | gfs_typedefs::gfs_control_type | multiplication factors for mountain blocking and orographic gravity wave drag | /2.0d0,0.25d0/ | - prslrd0 | gfs_typedefs::gfs_control_type | pressure level above which to apply Rayleigh damping | 0.0d0 | - ivegsrc | gfs_typedefs::gfs_control_type | flag for vegetation type dataset choice: \n 0: USGS; 1: IGBP(20 category); 2: UMD (13 category) | 2 | - isot | gfs_typedefs::gfs_control_type | flag for soil type dataset choice:\n 0: Zobler soil type (9 category) \n 1: STATSGO soil type (19 category) | 0 | - debug | gfs_typedefs::gfs_control_type | flag for debug printout | .false. | - nstf_name(5) | gfs_typedefs::gfs_control_type | NSST related paramters:\n flag 0 for no NST; 1 for uncoupled nst; and 2 for coupled NST \n nstf_name(1): 0=NSSTM off, 1= NSSTM on but uncoupled, 2= NSSTM on and coupled \n nstf_name(2): 1=NSSTM spin up on, 0=NSSTM spin up off \n nstf_name(3): 1=NSST analysis on, 0=NSSTM analysis off \n nstf_name(4): zsea1 in mm \n nstf_name(5): zesa2 in mm | /0,0,1,0,5/ | - nst_anl | gfs_typedefs::gfs_control_type | flag for NSSTM analysis in gcycle/sfcsub | .false. | - satmedmf | gfs_typedefs::gfs_control_type | logical flag for calling TKE EDMF PBL scheme | .false. | - -\section cpt_physics_nml EMC CPT Physics Parameters - \c NML_option | Definition in Host Model | Description | Default Value | --------------------|----------------------------------|---------------------------------------------------|-----------------------| - crtrh(3) | gfs_typedefs::gfs_control_type | critical relative humidity at the surface, PBL top and at the top of the atmosphere | /0.90d0,0.90d0,0.90d0/ | - ras | gfs_typedefs::gfs_control_type | logical flag for RAS convection scheme | .false. | - cscnv | gfs_typedefs::gfs_control_type | logical flag for Chikira-Sugiyama deep convection | .false. | - do_aw | gfs_typedefs::gfs_control_type | flag for Arakawa-Wu scale-awere adjustment | .false. | - shcnvcw | gfs_typedefs::gfs_control_type | logical flag for shallow convective cloud | .false. | - xkzm_h | gfs_typedefs::gfs_control_type | background vertical diffusion for heat q | 1.0d0 | - xkzm_m | gfs_typedefs::gfs_control_type | background vertical diffusion for momentum | 1.0d0 | - xkzm_s | gfs_typedefs::gfs_control_type | sigma threshold for background mom. diffusion | 1.0d0 | - microp_uniform | gfs_typedefs::gfs_control_type | logical flag for uniform subcolumns for MG microphysics | .true. | - mg_do_ice_gmao | gfs_typedefs::gfs_control_type | logical flag for turning on gmao ice autoconversion in MG microphysics | .false. | - mg_do_liq_liu | gfs_typedefs::gfs_control_type | logical flag for turning on Liu liquid treatment in MG microphysics | .true. | - mg_dcs | gfs_typedefs::gfs_control_type | autoconversion size threshold for cloud ice to snow in MG microphysics | 200.0 | - mg_alf | gfs_typedefs::gfs_control_type | tuning factor for alphas (alpha = 1 - critical relative humidity) | 1.0 | - mg_ts_auto_ice(2) | gfs_typedefs::gfs_control_type | autoconversion time scale for ice in MG microphysics | /180.0,180.0/ | - mg_qcvar | gfs_typedefs::gfs_control_type | cloud water relative variance in MG microphysics | 1.0 | - fprcp | gfs_typedefs::gfs_control_type | number of frozen precipitation species in MG microphysics \n 0: no prognostic rain and snow, 1: MG2;2:MG3 | 0 | - cs_parm(10) | gfs_typedefs::gfs_control_type | tunable parameters for Chikira-Sugiyama convection | /8.0,4.0,1.0e3,3.5e3,20.0,1.0,-999.,1.,0.6,0./ | - iccn | gfs_typedefs::gfs_control_type | flag for using IN and CCN forcing in MG2/3 microphysics | .false. | - aero_in | gfs_typedefs::gfs_control_type | flag for using aerosols in MG microphysics | .false. | - ctei_rm(2) | gfs_typedefs::gfs_control_type | critical cloud top entrainment instability criteria (used if mstrat=.true.) | /10.0d0,10.0d0/ | - rhcmax | gfs_typedefs::gfs_control_type | maximum critical relative humidity | 0.9999999 | - effr_in | gfs_typedefs::gfs_control_type | logical flag for using input cloud effective radii calculation | .false. | - cplflx | gfs_typedefs::gfs_control_type | logical flag for controlling cplflx collection | .false. | - iau_delthrs | gfs_typedefs::gfs_control_type | incremental analysis update (IAU) time interval in hours | 6 | - iaufhrs | gfs_typedefs::gfs_control_type | forecast hours associated with increment files | -1 | - -\section gsd_hrrr_nml GSD Physics Parameters - \c NML_option | Definition in Host Model | Description | Default Value | ----------------------------|---------------------------------|-----------------------------------------------|-----------------------| - ltaerosol | gfs_typedefs::gfs_control_type | logical flag for using aerosol climotology | .false. | - lradar | gfs_typedefs::gfs_control_type | logical flag for computing radar reflectivity | .false. | - do_mynnedmf | gfs_typedefs::gfs_control_type | flag to activate MYNN-EDMF scheme | .false. | - do_mynnsfclay | gfs_typedefs::gfs_control_type | flag to activate MYNN-SFCLAY scheme | .false. | - lmfshal | gfs_typedefs::gfs_control_type | flag for mass-flux shallow convection scheme in the cloud fraction calculation (lmf=shal_cnv .and. imfshalcnv > 0) | shal_cnv .and. (imfshalcnv > 0) | - bl_mynn_mixlength | gfs_typedefs::gfs_control_type | flag for different version of mixing length formulation \n 0: Original form from Nakanishi and Niino (2009) \cite NAKANISHI_2009 . NO scale-awareness is applied to the master mixing length, regardless of "scaleware" setting \n 1: HRRR operational form 201609-201807.Designed to work without the mass-flux scheme. Uses BouLac mixing length in free atmosphere. \n 2: HRRR operational form 201807-present. Designed to be compatible with mass-flux scheme activated (default) | 2 | - bl_mynn_edmf | gfs_typedefs::gfs_control_type | flag to activate the mass-flux scheme \n 0: Deactivate mass-flux scheme \n 1: Activate dynamic multiplume mass-flux scheme (default) | 0 | - bl_mynn_edmf_mom | gfs_typedefs::gfs_control_type | flag to activate the transport of momentum \n 0: Deactivate momentum transport in mass-flux scheme (default) \n 1: Activate momentum transport in dynamic multiplume mass-flux scheme. \p bl_mynn_edmf must be set to 1 | 1 | - bl_mynn_edmf_tke | gfs_typedefs::gfs_control_type | flag to activate the transport of TKE \n 0: Deactivate TKE transport in mass-flux scheme (default) \n 1: Activate TKE transport in dynamic multiplume mass-flux scheme. \p bl_mynn_edmf must be set to 1 | 0 | - bl_mynn_edmf_tkeadvect | gfs_typedefs::gfs_control_type | activate computation of TKE advection (not yet in use for FV3) \n False: Deactivate TKE advection (default) \n True: Activate TKE advection | .false. | - bl_mynn_edmf_tkebudget | gfs_typedefs::gfs_control_type | flag to activate TKE budget | 0 | - bl_mynn_edmf_cloudpdf | gfs_typedefs::gfs_control_type | flag to determine which cloud PDF to use \n 0: use Sommeria-Deardorff subgrid cloud PDF \n 1: use Kuwano-Yoshida subgrid cloud PDF \n 2: use modified Chaboureau-Bechtold subgrid cloud PDF (default) | 2 | - bl_mynn_edmf_cloudmix | gfs_typedefs::gfs_control_type | flag to activate mixing of cloud species \n: Deactivate the mixing of any water species mixing ratios \n 1: activate the mixing of all water species mixing ratios (default) | 1 | - bl_mynn_mixqt | gfs_typedefs::gfs_control_type | flag to mix total water or individual species \n 0: Mix individual water species separately (default) \n 1: DO NOT USE | 0 | - icloud_bl | gfs_typedefs::gfs_control_type | flag to coupling sgs clouds to radiation \n 0: Deactivate coupling subgrid clouds to radiation \n 1: Activate subgrid cloud coupling to radiation (highly suggested) | 1 | - lsoil_lsm | gfs_typedefs::gfs_control_type | number of soil layers internal to land surface model | -1 | - lsm | gfs_typedefs::gfs_control_type | flag for land surface model | 1 | - -\section stochy_nml Stochastic Physics Parameters - \c NML_option | Definition in Host Model | Description | Default Value | --------------------|--------------------------------|-----------------------------------------------------------------------|---------------| - do_sppt | gfs_typedefs::gfs_control_type | flag for stochastic SPPT option | .false. | - do_shum | gfs_typedefs::gfs_control_type | flag for stochastic SHUM option | .false. | - do_skeb | gfs_typedefs::gfs_control_type | flag for stochastic SKEB option | .false. | - use_zmtnblck | gfs_typedefs::gfs_control_type | flag for mountain blocking | .false. | - do_sfcperts | gfs_typedefs::gfs_control_type | flag for stochastic surface perturbations option | .false. | - nsfcpert | gfs_typedefs::gfs_control_type | number of weights for stochastic surface perturbation | 6 | - pertz0 | gfs_typedefs::gfs_control_type | magnitude of perturbation of momentum roughness length | -999. | - pertzt | gfs_typedefs::gfs_control_type | magnitude of perturbation of heat to momentum roughness length ratio | -999. | - pertshc | gfs_typedefs::gfs_control_type | magnitude of perturbation of soil hydraulic conductivity | -999. | - pertlai | gfs_typedefs::gfs_control_type | magnitude of perturbation of leaf area index | -999. | - pertalb | gfs_typedefs::gfs_control_type | magnitude of surface albedo perturbation | -999. | - pertvegf | gfs_typedefs::gfs_control_type | magnitude of perturbation of vegetation fraction | -999. | - -\subsection gen_stochy_nml General Stochastic Physics Paramters - \c NML_option | Definition in Host Model | Description | Default Value | --------------------|----------------------------|--------------------------------------------------------------|---------------| - ntrunc | compns_stochy_mod | spectral resolution (e.g. T126) of random patterns | -999 | - lon_s, lat_s | compns_stochy_mod | number of longitude and latitude point for the Gaussian grid | -999 | - fhstoch | compns_stochy_mod | forecast hour to write out random pattern in order to restart the pattern for a different forecast (used in DA), file is stoch_out.F | -999.0 | - stochini | compns_stochy_mod | set to true if wanting to read in a previous random pattern (input file need to be named \c stoch_ini) | -999.0 | .false. | - -\subsection sppt_contrl_nml SPPT Control Parameters - \c NML_option | Definition in Host Model | Description | Default Value | --------------------|----------------------------|--------------------------------------------------------------------------------|---------------| - sppt | compns_stochy_mod | amplitude of random patterns | -999. | - sppt_tau | compns_stochy_mod | decorrelation timescales in secods | -999. | - sppt_lscale | compns_stochy_mod | decorrelation spatial scales in meters | -999. | - sppt_logit | compns_stochy_mod | logit transform for SPPT to bounded interval [-1,+1] | .false. | - iseed_sppt | compns_stochy_mod | seeds for setting the random number sequence (ignored if \c stochini is true) | 0 | - sppt_sigtop1, sppt_sigtop2 | compns_stochy_mod | sigma levels to taper perturbations to zeros | 0.1, 0.025 | - sppt_sfclimit | compns_stochy_mod | reduce amplitude of SPPT near surface (lowest 2 levels) | .false. | - use_zmtnblck | gfs_typedefs::gfs_control_type | flag for mountain blocking. .T. = do not apply perturbations below the dividing streamline that is diagnosed by the gravity wave drag, mountain blocking scheme | .false. | - - -\subsection shum_contrl_nml SHUM Control Parameters - \c NML_option | Definition in Host Model | Description | Default Value | --------------------|----------------------------|------------------------------------------------------------------------------|---------------| - shum | compns_stochy_mod | amplitude of stochastic boundary layer specific humidity perturbations | -999. | - shum_tau | compns_stochy_mod | decorrelation time scales in seconds | -999. | - shum_lscale | compns_stochy_mod | decorrelation spatial scales in meters | -999. | - shum_sigefold | compns_stochy_mod | e-folding lengthscale (in units of sigma) of specific humidity perturbations | 0.2 | - -\subsection skeb_contrl_nml SKEB Control Parameters - \c NML_option | Definition in Host Model | Description | Default Value | -------------------------------|----------------------------|------------------------------------------------------------------------------------|---------------| - skeb | compns_stochy_mod | stochastic KE backscatter amplitude | -999. | - skeb_tau | compns_stochy_mod | decorrelation timescales in seconds | -999. | - skeb_lscale | compns_stochy_mod | decorrelation spatial scales in meter | -999. | - iseed_skeb | compns_stochy_mod | seeds for setting the random number sequnce (ignored if \c stochini is true) | 0 | - skebnorm | compns_stochy_mod | 0: random pattern is stream function,1: pattern is kenorm, 2: pattern is vorticity | 0 | - skeb_varspect_opt | compns_stochy_mod | Gaussian or power law variance spectrum for SKEB (0: Gaussian, 1: power law | 0 | - skeb_npass | compns_stochy_mod | number of passes of smoother for dissipation estimate | 11 | - skeb_vdof | compns_stochy_mod | the number of degrees of freedom in the vertical for the SKEB random pattern | 5 | - skeb_sigtop1, skeb_sigtop2 | compns_stochy_mod | sigma levels to taper perturbations to zeros | 0.1, 0.025 | - - - -\section zhao_carr_nml Zhao-Carr MP Parameters - \c NML_option | DDT in Host Model | Description | Default Value | --------------------|---------------------------------|-----------------------------------------------|---------------------| - psautco(2) | gfs_typedefs::gfs_control_type | auto conversion coeff from ice to snow | /6.0d-4,3.0d-4/ | - prautco(2) | gfs_typedefs::gfs_control_type | auto conversion coeff from cloud to rain | /1.0d-4,1.0d-4/ | - -\section gfdl_cloud_microphysics_nml GFDL Cloud MP Parameters -The namelist variable description is provided in module_gfdl_cloud_microphys.F90 - \c NML_option | Definition in CCPP | Description | Default Value | --------------------------|---------------------------|--------------------------------------------------------------------------------|----------------------| - sedi_transport | gfdl_cloud_microphys_mod | logical flag for turning on horizontal momentum transport during sedimentation | .true. | - do_sedi_heat | gfdl_cloud_microphys_mod | logical flag for turning on horizontal heat transport during sedimentation | .true. | - rad_snow | gfdl_cloud_microphys_mod | logical flag for considering snow in cloud fraction calculation | .true. | - rad_graupel | gfdl_cloud_microphys_mod | logical flag for considering graupel in cloud fraction calculation | .true. | - rad_rain | gfdl_cloud_microphys_mod | logical flag for considering rain in cloud fraction calculation | .true. | - const_vi | gfdl_cloud_microphys_mod | logical flag for using constant cloud ice fall speed | .false. | - const_vs | gfdl_cloud_microphys_mod | logical flag for using constant snow fall speed | .false. | - const_vg | gfdl_cloud_microphys_mod | logical flag for using constant graupel fall speed | .false. | - const_vr | gfdl_cloud_microphys_mod | logical flag for using constant rain fall speed | .false. | - vi_max | gfdl_cloud_microphys_mod | maximum fall speed for cloud ice | 0.5 | - vs_max | gfdl_cloud_microphys_mod | maximum fall speed for snow | 5.0 | - vg_max | gfdl_cloud_microphys_mod | maximum fall speed for graupel | 8.0 | - vr_max | gfdl_cloud_microphys_mod | maximum fall speed for rain | 12.0 | - qi_lim | gfdl_cloud_microphys_mod | cloud ice limiter to prevent large ice built up in cloud ice freezing and deposition | 1. | - prog_ccn | gfdl_cloud_microphys_mod | logical flag for activating prognostic CCN (not supported in GFS Physics) | .false. | - do_qa | gfdl_cloud_microphys_mod | logical flag for activating inline cloud fraction diagnosis in fast saturation adjustment | .true. | - fast_sat_adj | gfdl_cloud_microphys_mod | logical flag for adjusting cloud water evaporation/freezing, cloud ice deposition when fast saturation adjustment is activated (do_sat_adj=.true.) | .true. | - tau_l2v | gfdl_cloud_microphys_mod | time scale for evaporation of cloud water to water vapor. Increasing(decreasing) \p tau_l2v can decrease(boost) deposition of cloud water to water vapor | 300. | - tau_v2l | gfdl_cloud_microphys_mod | time scale for condensation of water vapor to cloud water. Increasing(decreasing) \p tau_v2l can decrease(boost) condensation of water vapor to cloud water | 150. | - tau_g2v | gfdl_cloud_microphys_mod | time scale for sublimation of graupel to water vapor. Increasing(decreasing) \p tau_g2v can decrease(boost) sublimation of graupel to water vapor | 900. | - rthresh | gfdl_cloud_microphys_mod | critical cloud water radius for autoconversion (cloud water -> rain). Increasing(decreasing) of \p rthresh makes the autoconversion harder(easier) | 10.0e-6 | - dw_land | gfdl_cloud_microphys_mod | base value for subgrid deviation/variability over land | 0.20 | - dw_ocean | gfdl_cloud_microphys_mod | base value for subgrid deviation/variability over ocean | 0.10 | - ql_gen | gfdl_cloud_microphys_mod | maximum value for cloud water generated from condensation of water vapor (water vapor-> cloud water) | 1.0e-3 | - ql_mlt | gfdl_cloud_microphys_mod | maximum value of cloud water allowed from melted cloud ice (cloud ice -> cloud water or rain) | 2.0e-3 | - qi0_crt | gfdl_cloud_microphys_mod | threshold of cloud ice to snow autoconversion (cloud ice -> snow) | 1.0e-4 | - qs0_crt | gfdl_cloud_microphys_mod | threshold of snow to graupel autoconversion (snow->graupel) | 1.0e-3 | - tau_i2s | gfdl_cloud_microphys_mod | time scale for autoconversion of cloud ice to snow | 1000. | - c_psaci | gfdl_cloud_microphys_mod | accretion efficiency of cloud ice to snow | 0.02 | - c_pgacs | gfdl_cloud_microphys_mod | accretion efficiency of snow to graupel | 2.0e-3 | - rh_inc | gfdl_cloud_microphys_mod | relative humidity increment for complete evaporation of cloud water and cloud ice | 0.25 | - rh_inr | gfdl_cloud_microphys_mod | relative humidity increment for sublimation of snow | 0.25 | - rh_ins | gfdl_cloud_microphys_mod | relative humidity increment for minimum evaporation of rain | 0.25 | - ccn_l | gfdl_cloud_microphys_mod | base CCN over land \f$cm^{-3}\f$ | 270. | - ccn_o | gfdl_cloud_microphys_mod | base CCN over ocean \f$cm^{-3}\f$ | 90. | - c_paut | gfdl_cloud_microphys_mod | autoconversion efficiency of cloud water to rain | 0.55 | - c_cracw | gfdl_cloud_microphys_mod | accretion efficiency of cloud water to rain | 0.9 | - use_ppm | gfdl_cloud_microphys_mod | \e true to use PPM fall scheme; \e false to use time-implicit monotonic fall scheme | .false. | - use_ccn | gfdl_cloud_microphys_mod | \e true to compute prescribed CCN. It should be .true. when \p prog_ccn = .false. | .false. | - mono_prof | gfdl_cloud_microphys_mod | \e true to turn on terminal fall with monotonic PPM scheme. This is used together with \p use_ppm=.true. | .true. | - z_slope_liq | gfdl_cloud_microphys_mod | \e true to turn on vertically subgrid linear monotonic slope for autoconversion of cloud water to rain | .true. | - z_slope_ice | gfdl_cloud_microphys_mod | \e true to turn on vertically subgrid linear monotonic slope for autoconversion of cloud ice to snow | .false. | - de_ice | gfdl_cloud_microphys_mod | \e true to convert excessive cloud ice to snow to prevent ice over-built from other sources like convection scheme (not supported in GFS physics) | .false. | - fix_negative | gfdl_cloud_microphys_mod | \e true to fix negative water species using nearby points | .false. | - icloud_f | gfdl_cloud_microphys_mod | flag (0,1,or 2) for cloud fraction diagnostic scheme | 0 | - mp_time | gfdl_cloud_microphys_mod | time step of GFDL cloud microphysics | 150. | - */ diff --git a/physics/drag_suite.F90 b/physics/drag_suite.F90 new file mode 100644 index 000000000..080bee156 --- /dev/null +++ b/physics/drag_suite.F90 @@ -0,0 +1,1306 @@ +!> \File drag_suite.F90 +!! This file is the parameterization of orographic gravity wave +!! drag, mountain blocking, and form drag. + +!> This module contains the CCPP-compliant orographic gravity wave dray scheme. + module drag_suite + + contains + +!> \section arg_table_drag_suite_init Argument Table +!! + subroutine drag_suite_init() + end subroutine drag_suite_init + +! \defgroup GFS_ogwd GFS Orographic Gravity Wave Drag +!> \defgroup gfs_drag_suite GFS drag_suite Main +!! \brief This subroutine includes orographic gravity wave drag, mountain +!! blocking, and form drag. +!! +!> The time tendencies of zonal and meridional wind are altered to +!! include the effect of mountain induced gravity wave drag from +!! subgrid scale orography including convective breaking, shear +!! breaking and the presence of critical levels. +!! +!> \section arg_table_drag_suite_run Argument Table +!! \htmlinclude drag_suite_run.html +!! +!> \section gen_drag_suite GFS Orographic GWD Scheme General Algorithm +!! -# Calculate subgrid mountain blocking +!! -# Calculate orographic wave drag +!! +!! The NWP model gravity wave drag (GWD) scheme in the GFS has two +!! main components: how the surface stress is computed, and then how +!! that stress is distributed over a vertical column where it may +!! interact with the models momentum. Each of these depends on the +!! large scale environmental atmospheric state and assumptions about +!! the sub-grid scale processes. In Alpert GWD (1987) based on linear, +!! two-dimensional non-rotating, stably stratified flow over a mountain ridge, +!! sub-grid scale gravity wave motions are assumed which propagate away +!! from the mountain. Described in Alpert (1987), the flux measured over +!! a "low level" vertically averaged layer, in the atmosphere defines a base +!! level flux. "Low level" was taken to be the first 1/3 of the troposphere +!! in the 1987 implementation. This choice was meant to encompass a thick +!! low layer for vertical averages of the environmental (large scale) flow +!! quantities. The vertical momentum flux or gravity wave stress in a +!! grid box due to a single mountain is given as in Pierrehumbert, (1987) (PH): +!! +!! \f$ \tau = \frac {\rho \: U^{3}\: G(F_{r})} {\Delta X \; N } \f$ +!! +!! emetic \f$ \Delta X \f$ is a grid increment, N is the Brunt Viasala frequency +!! +!! +!! \f$ N(\sigma) = \frac{-g \: \sigma \: +!! \frac{\partial\Theta}{\partial\sigma}}{\Theta \:R \:T} \f$ +!! +!! The environmental variables are calculated from a mass weighted vertical +!! average over a base layer. G(Fr) is a monotonically increasing +!! function of Froude number, +!! +!! \f$ F_{r} = \frac{N h^{'}}{U} \f$ +!! +!! where U is the wind speed calculated as a mass weighted vertical average in +!! the base layer, and h', is the vertical displacement caused by the orography +!! variance. An effective mountain length for the gravity wave processes, +!! +!! \f$ l^{*} = \frac{\Delta X}{m} \f$ +!! +!! where m is the number of mountains in a grid box, can then +!! be defined to obtain the form of the base level stress +!! +!! +!! \f$ \tau = \frac {\rho \: U^{3} \: G(F_{r})} {N \;l^{*}} \f$ +!! +!! giving the stress induced from the surface in a model grid box. +!! PH gives the form for the function G(Fr) as +!! +!! +!! \f$ G(F_{r}) = \bar{G}\frac{F^{2}_{r}}{F^{2}_{r}\: + \:a^{2}} \f$ +!! +!! Where \f$ \bar{G} \f$ is an order unity non-dimensional saturation +!! flux set to 1 and 'a' is a function of the mountain aspect ratio also +!!set to 1 in the 1987 implementation of the GFS GWD. Typical values of +!! U=10m/s, N=0.01 1/s, l*=100km, and a=1, gives a flux of 1 Pascal and +!! if this flux is made to go to zero linearly with height then the +!! decelerations would be about 10/m/s/day which is consistent with +!! observations in PH. +!! +!! +!! In Kim, Moorthi, Alpert's (1998, 2001) GWD currently in GFS operations, +!! the GWD scheme has the same physical basis as in Alpert (1987) with the addition +!! of enhancement factors for the amplitude, G, and mountain shape details +!! in G(Fr) to account for effects from the mountain blocking. A factor, +!! E m’, is an enhancement factor on the stress in the Alpert '87 scheme. +!! The E ranges from no enhancement to an upper limit of 3, E=E(OA)[1-3], +!! and is a function of OA, the Orographic Asymmetry defined in KA (1995) as +!! +!! Orographic Asymmetry (OA) = \f$ \frac{ \bar{x} \; - \; +!! \sum\limits_{j=1}^{N_{b}} x_{j} \; n_{j} }{\sigma_{x}} \f$ +!! +!! where Nb is the total number of bottom blocks in the mountain barrier, +!! \f$ \sigma_{x} \f$ is the standard deviation of the horizontal distance defined by +!! +!! \f$ \sigma_{x} = \sqrt{ \frac{\sum\limits_{j=1}^{N_{b}} +!! \; (x_{j} \; - \; \bar{x} )^2}{N_{x}} } \f$ +!! +!! +!! where Nx is the number of grid intervals for the large scale domain being +!! considered. So the term, E(OA)m’/ \f$ \Delta X \f$ in Kim's scheme represents +!! a multiplier on G shown in Alpert's eq (1), where m’ is the number of mountains +!! in a sub-grid scale box. Kim increased the complexity of m’ making it a +!! function of the fractional area of the sub-grid mountain and the asymmetry +!! and convexity statistics which are found from running a gravity wave +!! model for a large number of cases: +!! +!! \f$ m^{'} = C_{m} \Delta X \left[ \frac{1 \; + \; +!! \sum\limits_{x} L_{h} }{\Delta X} \right]^{OA+1} \f$ +!! +!! Where, according to Kim, \f$ \sum \frac{L_{h}}{\Delta X} \f$ is +!! the fractional area covered by the subgrid-scale orography higher than +!! a critical height \f$ h_{c} = Fr_{c} U_{0}/N_{0} \f$ , over the +!! "low level" vertically averaged layer, for a grid box with the interval +!! \f$ \Delta X \f$. Each \f$ L_{n}\f$ is the width of a segment of +!! orography intersection at the critical height: +!! +!! \f$ Fr_{0} = \frac{N_{0} \; h^{'}}{U_{0}} \f$ +!! +!! \f$ G^{'}(OC,Fr_{0}) = \frac{Fr_{0}^{2}}{Fr_{0}^{2} \; + \; a^{2}} \f$ +!! +!! \f$ a^{2} = \frac{C_{G}}{OC} \f$ +!! +!! \f$ E(OA, Fr_{0}) = (OA \; + \; 2)^{\delta} \f$ and \f$ \delta +!! \; = \; \frac{C_{E} \; Fr_{0}}{Fr_{c}} \f$ where \f$ Fr_{c} \f$ +!! is as in Alpert. +!! +!! +!! This represents a closed scheme, somewhat empirical adjustments +!! to the original scheme to calculate the surface stress. +!! +!! Momentum is deposited by the sub-grid scale gravity waves break due +!! to the presence of convective mixing assumed to occur when the +!! minimum Richardson number: +!! +!! Orographic Convexity (OC) = \f$ \frac{ \sum\limits_{j=1}^{N_{x}} +!! \; (h_{j} \; - \; \bar{h})^4 }{N_{x} \;\sigma_{h}^4} \f$ , +!! and where \f$ \sigma_{h} = \sqrt{ \frac{\sum\limits_{j=1}^{N_{x}} +!! \; (h_{j} \; - \; \bar{h} )^2}{N_{x}} } \f$ +!! +!! This represents a closed scheme, somewhat empirical adjustments +!! to the original scheme to calculate the surface stress. +!! +!! Momentum is deposited by the sub-grid scale gravity waves break due +!! to the presence of convective mixing assumed to occur when +!! the minimum Richardson number: +!! +!! \f$ Ri_{m} = \frac{Ri(1 \; - \; Fr)}{(1 \; + \; \sqrt{Ri}Fr)^2} \f$ +!! +!! Is less than 1/4 Or if critical layers are encountered in a layer +!! the the momentum flux will vanish. The critical layer is defined +!! when the base layer wind becomes perpendicular to the environmental +!! wind. Otherwise, wave breaking occurs at a level where the amplification +!! of the wave causes the local Froude number or similarly a truncated +!! (first term of the) Scorer parameter, to be reduced below a critical +!! value by the saturation hypothesis (Lindzen,). This is done through +!! eq 1 which can be written as +!! +!! \f$ \tau = \rho U N k h^{'2} \f$ +!! +!! For small Froude number this is discretized in the vertical so at each +!! level the stress is reduced by ratio of the Froude or truncated Scorer +!! parameter, \f$ \frac{U^{2}}{N^{2}} = \frac{N \tau_{l-1}}{\rho U^{3} k} \f$ , +!! where the stress is from the layer below beginning with that found near +!! the surface. The respective change in momentum is applied in +!! that layer building up from below. +!! +!! An amplitude factor is part of the calibration of this scheme which is +!! a function of the model resolution and the vertical diffusion. This +!! is because the vertical diffusion and the GWD account encompass +!! similar physical processes. Thus, one needs to run the model over +!! and over for various amplitude factors for GWD and vertical diffusion. +!! +!! In addition, there is also mountain blocking from lift and frictional +!! forces. Improved integration between how the GWD is calculated and +!! the mountain blocking of wind flow around sub-grid scale orography +!! is underway at NCEP. The GFS already has convectively forced GWD +!! an independent process. The next step is to test +!! +!> \section det_drag_suite GFS Orographic GWD Scheme Detailed Algorithm +!> @{ +! subroutine drag_suite_run( & +! & IM,IX,KM,A,B,C,U1,V1,T1,Q1,KPBL, & +! & PRSI,DEL,PRSL,PRSLK,PHII, PHIL,DELTIM,KDT, & +! & HPRIME,OC,OA4,CLX4,THETA,SIGMA,GAMMA,ELVMAX, & +! & DUSFC,DVSFC,G, CP, RD, RV, IMX, & +! & nmtvr, cdmbgwd, me, lprnt, ipr, rdxzb, errmsg, errflg) +! + subroutine drag_suite_run( & + & IM,IX,KM,dvdt,dudt,dtdt,U1,V1,T1,Q1,KPBL, & + & PRSI,DEL,PRSL,PRSLK,PHII,PHIL,DELTIM,KDT, & + & VAR,oc1,oa4,ol4, & +! & varss,oc1ss,oa4ss,ol4ss, & + & THETA,SIGMA,GAMMA,ELVMAX, & + & dtaux2d_ls,dtauy2d_ls,dtaux2d_bl,dtauy2d_bl, & + & dtaux2d_ss,dtauy2d_ss,dtaux2d_fd,dtauy2d_fd, & + & dusfc,dvsfc, & + & dusfc_ls,dvsfc_ls,dusfc_bl,dvsfc_bl, & + & dusfc_ss,dvsfc_ss,dusfc_fd,dvsfc_fd, & + & slmsk,br1,hpbl, & + & g, cp, rd, rv, fv, pi, imx, cdmbgwd, me, master, & + & lprnt, ipr, rdxzb, dx, gwd_opt, errmsg, errflg ) + +! ******************************************************************** +! -----> I M P L E M E N T A T I O N V E R S I O N <---------- +! +! ----- This code ----- +!begin WRF code + +! this code handles the time tendencies of u v due to the effect of mountain +! induced gravity wave drag from sub-grid scale orography. this routine +! not only treats the traditional upper-level wave breaking due to mountain +! variance (alpert 1988), but also the enhanced lower-tropospheric wave +! breaking due to mountain convexity and asymmetry (kim and arakawa 1995). +! thus, in addition to the terrain height data in a model grid box, +! additional 10-2d topographic statistics files are needed, including +! orographic standard deviation (var), convexity (oc1), asymmetry (oa4) +! and ol (ol4). these data sets are prepared based on the 30 sec usgs orography +! hong (1999). the current scheme was implmented as in hong et al.(2008) +! +! Originally coded by song-you hong and young-joon kim and implemented by song-you hong +! +! program history log: +! 2014-10-01 Hyun-Joo Choi (from KIAPS) flow-blocking drag of kim and doyle +! with blocked height by dividing streamline theory +! 2017-04-06 Joseph Olson (from Gert-Jan Steeneveld) added small-scale +! orographic grabity wave drag: +! 2017-09-15 Joseph Olson, with some bug fixes from Michael Toy: added the +! topographic form drag of Beljaars et al. (2004, QJRMS) +! Activation of each component is done by specifying the integer-parameters +! (defined below) to 0: inactive or 1: active +! gwd_opt_ls = 0 or 1: large-scale +! gwd_opt_bl = 0 or 1: blocking drag +! gwd_opt_ss = 0 or 1: small-scale gravity wave drag +! gwd_opt_fd = 0 or 1: topographic form drag +! 2017-09-25 Michael Toy (from NCEP GFS model) added dissipation heating +! gsd_diss_ht_opt = 0: dissipation heating off +! gsd_diss_ht_opt = 1: dissipation heating on +! +! References: +! Hong et al. (2008), wea. and forecasting +! Kim and Doyle (2005), Q. J. R. Meteor. Soc. +! Kim and Arakawa (1995), j. atmos. sci. +! Alpert et al. (1988), NWP conference. +! Hong (1999), NCEP office note 424. +! Steeneveld et al (2008), JAMC +! Tsiringakis et al. (2017), Q. J. R. Meteor. Soc. +! Beljaars et al. (2004), Q. J. R. Meteor. Soc. +! +! notice : comparible or lower resolution orography files than model resolution +! are desirable in preprocess (wps) to prevent weakening of the drag +!------------------------------------------------------------------------------- +! +! input +! dudt (im,km) non-lin tendency for u wind component +! dvdt (im,km) non-lin tendency for v wind component +! u1(im,km) zonal wind / sqrt(rcl) m/sec at t0-dt +! v1(im,km) meridional wind / sqrt(rcl) m/sec at t0-dt +! t1(im,km) temperature deg k at t0-dt +! q1(im,km) specific humidity at t0-dt +! deltim time step secs +! del(km) positive increment of pressure across layer (pa) +! KPBL(IM) is the index of the top layer of the PBL +! ipr & lprnt for diagnostics +! +! output +! dudt, dvdt wind tendency due to gwdo +! dTdt +! +!------------------------------------------------------------------------------- + +!end wrf code +!----------------------------------------------------------------------C +! USE +! ROUTINE IS CALLED FROM CCPP (AFTER CALLING PBL SCHEMES) +! +! PURPOSE +! USING THE GWD PARAMETERIZATIONS OF PS-GLAS AND PH- +! GFDL TECHNIQUE. THE TIME TENDENCIES OF U V +! ARE ALTERED TO INCLUDE THE EFFECT OF MOUNTAIN INDUCED +! GRAVITY WAVE DRAG FROM SUB-GRID SCALE OROGRAPHY INCLUDING +! CONVECTIVE BREAKING, SHEAR BREAKING AND THE PRESENCE OF +! CRITICAL LEVELS +! +! +! ******************************************************************** + USE MACHINE , ONLY : kind_phys + implicit none + + ! Interface variables + integer, intent(in) :: im, ix, km, imx, kdt, ipr, me, master + integer, intent(in) :: gwd_opt + logical, intent(in) :: lprnt + integer, intent(in) :: KPBL(im) + real(kind=kind_phys), intent(in) :: deltim, G, CP, RD, RV, cdmbgwd(2) + + integer :: kpblmax + integer, parameter :: ims=1, kms=1, its=1, kts=1 + real(kind=kind_phys), intent(in) :: fv, pi + real(kind=kind_phys) :: rcl, cdmb + real(kind=kind_phys) :: g_inv + + real(kind=kind_phys), intent(out) :: & + & dudt(im,km),dvdt(im,km), & + & dtdt(im,km), rdxzb(im) + real(kind=kind_phys), intent(in) :: & + & u1(im,km),v1(im,km), & + & t1(im,km),q1(im,km), & + & PHII(im,km+1),prsl(im,km), & + & prslk(im,km),PHIL(im,km) + real(kind=kind_phys), intent(in) :: prsi(im,km+1), & + & del(im,km) + real(kind=kind_phys), intent(in) :: var(im),oc1(im), & + & oa4(im,4),ol4(im,4), & + & dx(im) + !real(kind=kind_phys), intent(in) :: varss(im),oc1ss(im), & + real(kind=kind_phys) :: varss(im),oc1ss(im), & + & oa4ss(im,4),ol4ss(im,4) + real(kind=kind_phys), intent(in) :: THETA(im),SIGMA(im), & + & GAMMA(im),ELVMAX(im) + +! added for small-scale orographic wave drag + real(kind=kind_phys), dimension(im,km) :: utendwave,vtendwave,thx,thvx + real(kind=kind_phys), intent(in) :: br1(im), & + & hpbl(im), & + & slmsk(im) + real(kind=kind_phys), dimension(im) :: govrth,xland + !real(kind=kind_phys), dimension(im,km) :: dz2 + real(kind=kind_phys) :: tauwavex0,tauwavey0, & + & XNBV,density,tvcon,hpbl2 + integer :: kpbl2,kvar + !real(kind=kind_phys), dimension(im,km+1) :: zq ! = PHII/g + real(kind=kind_phys), dimension(im,km) :: zl ! = PHIL/g + +!SPP + real(kind=kind_phys), dimension(im) :: rstoch + +!Output: + real(kind=kind_phys), intent(out) :: & + & dusfc(im), dvsfc(im) +!Output (optional): + real(kind=kind_phys), intent(out) :: & + & dusfc_ls(:),dvsfc_ls(:), & + & dusfc_bl(:),dvsfc_bl(:), & + & dusfc_ss(:),dvsfc_ss(:), & + & dusfc_fd(:),dvsfc_fd(:) + real(kind=kind_phys), intent(out) :: & + & dtaux2d_ls(:,:),dtauy2d_ls(:,:), & + & dtaux2d_bl(:,:),dtauy2d_bl(:,:), & + & dtaux2d_ss(:,:),dtauy2d_ss(:,:), & + & dtaux2d_fd(:,:),dtauy2d_fd(:,:) + +!Misc arrays + real(kind=kind_phys), dimension(im,km) :: dtaux2d, dtauy2d + +!------------------------------------------------------------------------- +! Flags to regulate the activation of specific components of drag suite: +! Each component is tapered off automatically as a function of dx, so best to +! keep them activated (=1). + integer, parameter :: & + gwd_opt_ls = 1, & ! large-scale gravity wave drag + gwd_opt_bl = 1, & ! blocking drag + gwd_opt_ss = 1, & ! small-scale gravity wave drag (Steeneveld et al. 2008) + gwd_opt_fd = 1, & ! form drag (Beljaars et al. 2004, QJRMS) + gsd_diss_ht_opt = 0 + +! Parameters for bounding the scale-adaptive variability: +! Small-scale GWD + turbulent form drag + real(kind=kind_phys), parameter :: dxmin_ss = 1000., & + & dxmax_ss = 12000. ! min,max range of tapering (m) +! Large-scale GWD + blocking + real(kind=kind_phys), parameter :: dxmin_ls = 3000., & + & dxmax_ls = 13000. ! min,max range of tapering (m) + real(kind=kind_phys) :: ss_taper, ls_taper ! small- and large-scale tapering factors (-) +! +! Variables for limiting topographic standard deviation (var) + real(kind=kind_phys), parameter :: varmax_ss = 50., & + varmax_fd = 150., & + beta_ss = 0.1, & + beta_fd = 0.2 + real(kind=kind_phys) :: var_temp, var_temp2 + +! added Beljaars orographic form drag + real(kind=kind_phys), dimension(im,km) :: utendform,vtendform + real(kind=kind_phys) :: a1,a2,wsp + real(kind=kind_phys) :: H_efold + +! critical richardson number for wave breaking : ! larger drag with larger value + real(kind=kind_phys), parameter :: ric = 0.25 + real(kind=kind_phys), parameter :: dw2min = 1. + real(kind=kind_phys), parameter :: rimin = -100. + real(kind=kind_phys), parameter :: bnv2min = 1.0e-5 + real(kind=kind_phys), parameter :: efmin = 0.0 + real(kind=kind_phys), parameter :: efmax = 10.0 + real(kind=kind_phys), parameter :: xl = 4.0e4 + real(kind=kind_phys), parameter :: critac = 1.0e-5 + real(kind=kind_phys), parameter :: gmax = 1. + real(kind=kind_phys), parameter :: veleps = 1.0 + real(kind=kind_phys), parameter :: factop = 0.5 + real(kind=kind_phys), parameter :: frc = 1.0 + real(kind=kind_phys), parameter :: ce = 0.8 + real(kind=kind_phys), parameter :: cg = 0.5 + integer,parameter :: kpblmin = 2 + +! +! local variables +! + integer :: i,j,k,lcap,lcapp1,nwd,idir, & + klcap,kp1 +! + real(kind=kind_phys) :: rcs,csg,fdir,cleff,cleff_ss,cs, & + rcsks,wdir,ti,rdz,tem2,dw2,shr2, & + bvf2,rdelks,wtkbj,tem,gfobnv,hd,fro, & + rim,temc,tem1,efact,temv,dtaux,dtauy, & + dtauxb,dtauyb,eng0,eng1 +! + logical :: ldrag(im),icrilv(im), & + flag(im),kloop1(im) +! + real(kind=kind_phys) :: taub(im),taup(im,km+1), & + xn(im),yn(im), & + ubar(im),vbar(im), & + fr(im),ulow(im), & + rulow(im),bnv(im), & + oa(im),ol(im), & + oass(im),olss(im), & + roll(im),dtfac(im), & + brvf(im),xlinv(im), & + delks(im),delks1(im), & + bnv2(im,km),usqj(im,km), & + taud_ls(im,km),taud_bl(im,km), & + ro(im,km), & + vtk(im,km),vtj(im,km), & + zlowtop(im),velco(im,km-1), & + coefm(im),coefm_ss(im) +! + integer :: kbl(im),klowtop(im) + integer,parameter :: mdir=8 + !integer :: nwdir(mdir) + !data nwdir/6,7,5,8,2,3,1,4/ + integer, parameter :: nwdir(8) = (/6,7,5,8,2,3,1,4/) +! +! variables for flow-blocking drag +! + real(kind=kind_phys),parameter :: frmax = 10. + real(kind=kind_phys),parameter :: olmin = 1.0e-5 + real(kind=kind_phys),parameter :: odmin = 0.1 + real(kind=kind_phys),parameter :: odmax = 10. + real(kind=kind_phys),parameter :: erad = 6371.315e+3 + integer :: komax(im) + integer :: kblk + real(kind=kind_phys) :: cd + real(kind=kind_phys) :: zblk,tautem + real(kind=kind_phys) :: pe,ke + real(kind=kind_phys) :: delx,dely,dxy4(4),dxy4p(4) + real(kind=kind_phys) :: dxy(im),dxyp(im) + real(kind=kind_phys) :: ol4p(4),olp(im),od(im) + real(kind=kind_phys) :: taufb(im,km+1) + + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! Calculate inverse of gravitational acceleration + g_inv = 1./G + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + +if (me==master) print *,"Running drag suite" +!-------------------------------------------------------------------- +! SCALE-ADPTIVE PARAMETER FROM GFS GWD SCHEME +!-------------------------------------------------------------------- +! parameter (cdmb = 1.0) ! non-dim sub grid mtn drag Amp (*j*) +! non-dim sub grid mtn drag Amp (*j*) +! cdmb = 1.0/float(IMX/192) +! cdmb = 192.0/float(IMX) + cdmb = 4.0 * 192.0/float(IMX) + if (cdmbgwd(1) >= 0.0) cdmb = cdmb * cdmbgwd(1) + +!>-# Orographic Gravity Wave Drag Section + kpblmax = km / 2 ! maximum pbl height : # of vertical levels / 2 +! +! Scale cleff between IM=384*2 and 192*2 for T126/T170 and T62 +! + if (imx > 0) then +! cleff = 1.0E-5 * SQRT(FLOAT(IMX)/384.0) +! cleff = 1.0E-5 * SQRT(FLOAT(IMX)/192.0) ! this is inverse of CLEFF! +! cleff = 0.5E-5 * SQRT(FLOAT(IMX)/192.0) ! this is inverse of CLEFF! +! cleff = 1.0E-5 * SQRT(FLOAT(IMX)/192)/float(IMX/192) +! cleff = 1.0E-5 / SQRT(FLOAT(IMX)/192.0) ! this is inverse of CLEFF! + cleff = 0.5E-5 / SQRT(FLOAT(IMX)/192.0) ! this is inverse of CLEFF! +! hmhj for ndsl +! jw cleff = 0.1E-5 / SQRT(FLOAT(IMX)/192.0) ! this is inverse of CLEFF! +! cleff = 2.0E-5 * SQRT(FLOAT(IMX)/192.0) ! this is inverse of CLEFF! +! cleff = 2.5E-5 * SQRT(FLOAT(IMX)/192.0) ! this is inverse of CLEFF! + endif + if (cdmbgwd(2) >= 0.0) cleff = cleff * cdmbgwd(2) +!-------------------------------------------------------------------- +! END SCALE-ADPTIVE PARAMETER SECTION +!-------------------------------------------------------------------- +! +!---- constants +! + rcl = 1. + rcs = sqrt(rcl) + cs = 1. / sqrt(rcl) + csg = cs * g + lcap = km + lcapp1 = lcap + 1 + fdir = mdir / (2.0*pi) + + do i=1,im + if (slmsk(i)==1. .or. slmsk(i)==2.) then !sea/land/ice mask (=0/1/2) in FV3 + xland(i)=1.0 !but land/water = (1/2) in this module + else + xland(i)=2.0 + endif + RDXZB(i) = 0.0 + enddo + +!temporary use of large-scale data: + do i=1,im + varss(i)=var(i) + oc1ss(i)=oc1(i) + do j=1,4 + oa4ss(i,j)=oa4(i,j) + ol4ss(i,j)=ol4(i,j) + enddo + enddo +! +!--- calculate scale-aware tapering factors +!NOTE: if dx(1) is not representative of most/all dx, this needs to change... +if ( dx(1) .ge. dxmax_ls ) then + ls_taper = 1. +else + if ( dx(1) .le. dxmin_ls) then + ls_taper = 0. + else + ls_taper = 0.5 * ( SIN(pi*(dx(1)-0.5*(dxmax_ls+dxmin_ls))/ & + (dxmax_ls-dxmin_ls)) + 1. ) + end if +end if +if (me==master) print *,"in Drag Suite, dx(1:2):",dx(1),dx(2) +if ( dx(1) .ge. dxmax_ss ) then + ss_taper = 1. +else + if ( dx(1) .le. dxmin_ss) then + ss_taper = 0. + else + ss_taper = dxmax_ss * (1. - dxmin_ss/dx(1))/(dxmax_ss-dxmin_ss) + end if +end if +if (me==master) print *,"in Drag Suite, ss_taper:",ss_taper + +!--- calculate length of grid for flow-blocking drag +! + delx = dx(1) + dely = dx(1) + dxy4(1) = delx + dxy4(2) = dely + dxy4(3) = sqrt(delx*delx + dely*dely) + dxy4(4) = dxy4(3) + dxy4p(1) = dxy4(2) + dxy4p(2) = dxy4(1) + dxy4p(3) = dxy4(4) + dxy4p(4) = dxy4(3) +! +!-----initialize arrays +! + dtaux = 0.0 + dtauy = 0.0 + do i = its,im + klowtop(i) = 0 + kbl(i) = 0 + enddo +! + do i = its,im + xn(i) = 0.0 + yn(i) = 0.0 + ubar (i) = 0.0 + vbar (i) = 0.0 + roll (i) = 0.0 + taub (i) = 0.0 + oa(i) = 0.0 + ol(i) = 0.0 + oass(i) = 0.0 + olss(i) = 0.0 + ulow (i) = 0.0 + dtfac(i) = 1.0 + rstoch(i) = 0.0 + ldrag(i) = .false. + icrilv(i) = .false. + flag(i) = .true. + enddo + + do k = kts,km + do i = its,im + usqj(i,k) = 0.0 + bnv2(i,k) = 0.0 + vtj(i,k) = 0.0 + vtk(i,k) = 0.0 + taup(i,k) = 0.0 + taud_ls(i,k) = 0.0 + taud_bl(i,k) = 0.0 + dtaux2d(i,k) = 0.0 + dtauy2d(i,k) = 0.0 + enddo + enddo +! + if (gwd_opt == 33) then + do i = its,im + dusfc_ls(i) = 0.0 + dvsfc_ls(i) = 0.0 + dusfc_bl(i) = 0.0 + dvsfc_bl(i) = 0.0 + dusfc_ss(i) = 0.0 + dvsfc_ss(i) = 0.0 + dusfc_fd(i) = 0.0 + dvsfc_fd(i) = 0.0 + enddo + do k = kts,km + do i = its,im + dtaux2d_ls(i,k)= 0.0 + dtauy2d_ls(i,k)= 0.0 + dtaux2d_bl(i,k)= 0.0 + dtauy2d_bl(i,k)= 0.0 + dtaux2d_ss(i,k)= 0.0 + dtauy2d_ss(i,k)= 0.0 + dtaux2d_fd(i,k)= 0.0 + dtauy2d_fd(i,k)= 0.0 + enddo + enddo + endif + + do i = its,im + taup(i,km+1) = 0.0 + xlinv(i) = 1.0/xl + dusfc(i) = 0.0 + dvsfc(i) = 0.0 + enddo +! +! initialize array for flow-blocking drag +! + taufb(1:im,1:km+1) = 0.0 + komax(1:im) = 0 +! + do k = kts,km + do i = its,im + vtj(i,k) = t1(i,k) * (1.+fv*q1(i,k)) + vtk(i,k) = vtj(i,k) / prslk(i,k) + ro(i,k) = 1./rd * prsl(i,k) / vtj(i,k) ! density kg/m**3 + enddo + enddo +! +! calculate mid-layer height (zl), interface height (zq), and layer depth (dz2). +! + !zq=0. + do k = kts,km + do i = its,im + !zq(i,k+1) = PHII(i,k+1)*g_inv + !dz2(i,k) = (PHII(i,k+1)-PHII(i,k))*g_inv + zl(i,k) = PHIL(i,k)*g_inv + enddo + enddo +! +! determine reference level: maximum of 2*var and pbl heights +! + do i = its,im + zlowtop(i) = 2. * var(i) + enddo +! + do i = its,im + kloop1(i) = .true. + enddo +! + do k = kts+1,km + do i = its,im + if(kloop1(i).and.zl(i,k)-zl(i,1).ge.zlowtop(i)) then + klowtop(i) = k+1 + kloop1(i) = .false. + endif + enddo + enddo +! + do i = its,im + kbl(i) = max(kpbl(i), klowtop(i)) + kbl(i) = max(min(kbl(i),kpblmax),kpblmin) + enddo +! +! determine the level of maximum orographic height +! + ! komax(:) = kbl(:) + komax(:) = klowtop(:) - 1 ! modification by NOAA/GSD March 2018 +! + do i = its,im + delks(i) = 1.0 / (prsi(i,1) - prsi(i,kbl(i))) + delks1(i) = 1.0 / (prsl(i,1) - prsl(i,kbl(i))) + enddo +! +! compute low level averages within pbl +! + do k = kts,kpblmax + do i = its,im + if (k.lt.kbl(i)) then + rcsks = rcs * del(i,k) * delks(i) + rdelks = del(i,k) * delks(i) + ubar(i) = ubar(i) + rcsks * u1(i,k) ! pbl u mean + vbar(i) = vbar(i) + rcsks * v1(i,k) ! pbl v mean + roll(i) = roll(i) + rdelks * ro(i,k) ! ro mean + endif + enddo + enddo +! +! figure out low-level horizontal wind direction +! +! nwd 1 2 3 4 5 6 7 8 +! wd w s sw nw e n ne se +! + do i = its,im + wdir = atan2(ubar(i),vbar(i)) + pi + idir = mod(nint(fdir*wdir),mdir) + 1 + nwd = nwdir(idir) + oa(i) = (1-2*int( (nwd-1)/4 )) * oa4(i,mod(nwd-1,4)+1) + ol(i) = ol4(i,mod(nwd-1,4)+1) + ! Repeat for small-scale gwd + oass(i) = (1-2*int( (nwd-1)/4 )) * oa4ss(i,mod(nwd-1,4)+1) + olss(i) = ol4ss(i,mod(nwd-1,4)+1) + +! +!----- compute orographic width along (ol) and perpendicular (olp) +!----- the direction of wind +! + ol4p(1) = ol4(i,2) + ol4p(2) = ol4(i,1) + ol4p(3) = ol4(i,4) + ol4p(4) = ol4(i,3) + olp(i) = ol4p(mod(nwd-1,4)+1) +! +!----- compute orographic direction (horizontal orographic aspect ratio) +! + od(i) = olp(i)/max(ol(i),olmin) + od(i) = min(od(i),odmax) + od(i) = max(od(i),odmin) +! +!----- compute length of grid in the along(dxy) and cross(dxyp) wind directions +! + dxy(i) = dxy4(MOD(nwd-1,4)+1) + dxyp(i) = dxy4p(MOD(nwd-1,4)+1) + enddo +! +! END INITIALIZATION; BEGIN GWD CALCULATIONS: +! +IF ( ((gwd_opt_ls .EQ. 1).or.(gwd_opt_bl .EQ. 1)).and. & + (ls_taper .GT. 1.E-02) ) THEN !==== +! +!--- saving richardson number in usqj for migwdi +! + do k = kts,km-1 + do i = its,im + ti = 2.0 / (t1(i,k)+t1(i,k+1)) + rdz = 1./(zl(i,k+1) - zl(i,k)) + tem1 = u1(i,k) - u1(i,k+1) + tem2 = v1(i,k) - v1(i,k+1) + dw2 = rcl*(tem1*tem1 + tem2*tem2) + shr2 = max(dw2,dw2min) * rdz * rdz + bvf2 = g*(g/cp+rdz*(vtj(i,k+1)-vtj(i,k))) * ti + usqj(i,k) = max(bvf2/shr2,rimin) + bnv2(i,k) = 2.0*g*rdz*(vtk(i,k+1)-vtk(i,k))/(vtk(i,k+1)+vtk(i,k)) + bnv2(i,k) = max( bnv2(i,k), bnv2min ) + enddo + enddo +! +!----compute the "low level" or 1/3 wind magnitude (m/s) +! + do i = its,im + ulow(i) = max(sqrt(ubar(i)*ubar(i) + vbar(i)*vbar(i)), 1.0) + rulow(i) = 1./ulow(i) + enddo +! + do k = kts,km-1 + do i = its,im + velco(i,k) = (0.5*rcs) * ((u1(i,k)+u1(i,k+1)) * ubar(i) & + + (v1(i,k)+v1(i,k+1)) * vbar(i)) + velco(i,k) = velco(i,k) * rulow(i) + if ((velco(i,k).lt.veleps) .and. (velco(i,k).gt.0.)) then + velco(i,k) = veleps + endif + enddo + enddo +! +! no drag when critical level in the base layer +! + do i = its,im + ldrag(i) = velco(i,1).le.0. + enddo +! +! no drag when velco.lt.0 +! + do k = kpblmin,kpblmax + do i = its,im + if (k .lt. kbl(i)) ldrag(i) = ldrag(i).or. velco(i,k).le.0. + enddo + enddo +! +! no drag when bnv2.lt.0 +! + do k = kts,kpblmax + do i = its,im + if (k .lt. kbl(i)) ldrag(i) = ldrag(i).or. bnv2(i,k).lt.0. + enddo + enddo +! +!-----the low level weighted average ri is stored in usqj(1,1; im) +!-----the low level weighted average n**2 is stored in bnv2(1,1; im) +!---- this is called bnvl2 in phys_gwd_alpert_sub not bnv2 +!---- rdelks (del(k)/delks) vert ave factor so we can * instead of / +! + do i = its,im + wtkbj = (prsl(i,1)-prsl(i,2)) * delks1(i) + bnv2(i,1) = wtkbj * bnv2(i,1) + usqj(i,1) = wtkbj * usqj(i,1) + enddo +! + do k = kpblmin,kpblmax + do i = its,im + if (k .lt. kbl(i)) then + rdelks = (prsl(i,k)-prsl(i,k+1)) * delks1(i) + bnv2(i,1) = bnv2(i,1) + bnv2(i,k) * rdelks + usqj(i,1) = usqj(i,1) + usqj(i,k) * rdelks + endif + enddo + enddo +! + do i = its,im + ldrag(i) = ldrag(i) .or. bnv2(i,1).le.0.0 + ldrag(i) = ldrag(i) .or. ulow(i).eq.1.0 + ldrag(i) = ldrag(i) .or. var(i) .le. 0.0 + enddo +! +! set all ri low level values to the low level value +! + do k = kpblmin,kpblmax + do i = its,im + if (k .lt. kbl(i)) usqj(i,k) = usqj(i,1) + enddo + enddo +! + do i = its,im + if (.not.ldrag(i)) then + bnv(i) = sqrt( bnv2(i,1) ) + fr(i) = bnv(i) * rulow(i) * 2. * var(i) * od(i) + fr(i) = min(fr(i),frmax) + xn(i) = ubar(i) * rulow(i) + yn(i) = vbar(i) * rulow(i) + endif + enddo +! +! compute the base level stress and store it in taub +! calculate enhancement factor, number of mountains & aspect +! ratio const. use simplified relationship between standard +! deviation & critical hgt + + do i = its,im + if (.not. ldrag(i)) then + efact = (oa(i) + 2.) ** (ce*fr(i)/frc) + efact = min( max(efact,efmin), efmax ) +!!!!!!! cleff (effective grid length) is highly tunable parameter +!!!!!!! the bigger (smaller) value produce weaker (stronger) wave drag +!WRF cleff = sqrt(dxy(i)**2. + dxyp(i)**2.) +!WRF cleff = 3. * max(dx(i),cleff) + coefm(i) = (1. + ol(i)) ** (oa(i)+1.) +!WRF xlinv(i) = coefm(i) / cleff + xlinv(i) = coefm(i) * cleff + tem = fr(i) * fr(i) * oc1(i) + gfobnv = gmax * tem / ((tem + cg)*bnv(i)) + if ( gwd_opt_ls .NE. 0 ) then + taub(i) = xlinv(i) * roll(i) * ulow(i) * ulow(i) & + * ulow(i) * gfobnv * efact + else ! We've gotten what we need for the blocking scheme + taub(i) = 0.0 + end if + else + taub(i) = 0.0 + xn(i) = 0.0 + yn(i) = 0.0 + endif + enddo + +ENDIF ! (gwd_opt_ls .EQ. 1).or.(gwd_opt_bl .EQ. 1) + +!========================================================= +! add small-scale wavedrag for stable boundary layer +!========================================================= + XNBV=0. + tauwavex0=0. + tauwavey0=0. + density=1.2 + utendwave=0. + vtendwave=0. +! + IF ( (gwd_opt_ss .EQ. 1).and.(ss_taper.GT.1.E-02) ) THEN + if (me==master) print *,"in Drag Suite: Running small-scale gravity wave drag" +! +! declaring potential temperature +! + do k = kts,km + do i = its,im + thx(i,k) = t1(i,k)/prslk(i,k) + enddo + enddo +! + do k = kts,km + do i = its,im + tvcon = (1.+fv*q1(i,k)) + thvx(i,k) = thx(i,k)*tvcon + enddo + enddo + + do i=its,im + hpbl2 = hpbl(i)+10. + kpbl2 = kpbl(i) + !kvar = MIN(kpbl, k-level of var) + kvar = 1 + do k=kts+1,MAX(kpbl(i),kts+1) +! IF (zl(i,k)>2.*var(i) .or. zl(i,k)>2*varmax) then + IF (zl(i,k)>300.) then + kpbl2 = k + IF (k == kpbl(i)) then + hpbl2 = hpbl(i)+10. + ELSE + hpbl2 = zl(i,k)+10. + ENDIF + exit + ENDIF + enddo + if((xland(i)-1.5).le.0. .and. 2.*varss(i).le.hpbl(i))then + if(br1(i).gt.0. .and. thvx(i,kpbl2)-thvx(i,kts) > 0.)then +!WRF cleff_ss = sqrt(dxy(i)**2 + dxyp(i)**2) +! cleff_ss = 3. * max(dx(i),cleff_ss) +! cleff_ss = 10. * max(dxmax_ss,cleff_ss) +!WRF cleff_ss = 0.1 * max(dxmax_ss,cleff_ss) + cleff_ss = 0.1 * 12000. + coefm_ss(i) = (1. + olss(i)) ** (oass(i)+1.) + xlinv(i) = coefm_ss(i) / cleff_ss + !govrth(i)=g/(0.5*(thvx(i,kpbl(i))+thvx(i,kts))) + govrth(i)=g/(0.5*(thvx(i,kpbl2)+thvx(i,kts))) + !XNBV=sqrt(govrth(i)*(thvx(i,kpbl(i))-thvx(i,kts))/hpbl(i)) + XNBV=sqrt(govrth(i)*(thvx(i,kpbl2)-thvx(i,kts))/hpbl2) +! + !if(abs(XNBV/u1(i,kpbl(i))).gt.xlinv(i))then + if(abs(XNBV/u1(i,kpbl2)).gt.xlinv(i))then + !tauwavex0=0.5*XNBV*xlinv(i)*(2*MIN(varss(i),75.))**2*ro(i,kts)*u1(i,kpbl(i)) + !tauwavex0=0.5*XNBV*xlinv(i)*(2.*MIN(varss(i),40.))**2*ro(i,kts)*u1(i,kpbl2) + !tauwavex0=0.5*XNBV*xlinv(i)*(2.*MIN(varss(i),40.))**2*ro(i,kts)*u1(i,3) + var_temp = MIN(varss(i),varmax_ss) + & + MAX(0.,beta_ss*(varss(i)-varmax_ss)) + ! Note: This is a semi-implicit treatment of the time differencing + var_temp2 = 0.5*XNBV*xlinv(i)*(2.*var_temp)**2*ro(i,kvar) ! this is greater than zero + tauwavex0=-var_temp2*u1(i,kvar)/(1.+var_temp2*deltim) + tauwavex0=tauwavex0*ss_taper + else + tauwavex0=0. + endif +! + !if(abs(XNBV/v1(i,kpbl(i))).gt.xlinv(i))then + if(abs(XNBV/v1(i,kpbl2)).gt.xlinv(i))then + !tauwavey0=0.5*XNBV*xlinv(i)*(2*MIN(varss(i),75.))**2*ro(i,kts)*v1(i,kpbl(i)) + !tauwavey0=0.5*XNBV*xlinv(i)*(2.*MIN(varss(i),40.))**2*ro(i,kts)*v1(i,kpbl2) + !tauwavey0=0.5*XNBV*xlinv(i)*(2.*MIN(varss(i),40.))**2*ro(i,kts)*v1(i,3) + var_temp = MIN(varss(i),varmax_ss) + & + MAX(0.,beta_ss*(varss(i)-varmax_ss)) + ! Note: This is a semi-implicit treatment of the time differencing + tauwavey0=-var_temp2*v1(i,kvar)/(1.+var_temp2*deltim) + tauwavey0=tauwavey0*ss_taper + else + tauwavey0=0. + endif + + do k=kts,kpbl(i) !MIN(kpbl2+1,km-1) +!original + !utendwave(i,k)=-1.*tauwavex0*2.*max((1.-zl(i,k)/hpbl(i)),0.)/hpbl(i) + !vtendwave(i,k)=-1.*tauwavey0*2.*max((1.-zl(i,k)/hpbl(i)),0.)/hpbl(i) +!new + utendwave(i,k)=-1.*tauwavex0*2.*max((1.-zl(i,k)/hpbl2),0.)/hpbl2 + vtendwave(i,k)=-1.*tauwavey0*2.*max((1.-zl(i,k)/hpbl2),0.)/hpbl2 +!mod-to be used in HRRRv3/RAPv4 + !utendwave(i,k)=-1.*tauwavex0 * max((1.-zl(i,k)/hpbl2),0.)**2 + !vtendwave(i,k)=-1.*tauwavey0 * max((1.-zl(i,k)/hpbl2),0.)**2 + enddo + endif + endif + enddo ! end i loop + + do k = kts,km + do i = its,im + dudt(i,k) = dudt(i,k) + utendwave(i,k) + dvdt(i,k) = dvdt(i,k) + vtendwave(i,k) + dusfc(i) = dusfc(i) + utendwave(i,k) * del(i,k) + dvsfc(i) = dvsfc(i) + vtendwave(i,k) * del(i,k) + enddo + enddo + if (gwd_opt == 33) then + do k = kts,km + do i = its,im + dusfc_ss(i) = dusfc_ss(i) + utendwave(i,k) * del(i,k) + dvsfc_ss(i) = dvsfc_ss(i) + vtendwave(i,k) * del(i,k) + dtaux2d_ss(i,k) = utendwave(i,k) + dtauy2d_ss(i,k) = vtendwave(i,k) + enddo + enddo + endif + +ENDIF ! end if gwd_opt_ss == 1 + +!================================================================ +! Topographic Form Drag from Beljaars et al. (2004, QJRMS, equ. 16): +!================================================================ +IF ( (gwd_opt_fd .EQ. 1).and.(ss_taper.GT.1.E-02) ) THEN + if (me==master) print *,"in Drag Suite: Running form drag" + + utendform=0. + vtendform=0. + + DO i=its,im + IF ((xland(i)-1.5) .le. 0.) then + !(IH*kflt**n1)**-1 = (0.00102*0.00035**-1.9)**-1 = 0.00026615161 + var_temp = MIN(varss(i),varmax_fd) + & + MAX(0.,beta_fd*(varss(i)-varmax_fd)) + var_temp = MIN(var_temp, 250.) + a1=0.00026615161*var_temp**2 +! a1=0.00026615161*MIN(varss(i),varmax)**2 +! a1=0.00026615161*(0.5*varss(i))**2 + ! k1**(n1-n2) = 0.003**(-1.9 - -2.8) = 0.003**0.9 = 0.005363 + a2=a1*0.005363 + ! Revise e-folding height based on PBL height and topographic std. dev. -- M. Toy 3/12/2018 + H_efold = max(2*varss(i),hpbl(i)) + H_efold = min(H_efold,1500.) + DO k=kts,km + wsp=SQRT(u1(i,k)**2 + v1(i,k)**2) + ! alpha*beta*Cmd*Ccorr*2.109 = 12.*1.*0.005*0.6*2.109 = 0.0759 + var_temp = 0.0759*EXP(-(zl(i,k)/H_efold)**1.5)*a2* & + zl(i,k)**(-1.2)*ss_taper ! this is greater than zero + ! Note: This is a semi-implicit treatment of the time differencing + ! per Beljaars et al. (2004, QJRMS) + utendform(i,k) = - var_temp*wsp*u1(i,k)/(1. + var_temp*deltim*wsp) + vtendform(i,k) = - var_temp*wsp*v1(i,k)/(1. + var_temp*deltim*wsp) + !IF(zl(i,k) > 4000.) exit + ENDDO + ENDIF + ENDDO + + do k = kts,km + do i = its,im + dudt(i,k) = dudt(i,k) + utendform(i,k) + dvdt(i,k) = dvdt(i,k) + vtendform(i,k) + dusfc(i) = dusfc(i) + utendform(i,k) * del(i,k) + dvsfc(i) = dvsfc(i) + vtendform(i,k) * del(i,k) + enddo + enddo + if (gwd_opt == 33) then + do k = kts,km + do i = its,im + dtaux2d_fd(i,k) = utendform(i,k) + dtauy2d_fd(i,k) = vtendform(i,k) + dusfc_fd(i) = dusfc_fd(i) + utendform(i,k) * del(i,k) + dvsfc_fd(i) = dvsfc_fd(i) + vtendform(i,k) * del(i,k) + enddo + enddo + endif + +ENDIF ! end if gwd_opt_fd == 1 +!======================================================= +! More for the large-scale gwd component +IF ( (gwd_opt_ls .EQ. 1).and.(ls_taper.GT.1.E-02) ) THEN + if (me==master) print *,"in Drag Suite: Running large-scale gravity wave drag" +! +! now compute vertical structure of the stress. + do k = kts,kpblmax + do i = its,im + if (k .le. kbl(i)) taup(i,k) = taub(i) + enddo + enddo +! + do k = kpblmin, km-1 ! vertical level k loop! + kp1 = k + 1 + do i = its,im +! +! unstablelayer if ri < ric +! unstable layer if upper air vel comp along surf vel <=0 (crit lay) +! at (u-c)=0. crit layer exists and bit vector should be set (.le.) +! + if (k .ge. kbl(i)) then + icrilv(i) = icrilv(i) .or. ( usqj(i,k) .lt. ric) & + .or. (velco(i,k) .le. 0.0) + brvf(i) = max(bnv2(i,k),bnv2min) ! brunt-vaisala frequency squared + brvf(i) = sqrt(brvf(i)) ! brunt-vaisala frequency + endif + enddo +! + do i = its,im + if (k .ge. kbl(i) .and. (.not. ldrag(i))) then + if (.not.icrilv(i) .and. taup(i,k) .gt. 0.0 ) then + temv = 1.0 / velco(i,k) + tem1 = coefm(i)/dxy(i)*(ro(i,kp1)+ro(i,k))*brvf(i)*velco(i,k)*0.5 + hd = sqrt(taup(i,k) / tem1) + fro = brvf(i) * hd * temv +! +! rim is the minimum-richardson number by shutts (1985) + tem2 = sqrt(usqj(i,k)) + tem = 1. + tem2 * fro + rim = usqj(i,k) * (1.-fro) / (tem * tem) +! +! check stability to employ the 'saturation hypothesis' +! of lindzen (1981) except at tropospheric downstream regions +! + if (rim .le. ric) then ! saturation hypothesis! + if ((oa(i) .le. 0.).or.(kp1 .ge. kpblmin )) then + temc = 2.0 + 1.0 / tem2 + hd = velco(i,k) * (2.*sqrt(temc)-temc) / brvf(i) + taup(i,kp1) = tem1 * hd * hd + endif + else ! no wavebreaking! + taup(i,kp1) = taup(i,k) + endif + endif + endif + enddo + enddo +! + if(lcap.lt.km) then + do klcap = lcapp1,km + do i = its,im + taup(i,klcap) = prsi(i,klcap) / prsi(i,lcap) * taup(i,lcap) + enddo + enddo + endif + +ENDIF !END LARGE-SCALE TAU CALCULATION +!=============================================================== +!COMPUTE BLOCKING COMPONENT +!=============================================================== +IF ( (gwd_opt_bl .EQ. 1) .and. (ls_taper .GT. 1.E-02) ) THEN + if (me==master) print *,"in Drag Suite: Running blocking drag" + + do i = its,im + if(.not.ldrag(i)) then +! +!------- determine the height of flow-blocking layer +! + kblk = 0 + pe = 0.0 + do k = km, kpblmin, -1 + if(kblk.eq.0 .and. k.le.komax(i)) then + pe = pe + bnv2(i,k)*(zl(i,komax(i))-zl(i,k))*del(i,k)/g/ro(i,k) + ke = 0.5*((rcs*u1(i,k))**2.+(rcs*v1(i,k))**2.) +! +!---------- apply flow-blocking drag when pe >= ke +! + if(pe.ge.ke) then + kblk = k + kblk = min(kblk,kbl(i)) + zblk = zl(i,kblk)-zl(i,kts) + RDXZB(i) = real(k,kind=kind_phys) + endif + endif + enddo + if(kblk.ne.0) then +! +!--------- compute flow-blocking stress +! + cd = max(2.0-1.0/od(i),0.0) + taufb(i,kts) = 0.5 * roll(i) * coefm(i) / max(dxmax_ls,dxy(i))**2 * cd * dxyp(i) & + * olp(i) * zblk * ulow(i)**2 + tautem = taufb(i,kts)/float(kblk-kts) + do k = kts+1, kblk + taufb(i,k) = taufb(i,k-1) - tautem + enddo +! +!----------sum orographic GW stress and flow-blocking stress +! + ! taup(i,:) = taup(i,:) + taufb(i,:) ! Keep taup and taufb separate for now + endif + endif + enddo + +ENDIF ! end blocking drag +!=========================================================== +IF ( (gwd_opt_ls .EQ. 1 .OR. gwd_opt_bl .EQ. 1) .and. (ls_taper .GT. 1.E-02) ) THEN +! +! calculate - (g)*d(tau)/d(pressure) and deceleration terms dtaux, dtauy +! + do k = kts,km + do i = its,im + taud_ls(i,k) = 1. * (taup(i,k+1) - taup(i,k)) * csg / del(i,k) + taud_bl(i,k) = 1. * (taufb(i,k+1) - taufb(i,k)) * csg / del(i,k) + enddo + enddo +! +! limit de-acceleration (momentum deposition ) at top to 1/2 value +! the idea is some stuff must go out the 'top' + do klcap = lcap,km + do i = its,im + taud_ls(i,klcap) = taud_ls(i,klcap) * factop + taud_bl(i,klcap) = taud_bl(i,klcap) * factop + enddo + enddo +! +! if the gravity wave drag would force a critical line +! in the lower ksmm1 layers during the next deltim timestep, +! then only apply drag until that critical line is reached. +! + do k = kts,kpblmax-1 + do i = its,im + if (k .le. kbl(i)) then + if((taud_ls(i,k)+taud_bl(i,k)).ne.0.) & + dtfac(i) = min(dtfac(i),abs(velco(i,k) & + /(deltim*rcs*(taud_ls(i,k)+taud_bl(i,k))))) + endif + enddo + enddo +! + do k = kts,km + do i = its,im + taud_ls(i,k) = taud_ls(i,k) * dtfac(i) * ls_taper *(1.-rstoch(i)) + taud_bl(i,k) = taud_bl(i,k) * dtfac(i) * ls_taper *(1.-rstoch(i)) + + dtaux = taud_ls(i,k) * xn(i) + dtauy = taud_ls(i,k) * yn(i) + dtauxb = taud_bl(i,k) * xn(i) + dtauyb = taud_bl(i,k) * yn(i) + + !add blocking and large-scale contributions to tendencies + dudt(i,k) = dtaux + dtauxb + dudt(i,k) + dvdt(i,k) = dtauy + dtauyb + dvdt(i,k) + + if ( gsd_diss_ht_opt .EQ. 1 ) then + ! Calculate dissipation heating + ! Initial kinetic energy (at t0-dt) + eng0 = 0.5*( (rcs*u1(i,k))**2. + (rcs*v1(i,k))**2. ) + ! Kinetic energy after wave-breaking/flow-blocking + eng1 = 0.5*( (rcs*(u1(i,k)+(dtaux+dtauxb)*deltim))**2 + & + (rcs*(v1(i,k)+(dtauy+dtauyb)*deltim))**2 ) + ! Modify theta tendency + dtdt(i,k) = dtdt(i,k) + max((eng0-eng1),0.0)/cp/deltim/prslk(i,k) + end if + + dusfc(i) = dusfc(i) + taud_ls(i,k)*xn(i)*del(i,k) + taud_bl(i,k)*xn(i)*del(i,k) + dvsfc(i) = dvsfc(i) + taud_ls(i,k)*yn(i)*del(i,k) + taud_bl(i,k)*yn(i)*del(i,k) + enddo + enddo + + ! Finalize dusfc and dvsfc diagnostics + do i = its,im + dusfc(i) = (-1./g*rcs) * dusfc(i) + dvsfc(i) = (-1./g*rcs) * dvsfc(i) + enddo + + if (gwd_opt == 33) then + do k = kts,km + do i = its,im + dtaux2d_ls(i,k) = taud_ls(i,k) * xn(i) + dtauy2d_ls(i,k) = taud_ls(i,k) * yn(i) + dtaux2d_bl(i,k) = taud_bl(i,k) * xn(i) + dtauy2d_bl(i,k) = taud_bl(i,k) * yn(i) + dusfc_ls(i) = dusfc_ls(i) + dtaux2d_ls(i,k) * del(i,k) + dvsfc_ls(i) = dvsfc_ls(i) + dtauy2d_ls(i,k) * del(i,k) + dusfc_bl(i) = dusfc_bl(i) + dtaux2d_bl(i,k) * del(i,k) + dvsfc_bl(i) = dvsfc_bl(i) + dtauy2d_bl(i,k) * del(i,k) + enddo + enddo + endif + +ENDIF + +if (gwd_opt == 33) then + ! Finalize dusfc and dvsfc diagnostics + do i = its,im + dusfc_ls(i) = (-1./g*rcs) * dusfc_ls(i) + dvsfc_ls(i) = (-1./g*rcs) * dvsfc_ls(i) + dusfc_bl(i) = (-1./g*rcs) * dusfc_bl(i) + dvsfc_bl(i) = (-1./g*rcs) * dvsfc_bl(i) + dusfc_ss(i) = (-1./g*rcs) * dusfc_ss(i) + dvsfc_ss(i) = (-1./g*rcs) * dvsfc_ss(i) + dusfc_fd(i) = (-1./g*rcs) * dusfc_fd(i) + dvsfc_fd(i) = (-1./g*rcs) * dvsfc_fd(i) + enddo +endif +! + return + end subroutine drag_suite_run +!------------------------------------------------------------------- +! +!> \section arg_table_drag_suite_finalize Argument Table +!! + subroutine drag_suite_finalize() + end subroutine drag_suite_finalize + + end module drag_suite diff --git a/physics/drag_suite.meta b/physics/drag_suite.meta new file mode 100644 index 000000000..dfb6f64b8 --- /dev/null +++ b/physics/drag_suite.meta @@ -0,0 +1,586 @@ +[ccpp-arg-table] + name = drag_suite_init + type = scheme + +######################################################################## +[ccpp-arg-table] + name = drag_suite_run + type = scheme +[im] + standard_name = horizontal_loop_extent + long_name = horizontal loop extent + units = count + dimensions = () + type = integer + intent = in + optional = F +[ix] + standard_name = horizontal_dimension + long_name = horizontal dimension + units = count + dimensions = () + type = integer + intent = in + optional = F +[km] + standard_name = vertical_dimension + long_name = number of vertical layers + units = count + dimensions = () + type = integer + intent = in + optional = F +[dvdt] + standard_name = tendency_of_y_wind_due_to_model_physics + long_name = meridional wind tendency due to model physics + units = m s-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[dudt] + standard_name = tendency_of_x_wind_due_to_model_physics + long_name = zonal wind tendency due to model physics + units = m s-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[dtdt] + standard_name = tendency_of_air_temperature_due_to_model_physics + long_name = air temperature tendency due to model physics + units = K s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[u1] + standard_name = x_wind + long_name = zonal wind + units = m s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[v1] + standard_name = y_wind + long_name = meridional wind + units = m s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[t1] + standard_name = air_temperature + long_name = mid-layer temperature + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[q1] + standard_name = water_vapor_specific_humidity + long_name = mid-layer specific humidity of water vapor + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[kpbl] + standard_name = vertical_index_at_top_of_atmosphere_boundary_layer + long_name = vertical index at top atmospheric boundary layer + units = index + dimensions = (horizontal_dimension) + type = integer + intent = in + optional = F +[prsi] + standard_name = air_pressure_at_interface + long_name = interface pressure + units = Pa + dimensions = (horizontal_dimension,vertical_dimension_plus_one) + type = real + kind = kind_phys + intent = in + optional = F +[del] + standard_name = air_pressure_difference_between_midlayers + long_name = difference between mid-layer pressures + units = Pa + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[prsl] + standard_name = air_pressure + long_name = mid-layer pressure + units = Pa + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[prslk] + standard_name = dimensionless_exner_function_at_model_layers + long_name = mid-layer Exner function + units = none + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[phii] + standard_name = geopotential_at_interface + long_name = interface geopotential + units = m2 s-2 + dimensions = (horizontal_dimension,vertical_dimension_plus_one) + type = real + kind = kind_phys + intent = in + optional = F +[phil] + standard_name = geopotential + long_name = mid-layer geopotential + units = m2 s-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[deltim] + standard_name = time_step_for_physics + long_name = physics time step + units = s + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[kdt] + standard_name = index_of_time_step + long_name = current time step index + units = index + dimensions = () + type = integer + intent = in + optional = F +[var] + standard_name = standard_deviation_of_subgrid_orography + long_name = standard deviation of subgrid orography + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[oc1] + standard_name = convexity_of_subgrid_orography + long_name = convexity of subgrid orography + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[oa4] + standard_name = asymmetry_of_subgrid_orography + long_name = asymmetry of subgrid orography + units = none + dimensions = (horizontal_dimension,4) + type = real + kind = kind_phys + intent = in + optional = F +[ol4] + standard_name = fraction_of_grid_box_with_subgrid_orography_higher_than_critical_height + long_name = horizontal fraction of grid box covered by subgrid orography higher than critical height + units = frac + dimensions = (horizontal_dimension,4) + type = real + kind = kind_phys + intent = in + optional = F +[theta] + standard_name = angle_from_east_of_maximum_subgrid_orographic_variations + long_name = angle with respect to east of maximum subgrid orographic variations + units = degrees + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[sigma] + standard_name = slope_of_subgrid_orography + long_name = slope of subgrid orography + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[gamma] + standard_name = anisotropy_of_subgrid_orography + long_name = anisotropy of subgrid orography + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[elvmax] + standard_name = maximum_subgrid_orography + long_name = maximum of subgrid orography + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[dtaux2d_ls] + standard_name = x_momentum_tendency_from_large_scale_gwd + long_name = x momentum tendency from large scale gwd + units = m s-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[dtauy2d_ls] + standard_name = y_momentum_tendency_from_large_scale_gwd + long_name = y momentum tendency from large scale gwd + units = m s-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[dtaux2d_bl] + standard_name = x_momentum_tendency_from_blocking_drag + long_name = x momentum tendency from blocking drag + units = m s-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[dtauy2d_bl] + standard_name = y_momentum_tendency_from_blocking_drag + long_name = y momentum tendency from blocking drag + units = m s-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[dtaux2d_ss] + standard_name = x_momentum_tendency_from_small_scale_gwd + long_name = x momentum tendency from small scale gwd + units = m s-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[dtauy2d_ss] + standard_name = y_momentum_tendency_from_small_scale_gwd + long_name = y momentum tendency from small scale gwd + units = m s-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[dtaux2d_fd] + standard_name = x_momentum_tendency_from_form_drag + long_name = x momentum tendency from form drag + units = m s-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[dtauy2d_fd] + standard_name = y_momentum_tendency_from_form_drag + long_name = y momentum tendency from form drag + units = m s-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[dusfc] + standard_name = instantaneous_x_stress_due_to_gravity_wave_drag + long_name = zonal surface stress due to orographic gravity wave drag + units = Pa + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[dvsfc] + standard_name = instantaneous_y_stress_due_to_gravity_wave_drag + long_name = meridional surface stress due to orographic gravity wave drag + units = Pa + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[dusfc_ls] + standard_name = integrated_x_momentum_flux_from_large_scale_gwd + long_name = integrated x momentum flux from large scale gwd + units = Pa s + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[dvsfc_ls] + standard_name = integrated_y_momentum_flux_from_large_scale_gwd + long_name = integrated y momentum flux from large scale gwd + units = Pa s + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[dusfc_bl] + standard_name = integrated_x_momentum_flux_from_blocking_drag + long_name = integrated x momentum flux from blocking drag + units = Pa s + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[dvsfc_bl] + standard_name = integrated_y_momentum_flux_from_blocking_drag + long_name = integrated y momentum flux from blocking drag + units = Pa s + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[dusfc_ss] + standard_name = integrated_x_momentum_flux_from_small_scale_gwd + long_name = integrated x momentum flux from small scale gwd + units = Pa s + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[dvsfc_ss] + standard_name = integrated_y_momentum_flux_from_small_scale_gwd + long_name = integrated y momentum flux from small scale gwd + units = Pa s + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[dusfc_fd] + standard_name = integrated_x_momentum_flux_from_form_drag + long_name = integrated x momentum flux from form drag + units = Pa s + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[dvsfc_fd] + standard_name = integrated_y_momentum_flux_from_form_drag + long_name = integrated y momentum flux from form drag + units = Pa s + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[slmsk] + standard_name = sea_land_ice_mask_real + long_name = landmask: sea/land/ice=0/1/2 + units = flag + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[br1] + standard_name = bulk_richardson_number_at_lowest_model_level + long_name = bulk Richardson number at the surface + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[hpbl] + standard_name = atmosphere_boundary_layer_thickness + long_name = PBL thickness + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[g] + standard_name = gravitational_acceleration + long_name = gravitational acceleration + units = m s-2 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[cp] + standard_name = specific_heat_of_dry_air_at_constant_pressure + long_name = specific heat of dry air at constant pressure + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[rd] + standard_name = gas_constant_dry_air + long_name = ideal gas constant for dry air + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[rv] + standard_name = gas_constant_water_vapor + long_name = ideal gas constant for water vapor + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[fv] + standard_name = ratio_of_vapor_to_dry_air_gas_constants_minus_one + long_name = (rv/rd) - 1 (rv = ideal gas constant for water vapor) + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[pi] + standard_name = pi + long_name = ratio of a circle's circumference to its diameter + units = radians + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[imx] + standard_name = number_of_equatorial_longitude_points + long_name = number of longitude points along the equator + units = count + dimensions = () + type = integer + intent = in + optional = F +[cdmbgwd] + standard_name = multiplication_factors_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) + type = real + kind = kind_phys + intent = in + optional = F +[me] + standard_name = mpi_rank + long_name = rank of the current MPI task + units = index + dimensions = () + type = integer + intent = in + optional = F +[master] + standard_name = mpi_root + long_name = master MPI-rank + units = index + dimensions = () + type = integer + intent = in + optional = F +[lprnt] + standard_name = flag_print + long_name = flag for debugging printouts + units = flag + dimensions = () + type = logical + intent = in + optional = F +[ipr] + standard_name = horizontal_index_of_printed_column + long_name = horizontal index of column used in debugging printouts + units = index + dimensions = () + type = integer + intent = in + optional = F +[rdxzb] + standard_name = level_of_dividing_streamline + long_name = level of the dividing streamline + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[dx] + standard_name = cell_size + long_name = size of the grid cell + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[gwd_opt] + standard_name = gwd_opt + long_name = flag to choose gwd scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F + +######################################################################## +[ccpp-arg-table] + name = drag_suite_finalize + type = scheme diff --git a/physics/funcphys.f90 b/physics/funcphys.f90 index 1b50ad185..8cb4b1b15 100644 --- a/physics/funcphys.f90 +++ b/physics/funcphys.f90 @@ -471,7 +471,7 @@ elemental function fpvslq(t) !! This function should be expanded inline in the calling routine. !>\author N Phillips !>\param[in] t real, temperature in Kelvin -!>\param[out] fpvslx real, saturation vapor pressure in Pascals +!\param[out] fpvslx real, saturation vapor pressure in Pascals elemental function fpvslx(t) !$$$ Subprogram Documentation Block ! @@ -683,7 +683,7 @@ elemental function fpvsiq(t) !!\n where tr is ttp/t and other values are physical constants. !! This function should be expanded inline in the calling routine. !>\param[in] t real, temperature in Kelvin -!>\param[out] fpvsix real, saturation vapor pressure in Pascals +!\param[out] fpvsix real, saturation vapor pressure in Pascals elemental function fpvsix(t) !$$$ Subprogram Documentation Block ! @@ -788,7 +788,7 @@ subroutine gpvs !! computed in gpvs(). See documentation for fpvsx() for details. !! Input values outside table range are reset to table extrema. !>\param[in] t real, temperature in Kelvin -!>\param[out] fpvs real, saturation vapor pressure in Pascals +!\param[out] fpvs real, saturation vapor pressure in Pascals elemental function fpvs(t) !$$$ Subprogram Documentation Block ! @@ -838,7 +838,7 @@ elemental function fpvs(t) !! computed in gpvs(). See documentation for fpvsx() for details. !! Input values outside table range are reset to table extrema. !>\param[in] t real, temperatue in Kelvin -!>\param[out] fpvsq real, saturation vapor pressure in Pascals +!\param[out] fpvsq real, saturation vapor pressure in Pascals elemental function fpvsq(t) !$$$ Subprogram Documentation Block ! @@ -902,8 +902,8 @@ elemental function fpvsq(t) !!\n where tr is ttp/t and other values are physical constants. !! The reference for this computation is Emanuel(1994), pages 116-117. !! This function should be expanded inline in the calling routine. -!>\param[in] t real, temperature in Kelvin -!>\param[out] fpvsx real, saturation vapor pressure in Pascals +!!\param[in] t real, temperature in Kelvin +!\param[out] fpvsx real, saturation vapor pressure in Pascals elemental function fpvsx(t) !$$$ Subprogram Documentation Block ! @@ -1078,8 +1078,8 @@ elemental function ftdpl(pv) !! A quadratic interpolation is done between values in a lookup table !! computed in gtdpl(). See documentation for ftdplxg() for details. !! Input values outside table range are reset to table extrema. -!>\param[in] pv real, vapor pressure in Pascals -!>\param[out] ftdplq real, dewpoint temperature in Kelvin +!!\param[in] pv real, vapor pressure in Pascals +!\param[out] ftdplq real, dewpoint temperature in Kelvin elemental function ftdplq(pv) !$$$ Subprogram Documentation Block ! @@ -1133,8 +1133,8 @@ elemental function ftdplq(pv) !! An approximate dewpoint temperature for function ftdplxg() !! is obtained using ftdpl() so gtdpl() must be already called. !! See documentation for ftdplxg() for details. -!>\param[in] pv real, vapor pressure in Pascals -!>\param[out] ftdplx real, dewpoint temperature in Kelvin +!!\param[in] pv real, vapor pressure in Pascals +!\param[out] ftdplx real, dewpoint temperature in Kelvin elemental function ftdplx(pv) !$$$ Subprogram Documentation Block ! @@ -1190,9 +1190,9 @@ elemental function ftdplx(pv) !!\n The formula is inverted by iterating Newtonian approximations !! for each pvs until t is found to within 1.e-6 Kelvin. !! This function can be expanded inline in the calling routine. -!>\param[in] tg real, guess dewpoint temperature in Kelvin -!>\param[in] pv real, vapor pressure in Pascals -!>\param[out] ftdplxg real, dewpoint temperature in Kelvin +!!\param[in] tg real, guess dewpoint temperature in Kelvin +!!\param[in] pv real, vapor pressure in Pascals +!\param[out] ftdplxg real, dewpoint temperature in Kelvin elemental function ftdplxg(tg,pv) !$$$ Subprogram Documentation Block ! @@ -1314,7 +1314,7 @@ subroutine gtdpi !! computed in gtdpi(). See documentation for ftdpixg for details. !! Input values outside table range are reset to table extrema. !>\param[in] pv real, vapor pressure in Pascals -!>\param[out] ftdpi real, dewpoint temperature in Kelvin +!\param[out] ftdpi real, dewpoint temperature in Kelvin elemental function ftdpi(pv) !$$$ Subprogram Documentation Block ! @@ -1366,7 +1366,7 @@ elemental function ftdpi(pv) !! computed in gtdpi(). see documentation for ftdpixg() for details. !! Input values outside table range are reset to table extrema. !>\param[in] pv real, vapor pressure in Pascals -!>\param[out] ftdpiq real, dewpoint temperature in Kelvin +!\param[out] ftdpiq real, dewpoint temperature in Kelvin elemental function ftdpiq(pv) !$$$ Subprogram Documentation Block ! @@ -1422,7 +1422,7 @@ elemental function ftdpiq(pv) !! is obtained using ftdpi() so gtdpi() must be already called. !! See documentation for ftdpixg() for details. !>\param[in] pv real, vapor pressure in Pascals -!>\param[out] ftdpix real, dewpoint temperature in Kelvin +!\param[out] ftdpix real, dewpoint temperature in Kelvin elemental function ftdpix(pv) !$$$ Subprogram Documentation Block ! @@ -1481,7 +1481,7 @@ elemental function ftdpix(pv) !! This function can be expanded inline in the calling routine. !>\param[in] tg real, guess dewpoint temperature in Kelvin !>\param[in] pv real, vapor pressure in Pascals -!>\param[out] ftdpixg real, dewpoint temperature in Kelvin +!\param[out] ftdpixg real, dewpoint temperature in Kelvin elemental function ftdpixg(tg,pv) !$$$ Subprogram Documentation Block ! @@ -1604,7 +1604,7 @@ subroutine gtdp !! computed in gtdp(). See documentation for ftdpxg() for details. !! Input values outside table range are reset to table extrema. !>\param[in] pv real, vapor pressure in Pascals -!>\param[out] ftdp real, dewpoint temperature in Kelvin +!\param[out] ftdp real, dewpoint temperature in Kelvin elemental function ftdp(pv) !$$$ Subprogram Documentation Block ! @@ -1656,7 +1656,7 @@ elemental function ftdp(pv) !! computed in gtdp(). See documentation for ftdpxg() for details. !! Input values outside table range are reset to table extrema. !>\param[in] pv real, vapor pressure in Pascals -!>\param[out] ftdpq real, dewpoint temperature in Kelvin +!\param[out] ftdpq real, dewpoint temperature in Kelvin elemental function ftdpq(pv) !$$$ Subprogram Documentation Block ! @@ -1712,7 +1712,7 @@ elemental function ftdpq(pv) !! is obtained using ftdp() so gtdp() must be already called. !! See documentation for ftdpxg() for details. !>\param[in] pv real, vapor pressure in Pascals -!>\param[out] ftdpx real, dewpoint temperature in Kelvin +!\param[out] ftdpx real, dewpoint temperature in Kelvin elemental function ftdpx(pv) !$$$ Subprogram Documentation Block ! @@ -1776,7 +1776,7 @@ elemental function ftdpx(pv) !! This function can be expanded inline in the calling routine. !>\param[in] tg real, guess dewpoint temperature in Kelvin !>\param[in] pv real, vapor pressure in Pascals -!>\param[out] ftdpxg real, dewpoint temperature in Kelvin +!\param[out] ftdpxg real, dewpoint temperature in Kelvin elemental function ftdpxg(tg,pv) !$$$ Subprogram Documentation Block ! @@ -1937,7 +1937,7 @@ subroutine gthe !! except zero is returned for too cold or high LCLs. !>\param[in] t real, LCL temperature in Kelvin !>\param[in] pk real, LCL pressure over 1e5 Pa to the kappa power -!>\param[out] fthe real, equivalent potential temperature in Kelvin +!\param[out] fthe real, equivalent potential temperature in Kelvin elemental function fthe(t,pk) !$$$ Subprogram Documentation Block ! @@ -2000,7 +2000,7 @@ elemental function fthe(t,pk) !! except zero is returned for too cold or high LCLs. !>\param[in] t real, LCL temperature in Kelvin !>\param[in] pk real, LCL pressure over 1e5 Pa to the kappa power -!>\param[out] ftheq real, equivalent potential temperature in Kelvin +!\param[out] ftheq real, equivalent potential temperature in Kelvin elemental function ftheq(t,pk) !$$$ Subprogram Documentation Block ! @@ -2085,7 +2085,7 @@ elemental function ftheq(t,pk) !! This function should be expanded inline in the calling routine. !>\param[in] t real, LCL temperature in Kelvin !>\param[in] pk real, LCL pressure over 1e5 Pa to the kappa power -!>\param[out] fthex real, equivalent potential temperature in Kelvin +!\param[out] fthex real, equivalent potential temperature in Kelvin function fthex(t,pk) !$$$ Subprogram Documentation Block ! @@ -2283,7 +2283,7 @@ elemental subroutine stma(the,pk,tma,qma) !! Input values outside table range are reset to table extrema. !>\param[in] the real, equivalent potential temperature in Kelvin !>\param[in] pk real, pressure over 1e5 Pa to the kappa power -!>\param[out] tmaq real, parcel temperature in Kelvin +!>\param[out] tma real, parcel temperature in Kelvin !>\param[out] qma real, parcel specific humidity in kg/kg elemental subroutine stmaq(the,pk,tma,qma) !$$$ Subprogram Documentation Block @@ -2569,7 +2569,7 @@ subroutine gpkap !! computed in gpkap(). See documentation for fpkapx() for details. !! Input values outside table range are reset to table extrema. !>\param[in] p real, pressure in Pascals -!>\param[out] fpkap real, p over 1e5 Pa to the kappa power +!\param[out] fpkap real, p over 1e5 Pa to the kappa power elemental function fpkap(p) !$$$ Subprogram Documentation Block ! @@ -2621,7 +2621,7 @@ elemental function fpkap(p) !! computed in gpkap(). see documentation for fpkapx() for details. !! Input values outside table range are reset to table extrema. !>\param[in] p real, pressure in Pascals -!>\param[out] fpkapq real, p over 1e5 Pa to the kappa power +!\param[out] fpkapq real, p over 1e5 Pa to the kappa power elemental function fpkapq(p) !$$$ Subprogram Documentation Block ! @@ -2678,7 +2678,7 @@ elemental function fpkapq(p) !! The pressure range is 40000-110000 Pa and kappa is defined in fpkapx(). !>\param[in] p real, surface pressure in Pascals p should be in the !! range 40000 to 110000 -!>\param[out] fpkapo real, p over 1e5 Pa to the kappa power +!\param[out] fpkapo real, p over 1e5 Pa to the kappa power function fpkapo(p) !$$$ Subprogram documentation block ! @@ -2739,7 +2739,7 @@ function fpkapo(p) !> This function raises pressure over 1e5 Pa to the kappa power. !! Kappa is equal to rd/cp where rd and cp are physical constants. !>\param[in] p real, pressure in Pascals -!>\param[out] fpkapx real, p over 1e5 Pa to the kappa power +!\param[out] fpkapx real, p over 1e5 Pa to the kappa power elemental function fpkapx(p) !$$$ Subprogram documentation block ! @@ -2827,7 +2827,7 @@ subroutine grkap !! computed in grkap(). See documentation for frkapx() for details. !! Input values outside table range are reset to table extrema. !>\param[in] pkap real, p over 1e5 Pa to the kappa power -!>\param[out] frkap real, pressure in Pascals +!\param[out] frkap real, pressure in Pascals elemental function frkap(pkap) !$$$ Subprogram Documentation Block ! @@ -2878,7 +2878,7 @@ elemental function frkap(pkap) !! computed in grkap(). see documentation for frkapx() for details. !! Input values outside table range are reset to table extrema. !>\param[in] pkap real, p over 1e5 Pa to the kappa power -!>\param[out] frkapq real, pressure in Pascals +!\param[out] frkapq real, pressure in Pascals elemental function frkapq(pkap) !$$$ Subprogram Documentation Block ! @@ -2931,7 +2931,7 @@ elemental function frkapq(pkap) !> This function raise pressure over 1e5 Pa to the 1/kappa power. !! Kappa is equal to rd/cp where rd and cp are physical constants. !>\param[in] pkap real, p over 1e5 Pa to the kappa power -!>\param[out] frkapx real, pressure in Pascals +!\param[out] frkapx real, pressure in Pascals elemental function frkapx(pkap) !$$$ Subprogram documentation block ! @@ -3032,7 +3032,7 @@ subroutine gtlcl !! Input values outside table range are reset to table extrema. !>\param[in] t real, LCL temperature in Kelvin !>\param[in] tdpd real, dewpoint depression in Kelvin -!>\param[out] ftlcl real, temperature at the LCL in Kelvin +!\param[out] ftlcl real, temperature at the LCL in Kelvin elemental function ftlcl(t,tdpd) !$$$ Subprogram Documentation Block ! @@ -3087,7 +3087,7 @@ elemental function ftlcl(t,tdpd) !! Input values outside table range are reset to table extrema. !>\param[in] t real, LCL temperature in Kelvin !>\param[in] tdpd real, dowpoint depression in Kelvin -!>\param[out] ftlcl real, temperature at the LCL in Kelvin +!\param[out] ftlcl real, temperature at the LCL in Kelvin elemental function ftlclq(t,tdpd) !$$$ Subprogram Documentation Block ! @@ -3155,7 +3155,7 @@ elemental function ftlclq(t,tdpd) !! approximates the original exact implicit relationship. !>\param[in] t real, temperature in Kelvin !>\param[in] tdpd real, dewpoint depression in Kelvin -!>\param[out] ftlclo real, temperature at the LCL in Kelvin +!\param[out] ftlclo real, temperature at the LCL in Kelvin function ftlclo(t,tdpd) !$$$ Subprogram documentation block ! @@ -3219,7 +3219,7 @@ function ftlclo(t,tdpd) !! returned temperature is 180 Kelvin. !>\param[in] t real, temperature in Kelvin !>\param[in] tdpd real, dewpoint depression in Kelvin -!>\param[out] ftlclx real, temperature at the LCL in Kelvin +!\param[out] ftlclx real, temperature at the LCL in Kelvin elemental function ftlclx(t,tdpd) !$$$ Subprogram documentation block ! diff --git a/physics/gcm_shoc.F90 b/physics/gcm_shoc.F90 index f2c9b7a7b..b32843bc1 100644 --- a/physics/gcm_shoc.F90 +++ b/physics/gcm_shoc.F90 @@ -21,225 +21,128 @@ end subroutine shoc_finalize #if 0 !> \section arg_table_shoc_run Argument Table -!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | -!! |----------------------------|-----------------------------------------------------------------------------|---------------------------------------------------------------------------------------------|---------------|------|------------|-----------|--------|----------| -!! | ix | horizontal_dimension | horizontal dimension | count | 0 | integer | | in | F | -!! | nx | horizontal_loop_extent | horizontal loop extent | count | 0 | integer | | in | F | -!! | nzm | vertical_dimension | vertical layer dimension | count | 0 | integer | | in | F | -!! | do_shoc | flag_for_shoc | flag for SHOC | flag | 0 | logical | | in | F | -!! | shocaftcnv | flag_for_shoc_after_convection | flag to execute SHOC after convection | flag | 0 | logical | | in | F | -!! | mg3_as_mg2 | flag_mg3_as_mg2 | flag for controlling prep for Morrison-Gettelman microphysics | flag | 0 | logical | | in | F | -!! | imp_physics | flag_for_microphysics_scheme | choice of microphysics scheme | flag | 0 | integer | | in | F | -!! | imp_physics_gfdl | flag_for_gfdl_microphysics_scheme | choice of GFDL microphysics scheme | flag | 0 | integer | | in | F | -!! | imp_physics_zhao_carr | flag_for_zhao_carr_microphysics_scheme | choice of Zhao-Carr microphysics scheme | flag | 0 | integer | | in | F | -!! | imp_physics_zhao_carr_pdf | flag_for_zhao_carr_pdf_microphysics_scheme | choice of Zhao-Carr microphysics scheme with PDF clouds | flag | 0 | integer | | in | F | -!! | imp_physics_mg | flag_for_morrison_gettelman_microphysics_scheme | choice of Morrison-Gettelman rmicrophysics scheme | flag | 0 | integer | | in | F | -!! | fprcp | number_of_frozen_precipitation_species | number of frozen precipitation species | count | 0 | integer | | in | F | -!! | tcr | cloud_phase_transition_threshold_temperature | threshold temperature below which cloud starts to freeze | K | 0 | real | kind_phys | in | F | -!! | tcrf | cloud_phase_transition_denominator | denominator in cloud phase transition = 1/(tcr-tf) | K-1 | 0 | real | kind_phys | in | F | -!! | con_cp | specific_heat_of_dry_air_at_constant_pressure | specific heat of dry air at constant pressure | J kg-1 K-1 | 0 | real | kind_phys | in | F | -!! | con_g | gravitational_acceleration | gravitational acceleration | m s-2 | 0 | real | kind_phys | in | F | -!! | con_hvap | latent_heat_of_vaporization_of_water_at_0C | latent heat of evaporation/sublimation | J kg-1 | 0 | real | kind_phys | in | F | -!! | con_hfus | latent_heat_of_fusion_of_water_at_0C | latent heat of fusion | J kg-1 | 0 | real | kind_phys | in | F | -!! | con_rv | gas_constant_water_vapor | ideal gas constant for water vapor | J kg-1 K-1 | 0 | real | kind_phys | in | F | -!! | con_rd | gas_constant_dry_air | ideal gas constant for dry air | J kg-1 K-1 | 0 | real | kind_phys | in | F | -!! | con_pi | pi | ratio of a circle's circumference to its diameter | radians | 0 | real | kind_phys | in | F | -!! | con_fvirt | ratio_of_vapor_to_dry_air_gas_constants_minus_one | (rv/rd) - 1 (rv = ideal gas constant for water vapor) | none | 0 | real | kind_phys | in | F | -!! | gq0_cloud_ice | ice_water_mixing_ratio_updated_by_physics | moist (dry+vapor, no condensates) mixing ratio of ice water updated by physics | kg kg-1 | 2 | real | kind_phys | in | F | -!! | gq0_rain | rain_water_mixing_ratio_updated_by_physics | moist (dry+vapor, no condensates) mixing ratio of rain water updated by physics | kg kg-1 | 2 | real | kind_phys | in | F | -!! | gq0_snow | snow_water_mixing_ratio_updated_by_physics | moist (dry+vapor, no condensates) mixing ratio of snow water updated by physics | kg kg-1 | 2 | real | kind_phys | in | F | -!! | gq0_graupel | graupel_mixing_ratio_updated_by_physics | moist (dry+vapor, no condensates) mixing ratio of graupel updated by physics | kg kg-1 | 2 | real | kind_phys | in | F | -!! | dtp | time_step_for_physics | time step for physics | s | 0 | real | kind_phys | in | F | -!! | me | mpi_rank | current MPI-rank | index | 0 | integer | | in | F | -!! | prsl | air_pressure | mean layer pressure | Pa | 2 | real | kind_phys | in | F | -!! | phii | geopotential_at_interface | geopotential at model layer interfaces | m2 s-2 | 2 | real | kind_phys | in | F | -!! | phil | geopotential | geopotential at model layer centers | m2 s-2 | 2 | real | kind_phys | in | F | -!! | u | x_wind_updated_by_physics | zonal wind updated by physics | m s-1 | 2 | real | kind_phys | in | F | -!! | v | y_wind_updated_by_physics | meridional wind updated by physics | m s-1 | 2 | real | kind_phys | in | F | -!! | omega | omega | layer mean vertical velocity | Pa s-1 | 2 | real | kind_phys | in | F | -!! | rhc | critical_relative_humidity | critical relative humidity | frac | 2 | real | kind_phys | in | F | -!! | supice | ice_supersaturation_threshold | ice supersaturation parameter for PDF clouds | none | 0 | real | kind_phys | in | F | -!! | pcrit | shoc_tke_dissipatation_pressure_threshold | pressure below which extra TKE diss. is applied in SHOC | Pa | 0 | real | kind_phys | in | F | -!! | cefac | shoc_tke_dissipation_tunable_parameter | mult. tuning parameter for TKE diss. in SHOC | none | 0 | real | kind_phys | in | F | -!! | cesfac | shoc_tke_dissipation_tunable_parameter_near_surface | mult. tuning parameter for TKE diss. at surface in SHOC | none | 0 | real | kind_phys | in | F | -!! | tkef1 | shoc_implicit_TKE_integration_uncentering_term | uncentering term for TKE integration in SHOC | none | 0 | real | kind_phys | in | F | -!! | dis_opt | shoc_flag_for_optional_surface_TKE_dissipation | flag for alt. TKE diss. near surface in SHOC (>0 = ON) | none | 0 | real | kind_phys | in | F | -!! | hflx | kinematic_surface_upward_sensible_heat_flux | kinematic surface upward sensible heat flux | K m s-1 | 1 | real | kind_phys | in | F | -!! | evap | kinematic_surface_upward_latent_heat_flux | kinematic surface upward latent heat flux | kg kg-1 m s-1 | 1 | real | kind_phys | in | F | -!! | prnum | prandtl_number | turbulent Prandtl number | none | 2 | real | kind_phys | in | F | -!! | skip_macro | flag_skip_macro | flag to skip cloud macrophysics in Morrison scheme | flag | 0 | logical | | inout | F | -!! | clw_ice | ice_water_mixing_ratio_convective_transport_tracer | moist (dry+vapor, no condensates) mixing ratio of ice water in the convectively transported tracer array | kg kg-1 | 2 | real | kind_phys | inout | F | -!! | clw_liquid | cloud_condensed_water_mixing_ratio_convective_transport_tracer | moist (dry+vapor, no condensates) mixing ratio of cloud water (condensate) in the convectively transported tracer array | kg kg-1 | 2 | real | kind_phys | inout | F | -!! | gq0_cloud_liquid | cloud_condensed_water_mixing_ratio_updated_by_physics | moist (dry+vapor, no condensates) mixing ratio of cloud condensed water updated by physics | kg kg-1 | 2 | real | kind_phys | inout | F | -!! | ncpl | cloud_droplet_number_concentration_updated_by_physics | number concentration of cloud droplets updated by physics | kg-1 | 2 | real | kind_phys | inout | F | -!! | ncpi | ice_number_concentration_updated_by_physics | number concentration of ice updated by physics | kg-1 | 2 | real | kind_phys | inout | F | -!! | gt0 | air_temperature_updated_by_physics | temperature updated by physics | K | 2 | real | kind_phys | inout | F | -!! | gq0_water_vapor | water_vapor_specific_humidity_updated_by_physics | water vapor specific humidity updated by physics | kg kg-1 | 2 | real | kind_phys | inout | F | -!! | cld_sgs | subgrid_scale_cloud_fraction_from_shoc | subgrid-scale cloud fraction from the SHOC scheme | frac | 2 | real | kind_phys | inout | F | -!! | tke | turbulent_kinetic_energy_convective_transport_tracer | turbulent kinetic energy in the convectively transported tracer array | m2 s-2 | 2 | real | kind_phys | inout | F | -!! | tkh | atmosphere_heat_diffusivity_from_shoc | diffusivity for heat from the SHOC scheme | m2 s-1 | 2 | real | kind_phys | inout | F | -!! | wthv_sec | kinematic_buoyancy_flux_from_shoc | upward kinematic buoyancy flux from the SHOC scheme | K m s-1 | 2 | real | kind_phys | inout | F | -!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | -!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | +!! \htmlinclude shoc_run.html !! #endif -subroutine shoc_run (ix, nx, nzm, do_shoc, shocaftcnv, mg3_as_mg2, imp_physics, imp_physics_gfdl, imp_physics_zhao_carr, & - imp_physics_zhao_carr_pdf, imp_physics_mg, fprcp, tcr, tcrf, con_cp, con_g, con_hvap, con_hfus, con_rv, con_rd, con_pi, & - con_fvirt, gq0_cloud_ice, gq0_rain, gq0_snow, gq0_graupel, dtp, me, prsl, phii, phil, u, v, omega, rhc, supice, pcrit, & - cefac, cesfac, tkef1, dis_opt, hflx, evap, prnum, & - skip_macro, clw_ice, clw_liquid, gq0_cloud_liquid, ncpl, ncpi, gt0, gq0_water_vapor, cld_sgs, tke, tkh, wthv_sec, & - errmsg, errflg) +subroutine shoc_run (ix, nx, nzm, tcr, tcrf, con_cp, con_g, con_hvap, con_hfus, con_rv, con_rd, & + con_pi, con_fvirt, dtp, prsl, delp, phii, phil, u, v, omega, rhc, & + supice, pcrit, cefac, cesfac, tkef1, dis_opt, hflx, evap, prnum, & + gt0, gq0, ntrac, ntqv, ntcw, ntiw, ntrw, ntsw, ntgl, ntlnc, ntinc, & + cld_sgs, tke, tkh, wthv_sec, errmsg, errflg) implicit none - integer, intent(in) :: ix, nx, nzm, imp_physics, imp_physics_gfdl, imp_physics_zhao_carr, imp_physics_zhao_carr_pdf, & - imp_physics_mg, fprcp, me - logical, intent(in) :: do_shoc, shocaftcnv, mg3_as_mg2 + integer, intent(in) :: ix, nx, nzm, ntrac, ntqv, ntcw, ntiw, ntrw, ntsw, ntgl, ntlnc, ntinc real(kind=kind_phys), intent(in) :: tcr, tcrf, con_cp, con_g, con_hvap, con_hfus, con_rv, con_rd, con_pi, con_fvirt, & - dtp, supice, pcrit, cefac, cesfac, tkef1, dis_opt + dtp, supice, pcrit, cefac, cesfac, tkef1, dis_opt ! - real(kind=kind_phys), intent(in), dimension(nx) :: hflx, evap - real(kind=kind_phys), intent(in), dimension(nx,nzm) :: gq0_cloud_ice, gq0_rain, gq0_snow, gq0_graupel, prsl, phil, & - u, v, omega, rhc, prnum + real(kind=kind_phys), intent(in), dimension(nx) :: hflx, evap + real(kind=kind_phys), intent(in), dimension(nx,nzm) :: prsl, delp, phil, u, v, omega, rhc, prnum real(kind=kind_phys), intent(in), dimension(nx,nzm+1) :: phii ! - logical, intent(inout) :: skip_macro - real(kind=kind_phys), intent(inout), dimension(nx,nzm) :: clw_ice, clw_liquid, gq0_cloud_liquid, ncpl, ncpi, gt0, & - gq0_water_vapor, cld_sgs, tke, tkh, wthv_sec + real(kind=kind_phys), intent(inout), dimension(nx,nzm) :: gt0, cld_sgs, tke, tkh, wthv_sec + real(kind=kind_phys), intent(inout), dimension(nx,nzm,ntrac) :: gq0 character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg - real(kind=kind_phys), parameter :: epsq = 1.e-20 + real(kind=kind_phys), parameter :: epsq = 1.d-20 integer :: i, k real(kind=kind_phys) :: tem - real(kind=kind_phys), dimension(nx,nzm) :: qsnw ! qsnw can be local to this routine - real(kind=kind_phys), dimension(nx,nzm) :: qgl ! qgl can be local to this routine + real(kind=kind_phys), dimension(nx,nzm) :: qi ! local array of suspended cloud ice + real(kind=kind_phys), dimension(nx,nzm) :: qc ! local array of suspended cloud water + real(kind=kind_phys), dimension(nx,nzm) :: qsnw ! local array of suspended snowq + real(kind=kind_phys), dimension(nx,nzm) :: qrn ! local array of suepended rain + real(kind=kind_phys), dimension(nx,nzm) :: qgl ! local array of suspended graupel + real(kind=kind_phys), dimension(nx,nzm) :: ncpl ! local array of cloud water number concentration + real(kind=kind_phys), dimension(nx,nzm) :: ncpi ! local array of cloud ice number concentration ! Initialize CCPP error handling variables errmsg = '' errflg = 0 - if (shocaftcnv) then - if (imp_physics == imp_physics_mg) then - skip_macro = do_shoc - if (abs(fprcp) == 1 .or. mg3_as_mg2) then - do k=1,nzm - do i=1,nx - !GF - gq0(ntrw) is passed in directly, no need to copy - !qrn(i,k) = gq0_rain(i,k) - qsnw(i,k) = gq0_snow(i,k) - qgl(i,k) = 0.0 - enddo - enddo - elseif (fprcp > 1) then - do k=1,nzm - do i=1,nx - !qrn(i,k) = gq0_rain(i,k) - qsnw(i,k) = gq0_snow(i,k) + gq0_graupel(i,k) - qgl(i,k) = 0.0 - enddo - enddo - endif - endif - else - if (imp_physics == imp_physics_mg) then - skip_macro = do_shoc - do k=1,nzm + if (ntiw < 0) then ! this is valid only for Zhao-Carr scheme + do k=1,nzm do i=1,nx - ! DH* THESE ARE NOT IN THE ORIGINAL CODE (AND THEY WERE NEVER) ::: clw_ice(i,k) = gq0_cloud_ice(i,k) ! ice - ! DH* THESE ARE NOT IN THE ORIGINAL CODE (AND THEY WERE NEVER) ::: clw_liquid(i,k) = gq0_cloud_liquid(i,k) ! water - !GF - since gq0(ntlnc/ntinc) are passed in directly, no need to copy - !ncpl(i,k) = Stateout%gq0(i,k,ntlnc) - !ncpi(i,k) = Stateout%gq0(i,k,ntinc) + qc(i,k) = gq0(i,k,ntcw) + if (abs(qc(i,k)) < epsq) then + qc(i,k) = 0.0 + endif + tem = qc(i,k) * max(0.0, MIN(1.0, (tcr-gt0(i,k))*tcrf)) + qi(i,k) = tem ! ice + qc(i,k) = qc(i,k) - tem ! water + qrn(i,k) = 0.0 + qsnw(i,k) = 0.0 + ncpl(i,k) = 0 + ncpi(i,k) = 0 enddo enddo - if (abs(fprcp) == 1 .or. mg3_as_mg2) then - do k=1,nzm - do i=1,nx - !GF - gq0(ntrw) is passed in directly, no need to copy - !qrn(i,k) = gq0_rain(i,k) - qsnw(i,k) = gq0_snow(i,k) - qgl(i,k) = 0.0 + else + if (ntgl > 0) then ! graupel exists - combine graupel with snow + do k=1,nzm + do i=1,nx + qc(i,k) = gq0(i,k,ntcw) + qi(i,k) = gq0(i,k,ntiw) + qrn(i,k) = gq0(i,k,ntrw) + qsnw(i,k) = gq0(i,k,ntsw) + gq0(i,k,ntgl) enddo enddo - elseif (fprcp > 1) then - do k=1,nzm - do i=1,nx - !qrn(i,k) = gq0_rain(i,k) - qsnw(i,k) = gq0_snow(i,k) + gq0_graupel(i,k) - qgl(i,k) = 0.0 - clw_ice(i,k) = clw_ice(i,k) + gq0_graupel(i,k) + else ! no graupel + do k=1,nzm + do i=1,nx + qc(i,k) = gq0(i,k,ntcw) + qi(i,k) = gq0(i,k,ntiw) + qrn(i,k) = gq0(i,k,ntrw) + qsnw(i,k) = gq0(i,k,ntsw) enddo enddo - endif - elseif (imp_physics == imp_physics_gfdl) then ! GFDL MP - needs modify for condensation - do k=1,nzm - do i=1,nx - clw_ice(i,k) = gq0_cloud_ice(i,k) ! ice - clw_liquid(i,k) = gq0_cloud_liquid(i,k) ! water - !qrn(i,k) = gq0_rain(i,k) - qsnw(i,k) = gq0_snow(i,k) - qgl(i,k) = 0.0 - enddo - enddo - elseif (imp_physics == imp_physics_zhao_carr .or. imp_physics == imp_physics_zhao_carr_pdf) then - do k=1,nzm - do i=1,nx - if (abs(gq0_cloud_liquid(i,k)) < epsq) then - gq0_cloud_liquid(i,k) = 0.0 - endif - tem = gq0_cloud_liquid(i,k) * max(0.0, MIN(1.0, (tcr-gt0(i,k))*tcrf)) - clw_ice(i,k) = tem ! ice - clw_liquid(i,k) = gq0_cloud_liquid(i,k) - tem ! water - qsnw(i,k) = 0.0 - qgl(i,k) = 0.0 - enddo - enddo endif - endif !shocaftcnv + if (ntlnc > 0) then + do k=1,nzm + do i=1,nx + ncpl(i,k) = gq0(i,k,ntlnc) + ncpi(i,k) = gq0(i,k,ntinc) + enddo + enddo + endif + endif ! phy_f3d(1,1,ntot3d-2) - shoc determined sgs clouds ! phy_f3d(1,1,ntot3d-1) - shoc determined diffusion coefficients ! phy_f3d(1,1,ntot3d ) - shoc determined w'theta' - !GFDL lat has no meaning inside of shoc - changed to "1" - + call shoc_work (ix, nx, nzm, nzm+1, dtp, prsl, delp, & + phii, phil, u, v, omega, gt0, gq0(:,:,1), qi, qc, qsnw, qrn, & + rhc, supice, pcrit, cefac, cesfac, tkef1, dis_opt, & + cld_sgs, tke, hflx, evap, prnum, tkh, wthv_sec, & + ntlnc, ncpl, ncpi, & + con_cp, con_g, con_hvap, con_hfus, con_rv, con_rd, con_pi, con_fvirt) - ! DH* can we pass in gq0_graupel? is that zero? the original code - ! passes in qgl which is zero (always? sometimes?), in shoc_work - ! this qgl gets added to qpi, qpi = qpi_i + qgl with qpi_i = qsnw; - ! - with the above qsnw(i,k) = gq0_snow(i,k) + gq0_graupel(i,k), - ! would that be double counting? *DH - call shoc_work (ix, nx, 1, nzm, nzm+1, dtp, me, 1, prsl, & - phii, phil, u, v, omega, gt0, & - gq0_water_vapor, clw_ice, clw_liquid, qsnw, gq0_rain, & - qgl, rhc, supice, pcrit, cefac, cesfac, tkef1, dis_opt, & - cld_sgs, tke, hflx, evap, prnum, tkh, wthv_sec, .false., 1, ncpl, ncpi, & - con_cp, con_g, con_hvap, con_hfus, con_rv, con_rd, con_pi, con_fvirt) - - if (.not.shocaftcnv) then - if (imp_physics == imp_physics_mg .and. fprcp > 1) then + if (ntiw < 0) then ! this is valid only for Zhao-Carr scheme + do k=1,nzm + do i=1,nx + gq0(i,k,ntcw) = qc(i,k) + qi(i,k) + enddo + enddo + else + do k=1,nzm + do i=1,nx + gq0(i,k,ntcw) = qc(i,k) + gq0(i,k,ntiw) = qi(i,k) + enddo + enddo + if (ntlnc > 0) then do k=1,nzm do i=1,nx - clw_ice(i,k) = clw_ice(i,k) - gq0_graupel(i,k) + gq0(i,k,ntlnc) = ncpl(i,k) + gq0(i,k,ntinc) = ncpi(i,k) enddo enddo endif - endif ! .not. shocaftcnv - - !GF since gq0(ntlnc/ntinc) are passed in directly, no need to copy back - ! if (ntlnc > 0 .and. ntinc > 0 .and. ncld >= 2) then - ! do k=1,nzm - ! do i=1,nx - ! Stateout%gq0(i,k,ntlnc) = ncpl(i,k) - ! Stateout%gq0(i,k,ntinc) = ncpi(i,k) - ! enddo - ! enddo - ! endif + endif end subroutine shoc_run @@ -258,27 +161,25 @@ end subroutine shoc_run ! replacing fac_fus by fac_sub ! S.Moorthi - 00-00-17 - added an alternate option for near boundary cek following ! Scipion et. al., from U. Oklahoma. - subroutine shoc_work (ix, nx, ny, nzm, nz, dtn, me, lat, & - prsl, phii, phil, u, v, omega, tabs, & - qwv, qi, qc, qpi_i, qpl, qgl, rhc, supice, & - pcrit, cefac, cesfac, tkef1, dis_opt, & - cld_sgs, tke, hflx, evap, prnum, tkh, & - wthv_sec, lprnt, ipr, ncpl, ncpi, & - cp, ggr, lcond, lfus, rv, rgas, pi, epsv) + subroutine shoc_work (ix, nx, nzm, nz, dtn, & + prsl, delp, phii, phil, u, v, omega, tabs, & + qwv, qi, qc, qpi, qpl, rhc, supice, & + pcrit, cefac, cesfac, tkef1, dis_opt, & + cld_sgs, tke, hflx, evap, prnum, tkh, & + wthv_sec, ntlnc, ncpl, ncpi, & + cp, ggr, lcond, lfus, rv, rgas, pi, epsv) use funcphys , only : fpvsl, fpvsi, fpvs ! saturation vapor pressure for water & ice implicit none - real, intent(in) :: cp, ggr, lcond, lfus, rv, rgas, pi, epsv + real, intent(in) :: cp, ggr, lcond, lfus, rv, rgas, pi, epsv integer, intent(in) :: ix ! max number of points in the physics window in the x integer, intent(in) :: nx ! Number of points in the physics window in the x - integer, intent(in) :: ny ! and y directions - integer, intent(in) :: me ! MPI rank - integer, intent(in) :: lat ! latitude integer, intent(in) :: nzm ! Number of vertical layers integer, intent(in) :: nz ! Number of layer interfaces (= nzm + 1) + integer, intent(in) :: ntlnc ! index of liquid water number concentration real, intent(in) :: dtn ! Physics time step, s real, intent(in) :: pcrit ! pressure in Pa below which additional tke dissipation is applied @@ -292,58 +193,61 @@ subroutine shoc_work (ix, nx, ny, nzm, nz, dtn, me, lat, & ! The interface is talored to GFS in a sense that input variables are 2D - real, intent(in) :: prsl (ix,ny,nzm) ! mean layer presure - real, intent(in) :: phii (ix,ny,nz ) ! interface geopotential height - real, intent(in) :: phil (ix,ny,nzm) ! layer geopotential height - real, intent(in) :: u (ix,ny,nzm) ! u-wind, m/s - real, intent(in) :: v (ix,ny,nzm) ! v-wind, m/s - real, intent(in) :: omega (ix,ny,nzm) ! omega, Pa/s - real, intent(inout) :: tabs (ix,ny,nzm) ! temperature, K - real, intent(inout) :: qwv (ix,ny,nzm) ! water vapor mixing ratio, kg/kg - real, intent(inout) :: qc (ix,ny,nzm) ! cloud water mixing ratio, kg/kg - real, intent(inout) :: qi (ix,ny,nzm) ! cloud ice mixing ratio, kg/kg + real, intent(in) :: prsl (ix,nzm) ! mean layer presure + real, intent(in) :: delp (ix,nzm) ! layer presure depth + real, intent(in) :: phii (ix,nz ) ! interface geopotential height + real, intent(in) :: phil (ix,nzm) ! layer geopotential height + real, intent(in) :: u (ix,nzm) ! u-wind, m/s + real, intent(in) :: v (ix,nzm) ! v-wind, m/s + real, intent(in) :: omega (ix,nzm) ! omega, Pa/s + real, intent(inout) :: tabs (ix,nzm) ! temperature, K + real, intent(inout) :: qwv (ix,nzm) ! water vapor mixing ratio, kg/kg + real, intent(inout) :: qc (ix,nzm) ! cloud water mixing ratio, kg/kg + real, intent(inout) :: qi (ix,nzm) ! cloud ice mixing ratio, kg/kg ! Anning Cheng 03/11/2016 SHOC feedback to number concentration - real, intent(inout) :: ncpl (nx,ny,nzm) ! cloud water number concentration,/m^3 - real, intent(inout) :: ncpi (nx,ny,nzm) ! cloud ice number concentration,/m^3 - real, intent(in) :: qpl (nx,ny,nzm) ! rain mixing ratio, kg/kg - not used at this time - real, intent(in) :: qpi_i (nx,ny,nzm) ! snow mixing ratio, kg/kg - not used at this time - real, intent(in) :: qgl (nx,ny,nzm) ! graupel mixing ratio, kg/kg - not used at this time - real, intent(in) :: rhc (nx,ny,nzm) ! critical relative humidity - real, intent(in) :: supice ! ice supersaturation parameter - real, intent(inout) :: cld_sgs(ix,ny,nzm) ! sgs cloud fraction -! real, intent(inout) :: cld_sgs(nx,ny,nzm) ! sgs cloud fraction - real, intent(inout) :: tke (ix,ny,nzm) ! turbulent kinetic energy. m**2/s**2 -! real, intent(inout) :: tk (nx,ny,nzm) ! eddy viscosity - real, intent(inout) :: tkh (ix,ny,nzm) ! eddy diffusivity - real, intent(in) :: prnum (nx,ny,nzm) ! turbulent Prandtl number - real, intent(inout) :: wthv_sec (ix,ny,nzm) ! Buoyancy flux, K*m/s - - real, parameter :: zero=0.0, one=1.0, half=0.5, two=2.0, eps=0.622, & - three=3.0, oneb3=one/three, twoby3=two/three - real, parameter :: sqrt2 = sqrt(two), twoby15 = two / 15.0, & - skew_facw=1.2, skew_fact=0.0, & - tkhmax=300.0 - real :: lsub, fac_cond, fac_fus, cpolv, fac_sub, ggri, kapa, gocp, rog, sqrtpii, & - epsterm, onebeps, onebrvcp + real, intent(inout) :: ncpl (nx,nzm) ! cloud water number concentration,/m^3 + real, intent(inout) :: ncpi (nx,nzm) ! cloud ice number concentration,/m^3 + real, intent(in) :: qpl (nx,nzm) ! rain mixing ratio, kg/kg + real, intent(in) :: qpi (nx,nzm) ! snow mixing ratio, kg/kg + + real, intent(in) :: rhc (nx,nzm) ! critical relative humidity + real, intent(in) :: supice ! ice supersaturation parameter + real, intent(out) :: cld_sgs(ix,nzm) ! sgs cloud fraction +! real, intent(inout) :: cld_sgs(nx,nzm) ! sgs cloud fraction + real, intent(inout) :: tke (ix,nzm) ! turbulent kinetic energy. m**2/s**2 +! real, intent(inout) :: tk (nx,nzm) ! eddy viscosity + real, intent(inout) :: tkh (ix,nzm) ! eddy diffusivity + real, intent(in) :: prnum (nx,nzm) ! turbulent Prandtl number + real, intent(inout) :: wthv_sec (ix,nzm) ! Buoyancy flux, K*m/s + + real, parameter :: zero=0.0d0, one=1.0d0, half=0.5d0, two=2.0d0, eps=0.622d0, & + three=3.0d0, oneb3=one/three, twoby3=two/three, fourb3=twoby3+twoby3 + real, parameter :: sqrt2 = sqrt(two), twoby15 = two / 15.d0, & + nmin = 1.0d0, RI_cub = 6.4d-14, RL_cub = 1.0d-15, & + skew_facw=1.2d0, skew_fact=0.d0, & + tkhmax=300.d0, qcmin=1.0d-9 + real :: lsub, fac_cond, fac_fus, cpolv, fac_sub, ggri, kapa, gocp, & + rog, sqrtpii, epsterm, onebeps, onebrvcp ! SHOC tunable parameters - real, parameter :: lambda = 0.04 -! real, parameter :: min_tke = 1e-6 ! Minumum TKE value, m**2/s**2 - real, parameter :: min_tke = 1e-4 ! Minumum TKE value, m**2/s**2 -! real, parameter :: max_tke = 100.0 ! Maximum TKE value, m**2/s**2 - real, parameter :: max_tke = 40.0 ! Maximum TKE value, m**2/s**2 + real, parameter :: lambda = 0.04d0 +! real, parameter :: min_tke = 1.0d-6 ! Minumum TKE value, m**2/s**2 + real, parameter :: min_tke = 1.0d-4 ! Minumum TKE value, m**2/s**2 +! real, parameter :: max_tke = 100.0d0 ! Maximum TKE value, m**2/s**2 + real, parameter :: max_tke = 40.0d0 ! Maximum TKE value, m**2/s**2 ! Maximum turbulent eddy length scale, m -! real, parameter :: max_eddy_length_scale = 2000. - real, parameter :: max_eddy_length_scale = 1000. +! real, parameter :: max_eddy_length_scale = 2000.0d0 + real, parameter :: max_eddy_length_scale = 1000.0d0 ! Maximum "return-to-isotropy" time scale, s - real, parameter :: max_eddy_dissipation_time_scale = 2000. - real, parameter :: Pr = 1.0 ! Prandtl number + real, parameter :: max_eddy_dissipation_time_scale = 2000.d0 + real, parameter :: Pr = 1.0d0 ! Prandtl number ! Constants for the TKE dissipation term based on Deardorff (1980) - real, parameter :: pt19=0.19, pt51=0.51, pt01=0.01, atmin=0.01, atmax=one-atmin - real, parameter :: Cs = 0.15, epsln=1.0e-6 - real, parameter :: Ck = 0.1 ! Coeff in the eddy diffusivity - TKE relationship, see Eq. 7 in BK13 + real, parameter :: pt19=0.19d0, pt51=0.51d0, pt01=0.01d0, atmin=0.01d0, atmax=one-atmin + real, parameter :: Cs = 0.15d0, epsln=1.0d-6 +! real, parameter :: Ck = 0.2d0 ! Coeff in the eddy diffusivity - TKE relationship, see Eq. 7 in BK13 + real, parameter :: Ck = 0.1d0 ! Coeff in the eddy diffusivity - TKE relationship, see Eq. 7 in BK13 ! real, parameter :: Ce = Ck**3/(0.7*Cs**4) ! real, parameter :: Ce = Ck**3/(0.7*Cs**4) * 2.2 @@ -356,79 +260,75 @@ subroutine shoc_work (ix, nx, ny, nzm, nz, dtn, me, lat, & real, parameter :: Ce = Ck**3/Cs**4, Ces = Ce ! real, parameter :: Ce = Ck**3/Cs**4, Ces = Ce*3.0/0.7 -! real, parameter :: vonk=0.35 ! Von Karman constant - real, parameter :: vonk=0.4 ! Von Karman constant Moorthi - as in GFS - real, parameter :: tscale=400.! time scale set based off of similarity results of BK13, s - real, parameter :: w_tol_sqd = 4.0e-04 ! Min vlaue of second moment of w +! real, parameter :: vonk=0.35 ! Von Karman constant + real, parameter :: vonk=0.4d0 ! Von Karman constant Moorthi - as in GFS + real, parameter :: tscale=400.0d0 ! time scale set based off of similarity results of BK13, s + real, parameter :: w_tol_sqd = 4.0d-04 ! Min vlaue of second moment of w ! real, parameter :: w_tol_sqd = 1.0e-04 ! Min vlaue of second moment of w - real, parameter :: w_thresh = 0.0, thresh = 0.0 - real, parameter :: w3_tol = 1.0e-20 ! Min vlaue of third moment of w + real, parameter :: w_thresh = 0.0d0, thresh = 0.0d0 + real, parameter :: w3_tol = 1.0d-20 ! Min vlaue of third moment of w ! These parameters are a tie-in with a microphysical scheme ! Double check their values for the Zhao-Carr scheme. - real, parameter :: tbgmin = 233.16 ! Minimum temperature for cloud water., K (ZC) -! real, parameter :: tbgmin = 258.16 ! Minimum temperature for cloud water., K (ZC) -! real, parameter :: tbgmin = 253.16 ! Minimum temperature for cloud water., K - real, parameter :: tbgmax = 273.16 ! Maximum temperature for cloud ice, K + real, parameter :: tbgmin = 233.16d0 ! Minimum temperature for cloud water., K (ZC) +! real, parameter :: tbgmin = 258.16d0 ! Minimum temperature for cloud water., K (ZC) +! real, parameter :: tbgmin = 253.16d0 ! Minimum temperature for cloud water., K + real, parameter :: tbgmax = 273.16d0 ! Maximum temperature for cloud ice, K real, parameter :: a_bg = one/(tbgmax-tbgmin) ! ! Parameters to tune the second order moments- No tuning is performed currently - real, parameter :: thl2tune = 1.0, qw2tune = 1.0, qwthl2tune = 1.0, & -! thl_tol = 1.e-4, rt_tol = 1.e-8, basetemp = 300.0 - thl_tol = 1.e-2, rt_tol = 1.e-4, basetemp = 300.0 +! real, parameter :: thl2tune = 2.0d0, qw2tune = 2.0d0, qwthl2tune = 2.0d0, & + real, parameter :: thl2tune = 1.0d0, qw2tune = 1.0d0, qwthl2tune = 1.0d0, & +! thl_tol = 1.0d-4, rt_tol = 1.0d-8, basetemp = 300.0d0 + thl_tol = 1.0d-2, rt_tol = 1.0d-4 integer, parameter :: nitr=6 ! Local variables. Note that pressure is in millibars in the SHOC code. - logical lprnt - integer ipr - - real zl (nx,ny,nzm) ! height of the pressure levels above surface, m - real zi (nx,ny,nz) ! height of the interface levels, m - real adzl (nx,ny,nzm) ! layer thickness i.e. zi(k+1)-zi(k) - defined at levels - real adzi (nx,ny,nz) ! level thickness i.e. zl(k)-zl(k-1) - defined at interface + real zl (nx,nzm) ! height of the pressure levels above surface, m + real zi (nx,nz) ! height of the interface levels, m + real adzl (nx,nzm) ! layer thickness i.e. zi(k+1)-zi(k) - defined at levels + real adzi (nx,nz) ! level thickness i.e. zl(k)-zl(k-1) - defined at interface - real hl (nx,ny,nzm) ! liquid/ice water static energy , K - real qv (nx,ny,nzm) ! water vapor, kg/kg - real qcl (nx,ny,nzm) ! liquid water (condensate), kg/kg - real qci (nx,ny,nzm) ! ice water (condensate), kg/kg - real w (nx,ny,nzm) ! z-wind, m/s - real bet (nx,ny,nzm) ! ggr/tv0 - real gamaz (nx,ny,nzm) ! ggr/cp*z - real qpi (nx,ny,nzm) ! snow + graupel mixing ratio, kg/kg -! real qpl (nx,ny,nzm) ! rain mixing ratio, kg/kg + real hl (nx,nzm) ! liquid/ice water static energy , K + real qv (nx,nzm) ! water vapor, kg/kg + real qcl (nx,nzm) ! liquid water (condensate), kg/kg + real qci (nx,nzm) ! ice water (condensate), kg/kg + real w (nx,nzm) ! z-wind, m/s + real bet (nx,nzm) ! ggr/tv0 + real gamaz (nx,nzm) ! ggr/cp*z ! Moments of the trivariate double Gaussian PDF for the SGS total water mixing ratio ! SGS liquid/ice static energy, and vertical velocity - real qw_sec (nx,ny,nzm) ! Second moment total water mixing ratio, kg^2/kg^2 - real thl_sec (nx,ny,nzm) ! Second moment liquid/ice static energy, K^2 - real qwthl_sec(nx,ny,nzm) ! Covariance tot. wat. mix. ratio and static energy, K*kg/kg - real wqw_sec (nx,ny,nzm) ! Turbulent flux of tot. wat. mix., kg/kg*m/s - real wthl_sec (nx,ny,nzm) ! Turbulent flux of liquid/ice static energy, K*m/s - real w_sec (nx,ny,nzm) ! Second moment of vertical velocity, m**2/s**2 - real w3 (nx,ny,nzm) ! Third moment of vertical velocity, m**3/s**3 - real wqp_sec (nx,ny,nzm) ! Turbulent flux of precipitation, kg/kg*m/s + real qw_sec (nx,nzm) ! Second moment total water mixing ratio, kg^2/kg^2 + real thl_sec (nx,nzm) ! Second moment liquid/ice static energy, K^2 + real qwthl_sec(nx,nzm) ! Covariance tot. wat. mix. ratio and static energy, K*kg/kg + real wqw_sec (nx,nzm) ! Turbulent flux of tot. wat. mix., kg/kg*m/s + real wthl_sec (nx,nzm) ! Turbulent flux of liquid/ice static energy, K*m/s + real w_sec (nx,nzm) ! Second moment of vertical velocity, m**2/s**2 + real w3 (nx,nzm) ! Third moment of vertical velocity, m**3/s**3 + real wqp_sec (nx,nzm) ! Turbulent flux of precipitation, kg/kg*m/s ! Eddy length formulation - real smixt (nx,ny,nzm) ! Turbulent length scale, m - real isotropy (nx,ny,nzm) ! "Return-to-isotropy" eddy dissipation time scale, s -! real isotropy_debug (nx,ny,nzm) ! Return to isotropy scale, s without artificial limits - real brunt (nx,ny,nzm) ! Moist Brunt-Vaisalla frequency, s^-1 - real conv_vel2(nx,ny,nzm) ! Convective velocity scale cubed, m^3/s^3 + real smixt (nx,nzm) ! Turbulent length scale, m + real isotropy (nx,nzm) ! "Return-to-isotropy" eddy dissipation time scale, s +! real isotropy_debug (nx,nzm) ! Return to isotropy scale, s without artificial limits + real brunt (nx,nzm) ! Moist Brunt-Vaisalla frequency, s^-1 + real conv_vel2(nx,nzm) ! Convective velocity scale cubed, m^3/s^3 - real cek(nx,ny) + real cek(nx) ! Output of SHOC real diag_frac, diag_qn, diag_qi, diag_ql -! real diag_frac(nx,ny,nzm) ! SGS cloud fraction -! real diag_qn (nx,ny,nzm) ! SGS cloud+ice condensate, kg/kg -! real diag_qi (nx,ny,nzm) ! SGS ice condensate, kg/kg -! real diag_ql (nx,ny,nzm) ! SGS liquid condensate, kg/kg +! real diag_frac(nx,nzm) ! SGS cloud fraction +! real diag_qn (nx,nzm) ! SGS cloud+ice condensate, kg/kg +! real diag_qi (nx,nzm) ! SGS ice condensate, kg/kg +! real diag_ql (nx,nzm) ! SGS liquid condensate, kg/kg ! Horizontally averaged variables @@ -441,156 +341,149 @@ subroutine shoc_work (ix, nx, ny, nzm, nz, dtn, me, lat, & ! Local variables -! real, dimension(nx,ny,nzm) :: tkesbbuoy, tkesbshear, tkesbdiss, tkesbbuoy_debug & +! real, dimension(nx,nzm) :: tkesbbuoy, tkesbshear, tkesbdiss, tkesbbuoy_debug & ! tkebuoy_sgs, total_water, tscale1_debug, brunt2 - real, dimension(nx,ny,nzm) :: total_water, brunt2, thv, tkesbdiss - real, dimension(nx,ny,nzm) :: def2 - real, dimension(nx,ny) :: denom, numer, l_inf, cldarr, thedz, thedz2 + real, dimension(nx,nzm) :: total_water, brunt2, thv, tkesbdiss + real, dimension(nx,nzm) :: def2 + real, dimension(nx) :: denom, numer, l_inf, cldarr, thedz, thedz2 real lstarn, depth, omn, betdz, bbb, term, qsatt, dqsat, & - conv_var, tkes, skew_w, skew_qw, aterm, w1_1, w1_2, w2_1, & + conv_var, tkes, skew_w, skew_qw, aterm, w1_1, w1_2, w2_1, & w2_2, w3var, thl1_1, thl1_2, thl2_1, thl2_2, qw1_1, qw1_2, qw2_1, & qw2_2, ql1, ql2, w_ql1, w_ql2, & - r_qwthl_1, r_wqw_1, r_wthl_1, testvar, s1, s2, std_s1, std_s2, C1, C2, & + r_qwthl_1, r_wqw_1, r_wthl_1, testvar, s1, s2, std_s1, std_s2, C1, C2, & thl_first, qw_first, w_first, Tl1_1, Tl1_2, betatest, pval, pkap, & w2thl, w2qw,w2ql, w2ql_1, w2ql_2, & thec, thlsec, qwsec, qwthlsec, wqwsec, wthlsec, thestd,dum, & cqt1, cthl1, cqt2, cthl2, qn1, qn2, qi1, qi2, omn1, omn2, & basetemp2, beta1, beta2, qs1, qs2, & - esval1_1, esval2_1, esval1_2, esval2_2, om1, om2, & + esval, esval2, om1, om2, epss, & lstarn1, lstarn2, sqrtw2, sqrtthl, sqrtqt, & - sqrtstd1, sqrtstd2, tsign, tvar, sqrtw2t, wqls, wqis, & - sqrtqw2_1, sqrtqw2_2, sqrtthl2_1, sqrtthl2_2, sm, prespot, & - corrtest1, corrtest2, wrk, wrk1, wrk2, wrk3, onema, pfac + sqrtstd1, sqrtstd2, tsign, tvar, sqrtw2t, wqls, wqis, & + sqrtqw2_1, sqrtqw2_2, sqrtthl2_1, sqrtthl2_2, sm, prespot, & + corrtest1, corrtest2, wrk, wrk1, wrk2, wrk3, onema, pfac - integer i,j,k,km1,ku,kd,ka,kb + integer i,k,km1,ku,kd,ka,kb + !calculate derived constants - lsub = lcond+lfus + lsub = lcond+lfus fac_cond = lcond/cp - fac_fus = lfus/cp - cpolv = cp/lcond - fac_sub = lsub/cp - ggri = 1.0/ggr - kapa = rgas/cp - gocp = ggr/cp - rog = rgas*ggri - sqrtpii = one/sqrt(pi+pi) - epsterm = rgas/rv - onebeps = one/epsterm - onebrvcp= one/(rv*cp) + fac_fus = lfus/cp + cpolv = cp/lcond + fac_sub = lsub/cp + ggri = one/ggr + kapa = rgas/cp + gocp = ggr/cp + rog = rgas*ggri + sqrtpii = one/sqrt(pi+pi) + epsterm = rgas/rv + onebeps = one/epsterm + onebrvcp = one/(rv*cp) + epss = eps * supice ! Map GFS variables to those of SHOC - SHOC operates on 3D fields ! Here a Y-dimension is added to the input variables, along with some unit conversions do k=1,nz - do j=1,ny - do i=1,nx - zi(i,j,k) = phii(i,j,k) * ggri - enddo + do i=1,nx + zi(i,k) = phii(i,k) * ggri enddo enddo -! if (lprnt) write(0,*)' tabsin=',tabs(ipr,1,1:40) -! if (lprnt) write(0,*)' qcin=',qc(ipr,1,1:40) -! if (lprnt) write(0,*)' qwvin=',qwv(ipr,1,1:40) -! if (lprnt) write(0,*)' qiin=',qi(ipr,1,1:40) -! if (lprnt) write(0,*)' qplin=',qpl(ipr,1,1:40) -! if (lprnt) write(0,*)' qpiin=',qpi(ipr,1,1:40) ! ! move water from vapor to condensate if the condensate is negative ! do k=1,nzm - do j=1,ny - do i=1,nx - if (qc(i,j,k) < zero) then - wrk = qwv(i,j,k) + qc(i,j,k) - if (wrk >= zero) then - qwv(i,j,k) = wrk - tabs(i,j,k) = tabs(i,j,k) - fac_cond * qc(i,j,k) - qc(i,j,k) = zero - else - qc(i,j,k) = zero - tabs(i,j,k) = tabs(i,j,k) + fac_cond * qwv(i,j,k) - qwv(i,j,k) = zero - endif - endif - if (qi(i,j,k) < zero) then - wrk = qwv(i,j,k) + qi(i,j,k) - if (wrk >= zero) then - qwv(i,j,k) = wrk - tabs(i,j,k) = tabs(i,j,k) - fac_sub * qi(i,j,k) - qi(i,j,k) = zero - else - qi(i,j,k) = zero - tabs(i,j,k) = tabs(i,j,k) + fac_sub * qwv(i,j,k) - qwv(i,j,k) = zero - endif - endif - enddo + do i=1,nx + if (qc(i,k) < zero) then + qwv(i,k) = qwv(i,k) + qc(i,k) + tabs(i,k) = tabs(i,k) - fac_cond * qc(i,k) + qc(i,k) = zero + endif + if (qi(i,k) < zero) then + qwv(i,k) = qwv(i,k) + qi(i,k) + tabs(i,k) = tabs(i,k) - fac_sub * qi(i,k) + qi(i,k) = zero + endif +! +! testing removal of ice when too warm to sustain ice +! +! if (qi(i,k) > zero .and. tabs(i,k) > 273.16) then +! wrk = (tabs(i,k) - 273.16) / fac_sub +! if (wrk < qi(i,k)) then +! wrk = qi(i,k) - wrk +! qi(i,k) = wrk +! qwv(i,k) = qwv(i,k) + wrk +! tabs(i,k) = 273.16 +! else +! tabs(i,k) = tabs(i,k) - qi(i,k) / fac_sub +! qwv(i,k) = qwv(i,k) + qi(i,k) +! qi(i,k) = 0.0 +! endif +! endif + + enddo + enddo +! fill negative water vapor from below + do k=nzm,2,-1 + km1 = k - 1 + do i=1,nx + if (qwv(i,k) < zero) then + qwv(i,k) = qwv(i,km1) + qwv(i,k) * delp(i,k) / delp(i,km1) + endif enddo enddo - -! if (lprnt) write(0,*)' tabsin2=',tabs(ipr,1,1:40) do k=1,nzm - do j=1,ny - do i=1,nx - zl(i,j,k) = phil(i,j,k) * ggri - wrk = one / prsl(i,j,k) - qv(i,j,k) = max(qwv(i,j,k), zero) - thv(i,j,k) = tabs(i,j,k) * (one+epsv*qv(i,j,k)) - w(i,j,k) = - rog * omega(i,j,k) * thv(i,j,k) * wrk - qcl(i,j,k) = max(qc(i,j,k), zero) - qci(i,j,k) = max(qi(i,j,k), zero) - qpi(i,j,k) = qpi_i(i,j,k) + qgl(i,j,k) ! add snow and graupel together + do i=1,nx + zl(i,k) = phil(i,k) * ggri + wrk = one / prsl(i,k) + qv(i,k) = max(qwv(i,k), zero) + thv(i,k) = tabs(i,k) * (one+epsv*qv(i,k)) + w(i,k) = - rog * omega(i,k) * thv(i,k) * wrk + qcl(i,k) = max(qc(i,k), zero) + qci(i,k) = max(qi(i,k), zero) ! -! qpl(i,j,k) = zero ! comment or remove when using with prognostic rain/snow -! qpi(i,j,k) = zero ! comment or remove when using with prognostic rain/snow +! qpl(i,k) = zero ! comment or remove when using with prognostic rain/snow +! qpi(i,k) = zero ! comment or remove when using with prognostic rain/snow - wqp_sec(i,j,k) = zero ! Turbulent flux of precipiation + wqp_sec(i,k) = zero ! Turbulent flux of precipiation ! - total_water(i,j,k) = qcl(i,j,k) + qci(i,j,k) + qv(i,j,k) + total_water(i,k) = qcl(i,k) + qci(i,k) + qv(i,k) - prespot = (100000.0*wrk) ** kapa ! Exner function - bet(i,j,k) = ggr/(tabs(i,j,k)*prespot) ! Moorthi - thv(i,j,k) = thv(i,j,k)*prespot ! Moorthi + prespot = (100000.0d0*wrk) ** kapa ! Exner function + bet(i,k) = ggr/(tabs(i,k)*prespot) ! Moorthi + thv(i,k) = thv(i,k)*prespot ! Moorthi ! ! Lapse rate * height = reference temperature - gamaz(i,j,k) = gocp * zl(i,j,k) + gamaz(i,k) = gocp * zl(i,k) ! Liquid/ice water static energy - ! Note the the units are degrees K - hl(i,j,k) = tabs(i,j,k) + gamaz(i,j,k) - fac_cond*(qcl(i,j,k)+qpl(i,j,k)) & - - fac_sub *(qci(i,j,k)+qpi(i,j,k)) - w3(i,j,k) = zero - enddo + hl(i,k) = tabs(i,k) + gamaz(i,k) - fac_cond*(qcl(i,k)+qpl(i,k)) & + - fac_sub *(qci(i,k)+qpi(i,k)) + w3(i,k) = zero enddo enddo -! if (lprnt) write(0,*)' hlin=',hl(ipr,1,1:40) - ! Define vertical grid increments for later use in the vertical differentiation do k=2,nzm km1 = k - 1 - do j=1,ny - do i=1,nx - adzi(i,j,k) = zl(i,j,k) - zl(i,j,km1) - adzl(i,j,km1) = zi(i,j,k) - zi(i,j,km1) - enddo + do i=1,nx + adzi(i,k) = zl(i,k) - zl(i,km1) + adzl(i,km1) = zi(i,k) - zi(i,km1) enddo enddo - do j=1,ny - do i=1,nx - adzi(i,j,1) = (zl(i,j,1)-zi(i,j,1)) ! unused in the code - adzi(i,j,nz) = adzi(i,j,nzm) ! at the top - probably unused - adzl(i,j,nzm) = zi(i,j,nz) - zi(i,j,nzm) + do i=1,nx + adzi(i,1) = (zl(i,1)-zi(i,1)) ! unused in the code + adzi(i,nz) = adzi(i,nzm) ! at the top - probably unused + adzl(i,nzm) = zi(i,nz) - zi(i,nzm) ! - wthl_sec(i,j,1) = hflx(i) - wqw_sec(i,j,1) = evap(i) - enddo + wthl_sec(i,1) = hflx(i) + wqw_sec(i,1) = evap(i) enddo @@ -619,77 +512,69 @@ subroutine shoc_work (ix, nx, ny, nzm, nz, dtn, me, lat, & ku = k ka = kb endif - do j=1,ny - do i=1,nx - if (tke(i,j,k) > zero) then -! wrk = half*(tkh(i,j,ka)+tkh(i,j,kb))*(w(i,j,ku) - w(i,j,kd)) & - wrk = half*(tkh(i,j,ka)*prnum(i,j,ka)+tkh(i,j,kb)*prnum(i,j,kb))*(w(i,j,ku) - w(i,j,kd)) & - * sqrt(tke(i,j,k)) / (zl(i,j,ku) - zl(i,j,kd)) - w_sec(i,j,k) = max(twoby3 * tke(i,j,k) - twoby15 * wrk, zero) -! w_sec(i,j,k) = max(twoby3 * tke(i,j,k), zero) -! if(lprnt .and. i == ipr .and. k <40) write(0,*)' w_sec=',w_sec(i,j,k),' tke=r',tke(i,j,k),& -! ' tkh=',tkh(i,j,ka),tkh(i,j,kb),' w=',w(i,j,ku),w(i,j,kd),' prnum=',prnum(i,j,ka),prnum(i,j,kb) - else - w_sec(i,j,k) = zero - endif - enddo + do i=1,nx + if (tke(i,k) > zero) then +! wrk = half*(tkh(i,ka)+tkh(i,kb))*(w(i,ku) - w(i,kd)) & + wrk = half*(tkh(i,ka)*prnum(i,ka)+tkh(i,kb)*prnum(i,kb))*(w(i,ku) - w(i,kd)) & + * sqrt(tke(i,k)) / (zl(i,ku) - zl(i,kd)) + w_sec(i,k) = max(twoby3 * tke(i,k) - twoby15 * wrk, zero) +! w_sec(i,k) = max(twoby3 * tke(i,k), zero) + else + w_sec(i,k) = zero + endif enddo enddo do k=2,nzm km1 = k - 1 - do j=1,ny - do i=1,nx + do i=1,nx ! Use backward difference in the vertical, use averaged values of "return-to-isotropy" ! time scale and diffusion coefficient - wrk1 = one / adzi(i,j,k) ! adzi(k) = (zl(k)-zl(km1)) -! wrk3 = max(tkh(i,j,k),pt01) * wrk1 - wrk3 = max(tkh(i,j,k),epsln) * wrk1 + wrk1 = one / adzi(i,k) ! adzi(k) = (zl(k)-zl(km1)) +! wrk3 = max(tkh(i,k),pt01) * wrk1 + wrk3 = max(tkh(i,k),epsln) * wrk1 - sm = half*(isotropy(i,j,k)+isotropy(i,j,km1))*wrk1*wrk3 ! Tau*Kh/dz^2 + sm = half*(isotropy(i,k)+isotropy(i,km1))*wrk1*wrk3 ! Tau*Kh/dz^2 ! SGS vertical flux liquid/ice water static energy. Eq 1 in BK13 ! No rain, snow or graupel in pdf (Annig, 08/29/2018) - wrk1 = hl(i,j,k) - hl(i,j,km1) & - + (qpl(i,j,k) - qpl(i,j,km1)) * fac_cond & - + (qpi(i,j,k) - qpi(i,j,km1)) * fac_sub - wthl_sec(i,j,k) = - wrk3 * wrk1 + wrk1 = hl(i,k) - hl(i,km1) & + + (qpl(i,k) - qpl(i,km1)) * fac_cond & + + (qpi(i,k) - qpi(i,km1)) * fac_sub + wthl_sec(i,k) = - wrk3 * wrk1 ! SGS vertical flux of total water. Eq 2 in BK13 - wrk2 = total_water(i,j,k) - total_water(i,j,km1) - wqw_sec(i,j,k) = - wrk3 * wrk2 + wrk2 = total_water(i,k) - total_water(i,km1) + wqw_sec(i,k) = - wrk3 * wrk2 ! Second moment of liquid/ice water static energy. Eq 4 in BK13 - thl_sec(i,j,k) = thl2tune * sm * wrk1 * wrk1 + thl_sec(i,k) = thl2tune * sm * wrk1 * wrk1 ! Second moment of total water mixing ratio. Eq 3 in BK13 - qw_sec(i,j,k) = qw2tune * sm * wrk2 * wrk2 + qw_sec(i,k) = qw2tune * sm * wrk2 * wrk2 ! Covariance of total water mixing ratio and liquid/ice water static energy. ! Eq 5 in BK13 - qwthl_sec(i,j,k) = qwthl2tune * sm * wrk1 * wrk2 + qwthl_sec(i,k) = qwthl2tune * sm * wrk1 * wrk2 - enddo ! i loop - enddo ! j loop + enddo ! i loop enddo ! k loop ! These would be at the surface - do we need them? - do j=1,ny - do i=1,nx -! wthl_sec(i,j,1) = wthl_sec(i,j,2) -! wqw_sec(i,j,1) = wqw_sec(i,j,2) - thl_sec(i,j,1) = thl_sec(i,j,2) - qw_sec(i,j,1) = qw_sec(i,j,2) - qwthl_sec(i,j,1) = qwthl_sec(i,j,2) - enddo + do i=1,nx +! wthl_sec(i,1) = wthl_sec(i,2) +! wqw_sec(i,1) = wqw_sec(i,2) + thl_sec(i,1) = thl_sec(i,2) + qw_sec(i,1) = qw_sec(i,2) + qwthl_sec(i,1) = qwthl_sec(i,2) enddo ! Diagnose the third moment of SGS vertical velocity @@ -709,10 +594,10 @@ subroutine tke_shoc() ! This subroutine solves the TKE equation, ! Heavily based on SAM's tke_full.f90 by Marat Khairoutdinov - real grd,betdz,Cee,lstarn, lstarp, bbb, omn, omp,qsatt,dqsat, smix, & + real grd,betdz,Cee,lstarn, lstarp, bbb, omn, omp,qsatt,dqsat, smix, & buoy_sgs,ratio,a_prod_sh,a_prod_bu,a_diss,a_prod_bu_debug, buoy_sgs_debug, & tscale1, wrk, wrk1, wtke, wtk2, rdtn, tkef2 - integer i,j,k,ku,kd,itr,k1 + integer i,k,ku,kd,itr,k1 rdtn = one / dtn @@ -721,13 +606,11 @@ subroutine tke_shoc() ! Ensure values of TKE are reasonable do k=1,nzm - do j=1,ny - do i=1,nx - tke(i,j,k) = max(min_tke,tke(i,j,k)) - tkesbdiss(i,j,k) = zero -! tkesbshear(i,j,k) = zero -! tkesbbuoy(i,j,k) = zero - enddo + do i=1,nx + tke(i,k) = max(min_tke,tke(i,k)) + tkesbdiss(i,k) = zero +! tkesbshear(i,k) = zero +! tkesbbuoy(i,k) = zero enddo enddo @@ -752,11 +635,9 @@ subroutine tke_shoc() endif if (dis_opt > 0) then - do j=1,ny - do i=1,nx - wrk = (zl(i,j,k)-zi(i,j,1)) / adzl(i,j,1) + 1.5 - cek(i,j) = 1.0 + 2.0 / max((wrk*wrk - 3.3), 0.5) - enddo + do i=1,nx + wrk = (zl(i,k)-zi(i,1)) / adzl(i,1) + 1.5d0 + cek(i) = (one + two / max((wrk*wrk - 3.3d0), 0.5d0)) * cefac enddo else if (k == 1) then @@ -766,111 +647,95 @@ subroutine tke_shoc() endif endif - do j=1,ny - do i=1,nx - grd = adzl(i,j,k) ! adzl(k) = zi(k+1)-zi(k) + do i=1,nx + grd = adzl(i,k) ! adzl(k) = zi(k+1)-zi(k) ! TKE boyancy production term. wthv_sec (buoyancy flux) is calculated in ! assumed_pdf(). The value used here is from the previous time step - a_prod_bu = ggr / thv(i,j,k) * wthv_sec(i,j,k) + a_prod_bu = ggr / thv(i,k) * wthv_sec(i,k) ! If wthv_sec from subgrid PDF is not available use Brunt-Vaisalla frequency from eddy_length() !Obtain Brunt-Vaisalla frequency from diagnosed SGS buoyancy flux !Presumably it is more precise than BV freq. calculated in eddy_length()? - buoy_sgs = - (a_prod_bu+a_prod_bu) / (tkh(i,j,ku)+tkh(i,j,kd) + 0.0001) ! tkh is eddy thermal diffussivity + buoy_sgs = - (a_prod_bu+a_prod_bu) / (tkh(i,ku)+tkh(i,kd) + 0.0001) ! tkh is eddy thermal diffussivity !Compute $c_k$ (variable Cee) for the TKE dissipation term following Deardorff (1980) - if (buoy_sgs <= zero) then - smix = grd - else - smix = min(grd,max(0.1*grd, 0.76*sqrt(tke(i,j,k)/(buoy_sgs+1.e-10)))) - endif + if (buoy_sgs <= zero) then + smix = grd + else + smix = min(grd,max(0.1d0*grd, 0.76d0*sqrt(tke(i,k)/(buoy_sgs+1.0d-10)))) + endif - ratio = smix/grd - Cee = Cek(i,j) * (pt19 + pt51*ratio) * max(one, sqrt(pcrit/prsl(i,j,k))) + ratio = smix/grd + Cee = Cek(i) * (pt19 + pt51*ratio) * max(one, sqrt(pcrit/prsl(i,k))) ! TKE shear production term - a_prod_sh = half*(def2(i,j,ku)*tkh(i,j,ku)*prnum(i,j,ku) & - + def2(i,j,kd)*tkh(i,j,kd)*prnum(i,j,kd)) + a_prod_sh = half*(def2(i,ku)*tkh(i,ku)*prnum(i,ku) & + + def2(i,kd)*tkh(i,kd)*prnum(i,kd)) -! smixt (turb. mixing lenght) is calculated in eddy_length() +! smixt (turb. mixing lenght) is calculated in eddy_length() ! Explicitly integrate TKE equation forward in time -! a_diss = Cee/smixt(i,j,k)*tke(i,j,k)**1.5 ! TKE dissipation term -! tke(i,j,k) = max(zero,tke(i,j,k)+dtn*(max(zero,a_prod_sh+a_prod_bu)-a_diss)) +! a_diss = Cee/smixt(i,k)*tke(i,k)**1.5 ! TKE dissipation term +! tke(i,k) = max(zero,tke(i,k)+dtn*(max(zero,a_prod_sh+a_prod_bu)-a_diss)) ! Semi-implicitly integrate TKE equation forward in time - wtke = tke(i,j,k) - wtk2 = wtke -! wrk = (dtn*Cee)/smixt(i,j,k) - wrk = (dtn*Cee) / smixt(i,j,k) - wrk1 = wtke + dtn*(a_prod_sh+a_prod_bu) - -! if (lprnt .and. i == ipr .and. k<40) write(0,*)' wtke=',wtke,' wrk1=',wrk1,& -! ' a_prod_sh=',a_prod_sh,' a_prod_bu=',a_prod_bu,' dtn=',dtn,' smixt=',& -! smixt(i,j,k),' tkh=',tkh(i,j,ku),tkh(i,j,kd),' def2=',def2(i,j,ku),def2(i,j,kd)& -! ,' prnum=',prnum(i,j,ku),prnum(i,j,kd),' wthv_sec=',wthv_sec(i,j,k),' thv=',thv(i,j,k) - - do itr=1,nitr ! iterate for implicit solution - wtke = min(max(min_tke, wtke), max_tke) - a_diss = wrk*sqrt(wtke) ! Coefficient in the TKE dissipation term - wtke = wrk1 / (one+a_diss) - wtke = tkef1*wtke + tkef2*wtk2 ! tkef1+tkef2 = 1.0 - -! if (lprnt .and. i == ipr .and. k<40) write(0,*)' wtke=',wtke,' wtk2=',wtk2,& -! ' a_diss=',a_diss,' a_prod_sh=',a_prod_sh,' a_prod_bu=',a_prod_bu,& -! ' wrk1=',wrk1,' itr=',itr,' k=',k - - wtk2 = wtke - - enddo + wtke = tke(i,k) + wtk2 = wtke +! wrk = (dtn*Cee)/smixt(i,k) + wrk = (dtn*Cee) / smixt(i,k) + wrk1 = wtke + dtn*(a_prod_sh+a_prod_bu) + + do itr=1,nitr ! iterate for implicit solution + wtke = min(max(min_tke, wtke), max_tke) + a_diss = wrk*sqrt(wtke) ! Coefficient in the TKE dissipation term + wtke = wrk1 / (one+a_diss) + wtke = tkef1*wtke + tkef2*wtk2 ! tkef1+tkef2 = 1.0 + wtk2 = wtke + enddo - tke(i,j,k) = min(max(min_tke, wtke), max_tke) - a_diss = wrk*sqrt(tke(i,j,k)) + tke(i,k) = min(max(min_tke, wtke), max_tke) + a_diss = wrk*sqrt(tke(i,k)) - tscale1 = (dtn+dtn) / a_diss ! corrected Eq 8 in BK13 -- tau = 2*tke/eps + tscale1 = (dtn+dtn) / a_diss ! corrected Eq 8 in BK13 -- tau = 2*tke/eps - tkesbdiss(i,j,k) = rdtn*a_diss*tke(i,j,k) ! TKE dissipation term, epsilon + tkesbdiss(i,k) = rdtn*a_diss*tke(i,k) ! TKE dissipation term, epsilon ! Calculate "return-to-isotropy" eddy dissipation time scale, see Eq. 8 in BK13 - if (buoy_sgs <= zero) then - isotropy(i,j,k) = min(max_eddy_dissipation_time_scale,tscale1) - else - isotropy(i,j,k) = min(max_eddy_dissipation_time_scale, & - tscale1/(one+lambda*buoy_sgs*tscale1*tscale1)) - endif + if (buoy_sgs <= zero) then + isotropy(i,k) = min(max_eddy_dissipation_time_scale, tscale1) + else + isotropy(i,k) = min(max_eddy_dissipation_time_scale, & + tscale1/(one+lambda*buoy_sgs*tscale1*tscale1)) + endif ! TKE budget terms -! tkesbdiss(i,j,k) = a_diss -! tkesbshear(i,j,k) = a_prod_sh -! tkesbbuoy(i,j,k) = a_prod_bu -! tkesbbuoy_debug(i,j,k) = a_prod_bu_debug -! tkebuoy_sgs(i,j,k) = buoy_sgs +! tkesbdiss(i,k) = a_diss +! tkesbshear(i,k) = a_prod_sh +! tkesbbuoy(i,k) = a_prod_bu +! tkesbbuoy_debug(i,k) = a_prod_bu_debug +! tkebuoy_sgs(i,k) = buoy_sgs - enddo ! i loop - enddo ! j loop - enddo ! k -! + enddo ! i loop + enddo ! k loop wrk = half * ck do k=2,nzm k1 = k - 1 - do j=1,ny - do i=1,nx - tkh(i,j,k) = min(tkhmax, wrk * (isotropy(i,j,k) * tke(i,j,k) & - + isotropy(i,j,k1) * tke(i,j,k1))) ! Eddy thermal diffusivity - enddo ! i - enddo ! j - enddo ! k + do i=1,nx + tkh(i,k) = min(tkhmax, wrk * (isotropy(i,k) * tke(i,k) & + + isotropy(i,k1) * tke(i,k1))) ! Eddy thermal diffusivity + enddo ! i + enddo ! k end subroutine tke_shoc @@ -880,31 +745,26 @@ subroutine tke_shear_prod(def2) ! Calculate TKE shear production term - real, intent(out) :: def2(nx,ny,nzm) + real, intent(out) :: def2(nx,nzm) real rdzw, wrku, wrkv, wrkw - integer i,j,k,k1 + integer i,k,k1 ! Calculate TKE shear production term at layer interface do k=2,nzm k1 = k - 1 - do j=1,ny - do i=1,nx - rdzw = one / adzi(i,j,k) - wrku = (u(i,j,k)-u(i,j,k1)) * rdzw - wrkv = (v(i,j,k)-v(i,j,k1)) * rdzw -! wrkw = (w(i,j,k)-w(i,j,k1)) * rdzw - def2(i,j,k) = wrku*wrku + wrkv*wrkv !+ 2*wrkw(1) * wrkw(1) - enddo - enddo - enddo ! k loop - do j=1,ny do i=1,nx -! def2(i,j,1) = def2(i,j,2) - def2(i,j,1) = (u(i,j,1)*u(i,j,1) + v(i,j,1)*v(i,j,1)) & - / (zl(i,j,1)*zl(i,j,1)) + rdzw = one / adzi(i,k) + wrku = (u(i,k)-u(i,k1)) * rdzw + wrkv = (v(i,k)-v(i,k1)) * rdzw +! wrkw = (w(i,k)-w(i,k1)) * rdzw + def2(i,k) = wrku*wrku + wrkv*wrkv !+ 2*wrkw(1) * wrkw(1) enddo + enddo ! k loop + do i=1,nx +! def2(i,1) = def2(i,2) + def2(i,1) = (u(i,1)*u(i,1) + v(i,1)*v(i,1)) / (zl(i,1)*zl(i,1)) enddo end subroutine tke_shear_prod @@ -916,51 +776,45 @@ subroutine eddy_length() ! Local variables real wrk, wrk1, wrk2, wrk3 - integer i, j, k, kk, kl, ku, kb, kc, kli, kui + integer i, k, kk, kl, ku, kb, kc, kli, kui - do j=1,ny - do i=1,nx - cldarr(i,j) = zero - numer(i,j) = zero - denom(i,j) = zero - enddo + do i=1,nx + cldarr(i) = zero + numer(i) = zero + denom(i) = zero enddo ! Find the length scale outside of clouds, that includes boundary layers. do k=1,nzm - do j=1,ny - do i=1,nx + do i=1,nx ! Reinitialize the mixing length related arrays to zero -! smixt(i,j,k) = one ! shoc_mod module variable smixt - smixt(i,j,k) = epsln ! shoc_mod module variable smixt - brunt(i,j,k) = zero +! smixt(i,k) = one ! shoc_mod module variable smixt + smixt(i,k) = epsln ! shoc_mod module variable smixt + brunt(i,k) = zero !Eq. 11 in BK13 (Eq. 4.13 in Pete's dissertation) !Outside of cloud, integrate from the surface to the cloud base !Should the 'if' below check if the cloud liquid < a small constant instead? - if (qcl(i,j,k)+qci(i,j,k) <= zero) then - tkes = sqrt(tke(i,j,k)) * adzl(i,j,k) - numer(i,j) = numer(i,j) + tkes*zl(i,j,k) ! Numerator in Eq. 11 in BK13 - denom(i,j) = denom(i,j) + tkes ! Denominator in Eq. 11 in BK13 - else - cldarr(i,j) = one ! Take note of columns containing cloud. - endif - enddo + if (qcl(i,k)+qci(i,k) <= qcmin) then + tkes = sqrt(tke(i,k)) * adzl(i,k) + numer(i) = numer(i) + tkes*zl(i,k) ! Numerator in Eq. 11 in BK13 + denom(i) = denom(i) + tkes ! Denominator in Eq. 11 in BK13 + else + cldarr(i) = one ! Take note of columns containing cloud. + endif enddo enddo ! Calculate the measure of PBL depth, Eq. 11 in BK13 (Is this really PBL depth?) - do j=1,ny - do i=1,nx - if (denom(i,j) > zero .and. numer(i,j) > zero) then - l_inf(i,j) = min(0.1 * (numer(i,j)/denom(i,j)), 100.0) - else - l_inf(i,j) = 100.0 - endif - enddo + do i=1,nx + if (denom(i) > zero .and. numer(i) > zero) then + l_inf(i) = min(0.1d0 * (numer(i)/denom(i)), 100.0d0) + else + l_inf(i) = 100.0d0 + endif enddo !Calculate length scale outside of cloud, Eq. 10 in BK13 (Eq. 4.12 in Pete's dissertation) @@ -971,81 +825,80 @@ subroutine eddy_length() if (k == 1) then kb = 1 kc = 2 - thedz(:,:) = adzi(:,:,kc) + thedz(:) = adzi(:,kc) elseif (k == nzm) then kb = nzm-1 kc = nzm - thedz(:,:) = adzi(:,:,k) + thedz(:) = adzi(:,k) else - thedz(:,:) = adzi(:,:,kc) + adzi(:,:,k) ! = (z(k+1)-z(k-1)) + thedz(:) = adzi(:,kc) + adzi(:,k) ! = (z(k+1)-z(k-1)) endif - do j=1,ny - do i=1,nx + do i=1,nx ! vars module variable bet (=ggr/tv0) ; grid module variable adzi - betdz = bet(i,j,k) / thedz(i,j) + betdz = bet(i,k) / thedz(i) - tkes = sqrt(tke(i,j,k)) + tkes = sqrt(tke(i,k)) ! Compute local Brunt-Vaisalla frequency - wrk = qcl(i,j,k) + qci(i,j,k) - if (wrk > zero) then ! If in the cloud + wrk = qcl(i,k) + qci(i,k) + if (wrk > zero) then ! If in the cloud ! Find the in-cloud Brunt-Vaisalla frequency - omn = qcl(i,j,k) / (wrk+1.e-20) ! Ratio of liquid water to total water + omn = qcl(i,k) / (wrk+1.e-20) ! Ratio of liquid water to total water ! Latent heat of phase transformation based on relative water phase content ! fac_cond = lcond/cp, fac_fus = lfus/cp - lstarn = fac_cond + (one-omn)*fac_fus + lstarn = fac_cond + (one-omn)*fac_fus ! Derivative of saturation mixing ratio over water/ice wrt temp. based on relative water phase content - dqsat = omn * dtqsatw(tabs(i,j,k),prsl(i,j,k)) & - + (one-omn) * dtqsati(tabs(i,j,k),prsl(i,j,k)) + dqsat = omn * dtqsatw(tabs(i,k),prsl(i,k)) & + + (one-omn) * dtqsati(tabs(i,k),prsl(i,k)) ! Saturation mixing ratio over water/ice wrt temp based on relative water phase content - qsatt = omn * qsatw(tabs(i,j,k),prsl(i,j,k)) & - + (one-omn) * qsati(tabs(i,j,k),prsl(i,j,k)) + qsatt = omn * qsatw(tabs(i,k),prsl(i,k)) & + + (one-omn) * qsati(tabs(i,k),prsl(i,k)) ! liquid/ice moist static energy static energy divided by cp? - bbb = (one + epsv*qsatt-wrk-qpl(i,j,k)-qpi(i,j,k) & - + 1.61*tabs(i,j,k)*dqsat) / (one+lstarn*dqsat) + bbb = (one + epsv*qsatt-wrk-qpl(i,k)-qpi(i,k) & + + 1.61d0*tabs(i,k)*dqsat) / (one+lstarn*dqsat) ! Calculate Brunt-Vaisalla frequency using centered differences in the vertical - brunt(i,j,k) = betdz*(bbb*(hl(i,j,kc)-hl(i,j,kb)) & - + (bbb*lstarn - (one+lstarn*dqsat)*tabs(i,j,k)) & - * (total_water(i,j,kc)-total_water(i,j,kb)) & - + (bbb*fac_cond - (one+fac_cond*dqsat)*tabs(i,j,k))*(qpl(i,j,kc)-qpl(i,j,kb)) & - + (bbb*fac_sub - (one+fac_sub*dqsat)*tabs(i,j,k))*(qpi(i,j,kc)-qpi(i,j,kb)) ) + brunt(i,k) = betdz*(bbb*(hl(i,kc)-hl(i,kb)) & + + (bbb*lstarn - (one+lstarn*dqsat)*tabs(i,k)) & + * (total_water(i,kc)-total_water(i,kb)) & + + (bbb*fac_cond - (one+fac_cond*dqsat)*tabs(i,k))*(qpl(i,kc)-qpl(i,kb)) & + + (bbb*fac_sub - (one+fac_sub*dqsat)*tabs(i,k))*(qpi(i,kc)-qpi(i,kb)) ) - else ! outside of cloud + else ! outside of cloud ! Find outside-of-cloud Brunt-Vaisalla frequency ! Only unsaturated air, rain and snow contribute to virt. pot. temp. ! liquid/ice moist static energy divided by cp? - bbb = one + epsv*qv(i,j,k) - qpl(i,j,k) - qpi(i,j,k) - brunt(i,j,k) = betdz*( bbb*(hl(i,j,kc)-hl(i,j,kb)) & - + epsv*tabs(i,j,k)*(total_water(i,j,kc)-total_water(i,j,kb)) & - + (bbb*fac_cond-tabs(i,j,k))*(qpl(i,j,kc)-qpl(i,j,kb)) & - + (bbb*fac_sub -tabs(i,j,k))*(qpi(i,j,kc)-qpi(i,j,kb)) ) - endif + bbb = one + epsv*qv(i,k) - qpl(i,k) - qpi(i,k) + brunt(i,k) = betdz*( bbb*(hl(i,kc)-hl(i,kb)) & + + epsv*tabs(i,k)*(total_water(i,kc)-total_water(i,kb)) & + + (bbb*fac_cond-tabs(i,k))*(qpl(i,kc)-qpl(i,kb)) & + + (bbb*fac_sub -tabs(i,k))*(qpi(i,kc)-qpi(i,kb)) ) + endif ! Reduction of mixing length in the stable regions (where B.-V. freq. > 0) is required. ! Here we find regions of Brunt-Vaisalla freq. > 0 for later use. - if (brunt(i,j,k) >= zero) then - brunt2(i,j,k) = brunt(i,j,k) - else - brunt2(i,j,k) = zero - endif + if (brunt(i,k) >= zero) then + brunt2(i,k) = brunt(i,k) + else + brunt2(i,k) = zero + endif ! Calculate turbulent length scale in the boundary layer. ! See Eq. 10 in BK13 (Eq. 4.12 in Pete's dissertation) @@ -1053,36 +906,34 @@ subroutine eddy_length() ! Keep the length scale adequately small near the surface following Blackadar (1984) ! Note that this is not documented in BK13 and was added later for SP-CAM runs -! if (k == 1) then -! term = 600.*tkes -! smixt(i,j,k) = term + (0.4*zl(i,j,k)-term)*exp(-zl(i,j,k)*0.01) -! else +! if (k == 1) then +! term = 600.*tkes +! smixt(i,k) = term + (0.4*zl(i,k)-term)*exp(-zl(i,k)*0.01) +! else ! tscale is the eddy turnover time scale in the boundary layer and is ! an empirically derived constant - if (tkes > zero .and. l_inf(i,j) > zero) then - wrk1 = one / (tscale*tkes*vonk*zl(i,j,k)) - wrk2 = one / (tscale*tkes*l_inf(i,j)) - wrk1 = wrk1 + wrk2 + pt01 * brunt2(i,j,k) / tke(i,j,k) - wrk1 = sqrt(one / max(wrk1,1.0e-8)) * (one/0.3) -! smixt(i,j,k) = min(max_eddy_length_scale, 2.8284*sqrt(wrk1)/0.3) - smixt(i,j,k) = min(max_eddy_length_scale, wrk1) - -! smixt(i,j,k) = min(max_eddy_length_scale,(2.8284*sqrt(1./((1./(tscale*tkes*vonk*zl(i,j,k))) & -! + (1./(tscale*tkes*l_inf(i,j)))+0.01*(brunt2(i,j,k)/tke(i,j,k)))))/0.3) -! else -! smixt(i,j,k) = zero - endif + if (tkes > zero .and. l_inf(i) > zero) then + wrk1 = one / (tscale*tkes*vonk*zl(i,k)) + wrk2 = one / (tscale*tkes*l_inf(i)) + wrk1 = wrk1 + wrk2 + pt01 * brunt2(i,k) / tke(i,k) + wrk1 = sqrt(one / max(wrk1,1.0d-8)) * (one/0.3d0) +! smixt(i,k) = min(max_eddy_length_scale, 2.8284*sqrt(wrk1)/0.3) + smixt(i,k) = min(max_eddy_length_scale, wrk1) + +! smixt(i,k) = min(max_eddy_length_scale,(2.8284*sqrt(1./((1./(tscale*tkes*vonk*zl(i,k))) & +! + (1./(tscale*tkes*l_inf(i)))+0.01*(brunt2(i,k)/tke(i,k)))))/0.3) +! else +! smixt(i,k) = zero + endif ! endif - enddo enddo enddo - ! Now find the in-cloud turbulence length scale ! See Eq. 13 in BK13 (Eq. 4.18 in Pete's disseration) @@ -1095,83 +946,78 @@ subroutine eddy_length() ! call conv_scale() ! inlining the relevant code -! do j=1,ny -! do i=1,nx -! conv_vel2(i,j,1) = zero ! Convective velocity scale cubed -! enddo +! do i=1,nx +! conv_vel2(i,1) = zero ! Convective velocity scale cubed ! enddo ! Integrate velocity scale in the vertical ! do k=2,nzm -! do j=1,ny -! do i=1,nx -! conv_vel2(i,j,k) = conv_vel2(i,j,k-1) & -! + 2.5*adzi(i,j,k)*bet(i,j,k)*wthv_sec(i,j,k) -! enddo +! do i=1,nx +! conv_vel2(i,k) = conv_vel2(i,k-1) & +! + 2.5*adzi(i,k)*bet(i,k)*wthv_sec(i,k) ! enddo ! enddo - do j=1,ny - do i=1,nx + do i=1,nx - if (cldarr(i,j) == 1) then ! If there's a cloud in this column + if (cldarr(i) == 1) then ! If there's a cloud in this column - kl = 0 - ku = 0 - do k=2,nzm-3 + kl = 0 + ku = 0 + do k=2,nzm-3 -! Look for the cloud base in this column +! Look for the cloud base in this column ! thresh (=0) is a variable local to eddy_length(). Should be a module constant. - wrk = qcl(i,j,k) + qci(i,j,k) - if (wrk > thresh .and. kl == 0) then - kl = k + wrk = qcl(i,k) + qci(i,k) + if (wrk > qcmin) then + if (kl == 0) then + kl = k endif ! Look for the cloud top in this column - if (wrk > thresh .and. qcl(i,j,k+1)+qci(i,j,k+1) <= thresh) then + if (qcl(i,k+1)+qci(i,k+1) <= qcmin) then ku = k ! conv_vel2 (Cubed convective velocity scale) is calculated in conv_scale() -! Use the value of conv_vel2 at the top of the cloud. -! conv_var = conv_vel2(i,j,k)**(oneb3) +! Use the value of conv_vel2 at the top of the cloud. +! conv_var = conv_vel2(i,k)** oneb3 endif + endif ! Compute the mixing length scale for the cloud layer that we just found -! if (kl > 0 .and. ku > 0 .and. ku-kl > 1) then - if (kl > 0 .and. ku > 0 .and. ku-kl > 0) then - +! if (kl > 0 .and. ku > 0 .and. ku-kl > 1) then +! if (kl > 0 .and. ku > 0 .and. ku-kl > 0) then + if (kl > 0 .and. ku >= kl) then ! The calculation below finds the integral in the Eq. 10 in BK13 for the current cloud - conv_var = zero - do kk=kl,ku - conv_var = conv_var+ 2.5*adzi(i,j,kk)*bet(i,j,kk)*wthv_sec(i,j,kk) - enddo - conv_var = conv_var ** oneb3 - - if (conv_var > 0) then ! If convective vertical velocity scale > 0 + conv_var = zero + do kk=kl,ku + conv_var = conv_var+ 2.5d0*adzi(i,kk)*bet(i,kk)*wthv_sec(i,kk) + enddo + conv_var = conv_var ** oneb3 - depth = (zl(i,j,ku)-zl(i,j,kl)) + adzl(i,j,kl) + if (conv_var > 0) then ! If convective vertical velocity scale > 0 + depth = (zl(i,ku)-zl(i,kl)) + adzl(i,kl) - do kk=kl,ku + do kk=kl,ku ! in-cloud turbulence length scale, Eq. 13 in BK13 (Eq. 4.18) -! wrk = conv_var/(depth*sqrt(tke(i,j,kk))) -! wrk = wrk * wrk + pt01*brunt2(i,j,kk)/tke(i,j,kk) +! wrk = conv_var/(depth*sqrt(tke(i,kk))) +! wrk = wrk * wrk + pt01*brunt2(i,kk)/tke(i,kk) - wrk = conv_var/(depth*depth*sqrt(tke(i,j,kk))) & - + pt01*brunt2(i,j,kk)/tke(i,j,kk) + wrk = conv_var/(depth*depth*sqrt(tke(i,kk))) & + + pt01*brunt2(i,kk)/tke(i,kk) - smixt(i,j,kk) = min(max_eddy_length_scale, (one/0.3)*sqrt(one/wrk)) + smixt(i,kk) = min(max_eddy_length_scale, (one/0.3d0)*sqrt(one/wrk)) - enddo + enddo - endif ! If convective vertical velocity scale > 0 - kl = zero - ku = zero - endif ! if inside the cloud layer + endif ! If convective vertical velocity scale > 0 + kl = zero + ku = zero + endif ! if inside the cloud layer - enddo ! k=2,nzm-3 - endif ! if in the cloudy column - enddo ! i=1,nx - enddo ! j=1,ny + enddo ! k=2,nzm-3 + endif ! if in the cloudy column + enddo ! i=1,nx end subroutine eddy_length @@ -1183,7 +1029,7 @@ subroutine conv_scale() ! for the definition of the length scale in clouds ! See Eq. 16 in BK13 (Eq. 4.21 in Pete's dissertation) - integer i, j, k + integer i, k !!!!!!!!! !! A bug in formulation of conv_vel @@ -1191,27 +1037,23 @@ subroutine conv_scale() !!!!!!!!!! ! conv_vel(1)=zero ! Horizontally averaged convective velocity scale cubed - do j=1,ny - do i=1,nx - conv_vel2(i,j,1) = zero ! Convective velocity scale cubed - enddo + do i=1,nx + conv_vel2(i,1) = zero ! Convective velocity scale cubed enddo ! Integrate velocity scale in the vertical do k=2,nzm ! conv_vel(k)=conv_vel(k-1) - do j=1,ny - do i=1,nx + do i=1,nx !********************************************************************** !Do not include grid-scale contribution to convective velocity scale in GCM applications -! conv_vel(k)=conv_vel(k-1)+2.5*adzi(k)*bet(k)*(tvwle(k)+tvws(k)) -! conv_vel(k)=conv_vel(k)+2.5*adzi(i,j,k)*bet(i,j,k)*(tvws(k)) +! conv_vel(k)=conv_vel(k-1)+2.5*adzi(k)*bet(k)*(tvwle(k)+tvws(k)) +! conv_vel(k)=conv_vel(k)+2.5*adzi(i,k)*bet(i,k)*(tvws(k)) !Do not include grid-scale contribution to convective velocity scale in GCM applications -! conv_vel2(i,j,k)=conv_vel2(i,j,k-1)+2.5*adzi(k)*bet(k)*(tvwle(k)+wthv_sec(i,j,k)) +! conv_vel2(i,k)=conv_vel2(i,k-1)+2.5*adzi(k)*bet(k)*(tvwle(k)+wthv_sec(i,k)) !********************************************************************** - conv_vel2(i,j,k) = conv_vel2(i,j,k-1) & - + 2.5*adzi(i,j,k)*bet(i,j,k)*wthv_sec(i,j,k) - enddo + conv_vel2(i,k) = conv_vel2(i,k-1) & + + 2.5*adzi(i,k)*bet(i,k)*wthv_sec(i,k) enddo enddo @@ -1222,7 +1064,7 @@ subroutine check_eddy() ! This subroutine checks eddy length values - integer i, j, k, kb, ks, zend + integer i, k, kb, ks, zend real wrk ! real zstart, zthresh, qthresh @@ -1240,25 +1082,23 @@ subroutine check_eddy() kb = k+1 endif - do j=1,ny - do i=1,nx + do i=1,nx - wrk = 0.1*adzl(i,j,k) + wrk = 0.1*adzl(i,k) ! Minimum 0.1 of local dz - smixt(i,j,k) = max(wrk, min(max_eddy_length_scale,smixt(i,j,k))) + smixt(i,k) = max(wrk, min(max_eddy_length_scale,smixt(i,k))) -! If chracteristic grid dimension in the horizontal< 1000m, set lengthscale to +! If chracteristic grid dimension in the horizontal< 1000m, set lengthscale to ! be not larger that that. -! if (sqrt(dx*dy) .le. 1000.) smixt(i,j,k)=min(sqrt(dx*dy),smixt(i,j,k)) +! if (sqrt(dx*dy) .le. 1000.) smixt(i,k)=min(sqrt(dx*dy),smixt(i,k)) - if (qcl(i,j,kb) == 0 .and. qcl(i,j,k) > 0 .and. brunt(i,j,k) > 1.e-4) then + if (qcl(i,kb) == 0 .and. qcl(i,k) > 0 .and. brunt(i,k) > 1.0d-4) then !If just above the cloud top and atmosphere is stable, set to 0.1 of local dz - smixt(i,j,k) = wrk - endif + smixt(i,k) = wrk + endif - enddo ! i - enddo ! j - enddo ! k + enddo ! i + enddo ! k end subroutine check_eddy @@ -1270,7 +1110,7 @@ subroutine canuto() ! Result is returned in a global variable w3 defined at the interface levels. ! Local variables - integer i, j, k, kb, kc + integer i, k, kb, kc real bet2, f0, f1, f2, f3, f4, f5, iso, isosqr, & omega0, omega1, omega2, X0, Y0, X1, Y1, AA0, AA1, buoy_sgs2, & @@ -1278,10 +1118,10 @@ subroutine canuto() ! cond, wrk, wrk1, wrk2, wrk3, avew ! ! See Eq. 7 in C01 (B.7 in Pete's dissertation) - real, parameter :: c=7.0, a0=0.52/(c*c*(c-2.)), a1=0.87/(c*c), & - a2=0.5/c, a3=0.6/(c*(c-2.)), a4=2.4/(3.*c+5.), & - a5=0.6/(c*(3.*c+5)) -!Moorthi a5=0.6/(c*(3.+5.*c)) + real, parameter :: c=7.0d0, a0=0.52d0/(c*c*(c-2.0d0)), a1=0.87d0/(c*c), & + a2=0.5d0/c, a3=0.6d0/(c*(c-2.0d0)), a4=2.4d0/(3.0d0*c+5.0d0), & + a5=0.6d0/(c*(3.0d0*c+5.0d0)) +!Moorthi a5=0.6d0/(c*(3.0d0+5.0d0*c)) ! do k=1,nzm do k=2,nzm @@ -1292,51 +1132,43 @@ subroutine canuto() ! if(k == 1) then ! kb = 1 ! kc = 2 -! do j=1,ny -! do i=1,nx -! thedz(i,j) = one / adzl(i,j,kc) -! thedz2(i,j) = thedz(i,j) -! enddo +! do i=1,nx +! thedz(i) = one / adzl(i,kc) +! thedz2(i) = thedz(i) ! enddo ! elseif(k == nzm) then - if (k == nzm) then + if(k == nzm) then kb = nzm-1 kc = nzm - do j=1,ny - do i=1,nx - thedz(i,j) = one / adzi(i,j,k) - thedz2(i,j) = one / adzl(i,j,kb) - enddo + do i=1,nx + thedz(i) = one / adzi(i,k) + thedz2(i) = one / adzl(i,kb) enddo else - do j=1,ny - do i=1,nx - thedz(i,j) = one / adzi(i,j,k) - thedz2(i,j) = one / (adzl(i,j,k)+adzl(i,j,kb)) - enddo + do i=1,nx + thedz(i) = one / adzi(i,k) + thedz2(i) = one / (adzl(i,k)+adzl(i,kb)) enddo endif + do i=1,nx - do j=1,ny - do i=1,nx - - iso = half*(isotropy(i,j,k)+isotropy(i,j,kb)) - isosqr = iso*iso ! Two-level average of "return-to-isotropy" time scale squared - buoy_sgs2 = isosqr*half*(brunt(i,j,k)+brunt(i,j,kb)) - bet2 = half*(bet(i,j,k)+bet(i,j,kb)) !Two-level average of BV frequency squared + iso = half*(isotropy(i,k)+isotropy(i,kb)) + isosqr = iso*iso ! Two-level average of "return-to-isotropy" time scale squared + buoy_sgs2 = isosqr*half*(brunt(i,k)+brunt(i,kb)) + bet2 = half*(bet(i,k)+bet(i,kb)) !Two-level average of BV frequency squared ! Compute functions f0-f5, see Eq, 8 in C01 (B.8 in Pete's dissertation) - avew = half*(w_sec(i,j,k)+w_sec(i,j,kb)) + avew = half*(w_sec(i,k)+w_sec(i,kb)) + !aab ! - wrk1 = bet2*iso - wrk2 = thedz2(i,j)*wrk1*wrk1*iso - wrk3 = thl_sec(i,j,kc) - thl_sec(i,j,kb) - f0 = wrk2 * wrk1 * wthl_sec(i,j,k) * wrk3 + wrk1 = bet2*iso + wrk2 = thedz2(i)*wrk1*wrk1*iso + wrk3 = thl_sec(i,kc) - thl_sec(i,kb) - wrk = wthl_sec(i,j,kc) - wthl_sec(i,j,kb) + f0 = wrk2 * wrk1 * wthl_sec(i,k) * wrk3 - f1 = wrk2 * (wrk*wthl_sec(i,j,k) + half*avew*wrk3) + wrk = wthl_sec(i,kc) - wthl_sec(i,kb) - wrk1 = bet2*isosqr - f2 = thedz(i,j)*wrk1*wthl_sec(i,j,k)*(w_sec(i,j,k)-w_sec(i,j,kb)) & - + (thedz2(i,j)+thedz2(i,j))*bet(i,j,k)*isosqr*wrk + f1 = wrk2 * (wrk*wthl_sec(i,k) + half*avew*wrk3) - f3 = thedz2(i,j)*wrk1*wrk + thedz(i,j)*bet2*isosqr*(wthl_sec(i,j,k)*(tke(i,j,k)-tke(i,j,kb))) + wrk1 = bet2*isosqr + f2 = thedz(i)*wrk1*wthl_sec(i,k)*(w_sec(i,k)-w_sec(i,kb)) & + + (thedz2(i)+thedz2(i))*bet(i,k)*isosqr*wrk - wrk1 = thedz(i,j)*iso*avew - f4 = wrk1*(w_sec(i,j,k)-w_sec(i,j,kb) + tke(i,j,k)-tke(i,j,kb)) + f3 = thedz2(i)*wrk1*wrk + thedz(i)*bet2*isosqr*(wthl_sec(i,k)*(tke(i,k)-tke(i,kb))) - f5 = wrk1*(w_sec(i,j,k)-w_sec(i,j,kb)) + wrk1 = thedz(i)*iso*avew + f4 = wrk1*(w_sec(i,k)-w_sec(i,kb) + tke(i,k)-tke(i,kb)) + + f5 = wrk1*(w_sec(i,k)-w_sec(i,kb)) ! Compute the "omega" terms, see Eq. 6 in C01 (B.6 in Pete's dissertation) - omega0 = a4 / (one-a5*buoy_sgs2) - omega1 = omega0 / (c+c) - omega2 = omega1*f3+(5./4.)*omega0*f4 + omega0 = a4 / (one-a5*buoy_sgs2) + omega1 = omega0 / (c+c) + omega2 = omega1*f3+(5./4.)*omega0*f4 ! Compute the X0, Y0, X1, Y1 terms, see Eq. 5 a-b in C01 (B.5 in Pete's dissertation) - wrk1 = one / (one-(a1+a3)*buoy_sgs2) - wrk2 = one / (one-a3*buoy_sgs2) - X0 = wrk1 * (a2*buoy_sgs2*(one-a3*buoy_sgs2)) - Y0 = wrk2 * (two*a2*buoy_sgs2*X0) - X1 = wrk1 * (a0*f0+a1*f1+a2*(one-a3*buoy_sgs2)*f2) - Y1 = wrk2 * (two*a2*(buoy_sgs2*X1+(a0/a1)*f0+f1)) + wrk1 = one / (one-(a1+a3)*buoy_sgs2) + wrk2 = one / (one-a3*buoy_sgs2) + X0 = wrk1 * (a2*buoy_sgs2*(one-a3*buoy_sgs2)) + Y0 = wrk2 * (two*a2*buoy_sgs2*X0) + X1 = wrk1 * (a0*f0+a1*f1+a2*(one-a3*buoy_sgs2)*f2) + Y1 = wrk2 * (two*a2*(buoy_sgs2*X1+(a0/a1)*f0+f1)) ! Compute the A0, A1 terms, see Eq. 5d in C01 (B.5 in Pete's dissertation) - AA0 = omega0*X0 + omega1*Y0 - AA1 = omega0*X1 + omega1*Y1 + omega2 + AA0 = omega0*X0 + omega1*Y0 + AA1 = omega0*X1 + omega1*Y1 + omega2 ! Finally, we have the third moment of w, see Eq. 4c in C01 (B.4 in Pete's dissertation) -! cond is an estimate of third moment from second oment - If the third moment is larger +! cond_w is an estimate of third moment from second oment - If the third moment is larger ! than the estimate - limit w3. !aab ! Implemetation of the C01 approach in this subroutine is nearly complete ! (the missing part are Eqs. 5c and 5e which are very simple) -! therefore it's easy to diagnose other third order moments obtained in C01 using this code. +! therefore it's easy to diagnose other third order moments obtained in C01 using this code. - enddo enddo enddo - do j=1,ny - do i=1,nx - w3(i,j,1) = w3(i,j,2) - enddo + do i=1,nx + w3(i,1) = w3(i,2) enddo end subroutine canuto @@ -1431,7 +1261,7 @@ subroutine assumed_pdf() ! Local variables - integer i,j,k,ku,kd + integer i,k,ku,kd real wrk, wrk1, wrk2, wrk3, wrk4, bastoeps, eps_ss1, eps_ss2, cond_w ! bastoeps = basetemp / epsterm @@ -1449,477 +1279,441 @@ subroutine assumed_pdf() ku = k + 1 ! if (k == nzm) ku = k - DO j=1,ny - DO i=1,nx + DO i=1,nx ! Initialize cloud variables to zero - diag_qn = zero - diag_frac = zero - diag_ql = zero - diag_qi = zero + diag_qn = zero + diag_frac = zero + diag_ql = zero + diag_qi = zero - pval = prsl(i,j,k) - pfac = pval * 1.0e-5 - pkap = pfac ** kapa + pval = prsl(i,k) + pfac = pval * 1.0d-5 + pkap = pfac ** kapa -! Read in liquid/ice static energy, total water mixing ratio, +! Read in liquid/ice static energy, total water mixing ratio, ! and vertical velocity to variables PDF needs - - thl_first = hl(i,j,k) + fac_cond*qpl(i,j,k) & - + fac_sub*qpi(i,j,k) - - qw_first = total_water(i,j,k) -! w_first = half*(w(i,j,kd)+w(i,j,ku)) - w_first = w(i,j,k) + thl_first = hl(i,k) + fac_cond*qpl(i,k) + fac_sub*qpi(i,k) + qw_first = total_water(i,k) +! w_first = half*(w(i,kd)+w(i,ku)) + w_first = w(i,k) ! GET ALL INPUT VARIABLES ON THE SAME GRID ! Points to be computed with relation to thermo point ! Read in points that need to be averaged - if (k < nzm) then - w3var = half*(w3(i,j,kd)+w3(i,j,ku)) - thlsec = max(zero, half*(thl_sec(i,j,kd)+thl_sec(i,j,ku)) ) - qwsec = max(zero, half*(qw_sec(i,j,kd)+qw_sec(i,j,ku)) ) - qwthlsec = half * (qwthl_sec(i,j,kd) + qwthl_sec(i,j,ku)) - wqwsec = half * (wqw_sec(i,j,kd) + wqw_sec(i,j,ku)) - wthlsec = half * (wthl_sec(i,j,kd) + wthl_sec(i,j,ku)) - else ! at the model top assuming zeros - w3var = half*w3(i,j,k) - thlsec = max(zero, half*thl_sec(i,j,k)) - qwsec = max(zero, half*qw_sec(i,j,k)) - qwthlsec = half * qwthl_sec(i,j,k) - wqwsec = half * wqw_sec(i,j,k) - wthlsec = half * wthl_sec(i,j,k) - endif + if (k < nzm) then + w3var = half*(w3(i,kd)+w3(i,ku)) + thlsec = max(zero, half*(thl_sec(i,kd)+thl_sec(i,ku)) ) + qwsec = max(zero, half*(qw_sec(i,kd)+qw_sec(i,ku)) ) + qwthlsec = half * (qwthl_sec(i,kd) + qwthl_sec(i,ku)) + wqwsec = half * (wqw_sec(i,kd) + wqw_sec(i,ku)) + wthlsec = half * (wthl_sec(i,kd) + wthl_sec(i,ku)) + else ! at the model top assuming zeros + w3var = half*w3(i,k) + thlsec = max(zero, half*thl_sec(i,k)) + qwsec = max(zero, half*qw_sec(i,k)) + qwthlsec = half * qwthl_sec(i,k) + wqwsec = half * wqw_sec(i,k) + wthlsec = half * wthl_sec(i,k) + endif -! w3var = w3(i,j,k) -! thlsec = max(zero,thl_sec(i,j,k)) -! qwsec = max(zero,qw_sec(i,j,k)) -! qwthlsec = qwthl_sec(i,j,k) -! wqwsec = wqw_sec(i,j,k) -! wthlsec = wthl_sec(i,j,k) +! w3var = w3(i,k) +! thlsec = max(zero,thl_sec(i,k)) +! qwsec = max(zero,qw_sec(i,k)) +! qwthlsec = qwthl_sec(i,k) +! wqwsec = wqw_sec(i,k) +! wthlsec = wthl_sec(i,k) ! Compute square roots of some variables so we don't have to do it again -! if (lprnt .and. i == ipr .and. k<40) write(0,*)' w_sec=',w_sec(i,j,k),' k=',k - if (w_sec(i,j,k) > zero) then - sqrtw2 = sqrt(w_sec(i,j,k)) - else - sqrtw2 = zero - endif - if (thlsec > zero) then - sqrtthl = sqrt(thlsec) - else - sqrtthl = zero - endif - if (qwsec > zero) then - sqrtqt = sqrt(qwsec) - else - sqrtqt = zero - endif + if (w_sec(i,k) > zero) then + sqrtw2 = sqrt(w_sec(i,k)) + else + sqrtw2 = zero + endif + if (thlsec > zero) then + sqrtthl = sqrt(thlsec) + else + sqrtthl = zero + endif + if (qwsec > zero) then + sqrtqt = sqrt(qwsec) + else + sqrtqt = zero + endif ! Find parameters of the double Gaussian PDF of vertical velocity ! Skewness of vertical velocity -! Skew_w = w3var / w_sec(i,j,k)**(3./2.) -! Skew_w = w3var / (sqrtw2*sqrtw2*sqrtw2) ! Moorthi - - IF (w_sec(i,j,k) <= w_tol_sqd) THEN ! If variance of w is too small then - ! PDF is a sum of two delta functions - Skew_w = zero - w1_1 = w_first - w1_2 = w_first - w2_1 = zero - w2_2 = zero - aterm = half - onema = half - ELSE - +! Skew_w = w3var / w_sec(i,k)**(3./2.) +! Skew_w = w3var / (sqrtw2*sqrtw2*sqrtw2) ! Moorthi + + IF (w_sec(i,k) <= w_tol_sqd) THEN ! If variance of w is too small then + ! PDF is a sum of two delta functions + Skew_w = zero + w1_1 = w_first + w1_2 = w_first + w2_1 = zero + w2_2 = zero + aterm = half + onema = half + ELSE !aab - - Skew_w = w3var / (sqrtw2*sqrtw2*sqrtw2) ! Moorthi -! Proportionality coefficients between widths of each vertical velocity + + Skew_w = w3var / (sqrtw2*sqrtw2*sqrtw2) ! Moorthi +! Proportionality coefficients between widths of each vertical velocity ! gaussian and the sqrt of the second moment of w - w2_1 = 0.4 - w2_2 = 0.4 + w2_1 = 0.4 + w2_2 = 0.4 -! Compute realtive weight of the first PDF "plume" +! Compute realtive weight of the first PDF "plume" ! See Eq A4 in Pete's dissertaion - Ensure 0.01 < a < 0.99 - wrk = one - w2_1 - aterm = max(atmin,min(half*(one-Skew_w*sqrt(one/(4.*wrk*wrk*wrk+Skew_w*Skew_w))),atmax)) - onema = one - aterm + wrk = one - w2_1 + aterm = max(atmin,min(half*(one-Skew_w*sqrt(one/(4.*wrk*wrk*wrk+Skew_w*Skew_w))),atmax)) + onema = one - aterm - sqrtw2t = sqrt(wrk) + sqrtw2t = sqrt(wrk) ! Eq. A.5-A.6 - wrk = sqrt(onema/aterm) - w1_1 = sqrtw2t * wrk - w1_2 = - sqrtw2t / wrk + wrk = sqrt(onema/aterm) + w1_1 = sqrtw2t * wrk + w1_2 = - sqrtw2t / wrk - w2_1 = w2_1 * w_sec(i,j,k) - w2_2 = w2_2 * w_sec(i,j,k) + w2_1 = w2_1 * w_sec(i,k) + w2_2 = w2_2 * w_sec(i,k) - ENDIF + ENDIF ! Find parameters of the PDF of liquid/ice static energy -! if (lprnt .and. i == ipr .and. k<40) write(0,*)' thlsec=',thlsec,' w1_2=',w1_2,' w1_1=',w1_1,& -! ' thl_first=',thl_first,' k=',k,' wthlsec=',wthlsec,sqrtw2,sqrtthl - IF (thlsec <= thl_tol*thl_tol .or. abs(w1_2-w1_1) <= w_thresh) THEN - thl1_1 = thl_first - thl1_2 = thl_first - thl2_1 = zero - thl2_2 = zero - sqrtthl2_1 = zero - sqrtthl2_2 = zero - ELSE - - corrtest1 = max(-one,min(one,wthlsec/(sqrtw2*sqrtthl))) - - thl1_1 = -corrtest1 / w1_2 ! A.7 - thl1_2 = -corrtest1 / w1_1 ! A.8 - - wrk1 = thl1_1 * thl1_1 - wrk2 = thl1_2 * thl1_2 - wrk3 = three * (one - aterm*wrk1 - onema*wrk2) - wrk4 = -skew_facw*Skew_w - aterm*wrk1*thl1_1 - onema*wrk2*thl1_2 ! testing - Moorthi -! wrk4 = -skew_fact*Skew_w - aterm*wrk1*thl1_1 - onema*wrk2*thl1_2 ! testing - Moorthi -! wrk4 = - aterm*wrk1*thl1_1 - onema*wrk2*thl1_2 - wrk = three * (thl1_2-thl1_1) - if (wrk /= zero) then - thl2_1 = thlsec * min(100.,max(zero,( thl1_2*wrk3-wrk4)/(aterm*wrk))) ! A.10 - thl2_2 = thlsec * min(100.,max(zero,(-thl1_1*wrk3+wrk4)/(onema*wrk))) ! A.11 - else - thl2_1 = zero - thl2_2 = zero - endif + IF (thlsec <= thl_tol*thl_tol .or. abs(w1_2-w1_1) <= w_thresh) THEN + thl1_1 = thl_first + thl1_2 = thl_first + thl2_1 = zero + thl2_2 = zero + sqrtthl2_1 = zero + sqrtthl2_2 = zero + ELSE + + corrtest1 = max(-one,min(one,wthlsec/(sqrtw2*sqrtthl))) + + thl1_1 = -corrtest1 / w1_2 ! A.7 + thl1_2 = -corrtest1 / w1_1 ! A.8 + + wrk1 = thl1_1 * thl1_1 + wrk2 = thl1_2 * thl1_2 + wrk3 = three * (one - aterm*wrk1 - onema*wrk2) + wrk4 = -skew_facw*Skew_w - aterm*wrk1*thl1_1 - onema*wrk2*thl1_2 ! testing - Moorthi +! wrk4 = -skew_fact*Skew_w - aterm*wrk1*thl1_1 - onema*wrk2*thl1_2 ! testing - Moorthi +! wrk4 = - aterm*wrk1*thl1_1 - onema*wrk2*thl1_2 + wrk = three * (thl1_2-thl1_1) + if (wrk /= zero) then + thl2_1 = thlsec * min(100.0d0,max(zero,(thl1_2*wrk3-wrk4)/(aterm*wrk))) ! A.10 + thl2_2 = thlsec * min(100.0d0,max(zero,(-thl1_1*wrk3+wrk4)/(onema*wrk))) ! A.11 + else + thl2_1 = zero + thl2_2 = zero + endif ! -! if (lprnt .and. i == ipr .and. k<40) write(0,*)' thl1_1=',thl1_1,' sqrtthl=',sqrtthl,' thl_first=',thl_first,& -! ' thl1_2=',thl1_2,' corrtest1=',corrtest1,' w1_2=',w1_2,' w1_1=',w1_1 - - thl1_1 = thl1_1*sqrtthl + thl_first - thl1_2 = thl1_2*sqrtthl + thl_first + thl1_1 = thl1_1*sqrtthl + thl_first + thl1_2 = thl1_2*sqrtthl + thl_first -! if (lprnt .and. i == ipr .and. k<40) write(0,*)' thl1_1=',thl1_1,' thl1_2=',thl1_2 + sqrtthl2_1 = sqrt(thl2_1) + sqrtthl2_2 = sqrt(thl2_2) - sqrtthl2_1 = sqrt(thl2_1) - sqrtthl2_2 = sqrt(thl2_2) - - ENDIF + ENDIF ! FIND PARAMETERS FOR TOTAL WATER MIXING RATIO - IF (qwsec <= rt_tol*rt_tol .or. abs(w1_2-w1_1) <= w_thresh) THEN - qw1_1 = qw_first - qw1_2 = qw_first - qw2_1 = zero - qw2_2 = zero - sqrtqw2_1 = zero - sqrtqw2_2 = zero - ELSE + IF (qwsec <= rt_tol*rt_tol .or. abs(w1_2-w1_1) <= w_thresh) THEN + qw1_1 = qw_first + qw1_2 = qw_first + qw2_1 = zero + qw2_2 = zero + sqrtqw2_1 = zero + sqrtqw2_2 = zero + ELSE - corrtest2 = max(-one,min(one,wqwsec/(sqrtw2*sqrtqt))) + corrtest2 = max(-one,min(one,wqwsec/(sqrtw2*sqrtqt))) - qw1_1 = - corrtest2 / w1_2 ! A.7 - qw1_2 = - corrtest2 / w1_1 ! A.8 + qw1_1 = - corrtest2 / w1_2 ! A.7 + qw1_2 = - corrtest2 / w1_1 ! A.8 - tsign = abs(qw1_2-qw1_1) + tsign = abs(qw1_2-qw1_1) -! Skew_qw = skew_facw*Skew_w +! Skew_qw = skew_facw*Skew_w - IF (tsign > 0.4) THEN - Skew_qw = skew_facw*Skew_w - ELSEIF (tsign <= 0.2) THEN - Skew_qw = zero - ELSE - Skew_qw = (skew_facw/0.2) * Skew_w * (tsign-0.2) - ENDIF + IF (tsign > 0.4) THEN + Skew_qw = skew_facw*Skew_w + ELSEIF (tsign <= 0.2) THEN + Skew_qw = zero + ELSE + Skew_qw = (skew_facw/0.2) * Skew_w * (tsign-0.2) + ENDIF - wrk1 = qw1_1 * qw1_1 - wrk2 = qw1_2 * qw1_2 - wrk3 = three * (one - aterm*wrk1 - onema*wrk2) - wrk4 = Skew_qw - aterm*wrk1*qw1_1 - onema*wrk2*qw1_2 - wrk = three * (qw1_2-qw1_1) + wrk1 = qw1_1 * qw1_1 + wrk2 = qw1_2 * qw1_2 + wrk3 = three * (one - aterm*wrk1 - onema*wrk2) + wrk4 = Skew_qw - aterm*wrk1*qw1_1 - onema*wrk2*qw1_2 + wrk = three * (qw1_2-qw1_1) - if (wrk /= zero) then - qw2_1 = qwsec * min(100.,max(zero,( qw1_2*wrk3-wrk4)/(aterm*wrk))) ! A.10 - qw2_2 = qwsec * min(100.,max(zero,(-qw1_1*wrk3+wrk4)/(onema*wrk))) ! A.11 - else - qw2_1 = zero - qw2_2 = zero - endif + if (wrk /= zero) then + qw2_1 = qwsec * min(100.0d0,max(zero,( qw1_2*wrk3-wrk4)/(aterm*wrk))) ! A.10 + qw2_2 = qwsec * min(100.0d0,max(zero,(-qw1_1*wrk3+wrk4)/(onema*wrk))) ! A.11 + else + qw2_1 = zero + qw2_2 = zero + endif ! - qw1_1 = qw1_1*sqrtqt + qw_first - qw1_2 = qw1_2*sqrtqt + qw_first + qw1_1 = qw1_1*sqrtqt + qw_first + qw1_2 = qw1_2*sqrtqt + qw_first - sqrtqw2_1 = sqrt(qw2_1) - sqrtqw2_2 = sqrt(qw2_2) + sqrtqw2_1 = sqrt(qw2_1) + sqrtqw2_2 = sqrt(qw2_2) - ENDIF + ENDIF ! CONVERT FROM TILDA VARIABLES TO "REAL" VARIABLES - w1_1 = w1_1*sqrtw2 + w_first - w1_2 = w1_2*sqrtw2 + w_first + w1_1 = w1_1*sqrtw2 + w_first + w1_2 = w1_2*sqrtw2 + w_first -! FIND WITHIN-PLUME CORRELATIONS +! FIND WITHIN-PLUME CORRELATIONS - testvar = aterm*sqrtqw2_1*sqrtthl2_1 + onema*sqrtqw2_2*sqrtthl2_2 + testvar = aterm*sqrtqw2_1*sqrtthl2_1 + onema*sqrtqw2_2*sqrtthl2_2 - IF (testvar == 0) THEN - r_qwthl_1 = zero - ELSE - r_qwthl_1 = max(-one,min(one,(qwthlsec-aterm*(qw1_1-qw_first)*(thl1_1-thl_first) & - -onema*(qw1_2-qw_first)*(thl1_2-thl_first))/testvar)) ! A.12 - ENDIF + IF (testvar == 0) THEN + r_qwthl_1 = zero + ELSE + r_qwthl_1 = max(-one,min(one,(qwthlsec-aterm*(qw1_1-qw_first)*(thl1_1-thl_first) & + -onema*(qw1_2-qw_first)*(thl1_2-thl_first))/testvar)) ! A.12 + ENDIF ! BEGIN TO COMPUTE CLOUD PROPERTY STATISTICS -! wrk1 = gamaz(i,j,k) - fac_cond * qpl(i,j,k) - fac_sub * qpi(i,j,k) -! Tl1_1 = thl1_1 - wrk1 -! Tl1_2 = thl1_2 - wrk1 +! wrk1 = gamaz(i,k) - fac_cond*qpl(i,k) - fac_sub*qpi(i,k) +! Tl1_1 = thl1_1 - wrk1 +! Tl1_2 = thl1_2 - wrk1 - Tl1_1 = thl1_1 - gamaz(i,j,k) - Tl1_2 = thl1_2 - gamaz(i,j,k) - -! if (lprnt .and. i == ipr .and. k<40) write(0,*)' Tl1_1=',Tl1_1,' Tl1_2=',Tl1_2,& -! ' wrk1=',wrk1,' thl1_1=',thl1_1,' thl1_2=',thl1_2,' qpl=',qpl(i,j,k),' qpi=',qpi(i,j,k) + Tl1_1 = thl1_1 - gamaz(i,k) + Tl1_2 = thl1_2 - gamaz(i,k) ! Now compute qs - esval1_1 = zero - esval2_1 = zero - eps_ss1 = eps - eps_ss2 = eps - om1 = one - ! Partition based on temperature for the first plume - IF (Tl1_1 >= tbgmax) THEN - esval1_1 = min(fpvsl(Tl1_1), pval) -! esval1_1 = esatw(Tl1_1) - lstarn1 = lcond - ELSE IF (Tl1_1 <= tbgmin) THEN - esval1_1 = min(fpvsi(Tl1_1), pval) -! esval1_1 = esati(Tl1_1) - lstarn1 = lsub - eps_ss1 = eps * supice - ELSE - esval1_1 = min(fpvsl(Tl1_1), pval) - esval2_1 = min(fpvsi(Tl1_1), pval) -! esval1_1 = esatw(Tl1_1) -! esval2_1 = esati(Tl1_1) - om1 = max(zero, min(one, a_bg*(Tl1_1-tbgmin))) - lstarn1 = lcond + (one-om1)*lfus - eps_ss2 = eps * supice - - ENDIF - qs1 = om1 * eps_ss1*esval1_1/(pval-0.378*esval1_1) & - + (one-om1) * eps_ss2*esval2_1/(pval-0.378*esval2_1) - -! beta1 = (rgas/rv)*(lstarn1/(rgas*Tl1_1))*(lstarn1/(cp*Tl1_1)) - beta1 = (lstarn1*lstarn1*onebrvcp) / (Tl1_1*Tl1_1) ! A.18 + IF (Tl1_1 >= tbgmax) THEN + lstarn1 = lcond + esval = min(fpvsl(Tl1_1), pval) + qs1 = eps * esval / (pval-0.378d0*esval) + ELSE IF (Tl1_1 <= tbgmin) THEN + lstarn1 = lsub + esval = min(fpvsi(Tl1_1), pval) + qs1 = epss * esval / (pval-0.378d0*esval) + ELSE + om1 = max(zero, min(one, a_bg*(Tl1_1-tbgmin))) + lstarn1 = lcond + (one-om1)*lfus + esval = min(fpvsl(Tl1_1), pval) + esval2 = min(fpvsi(Tl1_1), pval) + qs1 = om1 * eps * esval / (pval-0.378d0*esval) & + + (one-om1) * epss * esval2 / (pval-0.378d0*esval2) + ENDIF + +! beta1 = (rgas/rv)*(lstarn1/(rgas*Tl1_1))*(lstarn1/(cp*Tl1_1)) +! beta1 = (lstarn1*lstarn1*onebrvcp) / (Tl1_1*Tl1_1) ! A.18 + + beta1 = lstarn1 / Tl1_1 + beta1 = beta1 * beta1 * onebrvcp ! Are the two plumes equal? If so then set qs and beta ! in each column to each other to save computation - IF (Tl1_1 == Tl1_2) THEN - qs2 = qs1 - beta2 = beta1 + IF (Tl1_1 == Tl1_2) THEN + qs2 = qs1 + beta2 = beta1 + ELSE + IF (Tl1_2 >= tbgmax) THEN + lstarn2 = lcond + esval = min(fpvsl(Tl1_2), pval) + qs2 = eps * esval / (pval-0.378d0*esval) + ELSE IF (Tl1_2 <= tbgmin) THEN + lstarn2 = lsub + esval = min(fpvsi(Tl1_2), pval) + qs2 = epss * esval / (pval-0.378d0*esval) ELSE - - esval1_2 = zero - esval2_2 = zero - eps_ss1 = eps - eps_ss2 = eps - om2 = one - - IF (Tl1_2 >= tbgmax) THEN - esval1_2 = min(fpvsl(Tl1_2), pval) -! esval1_2 = esatw(Tl1_2) - lstarn2 = lcond - ELSE IF (Tl1_2 <= tbgmin) THEN - esval1_2 = min(fpvsi(Tl1_2), pval) -! esval1_2 = esati(Tl1_2) - lstarn2 = lsub - eps_ss1 = eps * supice - ELSE - esval1_2 = min(fpvsl(Tl1_2), pval) - esval2_2 = min(fpvsi(Tl1_2), pval) -! esval1_2 = esatw(Tl1_2) -! esval2_2 = esati(Tl1_2) - om2 = max(zero, min(one, a_bg*(Tl1_2-tbgmin))) - lstarn2 = lcond + (one-om2)*lfus - eps_ss2 = eps * supice - ENDIF - - qs2 = om2 * eps_ss1*esval1_2/(pval-0.378*esval1_2) & - + (one-om2) * eps_ss2*esval2_2/(pval-0.378*esval2_2) - -! beta2 = (rgas/rv)*(lstarn2/(rgas*Tl1_2))*(lstarn2/(cp*Tl1_2)) ! A.18 - beta2 = (lstarn2*lstarn2*onebrvcp) / (Tl1_2*Tl1_2) ! A.18 - + om2 = max(zero, min(one, a_bg*(Tl1_2-tbgmin))) + lstarn2 = lcond + (one-om2)*lfus + esval = min(fpvsl(Tl1_2), pval) + esval2 = min(fpvsi(Tl1_2), pval) + qs2 = om2 * eps * esval / (pval-0.378d0*esval) & + + (one-om2) * epss * esval2 / (pval-0.378d0*esval2) ENDIF - qs1 = qs1 * rhc(i,j,k) - qs2 = qs2 * rhc(i,j,k) +! beta2 = (rgas/rv)*(lstarn2/(rgas*Tl1_2))*(lstarn2/(cp*Tl1_2)) ! A.18 +! beta2 = (lstarn2*lstarn2*onebrvcp) / (Tl1_2*Tl1_2) ! A.18 -! Now compute cloud stuff - compute s term + beta2 = lstarn2 / Tl1_2 + beta2 = beta2 * beta2 * onebrvcp - cqt1 = one / (one+beta1*qs1) ! A.19 - wrk = qs1 * (one+beta1*qw1_1) * cqt1 - s1 = qw1_1 - wrk ! A.17 - cthl1 = cqt1*wrk*cpolv*beta1*pkap ! A.20 - wrk1 = cthl1 * cthl1 - wrk2 = cqt1 * cqt1 -! std_s1 = sqrt(max(zero,wrk1*thl2_1+wrk2*qw2_1-2.*cthl1*sqrtthl2_1*cqt1*sqrtqw2_1*r_qwthl_1)) - std_s1 = sqrt(max(zero, wrk1*thl2_1+wrk2*qw2_1 & - - two*cthl1*sqrtthl2_1*cqt1*sqrtqw2_1*r_qwthl_1)) + ENDIF - qn1 = zero - C1 = zero + qs1 = qs1 * rhc(i,k) + qs2 = qs2 * rhc(i,k) - IF (std_s1 > zero) THEN - wrk = s1 / (std_s1*sqrt2) - C1 = max(zero, min(one, half*(one+erf(wrk)))) ! A.15 +! Now compute cloud stuff - compute s term -! if (lprnt .and. i == ipr .and. k<40) write(0,*)' in shoc wrk=',wrk,' s1=','std=',std_s1,& -! ' c1=',c1*100,' qs1=',qs1,' qw1_1=',qw1_1,' k=',k + cqt1 = one / (one+beta1*qs1) ! A.19 + wrk = qs1 * (one+beta1*qw1_1) * cqt1 + s1 = qw1_1 - wrk ! A.17 + cthl1 = cqt1*wrk*cpolv*beta1*pkap ! A.20 -! IF (C1 > zero) qn1 = s1*C1 + (std_s1*sqrtpii)*exp(-wrk*wrk) ! A.16 - qn1 = max(zero, s1*C1 + (std_s1*sqrtpii)*exp(-wrk*wrk)) ! A.16 - ELSEIF (s1 > zero) THEN - C1 = one - qn1 = s1 - ENDIF + wrk1 = cthl1 * cthl1 + wrk2 = cqt1 * cqt1 +! std_s1 = sqrt(max(zero,wrk1*thl2_1+wrk2*qw2_1-2.*cthl1*sqrtthl2_1*cqt1*sqrtqw2_1*r_qwthl_1)) + std_s1 = sqrt(max(zero, wrk1*thl2_1+wrk2*qw2_1 & + - two*cthl1*sqrtthl2_1*cqt1*sqrtqw2_1*r_qwthl_1)) -! now compute non-precipitating cloud condensate + qn1 = zero + C1 = zero -! If two plumes exactly equal, then just set many of these -! variables to themselves to save on computation. - IF (qw1_1 == qw1_2 .and. thl2_1 == thl2_2 .and. qs1 == qs2) THEN - s2 = s1 - cthl2 = cthl1 - cqt2 = cqt1 - std_s2 = std_s1 - C2 = C1 - qn2 = qn1 - ELSE + IF (std_s1 > zero) THEN + wrk = s1 / (std_s1*sqrt2) + C1 = max(zero, min(one, half*(one+erf(wrk)))) ! A.15 - cqt2 = one / (one+beta2*qs2) - wrk = qs2 * (one+beta2*qw1_2) * cqt2 - s2 = qw1_2 - wrk - cthl2 = wrk*cqt2*cpolv*beta2*pkap - wrk1 = cthl2 * cthl2 - wrk2 = cqt2 * cqt2 -! std_s2 = sqrt(max(zero,wrk1*thl2_2+wrk2*qw2_2-2.*cthl2*sqrtthl2_2*cqt2*sqrtqw2_2*r_qwthl_1)) - std_s2 = sqrt(max(zero, wrk1*thl2_2+wrk2*qw2_2 & - - two*cthl2*sqrtthl2_2*cqt2*sqrtqw2_2*r_qwthl_1)) - - qn2 = zero - C2 = zero - - IF (std_s2 > zero) THEN - wrk = s2 / (std_s2*sqrt2) - C2 = max(zero, min(one, half*(one+erf(wrk)))) -! IF (C2 > zero) qn2 = s2*C2 + (std_s2*sqrtpii)*exp(-wrk*wrk) - qn2 = max(zero, s2*C2 + (std_s2*sqrtpii)*exp(-wrk*wrk)) - ELSEIF (s2 > zero) THEN - C2 = one - qn2 = s2 - ENDIF + IF (C1 > zero) qn1 = s1*C1 + (std_s1*sqrtpii)*exp(-wrk*wrk) ! A.16 + ELSEIF (s1 >= qcmin) THEN + C1 = one + qn1 = s1 + ENDIF - ENDIF +! now compute non-precipitating cloud condensate -! finally, compute the SGS cloud fraction - diag_frac = aterm*C1 + onema*C2 +! If two plumes exactly equal, then just set many of these +! variables to themselves to save on computation. + IF (qw1_1 == qw1_2 .and. thl2_1 == thl2_2 .and. qs1 == qs2) THEN + s2 = s1 + cthl2 = cthl1 + cqt2 = cqt1 + std_s2 = std_s1 + C2 = C1 + qn2 = qn1 + ELSE + + cqt2 = one / (one+beta2*qs2) + wrk = qs2 * (one+beta2*qw1_2) * cqt2 + s2 = qw1_2 - wrk + cthl2 = wrk*cqt2*cpolv*beta2*pkap + wrk1 = cthl2 * cthl2 + wrk2 = cqt2 * cqt2 +! std_s2 = sqrt(max(zero,wrk1*thl2_2+wrk2*qw2_2-2.*cthl2*sqrtthl2_2*cqt2*sqrtqw2_2*r_qwthl_1)) + std_s2 = sqrt(max(zero, wrk1*thl2_2+wrk2*qw2_2 & + - two*cthl2*sqrtthl2_2*cqt2*sqrtqw2_2*r_qwthl_1)) + + qn2 = zero + C2 = zero + + IF (std_s2 > zero) THEN + wrk = s2 / (std_s2*sqrt2) + C2 = max(zero, min(one, half*(one+erf(wrk)))) + IF (C2 > zero) qn2 = s2*C2 + (std_s2*sqrtpii)*exp(-wrk*wrk) + ELSEIF (s2 >= qcmin) THEN + C2 = one + qn2 = s2 + ENDIF - om1 = max(zero, min(one, (Tl1_1-tbgmin)*a_bg)) - om2 = max(zero, min(one, (Tl1_2-tbgmin)*a_bg)) + ENDIF - qn1 = min(qn1,qw1_1) - qn2 = min(qn2,qw1_2) +! finally, compute the SGS cloud fraction + diag_frac = aterm*C1 + onema*C2 - ql1 = qn1*om1 - ql2 = qn2*om2 + om1 = max(zero, min(one, (Tl1_1-tbgmin)*a_bg)) + om2 = max(zero, min(one, (Tl1_2-tbgmin)*a_bg)) - qi1 = qn1 - ql1 - qi2 = qn2 - ql2 + qn1 = min(qn1,qw1_1) + qn2 = min(qn2,qw1_2) -! if (lprnt .and. i == ipr .and. k<40) write(0,*)' in shoc qi=',qi1,qi2,' ql=',ql1,ql2,& -! ' c1=',c1,' c2=',c2,' s1=',s1,' s2=',s2,' k=',k,' tl1=',tl1_1,tl1_2,' om1=',om1,'om2=',om2& -! ,' tbgmin=',tbgmin,'a_bg=',a_bg + ql1 = qn1*om1 + ql2 = qn2*om2 + qi1 = qn1 - ql1 + qi2 = qn2 - ql2 - diag_qn = min(max(zero, aterm*qn1 + onema*qn2), total_water(i,j,k)) - diag_ql = min(max(zero, aterm*ql1 + onema*ql2), diag_qn) - diag_qi = diag_qn - diag_ql + diag_qn = min(max(zero, aterm*qn1 + onema*qn2), total_water(i,k)) + diag_ql = min(max(zero, aterm*ql1 + onema*ql2), diag_qn) + diag_qi = diag_qn - diag_ql ! Update temperature variable based on diagnosed cloud properties - om1 = max(zero, min(one, (tabs(i,j,k)-tbgmin)*a_bg)) - lstarn1 = lcond + (one-om1)*lfus - tabs(i,j,k) = hl(i,j,k) - gamaz(i,j,k) + fac_cond*(diag_ql+qpl(i,j,k)) & - + fac_sub *(diag_qi+qpi(i,j,k)) & - + tkesbdiss(i,j,k) * (dtn/cp) ! tke dissipative heating - -! if (lprnt .and. i == ipr .and. k < 40) write(0,*)' tabsout=',tabs(ipr,1,k),' k=',k& -! ,' hl=',hl(i,j,k),' gamaz=',gamaz(i,j,k),' diag_ql=',diag_ql,' qpl=',qpl(i,j,k)& -! ,' diag_qi=',diag_qi,' qpi=',qpi(i,j,k),' diag_qn =',diag_qn ,' aterm=',aterm,' onema=',onema& -! ,' qn1=',qn1 ,' qn2=',qn2,' ql1=',ql1,' ql2=',ql2 + om1 = max(zero, min(one, (tabs(i,k)-tbgmin)*a_bg)) + lstarn1 = lcond + (one-om1)*lfus + tabs(i,k) = hl(i,k) - gamaz(i,k) + fac_cond*(diag_ql+qpl(i,k)) & + + fac_sub *(diag_qi+qpi(i,k)) & + + tkesbdiss(i,k) * (dtn/cp) ! tke dissipative heating + ! Update moisture fields ! Update ncpl and ncpi Anning Cheng 03/11/2016 -! ncpl(i,j,k) = diag_ql/max(qc(i,j,k),1.e-10)*ncpl(i,j,k) -! The following commneted by Moorthi on April 26, 2017 to test blowing up -! ncpl(i,j,k) = (1.0-diag_ql/max(qc(i,j,k),1.e-10)) * ncpl(i,j,k) -! ncpi(i,j,k) = (1.0-diag_qi/max(qi(i,j,k),1.e-10)) * ncpi(i,j,k) - qc(i,j,k) = diag_ql - qi(i,j,k) = diag_qi - qwv(i,j,k) = total_water(i,j,k) - diag_qn - cld_sgs(i,j,k) = diag_frac +! ncpl(i,k) = diag_ql/max(qc(i,k),1.e-10)*ncpl(i,k) + qc(i,k) = diag_ql + qi(i,k) = diag_qi + qwv(i,k) = total_water(i,k) - diag_qn + cld_sgs(i,k) = diag_frac + +! Update ncpl and ncpi Moorthi 12/12/2018 + if (ntlnc > 0) then ! liquid and ice number concentrations predicted + if (ncpl(i,k) > nmin) then + ncpl(i,k) = diag_ql/max(qc(i,k),1.0d-10)*ncpl(i,k) + else + ncpl(i,k) = max(diag_ql/(fourb3*pi*RL_cub*997.0d0), nmin) + endif + if (ncpi(i,k) > nmin) then + ncpi(i,k) = diag_qi/max(qi(i,k),1.0d-10)*ncpi(i,k) + else + ncpi(i,k) = max(diag_qi/(fourb3*pi*RI_cub*500.0d0), nmin) + endif + endif ! Compute the liquid water flux - wqls = aterm * ((w1_1-w_first)*ql1) + onema * ((w1_2-w_first)*ql2) - wqis = aterm * ((w1_1-w_first)*qi1) + onema * ((w1_2-w_first)*qi2) + wqls = aterm * ((w1_1-w_first)*ql1) + onema * ((w1_2-w_first)*ql2) + wqis = aterm * ((w1_1-w_first)*qi1) + onema * ((w1_2-w_first)*qi2) ! Compute statistics for the fluxes so we don't have to save these variables - wqlsb(k) = wqlsb(k) + wqls - wqisb(k) = wqisb(k) + wqis + wqlsb(k) = wqlsb(k) + wqls + wqisb(k) = wqisb(k) + wqis ! diagnostic buoyancy flux. Includes effects from liquid water, ice ! condensate, liquid & ice precipitation -! wrk = epsv * basetemp - wrk = epsv * thv(i,j,k) +! wrk = epsv * basetemp + wrk = epsv * thv(i,k) - bastoeps = onebeps * thv(i,j,k) + bastoeps = onebeps * thv(i,k) - if (k < nzm) then - wthv_sec(i,j,k) = wthlsec + wrk*wqwsec & - + (fac_cond-bastoeps)*wqls & - + (fac_sub-bastoeps) *wqis & - + ((lstarn1/cp)-thv(i,j,k))*half*(wqp_sec(i,j,kd)+wqp_sec(i,j,ku)) - else - wthv_sec(i,j,k) = wthlsec + wrk*wqwsec & - + (fac_cond-bastoeps)*wqls & - + (fac_sub-bastoeps) *wqis & - + ((lstarn1/cp)-thv(i,j,k))*half*wqp_sec(i,j,k) - endif + if (k < nzm) then + wthv_sec(i,k) = wthlsec + wrk*wqwsec & + + (fac_cond-bastoeps)*wqls & + + (fac_sub-bastoeps) *wqis & + + ((lstarn1/cp)-thv(i,k))*half*(wqp_sec(i,kd)+wqp_sec(i,ku)) + else + wthv_sec(i,k) = wthlsec + wrk*wqwsec & + + (fac_cond-bastoeps)*wqls & + + (fac_sub-bastoeps) *wqis & + + ((lstarn1/cp)-thv(i,k))*half*wqp_sec(i,k) + endif -! wthv_sec(i,j,k) = wthlsec + wrk*wqwsec & -! + (fac_cond-bastoeps)*wqls & -! + (fac_sub-bastoeps)*wqis & -! + ((lstarn1/cp)-basetemp)*half*(wqp_sec(i,j,kd)+wqp_sec(i,j,ku)) +! wthv_sec(i,k) = wthlsec + wrk*wqwsec & +! + (fac_cond-bastoeps)*wqls & +! + (fac_sub-bastoeps)*wqis & +! + ((lstarn1/cp)-basetemp)*half*(wqp_sec(i,kd)+wqp_sec(i,ku)) - ENDDO ENDDO ENDDO diff --git a/physics/gcm_shoc.meta b/physics/gcm_shoc.meta new file mode 100644 index 000000000..07f014356 --- /dev/null +++ b/physics/gcm_shoc.meta @@ -0,0 +1,422 @@ +[ccpp-arg-table] + name = shoc_run + type = scheme +[ix] + standard_name = horizontal_dimension + long_name = horizontal dimension + units = count + dimensions = () + type = integer + intent = in + optional = F +[nx] + standard_name = horizontal_loop_extent + long_name = horizontal loop extent + units = count + dimensions = () + type = integer + intent = in + optional = F +[nzm] + standard_name = vertical_dimension + long_name = vertical layer dimension + units = count + dimensions = () + type = integer + intent = in + optional = F +[tcr] + standard_name = cloud_phase_transition_threshold_temperature + long_name = threshold temperature below which cloud starts to freeze + units = K + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[tcrf] + standard_name = cloud_phase_transition_denominator + long_name = denominator in cloud phase transition = 1/(tcr-tf) + units = K-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[con_cp] + standard_name = specific_heat_of_dry_air_at_constant_pressure + long_name = specific heat of dry air at constant pressure + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[con_g] + standard_name = gravitational_acceleration + long_name = gravitational acceleration + units = m s-2 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[con_hvap] + standard_name = latent_heat_of_vaporization_of_water_at_0C + long_name = latent heat of evaporation/sublimation + units = J kg-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[con_hfus] + standard_name = latent_heat_of_fusion_of_water_at_0C + long_name = latent heat of fusion + units = J kg-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[con_rv] + standard_name = gas_constant_water_vapor + long_name = ideal gas constant for water vapor + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[con_rd] + standard_name = gas_constant_dry_air + long_name = ideal gas constant for dry air + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[con_pi] + standard_name = pi + long_name = ratio of a circle's circumference to its diameter + units = radians + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[con_fvirt] + standard_name = ratio_of_vapor_to_dry_air_gas_constants_minus_one + long_name = (rv/rd) - 1 (rv = ideal gas constant for water vapor) + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[dtp] + standard_name = time_step_for_physics + long_name = time step for physics + units = s + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[prsl] + standard_name = air_pressure + long_name = mean layer pressure + units = Pa + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[delp] + standard_name = air_pressure_difference_between_midlayers + long_name = pres(k) - pres(k+1) + units = Pa + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[phii] + standard_name = geopotential_at_interface + long_name = geopotential at model layer interfaces + units = m2 s-2 + dimensions = (horizontal_dimension,vertical_dimension_plus_one) + type = real + kind = kind_phys + intent = in + optional = F +[phil] + standard_name = geopotential + long_name = geopotential at model layer centers + units = m2 s-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[u] + standard_name = x_wind_updated_by_physics + long_name = zonal wind updated by physics + units = m s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[v] + standard_name = y_wind_updated_by_physics + long_name = meridional wind updated by physics + units = m s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[omega] + standard_name = omega + long_name = layer mean vertical velocity + units = Pa s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[rhc] + standard_name = critical_relative_humidity + long_name = critical relative humidity + units = frac + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[supice] + standard_name = ice_supersaturation_threshold + long_name = ice supersaturation parameter for PDF clouds + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[pcrit] + standard_name = shoc_tke_dissipatation_pressure_threshold + long_name = pressure below which extra TKE diss. is applied in SHOC + units = Pa + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[cefac] + standard_name = shoc_tke_dissipation_tunable_parameter + long_name = mult. tuning parameter for TKE diss. in SHOC + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[cesfac] + standard_name = shoc_tke_dissipation_tunable_parameter_near_surface + long_name = mult. tuning parameter for TKE diss. at surface in SHOC + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[tkef1] + standard_name = shoc_implicit_TKE_integration_uncentering_term + long_name = uncentering term for TKE integration in SHOC + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[dis_opt] + standard_name = shoc_flag_for_optional_surface_TKE_dissipation + long_name = flag for alt. TKE diss. near surface in SHOC (>0 = ON) + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[hflx] + standard_name = kinematic_surface_upward_sensible_heat_flux + long_name = kinematic surface upward sensible heat flux + units = K m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[evap] + standard_name = kinematic_surface_upward_latent_heat_flux + long_name = kinematic surface upward latent heat flux + units = kg kg-1 m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[prnum] + standard_name = prandtl_number + long_name = turbulent Prandtl number + units = none + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[gt0] + standard_name = air_temperature_updated_by_physics + long_name = temperature updated by physics + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[gq0] + standard_name = tracer_concentration_updated_by_physics + long_name = tracer concentration updated by physics + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension,number_of_tracers) + type = real + kind = kind_phys + intent = inout + optional = F +[ntrac] + standard_name = number_of_tracers + long_name = number of tracers + units = count + dimensions = () + type = integer + intent = in + optional = F +[ntqv] + standard_name = index_for_water_vapor + long_name = tracer index for water vapor (specific humidity) + units = index + dimensions = () + type = integer + intent = in + optional = F +[ntcw] + standard_name = index_for_liquid_cloud_condensate + long_name = tracer index for cloud condensate (or liquid water) + units = index + dimensions = () + type = integer + intent = in + optional = F +[ntiw] + standard_name = index_for_ice_cloud_condensate + long_name = tracer index for ice water + units = index + dimensions = () + type = integer + intent = in + optional = F +[ntrw] + standard_name = index_for_rain_water + long_name = tracer index for rain water + units = index + dimensions = () + type = integer + intent = in + optional = F +[ntsw] + standard_name = index_for_snow_water + long_name = tracer index for snow water + units = index + dimensions = () + type = integer + intent = in + optional = F +[ntgl] + standard_name = index_for_graupel + long_name = tracer index for graupel + units = index + dimensions = () + type = integer + intent = in + optional = F +[ntlnc] + standard_name = index_for_liquid_cloud_number_concentration + long_name = tracer index for liquid number concentration + units = index + dimensions = () + type = integer + intent = in + optional = F +[ntinc] + standard_name = index_for_ice_cloud_number_concentration + long_name = tracer index for ice number concentration + units = index + dimensions = () + type = integer + intent = in + optional = F +[cld_sgs] + standard_name = subgrid_scale_cloud_fraction_from_shoc + long_name = subgrid-scale cloud fraction from the SHOC scheme + units = frac + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[tke] + standard_name = turbulent_kinetic_energy_convective_transport_tracer + long_name = turbulent kinetic energy in the convectively transported tracer array + units = m2 s-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[tkh] + standard_name = atmosphere_heat_diffusivity_from_shoc + long_name = diffusivity for heat from the SHOC scheme + units = m2 s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[wthv_sec] + standard_name = kinematic_buoyancy_flux_from_shoc + long_name = upward kinematic buoyancy flux from the SHOC scheme + units = K m s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F diff --git a/physics/gcycle.F90 b/physics/gcycle.F90 index 4fc1bfa04..bb1730fc2 100644 --- a/physics/gcycle.F90 +++ b/physics/gcycle.F90 @@ -1,11 +1,11 @@ !>\file gcycle.F90 -!! This file repopulates specific time-varying sfc properties for -!! AMIP/forecast runs +!! This file repopulates specific time-varying surface properties for +!! atmospheric forecast runs. +!>\ingroup mod_GFS_phys_time_vary +!! This subroutine repopulates specific time-varying surface properties for +!! atmospheric forecast runs. # 1 "physics/gcycle.F90" -!>\ingroup Noah_LSM -!! This subroutine repopulates specific time-varying sfc properties for -!! AMIP/forecast runs. SUBROUTINE GCYCLE (nblks, Model, Grid, Sfcprop, Cldprop) ! ! @@ -41,7 +41,7 @@ SUBROUTINE GCYCLE (nblks, Model, Grid, Sfcprop, Cldprop) TG3FCS (Model%nx*Model%ny), & CNPFCS (Model%nx*Model%ny), & AISFCS (Model%nx*Model%ny), & -! F10MFCS(Model%nx*Model%ny), & +! F10MFCS(Model%nx*Model%ny), & VEGFCS (Model%nx*Model%ny), & VETFCS (Model%nx*Model%ny), & SOTFCS (Model%nx*Model%ny), & @@ -64,7 +64,7 @@ SUBROUTINE GCYCLE (nblks, Model, Grid, Sfcprop, Cldprop) character(len=6) :: tile_num_ch real(kind=kind_phys), parameter :: pifac=180.0/pi - real(kind=kind_phys) :: sig1t + real(kind=kind_phys) :: sig1t, dt_warm integer :: npts, len, nb, ix, jx, ls, ios logical :: exists ! @@ -110,7 +110,7 @@ SUBROUTINE GCYCLE (nblks, Model, Grid, Sfcprop, Cldprop) ZORFCS (len) = Sfcprop(nb)%zorl (ix) TG3FCS (len) = Sfcprop(nb)%tg3 (ix) CNPFCS (len) = Sfcprop(nb)%canopy (ix) -! F10MFCS (len) = Sfcprop(nb)%f10m (ix) +! F10MFCS (len) = Sfcprop(nb)%f10m (ix) VEGFCS (len) = Sfcprop(nb)%vfrac (ix) VETFCS (len) = Sfcprop(nb)%vtype (ix) SOTFCS (len) = Sfcprop(nb)%stype (ix) @@ -191,21 +191,28 @@ SUBROUTINE GCYCLE (nblks, Model, Grid, Sfcprop, Cldprop) close (Model%nlunit) #endif - len = 0 + len = 0 do nb = 1,nblks do ix = 1,size(Grid(nb)%xlat,1) len = len + 1 Sfcprop(nb)%slmsk (ix) = SLIFCS (len) if ( Model%nstf_name(1) > 0 ) then Sfcprop(nb)%tref(ix) = TSFFCS (len) +! if ( Model%nstf_name(2) == 0 ) then +! dt_warm = (Sfcprop(nb)%xt(ix) + Sfcprop(nb)%xt(ix) ) & +! / Sfcprop(nb)%xz(ix) +! Sfcprop(nb)%tsfco(ix) = Sfcprop(nb)%tref(ix) & +! + dt_warm - Sfcprop(nb)%dt_cool(ix) +! endif else - Sfcprop(nb)%tsfc(ix) = TSFFCS (len) + Sfcprop(nb)%tsfc(ix) = TSFFCS (len) + Sfcprop(nb)%tsfco(ix) = TSFFCS (len) endif Sfcprop(nb)%weasd (ix) = SNOFCS (len) Sfcprop(nb)%zorl (ix) = ZORFCS (len) Sfcprop(nb)%tg3 (ix) = TG3FCS (len) Sfcprop(nb)%canopy (ix) = CNPFCS (len) -! Sfcprop(nb)%f10m (ix) = F10MFCS (len) +! Sfcprop(nb)%f10m (ix) = F10MFCS (len) Sfcprop(nb)%vfrac (ix) = VEGFCS (len) Sfcprop(nb)%vtype (ix) = VETFCS (len) Sfcprop(nb)%stype (ix) = SOTFCS (len) @@ -240,6 +247,6 @@ SUBROUTINE GCYCLE (nblks, Model, Grid, Sfcprop, Cldprop) ! call mymaxmin(slifcs,len,len,1,'slifcs') ! ! if (Model%me .eq. 0) print*,'executed gcycle during hour=',fhour - + RETURN END diff --git a/physics/get_prs_fv3.F90 b/physics/get_prs_fv3.F90 index 25074908d..dd5871896 100644 --- a/physics/get_prs_fv3.F90 +++ b/physics/get_prs_fv3.F90 @@ -20,18 +20,7 @@ end subroutine get_prs_fv3_init !! \section arg_table_get_prs_fv3_run Argument Table -!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | -!! |----------------|-----------------------------------------------------------------------------------|-------------------------------------------------------------------------------------|------------|------|-----------|-----------|--------|----------| -!! | ix | horizontal_dimension | horizontal dimension | count | 0 | integer | | in | F | -!! | levs | vertical_dimension | number of vertical layers | count | 0 | integer | | in | F | -!! | phii | geopotential_at_interface | interface geopotential | m2 s-2 | 2 | real | kind_phys | in | F | -!! | prsi | air_pressure_at_interface | interface pressure | Pa | 2 | real | kind_phys | in | F | -!! | tgrs | air_temperature | mid-layer temperature | K | 2 | real | kind_phys | in | F | -!! | qgrs1 | water_vapor_specific_humidity | mid-layer specific humidity of water vapor | kg kg-1 | 2 | real | kind_phys | in | F | -!! | del | air_pressure_difference_between_midlayers | difference between mid-layer pressures | Pa | 2 | real | kind_phys | out | F | -!! | del_gz | geopotential_difference_between_midlayers_divided_by_midlayer_virtual_temperature | difference between mid-layer geopotentials divided by mid-layer virtual temperature | m2 s-2 K-1 | 2 | real | kind_phys | out | F | -!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | -!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | +!! \htmlinclude get_prs_fv3_run.html !! subroutine get_prs_fv3_run(ix, levs, phii, prsi, tgrs, qgrs1, del, del_gz, errmsg, errflg) @@ -99,17 +88,7 @@ end subroutine get_phi_fv3_init !! \section arg_table_get_phi_fv3_run Argument Table -!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | -!! |----------------|-----------------------------------------------------------------------------------|-------------------------------------------------------------------------------------|------------|------|-----------|-----------|--------|----------| -!! | ix | horizontal_dimension | horizontal dimension | count | 0 | integer | | in | F | -!! | levs | vertical_dimension | number of vertical layers | count | 0 | integer | | in | F | -!! | gt0 | air_temperature_updated_by_physics | updated air temperature | K | 2 | real | kind_phys | in | F | -!! | gq01 | water_vapor_specific_humidity_updated_by_physics | mid-layer specific humidity of water vapor | kg kg-1 | 2 | real | kind_phys | in | F | -!! | del_gz | geopotential_difference_between_midlayers_divided_by_midlayer_virtual_temperature | difference between mid-layer geopotentials divided by mid-layer virtual temperature | m2 s-2 K-1 | 2 | real | kind_phys | inout | F | -!! | phii | geopotential_at_interface | interface geopotential | m2 s-2 | 2 | real | kind_phys | out | F | -!! | phil | geopotential | mid-layer geopotential | m2 s-2 | 2 | real | kind_phys | out | F | -!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | -!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | +!! \htmlinclude get_phi_fv3_run.html !! subroutine get_phi_fv3_run(ix, levs, gt0, gq01, del_gz, phii, phil, errmsg, errflg) diff --git a/physics/get_prs_fv3.meta b/physics/get_prs_fv3.meta new file mode 100644 index 000000000..f93d259e1 --- /dev/null +++ b/physics/get_prs_fv3.meta @@ -0,0 +1,193 @@ +[ccpp-arg-table] + name = get_prs_fv3_init + type = scheme + +######################################################################## +[ccpp-arg-table] + name = get_prs_fv3_run + type = scheme +[ix] + standard_name = horizontal_dimension + long_name = horizontal dimension + units = count + dimensions = () + type = integer + intent = in + optional = F +[levs] + standard_name = vertical_dimension + long_name = number of vertical layers + units = count + dimensions = () + type = integer + intent = in + optional = F +[phii] + standard_name = geopotential_at_interface + long_name = interface geopotential + units = m2 s-2 + dimensions = (horizontal_dimension,vertical_dimension_plus_one) + type = real + kind = kind_phys + intent = in + optional = F +[prsi] + standard_name = air_pressure_at_interface + long_name = interface pressure + units = Pa + dimensions = (horizontal_dimension,vertical_dimension_plus_one) + type = real + kind = kind_phys + intent = in + optional = F +[tgrs] + standard_name = air_temperature + long_name = mid-layer temperature + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[qgrs1] + standard_name = water_vapor_specific_humidity + long_name = mid-layer specific humidity of water vapor + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[del] + standard_name = air_pressure_difference_between_midlayers + long_name = difference between mid-layer pressures + units = Pa + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[del_gz] + standard_name = geopotential_difference_between_midlayers_divided_by_midlayer_virtual_temperature + long_name = difference between mid-layer geopotentials divided by mid-layer virtual temperature + units = m2 s-2 K-1 + dimensions = (horizontal_dimension,vertical_dimension_plus_one) + type = real + kind = kind_phys + intent = out + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F + +######################################################################## +[ccpp-arg-table] + name = get_prs_fv3_finalize + type = scheme + +######################################################################## +[ccpp-arg-table] + name = get_phi_fv3_init + type = scheme + +######################################################################## +[ccpp-arg-table] + name = get_phi_fv3_run + type = scheme +[ix] + standard_name = horizontal_dimension + long_name = horizontal dimension + units = count + dimensions = () + type = integer + intent = in + optional = F +[levs] + standard_name = vertical_dimension + long_name = number of vertical layers + units = count + dimensions = () + type = integer + intent = in + optional = F +[gt0] + standard_name = air_temperature_updated_by_physics + long_name = updated air temperature + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[gq01] + standard_name = water_vapor_specific_humidity_updated_by_physics + long_name = mid-layer specific humidity of water vapor + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[del_gz] + standard_name = geopotential_difference_between_midlayers_divided_by_midlayer_virtual_temperature + long_name = difference between mid-layer geopotentials divided by mid-layer virtual temperature + units = m2 s-2 K-1 + dimensions = (horizontal_dimension,vertical_dimension_plus_one) + type = real + kind = kind_phys + intent = inout + optional = F +[phii] + standard_name = geopotential_at_interface + long_name = interface geopotential + units = m2 s-2 + dimensions = (horizontal_dimension,vertical_dimension_plus_one) + type = real + kind = kind_phys + intent = out + optional = F +[phil] + standard_name = geopotential + long_name = mid-layer geopotential + units = m2 s-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F + +######################################################################## +[ccpp-arg-table] + name = get_phi_fv3_finalize + type = scheme diff --git a/physics/gfdl_cloud_microphys.F90 b/physics/gfdl_cloud_microphys.F90 index 3fd83210f..1ccedb956 100644 --- a/physics/gfdl_cloud_microphys.F90 +++ b/physics/gfdl_cloud_microphys.F90 @@ -26,19 +26,7 @@ module gfdl_cloud_microphys !! cloud microphysics. !! !> \section arg_table_gfdl_cloud_microphys_init Argument Table -!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | -!! |------------------|--------------------------------------------------|----------------------------------------------------|--------|------|-----------|-------|--------|----------| -!! | me | mpi_rank | MPI rank of current process | index | 0 | integer | | in | F | -!! | master | mpi_root | MPI rank of master process | index | 0 | integer | | in | F | -!! | nlunit | iounit_namelist | fortran unit number for opening nameliust file | none | 0 | integer | | in | F | -!! | input_nml_file | namelist_filename_for_internal_file_reads | character string to store full namelist contents | none | 1 | character | len=* | in | F | -!! | logunit | iounit_log | fortran unit number for writing logfile | none | 0 | integer | | in | F | -!! | fn_nml | namelist_filename | namelist filename | none | 0 | character | len=* | in | F | -!! | imp_physics | flag_for_microphysics_scheme | choice of microphysics scheme | flag | 0 | integer | | in | F | -!! | imp_physics_gfdl | flag_for_gfdl_microphysics_scheme | choice of GFDL microphysics scheme | flag | 0 | integer | | in | F | -!! | do_shoc | flag_for_shoc | flag to indicate use of SHOC | flag | 0 | logical | | in | F | -!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | -!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | +!! \htmlinclude gfdl_cloud_microphys_init.html !! subroutine gfdl_cloud_microphys_init (me, master, nlunit, input_nml_file, logunit, fn_nml, & imp_physics, imp_physics_gfdl, do_shoc, errmsg, errflg) @@ -86,10 +74,7 @@ end subroutine gfdl_cloud_microphys_init !! cloud microphysics. !! !! \section arg_table_gfdl_cloud_microphys_finalize Argument Table -!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | -!! |-------------|--------------------|---------------------------------------------|---------|------|-----------|--------|--------|----------| -!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | -!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | +!! \htmlinclude gfdl_cloud_microphys_finalize.html !! subroutine gfdl_cloud_microphys_finalize(errmsg, errflg) @@ -125,58 +110,15 @@ end subroutine gfdl_cloud_microphys_finalize !! !>\brief The subroutine executes the full GFDL cloud microphysics. !! \section arg_table_gfdl_cloud_microphys_run Argument Table -!! | local_name | standard_name | long_name | units | rank | type | kind | intent| optional | -!! |------------------|------------------------------------------------------------------|-----------------------------------------------------------------------|------------|------|-----------|-----------|-------|----------| -!! | levs | vertical_dimension | number of vertical levels | count | 0 | integer | | in | F | -!! | im | horizontal_loop_extent | horizontal loop extent | count | 0 | integer | | in | F | -!! | con_g | gravitational_acceleration | gravitational acceleration | m s-2 | 0 | real | kind_phys | in | F | -!! | con_fvirt | ratio_of_vapor_to_dry_air_gas_constants_minus_one | rv/rd - 1 (rv = ideal gas constant for water vapor) | none | 0 | real | kind_phys | in | F | -!! | con_rd | gas_constant_dry_air | ideal gas constant for dry air | J kg-1 K-1 | 0 | real | kind_phys | in | F | -!! | frland | land_area_fraction_for_microphysics | land area fraction used in microphysics schemes | frac | 1 | real | kind_phys | in | F | -!! | garea | cell_area | area of grid cell | m2 | 1 | real | kind_phys | in | F | -!! | gq0 | water_vapor_specific_humidity_updated_by_physics | water vapor specific humidity updated by physics | kg kg-1 | 2 | real | kind_phys | inout | F | -!! | gq0_ntcw | cloud_condensed_water_mixing_ratio_updated_by_physics | cloud condensed water mixing ratio updated by physics | kg kg-1 | 2 | real | kind_phys | inout | F | -!! | gq0_ntrw | rain_water_mixing_ratio_updated_by_physics | moist mixing ratio of rain updated by physics | kg kg-1 | 2 | real | kind_phys | inout | F | -!! | gq0_ntiw | ice_water_mixing_ratio_updated_by_physics | moist mixing ratio of cloud ice updated by physics | kg kg-1 | 2 | real | kind_phys | inout | F | -!! | gq0_ntsw | snow_water_mixing_ratio_updated_by_physics | moist mixing ratio of snow updated by physics | kg kg-1 | 2 | real | kind_phys | inout | F | -!! | gq0_ntgl | graupel_mixing_ratio_updated_by_physics | moist mixing ratio of graupel updated by physics | kg kg-1 | 2 | real | kind_phys | inout | F | -!! | gq0_ntclamt | cloud_fraction_updated_by_physics | cloud fraction updated by physics | frac | 2 | real | kind_phys | inout | F | -!! | gt0 | air_temperature_updated_by_physics | air temperature updated by physics | K | 2 | real | kind_phys | inout | F | -!! | gu0 | x_wind_updated_by_physics | zonal wind updated by physics | m s-1 | 2 | real | kind_phys | inout | F | -!! | gv0 | y_wind_updated_by_physics | meridional wind updated by physics | m s-1 | 2 | real | kind_phys | inout | F | -!! | vvl | omega | layer mean vertical velocity | Pa s-1 | 2 | real | kind_phys | in | F | -!! | prsl | air_pressure | mean layer pressure | Pa | 2 | real | kind_phys | in | F | -!! | phii | geopotential_at_interface | geopotential at model layer interfaces | m2 s-2 | 2 | real | kind_phys | in | F | -!! | del | air_pressure_difference_between_midlayers | air pressure difference between mid-layers | Pa | 2 | real | kind_phys | in | F | -!! | rain0 | lwe_thickness_of_explicit_rain_amount | explicit rain on physics timestep | m | 1 | real | kind_phys | out | F | -!! | ice0 | lwe_thickness_of_ice_amount | ice fall on physics timestep | m | 1 | real | kind_phys | out | F | -!! | snow0 | lwe_thickness_of_snow_amount | snow fall on physics timestep | m | 1 | real | kind_phys | out | F | -!! | graupel0 | lwe_thickness_of_graupel_amount | graupel fall on physics timestep | m | 1 | real | kind_phys | out | F | -!! | prcp0 | lwe_thickness_of_explicit_precipitation_amount | explicit precipitation (rain, ice, snow, graupel) on physics timestep | m | 1 | real | kind_phys | out | F | -!! | sr | ratio_of_snowfall_to_rainfall | snow ratio: ratio of snow to total precipitation | frac | 1 | real | kind_phys | out | F | -!! | dtp | time_step_for_physics | physics timestep | s | 0 | real | kind_phys | in | F | -!! | hydrostatic | flag_for_hydrostatic_solver | flag indicating hydrostatic solver | flag | 0 | logical | | in | F | -!! | phys_hydrostatic | flag_for_hydrostatic_heating_from_physics | flag indicating hydrostatic heating from physics | flag | 0 | logical | | in | F | -!! | lradar | flag_for_radar_reflectivity | flag for radar reflectivity | flag | 0 | logical | | in | F | -!! | refl_10cm | radar_reflectivity_10cm | instantaneous refl_10cm | dBZ | 2 | real | kind_phys | inout | F | -!! | kdt | index_of_time_step | current forecast iteration | index | 0 | integer | | in | F | -!! | nsteps_per_reset | number_of_time_steps_per_maximum_hourly_time_interval | number_of_time_steps_per_maximum_hourly_time_interval | count | 0 | integer | | in | F | -!! | effr_in | flag_for_cloud_effective_radii | flag for cloud effective radii calculations in microphysics | | 0 | logical | | in | F | -!! | rew | effective_radius_of_stratiform_cloud_liquid_water_particle_in_um | eff. radius of cloud liquid water particle in micrometer | um | 2 | real | kind_phys | inout | F | -!! | rei | effective_radius_of_stratiform_cloud_ice_particle_in_um | eff. radius of cloud ice water particle in micrometer | um | 2 | real | kind_phys | inout | F | -!! | rer | effective_radius_of_stratiform_cloud_rain_particle_in_um | effective radius of cloud rain particle in micrometers | um | 2 | real | kind_phys | inout | F | -!! | res | effective_radius_of_stratiform_cloud_snow_particle_in_um | effective radius of cloud snow particle in micrometers | um | 2 | real | kind_phys | inout | F | -!! | reg | effective_radius_of_stratiform_cloud_graupel_particle_in_um | eff. radius of cloud graupel particle in micrometer | um | 2 | real | kind_phys | inout | F | -!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | -!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | +!! \htmlinclude gfdl_cloud_microphys_run.html !! subroutine gfdl_cloud_microphys_run( & - levs, im, con_g, con_fvirt, con_rd, frland, garea, & + levs, im, con_g, con_fvirt, con_rd, frland, garea, islmsk, & gq0, gq0_ntcw, gq0_ntrw, gq0_ntiw, gq0_ntsw, gq0_ntgl, gq0_ntclamt, & gt0, gu0, gv0, vvl, prsl, phii, del, & rain0, ice0, snow0, graupel0, prcp0, sr, & dtp, hydrostatic, phys_hydrostatic, lradar, refl_10cm, & - kdt, nsteps_per_reset, effr_in, rew, rei, rer, res, reg, errmsg, errflg) + reset, effr_in, rew, rei, rer, res, reg, errmsg, errflg) use machine, only: kind_phys @@ -187,17 +129,14 @@ subroutine gfdl_cloud_microphys_run( & real(kind=kind_phys), parameter :: one = 1.0d0 real(kind=kind_phys), parameter :: con_p001= 0.001d0 real(kind=kind_phys), parameter :: con_day = 86400.d0 -#ifdef TRANSITION real(kind=kind_phys), parameter :: rainmin = 1.0d-13 -#else - real(kind=kind_phys), parameter :: rainmin = 1.0e-13 -#endif ! *DH ! interface variables integer, intent(in ) :: levs, im real(kind=kind_phys), intent(in ) :: con_g, con_fvirt, con_rd real(kind=kind_phys), intent(in ), dimension(1:im) :: frland, garea + integer, intent(in ), dimension(1:im) :: islmsk real(kind=kind_phys), intent(inout), dimension(1:im,1:levs) :: gq0, gq0_ntcw, gq0_ntrw, gq0_ntiw, & gq0_ntsw, gq0_ntgl, gq0_ntclamt real(kind=kind_phys), intent(inout), dimension(1:im,1:levs) :: gt0, gu0, gv0 @@ -217,8 +156,7 @@ subroutine gfdl_cloud_microphys_run( & logical, intent (in) :: lradar real(kind=kind_phys), intent(inout), dimension(1:im,1:levs) :: refl_10cm - integer, intent (in) :: kdt, nsteps_per_reset - logical, intent (in) :: effr_in + logical, intent (in) :: reset, effr_in real(kind=kind_phys), intent(inout), dimension(1:im,1:levs) :: rew, rei, rer, res, reg character(len=*), intent(out) :: errmsg @@ -233,10 +171,6 @@ subroutine gfdl_cloud_microphys_run( & real(kind=kind_phys), dimension(:,:), allocatable :: den real(kind=kind_phys) :: onebg real(kind=kind_phys) :: tem -#ifdef TRANSITION - real(kind=kind_phys), volatile :: volatile_var1, volatile_var2 -#endif - ! Initialize CCPP error handling variables errmsg = '' @@ -298,7 +232,7 @@ subroutine gfdl_cloud_microphys_run( & qv1, ql1, qr1, qi1, qs1, qg1, qa1, qn1, qv_dt, ql_dt, qr_dt, qi_dt, & qs_dt, qg_dt, qa_dt, pt_dt, pt, w, uin, vin, u_dt, v_dt, dz, delp, & garea, dtp, frland, rain0, snow0, ice0, graupel0, hydrostatic, & - phys_hydrostatic, p123, lradar, refl, kdt, nsteps_per_reset) + phys_hydrostatic, p123, lradar, refl, reset) tem = dtp*con_p001/con_day ! fix negative values @@ -324,18 +258,10 @@ subroutine gfdl_cloud_microphys_run( & ! calculate fraction of frozen precipitation using unscaled ! values of rain0, ice0, snow0, graupel0 (for bit-for-bit) do i=1,im -#ifdef TRANSITION - volatile_var1 = rain0(i)+snow0(i)+ice0(i)+graupel0(i) - volatile_var2 = snow0(i)+ice0(i)+graupel0(i) - prcp0(i) = volatile_var1 * tem - if ( volatile_var1 * tem > rainmin ) then - sr(i) = volatile_var2 / volatile_var1 -#else prcp0(i) = (rain0(i)+snow0(i)+ice0(i)+graupel0(i)) * tem if ( prcp0(i) > rainmin ) then sr(i) = (snow0(i) + ice0(i) + graupel0(i)) & / (rain0(i) + snow0(i) + ice0(i) + graupel0(i)) -#endif else sr(i) = 0.0 endif @@ -373,9 +299,11 @@ subroutine gfdl_cloud_microphys_run( & enddo enddo call cloud_diagnosis (1, im, 1, levs, den(1:im,1:levs), & + del(1:im,1:levs), islmsk(1:im), & gq0_ntcw(1:im,1:levs), gq0_ntiw(1:im,1:levs), & - gq0_ntrw(1:im,1:levs), gq0_ntsw(1:im,1:levs), & - gq0_ntgl(1:im,1:levs), gt0(1:im,1:levs), & + gq0_ntrw(1:im,1:levs), & + gq0_ntsw(1:im,1:levs) + gq0_ntgl(1:im,1:levs), & + gq0_ntgl(1:im,1:levs)*0.0, gt0(1:im,1:levs), & rew(1:im,1:levs), rei(1:im,1:levs), rer(1:im,1:levs),& res(1:im,1:levs), reg(1:im,1:levs)) deallocate(den) diff --git a/physics/gfdl_cloud_microphys.meta b/physics/gfdl_cloud_microphys.meta new file mode 100644 index 000000000..3d202722b --- /dev/null +++ b/physics/gfdl_cloud_microphys.meta @@ -0,0 +1,490 @@ +[ccpp-arg-table] + name = gfdl_cloud_microphys_init + type = scheme +[me] + standard_name = mpi_rank + long_name = MPI rank of current process + units = index + dimensions = () + type = integer + intent = in + optional = F +[master] + standard_name = mpi_root + long_name = MPI rank of master process + units = index + dimensions = () + type = integer + intent = in + optional = F +[nlunit] + standard_name = iounit_namelist + long_name = fortran unit number for opening nameliust file + units = none + dimensions = () + type = integer + intent = in + optional = F +[input_nml_file] + standard_name = namelist_filename_for_internal_file_reads + long_name = character string to store full namelist contents + units = none + dimensions = (number_of_lines_of_namelist_filename_for_internal_file_reads) + type = character + kind = len=* + intent = in + optional = F +[logunit] + standard_name = iounit_log + long_name = fortran unit number for writing logfile + units = none + dimensions = () + type = integer + intent = in + optional = F +[fn_nml] + standard_name = namelist_filename + long_name = namelist filename + units = none + dimensions = () + type = character + kind = len=* + intent = in + optional = F +[imp_physics] + standard_name = flag_for_microphysics_scheme + long_name = choice of microphysics scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F +[imp_physics_gfdl] + standard_name = flag_for_gfdl_microphysics_scheme + long_name = choice of GFDL microphysics scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F +[do_shoc] + standard_name = flag_for_shoc + long_name = flag to indicate use of SHOC + units = flag + dimensions = () + type = logical + intent = in + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F + +######################################################################## +[ccpp-arg-table] + name = gfdl_cloud_microphys_finalize + type = scheme +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F + +######################################################################## +[ccpp-arg-table] + name = gfdl_cloud_microphys_run + type = scheme +[levs] + standard_name = vertical_dimension + long_name = number of vertical levels + units = count + dimensions = () + type = integer + intent = in + optional = F +[im] + standard_name = horizontal_loop_extent + long_name = horizontal loop extent + units = count + dimensions = () + type = integer + intent = in + optional = F +[con_g] + standard_name = gravitational_acceleration + long_name = gravitational acceleration + units = m s-2 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[con_fvirt] + standard_name = ratio_of_vapor_to_dry_air_gas_constants_minus_one + long_name = rv/rd - 1 (rv = ideal gas constant for water vapor) + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[con_rd] + standard_name = gas_constant_dry_air + long_name = ideal gas constant for dry air + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[frland] + standard_name = land_area_fraction_for_microphysics + long_name = land area fraction used in microphysics schemes + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[garea] + standard_name = cell_area + long_name = area of grid cell + units = m2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[islmsk] + standard_name = sea_land_ice_mask + long_name = sea/land/ice mask (=0/1/2) + units = flag + dimensions = (horizontal_dimension) + type = integer + intent = in + optional = F +[gq0] + standard_name = water_vapor_specific_humidity_updated_by_physics + long_name = water vapor specific humidity updated by physics + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[gq0_ntcw] + standard_name = cloud_condensed_water_mixing_ratio_updated_by_physics + long_name = cloud condensed water mixing ratio updated by physics + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[gq0_ntrw] + standard_name = rain_water_mixing_ratio_updated_by_physics + long_name = moist mixing ratio of rain updated by physics + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[gq0_ntiw] + standard_name = ice_water_mixing_ratio_updated_by_physics + long_name = moist mixing ratio of cloud ice updated by physics + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[gq0_ntsw] + standard_name = snow_water_mixing_ratio_updated_by_physics + long_name = moist mixing ratio of snow updated by physics + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[gq0_ntgl] + standard_name = graupel_mixing_ratio_updated_by_physics + long_name = moist ratio of mass of graupel to mass of dry air plus vapor (without condensates) updated by physics + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[gq0_ntclamt] + standard_name = cloud_fraction_updated_by_physics + long_name = cloud fraction updated by physics + units = frac + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[gt0] + standard_name = air_temperature_updated_by_physics + long_name = air temperature updated by physics + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[gu0] + standard_name = x_wind_updated_by_physics + long_name = zonal wind updated by physics + units = m s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[gv0] + standard_name = y_wind_updated_by_physics + long_name = meridional wind updated by physics + units = m s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[vvl] + standard_name = omega + long_name = layer mean vertical velocity + units = Pa s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[prsl] + standard_name = air_pressure + long_name = mean layer pressure + units = Pa + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[phii] + standard_name = geopotential_at_interface + long_name = geopotential at model layer interfaces + units = m2 s-2 + dimensions = (horizontal_dimension,vertical_dimension_plus_one) + type = real + kind = kind_phys + intent = in + optional = F +[del] + standard_name = air_pressure_difference_between_midlayers + long_name = air pressure difference between mid-layers + units = Pa + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[rain0] + standard_name = lwe_thickness_of_explicit_rain_amount + long_name = explicit rain on physics timestep + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[ice0] + standard_name = lwe_thickness_of_ice_amount + long_name = ice fall on physics timestep + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[snow0] + standard_name = lwe_thickness_of_snow_amount + long_name = snow fall on physics timestep + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[graupel0] + standard_name = lwe_thickness_of_graupel_amount + long_name = graupel fall on physics timestep + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[prcp0] + standard_name = lwe_thickness_of_explicit_precipitation_amount + long_name = explicit precipitation (rain, ice, snow, graupel) on physics timestep + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[sr] + standard_name = ratio_of_snowfall_to_rainfall + long_name = snow ratio: ratio of snow to total precipitation + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[dtp] + standard_name = time_step_for_physics + long_name = physics timestep + units = s + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[hydrostatic] + standard_name = flag_for_hydrostatic_solver + long_name = flag indicating hydrostatic solver + units = flag + dimensions = () + type = logical + intent = in + optional = F +[phys_hydrostatic] + standard_name = flag_for_hydrostatic_heating_from_physics + long_name = flag indicating hydrostatic heating from physics + units = flag + dimensions = () + type = logical + intent = in + optional = F +[lradar] + standard_name = flag_for_radar_reflectivity + long_name = flag for radar reflectivity + units = flag + dimensions = () + type = logical + intent = in + optional = F +[refl_10cm] + standard_name = radar_reflectivity_10cm + long_name = instantaneous refl_10cm + units = dBZ + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[reset] + standard_name = flag_reset_maximum_hourly_fields + long_name = flag for resetting maximum hourly fields + units = flag + dimensions = () + type = logical + intent = in + optional = F +[effr_in] + standard_name = flag_for_cloud_effective_radii + long_name = flag for cloud effective radii calculations in GFDL microphysics + units = + dimensions = () + type = logical + intent = in + optional = F +[rew] + standard_name = effective_radius_of_stratiform_cloud_liquid_water_particle_in_um + long_name = eff. radius of cloud liquid water particle in micrometer + units = um + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[rei] + standard_name = effective_radius_of_stratiform_cloud_ice_particle_in_um + long_name = eff. radius of cloud ice water particle in micrometer + units = um + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[rer] + standard_name = effective_radius_of_stratiform_cloud_rain_particle_in_um + long_name = effective radius of cloud rain particle in micrometers + units = um + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[res] + standard_name = effective_radius_of_stratiform_cloud_snow_particle_in_um + long_name = effective radius of cloud snow particle in micrometers + units = um + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[reg] + standard_name = effective_radius_of_stratiform_cloud_graupel_particle_in_um + long_name = eff. radius of cloud graupel particle in micrometer + units = um + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F diff --git a/physics/gfdl_fv_sat_adj.F90 b/physics/gfdl_fv_sat_adj.F90 index b4b273595..f5c84cd99 100644 --- a/physics/gfdl_fv_sat_adj.F90 +++ b/physics/gfdl_fv_sat_adj.F90 @@ -1,5 +1,5 @@ !>\file gfdl_fv_sat_adj.F90 -!! This file contains the fast saturation adjustment in the GFDL cloud microphysics. +!! This file contains the GFDL in-core fast saturation adjustment. !! and it is an "intermediate physics" implemented in the remapping Lagrangian to !! Eulerian loop of FV3 solver. !*********************************************************************** @@ -23,8 +23,8 @@ !* If not, see . !*********************************************************************** -!> This module is part of the GFDL Cloud MP and it is the CCPP-compliant -!! fast phyiscs called in FV3 dynamics solver. +!> This module contains the GFDL in-core fast saturation adjustment +!! called in FV3 dynamics solver. module fv_sat_adj ! Modules Included: ! @@ -49,11 +49,10 @@ module fv_sat_adj ! ! +! rad_rain, rad_snow, rad_graupel, dw_ocean, dw_land, tintqs ! !
gfdl_cloud_microphys_modql_gen, qi_gen, qi0_max, ql_mlt, ql0_max, qi_lim, qs_mlt, ! tau_r2g, tau_smlt, tau_i2s, tau_v2l, tau_l2v, tau_imlt, tau_l2r, -! rad_rain, rad_snow, rad_graupel, dw_ocean, dw_land
! DH* TODO - MAKE THIS INPUT ARGUMENTS *DH - !use constants_mod, only: rvgas, rdgas, grav, hlv, hlf, cp_air use physcons, only : rdgas => con_rd_dyn, & rvgas => con_rv_dyn, & grav => con_g_dyn, & @@ -65,8 +64,7 @@ module fv_sat_adj use gfdl_cloud_microphys_mod, only: ql_gen, qi_gen, qi0_max, ql_mlt, ql0_max, qi_lim, qs_mlt use gfdl_cloud_microphys_mod, only: icloud_f, sat_adj0, t_sub, cld_min use gfdl_cloud_microphys_mod, only: tau_r2g, tau_smlt, tau_i2s, tau_v2l, tau_l2v, tau_imlt, tau_l2r - use gfdl_cloud_microphys_mod, only: rad_rain, rad_snow, rad_graupel, dw_ocean, dw_land - + use gfdl_cloud_microphys_mod, only: rad_rain, rad_snow, rad_graupel, dw_ocean, dw_land, tintqs #ifdef MULTI_GASES use ccpp_multi_gases_mod, only: multi_gases_init, & multi_gases_finalize, & @@ -118,18 +116,7 @@ module fv_sat_adj !>\brief The subroutine 'fv_sat_adj_init' initializes lookup tables for the saturation mixing ratio. !! \section arg_table_fv_sat_adj_init Argument Table -!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | -!! |----------------|---------------------------------------------------------------|----------------------------------------------------------------------------------------|------------|------|-----------|-----------|--------|----------| -!! | do_sat_adj | flag_for_saturation_adjustment_for_microphysics_in_dynamics | flag for saturation adjustment for microphysics in dynamics | none | 0 | logical | | in | F | -!! | kmp | top_layer_index_for_fast_physics | top_layer_inder_for_gfdl_mp | index | 0 | integer | | in | F | -!! | nwat | number_of_water_species | number of water species | count | 0 | integer | | in | F | -!! | ngas | number_of_gases_for_multi_gases_physics | number of gases for multi gases physics | count | 0 | integer | | in | F | -!! | rilist | gas_constants_for_multi_gases_physics | gas constants for multi gases physics | J kg-1 K-1 | 1 | real | kind_dyn | in | F | -!! | cpilist | specific_heat_capacities_for_multi_gases_physics | specific heat capacities for multi gases physics | J kg-1 K-1 | 1 | real | kind_dyn | in | F | -!! | mpirank | mpi_rank_for_fast_physics | current MPI-rank for fast physics schemes | index | 0 | integer | | in | F | -!! | mpiroot | mpi_root_for_fast_physics | master MPI-rank for fast physics schemes | index | 0 | integer | | in | F | -!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | -!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | +!! \htmlinclude fv_sat_adj_init.html !! subroutine fv_sat_adj_init(do_sat_adj, kmp, nwat, ngas, rilist, cpilist, & mpirank, mpiroot, errmsg, errflg) @@ -195,10 +182,7 @@ end subroutine fv_sat_adj_init !\ingroup fast_sat_adj !>\brief The subroutine 'fv_sat_adj_finalize' deallocates lookup tables for the saturation mixing ratio. !! \section arg_table_fv_sat_adj_finalize Argument Table -!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | -!! |----------------|---------------------------------------------------------------|----------------------------------------------------------------------------------------|---------|------|-----------|-----------|--------|----------| -!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | -!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | +!! \htmlinclude fv_sat_adj_finalize.html !! subroutine fv_sat_adj_finalize (errmsg, errflg) @@ -227,7 +211,7 @@ subroutine fv_sat_adj_finalize (errmsg, errflg) end subroutine fv_sat_adj_finalize -!>\defgroup fast_sat_adj GFDL In-Core Fast Saturation Adjustment +!>\defgroup fast_sat_adj GFDL In-Core Fast Saturation Adjustment Module !> @{ !! The subroutine 'fv_sat_adj' implements the fast processes in the GFDL !! Cloud MP. It is part of the GFDL Cloud MP. @@ -238,52 +222,7 @@ end subroutine fv_sat_adj_finalize !! It handles the heat release due to in situ phase changes. !! !! \section arg_table_fv_sat_adj_run Argument Table -!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | -!! |----------------|---------------------------------------------------------------|----------------------------------------------------------------------------------------|-----------|------|-----------|-----------|--------|----------| -!! | mdt | time_step_for_remapping_for_fast_physics | remapping time step for fast physics | s | 0 | real | kind_dyn | in | F | -!! | zvir | ratio_of_vapor_to_dry_air_gas_constants_minus_one_default_kind| zvir=rv/rd-1.0 | none | 0 | real | kind_dyn | in | F | -!! | is | starting_x_direction_index | starting X direction index | count | 0 | integer | | in | F | -!! | ie | ending_x_direction_index | ending X direction index | count | 0 | integer | | in | F | -!! | isd | starting_x_direction_index_domain | starting X direction index for domain | count | 0 | integer | | in | F | -!! | ied | ending_x_direction_index_domain | ending X direction index for domain | count | 0 | integer | | in | F | -!! | kmp | top_layer_index_for_fast_physics | top layer index for GFDL mp | index | 0 | integer | | in | F | -!! | km | vertical_dimension_for_fast_physics | number of vertical levels | count | 0 | integer | | in | F | -!! | kmdelz | vertical_dimension_for_thickness_at_Lagrangian_surface | vertical dimension for thickness at Lagrangian surface | count | 0 | integer | | in | F | -!! | js | starting_y_direction_index | starting Y direction index | count | 0 | integer | | in | F | -!! | je | ending_y_direction_index | ending Y direction index | count | 0 | integer | | in | F | -!! | jsd | starting_y_direction_index_domain | starting X direction index for domain | count | 0 | integer | | in | F | -!! | jed | ending_y_direction_index_domain | ending X direction index for domain | count | 0 | integer | | in | F | -!! | ng | number_of_ghost_zones | number of ghost zones defined in fv_mp | count | 0 | integer | | in | F | -!! | hydrostatic | flag_for_hydrostatic_solver_for_fast_physics | flag for use the hydrostatic or nonhydrostatic solver | flag | 0 | logical | | in | F | -!! | fast_mp_consv | flag_for_fast_microphysics_energy_conservation | flag for fast microphysics energy conservation | flag | 0 | logical | | in | F | -!! | te0_2d | atmosphere_energy_content_in_column | atmosphere total energy in columns | J m-2 | 2 | real | kind_dyn | inout | F | -!! | te0 | atmosphere_energy_content_at_Lagrangian_surface | atmosphere total energy at Lagrangian surface | J m-2 | 3 | real | kind_dyn | out | F | -!! | ngas | number_of_gases_for_multi_gases_physics | number of gases for multi gases physics | count | 0 | integer | | in | F | -!! | qvi | gas_tracers_for_multi_gas_physics_at_Lagrangian_surface | gas tracers for multi gas physics at Lagrangian surface | kg kg-1 | 4 | real | kind_dyn | inout | F | -!! | qv | water_vapor_specific_humidity_at_Lagrangian_surface | water vapor specific humidity updated by fast physics at Lagrangian surface | kg kg-1 | 3 | real | kind_dyn | inout | F | -!! | ql | cloud_liquid_water_specific_humidity_at_Lagrangian_surface | cloud liquid water specific humidity updated by fast physics at Lagrangian surface | kg kg-1 | 3 | real | kind_dyn | inout | F | -!! | qi | cloud_ice_specific_humidity_at_Lagrangian_surface | cloud ice specific humidity updated by fast physics at Lagrangian surface | kg kg-1 | 3 | real | kind_dyn | inout | F | -!! | qr | cloud_rain_specific_humidity_at_Lagrangian_surface | cloud rain specific humidity updated by fast physics at Lagrangian surface | kg kg-1 | 3 | real | kind_dyn | inout | F | -!! | qs | cloud_snow_specific_humidity_at_Lagrangian_surface | cloud snow specific humidity updated by fast physics at Lagrangian surface | kg kg-1 | 3 | real | kind_dyn | inout | F | -!! | qg | cloud_graupel_specific_humidity_at_Lagrangian_surface | cloud graupel specific humidity updated by fast physics at Lagrangian surface | kg kg-1 | 3 | real | kind_dyn | inout | F | -!! | hs | surface_geopotential_at_Lagrangian_surface | surface geopotential at Lagrangian surface | m2 s-2 | 2 | real | kind_dyn | in | F | -!! | peln | log_pressure_at_Lagrangian_surface | logarithm of pressure at Lagrangian surface | Pa | 3 | real | kind_dyn | in | F | -!! | delz | thickness_at_Lagrangian_surface | thickness at Lagrangian_surface | m | 3 | real | kind_dyn | in | F | -!! | delp | pressure_thickness_at_Lagrangian_surface | pressure thickness at Lagrangian surface | Pa | 3 | real | kind_dyn | in | F | -!! | pt | virtual_temperature_at_Lagrangian_surface | virtual temperature at Lagrangian surface | K | 3 | real | kind_dyn | inout | F | -!! | pkz | finite-volume_mean_edge_pressure_raised_to_the_power_of_kappa | finite-volume mean edge pressure raised to the power of kappa | Pa**kappa | 3 | real | kind_dyn | inout | F | -!! | q_con | cloud_condensed_water_specific_humidity_at_Lagrangian_surface | cloud condensed water specific humidity updated by fast physics at Lagrangian surface | kg kg-1 | 3 | real | kind_dyn | inout | F | -!! | akap | kappa_dry_for_fast_physics | modified kappa for dry air, fast physics | none | 0 | real | kind_dyn | in | F | -!! | cappa | cappa_moist_gas_constant_at_Lagrangian_surface | cappa(i,j,k) = rdgas / ( rdgas + cvm(i)/(1.+r_vir*q(i,j,k,sphum)) ) | none | 3 | real | kind_dyn | inout | F | -!! | area | cell_area_for_fast_physics | area of the grid cell for fast physics | m2 | 2 | real | kind_grid | in | F | -!! | dtdt | tendency_of_air_temperature_at_Lagrangian_surface | air temperature tendency due to fast physics at Lagrangian surface | K s-1 | 3 | real | kind_dyn | inout | F | -!! | out_dt | flag_for_tendency_of_air_temperature_at_Lagrangian_surface | flag for calculating tendency of air temperature due to fast physics | flag | 0 | logical | | in | F | -!! | last_step | flag_for_the_last_step_of_k_split_remapping | flag for the last step of k-split remapping | flag | 0 | logical | | in | F | -!! | do_qa | flag_for_inline_cloud_fraction_calculation | flag for the inline cloud fraction calculation | flag | 0 | logical | | in | F | -!! | qa | cloud_fraction_at_Lagrangian_surface | cloud fraction at Lagrangian surface | none | 3 | real | kind_dyn | out | F | -!! | nthreads | omp_threads_for_fast_physics | number of OpenMP threads available for fast physics schemes | count | 0 | integer | | in | F | -!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | -!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | +!! \htmlinclude fv_sat_adj_run.html !! subroutine fv_sat_adj_run(mdt, zvir, is, ie, isd, ied, kmp, km, kmdelz, js, je, jsd, jed, & ng, hydrostatic, fast_mp_consv, te0_2d, te0, ngas, qvi, qv, ql, qi, qr, & @@ -356,10 +295,6 @@ subroutine fv_sat_adj_run(mdt, zvir, is, ie, isd, ied, kmp, km, kmdelz, js, je, ! Local variables real(kind=kind_dyn), dimension(is:ie,js:je) :: dpln -#ifdef TRANSITION - ! For bit-for-bit reproducibility - real(kind=kind_dyn), volatile :: volatile_var -#endif integer :: kdelz integer :: k, j, i @@ -377,9 +312,6 @@ subroutine fv_sat_adj_run(mdt, zvir, is, ie, isd, ied, kmp, km, kmdelz, js, je, !$OMP ql,qv,te0,fast_mp_consv, & !$OMP hydrostatic,ng,zvir,pkz, & !$OMP akap,te0_2d,ngas,qvi) & -#ifdef TRANSITION -!$OMP private(volatile_var) & -#endif !$OMP private(k,j,i,kdelz,dpln) #endif @@ -411,28 +343,13 @@ subroutine fv_sat_adj_run(mdt, zvir, is, ie, isd, ied, kmp, km, kmdelz, js, je, do j=js,je do i=is,ie #ifdef MOIST_CAPPA -#ifdef TRANSITION - volatile_var = log(rrg*delp(i,j,k)/delz(i,j,k)*pt(i,j,k)) - pkz(i,j,k) = exp(cappa(i,j,k)*volatile_var) -#else pkz(i,j,k) = exp(cappa(i,j,k)*log(rrg*delp(i,j,k)/delz(i,j,k)*pt(i,j,k))) -#endif -#else -#ifdef TRANSITION -#ifdef MULTI_GASES - volatile_var = log(rrg*delp(i,j,k)/delz(i,j,k)*pt(i,j,k)) - pkz(i,j,k) = exp(akap*(virqd(q(i,j,k,1:num_gas))/vicpqd(q(i,j,k,1:num_gas))*volatile_var) -#else - volatile_var = log(rrg*delp(i,j,k)/delz(i,j,k)*pt(i,j,k)) - pkz(i,j,k) = exp(akap*volatile_var) -#endif #else #ifdef MULTI_GASES pkz(i,j,k) = exp(akap*(virqd(q(i,j,k,1:num_gas))/vicpqd(q(i,j,k,1:num_gas))*log(rrg*delp(i,j,k)/delz(i,j,k)*pt(i,j,k))) #else pkz(i,j,k) = exp(akap*log(rrg*delp(i,j,k)/delz(i,j,k)*pt(i,j,k))) #endif -#endif #endif enddo enddo @@ -1112,9 +1029,13 @@ subroutine fv_sat_adj_work(mdt, zvir, is, ie, js, je, ng, hydrostatic, consv_te, do i = is, ie + if(tintqs) then + tin = pt1(i) + else tin = pt1 (i) - (lcp2 (i) * q_cond (i) + icp2 (i) * q_sol (i)) ! minimum temperature ! tin = pt1 (i) - ((lv00 + d0_vap * pt1 (i)) * q_cond (i) + & ! (li00 + dc_ice * pt1 (i)) * q_sol (i)) / (mc_air (i) + qpz (i) * c_vap) + endif ! ----------------------------------------------------------------------- ! determine saturated specific humidity @@ -1157,14 +1078,14 @@ subroutine fv_sat_adj_work(mdt, zvir, is, ie, js, je, ng, hydrostatic, consv_te, ! icloud_f = 2: binary cloud scheme (0 / 1) ! ----------------------------------------------------------------------- - if (rh > 0.75 .and. qpz (i) > 1.e-6) then + if (rh > 0.75 .and. qpz (i) > 1.e-8) then dq = hvar (i) * qpz (i) q_plus = qpz (i) + dq q_minus = qpz (i) - dq if (icloud_f == 2) then if (qpz (i) > qstar (i)) then qa (i, j) = 1. - elseif (qstar (i) < q_plus .and. q_cond (i) > 1.e-6) then + elseif (qstar (i) < q_plus .and. q_cond (i) > 1.e-8) then qa (i, j) = ((q_plus - qstar (i)) / dq) ** 2 qa (i, j) = min (1., qa (i, j)) else @@ -1184,7 +1105,7 @@ subroutine fv_sat_adj_work(mdt, zvir, is, ie, js, je, ng, hydrostatic, consv_te, qa (i, j) = 0. endif ! impose minimum cloudiness if substantial q_cond (i) exist - if (q_cond (i) > 1.e-6) then + if (q_cond (i) > 1.e-8) then qa (i, j) = max (cld_min, qa (i, j)) endif qa (i, j) = min (1., qa (i, j)) diff --git a/physics/gfdl_fv_sat_adj.meta b/physics/gfdl_fv_sat_adj.meta new file mode 100644 index 000000000..983863a26 --- /dev/null +++ b/physics/gfdl_fv_sat_adj.meta @@ -0,0 +1,489 @@ +[ccpp-arg-table] + name = fv_sat_adj_init + type = scheme +[do_sat_adj] + standard_name = flag_for_saturation_adjustment_for_microphysics_in_dynamics + long_name = flag for saturation adjustment for microphysics in dynamics + units = none + dimensions = () + type = logical + intent = in + optional = F +[kmp] + standard_name = top_layer_index_for_fast_physics + long_name = top_layer_inder_for_gfdl_mp + units = index + dimensions = () + type = integer + intent = in + optional = F +[nwat] + standard_name = number_of_water_species + long_name = number of water species + units = count + dimensions = () + type = integer + intent = in + optional = F +[ngas] + standard_name = number_of_gases_for_multi_gases_physics + long_name = number of gases for multi gases physics + units = count + dimensions = () + type = integer + intent = in + optional = F +[rilist] + standard_name = gas_constants_for_multi_gases_physics + long_name = gas constants for multi gases physics + units = J kg-1 K-1 + dimensions = (0:number_of_gases_for_multi_gases_physics) + type = real + kind = kind_dyn + intent = in + optional = F +[cpilist] + standard_name = specific_heat_capacities_for_multi_gases_physics + long_name = specific heat capacities for multi gases physics + units = J kg-1 K-1 + dimensions = (0:number_of_gases_for_multi_gases_physics) + type = real + kind = kind_dyn + intent = in + optional = F +[mpirank] + standard_name = mpi_rank_for_fast_physics + long_name = current MPI-rank for fast physics schemes + units = index + dimensions = () + type = integer + intent = in + optional = F +[mpiroot] + standard_name = mpi_root_for_fast_physics + long_name = master MPI-rank for fast physics schemes + units = index + dimensions = () + type = integer + intent = in + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F + +######################################################################## +[ccpp-arg-table] + name = fv_sat_adj_finalize + type = scheme +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F + +######################################################################## +[ccpp-arg-table] + name = fv_sat_adj_run + type = scheme +[mdt] + standard_name = time_step_for_remapping_for_fast_physics + long_name = remapping time step for fast physics + units = s + dimensions = () + type = real + kind = kind_dyn + intent = in + optional = F +[zvir] + standard_name = ratio_of_vapor_to_dry_air_gas_constants_minus_one_default_kind + long_name = zvir=rv/rd-1.0 + units = none + dimensions = () + type = real + kind = kind_dyn + intent = in + optional = F +[is] + standard_name = starting_x_direction_index + long_name = starting X direction index + units = count + dimensions = () + type = integer + intent = in + optional = F +[ie] + standard_name = ending_x_direction_index + long_name = ending X direction index + units = count + dimensions = () + type = integer + intent = in + optional = F +[isd] + standard_name = starting_x_direction_index_domain + long_name = starting X direction index for domain + units = count + dimensions = () + type = integer + intent = in + optional = F +[ied] + standard_name = ending_x_direction_index_domain + long_name = ending X direction index for domain + units = count + dimensions = () + type = integer + intent = in + optional = F +[kmp] + standard_name = top_layer_index_for_fast_physics + long_name = top layer index for GFDL mp + units = index + dimensions = () + type = integer + intent = in + optional = F +[km] + standard_name = vertical_dimension_for_fast_physics + long_name = number of vertical levels + units = count + dimensions = () + type = integer + intent = in + optional = F +[kmdelz] + standard_name = vertical_dimension_for_thickness_at_Lagrangian_surface + long_name = vertical dimension for thickness at Lagrangian surface + units = count + dimensions = () + type = integer + intent = in + optional = F +[js] + standard_name = starting_y_direction_index + long_name = starting Y direction index + units = count + dimensions = () + type = integer + intent = in + optional = F +[je] + standard_name = ending_y_direction_index + long_name = ending Y direction index + units = count + dimensions = () + type = integer + intent = in + optional = F +[jsd] + standard_name = starting_y_direction_index_domain + long_name = starting X direction index for domain + units = count + dimensions = () + type = integer + intent = in + optional = F +[jed] + standard_name = ending_y_direction_index_domain + long_name = ending X direction index for domain + units = count + dimensions = () + type = integer + intent = in + optional = F +[ng] + standard_name = number_of_ghost_zones + long_name = number of ghost zones defined in fv_mp + units = count + dimensions = () + type = integer + intent = in + optional = F +[hydrostatic] + standard_name = flag_for_hydrostatic_solver_for_fast_physics + long_name = flag for use the hydrostatic or nonhydrostatic solver + units = flag + dimensions = () + type = logical + intent = in + optional = F +[fast_mp_consv] + standard_name = flag_for_fast_microphysics_energy_conservation + long_name = flag for fast microphysics energy conservation + units = flag + dimensions = () + type = logical + intent = in + optional = F +[te0_2d] + standard_name = atmosphere_energy_content_in_column + long_name = atmosphere total energy in columns + units = J m-2 + dimensions = (starting_x_direction_index:ending_x_direction_index,starting_y_direction_index:ending_y_direction_index) + type = real + kind = kind_dyn + intent = inout + optional = F +[te0] + standard_name = atmosphere_energy_content_at_Lagrangian_surface + long_name = atmosphere total energy at Lagrangian surface + units = J m-2 + dimensions = (starting_x_direction_index_domain:ending_x_direction_index_domain,starting_y_direction_index_domain:ending_y_direction_index_domain,1:vertical_dimension_for_fast_physics) + type = real + kind = kind_dyn + intent = out + optional = F +[ngas] + standard_name = number_of_gases_for_multi_gases_physics + long_name = number of gases for multi gases physics + units = count + dimensions = () + type = integer + intent = in + optional = F +[qvi] + standard_name = gas_tracers_for_multi_gas_physics_at_Lagrangian_surface + long_name = gas tracers for multi gas physics at Lagrangian surface + units = kg kg-1 + dimensions = (starting_x_direction_index_domain:ending_x_direction_index_domain,starting_y_direction_index_domain:ending_y_direction_index_domain,1:vertical_dimension_for_fast_physics,1:number_of_gases_for_multi_gases_physics) + type = real + kind = kind_dyn + intent = inout + optional = F +[qv] + standard_name = water_vapor_specific_humidity_at_Lagrangian_surface + long_name = water vapor specific humidity updated by fast physics at Lagrangian surface + units = kg kg-1 + dimensions = (starting_x_direction_index_domain:ending_x_direction_index_domain,starting_y_direction_index_domain:ending_y_direction_index_domain,1:vertical_dimension_for_fast_physics) + type = real + kind = kind_dyn + intent = inout + optional = F +[ql] + standard_name = cloud_liquid_water_specific_humidity_at_Lagrangian_surface + long_name = cloud liquid water specific humidity updated by fast physics at Lagrangian surface + units = kg kg-1 + dimensions = (starting_x_direction_index_domain:ending_x_direction_index_domain,starting_y_direction_index_domain:ending_y_direction_index_domain,1:vertical_dimension_for_fast_physics) + type = real + kind = kind_dyn + intent = inout + optional = F +[qi] + standard_name = cloud_ice_specific_humidity_at_Lagrangian_surface + long_name = cloud ice specific humidity updated by fast physics at Lagrangian surface + units = kg kg-1 + dimensions = (starting_x_direction_index_domain:ending_x_direction_index_domain,starting_y_direction_index_domain:ending_y_direction_index_domain,1:vertical_dimension_for_fast_physics) + type = real + kind = kind_dyn + intent = inout + optional = F +[qr] + standard_name = cloud_rain_specific_humidity_at_Lagrangian_surface + long_name = cloud rain specific humidity updated by fast physics at Lagrangian surface + units = kg kg-1 + dimensions = (starting_x_direction_index_domain:ending_x_direction_index_domain,starting_y_direction_index_domain:ending_y_direction_index_domain,1:vertical_dimension_for_fast_physics) + type = real + kind = kind_dyn + intent = inout + optional = F +[qs] + standard_name = cloud_snow_specific_humidity_at_Lagrangian_surface + long_name = cloud snow specific humidity updated by fast physics at Lagrangian surface + units = kg kg-1 + dimensions = (starting_x_direction_index_domain:ending_x_direction_index_domain,starting_y_direction_index_domain:ending_y_direction_index_domain,1:vertical_dimension_for_fast_physics) + type = real + kind = kind_dyn + intent = inout + optional = F +[qg] + standard_name = cloud_graupel_specific_humidity_at_Lagrangian_surface + long_name = cloud graupel specific humidity updated by fast physics at Lagrangian surface + units = kg kg-1 + dimensions = (starting_x_direction_index_domain:ending_x_direction_index_domain,starting_y_direction_index_domain:ending_y_direction_index_domain,1:vertical_dimension_for_fast_physics) + type = real + kind = kind_dyn + intent = inout + optional = F +[hs] + standard_name = surface_geopotential_at_Lagrangian_surface + long_name = surface geopotential at Lagrangian surface + units = m2 s-2 + dimensions = (starting_x_direction_index_domain:ending_x_direction_index_domain,starting_y_direction_index_domain:ending_y_direction_index_domain) + type = real + kind = kind_dyn + intent = in + optional = F +[peln] + standard_name = log_pressure_at_Lagrangian_surface + long_name = logarithm of pressure at Lagrangian surface + units = Pa + dimensions = (starting_x_direction_index:ending_x_direction_index,1:vertical_dimension_for_fast_physics_plus_one,starting_y_direction_index:ending_y_direction_index) + type = real + kind = kind_dyn + intent = in + optional = F +[delz] + standard_name = thickness_at_Lagrangian_surface + long_name = thickness at Lagrangian_surface + units = m + dimensions = (starting_x_direction_index_domain:ending_x_direction_index_domain,starting_y_direction_index_domain:ending_y_direction_index_domain,1:vertical_dimension_for_thickness_at_Lagrangian_surface) + type = real + kind = kind_dyn + intent = in + optional = F +[delp] + standard_name = pressure_thickness_at_Lagrangian_surface + long_name = pressure thickness at Lagrangian surface + units = Pa + dimensions = (starting_x_direction_index_domain:ending_x_direction_index_domain,starting_y_direction_index_domain:ending_y_direction_index_domain,1:vertical_dimension_for_fast_physics) + type = real + kind = kind_dyn + intent = in + optional = F +[pt] + standard_name = virtual_temperature_at_Lagrangian_surface + long_name = virtual temperature at Lagrangian surface + units = K + dimensions = (starting_x_direction_index_domain:ending_x_direction_index_domain,starting_y_direction_index_domain:ending_y_direction_index_domain,1:vertical_dimension_for_fast_physics) + type = real + kind = kind_dyn + intent = inout + optional = F +[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 + 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 + intent = inout + optional = F +[q_con] + standard_name = cloud_condensed_water_specific_humidity_at_Lagrangian_surface + long_name = cloud condensed water specific humidity updated by fast physics at Lagrangian surface + units = kg kg-1 + dimensions = (starting_x_direction_index_domain:ending_x_direction_index_domain,starting_y_direction_index_domain:ending_y_direction_index_domain,1:vertical_dimension_for_condensed_water_at_Lagrangian_surface) + type = real + kind = kind_dyn + intent = inout + optional = F +[akap] + standard_name = kappa_dry_for_fast_physics + long_name = modified kappa for dry air, fast physics + units = none + dimensions = () + type = real + kind = kind_dyn + intent = in + optional = F +[cappa] + standard_name = cappa_moist_gas_constant_at_Lagrangian_surface + long_name = cappa(i,j,k) = rdgas / ( rdgas + cvm(i)/(1.+r_vir*q(i,j,k,sphum)) ) + units = none + dimensions = (starting_x_direction_index_domain:ending_x_direction_index_domain,starting_y_direction_index_domain:ending_y_direction_index_domain,1:vertical_dimension_for_cappa_at_Lagrangian_surface) + type = real + kind = kind_dyn + intent = inout + optional = F +[area] + standard_name = cell_area_for_fast_physics + long_name = area of the grid cell for fast physics + units = m2 + dimensions = (starting_x_direction_index_domain:ending_x_direction_index_domain,starting_y_direction_index_domain:ending_y_direction_index_domain) + type = real + kind = kind_grid + intent = in + optional = F +[dtdt] + standard_name = tendency_of_air_temperature_at_Lagrangian_surface + long_name = air temperature tendency due to fast physics at Lagrangian surface + units = K s-1 + dimensions = (starting_x_direction_index:ending_x_direction_index,starting_y_direction_index:ending_y_direction_index,1:vertical_dimension_for_fast_physics) + type = real + kind = kind_dyn + intent = inout + optional = F +[out_dt] + standard_name = flag_for_tendency_of_air_temperature_at_Lagrangian_surface + long_name = flag for calculating tendency of air temperature due to fast physics + units = flag + dimensions = () + type = logical + intent = in + optional = F +[last_step] + standard_name = flag_for_the_last_step_of_k_split_remapping + long_name = flag for the last step of k-split remapping + units = flag + dimensions = () + type = logical + intent = in + optional = F +[do_qa] + standard_name = flag_for_inline_cloud_fraction_calculation + long_name = flag for the inline cloud fraction calculation + units = flag + dimensions = () + type = logical + intent = in + optional = F +[qa] + standard_name = cloud_fraction_at_Lagrangian_surface + long_name = cloud fraction at Lagrangian surface + units = none + dimensions = (starting_x_direction_index_domain:ending_x_direction_index_domain,starting_y_direction_index_domain:ending_y_direction_index_domain,1:vertical_dimension_for_fast_physics) + type = real + kind = kind_dyn + intent = out + optional = F +[nthreads] + standard_name = omp_threads_for_fast_physics + long_name = number of OpenMP threads available for fast physics schemes + units = count + dimensions = () + type = integer + intent = in + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F diff --git a/physics/gfs_phy_tracer_config.f b/physics/gfs_phy_tracer_config.F similarity index 100% rename from physics/gfs_phy_tracer_config.f rename to physics/gfs_phy_tracer_config.F diff --git a/physics/gmtb_scm_sfc_flux_spec.F90 b/physics/gmtb_scm_sfc_flux_spec.F90 index 1ce2f95a0..d77e42000 100644 --- a/physics/gmtb_scm_sfc_flux_spec.F90 +++ b/physics/gmtb_scm_sfc_flux_spec.F90 @@ -25,42 +25,7 @@ end subroutine gmtb_scm_sfc_flux_spec_finalize !! is "backing out" parameters that are calculated in sfc_dff.f from the known surface heat fluxes and roughness length. !! !! \section arg_table_gmtb_scm_sfc_flux_spec_run Argument Table -!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | -!! |------------------|------------------------------------------------------------------------------|-----------------------------------------------------------------|---------------|------|-----------|-----------|--------|----------| -!! | u1 | x_wind_at_lowest_model_layer | x component of 1st model layer wind | m s-1 | 1 | real | kind_phys | in | F | -!! | v1 | y_wind_at_lowest_model_layer | y component of 1st model layer wind | m s-1 | 1 | real | kind_phys | in | F | -!! | z1 | height_above_ground_at_lowest_model_layer | height above ground at 1st model layer | m | 1 | real | kind_phys | in | F | -!! | t1 | air_temperature_at_lowest_model_layer | 1st model layer air temperature | K | 1 | real | kind_phys | in | F | -!! | q1 | water_vapor_specific_humidity_at_lowest_model_layer | 1st model layer specific humidity | kg kg-1 | 1 | real | kind_phys | in | F | -!! | p1 | air_pressure_at_lowest_model_layer | Model layer 1 mean pressure | Pa | 1 | real | kind_phys | in | F | -!! | roughness_length | surface_roughness_length | surface roughness length | cm | 1 | real | kind_phys | in | F | -!! | spec_sh_flux | specified_kinematic_surface_upward_sensible_heat_flux | specified kinematic surface upward sensible heat flux | K m s-1 | 1 | real | kind_phys | in | F | -!! | spec_lh_flux | specified_kinematic_surface_upward_latent_heat_flux | specified kinematic surface upward latent heat flux | kg kg-1 m s-1 | 1 | real | kind_phys | in | F | -!! | exner_inverse | ratio_of_exner_function_between_midlayer_and_interface_at_lowest_model_layer | Exner function ratio bt midlayer and interface at 1st layer | ratio | 1 | real | kind_phys | in | F | -!! | T_surf | surface_skin_temperature | surface skin temperature | K | 1 | real | kind_phys | in | F | -!! | cp | specific_heat_of_dry_air_at_constant_pressure | specific heat of dry air at constant pressure | J kg-1 K-1 | 0 | real | kind_phys | in | F | -!! | grav | gravitational_acceleration | gravitational acceleration | m s-2 | 0 | real | kind_phys | in | F | -!! | hvap | latent_heat_of_vaporization_of_water_at_0C | latent heat of vaporization of water at 0C | J kg-1 | 0 | real | kind_phys | in | F | -!! | rd | gas_constant_dry_air | ideal gas constant for dry air | J kg-1 K-1 | 0 | real | kind_phys | in | F | -!! | fvirt | ratio_of_vapor_to_dry_air_gas_constants_minus_one | rv/rd - 1 (rv = ideal gas constant for water vapor) | none | 0 | real | kind_phys | in | F | -!! | vonKarman | vonKarman_constant | vonKarman constant | none | 0 | real | kind_phys | in | F | -!! | sh_flux | kinematic_surface_upward_sensible_heat_flux | surface upward sensible heat flux | K m s-1 | 1 | real | kind_phys | out | F | -!! | lh_flux | kinematic_surface_upward_latent_heat_flux | surface upward evaporation flux | kg kg-1 m s-1 | 1 | real | kind_phys | out | F | -!! | u_star | surface_friction_velocity | boundary layer parameter | m s-1 | 1 | real | kind_phys | out | F | -!! | sfc_stress | surface_wind_stress | surface wind stress | m2 s-2 | 1 | real | kind_phys | out | F | -!! | cm | surface_drag_coefficient_for_momentum_in_air | surface exchange coeff for momentum | none | 1 | real | kind_phys | out | F | -!! | ch | surface_drag_coefficient_for_heat_and_moisture_in_air | surface exchange coeff heat & moisture | none | 1 | real | kind_phys | out | F | -!! | fm | Monin-Obukhov_similarity_function_for_momentum | Monin-Obukhov similarity function for momentum | none | 1 | real | kind_phys | out | F | -!! | fh | Monin-Obukhov_similarity_function_for_heat | Monin-Obukhov similarity function for heat | none | 1 | real | kind_phys | out | F | -!! | rb | bulk_richardson_number_at_lowest_model_level | bulk Richardson number at the surface | none | 1 | real | kind_phys | out | F | -!! | u10m | x_wind_at_10m | 10 meter u wind speed | m s-1 | 1 | real | kind_phys | out | F | -!! | v10m | y_wind_at_10m | 10 meter v wind speed | m s-1 | 1 | real | kind_phys | out | F | -!! | wind1 | wind_speed_at_lowest_model_layer | wind speed at lowest model level | m s-1 | 1 | real | kind_phys | out | F | -!! | qss | surface_specific_humidity | surface air saturation specific humidity | kg kg-1 | 1 | real | kind_phys | out | F | -!! | t2m | temperature_at_2m | 2 meter temperature | K | 1 | real | kind_phys | out | F | -!! | q2m | specific_humidity_at_2m | 2 meter specific humidity | kg kg-1 | 1 | real | kind_phys | out | F | -!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | -!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | +!! \htmlinclude gmtb_scm_sfc_flux_spec_run.html !! !! \section general_sfc_flux_spec General Algorithm !! -# Compute friction velocity from the wind speed at the lowest model layer, the height about the ground, and the roughness length. diff --git a/physics/gmtb_scm_sfc_flux_spec.meta b/physics/gmtb_scm_sfc_flux_spec.meta new file mode 100644 index 000000000..6424789bc --- /dev/null +++ b/physics/gmtb_scm_sfc_flux_spec.meta @@ -0,0 +1,308 @@ +[ccpp-arg-table] + name = gmtb_scm_sfc_flux_spec_run + type = scheme +[u1] + standard_name = x_wind_at_lowest_model_layer + long_name = x component of 1st model layer wind + units = m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[v1] + standard_name = y_wind_at_lowest_model_layer + long_name = y component of 1st model layer wind + units = m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[z1] + standard_name = height_above_ground_at_lowest_model_layer + long_name = height above ground at 1st model layer + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[t1] + standard_name = air_temperature_at_lowest_model_layer + long_name = 1st model layer air temperature + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[q1] + standard_name = water_vapor_specific_humidity_at_lowest_model_layer + long_name = 1st model layer specific humidity + units = kg kg-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[p1] + standard_name = air_pressure_at_lowest_model_layer + long_name = Model layer 1 mean pressure + units = Pa + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[roughness_length] + standard_name = surface_roughness_length + long_name = surface roughness length + units = cm + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[spec_sh_flux] + standard_name = specified_kinematic_surface_upward_sensible_heat_flux + long_name = specified kinematic surface upward sensible heat flux + units = K m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[spec_lh_flux] + standard_name = specified_kinematic_surface_upward_latent_heat_flux + long_name = specified kinematic surface upward latent heat flux + units = kg kg-1 m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[exner_inverse] + standard_name = ratio_of_exner_function_between_midlayer_and_interface_at_lowest_model_layer + long_name = Exner function ratio bt midlayer and interface at 1st layer + units = ratio + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[T_surf] + standard_name = surface_skin_temperature + long_name = surface skin temperature + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[cp] + standard_name = specific_heat_of_dry_air_at_constant_pressure + long_name = specific heat of dry air at constant pressure + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[grav] + standard_name = gravitational_acceleration + long_name = gravitational acceleration + units = m s-2 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[hvap] + standard_name = latent_heat_of_vaporization_of_water_at_0C + long_name = latent heat of vaporization of water at 0C + units = J kg-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[rd] + standard_name = gas_constant_dry_air + long_name = ideal gas constant for dry air + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[fvirt] + standard_name = ratio_of_vapor_to_dry_air_gas_constants_minus_one + long_name = rv/rd - 1 (rv = ideal gas constant for water vapor) + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[vonKarman] + standard_name = vonKarman_constant + long_name = vonKarman constant + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[sh_flux] + standard_name = kinematic_surface_upward_sensible_heat_flux + long_name = surface upward sensible heat flux + units = K m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[lh_flux] + standard_name = kinematic_surface_upward_latent_heat_flux + long_name = surface upward evaporation flux + units = kg kg-1 m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[u_star] + standard_name = surface_friction_velocity + long_name = boundary layer parameter + units = m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[sfc_stress] + standard_name = surface_wind_stress + long_name = surface wind stress + units = m2 s-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[cm] + standard_name = surface_drag_coefficient_for_momentum_in_air + long_name = surface exchange coeff for momentum + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[ch] + standard_name = surface_drag_coefficient_for_heat_and_moisture_in_air + long_name = surface exchange coeff heat & moisture + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[fm] + standard_name = Monin_Obukhov_similarity_function_for_momentum + long_name = Monin-Obukhov similarity function for momentum + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[fh] + standard_name = Monin_Obukhov_similarity_function_for_heat + long_name = Monin-Obukhov similarity function for heat + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[rb] + standard_name = bulk_richardson_number_at_lowest_model_level + long_name = bulk Richardson number at the surface + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[u10m] + standard_name = x_wind_at_10m + long_name = 10 meter u wind speed + units = m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[v10m] + standard_name = y_wind_at_10m + long_name = 10 meter v wind speed + units = m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[wind1] + standard_name = wind_speed_at_lowest_model_layer + long_name = wind speed at lowest model level + units = m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[qss] + standard_name = surface_specific_humidity + long_name = surface air saturation specific humidity + units = kg kg-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[t2m] + standard_name = temperature_at_2m + long_name = 2 meter temperature + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[q2m] + standard_name = specific_humidity_at_2m + long_name = 2 meter specific humidity + units = kg kg-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F diff --git a/physics/gscond.f b/physics/gscond.f index bfc6115fa..6dd77d87e 100644 --- a/physics/gscond.f +++ b/physics/gscond.f @@ -29,31 +29,7 @@ end subroutine zhaocarr_gscond_finalize !! #if 0 !> \section arg_table_zhaocarr_gscond_run Argument Table -!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | -!! |----------------|----------------------------------------------------------------|-------------------------------------------------------------------------------------------------------------------------|---------|------|-----------|-----------|--------|----------| -!! | im | horizontal_loop_extent | horizontal loop extent | count | 0 | integer | | in | F | -!! | ix | horizontal_dimension | horizontal dimension | count | 0 | integer | | in | F | -!! | km | vertical_dimension | vertical layer dimension | count | 0 | integer | | in | F | -!! | dt | time_step_for_physics | physics time step | s | 0 | real | kind_phys | in | F | -!! | dtf | time_step_for_dynamics | dynamics time step | s | 0 | real | kind_phys | in | F | -!! | prsl | air_pressure | layer mean air pressure | Pa | 2 | real | kind_phys | in | F | -!! | ps | surface_air_pressure | surface pressure | Pa | 1 | real | kind_phys | in | F | -!! | q | water_vapor_specific_humidity_updated_by_physics | water vapor specific humidity | kg kg-1 | 2 | real | kind_phys | inout | F | -!! | clw1 | ice_water_mixing_ratio_convective_transport_tracer | moist (dry+vapor, no condensates) mixing ratio of ice water in the convectively transported tracer array | kg kg-1 | 2 | real | kind_phys | in | F | -!! | clw2 | cloud_condensed_water_mixing_ratio_convective_transport_tracer | moist (dry+vapor, no condensates) mixing ratio of cloud water (condensate) in the convectively transported tracer array | kg kg-1 | 2 | real | kind_phys | in | F | -!! | cwm | cloud_condensed_water_mixing_ratio_updated_by_physics | moist cloud condensed water mixing ratio | kg kg-1 | 2 | real | kind_phys | out | F | -!! | t | air_temperature_updated_by_physics | layer mean air temperature | K | 2 | real | kind_phys | inout | F | -!! | tp | air_temperature_two_time_steps_back | air temperature two time steps back | K | 2 | real | kind_phys | inout | F | -!! | qp | water_vapor_specific_humidity_two_time_steps_back | water vapor specific humidity two time steps back | kg kg-1 | 2 | real | kind_phys | inout | F | -!! | psp | surface_air_pressure_two_time_steps_back | surface air pressure two time steps back | Pa | 1 | real | kind_phys | inout | F | -!! | tp1 | air_temperature_at_previous_time_step | air temperature at previous time step | K | 2 | real | kind_phys | inout | F | -!! | qp1 | water_vapor_specific_humidity_at_previous_time_step | water vapor specific humidity at previous time step | kg kg-1 | 2 | real | kind_phys | inout | F | -!! | psp1 | surface_air_pressure_at_previous_time_step | surface air surface pressure at previous time step | Pa | 1 | real | kind_phys | inout | F | -!! | u | critical_relative_humidity | critical relative humidity | frac | 2 | real | kind_phys | in | F | -!! | lprnt | flag_print | flag for printing diagnostics to output | flag | 0 | logical | | in | F | -!! | ipr | horizontal_index_of_printed_column | horizontal index of printed column | index | 0 | integer | | in | F | -!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | -!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | +!! \htmlinclude zhaocarr_gscond_run.html !! #endif !> \section general_gscond GFS gscond Scheme General Algorithm diff --git a/physics/gscond.meta b/physics/gscond.meta new file mode 100644 index 000000000..f2046df0a --- /dev/null +++ b/physics/gscond.meta @@ -0,0 +1,214 @@ +[ccpp-arg-table] + name = gscond_init + type = scheme + +######################################################################## +[ccpp-arg-table] + name = gscond_finalize + type = scheme + +######################################################################## +[ccpp-arg-table] + name = zhaocarr_gscond_run + type = scheme +[im] + standard_name = horizontal_loop_extent + long_name = horizontal loop extent + units = count + dimensions = () + type = integer + intent = in + optional = F +[ix] + standard_name = horizontal_dimension + long_name = horizontal dimension + units = count + dimensions = () + type = integer + intent = in + optional = F +[km] + standard_name = vertical_dimension + long_name = vertical layer dimension + units = count + dimensions = () + type = integer + intent = in + optional = F +[dt] + standard_name = time_step_for_physics + long_name = physics time step + units = s + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[dtf] + standard_name = time_step_for_dynamics + long_name = dynamics time step + units = s + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[prsl] + standard_name = air_pressure + long_name = layer mean air pressure + units = Pa + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[ps] + standard_name = surface_air_pressure + long_name = surface pressure + units = Pa + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[q] + standard_name = water_vapor_specific_humidity_updated_by_physics + long_name = water vapor specific humidity + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[clw1] + standard_name = ice_water_mixing_ratio_convective_transport_tracer + long_name = ratio of mass of ice water to mass of dry air plus vapor (without condensates) in the convectively transported tracer array + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[clw2] + standard_name = cloud_condensed_water_mixing_ratio_convective_transport_tracer + long_name = ratio of mass of cloud water to mass of dry air plus vapor (without condensates) in the convectively transported tracer array + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[cwm] + standard_name = cloud_condensed_water_mixing_ratio_updated_by_physics + long_name = moist cloud condensed water mixing ratio + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[t] + standard_name = air_temperature_updated_by_physics + long_name = layer mean air temperature + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[tp] + standard_name = air_temperature_two_time_steps_back + long_name = air temperature two time steps back + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[qp] + standard_name = water_vapor_specific_humidity_two_time_steps_back + long_name = water vapor specific humidity two time steps back + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[psp] + standard_name = surface_air_pressure_two_time_steps_back + long_name = surface air pressure two time steps back + units = Pa + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[tp1] + standard_name = air_temperature_at_previous_time_step + long_name = air temperature at previous time step + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[qp1] + standard_name = water_vapor_specific_humidity_at_previous_time_step + long_name = water vapor specific humidity at previous time step + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[psp1] + standard_name = surface_air_pressure_at_previous_time_step + long_name = surface air surface pressure at previous time step + units = Pa + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[u] + standard_name = critical_relative_humidity + long_name = critical relative humidity + units = frac + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[lprnt] + standard_name = flag_print + long_name = flag for printing diagnostics to output + units = flag + dimensions = () + type = logical + intent = in + optional = F +[ipr] + standard_name = horizontal_index_of_printed_column + long_name = horizontal index of printed column + units = index + dimensions = () + type = integer + intent = in + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F diff --git a/physics/gwdc.f b/physics/gwdc.f index d25e8b533..9909a3100 100644 --- a/physics/gwdc.f +++ b/physics/gwdc.f @@ -17,30 +17,12 @@ end subroutine gwdc_pre_init ! \brief Brief description of the subroutine !! !! \section arg_table_gwdc_pre_run Argument Table -!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | -!! |----------------|--------------------------------------------------------------------------|---------------------------------------------------------------|-------|------|-----------|-----------|--------|----------| -!! | im | horizontal_loop_extent | horizontal loop extent | count | 0 | integer | | in | F | -!! | cgwf | multiplication_factors_for_convective_gravity_wave_drag | multiplication factors for convective gravity wave drag | none | 1 | real | kind_phys | in | F | -!! | dx | cell_size | grid size in zonal direction | m | 1 | real | kind_phys | in | F | -!! | work1 | grid_size_related_coefficient_used_in_scale-sensitive_schemes | grid size related coefficient used in scale-sensitive schemes | none | 1 | real | kind_phys | in | F | -!! | work2 | grid_size_related_coefficient_used_in_scale-sensitive_schemes_complement | complement to work1 | none | 1 | real | kind_phys | in | F | -!! | dlength | characteristic_grid_length_scale | representative horizontal length scale of grid box | m | 1 | real | kind_phys | out | F | -!! | cldf | cloud_area_fraction | fraction of grid box area in which updrafts occur | frac | 1 | real | kind_phys | out | F | -!! | levs | vertical_dimension | number of vertical layers | count | 0 | integer | | in | F | -!! | kbot | vertical_index_at_cloud_base | vertical index at cloud base | index | 1 | integer | | in | F | -!! | ktop | vertical_index_at_cloud_top | vertical index at cloud top | index | 1 | integer | | in | F | -!! | dtp | time_step_for_physics | physics time step | s | 0 | real | kind_phys | in | F | -!! | gt0 | air_temperature_updated_by_physics | updated air temperature | K | 2 | real | kind_phys | in | F | -!! | gt0_init | air_temperature_save | air temperature before entering convection scheme | K | 2 | real | kind_phys | in | F | -!! | del | air_pressure_difference_between_midlayers | difference between mid-layer pressures | Pa | 2 | real | kind_phys | in | F | -!! | cumabs | maximum_column_heating_rate | maximum heating rate in column | K s-1 | 1 | real | kind_phys | out | F | -!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | -!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | +!! \htmlinclude gwdc_pre_run.html !! subroutine gwdc_pre_run ( & & im, cgwf, dx, work1, work2, dlength, cldf, & & levs, kbot, ktop, dtp, gt0, gt0_init, del, cumabs, & - & errmsg, errflg ) + & do_cnvgwd, errmsg, errflg ) use machine, only : kind_phys implicit none @@ -56,6 +38,7 @@ subroutine gwdc_pre_run ( & real(kind=kind_phys), intent(out) :: & & dlength(:), cldf(:), cumabs(:) + logical, intent(in) :: do_cnvgwd character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -67,6 +50,14 @@ subroutine gwdc_pre_run ( & errmsg = '' errflg = 0 + ! DH* + if (.not. do_cnvgwd) then + write(0,*) "ERROR: , GWDC_PRE CALLED BUT DO_CNVGWD FALSE" + call sleep(5) + stop + end if + ! *DH + do i = 1, im tem1 = dx(i) tem2 = tem1 @@ -116,48 +107,14 @@ module gwdc subroutine gwdc_init() end subroutine gwdc_init -! \defgroup GFS_cgwd GFS Convective Gravity Wave Drag -!> \defgroup GFS_gwdc_run GFS gwdc Main +!> \defgroup GFS_gwdc_run GFS Convective Gravity Wave Drag Scheme Module !! \brief This subroutine is the parameterization of convective gravity wave !! drag based on the theory given by Chun and Baik (1998) !! \cite chun_and_baik_1998 modified for implementation into the !! GFS/CFS by Ake Johansson(Aug 2005). !! !> \section arg_table_gwdc_run Argument Table -!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | -!! |----------------|--------------------------------------------------------|--------------------------------------------------------------------|------------|------|-----------|-----------|--------|----------| -!! | im | horizontal_loop_extent | horizontal loop extent | count | 0 | integer | | in | F | -!! | ix | horizontal_dimension | horizontal dimension | count | 0 | integer | | in | F | -!! | km | vertical_dimension | number of vertical layers | count | 0 | integer | | in | F | -!! | lat | latitude_index_in_debug_printouts | latitude index in debug printouts | index | 0 | integer | | in | F | -!! | u1 | x_wind | zonal wind | m s-1 | 2 | real | kind_phys | in | F | -!! | v1 | y_wind | meridional wind | m s-1 | 2 | real | kind_phys | in | F | -!! | t1 | air_temperature | mid-layer temperature | K | 2 | real | kind_phys | in | F | -!! | q1 | water_vapor_specific_humidity | mid-layer specific humidity of water vapor | kg kg-1 | 2 | real | kind_phys | in | F | -!! | deltim | time_step_for_physics | physics time step | s | 0 | real | kind_phys | in | F | -!! | pmid1 | air_pressure | mid-layer pressure | Pa | 2 | real | kind_phys | in | F | -!! | pint1 | air_pressure_at_interface | interface pressure | Pa | 2 | real | kind_phys | in | F | -!! | dpmid1 | air_pressure_difference_between_midlayers | difference between mid-layer pressures | Pa | 2 | real | kind_phys | in | F | -!! | qmax | maximum_column_heating_rate | maximum heating rate in column | K s-1 | 1 | real | kind_phys | in | F | -!! | ktop | vertical_index_at_cloud_top | vertical index at cloud top | index | 1 | integer | | in | F | -!! | kbot | vertical_index_at_cloud_base | vertical index at cloud base | index | 1 | integer | | in | F | -!! | kcnv | flag_deep_convection | flag indicating whether convection occurs in column (0 or 1) | flag | 1 | integer | | in | F | -!! | cldf | cloud_area_fraction | fraction of grid box area in which updrafts occur | frac | 1 | real | kind_phys | in | F | -!! | grav | gravitational_acceleration | gravitational acceleration | m s-2 | 0 | real | kind_phys | in | F | -!! | cp | specific_heat_of_dry_air_at_constant_pressure | specific heat of dry air at constant pressure | J kg-1 K-1 | 0 | real | kind_phys | in | F | -!! | rd | gas_constant_dry_air | ideal gas constant for dry air | J kg-1 K-1 | 0 | real | kind_phys | in | F | -!! | fv | ratio_of_vapor_to_dry_air_gas_constants_minus_one | rv/rd - 1 (rv = ideal gas constant for water vapor) | none | 0 | real | kind_phys | in | F | -!! | pi | pi | ratio of a circle's circumference to its diameter | radians | 0 | real | kind_phys | in | F | -!! | dlength | characteristic_grid_length_scale | representative horizontal length scale of grid box | m | 1 | real | kind_phys | in | F | -!! | lprnt | flag_print | flag for debugging printouts | flag | 0 | logical | | in | F | -!! | ipr | horizontal_index_of_printed_column | horizontal index of column used in debugging printouts | index | 0 | integer | | in | F | -!! | fhour | forecast_time | forecast hour | h | 0 | real | kind_phys | in | F | -!! | utgwc | tendency_of_x_wind_due_to_convective_gravity_wave_drag | zonal wind tendency due to convective gravity wave drag | m s-2 | 2 | real | kind_phys | out | F | -!! | vtgwc | tendency_of_y_wind_due_to_convective_gravity_wave_drag | meridional wind tendency due to convective gravity wave drag | m s-2 | 2 | real | kind_phys | out | F | -!! | tauctx | instantaneous_x_stress_due_to_gravity_wave_drag | zonal stress at cloud top due to convective gravity wave drag | Pa | 1 | real | kind_phys | out | F | -!! | taucty | instantaneous_y_stress_due_to_gravity_wave_drag | meridional stress at cloud top due to convective gravity wave drag | Pa | 1 | real | kind_phys | out | F | -!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | -!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | +!! \htmlinclude gwdc_run.html !! !>\section gen_gwdc GFS Convective GWD Scheme General Algorithm !! Parameterizing subgrid-scale convection-induced gravity wave @@ -1505,28 +1462,7 @@ end subroutine gwdc_post_init ! \brief Brief description of the subroutine !! !> \section arg_table_gwdc_post_run Argument Table -!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | -!! |----------------|-----------------------------------------------------------------|--------------------------------------------------------------------------|------------|------|-----------|-----------|--------|----------| -!! | im | horizontal_loop_extent | horizontal loop extent | count | 0 | integer | | in | F | -!! | levs | vertical_dimension | number of vertical layers | count | 0 | integer | | in | F | -!! | lssav | flag_diagnostics | flag for calculating diagnostic fields | flag | 0 | logical | | in | F | -!! | ldiag3d | flag_diagnostics_3D | flag for calculating 3-D diagnostic fields | flag | 0 | logical | | in | F | -!! | dtf | time_step_for_dynamics | dynamics time step | s | 0 | real | kind_phys | in | F | -!! | dtp | time_step_for_physics | physics time step | s | 0 | real | kind_phys | in | F | -!! | con_cp | specific_heat_of_dry_air_at_constant_pressure | specific heat of dry air at constant pressure | J kg-1 K-1 | 0 | real | kind_phys | in | F | -!! | tauctx | instantaneous_x_stress_due_to_gravity_wave_drag | zonal stress at cloud top due to convective gravity wave drag | Pa | 1 | real | kind_phys | in | F | -!! | taucty | instantaneous_y_stress_due_to_gravity_wave_drag | meridional stress at cloud top due to convective gravity wave drag | Pa | 1 | real | kind_phys | in | F | -!! | gwdcu | tendency_of_x_wind_due_to_convective_gravity_wave_drag | zonal wind tendency due to convective gravity wave drag | m s-2 | 2 | real | kind_phys | in | F | -!! | gwdcv | tendency_of_y_wind_due_to_convective_gravity_wave_drag | meridional wind tendency due to convective gravity wave drag | m s-2 | 2 | real | kind_phys | in | F | -!! | dugwd | time_integral_of_x_stress_due_to_gravity_wave_drag | integral over time of zonal stress due to gravity wave drag | Pa s | 1 | real | kind_phys | inout | F | -!! | dvgwd | time_integral_of_y_stress_due_to_gravity_wave_drag | integral over time of meridional stress due to gravity wave drag | Pa s | 1 | real | kind_phys | inout | F | -!! | du3dt | cumulative_change_in_x_wind_due_to_convective_gravity_wave_drag | cumulative change in zonal wind due to convective gravity wave drag | m s-1 | 2 | real | kind_phys | inout | F | -!! | dv3dt | cumulative_change_in_y_wind_due_to_convective_gravity_wave_drag | cumulative change in meridional wind due to convective gravity wave drag | m s-1 | 2 | real | kind_phys | inout | F | -!! | gu0 | x_wind_updated_by_physics | updated zonal wind | m s-1 | 2 | real | kind_phys | inout | F | -!! | gv0 | y_wind_updated_by_physics | updated meridional wind | m s-1 | 2 | real | kind_phys | inout | F | -!! | gt0 | air_temperature_updated_by_physics | updated air temperature | K | 2 | real | kind_phys | inout | F | -!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | -!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | +!! \htmlinclude gwdc_post_run.html !! subroutine gwdc_post_run( & & im, levs, lssav, ldiag3d, dtf, dtp, con_cp, & diff --git a/physics/gwdc.meta b/physics/gwdc.meta new file mode 100644 index 000000000..2151cc5f7 --- /dev/null +++ b/physics/gwdc.meta @@ -0,0 +1,652 @@ +[ccpp-arg-table] + name = gwdc_pre_init + type = scheme + +######################################################################## +[ccpp-arg-table] + name = gwdc_pre_run + type = scheme +[im] + standard_name = horizontal_loop_extent + long_name = horizontal loop extent + units = count + dimensions = () + type = integer + intent = in + optional = F +[cgwf] + standard_name = multiplication_factors_for_convective_gravity_wave_drag + long_name = multiplication factors for convective gravity wave drag + units = none + dimensions = (2) + type = real + kind = kind_phys + intent = in + optional = F +[dx] + standard_name = cell_size + long_name = grid size in zonal direction + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[work1] + standard_name = grid_size_related_coefficient_used_in_scale_sensitive_schemes + long_name = grid size related coefficient used in scale-sensitive schemes + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[work2] + standard_name = grid_size_related_coefficient_used_in_scale_sensitive_schemes_complement + long_name = complement to work1 + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[dlength] + standard_name = characteristic_grid_length_scale + long_name = representative horizontal length scale of grid box + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[cldf] + standard_name = cloud_area_fraction + long_name = fraction of grid box area in which updrafts occur + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[levs] + standard_name = vertical_dimension + long_name = number of vertical layers + units = count + dimensions = () + type = integer + intent = in + optional = F +[kbot] + standard_name = vertical_index_at_cloud_base + long_name = vertical index at cloud base + units = index + dimensions = (horizontal_dimension) + type = integer + intent = in + optional = F +[ktop] + standard_name = vertical_index_at_cloud_top + long_name = vertical index at cloud top + units = index + dimensions = (horizontal_dimension) + type = integer + intent = in + optional = F +[dtp] + standard_name = time_step_for_physics + long_name = physics time step + units = s + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[gt0] + standard_name = air_temperature_updated_by_physics + long_name = updated air temperature + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[gt0_init] + standard_name = air_temperature_save + long_name = air temperature before entering convection scheme + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[del] + standard_name = air_pressure_difference_between_midlayers + long_name = difference between mid-layer pressures + units = Pa + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[cumabs] + standard_name = maximum_column_heating_rate + long_name = maximum heating rate in column + units = K s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[do_cnvgwd] + standard_name = flag_for_convective_gravity_wave_drag + long_name = flag for convective gravity wave drag (gwd) + units = flag + dimensions = () + type = logical + intent = in + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F + +######################################################################## +[ccpp-arg-table] + name = gwdc_pre_finalize + type = scheme + +######################################################################## +[ccpp-arg-table] + name = gwdc_init + type = scheme + +######################################################################## +[ccpp-arg-table] + name = gwdc_run + type = scheme +[im] + standard_name = horizontal_loop_extent + long_name = horizontal loop extent + units = count + dimensions = () + type = integer + intent = in + optional = F +[ix] + standard_name = horizontal_dimension + long_name = horizontal dimension + units = count + dimensions = () + type = integer + intent = in + optional = F +[km] + standard_name = vertical_dimension + long_name = number of vertical layers + units = count + dimensions = () + type = integer + intent = in + optional = F +[lat] + standard_name = latitude_index_in_debug_printouts + long_name = latitude index in debug printouts + units = index + dimensions = () + type = integer + intent = in + optional = F +[u1] + standard_name = x_wind + long_name = zonal wind + units = m s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[v1] + standard_name = y_wind + long_name = meridional wind + units = m s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[t1] + standard_name = air_temperature + long_name = mid-layer temperature + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[q1] + standard_name = water_vapor_specific_humidity + long_name = mid-layer specific humidity of water vapor + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[deltim] + standard_name = time_step_for_physics + long_name = physics time step + units = s + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[pmid1] + standard_name = air_pressure + long_name = mid-layer pressure + units = Pa + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[pint1] + standard_name = air_pressure_at_interface + long_name = interface pressure + units = Pa + dimensions = (horizontal_dimension,vertical_dimension_plus_one) + type = real + kind = kind_phys + intent = in + optional = F +[dpmid1] + standard_name = air_pressure_difference_between_midlayers + long_name = difference between mid-layer pressures + units = Pa + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[qmax] + standard_name = maximum_column_heating_rate + long_name = maximum heating rate in column + units = K s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[ktop] + standard_name = vertical_index_at_cloud_top + long_name = vertical index at cloud top + units = index + dimensions = (horizontal_dimension) + type = integer + intent = in + optional = F +[kbot] + standard_name = vertical_index_at_cloud_base + long_name = vertical index at cloud base + units = index + dimensions = (horizontal_dimension) + type = integer + intent = in + optional = F +[kcnv] + standard_name = flag_deep_convection + long_name = flag indicating whether convection occurs in column (0 or 1) + units = flag + dimensions = (horizontal_dimension) + type = integer + intent = in + optional = F +[cldf] + standard_name = cloud_area_fraction + long_name = fraction of grid box area in which updrafts occur + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[grav] + standard_name = gravitational_acceleration + long_name = gravitational acceleration + units = m s-2 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[cp] + standard_name = specific_heat_of_dry_air_at_constant_pressure + long_name = specific heat of dry air at constant pressure + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[rd] + standard_name = gas_constant_dry_air + long_name = ideal gas constant for dry air + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[fv] + standard_name = ratio_of_vapor_to_dry_air_gas_constants_minus_one + long_name = rv/rd - 1 (rv = ideal gas constant for water vapor) + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[pi] + standard_name = pi + long_name = ratio of a circle's circumference to its diameter + units = radians + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[dlength] + standard_name = characteristic_grid_length_scale + long_name = representative horizontal length scale of grid box + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[lprnt] + standard_name = flag_print + long_name = flag for debugging printouts + units = flag + dimensions = () + type = logical + intent = in + optional = F +[ipr] + standard_name = horizontal_index_of_printed_column + long_name = horizontal index of column used in debugging printouts + units = index + dimensions = () + type = integer + intent = in + optional = F +[fhour] + standard_name = forecast_time + long_name = forecast hour + units = h + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[utgwc] + standard_name = tendency_of_x_wind_due_to_convective_gravity_wave_drag + long_name = zonal wind tendency due to convective gravity wave drag + units = m s-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[vtgwc] + standard_name = tendency_of_y_wind_due_to_convective_gravity_wave_drag + long_name = meridional wind tendency due to convective gravity wave drag + units = m s-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[tauctx] + standard_name = instantaneous_x_stress_due_to_gravity_wave_drag + long_name = zonal stress at cloud top due to convective gravity wave drag + units = Pa + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[taucty] + standard_name = instantaneous_y_stress_due_to_gravity_wave_drag + long_name = meridional stress at cloud top due to convective gravity wave drag + units = Pa + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F + +######################################################################## +[ccpp-arg-table] + name = gwdc_finalize + type = scheme + +######################################################################## +[ccpp-arg-table] + name = gwdc_post_init + type = scheme + +######################################################################## +[ccpp-arg-table] + name = gwdc_post_run + type = scheme +[im] + standard_name = horizontal_loop_extent + long_name = horizontal loop extent + units = count + dimensions = () + type = integer + intent = in + optional = F +[levs] + standard_name = vertical_dimension + long_name = number of vertical layers + units = count + dimensions = () + type = integer + intent = in + optional = F +[lssav] + standard_name = flag_diagnostics + long_name = flag for calculating diagnostic fields + units = flag + dimensions = () + type = logical + intent = in + optional = F +[ldiag3d] + standard_name = flag_diagnostics_3D + long_name = flag for calculating 3-D diagnostic fields + units = flag + dimensions = () + type = logical + intent = in + optional = F +[dtf] + standard_name = time_step_for_dynamics + long_name = dynamics time step + units = s + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[dtp] + standard_name = time_step_for_physics + long_name = physics time step + units = s + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[con_cp] + standard_name = specific_heat_of_dry_air_at_constant_pressure + long_name = specific heat of dry air at constant pressure + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[tauctx] + standard_name = instantaneous_x_stress_due_to_gravity_wave_drag + long_name = zonal stress at cloud top due to convective gravity wave drag + units = Pa + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[taucty] + standard_name = instantaneous_y_stress_due_to_gravity_wave_drag + long_name = meridional stress at cloud top due to convective gravity wave drag + units = Pa + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[gwdcu] + standard_name = tendency_of_x_wind_due_to_convective_gravity_wave_drag + long_name = zonal wind tendency due to convective gravity wave drag + units = m s-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[gwdcv] + standard_name = tendency_of_y_wind_due_to_convective_gravity_wave_drag + long_name = meridional wind tendency due to convective gravity wave drag + units = m s-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[dugwd] + standard_name = time_integral_of_x_stress_due_to_gravity_wave_drag + long_name = integral over time of zonal stress due to gravity wave drag + units = Pa s + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[dvgwd] + standard_name = time_integral_of_y_stress_due_to_gravity_wave_drag + long_name = integral over time of meridional stress due to gravity wave drag + units = Pa s + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[du3dt] + standard_name = cumulative_change_in_x_wind_due_to_convective_gravity_wave_drag + long_name = cumulative change in zonal wind due to convective gravity wave drag + units = m s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[dv3dt] + standard_name = cumulative_change_in_y_wind_due_to_convective_gravity_wave_drag + long_name = cumulative change in meridional wind due to convective gravity wave drag + units = m s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[gu0] + standard_name = x_wind_updated_by_physics + long_name = updated zonal wind + units = m s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[gv0] + standard_name = y_wind_updated_by_physics + long_name = updated meridional wind + units = m s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[gt0] + standard_name = air_temperature_updated_by_physics + long_name = updated air temperature + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F + +######################################################################## +[ccpp-arg-table] + name = gwdc_post_finalize + type = scheme diff --git a/physics/gwdps.f b/physics/gwdps.f index 8784a2f6d..9454b967d 100644 --- a/physics/gwdps.f +++ b/physics/gwdps.f @@ -2,144 +2,6 @@ !! This file is the parameterization of orographic gravity wave !! drag and mountain blocking. -!> This module contains the CCPP-compliant orographic gravity wave -!! drag pre interstitial codes. - module gwdps_pre - - contains - -!> \section arg_table_gwdps_pre_init Argument Table -!! - subroutine gwdps_pre_init() - end subroutine gwdps_pre_init - -!! \section arg_table_gwdps_pre_run Argument Table -!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | -!! |----------------|-------------------------------------------------------------------------|------------------------------------------------------------------------------------------|---------|------|-----------|-----------|--------|----------| -!! | im | horizontal_loop_extent | horizontal dimension | count | 0 | integer | | in | F | -!! | levs | vertical_dimension | vertical layer dimension | count | 0 | integer | | in | F | -!! | nmtvr | number_of_statistical_measures_of_subgrid_orography | number of statistical measures of subgrid orography | count | 0 | integer | | in | F | -!! | mntvar | statistical_measures_of_subgrid_orography | array of statistical measures of subgrid orography | various | 2 | real | kind_phys | in | F | -!! | hprime | standard_deviation_of_subgrid_orography | standard deviation of subgrid orography | m | 1 | real | kind_phys | out | F | -!! | oc | convexity_of_subgrid_orography | convexity of subgrid orography | none | 1 | real | kind_phys | out | F | -!! | oa4 | asymmetry_of_subgrid_orography | asymmetry of subgrid orography | none | 2 | real | kind_phys | out | F | -!! | clx | fraction_of_grid_box_with_subgrid_orography_higher_than_critical_height | horizontal fraction of grid box covered by subgrid orography higher than critical height | frac | 2 | real | kind_phys | out | F | -!! | theta | angle_from_east_of_maximum_subgrid_orographic_variations | angle with_respect to east of maximum subgrid orographic variations | degrees | 1 | real | kind_phys | out | F | -!! | sigma | slope_of_subgrid_orography | slope of subgrid orography | none | 1 | real | kind_phys | out | F | -!! | gamma | anisotropy_of_subgrid_orography | anisotropy of subgrid orography | none | 1 | real | kind_phys | out | F | -!! | elvmax | maximum_subgrid_orography | maximum of subgrid orography | m | 1 | real | kind_phys | out | F | -!! | lssav | flag_diagnostics | logical flag for storing diagnostics | flag | 0 | logical | | in | F | -!! | ldiag3d | flag_diagnostics_3D | flag for 3d diagnostic fields | flag | 0 | logical | | in | F | -!! | dtdt | tendency_of_air_temperature_due_to_model_physics | updated tendency of the temperature | K s-1 | 2 | real | kind_phys | in | F | -!! | dt3dt | cumulative_change_in_temperature_due_to_orographic_gravity_wave_drag | cumulative change in temperature due to orographic gravity wave drag | K | 2 | real | kind_phys | inout | F | -!! | dtf | time_step_for_dynamics | dynamics timestep | s | 0 | real | kind_phys | in | F | -!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | -!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | -!! -!! \section general General Algorithm -!! \section detailed Detailed Algorithm -!! @{ - subroutine gwdps_pre_run( & - & im, levs, nmtvr, mntvar, & - & hprime, oc, oa4, clx, theta, & - & sigma, gamma, elvmax, lssav, ldiag3d, & - & dtdt, dt3dt, dtf, errmsg, errflg) - - use machine, only : kind_phys - implicit none - - integer, intent(in) :: im, levs, nmtvr - real(kind=kind_phys), intent(in) :: mntvar(im,nmtvr) - - real(kind=kind_phys), intent(out) :: & - & hprime(im), oc(im), oa4(im,4), clx(im,4), & - & theta(im), sigma(im), gamma(im), elvmax(im) & - - logical, intent(in) :: lssav, ldiag3d - real(kind=kind_phys), intent(in) :: dtdt(im,levs) - real(kind=kind_phys), intent(inout) :: dt3dt(im,levs) - real(kind=kind_phys), intent(in) :: dtf - - character(len=*), intent(out) :: errmsg - integer, intent(out) :: errflg - - integer :: i, k - - ! Initialize CCPP error handling variables - errmsg = '' - errflg = 0 - - if (nmtvr == 14) then ! current operational - as of 2014 - hprime(:) = mntvar(:,1) - oc(:) = mntvar(:,2) - oa4(:,1) = mntvar(:,3) - oa4(:,2) = mntvar(:,4) - oa4(:,3) = mntvar(:,5) - oa4(:,4) = mntvar(:,6) - clx(:,1) = mntvar(:,7) - clx(:,2) = mntvar(:,8) - clx(:,3) = mntvar(:,9) - clx(:,4) = mntvar(:,10) - theta(:) = mntvar(:,11) - gamma(:) = mntvar(:,12) - sigma(:) = mntvar(:,13) - elvmax(:) = mntvar(:,14) - elseif (nmtvr == 10) then - hprime(:) = mntvar(:,1) - oc(:) = mntvar(:,2) - oa4(:,1) = mntvar(:,3) - oa4(:,2) = mntvar(:,4) - oa4(:,3) = mntvar(:,5) - oa4(:,4) = mntvar(:,6) - clx(:,1) = mntvar(:,7) - clx(:,2) = mntvar(:,8) - clx(:,3) = mntvar(:,9) - clx(:,4) = mntvar(:,10) - elseif (nmtvr == 6) then - hprime(:) = mntvar(:,1) - oc(:) = mntvar(:,2) - oa4(:,1) = mntvar(:,3) - oa4(:,2) = mntvar(:,4) - oa4(:,3) = mntvar(:,5) - oa4(:,4) = mntvar(:,6) - clx(:,1) = 0.0 - clx(:,2) = 0.0 - clx(:,3) = 0.0 - clx(:,4) = 0.0 - else - hprime = 0 - oc = 0 - oa4 = 0 - clx = 0 - theta = 0 - gamma = 0 - sigma = 0 - elvmax = 0 - endif ! end if_nmtvr - - if (lssav) then - if (ldiag3d) then - do k=1,levs - do i=1,im - dt3dt(i,k) = dt3dt(i,k) - dtdt(i,k)*dtf - enddo - enddo - endif - endif - - end subroutine gwdps_pre_run -!> @} - -! \ingroup GFS_ogwd -! \brief Brief description of the subroutine -! -!> \section arg_table_gwdps_pre_finalize Argument Table -!! - subroutine gwdps_pre_finalize() - end subroutine gwdps_pre_finalize - - end module gwdps_pre - !> This module contains the CCPP-compliant orographic gravity wave dray scheme. module gwdps @@ -150,7 +12,7 @@ module gwdps subroutine gwdps_init() end subroutine gwdps_init -!> \defgroup gfs_gwdps GFS gwdps Main +!> \defgroup gfs_gwdps GFS Orographic Gravity Wave Drag and Mountain Blocking Scheme Module !! \brief This subroutine includes orographic gravity wave drag and mountain !! blocking. !! @@ -160,50 +22,7 @@ end subroutine gwdps_init !! breaking and the presence of critical levels. !! !! \section arg_table_gwdps_run Argument Table -!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | -!! |----------------|-------------------------------------------------------------------------------|----------------------------------------------------------------------------------------------------------|------------|------|-----------|-----------|--------|----------| -!! | im | horizontal_loop_extent | horizontal loop extent | count | 0 | integer | | in | F | -!! | ix | horizontal_dimension | horizontal dimension | count | 0 | integer | | in | F | -!! | km | vertical_dimension | number of vertical layers | count | 0 | integer | | in | F | -!! | A | tendency_of_y_wind_due_to_model_physics | meridional wind tendency due to model physics | m s-2 | 2 | real | kind_phys | inout | F | -!! | B | tendency_of_x_wind_due_to_model_physics | zonal wind tendency due to model physics | m s-2 | 2 | real | kind_phys | inout | F | -!! | C | tendency_of_air_temperature_due_to_model_physics | air temperature tendency due to model physics | K s-1 | 2 | real | kind_phys | inout | F | -!! | u1 | x_wind | zonal wind | m s-1 | 2 | real | kind_phys | in | F | -!! | v1 | y_wind | meridional wind | m s-1 | 2 | real | kind_phys | in | F | -!! | t1 | air_temperature | mid-layer temperature | K | 2 | real | kind_phys | in | F | -!! | q1 | water_vapor_specific_humidity | mid-layer specific humidity of water vapor | kg kg-1 | 2 | real | kind_phys | in | F | -!! | kpbl | vertical_index_at_top_of_atmosphere_boundary_layer | vertical index at top atmospheric boundary layer | index | 1 | integer | | in | F | -!! | prsi | air_pressure_at_interface | interface pressure | Pa | 2 | real | kind_phys | in | F | -!! | del | air_pressure_difference_between_midlayers | difference between mid-layer pressures | Pa | 2 | real | kind_phys | in | F | -!! | prsl | air_pressure | mid-layer pressure | Pa | 2 | real | kind_phys | in | F | -!! | prslk | dimensionless_exner_function_at_model_layers | mid-layer Exner function | none | 2 | real | kind_phys | in | F | -!! | phii | geopotential_at_interface | interface geopotential | m2 s-2 | 2 | real | kind_phys | in | F | -!! | phil | geopotential | mid-layer geopotential | m2 s-2 | 2 | real | kind_phys | in | F | -!! | deltim | time_step_for_physics | physics time step | s | 0 | real | kind_phys | in | F | -!! | kdt | index_of_time_step | current time step index | index | 0 | integer | | in | F | -!! | hprime | standard_deviation_of_subgrid_orography | standard deviation of subgrid orography | m | 1 | real | kind_phys | in | F | -!! | oc | convexity_of_subgrid_orography | convexity of subgrid orography | none | 1 | real | kind_phys | in | F | -!! | oa4 | asymmetry_of_subgrid_orography | asymmetry of subgrid orography | none | 2 | real | kind_phys | in | F | -!! | clx4 | fraction_of_grid_box_with_subgrid_orography_higher_than_critical_height | horizontal fraction of grid box covered by subgrid orography higher than critical height | frac | 2 | real | kind_phys | in | F | -!! | theta | angle_from_east_of_maximum_subgrid_orographic_variations | angle with respect to east of maximum subgrid orographic variations | degrees | 1 | real | kind_phys | in | F | -!! | sigma | slope_of_subgrid_orography | slope of subgrid orography | none | 1 | real | kind_phys | in | F | -!! | gamma | anisotropy_of_subgrid_orography | anisotropy of subgrid orography | none | 1 | real | kind_phys | in | F | -!! | elvmax | maximum_subgrid_orography | maximum of subgrid orography | m | 1 | real | kind_phys | inout | F | -!! | dusfc | instantaneous_x_stress_due_to_gravity_wave_drag | zonal surface stress due to orographic gravity wave drag | Pa | 1 | real | kind_phys | out | F | -!! | dvsfc | instantaneous_y_stress_due_to_gravity_wave_drag | meridional surface stress due to orographic gravity wave drag | Pa | 1 | real | kind_phys | out | F | -!! | g | gravitational_acceleration | gravitational acceleration | m s-2 | 0 | real | kind_phys | in | F | -!! | cp | specific_heat_of_dry_air_at_constant_pressure | specific heat of dry air at constant pressure | J kg-1 K-1 | 0 | real | kind_phys | in | F | -!! | rd | gas_constant_dry_air | ideal gas constant for dry air | J kg-1 K-1 | 0 | real | kind_phys | in | F | -!! | rv | gas_constant_water_vapor | ideal gas constant for water vapor | J kg-1 K-1 | 0 | real | kind_phys | in | F | -!! | imx | number_of_equatorial_longitude_points | number of longitude points along the equator | count | 0 | integer | | in | F | -!! | nmtvr | number_of_statistical_measures_of_subgrid_orography | number of statistical measures of subgrid orography | count | 0 | integer | | in | F | -!! | cdmbgwd | multiplication_factors_for_mountain_blocking_and_orographic_gravity_wave_drag | multiplic. factors for (1) mountain blocking drag coeff. and (2) ref. level orographic gravity wave drag | none | 1 | real | kind_phys | in | F | -!! | me | mpi_rank | rank of the current MPI task | index | 0 | integer | | in | F | -!! | lprnt | flag_print | flag for debugging printouts | flag | 0 | logical | | in | F | -!! | ipr | horizontal_index_of_printed_column | horizontal index of column used in debugging printouts | index | 0 | integer | | in | F | -!! | rdxzb | level_of_dividing_streamline | level of the dividing streamline | none | 1 | real | kind_phys | out | F | -!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | -!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | +!! \htmlinclude gwdps_run.html !! !> \section gen_gwdps GFS Orographic GWD Scheme General Algorithm !! -# Calculate subgrid mountain blocking @@ -480,12 +299,8 @@ subroutine gwdps_run( & ! Interface variables integer, intent(in) :: im, ix, km, imx, kdt, ipr, me integer, intent(in) :: KPBL(IM) ! Index for the PBL top layer! - ! DH* adding intent(in) information for the following variables - ! changes the results on Theia/Intel - skip for bit-for-bit results *DH -! real(kind=kind_phys), intent(in) :: & -! & deltim, G, CP, RD, RV, cdmbgwd(2) - real(kind=kind_phys) deltim, G, CP, RD, RV, cdmbgwd(2) - ! *DH + real(kind=kind_phys), intent(in) :: & + & deltim, G, CP, RD, RV, cdmbgwd(4) real(kind=kind_phys), intent(inout) :: & & A(IX,KM), B(IX,KM), C(IX,KM) real(kind=kind_phys), intent(in) :: & @@ -563,7 +378,8 @@ subroutine gwdps_run( & real(kind=kind_phys) TAUB(IM), XN(IM), YN(IM), UBAR(IM) & &, VBAR(IM), ULOW(IM), OA(IM), CLX(IM) & &, ROLL(IM), ULOI(IM) & - &, DTFAC(IM), XLINV(IM), DELKS(IM), DELKS1(IM) + &, DTFAC(IM), XLINV(IM), DELKS(IM) +! &, DTFAC(IM), XLINV(IM), DELKS(IM), DELKS1(IM) ! real(kind=kind_phys) BNV2(IM,KM), TAUP(IM,KM+1), ri_n(IM,KM) & &, TAUD(IM,KM), RO(IM,KM), VTK(IM,KM) & @@ -573,7 +389,8 @@ subroutine gwdps_run( & ! real(kind=kind_phys) VELKO(KM-1) integer kref(IM), kint(im), iwk(im), ipt(im) ! for lm mtn blocking - integer kreflm(IM), iwklm(im) + integer iwklm(im) +! integer kreflm(IM), iwklm(im) integer idxzb(im), ktrial, klevm1 ! real(kind=kind_phys) gor, gocp, fv, gr2, bnv, fr & @@ -651,7 +468,7 @@ subroutine gwdps_run( & do i=1,npt iwklm(i) = 2 IDXZB(i) = 0 - kreflm(i) = 0 +! kreflm(i) = 0 enddo ! if (lprnt) ! & print *,' in gwdps_lm.f npt,IM,IX,IY,km,me=',npt,IM,IX,IY,km,me @@ -733,14 +550,14 @@ subroutine gwdps_run( & ! DO I = 1, npt J = ipt(i) - DELKS(I) = 1.0 / (PRSI(J,1) - PRSI(J,iwklm(i))) - DELKS1(I) = 1.0 / (PRSL(J,1) - PRSL(J,iwklm(i))) - UBAR (I) = 0.0 - VBAR (I) = 0.0 - ROLL (I) = 0.0 - PE (I) = 0.0 - EK (I) = 0.0 - BNV2bar(I) = (PRSL(J,1)-PRSL(J,2)) * DELKS1(I) * BNV2LM(I,1) + DELKS(I) = 1.0 / (PRSI(J,1) - PRSI(J,iwklm(i))) +! DELKS1(I) = 1.0 / (PRSI(J,1) - PRSL(J,iwklm(i))) + UBAR (I) = 0.0 + VBAR (I) = 0.0 + ROLL (I) = 0.0 + PE (I) = 0.0 + EK (I) = 0.0 + BNV2bar(I) = (PRSI(J,1)-PRSL(J,1)) * DELKS(I) * BNV2LM(I,1) ENDDO ! --- find the dividing stream line height @@ -748,13 +565,13 @@ subroutine gwdps_run( & ! --- iwklm(i) is the k-index of mtn elvmax elevation !> - Find the dividing streamline height starting from the level above !! the maximum mountain height and processing downward. - DO Ktrial = KMLL, 1, -1 - DO I = 1, npt - IF ( Ktrial < iwklm(I) .and. kreflm(I) == 0 ) then - kreflm(I) = Ktrial - ENDIF - ENDDO - ENDDO +! DO Ktrial = KMLL, 1, -1 +! DO I = 1, npt +! IF ( Ktrial < iwklm(I) .and. kreflm(I) == 0 ) then +! kreflm(I) = Ktrial +! ENDIF +! ENDDO +! ENDDO ! print *,' in gwdps_lm.f 4 npt=',npt,kreflm(npt),me ! ! --- in the layer kreflm(I) to 1 find PE (which needs N, ELVMAX) @@ -763,13 +580,17 @@ subroutine gwdps_run( & ! --- is the vert ave of quantities from the surface to mtn top. ! DO I = 1, npt - DO K = 1, Kreflm(I) + DO K = 1, iwklm(i)-1 J = ipt(i) RDELKS = DEL(J,K) * DELKS(I) UBAR(I) = UBAR(I) + RDELKS * U1(J,K) ! trial Mean U below VBAR(I) = VBAR(I) + RDELKS * V1(J,K) ! trial Mean V below ROLL(I) = ROLL(I) + RDELKS * RO(I,K) ! trial Mean RO below - RDELKS = (PRSL(J,K)-PRSL(J,K+1)) * DELKS1(I) + if (k < iwklm(I)-1) then + RDELKS = (PRSL(J,K)-PRSL(J,K+1)) * DELKS(I) + else + RDELKS = (PRSL(J,K)-PRSI(J,K+1)) * DELKS(I) + endif BNV2bar(I) = BNV2bar(I) + BNV2lm(I,K) * RDELKS ! --- these vert ave are for diags, testing and GWD to follow (*j*). ENDDO @@ -1043,14 +864,14 @@ subroutine gwdps_run( & J = ipt(i) kref(I) = MAX(IWK(I), KPBL(J)+1 ) ! reference level DELKS(I) = 1.0 / (PRSI(J,1) - PRSI(J,kref(I))) - DELKS1(I) = 1.0 / (PRSL(J,1) - PRSL(J,kref(I))) +! DELKS1(I) = 1.0 / (PRSI(J,1) - PRSL(J,kref(I))) UBAR (I) = 0.0 VBAR (I) = 0.0 ROLL (I) = 0.0 KBPS = MAX(KBPS, kref(I)) KMPS = MIN(KMPS, kref(I)) ! - BNV2bar(I) = (PRSL(J,1)-PRSL(J,2)) * DELKS1(I) * BNV2(I,1) + BNV2bar(I) = (PRSI(J,1)-PRSL(J,1)) * DELKS(I) * BNV2(I,1) ENDDO ! print *,' in gwdps_lm.f GWD:15 =',KBPS,KMPS KBPSP1 = KBPS + 1 @@ -1064,7 +885,11 @@ subroutine gwdps_run( & VBAR(I) = VBAR(I) + RDELKS * V1(J,K) ! Mean V below kref ! ROLL(I) = ROLL(I) + RDELKS * RO(I,K) ! Mean RO below kref - RDELKS = (PRSL(J,K)-PRSL(J,K+1)) * DELKS1(I) + if (k < kref(i)-1) then + RDELKS = (PRSL(J,K)-PRSL(J,K+1)) * DELKS(I) + else + RDELKS = (PRSL(J,K)-PRSI(J,K+1)) * DELKS(I) + endif BNV2bar(I) = BNV2bar(I) + BNV2(I,K) * RDELKS ENDIF ENDDO @@ -1491,75 +1316,3 @@ subroutine gwdps_finalize() end subroutine gwdps_finalize end module gwdps - -!> This module contains the CCPP-compliant orographic gravity wave drag post -!! interstitial codes. - module gwdps_post - - contains - -!! \section arg_table_gwdps_post_init Argument Table -!! - subroutine gwdps_post_init() - end subroutine gwdps_post_init - -!! \section arg_table_gwdps_post_run Argument Table -!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | -!! |----------------|----------------------------------------------------------------------|--------------------------------------------------------------------------|-------|------|-----------|-----------|--------|----------| -!! | lssav | flag_diagnostics | flag for calculating diagnostic fields | flag | 0 | logical | | in | F | -!! | ldiag3d | flag_diagnostics_3D | flag for calculating 3-D diagnostic fields | flag | 0 | logical | | in | F | -!! | dtf | time_step_for_dynamics | dynamics time step | s | 0 | real | kind_phys | in | F | -!! | dusfcg | instantaneous_x_stress_due_to_gravity_wave_drag | zonal surface stress due to orographic gravity wave drag | Pa | 1 | real | kind_phys | in | F | -!! | dvsfcg | instantaneous_y_stress_due_to_gravity_wave_drag | meridional surface stress due to orographic gravity wave drag | Pa | 1 | real | kind_phys | in | F | -!! | dudt | tendency_of_x_wind_due_to_model_physics | zonal wind tendency due to model physics | m s-2 | 2 | real | kind_phys | in | F | -!! | dvdt | tendency_of_y_wind_due_to_model_physics | meridional wind tendency due to model physics | m s-2 | 2 | real | kind_phys | in | F | -!! | dtdt | tendency_of_air_temperature_due_to_model_physics | air temperature tendency due to model physics | K s-1 | 2 | real | kind_phys | in | F | -!! | dugwd | time_integral_of_x_stress_due_to_gravity_wave_drag | integral over time of zonal stress due to gravity wave drag | Pa s | 1 | real | kind_phys | inout | F | -!! | dvgwd | time_integral_of_y_stress_due_to_gravity_wave_drag | integral over time of meridional stress due to gravity wave drag | Pa s | 1 | real | kind_phys | inout | F | -!! | du3dt | cumulative_change_in_x_wind_due_to_orographic_gravity_wave_drag | cumulative change in zonal wind due to orographic gravity wave drag | m s-1 | 2 | real | kind_phys | inout | F | -!! | dv3dt | cumulative_change_in_y_wind_due_to_orographic_gravity_wave_drag | cumulative change in meridional wind due to orographic gravity wave drag | m s-1 | 2 | real | kind_phys | inout | F | -!! | dt3dt | cumulative_change_in_temperature_due_to_orographic_gravity_wave_drag | cumulative change in temperature due to orographic gravity wave drag | K | 2 | real | kind_phys | inout | F | -!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | -!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | -!! - subroutine gwdps_post_run( & - & lssav, ldiag3d, dtf, dusfcg, dvsfcg, dudt, dvdt, dtdt, & - & dugwd, dvgwd, du3dt, dv3dt, dt3dt, errmsg, errflg) - - use machine, only : kind_phys - implicit none - - logical, intent(in) :: lssav, ldiag3d - real(kind=kind_phys), intent(in) :: dtf - real(kind=kind_phys), intent(in) :: & - & dusfcg(:), dvsfcg(:), dudt(:,:), dvdt(:,:), dtdt(:,:) - - real(kind=kind_phys), intent(inout) :: & - & dugwd(:), dvgwd(:), du3dt(:,:), dv3dt(:,:), dt3dt(:,:) - - character(len=*), intent(out) :: errmsg - integer, intent(out) :: errflg - - ! Initialize CCPP error handling variables - errmsg = '' - errflg = 0 - - if (lssav) then - dugwd(:) = dugwd(:) + dusfcg(:)*dtf - dvgwd(:) = dvgwd(:) + dvsfcg(:)*dtf - - if (ldiag3d) then - du3dt(:,:) = du3dt(:,:) + dudt(:,:) * dtf - dv3dt(:,:) = dv3dt(:,:) + dvdt(:,:) * dtf - dt3dt(:,:) = dt3dt(:,:) + dtdt(:,:) * dtf - endif - endif - - end subroutine gwdps_post_run - -!> \section arg_table_gwdps_post_finalize Argument Table -!! - subroutine gwdps_post_finalize() - end subroutine gwdps_post_finalize - - end module gwdps_post diff --git a/physics/gwdps.meta b/physics/gwdps.meta new file mode 100644 index 000000000..677dc6502 --- /dev/null +++ b/physics/gwdps.meta @@ -0,0 +1,380 @@ +[ccpp-arg-table] + name = gwdps_init + type = scheme + +######################################################################## +[ccpp-arg-table] + name = gwdps_run + type = scheme +[im] + standard_name = horizontal_loop_extent + long_name = horizontal loop extent + units = count + dimensions = () + type = integer + intent = in + optional = F +[ix] + standard_name = horizontal_dimension + long_name = horizontal dimension + units = count + dimensions = () + type = integer + intent = in + optional = F +[km] + standard_name = vertical_dimension + long_name = number of vertical layers + units = count + dimensions = () + type = integer + intent = in + optional = F +[A] + standard_name = tendency_of_y_wind_due_to_model_physics + long_name = meridional wind tendency due to model physics + units = m s-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[B] + standard_name = tendency_of_x_wind_due_to_model_physics + long_name = zonal wind tendency due to model physics + units = m s-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[C] + standard_name = tendency_of_air_temperature_due_to_model_physics + long_name = air temperature tendency due to model physics + units = K s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[u1] + standard_name = x_wind + long_name = zonal wind + units = m s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[v1] + standard_name = y_wind + long_name = meridional wind + units = m s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[t1] + standard_name = air_temperature + long_name = mid-layer temperature + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[q1] + standard_name = water_vapor_specific_humidity + long_name = mid-layer specific humidity of water vapor + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[kpbl] + standard_name = vertical_index_at_top_of_atmosphere_boundary_layer + long_name = vertical index at top atmospheric boundary layer + units = index + dimensions = (horizontal_dimension) + type = integer + intent = in + optional = F +[prsi] + standard_name = air_pressure_at_interface + long_name = interface pressure + units = Pa + dimensions = (horizontal_dimension,vertical_dimension_plus_one) + type = real + kind = kind_phys + intent = in + optional = F +[del] + standard_name = air_pressure_difference_between_midlayers + long_name = difference between mid-layer pressures + units = Pa + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[prsl] + standard_name = air_pressure + long_name = mid-layer pressure + units = Pa + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[prslk] + standard_name = dimensionless_exner_function_at_model_layers + long_name = mid-layer Exner function + units = none + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[phii] + standard_name = geopotential_at_interface + long_name = interface geopotential + units = m2 s-2 + dimensions = (horizontal_dimension,vertical_dimension_plus_one) + type = real + kind = kind_phys + intent = in + optional = F +[phil] + standard_name = geopotential + long_name = mid-layer geopotential + units = m2 s-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[deltim] + standard_name = time_step_for_physics + long_name = physics time step + units = s + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[kdt] + standard_name = index_of_time_step + long_name = current time step index + units = index + dimensions = () + type = integer + intent = in + optional = F +[hprime] + standard_name = standard_deviation_of_subgrid_orography + long_name = standard deviation of subgrid orography + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[oc] + standard_name = convexity_of_subgrid_orography + long_name = convexity of subgrid orography + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[oa4] + standard_name = asymmetry_of_subgrid_orography + long_name = asymmetry of subgrid orography + units = none + dimensions = (horizontal_dimension,4) + type = real + kind = kind_phys + intent = in + optional = F +[clx4] + standard_name = fraction_of_grid_box_with_subgrid_orography_higher_than_critical_height + long_name = horizontal fraction of grid box covered by subgrid orography higher than critical height + units = frac + dimensions = (horizontal_dimension,4) + type = real + kind = kind_phys + intent = in + optional = F +[theta] + standard_name = angle_from_east_of_maximum_subgrid_orographic_variations + long_name = angle with respect to east of maximum subgrid orographic variations + units = degrees + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[sigma] + standard_name = slope_of_subgrid_orography + long_name = slope of subgrid orography + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[gamma] + standard_name = anisotropy_of_subgrid_orography + long_name = anisotropy of subgrid orography + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[elvmax] + standard_name = maximum_subgrid_orography + long_name = maximum of subgrid orography + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[dusfc] + standard_name = instantaneous_x_stress_due_to_gravity_wave_drag + long_name = zonal surface stress due to orographic gravity wave drag + units = Pa + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[dvsfc] + standard_name = instantaneous_y_stress_due_to_gravity_wave_drag + long_name = meridional surface stress due to orographic gravity wave drag + units = Pa + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[g] + standard_name = gravitational_acceleration + long_name = gravitational acceleration + units = m s-2 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[cp] + standard_name = specific_heat_of_dry_air_at_constant_pressure + long_name = specific heat of dry air at constant pressure + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[rd] + standard_name = gas_constant_dry_air + long_name = ideal gas constant for dry air + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[rv] + standard_name = gas_constant_water_vapor + long_name = ideal gas constant for water vapor + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[imx] + standard_name = number_of_equatorial_longitude_points + long_name = number of longitude points along the equator + units = count + dimensions = () + type = integer + intent = in + optional = F +[nmtvr] + standard_name = number_of_statistical_measures_of_subgrid_orography + long_name = number of statistical measures of subgrid orography + units = count + dimensions = () + type = integer + intent = in + optional = F +[cdmbgwd] + standard_name = multiplication_factors_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 = (4) + type = real + kind = kind_phys + intent = in + optional = F +[me] + standard_name = mpi_rank + long_name = rank of the current MPI task + units = index + dimensions = () + type = integer + intent = in + optional = F +[lprnt] + standard_name = flag_print + long_name = flag for debugging printouts + units = flag + dimensions = () + type = logical + intent = in + optional = F +[ipr] + standard_name = horizontal_index_of_printed_column + long_name = horizontal index of column used in debugging printouts + units = index + dimensions = () + type = integer + intent = in + optional = F +[rdxzb] + standard_name = level_of_dividing_streamline + long_name = level of the dividing streamline + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F + +######################################################################## +[ccpp-arg-table] + name = gwdps_finalize + type = scheme diff --git a/physics/h2ophys.f b/physics/h2ophys.f index 51e3a6051..929b38aa7 100644 --- a/physics/h2ophys.f +++ b/physics/h2ophys.f @@ -19,25 +19,10 @@ module h2ophys subroutine h2ophys_init() end subroutine h2ophys_init -!>\defgroup GFS_h2ophys GFS h2ophys Main +!>\defgroup GFS_h2ophys GFS Water Vapor Photochemical Production and Loss Module !> This subroutine is NRL H2O physics for stratosphere and mesosphere. !! \section arg_table_h2ophys_run Argument Table -!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | -!! |----------------|---------------------------------------------------|---------------------------------------------------|---------|------|-----------|-----------|--------|----------| -!! | ix | horizontal_dimension | horizontal dimension | count | 0 | integer | | in | F | -!! | im | horizontal_loop_extent | horizontal loop extent | count | 0 | integer | | in | F | -!! | levs | vertical_dimension | number of vertical layers | count | 0 | integer | | in | F | -!! | kh2o | vertical_dimension_of_h2o_forcing_data | number of vertical layers in h2o forcing data | count | 0 | integer | | in | F | -!! | dt | time_step_for_physics | physics time step | s | 0 | real | kind_phys | in | F | -!! | h2o | water_vapor_specific_humidity_updated_by_physics | water vapor specific humidity updated by physics | kg kg-1 | 2 | real | kind_phys | inout | F | -!! | ph2o | natural_log_of_h2o_forcing_data_pressure_levels | natural log of h2o forcing data pressure levels | log(Pa) | 1 | real | kind_phys | in | F | -!! | prsl | air_pressure | mid-layer pressure | Pa | 2 | real | kind_phys | in | F | -!! | h2opltc | h2o_forcing | water forcing data | various | 3 | real | kind_phys | in | F | -!! | h2o_coeff | number_of_coefficients_in_h2o_forcing_data | number of coefficients in h2o forcing data | index | 0 | integer | | in | F | -!! | ldiag3d | flag_diagnostics_3D | flag for calculating 3-D diagnostic fields | flag | 0 | logical | | in | F | -!! | me | mpi_rank | rank of the current MPI task | index | 0 | integer | | in | F | -!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | -!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | +!! \htmlinclude h2ophys_run.html !! !! \section genal_h2ophys GFS H2O Physics Scheme General Algorithm !> @{ diff --git a/physics/h2ophys.meta b/physics/h2ophys.meta new file mode 100644 index 000000000..9aed54eb2 --- /dev/null +++ b/physics/h2ophys.meta @@ -0,0 +1,131 @@ +[ccpp-arg-table] + name = h2ophys_init + type = scheme + +######################################################################## +[ccpp-arg-table] + name = h2ophys_run + type = scheme +[ix] + standard_name = horizontal_dimension + long_name = horizontal dimension + units = count + dimensions = () + type = integer + intent = in + optional = F +[im] + standard_name = horizontal_loop_extent + long_name = horizontal loop extent + units = count + dimensions = () + type = integer + intent = in + optional = F +[levs] + standard_name = vertical_dimension + long_name = number of vertical layers + units = count + dimensions = () + type = integer + intent = in + optional = F +[kh2o] + standard_name = vertical_dimension_of_h2o_forcing_data + long_name = number of vertical layers in h2o forcing data + units = count + dimensions = () + type = integer + intent = in + optional = F +[dt] + standard_name = time_step_for_physics + long_name = physics time step + units = s + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[h2o] + standard_name = water_vapor_specific_humidity_updated_by_physics + long_name = water vapor specific humidity updated by physics + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[ph2o] + standard_name = natural_log_of_h2o_forcing_data_pressure_levels + long_name = natural log of h2o forcing data pressure levels + units = log(Pa) + dimensions = (vertical_dimension_of_h2o_forcing_data) + type = real + kind = kind_phys + intent = in + optional = F +[prsl] + standard_name = air_pressure + long_name = mid-layer pressure + units = Pa + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[h2opltc] + standard_name = h2o_forcing + long_name = water forcing data + units = various + dimensions = (horizontal_dimension,vertical_dimension_of_h2o_forcing_data,number_of_coefficients_in_h2o_forcing_data) + type = real + kind = kind_phys + intent = in + optional = F +[h2o_coeff] + standard_name = number_of_coefficients_in_h2o_forcing_data + long_name = number of coefficients in h2o forcing data + units = index + dimensions = () + type = integer + intent = in + optional = F +[ldiag3d] + standard_name = flag_diagnostics_3D + long_name = flag for calculating 3-D diagnostic fields + units = flag + dimensions = () + type = logical + intent = in + optional = F +[me] + standard_name = mpi_rank + long_name = rank of the current MPI task + units = index + dimensions = () + type = integer + intent = in + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F + +######################################################################## +[ccpp-arg-table] + name = h2ophys_finalize + type = scheme diff --git a/physics/lsm_ruc_sfc_sice_interstitial.F90 b/physics/lsm_ruc_sfc_sice_interstitial.F90 new file mode 100644 index 000000000..63f006f1e --- /dev/null +++ b/physics/lsm_ruc_sfc_sice_interstitial.F90 @@ -0,0 +1,113 @@ +module lsm_ruc_sfc_sice_pre + + use machine, only: kind_phys + + implicit none + + private + + public :: lsm_ruc_sfc_sice_pre_init, lsm_ruc_sfc_sice_pre_run, lsm_ruc_sfc_sice_pre_finalize + +contains + + subroutine lsm_ruc_sfc_sice_pre_init () + end subroutine lsm_ruc_sfc_sice_pre_init + + subroutine lsm_ruc_sfc_sice_pre_finalize () + end subroutine lsm_ruc_sfc_sice_pre_finalize + +#if 0 +!> \section arg_table_lsm_ruc_sfc_sice_pre_run Argument Table +!! \htmlinclude lsm_ruc_sfc_sice_pre_run.html +!! +#endif + subroutine lsm_ruc_sfc_sice_pre_run(im, lsoil_ruc, lsoil, land, stc, tslb, errmsg, errflg) + + implicit none + + ! Interface variables + integer, intent(in) :: im, lsoil_ruc, lsoil + logical, dimension(im), intent(in) :: land +! --- on Noah levels + real (kind=kind_phys), dimension(im,lsoil), intent(inout) :: stc +! --- on RUC levels + real (kind=kind_phys), dimension(im,lsoil_ruc), intent(in) :: tslb + + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! Local variables + integer :: i, k + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + do i=1,im + if (.not.land(i)) then + do k=1,min(lsoil,lsoil_ruc) + stc(i,k) = tslb(i,k) + end do + end if + end do + + end subroutine lsm_ruc_sfc_sice_pre_run + +end module lsm_ruc_sfc_sice_pre + +module lsm_ruc_sfc_sice_post + + use machine, only: kind_phys + + implicit none + + private + + public :: lsm_ruc_sfc_sice_post_init, lsm_ruc_sfc_sice_post_run, lsm_ruc_sfc_sice_post_finalize + +contains + + subroutine lsm_ruc_sfc_sice_post_init () + end subroutine lsm_ruc_sfc_sice_post_init + + subroutine lsm_ruc_sfc_sice_post_finalize () + end subroutine lsm_ruc_sfc_sice_post_finalize + +#if 0 +!> \section arg_table_lsm_ruc_sfc_sice_post_run Argument Table +!! \htmlinclude lsm_ruc_sfc_sice_post_run.html +!! +#endif + subroutine lsm_ruc_sfc_sice_post_run(im, lsoil_ruc, lsoil, land, stc, tslb, errmsg, errflg) + + implicit none + + ! Interface variables + integer, intent(in) :: im, lsoil_ruc, lsoil + logical, dimension(im), intent(in) :: land +! --- on Noah levels + real (kind=kind_phys), dimension(im,lsoil), intent(in) :: stc +! --- on RUC levels + real (kind=kind_phys), dimension(im,lsoil_ruc), intent(inout) :: tslb + + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! Local variables + integer :: i, k + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + do i=1,im + if (.not.land(i)) then + do k=1,min(lsoil,lsoil_ruc) + tslb(i,k) = stc(i,k) + end do + end if + end do + + end subroutine lsm_ruc_sfc_sice_post_run + +end module lsm_ruc_sfc_sice_post diff --git a/physics/lsm_ruc_sfc_sice_interstitial.meta b/physics/lsm_ruc_sfc_sice_interstitial.meta new file mode 100644 index 000000000..c105abe9d --- /dev/null +++ b/physics/lsm_ruc_sfc_sice_interstitial.meta @@ -0,0 +1,142 @@ +[ccpp-arg-table] + name = lsm_ruc_sfc_sice_pre_run + type = scheme +[im] + standard_name = horizontal_loop_extent + long_name = horizontal loop extent + units = count + dimensions = () + type = integer + intent = in + optional = F +[lsoil_ruc] + standard_name = soil_vertical_dimension_for_land_surface_model + long_name = number of soil layers internal to land surface model + units = count + dimensions = () + type = integer + intent = in + optional = F +[lsoil] + standard_name = soil_vertical_dimension + long_name = soil vertical layer dimension + units = count + dimensions = () + type = integer + intent = in + optional = F +[land] + standard_name = flag_nonzero_land_surface_fraction + long_name = flag indicating presence of some land surface area fraction + units = flag + dimensions = (horizontal_dimension) + type = logical + intent = in + optional = F +[stc] + standard_name = soil_temperature + long_name = soil temperature + units = K + dimensions = (horizontal_dimension,soil_vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[tslb] + standard_name = soil_temperature_for_land_surface_model + long_name = soil temperature for land surface model + units = K + dimensions = (horizontal_dimension,soil_vertical_dimension_for_land_surface_model) + type = real + kind = kind_phys + intent = in + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F + +######################################################################## +[ccpp-arg-table] + name = lsm_ruc_sfc_sice_post_run + type = scheme +[im] + standard_name = horizontal_loop_extent + long_name = horizontal loop extent + units = count + dimensions = () + type = integer + intent = in + optional = F +[lsoil_ruc] + standard_name = soil_vertical_dimension_for_land_surface_model + long_name = number of soil layers internal to land surface model + units = count + dimensions = () + type = integer + intent = in + optional = F +[lsoil] + standard_name = soil_vertical_dimension + long_name = soil vertical layer dimension + units = count + dimensions = () + type = integer + intent = in + optional = F +[land] + standard_name = flag_nonzero_land_surface_fraction + long_name = flag indicating presence of some land surface area fraction + units = flag + dimensions = (horizontal_dimension) + type = logical + intent = in + optional = F +[stc] + standard_name = soil_temperature + long_name = soil temperature + units = K + dimensions = (horizontal_dimension,soil_vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[tslb] + standard_name = soil_temperature_for_land_surface_model + long_name = soil temperature for land surface model + units = K + dimensions = (horizontal_dimension,soil_vertical_dimension_for_land_surface_model) + type = real + kind = kind_phys + intent = inout + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F diff --git a/physics/m_micro.F90 b/physics/m_micro.F90 index f973842f0..f0947b9b4 100644 --- a/physics/m_micro.F90 +++ b/physics/m_micro.F90 @@ -17,44 +17,10 @@ module m_micro !>\ingroup mg_driver !! This subroutine is the MG initialization. !> \section arg_table_m_micro_init Argument Table -!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | -!! |------------------------|-------------------------------------------------|---------------------------------------------------------------------------------------------|-------------|------|------------|-----------|--------|----------| -!! | imp_physics | flag_for_microphysics_scheme | choice of microphysics scheme | flag | 0 | integer | | in | F | -!! | imp_physics_mg | flag_for_morrison_gettelman_microphysics_scheme | choice of Morrison-Gettelman rmicrophysics scheme | flag | 0 | integer | | in | F | -!! | fprcp | number_of_frozen_precipitation_species | number of frozen precipitation species | count | 0 | integer | | in | F | -!! | gravit | gravitational_acceleration | gravitational acceleration | m s-2 | 0 | real | kind_phys | in | F | -!! | rair | gas_constant_dry_air | ideal gas constant for dry air | J kg-1 K-1 | 0 | real | kind_phys | in | F | -!! | rh2o | gas_constant_water_vapor | ideal gas constant for water vapor | J kg-1 K-1 | 0 | real | kind_phys | in | F | -!! | cpair | specific_heat_of_dry_air_at_constant_pressure | specific heat of dry air at constant pressure | J kg-1 K-1 | 0 | real | kind_phys | in | F | -!! | tmelt | triple_point_temperature_of_water | triple point temperature of water | K | 0 | real | kind_phys | in | F | -!! | latvap | latent_heat_of_vaporization_of_water_at_0C | latent heat of evaporation/sublimation | J kg-1 | 0 | real | kind_phys | in | F | -!! | latice | latent_heat_of_fusion_of_water_at_0C | latent heat of fusion | J kg-1 | 0 | real | kind_phys | in | F | -!! | mg_dcs | mg_autoconversion_size_threshold_ice_snow | autoconversion size threshold for cloud ice to snow for MG microphysics | um | 0 | real | kind_phys | in | F | -!! | mg_qcvar | mg_cloud_water_variance | cloud water relative variance for MG microphysics | | 0 | real | kind_phys | in | F | -!! | mg_ts_auto_ice | mg_time_scale_for_autoconversion_of_ice | autoconversion time scale for ice for MG microphysics | s | 1 | real | kind_phys | in | F | -!! | mg_rhmini | mg_minimum_rh_for_ice | relative humidity threshold parameter for nucleating ice for MG microphysics | none | 0 | real | kind_phys | in | F | -!! | microp_uniform | mg_flag_for_uniform_subcolumns | flag for uniform subcolumns for MG microphysics | flag | 0 | logical | | in | F | -!! | do_cldice | mg_flag_for_cloud_ice_processes | flag for cloud ice processes for MG microphysics | flag | 0 | logical | | in | F | -!! | hetfrz_classnuc | mg_flag_for_heterogeneous_freezing | flag for heterogeneous freezing for MG microphysics | flag | 0 | logical | | in | F | -!! | mg_precip_frac_method | mg_type_of_precip_fraction_method | type of precip fraction method for MG microphysics (in_cloud or max_overlap) | none | 0 | character | len=16 | in | F | -!! | mg_berg_eff_factor | mg_bergeron_efficiency_factor | bergeron efficiency factor for MG microphysics | frac | 0 | real | kind_phys | in | F | -!! | sed_supersat | mg_allow_supersat_after_sed | allow supersaturation after sedimentation for MG microphysics | flag | 0 | logical | | in | F | -!! | do_sb_physics | mg_flag_for_sb2001_autoconversion | flag for SB 2001 autoconversion or accretion for MG microphysics | flag | 0 | logical | | in | F | -!! | mg_do_hail | mg_flag_for_hail | flag for hail for MG microphysics (graupel possible if false) | flag | 0 | logical | | in | F | -!! | mg_do_graupel | mg_flag_for_graupel | flag for graupel for MG microphysics (hail possible if false) | flag | 0 | logical | | in | F | -!! | mg_nccons | mg_flag_drop_concentration_constant | flag for constant droplet concentration for MG microphysics | flag | 0 | logical | | in | F | -!! | mg_nicons | mg_flag_ice_concentration_constant | flag for constant ice concentration for MG microphysics | flag | 0 | logical | | in | F | -!! | mg_ngcons | mg_flag_graupel_concentration_constant | flag for constant graupel concentration for MG microphysics | flag | 0 | logical | | in | F | -!! | mg_ncnst | mg_drop_concentration_constant | droplet concentration constant for MG microphysics | m-3 | 0 | real | kind_phys | in | F | -!! | mg_ninst | mg_ice_concentration_constant | ice concentration constant for MG microphysics | m-3 | 0 | real | kind_phys | in | F | -!! | mg_ngnst | mg_graupel_concentration_constant | graupel concentration constant for MG microphysics | m-3 | 0 | real | kind_phys | in | F | -!! | mg_do_ice_gmao | mg_flag_for_gmao_ice_formulation | flag for gmao ice formulation | flag | 0 | logical | | in | F | -!! | mg_do_liq_liu | mg_flag_for_liu_liquid_treatment | flag for liu liquid treatment | flag | 0 | logical | | in | F | -!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | -!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | +!! \htmlinclude m_micro_init.html !! subroutine m_micro_init(imp_physics, imp_physics_mg, fprcp, gravit, rair, rh2o, cpair,& - tmelt, latvap, latice, mg_dcs, mg_qcvar, mg_ts_auto_ice, & + eps, tmelt, latvap, latice, mg_dcs, mg_qcvar, mg_ts_auto_ice, & mg_rhmini, microp_uniform, do_cldice, hetfrz_classnuc, & mg_precip_frac_method, mg_berg_eff_factor, sed_supersat, & do_sb_physics, mg_do_hail, mg_do_graupel, mg_nccons, & @@ -72,7 +38,7 @@ subroutine m_micro_init(imp_physics, imp_physics_mg, fprcp, gravit, rair, rh2o, sed_supersat, do_sb_physics, mg_do_hail, & mg_do_graupel, mg_nccons, mg_nicons, mg_ngcons, & mg_do_ice_gmao, mg_do_liq_liu - real(kind=kind_phys), intent(in) :: gravit, rair, rh2o, cpair, tmelt, latvap, latice + real(kind=kind_phys), intent(in) :: gravit, rair, rh2o, cpair, eps, tmelt, latvap, latice real(kind=kind_phys), intent(in) :: mg_dcs, mg_qcvar, mg_ts_auto_ice(2), mg_rhmini, & mg_berg_eff_factor, mg_ncnst, mg_ninst, mg_ngnst character(len=16), intent(in) :: mg_precip_frac_method @@ -84,7 +50,7 @@ subroutine m_micro_init(imp_physics, imp_physics_mg, fprcp, gravit, rair, rh2o, if (is_initialized) return - if (imp_physics/=imp_physics_mg) then + if (imp_physics /= imp_physics_mg) then write(errmsg,'(*(a))') "Logic error: namelist choice of microphysics is different from Morrison-Gettelman MP" errflg = 1 return @@ -94,20 +60,20 @@ subroutine m_micro_init(imp_physics, imp_physics_mg, fprcp, gravit, rair, rh2o, call ini_micro (mg_dcs, mg_qcvar, mg_ts_auto_ice(1)) elseif (fprcp == 1) then call micro_mg_init2_0(kind_phys, gravit, rair, rh2o, cpair, & - tmelt, latvap, latice, mg_rhmini, & + eps, tmelt, latvap, latice, mg_rhmini,& mg_dcs, mg_ts_auto_ice, & mg_qcvar, & microp_uniform, do_cldice, & hetfrz_classnuc, & mg_precip_frac_method, & mg_berg_eff_factor, & - sed_supersat, do_sb_physics, & + sed_supersat, do_sb_physics, & mg_do_ice_gmao, mg_do_liq_liu, & - mg_nccons, mg_nicons, & - mg_ncnst, mg_ninst) + mg_nccons, mg_nicons, & + mg_ncnst, mg_ninst) elseif (fprcp == 2) then call micro_mg_init3_0(kind_phys, gravit, rair, rh2o, cpair, & - tmelt, latvap, latice, mg_rhmini, & + eps, tmelt, latvap, latice, mg_rhmini,& mg_dcs, mg_ts_auto_ice, & mg_qcvar, & mg_do_hail, mg_do_graupel, & @@ -115,11 +81,11 @@ subroutine m_micro_init(imp_physics, imp_physics_mg, fprcp, gravit, rair, rh2o, hetfrz_classnuc, & mg_precip_frac_method, & mg_berg_eff_factor, & - sed_supersat, do_sb_physics, & + sed_supersat, do_sb_physics, & mg_do_ice_gmao, mg_do_liq_liu, & - mg_nccons, mg_nicons, & - mg_ncnst, mg_ninst, & - mg_ngcons, mg_ngnst) + mg_nccons, mg_nicons, & + mg_ncnst, mg_ninst, & + mg_ngcons, mg_ngnst) else write(0,*)' fprcp = ',fprcp,' is not a valid option - aborting' stop @@ -137,7 +103,7 @@ end subroutine m_micro_init subroutine m_micro_finalize end subroutine m_micro_finalize -!> \defgroup mg2mg3 CPT Morrison-Gettelman MP scheme Module +!> \defgroup mg2mg3 Morrison-Gettelman MP scheme Module !! This module contains the the entity of MG2 and MG3 schemes. !> @{ !> \defgroup mg_driver Morrison-Gettelman MP Driver Module @@ -147,79 +113,7 @@ end subroutine m_micro_finalize #if 0 !> \section arg_table_m_micro_run Argument Table -!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | -!! |----------------|-----------------------------------------------------------------------------|---------------------------------------------------------------------------------------------|-------------|------|------------|-----------|--------|----------| -!! | im | horizontal_loop_extent | horizontal loop extent | count | 0 | integer | | in | F | -!! | ix | horizontal_dimension | horizontal dimension | count | 0 | integer | | in | F | -!! | lm | vertical_dimension | vertical layer dimension | count | 0 | integer | | in | F | -!! | flipv | flag_flip | vertical flip logical | flag | 0 | logical | | in | F | -!! | dt_i | time_step_for_physics | physics time step | s | 0 | real | kind_phys | in | F | -!! | prsl_i | air_pressure | layer mean pressure | Pa | 2 | real | kind_phys | in | F | -!! | prsi_i | air_pressure_at_interface | air pressure at model layer interfaces | Pa | 2 | real | kind_phys | in | F | -!! | phil | geopotential | geopotential at model layer centers | m2 s-2 | 2 | real | kind_phys | in | F | -!! | phii | geopotential_at_interface | geopotential at model layer interfaces | m2 s-2 | 2 | real | kind_phys | in | F | -!! | omega_i | omega | layer mean vertical velocity | Pa s-1 | 2 | real | kind_phys | in | F | -!! | qlls_i | cloud_condensed_water_mixing_ratio_convective_transport_tracer | moist (dry+vapor, no condensates) mixing ratio of cloud water (condensate) in the convectively transported tracer array | kg kg-1 | 2 | real | kind_phys | in | F | -!! | qlcn_i | mass_fraction_of_convective_cloud_liquid_water | mass fraction of convective cloud liquid water | kg kg-1 | 2 | real | kind_phys | in | F | -!! | qils_i | ice_water_mixing_ratio_convective_transport_tracer | moist (dry+vapor, no condensates) mixing ratio of ice water in the convectively transported tracer array | kg kg-1 | 2 | real | kind_phys | in | F | -!! | qicn_i | mass_fraction_of_convective_cloud_ice | mass fraction of convective cloud ice water | kg kg-1 | 2 | real | kind_phys | in | F | -!! | lwheat_i | tendency_of_air_temperature_due_to_longwave_heating_on_radiation_timestep | total sky lw heating rate | K s-1 | 2 | real | kind_phys | in | F | -!! | swheat_i | tendency_of_air_temperature_due_to_shortwave_heating_on_radiation_timestep | total sky sw heating rate | K s-1 | 2 | real | kind_phys | in | F | -!! | w_upi | vertical_velocity_for_updraft | vertical velocity for updraft | m s-1 | 2 | real | kind_phys | in | F | -!! | cf_upi | convective_cloud_fraction_for_microphysics | convective cloud fraction for microphysics | frac | 2 | real | kind_phys | in | F | -!! | frland | land_area_fraction_for_microphysics | land area fraction used in microphysics schemes | frac | 1 | real | kind_phys | in | F | -!! | zpbl | atmosphere_boundary_layer_thickness | pbl height | m | 1 | real | kind_phys | in | F | -!! | cnv_mfd_i | detrained_mass_flux | detrained mass flux | kg m-2 s-1 | 2 | real | kind_phys | in | F | -!! | cnv_dqldt_i | tendency_of_cloud_water_due_to_convective_microphysics | tendency of cloud water due to convective microphysics | kg m-2 s-1 | 2 | real | kind_phys | in | F | -!! | clcn_i | convective_cloud_volume_fraction | convective cloud volume fraction | frac | 2 | real | kind_phys | in | F | -!! | u_i | x_wind_updated_by_physics | zonal wind updated by physics | m s-1 | 2 | real | kind_phys | in | F | -!! | v_i | y_wind_updated_by_physics | meridional wind updated by physics | m s-1 | 2 | real | kind_phys | in | F | -!! | taugwx | cumulative_surface_x_momentum_flux_for_diag_multiplied_by_timestep | cumulative sfc x momentum flux multiplied by timestep | Pa s | 1 | real | kind_phys | in | F | -!! | taugwy | cumulative_surface_y_momentum_flux_for_diag_multiplied_by_timestep | cumulative sfc y momentum flux multiplied by timestep | Pa s | 1 | real | kind_phys | in | F | -!! | tauorox | instantaneous_surface_x_momentum_flux | x momentum flux | Pa | 1 | real | kind_phys | in | F | -!! | tauoroy | instantaneous_surface_y_momentum_flux | y momentum flux | Pa | 1 | real | kind_phys | in | F | -!! | cnv_fice_i | ice_fraction_in_convective_tower | ice fraction in convective tower | frac | 2 | real | kind_phys | in | F | -!! | cnv_ndrop_i | number_concentration_of_cloud_liquid_water_particles_for_detrainment | droplet number concentration in convective detrainment | m-3 | 2 | real | kind_phys | in | F | -!! | cnv_nice_i | number_concentration_of_ice_crystals_for_detrainment | crystal number concentration in convective detrainment | m-3 | 2 | real | kind_phys | in | F | -!! | q_io | water_vapor_specific_humidity_updated_by_physics | water vapor specific humidity updated by physics | kg kg-1 | 2 | real | kind_phys | inout | F | -!! | lwm_o | cloud_condensed_water_mixing_ratio_updated_by_physics | moist (dry+vapor, no condensates) mixing ratio of cloud condensed water updated by physics | kg kg-1 | 2 | real | kind_phys | out | F | -!! | qi_o | ice_water_mixing_ratio_updated_by_physics | moist (dry+vapor, no condensates) mixing ratio of ice water updated by physics | kg kg-1 | 2 | real | kind_phys | out | F | -!! | t_io | air_temperature_updated_by_physics | temperature updated by physics | K | 2 | real | kind_phys | inout | F | -!! | rn_o | lwe_thickness_of_explicit_precipitation_amount | explicit precipitation (rain, ice, snow, graupel, ...) on physics timestep | m | 1 | real | kind_phys | out | F | -!! | sr_o | ratio_of_snowfall_to_rainfall | snow ratio: ratio of snow to total precipitation | frac | 1 | real | kind_phys | out | F | -!! | ncpl_io | cloud_droplet_number_concentration_updated_by_physics | number concentration of cloud droplets updated by physics | kg-1 | 2 | real | kind_phys | inout | F | -!! | ncpi_io | ice_number_concentration_updated_by_physics | number concentration of ice updated by physics | kg-1 | 2 | real | kind_phys | inout | F | -!! | fprcp | number_of_frozen_precipitation_species | number of frozen precipitation species | count | 0 | integer | | in | F | -!! | rnw_io | local_rain_water_mixing_ratio | moist (dry+vapor, no condensates) mixing ratio of rain water local to physics | kg kg-1 | 2 | real | kind_phys | inout | F | -!! | snw_io | local_snow_water_mixing_ratio | moist (dry+vapor, no condensates) mixing ratio of snow water local to physics | kg kg-1 | 2 | real | kind_phys | inout | F | -!! | qgl_io | local_graupel_mixing_ratio | moist (dry+vapor, no condensates) mixing ratio of graupel local to physics | kg kg-1 | 2 | real | kind_phys | inout | F | -!! | ncpr_io | local_rain_number_concentration | number concentration of rain local to physics | kg-1 | 2 | real | kind_phys | inout | F | -!! | ncps_io | local_snow_number_concentration | number concentration of snow local to physics | kg-1 | 2 | real | kind_phys | inout | F | -!! | ncgl_io | local_graupel_number_concentration | number concentration of graupel local to physics | kg-1 | 2 | real | kind_phys | inout | F | -!! | clls_io | cloud_fraction_for_MG | cloud fraction used by Morrison-Gettelman MP | frac | 2 | real | kind_phys | inout | F | -!! | kcbl | vertical_index_at_cloud_base | vertical index at cloud base | index | 1 | integer | | inout | F | -!! | cldreffl | effective_radius_of_stratiform_cloud_liquid_water_particle_in_um | effective radius of cloud liquid water particle in micrometer | um | 2 | real | kind_phys | out | F | -!! | cldreffi | effective_radius_of_stratiform_cloud_ice_particle_in_um | effective radius of cloud ice water particle in micrometers | um | 2 | real | kind_phys | out | F | -!! | cldreffr | effective_radius_of_stratiform_cloud_rain_particle_in_um | effective radius of cloud rain particle in micrometers | um | 2 | real | kind_phys | out | F | -!! | cldreffs | effective_radius_of_stratiform_cloud_snow_particle_in_um | effective radius of cloud snow particle in micrometers | um | 2 | real | kind_phys | out | F | -!! | cldreffg | effective_radius_of_stratiform_cloud_graupel_particle_in_um | effective radius of cloud graupel particle in micrometers | um | 2 | real | kind_phys | out | F | -!! | aerfld_i | aerosol_number_concentration_from_gocart_aerosol_climatology | GOCART aerosol climatology number concentration | kg-1? | 3 | real | kind_phys | in | F | -!! | aero_in | flag_for_aerosol_input_MG | flag for using aerosols in Morrison-Gettelman microphysics | flag | 0 | logical | | in | F | -!! | naai_i | in_number_concentration | IN number concentration | kg-1? | 2 | real | kind_phys | in | F | -!! | npccn_i | ccn_number_concentration | CCN number concentration | kg-1? | 2 | real | kind_phys | in | F | -!! | iccn | flag_for_in_ccn_forcing_for_morrison_gettelman_microphysics | flag for IN and CCN forcing for morrison gettelman microphysics | flag | 0 | logical | | in | F | -!! | skip_macro | flag_skip_macro | flag to skip cloud macrophysics in Morrison scheme | flag | 0 | logical | | in | F | -!! | lprnt | flag_print | control flag for diagnostic print out | flag | 0 | logical | | in | F | -!! | alf_fac | mg_tuning_factor_for_alphas | tuning factor for alphas (alpha = 1 - critical relative humidity) | none | 0 | real | kind_phys | in | F | -!! | qc_min | mg_minimum_cloud_condensed_water_and_ice_mixing_ratio | minimum cloud condensed water and ice mixing ratio in MG macro clouds | kg kg-1 | 1 | real | kind_phys | in | F | -!! | pdfflag | flag_for_pdf_for_morrison_gettelman_microphysics_scheme | pdf flag for MG macrophysics | flag | 0 | integer | | in | F | -!! | ipr | horizontal_index_of_printed_column | horizontal index of printed column | index | 0 | integer | | in | F | -!! | kdt | index_of_time_step | current forecast iteration | index | 0 | integer | | in | F | -!! | xlat | latitude | latitude | radians | 1 | real | kind_phys | in | F | -!! | xlon | longitude | longitude | radians | 1 | real | kind_phys | in | F | -!! | rhc_i | critical_relative_humidity | critical relative humidity | frac | 2 | real | kind_phys | in | F | -!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | -!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | +!! \htmlinclude m_micro_run.html !! #endif !>\ingroup mg_driver @@ -242,8 +136,8 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & &, CLDREFFG, aerfld_i & &, aero_in, naai_i, npccn_i, iccn & &, skip_macro & - &, lprnt, alf_fac, qc_min, pdfflag & - &, ipr, kdt, xlat, xlon, rhc_i, & + &, alf_fac, qc_min, pdfflag & + &, kdt, xlat, xlon, rhc_i, & & errmsg, errflg) use machine , only: kind_phys @@ -260,7 +154,7 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & use aer_cloud, only: AerProps, getINsubset,init_aer, & & aerosol_activate,AerConversion1 use cldmacro, only: macro_cloud,meltfrz_inst,update_cld, & - & meltfrz_inst + & meltfrz_inst, fix_up_clouds_2M use cldwat2m_micro,only: mmicro_pcond use micro_mg2_0, only: micro_mg_tend2_0 => micro_mg_tend, qcvar2 => qcvar use micro_mg3_0, only: micro_mg_tend3_0 => micro_mg_tend, qcvar3 => qcvar @@ -284,11 +178,12 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & real, parameter :: one=1.0, oneb3=one/3.0, onebcp=one/cp, & & kapa=rgas*onebcp, cpbg=cp/grav, & & lvbcp=hvap*onebcp, lsbcp=(hvap+hfus)*onebcp,& - qsmall=1.e-14, rainmin = 1.0e-13 + & qsmall=1.e-14, rainmin = 1.0e-13, & + & fourb3=4.0/3.0, RL_cub=1.0e-15, nmin=1.0 integer, parameter :: ncolmicro = 1 - integer,intent(in) :: im, ix,lm, ipr, kdt, fprcp, pdfflag - logical,intent(in) :: flipv, aero_in, skip_macro, lprnt, iccn + integer,intent(in) :: im, ix,lm, kdt, fprcp, pdfflag + logical,intent(in) :: flipv, aero_in, skip_macro, iccn real (kind=kind_phys), intent(in):: dt_i, alf_fac, qc_min(2) real (kind=kind_phys), dimension(ix,lm),intent(in) :: & @@ -296,10 +191,16 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & & lwheat_i,swheat_i real (kind=kind_phys), dimension(ix,0:lm),intent(in):: prsi_i, & & phii - real (kind=kind_phys), dimension(im,lm),intent(in) :: & +! GJF* These variables are conditionally allocated depending on whether the +! Morrison-Gettelman microphysics is used, so they must be declared +! using assumed shape. + real (kind=kind_phys), dimension(:,:), intent(in) :: & & CNV_DQLDT_i, CLCN_i, QLCN_i, QICN_i, & & CNV_MFD_i, cf_upi, CNV_FICE_i, CNV_NDROP_i, & - & CNV_NICE_i, w_upi, rhc_i, naai_i, npccn_i + & CNV_NICE_i, w_upi +! *GJF + real (kind=kind_phys), dimension(im,lm),intent(in) :: & + & rhc_i, naai_i, npccn_i real (kind=kind_phys), dimension(im,lm,ntrcaer),intent(in) :: & & aerfld_i real (kind=kind_phys),dimension(im),intent(in):: TAUGWX, & @@ -319,9 +220,13 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & integer, dimension(IM), intent(inout):: KCBL real (kind=kind_phys),dimension(ix,lm),intent(inout):: q_io, t_io, & & ncpl_io,ncpi_io,CLLS_io - real (kind=kind_phys),dimension(im,lm),intent(inout):: rnw_io,snw_io,& +! GJF* These variables are conditionally allocated depending on whether the +! Morrison-Gettelman microphysics is used, so they must be declared +! using assumed shape. + real (kind=kind_phys),dimension(:,:),intent(inout):: rnw_io,snw_io,& & ncpr_io, ncps_io, & & qgl_io, ncgl_io +! *GJF !Moo real (kind=kind_phys),dimension(im,lm),intent(inout):: CLLS_io @@ -329,7 +234,7 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & integer kcldtopcvn,i,k,ll, kbmin, NAUX, nbincontactdust,l integer, dimension(im) :: kct real (kind=kind_phys) T_ICE_ALL, USE_AV_V,BKGTAU,LCCIRRUS, & - & NPRE_FRAC, Nct, Wct, fcn, ksa1, tauxr8, DT_Moist, dt_r8, & + & NPRE_FRAC, Nct, Wct, fcn, ksa1, tauxr8, DT_Moist, dt_r8, tem, & & TMAXLL, USURF,LTS_UP, LTS_LOW, MIN_EXP, fracover, c2_gw, est3 real(kind=kind_phys), allocatable, dimension(:,:) :: & @@ -474,7 +379,8 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & type (AerProps) :: AeroAux, AeroAux_b real, allocatable, dimension(:,:,:) :: AERMASSMIX - logical :: use_average_v, ltrue, lprint + logical :: use_average_v, ltrue, lprint, lprnt + integer :: ipr !================================== !====2-moment Microhysics= @@ -502,6 +408,9 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & errmsg = '' errflg = 0 + lprnt = .false. + ipr = 1 + ! rhr8 = 1.0 if(flipv) then DO K=1, LM @@ -623,10 +532,43 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & enddo endif endif +! if (lprnt) then +! write(0,*)' inmic qlcn=',qlcn(ipr,:) +! write(0,*)' inmic qlls=',qlls(ipr,:) +! write(0,*)' inmic qicn=',qicn(ipr,:) +! write(0,*)' inmic qils=',qils(ipr,:) +! endif ! DT_MOIST = dt_i dt_r8 = dt_i + if (kdt == 1) then + DO K=1, LM + DO I = 1,IM + CALL fix_up_clouds_2M(Q1(I,K), TEMP(i,k), QLLS(I,K), & + & QILS(I,K), CLLS(I,K), QLCN(I,K), & + & QICN(I,K), CLCN(I,K), NCPL(I,K), & + & NCPI(I,K), qc_min) + if (rnw(i,k) <= qc_min(1)) then + ncpr(i,k) = 0.0 + elseif (ncpr(i,k) <= nmin) then ! make sure NL > 0 if Q >0 + ncpr(i,k) = max(rnw(i,k) / (fourb3 * PI *RL_cub*997.0), nmin) + endif + if (snw(i,k) <= qc_min(2)) then + ncps(i,k) = 0.0 + elseif (ncps(i,k) <= nmin) then + ncps(i,k) = max(snw(i,k) / (fourb3 * PI *RL_cub*500.0), nmin) + endif + if (qgl(i,k) <= qc_min(2)) then + ncgl(i,k) = 0.0 + elseif (ncgl(i,k) <= nmin) then + ncgl(i,k) = max(qgl(i,k) / (fourb3 * PI *RL_cub*500.0), nmin) + endif + + enddo + enddo + endif + do i=1,im KCBL(i) = max(LM-KCBL(i),10) KCT(i) = 10 @@ -712,7 +654,6 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & ! deallocate (vmip) ! endif - do l=lm-1,1,-1 do i=1,im tx1 = 0.5 * (temp(i,l+1) + temp(i,l)) @@ -764,7 +705,7 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & !======================================================================================================================= !======================================================================================================================= !> -# Nucleation of cloud droplets and ice crystals -!! Aerosol cloud interactions. Calculate maxCCN tendency using Fountoukis and nenes (2005) or Abdul Razzak and Ghan (2002) +!! Aerosol cloud interactions. Calculate maxCCN tendency using Fountoukis and Nenes (2005) or Abdul Razzak and Ghan (2002) !! liquid Activation Parameterization !! Ice activation follows the Barahona & Nenes ice activation scheme, ACP, (2008, 2009). !! Written by Donifan Barahona and described in Barahona et al. (2013) @@ -794,7 +735,7 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & AERMASSMIX(:,:,1:5) = 1.e-6 AERMASSMIX(:,:,6:15) = 2.e-14 end if -!> - Call aerConversion1() +!> - Call aerconversion1() call AerConversion1 (AERMASSMIX, AeroProps) deallocate(AERMASSMIX) @@ -866,7 +807,7 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & ! ==================================================================== -!> -# Call gw_prof() to Calculate subgrid scale distribution in vertical velocity +!> -# Call gw_prof() to calculate subgrid scale distribution in vertical velocity ! ==================================================================== @@ -885,7 +826,7 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & wparc_cgw(k) = 0.0 end do -!> - Subgrid variability from Convective Sources According to Barahona et al. 2014 in prep +!> - Subgrid variability from convective sources according to Barahona et al. 2014 (in preparation) if (kcldtopcvn > 20) then @@ -946,7 +887,7 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & -!> - Compute Total variance +!> - Compute total variance do K = 1, LM swparc(k) = sqrt(wparc_gw(k) * wparc_gw(k) & @@ -986,7 +927,7 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & ! &,' ccn_param=',ccn_param,' in_param=',in_param & ! &,' AeroAux%kap=',AeroAux%kap -!> -# Call aerosol_activate() to activate the aerosols. +!> -# Call aerosol_activate() to activate the aerosols call aerosol_activate(tauxr8, plevr8(K), swparc(K), & & wparc_ls(K), AeroAux, npre8(k), dpre8(k), ccn_diag, & & ndropr8(k), npccninr8(K), smaxliq(K), & @@ -1081,7 +1022,7 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & !===========================End cloud particle nucleation======================= ! ----------------------------- ! -!> -# Begin Cloud Macrophysics +!> -# Begin cloud macrophysics ! do k=1,lm ! do i=1,im @@ -1145,7 +1086,7 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & ! call macro_cloud (IM, LM, DT_MOIST, PLO, PLE, PK, FRLAND, & ! call macro_cloud (IM, LM, DT_MOIST, PLO, PLE, FRLAND, & -!> - Call macro_cloud() for cloud macrophysics. +!> - Call macro_cloud() for cloud macrophysics call macro_cloud (IM, LM, DT_MOIST, alf_fac, PLO, PLE, & & CNV_DQLDT, & ! & CNV_MFD, CNV_DQLDT, & @@ -1215,7 +1156,7 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & !============ Put cloud fraction back in contact with the PDF (Barahona et al., GMD, 2014)============ !make sure QI , NI stay within T limits -!> - Call meltfrz_inst() to calculate instantaneous freezing or condensate. +!> - Call meltfrz_inst() to calculate instantaneous freezing or condensate call meltfrz_inst(IM, LM, TEMP, QLLS, QLCN, QILS, QICN, NCPL, NCPI) @@ -1345,6 +1286,7 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & ! else ! call init_Aer(AeroAux) ! end if +!> - Call getinsubset() to extract dust properties call getINsubset(1, AeroAux, AeroAux_b) naux = AeroAux_b%nmods if (nbincontactdust < naux) then @@ -1609,7 +1551,9 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & ! if(lprint) then ! write(0,*)' calling micro_mg_tend3_0 qcvar3=',qcvar3,' i=',i ! write(0,*)' qcr8=',qcr8(:) +! write(0,*)' qir8=',qir8(:) ! write(0,*)' ncr8=',ncr8(:) +! write(0,*)' nir8=',nir8(:) ! write(0,*)' npccninr8=',npccninr8(:) ! write(0,*)' plevr8=',plevr8(:) ! write(0,*)' ter8=',ter8(:) @@ -1742,16 +1686,47 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & !TVQX1 = SUM( ( Q1 + QL_TOT + QI_TOT(1:im,:,:))*DM, 3) & + if (skip_macro) then + do k=1,lm + do i=1,im + QLCN(i,k) = QL_TOT(i,k) * FQA(i,k) + QLLS(i,k) = QL_TOT(i,k) - QLCN(i,k) + QICN(i,k) = QI_TOT(i,k) * FQA(i,k) + QILS(i,k) = QI_TOT(i,k) - QICN(i,k) + + CALL fix_up_clouds_2M(Q1(I,K), TEMP(i,k), QLLS(I,K), & + & QILS(I,K), CLLS(I,K), QLCN(I,K), & + & QICN(I,K), CLCN(I,K), NCPL(I,K), & + & NCPI(I,K), qc_min) - if (.not. skip_macro) then + QL_TOT(I,K) = QLLS(I,K) + QLCN(I,K) + QI_TOT(I,K) = QILS(I,K) + QICN(I,K) + if (rnw(i,k) <= qc_min(1)) then + ncpl(i,k) = 0.0 + elseif (ncpl(i,k) <= nmin) then ! make sure NL > 0 if Q >0 + ncpl(i,k) = max(rnw(i,k) / (fourb3 * PI *RL_cub*997.0), nmin) + endif + if (snw(i,k) <= qc_min(2)) then + ncpl(i,k) = 0.0 + elseif (ncps(i,k) <= nmin) then + ncps(i,k) = max(snw(i,k) / (fourb3 * PI *RL_cub*500.0), nmin) + endif + if (qgl(i,k) <= qc_min(2)) then + ncgl(i,k) = 0.0 + elseif (ncgl(i,k) <= nmin) then + ncgl(i,k) = max(qgl(i,k) / (fourb3 * PI *RL_cub*500.0), nmin) + endif + enddo + enddo + else do k=1,lm do i=1,im QLCN(i,k) = QL_TOT(i,k) * FQA(i,k) QLLS(i,k) = QL_TOT(i,k) - QLCN(i,k) QICN(i,k) = QI_TOT(i,k) * FQA(i,k) QILS(i,k) = QI_TOT(i,k) - QICN(i,k) - end do - end do + enddo + enddo !> - Call update_cld() call update_cld(im, lm, DT_MOIST, ALPHT_X, qc_min & @@ -1765,8 +1740,24 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & do i=1,im QL_TOT(I,K) = QLLS(I,K) + QLCN(I,K) QI_TOT(I,K) = QILS(I,K) + QICN(I,K) - end do - end do +! + if (rnw(i,k) <= qc_min(1)) then + ncpl(i,k) = 0.0 + elseif (ncpl(i,k) <= nmin) then ! make sure NL > 0 if Q >0 + ncpl(i,k) = max(rnw(i,k) / (fourb3 * PI *RL_cub*997.0), nmin) + endif + if (snw(i,k) <= qc_min(2)) then + ncpl(i,k) = 0.0 + elseif (ncps(i,k) <= nmin) then + ncps(i,k) = max(snw(i,k) / (fourb3 * PI *RL_cub*500.0), nmin) + endif + if (qgl(i,k) <= qc_min(2)) then + ncgl(i,k) = 0.0 + elseif (ncgl(i,k) <= nmin) then + ncgl(i,k) = max(qgl(i,k) / (fourb3 * PI *RL_cub*500.0), nmin) + endif + enddo + enddo deallocate(CNV_MFD,CNV_FICE,CNV_NDROP,CNV_NICE) ! deallocate(CNV_MFD,CNV_PRC3,CNV_FICE,CNV_NDROP,CNV_NICE) endif @@ -1806,11 +1797,17 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & qi_o(i,k) = QI_TOT(i,ll) END DO END DO - if (.not. skip_macro) then + if (skip_macro) then + DO K=1, LM + ll = lm-k+1 + DO I = 1,IM + CLLS_io(i,k) = max(0.0, min(CLLS(i,ll)+CLCN(i,ll),1.0)) + enddo + enddo + else DO K=1, LM ll = lm-k+1 DO I = 1,IM -! CLLS_io(i,k) = max(0.0, min(CLLS(i,ll)+CLCN(i,ll),1.0)) CLLS_io(i,k) = CLLS(i,ll) enddo enddo @@ -1832,15 +1829,21 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & qi_o(i,k) = QI_TOT(i,k) END DO END DO - if (.not. skip_macro) then + if (skip_macro) then + DO K=1, LM + DO I = 1,IM + CLLS_io(i,k) = max(0.0, min(CLLS(i,k)+CLCN(i,k),1.0)) + enddo + enddo + else DO K=1, LM DO I = 1,IM -! CLLS_io(i,k) = max(0.0, min(CLLS(i,k)+CLCN(i,k),1.0)) CLLS_io(i,k) = CLLS(i,k) enddo enddo endif - endif + endif ! end of flipv if + DO I = 1,IM tx1 = LS_PRC2(i) + LS_SNR(i) rn_o(i) = tx1 * dt_i * 0.001 @@ -1855,7 +1858,7 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & if (allocated(ALPHT_X)) deallocate (ALPHT_X) ! if (lprnt) then -! write(0,*)' rn_o=',rn_o(ipr),' ls_prc2=',ls_prc2(ipr),' ls_snr=',ls_snr(ipr) +! write(0,*)' rn_o=',rn_o(ipr),' ls_prc2=',ls_prc2(ipr),' ls_snr=',ls_snr(ipr),' kdt=',kdt ! write(0,*)' end micro_mg_tend t_io= ', t_io(ipr,:) ! write(0,*)' end micro_mg_tend clls_io= ', clls_io(ipr,:) ! endif diff --git a/physics/m_micro.meta b/physics/m_micro.meta new file mode 100644 index 000000000..749b627f7 --- /dev/null +++ b/physics/m_micro.meta @@ -0,0 +1,912 @@ +[ccpp-arg-table] + name = m_micro_init + type = scheme +[imp_physics] + standard_name = flag_for_microphysics_scheme + long_name = choice of microphysics scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F +[imp_physics_mg] + standard_name = flag_for_morrison_gettelman_microphysics_scheme + long_name = choice of Morrison-Gettelman microphysics scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F +[fprcp] + standard_name = number_of_frozen_precipitation_species + long_name = number of frozen precipitation species + units = count + dimensions = () + type = integer + intent = in + optional = F +[gravit] + standard_name = gravitational_acceleration + long_name = gravitational acceleration + units = m s-2 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[rair] + standard_name = gas_constant_dry_air + long_name = ideal gas constant for dry air + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[rh2o] + standard_name = gas_constant_water_vapor + long_name = ideal gas constant for water vapor + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[cpair] + standard_name = specific_heat_of_dry_air_at_constant_pressure + long_name = specific heat of dry air at constant pressure + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[eps] + standard_name = ratio_of_dry_air_to_water_vapor_gas_constants + long_name = rd/rv + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[tmelt] + standard_name = triple_point_temperature_of_water + long_name = triple point temperature of water + units = K + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[latvap] + standard_name = latent_heat_of_vaporization_of_water_at_0C + long_name = latent heat of evaporation/sublimation + units = J kg-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[latice] + standard_name = latent_heat_of_fusion_of_water_at_0C + long_name = latent heat of fusion + units = J kg-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[mg_dcs] + standard_name = mg_autoconversion_size_threshold_ice_snow + long_name = autoconversion size threshold for cloud ice to snow for MG microphysics + units = um + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[mg_qcvar] + standard_name = mg_cloud_water_variance + long_name = cloud water relative variance for MG microphysics + units = + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[mg_ts_auto_ice] + standard_name = mg_time_scale_for_autoconversion_of_ice + long_name = autoconversion time scale for ice for MG microphysics + units = s + dimensions = (2) + type = real + kind = kind_phys + intent = in + optional = F +[mg_rhmini] + standard_name = mg_minimum_rh_for_ice + long_name = relative humidity threshold parameter for nucleating ice for MG microphysics + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[microp_uniform] + standard_name = mg_flag_for_uniform_subcolumns + long_name = flag for uniform subcolumns for MG microphysics + units = flag + dimensions = () + type = logical + intent = in + optional = F +[do_cldice] + standard_name = mg_flag_for_cloud_ice_processes + long_name = flag for cloud ice processes for MG microphysics + units = flag + dimensions = () + type = logical + intent = in + optional = F +[hetfrz_classnuc] + standard_name = mg_flag_for_heterogeneous_freezing + long_name = flag for heterogeneous freezing for MG microphysics + units = flag + dimensions = () + type = logical + intent = in + optional = F +[mg_precip_frac_method] + standard_name = mg_type_of_precip_fraction_method + long_name = type of precip fraction method for MG microphysics (in_cloud or max_overlap) + units = none + dimensions = () + type = character + kind = len=16 + intent = in + optional = F +[mg_berg_eff_factor] + standard_name = mg_bergeron_efficiency_factor + long_name = bergeron efficiency factor for MG microphysics + units = frac + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[sed_supersat] + standard_name = mg_allow_supersat_after_sed + long_name = allow supersaturation after sedimentation for MG microphysics + units = flag + dimensions = () + type = logical + intent = in + optional = F +[do_sb_physics] + standard_name = mg_flag_for_sb2001_autoconversion + long_name = flag for SB 2001 autoconversion or accretion for MG microphysics + units = flag + dimensions = () + type = logical + intent = in + optional = F +[mg_do_hail] + standard_name = mg_flag_for_hail + long_name = flag for hail for MG microphysics (graupel possible if false) + units = flag + dimensions = () + type = logical + intent = in + optional = F +[mg_do_graupel] + standard_name = mg_flag_for_graupel + long_name = flag for graupel for MG microphysics (hail possible if false) + units = flag + dimensions = () + type = logical + intent = in + optional = F +[mg_nccons] + standard_name = mg_flag_drop_concentration_constant + long_name = flag for constant droplet concentration for MG microphysics + units = flag + dimensions = () + type = logical + intent = in + optional = F +[mg_nicons] + standard_name = mg_flag_ice_concentration_constant + long_name = flag for constant ice concentration for MG microphysics + units = flag + dimensions = () + type = logical + intent = in + optional = F +[mg_ngcons] + standard_name = mg_flag_graupel_concentration_constant + long_name = flag for constant graupel concentration for MG microphysics + units = flag + dimensions = () + type = logical + intent = in + optional = F +[mg_ncnst] + standard_name = mg_drop_concentration_constant + long_name = droplet concentration constant for MG microphysics + units = m-3 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[mg_ninst] + standard_name = mg_ice_concentration_constant + long_name = ice concentration constant for MG microphysics + units = m-3 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[mg_ngnst] + standard_name = mg_graupel_concentration_constant + long_name = graupel concentration constant for MG microphysics + units = m-3 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[mg_do_ice_gmao] + standard_name = mg_flag_for_gmao_ice_formulation + long_name = flag for gmao ice formulation + units = flag + dimensions = () + type = logical + intent = in + optional = F +[mg_do_liq_liu] + standard_name = mg_flag_for_liu_liquid_treatment + long_name = flag for liu liquid treatment + units = flag + dimensions = () + type = logical + intent = in + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F + +######################################################################## +[ccpp-arg-table] + name = m_micro_finalize + type = scheme + +######################################################################## +[ccpp-arg-table] + name = m_micro_run + type = scheme +[im] + standard_name = horizontal_loop_extent + long_name = horizontal loop extent + units = count + dimensions = () + type = integer + intent = in + optional = F +[ix] + standard_name = horizontal_dimension + long_name = horizontal dimension + units = count + dimensions = () + type = integer + intent = in + optional = F +[lm] + standard_name = vertical_dimension + long_name = vertical layer dimension + units = count + dimensions = () + type = integer + intent = in + optional = F +[flipv] + standard_name = flag_flip + long_name = vertical flip logical + units = flag + dimensions = () + type = logical + intent = in + optional = F +[dt_i] + standard_name = time_step_for_physics + long_name = physics time step + units = s + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[prsl_i] + standard_name = air_pressure + long_name = layer mean pressure + units = Pa + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[prsi_i] + standard_name = air_pressure_at_interface + long_name = air pressure at model layer interfaces + units = Pa + dimensions = (horizontal_dimension,vertical_dimension_plus_one) + type = real + kind = kind_phys + intent = in + optional = F +[phil] + standard_name = geopotential + long_name = geopotential at model layer centers + units = m2 s-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[phii] + standard_name = geopotential_at_interface + long_name = geopotential at model layer interfaces + units = m2 s-2 + dimensions = (horizontal_dimension,vertical_dimension_plus_one) + type = real + kind = kind_phys + intent = in + optional = F +[omega_i] + standard_name = omega + long_name = layer mean vertical velocity + units = Pa s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[qlls_i] + standard_name = cloud_condensed_water_mixing_ratio_convective_transport_tracer + long_name = ratio of mass of cloud water to mass of dry air plus vapor (without condensates) in the convectively transported tracer array + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[qlcn_i] + standard_name = mass_fraction_of_convective_cloud_liquid_water + long_name = mass fraction of convective cloud liquid water + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[qils_i] + standard_name = ice_water_mixing_ratio_convective_transport_tracer + long_name = ratio of mass of ice water to mass of dry air plus vapor (without condensates) in the convectively transported tracer array + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[qicn_i] + standard_name = mass_fraction_of_convective_cloud_ice + long_name = mass fraction of convective cloud ice water + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[lwheat_i] + standard_name = tendency_of_air_temperature_due_to_longwave_heating_on_radiation_timestep + long_name = total sky lw heating rate + units = K s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[swheat_i] + standard_name = tendency_of_air_temperature_due_to_shortwave_heating_on_radiation_timestep + long_name = total sky sw heating rate + units = K s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[w_upi] + standard_name = vertical_velocity_for_updraft + long_name = vertical velocity for updraft + units = m s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[cf_upi] + standard_name = convective_cloud_fraction_for_microphysics + long_name = convective cloud fraction for microphysics + units = frac + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[frland] + standard_name = land_area_fraction_for_microphysics + long_name = land area fraction used in microphysics schemes + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[zpbl] + standard_name = atmosphere_boundary_layer_thickness + long_name = pbl height + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[cnv_mfd_i] + standard_name = detrained_mass_flux + long_name = detrained mass flux + units = kg m-2 s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[cnv_dqldt_i] + standard_name = tendency_of_cloud_water_due_to_convective_microphysics + long_name = tendency of cloud water due to convective microphysics + units = kg m-2 s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[clcn_i] + standard_name = convective_cloud_volume_fraction + long_name = convective cloud volume fraction + units = frac + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[u_i] + standard_name = x_wind_updated_by_physics + long_name = zonal wind updated by physics + units = m s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[v_i] + standard_name = y_wind_updated_by_physics + long_name = meridional wind updated by physics + units = m s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[taugwx] + standard_name = cumulative_surface_x_momentum_flux_for_diag_multiplied_by_timestep + long_name = cumulative sfc x momentum flux multiplied by timestep + units = Pa s + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[taugwy] + standard_name = cumulative_surface_y_momentum_flux_for_diag_multiplied_by_timestep + long_name = cumulative sfc y momentum flux multiplied by timestep + units = Pa s + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[tauorox] + standard_name = instantaneous_surface_x_momentum_flux + long_name = x momentum flux + units = Pa + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[tauoroy] + standard_name = instantaneous_surface_y_momentum_flux + long_name = y momentum flux + units = Pa + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[cnv_fice_i] + standard_name = ice_fraction_in_convective_tower + long_name = ice fraction in convective tower + units = frac + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[cnv_ndrop_i] + standard_name = number_concentration_of_cloud_liquid_water_particles_for_detrainment + long_name = droplet number concentration in convective detrainment + units = m-3 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[cnv_nice_i] + standard_name = number_concentration_of_ice_crystals_for_detrainment + long_name = crystal number concentration in convective detrainment + units = m-3 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[q_io] + standard_name = water_vapor_specific_humidity_updated_by_physics + long_name = water vapor specific humidity updated by physics + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[lwm_o] + standard_name = cloud_condensed_water_mixing_ratio_updated_by_physics + long_name = ratio of mass of cloud water to mass of dry air plus vapor (without condensates) updated by physics + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[qi_o] + standard_name = ice_water_mixing_ratio_updated_by_physics + long_name = ratio of mass of ice water to mass of dry air plus vapor (without condensates) updated by physics + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[t_io] + standard_name = air_temperature_updated_by_physics + long_name = temperature updated by physics + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[rn_o] + standard_name = lwe_thickness_of_explicit_precipitation_amount + long_name = explicit precipitation (rain, ice, snow, graupel, ...) on physics timestep + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[sr_o] + standard_name = ratio_of_snowfall_to_rainfall + long_name = snow ratio: ratio of snow to total precipitation + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[ncpl_io] + standard_name = cloud_droplet_number_concentration_updated_by_physics + long_name = number concentration of cloud droplets updated by physics + units = kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[ncpi_io] + standard_name = ice_number_concentration_updated_by_physics + long_name = number concentration of ice updated by physics + units = kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[fprcp] + standard_name = number_of_frozen_precipitation_species + long_name = number of frozen precipitation species + units = count + dimensions = () + type = integer + intent = in + optional = F +[rnw_io] + standard_name = local_rain_water_mixing_ratio + long_name = ratio of mass of rain water to mass of dry air plus vapor (without condensates) local to physics + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[snw_io] + standard_name = local_snow_water_mixing_ratio + long_name = ratio of mass of snow water to mass of dry air plus vapor (without condensates) local to physics + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[qgl_io] + standard_name = local_graupel_mixing_ratio + long_name = ratio of mass of graupel to mass of dry air plus vapor (without condensates) local to physics + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[ncpr_io] + standard_name = local_rain_number_concentration + long_name = number concentration of rain local to physics + units = kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[ncps_io] + standard_name = local_snow_number_concentration + long_name = number concentration of snow local to physics + units = kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[ncgl_io] + standard_name = local_graupel_number_concentration + long_name = number concentration of graupel local to physics + units = kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[clls_io] + standard_name = cloud_fraction_for_MG + long_name = cloud fraction used by Morrison-Gettelman MP + units = frac + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[kcbl] + standard_name = vertical_index_at_cloud_base + long_name = vertical index at cloud base + units = index + dimensions = (horizontal_dimension) + type = integer + intent = inout + optional = F +[cldreffl] + standard_name = effective_radius_of_stratiform_cloud_liquid_water_particle_in_um + long_name = effective radius of cloud liquid water particle in micrometer + units = um + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[cldreffi] + standard_name = effective_radius_of_stratiform_cloud_ice_particle_in_um + long_name = effective radius of cloud ice water particle in micrometers + units = um + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[cldreffr] + standard_name = effective_radius_of_stratiform_cloud_rain_particle_in_um + long_name = effective radius of cloud rain particle in micrometers + units = um + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[cldreffs] + standard_name = effective_radius_of_stratiform_cloud_snow_particle_in_um + long_name = effective radius of cloud snow particle in micrometers + units = um + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[cldreffg] + standard_name = effective_radius_of_stratiform_cloud_graupel_particle_in_um + long_name = effective radius of cloud graupel particle in micrometers + units = um + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[aerfld_i] + standard_name = aerosol_number_concentration_from_gocart_aerosol_climatology + long_name = GOCART aerosol climatology number concentration + units = kg-1? + dimensions = (horizontal_dimension,vertical_dimension,number_of_aerosol_tracers_MG) + type = real + kind = kind_phys + intent = in + optional = F +[aero_in] + standard_name = flag_for_aerosol_input_MG + long_name = flag for using aerosols in Morrison-Gettelman microphysics + units = flag + dimensions = () + type = logical + intent = in + optional = F +[naai_i] + standard_name = in_number_concentration + long_name = IN number concentration + units = kg-1? + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[npccn_i] + standard_name = ccn_number_concentration + long_name = CCN number concentration + units = kg-1? + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[iccn] + standard_name = flag_for_in_ccn_forcing_for_morrison_gettelman_microphysics + long_name = flag for IN and CCN forcing for morrison gettelman microphysics + units = flag + dimensions = () + type = logical + intent = in + optional = F +[skip_macro] + standard_name = flag_skip_macro + long_name = flag to skip cloud macrophysics in Morrison scheme + units = flag + dimensions = () + type = logical + intent = in + optional = F +[alf_fac] + standard_name = mg_tuning_factor_for_alphas + long_name = tuning factor for alphas (alpha = 1 - critical relative humidity) + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[qc_min] + standard_name = mg_minimum_cloud_condensed_water_and_ice_mixing_ratio + long_name = minimum cloud condensed water and ice mixing ratio in MG macro clouds + units = kg kg-1 + dimensions = (2) + type = real + kind = kind_phys + intent = in + optional = F +[pdfflag] + standard_name = flag_for_pdf_for_morrison_gettelman_microphysics_scheme + long_name = pdf flag for MG macrophysics + units = flag + dimensions = () + type = integer + intent = in + optional = F +[kdt] + standard_name = index_of_time_step + long_name = current forecast iteration + units = index + dimensions = () + type = integer + intent = in + optional = F +[xlat] + standard_name = latitude + long_name = latitude + units = radians + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[xlon] + standard_name = longitude + long_name = longitude + units = radians + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[rhc_i] + standard_name = critical_relative_humidity + long_name = critical relative humidity + units = frac + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F diff --git a/physics/m_micro_interstitial.F90 b/physics/m_micro_interstitial.F90 index 259c82519..930b32b3d 100644 --- a/physics/m_micro_interstitial.F90 +++ b/physics/m_micro_interstitial.F90 @@ -18,53 +18,19 @@ end subroutine m_micro_pre_init !! #if 0 !! \section arg_table_m_micro_pre_run Argument Table -!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | -!! |----------------|-------------------------------------------------------|----------------------------------------------------------------------------------------------------------------------------------|---------|------|------------|-----------|--------|----------| -!! | im | horizontal_loop_extent | horizontal loop extent | count | 0 | integer | | in | F | -!! | levs | vertical_dimension | number of vertical layers | count | 0 | integer | | in | F | -!! | do_shoc | flag_for_shoc | flag for SHOC | flag | 0 | logical | | in | F | -!! | fprcp | number_of_frozen_precipitation_species | number of frozen precipitation species | count | 0 | integer | | in | F | -!! | mg3_as_mg2 | flag_mg3_as_mg2 | flag for controlling prep for Morrison-Gettelman microphysics | flag | 0 | logical | | in | F | -!! | gq0_ice | ice_water_mixing_ratio_updated_by_physics | moist (dry+vapor, no condensates) mixing ratio of ice water updated by physics | kg kg-1 | 2 | real | kind_phys | in | F | -!! | gq0_water | cloud_condensed_water_mixing_ratio_updated_by_physics | moist (dry+vapor, no condensates) mixing ratio of cloud condensed water updated by physics | kg kg-1 | 2 | real | kind_phys | in | F | -!! | gq0_rain | rain_water_mixing_ratio_updated_by_physics | moist (dry+vapor, no condensates) mixing ratio of rain water updated by physics | kg kg-1 | 2 | real | kind_phys | in | F | -!! | gq0_snow | snow_water_mixing_ratio_updated_by_physics | moist (dry+vapor, no condensates) mixing ratio of snow water updated by physics | kg kg-1 | 2 | real | kind_phys | in | F | -!! | gq0_graupel | graupel_mixing_ratio_updated_by_physics | moist (dry+vapor, no condensates) mixing ratio of graupel updated by physics | kg kg-1 | 2 | real | kind_phys | in | F | -!! | gq0_rain_nc | rain_number_concentration_updated_by_physics | number concentration of rain updated by physics | kg-1 | 2 | real | kind_phys | in | F | -!! | gq0_snow_nc | snow_number_concentration_updated_by_physics | number concentration of snow updated by physics | kg-1 | 2 | real | kind_phys | in | F | -!! | gq0_graupel_nc | graupel_number_concentration_updated_by_physics | number concentration of graupel updated by physics | kg-1 | 2 | real | kind_phys | in | F | -!! | cld_shoc | subgrid_scale_cloud_fraction_from_shoc | subgrid-scale cloud fraction from the SHOC scheme | frac | 2 | real | kind_phys | in | F | -!! | cnvc | convective_cloud_cover | convective cloud cover | frac | 2 | real | kind_phys | in | F | -!! | cnvw | convective_cloud_water_mixing_ratio | moist convective cloud water mixing ratio | kg kg-1 | 2 | real | kind_phys | in | F | -!! | tcr | cloud_phase_transition_threshold_temperature | threshold temperature below which cloud starts to freeze | K | 0 | real | kind_phys | in | F | -!! | tcrf | cloud_phase_transition_denominator | denominator in cloud phase transition = 1/(tcr-tf) | K-1 | 0 | real | kind_phys | in | F | -!! | gt0 | air_temperature_updated_by_physics | temperature updated by physics | K | 2 | real | kind_phys | in | F | -!! | qrn | local_rain_water_mixing_ratio | moist (dry+vapor, no condensates) mixing ratio of rain water local to physics | kg kg-1 | 2 | real | kind_phys | inout | F | -!! | qsnw | local_snow_water_mixing_ratio | moist (dry+vapor, no condensates) mixing ratio of snow water local to physics | kg kg-1 | 2 | real | kind_phys | inout | F | -!! | qgl | local_graupel_mixing_ratio | moist (dry+vapor, no condensates) mixing ratio of graupel local to physics | kg kg-1 | 2 | real | kind_phys | inout | F | -!! | ncpr | local_rain_number_concentration | number concentration of rain local to physics | kg-1 | 2 | real | kind_phys | inout | F | -!! | ncps | local_snow_number_concentration | number concentration of snow local to physics | kg-1 | 2 | real | kind_phys | inout | F | -!! | ncgl | local_graupel_number_concentration | number concentration of graupel local to physics | kg-1 | 2 | real | kind_phys | inout | F | -!! | cld_frc_MG | cloud_fraction_for_MG | cloud fraction used by Morrison-Gettelman MP | frac | 2 | real | kind_phys | inout | F | -!! | qlcn | mass_fraction_of_convective_cloud_liquid_water | mass fraction of convective cloud liquid water | kg kg-1 | 2 | real | kind_phys | inout | F | -!! | qicn | mass_fraction_of_convective_cloud_ice | mass fraction of convective cloud ice water | kg kg-1 | 2 | real | kind_phys | inout | F | -!! | cf_upi | convective_cloud_fraction_for_microphysics | convective cloud fraction for microphysics | frac | 2 | real | kind_phys | inout | F | -!! | clw_water | cloud_condensed_water_mixing_ratio_convective_transport_tracer | moist (dry+vapor, no condensates) mixing ratio of cloud water (condensate) in the convectively transported tracer array | kg kg-1 | 2 | real | kind_phys | out | F | -!! | clw_ice | ice_water_mixing_ratio_convective_transport_tracer | moist (dry+vapor, no condensates) mixing ratio of ice water in the convectively transported tracer array | kg kg-1 | 2 | real | kind_phys | out | F | -!! | clcn | convective_cloud_volume_fraction | convective cloud volume fraction | frac | 2 | real | kind_phys | in | F | -!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | -!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | +!! \htmlinclude m_micro_pre_run.html !! #endif - subroutine m_micro_pre_run (im, levs, do_shoc, fprcp, mg3_as_mg2, gq0_ice, gq0_water, gq0_rain, & - gq0_snow, gq0_graupel, gq0_rain_nc, gq0_snow_nc, gq0_graupel_nc, cld_shoc, cnvc, cnvw, tcr, tcrf, gt0, & - qrn, qsnw, qgl, ncpr, ncps, ncgl, cld_frc_MG, qlcn, qicn, cf_upi, clw_water, clw_ice, clcn, errmsg, errflg ) + subroutine m_micro_pre_run (im, levs, do_shoc, skip_macro, fprcp, mg3_as_mg2, gq0_ice, gq0_water, gq0_rain, & + gq0_snow, gq0_graupel, gq0_rain_nc, gq0_snow_nc, gq0_graupel_nc, cld_shoc, cnvc, cnvw, tcr, tcrf, gt0, & + qrn, qsnw, qgl, ncpr, ncps, ncgl, cld_frc_MG, clw_water, clw_ice, clcn, errmsg, errflg ) use machine, only : kind_phys implicit none integer, intent(in) :: im, levs, fprcp logical, intent(in) :: do_shoc, mg3_as_mg2 + logical, intent(inout) :: skip_macro real(kind=kind_phys), intent(in) :: tcr, tcrf real(kind=kind_phys), intent(in) :: & @@ -75,7 +41,7 @@ subroutine m_micro_pre_run (im, levs, do_shoc, fprcp, mg3_as_mg2, gq0_ice, gq0_w real(kind=kind_phys), intent(inout) :: & qrn(:,:), qsnw(:,:), qgl(:,:), ncpr(:,:), ncps(:,:), ncgl(:,:), & - cld_frc_MG(:,:), cf_upi(:,:), qlcn(:,:), qicn(:,:) + cld_frc_MG(:,:) real(kind=kind_phys), intent(out) :: clw_ice(:,:), clw_water(:,:) @@ -96,38 +62,39 @@ subroutine m_micro_pre_run (im, levs, do_shoc, fprcp, mg3_as_mg2, gq0_ice, gq0_w ! in other procceses too. August 28/2015; Hope that can be done next ! year. I believe this will make the physical interaction more reasonable ! Anning 12/5/2015 changed ntcw hold liquid only + skip_macro = do_shoc if (do_shoc) then if (fprcp == 0) then do k=1,levs do i=1,im - clw_ice(i,k) = gq0_ice(i,k) - clw_water(i,k) = gq0_water(i,k) + clw_ice(i,k) = gq0_ice(i,k) + clw_water(i,k) = gq0_water(i,k) cld_frc_MG(i,k) = cld_shoc(i,k) enddo enddo else if ((abs(fprcp) == 1) .or. mg3_as_mg2) then do k=1,levs do i=1,im - clw_ice(i,k) = gq0_ice(i,k) - clw_water(i,k) = gq0_water(i,k) - qrn(i,k) = gq0_rain(i,k) - qsnw(i,k) = gq0_snow(i,k) - ncpr(i,k) = gq0_rain_nc(i,k) - ncps(i,k) = gq0_snow_nc(i,k) + clw_ice(i,k) = gq0_ice(i,k) + clw_water(i,k) = gq0_water(i,k) + qrn(i,k) = gq0_rain(i,k) + qsnw(i,k) = gq0_snow(i,k) + ncpr(i,k) = gq0_rain_nc(i,k) + ncps(i,k) = gq0_snow_nc(i,k) cld_frc_MG(i,k) = cld_shoc(i,k) enddo enddo else do k=1,levs do i=1,im - clw_ice(i,k) = gq0_ice(i,k) - clw_water(i,k) = gq0_water(i,k) - qrn(i,k) = gq0_rain(i,k) - qsnw(i,k) = gq0_snow(i,k) - qgl(i,k) = gq0_graupel(i,k) - ncpr(i,k) = gq0_rain_nc(i,k) - ncps(i,k) = gq0_snow_nc(i,k) - ncgl(i,k) = gq0_graupel_nc(i,k) + clw_ice(i,k) = gq0_ice(i,k) + clw_water(i,k) = gq0_water(i,k) + qrn(i,k) = gq0_rain(i,k) + qsnw(i,k) = gq0_snow(i,k) + qgl(i,k) = gq0_graupel(i,k) + ncpr(i,k) = gq0_rain_nc(i,k) + ncps(i,k) = gq0_snow_nc(i,k) + ncgl(i,k) = gq0_graupel_nc(i,k) cld_frc_MG(i,k) = cld_shoc(i,k) enddo enddo @@ -136,32 +103,32 @@ subroutine m_micro_pre_run (im, levs, do_shoc, fprcp, mg3_as_mg2, gq0_ice, gq0_w if (fprcp == 0 ) then do k=1,levs do i=1,im - clw_ice(i,k) = gq0_ice(i,k) + clw_ice(i,k) = gq0_ice(i,k) clw_water(i,k) = gq0_water(i,k) enddo enddo elseif (abs(fprcp) == 1 .or. mg3_as_mg2) then do k=1,levs do i=1,im - clw_ice(i,k) = gq0_ice(i,k) + clw_ice(i,k) = gq0_ice(i,k) clw_water(i,k) = gq0_water(i,k) - qrn(i,k) = gq0_rain(i,k) - qsnw(i,k) = gq0_snow(i,k) - ncpr(i,k) = gq0_rain_nc(i,k) - ncps(i,k) = gq0_snow_nc(i,k) + qrn(i,k) = gq0_rain(i,k) + qsnw(i,k) = gq0_snow(i,k) + ncpr(i,k) = gq0_rain_nc(i,k) + ncps(i,k) = gq0_snow_nc(i,k) enddo enddo else do k=1,levs do i=1,im - clw_ice(i,k) = gq0_ice(i,k) + clw_ice(i,k) = gq0_ice(i,k) clw_water(i,k) = gq0_water(i,k) - qrn(i,k) = gq0_rain(i,k) - qsnw(i,k) = gq0_snow(i,k) - qgl(i,k) = gq0_graupel(i,k) - ncpr(i,k) = gq0_rain_nc(i,k) - ncps(i,k) = gq0_snow_nc(i,k) - ncgl(i,k) = gq0_graupel_nc(i,k) + qrn(i,k) = gq0_rain(i,k) + qsnw(i,k) = gq0_snow(i,k) + qgl(i,k) = gq0_graupel(i,k) + ncpr(i,k) = gq0_rain_nc(i,k) + ncps(i,k) = gq0_snow_nc(i,k) + ncgl(i,k) = gq0_graupel_nc(i,k) enddo enddo endif @@ -203,31 +170,12 @@ end subroutine m_micro_post_init ! \brief Brief description of the subroutine !! !! \section arg_table_m_micro_post_run Argument Table -!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | -!! |----------------|--------------------------------------------------------------------------|----------------------------------------------------------------------------------|---------|------|-----------|-----------|--------|----------| -!! | im | horizontal_loop_extent | horizontal loop extent | count | 0 | integer | | in | F | -!! | levs | vertical_dimension | number of vertical layers | count | 0 | integer | | in | F | -!! | fprcp | number_of_frozen_precipitation_species | number of frozen precipitation species | count | 0 | integer | | in | F | -!! | mg3_as_mg2 | flag_mg3_as_mg2 | flag for controlling prep for Morrison-Gettelman microphysics | flag | 0 | logical | | in | F | -!! | ncpr | local_rain_number_concentration | number concentration of rain local to physics | kg-1 | 2 | real | kind_phys | in | F | -!! | ncps | local_snow_number_concentration | number concentration of snow local to physics | kg-1 | 2 | real | kind_phys | in | F | -!! | ncgl | local_graupel_number_concentration | number concentration of graupel local to physics | kg-1 | 2 | real | kind_phys | in | F | -!! | qrn | local_rain_water_mixing_ratio | moist (dry+vapor, no condensates) mixing ratio of rain water local to physics | kg kg-1 | 2 | real | kind_phys | inout | F | -!! | qsnw | local_snow_water_mixing_ratio | moist (dry+vapor, no condensates) mixing ratio of snow water local to physics | kg kg-1 | 2 | real | kind_phys | inout | F | -!! | qgl | local_graupel_mixing_ratio | moist (dry+vapor, no condensates) mixing ratio of graupel local to physics | kg kg-1 | 2 | real | kind_phys | inout | F | -!! | gq0_rain | rain_water_mixing_ratio_updated_by_physics | moist (dry+vapor, no condensates) mixing ratio of rain water updated by physics | kg kg-1 | 2 | real | kind_phys | out | F | -!! | gq0_snow | snow_water_mixing_ratio_updated_by_physics | moist (dry+vapor, no condensates) mixing ratio of snow water updated by physics | kg kg-1 | 2 | real | kind_phys | out | F | -!! | gq0_graupel | graupel_mixing_ratio_updated_by_physics | moist (dry+vapor, no condensates) mixing ratio of graupel updated by physics | kg kg-1 | 2 | real | kind_phys | out | F | -!! | gq0_rain_nc | rain_number_concentration_updated_by_physics | number concentration of rain updated by physics | kg-1 | 2 | real | kind_phys | out | F | -!! | gq0_snow_nc | snow_number_concentration_updated_by_physics | number concentration of snow updated by physics | kg-1 | 2 | real | kind_phys | out | F | -!! | gq0_graupel_nc | graupel_number_concentration_updated_by_physics | number concentration of graupel updated by physics | kg-1 | 2 | real | kind_phys | out | F | -!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | -!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | +!! \htmlinclude m_micro_post_run.html !! - subroutine m_micro_post_run( & - im, levs, fprcp, mg3_as_mg2, ncpr, ncps, ncgl, qrn, qsnw, qgl, & - gq0_rain, gq0_snow, gq0_graupel, gq0_rain_nc, gq0_snow_nc, & - gq0_graupel_nc, errmsg, errflg) + subroutine m_micro_post_run( & + im, levs, fprcp, mg3_as_mg2, ncpr, ncps, ncgl, qrn, qsnw, qgl, & + gq0_ice, gq0_rain, gq0_snow, gq0_graupel, gq0_rain_nc, gq0_snow_nc, & + gq0_graupel_nc, ice, snow, graupel, dtp, errmsg, errflg) use machine, only : kind_phys implicit none @@ -235,17 +183,33 @@ subroutine m_micro_post_run( & integer, intent(in) :: im, levs, fprcp logical, intent(in) :: mg3_as_mg2 - real(kind=kind_phys), intent(in) :: ncpr(:,:), ncps(:,:), ncgl(:,:) - real(kind=kind_phys), intent(inout) :: qrn(:,:), qsnw(:,:), qgl(:,:) - real(kind=kind_phys), intent(inout) :: gq0_rain(:,:), gq0_snow(:,:), & - gq0_graupel(:,:), gq0_rain_nc(:,:), gq0_snow_nc(:,:), gq0_graupel_nc(:,:) + real(kind=kind_phys), intent(in ) :: ncpr(1:im,1:levs) + real(kind=kind_phys), intent(in ) :: ncps(1:im,1:levs) + real(kind=kind_phys), intent(in ) :: ncgl(1:im,1:levs) + real(kind=kind_phys), intent(inout) :: qrn(1:im,1:levs) + real(kind=kind_phys), intent(inout) :: qsnw(1:im,1:levs) + real(kind=kind_phys), intent(inout) :: qgl(1:im,1:levs) + real(kind=kind_phys), intent(inout) :: gq0_ice(1:im,1:levs) + real(kind=kind_phys), intent(inout) :: gq0_rain(1:im,1:levs) + real(kind=kind_phys), intent(inout) :: gq0_snow(1:im,1:levs) + real(kind=kind_phys), intent(inout) :: gq0_graupel(1:im,1:levs) + real(kind=kind_phys), intent(inout) :: gq0_rain_nc(1:im,1:levs) + real(kind=kind_phys), intent(inout) :: gq0_snow_nc(1:im,1:levs) + real(kind=kind_phys), intent(inout) :: gq0_graupel_nc(1:im,1:levs) + real(kind=kind_phys), intent( out) :: ice(1:im) + real(kind=kind_phys), intent( out) :: snow(1:im) + real(kind=kind_phys), intent( out) :: graupel(1:im) + real(kind=kind_phys), intent(in ) :: dtp character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg + ! Local variables + real(kind=kind_phys), parameter :: qsmall = 1.0d-20 + real(kind=kind_phys), parameter :: con_p001 = 0.001d0 + real(kind=kind_phys), parameter :: con_day = 86400.0d0 integer :: i, k - - real(kind=kind_phys), parameter :: qsmall = 1.0e-20 + real(kind=kind_phys) :: tem ! Initialize CCPP error handling variables errmsg = '' @@ -260,7 +224,7 @@ subroutine m_micro_post_run( & ! &, gq0(1,1,1),gq0(1,1,ntcw),gq0(1,1,ntcw+1),' m_micro ') ! if (lprnt) write(0,*) ' rain1=',rain1(ipr)*86400.0, & -! &' rainc=',diag%rainc(ipr)*86400.0 & +! &' rainc=',diag%rainc(ipr)*86400.0 ! &,' cn_prc=',cn_prc(ipr),' cn_snr=',cn_snr(ipr) ! if(lprnt) write(0,*) ' aftgt0=',Stateout%gt0(ipr,:),' kdt=',kdt ! if (lprnt) write(0,*) ' aftlsgq0=',stateout%gq0(ipr,:,1),' kdt=',kdt @@ -273,31 +237,41 @@ subroutine m_micro_post_run( & ! if (lprnt) write(0,*)' qsnwa=',qsnw(ipr,:),' kdt=',kdt ! if (lprnt) write(0,*)' qglba',qgl(ipr,:),' kdt=',kdt + tem = dtp * con_p001 / con_day if (abs(fprcp) == 1 .or. mg3_as_mg2) then do k=1,levs do i=1,im if (abs(qrn(i,k)) < qsmall) qrn(i,k) = 0.0 if (abs(qsnw(i,k)) < qsmall) qsnw(i,k) = 0.0 - gq0_rain(i,k) = qrn(i,k) - gq0_snow(i,k) = qsnw(i,k) + gq0_rain(i,k) = qrn(i,k) + gq0_snow(i,k) = qsnw(i,k) gq0_rain_nc(i,k) = ncpr(i,k) gq0_snow_nc(i,k) = ncps(i,k) enddo enddo + do i=1,im + ice(i) = tem * gq0_ice(i,1) + snow(i) = tem * qsnw(i,1) + enddo elseif (fprcp > 1) then do k=1,levs do i=1,im if (abs(qrn(i,k)) < qsmall) qrn(i,k) = 0.0 if (abs(qsnw(i,k)) < qsmall) qsnw(i,k) = 0.0 if (abs(qgl(i,k)) < qsmall) qgl(i,k) = 0.0 - gq0_rain(i,k) = qrn(i,k) - gq0_snow(i,k) = qsnw(i,k) - gq0_graupel(i,k) = qgl(i,k) - gq0_rain_nc(i,k) = ncpr(i,k) - gq0_snow_nc(i,k) = ncps(i,k) + gq0_rain(i,k) = qrn(i,k) + gq0_snow(i,k) = qsnw(i,k) + gq0_graupel(i,k) = qgl(i,k) + gq0_rain_nc(i,k) = ncpr(i,k) + gq0_snow_nc(i,k) = ncps(i,k) gq0_graupel_nc(i,k) = ncgl(i,k) enddo enddo + do i=1,im + ice(i) = tem * gq0_ice(i,1) + snow(i) = tem * qsnw(i,1) + graupel(i) = tem * qgl(i,1) + enddo endif diff --git a/physics/m_micro_interstitial.meta b/physics/m_micro_interstitial.meta new file mode 100644 index 000000000..0b5b56b2f --- /dev/null +++ b/physics/m_micro_interstitial.meta @@ -0,0 +1,511 @@ +[ccpp-arg-table] + name = m_micro_pre_init + type = scheme + +######################################################################## +[ccpp-arg-table] + name = m_micro_pre_run + type = scheme +[im] + standard_name = horizontal_loop_extent + long_name = horizontal loop extent + units = count + dimensions = () + type = integer + intent = in + optional = F +[levs] + standard_name = vertical_dimension + long_name = number of vertical layers + units = count + dimensions = () + type = integer + intent = in + optional = F +[do_shoc] + standard_name = flag_for_shoc + long_name = flag for SHOC + units = flag + dimensions = () + type = logical + intent = in + optional = F +[skip_macro] + standard_name = flag_skip_macro + long_name = flag to skip cloud macrophysics in Morrison scheme + units = flag + dimensions = () + type = logical + intent = inout + optional = F +[fprcp] + standard_name = number_of_frozen_precipitation_species + long_name = number of frozen precipitation species + units = count + dimensions = () + type = integer + intent = in + optional = F +[mg3_as_mg2] + standard_name = flag_mg3_as_mg2 + long_name = flag for controlling prep for Morrison-Gettelman microphysics + units = flag + dimensions = () + type = logical + intent = in + optional = F +[gq0_ice] + standard_name = ice_water_mixing_ratio_updated_by_physics + long_name = ratio of mass of ice water to mass of dry air plus vapor (without condensates) updated by physics + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[gq0_water] + standard_name = cloud_condensed_water_mixing_ratio_updated_by_physics + long_name = ratio of mass of cloud water to mass of dry air plus vapor (without condensates) updated by physics + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[gq0_rain] + standard_name = rain_water_mixing_ratio_updated_by_physics + long_name = ratio of mass of rain water to mass of dry air plus vapor (without condensates) updated by physics + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[gq0_snow] + standard_name = snow_water_mixing_ratio_updated_by_physics + long_name = ratio of mass of snow water to mass of dry air plus vapor (without condensates) updated by physics + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[gq0_graupel] + standard_name = graupel_mixing_ratio_updated_by_physics + long_name = ratio of mass of graupel to mass of dry air plus vapor (without condensates) updated by physics + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[gq0_rain_nc] + standard_name = rain_number_concentration_updated_by_physics + long_name = number concentration of rain updated by physics + units = kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[gq0_snow_nc] + standard_name = snow_number_concentration_updated_by_physics + long_name = number concentration of snow updated by physics + units = kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[gq0_graupel_nc] + standard_name = graupel_number_concentration_updated_by_physics + long_name = number concentration of graupel updated by physics + units = kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[cld_shoc] + standard_name = subgrid_scale_cloud_fraction_from_shoc + long_name = subgrid-scale cloud fraction from the SHOC scheme + units = frac + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[cnvc] + standard_name = convective_cloud_cover + long_name = convective cloud cover + units = frac + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[cnvw] + standard_name = convective_cloud_water_mixing_ratio + long_name = moist convective cloud water mixing ratio + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[tcr] + standard_name = cloud_phase_transition_threshold_temperature + long_name = threshold temperature below which cloud starts to freeze + units = K + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[tcrf] + standard_name = cloud_phase_transition_denominator + long_name = denominator in cloud phase transition = 1/(tcr-tf) + units = K-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[gt0] + standard_name = air_temperature_updated_by_physics + long_name = temperature updated by physics + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[qrn] + standard_name = local_rain_water_mixing_ratio + long_name = ratio of mass of rain water to mass of dry air plus vapor (without condensates) local to physics + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[qsnw] + standard_name = local_snow_water_mixing_ratio + long_name = ratio of mass of snow water to mass of dry air plus vapor (without condensates) local to physics + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[qgl] + standard_name = local_graupel_mixing_ratio + long_name = ratio of mass of graupel to mass of dry air plus vapor (without condensates) local to physics + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[ncpr] + standard_name = local_rain_number_concentration + long_name = number concentration of rain local to physics + units = kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[ncps] + standard_name = local_snow_number_concentration + long_name = number concentration of snow local to physics + units = kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[ncgl] + standard_name = local_graupel_number_concentration + long_name = number concentration of graupel local to physics + units = kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[cld_frc_MG] + standard_name = cloud_fraction_for_MG + long_name = cloud fraction used by Morrison-Gettelman MP + units = frac + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[clw_water] + standard_name = cloud_condensed_water_mixing_ratio_convective_transport_tracer + long_name = ratio of mass of cloud water to mass of dry air plus vapor (without condensates) in the convectively transported tracer array + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[clw_ice] + standard_name = ice_water_mixing_ratio_convective_transport_tracer + long_name = ratio of mass of ice water to mass of dry air plus vapor (without condensates) in the convectively transported tracer array + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[clcn] + standard_name = convective_cloud_volume_fraction + long_name = convective cloud volume fraction + units = frac + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F + +######################################################################## +[ccpp-arg-table] + name = m_micro_pre_finalize + type = scheme + +######################################################################## +[ccpp-arg-table] + name = m_micro_post_init + type = scheme + +######################################################################## +[ccpp-arg-table] + name = m_micro_post_run + type = scheme +[im] + standard_name = horizontal_loop_extent + long_name = horizontal loop extent + units = count + dimensions = () + type = integer + intent = in + optional = F +[levs] + standard_name = vertical_dimension + long_name = number of vertical layers + units = count + dimensions = () + type = integer + intent = in + optional = F +[fprcp] + standard_name = number_of_frozen_precipitation_species + long_name = number of frozen precipitation species + units = count + dimensions = () + type = integer + intent = in + optional = F +[mg3_as_mg2] + standard_name = flag_mg3_as_mg2 + long_name = flag for controlling prep for Morrison-Gettelman microphysics + units = flag + dimensions = () + type = logical + intent = in + optional = F +[ncpr] + standard_name = local_rain_number_concentration + long_name = number concentration of rain local to physics + units = kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[ncps] + standard_name = local_snow_number_concentration + long_name = number concentration of snow local to physics + units = kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[ncgl] + standard_name = local_graupel_number_concentration + long_name = number concentration of graupel local to physics + units = kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[qrn] + standard_name = local_rain_water_mixing_ratio + long_name = ratio of mass of rain water to mass of dry air plus vapor (without condensates) local to physics + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[qsnw] + standard_name = local_snow_water_mixing_ratio + long_name = ratio of mass of snow water to mass of dry air plus vapor (without condensates) local to physics + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[qgl] + standard_name = local_graupel_mixing_ratio + long_name = ratio of mass of graupel to mass of dry air plus vapor (without condensates) local to physics + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[gq0_ice] + standard_name = ice_water_mixing_ratio_updated_by_physics + long_name = ratio of mass of ice water to mass of dry air plus vapor (without condensates) updated by physics + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[gq0_rain] + standard_name = rain_water_mixing_ratio_updated_by_physics + long_name = ratio of mass of rain water to mass of dry air plus vapor (without condensates) updated by physics + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[gq0_snow] + standard_name = snow_water_mixing_ratio_updated_by_physics + long_name = ratio of mass of snow water to mass of dry air plus vapor (without condensates) updated by physics + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[gq0_graupel] + standard_name = graupel_mixing_ratio_updated_by_physics + long_name = ratio of mass of graupel to mass of dry air plus vapor (without condensates) updated by physics + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[gq0_rain_nc] + standard_name = rain_number_concentration_updated_by_physics + long_name = number concentration of rain updated by physics + units = kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[gq0_snow_nc] + standard_name = snow_number_concentration_updated_by_physics + long_name = number concentration of snow updated by physics + units = kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[gq0_graupel_nc] + standard_name = graupel_number_concentration_updated_by_physics + long_name = number concentration of graupel updated by physics + units = kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[ice] + standard_name = lwe_thickness_of_ice_amount_on_dynamics_timestep + long_name = ice fall at this time step + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[snow] + standard_name = lwe_thickness_of_snow_amount_on_dynamics_timestep + long_name = snow fall at this time step + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[graupel] + standard_name = lwe_thickness_of_graupel_amount_on_dynamics_timestep + long_name = graupel fall at this time step + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[dtp] + standard_name = time_step_for_physics + long_name = physics timestep + units = s + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F + +######################################################################## +[ccpp-arg-table] + name = m_micro_post_finalize + type = scheme diff --git a/physics/machine.F b/physics/machine.F index 8adf87ac6..896b665da 100644 --- a/physics/machine.F +++ b/physics/machine.F @@ -1,14 +1,8 @@ module machine -#if 0 !! \section arg_table_machine -!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | -!! |-----------------------------------|-------------------------- |-------------------------------------------------------|---------|------|-----------|----------|--------|----------| -!! | kind_dyn | kind_dyn | definition of kind_dyn | none | 0 | integer | | none | F | -!! | kind_grid | kind_grid | definition of kind_grid | none | 0 | integer | | none | F | -!! | kind_phys | kind_phys | definition of kind_phys | none | 0 | integer | | none | F | +!! \htmlinclude machine.html !! -#endif implicit none @@ -24,6 +18,7 @@ module machine &, kind_phys = 8 ,kind_taum=8 & &, kind_grid = 8 & &, kind_REAL = 8 &! used in cmp_comm + &, kind_LOGICAL = 4 & &, kind_INTEGER = 4 ! -,,- #else @@ -38,6 +33,7 @@ module machine &, kind_phys = 4 ,kind_taum=4 & &, kind_grid = 4 & &, kind_REAL = 4 &! used in cmp_comm + &, kind_LOGICAL = 4 & &, kind_INTEGER = 4 ! -,,- #endif diff --git a/physics/machine.meta b/physics/machine.meta new file mode 100644 index 000000000..d93f50e09 --- /dev/null +++ b/physics/machine.meta @@ -0,0 +1,33 @@ +[ccpp-arg-table] + name = machine + type = module +[kind_dyn] + standard_name = kind_dyn + long_name = definition of kind_dyn + units = none + dimensions = () + type = integer +[kind_grid] + standard_name = kind_grid + long_name = definition of kind_grid + units = none + dimensions = () + type = integer +[kind_phys] + standard_name = kind_phys + long_name = definition of kind_phys + units = none + dimensions = () + type = integer +[kind_LOGICAL] + standard_name = kind_LOGICAL + long_name = definition of kind_LOGICAL + units = none + dimensions = () + type = integer +[kind_INTEGER] + standard_name = kind_INTEGER + long_name = definition of kind_INTEGER + units = none + dimensions = () + type = integer diff --git a/physics/maximum_hourly_diagnostics.F90 b/physics/maximum_hourly_diagnostics.F90 index 545f393b9..174e0c95c 100644 --- a/physics/maximum_hourly_diagnostics.F90 +++ b/physics/maximum_hourly_diagnostics.F90 @@ -8,7 +8,7 @@ module maximum_hourly_diagnostics public maximum_hourly_diagnostics_init, maximum_hourly_diagnostics_run, maximum_hourly_diagnostics_finalize - ! DH* TODO - THIS CAME FROM PHYSCONS.F90 BUT IS IT BETTER PLACED IN HERE? + ! DH* TODO - cleanup use of constants real(kind=kind_phys), parameter ::PQ0=379.90516E0, A2A=17.2693882, A3=273.16, A4=35.86, RHmin=1.0E-6 ! *DH @@ -22,48 +22,20 @@ end subroutine maximum_hourly_diagnostics_finalize #if 0 !> \section arg_table_maximum_hourly_diagnostics_run Argument Table -!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | -!! |----------------------|--------------------------------------------------------------------|--------------------------------------------------------------------|------------|------|-----------|-----------|--------|----------| -!! | im | horizontal_loop_extent | horizontal loop extent | count | 0 | integer | | in | F | -!! | levs | vertical_dimension | number of vertical levels | count | 0 | integer | | in | F | -!! | kdt | index_of_time_step | current forecast iteration | index | 0 | integer | | in | F | -!! | nsteps_per_reset | number_of_time_steps_per_maximum_hourly_time_interval | number_of_time_steps_per_maximum_hourly_time_interval | count | 0 | integer | | in | F | -!! | lradar | flag_for_radar_reflectivity | flag for radar reflectivity | flag | 0 | logical | | in | F | -!! | imp_physics | flag_for_microphysics_scheme | choice of microphysics scheme | flag | 0 | integer | | in | F | -!! | imp_physics_gfdl | flag_for_gfdl_microphysics_scheme | choice of GFDL microphysics scheme | flag | 0 | integer | | in | F | -!! | imp_physics_thompson | flag_for_thompson_microphysics_scheme | choice of Thompson microphysics scheme | flag | 0 | integer | | in | F | -!! | con_g | gravitational_acceleration | gravitational acceleration | m s-2 | 0 | real | kind_phys | in | F | -!! | phil | geopotential | geopotential at model layer centers | m2 s-2 | 2 | real | kind_phys | in | F | -!! | gt0 | air_temperature_updated_by_physics | temperature updated by physics | K | 2 | real | kind_phys | in | F | -!! | refl_10cm | radar_reflectivity_10cm | instantaneous refl_10cm | dBZ | 2 | real | kind_phys | in | F | -!! | refdmax | maximum_reflectivity_at_1km_agl_over_maximum_hourly_time_interval | maximum reflectivity at 1km agl over maximum hourly time interval | dBZ | 1 | real | kind_phys | inout | F | -!! | refdmax263k | maximum_reflectivity_at_minus10c_over_maximum_hourly_time_interval | maximum reflectivity at minus10c over maximum hourly time interval | dBZ | 1 | real | kind_phys | inout | F | -!! | u10m | x_wind_at_10m | 10 meter u wind speed | m s-1 | 1 | real | kind_phys | in | F | -!! | v10m | y_wind_at_10m | 10 meter v wind speed | m s-1 | 1 | real | kind_phys | in | F | -!! | u10max | maximum_u_wind_at_10m_over_maximum_hourly_time_interval | maximum u wind at 10m over maximum hourly time interval | m s-1 | 1 | real | kind_phys | inout | F | -!! | v10max | maximum_v_wind_at_10m_over_maximum_hourly_time_interval | maximum v wind at 10m over maximum hourly time interval | m s-1 | 1 | real | kind_phys | inout | F | -!! | spd10max | maximum_wind_at_10m_over_maximum_hourly_time_interval | maximum wind at 10m over maximum hourly time interval | m s-1 | 1 | real | kind_phys | inout | F | -!! | pgr | surface_air_pressure | surface pressure | Pa | 1 | real | kind_phys | in | F | -!! | t2m | temperature_at_2m | 2 meter temperature | K | 1 | real | kind_phys | in | F | -!! | q2m | specific_humidity_at_2m | 2 meter specific humidity | kg kg-1 | 1 | real | kind_phys | in | F | -!! | t02max | maximum_temperature_at_2m_over_maximum_hourly_time_interval | maximum temperature at 2m over maximum hourly time interval | K | 1 | real | kind_phys | inout | F | -!! | t02min | minimum_temperature_at_2m_over_maximum_hourly_time_interval | minumum temperature at 2m over maximum hourly time interval | K | 1 | real | kind_phys | inout | F | -!! | rh02max | maximum_relative_humidity_at_2m_over_maximum_hourly_time_interval | maximum relative humidity at 2m over maximum hourly time interval | % | 1 | real | kind_phys | inout | F | -!! | rh02min | minimum_relative_humidity_at_2m_over_maximum_hourly_time_interval | minumum relative humidity at 2m over maximum hourly time interval | % | 1 | real | kind_phys | inout | F | -!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | -!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | +!! \htmlinclude maximum_hourly_diagnostics_run.html !! #endif - subroutine maximum_hourly_diagnostics_run(im, levs, kdt, nsteps_per_reset, lradar, imp_physics, & - imp_physics_gfdl, imp_physics_thompson, con_g, phil, & + subroutine maximum_hourly_diagnostics_run(im, levs, reset, lradar, imp_physics, & + imp_physics_gfdl, imp_physics_thompson, & + imp_physics_fer_hires,con_g, phil, & gt0, refl_10cm, refdmax, refdmax263k, u10m, v10m, & u10max, v10max, spd10max, pgr, t2m, q2m, t02max, & t02min, rh02max, rh02min, errmsg, errflg) ! Interface variables - integer, intent(in) :: im, levs, kdt, nsteps_per_reset - logical, intent(in) :: lradar - integer, intent(in) :: imp_physics, imp_physics_gfdl, imp_physics_thompson + integer, intent(in) :: im, levs + logical, intent(in) :: reset, lradar + integer, intent(in) :: imp_physics, imp_physics_gfdl, imp_physics_thompson, imp_physics_fer_hires real(kind_phys), intent(in ) :: con_g real(kind_phys), intent(in ) :: phil(im,levs) real(kind_phys), intent(in ) :: gt0(im,levs) @@ -88,30 +60,26 @@ subroutine maximum_hourly_diagnostics_run(im, levs, kdt, nsteps_per_reset, lrada ! Local variables real(kind_phys), dimension(:), allocatable :: refd, refd263k real(kind_phys) :: tem, pshltr, QCQ, rh02 - integer :: kdtminus1, i + integer :: i ! Initialize CCPP error handling variables errmsg = '' errflg = 0 - kdtminus1 = kdt-1 - !Calculate hourly max 1-km agl and -10C reflectivity - if (lradar .and. (imp_physics == imp_physics_gfdl .or. imp_physics == imp_physics_thompson)) then + if (lradar .and. (imp_physics == imp_physics_gfdl .or. & + imp_physics == imp_physics_thompson .or. & + imp_physics == imp_physics_fer_hires)) then allocate(refd(im)) allocate(refd263k(im)) call max_fields(phil,refl_10cm,con_g,im,levs,refd,gt0,refd263k) - if(mod(kdtminus1,nsteps_per_reset)==0)then + if (reset) then do i=1,im refdmax(i) = -35. refdmax263k(i) = -35. enddo endif do i=1,im - !if(mod(kdtminus1,nsteps_per_reset)==0)then - ! refdmax(I) = -35. - ! refdmax263k(I) = -35. - !endif refdmax(i) = max(refdmax(i),refd(i)) refdmax263k(i) = max(refdmax263k(i),refd263k(i)) enddo @@ -119,7 +87,7 @@ subroutine maximum_hourly_diagnostics_run(im, levs, kdt, nsteps_per_reset, lrada deallocate (refd263k) endif ! - if(mod(kdtminus1,nsteps_per_reset)==0)then + if (reset) then do i=1,im spd10max(i) = -999. u10max(i) = -999. @@ -133,15 +101,6 @@ subroutine maximum_hourly_diagnostics_run(im, levs, kdt, nsteps_per_reset, lrada do i=1,im ! find max hourly wind speed then decompose tem = sqrt(u10m(i)*u10m(i) + v10m(i)*v10m(i)) - !if(mod(kdtminus1,nsteps_per_reset)==0)then - ! spd10max(i) = -999. - ! u10max(i) = -999. - ! v10max(i) = -999. - ! t02max(i) = -999. - ! t02min(i) = 999. - ! rh02max(i) = -999. - ! rh02min(i) = 999. - !endif if (tem > spd10max(i)) then spd10max(i) = tem u10max(i) = u10m(i) @@ -150,16 +109,16 @@ subroutine maximum_hourly_diagnostics_run(im, levs, kdt, nsteps_per_reset, lrada pshltr=pgr(i)*exp(-0.068283/gt0(i,1)) QCQ=PQ0/pshltr*EXP(A2A*(t2m(i)-A3)/(t2m(i)-A4)) rh02=q2m(i)/QCQ - IF (rh02.GT.1.0) THEN - rh02=1.0 + IF (rh02 > 1.0) THEN + rh02 = 1.0 ENDIF - IF (rh02.LT.RHmin) THEN !use smaller RH limit for stratosphere - rh02=RHmin + IF (rh02 < RHmin) THEN !use smaller RH limit for stratosphere + rh02 = RHmin ENDIF - rh02max(i)=max(rh02max(i),rh02) - rh02min(i)=min(rh02min(i),rh02) - t02max(i)=max(t02max(i),t2m(i)) !<--- hourly max 2m t - t02min(i)=min(t02min(i),t2m(i)) !<--- hourly min 2m t + rh02max(i) = max(rh02max(i),rh02) + rh02min(i) = min(rh02min(i),rh02) + t02max(i) = max(t02max(i),t2m(i)) !<--- hourly max 2m t + t02min(i) = min(t02min(i),t2m(i)) !<--- hourly min 2m t enddo end subroutine maximum_hourly_diagnostics_run @@ -183,8 +142,7 @@ subroutine max_fields(phil,ref3D,grav,im,levs,refd,tk,refd263k) do i=1,im refd(I) = -35. vloop: do k=1,levs-1 - if ( (z(i,k+1)) .ge. 1000. & - .and.(z(i,k)) .le. 1000.) then + if ( z(i,k+1) >= 1000. .and. z(i,k) <= 1000.) then zmidp1=z(i,k+1) zmidLOC=z(i,k) dbz1(1)=ref3d(i,k+1) !- dBZ (not Z) values diff --git a/physics/maximum_hourly_diagnostics.meta b/physics/maximum_hourly_diagnostics.meta new file mode 100644 index 000000000..5146ce2f0 --- /dev/null +++ b/physics/maximum_hourly_diagnostics.meta @@ -0,0 +1,246 @@ +[ccpp-arg-table] + name = maximum_hourly_diagnostics_run + type = scheme +[im] + standard_name = horizontal_loop_extent + long_name = horizontal loop extent + units = count + dimensions = () + type = integer + intent = in + optional = F +[levs] + standard_name = vertical_dimension + long_name = number of vertical levels + units = count + dimensions = () + type = integer + intent = in + optional = F +[reset] + standard_name = flag_reset_maximum_hourly_fields + long_name = flag for resetting maximum hourly fields + units = flag + dimensions = () + type = logical + intent = in + optional = F +[lradar] + standard_name = flag_for_radar_reflectivity + long_name = flag for radar reflectivity + units = flag + dimensions = () + type = logical + intent = in + optional = F +[imp_physics] + standard_name = flag_for_microphysics_scheme + long_name = choice of microphysics scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F +[imp_physics_gfdl] + standard_name = flag_for_gfdl_microphysics_scheme + long_name = choice of GFDL microphysics scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F +[imp_physics_thompson] + standard_name = flag_for_thompson_microphysics_scheme + long_name = choice of Thompson microphysics scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F +[imp_physics_fer_hires] + standard_name = flag_for_fer_hires_microphysics_scheme + long_name = choice of Ferrier-Aligo microphysics scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F +[con_g] + standard_name = gravitational_acceleration + long_name = gravitational acceleration + units = m s-2 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[phil] + standard_name = geopotential + long_name = geopotential at model layer centers + units = m2 s-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[gt0] + standard_name = air_temperature_updated_by_physics + long_name = temperature updated by physics + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[refl_10cm] + standard_name = radar_reflectivity_10cm + long_name = instantaneous refl_10cm + units = dBZ + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[refdmax] + standard_name = maximum_reflectivity_at_1km_agl_over_maximum_hourly_time_interval + long_name = maximum reflectivity at 1km agl over maximum hourly time interval + units = dBZ + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[refdmax263k] + standard_name = maximum_reflectivity_at_minus10c_over_maximum_hourly_time_interval + long_name = maximum reflectivity at minus10c over maximum hourly time interval + units = dBZ + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[u10m] + standard_name = x_wind_at_10m + long_name = 10 meter u wind speed + units = m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[v10m] + standard_name = y_wind_at_10m + long_name = 10 meter v wind speed + units = m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[u10max] + standard_name = maximum_u_wind_at_10m_over_maximum_hourly_time_interval + long_name = maximum u wind at 10m over maximum hourly time interval + units = m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[v10max] + standard_name = maximum_v_wind_at_10m_over_maximum_hourly_time_interval + long_name = maximum v wind at 10m over maximum hourly time interval + units = m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[spd10max] + standard_name = maximum_wind_at_10m_over_maximum_hourly_time_interval + long_name = maximum wind at 10m over maximum hourly time interval + units = m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[pgr] + standard_name = surface_air_pressure + long_name = surface pressure + units = Pa + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[t2m] + standard_name = temperature_at_2m + long_name = 2 meter temperature + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[q2m] + standard_name = specific_humidity_at_2m + long_name = 2 meter specific humidity + units = kg kg-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[t02max] + standard_name = maximum_temperature_at_2m_over_maximum_hourly_time_interval + long_name = maximum temperature at 2m over maximum hourly time interval + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[t02min] + standard_name = minimum_temperature_at_2m_over_maximum_hourly_time_interval + long_name = minumum temperature at 2m over maximum hourly time interval + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[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 = % + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[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 = % + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F diff --git a/physics/mfpbltq.f b/physics/mfpbltq.f new file mode 100644 index 000000000..a6fc22cef --- /dev/null +++ b/physics/mfpbltq.f @@ -0,0 +1,453 @@ +!>\file mfpbltq.f +!! This file contains the subroutine that calculates mass flux and +!! updraft parcel properties for thermals driven by surface heating +!! for use in the TKE-EDMF PBL scheme (updated version). + +!>\ingroup satmedmfvdifq +!! This subroutine computes mass flux and updraft parcel properties for +!! thermals driven by surface heating. +!!\section mfpbltq_gen GFS mfpblt General Algorithm +!> @{ + subroutine mfpbltq(im,ix,km,kmpbl,ntcw,ntrac1,delt, + & cnvflg,zl,zm,q1,t1,u1,v1,plyr,pix,thlx,thvx, + & gdx,hpbl,kpbl,vpert,buo,xmf, + & tcko,qcko,ucko,vcko,xlamue,a1) +! + use machine , only : kind_phys + use funcphys , only : fpvs + use physcons, grav => con_g, cp => con_cp + &, rv => con_rv, hvap => con_hvap + &, fv => con_fvirt + &, eps => con_eps, epsm1 => con_epsm1 +! + implicit none +! + integer im, ix, km, kmpbl, ntcw, ntrac1 +! &, me + integer kpbl(im) + logical cnvflg(im) + real(kind=kind_phys) delt + real(kind=kind_phys) q1(ix,km,ntrac1), + & t1(ix,km), u1(ix,km), v1(ix,km), + & plyr(im,km),pix(im,km),thlx(im,km), + & thvx(im,km),zl(im,km), zm(im,km), + & gdx(im), hpbl(im), vpert(im), + & buo(im,km), xmf(im,km), + & tcko(im,km),qcko(im,km,ntrac1), + & ucko(im,km),vcko(im,km), + & xlamue(im,km-1) +! +c local variables and arrays +! + integer i, j, k, n, ndc +! + real(kind=kind_phys) dt2, dz, ce0, cm, + & factor, gocp, + & g, b1, f1, + & bb1, bb2, + & a1, pgcon, + & qmin, qlmin, xmmx, rbint, + & tem, tem1, tem2, + & ptem, ptem1, ptem2 +! + real(kind=kind_phys) elocp, el2orc, qs, es, + & tlu, gamma, qlu, + & thup, thvu, dq +! + real(kind=kind_phys) rbdn(im), rbup(im), xlamuem(im,km-1) + real(kind=kind_phys) delz(im), xlamax(im) +! + real(kind=kind_phys) wu2(im,km), thlu(im,km), + & qtx(im,km), qtu(im,km) +! + real(kind=kind_phys) xlamavg(im), sigma(im), + & scaldfunc(im), sumx(im) +! + logical totflg, flg(im) +! +! physical parameters + parameter(g=grav) + parameter(gocp=g/cp) + parameter(elocp=hvap/cp,el2orc=hvap*hvap/(rv*cp)) + parameter(ce0=0.4,cm=1.0) + parameter(qmin=1.e-8,qlmin=1.e-12) + parameter(pgcon=0.55) + parameter(b1=0.5,f1=0.15) +! +!************************************************************************ +!! + totflg = .true. + do i=1,im + totflg = totflg .and. (.not. cnvflg(i)) + enddo + if(totflg) return +!! +! + dt2 = delt +! + do k = 1, km + do i=1,im + if (cnvflg(i)) then + buo(i,k) = 0. + wu2(i,k) = 0. + qtx(i,k) = q1(i,k,1) + q1(i,k,ntcw) + endif + enddo + enddo +! +!> - Compute thermal excess +! + do i=1,im + if(cnvflg(i)) then + thlu(i,1)= thlx(i,1) + vpert(i) + qtu(i,1) = qtx(i,1) + buo(i,1) = g * vpert(i) / thvx(i,1) + endif + enddo +! +!> - Compute entrainment rate +! + do i=1,im + if(cnvflg(i)) then + k = kpbl(i) / 2 + k = max(k, 1) + delz(i) = zl(i,k+1) - zl(i,k) + xlamax(i) = ce0 / delz(i) + endif + enddo +! + do k = 1, kmpbl + do i=1,im + if(cnvflg(i)) then + if(k < kpbl(i)) then + ptem = 1./(zm(i,k)+delz(i)) + tem = max((hpbl(i)-zm(i,k)+delz(i)) ,delz(i)) + ptem1 = 1./tem + xlamue(i,k) = ce0 * (ptem+ptem1) + else + xlamue(i,k) = xlamax(i) + endif +! + xlamuem(i,k) = cm * xlamue(i,k) + endif + enddo + enddo +! +!> - Compute buoyancy for updraft air parcel +! + do k = 2, kmpbl + do i=1,im + if(cnvflg(i)) then + dz = zl(i,k) - zl(i,k-1) + tem = 0.5 * xlamue(i,k-1) * dz + factor = 1. + tem +! + thlu(i,k) = ((1.-tem)*thlu(i,k-1)+tem* + & (thlx(i,k-1)+thlx(i,k)))/factor + qtu(i,k) = ((1.-tem)*qtu(i,k-1)+tem* + & (qtx(i,k-1)+qtx(i,k)))/factor +! + tlu = thlu(i,k) / pix(i,k) + es = 0.01 * fpvs(tlu) ! fpvs in pa + qs = max(qmin, eps * es / (plyr(i,k)+epsm1*es)) + dq = qtu(i,k) - qs +! + if (dq > 0.) then + gamma = el2orc * qs / (tlu**2) + qlu = dq / (1. + gamma) + qtu(i,k) = qs + qlu + tem1 = 1. + fv * qs - qlu + thup = thlu(i,k) + pix(i,k) * elocp * qlu + thvu = thup * tem1 + else + tem1 = 1. + fv * qtu(i,k) + thvu = thlu(i,k) * tem1 + endif + buo(i,k) = g * (thvu / thvx(i,k) - 1.) +! + endif + enddo + enddo +! +!> - Compute updraft velocity square(wu2, eqn 13 in +!! Han et al.(2019) \cite Han_2019) +! +! tem = 1.-2.*f1 +! bb1 = 2. * b1 / tem +! bb2 = 2. / tem +! from Soares et al. (2004,QJRMS) +! bb1 = 2. +! bb2 = 4. +! +! from Bretherton et al. (2004, MWR) +! bb1 = 4. +! bb2 = 2. +! +! from our tuning + bb1 = 2.0 + bb2 = 4.0 +! + do i = 1, im + if(cnvflg(i)) then + dz = zm(i,1) + tem = 0.5*bb1*xlamue(i,1)*dz + tem1 = bb2 * buo(i,1) * dz + ptem1 = 1. + tem + wu2(i,1) = tem1 / ptem1 + endif + enddo + do k = 2, kmpbl + do i = 1, im + if(cnvflg(i)) then + dz = zm(i,k) - zm(i,k-1) + tem = 0.25*bb1*(xlamue(i,k)+xlamue(i,k-1))*dz + tem1 = bb2 * buo(i,k) * dz + ptem = (1. - tem) * wu2(i,k-1) + ptem1 = 1. + tem + wu2(i,k) = (ptem + tem1) / ptem1 + endif + enddo + enddo +! +!> - Update pbl height as the height where updraft velocity vanishes +! + do i=1,im + flg(i) = .true. + if(cnvflg(i)) then + flg(i) = .false. + rbup(i) = wu2(i,1) + endif + enddo + do k = 2, kmpbl + do i = 1, im + if(.not.flg(i)) then + rbdn(i) = rbup(i) + rbup(i) = wu2(i,k) + kpbl(i)= k + flg(i) = rbup(i).le.0. + endif + enddo + enddo + do i = 1,im + if(cnvflg(i)) then + k = kpbl(i) + if(rbdn(i) <= 0.) then + rbint = 0. + elseif(rbup(i) >= 0.) then + rbint = 1. + else + rbint = rbdn(i)/(rbdn(i)-rbup(i)) + endif + hpbl(i) = zm(i,k-1) + rbint*(zm(i,k)-zm(i,k-1)) + endif + enddo +! +!> - Update entrainment rate +! + do i=1,im + if(cnvflg(i)) then + k = kpbl(i) / 2 + k = max(k, 1) + delz(i) = zl(i,k+1) - zl(i,k) + xlamax(i) = ce0 / delz(i) + endif + enddo +! + do k = 1, kmpbl + do i=1,im + if(cnvflg(i)) then + if(k < kpbl(i)) then + ptem = 1./(zm(i,k)+delz(i)) + tem = max((hpbl(i)-zm(i,k)+delz(i)) ,delz(i)) + ptem1 = 1./tem + xlamue(i,k) = ce0 * (ptem+ptem1) + else + xlamue(i,k) = xlamax(i) + endif +! + xlamuem(i,k) = cm * xlamue(i,k) + endif + enddo + enddo +! +!> - Compute entrainment rate averaged over the whole pbl +! + do i = 1, im + xlamavg(i) = 0. + sumx(i) = 0. + enddo + do k = 1, kmpbl + do i = 1, im + if (cnvflg(i) .and. k < kpbl(i)) then + dz = zl(i,k+1) - zl(i,k) + xlamavg(i) = xlamavg(i) + xlamue(i,k) * dz + sumx(i) = sumx(i) + dz + endif + enddo + enddo + do i = 1, im + if(cnvflg(i)) then + xlamavg(i) = xlamavg(i) / sumx(i) + endif + enddo +! +!> - Updraft mass flux as a function of updraft velocity profile +! + do k = 1, kmpbl + do i = 1, im + if (cnvflg(i) .and. k < kpbl(i)) then + xmf(i,k) = a1 * sqrt(wu2(i,k)) + endif + enddo + enddo +! +!> - Compute updraft fraction as a function of mean entrainment rate +!!(Grell and Freitas (2014) \cite grell_and_freitas_2014 +! + do i = 1, im + if(cnvflg(i)) then + tem = 0.2 / xlamavg(i) + tem1 = 3.14 * tem * tem + sigma(i) = tem1 / (gdx(i) * gdx(i)) + sigma(i) = max(sigma(i), 0.001) + sigma(i) = min(sigma(i), 0.999) + endif + enddo +! +!> - Compute scale-aware function based on +!! Arakawa and Wu (2013) \cite arakawa_and_wu_2013 +! + do i = 1, im + if(cnvflg(i)) then + if (sigma(i) > a1) then + scaldfunc(i) = (1.-sigma(i)) * (1.-sigma(i)) + scaldfunc(i) = max(min(scaldfunc(i), 1.0), 0.) + else + scaldfunc(i) = 1.0 + endif + endif + enddo +! +!> - Final scale-aware updraft mass flux +! + do k = 1, kmpbl + do i = 1, im + if (cnvflg(i) .and. k < kpbl(i)) then + xmf(i,k) = scaldfunc(i) * xmf(i,k) + dz = zl(i,k+1) - zl(i,k) + xmmx = dz / dt2 + xmf(i,k) = min(xmf(i,k),xmmx) + endif + enddo + enddo +! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +!> - Compute updraft property using updated entranment rate +! + do i=1,im + if(cnvflg(i)) then + thlu(i,1)= thlx(i,1) + endif + enddo +! +! do i=1,im +! if(cnvflg(i)) then +! ptem1 = max(qcko(i,1,ntcw), 0.) +! tlu = thlu(i,1) / pix(i,1) +! tcko(i,1) = tlu + elocp * ptem1 +! endif +! enddo +! + do k = 2, kmpbl + do i=1,im + if(cnvflg(i) .and. k <= kpbl(i)) then + dz = zl(i,k) - zl(i,k-1) + tem = 0.5 * xlamue(i,k-1) * dz + factor = 1. + tem +! + thlu(i,k) = ((1.-tem)*thlu(i,k-1)+tem* + & (thlx(i,k-1)+thlx(i,k)))/factor + qtu(i,k) = ((1.-tem)*qtu(i,k-1)+tem* + & (qtx(i,k-1)+qtx(i,k)))/factor +! + tlu = thlu(i,k) / pix(i,k) + es = 0.01 * fpvs(tlu) ! fpvs in pa + qs = max(qmin, eps * es / (plyr(i,k)+epsm1*es)) + dq = qtu(i,k) - qs +! + if (dq > 0.) then + gamma = el2orc * qs / (tlu**2) + qlu = dq / (1. + gamma) + qtu(i,k) = qs + qlu + qcko(i,k,1) = qs + qcko(i,k,ntcw) = qlu + tcko(i,k) = tlu + elocp * qlu + else + qcko(i,k,1) = qtu(i,k) + qcko(i,k,ntcw) = 0. + tcko(i,k) = tlu + endif +! + endif + enddo + enddo +! + do k = 2, kmpbl + do i = 1, im + if (cnvflg(i) .and. k <= kpbl(i)) then + dz = zl(i,k) - zl(i,k-1) + tem = 0.5 * xlamuem(i,k-1) * dz + factor = 1. + tem + ptem = tem + pgcon + ptem1= tem - pgcon + ucko(i,k) = ((1.-tem)*ucko(i,k-1)+ptem*u1(i,k) + & +ptem1*u1(i,k-1))/factor + vcko(i,k) = ((1.-tem)*vcko(i,k-1)+ptem*v1(i,k) + & +ptem1*v1(i,k-1))/factor + endif + enddo + enddo +! + if(ntcw > 2) then +! + do n = 2, ntcw-1 + do k = 2, kmpbl + do i = 1, im + if (cnvflg(i) .and. k <= kpbl(i)) then + dz = zl(i,k) - zl(i,k-1) + tem = 0.5 * xlamue(i,k-1) * dz + factor = 1. + tem +! + qcko(i,k,n) = ((1.-tem)*qcko(i,k-1,n)+tem* + & (q1(i,k,n)+q1(i,k-1,n)))/factor + endif + enddo + enddo + enddo +! + endif +! + ndc = ntrac1 - ntcw +! + if(ndc > 0) then +! + do n = ntcw+1, ntrac1 + do k = 2, kmpbl + do i = 1, im + if (cnvflg(i) .and. k <= kpbl(i)) then + dz = zl(i,k) - zl(i,k-1) + tem = 0.5 * xlamue(i,k-1) * dz + factor = 1. + tem +! + qcko(i,k,n) = ((1.-tem)*qcko(i,k-1,n)+tem* + & (q1(i,k,n)+q1(i,k-1,n)))/factor + endif + enddo + enddo + enddo +! + endif +! + return + end +!> @} diff --git a/physics/mfscuq.f b/physics/mfscuq.f new file mode 100644 index 000000000..3390c3e58 --- /dev/null +++ b/physics/mfscuq.f @@ -0,0 +1,550 @@ +!>\file mfscuq.f +!! This file contains the mass flux and downdraft parcel preperties +!! parameterization for stratocumulus-top-driven turbulence (updated version). + +!>\ingroup satmedmfvdifq +!! This subroutine computes mass flux and downdraft parcel properties +!! for stratocumulus-top-driven turbulence. +!! \section mfscuq GFS mfscu General Algorithm +!> @{ + subroutine mfscuq(im,ix,km,kmscu,ntcw,ntrac1,delt, + & cnvflg,zl,zm,q1,t1,u1,v1,plyr,pix, + & thlx,thvx,thlvx,gdx,thetae, + & krad,mrad,radmin,buo,xmfd, + & tcdo,qcdo,ucdo,vcdo,xlamde,a1) +! + use machine , only : kind_phys + use funcphys , only : fpvs + use physcons, grav => con_g, cp => con_cp + &, rv => con_rv, hvap => con_hvap + &, fv => con_fvirt + &, eps => con_eps, epsm1 => con_epsm1 +! + implicit none +! + integer im, ix, km, kmscu, ntcw, ntrac1 +! &, me + integer krad(im), mrad(im) +! + logical cnvflg(im) + real(kind=kind_phys) delt + real(kind=kind_phys) q1(ix,km,ntrac1),t1(ix,km), + & u1(ix,km), v1(ix,km), + & plyr(im,km), pix(im,km), + & thlx(im,km), + & thvx(im,km), thlvx(im,km), + & gdx(im), + & zl(im,km), zm(im,km), + & thetae(im,km), radmin(im), + & buo(im,km), xmfd(im,km), + & tcdo(im,km), qcdo(im,km,ntrac1), + & ucdo(im,km), vcdo(im,km), + & xlamde(im,km-1) +! +! local variables and arrays +! +! + integer i,j,indx, k, n, kk, ndc + integer krad1(im) +! + real(kind=kind_phys) dt2, dz, ce0, cm, + & gocp, factor, g, tau, + & b1, f1, bb1, bb2, + & a1, a2, + & cteit, pgcon, + & qmin, qlmin, + & xmmx, tem, tem1, tem2, + & ptem, ptem1, ptem2 +! + real(kind=kind_phys) elocp, el2orc, qs, es, + & tld, gamma, qld, thdn, + & thvd, dq +! + real(kind=kind_phys) wd2(im,km), thld(im,km), + & qtx(im,km), qtd(im,km), + & thlvd(im), hrad(im), + & xlamdem(im,km-1), ra1(im) + real(kind=kind_phys) delz(im), xlamax(im) +! + real(kind=kind_phys) xlamavg(im), sigma(im), + & scaldfunc(im), sumx(im) +! + logical totflg, flg(im) +! + real(kind=kind_phys) actei, cldtime +! +c physical parameters + parameter(g=grav) + parameter(gocp=g/cp) + parameter(elocp=hvap/cp,el2orc=hvap*hvap/(rv*cp)) + parameter(ce0=0.4,cm=1.0,pgcon=0.55) + parameter(qmin=1.e-8,qlmin=1.e-12) + parameter(b1=0.45,f1=0.15) + parameter(a2=0.5) + parameter(cldtime=500.) + parameter(actei = 0.7) +! parameter(actei = 0.23) +! +!************************************************************************ +!! + totflg = .true. + do i=1,im + totflg = totflg .and. (.not. cnvflg(i)) + enddo + if(totflg) return +!! + dt2 = delt +! + do k = 1, km + do i=1,im + if(cnvflg(i)) then + buo(i,k) = 0. + wd2(i,k) = 0. + qtx(i,k) = q1(i,k,1) + q1(i,k,ntcw) + endif + enddo + enddo +! + do i = 1, im + if(cnvflg(i)) then + hrad(i) = zm(i,krad(i)) + krad1(i) = krad(i)-1 + endif + enddo +! + do i = 1, im + if(cnvflg(i)) then + k = krad(i) + tem = zm(i,k+1)-zm(i,k) + tem1 = cldtime*radmin(i)/tem + tem1 = max(tem1, -3.0) + thld(i,k)= thlx(i,k) + tem1 + qtd(i,k) = qtx(i,k) + thlvd(i) = thlvx(i,k) + tem1 + buo(i,k) = - g * tem1 / thvx(i,k) + endif + enddo +! +!> - Specify downdraft fraction +! + do i=1,im + if(cnvflg(i)) then + ra1(i) = a1 + endif + enddo +! +!> - If the condition for cloud-top instability is met, +!! increase downdraft fraction +! + do i = 1, im + if(cnvflg(i)) then + k = krad(i) + tem = thetae(i,k) - thetae(i,k+1) + tem1 = qtx(i,k) - qtx(i,k+1) + if (tem > 0. .and. tem1 > 0.) then + cteit= cp*tem/(hvap*tem1) + if(cteit > actei) then + ra1(i) = a2 + endif + endif + endif + enddo +! +!> - First-guess level of downdraft extension (mrad) +! + do i = 1, im + flg(i) = cnvflg(i) + mrad(i) = krad(i) + enddo + do k = kmscu,1,-1 + do i = 1, im + if(flg(i) .and. k < krad(i)) then + if(thlvd(i) <= thlvx(i,k)) then + mrad(i) = k + else + flg(i)=.false. + endif + endif + enddo + enddo + do i=1,im + if (cnvflg(i)) then + kk = krad(i)-mrad(i) + if(kk < 1) cnvflg(i)=.false. + endif + enddo +!! + totflg = .true. + do i=1,im + totflg = totflg .and. (.not. cnvflg(i)) + enddo + if(totflg) return +!! +! +!> - Compute entrainment rate +! + do i=1,im + if(cnvflg(i)) then + k = mrad(i) + (krad(i)-mrad(i)) / 2 + k = max(k, mrad(i)) + delz(i) = zl(i,k+1) - zl(i,k) + xlamax(i) = ce0 / delz(i) + endif + enddo +! + do k = 1, kmscu + do i=1,im + if(cnvflg(i)) then + if(k >= mrad(i) .and. k < krad(i)) then + if(mrad(i) == 1) then + ptem = 1./(zm(i,k)+delz(i)) + else + ptem = 1./(zm(i,k)-zm(i,mrad(i)-1)+delz(i)) + endif + tem = max((hrad(i)-zm(i,k)+delz(i)) ,delz(i)) + ptem1 = 1./tem + xlamde(i,k) = ce0 * (ptem+ptem1) + else + xlamde(i,k) = xlamax(i) + endif +! + xlamdem(i,k) = cm * xlamde(i,k) + endif + enddo + enddo +! +!> - Compute buoyancy for downdraft air parcel +! + do k = kmscu,1,-1 + do i=1,im + if(cnvflg(i) .and. k < krad(i)) then + dz = zl(i,k+1) - zl(i,k) + tem = 0.5 * xlamde(i,k) * dz + factor = 1. + tem +! + thld(i,k) = ((1.-tem)*thld(i,k+1)+tem* + & (thlx(i,k)+thlx(i,k+1)))/factor + qtd(i,k) = ((1.-tem)*qtd(i,k+1)+tem* + & (qtx(i,k)+qtx(i,k+1)))/factor +! + tld = thld(i,k) / pix(i,k) + es = 0.01 * fpvs(tld) ! fpvs in pa + qs = max(qmin, eps * es / (plyr(i,k)+epsm1*es)) + dq = qtd(i,k) - qs +! + if (dq > 0.) then + gamma = el2orc * qs / (tld**2) + qld = dq / (1. + gamma) + qtd(i,k) = qs + qld + tem1 = 1. + fv * qs - qld + thdn = thld(i,k) + pix(i,k) * elocp * qld + thvd = thdn * tem1 + else + tem1 = 1. + fv * qtd(i,k) + thvd = thld(i,k) * tem1 + endif + buo(i,k) = g * (1. - thvd / thvx(i,k)) +! + endif + enddo + enddo +! +!> - Compute downdraft velocity square(wd2) +! +! tem = 1.-2.*f1 +! bb1 = 2. * b1 / tem +! bb2 = 2. / tem +! from Soares et al. (2004,QJRMS) +! bb1 = 2. +! bb2 = 4. +! +! from Bretherton et al. (2004, MWR) +! bb1 = 4. +! bb2 = 2. +! +! from our tuning + bb1 = 2.0 + bb2 = 4.0 +! + do i = 1, im + if(cnvflg(i)) then + k = krad1(i) + dz = zm(i,k+1) - zm(i,k) +! tem = 0.25*bb1*(xlamde(i,k)+xlamde(i,k+1))*dz + tem = 0.5*bb1*xlamde(i,k)*dz + tem1 = bb2 * buo(i,k+1) * dz + ptem1 = 1. + tem + wd2(i,k) = tem1 / ptem1 + endif + enddo + do k = kmscu,1,-1 + do i = 1, im + if(cnvflg(i) .and. k < krad1(i)) then + dz = zm(i,k+1) - zm(i,k) + tem = 0.25*bb1*(xlamde(i,k)+xlamde(i,k+1))*dz + tem1 = bb2 * buo(i,k+1) * dz + ptem = (1. - tem) * wd2(i,k+1) + ptem1 = 1. + tem + wd2(i,k) = (ptem + tem1) / ptem1 + endif + enddo + enddo +c + do i = 1, im + flg(i) = cnvflg(i) + if(flg(i)) mrad(i) = krad(i) + enddo + do k = kmscu,1,-1 + do i = 1, im + if(flg(i) .and. k < krad(i)) then + if(wd2(i,k) > 0.) then + mrad(i) = k + else + flg(i)=.false. + endif + endif + enddo + enddo +! + do i=1,im + if (cnvflg(i)) then + kk = krad(i)-mrad(i) + if(kk < 1) cnvflg(i)=.false. + endif + enddo +!! + totflg = .true. + do i=1,im + totflg = totflg .and. (.not. cnvflg(i)) + enddo + if(totflg) return +!! +! +!> - Update entrainment rate +! + do i=1,im + if(cnvflg(i)) then + k = mrad(i) + (krad(i)-mrad(i)) / 2 + k = max(k, mrad(i)) + delz(i) = zl(i,k+1) - zl(i,k) + xlamax(i) = ce0 / delz(i) + endif + enddo +! + do k = 1, kmscu + do i=1,im + if(cnvflg(i)) then + if(k >= mrad(i) .and. k < krad(i)) then + if(mrad(i) == 1) then + ptem = 1./(zm(i,k)+delz(i)) + else + ptem = 1./(zm(i,k)-zm(i,mrad(i)-1)+delz(i)) + endif + tem = max((hrad(i)-zm(i,k)+delz(i)) ,delz(i)) + ptem1 = 1./tem + xlamde(i,k) = ce0 * (ptem+ptem1) + else + xlamde(i,k) = xlamax(i) + endif +! + xlamdem(i,k) = cm * xlamde(i,k) + endif + enddo + enddo +! +!> - Compute entrainment rate averaged over the whole downdraft layers +! + do i = 1, im + xlamavg(i) = 0. + sumx(i) = 0. + enddo + do k = kmscu, 1, -1 + do i = 1, im + if(cnvflg(i) .and. + & (k >= mrad(i) .and. k < krad(i))) then + dz = zl(i,k+1) - zl(i,k) + xlamavg(i) = xlamavg(i) + xlamde(i,k) * dz + sumx(i) = sumx(i) + dz + endif + enddo + enddo + do i = 1, im + if(cnvflg(i)) then + xlamavg(i) = xlamavg(i) / sumx(i) + endif + enddo +! +!> - Compute downdraft mass flux +! + do k = kmscu, 1, -1 + do i = 1, im + if(cnvflg(i) .and. + & (k >= mrad(i) .and. k < krad(i))) then + xmfd(i,k) = ra1(i) * sqrt(wd2(i,k)) + endif + enddo + enddo +! +!> - Compute downdraft fraction as a function of mean entrainment rate +!! (Grell and Freitas(2014) \cite grell_and_freitas_2014 +! + do i = 1, im + if(cnvflg(i)) then + tem = 0.2 / xlamavg(i) + tem1 = 3.14 * tem * tem + sigma(i) = tem1 / (gdx(i) * gdx(i)) + sigma(i) = max(sigma(i), 0.001) + sigma(i) = min(sigma(i), 0.999) + endif + enddo +! +!> - Compute scale-aware function based on +!! Arakawa and Wu (2013) \cite arakawa_and_wu_2013 +! + do i = 1, im + if(cnvflg(i)) then + if (sigma(i) > ra1(i)) then + scaldfunc(i) = (1.-sigma(i)) * (1.-sigma(i)) + scaldfunc(i) = max(min(scaldfunc(i), 1.0), 0.) + else + scaldfunc(i) = 1.0 + endif + endif + enddo +! +!> - Compute final scale-aware downdraft mass flux +! + do k = kmscu, 1, -1 + do i = 1, im + if(cnvflg(i) .and. + & (k >= mrad(i) .and. k < krad(i))) then + xmfd(i,k) = scaldfunc(i) * xmfd(i,k) + dz = zl(i,k+1) - zl(i,k) + xmmx = dz / dt2 + xmfd(i,k) = min(xmfd(i,k),xmmx) + endif + enddo + enddo +! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +!> - Compute downdraft property using updated entranment rate +! + do i = 1, im + if(cnvflg(i)) then + k = krad(i) + thld(i,k)= thlx(i,k) + endif + enddo +! +! do i = 1, im +! if(cnvflg(i)) then +! k = krad(i) +! ptem1 = max(qcdo(i,k,ntcw), 0.) +! tld = thld(i,k) / pix(i,k) +! tcdo(i,k) = tld + elocp * ptem1 +! qcdo(i,k,1) = qcdo(i,k,1)+0.2*qcdo(i,k,1) +! qcdo(i,k,ntcw) = qcdo(i,k,ntcw)+0.2*qcdo(i,k,ntcw) +! endif +! enddo +! + do k = kmscu,1,-1 + do i=1,im + if(cnvflg(i) .and. + & (k >= mrad(i) .and. k < krad(i))) then + dz = zl(i,k+1) - zl(i,k) + tem = 0.5 * xlamde(i,k) * dz + factor = 1. + tem +! + thld(i,k) = ((1.-tem)*thld(i,k+1)+tem* + & (thlx(i,k)+thlx(i,k+1)))/factor + qtd(i,k) = ((1.-tem)*qtd(i,k+1)+tem* + & (qtx(i,k)+qtx(i,k+1)))/factor +! + tld = thld(i,k) / pix(i,k) + es = 0.01 * fpvs(tld) ! fpvs in pa + qs = max(qmin, eps * es / (plyr(i,k)+epsm1*es)) + dq = qtd(i,k) - qs +! + if (dq > 0.) then + gamma = el2orc * qs / (tld**2) + qld = dq / (1. + gamma) + qtd(i,k) = qs + qld + qcdo(i,k,1) = qs + qcdo(i,k,ntcw) = qld + tcdo(i,k) = tld + elocp * qld + else + qcdo(i,k,1) = qtd(i,k) + qcdo(i,k,ntcw) = 0. + tcdo(i,k) = tld + endif +! + endif + enddo + enddo +! + do k = kmscu, 1, -1 + do i = 1, im + if (cnvflg(i) .and. k < krad(i)) then + if(k >= mrad(i)) then + dz = zl(i,k+1) - zl(i,k) + tem = 0.5 * xlamdem(i,k) * dz + factor = 1. + tem + ptem = tem - pgcon + ptem1= tem + pgcon +! + ucdo(i,k) = ((1.-tem)*ucdo(i,k+1)+ptem*u1(i,k+1) + & +ptem1*u1(i,k))/factor + vcdo(i,k) = ((1.-tem)*vcdo(i,k+1)+ptem*v1(i,k+1) + & +ptem1*v1(i,k))/factor + endif + endif + enddo + enddo +! + if(ntcw > 2) then +! + do n = 2, ntcw-1 + do k = kmscu, 1, -1 + do i = 1, im + if (cnvflg(i) .and. k < krad(i)) then + if(k >= mrad(i)) then + dz = zl(i,k+1) - zl(i,k) + tem = 0.5 * xlamde(i,k) * dz + factor = 1. + tem +! + qcdo(i,k,n) = ((1.-tem)*qcdo(i,k+1,n)+tem* + & (q1(i,k,n)+q1(i,k+1,n)))/factor + endif + endif + enddo + enddo + enddo +! + endif +! + ndc = ntrac1 - ntcw +! + if(ndc > 0) then +! + do n = ntcw+1, ntrac1 + do k = kmscu, 1, -1 + do i = 1, im + if (cnvflg(i) .and. k < krad(i)) then + if(k >= mrad(i)) then + dz = zl(i,k+1) - zl(i,k) + tem = 0.5 * xlamde(i,k) * dz + factor = 1. + tem +! + qcdo(i,k,n) = ((1.-tem)*qcdo(i,k+1,n)+tem* + & (q1(i,k,n)+q1(i,k+1,n)))/factor + endif + endif + enddo + enddo + enddo +! + endif +! + return + end +!> @} diff --git a/physics/micro_mg2_0.F90 b/physics/micro_mg2_0.F90 index 281802878..135c11e49 100644 --- a/physics/micro_mg2_0.F90 +++ b/physics/micro_mg2_0.F90 @@ -95,7 +95,6 @@ module micro_mg2_0 ! 2) saturation vapor pressure and specific humidity over water ! 3) svp over ice use machine, only : r8 => kind_phys -use physcons, only : epsqs => con_eps, fv => con_fvirt use funcphys, only : fpvsl, fpvsi !use wv_sat_methods, only: & @@ -183,7 +182,7 @@ module micro_mg2_0 real(r8) :: gamma_br_plus1, gamma_bs_plus1, gamma_bi_plus1, gamma_bj_plus1 real(r8) :: gamma_br_plus4, gamma_bs_plus4, gamma_bi_plus4, gamma_bj_plus4 real(r8) :: xxlv_squared, xxls_squared -real(r8) :: omeps +real(r8) :: omeps, epsqs character(len=16) :: micro_mg_precip_frac_method ! type of precipitation fraction method real(r8) :: micro_mg_berg_eff_factor ! berg efficiency factor @@ -200,7 +199,7 @@ module micro_mg2_0 !>\ingroup mg2_0_mp !! This subroutine calculates subroutine micro_mg_init( & - kind, gravit, rair, rh2o, cpair, & + kind, gravit, rair, rh2o, cpair, eps, & tmelt_in, latvap, latice, & rhmini_in, micro_mg_dcs,ts_auto, mg_qcvar, & microp_uniform_in, do_cldice_in, use_hetfrz_classnuc_in, & @@ -226,6 +225,8 @@ subroutine micro_mg_init( & real(r8), intent(in) :: rair real(r8), intent(in) :: rh2o real(r8), intent(in) :: cpair + real(r8), intent(in) :: eps +! real(r8), intent(in) :: fv real(r8), intent(in) :: tmelt_in !< Freezing point of water (K) real(r8), intent(in) :: latvap real(r8), intent(in) :: latice @@ -321,6 +322,7 @@ subroutine micro_mg_init( & xxlv_squared = xxlv * xxlv xxls_squared = xxls * xxls + epsqs = eps omeps = one - epsqs tmn = 173.16_r8 tmx = 375.16_r8 diff --git a/physics/micro_mg3_0.F90 b/physics/micro_mg3_0.F90 index 0157ac763..fd155bfa7 100644 --- a/physics/micro_mg3_0.F90 +++ b/physics/micro_mg3_0.F90 @@ -1,12 +1,14 @@ !>\file micro_mg3_0.F90 !! This file contains Morrison-Gettelman MP version 3.0 - -!! Update of MG microphysics with prognostic hai OR graupel. +!! Update of MG microphysics with prognostic hail OR graupel. !>\ingroup mg2mg3 !>\defgroup mg3_mp Morrison-Gettelman MP version 3.0 !> @{ -!! This module contains MG microphysics version 3.0 - Update of MG microphysics with -!! prognostic hail OR graupel. +!!--------------------------------------------------------------------------------- +!! Purpose: +!! MG microphysics version 3.0 - Update of MG microphysics with +!! prognostic hail OR graupel. !! !! \authors Andrew Gettelman, Hugh Morrison !! @@ -46,6 +48,7 @@ !! !! for questions contact Hugh Morrison, Andrew Gettelman !! e-mail: morrison@ucar.edu, andrew@ucar.edu +!!--------------------------------------------------------------------------------- !! !! NOTE: Modified to allow other microphysics packages (e.g. CARMA) to do ice !! microphysics in cooperation with the MG liquid microphysics. This is @@ -124,7 +127,6 @@ module micro_mg3_0 use machine, only : r8 => kind_phys -use physcons, only : epsqs => con_eps, fv => con_fvirt use funcphys, only : fpvsl, fpvsi !use wv_sat_methods, only: & @@ -232,7 +234,7 @@ module micro_mg3_0 real(r8) :: gamma_br_plus1, gamma_bs_plus1, gamma_bi_plus1, gamma_bj_plus1, gamma_bg_plus1 real(r8) :: gamma_br_plus4, gamma_bs_plus4, gamma_bi_plus4, gamma_bj_plus4, gamma_bg_plus4 real(r8) :: xxlv_squared, xxls_squared -real(r8) :: omeps +real(r8) :: omeps, epsqs character(len=16) :: micro_mg_precip_frac_method !< type of precipitation fraction method real(r8) :: micro_mg_berg_eff_factor !< berg efficiency factor @@ -247,14 +249,16 @@ module micro_mg3_0 !=============================================================================== !>\ingroup mg3_mp -!! This subroutine initializes microphysics routine, should be called -!! once at start of simulation. +!! This subroutine initializes the microphysics +!! and needs to be called once at start of simulation. !!\author Andrew Gettelman, Dec 2005 subroutine micro_mg_init( & - kind, gravit, rair, rh2o, cpair, & + kind, gravit, rair, rh2o, cpair, eps, & tmelt_in, latvap, latice, & - rhmini_in, micro_mg_dcs,ts_auto, mg_qcvar, & !++ag - micro_mg_do_hail_in, micro_mg_do_graupel_in, &!--ag + rhmini_in, micro_mg_dcs,ts_auto, mg_qcvar, & +!++ag + micro_mg_do_hail_in, micro_mg_do_graupel_in, & +!--ag microp_uniform_in, do_cldice_in, use_hetfrz_classnuc_in, & micro_mg_precip_frac_method_in, micro_mg_berg_eff_factor_in, & allow_sed_supersat_in, do_sb_physics_in, & @@ -274,37 +278,39 @@ subroutine micro_mg_init( & ! !----------------------------------------------------------------------- - integer, intent(in) :: kind !< Kind used for reals + integer, intent(in) :: kind ! Kind used for reals real(r8), intent(in) :: gravit real(r8), intent(in) :: rair real(r8), intent(in) :: rh2o real(r8), intent(in) :: cpair - real(r8), intent(in) :: tmelt_in !< Freezing point of water (K) + real(r8), intent(in) :: eps +! real(r8), intent(in) :: fv + real(r8), intent(in) :: tmelt_in ! Freezing point of water (K) real(r8), intent(in) :: latvap real(r8), intent(in) :: latice - real(r8), intent(in) :: rhmini_in !< Minimum rh for ice cloud fraction > 0. + real(r8), intent(in) :: rhmini_in ! Minimum rh for ice cloud fraction > 0. real(r8), intent(in) :: micro_mg_dcs real(r8), intent(in) :: ts_auto(2) real(r8), intent(in) :: mg_qcvar !++ag !MG3 dense precipitating ice. Note, only 1 can be true, or both false. - logical, intent(in) :: micro_mg_do_graupel_in !< .true. = configure with graupel - !< .false. = no graupel (hail possible) - logical, intent(in) :: micro_mg_do_hail_in !< .true. = configure with hail - !< .false. = no hail (graupel possible) + logical, intent(in) :: micro_mg_do_graupel_in ! .true. = configure with graupel + ! .false. = no graupel (hail possible) + logical, intent(in) :: micro_mg_do_hail_in ! .true. = configure with hail + ! .false. = no hail (graupel possible) !--ag - logical, intent(in) :: microp_uniform_in !< .true. = configure uniform for sub-columns - !< .false. = use w/o sub-columns (standard) - logical, intent(in) :: do_cldice_in !< .true. = do all processes (standard) - !< .false. = skip all processes affecting cloud ice - logical, intent(in) :: use_hetfrz_classnuc_in !< use heterogeneous freezing + logical, intent(in) :: microp_uniform_in ! .true. = configure uniform for sub-columns + ! .false. = use w/o sub-columns (standard) + logical, intent(in) :: do_cldice_in ! .true. = do all processes (standard) + ! .false. = skip all processes affecting cloud ice + logical, intent(in) :: use_hetfrz_classnuc_in ! use heterogeneous freezing - character(len=16),intent(in) :: micro_mg_precip_frac_method_in !< type of precipitation fraction method - real(r8), intent(in) :: micro_mg_berg_eff_factor_in !< berg efficiency factor - logical, intent(in) :: allow_sed_supersat_in !< allow supersaturated conditions after sedimentation loop - logical, intent(in) :: do_sb_physics_in !< do SB autoconversion and accretion physics + character(len=16),intent(in) :: micro_mg_precip_frac_method_in ! type of precipitation fraction method + real(r8), intent(in) :: micro_mg_berg_eff_factor_in ! berg efficiency factor + logical, intent(in) :: allow_sed_supersat_in ! allow supersaturated conditions after sedimentation loop + logical, intent(in) :: do_sb_physics_in ! do SB autoconversion and accretion physics logical, intent(in) :: do_ice_gmao_in logical, intent(in) :: do_liq_liu_in @@ -410,6 +416,7 @@ subroutine micro_mg_init( & xxlv_squared = xxlv * xxlv xxls_squared = xxls * xxls + epsqs = eps omeps = one - epsqs tmn = 173.16_r8 tmx = 375.16_r8 @@ -427,8 +434,7 @@ end subroutine micro_mg_init !microphysics routine for each timestep goes here... !>\ingroup mg3_mp -!! This subroutine calculates calculate -!! MG3 microphysical processes and other utilities. +!! This subroutine calculates the MG3 microphysical processes. !>\authors Hugh Morrison, Andrew Gettelman, NCAR, Peter Caldwell, LLNL !! e-mail: morrison@ucar.edu, andrew@ucar.edu !!\section mg3_micro_mg_tend MG3 micro_mg_tend General Algorithm @@ -439,8 +445,10 @@ subroutine micro_mg_tend ( & qcn, qin, & ncn, nin, & qrn, qsn, & - nrn, nsn, &!++ag - qgr, ngr, &!--ag + nrn, nsn, & +!++ag + qgr, ngr, & +!--ag relvar, accre_enhan_i, & p, pdel, & cldn, liqcldf, icecldf, qsatfac, & @@ -451,8 +459,10 @@ subroutine micro_mg_tend ( & qctend, qitend, & nctend, nitend, & qrtend, qstend, & - nrtend, nstend, &!++ag - qgtend, ngtend, &!--ag + nrtend, nstend, & +!++ag + qgtend, ngtend, & +!--ag effc, effc_fn, effi, & sadice, sadsnow, & prect, preci, & @@ -461,30 +471,43 @@ subroutine micro_mg_tend ( & prain, prodsnow, & cmeout, deffi, & pgamrad, lamcrad, & - qsout, dsout, &!++ag - qgout, ngout, dgout, &!--ag - lflx, iflx, &!++ag - gflx, &!--ag - rflx, sflx, qrout, &!++ag - reff_rain, reff_snow, reff_grau, &!--ag + qsout, dsout, & +!++ag + qgout, ngout, dgout, & +!--ag + lflx, iflx, & +!++ag + gflx, & +!--ag + rflx, sflx, qrout, & +!++ag + reff_rain, reff_snow, reff_grau, & +!--ag + qcsevap, qisevap, qvres, & cmeitot, vtrmc, vtrmi, & - umr, ums, &!++ag - umg, qgsedten, &!--ag + umr, ums, & +!++ag + umg, qgsedten, & +!--ag qcsedten, qisedten, & qrsedten, qssedten, & pratot, prctot, & mnuccctot, mnuccttot, msacwitot, & psacwstot, bergstot, bergtot, & melttot, homotot, & - qcrestot, prcitot, praitot, &!++ag - qirestot, mnuccrtot, mnuccritot, pracstot, &!--ag - meltsdttot, frzrdttot, mnuccdtot, &!++ag + qcrestot, prcitot, praitot, & +!++ag + qirestot, mnuccrtot, mnuccritot, pracstot, & +!--ag + meltsdttot, frzrdttot, mnuccdtot, & +!++ag pracgtot, psacwgtot, pgsacwtot, & pgracstot, prdgtot, & qmultgtot, qmultrgtot, psacrtot, & npracgtot, nscngtot, ngracstot, & - nmultgtot, nmultrgtot, npsacwgtot, &!--ag + nmultgtot, nmultrgtot, npsacwgtot, & +!--ag nrout, nsout, & refl, arefl, areflz, & frefl, csrfl, acsrfl, & @@ -492,8 +515,10 @@ subroutine micro_mg_tend ( & ncai, ncal, & qrout2, qsout2, & nrout2, nsout2, & - drout2, dsout2, &!++ag - qgout2, ngout2, dgout2, freqg, &!--ag + drout2, dsout2, & +!++ag + qgout2, ngout2, dgout2, freqg, & +!--ag freqs, freqr, & nfice, qcrat, & prer_evap, xlat, xlon, lprnt, iccn, aero_in, nlball) @@ -584,7 +609,9 @@ subroutine micro_mg_tend ( & real(r8), intent(in) :: liqcldf(mgncol,nlev) !< liquid cloud fraction (no units) real(r8), intent(in) :: icecldf(mgncol,nlev) !< ice cloud fraction (no units) real(r8), intent(in) :: qsatfac(mgncol,nlev) !< subgrid cloud water saturation scaling factor (no units) - logical, intent(in) :: lprnt, iccn, aero_in + logical, intent(in) :: lprnt !< control flag for diagnostic print out + logical, intent(in) :: iccn !< flag for IN and CCN forcing for Morrison-Gettelman microphysics + logical, intent(in) :: aero_in !< flag for using aerosols in Morrison-Gettelman microphysics ! used for scavenging @@ -1592,7 +1619,7 @@ subroutine micro_mg_tend ( & tlat(i,k) = tlat(i,k) + dum1 meltsdttot(i,k) = meltsdttot(i,k) + dum1 -! if (lprnt .and. k >=100) write(0,*)' tlats=',tlat(i,k),' dum1=',dum1,& +! if (lprnt .and. k >=40) write(0,*)' tlats=',tlat(i,k),' dum1=',dum1,& ! ' minstsm=',minstsm(i,k),' qs=',qs(i,k),' xlf=',xlf,' oneodt=',oneodt, & ! ' snowmelt=',snowmelt,' t=',t(i,k),' dum=',dum,' k=',k @@ -1634,7 +1661,7 @@ subroutine micro_mg_tend ( & tlat(i,k) = dum1 + tlat(i,k) meltsdttot(i,k) = dum1 + meltsdttot(i,k) -! if (lprnt .and. k >=100) write(0,*)' tlatg=',tlat(i,k),' dum1=',dum1,& +! if (lprnt .and. k >=40) write(0,*)' tlatg=',tlat(i,k),' dum1=',dum1,& ! ' minstgm=',minstgm(i,k),' qg=',qg(i,k),' xlf=',xlf,' oneodt=',oneodt, & ! ' snowmelt=',snowmelt,' t=',t(i,k),' k=',k,' cpp=',cpp @@ -2162,6 +2189,10 @@ subroutine micro_mg_tend ( & call bergeron_process_snow(t(:,k), rho(:,k), dv(:,k), mu(:,k), sc(:,k), & qvl(:,k), qvi(:,k), asn(:,k), qcic(:,k), qsic(:,k), lams(:,k), n0s(:,k), & bergs(:,k), mgncol) +! if(lprnt) write(0,*)' bergs1=',bergs(1,k),' k=',k,' micro_mg_berg_eff_factor=',micro_mg_berg_eff_factor +! if(lprnt) write(0,*)' t=',t(1,k),' rho=',rho(1,k),' dv=',dv(1,k),' mu=',mu(1,k),& +! 'qcic=',qcic(1,k),' qsic=',qsic(1,k),' qvl=',qvl(1,k),' qvi=',qvi(1,k), & +! ' mu=',mu(1,k),' sc=',sc(1,k),' asn=',asn(1,k),' lams=',lams(1,k),' n0s=',n0s(1,k),' ni=',ni(1,k) bergs(:,k) = bergs(:,k) * micro_mg_berg_eff_factor @@ -2172,6 +2203,11 @@ subroutine micro_mg_tend ( & icldm(:,k), rho(:,k), dv(:,k), qvl(:,k), qvi(:,k), & berg(:,k), vap_dep(:,k), ice_sublim(:,k), mgncol) +! if(lprnt) write(0,*)' t=',t(1,k),' k=',k,' q=',q(1,k),' qi=',qi(1,k),& +! ' ni=',ni(1,k),' icldm=',icldm(1,k),' rho=',rho(1,k),' dv=',dv(1,k),& +! ' qvl=',qvl(1,k),' qvi=',qvi(1,k),' berg=',berg(1,k),' vap_dep=',& +! vap_dep(1,k),' ice_sublim=',ice_sublim(1,k) +! if(lprnt) write(0,*)' berg1=',berg(1,k),' k=',k,' micro_mg_berg_eff_factor=',micro_mg_berg_eff_factor do i=1,mgncol ! sublimation should not exceed available ice ice_sublim(i,k) = max(ice_sublim(i,k), -qi(i,k)*oneodt) @@ -2347,6 +2383,8 @@ subroutine micro_mg_tend ( & qcrat(i,k) = one end if +! if(lprnt) write(0,*)' bergs2=',bergs(1,k),' k=',k,' ratio=',ratio + !PMC 12/3/12: ratio is also frac of step w/ liquid. !thus we apply berg for "ratio" of timestep and vapor !deposition for the remaining frac of the timestep. @@ -2417,13 +2455,11 @@ subroutine micro_mg_tend ( & if (do_cldice) then ! freezing of rain to produce ice if mean rain size is smaller than Dcs - if (lamr(i,k) > qsmall) then - if(one/lamr(i,k) < Dcs) then - mnuccri(i,k) = mnuccr(i,k) - nnuccri(i,k) = nnuccr(i,k) - mnuccr(i,k) = zero - nnuccr(i,k) = zero - end if + if (lamr(i,k) > qsmall .and. one/lamr(i,k) < Dcs) then + mnuccri(i,k) = mnuccr(i,k) + nnuccri(i,k) = nnuccr(i,k) + mnuccr(i,k) = zero + nnuccr(i,k) = zero end if end if @@ -2820,11 +2856,11 @@ subroutine micro_mg_tend ( & ! if (lprnt) write(0,*)' k=',k,' tlat=',tlat(i,k) ! if (lprnt .and. k >= 60) write(0,*)' k=',k,' tlat=',tlat(i,k) -! qctend(i,k) = qctend(i,k) + (-pra(i,k)-prc(i,k)-mnuccc(i,k)-mnucct(i,k)-msacwi(i,k)- & -! psacws(i,k)-bergs(i,k))*l!ldm(i,k)-berg(i,k) +! qctend(i,k) = qctend(i,k) + (-pra(i,k)-prc(i,k)-mnuccc(i,k)-mnucct(i,k)-msacwi(i,k)- & +! psacws(i,k)-bergs(i,k))*lcldm(i,k)-berg(i,k) - qctend(i,k) = qctend(i,k)+ & - (-pra(i,k)-prc(i,k)-mnuccc(i,k)-mnucct(i,k)-msacwi(i,k)- & + qctend(i,k) = qctend(i,k) + & + (-pra(i,k)-prc(i,k)-mnuccc(i,k)-mnucct(i,k)-msacwi(i,k) - & psacws(i,k)-bergs(i,k)-qmultg(i,k)-psacwg(i,k)-pgsacw(i,k))*lcldm(i,k)-berg(i,k) if (do_cldice) then @@ -3662,7 +3698,7 @@ subroutine micro_mg_tend ( & end do !! nstep loop ! if (lprnt) write(0,*)' prectaftssno=',prect(i),' preci=',preci(i) -! if (lprnt) write(0,*)' qgtnd1=',qgtend(1,:) +! if (lprnt) write(0,*)' qgtnd1=',qgtend(1,:) if (do_graupel .or. do_hail) then !++ag Graupel Sedimentation @@ -4446,18 +4482,18 @@ end subroutine micro_mg_tend !======================================================================== !>\ingroup mg3_mp -!! This subroutine calculates effective radius for rain + cloud. +!! This subroutine calculates effective radii for rain and cloud. subroutine calc_rercld(lamr, n0r, lamc, pgam, qric, qcic, ncic, rercld, mgncol,nlev) - integer, intent(in) :: mgncol, nlev - real(r8), dimension(mgncol,nlev), intent(in) :: lamr !< rain size parameter (slope) - real(r8), dimension(mgncol,nlev), intent(in) :: n0r !< rain size parameter (intercept) - real(r8), dimension(mgncol,nlev), intent(in) :: lamc !< size distribution parameter (slope) - real(r8), dimension(mgncol,nlev), intent(in) :: pgam !< droplet size parameter - real(r8), dimension(mgncol,nlev), intent(in) :: qric !< in-cloud rain mass mixing ratio - real(r8), dimension(mgncol,nlev), intent(in) :: qcic !< in-cloud cloud liquid - real(r8), dimension(mgncol,nlev), intent(in) :: ncic !< in-cloud droplet number concentration - - real(r8), dimension(mgncol,nlev), intent(inout) :: rercld !< effective radius calculation for rain + cloud + integer, intent(in) :: mgncol, nlev ! horizontal and vertical dimension + real(r8), dimension(mgncol,nlev), intent(in) :: lamr ! rain size parameter (slope) + real(r8), dimension(mgncol,nlev), intent(in) :: n0r ! rain size parameter (intercept) + real(r8), dimension(mgncol,nlev), intent(in) :: lamc ! size distribution parameter (slope) + real(r8), dimension(mgncol,nlev), intent(in) :: pgam ! droplet size parameter + real(r8), dimension(mgncol,nlev), intent(in) :: qric ! in-cloud rain mass mixing ratio + real(r8), dimension(mgncol,nlev), intent(in) :: qcic ! in-cloud cloud liquid + real(r8), dimension(mgncol,nlev), intent(in) :: ncic ! in-cloud droplet number concentration + + real(r8), dimension(mgncol,nlev), intent(inout) :: rercld ! effective radius calculation for rain + cloud ! combined size of precip & cloud drops real(r8) :: Atmp diff --git a/physics/micro_mg_utils.F90 b/physics/micro_mg_utils.F90 index fe1c8c8b0..89dd7193e 100644 --- a/physics/micro_mg_utils.F90 +++ b/physics/micro_mg_utils.F90 @@ -253,7 +253,8 @@ module micro_mg_utils ! Mass of each raindrop created from autoconversion. real(r8), parameter :: droplet_mass_25um = 4._r8/3._r8*pi*rhow*(25.e-6_r8)**3 -real(r8), parameter :: droplet_mass_40um = 4._r8/3._r8*pi*rhow*(40.e-6_r8)**3 +real(r8), parameter :: droplet_mass_40um = 4._r8/3._r8*pi*rhow*(40.e-6_r8)**3, & + droplet_mass_40umi = 1._r8/droplet_mass_40um !========================================================= ! Constants set in initialization @@ -793,10 +794,10 @@ subroutine size_dist_param_ice_vect(props, qic, nic, lam, mgncol, n0) end subroutine size_dist_param_ice_vect !>\ingroup micro_mg_utils_mod +!> Finds the average diameter of particles given their density, and +!! mass/number concentrations in the air. +!! Assumes that diameter follows an exponential distribution. real(r8) elemental function avg_diameter(q, n, rho_air, rho_sub) - !> Finds the average diameter of particles given their density, and - !! mass/number concentrations in the air. - !! Assumes that diameter follows an exponential distribution. real(r8), intent(in) :: q !< mass mixing ratio real(r8), intent(in) :: n !< number concentration (per volume) real(r8), intent(in) :: rho_air !< local density of the air @@ -807,9 +808,9 @@ real(r8) elemental function avg_diameter(q, n, rho_air, rho_sub) end function avg_diameter !>\ingroup mg2mg3 +!> Finds a coefficient for process rates based on the relative variance +!! of cloud water. elemental function var_coef_r8(relvar, a) result(res) - !> Finds a coefficient for process rates based on the relative variance - !! of cloud water. real(r8), intent(in) :: relvar real(r8), intent(in) :: a real(r8) :: res @@ -819,9 +820,9 @@ elemental function var_coef_r8(relvar, a) result(res) end function var_coef_r8 !>\ingroup mg2mg3 +!> Finds a coefficient for process rates based on the relative variance +!! of cloud water. elemental function var_coef_integer(relvar, a) result(res) - !> Finds a coefficient for process rates based on the relative variance - !! of cloud water. real(r8), intent(in) :: relvar integer, intent(in) :: a real(r8) :: res @@ -838,7 +839,7 @@ end function var_coef_integer !! Initial ice deposition and sublimation loop. !! Run before the main loop !! This subroutine written by Peter Caldwell -subroutine ice_deposition_sublimation(t, qv, qi, ni, & +subroutine ice_deposition_sublimation(t, qv, qi, ni, & icldm, rho, dv,qvl, qvi, & berg, vap_dep, ice_sublim, mgncol) @@ -1014,7 +1015,8 @@ subroutine sb2001v2_liq_autoconversion(pgam,qc,nc,qr,rho,relvar,au,nprc,nprc1,mg ! parameters for Seifert and Beheng (2001) autoconversion/accretion real(r8), parameter :: kc = 9.44e9_r8 real(r8), parameter :: kr = 5.78e3_r8 - real(r8), parameter :: auf = kc / (20._r8*2.6e-7_r8) * 1000._r8 + real(r8), parameter :: auf = kc / (20._r8*2.6e-7_r8) * 1000._r8, & + con_nprc1 = two/2.6e-7_r8*1000._r8 real(r8) :: dum, dum1, nu, pra_coef, tx1, tx2, tx3, tx4 integer :: dumi, i @@ -1045,8 +1047,10 @@ subroutine sb2001v2_liq_autoconversion(pgam,qc,nc,qr,rho,relvar,au,nprc,nprc1,mg ! (rho(i)*qc(i)/1000._r8)**4._r8/(rho(i)*nc(i)/1.e6_r8)**2._r8* & ! (1._r8+dum1/(1._r8-dum)**2)*1000._r8 / rho(i) - nprc1(i) = au(i) * two / 2.6e-7_r8 * 1000._r8 - nprc(i) = au(i) / droplet_mass_40um +! nprc1(i) = au(i) * two / 2.6e-7_r8 * 1000._r8 +! nprc(i) = au(i) / droplet_mass_40um + nprc1(i) = au(i) * con_nprc1 + nprc(i) = au(i) * droplet_mass_40umi else au(i) = zero nprc1(i) = zero @@ -1080,7 +1084,8 @@ subroutine liu_liq_autoconversion(pgam,qc,nc,qr,rho,relvar, & real(r8) :: xs,lw, nw, beta6 ! real(r8), parameter :: dcrit=1.0e-6, miu_disp=1. ! real(r8), parameter :: dcrit=1.0e-3, miu_disp=1. - real(r8), parameter :: dcrit=2.0e-3, miu_disp=0.8 + real(r8), parameter :: dcrit = 2.0e-3, miu_disp = 0.8, & + con_nprc1 = two/2.6e-7_r8*1000._r8 integer :: i do i=1,mgncol @@ -1099,8 +1104,10 @@ subroutine liu_liq_autoconversion(pgam,qc,nc,qr,rho,relvar, & / (gamma(relvar(i))*(relvar(i)*relvar(i))) au(i) = au(i) * dcrit - nprc1(i)= au(i) * (two/2.6e-7_r8*1000._r8) - nprc(i) = au(i) / droplet_mass_40um +! nprc1(i)= au(i) * (two/2.6e-7_r8*1000._r8) +! nprc(i) = au(i) / droplet_mass_40um + nprc1(i)= au(i) * con_nprc1 + nprc(i) = au(i) * droplet_mass_40umi else au(i) = zero nprc1(i) = zero diff --git a/physics/module_BL_MYJPBL.F90 b/physics/module_BL_MYJPBL.F90 new file mode 100755 index 000000000..b23e67cb5 --- /dev/null +++ b/physics/module_BL_MYJPBL.F90 @@ -0,0 +1,2188 @@ +!----------------------------------------------------------------------- +! + MODULE MODULE_BL_MYJPBL +! +!----------------------------------------------------------------------- +! +!*** THE MYJ PBL SCHEME +! +!----------------------------------------------------------------------- +! +! USE MODULE_INCLUDE +! +! USE MODULE_CONSTANTS,ONLY : A2,A3,A4,CP,ELIV,ELWV,ELIWV & +! ,EP_1,EPSQ & +! ,G,P608,PI,PQ0,R_D,R_V,RHOWATER & +! ,STBOLT,CAPPA + + USE machine, only: kfpt => kind_phys, & + kint => kind_INTEGER, & + klog => kind_LOGICAL + +!----------------------------------------------------------------------- +! + IMPLICIT NONE +! +!----------------------------------------------------------------------- +! integer,parameter :: isingle=selected_int_kind(r=9) +! integer,parameter :: idouble=selected_int_kind(r=18) +! integer,parameter :: single=selected_real_kind(p=6,r=37) +! integer,parameter :: double=selected_real_kind(p=13,r=200) + +! integer,parameter:: & +! klog=4 & +! ,kint=isingle & +! ,kdin=idouble & +! ,kfpt=single & +! ,kdbl=double + +! real (kind=kfpt),parameter :: r4_in=x'ffbfffff' +! real (kind=kdbl),parameter :: r8_in=x'fff7ffffffffffff' +! integer(kind=kint),parameter :: i4_in=-999 ! -huge(1) + + ! integer,parameter:: & + ! klog=4 & ! logical variables + ! ,kint=4 & ! integer variables + ! !,kfpt=4 & ! floating point variables + ! ,kfpt=8 & ! floating point variables + ! ,kdbl=8 ! double precision + + REAL(kind=kfpt),PARAMETER :: A2=17.2693882,A3=273.15,A4=35.86,CP=1004.6 & + ,ELIV=2.850e6,ELWV=2.501e6,R_V=461.6 & +! ,EPSQ=1.e-12,EPSQ2=0.02,G=9.8060226 & + ,EPSQ=1.e-12,G=9.8060226 & + ,PQ0=379.90516,R_D=287.04,EP_1=R_V/R_D-1. & + ,P608=R_V/R_D-1.,PI=3.141592653589793 & + ,RHOWATER=1000.,STBOLT=5.67051E-8,CAPPA=R_D/CP + REAL(kind=kfpt),PARAMETER :: eliwv=2.683e6 +! + REAL(kind=kfpt),PARAMETER :: CONW=1./G,CONT=CP/G,CONQ=ELWV/G + +!----------------------------------------------------------------------- +! + PRIVATE +! + PUBLIC:: MYJPBL_INIT, MYJPBL +! +!----------------------------------------------------------------------- +!----------------------------------------------------------------------- +!*** FOR MYJ TURBULENCE +!----------------------------------------------------------------------- +!----------------------------------------------------------------------- +! + REAL(KIND=KFPT),PARAMETER:: & + ELEVFC=0.6 +! + REAL(KIND=KFPT),PARAMETER:: & + VKARMAN=0.4 & +! + ,XLS=ELIV,XLV=ELWV & + ,RLIVWV=XLS/XLV,ELOCP=2.72E6/CP & +! + ,EPS1=1.E-12,EPS2=0. & + ,EPSRU=1.E-7,EPSRS=1.E-7 & + ,EPSTRB=1.E-24 & + ,FH=1.10 & +! + ,ALPH=0.30,BETA=1./273.,EL0MAX=1000.,EL0MIN=1. & +! ,ELFC=0.5,GAM1=0.2222222222222222222 & +! ,ELFC=0.23*0.25,GAM1=0.2222222222222222222 & + ,ELFC=1.,GAM1=0.2222222222222222222 & +! + ,A1=0.659888514560862645 & + ,A2X=0.6574209922667784586 & + ,B1=11.87799326209552761 & + ,B2=7.226971804046074028 & + ,C1=0.000830955950095854396 & + ,ELZ0=0.,ESQ=5.0 & +! + ,SEAFC=0.98,PQ0SEA=PQ0*SEAFC & +! + ,BTG=BETA*G & + ,ESQHF=0.5*5.0 & + ,RB1=1./B1 +! + REAL(KIND=KFPT),PARAMETER:: & + ADNH= 9.*A1*A2X*A2X*(12.*A1+3.*B2)*BTG*BTG & + ,ADNM=18.*A1*A1*A2X*(B2-3.*A2X)*BTG & + ,ANMH=-9.*A1*A2X*A2X*BTG*BTG & + ,ANMM=-3.*A1*A2X*(3.*A2X+3.*B2*C1+18.*A1*C1-B2)*BTG & + ,BDNH= 3.*A2X*(7.*A1+B2)*BTG & + ,BDNM= 6.*A1*A1 & + ,BEQH= A2X*B1*BTG+3.*A2X*(7.*A1+B2)*BTG & + ,BEQM=-A1*B1*(1.-3.*C1)+6.*A1*A1 & + ,BNMH=-A2X*BTG & + ,BNMM=A1*(1.-3.*C1) & + ,BSHH=9.*A1*A2X*A2X*BTG & + ,BSHM=18.*A1*A1*A2X*C1 & + ,BSMH=-3.*A1*A2X*(3.*A2X+3.*B2*C1+12.*A1*C1-B2)*BTG & + ,CESH=A2X & + ,CESM=A1*(1.-3.*C1) & + ,CNV=EP_1*G/BTG +! +!----------------------------------------------------------------------- +!*** FREE TERM IN THE EQUILIBRIUM EQUATION FOR (L/Q)**2 +!----------------------------------------------------------------------- +! + REAL(KIND=KFPT),PARAMETER:: & + AEQH=9.*A1*A2X*A2X*B1*BTG*BTG & + +9.*A1*A2X*A2X*(12.*A1+3.*B2)*BTG*BTG & + ,AEQM=3.*A1*A2X*B1*(3.*A2X+3.*B2*C1+18.*A1*C1-B2) & + *BTG+18.*A1*A1*A2X*(B2-3.*A2X)*BTG +! +!----------------------------------------------------------------------- +!*** FORBIDDEN TURBULENCE AREA +!----------------------------------------------------------------------- +! + REAL(KIND=KFPT),PARAMETER:: & + REQU=-AEQH/AEQM & + ,EPSGH=1.E-9,EPSGM=REQU*EPSGH +! +!----------------------------------------------------------------------- +!*** NEAR ISOTROPY FOR SHEAR TURBULENCE, WW/Q2 LOWER LIMIT +!----------------------------------------------------------------------- +! + REAL(KIND=KFPT),PARAMETER:: & + UBRYL=(18.*REQU*A1*A1*A2X*B2*C1*BTG & + +9.*A1*A2X*A2X*B2*BTG*BTG) & + /(REQU*ADNM+ADNH) & + ,UBRY=(1.+EPSRS)*UBRYL,UBRY3=3.*UBRY +! + REAL(KIND=KFPT),PARAMETER:: & + AUBH=27.*A1*A2X*A2X*B2*BTG*BTG-ADNH*UBRY3 & + ,AUBM=54.*A1*A1*A2X*B2*C1*BTG -ADNM*UBRY3 & + ,BUBH=(9.*A1*A2X+3.*A2X*B2)*BTG-BDNH*UBRY3 & + ,BUBM=18.*A1*A1*C1 -BDNM*UBRY3 & + ,CUBR=1. - UBRY3 & + ,RCUBR=1./CUBR +! +!----------------------------------------------------------------------- +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +!---LOOK-UP TABLES------------------------------------------------------ +INTEGER(KIND=KINT),PARAMETER:: & + ITBL=401 & ! CONVECTION TABLES, DIMENSION 1 +,JTBL=1201 & ! CONVECTION TABLES, DIMENSION 2 +,KERFM=301 & ! SIZE OF ERF HALF TABLE +,KERFM2=KERFM-2 ! INTERNAL POINTS OF ERF HALF TABLE + +REAL(KIND=KFPT),PARAMETER:: & + PL=2500. & ! LOWER BOUND OF PRESSURE RANGE +,PH=105000. & ! UPPER BOUND OF PRESSURE RANGE +,THL=210. & ! LOWER BOUND OF POTENTIAL TEMPERATURE RANGE +,THH=365. & ! UPPER BOUND OF POTENTIAL TEMPERATURE RANGE +,XEMIN=0. & ! LOWER BOUND OF ERF HALF TABLE +,XEMAX=3. ! UPPER BOUND OF ERF HALF TABLE + +REAL(KIND=KFPT),PRIVATE,SAVE:: & + RDP & ! SCALING FACTOR FOR PRESSURE +,RDQ & ! SCALING FACTOR FOR HUMIDITY +,RDTH & ! SCALING FACTOR FOR POTENTIAL TEMPERATURE +,RDTHE & ! SCALING FACTOR FOR EQUIVALENT POT. TEMPERATURE +,RDXE ! ERF HALF TABLE SCALING FACTOR + +REAL(KIND=KFPT),DIMENSION(1:ITBL),PRIVATE,SAVE:: & + STHE & ! RANGE FOR EQUIVALENT POTENTIAL TEMPERATURE +,THE0 ! BASE FOR EQUIVALENT POTENTIAL TEMPERATURE + +REAL(KIND=KFPT),DIMENSION(1:JTBL),PRIVATE,SAVE:: & + QS0 & ! BASE FOR SATURATION SPECIFIC HUMIDITY +,SQS ! RANGE FOR SATURATION SPECIFIC HUMIDITY + +REAL(KIND=KFPT),DIMENSION(1:KERFM),PRIVATE,SAVE:: & + HERFF ! HALF ERF TABLE + +REAL(KIND=KFPT),DIMENSION(1:ITBL,1:JTBL),PRIVATE,SAVE:: & + PTBL ! SATURATION PRESSURE TABLE + +REAL(KIND=KFPT),DIMENSION(1:JTBL,1:ITBL),PRIVATE,SAVE:: & + TTBL ! TEMPERATURE TABLE +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +!----------------------------------------------------------------------- +! + CONTAINS +! +!----------------------------------------------------------------------- +!&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& +!----------------------------------------------------------------------- +! +! REFERENCES: JANJIC (2001), NCEP OFFICE NOTE 437 +! +! ABSTRACT: +! MYJ UPDATES THE TURBULENT KINETIC ENERGY WITH THE PRODUCTION/ +! DISSIPATION TERM AND THE VERTICAL DIFFUSION TERM +! (USING AN IMPLICIT FORMULATION) FROM MELLOR-YAMADA +! LEVEL 2.5 AS EXTENDED BY JANJIC. EXCHANGE COEFFICIENTS FOR +! THE SURFACE LAYER ARE COMPUTED FROM THE MONIN-OBUKHOV THEORY. +! THE TURBULENT VERTICAL EXCHANGE IS THEN EXECUTED. +! +!----------------------------------------------------------------------- + SUBROUTINE MYJPBL(NTSD,ME,DT_PHS,EPSL,EPSQ2,HT,STDH,DZ,DEL & + ,PMID,PINH,TH,T,EXNER,Q,CWM,U,V & + ,TSK,QSFC,CHKLOWQ,THZ0,QZ0,UZ0,VZ0 & + ,XLAND,SICE,SNOW & + ,Q2,EXCH_H,USTAR,Z0,EL_MYJ,PBLH,KPBL,CT & + ,AKHS,AKMS,ELFLX,MIXHT,THLM,QLM & + ,RUBLTEN,RVBLTEN,RTHBLTEN,RQBLTEN,RQCBLTEN & + ,DUSFC,DVSFC,DTSFC,DQSFC,xkzo,xkzmo,ICT & + ,IDS,IDE,JDS,JDE & + ,IMS,IME,JMS,JME & + ,ITS,ITE,JTS,JTE,LM) + +! SUBROUTINE MYJPBL(DT,NPHS,EPSL,EPSQ2,HT,STDH,DZ & +! ,PMID,PINH,TH,T,EXNER,Q,CWM,U,V & +! ,TSK,QSFC,CHKLOWQ,THZ0,QZ0,UZ0,VZ0 & +! ,XLAND,SICE,SNOW & +! ,Q2,EXCH_H,USTAR,Z0,EL_MYJ,PBLH,KPBL,CT & +! ,AKHS,AKMS,ELFLX,MIXHT & +! ,RUBLTEN,RVBLTEN,RTHBLTEN,RQBLTEN,RQCBLTEN & +! ,IDS,IDE,JDS,JDE & +! ,IMS,IME,JMS,JME & +! ,ITS,ITE,JTS,JTE,LM) + +!---------------------------------------------------------------------- +! + IMPLICIT NONE +! + logical(kind=klog),save:: & + reinit +!---------------------------------------------------------------------- + INTEGER(KIND=KINT),INTENT(IN):: & + IDS,IDE,JDS,JDE & + ,IMS,IME,JMS,JME & + ,ITS,ITE,JTS,JTE,LM +! + INTEGER,INTENT(IN) :: ICT,ME,NTSD + +! INTEGER(KIND=KINT),INTENT(IN):: & +! NPHS +! + INTEGER(KIND=KINT),DIMENSION(IMS:IME,JMS:JME),INTENT(OUT):: & + KPBL +! + REAL(KIND=KFPT),INTENT(IN):: & + DT_PHS +! DT +! + real(kind=kfpt),dimension(1:lm-1),intent(inout):: EPSL + real(kind=kfpt),dimension(1:lm),intent(in):: EPSQ2 +! + REAL(KIND=KFPT),DIMENSION(IMS:IME,JMS:JME),INTENT(IN):: & + HT,SICE,SNOW,STDH & + ,TSK,XLAND & + ,CHKLOWQ,ELFLX,THLM,QLM +! + REAL(KIND=KFPT),DIMENSION(IMS:IME,JMS:JME,1:LM),INTENT(IN):: & + DZ,EXNER,PMID,Q,CWM,U,V,T,TH,DEL,xkzo,xkzmo +! + REAL(KIND=KFPT),DIMENSION(IMS:IME,JMS:JME,1:LM+1),INTENT(IN):: & + PINH +! + REAL(KIND=KFPT),DIMENSION(IMS:IME,JMS:JME),INTENT(OUT):: & + MIXHT & + ,PBLH +! + REAL(KIND=KFPT),DIMENSION(IMS:IME,JMS:JME,1:LM),INTENT(OUT):: & + EL_MYJ +! + REAL(KIND=KFPT),DIMENSION(IMS:IME,JMS:JME,1:LM),INTENT(OUT):: & + RQCBLTEN & + ,RUBLTEN,RVBLTEN & + ,RTHBLTEN,RQBLTEN +! + REAL(kind=KFPT),DIMENSION(IMS:IME,JMS:JME),INTENT(OUT) :: & + DUSFC,DVSFC & + ,DTSFC,DQSFC +! + REAL(KIND=KFPT),DIMENSION(IMS:IME,JMS:JME),INTENT(INOUT):: & + AKHS,AKMS +! + REAL(KIND=KFPT),DIMENSION(IMS:IME,JMS:JME),INTENT(INOUT):: & + CT,QSFC,QZ0 & + ,THZ0,USTAR & + ,UZ0,VZ0,Z0 +! + REAL(KIND=KFPT),DIMENSION(IMS:IME,JMS:JME,1:LM),INTENT(INOUT):: & + EXCH_H & + ,Q2 +! +!---------------------------------------------------------------------- +!*** +!*** LOCAL VARIABLES +!*** + INTEGER(KIND=KINT):: & + I,IQTB,ITTB,J,K,LLOW,LMH,LMXL +! + INTEGER(KIND=KINT),DIMENSION(IMS:IME,JMS:JME):: & + LPBL +! + REAL(KIND=KFPT):: & + AKHS_DENS,AKMS_DENS,BQ,BQS00K,BQS10K & + ,DCDT,DELTAZ,DQDT,DTDIF,DTDT,DTTURBL & + ,P00K,P01K,P10K,P11K,PELEVFC,PP1,PSFC,PSP,PTOP & + ,QBT,QFC1,QLOW,QQ1,QX & + ,RDTTURBL,RG,RSQDT,RXNERS,RXNSFC & + ,SEAMASK,SQ,SQS00K,SQS10K & + ,THBT,THNEW,THOLD,TQ,TTH & + ,ULOW,VLOW,RSTDH,STDFAC,ZSF,ZSX,ZSY,ZUV +! + REAL(KIND=KFPT),DIMENSION(1:LM):: & + CWMK,PK,PSK,Q2K,QK,RHOK,RXNERK,THEK,THK,THVK,TK,UK,VK +! + REAL(KIND=KFPT),DIMENSION(1:LM-1):: & + AKHK,AKMK,DCOL,EL,GH,GM +! + REAL(KIND=KFPT),DIMENSION(1:LM+1):: & + ZHK +! + REAL(KIND=KFPT),DIMENSION(IMS:IME,JMS:JME):: & + THSK +! + REAL(KIND=KFPT),DIMENSION(IMS:IME,JMS:JME,1:LM):: & + RXNER,THV +! + REAL(KIND=KFPT),DIMENSION(IMS:IME,JMS:JME,1:LM-1):: & + AKH,AKM +! + REAL(KIND=KFPT),DIMENSION(IMS:IME,JMS:JME,1:LM+1):: & + ZINT +! +!*** Begin debugging + REAL(KIND=KFPT):: ZSL_DIAG + INTEGER(KIND=KINT):: IMD,JMD,PRINT_DIAG +!*** End debugging +!----------------------------------------------------------------------- +!*********************************************************************** + data reinit/.false./ +!----------------------------------------------------------------------- +! if(reinit) then +! call MYJPBL_INIT( & +! 1,IDE,1,1,LM, & +! 1,IDE,1,1, & +! 1,IDE,1,1) +! reinit=.false. +! endif +! +!---------------------------------------------------------------------- +!********************************************************************** +!---------------------------------------------------------------------- +! +!*** Begin debugging + IMD=(IMS+IME)/2 + JMD=(JMS+JME)/2 +!*** End debugging +! +!*** MAKE PREPARATIONS +! +!---------------------------------------------------------------------- + STDFAC=1. +!---------------------------------------------------------------------- +! DTTURBL=DT*NPHS + DTTURBL=DT_PHS + RDTTURBL=1./DTTURBL + RSQDT=SQRT(RDTTURBL) + DTDIF=DTTURBL + RG=1./G +! + DO K=1,LM-1 + DO J=JTS,JTE + DO I=ITS,ITE + AKM(I,J,K)=0. + ENDDO + ENDDO + ENDDO +! + DO K=1,LM+1 + DO J=JTS,JTE + DO I=ITS,ITE + ZINT(I,J,K)=0. + ENDDO + ENDDO + ENDDO +! + DO J=JTS,JTE + DO I=ITS,ITE + ZINT(I,J,LM+1)=HT(I,J) ! Z AT BOTTOM OF LOWEST SIGMA LAYER + ENDDO + ENDDO +! + DO K=LM,1,-1 + DO J=JTS,JTE + DO I=ITS,ITE + ZINT(I,J,K)=ZINT(I,J,K+1)+DZ(I,J,K) + RXNER(I,J,K)=1./EXNER(I,J,K) + THV(I,J,K)=(Q(I,J,K)*0.608+(1.-CWM(I,J,K)))*TH(I,J,K) + ENDDO + ENDDO + ENDDO +! + DO J=JTS,JTE + DO I=ITS,ITE + EL_MYJ(I,J,LM)=0. + ENDDO + ENDDO + DO J=JTS,JTE + DO I=ITS,ITE + DUSFC(I,J)=0. + DVSFC(I,J)=0. + DTSFC(I,J)=0. + DQSFC(I,J)=0. + ENDDO + ENDDO + +! +!---------------------------------------------------------------------- +!....................................................................... +!ZJ$OMP PARALLEL DO & +!ZJ$OMP PRIVATE(J,I,LMH,PTOP,PSFC,SEAMASK,K,TK,THVK,QK,Q2K,RXNERK, & +!ZJ$OMP PK,UK,VK,Q2K,ZHK,LMXL,GM,GH,EL,AKMK,AKHK,DELTAZ), & +!ZJ$OMP SCHEDULE(DYNAMIC) +!....................................................................... +!---------------------------------------------------------------------- + setup_integration: DO J=JTS,JTE +!---------------------------------------------------------------------- +! + DO I=ITS,ITE +! + LMH=LM +! + PTOP=PINH(I,J,1) + PSFC=PINH(I,J,LMH+1) +! +!*** CONVERT LAND MASK (1 FOR SEA; 0 FOR LAND) +! + SEAMASK=XLAND(I,J)-1. +! +!*** FILL 1-D VERTICAL ARRAYS +! + DO K=LM,1,-1 + PK(K)=PMID(I,J,K) + TK(K)=T(I,J,K) + QK(K)=Q(I,J,K) + THVK(K)=THV(I,J,K) + RXNERK(K)=RXNER(I,J,K) + UK(K)=U(I,J,K) + VK(K)=V(I,J,K) + Q2K(K)=Q2(I,J,K) +! +!*** COMPUTE THE HEIGHTS OF THE LAYER INTERFACES +! + ZHK(K)=ZINT(I,J,K) +! + ENDDO + ZHK(LM+1)=HT(I,J) ! Z AT BOTTOM OF LOWEST SIGMA LAYER +! +!*** POTENTIAL INSTABILITY +! + PELEVFC=PMID(I,J,LMH)*ELEVFC +! + DO K=LMH,1,-1 +!----------------------------------------------------------------------- + IF(K==LMH .OR. PMID(I,J,K)>PELEVFC) THEN +!---PREPARATION FOR SEARCH FOR MAX CAPE--------------------------------- + QBT=QK(K) + THBT=TH(I,J,K) + TTH=(THBT-THL)*RDTH + QQ1=TTH-AINT(TTH) + ITTB=INT(TTH)+1 +!---KEEPING INDICES WITHIN THE TABLE------------------------------------ + IF(ITTB.LT.1)THEN + ITTB=1 + QQ1=0. + ELSE IF(ITTB.GE.JTBL)THEN + ITTB=JTBL-1 + QQ1=0. + ENDIF +!---BASE AND SCALING FACTOR FOR SPEC. HUMIDITY-------------------------- + BQS00K=QS0(ITTB) + SQS00K=SQS(ITTB) + BQS10K=QS0(ITTB+1) + SQS10K=SQS(ITTB+1) +!--------------SCALING SPEC. HUMIDITY & TABLE INDEX--------------------- + BQ=(BQS10K-BQS00K)*QQ1+BQS00K + SQ=(SQS10K-SQS00K)*QQ1+SQS00K + TQ=(QBT-BQ)/SQ*RDQ + PP1=TQ-AINT(TQ) + IQTB=INT(TQ)+1 +!----------------KEEPING INDICES WITHIN THE TABLE----------------------- + IF(IQTB.LT.1)THEN + IQTB=1 + PP1=0. + ELSEIF(IQTB.GE.ITBL)THEN + IQTB=ITBL-1 + PP1=0. + ENDIF +!--------------SATURATION PRESSURE AT FOUR SURROUNDING TABLE PTS.------- + P00K=PTBL(IQTB ,ITTB ) + P10K=PTBL(IQTB+1,ITTB ) + P01K=PTBL(IQTB ,ITTB+1) + P11K=PTBL(IQTB+1,ITTB+1) +!--------------SATURATION POINT VARIABLES AT THE BOTTOM----------------- + PSP=P00K+(P10K-P00K)*PP1+(P01K-P00K)*QQ1 & + +(P00K-P10K-P01K+P11K)*PP1*QQ1 + RXNERS=(1.E5/PSP)**CAPPA + THEK(K)=THBT*EXP(ELOCP*QBT*RXNERS/THBT) + PSK (K)=PSP +!----------------------------------------------------------------------- + ELSE +!----------------------------------------------------------------------- + THEK(K)=THEK(K+1) + PSK (K)=PINH(I,J,1) +!----------------------------------------------------------------------- + ENDIF +!----------------------------------------------------------------------- + ENDDO +! +!*** Begin debugging +! IF(I==IMD.AND.J==JMD)THEN +! PRINT_DIAG=1 +! ELSE +! PRINT_DIAG=0 +! ENDIF +! IF(I==227.AND.J==363)PRINT_DIAG=2 +!*** End debugging +! +!---------------------------------------------------------------------- +!*** +!*** FIND THE MIXING LENGTH +!*** + CALL MIXLEN(LMH,RSQDT,UK,VK,THVK,THEK & + ,Q2K,EPSL,EPSQ2,ZHK,PK,PSK,RXNERK,GM,GH,EL & + ,PBLH(I,J),LPBL(I,J),LMXL,CT(I,J),MIXHT(I,J) & + ,I,J,LM) +! +!---------------------------------------------------------------------- +!*** +!*** SOLVE FOR THE PRODUCTION/DISSIPATION OF +!*** THE TURBULENT KINETIC ENERGY +!*** +! + CALL PRODQ2(NTSD,ME,LMH,DTTURBL,USTAR(I,J),GM,GH,EL,Q2K & + ,EPSL,EPSQ2,I,J,LM) + +! if(i.eq.4)print*,'11ql test Q2(LMH)=',Q2K(LMH),B1,USTAR(I,J) +! +!---------------------------------------------------------------------- +!*** THE MODEL LAYER (COUNTING UPWARD) CONTAINING THE TOP OF THE PBL +!---------------------------------------------------------------------- +! + KPBL(I,J)=LPBL(I,J) +! +!---------------------------------------------------------------------- +!*** +!*** FIND THE EXCHANGE COEFFICIENTS IN THE FREE ATMOSPHERE +!*** + CALL DIFCOF(NTSD,ME,LMH,LMXL,GM,GH,EL,TK,Q2K,ZHK,AKMK,AKHK,I,J,LM & + ,PRINT_DIAG,KPBL(I,J)) +! +!*** COUNTING DOWNWARD FROM THE TOP, THE EXCHANGE COEFFICIENTS AKH +!*** ARE DEFINED ON THE BOTTOMS OF THE LAYERS 1 TO LM-1. COUNTING +!*** COUNTING UPWARD FROM THE BOTTOM, THOSE SAME COEFFICIENTS EXCH_H +!*** ARE DEFINED ON THE TOPS OF THE LAYERS 1 TO LM-1. +! + DO K=1,LM-1 + + DELTAZ=0.5*(ZHK(K)-ZHK(K+2)) + AKHK(K)=max(AKHK(K),xkzo(I,J,K)/DELTAZ) ! add minimum background diffusion + AKMK(K)=max(AKMK(K),xkzmo(I,J,K)/DELTAZ) + if((THVK(LM)-THVK(K)).GT.0.) then + AKHK(K)=max(AKHK(K),3./DELTAZ) ! add minimum background diffusion + AKMK(K)=max(AKMK(K),3./DELTAZ) + end if + AKH(I,J,K)=AKHK(K) + AKM(I,J,K)=AKMK(K) + EXCH_H(I,J,K)=AKHK(K)*DELTAZ + ENDDO +! +!---------------------------------------------------------------------- +!*** +!*** CARRY OUT THE VERTICAL DIFFUSION OF +!*** TURBULENT KINETIC ENERGY +!*** +! + CALL VDIFQ(LMH,DTDIF,Q2K,EL,ZHK,I,J,LM) +! +!*** SAVE THE NEW Q2 AND MIXING LENGTH. +! + DO K=1,LM + Q2(I,J,K)=MAX(Q2K(K),EPSQ2(K)) + IF(K0..OR.SICE(I,J)>0.5)THEN + QFC1=QFC1*RLIVWV + ENDIF +! + IF(QFC1>0.)THEN + QLOW=QK(LM) +!ql QSFC(I,J)=QLOW+ELFLX(I,J)/QFC1 + ENDIF +! + ELSE + PSFC=PINH(I,J,LM+1) + RXNSFC=(1.E5/PSFC)**CAPPA + +!ql QSFC(I,J)=PQ0SEA/PSFC & +!ql & *EXP(A2*(THSK(I,J)-A3*RXNSFC)/(THSK(I,J)-A4*RXNSFC)) + ENDIF +! + QZ0 (I,J)=(1.-SEAMASK)*QSFC(I,J)+SEAMASK*QZ0 (I,J) +! + LMH=LM +! +!---------------------------------------------------------------------- +!*** CARRY OUT THE VERTICAL DIFFUSION OF +!*** TEMPERATURE AND WATER VAPOR +!---------------------------------------------------------------------- +! + CALL VDIFH(DTDIF,LMH,THZ0(I,J),QZ0(I,J) & + ,AKHS_DENS,CHKLOWQ(I,J),CT(I,J) & + ,THK,QK,CWMK,AKHK,ZHK,RHOK,I,J,LM) +!---------------------------------------------------------------------- +!*** +! QL set lower bondary +! THK(LM)=THLM(I,J) +! QK(LM)=QLM(I,J) +!*** COMPUTE PRIMARY VARIABLE TENDENCIES +!*** + DO K=1,LM + RTHBLTEN(I,J,K)=(THK(K)-TH(I,J,K))*RDTTURBL + RQBLTEN(I,J,K)=(QK(K)-Q(I,J,K))*RDTTURBL + RQCBLTEN(I,J,K)=(CWMK(K)-CWM(I,J,K))*RDTTURBL + DTSFC(I,J)=DTSFC(I,J)+CONT*DEL(I,J,K)*RTHBLTEN(I,J,K)*EXNER(I,J,K) + DQSFC(I,J)=DQSFC(I,J)+CONQ*DEL(I,J,K)*RQBLTEN(I,J,K) + ENDDO +! +!*** Begin debugging +! IF(I==IMD.AND.J==JMD)THEN +! PRINT_DIAG=0 +! ELSE +! PRINT_DIAG=0 +! ENDIF +! IF(I==227.AND.J==363)PRINT_DIAG=0 +!*** End debugging +! + PSFC=.01*PINH(I,J,LM+1) + ZSL_DIAG=0.5*DZ(I,J,LM) +! +!*** Begin debugging +! IF(PRINT_DIAG==1)THEN +! +! WRITE(6,"(A, 2I5, 2I3, 2F8.2, F6.2, 2F8.2)") & +! '{TURB4 I,J, KPBL, KMXL, PSFC, ZSFC, ZSL, ZPBL, ZMXL = ' & +! , I, J, KPBL(I,J), LM-LMXL+1, PSFC, ZHK(LMH+1), ZSL_DIAG & +! , PBLH(I,J), ZHK(LMXL)-ZHK(LMH+1) +! WRITE(6,"(A, 2F7.2, F7.3, 3E11.4)") & +! '{TURB4 TSK, THSK, QZ0, Q**2_0, AKHS, EXCH_0 = ' & +! , TSK(I,J)-273.15, THSK(I,J), 1000.*QZ0(I,J) & +! , Q2(I,1,J), AKHS(I,J), AKHS(I,J)*ZSL_DIAG +! WRITE(6,"(A)") & +! '{TURB5 K, PMID, PINH_1, TC, TH, DTH, GH, GM, EL, Q**2, AKH, EXCH_H, DZ, DP' +! DO K=1,LM/2 +! WRITE(6,"(A,I3, 2F8.2, 2F8.3, 3E12.4, 4E11.4, F7.2, F6.2)") & +! '{TURB5 ', K, .01*PMID(I,K,J),.01*PINH(I,K,J), T(I,K,J)-273.15 & +! , TH(I,K,J), DTTURBL*RTHBLTEN(I,K,J), GH(K), GM(K) & +! , EL_MYJ(I,K,J), Q2(I,K+1,J), AKH(I,K,J) & +! , EXCH_H(I,K,J), DZ(I,K,J), .01*(PINH(I,K,J)-PINH(I,K+1,J)) +! ENDDO +! +! ELSEIF(PRINT_DIAG==2)THEN +! +! WRITE(6,"(A, 2I5, 2I3, 2F8.2, F6.2, 2F8.2)") & +! '}TURB4 I,J, KPBL, KMXL, PSFC, ZSFC, ZSL, ZPBL, ZMXL = ' & +! , I, J, KPBL(I,J), LM-LMXL+1, PSFC, ZHK(LMH+1), ZSL_DIAG & +! , PBLH(I,J), ZHK(LMXL)-ZHK(LMH+1) +! WRITE(6,"(A, 2F7.2, F7.3, 3E11.4)") & +! '}TURB4 TSK, THSK, QZ0, Q**2_0, AKHS, EXCH_0 = ' & +! , TSK(I,J)-273.15, THSK(I,J), 1000.*QZ0(I,J) & +! , Q2(I,1,J), AKHS(I,J), AKHS(I,J)*ZSL_DIAG +! WRITE(6,"(A)") & +! '}TURB5 K, PMID, PINH_1, TC, TH, DTH, GH, GM, EL, Q**2, AKH, EXCH_H, DZ, DP' +! DO K=1,LM/2 +! WRITE(6,"(A,I3, 2F8.2, 2F8.3, 3E12.4, 4E11.4, F7.2, F6.2)") & +! '}TURB5 ', K, .01*PMID(I,K,J),.01*PINH(I,K,J), T(I,K,J)-273.15 & +! , TH(I,K,J), DTTURBL*RTHBLTEN(I,K,J), GH(K), GM(K) & +! , EL_MYJ(I,K,J), Q2(I,K+1,J), AKH(I,K,J) & +! , EXCH_H(I,K,J), DZ(I,K,J), .01*(PINH(I,K,J)-PINH(I,K+1,J)) +! ENDDO +! ENDIF +!*** End debugging +! +!---------------------------------------------------------------------- +! + SEAMASK=XLAND(I,J)-1. +! + IF(SEAMASK.LT.0.5.AND.STDH(I,J).GT.1.) THEN + RSTDH=1./STDH(I,J) + ELSE + RSTDH=0. + ENDIF + ZHK(LM+1)=ZINT(I,J,LM+1) + ZSF=STDH(I,J)*STDFAC+ZHK(LM+1) +! +!---------------------------------------------------------------------- +! +!*** FILL 1-D VERTICAL ARRAYS +! + DO K=1,LM-1 + AKMK(K)=AKM(I,J,K) + AKMK(K)=AKMK(K)*(RHOK(K)+RHOK(K+1))*0.5 + ENDDO +! + AKMS_DENS=AKMS(I,J)*RHOK(LM) +! + DO K=LM,1,-1 + UK(K)=U(I,J,K) + VK(K)=V(I,J,K) + ZHK(K)=ZINT(I,J,K) + ENDDO + ZHK(LM+1)=ZINT(I,J,LM+1) +! +!---------------------------------------------------------------------- +! + DO K=1,LM-1 +!jun23 IF(SEAMASK.GT.0.5) THEN +!jun23 DCOL(K)=0. +!jun23 ELSE +!jun23 ZUV=(ZHK(K)+ZHK(K+1))*0.5 +!jun23 IF(ZUV.GT.ZSF) THEN +!jun23 DCOL(K)=0. +!jun23 ELSE +!jun23 DCOL(K)=HERF((((ZUV-ZHK(LM+1))*RSTDH)**2)*0.5) +!jun23 ENDIF +!jun23 ENDIF +!WWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWW + DCOL(K)=0. !ZJ +!MMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMM + ENDDO +! +!---------------------------------------------------------------------- +!*** CARRY OUT THE VERTICAL DIFFUSION OF +!*** VELOCITY COMPONENTS +!---------------------------------------------------------------------- +! + CALL VDIFV(LMH,DTDIF,UZ0(I,J),VZ0(I,J) & + & ,AKMS_DENS,DCOL,UK,VK,AKMK,ZHK,RHOK,I,J,LM) +! +!---------------------------------------------------------------------- +!*** +!*** COMPUTE PRIMARY VARIABLE TENDENCIES +!*** + DO K=1,LM + RUBLTEN(I,J,K)=(UK(K)-U(I,J,K))*RDTTURBL + RVBLTEN(I,J,K)=(VK(K)-V(I,J,K))*RDTTURBL + DUSFC(I,J)=DUSFC(I,J)+CONW*DEL(I,J,K)*RUBLTEN(I,J,K) + DVSFC(I,J)=DVSFC(I,J)+CONW*DEL(I,J,K)*RVBLTEN(I,J,K) + ENDDO +! + ENDDO +!---------------------------------------------------------------------- +! + ENDDO main_integration +!JAA!ZJ$OMP END PARALLEL DO +! +!---------------------------------------------------------------------- +! + END SUBROUTINE MYJPBL +! +!---------------------------------------------------------------------- +!XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX +!---------------------------------------------------------------------- + SUBROUTINE MIXLEN & +!---------------------------------------------------------------------- +! ****************************************************************** +! * * +! * LEVEL 2.5 MIXING LENGTH * +! * * +! ****************************************************************** +! + (LMH,RSQDT,U,V,THV,THE,Q2,EPSL,EPSQ2,Z,P,PS,RXNER & + ,GM,GH,EL,PBLH,LPBL,LMXL,CT,MIXHT,I,J,LM) +! +!---------------------------------------------------------------------- +! + IMPLICIT NONE +! +!---------------------------------------------------------------------- + INTEGER(KIND=KINT),INTENT(IN):: & + LMH,I,J,LM +! + REAL(KIND=KFPT),INTENT(IN):: & + RSQDT +! + INTEGER(KIND=KINT),INTENT(OUT):: & + LMXL,LPBL +! + real(kind=kfpt),dimension(1:lm-1),intent(inout):: EPSL + REAL(KIND=KFPT),DIMENSION(1:LM),INTENT(IN):: & + P,PS,EPSQ2,RXNER,THE,THV,U,V +! P,PS,Q2,EPSQ2,RXNER,THE,THV,U,V +! + REAL(KIND=KFPT),DIMENSION(1:LM),INTENT(INOUT):: Q2 +! + REAL(KIND=KFPT),DIMENSION(1:LM+1),INTENT(IN):: & + Z +! + REAL(KIND=KFPT),INTENT(OUT):: & + MIXHT & + ,PBLH +! + REAL(KIND=KFPT),DIMENSION(1:LM-1),INTENT(OUT):: & + EL,GH,GM +! + REAL(KIND=KFPT),INTENT(INOUT):: CT +!---------------------------------------------------------------------- +!*** +!*** LOCAL VARIABLES +!*** + INTEGER(KIND=KINT):: & + K,LPBLM +! + REAL(KIND=KFPT):: & + ADEN,BDEN,AUBR,BUBR,BLMX,CUBRY,DTHV,DZ & + ,EL0,ELOQ2X,GHL,GML & + ,QOL2ST,QOL2UN,QDZL & + ,RDZ,SQ,SREL,SZQ,VKRMZ,WCON +! + REAL(KIND=KFPT),DIMENSION(1:LM):: & + Q1 +! + REAL(KIND=KFPT),DIMENSION(1:LM-1):: & + ELM,REL +! +!---------------------------------------------------------------------- +!*********************************************************************** +!--------1---------2---------3---------4---------5---------6---------7-- + CUBRY=UBRY*1.5 !*2. +!--------------FIND THE HEIGHT OF THE PBL------------------------------- + LPBL=LMH +! LPBL=LMH-1 + DO K=LMH-1,1,-1 +! EPSL(K)=1. + if((THV(LMH)-THV(K)).GT.0.) then + Q2(K)=max(Q2(K),1.0) + EPSL(K)=10. + ENDIF + ENDDO +! + DO K=LMH-1,1,-1 + if(q2(k)-epsq2(k)+epsq2(lm).le.epsq2(lm)*fh) then + LPBL=K + GO TO 110 + ENDIF + ENDDO +! + LPBL=1 +! +!--------------THE HEIGHT OF THE PBL------------------------------------ +! + 110 PBLH=Z(LPBL+1)-Z(LMH+1) +! +!----------------------------------------------------------------------- + DO K=1,LMH + Q1(K)=0. + ENDDO +!----------------------------------------------------------------------- + DO K=1,LMH-1 + DZ=(Z(K)-Z(K+2))*0.5 + RDZ=1./DZ + GML=((U(K)-U(K+1))**2+(V(K)-V(K+1))**2)*RDZ*RDZ + GM(K)=MAX(GML,EPSGM) +! + DTHV=THV(K)-THV(K+1) +!---------------------------------------------------------------------- + IF(DTHV.GT.0.) THEN + IF(THE(K+1).GT.THE(K)) THEN + IF(PS(K+1).GT.P(K)) THEN !>12KM +! + WCON=(P(K+1)-PS(K+1))/(P(K+1)-P(K)) +! + if( & + (q2(k).gt.epsq2(k)) .and. & + (q2(k)*cubry.gt.(dz*wcon*rsqdt)**2) & + ) then +! + DTHV=(THE(K)-THE(K+1))+DTHV +! + ENDIF + ENDIF + ENDIF + ENDIF +!-------------------------------------------------------------------------- +! + GHL=DTHV*RDZ + IF(ABS(GHL)<=EPSGH)GHL=EPSGH + GH(K)=GHL + ENDDO +! + CT=0. +! +!---------------------------------------------------------------------- +!*** FIND MAXIMUM MIXING LENGTHS AND THE LEVEL OF THE PBL TOP +!---------------------------------------------------------------------- +! + LMXL=LMH +! + DO K=1,LMH-1 + GML=GM(K) + GHL=GH(K) +! + IF(GHL>=EPSGH)THEN + IF(GML/GHL<=REQU)THEN + ELM(K)=EPSL(K) + LMXL=K+1 + ELSE + AUBR=(AUBM*GML+AUBH*GHL)*GHL + BUBR= BUBM*GML+BUBH*GHL + QOL2ST=(-0.5*BUBR+SQRT(BUBR*BUBR*0.25-AUBR*CUBR))*RCUBR + ELOQ2X=1./MAX(EPSGH, QOL2ST) + ELM(K)=MAX(SQRT(ELOQ2X*Q2(K)),EPSL(K)) + ENDIF + ELSE + ADEN=(ADNM*GML+ADNH*GHL)*GHL + BDEN= BDNM*GML+BDNH*GHL + QOL2UN=-0.5*BDEN+SQRT(BDEN*BDEN*0.25-ADEN) + ELOQ2X=1./(QOL2UN+EPSRU) ! REPSR1/QOL2UN + ELM(K)=MAX(SQRT(ELOQ2X*Q2(K)),EPSL(K)) + ENDIF + ENDDO +! + IF(ELM(LMH-1)==EPSL(LMH-1))LMXL=LMH +! +!---------------------------------------------------------------------- +!*** THE HEIGHT OF THE MIXED LAYER +!---------------------------------------------------------------------- +! + BLMX=Z(LMXL)-Z(LMH+1) + MIXHT=BLMX +! +!---------------------------------------------------------------------- + DO K=LPBL,LMH + Q1(K)=SQRT(Q2(K)) + ENDDO +!---------------------------------------------------------------------- + SZQ=0. + SQ =0. +! + DO K=1,LMH-1 + QDZL=(Q1(K)+Q1(K+1))*(Z(K+1)-Z(K+2)) + SZQ=(Z(K+1)+Z(K+2)-Z(LMH+1)-Z(LMH+1))*QDZL+SZQ + SQ=QDZL+SQ + ENDDO +! +!---------------------------------------------------------------------- +!*** COMPUTATION OF ASYMPTOTIC L IN BLACKADAR FORMULA +!---------------------------------------------------------------------- +! + EL0=MIN(ALPH*SZQ*0.5/SQ,EL0MAX) + EL0=MAX(EL0 ,EL0MIN) +! +!---------------------------------------------------------------------- +!*** ABOVE THE PBL TOP +!---------------------------------------------------------------------- +! + LPBLM=MAX(LPBL-1,1) +! + DO K=1,LPBLM + EL(K)=MIN((Z(K)-Z(K+2))*ELFC,ELM(K)) + REL(K)=EL(K)/ELM(K) + ENDDO +! +!---------------------------------------------------------------------- +!*** INSIDE THE PBL +!---------------------------------------------------------------------- +! + IF(LPBL=EPSGH.AND.GML/GHL<=REQU) & + & .OR.(EQOL2<=EPS2)))THEN +! & .OR.(EQOL2<=EPS2)).and.IFLAG.EQ.1)THEN +! +! if(ntsd.eq.23.and.me.eq.76.and.I.eq.32)then +! print*,'no turb=',K,GML,GHL,EPSTRB,EPSGH,REQU,EQOL2,EPS2,GML/GHL +! end if +!---------------------------------------------------------------------- +!*** NO TURBULENCE +!---------------------------------------------------------------------- +! + Q2(K)=EPSQ2(K) + EL(K)=EPSL(K) +! IFLAG=2 +!---------------------------------------------------------------------- +! + ELSE +! +!---------------------------------------------------------------------- +!*** TURBULENCE +!---------------------------------------------------------------------- +!---------------------------------------------------------------------- +!*** COEFFICIENTS OF THE TERMS IN THE NUMERATOR +!---------------------------------------------------------------------- +! + ANUM=(ANMM*GML+ANMH*GHL)*GHL + BNUM= BNMM*GML+BNMH*GHL +! +!---------------------------------------------------------------------- +!*** COEFFICIENTS OF THE TERMS IN THE DENOMINATOR +!---------------------------------------------------------------------- +! + ADEN=(ADNM*GML+ADNH*GHL)*GHL + BDEN= BDNM*GML+BDNH*GHL + CDEN= 1. +! +!---------------------------------------------------------------------- +!*** COEFFICIENTS OF THE NUMERATOR OF THE LINEARIZED EQ. +!---------------------------------------------------------------------- +! + ARHS=-(ANUM*BDEN-BNUM*ADEN)*2. + BRHS=- ANUM*4. + CRHS=- BNUM*2. +! +!---------------------------------------------------------------------- +!*** INITIAL VALUE OF L/Q +!---------------------------------------------------------------------- +! + DLOQ1=EL(K)/SQRT(Q2(K)) +! +!---------------------------------------------------------------------- +!*** FIRST ITERATION FOR L/Q, RHS=0 +!---------------------------------------------------------------------- +! + ELOQ21=1./EQOL2 + ELOQ11=SQRT(ELOQ21) + ELOQ31=ELOQ21*ELOQ11 + ELOQ41=ELOQ21*ELOQ21 + ELOQ51=ELOQ21*ELOQ31 +! +!---------------------------------------------------------------------- +!*** 1./DENOMINATOR +!---------------------------------------------------------------------- +! + RDEN1=1./(ADEN*ELOQ41+BDEN*ELOQ21+CDEN) +! +!---------------------------------------------------------------------- +!*** D(RHS)/D(L/Q) +!---------------------------------------------------------------------- +! + RHSP1=(ARHS*ELOQ51+BRHS*ELOQ31+CRHS*ELOQ11)*RDEN1*RDEN1 +! +!---------------------------------------------------------------------- +!*** FIRST-GUESS SOLUTION +!---------------------------------------------------------------------- +! + ELOQ12=ELOQ11+(DLOQ1-ELOQ11)*EXP(RHSP1*DTTURBL) + ELOQ12=MAX(ELOQ12,EPS1) +! +!---------------------------------------------------------------------- +!*** SECOND ITERATION FOR L/Q +!---------------------------------------------------------------------- +! + ELOQ22=ELOQ12*ELOQ12 + ELOQ32=ELOQ22*ELOQ12 + ELOQ42=ELOQ22*ELOQ22 + ELOQ52=ELOQ22*ELOQ32 +! +!---------------------------------------------------------------------- +!*** 1./DENOMINATOR +!---------------------------------------------------------------------- +! + RDEN2=1./(ADEN*ELOQ42+BDEN*ELOQ22+CDEN) + RHS2 =-(ANUM*ELOQ42+BNUM*ELOQ22)*RDEN2+RB1 + RHSP2= (ARHS*ELOQ52+BRHS*ELOQ32+CRHS*ELOQ12)*RDEN2*RDEN2 + RHST2=RHS2/RHSP2 +! +!---------------------------------------------------------------------- +!*** CORRECTED SOLUTION +!---------------------------------------------------------------------- +! + ELOQ13=ELOQ12-RHST2+(RHST2+DLOQ1-ELOQ12)*EXP(RHSP2*DTTURBL) + ELOQ13=AMAX1(ELOQ13,EPS1) +! +!---------------------------------------------------------------------- +!*** TWO ITERATIONS IS ENOUGH IN MOST CASES ... +!---------------------------------------------------------------------- +! + ELOQN=ELOQ13 +! + IF(ELOQN>EPS1)THEN + Q2(K)=EL(K)*EL(K)/(ELOQN*ELOQN) + Q2(K)=AMAX1(Q2(K),EPSQ2(K)) + IF(Q2(K)==EPSQ2(K))THEN + EL(K)=EPSL(K) + ENDIF + ELSE + Q2(K)=EPSQ2(K) + EL(K)=EPSL(K) + ENDIF +! +!---------------------------------------------------------------------- +!*** END OF TURBULENT BRANCH +!---------------------------------------------------------------------- +! + ENDIF +!---------------------------------------------------------------------- +!*** END OF PRODUCTION/DISSIPATION LOOP +!---------------------------------------------------------------------- +! + ENDDO main_integration +! +!---------------------------------------------------------------------- +!*** LOWER BOUNDARY CONDITION FOR Q2 +!---------------------------------------------------------------------- +! + Q2(LMH)=AMAX1(B1**(2./3.)*USTAR*USTAR,EPSQ2(LMH)) +! if(I.eq.4)print*,'12ql test Q2(LMH)=',LMH,Q2(LMH),B1,USTAR + +!---------------------------------------------------------------------- +! + END SUBROUTINE PRODQ2 +! +!---------------------------------------------------------------------- +!XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX +!---------------------------------------------------------------------- + SUBROUTINE DIFCOF & +! ****************************************************************** +! * * +! * LEVEL 2.5 DIFFUSION COEFFICIENTS * +! * * +! ****************************************************************** + (NTSD,ME,LMH,LMXL,GM,GH,EL,T,Q2,Z,AKM,AKH,I,J,LM,PRINT_DIAG,KPBL) +!---------------------------------------------------------------------- +! + IMPLICIT NONE +! +!---------------------------------------------------------------------- + INTEGER(KIND=KINT),INTENT(IN):: & + LMH,LMXL,I,J,LM,ME,NTSD,KPBL +! + REAL(KIND=KFPT),DIMENSION(1:LM),INTENT(IN):: & + Q2,T +! + REAL(KIND=KFPT),DIMENSION(1:LM-1),INTENT(IN):: & + EL,GH,GM +! + REAL(KIND=KFPT),DIMENSION(1:LM+1),INTENT(IN):: & + Z +! + REAL(KIND=KFPT),DIMENSION(1:LM-1),INTENT(OUT):: & + AKH,AKM +!---------------------------------------------------------------------- +!*** +!*** LOCAL VARIABLES +!*** + INTEGER(KIND=KINT):: & + K,KINV +! + REAL(KIND=KFPT):: & + ADEN,AKMIN,BDEN,BESH,BESM,CDEN,D2T,ELL,ELOQ2,ELOQ4,ELQDZ & + ,ESH,ESM,GHL,GML,Q1L,RDEN,RDZ +! +!*** Begin debugging + INTEGER(KIND=KINT),INTENT(IN):: PRINT_DIAG +! REAL(KIND=KFPT):: D2TMIN +!*** End debugging +! +!---------------------------------------------------------------------- +!********************************************************************** +!---------------------------------------------------------------------- +! + DO K=1,LMH-1 + ELL=EL(K) +! + ELOQ2=ELL*ELL/Q2(K) + ELOQ4=ELOQ2*ELOQ2 +! + GML=GM(K) + GHL=GH(K) +! +!---------------------------------------------------------------------- +!*** COEFFICIENTS OF THE TERMS IN THE DENOMINATOR +!---------------------------------------------------------------------- +! + ADEN=(ADNM*GML+ADNH*GHL)*GHL + BDEN= BDNM*GML+BDNH*GHL + CDEN= 1. +! +!---------------------------------------------------------------------- +!*** COEFFICIENTS FOR THE SM DETERMINANT +!---------------------------------------------------------------------- +! + BESM=BSMH*GHL +! +!---------------------------------------------------------------------- +!*** COEFFICIENTS FOR THE SH DETERMINANT +!---------------------------------------------------------------------- +! + BESH=BSHM*GML+BSHH*GHL +! +!---------------------------------------------------------------------- +!*** 1./DENOMINATOR +!---------------------------------------------------------------------- +! + RDEN=1./(ADEN*ELOQ4+BDEN*ELOQ2+CDEN) +! +!---------------------------------------------------------------------- +!*** SM AND SH +!---------------------------------------------------------------------- +! + ESM=(BESM*ELOQ2+CESM)*RDEN + ESH=(BESH*ELOQ2+CESH)*RDEN +! +!---------------------------------------------------------------------- +!*** DIFFUSION COEFFICIENTS +!---------------------------------------------------------------------- +! + RDZ=2./(Z(K)-Z(K+2)) + Q1L=SQRT(Q2(K)) + ELQDZ=ELL*Q1L*RDZ + AKM(K)=ELQDZ*ESM + AKH(K)=ELQDZ*ESH +! if(NTSD.gt.22.and.me.eq.76.and.I.eq.32)then +! if(AKM(K).lt.RDZ*3.)then +! print*,'1K,ELQDZ,ESH,ELL,Q1L,RDZ,Q2=',K,ELQDZ,ESH & +! ,ELL,Q1L,RDZ,Q2(K),BESH,ELOQ2,CESH,RDEN & +! ,ADEN,ELOQ4,BDEN,CDEN,BSHM,GML,BSHH,GHL,BSMH & +! ,BDNM,BDNH,ADNM,ADNH +! else +! print*,'2K,ELQDZ,ESH,ELL,Q1L,RDZ,Q2=',K,ELQDZ,ESH & +! ,ELL,Q1L,RDZ,Q2(K),BESH,ELOQ2,CESH,RDEN & +! ,ADEN,ELOQ4,BDEN,CDEN,BSHM,GML,BSHH,GHL,BSMH & +! ,BDNM,BDNH,ADNM,ADNH +! end if +! if(K.eq.(LMH-1))stop +! end if +!WWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWW +! if(K.gt.KPBL)then +! AKM(K)=MAX(AKM(K),RDZ*3.) +! AKH(K)=MAX(AKH(K),RDZ*3.) +! end if +! AKM(K)=MAX(AKM(K),RDZ*3.) +! AKH(K)=MAX(AKH(K),RDZ*3.) +! AKM(K)=MAX(AKM(K),RDZ) +! AKH(K)=MAX(AKH(K),RDZ) +!MMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMM +!---------------------------------------------------------------------- + ENDDO +! qingfu test +! K=LM-1 +! RDZ=2./(Z(K)-Z(K+2)) +! AKH(LM-1)=AKH(LM-1)*10. +! AKM(K)=MAX(AKM(K),RDZ*3.)*10. +! AKH(K)=MAX(AKH(K),RDZ*3.)*10. +!---------------------------------------------------------------------- +! +!---------------------------------------------------------------------- +!*** INVERSIONS +!---------------------------------------------------------------------- +! +! IF(LMXL==LMH)THEN +! KINV=LMH +! D2TMIN=0. +! +! DO K=LMH/2,LMH-1 +! D2T=T(K-1)-2.*T(K)+T(K+1) +! IF(D2T0)THEN +! WRITE(6,"(A,3I3)") '{TURB1 LMXL,LMH,KINV=',LMXL,LMH,KINV +! WRITE(6,"(A,3I3)") '}TURB1 LMXL,LMH,KINV=',LMXL,LMH,KINV +! IF(PRINT_DIAG==1)THEN +! WRITE(6,"(A)") & +! '{TURB3 K, T, D2T, RDZ, Z(K), Z(K+2), AKMIN, AKH ' +! ELSE +! WRITE(6,"(A)") & +! '}TURB3 K, T, D2T, RDZ, Z(K), Z(K+2), AKMIN, AKH ' +! ENDIF +! DO K=LMH-1,KINV-1,-1 +! D2T=T(K-1)-2.*T(K)+T(K+1) +! RDZ=2./(Z(K)-Z(K+2)) +! AKMIN=0.5*RDZ +! IF(PRINT_DIAG==1)THEN +! WRITE(6,"(A,I3,F8.3,2E12.5,2F9.2,2E12.5)") '{TURB3 ' & +! ,K,T(K)-273.15,D2T,RDZ,Z(K),Z(K+2),AKMIN,AKH(K) +! ELSE +! WRITE(6,"(A,I3,F8.3,2E12.5,2F9.2,2E12.5)") '}TURB3 ' & +! ,K,T(K)-273.15,D2T,RDZ,Z(K),Z(K+2),AKMIN,AKH(K) +! ENDIF +! ENDDO +! ENDIF !- IF (PRINT_DIAG > 0) THEN +! ENDIF !- IF(KINVNLImax. +! (10) Ice deposition does not change the rime factor (RF) when RF>=10 & T>T_ICE. +! (11) Limit GAMMAS to <=1.5 (air resistance impact on ice fall speeds) +! (12) NSImax is maximum # conc of ice crsytals. At cold temperature NSImax is +! calculated based on assuming 10% of total ice content is due to cloud ice. +! +!-- Further modifications starting on 23 July 2015 +! (13) RHgrd is passed in as an input argument so that it can vary for different +! domains (RHgrd=0.98 for 12-km parent, 1.0 for 3-km nests) +! (14) Use the old "PRAUT" cloud water autoconversion *threshold* (QAUT0) + +!-- Further modifications starting on 28 July 2015 +! (15) Added calculations for radar reflectivity and number concentrations of +! rain (Nrain) and precipitating ice (Nsnow). +! (16) Removed double counting of air resistance term for riming onto ice (PIACW) +! (17) The maximum rime factor (RFmx) is now a function of MASSI(INDEXS), accounting +! for the increase in unrimed ice particle densities as values of INDEXS +! decrease from the maximum upper limit of 1000 microns to the lower limit of +! 50 microns, coinciding with the assumed size of cloud ice; see lines 1128-1134. +! (18) A new closure is used for updating the rime factor, which is described in +! detail near lines 1643-1682. The revised code is near lines 1683-1718. +! (19) Restructured the two-pass algorithm to be more robust, removed the HAIL +! & LARGE_RF logical variables so that NLICE>NLImax can occur. +! (20) Increased nsimax (see !aug27 below) +! (21) Modified the rain sedimentation (see two !aug27 blocks below) +! (22) NInuclei is the lower of Fletcher (1962), Cooper (1986), or NSImax. +! (23) NLImax is no longer used or enforced. Instead, INDEXS=MDImax when RF>20, +! else INDEXS is a function of temperature. Look for !sep10 comment. +! (24) An override was inserted for (18), such that the rime density is not diluted +! diluted when RF>20. Look for !sep10 comment. +! (25) Radar reflectivity calculations were changes to reduce radar bright bands, +! limit enhanced, mixed-phase reflectivity to RF>=20. Look for !sep10 comments. +! (26) NLICE is not to exceed NSI_max (250 L^-1) when RF<20. Look for !sep16 comments. +! Commented out! (28) Increase hail fall speeds using Thompson et al. (2008). Look for !sep22 comments. +! (29) Modify NLImax, INDEXS for RF>=20. Look for !sep22 comments. +! (30) Check on NSmICE, Vci based on whether FLIMASS<1. Look for !sep22a comments. +! Revised in (34)! (31) Introduced RFlag logical, which if =T enforces a lower limit of drop sizes not +! to go below INDEXRmin and N0r is adjusted. Look for !nov25 comments (corrections, +! refinements to sep25 & nov18 versions, includes an additional fix in nov25-fix). +! Also set INDEXRmin=500 rather than 250 microns. +!----------------------------------------------------------------------------- +!--- The following changes now refer to dates when those were made in 2016. +!----------------------------------------------------------------------------- +! (32) Convective (RF>=20, Ng~10 L^-1, RHOg~500 kg m^-3), transition (RF=10, Ng~25 L^-1, +! RHOg~300 kg m^-3), & stratiform (RF<2) profiles are blended based on RF. !mar08 +! (33) Fixed bug in Biggs' freezing, put back in collisional drop freezing. !mar03 +! (34) Changes in (31) are revised so that INDEXRmin at and below 0C level is +! based on a rain rate equal to the snowfall rate above the 0C level. !mar03 +! (35) Increase radar reflectivity when RF>10 and RQSnew > 2.5 g m^-3. !mar12 +! (36) !mar10 combines all elements of (32)-(35) together. +! (37) Bug fixes for the changes in (34) and the RFLAG variable !apr18 +! (38) Revised Schumann-Ludlam limit. !apr18 +! (39) Simplified PCOND (cloud cond/evap) calculation !apr21 +! (40) Slight change in calculating RF. !apr22 +! (41) Reduce RF values for calculating mean sizes of snow, graupel, sleet/hail !apr22a +! (42) Increase reflectivity from large, wet, high rime factor ice (graupel) by +! assuming |Kw|**2/|Ki|**2 = 0.224 (Smith, 1984, JCAM). +! (43) Major restructuring of code to allow N0r to vary from N0r0 !may11 +! (44) More major restructuring of code to use fixed XLS, XLV, XLF !may12 +! (45) Increased VEL_INC ~ VrimeF**2, put the enhanced graupel/hail fall speeds +! from Thompson into the code but only in limited circumstances, restructured +! and streamlined the INDEXS calculation, removed the upper limit for +! for the vapor mixing ratio is at water saturation when calculating ice +! deposition, and N0r is gradually increased for conditions supporting +! drizzle when rain contents decrease below 0.25 g/m**3. !may17 +! (46) The may11 code changes that increase N0r0 when rain contents exceed 1 g m^-3 +! have been removed, limit the number of iterations calculating final rain +! parameters, remove the revised N0r calculation for reflectivity. All of +! the changes following those made in the may10 code. !may20 +! (47) Reduce the assumed # concentration of hail/sleet when RF>10 from 5 L^-1 to +! 1 L^-1, and also reduce it for graupel when RF>5 from 10 L^-1 to 5 L^-1. +! This is being done to try and make greater use of the Thompson graupel/hail +! fallspeeds by having INDEXS==MDImax. +! (48) Increased NCW from 200e6 to 300e6 for a more delayed onset of drizzle, +! simplified drizzle algorithm to reduce/eliminate N0r bulls eyes and to allow +! for supercooled drizzle, and set limits for 8.e6 <= N0r (m^-4) <= 1.e9 !may31 +! (49) Further restructuring of code to better define STRAT, DRZL logicals, +! add these rain flags to mprates arrays !jun01 +! (50) Increase in reflectivity due to wet ice was commented out. +! (51) Fixed minor bug to update INDEXR2 in the "rain_pass: do" loop. !jun13 +! (52) Final changes to Nsnow for boosting reflectivities from ice for +! mass contents exceeding 5 g m^-3. !jun16 +! (53) Cosmetic changes only that do not affect the calculations. Removed old, unused +! diagnostic arrays. Updated comments. +! +!----------------------------------------------------------------------------- +! + MODULE MODULE_MP_FER_HIRES +! +!----------------------------------------------------------------------------- + +#ifdef MPI + USE mpi +#endif + USE machine +!MZ +!MZ USE MODULE_CONSTANTS,ONLY : PI, CP, EPSQ, GRAV=>G, RHOL=>RHOWATER, & +!MZ RD=>R_D, RV=>R_V, T0C=>TIW, EPS=>EP_2, EPS1=>EP_1, CLIQ, CICE, & +!MZ XLV +!MZ +!MZ temporary values copied from module_CONSTANTS; ideally they come from host model +!side + REAL, PARAMETER :: pi=3.141592653589793 ! ludolf number + REAL, PARAMETER :: cp=1004.6 ! spec. heat for dry air at constant pressure + REAL, PARAMETER :: epsq=1.e-12 ! floor value for specific humidity (kg/kg) + REAL, PARAMETER :: grav= 9.8060226 ! gravity + REAL, PARAMETER :: RHOL=1000. ! density of water (kg/m3) + REAL, PARAMETER :: RD=287.04 ! gas constant for dry air + REAL, PARAMETER :: RV=461.6 ! gas constant for water vapor + REAL, PARAMETER :: T0C= 273.15 ! melting point + REAL, PARAMETER :: EPS=RD/RV + REAL, PARAMETER :: EPS1=RV/RD-1. + REAL, PARAMETER :: CLIQ = 4190. ! MZ: inconsistent value below + REAL, PARAMETER :: CICE = 2106. + REAL, PARAMETER :: XLV = 2.5E6 +!----------------------------------------------------------------------------- + PUBLIC :: FERRIER_INIT_HR, GPVS_HR,FPVS,FPVS0,NX +!----------------------------------------------------------------------------- + REAL,PRIVATE,SAVE :: ABFR, CBFR, CIACW, CIACR, C_N0r0, C_NR, Crain, & !jul28 + & CRACW, ARAUT, BRAUT, ESW0, RFmx1, ARcw, RH_NgC, RH_NgT, & !jul31 !mar08 + & RR_DRmin, RR_DR1, RR_DR2, RR_DR3, RR_DR4, RR_DR5, RR_DRmax, & !may17 + & BETA6, & + & RQhail, AVhail, BVhail, QAUT0 !may17 +! + INTEGER,PRIVATE,PARAMETER :: INDEXRstrmax=500 !mar03, stratiform maximum + REAL,PUBLIC,SAVE :: CN0r0, CN0r_DMRmin, CN0r_DMRmax, & + RFmax, RQR_DRmax, RQR_DRmin +! + INTEGER, PRIVATE,PARAMETER :: MY_T1=1, MY_T2=35 + REAL,PRIVATE,DIMENSION(MY_T1:MY_T2),SAVE :: MY_GROWTH_NMM +! + REAL, PRIVATE,PARAMETER :: DMImin=.05e-3, DMImax=1.e-3, & + & DelDMI=1.e-6,XMImin=1.e6*DMImin + REAL, PUBLIC,PARAMETER :: XMImax=1.e6*DMImax, XMIexp=.0536 + INTEGER, PUBLIC,PARAMETER :: MDImin=XMImin, MDImax=XMImax + REAL, PRIVATE,DIMENSION(MDImin:MDImax) :: & + & ACCRI,VSNOWI,VENTI1,VENTI2 + REAL, PUBLIC,DIMENSION(MDImin:MDImax) :: SDENS !-- For RRTM +! + REAL, PRIVATE,PARAMETER :: DMRmin=.05e-3, DMRmax=1.0e-3, & + & DelDMR=1.e-6, XMRmin=1.e6*DMRmin, XMRmax=1.e6*DMRmax + INTEGER, PUBLIC,PARAMETER :: MDRmin=XMRmin, MDRmax=XMRmax +! + REAL, PRIVATE,DIMENSION(MDRmin:MDRmax):: & + & ACCRR,MASSR,RRATE,VRAIN,VENTR1,VENTR2 +! + INTEGER, PRIVATE,PARAMETER :: Nrime=40 + REAL, DIMENSION(2:9,0:Nrime),PRIVATE,SAVE :: VEL_RF +! + INTEGER,PARAMETER :: NX=7501 + REAL, PARAMETER :: XMIN=180.0,XMAX=330.0 + REAL, DIMENSION(NX),PUBLIC,SAVE :: TBPVS,TBPVS0 + REAL, PUBLIC,SAVE :: C1XPVS0,C2XPVS0,C1XPVS,C2XPVS +! + REAL,DIMENSION(MY_T2+8) :: MP_RESTART_STATE + REAL,DIMENSION(nx) :: TBPVS_STATE,TBPVS0_STATE +! + REAL, PRIVATE,PARAMETER :: CVAP=1846., XLF=3.3358e+5, XLS=XLV+XLF & + & ,EPSQ1=1.001*EPSQ, RCP=1./CP, RCPRV=RCP/RV, RGRAV=1./GRAV & + & ,RRHOL=1./RHOL, XLV1=XLV/CP, XLF1=XLF/CP, XLS1=XLS/CP & + & ,XLV2=XLV*XLV/RV, XLS2=XLS*XLS/RV & + & ,XLV3=XLV*XLV*RCPRV, XLS3=XLS*XLS*RCPRV & +!--- Constants specific to the parameterization follow: +!--- CLIMIT/CLIMIT1 are lower limits for treating accumulated precipitation + & ,CLIMIT=10.*EPSQ, CLIMIT1=-CLIMIT & + & ,C1=1./3. & + & ,DMR1=.1E-3, DMR2=.2E-3, DMR3=.32E-3, DMR4=0.45E-3 & + & ,DMR5=0.67E-3 & + & ,XMR1=1.e6*DMR1, XMR2=1.e6*DMR2, XMR3=1.e6*DMR3 & + & ,XMR4=1.e6*DMR4, XMR5=1.e6*DMR5, RQRmix=0.05E-3, RQSmix=1.E-3 & !jul28 !apr27 + & ,Cdry=1.634e13, Cwet=1./.224 !jul28 !apr27 + INTEGER, PARAMETER :: MDR1=XMR1, MDR2=XMR2, MDR3=XMR3, MDR4=XMR4 & + & , MDR5=XMR5 + +!-- Debug 20120111 +LOGICAL, SAVE :: WARN1=.TRUE.,WARN2=.TRUE.,WARN3=.TRUE.,WARN5=.TRUE. +REAL, SAVE :: Pwarn=75.E2, QTwarn=1.E-3 +INTEGER, PARAMETER :: MAX_ITERATIONS=10 + +! +! ====================================================================== +!--- Important tunable parameters that are exported to other modules +! * T_ICE - temperature (C) threshold at which all remaining liquid water +! is glaciated to ice +! * T_ICE_init - maximum temperature (C) at which ice nucleation occurs +! +!-- To turn off ice processes, set T_ICE & T_ICE_init to <= -100. (i.e., -100 C) +! +! * NSImax - maximum number concentrations (m**-3) of small ice crystals +! * NLImin - minimum number concentrations (m**-3) of large ice (snow/graupel/sleet) +! * N0r0 - assumed intercept (m**-4) of rain drops if drop diameters are between 0.2 and 1.0 mm +! * N0rmin - minimum intercept (m**-4) for rain drops +! * NCW - number concentrations of cloud droplets (m**-3) +! ====================================================================== + REAL, PUBLIC,PARAMETER :: & + & RHgrd_in=1. & + &, P_RHgrd_out=850.E2 & + & ,T_ICE=-40. & + & ,T_ICEK=T0C+T_ICE & + & ,T_ICE_init=-12. & + & ,NSI_max=250.E3 & + & ,NLImin=1.0E3 & + & ,N0r0=8.E6 & + & ,N0rmin=1.E4 & +!! based on Aligo's email,NCW is changed to 250E6 + & ,NCW=250.E6 + !HWRF & ,NCW=300.E6 !- 100.e6 (maritime), 500.e6 (continental) + +!--- Other public variables passed to other routines: + REAL, PUBLIC,DIMENSION(MDImin:MDImax) :: MASSI +! + + CONTAINS +!----------------------------------------------------------------------- +!----------------------------------------------------------------------- +!&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& +!----------------------------------------------------------------------- + +!>\ingroup hafs_famp +!! This is the driver scheme of Ferrier-Aligo microphysics scheme. +!! NOTE: The only differences between FER_HIRES and FER_HIRES_ADVECT +!! is that the QT, and F_* are all local variables in the advected +!! version, and QRIMEF is only in the advected version. The innards +!! are all the same. + SUBROUTINE FER_HIRES (DT,RHgrd, & + & dz8w,rho_phy,p_phy,pi_phy,th_phy,t_phy, & + & q,qt, & + & LOWLYR,SR, & + & F_ICE_PHY,F_RAIN_PHY,F_RIMEF_PHY, & + & QC,QR,QS, & + & RAINNC,RAINNCV, & + & threads, & + & ims,ime, jms,jme, lm, & + & d_ss, & + & refl_10cm,DX1 ) +!----------------------------------------------------------------------- + IMPLICIT NONE +!----------------------------------------------------------------------- + INTEGER,INTENT(IN) :: D_SS,IMS,IME,JMS,JME,LM,DX1 + REAL, INTENT(IN) :: DT,RHgrd + INTEGER, INTENT(IN) :: THREADS + REAL, INTENT(IN), DIMENSION(ims:ime, jms:jme, lm):: & + & dz8w,p_phy,pi_phy,rho_phy + REAL, INTENT(INOUT), DIMENSION(ims:ime, jms:jme, lm):: & + & th_phy,t_phy,q,qt + REAL, INTENT(INOUT), DIMENSION(ims:ime,jms:jme, lm ) :: & + & qc,qr,qs + REAL, INTENT(INOUT), DIMENSION(ims:ime, jms:jme,lm) :: & + & F_ICE_PHY,F_RAIN_PHY,F_RIMEF_PHY + REAL, INTENT(OUT), DIMENSION(ims:ime, jms:jme,lm) :: & + & refl_10cm + REAL, INTENT(INOUT), DIMENSION(ims:ime,jms:jme) :: & + & RAINNC,RAINNCV + REAL, INTENT(OUT), DIMENSION(ims:ime,jms:jme):: SR +! + INTEGER, DIMENSION( ims:ime, jms:jme ),INTENT(INOUT) :: LOWLYR + +!----------------------------------------------------------------------- +! LOCAL VARS +!----------------------------------------------------------------------- + +! TLATGS_PHY,TRAIN_PHY,APREC,PREC,ACPREC,SR are not directly related +! the microphysics scheme. Instead, they will be used by Eta precip +! assimilation. + + REAL, DIMENSION( ims:ime, jms:jme,lm ) :: & + & TLATGS_PHY,TRAIN_PHY + REAL, DIMENSION(ims:ime,jms:jme):: APREC,PREC,ACPREC + + INTEGER :: I,J,K,KK + REAL :: wc +!------------------------------------------------------------------------ +! For subroutine EGCP01COLUMN_hr +!----------------------------------------------------------------------- + INTEGER :: LSFC,I_index,J_index,L + INTEGER,DIMENSION(ims:ime,jms:jme) :: LMH + REAL :: TC,QI,QRdum,QW,Fice,Frain,DUM,ASNOW,ARAIN + REAL,DIMENSION(lm) :: P_col,Q_col,T_col,WC_col, & + RimeF_col,QI_col,QR_col,QW_col, THICK_col,DPCOL,pcond1d, & + pidep1d,piacw1d,piacwi1d,piacwr1d,piacr1d,picnd1d,pievp1d, & + pimlt1d,praut1d,pracw1d,prevp1d,pisub1d,pevap1d,DBZ_col, & + NR_col,NS_col,vsnow1d,vrain11d,vrain21d,vci1d,NSmICE1d, & + INDEXS1d,INDEXR1d,RFlag1d,RHC_col +! +!----------------------------------------------------------------------- +!********************************************************************** +!----------------------------------------------------------------------- +! + +! MZ: HWRF practice start +!---------- +!2015-03-30, recalculate some constants which may depend on phy time step + CALL MY_GROWTH_RATES_NMM_hr (DT) + +!--- CIACW is used in calculating riming rates +! The assumed effective collection efficiency of cloud water rimed onto +! ice is =0.5 below: +! + CIACW=DT*0.25*PI*0.5*(1.E5)**C1 +! +!--- CIACR is used in calculating freezing of rain colliding with large ice +! The assumed collection efficiency is 1.0 +! + CIACR=PI*DT +! +!--- CRACW is used in calculating collection of cloud water by rain (an +! assumed collection efficiency of 1.0) +! + CRACW=DT*0.25*PI*1.0 +! +!-- See comments in subroutine etanewhr_init starting with variable RDIS= +! + BRAUT=DT*1.1E10*BETA6/NCW + + !write(*,*)'dt=',dt + !write(*,*)'pi=',pi + !write(*,*)'c1=',c1 + !write(*,*)'ciacw=',ciacw + !write(*,*)'ciacr=',ciacr + !write(*,*)'cracw=',cracw + !write(*,*)'araut=',araut + !write(*,*)'braut=',braut +!! END OF adding, 2015-03-30 +!----------- +! MZ: HWRF practice end +! + + DO j = jms,jme + DO i = ims,ime + ACPREC(i,j)=0. + APREC (i,j)=0. + PREC (i,j)=0. + SR (i,j)=0. + ENDDO + DO k = 1,lm + DO i = ims,ime + TLATGS_PHY (i,j,k)=0. + TRAIN_PHY (i,j,k)=0. + ENDDO + ENDDO + ENDDO + +!----------------------------------------------------------------------- +!-- Start of original driver for EGCP01COLUMN_hr +!----------------------------------------------------------------------- +! + DO J=JMS,JME + DO I=IMS,IME + LSFC=LM-LOWLYR(I,J)+1 ! "L" of surface + DO K=1,LM + DPCOL(K)=RHO_PHY(I,J,K)*GRAV*dz8w(I,J,K) + ENDDO +! +!--- Initialize column data (1D arrays) +! + L=LM +!-- qt = CWM, total condensate + IF (qt(I,J,L) .LE. EPSQ) qt(I,J,L)=EPSQ + F_ice_phy(I,J,L)=1. + F_rain_phy(I,J,L)=0. + F_RimeF_phy(I,J,L)=1. + do L=LM,1,-1 +! +!--- Pressure (Pa) = (Psfc-Ptop)*(ETA/ETA_sfc)+Ptop +! + P_col(L)=P_phy(I,J,L) +! +!--- Layer thickness = RHO*DZ = -DP/G = (Psfc-Ptop)*D_ETA/(G*ETA_sfc) +! + THICK_col(L)=DPCOL(L)*RGRAV + T_col(L)=T_phy(I,J,L) + TC=T_col(L)-T0C + Q_col(L)=max(EPSQ, q(I,J,L)) + IF (qt(I,J,L) .LE. EPSQ1) THEN + WC_col(L)=0. + IF (TC .LT. T_ICE) THEN + F_ice_phy(I,J,L)=1. + ELSE + F_ice_phy(I,J,L)=0. + ENDIF + F_rain_phy(I,J,L)=0. + F_RimeF_phy(I,J,L)=1. + ELSE + WC_col(L)=qt(I,J,L) + +!-- Debug 20120111 +! TC==TC will fail if NaN, preventing unnecessary error messages +IF (WC_col(L)>QTwarn .AND. P_col(L)1 g/kg condensate in stratosphere; I,J,L,TC,P,QT=', & + I,J,L,TC,.01*P_col(L),1000.*WC_col(L) + QTwarn=MAX(WC_col(L),10.*QTwarn) + Pwarn=MIN(P_col(L),0.5*Pwarn) +ENDIF +!-- TC/=TC will pass if TC is NaN +IF (WARN5 .AND. TC/=TC) THEN + WRITE(0,*) 'WARN5: NaN temperature; I,J,L,P=',I,J,L,.01*P_col(L) + WARN5=.FALSE. +ENDIF + + ENDIF + IF (T_ICE<=-100.) F_ice_phy(I,J,L)=0. +! ! +! !--- Determine composition of condensate in terms of +! ! cloud water, ice, & rain +! ! + WC=WC_col(L) + QI=0. + QRdum=0. + QW=0. + Fice=F_ice_phy(I,J,L) + Frain=F_rain_phy(I,J,L) +! + IF (Fice .GE. 1.) THEN + QI=WC + ELSE IF (Fice .LE. 0.) THEN + QW=WC + ELSE + QI=Fice*WC + QW=WC-QI + ENDIF +! + IF (QW.GT.0. .AND. Frain.GT.0.) THEN + IF (Frain .GE. 1.) THEN + QRdum=QW + QW=0. + ELSE + QRdum=Frain*QW + QW=QW-QRdum + ENDIF + ENDIF + IF (QI .LE. 0.) F_RimeF_phy(I,J,L)=1. + RimeF_col(L)=F_RimeF_phy(I,J,L) ! (real) + QI_col(L)=QI + QR_col(L)=QRdum + QW_col(L)=QW +!GFDL => New. Added RHC_col to allow for height- and grid-dependent values for +!GFDL the relative humidity threshold for condensation ("RHgrd") +!6/11/2010 mod - Use lower RHgrd_out threshold for < 850 hPa +!------------------------------------------------------------ + IF(DX1 .GE. 10 .AND. P_col(L)0) associated with snow +! + APREC(I,J)=(ARAIN+ASNOW)*RRHOL ! Accumulated surface precip (depth in m) !<--- Ying + PREC(I,J)=PREC(I,J)+APREC(I,J) + ACPREC(I,J)=ACPREC(I,J)+APREC(I,J) + IF(APREC(I,J) .LT. 1.E-8) THEN + SR(I,J)=0. + ELSE + SR(I,J)=RRHOL*ASNOW/APREC(I,J) + ENDIF +! +!####################################################################### +!####################################################################### +! + enddo ! End "I" loop + enddo ! End "J" loop +! +!----------------------------------------------------------------------- +!-- End of original driver for EGCP01COLUMN_hr +!----------------------------------------------------------------------- +! + DO j = jms,jme + do k = lm, 1, -1 + DO i = ims,ime + th_phy(i,j,k) = t_phy(i,j,k)/pi_phy(i,j,k) + WC=qt(I,J,K) + QS(I,J,K)=0. + QR(I,J,K)=0. + QC(I,J,K)=0. +! + IF(F_ICE_PHY(I,J,K)>=1.)THEN + QS(I,J,K)=WC + ELSEIF(F_ICE_PHY(I,J,K)<=0.)THEN + QC(I,J,K)=WC + ELSE + QS(I,J,K)=F_ICE_PHY(I,J,K)*WC + QC(I,J,K)=WC-QS(I,J,K) + ENDIF +! + IF(QC(I,J,K)>0..AND.F_RAIN_PHY(I,J,K)>0.)THEN + IF(F_RAIN_PHY(I,J,K).GE.1.)THEN + QR(I,J,K)=QC(I,J,K) + QC(I,J,K)=0. + ELSE + QR(I,J,K)=F_RAIN_PHY(I,J,K)*QC(I,J,K) + QC(I,J,K)=QC(I,J,K)-QR(I,J,K) + ENDIF + ENDIF + ENDDO !- i + ENDDO !- k + ENDDO !- j +! +!- Update rain (convert from m to kg/m**2, which is also equivalent to mm depth) +! + DO j=jms,jme + DO i=ims,ime + RAINNC(i,j)=APREC(i,j)*1000.+RAINNC(i,j) + RAINNCV(i,j)=APREC(i,j)*1000. + ENDDO + ENDDO +! +!----------------------------------------------------------------------- +! + END SUBROUTINE FER_HIRES +! +!----------------------------------------------------------------------- +! +!############################################################################### +! ***** VERSION OF MICROPHYSICS DESIGNED FOR HIGHER RESOLUTION MESO ETA MODEL +! (1) Represents sedimentation by preserving a portion of the precipitation +! through top-down integration from cloud-top. Modified procedure to +! Zhao and Carr (1997). +! (2) Microphysical equations are modified to be less sensitive to time +! steps by use of Clausius-Clapeyron equation to account for changes in +! saturation mixing ratios in response to latent heating/cooling. +! (3) Prevent spurious temperature oscillations across 0C due to +! microphysics. +! (4) Uses lookup tables for: calculating two different ventilation +! coefficients in condensation and deposition processes; accretion of +! cloud water by precipitation; precipitation mass; precipitation rate +! (and mass-weighted precipitation fall speeds). +! (5) Assumes temperature-dependent variation in mean diameter of large ice +! (Houze et al., 1979; Ryan et al., 1996). +! -> 8/22/01: This relationship has been extended to colder temperatures +! to parameterize smaller large-ice particles down to mean sizes of MDImin, +! which is 50 microns reached at -55.9C. +! (6) Attempts to differentiate growth of large and small ice, mainly for +! improved transition from thin cirrus to thick, precipitating ice +! anvils. +! (7) Top-down integration also attempts to treat mixed-phase processes, +! allowing a mixture of ice and water. Based on numerous observational +! studies, ice growth is based on nucleation at cloud top & +! subsequent growth by vapor deposition and riming as the ice particles +! fall through the cloud. There are two modes of ice nucleation +! following Meyers et al. (JAM, 1992): +! a) Deposition & condensation freezing nucleation - eq. (2.4) when +! air is supersaturated w/r/t ice +! b) Contact freezing nucleation - eq. (2.6) in presence of cloud water +! (8) Depositional growth of newly nucleated ice is calculated for large time +! steps using Fig. 8 of Miller and Young (JAS, 1979), at 1 deg intervals +! using their ice crystal masses calculated after 600 s of growth in water +! saturated conditions. The growth rates are normalized by time step +! assuming 3D growth with time**1.5 following eq. (6.3) in Young (1993). +! (9) Ice precipitation rates can increase due to increase in response to +! cloud water riming due to (a) increased density & mass of the rimed +! ice, and (b) increased fall speeds of rimed ice. +!############################################################################### +!############################################################################### +! +!>\ingroup hafs_famp +!! This is the grid-scale microphysical processes of Ferrier-Aligo microphysics +!! scheme (i.e., condensation and precipitation). +!!\param arain accumulated rainfall at the surface (kg) +!!\param asnow accumulated snowfall at the surface (kg) +!!\param dtph physics time step (s) +!!\param rhc_col vertical column of threshold relative humidity for onset of +!! condensation (ratio) +!!\param i_index i index +!!\param j_index j index +!!\param lsfc Eta level of level above surface, ground +!!\param p_col vertical column of model pressure (Pa) +!!\param qi_col vertical column of model ice mixing ratio (kg/kg) +!!\param qr_col vertical column of model rain ratio (kg/kg) +!!\param q_col vertical column of model water vapor specific humidity (kg/kg) +!!\param qw_col +!!\param rimef_col +!!\param t_col +!!\param thick_col +!!\param wc_col +!!\param lm +!!\param pcond1d +!!\param pidep1d +!!\param piacw1d +!!\param piacwi1d + SUBROUTINE EGCP01COLUMN_hr ( ARAIN, ASNOW, DTPH, RHC_col, & + & I_index, J_index, LSFC, & + & P_col, QI_col, QR_col, Q_col, QW_col, RimeF_col, T_col, & + & THICK_col, WC_col ,LM,pcond1d,pidep1d, & + & piacw1d,piacwi1d,piacwr1d,piacr1d,picnd1d,pievp1d,pimlt1d, & + & praut1d,pracw1d,prevp1d,pisub1d,pevap1d, DBZ_col,NR_col,NS_col, & + & vsnow1d,vrain11d,vrain21d,vci1d,NSmICE1d,INDEXS1d,INDEXR1d, & !jul28 + & RFlag1d,DX1) !jun01 +! +!############################################################################### +!############################################################################### +! +!------------------------------------------------------------------------------- +!----- NOTE: Code is currently set up w/o threading! +!------------------------------------------------------------------------------- +!$$$ SUBPROGRAM DOCUMENTATION BLOCK +! . . . +! SUBPROGRAM: Grid-scale microphysical processes - condensation & precipitation +! PRGRMMR: Ferrier ORG: W/NP22 DATE: 08-2001 +! PRGRMMR: Jin (Modification for WRF structure) +!------------------------------------------------------------------------------- +! ABSTRACT: +! * Merges original GSCOND & PRECPD subroutines. +! * Code has been substantially streamlined and restructured. +! * Exchange between water vapor & small cloud condensate is calculated using +! the original Asai (1965, J. Japan) algorithm. See also references to +! Yau and Austin (1979, JAS), Rutledge and Hobbs (1983, JAS), and Tao et al. +! (1989, MWR). This algorithm replaces the Sundqvist et al. (1989, MWR) +! parameterization. +!------------------------------------------------------------------------------- +! +! USAGE: +! * CALL EGCP01COLUMN_hr FROM SUBROUTINE EGCP01DRV +! +! INPUT ARGUMENT LIST: +! DTPH - physics time step (s) +! RHgrd - threshold relative humidity (ratio) for onset of condensation +! I_index - I index +! J_index - J index +! LSFC - Eta level of level above surface, ground +! P_col - vertical column of model pressure (Pa) +! QI_col - vertical column of model ice mixing ratio (kg/kg) +! QR_col - vertical column of model rain ratio (kg/kg) +! Q_col - vertical column of model water vapor specific humidity (kg/kg) +! QW_col - vertical column of model cloud water mixing ratio (kg/kg) +! RimeF_col - vertical column of rime factor for ice in model (ratio, defined below) +! T_col - vertical column of model temperature (deg K) +! THICK_col - vertical column of model mass thickness (density*height increment) +! WC_col - vertical column of model mixing ratio of total condensate (kg/kg) +! RHC_col - vertical column of threshold relative humidity for onset of condensation (ratio) !GFDL +! +! +! OUTPUT ARGUMENT LIST: +! ARAIN - accumulated rainfall at the surface (kg) +! ASNOW - accumulated snowfall at the surface (kg) +! Q_col - vertical column of model water vapor specific humidity (kg/kg) +! WC_col - vertical column of model mixing ratio of total condensate (kg/kg) +! QW_col - vertical column of model cloud water mixing ratio (kg/kg) +! QI_col - vertical column of model ice mixing ratio (kg/kg) +! QR_col - vertical column of model rain ratio (kg/kg) +! RimeF_col - vertical column of rime factor for ice in model (ratio, defined below) +! T_col - vertical column of model temperature (deg K) +! DBZ_col - vertical column of radar reflectivity (dBZ) +! NR_col - vertical column of rain number concentration (m^-3) +! NS_col - vertical column of snow number concentration (m^-3) +! +! OUTPUT FILES: +! NONE +! +! Subprograms & Functions called: +! * Real Function CONDENSE - cloud water condensation +! * Real Function DEPOSIT - ice deposition (not sublimation) +! * Integer Function GET_INDEXR - estimate the mean size of raindrops (microns) +! +! UNIQUE: NONE +! +! LIBRARY: NONE +! +! ATTRIBUTES: +! LANGUAGE: FORTRAN 90 +! MACHINE : IBM SP +! +!------------------------------------------------------------------------- +!--------------- Arrays & constants in argument list --------------------- +!------------------------------------------------------------------------- +! + IMPLICIT NONE +! + INTEGER,INTENT(IN) :: LM,I_index, J_index, LSFC,DX1 + REAL,INTENT(IN) :: DTPH + REAL,INTENT(INOUT) :: ARAIN, ASNOW + REAL,DIMENSION(LM),INTENT(INOUT) :: P_col, QI_col,QR_col & + & ,Q_col ,QW_col, RimeF_col, T_col, THICK_col,WC_col,pcond1d & + & ,pidep1d,piacw1d,piacwi1d,piacwr1d,piacr1d,picnd1d,pievp1d & + & ,pimlt1d,praut1d,pracw1d,prevp1d,pisub1d,pevap1d,DBZ_col,NR_col & + & ,NS_col,vsnow1d,vrain11d,vrain21d,vci1d,NSmICE1d,INDEXS1d & !jun01 + & ,INDEXR1d,RFlag1d,RHC_col !jun01 +! +!-------------------------------------------------------------------------------- +!--- The following arrays are integral calculations based on the mean +! snow/graupel diameters, which vary from 50 microns to 1000 microns +! (1 mm) at 1-micron intervals and assume exponential size distributions. +! The values are normalized and require being multipled by the number +! concentration of large ice (NLICE). +!--------------------------------------- +! - VENTI1 - integrated quantity associated w/ ventilation effects +! (capacitance only) for calculating vapor deposition onto ice +! - VENTI2 - integrated quantity associated w/ ventilation effects +! (with fall speed) for calculating vapor deposition onto ice +! - ACCRI - integrated quantity associated w/ cloud water collection by ice +! - MASSI - integrated quantity associated w/ ice mass +! - VSNOWI - mass-weighted fall speed of snow (large ice), used to calculate +! precipitation rates +! - VEL_RF - velocity increase of rimed particles as functions of crude +! particle size categories (at 0.1 mm intervals of mean ice particle +! sizes) and rime factor (different values of Rime Factor of 1.1**N, +! where N=0 to Nrime). +!-------------------------------------------------------------------------------- +!--- The following arrays are integral calculations based on the mean +! rain diameters, which vary from 50 microns to 1000 microns +! (1 mm) at 1-micron intervals and assume exponential size distributions. +! The values are normalized and require being multiplied by the rain intercept +! (N0r). +!--------------------------------------- +! - VENTR1 - integrated quantity associated w/ ventilation effects +! (capacitance only) for calculating evaporation from rain +! - VENTR2 - integrated quantity associated w/ ventilation effects +! (with fall speed) for calculating evaporation from rain +! - ACCRR - integrated quantity associated w/ cloud water collection by rain +! - MASSR - integrated quantity associated w/ rain +! - VRAIN - mass-weighted fall speed of rain, used to calculate +! precipitation rates +! - RRATE - precipitation rates, which should also be equal to RHO*QR*VRAIN +! +!------------------------------------------------------------------------- +!------- Key parameters, local variables, & important comments --------- +!----------------------------------------------------------------------- +! +!--- TOLER => Tolerance or precision for accumulated precipitation +! + REAL, PARAMETER :: TOLER=5.E-7, C2=1./6., RHO0=1.194, & + Xratio=.025, Zmin=0.01, DBZmin=-20. +! +!--- If BLEND=1: +! precipitation (large) ice amounts are estimated at each level as a +! blend of ice falling from the grid point above and the precip ice +! present at the start of the time step (see TOT_ICE below). +!--- If BLEND=0: +! precipitation (large) ice amounts are estimated to be the precip +! ice present at the start of the time step. +! +!--- Extended to include sedimentation of rain on 2/5/01 +! + REAL, PARAMETER :: BLEND=1. +! +!--- This variable is for debugging purposes (if .true.) +! + LOGICAL, PARAMETER :: PRINT_diag=.false. +! +!----------------------------------------------------------------------- +!--- Local variables +!----------------------------------------------------------------------- +! + REAL :: EMAIRI, N0r, NLICE, NSmICE, NInuclei, Nrain, Nsnow, Nmix + REAL :: RHgrd + LOGICAL :: CLEAR, ICE_logical, DBG_logical, RAIN_logical, & + STRAT, DRZL + INTEGER :: INDEX_MY,INDEXR,INDEXR1,INDEXR2,INDEXS,IPASS,ITDX,IXRF,& + & IXS,LBEF,L,INDEXRmin,INDEXS0C,IDR !mar03 !may20 +! +! + REAL :: ABI,ABW,AIEVP,ARAINnew,ASNOWnew,BLDTRH,BUDGET, & + & CREVP,DELI,DELR,DELT,DELV,DELW,DENOMF, & + & DENOMI,DENOMW,DENOMWI,DIDEP, & + & DIEVP,DIFFUS,DLI,DTRHO,DUM,DUM1,DUM2,DUM3, & + & DWV0,DWVI,DWVR,DYNVIS,ESI,ESW,FIR,FLIMASS, & + & FWR,FWS,GAMMAR,GAMMAS, & + & PCOND,PIACR,PIACW,PIACWI,PIACWR,PICND,PIDEP,PIDEP_max, & + & PIEVP,PILOSS,PIMLT,PINIT,PP,PRACW,PRAUT,PREVP,PRLOSS, & + & QI,QInew,QLICE,QR,QRnew,QSI,QSIgrd,QSInew,QSW,QSW0, & + & QSWgrd,QSWnew,QT,QTICE,QTnew,QTRAIN,Q,QW,QWnew,Rcw, & + & RFACTOR,RFmx,RFrime,RHO,RIMEF,RIMEF1,RQR,RR,RRHO,SFACTOR, & + & TC,TCC,TFACTOR,THERM_COND,THICK,TK,TK2,TNEW, & + & TOT_ICE,TOT_ICEnew,TOT_RAIN,TOT_RAINnew, & + & VEL_INC,VENTR,VENTIL,VENTIS,VRAIN1,VRAIN2,VRIMEF,VSNOW, & + & VSNOW1,WC,WCnew,WSgrd,WS,WSnew,WV,WVnew, & + & XLI,XLIMASS,XRF, & + & NSImax,QRdum,QSmICE,QLgIce,RQLICE,VCI,TIMLT, & + & RQSnew,RQRnew,Zrain,Zsnow,Ztot,RHOX0C,RFnew,PSDEP,DELS !mar03 !apr22 + REAL, SAVE :: Revised_LICE=1.e-3 !-- kg/m**3 +! +!####################################################################### +!########################## Begin Execution ############################ +!####################################################################### +! +! + ARAIN=0. ! Accumulated rainfall into grid box from above (kg/m**2) + VRAIN1=0. ! Rain fall speeds into grib box from above (m/s) + VSNOW1=0. ! Ice fall speeds into grib box from above (m/s) + ASNOW=0. ! Accumulated snowfall into grid box from above (kg/m**2) + INDEXS0C=MDImin ! Mean snow/graupel diameter just above (<0C) freezing level (height) + RHOX0C=22.5 ! Estimated ice density at 0C (kg m^-3) !mar03 + TIMLT=0. ! Total ice melting in a layer (drizzle detection) + STRAT=.FALSE. ! Stratiform rain DSD below melting level !may11 + DRZL=.FALSE. ! Drizzle DSD below melting level !may23 +! +!----------------------------------------------------------------------- +!------------ Loop from top (L=1) to surface (L=LSFC) ------------------ +!----------------------------------------------------------------------- +! +big_loop: DO L=LM,1,-1 + pcond1d(L)=0. + pidep1d(L)=0. + piacw1d(L)=0. + piacwi1d(L)=0. + piacwr1d(L)=0. + piacr1d(L)=0. + picnd1d(L)=0. + pievp1d(L)=0. + pimlt1d(L)=0. + praut1d(L)=0. + pracw1d(L)=0. + prevp1d(L)=0. + pisub1d(L)=0. + pevap1d(L)=0. + vsnow1d(L)=0. + vrain11d(L)=0. + vrain21d(L)=0. + vci1d(L)=0. + NSmICE1d(L)=0. + DBZ_col(L)=DBZmin + NR_col(L)=0. + NS_col(L)=0. + INDEXR1d(L)=0. + INDEXS1d(L)=0. + RFlag1d(L)=0. !jun01 +! +!--- Skip this level and go to the next lower level if no condensate +! and very low specific humidities +! +!--- Check if any rain is falling into layer from above +! + IF (ARAIN .GT. CLIMIT) THEN + CLEAR=.FALSE. + VRAIN1=0. + ELSE + CLEAR=.TRUE. + ARAIN=0. + ENDIF +! +!--- Check if any ice is falling into layer from above +! +!--- NOTE that "SNOW" in variable names is often synonomous with +! large, precipitation ice particles +! + IF (ASNOW .GT. CLIMIT) THEN + CLEAR=.FALSE. + VSNOW1=0. + ELSE + ASNOW=0. + ENDIF +! +!----------------------------------------------------------------------- +!------------ Proceed with cloud microphysics calculations ------------- +!----------------------------------------------------------------------- +! + TK=T_col(L) ! Temperature (deg K) + TC=TK-T0C ! Temperature (deg C) + PP=P_col(L) ! Pressure (Pa) + Q=Q_col(L) ! Specific humidity of water vapor (kg/kg) + WV=Q/(1.-Q) ! Water vapor mixing ratio (kg/kg) + WC=WC_col(L) ! Grid-scale mixing ratio of total condensate (water or ice; kg/kg) + RHgrd=RHC_col(L) ! Threshold relative humidity for the onset of condensation +! +!----------------------------------------------------------------------- +!--- Moisture variables below are mixing ratios & not specifc humidities +!----------------------------------------------------------------------- +! +!--- This check is to determine grid-scale saturation when no condensate is present +! + ESW=MIN(1000.*FPVS0(TK),0.99*PP) ! Saturation vapor pressure w/r/t water + QSW=EPS*ESW/(PP-ESW) ! Saturation mixing ratio w/r/t water + WS=QSW ! General saturation mixing ratio (water/ice) + QSI=QSW ! Saturation mixing ratio w/r/t ice + IF (TC .LT. 0.) THEN + ESI=MIN(1000.*FPVS(TK),0.99*PP) ! Saturation vapor pressure w/r/t ice + QSI=EPS*ESI/(PP-ESI) ! Saturation mixing ratio w/r/t water + WS=QSI ! General saturation mixing ratio (water/ice) + ENDIF +! +!--- Effective grid-scale Saturation mixing ratios +! + QSWgrd=RHgrd*QSW + QSIgrd=RHgrd*QSI + WSgrd=RHgrd*WS +! +!--- Check if air is subsaturated and w/o condensate +! + IF (WV.GT.WSgrd .OR. WC.GT.EPSQ) CLEAR=.FALSE. +! +!----------------------------------------------------------------------- +!-- Loop to the end if in clear, subsaturated air free of condensate --- +!----------------------------------------------------------------------- +! + IF (CLEAR) THEN + STRAT=.FALSE. !- Reset stratiform rain flag + DRZL=.FALSE. !- Reset drizzle flag + INDEXRmin=MDRmin !- Reset INDEXRmin + TIMLT=0. !- Reset accumulated ice melting + CYCLE big_loop + ENDIF +! +!----------------------------------------------------------------------- +!--------- Initialize RHO, THICK & microphysical processes ------------- +!----------------------------------------------------------------------- +! +! +!--- Virtual temperature, TV=T*(1./EPS-1)*Q, Q is specific humidity; +! (see pp. 63-65 in Fleagle & Businger, 1963) +! + RHO=PP/(RD*TK*(1.+EPS1*Q)) ! Air density (kg/m**3) + RRHO=1./RHO ! Reciprocal of air density + DTRHO=DTPH*RHO ! Time step * air density + BLDTRH=BLEND*DTRHO ! Blend parameter * time step * air density + THICK=THICK_col(L) ! Layer thickness = RHO*DZ = -DP/G = (Psfc-Ptop)*D_ETA/(G*ETA_sfc) +! + ARAINnew=0. ! Updated accumulated rainfall + ASNOWnew=0. ! Updated accumulated snowfall + QI=QI_col(L) ! Ice mixing ratio + QInew=0. ! Updated ice mixing ratio + QR=QR_col(L) ! Rain mixing ratio + QRnew=0. ! Updated rain ratio + QW=QW_col(L) ! Cloud water mixing ratio + QWnew=0. ! Updated cloud water ratio +! + PCOND=0. ! Condensation (>0) or evaporation (<0) of cloud water (kg/kg) + PIDEP=0. ! Deposition (>0) or sublimation (<0) of ice crystals (kg/kg) + PINIT=0. ! Ice initiation (part of PIDEP calculation, kg/kg) + PIACW=0. ! Cloud water collection (riming) by precipitation ice (kg/kg; >0) + PIACWI=0. ! Growth of precip ice by riming (kg/kg; >0) + PIACWR=0. ! Shedding of accreted cloud water to form rain (kg/kg; >0) + PIACR=0. ! Freezing of rain onto large ice at supercooled temps (kg/kg; >0) + PICND=0. ! Condensation (>0) onto wet, melting ice (kg/kg) + PIEVP=0. ! Evaporation (<0) from wet, melting ice (kg/kg) + PIMLT=0. ! Melting ice (kg/kg; >0) + PRAUT=0. ! Cloud water autoconversion to rain (kg/kg; >0) + PRACW=0. ! Cloud water collection (accretion) by rain (kg/kg; >0) + PREVP=0. ! Rain evaporation (kg/kg; <0) + NSmICE=0. ! Cloud ice number concentration (m^-3) + Nrain=0. ! Rain number concentration (m^-3) !jul28 begin + Nsnow=0. ! "Snow" number concentration (m^-3) + RQRnew=0. ! Final rain content (kg/m**3) + RQSnew=0. ! Final "snow" content (kg/m**3) + Zrain=0. ! Radar reflectivity from rain (mm**6 m-3) + Zsnow=0. ! Radar reflectivity from snow (mm**6 m-3) + Ztot=0. ! Radar reflectivity from rain+snow (mm**6 m-3) + INDEXR=MDRmin ! Mean diameter of rain (microns) + INDEXR1=INDEXR ! 1st updated mean diameter of rain (microns) + INDEXR2=INDEXR ! 2nd updated mean diameter of rain (microns) + N0r=0. ! 1st estimate for rain intercept (m^-4) + DUM1=MIN(0.,TC) + DUM=XMImax*EXP(XMIexp*DUM1) + INDEXS=MIN(MDImax, MAX(MDImin, INT(DUM) ) ) ! 1st estimate for mean diameter of snow (microns) + VCI=0. ! Cloud ice fall speeds (m/s) + VSNOW=0. ! "Snow" (snow/graupel/sleet/hail) fall speeds (m/s) + VRAIN2=0. ! Rain fall speeds out of bottom of grid box (m/s) + RimeF1=1. ! Rime Factor (ratio, >=1, defined below) +! +!--- Double check input hydrometeor mixing ratios +! +! DUM=WC-(QI+QW+QR) +! DUM1=ABS(DUM) +! DUM2=TOLER*MIN(WC, QI+QW+QR) +! IF (DUM1 .GT. DUM2) THEN +! WRITE(0,"(/2(a,i4),a,i2)") '{@ i=',I_index,' j=',J_index, +! & ' L=',L +! WRITE(0,"(4(a12,g11.4,1x))") +! & '{@ TCold=',TC,'P=',.01*PP,'DIFF=',DUM,'WCold=',WC, +! & '{@ QIold=',QI,'QWold=',QW,'QRold=',QR +! ENDIF +! +!*********************************************************************** +!*********** MAIN MICROPHYSICS CALCULATIONS NOW FOLLOW! **************** +!*********************************************************************** +! +!--- Calculate a few variables, which are used more than once below +! +!--- Latent heat of vaporization as a function of temperature from +! Bolton (1980, JAS) +! + TK2=1./(TK*TK) ! 1./TK**2 +! +!--- Basic thermodynamic quantities +! * DYNVIS - dynamic viscosity [ kg/(m*s) ] +! * THERM_COND - thermal conductivity [ J/(m*s*K) ] +! * DIFFUS - diffusivity of water vapor [ m**2/s ] +! + TFACTOR=SQRT(TK*TK*TK)/(TK+120.) + DYNVIS=1.496E-6*TFACTOR + THERM_COND=2.116E-3*TFACTOR + DIFFUS=8.794E-5*TK**1.81/PP +! +!--- Air resistance term for the fall speed of ice following the +! basic research by Heymsfield, Kajikawa, others +! + GAMMAS=MIN(1.5, (1.E5/PP)**C1) !-- limited to 1.5x +! +!--- Air resistance for rain fall speed (Beard, 1985, JAS, p.470) +! + GAMMAR=(RHO0/RHO)**.4 +! +!---------------------------------------------------------------------- +!------------- IMPORTANT MICROPHYSICS DECISION TREE ----------------- +!---------------------------------------------------------------------- +! +!--- Determine if conditions supporting ice are present +! + IF (TC.LT.0. .OR. QI.GT. EPSQ .OR. ASNOW.GT.CLIMIT) THEN + ICE_logical=.TRUE. + ELSE + ICE_logical=.FALSE. + QLICE=0. + QTICE=0. + ENDIF + IF (T_ICE <= -100.) THEN + ICE_logical=.FALSE. + QLICE=0. + QTICE=0. + ENDIF +! +!--- Determine if rain is present +! + RAIN_logical=.FALSE. + IF (ARAIN.GT.CLIMIT .OR. QR.GT.EPSQ) RAIN_logical=.TRUE. +! +ice_test: IF (ICE_logical) THEN +! +!--- IMPORTANT: Estimate time-averaged properties. +! +!--- +! -> Small ice particles are assumed to have a mean diameter of 50 microns. +! * QSmICE - estimated mixing ratio for small cloud ice +!--- +! * TOT_ICE - total mass (small & large) ice before microphysics, +! which is the sum of the total mass of large ice in the +! current layer and the input flux of ice from above +! * PILOSS - greatest loss (<0) of total (small & large) ice by +! sublimation, removing all of the ice falling from above +! and the ice within the layer +! * RimeF1 - Rime Factor, which is the mass ratio of total (unrimed & rimed) +! ice mass to the unrimed ice mass (>=1) +! * VrimeF - the velocity increase due to rime factor or melting (ratio, >=1) +! * VSNOW - Fall speed of rimed snow w/ air resistance correction +! * VCI - Fall speed of 50-micron ice crystals w/ air resistance correction +! * EMAIRI - equivalent mass of air associated layer and with fall of snow into layer +! * XLIMASS - used for debugging, associated with calculating large ice mixing ratio +! * FLIMASS - mass fraction of large ice +! * QTICE - time-averaged mixing ratio of total ice +! * QLICE - time-averaged mixing ratio of large ice +! * NLICE - time-averaged number concentration of large ice +! * NSmICE - number concentration of small ice crystals at current level +! * QSmICE - mixing ratio of small ice crystals at current level +!--- +!--- Assumed number fraction of large ice particles to total (large & small) +! ice particles, which is based on a general impression of the literature. +! + NInuclei=0. + NSmICE=0. + QSmICE=0. + Rcw=0. + IF (TC<0.) THEN +! +!--- Max # conc of small ice crystals based on 10% of total ice content +! or the parameter NSI_max +! + NSImax=MAX(NSI_max, 0.1*RHO*QI/MASSI(MDImin) ) !aug27 +! +!-- Specify Fletcher, Cooper, Meyers, etc. here for ice nuclei concentrations +! Cooper (1986): NInuclei=MIN(5.*EXP(-0.304*TC), NSImax) +! Fletcher (1962): NInuclei=MIN(0.01*EXP(-0.6*TC), NSImax) +! +!aug28: The formulas below mean that Fletcher is used for >-21C and Cooper at colder +! temperatures. In areas of high ice contents near the tops of deep convection, +! the number concentrations will be determined by the lower value of the "FQi" +! contribution to NSImax or Cooper. +! + NInuclei=MIN(0.01*EXP(-0.6*TC), NSImax) !aug28 - Fletcher (1962) + NInuclei=MIN(5.*EXP(-0.304*TC), NInuclei) !aug28 - Cooper (1984) + IF (QI>EPSQ) THEN + DUM=RRHO*MASSI(MDImin) + NSmICE=MIN(NInuclei, QI/DUM) + QSmICE=NSmICE*DUM + ENDIF ! End IF (QI>EPSQ) + ENDIF ! End IF (TC<0.) + init_ice: IF (QI<=EPSQ .AND. ASNOW<=CLIMIT) THEN + TOT_ICE=0. + PILOSS=0. + RimeF1=1. + VrimeF=1. + VEL_INC=GAMMAS + VSNOW=0. + VSNOW1=0. + VCI=0. + EMAIRI=THICK + XLIMASS=RimeF1*MASSI(INDEXS) + FLIMASS=1. + QLICE=0. + RQLICE=0. + QTICE=0. + NLICE=0. + ELSE init_ice + ! + !--- For T<0C mean particle size follows Houze et al. (JAS, 1979, p. 160), + ! converted from Fig. 5 plot of LAMDAs. Similar set of relationships + ! also shown in Fig. 8 of Ryan (BAMS, 1996, p. 66). + ! +! +!sep10 - Start of changes described in (23) at top of code. +! + TOT_ICE=THICK*QI+BLEND*ASNOW + PILOSS=-TOT_ICE/THICK + QLgICE=MAX(0., QI-QSmICE) !-- 1st-guess estimate of large ice + VCI=GAMMAS*VSNOWI(MDImin) +! +!-- Need to save this original value before two_pass iteration +! + LBEF=MAX(1,L-1) + RimeF1=(RimeF_col(L)*THICK*QLgICE & + & +RimeF_col(LBEF)*BLEND*ASNOW)/TOT_ICE +! +!mar08 see (32); !apr22a see (41) start - Estimate mean diameter (INDEXS in microns) + IF (RimeF1>2.) THEN + DUM3=RH_NgC*(RHO*QLgICE)**C1 !- convective mean diameter + DUM2=RH_NgT*(RHO*QLgICE)**C1 !- transition mean diameter + IF (RimeF1>=10.) THEN + DUM=DUM3 + ELSE IF (RimeF1>=5.) THEN + DUM=0.2*(RimeF1-5.) !- Blend at 5<=RF<10 + DUM=DUM3*DUM+DUM2*(1.-DUM) + ELSE + DUM1=REAL(INDEXS) !- stratiform mean diameter + DUM=0.33333*(RimeF1-2.) !- Blend at 2=5. .AND. INDEXS==MDImax .AND. RQLICE>RQhail) THEN +!- Additional increase using Thompson graupel/hail fall speeds + DUM=GAMMAS*AVhail*RQLICE**BVhail + IF (DUM>VSNOW) THEN + VSNOW=DUM + VEL_INC=VSNOW/VSNOWI(INDEXS) + ENDIF + ENDIF + XLIMASS=RimeF1*MASSI(INDEXS) + NLICE=RQLICE/XLIMASS +! +!sep16 - End of change described in (26) at top of code. +! +!=========================================== + IF (IPASS>=2 .OR. & + (NLICE>=NLImin .AND. NLICE<=NSI_max)) EXIT two_pass +!may17 - end +!=========================================== +! +!--- Force NLICE to be between NLImin and NSI_max when IPASS=1 +! +! IF (PRINT_diag .AND. RQLICE>Revised_LICE) DUM2=NLICE !-- For debugging (see DUM2 below) + NLICE=MAX(NLImin, MIN(NSI_max, NLICE) ) +!sep16 - End of changes +! + XLI=RQLICE/(NLICE*RimeF1) !- Mean mass of unrimed ice +new_size: IF (XLI<=MASSI(MDImin) ) THEN + INDEXS=MDImin + ELSE IF (XLI<=MASSI(450) ) THEN new_size + DLI=9.5885E5*XLI**.42066 ! DLI in microns + INDEXS=MIN(MDImax, MAX(MDImin, INT(DLI) ) ) + ELSE IF (XLIRevised_LICE) THEN +! WRITE(0,"(5(a12,g11.4,1x))") '{$ RimeF1=',RimeF1, & +! & ' RHO*QLICE=',RQLICE,' TC=',TC,' NLICE=',NLICE, & +! & ' NLICEold=',DUM2 +! Revised_LICE=1.2*RQLICE +! ENDIF + ENDIF new_size +!=========================================== + ENDDO two_pass +!=========================================== + ENDIF init_ice + ENDIF ice_test +! +!mar03 !may11 !jun01 - start; see (34) above + IF(TC<=0.) THEN + STRAT=.FALSE. + INDEXRmin=MDRmin + TIMLT=0. + INDEXS0C=INDEXS + RHOX0C=22.5*MAX(1.,MIN(RimeF1,40.)) !- Estimated ice density at 0C (kg m^-3) + ELSE ! TC>0. + IF(.NOT.RAIN_logical) THEN + STRAT=.FALSE. !- Reset STRAT + INDEXRmin=MDRmin !- Reset INDEXRmin + IF(.NOT.ICE_logical) TIMLT=0. + ELSE +!- STRAT=T for stratiform rain + IF(TIMLT>EPSQ .AND. RHOX0C<=225.) THEN + STRAT=.TRUE. + ELSE + STRAT=.FALSE. !- Reset STRAT + INDEXRmin=MDRmin !- Reset INDEXRmin + ENDIF + IF(STRAT .AND. INDEXRmin<=MDRmin) THEN + INDEXRmin=INDEXS0C*(0.001*RHOX0C)**C1 + INDEXRmin=MAX(MDRmin, MIN(INDEXRmin, INDEXRstrmax) ) + ENDIF + ENDIF + ENDIF +! + IF(STRAT .OR. TIMLT>EPSQ) THEN + DRZL=.FALSE. + ELSE +!- DRZL=T for drizzle (no melted ice falling from above) + DRZL=.TRUE. !mar30 + ENDIF +!jun01 - end +! +!---------------------------------------------------------------------- +!--------------- Calculate individual processes ----------------------- +!---------------------------------------------------------------------- +! +!--- Cloud water autoconversion to rain (PRAUT) and collection of cloud +! water by precipitation ice (PIACW) +! + IF (QW.GT.EPSQ .AND. TC.GE.T_ICE) THEN +!-- The old autoconversion threshold returns + DUM2=RHO*QW + IF (DUM2>QAUT0) THEN +!-- July 2010 version follows Liu & Daum (JAS, 2004) and Liu et al. (JAS, 2006) + DUM2=DUM2*DUM2 + DUM=BRAUT*DUM2*QW + DUM1=ARAUT*DUM2 + PRAUT=MIN(QW, DUM*(1.-EXP(-DUM1*DUM1)) ) + ENDIF + IF (QLICE .GT. EPSQ) THEN + ! + !--- Collection of cloud water by large ice particles ("snow") + ! PIACWI=PIACW for riming, PIACWI=0 for shedding + ! + FWS=MIN(1., CIACW*VEL_INC*NLICE*ACCRI(INDEXS) ) !jul28 (16) + PIACW=FWS*QW + IF (TC<0.) THEN + PIACWI=PIACW !- Large ice riming + Rcw=ARcw*DUM2**C1 !- Cloud droplet radius in microns + ENDIF + ENDIF ! End IF (QLICE .GT. EPSQ) + ENDIF ! End IF (QW.GT.EPSQ .AND. TC.GE.T_ICE) +! +!---------------------------------------------------------------------- +!--- Calculate homogeneous freezing of cloud water (PIACW, PIACWI) and +! ice deposition (PIDEP), which also includes ice initiation (PINIT) +! +ice_only: IF (TC.LT.T_ICE .AND. (WV.GT.QSWgrd .OR. QW.GT.EPSQ)) THEN + ! + !--- Adjust to ice saturation at T More extensive units conversion than can be described here to go from +! eq. (13) in Liu et al. (JAS, 2006) to what's programmed below. Note that +! the units used throughout the paper are in cgs units! +! + ARAUT=1.03e19/(NCW*SQRT(NCW)) + BRAUT=DTPH*1.1E10*BETA6/NCW +! +!--- QAUT0 is the *OLD* threshold cloud content for autoconversion to rain +! needed for droplets to reach a diameter of 20 microns (following +! Manton and Cotton, 1977; Banta and Hanson, 1987, JCAM). It's no longer +! used in this version, but the value is passed into radiation in case +! a ball park estimate is needed. +!--- QAUT0=1.2567, 0.8378, or 0.4189 g/m**3 for droplet number concentrations +! of 300, 200, and 100 cm**-3, respectively +! + QAUT0=PI*RHOL*NCW*(20.E-6)**3/6. !-- legacy +! +!--- For calculating cloud droplet radius in microns, Rcw +! + ARcw=1.E6*(0.75/(PI*NCW*RHOL))**C1 +! +!may20 - start +! +!- An explanation for the following settings assumed for "hail" or frozen drops (RF>10): +! RH_NgC=PI*500.*5.E3 +! RHOg=500 kg m^-3, Ng=5.e3 m^-3 => "hail" content >7.85 g m^-3 for INDEXS=MDImax +!- or - +! RH_NgC=PI*500.*1.E3 +! RHOg=500 kg m^-3, Ng=1.e3 m^-3 => "hail" content >1.57 g m^-3 for INDEXS=MDImax +! + RH_NgC=PI*500.*1.E3 !- RHOg=500 kg m^-3, Ng=1.e3 m^-3 + RQhail=RH_NgC*(1.E-3)**3 !- Threshold "hail" content ! becomes 1.57 g m^-3 + Bvhail=0.82*C1 !- Exponent for Thompson graupel + Avhail=1353.*(1./RH_NgC)**Bvhail !- 1353 ~ constant for Thompson graupel + RH_NgC=1.E6*(1./RH_NgC)**C1 !mar08 (convection, convert to microns) +! +!- An explanation for the following settings assumed for graupel (RF>5): +! RH_NgT=PI*300.*10.E3 +! RHOg=300 kg m^-3, Ng=10.e3 m^-3 => "graupel" content must exceed 9.43 g m^-3 for INDEXS=MDImax +!- or - +! RH_NgT=PI*300.*5.E3 +! RHOg=300 kg m^-3, Ng=5.e3 m^-3 => "graupel" content must exceed 4.71 g m^-3 for INDEXS=MDImax +! + RH_NgT=PI*300.*5.E3 !- RHOg=300 kg m^-3, Ng=5.e3 m^-3 + RH_NgT=1.E6*(1./RH_NgT)**C1 !mar08 (transition, convert to microns) +!may20 - end +! +!--- For calculating snow optical depths by considering bulk density of +! snow based on emails from Q. Fu (6/27-28/01), where optical +! depth (T) = 1.5*SWP/(Reff*DENS), SWP is snow water path, Reff +! is effective radius, and DENS is the bulk density of snow. +! +! SWP (kg/m**2)=(1.E-3 kg/g)*SWPrad, SWPrad in g/m**2 used in radiation +! T = 1.5*1.E3*SWPrad/(Reff*DENS) +! +! See derivation for MASSI(INDEXS), note equal to RHO*QSNOW/NSNOW +! +! SDENS=1.5e3/DENS, DENS=MASSI(INDEXS)/[PI*(1.E-6*INDEXS)**3] +! + DO I=MDImin,MDImax + SDENS(I)=PI*1.5E-15*FLOAT(I*I*I)/MASSI(I) + ENDDO +! + Thour_print=-DTPH/3600. +! + + RETURN +! +!----------------------------------------------------------------------- +! +9061 CONTINUE + WRITE(0,*)' module_mp_etanew: error opening ETAMPNEW_DATA.expanded_rain on unit ',etampnew_unit1 + STOP +! +!----------------------------------------------------------------------- + END SUBROUTINE FERRIER_INIT_hr +! +!>\ingroup hafs_famp + SUBROUTINE MY_GROWTH_RATES_NMM_hr (DTPH) +! +!--- Below are tabulated values for the predicted mass of ice crystals +! after 600 s of growth in water saturated conditions, based on +! calculations from Miller and Young (JAS, 1979). These values are +! crudely estimated from tabulated curves at 600 s from Fig. 6.9 of +! Young (1993). Values at temperatures colder than -27C were +! assumed to be invariant with temperature. +! +!--- Used to normalize Miller & Young (1979) calculations of ice growth +! over large time steps using their tabulated values at 600 s. +! Assumes 3D growth with time**1.5 following eq. (6.3) in Young (1993). +! + IMPLICIT NONE +! + REAL,INTENT(IN) :: DTPH +! + REAL DT_ICE + REAL,DIMENSION(35) :: MY_600 +!WRF +! +!----------------------------------------------------------------------- +!-- 20090714: These values are in g and need to be converted to kg below + DATA MY_600 / & + & 5.5e-8, 1.4E-7, 2.8E-7, 6.E-7, 3.3E-6, & + & 2.E-6, 9.E-7, 8.8E-7, 8.2E-7, 9.4e-7, & + & 1.2E-6, 1.85E-6, 5.5E-6, 1.5E-5, 1.7E-5, & + & 1.5E-5, 1.E-5, 3.4E-6, 1.85E-6, 1.35E-6, & + & 1.05E-6, 1.E-6, 9.5E-7, 9.0E-7, 9.5E-7, & + & 9.5E-7, 9.E-7, 9.E-7, 9.E-7, 9.E-7, & + & 9.E-7, 9.E-7, 9.E-7, 9.E-7, 9.E-7 / ! -31 to -35 deg C +! +!----------------------------------------------------------------------- +! + DT_ICE=(DTPH/600.)**1.5 + MY_GROWTH_NMM=DT_ICE*MY_600*1.E-3 !-- 20090714: Convert from g to kg +! +!----------------------------------------------------------------------- +! + END SUBROUTINE MY_GROWTH_RATES_NMM_hr +! +!----------------------------------------------------------------------- +!--------- Old GFS saturation vapor pressure lookup tables ----------- +!----------------------------------------------------------------------- +! +!>\ingroup hafs_famp + SUBROUTINE GPVS_hr +! ****************************************************************** +!$$$ SUBPROGRAM DOCUMENTATION BLOCK +! . . . +! SUBPROGRAM: GPVS_hr COMPUTE SATURATION VAPOR PRESSURE TABLE +! AUTHOR: N PHILLIPS W/NP2 DATE: 30 DEC 82 +! +! ABSTRACT: COMPUTE SATURATION VAPOR PRESSURE TABLE AS A FUNCTION OF +! TEMPERATURE FOR THE TABLE LOOKUP FUNCTION FPVS. +! EXACT SATURATION VAPOR PRESSURES ARE CALCULATED IN SUBPROGRAM FPVSX. +! THE CURRENT IMPLEMENTATION COMPUTES A TABLE WITH A LENGTH +! OF 7501 FOR TEMPERATURES RANGING FROM 180.0 TO 330.0 KELVIN. +! +! PROGRAM HISTORY LOG: +! 91-05-07 IREDELL +! 94-12-30 IREDELL EXPAND TABLE +! 96-02-19 HONG ICE EFFECT +! 01-11-29 JIN MODIFIED FOR WRF +! +! USAGE: CALL GPVS_hr +! +! SUBPROGRAMS CALLED: +! (FPVSX) - INLINABLE FUNCTION TO COMPUTE SATURATION VAPOR PRESSURE +! +! ATTRIBUTES: +! LANGUAGE: FORTRAN 90 +! +!$$$ + IMPLICIT NONE + real :: X,XINC,T + integer :: JX +!---------------------------------------------------------------------- + XINC=(XMAX-XMIN)/(NX-1) + C1XPVS=1.-XMIN/XINC + C2XPVS=1./XINC + C1XPVS0=1.-XMIN/XINC + C2XPVS0=1./XINC +! + DO JX=1,NX + X=XMIN+(JX-1)*XINC + T=X + TBPVS(JX)=FPVSX(T) + TBPVS0(JX)=FPVSX0(T) + ENDDO +! + END SUBROUTINE GPVS_hr +!----------------------------------------------------------------------- +!*********************************************************************** +!----------------------------------------------------------------------- + REAL FUNCTION FPVS(T) +!----------------------------------------------------------------------- +!$$$ SUBPROGRAM DOCUMENTATION BLOCK +! . . . +! SUBPROGRAM: FPVS COMPUTE SATURATION VAPOR PRESSURE +! AUTHOR: N PHILLIPS W/NP2 DATE: 30 DEC 82 +! +! ABSTRACT: COMPUTE SATURATION VAPOR PRESSURE FROM THE TEMPERATURE. +! A LINEAR INTERPOLATION IS DONE BETWEEN VALUES IN A LOOKUP TABLE +! COMPUTED IN GPVS. SEE DOCUMENTATION FOR FPVSX FOR DETAILS. +! INPUT VALUES OUTSIDE TABLE RANGE ARE RESET TO TABLE EXTREMA. +! THE INTERPOLATION ACCURACY IS ALMOST 6 DECIMAL PLACES. +! ON THE CRAY, FPVS IS ABOUT 4 TIMES FASTER THAN EXACT CALCULATION. +! THIS FUNCTION SHOULD BE EXPANDED INLINE IN THE CALLING ROUTINE. +! +! PROGRAM HISTORY LOG: +! 91-05-07 IREDELL MADE INTO INLINABLE FUNCTION +! 94-12-30 IREDELL EXPAND TABLE +! 96-02-19 HONG ICE EFFECT +! 01-11-29 JIN MODIFIED FOR WRF +! +! USAGE: PVS=FPVS(T) +! +! INPUT ARGUMENT LIST: +! T - REAL TEMPERATURE IN KELVIN +! +! OUTPUT ARGUMENT LIST: +! FPVS - REAL SATURATION VAPOR PRESSURE IN KILOPASCALS (CB) +! +! ATTRIBUTES: +! LANGUAGE: FORTRAN 90 +!$$$ + IMPLICIT NONE + real,INTENT(IN) :: T + real XJ + integer :: JX +!----------------------------------------------------------------------- + IF (T>=XMIN .AND. T<=XMAX) THEN + XJ=MIN(MAX(C1XPVS+C2XPVS*T,1.),FLOAT(NX)) + JX=MIN(XJ,NX-1.) + FPVS=TBPVS(JX)+(XJ-JX)*(TBPVS(JX+1)-TBPVS(JX)) + ELSE IF (T>XMAX) THEN +!-- Magnus Tetens formula for water saturation (Murray, 1967) +! (saturation vapor pressure in kPa) + FPVS=0.61078*exp(17.2694*(T-273.16)/(T-35.86)) + ELSE +!-- Magnus Tetens formula for ice saturation(Murray, 1967) +! (saturation vapor pressure in kPa) + FPVS=0.61078*exp(21.8746*(T-273.16)/(T-7.66)) + ENDIF +! + END FUNCTION FPVS +!----------------------------------------------------------------------- +!----------------------------------------------------------------------- + REAL FUNCTION FPVS0(T) +!----------------------------------------------------------------------- + IMPLICIT NONE + real,INTENT(IN) :: T + real :: XJ1 + integer :: JX1 +!----------------------------------------------------------------------- + IF (T>=XMIN .AND. T<=XMAX) THEN + XJ1=MIN(MAX(C1XPVS0+C2XPVS0*T,1.),FLOAT(NX)) + JX1=MIN(XJ1,NX-1.) + FPVS0=TBPVS0(JX1)+(XJ1-JX1)*(TBPVS0(JX1+1)-TBPVS0(JX1)) + ELSE +!-- Magnus Tetens formula for water saturation (Murray, 1967) +! (saturation vapor pressure in kPa) + FPVS0=0.61078*exp(17.2694*(T-273.16)/(T-35.86)) + ENDIF +! + END FUNCTION FPVS0 +!----------------------------------------------------------------------- +!*********************************************************************** +!----------------------------------------------------------------------- + REAL FUNCTION FPVSX(T) +!----------------------------------------------------------------------- +!$$$ SUBPROGRAM DOCUMENTATION BLOCK +! . . . +! SUBPROGRAM: FPVSX COMPUTE SATURATION VAPOR PRESSURE +! AUTHOR: N PHILLIPS W/NP2 DATE: 30 DEC 82 +! +! ABSTRACT: EXACTLY COMPUTE SATURATION VAPOR PRESSURE FROM TEMPERATURE. +! THE WATER MODEL ASSUMES A PERFECT GAS, CONSTANT SPECIFIC HEATS +! FOR GAS AND LIQUID, AND NEGLECTS THE VOLUME OF THE LIQUID. +! THE MODEL DOES ACCOUNT FOR THE VARIATION OF THE LATENT HEAT +! OF CONDENSATION WITH TEMPERATURE. THE ICE OPTION IS NOT INCLUDED. +! THE CLAUSIUS-CLAPEYRON EQUATION IS INTEGRATED FROM THE TRIPLE POINT +! TO GET THE FORMULA +! PVS=PSATK*(TR**XA)*EXP(XB*(1.-TR)) +! WHERE TR IS TTP/T AND OTHER VALUES ARE PHYSICAL CONSTANTS +! THIS FUNCTION SHOULD BE EXPANDED INLINE IN THE CALLING ROUTINE. +! +! PROGRAM HISTORY LOG: +! 91-05-07 IREDELL MADE INTO INLINABLE FUNCTION +! 94-12-30 IREDELL EXACT COMPUTATION +! 96-02-19 HONG ICE EFFECT +! 01-11-29 JIN MODIFIED FOR WRF +! +! USAGE: PVS=FPVSX(T) +! REFERENCE: EMANUEL(1994),116-117 +! +! INPUT ARGUMENT LIST: +! T - REAL TEMPERATURE IN KELVIN +! +! OUTPUT ARGUMENT LIST: +! FPVSX - REAL SATURATION VAPOR PRESSURE IN KILOPASCALS (CB) +! +! ATTRIBUTES: +! LANGUAGE: FORTRAN 90 +!$$$ + IMPLICIT NONE +!----------------------------------------------------------------------- + real, parameter :: TTP=2.7316E+2,HVAP=2.5000E+6,PSAT=6.1078E+2 & + , CLIQ=4.1855E+3,CVAP= 1.8460E+3 & + , CICE=2.1060E+3,HSUB=2.8340E+6 +! + real, parameter :: PSATK=PSAT*1.E-3 + real, parameter :: DLDT=CVAP-CLIQ,XA=-DLDT/RV,XB=XA+HVAP/(RV*TTP) + real, parameter :: DLDTI=CVAP-CICE & + , XAI=-DLDTI/RV,XBI=XAI+HSUB/(RV*TTP) + real T,TR +!----------------------------------------------------------------------- + TR=TTP/T +! + IF(T.GE.TTP)THEN + FPVSX=PSATK*(TR**XA)*EXP(XB*(1.-TR)) + ELSE + FPVSX=PSATK*(TR**XAI)*EXP(XBI*(1.-TR)) + ENDIF +! + END FUNCTION FPVSX +!----------------------------------------------------------------------- +!----------------------------------------------------------------------- + REAL FUNCTION FPVSX0(T) +!----------------------------------------------------------------------- + IMPLICIT NONE + real,parameter :: TTP=2.7316E+2,HVAP=2.5000E+6,PSAT=6.1078E+2 & + , CLIQ=4.1855E+3,CVAP=1.8460E+3 & + , CICE=2.1060E+3,HSUB=2.8340E+6 + real,PARAMETER :: PSATK=PSAT*1.E-3 + real,PARAMETER :: DLDT=CVAP-CLIQ,XA=-DLDT/RV,XB=XA+HVAP/(RV*TTP) + real,PARAMETER :: DLDTI=CVAP-CICE & + , XAI=-DLDT/RV,XBI=XA+HSUB/(RV*TTP) + real :: T,TR +!----------------------------------------------------------------------- + TR=TTP/T + FPVSX0=PSATK*(TR**XA)*EXP(XB*(1.-TR)) +! + END FUNCTION FPVSX0 + +! + END MODULE module_mp_fer_hires diff --git a/physics/module_MYJPBL_wrapper.F90 b/physics/module_MYJPBL_wrapper.F90 new file mode 100644 index 000000000..e28cf5e69 --- /dev/null +++ b/physics/module_MYJPBL_wrapper.F90 @@ -0,0 +1,793 @@ +!> \file module_myjpbl_wrapper.F90 +!! Contains all of the code related to running the MYJ PBL scheme + + MODULE myjpbl_wrapper + + USE machine, only: kfpt => kind_phys, & + kind_phys + + contains + + subroutine myjpbl_wrapper_init () + end subroutine myjpbl_wrapper_init + + subroutine myjpbl_wrapper_finalize () + end subroutine myjpbl_wrapper_finalize + +!! +!> \brief This scheme (1) performs pre-myjpbl work, (2) runs the myjpbl, and (3) performs post-myjpbl work +!! \section arg_table_myjpbl_wrapper_run Argument Table +!! \htmlinclude myjpbl_wrapper_run.html +!! +!###=================================================================== + SUBROUTINE myjpbl_wrapper_run( & + & restart,do_myjsfc, & + & ix,im,levs,dt_phs, & + & kdt,ntrac,ntke, & + & ntcw,ntiw,ntrw,ntsw,ntgl, & + & ugrs, vgrs, tgrs, qgrs, & + & prsl, prsi, phii, hprime1, & + & prsik_1, prslk_1, prslki, tsfc, qsfc, & + & phy_myj_qsfc, phy_myj_thz0, phy_myj_qz0, & + & phy_myj_uz0, phy_myj_vz0, phy_myj_z0base, & + & phy_myj_akhs, phy_myj_akms, & + & phy_myj_chkqlm, phy_myj_elflx, & + & phy_myj_a1u, phy_myj_a1t, phy_myj_a1q, & + & pblh, kpbl, kinver, slmsk, & + & garea, ustar, cm, ch, wind, & + & snowd, zorl, evap, hflx, & + & dudt, dvdt, dtdt, dqdt, & + & dusfc,dvsfc,dtsfc,dqsfc, & + & dkt,xkzm_m, xkzm_h,xkzm_s, gamt,gamq, & + & con_cp,con_g,con_rd, & + & me, lprnt, errmsg, errflg ) + +! + + use MODULE_BL_MYJPBL, only: MYJPBL_INIT,MYJPBL + +!------------------------------------------------------------------- + implicit none + +! integer,parameter:: & +! klog=4 & ! logical variables +! ,kint=4 & ! integer variables +! !,kfpt=4 & ! floating point variables +! ,kfpt=8 & ! floating point variables +! ,kdbl=8 ! double precision + +!------------------------------------------------------------------- +! --- constant parameters: +!For reference +! real , parameter :: karman = 0.4 +! real , parameter :: g = 9.81 +! real , parameter :: r_d = 287. +! real , parameter :: cp = 7.*r_d/2. +! +! real, parameter :: g = 9.81, r_d=287., cp= 7.*r_d/2. +! real, parameter :: rd=r_d, rk=cp/rd +! real, parameter :: elwv=2.501e6, eliv=2.834e6 +! real, parameter :: reliw=eliv/elwv, + real, parameter :: xkgdx=25000.,xkzinv=0.15 + +! real, parameter :: g_inv=1./con_g, cappa=con_rd/con_cp + + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + +!MYJ-1D + integer,intent(in) :: im, ix, levs + integer,intent(in) :: kdt, me + integer,intent(in) :: ntrac,ntke,ntcw,ntiw,ntrw,ntsw,ntgl + logical,intent(in) :: restart,do_myjsfc,lprnt + real(kind=kind_phys),intent(in) :: con_cp, con_g, con_rd + real(kind=kind_phys),intent(in) :: dt_phs, xkzm_m, xkzm_h, xkzm_s + +!MYJ-2D + real(kind=kind_phys),dimension(im),intent(in) :: & + & prsik_1, prslk_1, prslki, slmsk, garea, & + snowd, evap, hflx, cm, ch, wind, hprime1 + real(kind=kind_phys),dimension(im),intent(inout) :: & + & pblh, zorl, ustar, tsfc, qsfc + real(kind=kind_phys),dimension(im),intent(inout) :: & + & phy_myj_qsfc, phy_myj_thz0, phy_myj_qz0, & + & phy_myj_uz0, phy_myj_vz0, phy_myj_z0base, & + & phy_myj_akhs, phy_myj_akms, & + & phy_myj_chkqlm, phy_myj_elflx, & + & phy_myj_a1u, phy_myj_a1t, phy_myj_a1q + real(kind=kind_phys),dimension(im),intent(out) :: & + & dusfc,dvsfc,dtsfc,dqsfc,gamt,gamq + integer,dimension(im),intent(out) :: kpbl + integer,dimension(im),intent(in) :: kinver + +!MYJ-3D + real(kind=kind_phys),dimension(im,levs+1),intent(in) :: & + phii, prsi + real(kind=kind_phys),dimension(im,levs),intent(in) :: & + & ugrs, vgrs, tgrs, prsl +! real(kind=kind_phys),dimension(im,levs),intent(inout) :: & +! dudt, dvdt, dtdt, dkt + real(kind=kind_phys),dimension(im,levs),intent(inout) :: & + dudt, dvdt, dtdt + real(kind=kind_phys),dimension(im,levs-1),intent(out) :: & + dkt + +!MYJ-4D + real(kind=kind_phys),dimension(im,levs,ntrac),intent(inout) :: & + & qgrs,dqdt + +!LOCAL + integer :: ntsd, k, k1, i, kx1 + integer :: i_min, i_max, k_min, k_max + + logical :: lprnt1,lprnt2 + integer :: ict, ide, lm, me1 + real(kind=kfpt) :: dt_myj, tem, tem1, tem2, ptem + integer,dimension(im) :: kpbl_myj + real(kind=kfpt),dimension(1:levs-1):: epsl + real(kind=kfpt),dimension(1:levs):: epsq2 + real(kind=kfpt),dimension(im) :: & + xland, sice, snowd1, ht, stdh, tsk, & + ustar1,z0,pblh_myj, & + elflx,mixht,ct + real(kind=kfpt), dimension(im,levs) :: & + & u_myj, v_myj, t_myj, q_myj, th_myj, & + & cw, dz_myj, pmid, q2, exner, del + real(kind=kfpt), dimension(im,levs+1) :: pint + real(kind=kfpt),dimension(im,levs) :: & + rublten,rvblten,rthblten,rqvblten,rqcblten + real(kind=kfpt),dimension(im,levs) :: el_myj + real(kind=kfpt),dimension(im) :: & + dusfc1,dvsfc1,dtsfc1,dqsfc1 + real(kind=kfpt),dimension(im) :: thlm,qlm + real(kind=kfpt),dimension(im,13) :: phy_f2d_myj + real(kind=kfpt), dimension(im,levs) :: xcofh & + & ,xkzo,xkzmo + real(kind=kind_phys) :: g, r_d, g_inv, cappa + real(kind=kind_phys) :: thz0, qz0, a1u, a1t, a1q + real(kind=kind_phys) :: z0m, aa1u, aa1t, z1uov, z1tox + real(kind=kind_phys) :: tmax,tmin,t_myj1 + real(kind=kind_phys),dimension(im) :: & + & thsfc,sfcz,tsfc1, & + & sm,work3,wind1,work4 & + & ,rho,qfc1,gdx,xkzm_hx,xkzm_mx,tx1, tx2 +! real(kind=kind_phys), dimension(im,levs,ntrac) :: & +! & qgrs_myj + real(kind=kind_phys),dimension(im,levs) :: dkt2 + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + +! if (lprnt) then +! write(0,*)"==============================================" +! write(0,*)"in myj wrapper..." +! endif + + ntsd = kdt - 1 + + lprnt1=.false. + lprnt2=.false. + + if (lprnt1) then + if(me.eq.0)print*,'ntsd=', ntsd + end if + +!prep MYJ-only variables + + r_d = con_rd + g = con_g + g_inv = 1./con_g + cappa = con_rd/con_cp + + do i=1,im + work3(i)=prsik_1(i) / prslk_1(i) + sice(i)=slmsk(i)*0.5 + if(sice(i) < 0.7)sice(i)=0 + sm(i)=1.; if(slmsk(i) > 0.5 ) sm(i)=0. + z0(i)=zorl(i)*0.01 + xland(i)=sm(i)+1. + sfcz(i)=phii(i,1)*g_inv + work4(i)=(1.e5/prsi(i,1))**cappa + thsfc(i)=tsfc(i)*work4(i) ! thsfc + enddo + + do k=1,levs + k1=levs+1-k + do i=1,im + u_myj(i,k)=ugrs(i,k1) + v_myj(i,k)=vgrs(i,k1) + t_myj(i,k)=tgrs(i,k1) + q_myj(i,k)=qgrs(i,k1,1) + cw(i,k) =qgrs(i,k1,ntcw) +! if(ntrw.gt.0)cw(i,k) = cw(i,k) + qgrs(i,k1,ntrw) +! if(ntiw.gt.0)cw(i,k) = cw(i,k) + qgrs(i,k1,ntiw) +! if(ntsw.gt.0)cw(i,k) = cw(i,k) + qgrs(i,k1,ntsw) +! if(ntgl.gt.0)cw(i,k) = cw(i,k) + qgrs(i,k1,ntgl) + if(ntke.gt.0)then + q2(i,k) =max(0.02,qgrs(i,k1,ntke)*2.) + else + q2(i,k) =0.02 + end if +! fmid(i,k) =phil(i,k1) + pmid(i,k) =prsl(i,k1) + exner(i,k)=(prsl(i,k1)*1.e-5)**cappa + th_myj(i,k)=tgrs(i,k1)/exner(i,k) + end do + end do + do k=1,levs+1 + k1=levs+2-k + do i=1,im + pint(i,k) =prsi(i,k1) + end do + end do + + do i=1,im + gdx(i) = sqrt(garea(i)) + enddo + + do i=1,im + kx1 = 1 + tx1(i) = 1.0 / prsi(i,1) + tx2(i) = tx1(i) + if(gdx(i) >= xkgdx) then + xkzm_hx(i) = xkzm_h + xkzm_mx(i) = xkzm_m + else + tem = 1. / (xkgdx - 5.) + tem1 = (xkzm_h - 0.01) * tem + tem2 = (xkzm_m - 0.01) * tem + ptem = gdx(i) - 5. + xkzm_hx(i) = 0.01 + tem1 * ptem + xkzm_mx(i) = 0.01 + tem2 * ptem + endif + enddo + xkzo = 0.0 + xkzmo = 0.0 + do k = 1,levs-1 + do i=1,im + if (k < kinver(i)) then +! vertical background diffusivity + ptem = prsi(i,k+1) * tx1(i) + tem1 = 1.0 - ptem + tem1 = tem1 * tem1 * 10.0 + xkzo(i,k) = xkzm_hx(i) * min(1.0, exp(-tem1)) + xkzo(i,k) = min(xkzo(i,k),xkzinv) +! vertical background diffusivity for momentum + if (ptem >= xkzm_s) then + xkzmo(i,k) = xkzm_mx(i) + kx1 = k + 1 + else + if (k == kx1 .and. k > 1) tx2(i) = 1.0 / prsi(i,k) + tem1 = 1.0 - prsi(i,k+1) * tx2(i) + tem1 = tem1 * tem1 * 5.0 + xkzmo(i,k) = xkzm_mx(i) * min(1.0, exp(-tem1)) + xkzmo(i,k) = min(xkzmo(i,k),xkzinv) + endif + endif + enddo + enddo + +! change vertical coordinate + do k=1,levs + k1=levs+1-k + do i=1,im + xcofh(i,k1)=xkzo(i,k) ! temp use xcofh + el_myj(i,k1)=xkzmo(i,k) ! temp use EL_MYJ + end do + end do + + do k=1,levs + do i=1,im + xkzo(i,k)=xcofh(i,k) + xkzmo(i,k)=el_myj(i,k) + end do + end do + + do k=1,levs-1 + epsq2(k)=0.02 + epsl(k)=sqrt(epsq2(k)*0.5) +! if (xkzo(i,k) .gt. 0.01) then +! epsl(k)=1.0 +! end if + end do + epsq2(levs)=epsq2(levs-1) + + do k = 1, levs + k1 = levs-k+1 + do i = 1, im + del(i,k) = prsi(i,k1) - prsi (i,k1+1) + dz_myj(i,k) = (phii(i,k1+1)-phii(i,k1)) * g_inv + enddo + enddo + + do i = 1, im + wind1(i)=max(wind(i),1.0) + end do + + if(.not.do_myjsfc)then + do i=1,im + if(sm(i).gt.0.5.and.sice(i).le.0.5) then + z0m=max(0.018*g_inv*ustar(i)*ustar(i),1.59E-5) + z1uov=0.35*30.*sqrt(sqrt(z0m*ustar(i)/1.5E-5))/ustar(i) + aa1u=cm(i)*wind1(i)*z1uov + a1u=aa1u/(1.-aa1u) + z1tox=0.84*z1uov + aa1t=ch(i)*wind1(i)*z1tox + a1t=aa1t/(1.-aa1t) +! +! a1u=0.3 +! a1t=0.25 +! + a1q=a1t + else + z0m=zorl(i)*0.01 + a1u=0. + a1t=0. + a1q=0. + end if + phy_myj_a1u(i) = a1u + phy_myj_a1t(i) = a1t + phy_myj_a1q(i) = a1q + phy_myj_akhs(i) = ch(i)*wind1(i)*(1.+a1t) + phy_myj_akms(i) = cm(i)*wind1(i)*(1.+a1u) + phy_myj_uz0(i) = u_myj(i,levs)*a1u/(1.+a1u) + phy_myj_vz0(i) = v_myj(i,levs)*a1u/(1.+a1u) + phy_myj_z0base(i)= z0m + + if(ntsd.eq.0)then +! if(sm(i).gt.0.5)then + qz0=max(evap(i)/phy_myj_akhs(i)+q_myj(i,levs),1.e-9) + thz0=hflx(i)/phy_myj_akhs(i)+th_myj(i,levs) +! else +! if(sice(i).gt.0.5)then +! qsfc(i)=qss_ice(i) +! else +! qsfc(i)=qss_land(i) +! end if +! endif + phy_myj_thz0(i) = thz0 + phy_myj_qz0(i) = qz0 + end if + if(cw(i,levs).gt.1.e-9)then + phy_myj_chkqlm(i)= 0. + else + phy_myj_chkqlm(i)= 1. + end if + end do + end if + + if(do_myjsfc)then + do i=1,im + phy_myj_akhs(i)=phy_myj_akhs(i)*wind1(i)/wind(i) + phy_myj_akms(i)=phy_myj_akms(i)*wind1(i)/wind(i) + end do + end if + +! update qsfc, thz0, qz0 and elflx after Land/Ocean model. + do i=1,im + phy_myj_elflx(i) = evap(i) + qsfc(i)=max(evap(i)/(ch(i)*wind1(i))+q_myj(i,levs),1.e-9) + tsfc1(i)=(hflx(i)/(ch(i)*wind1(i))+th_myj(i,levs))/work4(i) + phy_myj_qsfc(i) = qsfc(i) + thz0 = phy_myj_thz0(i) + thlm(i)=th_myj(i,levs) + qlm(i)=q_myj(i,levs) +! a1t=phy_myj_a1t(i) +! thsfc(i)=hflx(i)/phy_myj_akhs(i)+th_myj(i,levs) +! phy_myj_thz0(i)=((a1t*thlm(i)+thsfc(i))/(a1t+1.)+thz0)*0.5 ! thz0 + phy_myj_thz0(i)=0.5*(thz0+ & + hflx(i)/phy_myj_akhs(i)+th_myj(i,levs)) +! a1q=phy_myj_a1q(i) + qz0=phy_myj_qz0(i) +! phy_myj_qz0(i) = ((a1q*q_myj(i,levs)+qsfc(i))/(a1q+1.)+qz0)*0.5 + phy_myj_qz0(i) = 0.5*(qz0+ & + max(evap(i)/phy_myj_akhs(i)+q_myj(i,levs),1.e-9)) + enddo + + rthblten = 0. + rqvblten = 0. + rqcblten= 0. + rublten = 0. + rvblten = 0. +! rtrblten= 0. + xcofh=0. + kpbl(:)=levs-1 + ict=1 ! no longer used + + if (lprnt1) then + + if (me.eq.0.and.ntsd.lt.2)then + print*,'Qingfu test starts PBL' + print*,'ntsd,me,im,levs,ict=',ntsd,me,im,levs,ict + print*,'dt_phs,sfcz,dz_myj=',dt_phs,sfcz(1),dz_myj(1,5) + print*,'pmid,pint,th_myj=',pmid(1,5),pint(1,5),th_myj(1,5) + print*,'t_myj,exner,q_myj=',t_myj(1,5),exner(1,5),q_myj(1,5) + print*,'cw,u_myj,v_myj=',cw(1,5),u_myj(1,5),v_myj(1,5) + print*,'tsfc,xland,sice,snowd=',tsfc(1),xland(1),sice(1),snowd(1) + print*,'ustar,z0,pblh,kpbl=',ustar(1),z0(1),pblh(1),kpbl(1) + print*,'q2,xcofh=',q2(1,5),xcofh(1,5) +! print*,'Tbd%phy_f2d_myj(1,1-5)=',(Tbd%phy_f2d_myj(1,i),i=1,5) +! print*,'Tbd%phy_f2d_myj(1,6-10)=',(Tbd%phy_f2d_myj(1,i),i=6,10) +! print*,'Tbd%phy_f2d_myj(1,11-13)=',(Tbd%phy_f2d_myj(1,i),i=11,13) + print*,'thlm,thsfc=',thlm(i),thsfc(i) + end if + + do k=1,levs + do i=1,im + if(t_myj(i,k).gt.390..or.t_myj(i,k).lt.110.)then + print*,'Qingfu test starts PBL',i,k,t_myj(i,k) + print*,'ntsd,me,im,levs,ict=',ntsd,me,im,levs,ict + print*,'dt_phs,sfcz,dz_myj=',dt_phs,sfcz(i),dz_myj(i,k) + print*,'pmid,pint,th_myj=',pmid(i,k),pint(i,k),th_myj(i,k) + print*,'t_myj,exner,q_myj=',t_myj(i,k),exner(i,k),q_myj(i,k) + print*,'cw,u_myj,v_myj=',cw(i,k),u_myj(i,k),v_myj(i,k) + print*,'tsfc,xland,sice,snowd=',tsfc(i),xland(i),sice(i),snowd(i) + print*,'ustar,z0,pblh,kpbl=',ustar(i),z0(i),pblh(i),kpbl(i) + print*,'q2,xcofh=',q2(i,k),xcofh(i,k) + end if + end do + end do + + tmax=-1.e-5 + tmin=1.e5 + do k=1,levs + k1=levs+1-k + do i=1,im + if(tmax.lt.t_myj(i,k1))then + tmax=t_myj(i,k1) + i_max=i + k_max=k + end if + if(tmin.gt.t_myj(i,k1))then + tmin=t_myj(i,k1) + i_min=i + k_min=k + end if + end do + end do +! print*,'before i_min,k_min,i_max,k_max=',i_min,k_min,i_max,k_max +! print*,'ntsd,me,tmin,tmax=',ntsd,me,tmin,tmax +! if(me.eq.me1.and.tmin.lt.113.6.or.tmax.gt.350.)then +! i=i_max +! print*,'before bad bad tmin,tmax=',tmin,tmax,i_min,k_min,i_max,k_max +! print*,'ntsd,me,tmin,tmax=',ntsd,me,tmin,tmax +! end if + + end if + + ct=0. + ide=im + lm=levs + dt_myj=dt_phs + do i=1,im + ustar1(i)=ustar(i) + ht(i)=phii(i,1)*g_inv + stdh(i)=hprime1(i) + tsk(i)=tsfc(i) + snowd1(i)=snowd(i) + phy_f2d_myj(i,1) = phy_myj_qsfc(i) + phy_f2d_myj(i,2) = phy_myj_thz0(i) + phy_f2d_myj(i,3) = phy_myj_qz0(i) + phy_f2d_myj(i,4) = phy_myj_uz0(i) + phy_f2d_myj(i,5) = phy_myj_vz0(i) + phy_f2d_myj(i,6) = phy_myj_z0base(i) + phy_f2d_myj(i,7) = phy_myj_akhs(i) + phy_f2d_myj(i,8) = phy_myj_akms(i) + phy_f2d_myj(i,9) = phy_myj_chkqlm(i) + phy_f2d_myj(i,10) = phy_myj_elflx(i) + phy_f2d_myj(i,11) = phy_myj_a1u(i) + phy_f2d_myj(i,12) = phy_myj_a1t(i) + phy_f2d_myj(i,13) = phy_myj_a1q(i) +! do k=1,13 +! phy_f2d_myj(i,k)=Tbd%phy_f2d_myj(i,k) +! end do + end do + +! do i = 1, im +! rho(i) = prsl(i,1)/(r_d*tgrs(i,1) & +! *(0.608*qgrs(i,1,1)+1.-qgrs(i,1,ntcw))) +! if(sm(i).lt.0.5)then +! qfc1(i)=elwv*rho(i) +! if(snowd(i).gt.0..or.sice(i).gt.0.5)then +! qfc1(i)=qfc1(i)*reliw +! end if +! else +! qfc1(i)=elwv*rho(i) +! end if +! phy_f2d_myj(i,10)=qfc1(i)*phy_f2d_myj(i,10) ! convert units +! end do + + if(ntsd.eq.0.or.restart)then + if(.not.restart) xcofh=0. + call MYJPBL_INIT( & + 1,ide,1,1,lm, & + 1,ide,1,1, & + 1,ide,1,1) + end if + + call MYJPBL(ntsd,me,dt_myj,epsl,epsq2,ht,stdh,dz_myj,del & + ,pmid,pint,th_myj,t_myj,exner,q_myj,cw,u_myj,v_myj & + ,tsk,phy_f2d_myj(1:im,1),phy_f2d_myj(1:im,9) & + ,phy_f2d_myj(1:im,2),phy_f2d_myj(1:im,3) & + ,phy_f2d_myj(1:im,4),phy_f2d_myj(1:im,5) & + ,xland,sice,snowd1 & + ,q2,xcofh,ustar1,z0,el_myj,pblh_myj,kpbl_myj,ct & + ,phy_f2d_myj(1:im,7),phy_f2d_myj(1:im,8) & + ,phy_f2d_myj(1:im,10),mixht,thlm,qlm & + ,rublten,rvblten,rthblten,rqvblten,rqcblten & + ,dusfc1,dvsfc1,dtsfc1,dqsfc1,xkzo,xkzmo,ict & + ,1,ide,1,1 & + ,1,ide,1,1 & + ,1,ide,1,1,lm) + + do i=1,im + zorl(i)=z0(i)*100. + dusfc(i)=dusfc1(i) + dvsfc(i)=dvsfc1(i) + dtsfc(i)=dtsfc1(i) + dqsfc(i)=dqsfc1(i) + pblh(i)=pblh_myj(i) + kpbl(i)=levs-kpbl_myj(i) +! ustar(i)=ustar1(i) + phy_myj_qsfc(i) = phy_f2d_myj(i,1) + phy_myj_thz0(i) = phy_f2d_myj(i,2) + phy_myj_qz0(i) = phy_f2d_myj(i,3) + phy_myj_uz0(i) = phy_f2d_myj(i,4) + phy_myj_vz0(i) = phy_f2d_myj(i,5) + phy_myj_z0base(i) = phy_f2d_myj(i,6) + phy_myj_akhs(i) = phy_f2d_myj(i,7) + phy_myj_akms(i) = phy_f2d_myj(i,8) + phy_myj_chkqlm(i) = phy_f2d_myj(i,9) + phy_myj_elflx(i) = phy_f2d_myj(i,10) + phy_myj_a1u(i) = phy_f2d_myj(i,11) + phy_myj_a1t(i) = phy_f2d_myj(i,12) + phy_myj_a1q(i) = phy_f2d_myj(i,13) +! do k=1,13 +! Tbd%phy_f2d_myj(i,k)=phy_f2d_myj(i,k) +! end do + end do + + dkt2=0. + do k=1,levs + k1=levs-k+1 + do i=1,im +! dkt2(i,k)=max(xcofh(i,k1),xkzo(i,k)) + dkt2(i,k)=xcofh(i,k1) + end do + end do + if(ntke.gt.0)then + do k=1,levs + k1=levs+1-k + qgrs(:,k,ntke)=q2(:,k1)*0.5 + end do + end if + gamt=0. + gamq=0. + + do k=1,levs + k1=levs+1-k + do i=1,im + dudt(i,k)=dudt(i,k)+rublten(i,k1) + dvdt(i,k)=dvdt(i,k)+rvblten(i,k1) + dtdt(i,k)=dtdt(i,k)+rthblten(i,k1)*exner(i,k1) + dqdt(i,k,1)=dqdt(i,k,1)+rqvblten(i,k1) + dqdt(i,k,ntcw)=dqdt(i,k,ntcw)+rqcblten(i,k1) + end do + end do + + if (lprnt1) then + + do i=1,im + if(tsfc(i).gt.350.)then + print*,'21tsfc,tsfc1,hflx=',tsfc(i),tsfc1(i),hflx(i) + print*,'21qsfc,evap=',qsfc(i),evap(i) + end if + end do + tmax=-1.e-5 + tmin=1.e5 + do k=1,levs + k1=levs+1-k + do i=1,im +! t_myj1=t_myj(i,k1)+rthblten(i,k1)*exner(i,k1)*dt_phs + t_myj1=t_myj(i,k1)+dtdt(i,k)*dt_phs + if(tmax.lt.t_myj1)then + tmax=t_myj1 + i_max=i + k_max=k + me1=me + end if + if(tmin.gt.t_myj1)then + tmin=t_myj1 + i_min=i + k_min=k + end if + end do + end do +! print*,'2after i_min,k_min,i_max,k_max=',i_min,k_min,i_max,k_max +! print*,'ntsd,me,tmin,tmax=',ntsd,me,tmin,tmax + + if(me.eq.me1.and.tmin.lt.113.6.or.tmax.gt.350.)then + i=i_max + print*,'bad bad tmin,tmax=',tmin,tmax,i_min,k_min,i_max,k_max + + do k=1,levs + print*,'delt,t_myj=',k,dtdt(i,k)*dt_phs,tgrs(i,k) + end do + + print*,'ide,levs,ntsd=',ide,lm,ntsd,dt_myj + print*,'epsl,epsq2,ht,stdh,xland,sice,snowd1=', & + epsl(I),epsq2(I),ht(I),stdh(I),xland(I),sice(I),snowd1(I) + print*,'phy_f2d_myj=', & + (phy_f2d_myj(i,k),k=1,13) + print*,'tsk(i),ustar1,z0,pblh_myj,kpbl_myj=', & + tsk(i),ustar1(i),z0(i),pblh_myj(i),kpbl_myj(i) + print*,'mixht=',mixht(i) + do k=1,levs + print*,'u,v,t=',k,u_myj(i,k),v_myj(i,k), & + t_myj(i,k) + end do + do k=1,levs + print*,'q,th,dz_myj=',k,q_myj(i,k),TH_MYJ(i,k),dz_myj(i,k) + end do + do k=1,levs + print*,'del,pmid,pint,=',k,del(i,k), & + pmid(i,k),pint(i,K+1) + end do + do k=1,levs + print*,'exner,cw,q2=',k,exner(i,k),cw(i,k), & + q2(i,k) + end do + do k=1,levs + print*,'xcofh,el_myj,dkt2=',k,xcofh(i,k),el_myj(i,k),dkt2(i,k) + end do + end if + + end if ! lprnt1 + + if (lprnt2) then + + tmax=-1.e-5 + tmin=1.e5 + do k=1,levs + k1=levs+1-k + do i=1,im +! t_myj1=t_myj(i,k1)+rthblten(i,k1)*exner(i,k1)*dt_phs + t_myj1=t_myj(i,k1)+dtdt(i,k)*dt_phs + if(tmax.lt.t_myj1)then + tmax=t_myj1 + i_max=i + k_max=k + me1=me + end if + if(tmin.gt.t_myj1)then + tmin=t_myj1 + i_min=i + k_min=k + end if + end do + end do + print*,'2after me i_min,k_min,i_max,k_max=',me,i_min,k_min,i_max,k_max + print*,'ntsd,tmin,tmax=',ntsd,tmin,tmax + print*,'dtdt(i,j)=',dtdt(i_max,k_max)*dt_phs,t_myj(i_max,k_max) + + tmax=-1.e-5 + tmin=1.e5 + do k=1,levs + k1=levs+1-k + do i=1,im +! t_myj1=t_myj(i,k1)+rthblten(i,k1)*exner(i,k1)*dt_phs + t_myj1=ugrs(i,k)+dudt(i,k)*dt_phs +! t_myj1=dudt(i,k)*dt_phs + if(tmax.lt.t_myj1)then + tmax=t_myj1 + i_max=i + k_max=k + end if + if(tmin.gt.t_myj1)then + tmin=t_myj1 + i_min=i + k_min=k + end if + end do + end do + print*,'3after i_min,k_min,i_max,k_max=',i_min,k_min,i_max,k_max + print*,'ntsd,me,tmin,tmax=',ntsd,me,tmin,tmax + print*,'dudt(i,k)=',dudt(i_max,k_max)*dt_phs,ugrs(i_max,k_max) + + if(tmax.gt.200.or.tmin.lt.-200)then + print*,'bad,bad,bad=',dudt(i_max,k_max)*dt_phs,ugrs(i_max,k_max) + do k=1,levs + print*,'k,dudt*dt_phs,ugrs=',k,dudt(i_max,k)*dt_phs,ugrs(i_max,k) + end do + end if + + tmax=-1.e-5 + tmin=1.e5 + do k=1,levs + k1=levs+1-k + do i=1,im +! t_myj1=t_myj(i,k1)+rthblten(i,k1)*exner(i,k1)*dt_phs + t_myj1=vgrs(i,k)+dvdt(i,k)*dt_phs +! t_myj1=dvdt(i,k)*dt_phs + if(tmax.lt.t_myj1)then + tmax=t_myj1 + i_max=i + k_max=k + end if + if(tmin.gt.t_myj1)then + tmin=t_myj1 + i_min=i + k_min=k + end if + end do + end do + print*,'4after i_min,k_min,i_max,k_max=',i_min,k_min,i_max,k_max + print*,'ntsd,me,tmin,tmax=',ntsd,me,tmin,tmax + print*,'dvdt(i,k)=',dvdt(i_max,k_max)*dt_phs,vgrs(i_max,k_max) + + tmax=-1.e-5 + tmin=1.e5 + do k=1,levs + k1=levs+1-k + do i=1,im +! t_myj1=q_myj(i,k1)+rthblten(i,k1)*exner(i,k1)*dt_phs + t_myj1=q_myj(i,k1)+dqdt(i,k,1)*dt_phs +! t_myj1=dqdt(i,k,1)*dt_phs + if(tmax.lt.t_myj1)then + tmax=t_myj1 + i_max=i + k_max=k + end if + if(tmin.gt.t_myj1)then + tmin=t_myj1 + i_min=i + k_min=k + end if + end do + end do + print*,'5after i_min,k_min,i_max,k_max=',i_min,k_min,i_max,k_max + print*,'ntsd,me,tmin,tmax=',ntsd,me,tmin,tmax + print*,'dqdt(i,k)=',dqdt(i_max,k_max,1)*dt_phs,qgrs(i_max,k_max,1) + + tmax=-1.e-5 + tmin=1.e5 + do k=1,levs + k1=levs+1-k + do i=1,im +! t_myj1=t_myj(i,k1)+rthblten(i,k1)*exner(i,k1)*dt_phs + t_myj1=cw(i,k1)+dqdt(i,k,ntcw)*dt_phs +! t_myj1=dqdt(i,k,ntcw)*dt_phs + if(tmax.lt.t_myj1)then + tmax=t_myj1 + i_max=i + k_max=k + end if + if(tmin.gt.t_myj1)then + tmin=t_myj1 + i_min=i + k_min=k + end if + end do + end do + print*,'6after i_min,k_min,i_max,k_max=',i_min,k_min,i_max,k_max + print*,'ntsd,me,tmin,tmax=',ntsd,me,tmin,tmax + print*,'dqdt(i,k,ntcw)=',dqdt(i_max,k_max,ntcw)*dt_phs,qgrs(i_max,k_max,ntcw) + + end if ! lprnt2 + +! if (lprnt) then +! print* +! print*,"===Finished with myj_bl_driver; output:" +! print* +! endif + + ! External dkt has dimensions (1:im,1:levs-1) + dkt(1:im,1:levs-1) = dkt2(1:im,1:levs-1) + + END SUBROUTINE myjpbl_wrapper_run + +!###================================================================= + +END MODULE myjpbl_wrapper diff --git a/physics/module_MYJPBL_wrapper.meta b/physics/module_MYJPBL_wrapper.meta new file mode 100644 index 000000000..a70203def --- /dev/null +++ b/physics/module_MYJPBL_wrapper.meta @@ -0,0 +1,651 @@ +[ccpp-arg-table] + name = myjpbl_wrapper_run + type = scheme +[restart] + standard_name = flag_for_restart + long_name = flag for restart (warmstart) or coldstart + units = flag + dimensions = () + type = logical + intent = in + optional = F +[do_myjsfc] + standard_name = do_myjsfc + long_name = flag for MYJ surface layer scheme + units = flag + dimensions = () + type = logical + intent = in + optional = F +[ix] + standard_name = horizontal_dimension + long_name = horizontal dimension + units = count + dimensions = () + type = integer + intent = in + optional = F +[im] + standard_name = horizontal_loop_extent + long_name = horizontal loop extent + units = count + dimensions = () + type = integer + intent = in + optional = F +[levs] + standard_name = vertical_dimension + long_name = vertical layer dimension + units = count + dimensions = () + type = integer + intent = in + optional = F +[dt_phs] + standard_name = time_step_for_physics + long_name = time step for physics + units = s + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[kdt] + standard_name = index_of_time_step + long_name = current time step index + units = index + dimensions = () + type = integer + intent = in + optional = F +[ntrac] + standard_name = number_of_vertical_diffusion_tracers + long_name = number of tracers to diffuse vertically + units = count + dimensions = () + type = integer + intent = in + optional = F +[ntke] + standard_name = index_for_turbulent_kinetic_energy + long_name = tracer index for turbulent kinetic energy + units = index + dimensions = () + type = integer + intent = in + optional = F +[ntcw] + standard_name = index_for_liquid_cloud_condensate + long_name = cloud condensate index in tracer array + units = index + dimensions = () + type = integer + intent = in + optional = F +[ntiw] + standard_name = index_for_ice_cloud_condensate + long_name = tracer index for ice water + units = index + dimensions = () + type = integer + intent = in + optional = F +[ntrw] + standard_name = index_for_rain_water + long_name = tracer index for rain water + units = index + dimensions = () + type = integer + intent = in + optional = F +[ntsw] + standard_name = index_for_snow_water + long_name = tracer index for snow water + units = index + dimensions = () + type = integer + intent = in + optional = F +[ntgl] + standard_name = index_for_graupel + long_name = tracer index for graupel + units = index + dimensions = () + type = integer + intent = in + optional = F +[ugrs] + standard_name = x_wind + long_name = x component of layer wind + units = m s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[vgrs] + standard_name = y_wind + long_name = y component of layer wind + units = m s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[tgrs] + standard_name = air_temperature + long_name = layer mean air temperature + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[qgrs] + standard_name = vertically_diffused_tracer_concentration + long_name = tracer concentration diffused by PBL scheme + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension,number_of_vertical_diffusion_tracers) + type = real + kind = kind_phys + intent = in + optional = F +[prsl] + standard_name = air_pressure + long_name = mean layer pressure + units = Pa + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[prsi] + standard_name = air_pressure_at_interface + long_name = air pressure at model layer interfaces + units = Pa + dimensions = (horizontal_dimension,vertical_dimension_plus_one) + type = real + kind = kind_phys + intent = in + optional = F +[phii] + standard_name = geopotential_at_interface + long_name = geopotential at model layer interfaces + units = m2 s-2 + dimensions = (horizontal_dimension,vertical_dimension_plus_one) + type = real + kind = kind_phys + intent = in + optional = F +[hprime1] + standard_name = standard_deviation_of_subgrid_orography + long_name = standard deviation of subgrid orography + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[prsik_1] + standard_name = dimensionless_exner_function_at_lowest_model_interface + long_name = dimensionless Exner function at lowest model interface + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[prslk_1] + standard_name = dimensionless_exner_function_at_lowest_model_layer + long_name = dimensionless Exner function at lowest model layer + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[prslki] + standard_name = ratio_of_exner_function_between_midlayer_and_interface_at_lowest_model_layer + long_name = Exner function ratio bt midlayer and interface at 1st layer + units = ratio + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[tsfc] + standard_name = surface_skin_temperature + long_name = surface temperature + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[qsfc] + standard_name = surface_specific_humidity + long_name = surface air saturation specific humidity + units = kg kg-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[phy_myj_qsfc] + standard_name = surface_specific_humidity_for_MYJ_schemes + long_name = surface air saturation specific humidity for MYJ schem + units = kg kg-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[phy_myj_thz0] + standard_name = potential_temperature_at_viscous_sublayer_top + long_name = potential temperat at viscous sublayer top over water + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[phy_myj_qz0] + standard_name = specific_humidity_at_viscous_sublayer_top + long_name = specific humidity at_viscous sublayer top over water + units = kg kg-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[phy_myj_uz0] + standard_name = u_wind_component_at_viscous_sublayer_top + long_name = u wind component at viscous sublayer top over water + units = m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[phy_myj_vz0] + standard_name = v_wind_component_at_viscous_sublayer_top + long_name = v wind component at viscous sublayer top over water + units = m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[phy_myj_z0base] + standard_name = baseline_surface_roughness_length + long_name = baseline surface roughness length for momentum in mete + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[phy_myj_akhs] + standard_name = heat_exchange_coefficient_for_MYJ_schemes + long_name = surface heat exchange_coefficient for MYJ schemes + units = m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[phy_myj_akms] + standard_name = momentum_exchange_coefficient_for_MYJ_schemes + long_name = surface momentum exchange_coefficient for MYJ schemes + units = m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[phy_myj_chkqlm] + standard_name = surface_layer_evaporation_switch + long_name = surface layer evaporation switch + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[phy_myj_elflx] + standard_name = kinematic_surface_latent_heat_flux + long_name = kinematic surface latent heat flux + units = m s-1 kg kg-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[phy_myj_a1u] + standard_name = weight_for_momentum_at_viscous_sublayer_top + long_name = Weight for momentum at viscous layer top + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[phy_myj_a1t] + standard_name = weight_for_potental_temperature_at_viscous_sublayer_top + long_name = Weight for potental temperature at viscous layer top + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[phy_myj_a1q] + standard_name = weight_for_specific_humidity_at_viscous_sublayer_top + long_name = Weight for Specfic Humidity at viscous layer top + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[pblh] + standard_name = atmosphere_boundary_layer_thickness + long_name = PBL thickness + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[kpbl] + standard_name = vertical_index_at_top_of_atmosphere_boundary_layer + long_name = PBL top model level index + units = index + dimensions = (horizontal_dimension) + type = integer + intent = out + optional = F +[kinver] + standard_name = index_of_highest_temperature_inversion + long_name = index of highest temperature inversion + units = index + dimensions = (horizontal_dimension) + type = integer + intent = in + optional = F +[slmsk] + standard_name = sea_land_ice_mask_real + long_name = landmask: sea/land/ice=0/1/2 + units = flag + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[garea] + standard_name = cell_area + long_name = area of the grid cell + units = m2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[ustar] + standard_name = surface_friction_velocity + long_name = boundary layer parameter + units = m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[cm] + standard_name = surface_drag_coefficient_for_momentum_in_air + long_name = surface exchange coeff for momentum + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[ch] + standard_name = surface_drag_coefficient_for_heat_and_moisture_in_air + long_name = surface exchange coeff heat & moisture + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[wind] + standard_name = wind_speed_at_lowest_model_layer + long_name = wind speed at lowest model level + units = m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[snowd] + standard_name = surface_snow_thickness_water_equivalent + long_name = water equivalent snow depth over land + units = mm + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[zorl] + standard_name = surface_roughness_length + long_name = surface roughness length in cm + units = cm + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[hflx] + standard_name = kinematic_surface_upward_sensible_heat_flux + long_name = kinematic surface upward sensible heat flux + units = K m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[evap] + standard_name = kinematic_surface_upward_latent_heat_flux + long_name = kinematic surface upward latent heat flux + units = kg kg-1 m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[dudt] + standard_name = tendency_of_x_wind_due_to_model_physics + long_name = updated tendency of the x wind + units = m s-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[dvdt] + standard_name = tendency_of_y_wind_due_to_model_physics + long_name = updated tendency of the y wind + units = m s-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[dtdt] + standard_name = tendency_of_air_temperature_due_to_model_physics + long_name = updated tendency of the temperature + units = K s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[dqdt] + standard_name = tendency_of_vertically_diffused_tracer_concentration + long_name = updated tendency of the tracers PBL vertical diff + units = kg kg-1 s-1 + dimensions = (horizontal_dimension,vertical_dimension,number_of_vertical_diffusion_tracers) + type = real + kind = kind_phys + intent = inout + optional = F +[dusfc] + standard_name = instantaneous_surface_x_momentum_flux + long_name = x momentum flux + units = Pa + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[dvsfc] + standard_name = instantaneous_surface_y_momentum_flux + long_name = y momentum flux + units = Pa + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[dtsfc] + standard_name = instantaneous_surface_upward_sensible_heat_flux + long_name = surface upward sensible heat flux + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[dqsfc] + standard_name = instantaneous_surface_upward_latent_heat_flux + long_name = surface upward latent heat flux + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[dkt] + standard_name = atmosphere_heat_diffusivity + long_name = diffusivity for heat + units = m2 s-1 + dimensions = (horizontal_dimension,vertical_dimension_minus_one) + type = real + kind = kind_phys + intent = out + optional = F +[xkzm_m] + standard_name = atmosphere_momentum_diffusivity_background + long_name = background value of momentum diffusivity + units = m2 s-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[xkzm_h] + standard_name = atmosphere_heat_diffusivity_background + long_name = background value of heat diffusivity + units = m2 s-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[xkzm_s] + standard_name = diffusivity_background_sigma_level + long_name = sigma level threshold for background diffusivity + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[gamt] + standard_name = countergradient_mixing_term_for_temperature + long_name = countergradient mixing term for temperature + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[gamq] + standard_name = countergradient_mixing_term_for_water_vapor + long_name = countergradient mixing term for water vapor + units = kg kg-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[con_cp] + standard_name = specific_heat_of_dry_air_at_constant_pressure + long_name = specific heat of dry air at constant pressure + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[con_g] + standard_name = gravitational_acceleration + long_name = gravitational acceleration + units = m s-2 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[con_rd] + standard_name = gas_constant_dry_air + long_name = ideal gas constant for dry air + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[me] + standard_name = mpi_rank + long_name = current MPI-rank + units = index + dimensions = () + type = integer + intent = in + optional = F +[lprnt] + standard_name = flag_print + long_name = control flag for diagnostic print out + units = flag + dimensions = () + type = logical + intent = in + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F diff --git a/physics/module_MYJSFC_wrapper.F90 b/physics/module_MYJSFC_wrapper.F90 new file mode 100644 index 000000000..1406a99be --- /dev/null +++ b/physics/module_MYJSFC_wrapper.F90 @@ -0,0 +1,467 @@ +!> \file module_myjsfc_wrapper.F90 +!! Contains all of the code related to running the MYJ surface layer scheme + + MODULE myjsfc_wrapper + + USE machine, only: kfpt => kind_phys, & + kind_phys + + contains + + subroutine myjsfc_wrapper_init () + end subroutine myjsfc_wrapper_init + + subroutine myjsfc_wrapper_finalize () + end subroutine myjsfc_wrapper_finalize + +!! +!> \brief This scheme (1) performs pre-myjsfc work, (20 runs the myj sfc layer scheme, and (3) performs post-myjsfc work +!! \section arg_table_myjsfc_wrapper_run Argument Table +!! \htmlinclude myjsfc_wrapper_run.html +!! +!###=================================================================== + SUBROUTINE myjsfc_wrapper_run( & + & restart, & + & ix,im,levs, & + & kdt,ntrac,ntke, & + & ntcw,ntiw,ntrw,ntsw,ntgl, & + & iter,flag_iter, & + & ugrs, vgrs, tgrs, qgrs, & + & prsl, prsi, phii, & + & prsik_1, prslk_1, tsfc, qsfc, & + & phy_myj_qsfc, phy_myj_thz0, phy_myj_qz0, & + & phy_myj_uz0, phy_myj_vz0, phy_myj_z0base, & + & phy_myj_akhs, phy_myj_akms, & + & phy_myj_chkqlm, phy_myj_elflx, & + & phy_myj_a1u, phy_myj_a1t, phy_myj_a1q, & + & pblh, slmsk, zorl, ustar, rib, & + & cm,ch,stress,ffm,ffh,fm10,fh2, & + & landfrac,lakefrac,oceanfrac,fice, & + & z0rl_ocn, z0rl_lnd, z0rl_ice, & ! intent(inout) + & ustar_ocn, ustar_lnd, ustar_ice, & ! intent(inout) + & cm_ocn, cm_lnd, cm_ice, & ! intent(inout) + & ch_ocn, ch_lnd, ch_ice, & ! intent(inout) + & rb_ocn, rb_lnd, rb_ice, & ! intent(inout) + & stress_ocn,stress_lnd,stress_ice, & ! intent(inout) + & fm_ocn, fm_lnd, fm_ice, & ! intent(inout) + & fh_ocn, fh_lnd, fh_ice, & ! intent(inout) + & fm10_ocn, fm10_lnd, fm10_ice, & ! intent(inout) + & fh2_ocn, fh2_lnd, fh2_ice, & ! intent(inout) + & wind, con_cp, con_g, con_rd, & + & me, lprnt, errmsg, errflg ) ! intent(inout) +! + + use MODULE_SF_JSFC, only: JSFC_INIT,JSFC + +!------------------------------------------------------------------- + implicit none +!------------------------------------------------------------------- + +! integer,parameter:: & +! klog=4 & ! logical variables +! ,kint=4 & ! integer variables +! !,kfpt=4 & ! floating point variables +! ,kfpt=8 & ! floating point variables +! ,kdbl=8 ! double precision +! +! --- constant parameters: +! real(kind=kind_phys), parameter :: karman = 0.4 + +!------------------------------------------------------------------- +!------------------------------------------------------------------- +!For reference +! real , parameter :: karman = 0.4 +! real , parameter :: g = 9.81 +! real , parameter :: r_d = 287. +! real , parameter :: cp = 7.*r_d/2. +! real , parameter :: r_v = 461.6 +! real , parameter :: cpv = 4.*r_v +! real , parameter :: rcp = r_d/cp + +! real, parameter :: g_inv=1/g, cappa=r_d/cp + + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + +!MYJ-1D + integer,intent(in) :: im, ix, levs + integer,intent(in) :: kdt, iter, me + integer,intent(in) :: ntrac,ntke,ntcw,ntiw,ntrw,ntsw,ntgl + logical,intent(in) :: restart, lprnt + real(kind=kind_phys),intent(in) :: con_cp, con_g, con_rd + +!MYJ-2D + logical,dimension(im),intent(in) :: flag_iter + real(kind=kind_phys),dimension(im),intent(in) :: & + & prsik_1, prslk_1, tsfc, qsfc, slmsk + real(kind=kind_phys),dimension(im),intent(inout) :: & + & phy_myj_qsfc, phy_myj_thz0, phy_myj_qz0, & + & phy_myj_uz0, phy_myj_vz0, phy_myj_z0base, & + & phy_myj_akhs, phy_myj_akms, & + & phy_myj_chkqlm, phy_myj_elflx, & + & phy_myj_a1u, phy_myj_a1t, phy_myj_a1q + real(kind=kind_phys),dimension(im),intent(inout) :: & + & pblh, zorl, ustar, rib + real(kind=kind_phys),dimension(im),intent(out) :: & + & cm, ch, stress, ffm, ffh, fm10, fh2 + real(kind=kind_phys), dimension(im), intent(inout) :: & + & landfrac, lakefrac, oceanfrac, fice + real(kind=kind_phys), dimension(im), intent(inout) :: & + & z0rl_ocn, z0rl_lnd, z0rl_ice, & + & ustar_ocn, ustar_lnd, ustar_ice, & + & cm_ocn, cm_lnd, cm_ice, & + & ch_ocn, ch_lnd, ch_ice, & + & rb_ocn, rb_lnd, rb_ice, & + & stress_ocn,stress_lnd,stress_ice, & + & fm_ocn, fm_lnd, fm_ice, & + & fh_ocn, fh_lnd, fh_ice, & + & fm10_ocn, fm10_lnd, fm10_ice, & + & fh2_ocn, fh2_lnd, fh2_ice, & + & wind + + +!MYJ-3D + real(kind=kind_phys),dimension(im,levs+1),intent(in) :: & + phii, prsi + real(kind=kind_phys),dimension(im,levs),intent(in) :: & + & ugrs, vgrs, tgrs, prsl +!MYJ-4D + real(kind=kind_phys),dimension(im,levs,ntrac),intent(in) :: & + & qgrs + +!LOCAL + logical :: lprnt1, lprnt2 + integer :: ntsd, k, k1, i, n, ide, jde, kde + + real(kind=kind_phys) :: g, r_d, g_inv, cappa + real(kind=kfpt),dimension(levs) :: epsq2 + real(kind=kfpt),dimension(im) :: & + sfcz,tsk,xland,mavail,rmol, & + ustar1,z0,rib1,sm,pblh_myj + real(kind=kfpt),dimension(im,13) :: & + & phy_f2d_myj + real(kind=kfpt), dimension(im,levs) :: & + & u_myj, v_myj, t_myj, q_myj, th_myj, & + & cw, dz_myj, pmid, q2, exner + real(kind=kfpt), dimension(im,levs+1) :: pint + real(kind=kfpt),dimension(im) :: & + & cm1,ch1,stress1,ffm1,ffh1,wind1,ffm10,ffh2 +! real(kind=kind_phys), dimension(im,levs,ntrac) :: & +! & qgrs_myj + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + ntsd = kdt-1 + + lprnt1 =.false. + lprnt2 =.false. + + if (lprnt2) then + if(me.eq.0)then + print*,'in myj surface layer wrapper...' + print*,'ntsd,iter=',ntsd,iter + end if + endif + + r_d = con_rd + g = con_g + g_inv = 1./con_g + cappa = con_rd/con_cp + + if (ntsd==0.and.iter==1)then + do i=1,im + if(flag_iter(i))then + phy_myj_qsfc(i) = qgrs(i,1,1) ! qsfc(:) + phy_myj_thz0(i) = tsfc(i) ! thz0 + phy_myj_qz0(i) = qgrs(i,1,1) ! qz0(:) + phy_myj_uz0(i) = 0. ! uz0(:) + phy_myj_vz0(i) = 0. ! vz0(:) + phy_myj_z0base(i) = zorl(i)*0.01 ! z0base + phy_myj_akhs(i) = 0.01 ! akhs(:) + phy_myj_akms(i) = 0.01 ! akms(:) + phy_myj_chkqlm(i) = 0. ! chkqlm(:) + phy_myj_elflx(i) = 0. ! elflx(:) + phy_myj_a1u(i) = 0. ! a1u + phy_myj_a1t(i) = 0. ! a1t + phy_myj_a1q(i) = 0. ! a1q + end if + end do + end if + +!prep MYJ-only variables + do i=1,im + sm(i)=1.; if(slmsk(i) > 0.5 ) sm(i)=0. + xland(i)=sm(i)+1. + sfcz(i)=phii(i,1)*g_inv + enddo + + do k=1,levs + k1=levs+1-k + do i=1,im + u_myj(i,k)=ugrs(i,k1) + v_myj(i,k)=vgrs(i,k1) + t_myj(i,k)=tgrs(i,k1) + q_myj(i,k)=qgrs(i,k1,1) + cw(i,k) =qgrs(i,k1,ntcw) +! if(ntrw.gt.0)cw(i,k) = cw(i,k) + qgrs(i,k1,ntrw) +! if(ntiw.gt.0)cw(i,k) = cw(i,k) + qgrs(i,k1,ntiw) +! if(ntsw.gt.0)cw(i,k) = cw(i,k) + qgrs(i,k1,ntsw) +! if(ntgl.gt.0)cw(i,k) = cw(i,k) + qgrs(i,k1,ntgl) + if(ntke.gt.0)then + q2(i,k) =qgrs(i,k1,ntke)*2. + else + q2(i,k) =0.02 + end if + pmid(i,k) =prsl(i,k1) + exner(i,k)=(prsl(i,k1)*1.e-5)**cappa + th_myj(i,k)=tgrs(i,k1)/exner(i,k) + end do + end do + do k=1,levs+1 + k1=levs+2-k + do i=1,im + pint(i,k) =prsi(i,k1) + end do + end do + + do k = 1, levs + k1 = levs-k+1 + do i = 1, im + dz_myj(i,k) = (phii(i,k1+1)-phii(i,k1)) * g_inv + enddo + enddo + + if (lprnt1) then + if(me==0.and.ntsd.lt.2)then + k=63 + k1=levs+1-k + print*,'Qingfu starts MYJSFC' + print*,'ntsd,iter,me,1=',ntsd,iter,me + print*,'ntrac,ntcw,ntiw,ntrw,ntsw,ntgl,ntke=', & + ntrac,ntcw,ntiw,ntrw,ntsw,ntgl,ntke + print*,'im,levs,ntsd=',im,levs,ntsd + do i=10,40,40 + print*,'Qingfu before MYJ surface kdt,i,k1=',kdt,i,k1 + print*,'sfcz,dz_myj,th_myj,tsfc,qsfc=',sfcz(i),dz_myj(i,k), & + th_myj(i,k),tsfc(i),qsfc(i) + print*,'sm,z0,xland=', & + sm(i),z0(i),xland(i) +! print*,'phy_f2d_myj(i,1:13)=', & +! (phy_f2d_myj(i,n),n=1,13) + print*,'u_myj,v_myj=', & + u_myj(i,k),v_myj(i,k) + print*,'t_myj,q_myj,cw,q2=', & + t_myj(i,k),q_myj(i,k),cw(i,k),q2(i,k) + print*,'phii,pint,pmid', & + phii(i,k1),pint(i,k),pmid(i,k) + print*,'exner,th_myj=',exner(i,k),th_myj(i,k) + end do + end if + endif + +!----------------------------------------------------------------------- + ide=im+1 + jde=2 + kde=levs+1 + + do i = 1, im + epsq2(i)=0.02 + mavail(i)=1.0 + tsk(i)=tsfc(i) + phy_f2d_myj(i,1) = phy_myj_qsfc(i) + phy_f2d_myj(i,2) = phy_myj_thz0(i) + phy_f2d_myj(i,3) = phy_myj_qz0(i) + phy_f2d_myj(i,4) = phy_myj_uz0(i) + phy_f2d_myj(i,5) = phy_myj_vz0(i) + phy_f2d_myj(i,6) = phy_myj_z0base(i) + phy_f2d_myj(i,7) = phy_myj_akhs(i) + phy_f2d_myj(i,8) = phy_myj_akms(i) + phy_f2d_myj(i,9) = phy_myj_chkqlm(i) + phy_f2d_myj(i,10) = phy_myj_elflx(i) + phy_f2d_myj(i,11) = phy_myj_a1u(i) + phy_f2d_myj(i,12) = phy_myj_a1t(i) + phy_f2d_myj(i,13) = phy_myj_a1q(i) + z0(i)=zorl(i)*0.01 + rmol(i)=0. + rib1(I)=rib(i) + pblh_myj(i)=pblh(i) + ustar1(i)=ustar(i) + cm1(i)=0. + ch1(i)=0. + stress1(i)=0. + ffm1(i)=0. + ffh1(i)=0. + wind1(i)=0. + ffm10(i)=0. + ffh2(i)=0. + end do + + if((ntsd==0.and.iter.eq.1).or.restart)then + call JSFC_INIT(ustar1,restart & + & ,1,ide,1,jde,1,kde & + & ,1,im,1,1,1,levs & + & ,1,im,1,1,1,levs) + end if + + call JSFC(flag_iter,iter,me & + & ,ntsd,epsq2,sfcz,dz_myj & + & ,pmid,pint,th_myj,t_myj,q_myj,cw & + & ,u_myj,v_myj,q2,tsk & + & ,phy_f2d_myj(1:im,1),phy_f2d_myj(1:im,2) & + & ,phy_f2d_myj(1:im,3),phy_f2d_myj(1:im,4) & + & ,phy_f2d_myj(1:im,5),xland & + & ,ustar1,z0,phy_f2d_myj(1:im,6) & + & ,pblh_myj,mavail,rmol & + & ,phy_f2d_myj(1:im,7),phy_f2d_myj(1:im,8) & + & ,phy_f2d_myj(1:im,9),phy_f2d_myj(1:im,10) & + & ,rib1,cm1,ch1,stress1,ffm1,ffh1,wind1,ffm10,ffh2 & + & ,phy_f2d_myj(1:im,11),phy_f2d_myj(1:im,12) & + & ,phy_f2d_myj(1:im,13) & + & ,1,im,1,1,1,levs & + & ,1,im,1,1,1,levs & + & ,1,im,1,1,1,levs) + + do i = 1, im + if(flag_iter(i))then + zorl(i) = z0(i)*100. + + phy_myj_qsfc(i) = phy_f2d_myj(i,1) + phy_myj_thz0(i) = phy_f2d_myj(i,2) + phy_myj_qz0(i) = phy_f2d_myj(i,3) + phy_myj_uz0(i) = phy_f2d_myj(i,4) + phy_myj_vz0(i) = phy_f2d_myj(i,5) + phy_myj_z0base(i) = phy_f2d_myj(i,6) + phy_myj_akhs(i) = phy_f2d_myj(i,7) + phy_myj_akms(i) = phy_f2d_myj(i,8) + phy_myj_chkqlm(i) = phy_f2d_myj(i,9) + phy_myj_elflx(i) = - phy_f2d_myj(i,10) ! change flux definition + phy_myj_a1u(i) = phy_f2d_myj(i,11) + phy_myj_a1t(i) = phy_f2d_myj(i,12) + phy_myj_a1q(i) = phy_f2d_myj(i,13) + + rib(I)=rib1(i) + pblh(I)=pblh_myj(i) + cm(I)=cm1(i) + ch(I)=ch1(i) + stress(I)=stress1(i) + ffm(I)=ffm1(i) + ffh(I)=ffh1(i) + wind(I)=wind1(i) + fm10(I)=ffm10(i) + fh2(I)=ffh2(i) + ustar(i)=ustar1(i) + end if + end do + + if (lprnt1) then + + if(me==0.and.ntsd.lt.10)then + print*,'ntsd,iter,me,2=',ntsd,iter,me + do i=10,40,40 + if(flag_iter(i))then + print*,'Qingfu after MYJ surface kdt,i,k1=',kdt,i,k1 + print*,'xland,cm,ch=',xland(i),cm(i),ch(i) + print*,'ustar,z0,stress=',ustar(i),z0(i),stress(i) + print*,'ffm,ffh,wind,fm10,fh2=',ffm(i),ffh(i),wind(i),fm10(i),fh2(i) + print*,'phy_f2d_myj(9,1:13)=', & + (phy_f2d_myj(i,n),n=1,13) + print*,'u_myj,v_myj=', & + u_myj(i,k),v_myj(i,k) + print*,'t_myj,q_myj,cw,q2=', & + t_myj(i,k),q_myj(i,k),cw(i,k),q2(i,k) + print*,'phii,pint,pmid', & + phii(i,k1),pint(i,k),pmid(i,k) + print*,'exner,th_myj=',exner(i,k),th_myj(i,k) + print*,'Qingfu finish MYJSFC' + end if + end do + end if + + do k=1,levs + k1=levs+1-k + do i=1,im + if(t_myj(i,k).gt.320..or.t_myj(i,k).lt.150.)then + print*,'xland,cm,ch=',xland(i),cm(i),ch(i) + print*,'ustar,z0,stress=',ustar(i),z0(i),stress(i) + print*,'ffm,ffh,wind,fm10,fh2=',ffm(i),ffh(i),wind(i),fm10(i),fh2(i) + print*,'phy_f2d_myj(9,1:13)=', & + (phy_f2d_myj(i,n),n=1,13) + print*,'u_myj,v_myj=', & + u_myj(i,k),v_myj(i,k) + print*,'t_myj,q_myj,cw,q2=', & + t_myj(i,k),q_myj(i,k),cw(i,k),q2(i,k) + print*,'phii,pint,pmid', & + phii(i,k1),pint(i,k),pmid(i,k) + print*,'exner,th_myj=',exner(i,k),th_myj(i,k) + print*,'Qingfu finish MYJSFC' + end if + end do + end do + + end if + + do i = 1, im + if(flag_iter(i))then + z0rl_ocn(i) = zorl(i) + cm_ocn(i) = cm(i) + ch_ocn(i) = ch(i) + rb_ocn(i) = rib(i) + stress_ocn(i) = stress(i) + fm_ocn(i) = ffm(i) + fh_ocn(i) = ffh(i) + ustar_ocn(i) = ustar(i) + fm10_ocn(i) = fm10(i) + fh2_ocn(i) = fh2(i) + + z0rl_lnd(i) = zorl(i) + cm_lnd(i) = cm(i) + ch_lnd(i) = ch(i) + rb_lnd(i) = rib(i) + stress_lnd(i) = stress(i) + fm_lnd(i) = ffm(i) + fh_lnd(i) = ffh(i) + ustar_lnd(i) = ustar(i) + fm10_lnd(i) = fm10(i) + fh2_lnd(i) = fh2(i) + + z0rl_ice(i) = zorl(i) + cm_ice(i) = cm(i) + ch_ice(i) = ch(i) + rb_ice(i) = rib(i) + stress_ice(i) = stress(i) + fm_ice(i) = ffm(i) + fh_ice(i) = ffh(i) + ustar_ice(i) = ustar(i) + fm10_ice(i) = fm10(i) + fh2_ice(i) = fh2(i) + end if + end do + + if (lprnt2) then + if(me==0.and.ntsd.lt.10)then + print*,'ntsd,iter,me,3=',ntsd,iter,me + do i=10,40,40 + if(flag_iter(i))then + print*,'Qingfu after MYJ surface kdt,i,k1,3=',kdt,i,k1 + print*,'Qingfu test after MYJ surface kdt,i=',kdt,i,slmsk(i) + print*,'a1u,a1t,a1q=',(phy_f2d_myj(i,k),k=11,13) + print*,'zorl,cm,ch,rb,stress=',z0(i), & + cm(i),ch(i), & + rib(i),stress(i) + print*,'ffmm,ffhh,ustar,fm10,fh2,wind=', ffm(i), & + ffh(i),ustar(i),fm10(i),fh2(i),wind(i) + print*,'cm(i),ch(i)=', & + (0.4/ffm(i))**2,(0.4/ffm(i)*0.4/ffh(i)) + end if + end do + endif + endif + + + END SUBROUTINE myjsfc_wrapper_run + +!###================================================================= + +END MODULE myjsfc_wrapper diff --git a/physics/module_MYJSFC_wrapper.meta b/physics/module_MYJSFC_wrapper.meta new file mode 100644 index 000000000..8100d0b05 --- /dev/null +++ b/physics/module_MYJSFC_wrapper.meta @@ -0,0 +1,814 @@ +[ccpp-arg-table] + name = myjsfc_wrapper_run + type = scheme +[restart] + standard_name = flag_for_restart + long_name = flag for restart (warmstart) or coldstart + units = flag + dimensions = () + type = logical + intent = in + optional = F +[ix] + standard_name = horizontal_dimension + long_name = horizontal dimension + units = count + dimensions = () + type = integer + intent = in + optional = F +[im] + standard_name = horizontal_loop_extent + long_name = horizontal loop extent + units = count + dimensions = () + type = integer + intent = in + optional = F +[levs] + standard_name = vertical_dimension + long_name = vertical layer dimension + units = count + dimensions = () + type = integer + intent = in + optional = F +[kdt] + standard_name = index_of_time_step + long_name = current time step index + units = index + dimensions = () + type = integer + intent = in + optional = F +[ntrac] + standard_name = number_of_tracers + long_name = number of tracers + units = count + dimensions = () + type = integer + intent = in + optional = F +[ntke] + standard_name = index_for_turbulent_kinetic_energy + long_name = tracer index for turbulent kinetic energy + units = index + dimensions = () + type = integer + intent = in + optional = F +[ntcw] + standard_name = index_for_liquid_cloud_condensate + long_name = cloud condensate index in tracer array + units = index + dimensions = () + type = integer + intent = in + optional = F +[ntiw] + standard_name = index_for_ice_cloud_condensate + long_name = tracer index for ice water + units = index + dimensions = () + type = integer + intent = in + optional = F +[ntrw] + standard_name = index_for_rain_water + long_name = tracer index for rain water + units = index + dimensions = () + type = integer + intent = in + optional = F +[ntsw] + standard_name = index_for_snow_water + long_name = tracer index for snow water + units = index + dimensions = () + type = integer + intent = in + optional = F +[ntgl] + standard_name = index_for_graupel + long_name = tracer index for graupel + units = index + dimensions = () + type = integer + intent = in + optional = F +[iter] + standard_name = ccpp_loop_counter + long_name = loop counter for subcycling loops in CCPP + units = index + dimensions = () + type = integer + intent = in + optional = F +[flag_iter] + standard_name = flag_for_iteration + long_name = flag for iteration + units = flag + dimensions = (horizontal_dimension) + type = logical + intent = in + optional = F +[ugrs] + standard_name = x_wind + long_name = x component of layer wind + units = m s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[vgrs] + standard_name = y_wind + long_name = y component of layer wind + units = m s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[tgrs] + standard_name = air_temperature + long_name = layer mean air temperature + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[qgrs] + standard_name = tracer_concentration + long_name = model layer mean tracer concentration + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension,number_of_tracers) + type = real + kind = kind_phys + intent = in + optional = F +[prsl] + standard_name = air_pressure + long_name = mean layer pressure + units = Pa + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[prsi] + standard_name = air_pressure_at_interface + long_name = air pressure at model layer interfaces + units = Pa + dimensions = (horizontal_dimension,vertical_dimension_plus_one) + type = real + kind = kind_phys + intent = in + optional = F +[phii] + standard_name = geopotential_at_interface + long_name = geopotential at model layer interfaces + units = m2 s-2 + dimensions = (horizontal_dimension,vertical_dimension_plus_one) + type = real + kind = kind_phys + intent = in + optional = F +[prsik_1] + standard_name = dimensionless_exner_function_at_lowest_model_interface + long_name = dimensionless Exner function at lowest model interface + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[prslk_1] + standard_name = dimensionless_exner_function_at_lowest_model_layer + long_name = dimensionless Exner function at lowest model layer + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[tsfc] + standard_name = surface_skin_temperature + long_name = surface temperature + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[qsfc] + standard_name = surface_specific_humidity + long_name = surface air saturation specific humidity + units = kg kg-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[phy_myj_qsfc] + standard_name = surface_specific_humidity_for_MYJ_schemes + long_name = surface air saturation specific humidity for MYJ schem + units = kg kg-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[phy_myj_thz0] + standard_name = potential_temperature_at_viscous_sublayer_top + long_name = potential temperat at viscous sublayer top over water + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[phy_myj_qz0] + standard_name = specific_humidity_at_viscous_sublayer_top + long_name = specific humidity at_viscous sublayer top over water + units = kg kg-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[phy_myj_uz0] + standard_name = u_wind_component_at_viscous_sublayer_top + long_name = u wind component at viscous sublayer top over water + units = m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[phy_myj_vz0] + standard_name = v_wind_component_at_viscous_sublayer_top + long_name = v wind component at viscous sublayer top over water + units = m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[phy_myj_z0base] + standard_name = baseline_surface_roughness_length + long_name = baseline surface roughness length for momentum in mete + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[phy_myj_akhs] + standard_name = heat_exchange_coefficient_for_MYJ_schemes + long_name = surface heat exchange_coefficient for MYJ schemes + units = m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[phy_myj_akms] + standard_name = momentum_exchange_coefficient_for_MYJ_schemes + long_name = surface momentum exchange_coefficient for MYJ schemes + units = m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[phy_myj_chkqlm] + standard_name = surface_layer_evaporation_switch + long_name = surface layer evaporation switch + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[phy_myj_elflx] + standard_name = kinematic_surface_latent_heat_flux + long_name = kinematic surface latent heat flux + units = m s-1 kg kg-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[phy_myj_a1u] + standard_name = weight_for_momentum_at_viscous_sublayer_top + long_name = Weight for momentum at viscous layer top + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[phy_myj_a1t] + standard_name = weight_for_potental_temperature_at_viscous_sublayer_top + long_name = Weight for potental temperature at viscous layer top + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[phy_myj_a1q] + standard_name = weight_for_specific_humidity_at_viscous_sublayer_top + long_name = Weight for Specfic Humidity at viscous layer top + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[pblh] + standard_name = atmosphere_boundary_layer_thickness + long_name = PBL thickness + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[slmsk] + standard_name = sea_land_ice_mask_real + long_name = landmask: sea/land/ice=0/1/2 + units = flag + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[zorl] + standard_name = surface_roughness_length + long_name = surface roughness length + units = cm + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[ustar] + standard_name = surface_friction_velocity + long_name = boundary layer parameter + units = m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[rib] + standard_name = bulk_richardson_number_at_lowest_model_level + long_name = bulk Richardson number at the surface + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[cm] + standard_name = surface_drag_coefficient_for_momentum_in_air + long_name = surface exchange coeff for momentum + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[ch] + standard_name = surface_drag_coefficient_for_heat_and_moisture_in_air + long_name = surface exchange coeff heat & moisture + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[stress] + standard_name = surface_wind_stress + long_name = surface wind stress + units = m2 s-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[ffm] + standard_name = Monin_Obukhov_similarity_function_for_momentum + long_name = Monin_Obukhov similarity function for momentum + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[ffh] + standard_name = Monin_Obukhov_similarity_function_for_heat + long_name = Monin_Obukhov similarity function for heat + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[fm10] + standard_name = Monin_Obukhov_similarity_function_for_momentum_at_10m + long_name = Monin_Obukhov similarity parameter for momentum at 10m + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[fh2] + standard_name = Monin_Obukhov_similarity_function_for_heat_at_2m + long_name = Monin_Obukhov similarity parameter for heat at 2m + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[landfrac] + standard_name = land_area_fraction + long_name = fraction of horizontal grid area occupied by land + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[lakefrac] + standard_name = lake_area_fraction + long_name = fraction of horizontal grid area occupied by lake + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[oceanfrac] + standard_name = sea_area_fraction + long_name = fraction of horizontal grid area occupied by ocean + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[fice] + standard_name = sea_ice_concentration + long_name = ice fraction over open water + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[z0rl_ocn] + standard_name = surface_roughness_length_over_ocean_interstitial + long_name = surface roughness length over ocean (interstitial) + units = cm + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[z0rl_lnd] + standard_name = surface_roughness_length_over_land_interstitial + long_name = surface roughness length over land (interstitial) + units = cm + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[z0rl_ice] + standard_name = surface_roughness_length_over_ice_interstitial + long_name = surface roughness length over ice (interstitial) + units = cm + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[ustar_ocn] + standard_name = surface_friction_velocity_over_ocean + long_name = surface friction velocity over ocean + units = m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[ustar_lnd] + standard_name = surface_friction_velocity_over_land + long_name = surface friction velocity over land + units = m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[ustar_ice] + standard_name = surface_friction_velocity_over_ice + long_name = surface friction velocity over ice + units = m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[cm_ocn] + standard_name = surface_drag_coefficient_for_momentum_in_air_over_ocean + long_name = surface exchange coeff for momentum over ocean + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[cm_lnd] + standard_name = surface_drag_coefficient_for_momentum_in_air_over_land + long_name = surface exchange coeff for momentum over land + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[cm_ice] + standard_name = surface_drag_coefficient_for_momentum_in_air_over_ice + long_name = surface exchange coeff for momentum over ice + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[ch_ocn] + standard_name = surface_drag_coefficient_for_heat_and_moisture_in_air_over_ocean + long_name = surface exchange coeff heat & moisture over ocean + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[ch_lnd] + standard_name = surface_drag_coefficient_for_heat_and_moisture_in_air_over_land + long_name = surface exchange coeff heat & moisture over land + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[ch_ice] + standard_name = surface_drag_coefficient_for_heat_and_moisture_in_air_over_ice + long_name = surface exchange coeff heat & moisture over ice + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[rb_ocn] + standard_name = bulk_richardson_number_at_lowest_model_level_over_ocean + long_name = bulk Richardson number at the surface over ocean + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[rb_lnd] + 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_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[rb_ice] + standard_name = bulk_richardson_number_at_lowest_model_level_over_ice + long_name = bulk Richardson number at the surface over ice + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[stress_ocn] + standard_name = surface_wind_stress_over_ocean + long_name = surface wind stress over ocean + units = m2 s-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[stress_lnd] + standard_name = surface_wind_stress_over_land + long_name = surface wind stress over land + units = m2 s-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[stress_ice] + standard_name = surface_wind_stress_over_ice + long_name = surface wind stress over ice + units = m2 s-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[fm_ocn] + standard_name = Monin_Obukhov_similarity_function_for_momentum_over_ocean + long_name = Monin-Obukhov similarity funct for momentum over ocean + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[fm_lnd] + standard_name = Monin_Obukhov_similarity_function_for_momentum_over_land + long_name = Monin-Obukhov similarity funct for momentum over land + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[fm_ice] + standard_name = Monin_Obukhov_similarity_function_for_momentum_over_ice + long_name = Monin-Obukhov similarity funct for momentum over ice + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[fh_ocn] + standard_name = Monin_Obukhov_similarity_function_for_heat_over_ocean + long_name = Monin-Obukhov similarity function for heat over ocean + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[fh_lnd] + standard_name = Monin_Obukhov_similarity_function_for_heat_over_land + long_name = Monin-Obukhov similarity function for heat over land + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[fh_ice] + standard_name = Monin_Obukhov_similarity_function_for_heat_over_ice + long_name = Monin-Obukhov similarity function for heat over ice + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[fm10_ocn] + standard_name = Monin_Obukhov_similarity_function_for_momentum_at_10m_over_ocean + long_name = Monin-Obukhov parameter for momentum at 10m over ocean + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[fm10_lnd] + standard_name = Monin_Obukhov_similarity_function_for_momentum_at_10m_over_land + long_name = Monin-Obukhov parameter for momentum at 10m over land + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[fm10_ice] + standard_name = Monin_Obukhov_similarity_function_for_momentum_at_10m_over_ice + long_name = Monin-Obukhov parameter for momentum at 10m over ice + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[fh2_ocn] + standard_name = Monin_Obukhov_similarity_function_for_heat_at_2m_over_ocean + long_name = Monin-Obukhov parameter for heat at 2m over ocean + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[fh2_lnd] + standard_name = Monin_Obukhov_similarity_function_for_heat_at_2m_over_land + long_name = Monin-Obukhov parameter for heat at 2m over land + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[fh2_ice] + standard_name = Monin_Obukhov_similarity_function_for_heat_at_2m_over_ice + long_name = Monin-Obukhov parameter for heat at 2m over ice + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[wind] + standard_name = wind_speed_at_lowest_model_layer + long_name = wind speed at lowest model level + units = m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[con_cp] + standard_name = specific_heat_of_dry_air_at_constant_pressure + long_name = specific heat of dry air at constant pressure + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[con_g] + standard_name = gravitational_acceleration + long_name = gravitational acceleration + units = m s-2 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[con_rd] + standard_name = gas_constant_dry_air + long_name = ideal gas constant for dry air + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[me] + standard_name = mpi_rank + long_name = current MPI-rank + units = index + dimensions = () + type = integer + intent = in + optional = F +[lprnt] + standard_name = flag_print + long_name = control flag for diagnostic print out + units = flag + dimensions = () + type = logical + intent = in + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F diff --git a/physics/module_MYNNPBL_wrapper.F90 b/physics/module_MYNNPBL_wrapper.F90 index 740948695..396699d9f 100644 --- a/physics/module_MYNNPBL_wrapper.F90 +++ b/physics/module_MYNNPBL_wrapper.F90 @@ -19,109 +19,14 @@ end subroutine mynnedmf_wrapper_finalize ! \brief This scheme (1) performs pre-mynnedmf work, (2) runs the mynnedmf, and (3) performs post-mynnedmf work #if 0 !> \section arg_table_mynnedmf_wrapper_run Argument Table -!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | -!! |-----------------------------|------------------------------------------------------------------------------|----------------------------------------------------------------------------|---------------|------|-----------|-----------|--------|----------| -!! | ix | horizontal_dimension | horizontal dimension | count | 0 | integer | | in | F | -!! | im | horizontal_loop_extent | horizontal loop extent | count | 0 | integer | | in | F | -!! | levs | vertical_dimension | vertical layer dimension | count | 0 | integer | | in | F | -!! | flag_init | flag_for_first_time_step | flag signaling first time step for time integration loop | flag | 0 | logical | | in | F | -!! | flag_restart | flag_for_restart | flag for restart (warmstart) or coldstart | flag | 0 | logical | | in | F | -!! | delt | time_step_for_physics | time step for physics | s | 0 | real | kind_phys | in | F | -!! | dx | cell_size | size of the grid cell | m | 1 | real | kind_phys | in | F | -!! | zorl | surface_roughness_length | surface roughness length in cm | cm | 1 | real | kind_phys | in | F | -!! | phii | geopotential_at_interface | geopotential at model layer interfaces | m2 s-2 | 2 | real | kind_phys | in | F | -!! | U | x_wind | x component of layer wind | m s-1 | 2 | real | kind_phys | in | F | -!! | V | y_wind | y component of layer wind | m s-1 | 2 | real | kind_phys | in | F | -!! | omega | omega | layer mean vertical velocity | Pa s-1 | 2 | real | kind_phys | in | F | -!! | T3D | air_temperature | layer mean air temperature | K | 2 | real | kind_phys | in | F | -!! | qgrs_water_vapor | water_vapor_specific_humidity | water vapor specific humidity | kg kg-1 | 2 | real | kind_phys | in | F | -!! | qgrs_liquid_cloud | cloud_condensed_water_mixing_ratio | moist (dry+vapor, no condensates) mixing ratio of cloud water (condensate) | kg kg-1 | 2 | real | kind_phys | in | F | -!! | qgrs_ice_cloud | ice_water_mixing_ratio | moist (dry+vapor, no condensates) mixing ratio of ice water | kg kg-1 | 2 | real | kind_phys | in | F | -!! | qgrs_cloud_droplet_num_conc | cloud_droplet_number_concentration | number concentration of cloud droplets (liquid) | kg-1 | 2 | real | kind_phys | in | F | -!! | qgrs_cloud_ice_num_conc | ice_number_concentration | number concentration of ice | kg-1 | 2 | real | kind_phys | in | F | -!! | qgrs_ozone | ozone_mixing_ratio | ozone mixing ratio | kg kg-1 | 2 | real | kind_phys | in | F | -!! | qgrs_water_aer_num_conc | water_friendly_aerosol_number_concentration | number concentration of water-friendly aerosols | kg-1 | 2 | real | kind_phys | in | F | -!! | qgrs_ice_aer_num_conc | ice_friendly_aerosol_number_concentration | number concentration of ice-friendly aerosols | kg-1 | 2 | real | kind_phys | in | F | -!! | prsl | air_pressure | mean layer pressure | Pa | 2 | real | kind_phys | in | F | -!! | exner | dimensionless_exner_function_at_model_layers | Exner function at layers | none | 2 | real | kind_phys | in | F | -!! | slmsk | sea_land_ice_mask_real | landmask: sea/land/ice=0/1/2 | flag | 1 | real | kind_phys | in | F | -!! | tsurf | surface_skin_temperature | surface temperature | K | 1 | real | kind_phys | in | F | -!! | qsfc | surface_specific_humidity | surface air saturation specific humidity | kg kg-1 | 1 | real | kind_phys | in | F | -!! | ps | surface_air_pressure | surface pressure | Pa | 1 | real | kind_phys | in | F | -!! | ust | surface_friction_velocity | boundary layer parameter | m s-1 | 1 | real | kind_phys | in | F | -!! | ch | surface_drag_wind_speed_for_momentum_in_air | momentum exchange coefficient | m s-1 | 1 | real | kind_phys | out | F | -!! | hflx | kinematic_surface_upward_sensible_heat_flux | kinematic surface upward sensible heat flux | K m s-1 | 1 | real | kind_phys | in | F | -!! | qflx | kinematic_surface_upward_latent_heat_flux | kinematic surface upward latent heat flux | kg kg-1 m s-1 | 1 | real | kind_phys | in | F | -!! | wspd | wind_speed_at_lowest_model_layer | wind speed at lowest model level | m s-1 | 1 | real | kind_phys | in | F | -!! | rb | bulk_richardson_number_at_lowest_model_level | bulk Richardson number at the surface | none | 1 | real | kind_phys | in | F | -!! | dtsfc1 | instantaneous_surface_upward_sensible_heat_flux | surface upward sensible heat flux valid for current call | W m-2 | 1 | real | kind_phys | out | F | -!! | dqsfc1 | instantaneous_surface_upward_latent_heat_flux | surface upward latent heat flux valid for current call | W m-2 | 1 | real | kind_phys | out | F | -!! | dtsfci_diag | instantaneous_surface_upward_sensible_heat_flux_for_diag | instantaneous sfc sensible heat flux multiplied by timestep | W m-2 | 1 | real | kind_phys | out | F | -!! | dqsfci_diag | instantaneous_surface_upward_latent_heat_flux_for_diag | instantaneous sfc latent heat flux multiplied by timestep | W m-2 | 1 | real | kind_phys | out | F | -!! | dtsfc_diag | cumulative_surface_upward_sensible_heat_flux_for_diag_multiplied_by_timestep | cumulative sfc sensible heat flux multiplied by timestep | W m-2 s | 1 | real | kind_phys | out | F | -!! | dqsfc_diag | cumulative_surface_upward_latent_heat_flux_for_diag_multiplied_by_timestep | cumulative sfc latent heat flux multiplied by timestep | W m-2 s | 1 | real | kind_phys | out | F | -!! | recmol | reciprocal_of_obukhov_length | one over obukhov length | m-1 | 1 | real | kind_phys | in | F | -!! | qke | tke_at_mass_points | 2 x tke at mass points | m2 s-2 | 2 | real | kind_phys | inout | F | -!! | qke_adv | turbulent_kinetic_energy | turbulent kinetic energy | J | 2 | real | kind_phys | inout | F | -!! | tsq | t_prime_squared | temperature fluctuation squared | K2 | 2 | real | kind_phys | out | F | -!! | qsq | q_prime_squared | water vapor fluctuation squared | kg2 kg-2 | 2 | real | kind_phys | out | F | -!! | cov | t_prime_q_prime | covariance of temperature and moisture | K kg kg-1 | 2 | real | kind_phys | out | F | -!! | el_pbl | mixing_length | mixing length in meters | m | 2 | real | kind_phys | inout | F | -!! | Sh3D | stability_function_for_heat | stability function for heat | none | 2 | real | kind_phys | inout | F | -!! | exch_h | atmosphere_heat_diffusivity_for_mynnpbl | diffusivity for heat for MYNN PBL (defined for all mass levels) | m2 s-1 | 2 | real | kind_phys | out | F | -!! | exch_m | atmosphere_momentum_diffusivity_for_mynnpbl | diffusivity for momentum for MYNN PBL (defined for all mass levels) | m2 s-1 | 2 | real | kind_phys | out | F | -!! | PBLH | atmosphere_boundary_layer_thickness | PBL thickness | m | 1 | real | kind_phys | inout | F | -!! | kpbl | vertical_index_at_top_of_atmosphere_boundary_layer | PBL top model level index | index | 1 | integer | | inout | F | -!! | QC_BL | subgrid_cloud_mixing_ratio_pbl | subgrid cloud cloud mixing ratio from PBL scheme | kg kg-1 | 2 | real | kind_phys | inout | F | -!! | CLDFRA_BL | subgrid_cloud_fraction_pbl | subgrid cloud fraction from PBL scheme | frac | 2 | real | kind_phys | inout | F | -!! | edmf_a | emdf_updraft_area | updraft area from mass flux scheme | frac | 2 | real | kind_phys | inout | F | -!! | edmf_w | emdf_updraft_vertical_velocity | updraft vertical velocity from mass flux scheme | m s-1 | 2 | real | kind_phys | inout | F | -!! | edmf_qt | emdf_updraft_total_water | updraft total water from mass flux scheme | kg kg-1 | 2 | real | kind_phys | inout | F | -!! | edmf_thl | emdf_updraft_theta_l | updraft theta-l from mass flux scheme | K | 2 | real | kind_phys | inout | F | -!! | edmf_ent | emdf_updraft_entrainment_rate | updraft entrainment rate from mass flux scheme | s-1 | 2 | real | kind_phys | inout | F | -!! | edmf_qc | emdf_updraft_cloud_water | updraft cloud water from mass flux scheme | kg kg-1 | 2 | real | kind_phys | inout | F | -!! | nupdraft | number_of_plumes | number of plumes per grid column | count | 1 | integer | | inout | F | -!! | maxMF | maximum_mass_flux | maximum mass flux within a column | m s-1 | 1 | real | kind_phys | out | F | -!! | ktop_shallow | k_level_of_highest_reaching_plume | k-level of highest reaching plume | count | 1 | integer | | inout | F | -!! | RTHRATEN | tendency_of_air_temperature_due_to_longwave_heating_on_radiation_time_step | total sky longwave heating rate | K s-1 | 2 | real | kind_phys | in | F | -!! | dudt | tendency_of_x_wind_due_to_model_physics | updated tendency of the x wind | m s-2 | 2 | real | kind_phys | inout | F | -!! | dvdt | tendency_of_y_wind_due_to_model_physics | updated tendency of the y wind | m s-2 | 2 | real | kind_phys | inout | F | -!! | dtdt | tendency_of_air_temperature_due_to_model_physics | updated tendency of the temperature | K s-1 | 2 | real | kind_phys | inout | F | -!! | dqdt_water_vapor | tendency_of_water_vapor_specific_humidity_due_to_model_physics | water vapor specific humidity tendency due to model physics | kg kg-1 s-1 | 2 | real | kind_phys | inout | F | -!! | dqdt_liquid_cloud | tendency_of_liquid_cloud_water_mixing_ratio_due_to_model_physics | cloud condensed water mixing ratio tendency due to model physics | kg kg-1 s-1 | 2 | real | kind_phys | inout | F | -!! | dqdt_ice_cloud | tendency_of_ice_cloud_water_mixing_ratio_due_to_model_physics | cloud condensed water mixing ratio tendency due to model physics | kg kg-1 s-1 | 2 | real | kind_phys | inout | F | -!! | dqdt_ozone | tendency_of_ozone_mixing_ratio_due_to_model_physics | ozone mixing ratio tendency due to model physics | kg kg-1 s-1 | 2 | real | kind_phys | inout | F | -!! | dqdt_cloud_droplet_num_conc | tendency_of_cloud_droplet_number_concentration_due_to_model_physics | number conc. of cloud droplets (liquid) tendency due to model physics | kg-1 s-1 | 2 | real | kind_phys | inout | F | -!! | dqdt_ice_num_conc | tendency_of_ice_number_concentration_due_to_model_physics | number conc. of ice tendency due to model physics | kg-1 s-1 | 2 | real | kind_phys | inout | F | -!! | dqdt_water_aer_num_conc | tendency_of_water_friendly_aerosol_number_concentration_due_to_model_physics | number conc. of water-friendly aerosols tendency due to model physics | kg-1 s-1 | 2 | real | kind_phys | inout | F | -!! | dqdt_ice_aer_num_conc | tendency_of_ice_friendly_aerosol_number_concentration_due_to_model_physics | number conc. of ice-friendly aerosols tendency due to model physics | kg-1 s-1 | 2 | real | kind_phys | inout | F | -!! | grav_settling | grav_settling | flag to activate gravitational setting of fog | flag | 0 | integer | | in | F | -!! | bl_mynn_tkebudget | tke_budget | flag for activating TKE budget | flag | 0 | integer | | in | F | -!! | bl_mynn_tkeadvect | tke_advect | flag for activating TKE advect | flag | 0 | logical | | in | F | -!! | bl_mynn_cloudpdf | cloudpdf | flag to determine which cloud PDF to use | flag | 0 | integer | | in | F | -!! | bl_mynn_mixlength | mixing_length_flag | flag to determine which mixing length form to use | flag | 0 | integer | | in | F | -!! | bl_mynn_edmf | edmf_flag | flag to activate the mass-flux scheme | flag | 0 | integer | | in | F | -!! | bl_mynn_edmf_mom | edmf_momentum_transport_flag | flag to activate the transport of momentum | flag | 0 | integer | | in | F | -!! | bl_mynn_edmf_tke | edmf_tke_transport_flag | flag to activate the transport of TKE | flag | 0 | integer | | in | F | -!! | bl_mynn_edmf_part | edmf_partition_flag | flag to partitioning of the MF and ED areas | flag | 0 | integer | | in | F | -!! | bl_mynn_cloudmix | cloud_specie_mix_flag | flag to activate mixing of cloud species | flag | 0 | integer | | in | F | -!! | bl_mynn_mixqt | mix_total_water_flag | flag to mix total water or individual species | flag | 0 | integer | | in | F | -!! | icloud_bl | couple_sgs_clouds_to_radiation_flag | flag for coupling sgs clouds to radiation | flag | 0 | integer | | in | F | -!! | do_mynnsfclay | do_mynnsfclay | flag to activate MYNN surface layer | flag | 0 | logical | | in | F | -!! | imp_physics | flag_for_microphysics_scheme | choice of microphysics scheme | flag | 0 | integer | | in | F | -!! | imp_physics_gfdl | flag_for_gfdl_microphysics_scheme | choice of GFDL microphysics scheme | flag | 0 | integer | | in | F | -!! | imp_physics_thompson | flag_for_thompson_microphysics_scheme | choice of Thompson microphysics scheme | flag | 0 | integer | | in | F | -!! | imp_physics_wsm6 | flag_for_wsm6_microphysics_scheme | choice of WSM6 microphysics scheme | flag | 0 | integer | | in | F | -!! | ltaerosol | flag_for_aerosol_physics | flag for aerosol physics | flag | 0 | logical | | in | F | -!! | lprnt | flag_print | control flag for diagnostic print out | flag | 0 | logical | | in | F | -!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | -!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | +!! \htmlinclude mynnedmf_wrapper_run.html !! #endif SUBROUTINE mynnedmf_wrapper_run( & & ix,im,levs, & & flag_init,flag_restart, & - & delt,dx,zorl, & + & lssav, ldiag3d, lsidea, & + & delt,dtf,dx,zorl, & & phii,u,v,omega,t3d, & & qgrs_water_vapor, & & qgrs_liquid_cloud, & @@ -145,12 +50,13 @@ SUBROUTINE mynnedmf_wrapper_run( & & edmf_a,edmf_w,edmf_qt, & & edmf_thl,edmf_ent,edmf_qc, & & nupdraft,maxMF,ktop_shallow, & - & RTHRATEN, & & dudt, dvdt, dtdt, & & dqdt_water_vapor, dqdt_liquid_cloud, & & dqdt_ice_cloud, dqdt_ozone, & & dqdt_cloud_droplet_num_conc, dqdt_ice_num_conc, & & dqdt_water_aer_num_conc, dqdt_ice_aer_num_conc, & + & dt3dt, du3dt_PBL, du3dt_OGWD, dv3dt_PBL, dv3dt_OGWD, & + & htrsw, htrlw, xmu, & & grav_settling, bl_mynn_tkebudget, bl_mynn_tkeadvect, & & bl_mynn_cloudpdf, bl_mynn_mixlength, & & bl_mynn_edmf, bl_mynn_edmf_mom, bl_mynn_edmf_tke, & @@ -246,7 +152,8 @@ SUBROUTINE mynnedmf_wrapper_run( & character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg - + + LOGICAL, INTENT(IN) :: lssav, ldiag3d, lsidea ! NAMELIST OPTIONS (INPUT): LOGICAL, INTENT(IN) :: bl_mynn_tkeadvect, ltaerosol, & lprnt, do_mynnsfclay @@ -278,7 +185,7 @@ SUBROUTINE mynnedmf_wrapper_run( & & p_qc, p_qr, p_qi, p_qs, p_qg, p_qnc, p_qni !MYNN-1D - REAL(kind=kind_phys), intent(in) :: delt + REAL(kind=kind_phys), intent(in) :: delt, dtf INTEGER, intent(in) :: im, ix, levs LOGICAL, intent(in) :: flag_init, flag_restart INTEGER :: initflag, k, i @@ -287,6 +194,7 @@ SUBROUTINE mynnedmf_wrapper_run( & & ITS,ITE,JTS,JTE,KTS,KTE INTEGER :: kdvel, num_vert_mix INTEGER, PARAMETER :: nchem=1, ndvel=1 + REAL(kind=kind_phys) :: tem !MYNN-3D real(kind=kind_phys), dimension(im,levs+1), intent(in) :: phii @@ -311,11 +219,13 @@ SUBROUTINE mynnedmf_wrapper_run( & & qgrs_cloud_ice_num_conc, & & qgrs_ozone, & & qgrs_water_aer_num_conc, & - & qgrs_ice_aer_num_conc, & - & RTHRATEN + & qgrs_ice_aer_num_conc real(kind=kind_phys), dimension(im,levs), intent(out) :: & & Tsq, Qsq, Cov, exch_h, exch_m - + real(kind=kind_phys), dimension(:,:), intent(inout) :: dt3dt, & + & du3dt_PBL, du3dt_OGWD, dv3dt_PBL, dv3dt_OGWD + real(kind=kind_phys), dimension(im), intent(in) :: xmu + real(kind=kind_phys), dimension(im, levs), intent(in) :: htrsw, htrlw !LOCAL real(kind=kind_phys), dimension(im,levs) :: & & qvsh,qc,qi,qnc,qni,ozone,qnwfa,qnifa, & @@ -655,7 +565,7 @@ SUBROUTINE mynnedmf_wrapper_run( & & ,nupdraft=nupdraft,maxMF=maxMF & !output & ,ktop_shallow=ktop_shallow & !output & ,spp_pbl=spp_pbl,pattern_spp_pbl=pattern_spp_pbl & !input - & ,RTHRATEN=RTHRATEN & !input + & ,RTHRATEN=htrlw & !input & ,FLAG_QI=flag_qi,FLAG_QNI=flag_qni & !input & ,FLAG_QC=flag_qc,FLAG_QNC=flag_qnc & !input & ,FLAG_QNWFA=FLAG_QNWFA,FLAG_QNIFA=FLAG_QNIFA & !input @@ -791,7 +701,28 @@ SUBROUTINE mynnedmf_wrapper_run( & enddo enddo endif - + + if (lssav .and. ldiag3d) then + if (lsidea) then + dt3dt(1:im,:) = dt3dt(1:im,:) + dtdt(1:im,:)*dtf + else + do k=1,levs + do i=1,im + tem = dtdt(i,k) - (htrlw(i,k)+htrsw(i,k)*xmu(i)) + dt3dt(i,k) = dt3dt(i,k) + tem*dtf + enddo + enddo + endif + do k=1,levs + do i=1,im + du3dt_PBL(i,k) = du3dt_PBL(i,k) + dudt(i,k) * dtf + du3dt_OGWD(i,k) = du3dt_OGWD(i,k) - dudt(i,k) * dtf + dv3dt_PBL(i,k) = dv3dt_PBL(i,k) + dvdt(i,k) * dtf + dv3dt_OGWD(i,k) = dv3dt_OGWD(i,k) - dvdt(i,k) * dtf + enddo + enddo + endif + if (lprnt) then print* print*,"===Finished with mynn_bl_driver; output:" diff --git a/physics/module_MYNNPBL_wrapper.meta b/physics/module_MYNNPBL_wrapper.meta new file mode 100644 index 000000000..da09c0089 --- /dev/null +++ b/physics/module_MYNNPBL_wrapper.meta @@ -0,0 +1,926 @@ +[ccpp-arg-table] + name = mynnedmf_wrapper_run + type = scheme +[ix] + standard_name = horizontal_dimension + long_name = horizontal dimension + units = count + dimensions = () + type = integer + intent = in + optional = F +[im] + standard_name = horizontal_loop_extent + long_name = horizontal loop extent + units = count + dimensions = () + type = integer + intent = in + optional = F +[levs] + standard_name = vertical_dimension + long_name = vertical layer dimension + units = count + dimensions = () + type = integer + intent = in + optional = F +[flag_init] + standard_name = flag_for_first_time_step + long_name = flag signaling first time step for time integration loop + units = flag + dimensions = () + type = logical + intent = in + optional = F +[flag_restart] + standard_name = flag_for_restart + long_name = flag for restart (warmstart) or coldstart + units = flag + dimensions = () + type = logical + intent = in + optional = F +[lssav] + standard_name = flag_diagnostics + long_name = logical flag for storing diagnostics + units = flag + dimensions = () + type = logical + intent = in + optional = F +[ldiag3d] + standard_name = flag_diagnostics_3D + long_name = flag for 3d diagnostic fields + units = flag + dimensions = () + type = logical + intent = in + optional = F +[lsidea] + standard_name = flag_idealized_physics + long_name = flag for idealized physics + units = flag + dimensions = () + type = logical + intent = in + optional = F +[delt] + standard_name = time_step_for_physics + long_name = time step for physics + units = s + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[dtf] + standard_name = time_step_for_dynamics + long_name = dynamics timestep + units = s + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[dx] + standard_name = cell_size + long_name = size of the grid cell + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[zorl] + standard_name = surface_roughness_length + long_name = surface roughness length in cm + units = cm + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[phii] + standard_name = geopotential_at_interface + long_name = geopotential at model layer interfaces + units = m2 s-2 + dimensions = (horizontal_dimension,vertical_dimension_plus_one) + type = real + kind = kind_phys + intent = in + optional = F +[U] + standard_name = x_wind + long_name = x component of layer wind + units = m s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[V] + standard_name = y_wind + long_name = y component of layer wind + units = m s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[omega] + standard_name = omega + long_name = layer mean vertical velocity + units = Pa s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[T3D] + standard_name = air_temperature + long_name = layer mean air temperature + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[qgrs_water_vapor] + standard_name = water_vapor_specific_humidity + long_name = water vapor specific humidity + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[qgrs_liquid_cloud] + standard_name = cloud_condensed_water_mixing_ratio + long_name = ratio of mass of cloud water to mass of dry air plus vapor (without condensates) + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[qgrs_ice_cloud] + standard_name = ice_water_mixing_ratio + long_name = ratio of mass of ice water to mass of dry air plus vapor (without condensates) + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[qgrs_cloud_droplet_num_conc] + standard_name = cloud_droplet_number_concentration + long_name = number concentration of cloud droplets (liquid) + units = kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[qgrs_cloud_ice_num_conc] + standard_name = ice_number_concentration + long_name = number concentration of ice + units = kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[qgrs_ozone] + standard_name = ozone_mixing_ratio + long_name = ozone mixing ratio + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[qgrs_water_aer_num_conc] + standard_name = water_friendly_aerosol_number_concentration + long_name = number concentration of water-friendly aerosols + units = kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[qgrs_ice_aer_num_conc] + standard_name = ice_friendly_aerosol_number_concentration + long_name = number concentration of ice-friendly aerosols + units = kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[prsl] + standard_name = air_pressure + long_name = mean layer pressure + units = Pa + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[exner] + standard_name = dimensionless_exner_function_at_model_layers + long_name = Exner function at layers + units = none + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[slmsk] + standard_name = sea_land_ice_mask_real + long_name = landmask: sea/land/ice=0/1/2 + units = flag + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[tsurf] + standard_name = surface_skin_temperature + long_name = surface temperature + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[qsfc] + standard_name = surface_specific_humidity + long_name = surface air saturation specific humidity + units = kg kg-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[ps] + standard_name = surface_air_pressure + long_name = surface pressure + units = Pa + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[ust] + standard_name = surface_friction_velocity + long_name = boundary layer parameter + units = m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[ch] + standard_name = surface_drag_wind_speed_for_momentum_in_air + long_name = momentum exchange coefficient + units = m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[hflx] + standard_name = kinematic_surface_upward_sensible_heat_flux + long_name = kinematic surface upward sensible heat flux + units = K m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[qflx] + standard_name = kinematic_surface_upward_latent_heat_flux + long_name = kinematic surface upward latent heat flux + units = kg kg-1 m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[wspd] + standard_name = wind_speed_at_lowest_model_layer + long_name = wind speed at lowest model level + units = m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[rb] + standard_name = bulk_richardson_number_at_lowest_model_level + long_name = bulk Richardson number at the surface + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[dtsfc1] + standard_name = instantaneous_surface_upward_sensible_heat_flux + long_name = surface upward sensible heat flux valid for current call + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[dqsfc1] + standard_name = instantaneous_surface_upward_latent_heat_flux + long_name = surface upward latent heat flux valid for current call + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[dtsfci_diag] + standard_name = instantaneous_surface_upward_sensible_heat_flux_for_diag + long_name = instantaneous sfc sensible heat flux multiplied by timestep + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[dqsfci_diag] + standard_name = instantaneous_surface_upward_latent_heat_flux_for_diag + long_name = instantaneous sfc latent heat flux multiplied by timestep + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[dtsfc_diag] + standard_name = cumulative_surface_upward_sensible_heat_flux_for_diag_multiplied_by_timestep + long_name = cumulative sfc sensible heat flux multiplied by timestep + units = W m-2 s + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[dqsfc_diag] + standard_name = cumulative_surface_upward_latent_heat_flux_for_diag_multiplied_by_timestep + long_name = cumulative sfc latent heat flux multiplied by timestep + units = W m-2 s + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[recmol] + standard_name = reciprocal_of_obukhov_length + long_name = one over obukhov length + units = m-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[qke] + standard_name = tke_at_mass_points + long_name = 2 x tke at mass points + units = m2 s-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[qke_adv] + standard_name = turbulent_kinetic_energy + long_name = turbulent kinetic energy + units = J + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[tsq] + standard_name = t_prime_squared + long_name = temperature fluctuation squared + units = K2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[qsq] + standard_name = q_prime_squared + long_name = water vapor fluctuation squared + units = kg2 kg-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[cov] + standard_name = t_prime_q_prime + long_name = covariance of temperature and moisture + units = K kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[el_pbl] + standard_name = mixing_length + long_name = mixing length in meters + units = m + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[Sh3D] + standard_name = stability_function_for_heat + long_name = stability function for heat + units = none + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[exch_h] + standard_name = atmosphere_heat_diffusivity_for_mynnpbl + long_name = diffusivity for heat for MYNN PBL (defined for all mass levels) + units = m2 s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[exch_m] + standard_name = atmosphere_momentum_diffusivity_for_mynnpbl + long_name = diffusivity for momentum for MYNN PBL (defined for all mass levels) + units = m2 s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[PBLH] + standard_name = atmosphere_boundary_layer_thickness + long_name = PBL thickness + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[kpbl] + standard_name = vertical_index_at_top_of_atmosphere_boundary_layer + long_name = PBL top model level index + units = index + dimensions = (horizontal_dimension) + type = integer + intent = inout + optional = F +[QC_BL] + standard_name = subgrid_cloud_mixing_ratio_pbl + long_name = subgrid cloud cloud mixing ratio from PBL scheme + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[CLDFRA_BL] + standard_name = subgrid_cloud_fraction_pbl + long_name = subgrid cloud fraction from PBL scheme + units = frac + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[edmf_a] + standard_name = emdf_updraft_area + long_name = updraft area from mass flux scheme + units = frac + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[edmf_w] + standard_name = emdf_updraft_vertical_velocity + long_name = updraft vertical velocity from mass flux scheme + units = m s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[edmf_qt] + standard_name = emdf_updraft_total_water + long_name = updraft total water from mass flux scheme + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[edmf_thl] + standard_name = emdf_updraft_theta_l + long_name = updraft theta-l from mass flux scheme + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[edmf_ent] + standard_name = emdf_updraft_entrainment_rate + long_name = updraft entrainment rate from mass flux scheme + units = s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[edmf_qc] + standard_name = emdf_updraft_cloud_water + long_name = updraft cloud water from mass flux scheme + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[nupdraft] + standard_name = number_of_plumes + long_name = number of plumes per grid column + units = count + dimensions = (horizontal_dimension) + type = integer + intent = inout + optional = F +[maxMF] + standard_name = maximum_mass_flux + long_name = maximum mass flux within a column + units = m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[ktop_shallow] + standard_name = k_level_of_highest_reaching_plume + long_name = k-level of highest reaching plume + units = count + dimensions = (horizontal_dimension) + type = integer + intent = inout + optional = F +[dudt] + standard_name = tendency_of_x_wind_due_to_model_physics + long_name = updated tendency of the x wind + units = m s-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[dvdt] + standard_name = tendency_of_y_wind_due_to_model_physics + long_name = updated tendency of the y wind + units = m s-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[dtdt] + standard_name = tendency_of_air_temperature_due_to_model_physics + long_name = updated tendency of the temperature + units = K s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[dqdt_water_vapor] + standard_name = tendency_of_water_vapor_specific_humidity_due_to_model_physics + long_name = water vapor specific humidity tendency due to model physics + units = kg kg-1 s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[dqdt_liquid_cloud] + standard_name = tendency_of_liquid_cloud_water_mixing_ratio_due_to_model_physics + long_name = cloud condensed water mixing ratio tendency due to model physics + units = kg kg-1 s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[dqdt_ice_cloud] + standard_name = tendency_of_ice_cloud_water_mixing_ratio_due_to_model_physics + long_name = cloud condensed water mixing ratio tendency due to model physics + units = kg kg-1 s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[dqdt_ozone] + standard_name = tendency_of_ozone_mixing_ratio_due_to_model_physics + long_name = ozone mixing ratio tendency due to model physics + units = kg kg-1 s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[dqdt_cloud_droplet_num_conc] + standard_name = tendency_of_cloud_droplet_number_concentration_due_to_model_physics + long_name = number conc. of cloud droplets (liquid) tendency due to model physics + units = kg-1 s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[dqdt_ice_num_conc] + standard_name = tendency_of_ice_number_concentration_due_to_model_physics + long_name = number conc. of ice tendency due to model physics + units = kg-1 s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[dqdt_water_aer_num_conc] + standard_name = tendency_of_water_friendly_aerosol_number_concentration_due_to_model_physics + long_name = number conc. of water-friendly aerosols tendency due to model physics + units = kg-1 s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[dqdt_ice_aer_num_conc] + standard_name = tendency_of_ice_friendly_aerosol_number_concentration_due_to_model_physics + long_name = number conc. of ice-friendly aerosols tendency due to model physics + units = kg-1 s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[dt3dt] + standard_name = cumulative_change_in_temperature_due_to_PBL + long_name = cumulative change in temperature due to PBL + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[du3dt_PBL] + standard_name = cumulative_change_in_x_wind_due_to_PBL + long_name = cumulative change in x wind due to PBL + units = m s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[du3dt_OGWD] + standard_name = cumulative_change_in_x_wind_due_to_orographic_gravity_wave_drag + long_name = cumulative change in x wind due to orographic gravity wave drag + units = m s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[dv3dt_PBL] + standard_name = cumulative_change_in_y_wind_due_to_PBL + long_name = cumulative change in y wind due to PBL + units = m s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[dv3dt_OGWD] + standard_name = cumulative_change_in_y_wind_due_to_orographic_gravity_wave_drag + long_name = cumulative change in y wind due to orographic gravity wave drag + units = m s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[htrsw] + standard_name = tendency_of_air_temperature_due_to_shortwave_heating_on_radiation_timestep + long_name = total sky sw heating rate + units = K s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[htrlw] + standard_name = tendency_of_air_temperature_due_to_longwave_heating_on_radiation_timestep + long_name = total sky lw heating rate + units = K s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[xmu] + standard_name = zenith_angle_temporal_adjustment_factor_for_shortwave_fluxes + long_name = zenith angle temporal adjustment factor for shortwave + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[grav_settling] + standard_name = grav_settling + long_name = flag to activate gravitational setting of fog + units = flag + dimensions = () + type = integer + intent = in + optional = F +[bl_mynn_tkebudget] + standard_name = tke_budget + long_name = flag for activating TKE budget + units = flag + dimensions = () + type = integer + intent = in + optional = F +[bl_mynn_tkeadvect] + standard_name = tke_advect + long_name = flag for activating TKE advect + units = flag + dimensions = () + type = logical + intent = in + optional = F +[bl_mynn_cloudpdf] + standard_name = cloudpdf + long_name = flag to determine which cloud PDF to use + units = flag + dimensions = () + type = integer + intent = in + optional = F +[bl_mynn_mixlength] + standard_name = mixing_length_flag + long_name = flag to determine which mixing length form to use + units = flag + dimensions = () + type = integer + intent = in + optional = F +[bl_mynn_edmf] + standard_name = edmf_flag + long_name = flag to activate the mass-flux scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F +[bl_mynn_edmf_mom] + standard_name = edmf_momentum_transport_flag + long_name = flag to activate the transport of momentum + units = flag + dimensions = () + type = integer + intent = in + optional = F +[bl_mynn_edmf_tke] + standard_name = edmf_tke_transport_flag + long_name = flag to activate the transport of TKE + units = flag + dimensions = () + type = integer + intent = in + optional = F +[bl_mynn_edmf_part] + standard_name = edmf_partition_flag + long_name = flag to partitioning of the MF and ED areas + units = flag + dimensions = () + type = integer + intent = in + optional = F +[bl_mynn_cloudmix] + standard_name = cloud_specie_mix_flag + long_name = flag to activate mixing of cloud species + units = flag + dimensions = () + type = integer + intent = in + optional = F +[bl_mynn_mixqt] + standard_name = mix_total_water_flag + long_name = flag to mix total water or individual species + units = flag + dimensions = () + type = integer + intent = in + optional = F +[icloud_bl] + standard_name = couple_sgs_clouds_to_radiation_flag + long_name = flag for coupling sgs clouds to radiation + units = flag + dimensions = () + type = integer + intent = in + optional = F +[do_mynnsfclay] + standard_name = do_mynnsfclay + long_name = flag to activate MYNN surface layer + units = flag + dimensions = () + type = logical + intent = in + optional = F +[imp_physics] + standard_name = flag_for_microphysics_scheme + long_name = choice of microphysics scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F +[imp_physics_gfdl] + standard_name = flag_for_gfdl_microphysics_scheme + long_name = choice of GFDL microphysics scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F +[imp_physics_thompson] + standard_name = flag_for_thompson_microphysics_scheme + long_name = choice of Thompson microphysics scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F +[imp_physics_wsm6] + standard_name = flag_for_wsm6_microphysics_scheme + long_name = choice of WSM6 microphysics scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F +[ltaerosol] + standard_name = flag_for_aerosol_physics + long_name = flag for aerosol physics + units = flag + dimensions = () + type = logical + intent = in + optional = F +[lprnt] + standard_name = flag_print + long_name = control flag for diagnostic print out + units = flag + dimensions = () + type = logical + intent = in + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F diff --git a/physics/module_MYNNSFC_wrapper.F90 b/physics/module_MYNNSFC_wrapper.F90 index 554a00e74..5471c4825 100644 --- a/physics/module_MYNNSFC_wrapper.F90 +++ b/physics/module_MYNNSFC_wrapper.F90 @@ -15,71 +15,7 @@ end subroutine mynnsfc_wrapper_finalize !> \brief This scheme (1) performs pre-mynnsfc work, (2) runs the mynn sfc layer scheme, and (3) performs post-mynnsfc work #if 0 !! \section arg_table_mynnsfc_wrapper_run Argument Table -!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | -!! |---------------------|-----------------------------------------------------------------------------|-------------------------------------------------------|---------------|------|-----------|-----------|--------|----------| -!! | ix | horizontal_dimension | horizontal dimension | count | 0 | integer | | in | F | -!! | im | horizontal_loop_extent | horizontal loop extent | count | 0 | integer | | in | F | -!! | levs | vertical_dimension | vertical layer dimension | count | 0 | integer | | in | F | -!! | iter | ccpp_loop_counter | loop counter for subcycling loops in CCPP | index | 0 | integer | | in | F | -!! | flag_init | flag_for_first_time_step | flag signaling first time step for time integration loop | flag | 0 | logical | | in | F | -!! | flag_restart | flag_for_restart | flag for restart (warmstart) or coldstart | flag | 0 | logical | | in | F | -!! | delt | time_step_for_physics | time step for physics | s | 0 | real | kind_phys | in | F | -!! | dx | cell_size | size of the grid cell | m | 1 | real | kind_phys | in | F | -!! | u | x_wind | x component of layer wind | m s-1 | 2 | real | kind_phys | in | F | -!! | v | y_wind | y component of layer wind | m s-1 | 2 | real | kind_phys | in | F | -!! | t3d | air_temperature | layer mean air temperature | K | 2 | real | kind_phys | in | F | -!! | qvsh | water_vapor_specific_humidity | water vapor specific humidity | kg kg-1 | 2 | real | kind_phys | in | F | -!! | qc | cloud_condensed_water_mixing_ratio | moist (dry+vapor, no condensates) mixing ratio of cloud water (condensate) | kg kg-1 | 2 | real | kind_phys | in | F | -!! | prsl | air_pressure | mean layer pressure | Pa | 2 | real | kind_phys | in | F | -!! | phii | geopotential_at_interface | geopotential at model layer interfaces | m2 s-2 | 2 | real | kind_phys | in | F | -!! | exner | dimensionless_exner_function_at_model_layers | Exner function at layers | none | 2 | real | kind_phys | in | F | -!! | tsq | t_prime_squared | temperature fluctuation squared | K2 | 2 | real | kind_phys | in | F | -!! | qsq | q_prime_squared | water vapor fluctuation squared | kg2 kg-2 | 2 | real | kind_phys | in | F | -!! | cov | t_prime_q_prime | covariance of temperature and moisture | K kg kg-1 | 2 | real | kind_phys | in | F | -!! | el_pbl | mixing_length | mixing length in meters | m | 2 | real | kind_phys | in | F | -!! | Sh3D | stability_function_for_heat | stability function for heat | none | 2 | real | kind_phys | in | F | -!! | QC_BL | subgrid_cloud_mixing_ratio_pbl | subgrid cloud cloud mixing ratio from PBL scheme | kg kg-1 | 2 | real | kind_phys | in | F | -!! | CLDFRA_BL | subgrid_cloud_fraction_pbl | subgrid cloud fraction from PBL scheme | frac | 2 | real | kind_phys | in | F | -!! | ps | surface_air_pressure | surface pressure | Pa | 1 | real | kind_phys | in | F | -!! | PBLH | atmosphere_boundary_layer_thickness | PBL thickness | m | 1 | real | kind_phys | in | F | -!! | slmsk | sea_land_ice_mask_real | landmask: sea/land/ice=0/1/2 | flag | 1 | real | kind_phys | in | F | -!! | tsk | surface_skin_temperature | surface temperature | K | 1 | real | kind_phys | in | F | -!! | qsfc | surface_specific_humidity | surface air saturation specific humidity | kg kg-1 | 1 | real | kind_phys | in | F | -!! | snowd | surface_snow_thickness_water_equivalent | water equivalent snow depth over land | mm | 1 | real | kind_phys | in | F | -!! | zorl | surface_roughness_length | surface roughness length in cm | cm | 1 | real | kind_phys | inout | F | -!! | ust | surface_friction_velocity | boundary layer parameter | m s-1 | 1 | real | kind_phys | inout | F | -!! | ustm | surface_friction_velocity_drag | friction velocity isolated for momentum only | m s-1 | 1 | real | kind_phys | inout | F | -!! | zol | surface_stability_parameter | monin obukhov surface stability parameter | none | 1 | real | kind_phys | inout | F | -!! | mol | theta_star | temperature flux divided by ustar (temperature scale) | K | 1 | real | kind_phys | inout | F | -!! | rmol | reciprocal_of_obukhov_length | one over obukhov length | m-1 | 1 | real | kind_phys | inout | F | -!! | fm | Monin-Obukhov_similarity_function_for_momentum | Monin-Obukhov similarity parameter for momentum | none | 1 | real | kind_phys | inout | F | -!! | fh | Monin-Obukhov_similarity_function_for_heat | Monin-Obukhov similarity parameter for heat | none | 1 | real | kind_phys | inout | F | -!! | fm10 | Monin-Obukhov_similarity_function_for_momentum_at_10m | Monin-Obukhov similarity parameter for momentum | none | 1 | real | kind_phys | inout | F | -!! | fh2 | Monin-Obukhov_similarity_function_for_heat_at_2m | Monin-Obukhov similarity parameter for heat | none | 1 | real | kind_phys | inout | F | -!! | wspd | wind_speed_at_lowest_model_layer | wind speed at lowest model level | m s-1 | 1 | real | kind_phys | inout | F | -!! | br | bulk_richardson_number_at_lowest_model_level | bulk Richardson number at the surface | none | 1 | real | kind_phys | inout | F | -!! | ch | surface_drag_wind_speed_for_momentum_in_air | momentum exchange coefficient | m s-1 | 1 | real | kind_phys | inout | F | -!! | hflx | kinematic_surface_upward_sensible_heat_flux | kinematic surface upward sensible heat flux | K m s-1 | 1 | real | kind_phys | inout | F | -!! | QFX | kinematic_surface_upward_latent_heat_flux | kinematic surface upward latent heat flux | kg kg-1 m s-1 | 1 | real | kind_phys | inout | F | -!! | lh | surface_latent_heat | latent heating at the surface (pos = up) | W m-2 | 1 | real | kind_phys | inout | F | -!! | flhc | surface_exchange_coefficient_for_heat | surface exchange coefficient for heat | W m-2 K-1 | 1 | real | kind_phys | inout | F | -!! | flqc | surface_exchange_coefficient_for_moisture | surface exchange coefficient for moisture | kg m-2 s-1 | 1 | real | kind_phys | inout | F | -!! | u10 | x_wind_at_10m | 10 meter u wind speed | m s-1 | 1 | real | kind_phys | inout | F | -!! | v10 | y_wind_at_10m | 10 meter v wind speed | m s-1 | 1 | real | kind_phys | inout | F | -!! | th2 | potential_temperature_at_2m | 2 meter potential temperature | K | 1 | real | kind_phys | inout | F | -!! | t2 | temperature_at_2m | 2 meter temperature | K | 1 | real | kind_phys | inout | F | -!! | q2 | specific_humidity_at_2m | 2 meter specific humidity | kg kg-1 | 1 | real | kind_phys | inout | F | -!! | wstar | surface_wind_enhancement_due_to_convection | surface wind enhancement due to convection | m s-1 | 1 | real | kind_phys | inout | F | -!! | chs2 | surface_exchange_coefficient_for_heat_at_2m | exchange coefficient for heat at 2 meters | m s-1 | 1 | real | kind_phys | inout | F | -!! | cqs2 | surface_exchange_coefficient_for_moisture_at_2m | exchange coefficient for moisture at 2 meters | m s-1 | 1 | real | kind_phys | inout | F | -!! | cda | surface_drag_coefficient_for_momentum_in_air | surface exchange coeff for momentum | none | 1 | real | kind_phys | inout | F | -!! | cka | surface_drag_coefficient_for_heat_and_moisture_in_air | surface exchange coeff heat & moisture | none | 1 | real | kind_phys | inout | F | -!! | stress | surface_wind_stress | surface wind stress | m2 s-2 | 1 | real | kind_phys | inout | F | -!! | bl_mynn_cloudpdf | cloudpdf | flag to determine which cloud PDF to use | flag | 0 | integer | | in | F | -!! | icloud_bl | couple_sgs_clouds_to_radiation_flag | flag for coupling sgs clouds to radiation | flag | 0 | integer | | in | F | -!! | lprnt | flag_print | control flag for diagnostic print out | flag | 0 | logical | | none | F | -!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | -!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | +!! \htmlinclude mynnsfc_wrapper_run.html !! #endif !###=================================================================== diff --git a/physics/module_MYNNSFC_wrapper.meta b/physics/module_MYNNSFC_wrapper.meta new file mode 100644 index 000000000..da86a054b --- /dev/null +++ b/physics/module_MYNNSFC_wrapper.meta @@ -0,0 +1,560 @@ +[ccpp-arg-table] + name = mynnsfc_wrapper_run + type = scheme +[ix] + standard_name = horizontal_dimension + long_name = horizontal dimension + units = count + dimensions = () + type = integer + intent = in + optional = F +[im] + standard_name = horizontal_loop_extent + long_name = horizontal loop extent + units = count + dimensions = () + type = integer + intent = in + optional = F +[levs] + standard_name = vertical_dimension + long_name = vertical layer dimension + units = count + dimensions = () + type = integer + intent = in + optional = F +[iter] + standard_name = ccpp_loop_counter + long_name = loop counter for subcycling loops in CCPP + units = index + dimensions = () + type = integer + intent = in + optional = F +[flag_init] + standard_name = flag_for_first_time_step + long_name = flag signaling first time step for time integration loop + units = flag + dimensions = () + type = logical + intent = in + optional = F +[flag_restart] + standard_name = flag_for_restart + long_name = flag for restart (warmstart) or coldstart + units = flag + dimensions = () + type = logical + intent = in + optional = F +[delt] + standard_name = time_step_for_physics + long_name = time step for physics + units = s + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[dx] + standard_name = cell_size + long_name = size of the grid cell + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[u] + standard_name = x_wind + long_name = x component of layer wind + units = m s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[v] + standard_name = y_wind + long_name = y component of layer wind + units = m s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[t3d] + standard_name = air_temperature + long_name = layer mean air temperature + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[qvsh] + standard_name = water_vapor_specific_humidity + long_name = water vapor specific humidity + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[qc] + standard_name = cloud_condensed_water_mixing_ratio + long_name = ratio of mass of cloud water to mass of dry air plus vapor (without condensates) + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[prsl] + standard_name = air_pressure + long_name = mean layer pressure + units = Pa + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[phii] + standard_name = geopotential_at_interface + long_name = geopotential at model layer interfaces + units = m2 s-2 + dimensions = (horizontal_dimension,vertical_dimension_plus_one) + type = real + kind = kind_phys + intent = in + optional = F +[exner] + standard_name = dimensionless_exner_function_at_model_layers + long_name = Exner function at layers + units = none + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[tsq] + standard_name = t_prime_squared + long_name = temperature fluctuation squared + units = K2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[qsq] + standard_name = q_prime_squared + long_name = water vapor fluctuation squared + units = kg2 kg-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[cov] + standard_name = t_prime_q_prime + long_name = covariance of temperature and moisture + units = K kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[el_pbl] + standard_name = mixing_length + long_name = mixing length in meters + units = m + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[Sh3D] + standard_name = stability_function_for_heat + long_name = stability function for heat + units = none + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[QC_BL] + standard_name = subgrid_cloud_mixing_ratio_pbl + long_name = subgrid cloud cloud mixing ratio from PBL scheme + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[CLDFRA_BL] + standard_name = subgrid_cloud_fraction_pbl + long_name = subgrid cloud fraction from PBL scheme + units = frac + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[ps] + standard_name = surface_air_pressure + long_name = surface pressure + units = Pa + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[PBLH] + standard_name = atmosphere_boundary_layer_thickness + long_name = PBL thickness + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[slmsk] + standard_name = sea_land_ice_mask_real + long_name = landmask: sea/land/ice=0/1/2 + units = flag + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[tsk] + standard_name = surface_skin_temperature + long_name = surface temperature + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[qsfc] + standard_name = surface_specific_humidity + long_name = surface air saturation specific humidity + units = kg kg-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[snowd] + standard_name = surface_snow_thickness_water_equivalent + long_name = water equivalent snow depth over land + units = mm + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[zorl] + standard_name = surface_roughness_length + long_name = surface roughness length in cm + units = cm + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[ust] + standard_name = surface_friction_velocity + long_name = boundary layer parameter + units = m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[ustm] + standard_name = surface_friction_velocity_drag + long_name = friction velocity isolated for momentum only + units = m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[zol] + standard_name = surface_stability_parameter + long_name = monin obukhov surface stability parameter + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[mol] + standard_name = theta_star + long_name = temperature flux divided by ustar (temperature scale) + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[rmol] + standard_name = reciprocal_of_obukhov_length + long_name = one over obukhov length + units = m-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[fm] + standard_name = Monin_Obukhov_similarity_function_for_momentum + long_name = Monin-Obukhov similarity parameter for momentum + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[fh] + standard_name = Monin_Obukhov_similarity_function_for_heat + long_name = Monin-Obukhov similarity parameter for heat + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[fm10] + standard_name = Monin_Obukhov_similarity_function_for_momentum_at_10m + long_name = Monin-Obukhov similarity parameter for momentum + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[fh2] + standard_name = Monin_Obukhov_similarity_function_for_heat_at_2m + long_name = Monin-Obukhov similarity parameter for heat + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[wspd] + standard_name = wind_speed_at_lowest_model_layer + long_name = wind speed at lowest model level + units = m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[br] + standard_name = bulk_richardson_number_at_lowest_model_level + long_name = bulk Richardson number at the surface + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[ch] + standard_name = surface_drag_wind_speed_for_momentum_in_air + long_name = momentum exchange coefficient + units = m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[hflx] + standard_name = kinematic_surface_upward_sensible_heat_flux + long_name = kinematic surface upward sensible heat flux + units = K m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[QFX] + standard_name = kinematic_surface_upward_latent_heat_flux + long_name = kinematic surface upward latent heat flux + units = kg kg-1 m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[lh] + standard_name = surface_latent_heat + long_name = latent heating at the surface (pos = up) + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[flhc] + standard_name = surface_exchange_coefficient_for_heat + long_name = surface exchange coefficient for heat + units = W m-2 K-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[flqc] + standard_name = surface_exchange_coefficient_for_moisture + long_name = surface exchange coefficient for moisture + units = kg m-2 s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[u10] + standard_name = x_wind_at_10m + long_name = 10 meter u wind speed + units = m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[v10] + standard_name = y_wind_at_10m + long_name = 10 meter v wind speed + units = m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[th2] + standard_name = potential_temperature_at_2m + long_name = 2 meter potential temperature + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[t2] + standard_name = temperature_at_2m + long_name = 2 meter temperature + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[q2] + standard_name = specific_humidity_at_2m + long_name = 2 meter specific humidity + units = kg kg-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[wstar] + standard_name = surface_wind_enhancement_due_to_convection + long_name = surface wind enhancement due to convection + units = m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[chs2] + standard_name = surface_exchange_coefficient_for_heat_at_2m + long_name = exchange coefficient for heat at 2 meters + units = m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[cqs2] + standard_name = surface_exchange_coefficient_for_moisture_at_2m + long_name = exchange coefficient for moisture at 2 meters + units = m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[cda] + standard_name = surface_drag_coefficient_for_momentum_in_air + long_name = surface exchange coeff for momentum + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[cka] + standard_name = surface_drag_coefficient_for_heat_and_moisture_in_air + long_name = surface exchange coeff heat & moisture + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[stress] + standard_name = surface_wind_stress + long_name = surface wind stress + units = m2 s-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[bl_mynn_cloudpdf] + standard_name = cloudpdf + long_name = flag to determine which cloud PDF to use + units = flag + dimensions = () + type = integer + intent = in + optional = F +[icloud_bl] + standard_name = couple_sgs_clouds_to_radiation_flag + long_name = flag for coupling sgs clouds to radiation + units = flag + dimensions = () + type = integer + intent = in + optional = F +[lprnt] + standard_name = flag_print + long_name = control flag for diagnostic print out + units = flag + dimensions = () + type = logical + intent = in + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F diff --git a/physics/module_MYNNrad_post.F90 b/physics/module_MYNNrad_post.F90 index 987ad1efe..1364db62e 100644 --- a/physics/module_MYNNrad_post.F90 +++ b/physics/module_MYNNrad_post.F90 @@ -17,21 +17,12 @@ end subroutine mynnrad_post_finalize !! This interstitial code restores the original resolved-scale clouds (qc and qi). #if 0 !! \section arg_table_mynnrad_post_run Argument Table -!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | -!! |---------------------|-----------------------------------------------------------------------------|----------------------------------------------------------------------------|---------|------|-----------|-----------|--------|----------| -!! | ix | horizontal_dimension | horizontal dimension | count | 0 | integer | | in | F | -!! | im | horizontal_loop_extent | horizontal loop extent | count | 0 | integer | | in | F | -!! | levs | vertical_dimension | vertical layer dimension | count | 0 | integer | | in | F | -!! | qc | cloud_condensed_water_mixing_ratio | moist (dry+vapor, no condensates) mixing ratio of cloud water (condensate) | kg kg-1 | 2 | real | kind_phys | out | F | -!! | qi | ice_water_mixing_ratio | moist (dry+vapor, no condensates) mixing ratio of ice water | kg kg-1 | 2 | real | kind_phys | out | F | -!! | qc_save | cloud_condensed_water_mixing_ratio_save | moist (dry+vapor, no condensates) mixing ratio of cloud water (condensate) before entering a physics scheme | kg kg-1 | 2 | real | kind_phys | in | F | -!! | qi_save | ice_water_mixing_ratio_save | moist (dry+vapor, no condensates) mixing ratio of ice water before entering a physics scheme | kg kg-1 | 2 | real | kind_phys | in | F | -!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | -!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | +!! \htmlinclude mynnrad_post_run.html !! #endif SUBROUTINE mynnrad_post_run( & & ix,im,levs, & + & flag_init,flag_restart, & & qc,qi, & & qc_save, qi_save, & & errmsg, errflg ) @@ -44,6 +35,7 @@ SUBROUTINE mynnrad_post_run( & !------------------------------------------------------------------- integer, intent(in) :: ix, im, levs + logical, intent(in) :: flag_init, flag_restart real(kind=kind_phys), dimension(im,levs), intent(out) :: qc, qi real(kind=kind_phys), dimension(im,levs), intent(in) :: qc_save, qi_save character(len=*), intent(out) :: errmsg @@ -58,6 +50,11 @@ SUBROUTINE mynnrad_post_run( & !write(0,*)"==============================================" !write(0,*)"in mynn rad post" + if (flag_init .and. (.not. flag_restart)) then + !write (0,*) 'Skip MYNNrad_post flag_init = ', flag_init + return + endif + ! Add subgrid cloud information: do k = 1, levs do i = 1, im diff --git a/physics/module_MYNNrad_post.meta b/physics/module_MYNNrad_post.meta new file mode 100644 index 000000000..f6d1a41d7 --- /dev/null +++ b/physics/module_MYNNrad_post.meta @@ -0,0 +1,96 @@ +[ccpp-arg-table] + name = mynnrad_post_run + type = scheme +[ix] + standard_name = horizontal_dimension + long_name = horizontal dimension + units = count + dimensions = () + type = integer + intent = in + optional = F +[im] + standard_name = horizontal_loop_extent + long_name = horizontal loop extent + units = count + dimensions = () + type = integer + intent = in + optional = F +[levs] + standard_name = vertical_dimension + long_name = vertical layer dimension + units = count + dimensions = () + type = integer + intent = in + optional = F +[flag_init] + standard_name = flag_for_first_time_step + long_name = flag signaling first time step for time integration loop + units = flag + dimensions = () + type = logical + intent = in + optional = F +[flag_restart] + standard_name = flag_for_restart + long_name = flag for restart (warmstart) or coldstart + units = flag + dimensions = () + type = logical + intent = in + optional = F +[qc] + standard_name = cloud_condensed_water_mixing_ratio + long_name = no condensates) ratio of mass of cloud water to mass of dry air plus vapor (without condensates) + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[qi] + standard_name = ice_water_mixing_ratio + long_name = ratio of mass of ice water to mass of dry air plus vapor (without condensates) + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[qc_save] + standard_name = cloud_condensed_water_mixing_ratio_save + long_name = ratio of mass of cloud water to mass of dry air plus vapor (without condensates) before entering a physics scheme + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[qi_save] + standard_name = ice_water_mixing_ratio_save + long_name = ratio of mass of ice water to mass of dry air plus vapor (without condensates) before entering a physics scheme + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F diff --git a/physics/module_MYNNrad_pre.F90 b/physics/module_MYNNrad_pre.F90 index 7b8af5962..95dc95445 100644 --- a/physics/module_MYNNrad_pre.F90 +++ b/physics/module_MYNNrad_pre.F90 @@ -18,31 +18,21 @@ end subroutine mynnrad_pre_finalize !! This interstitial code adds the subgrid clouds to the resolved-scale clouds if there is no resolved-scale clouds in that particular grid box. #if 0 !> \section arg_table_mynnrad_pre_run Argument Table -!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | -!! |---------------------|-----------------------------------------------------------------------------|----------------------------------------------------------------------------|---------|------|-----------|-----------|--------|----------| -!! | ix | horizontal_dimension | horizontal dimension | count | 0 | integer | | in | F | -!! | im | horizontal_loop_extent | horizontal loop extent | count | 0 | integer | | in | F | -!! | levs | vertical_dimension | vertical layer dimension | count | 0 | integer | | in | F | -!! | qc | cloud_condensed_water_mixing_ratio | moist (dry+vapor, no condensates) mixing ratio of cloud water (condensate) | kg kg-1 | 2 | real | kind_phys | inout | F | -!! | qi | ice_water_mixing_ratio | moist (dry+vapor, no condensates) mixing ratio of ice water | kg kg-1 | 2 | real | kind_phys | inout | F | -!! | T3D | air_temperature | layer mean air temperature | K | 2 | real | kind_phys | in | F | -!! | qc_save | cloud_condensed_water_mixing_ratio_save | moist (dry+vapor, no condensates) mixing ratio of cloud water (condensate) before entering a physics scheme | kg kg-1 | 2 | real | kind_phys | out | F | -!! | qi_save | ice_water_mixing_ratio_save | moist (dry+vapor, no condensates) mixing ratio of ice water before entering a physics scheme | kg kg-1 | 2 | real | kind_phys | out | F | -!! | QC_BL | subgrid_cloud_mixing_ratio_pbl | subgrid cloud cloud mixing ratio from PBL scheme | kg kg-1 | 2 | real | kind_phys | in | F | -!! | CLDFRA_BL | subgrid_cloud_fraction_pbl | subgrid cloud fraction from PBL scheme | frac | 2 | real | kind_phys | in | F | -!! | delp | layer_pressure_thickness_for_radiation | layer pressure thickness on radiation levels | hPa | 2 | real | kind_phys | out | F | -!! | clouds1 | total_cloud_fraction | layer total cloud fraction | frac | 2 | real | kind_phys | inout | F | -!! | clouds2 | cloud_liquid_water_path | layer cloud liquid water path | g m-2 | 2 | real | kind_phys | inout | F | -!! | clouds3 | mean_effective_radius_for_liquid_cloud | mean effective radius for liquid cloud | micron | 2 | real | kind_phys | inout | F | -!! | clouds4 | cloud_ice_water_path | layer cloud ice water path | g m-2 | 2 | real | kind_phys | inout | F | -!! | clouds5 | mean_effective_radius_for_ice_cloud | mean effective radius for ice cloud | micron | 2 | real | kind_phys | inout | F | -!! | slmsk | sea_land_ice_mask_real | landmask: sea/land/ice=0/1/2 | flag | 1 | real | kind_phys | in | F | -!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | -!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | +!! \htmlinclude mynnrad_pre_run.html !! #endif +! +! cloud array description: ! +! clouds(:,:,1) - layer total cloud fraction ! +! clouds(:,:,2) - layer cloud liq water path ! +! clouds(:,:,3) - mean effective radius for liquid cloud ! +! clouds(:,:,4) - layer cloud ice water path ! +! clouds(:,:,5) - mean effective radius for ice cloud ! +! +!###=================================================================== SUBROUTINE mynnrad_pre_run( & & ix,im,levs, & + & flag_init,flag_restart, & & qc, qi, T3D, & & qc_save, qi_save, & & qc_bl,cldfra_bl, & @@ -61,6 +51,7 @@ SUBROUTINE mynnrad_pre_run( & ! Interface variables real (kind=kind_phys), parameter :: gfac=1.0e5/con_g integer, intent(in) :: ix, im, levs + logical, intent(in) :: flag_init, flag_restart real(kind=kind_phys), dimension(im,levs), intent(inout) :: qc, qi real(kind=kind_phys), dimension(im,levs), intent(in) :: T3D,delp real(kind=kind_phys), dimension(im,levs), intent(inout) :: & @@ -82,12 +73,17 @@ SUBROUTINE mynnrad_pre_run( & !write(0,*)"==============================================" !write(0,*)"in mynn rad pre" + if (flag_init .and. (.not. flag_restart)) then + !write (0,*) 'Skip MYNNrad_pre flag_init = ', flag_init + return + endif ! Add subgrid cloud information: do k = 1, levs do i = 1, im qc_save(i,k) = qc(i,k) qi_save(i,k) = qi(i,k) + clouds1(i,k) = CLDFRA_BL(i,k) IF (qc(i,k) < 1.E-6 .AND. qi(i,k) < 1.E-8 .AND. CLDFRA_BL(i,k)>0.001) THEN !Partition the BL clouds into water & ice according to a linear @@ -95,8 +91,8 @@ SUBROUTINE mynnrad_pre_run( & !one 3D array for both cloud water & ice. ! Wice = 1. - MIN(1., MAX(0., (t(i,k)-254.)/15.)) ! Wh2o = 1. - Wice - clouds1(i,k)=MAX(clouds1(i,k),CLDFRA_BL(i,k)) - clouds1(i,k)=MAX(0.0,MIN(1.0,clouds1(i,k))) + !clouds1(i,k)=MAX(clouds1(i,k),CLDFRA_BL(i,k)) + !clouds1(i,k)=MAX(0.0,MIN(1.0,clouds1(i,k))) qc(i,k) = QC_BL(i,k)*(MIN(1., MAX(0., (T3D(i,k)-254.)/15.)))*CLDFRA_BL(i,k) qi(i,k) = QC_BL(i,k)*(1. - MIN(1., MAX(0., (T3D(i,k)-254.)/15.)))*CLDFRA_BL(i,k) diff --git a/physics/module_MYNNrad_pre.meta b/physics/module_MYNNrad_pre.meta new file mode 100644 index 000000000..3b6a9ccbc --- /dev/null +++ b/physics/module_MYNNrad_pre.meta @@ -0,0 +1,186 @@ +[ccpp-arg-table] + name = mynnrad_pre_run + type = scheme +[ix] + standard_name = horizontal_dimension + long_name = horizontal dimension + units = count + dimensions = () + type = integer + intent = in + optional = F +[im] + standard_name = horizontal_loop_extent + long_name = horizontal loop extent + units = count + dimensions = () + type = integer + intent = in + optional = F +[levs] + standard_name = vertical_dimension + long_name = vertical layer dimension + units = count + dimensions = () + type = integer + intent = in + optional = F +[flag_init] + standard_name = flag_for_first_time_step + long_name = flag signaling first time step for time integration loop + units = flag + dimensions = () + type = logical + intent = in + optional = F +[flag_restart] + standard_name = flag_for_restart + long_name = flag for restart (warmstart) or coldstart + units = flag + dimensions = () + type = logical + intent = in + optional = F +[qc] + standard_name = cloud_condensed_water_mixing_ratio + long_name = ratio of mass of cloud water to mass of dry air plus vapor (without condensates) + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[qi] + standard_name = ice_water_mixing_ratio + long_name = ratio of mass of ice water to mass of dry air plus vapor (without condensates) + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[T3D] + standard_name = air_temperature + long_name = layer mean air temperature + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[qc_save] + standard_name = cloud_condensed_water_mixing_ratio_save + long_name = ratio of mass of cloud water to mass of dry air plus vapor (without condensates) before entering a physics scheme + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[qi_save] + standard_name = ice_water_mixing_ratio_save + long_name = ratio of mass of ice water to mass of dry air plus vapor (without condensates) before entering a physics scheme + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[QC_BL] + standard_name = subgrid_cloud_mixing_ratio_pbl + long_name = subgrid cloud cloud mixing ratio from PBL scheme + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[CLDFRA_BL] + standard_name = subgrid_cloud_fraction_pbl + long_name = subgrid cloud fraction from PBL scheme + units = frac + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[delp] + standard_name = layer_pressure_thickness_for_radiation + long_name = layer pressure thickness on radiation levels + units = hPa + dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + type = real + kind = kind_phys + intent = out + optional = F +[clouds1] + standard_name = total_cloud_fraction + long_name = layer total cloud fraction + units = frac + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[clouds2] + standard_name = cloud_liquid_water_path + long_name = layer cloud liquid water path + units = g m-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[clouds3] + standard_name = mean_effective_radius_for_liquid_cloud + long_name = mean effective radius for liquid cloud + units = micron + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[clouds4] + standard_name = cloud_ice_water_path + long_name = layer cloud ice water path + units = g m-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[clouds5] + standard_name = mean_effective_radius_for_ice_cloud + long_name = mean effective radius for ice cloud + units = micron + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[slmsk] + standard_name = sea_land_ice_mask_real + long_name = landmask: sea/land/ice=0/1/2 + units = flag + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F diff --git a/physics/module_SF_JSFC.F90 b/physics/module_SF_JSFC.F90 new file mode 100755 index 000000000..8d67a81cd --- /dev/null +++ b/physics/module_SF_JSFC.F90 @@ -0,0 +1,1323 @@ +!----------------------------------------------------------------------- +! + MODULE MODULE_SF_JSFC +! +!----------------------------------------------------------------------- +! +!*** THE J SURFACE SCHEME +! +!----------------------------------------------------------------------- +! +! USE MODULE_INCLUDE +! +! USE MODULE_CONSTANTS,ONLY : A2,A3,A4,CP,ELWV & +! ,G,P608,PI,PQ0,R_D,R_V,CAPPA +! +!----------------------------------------------------------------------- +! + + USE machine, only: kfpt => kind_phys + + IMPLICIT NONE +! +!----------------------------------------------------------------------- +! +! integer,parameter :: isingle=selected_int_kind(r=9) +! integer,parameter :: idouble=selected_int_kind(r=18) +! integer,parameter :: single=selected_real_kind(p=6,r=37) +! integer,parameter :: double=selected_real_kind(p=13,r=200) +! +! integer,parameter:: & +! klog=4 & +! ,kint=isingle & +! ,kdin=idouble & +! ,kfpt=single & +! ,kdbl=double + +! real (kind=kfpt),parameter :: r4_in=x'ffbfffff' +! real (kind=kdbl),parameter :: r8_in=x'fff7ffffffffffff' +! integer(kind=kint),parameter :: i4_in=-999 ! -huge(1) +! + ! integer,parameter:: & + ! klog=4 & ! logical variables + ! ,kint=4 & ! integer variables + ! !,kfpt=4 & ! floating point variables + ! ,kfpt=8 & ! floating point variables + ! ,kdbl=8 ! double precision +! + PRIVATE +! + PUBLIC :: JSFC_INIT,JSFC +! + INTEGER :: ITRMX=5 ! Iteration count for mixing length computation +! + REAL(kind=kfpt),PARAMETER :: VKARMAN=0.4 + + REAL(kind=kfpt),PARAMETER :: A2=17.2693882,A3=273.15,A4=35.86,CP=1004.6 & + ,ELWV=2.501e6,EPSQ2=0.02,G=9.8060226 & + ,PQ0=379.90516,R_D=287.04,R_V=461.6 & + ,P608=R_V/R_D-1.,CAPPA=R_D/CP & + ,PI=3.141592653589793 + + REAL(kind=kfpt),PARAMETER :: XLV=ELWV + REAL(kind=kfpt),PARAMETER :: ELOCP=2.72E6/CP + REAL(kind=kfpt),PARAMETER :: A2S=17.2693882,A3S=273.16,A4S=35.86 + REAL(kind=kfpt),PARAMETER :: GLKBR=10.,GLKBS=30. & + ,QVISC=2.1E-5,RIC=0.505,SMALL=0.35 & + ,SQPR=0.84,SQSC=0.84,SQVISC=258.2 & + ,TVISC=2.1E-5 & + ,USTC=0.7,USTR=0.225,VISC=1.5E-5 & + ,WWST=1.2,ZTFC=1. + REAL(kind=kfpt),PARAMETER :: SEAFC=0.98,PQ0SEA=PQ0*SEAFC + + REAL(kind=kfpt),PARAMETER :: CZIV=SMALL*GLKBS,GRRS=GLKBR/GLKBS + + REAL(kind=kfpt),PARAMETER :: RTVISC=1./TVISC,RVISC=1./VISC & + ,ZQRZT=SQSC/SQPR + + REAL(kind=kfpt),PARAMETER :: USTFC=0.018/G & + ,FZQ1=RTVISC*QVISC*ZQRZT & + ,FZQ2=RTVISC*QVISC*ZQRZT & + ,FZT1=RVISC *TVISC*SQPR & + ,FZT2=CZIV*GRRS*TVISC*SQPR & + ,FZU1=CZIV*VISC + REAL(kind=kfpt),PARAMETER :: WWST2=WWST*WWST & + ,RQVISC=1./QVISC + + REAL(kind=kfpt),PARAMETER :: RCAP=1./CAPPA + REAL(kind=kfpt),PARAMETER :: GOCP02=G/CP*2.,GOCP10=G/CP*10. + REAL(kind=kfpt),PARAMETER :: EPSU2=1.E-6,EPSUST=1.E-9,EPSZT=1.E-28 + REAL(kind=kfpt),PARAMETER :: CZIL=0.1,EXCML=0.0001,EXCMS=0.0001 & + & ,FH=1.10,TOPOFAC=9.0e-6 + + REAL(kind=kfpt),PARAMETER :: ZILFC=-CZIL*VKARMAN*SQVISC + REAL(kind=kfpt),PARAMETER :: EPSQ=1.e-9 +! +!----------------------------------------------------------------------- + INTEGER, PARAMETER :: KZTM=10001,KZTM2=KZTM-2 +! + REAL(kind=kfpt),PRIVATE,SAVE :: & + DZETA1,DZETA2,FH01,FH02,ZTMAX1,ZTMAX2,ZTMIN1,ZTMIN2 +! + REAL(kind=kfpt),DIMENSION(KZTM),PRIVATE,SAVE :: & + PSIH1,PSIH2,PSIM1,PSIM2 +! + INTEGER :: IERR +! +!----------------------------------------------------------------------- +! + CONTAINS +! +!----------------------------------------------------------------------- +!&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& +!----------------------------------------------------------------------- + SUBROUTINE JSFC(FLAG_ITER,ITER,ME & + & ,NTSD,EPSQ2,HT,DZ & + & ,PHMID,PHINT,TH,T,Q,QC,U,V,Q2 & + & ,TSK,QSFC,THZ0,QZ0,UZ0,VZ0 & + & ,XLAND & + & ,USTAR,Z0,Z0BASE,PBLH,MAVAIL,RMOL & + & ,AKHS,AKMS,CHKLOWQ,HLFLX,RIB & + & ,CM,CH,STRESS,FFM,FFH,WIND,FM10,FH2 & + & ,A1U,A1T,A1Q & + & ,IDS,IDE,JDS,JDE,KDS,KDE & + & ,IMS,IME,JMS,JME,KMS,KME & + & ,ITS,ITE,JTS,JTE,KTS,LM) +! +!----------------------------------------------------------------------- +! SUBROUTINE JSFC(NTSD,EPSQ2,HT,DZ & +! & ,PHMID,PHINT,TH,T,Q,QC,U,V,Q2 & +! & ,TSK,QSFC,THZ0,QZ0,UZ0,VZ0 & +! & ,XLAND & +! & ,VEGFRC,SNOWC & !added 5/17/2013 +! & ,USTAR,Z0,Z0BASE,PBLH,MAVAIL,RMOL & +! & ,AKHS,AKMS & +! & ,CHS,CHS2,CQS2,HFX,QFX,FLX_LH,FLHC,FLQC & +! & ,QGH,CPM,CT & +! & ,U10,V10,T02,TH02,TSHLTR,TH10,Q02,QSHLTR,Q10 & +! & ,PSHLTR,RIB & ! Added Bulk Richardson No. +! & ,IDS,IDE,JDS,JDE,KDS,KDE & +! & ,IMS,IME,JMS,JME,KMS,KME & +! & ,ITS,ITE,JTS,JTE,KTS,LM) +!---------------------------------------------------------------------- +! + IMPLICIT NONE +! +!---------------------------------------------------------------------- + INTEGER,INTENT(IN) :: IDS,IDE,JDS,JDE,KDS,KDE & + & ,IMS,IME,JMS,JME,KMS,KME & + & ,ITS,ITE,JTS,JTE,KTS,LM +! + INTEGER,INTENT(IN) :: NTSD,ITER,ME + LOGICAL,DIMENSION(IMS:IME,JMS:JME),INTENT(IN) :: FLAG_ITER + real(kind=kfpt),dimension(1:lm),intent(in):: epsq2 +! + REAL(kind=kfpt),DIMENSION(IMS:IME,JMS:JME),INTENT(IN) :: HT,MAVAIL,TSK & + & ,XLAND,Z0BASE +! & ,VEGFRC,SNOWC +! + REAL(kind=kfpt),DIMENSION(IMS:IME,JMS:JME,1:LM),INTENT(IN) :: DZ,PHMID +! + REAL(kind=kfpt),DIMENSION(IMS:IME,JMS:JME,1:LM+1),INTENT(IN) :: PHINT +! + REAL(kind=kfpt),DIMENSION(IMS:IME,JMS:JME,1:LM),INTENT(IN) :: Q,QC,U,V,Q2,T,TH +! +! REAL(kind=kfpt),DIMENSION(IMS:IME,JMS:JME),INTENT(OUT) :: FLX_LH,HFX,PSHLTR & +! & ,QFX,Q10,QSHLTR & +! & ,TH10,TSHLTR,T02 & +! & ,U10,V10,TH02,Q02 + REAL(kind=kfpt),DIMENSION(IMS:IME,JMS:JME) :: FLX_LH,HFX & + & ,QFX,Q10,TH10,T02 & + & ,U10,V10,TH02,Q02 + REAL(kind=kfpt),DIMENSION(IMS:IME,JMS:JME) :: PSHLTR,QSHLTR,TSHLTR +! + REAL(kind=kfpt),DIMENSION(IMS:IME,JMS:JME),INTENT(INOUT) :: AKHS,AKMS & + & ,PBLH,QSFC,RIB +! + REAL(kind=kfpt),DIMENSION(IMS:IME,JMS:JME),INTENT(INOUT) :: QZ0,RMOL,THZ0 & + & ,USTAR,UZ0,VZ0 & + & ,Z0 +! + REAL(kind=kfpt),DIMENSION(IMS:IME,JMS:JME),INTENT(OUT) :: HLFLX,CHKLOWQ + REAL(kind=kfpt),DIMENSION(IMS:IME,JMS:JME),INTENT(OUT) :: CM,CH,STRESS,FFM & + & ,FFH,WIND,FM10,FH2 & + & ,A1U,A1T,A1Q +! +! REAL(kind=kfpt),DIMENSION(IMS:IME,JMS:JME),INTENT(OUT) :: CHS,CHS2,CQS2 & +! & ,CPM,CT,FLHC,FLQC & +! & ,QGH + REAL(kind=kfpt),DIMENSION(IMS:IME,JMS:JME) :: CHS,CHS2,CQS2 & + & ,FLHC,FLQC + REAL(kind=kfpt),DIMENSION(IMS:IME,JMS:JME) :: QGH,CPM,CT +!---------------------------------------------------------------------- +!*** +!*** LOCAL VARIABLES +!*** + INTEGER :: I,J,K,LMH,LPBL +! + REAL(kind=kfpt) :: A,APESFC,B,BTGX,CWMLOW & + & ,DQDT,DTDIF,DTDT,DUDT,DVDT & + & ,FIS & + & ,P02P,P10P,PLOW,PSFC,PTOP,QLOW,QS02,QS10 & + & ,RAPA,RAPA02,RAPA10,RATIOMX,RDZ,SEAMASK,SM & + & ,T02P,T10P,TEM,TH02P,TH10P,THLOW,THELOW,THM & + & ,TLOW,TZ0,ULOW,VLOW,ZSL +! + REAL(kind=kfpt),DIMENSION(KTS:LM) :: CWMK,PK,Q2K,QK,THEK,THK,TK,UK,VK +! + REAL(kind=kfpt),DIMENSION(KTS:LM-1) :: EL,ELM +! + REAL(kind=kfpt),DIMENSION(KTS:LM+1) :: ZHK +! + REAL(kind=kfpt),DIMENSION(ITS:ITE,JTS:JTE) :: THSK +! + REAL(kind=kfpt),DIMENSION(ITS:ITE,JTS:JTE,KTS:LM+1) :: ZINT +! +!---------------------------------------------------------------------- +!********************************************************************** +!---------------------------------------------------------------------- +! +!*** MAKE PREPARATIONS +! +!---------------------------------------------------------------------- + DO J=JTS,JTE + DO I=ITS,ITE + IF(FLAG_ITER(I,J))THEN + DO K=KTS,LM+1 + ZINT(I,J,K)=0. + ENDDO + END IF + ENDDO + ENDDO +! + DO J=JTS,JTE + DO I=ITS,ITE + IF(FLAG_ITER(I,J))THEN + ZINT(I,J,LM+1)=HT(I,J) ! Z at bottom of lowest sigma layer + PBLH(I,J)=-1. +! +!!!!!!!!! +!!!!!! UNCOMMENT THESE LINES IF USING ETA COORDINATES +!!!!!!!!! +!!!!!! ZINT(I,J,LM+1)=1.E-4 ! Z of bottom of lowest eta layer +!!!!!! ZHK(LM+1)=1.E-4 ! Z of bottom of lowest eta layer +! + END IF + ENDDO + ENDDO +! + DO J=JTS,JTE + DO I=ITS,ITE + IF(FLAG_ITER(I,J))THEN + DO K=LM,KTS,-1 + ZINT(I,J,K)=ZINT(I,J,K+1)+DZ(I,J,K) + ENDDO + END IF + ENDDO + ENDDO +! + IF(NTSD==0.and.iter==1) then + DO J=JTS,JTE + DO I=ITS,ITE + IF(FLAG_ITER(I,J))THEN + USTAR(I,J)=0.1 + FIS=HT(I,J)*G + SM=XLAND(I,J)-1. +!!! Z0(I,J)=SM*Z0SEA+(1.-SM)*(Z0(I,J)*Z0MAX+FIS*FCM+Z0LAND) +!!! Z0(I,J)=SM*Z0SEA+(1.-SM)*(Z0(I,J)*Z0MAX+FIS*FCM+Z0LAND) + END IF + ENDDO + ENDDO + ENDIF +! +!!!! IF(NTSD==1)THEN + DO J=JTS,JTE + DO I=ITS,ITE + CT(I,J)=0. + ENDDO + ENDDO +!!!! ENDIF +! +!...................................................................... +!$omp parallel do & +!$omp private (j,i,lmh,ptop,psfc,seamask,k,thk,tk,ratiomx,qk,pk, & +!$omp cwmk,thek,q2k,zhk,uk,vk,lpbl,plow,tlow,thlow,thelow, & +!$omp qlow,cwmlow,ulow,vlow,zsl,apesfc,tz0,rapa,th02p,th10p, & +!$omp rapa02,rapa10,t02p,t10p,p02p,p10p,qs02,qs10) +!...................................................................... +!---------------------------------------------------------------------- + setup_integration: DO J=JTS,JTE +!---------------------------------------------------------------------- +! + DO I=ITS,ITE + IF(FLAG_ITER(I,J))THEN +! +!*** LOWEST LAYER ABOVE GROUND MUST BE FLIPPED +! + LMH=LM +! + PTOP=PHINT(I,J,1) + PSFC=PHINT(I,J,LMH+1) +! Define THSK here (for first timestep mostly) + THSK(I,J)=TSK(I,J)/(PSFC*1.E-5)**CAPPA +! +!*** CONVERT LAND MASK (1 FOR SEA; 0 FOR LAND) +! + SEAMASK=XLAND(I,J)-1. +! +!*** FILL 1-D VERTICAL ARRAYS +! + DO K=LM,KTS,-1 + THK(K)=TH(I,J,K) + TK(K)=T(I,J,K) + QK(K)=Q(I,J,K) + PK(K)=PHMID(I,J,K) + CWMK(K)=QC(I,J,K) + THEK(K)=(CWMK(K)*(-ELOCP/TK(K))+1.)*THK(K) + Q2K(K)=Q2(I,J,K) +! +! +!*** COMPUTE THE HEIGHTS OF THE LAYER INTERFACES +! + ZHK(K)=ZINT(I,J,K) +! + ENDDO + ZHK(LM+1)=HT(I,J) ! Z at bottom of lowest sigma layer +! + DO K=LM,KTS,-1 + UK(K)=U(I,J,K) + VK(K)=V(I,J,K) + ENDDO +! +!*** FIND THE HEIGHT OF THE PBL +! + LPBL=LMH + DO K=LMH-1,1,-1 + IF(Q2K(K)<=EPSQ2(K)*FH) THEN + LPBL=K + GO TO 110 + ENDIF + ENDDO +! + LPBL=1 +! +!----------------------------------------------------------------------- +!--------------THE HEIGHT OF THE PBL------------------------------------ +!----------------------------------------------------------------------- +! + 110 PBLH(I,J)=ZHK(LPBL)-ZHK(LMH+1) +! +!---------------------------------------------------------------------- + IF(QC(I,J,LM).GT.EPSQ)THEN + CHKLOWQ(I,J)=0. + ELSE + CHKLOWQ(I,J)=1. + ENDIF +!*** +!*** FIND THE SURFACE EXCHANGE COEFFICIENTS +!*** +!---------------------------------------------------------------------- + PLOW=PK(LMH) + TLOW=TK(LMH) + THLOW=THK(LMH) + THELOW=THEK(LMH) + QLOW=QK(LMH) + CWMLOW=CWMK(LMH) + ULOW=UK(LMH) + VLOW=VK(LMH) + ZSL=(ZHK(LMH)-ZHK(LMH+1))*0.5 +! if(me.eq.0)print*,'ZSL,ZHK(LMH),ZHK(LMH+1,LMH=',ZSL,ZHK(LMH),ZHK(LMH+1),LMH + APESFC=(PSFC*1.E-5)**CAPPA + if(NTSD==0) then + TZ0=TSK(I,J) + else + TZ0=THZ0(I,J)*APESFC + endif +! + CALL SFCDIF(NTSD,SEAMASK,THSK(I,J),QSFC(I,J),PSFC & + & ,UZ0(I,J),VZ0(I,J),TZ0,THZ0(I,J),QZ0(I,J) & + & ,USTAR(I,J),Z0(I,J),Z0BASE(I,J),CT(I,J),RMOL(I,J) & + & ,AKMS(I,J),AKHS(I,J),PBLH(I,J),MAVAIL(I,J) & + & ,CHS(I,J),CHS2(I,J),CQS2(I,J) & + & ,HFX(I,J),QFX(I,J),FLX_LH(I,J) & + & ,FLHC(I,J),FLQC(I,J),QGH(I,J),CPM(I,J) & + & ,ULOW,VLOW,TLOW,THLOW,THELOW,QLOW,CWMLOW & + & ,ZSL,PLOW,HLFLX(I,J) & +! & ,VEGFRC(I,J),SNOWC(I,J) & !added 5/17/2013 + & ,U10(I,J),V10(I,J),TSHLTR(I,J),TH10(I,J) & + & ,QSHLTR(I,J),Q10(I,J),PSHLTR(I,J) & + & ,FFM(I,J),FFH(I,J),FM10(I,J),FH2(I,J) & + & ,A1U(I,J),A1T(I,J),A1Q(I,J) & + & ,IDS,IDE,JDS,JDE,KDS,KDE & + & ,IMS,IME,JMS,JME,KMS,KME & + & ,ITS,ITE,JTS,JTE,KTS,LM,I,J,ZHK(LMH+1),RIB(I,J)) ! Added Bulk Richardson No. +! +!*** REMOVE SUPERATURATION AT 2M AND 10M +! + RAPA=APESFC + TH02P=TSHLTR(I,J) + TH10P=TH10(I,J) + TH02(I,J)=TSHLTR(I,J) +! + RAPA02=RAPA-GOCP02/TH02P + RAPA10=RAPA-GOCP10/TH10P +! + T02P=TH02P*RAPA02 + T10P=TH10P*RAPA10 +! 1 may 06 tgs T02(I,J) = T02P + T02(I,J) = TH02(I,J)*APESFC +! + P02P=(RAPA02**RCAP)*1.E5 + P10P=(RAPA10**RCAP)*1.E5 +! + QS02=PQ0/P02P*EXP(A2*(T02P-A3)/(T02P-A4)) + QS10=PQ0/P10P*EXP(A2*(T10P-A3)/(T10P-A4)) +! + IF(QSHLTR(I,J)>QS02)QSHLTR(I,J)=QS02 + IF(Q10 (I,J)>QS10)Q10 (I,J)=QS10 + Q02(I,J)=QSHLTR(I,J)/(1.-QSHLTR(I,J)) +!---------------------------------------------------------------------- +! STRESS(I,J)=USTAR(I,J)*USTAR(I,J) + WIND(I,J)=max(USTAR(I,J)*FFM(I,J)/VKARMAN,1.0) + CM(I,J)=VKARMAN*VKARMAN/(FFM(I,J)*FFM(I,J)) + CH(I,J)=VKARMAN*VKARMAN/(FFM(I,J)*FFH(I,J)) + TEM=0.00001/DZ(I,J,LM) + CM(I,J)=max(CM(I,J),tem) + CH(I,J)=max(CH(I,J),tem) + STRESS(I,J)=cm(I,J) * wind(I,J) * wind(I,J) + USTAR(I,J)=sqrt(stress(I,J)) +! + END IF ! FLAG_ITER +! + ENDDO +! +!---------------------------------------------------------------------- +! + ENDDO setup_integration +! +!...................................................................... +!$omp end parallel do +!...................................................................... +!---------------------------------------------------------------------- + + END SUBROUTINE JSFC +!XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX +!---------------------------------------------------------------------- + SUBROUTINE SFCDIF(NTSD,SEAMASK,THS,QS,PSFC & + & ,UZ0,VZ0,TZ0,THZ0,QZ0 & + & ,USTAR,Z0,Z0BASE,CT,RLMO,AKMS,AKHS,PBLH,WETM & + & ,CHS,CHS2,CQS2,HFX,QFX,FLX_LH,FLHC,FLQC,QGH,CPM & + & ,ULOW,VLOW,TLOW,THLOW,THELOW,QLOW,CWMLOW & + & ,ZSL,PLOW,HLFLX & +! & ,VEGF,SNOC & !added 5/17/2013 + & ,U10,V10,TH02,TH10,Q02,Q10,PSHLTR & + & ,FFM,FFH,FM10,FH2,A1U,A1T,A1Q & + & ,IDS,IDE,JDS,JDE,KDS,KDE & + & ,IMS,IME,JMS,JME,KMS,KME & + & ,ITS,ITE,JTS,JTE,KTS,LM,I,J,ZSFC,RIB) ! Added Bulk Richardson No. +! **************************************************************** +! * * +! * SURFACE LAYER * +! * * +! **************************************************************** +!---------------------------------------------------------------------- +! + IMPLICIT NONE +! +!---------------------------------------------------------------------- + INTEGER,INTENT(IN) :: IDS,IDE,JDS,JDE,KDS,KDE & + & ,IMS,IME,JMS,JME,KMS,KME & + & ,ITS,ITE,JTS,JTE,KTS,LM,i,j +! + INTEGER,INTENT(IN) :: NTSD +! + REAL(kind=kfpt),INTENT(IN) :: CWMLOW,PBLH,PLOW,QLOW,PSFC,SEAMASK,ZSFC & + & ,THELOW,THLOW,THS,TLOW,TZ0,ULOW,VLOW,WETM,ZSL & + & ,Z0BASE +! ,VEGF,SNOC +! + REAL(kind=kfpt),INTENT(OUT) :: CHS,CHS2,CPM,CQS2,CT,FLHC,FLQC,FLX_LH,HFX & + & ,RIB,PSHLTR,Q02,Q10,QFX,QGH,RLMO,TH02,TH10,U10,V10 + REAL(kind=kfpt),INTENT(OUT) :: FFM,FFH,FM10,FH2,A1U,A1T,A1Q +! + REAL(kind=kfpt),INTENT(INOUT) :: AKHS,AKMS,QZ0,THZ0,USTAR,UZ0,VZ0,Z0,QS +!---------------------------------------------------------------------- +!*** +!*** LOCAL VARIABLES +!*** + INTEGER :: ITR,K +! + REAL(kind=kfpt) :: A,B,BTGH,BTGX,CXCHL,CXCHS,DTHV,DU2,ELFC,FCT & + & ,HLFLX,HSFLX,HV,PSH02,PSH10,PSHZ,PSHZL,PSM10,PSMZ,PSMZL & + & ,RDZ,RDZT,RLMA,RLMN,RLMP & + & ,RLOGT,RLOGU,RWGH,RZ,RZST,RZSU,SIMH,SIMM,TEM,THM & + & ,UMFLX,USTARK,VMFLX,WGHT,WGHTT,WGHTQ,WSTAR2 & + & ,X,XLT,XLT4,XLU,XLU4,XT,XT4,XU,XU4,ZETALT,ZETALU & + & ,ZETAT,ZETAU,ZQ,ZSLT,ZSLU,ZT,ZU,TOPOTERM,ZZIL,CZETMAX +!vcw +! +!*** DIAGNOSTICS +! + REAL(kind=kfpt) :: AKHS02,AKHS10,AKMS02,AKMS10,EKMS10,QSAT10,QSAT2 & + & ,RLNT02,RLNT10,RLNU10,SIMH02,SIMH10,SIMM10,T02,T10 & + & ,TERM1,RLOW,U10E,V10E,WSTAR,XLT02,XLT024,XLT10 & + & ,XLT104,XLU10,XLU104,XU10,XU104,ZT02,ZT10,ZTAT02,ZTAT10 & + & ,ZTAU,ZTAU10,ZU10,ZUUZ +! REAL(kind=kfpt) :: ZILFC1,SNOWZO, Zom_ztmax +!---------------------------------------------------------------------- +!********************************************************************** +!---------------------------------------------------------------------- + RDZ=1./ZSL + CXCHL=EXCML*RDZ + CXCHS=EXCMS*RDZ +! + BTGX=G/THLOW + ELFC=VKARMAN*BTGX +! + IF(PBLH>1000.)THEN + BTGH=BTGX*PBLH + ELSE + BTGH=BTGX*1000. + ENDIF +! + WGHT=0. + WGHTT=0. + WGHTQ=0. +!---------------------------------------------------------------------- +! +!*** SEA POINTS +! +!---------------------------------------------------------------------- +! + IF(SEAMASK>0.5)THEN +! +!---------------------------------------------------------------------- + DO ITR=1,ITRMX +!---------------------------------------------------------------------- + Z0=MAX(USTFC*USTAR*USTAR,1.59E-5) +! +!*** VISCOUS SUBLAYER, JANJIC MWR 1994 +! +!---------------------------------------------------------------------- + IF(USTAR0)THEN + THZ0=((WGHTT*THLOW+THS)/(WGHTT+1.)+THZ0)*0.5 + QZ0=((WGHTQ*QLOW+QS)/(WGHTQ+1.)+QZ0)*0.5 + ELSE + THZ0=(WGHTT*THLOW+THS)/(WGHTT+1.) + QZ0=(WGHTQ*QLOW+QS)/(WGHTQ+1.) + ENDIF +! + ENDIF +! + IF(USTAR>=USTR.AND.USTAR0)THEN + THZ0=((WGHTT*THLOW+THS)/(WGHTT+1.)+THZ0)*0.5 + QZ0=((WGHTQ*QLOW+QS)/(WGHTQ+1.)+QZ0)*0.5 + ELSE + THZ0=(WGHTT*THLOW+THS)/(WGHTT+1.) + QZ0=(WGHTQ*QLOW+QS)/(WGHTQ+1.) + ENDIF +! + ENDIF +!---------------------------------------------------------------------- + ELSE +!---------------------------------------------------------------------- + ZU=Z0 + UZ0=0. + VZ0=0. +! + ZT=Z0 + THZ0=THS +! + ZQ=Z0 + QZ0=QS +!---------------------------------------------------------------------- + ENDIF +!---------------------------------------------------------------------- + TEM=(TLOW+TZ0)*0.5 + THM=(THELOW+THZ0)*0.5 +! + A=THM*P608 + B=(ELOCP/TEM-1.-P608)*THM +! + DTHV=((THELOW-THZ0)*((QLOW+QZ0+CWMLOW)*(0.5*P608)+1.) & + & +(QLOW-QZ0+CWMLOW)*A+CWMLOW*B) +! + DU2=MAX((ULOW-UZ0)**2+(VLOW-VZ0)**2,EPSU2) + RIB=BTGX*DTHV*ZSL/DU2 +!---------------------------------------------------------------------- +! IF(RIB>=RIC)THEN +!---------------------------------------------------------------------- +! AKMS=MAX( VISC*RDZ,CXCHS) +! AKHS=MAX(TVISC*RDZ,CXCHS) +!---------------------------------------------------------------------- +! ELSE ! turbulent branch +!---------------------------------------------------------------------- + ZSLU=ZSL+ZU + ZSLT=ZSL+ZT +! + RZSU=ZSLU/ZU + RZST=ZSLT/ZT +! + RLOGU=LOG(RZSU) + RLOGT=LOG(RZST) +! +!---------------------------------------------------------------------- +!*** 1./MONIN-OBUKHOV LENGTH +!---------------------------------------------------------------------- +! + RLMO=ELFC*AKHS*DTHV/USTAR**3 +! + ZETALU=ZSLU*RLMO + ZETALT=ZSLT*RLMO + ZETAU=ZU*RLMO + ZETAT=ZT*RLMO +! + ZETALU=MIN(MAX(ZETALU,ZTMIN1),ZTMAX1) + ZETALT=MIN(MAX(ZETALT,ZTMIN1),ZTMAX1) + ZETAU=MIN(MAX(ZETAU,ZTMIN1/RZSU),ZTMAX1/RZSU) + ZETAT=MIN(MAX(ZETAT,ZTMIN1/RZST),ZTMAX1/RZST) +! +!---------------------------------------------------------------------- +!*** WATER FUNCTIONS +!---------------------------------------------------------------------- +! + RZ=(ZETAU-ZTMIN1)/DZETA1 + K=INT(RZ) + RDZT=RZ-REAL(K) + K=MIN(K,KZTM2) + K=MAX(K,0) + PSMZ=(PSIM1(K+2)-PSIM1(K+1))*RDZT+PSIM1(K+1) +! + RZ=(ZETALU-ZTMIN1)/DZETA1 + K=INT(RZ) + RDZT=RZ-REAL(K) + K=MIN(K,KZTM2) + K=MAX(K,0) + PSMZL=(PSIM1(K+2)-PSIM1(K+1))*RDZT+PSIM1(K+1) +! + SIMM=PSMZL-PSMZ+RLOGU +! + RZ=(ZETAT-ZTMIN1)/DZETA1 + K=INT(RZ) + RDZT=RZ-REAL(K) + K=MIN(K,KZTM2) + K=MAX(K,0) + PSHZ=(PSIH1(K+2)-PSIH1(K+1))*RDZT+PSIH1(K+1) +! + RZ=(ZETALT-ZTMIN1)/DZETA1 + K=INT(RZ) + RDZT=RZ-REAL(K) + K=MIN(K,KZTM2) + K=MAX(K,0) + PSHZL=(PSIH1(K+2)-PSIH1(K+1))*RDZT+PSIH1(K+1) +! + SIMH=(PSHZL-PSHZ+RLOGT)*FH01 +!---------------------------------------------------------------------- + USTARK=USTAR*VKARMAN + if(abs(simm)<1.e-10.or.abs(simh)<1.e-10)then + write(0,*)' simm=',simm,' simh=',simh,' at i=',i,' j=',j + endif + +! if(abs(SIMM).lt.1.e-5.or.abs(SIMM).gt.1.e5)then + if(abs(SIMM).lt.1.e-10.or.abs(SIMH).lt.1.e-10)then + print*,'SIMM,PSMZL,PSMZ,RLOGU=',SIMM,PSMZL,PSMZ,RLOGU + print*,'SIMH,PSHZL,PSHZ,RLOGT,FH01=',SIMH,PSHZL,PSHZ,RLOGT,FH01 + print*,'USTARK,CXCHS=',USTARK,CXCHS + print*,'PSIM1(1,2),K=',PSIM1(K+1),PSIM1(K+2),K + print*,'ZETAU,ZTMIN1,DZETA1=',ZETAU,ZTMIN1,DZETA1 + print*,'PSIH1(1,2),RDZT=',PSIH1(K+1),PSIH1(K+2),RDZT + print*,'ZSLU,ZSLT,RLMO,ZU,ZT=',ZSLU,ZSLT,RLMO,ZU,ZT + print*,'A,B,DTHV,DU2,RIB=',A,B,DTHV,DU2,RIB + stop + end if + + + + AKMS=MAX(USTARK/SIMM,CXCHS) + AKHS=MAX(USTARK/SIMH,CXCHS) +! +!---------------------------------------------------------------------- +!*** BELJAARS CORRECTION FOR USTAR +!---------------------------------------------------------------------- +! + IF(DTHV<=0.)THEN !zj + WSTAR2=WWST2*ABS(BTGH*AKHS*DTHV)**(2./3.) !zj + ELSE !zj + WSTAR2=0. !zj + ENDIF !zj + USTAR=MAX(SQRT(AKMS*SQRT(DU2+WSTAR2)),EPSUST) +! +!---------------------------------------------------------------------- +! ENDIF ! End of turbulent branch +!---------------------------------------------------------------------- +! + ENDDO ! End of the iteration loop over sea points +! +!---------------------------------------------------------------------- +! +!*** LAND POINTS +! +!---------------------------------------------------------------------- +! + ELSE +! +!---------------------------------------------------------------------- + IF(NTSD==0)THEN + QS=QLOW + ENDIF +! + ZU=Z0 + UZ0=0. + VZ0=0. +! + ZT=ZU*ZTFC + THZ0=THS +! + ZQ=ZT + QZ0=QS +!---------------------------------------------------------------------- + TEM=(TLOW+TZ0)*0.5 + THM=(THELOW+THZ0)*0.5 +! + A=THM*P608 + B=(ELOCP/TEM-1.-P608)*THM +! + DTHV=((THELOW-THZ0)*((QLOW+QZ0+CWMLOW)*(0.5*P608)+1.) & + & +(QLOW-QZ0+CWMLOW)*A+CWMLOW*B) +! + DU2=MAX((ULOW-UZ0)**2+(VLOW-VZ0)**2,EPSU2) + RIB=BTGX*DTHV*ZSL/DU2 +!---------------------------------------------------------------------- +! IF(RIB>=RIC)THEN +! AKMS=MAX( VISC*RDZ,CXCHL) +! AKHS=MAX(TVISC*RDZ,CXCHL) +!---------------------------------------------------------------------- +! ELSE ! Turbulent branch +!---------------------------------------------------------------------- + ZSLU=ZSL+ZU +! + RZSU=ZSLU/ZU +! + RLOGU=LOG(RZSU) + + ZSLT=ZSL+ZU ! u,v and t are at the same level +!---------------------------------------------------------------------- +! +! +!mp Remove Topo modification of ZILFC term +! +! TOPOTERM=TOPOFAC*ZSFC**2. +! TOPOTERM=MAX(TOPOTERM,3.0) +! +!vcw +! RIB modification to ZILFC term +! 7/29/2009 V Wong recommends 5, change pending +! + CZETMAX = 10. +! stable + IF(DTHV>0.)THEN + IF (RIBUse Canuto/Kitamura mod (remove Ric and negative TKE) (1:yes, 0:no) @@ -435,7 +443,8 @@ MODULE module_bl_mynn SUBROUTINE mym_initialize ( & & kts,kte, & & dz, zw, & - & u, v, thl, qw, & ! &ust, rmo, pmz, phh, flt, flq, & + & u, v, thl, qw, & +! & ust, rmo, pmz, phh, flt, flq, & & zi, theta, sh, & & ust, rmo, el, & & Qke, Tsq, Qsq, Cov, Psig_bl, cldfra_bl1D, & @@ -995,12 +1004,12 @@ SUBROUTINE mym_length ( & CASE (2) !Experimental mixing length formulation cns = 3.5 - alp1 = 0.23 + alp1 = 0.25 + 0.02*MIN(MAX(zi-200.,0.),1000.)/1000. !0.23 alp2 = 0.6 !0.3 - alp3 = 2.0 - alp4 = 10. + alp3 = 3.0 !2.0 + alp4 = 20. !10. alp5 = 0.6 !0.3 !like alp2, but for free atmosphere - alp6 = 10.0 !used for MF mixing length instead of BouLac (x times MF) + alp6 = 50.0 !used for MF mixing length instead of BouLac (x times MF) ! Impose limits on the height integration for elt and the transition layer depth !zi2=MAX(zi,minzi) @@ -1016,7 +1025,7 @@ SUBROUTINE mym_length ( & afk = dz(k)/( dz(k)+dz(k-1) ) abk = 1.0 -afk qkw(k) = SQRT(MAX(qke(k)*abk+qke(k-1)*afk,1.0e-3)) - qtke(k) = 0.5*(qkw(k)**2.) ! q -> TKE + qtke(k) = 0.5*qkw(k) ! q -> TKE END DO elt = 1.0e-5 @@ -1052,7 +1061,8 @@ SUBROUTINE mym_length ( & bv = SQRT( gtr*dtv(k) ) !elb_mf = alp2*qkw(k) / bv & elb_mf = MAX(alp2*qkw(k), & - &MAX(1.-2.0*cldavg,0.0)**0.5*alp6*edmf_a1(k)*edmf_w1(k)) / bv & +! &MAX(1.-2.0*cldavg,0.0)**0.5*alp6*edmf_a1(k)*edmf_w1(k)) / bv & + & alp6*edmf_a1(k)*edmf_w1(k)) / bv & & *( 1.0 + alp3*SQRT( vsc/( bv*elt ) ) ) elb = MIN(alp5*qkw(k)/bv, zwk) elf = elb/(1. + (elb/600.)) !bound free-atmos mixing length to < 600 m. @@ -1074,12 +1084,12 @@ SUBROUTINE mym_length ( & ! velocity scale), except that elt is relpaced ! by zi, and zero is replaced by 1.0e-4 to ! prevent division by zero. - tau_cloud = MIN(MAX(0.5*zi/((gtr*zi*MAX(flt,1.0e-4))**(1.0/3.0)),25.),100.) + tau_cloud = MIN(MAX(0.5*zi/((gtr*zi*MAX(flt,1.0e-4))**(1.0/3.0)),50.),150.) !minimize influence of surface heat flux on tau far away from the PBLH. wt=.5*TANH((zwk - (zi2+h1))/h2) + .5 tau_cloud = tau_cloud*(1.-wt) + 50.*wt - elb = MIN(tau_cloud*SQRT(MIN(qtke(k),50.)), zwk) + elb = MIN(tau_cloud*SQRT(MIN(qtke(k),30.)), zwk) elf = elb elb_mf = elb END IF @@ -1126,13 +1136,29 @@ END SUBROUTINE mym_length !! computational expense. This subroutine computes the length scales up and down !! and then computes the min, average of the up/down length scales, and also !! considers the distance to the surface. -!!\param dlu the distance a parcel can be lifted upwards give a finite -!! amount of TKE. +!\param dlu the distance a parcel can be lifted upwards give a finite +! amount of TKE. !\param dld the distance a parcel can be displaced downwards given a -!! finite amount of TKE. -!!\param lb1 the minimum of the length up and length down -!!\param lb2 the average of the length up and length down +! finite amount of TKE. +!\param lb1 the minimum of the length up and length down +!\param lb2 the average of the length up and length down SUBROUTINE boulac_length0(k,kts,kte,zw,dz,qtke,theta,lb1,lb2) +! +! NOTE: This subroutine was taken from the BouLac scheme in WRF-ARW +! and modified for integration into the MYNN PBL scheme. +! WHILE loops were added to reduce the computational expense. +! This subroutine computes the length scales up and down +! and then computes the min, average of the up/down +! length scales, and also considers the distance to the +! surface. +! +! dlu = the distance a parcel can be lifted upwards give a finite +! amount of TKE. +! dld = the distance a parcel can be displaced downwards given a +! finite amount of TKE. +! lb1 = the minimum of the length up and length down +! lb2 = the average of the length up and length down +!------------------------------------------------------------------- INTEGER, INTENT(IN) :: k,kts,kte REAL, DIMENSION(kts:kte), INTENT(IN) :: qtke,dz,theta @@ -2334,7 +2360,7 @@ END SUBROUTINE mym_predict !! calculate the buoyancy flux. Different cloud PDFs can be selected by !! use of the namelist parameter \p bl_mynn_cloudpdf . SUBROUTINE mym_condensation (kts,kte, & - & dx, dz, & + & dx, dz, zw, & & thl, qw, & & p,exner, & & tsq, qsq, cov, & @@ -2355,6 +2381,7 @@ SUBROUTINE mym_condensation (kts,kte, & REAL, INTENT(IN) :: dx,PBLH1,HFX1,rmo REAL, DIMENSION(kts:kte), INTENT(IN) :: dz + REAL, DIMENSION(kts:kte+1), INTENT(IN) :: zw REAL, DIMENSION(kts:kte), INTENT(IN) :: p,exner, thl, qw, & &tsq, qsq, cov, th @@ -2365,7 +2392,8 @@ SUBROUTINE mym_condensation (kts,kte, & DOUBLE PRECISION :: t3sq, r3sq, c3sq REAL :: qsl,esat,qsat,tlk,qsat_tl,dqsl,cld0,q1k,eq1,qll,& - &q2p,pt,rac,qt,t,xl,rsl,cpm,cdhdz,Fng,qww,alpha,beta,bb,ls_min,ls,wt + &q2p,pt,rac,qt,t,xl,rsl,cpm,cdhdz,Fng,qww,alpha,beta,bb,& + &ls_min,ls,wt,cld_factor,fac_damp INTEGER :: i,j,k REAL :: erf @@ -2552,7 +2580,7 @@ SUBROUTINE mym_condensation (kts,kte, & zagl = zagl + dz(k) !Use analog to surface layer length scale to make the cloud mixing length scale !become less than z in stable conditions. - els = zagl/(1.0 + 1.0*MIN( 0.5*dz(1)*MAX(rmo,0.0), 1. )) + els = zagl ! /(1.0 + 1.0*MIN( 0.5*dz(1)*MAX(rmo,0.0), 1. )) ls_min = 300. + MIN(3.*MAX(HFX1,0.),300.) ls_min = MIN(MAX(els,25.),ls_min) ! Let this be the minimum possible length scale: @@ -2661,14 +2689,6 @@ SUBROUTINE mym_condensation (kts,kte, & vt(k) = qt-1.0 -rac*bet(k) vq(k) = p608*pt-tv0 +rac - !To avoid FPE in radiation driver, when these two quantities are multiplied by eachother, - ! add limit to qc_bl and cldfra_bl: - IF (QC_BL1D(k) < 1E-6 .AND. ABS(CLDFRA_BL1D(k)) > 0.01) QC_BL1D(k)= 1E-6 - IF (CLDFRA_BL1D(k) < 1E-2)THEN - CLDFRA_BL1D(k)=0. - QC_BL1D(k)=0. - ENDIF - END DO CASE ( 2, -2) ! JAYMES- this option added 8 May 2015 @@ -2740,20 +2760,25 @@ SUBROUTINE mym_condensation (kts,kte, & ! The "-1" and "-tv0" terms are included for consistency with ! the legacy vt and vq formulations (above). + !OLD-- ! increase the cloud fraction estimate below PBLH+1km - if (zagl .lt. PBLH2+1000.) cld(k) = MIN( 1., 1.5*cld(k) ) + !if (zagl .lt. PBLH2+1000.) then + ! cld_factor = 1.0 + MAX(0.0, ( RH(k) - 0.83 ) / 0.18 ) + ! cld(k) = MIN( 1., cld_factor*cld(k) ) + !end if + !NEW-- + ! dampen the amplification factor (cld_factor) with height in order + ! to limit excessively large cloud fractions aloft + fac_damp = 1. -MIN(MAX( zagl-(PBLH2+1000.),0.0)/ & + MAX((zw(k_tropo)-(PBLH2+1000.)),500.), 1.) + !cld_factor = 1.0 + fac_damp*MAX(0.0, ( RH(k) - 0.5 ) / 0.51 )**3.3 + cld_factor = 1.0 + fac_damp*MAX(0.0, ( RH(k) - 0.75 ) / 0.26 )**1.9 + cld(k) = MIN( 1., cld_factor*cld(k) ) + ! return a cloud condensate and cloud fraction for icloud_bl option: cldfra_bl1D(k) = cld(k) qc_bl1D(k) = ql(k) - !To avoid FPE in radiation driver, when these two quantities are multiplied by eachother, - ! add limit to qc_bl and cldfra_bl: - IF (QC_BL1D(k) < 1E-6 .AND. ABS(CLDFRA_BL1D(k)) > 0.01) QC_BL1D(k)= 1E-6 - IF (CLDFRA_BL1D(k) < 1E-2)THEN - CLDFRA_BL1D(k)=0. - QC_BL1D(k)=0. - ENDIF - END DO END SELECT !end cloudPDF option @@ -3980,7 +4005,7 @@ SUBROUTINE mynn_bl_driver( & INTEGER :: i,j,k REAL, DIMENSION(KTS:KTE) :: thl,thvl,tl,sqv,sqc,sqi,sqw,& &El, Dfm, Dfh, Dfq, Tcd, Qcd, Pdk, Pdt, Pdq, Pdc, & - &Vt, Vq, sgm + &Vt, Vq, sgm, thlsg REAL, DIMENSION(KTS:KTE) :: thetav,sh,u1,v1,w1,p1,ex1,dz1,th1,tk1,rho1,& & qke1,tsq1,qsq1,cov1,qv1,qi1,qc1,du1,dv1,dth1,dqv1,dqc1,dqi1, & @@ -3996,7 +4021,7 @@ SUBROUTINE mynn_bl_driver( & REAL, DIMENSION(KTS:KTE+1) :: zw REAL :: cpm,sqcg,flt,flq,flqv,flqc,pmz,phh,exnerg,zet,& - &afk,abk,ts_decay,th_sfc,ztop_shallow + &afk,abk,ts_decay,th_sfc,ztop_shallow,sqc9,sqi9 !JOE-add GRIMS parameters & variables real,parameter :: d1 = 0.02, d2 = 0.05, d3 = 0.001 @@ -4139,6 +4164,16 @@ SUBROUTINE mynn_bl_driver( & !suggested min temperature to improve accuracy. !thl(k)=th(i,k,j)*(1.- xlvcp/MAX(tk1(k),TKmin)*sqc(k) & ! & - xlscp/MAX(tk1(k),TKmin)*sqi(k)) + !COMPUTE THL USING SGS CLOUDS FOR PBLH DIAG + IF(sqc(k)<1e-6 .and. sqi(k)<1e-8 .and. CLDFRA_BL(i,k,j)>0.001)THEN + sqc9=QC_BL(i,k,j)*(MIN(1., MAX(0., (tk1(k)-254.)/15.)))*CLDFRA_BL(i,k,j) + sqi9=QC_BL(i,k,j)*(1. - MIN(1., MAX(0., (tk1(k)-254.)/15.)))*CLDFRA_BL(i,k,j) + ELSE + sqc9=sqc(k) + sqi9=sqi(k) + ENDIF + thlsg(k)=th(i,k,j)- xlvcp/exner(i,k,j)*sqc9 & + & - xlscp/exner(i,k,j)*sqi9 ELSE sqi(k)=0.0 sqw(k)=sqv(k)+sqc(k) @@ -4146,14 +4181,24 @@ SUBROUTINE mynn_bl_driver( & !Use form from Tripoli and Cotton (1981) with their !suggested min temperature to improve accuracy. !thl(k)=th(i,k,j)*(1.- xlvcp/MAX(tk1(k),TKmin)*sqc(k)) + !COMPUTE THL USING SGS CLOUDS FOR PBLH DIAG + IF(sqc(k)<1e-6 .and. CLDFRA_BL(i,k,j)>0.001)THEN + sqc9=QC_BL(i,k,j)*(MIN(1., MAX(0., (tk1(k)-254.)/15.)))*CLDFRA_BL(i,k,j) + sqi9=QC_BL(i,k,j)*(1. - MIN(1., MAX(0., (tk1(k)-254.)/15.)))*CLDFRA_BL(i,k,j) + ELSE + sqc9=sqc(k) + sqi9=0.0 + ENDIF + thlsg(k)=th(i,k,j)- xlvcp/exner(i,k,j)*sqc9 & + & - xlscp/exner(i,k,j)*sqi9 ENDIF + thvl(k)=thlsg(k)*(1.+0.61*sqv(k)) IF (k==kts) THEN zw(k)=0. ELSE zw(k)=zw(k-1)+dz(i,k-1,j) ENDIF - thvl(k)=thl(k)*(1.+0.61*sqv(k)) if (restart) then qke1(k) = qke(i,k,j) else @@ -4279,6 +4324,16 @@ SUBROUTINE mynn_bl_driver( & !suggested min temperature to improve accuracy. !thl(k)=th(i,k,j)*(1.- xlvcp/MAX(tk1(k),TKmin)*sqc(k) & ! & - xlscp/MAX(tk1(k),TKmin)*sqi(k)) + !COMPUTE THL USING SGS CLOUDS FOR PBLH DIAG + IF(sqc(k)<1e-6 .and. sqi(k)<1e-8 .and. CLDFRA_BL(i,k,j)>0.001)THEN + sqc9=QC_BL(i,k,j)*(MIN(1., MAX(0., (tk1(k)-254.)/15.)))*CLDFRA_BL(i,k,j) + sqi9=QC_BL(i,k,j)*(1. - MIN(1., MAX(0., (tk1(k)-254.)/15.)))*CLDFRA_BL(i,k,j) + ELSE + sqc9=sqc(k) + sqi9=sqi(k) + ENDIF + thlsg(k)=th(i,k,j)- xlvcp/exner(i,k,j)*sqc9 & + & - xlscp/exner(i,k,j)*sqi9 ELSE qi1(k)=0.0 sqi(k)=0.0 @@ -4287,7 +4342,19 @@ SUBROUTINE mynn_bl_driver( & !Use form from Tripoli and Cotton (1981) with their !suggested min temperature to improve accuracy. !thl(k)=th(i,k,j)*(1.- xlvcp/MAX(tk1(k),TKmin)*sqc(k)) + !COMPUTE THL USING SGS CLOUDS FOR PBLH DIAG + IF(sqc(k)<1e-6 .and. CLDFRA_BL(i,k,j)>0.001)THEN + sqc9=QC_BL(i,k,j)*(MIN(1., MAX(0., (tk1(k)-254.)/15.)))*CLDFRA_BL(i,k,j) + sqi9=QC_BL(i,k,j)*(1. - MIN(1., MAX(0., (tk1(k)-254.)/15.)))*CLDFRA_BL(i,k,j) + ELSE + sqc9=sqc(k) + sqi9=0.0 + ENDIF + thlsg(k)=th(i,k,j)- xlvcp/exner(i,k,j)*sqc9 & + & - xlscp/exner(i,k,j)*sqi9 ENDIF + thetav(k)=th(i,k,j)*(1.+0.608*sqv(k)) + thvl(k)=thlsg(k)*(1.+0.61*sqv(k)) IF (PRESENT(qni) .AND. FLAG_QNI ) THEN qni1(k)=qni(i,k,j) @@ -4309,8 +4376,6 @@ SUBROUTINE mynn_bl_driver( & ELSE qnifa1(k)=0.0 ENDIF - thetav(k)=th(i,k,j)*(1.+0.608*sqv(k)) - thvl(k)=thl(k)*(1.+0.61*sqv(k)) p1(k) = p(i,k,j) ex1(k)= exner(i,k,j) el(k) = el_pbl(i,k,j) @@ -4466,7 +4531,7 @@ SUBROUTINE mynn_bl_driver( & !! selected by use of the namelist parameter \p bl_mynn_cloudpdf. CALL mym_condensation ( kts,kte, & - &dx(i,j),dz1,thl,sqw,p1,ex1, & + &dx(i,j),dz1,zw,thl,sqw,p1,ex1, & &tsq1, qsq1, cov1, & &Sh,el,bl_mynn_cloudpdf, & &qc_bl1D,cldfra_bl1D, & @@ -4863,7 +4928,8 @@ END SUBROUTINE mynn_bl_driver SUBROUTINE mynn_bl_init_driver( & &RUBLTEN,RVBLTEN,RTHBLTEN,RQVBLTEN, & &RQCBLTEN,RQIBLTEN & !,RQNIBLTEN,RQNCBLTEN & - &,QKE,TKE_PBL,EXCH_H & ! &,icloud_bl,qc_bl,cldfra_bl & !JOE-subgrid bl clouds + &,QKE,TKE_PBL,EXCH_H & +! &,icloud_bl,qc_bl,cldfra_bl & !JOE-subgrid bl clouds &,RESTART,ALLOWED_TO_READ,LEVEL & &,IDS,IDE,JDS,JDE,KDS,KDE & &,IMS,IME,JMS,JME,KMS,KME & @@ -4940,6 +5006,23 @@ END SUBROUTINE mynn_bl_init_driver !> @{ SUBROUTINE GET_PBLH(KTS,KTE,zi,thetav1D,qke1D,zw1D,dz1D,landsea,kzi) + !--------------------------------------------------------------- + ! NOTES ON THE PBLH FORMULATION + ! + !The 1.5-theta-increase method defines PBL heights as the level at + !which the potential temperature first exceeds the minimum potential + !temperature within the boundary layer by 1.5 K. When applied to + !observed temperatures, this method has been shown to produce PBL- + !height estimates that are unbiased relative to profiler-based + !estimates (Nielsen-Gammon et al. 2008). However, their study did not + !include LLJs. Banta and Pichugina (2008) show that a TKE-based + !threshold is a good estimate of the PBL height in LLJs. Therefore, + !a hybrid definition is implemented that uses both methods, weighting + !the TKE-method more during stable conditions (PBLH < 400 m). + !A variable tke threshold (TKEeps) is used since no hard-wired + !value could be found to work best in all conditions. + !--------------------------------------------------------------- + INTEGER,INTENT(IN) :: KTS,KTE #ifdef HARDCODE_VERTICAL @@ -4982,7 +5065,7 @@ SUBROUTINE GET_PBLH(KTS,KTE,zi,thetav1D,qke1D,zw1D,dz1D,landsea,kzi) k = kthv+1 IF((landsea-1.5).GE.0)THEN ! WATER - delt_thv = 0.75 + delt_thv = 1.0 ELSE ! LAND delt_thv = 1.25 @@ -5197,7 +5280,7 @@ SUBROUTINE DMP_mf( & REAL, PARAMETER :: Atot = 0.10 ! Maximum total fractional area of all updrafts REAL, PARAMETER :: lmax = 1000.! diameter of largest plume REAL, PARAMETER :: dl = 100. ! diff size of each plume - the differential multiplied by the integrand - REAL, PARAMETER :: dcut = 1.0 ! max diameter of plume to parameterize relative to dx (km) + REAL, PARAMETER :: dcut = 1.2 ! max diameter of plume to parameterize relative to dx (km) REAL :: d != -2.3 to -1.7 ;=-1.9 in Neggers paper; power law exponent for number density (N=Cl^d). ! Note that changing d to -2.0 makes each size plume equally contribute to the total coverage of all plumes. ! Note that changing d to -1.7 doubles the area coverage of the largest plumes relative to the smallest plumes. @@ -5370,28 +5453,21 @@ SUBROUTINE DMP_mf( & ! Some of these criteria may be a little redundant but useful for bullet-proofing. ! (1) largest plume = 1.0 * dx. ! (2) Apply a scale-break, assuming no plumes with diameter larger than PBLH can exist. - ! (3) max plume size beneath clouds deck approx = 0.5 * cloud_base. + ! (3) max plume size beneath clouds deck approx = height of cloud_base. ! (4) add shear-dependent limit, when plume model breaks down. (taken out) ! (5) land-only limit to reduce plume sizes in weakly forced conditions ! Criteria (1) - NUP2 = max(1,min(NUP,INT(dx*dcut/dl))) + NUP2 = max(1,min(NUP,INT(dx*dcut/dl))) ! Criteria (2) and (4) - !wspd_pbl=SQRT(MAX(u(kpbl)**2 + v(kpbl)**2, 0.01)) - maxwidth = 1.1*PBLH !- MIN(15.*MAX(wspd_pbl - 7.5, 0.), 0.3*PBLH) + !wspd_pbl=SQRT(MAX(u(kpbl)**2 + v(kpbl)**2, 0.01)) + maxwidth = 1.2*PBLH !- MIN(15.*MAX(wspd_pbl - 7.5, 0.), 0.3*PBLH) ! Criteria (3) -! maxwidth = MIN(maxwidth,0.5*cloud_base) - maxwidth = MIN(maxwidth,0.75*cloud_base) + maxwidth = MIN(maxwidth,cloud_base) ! Criteria (5) - IF((landsea-1.5).LT.0)THEN - IF (cloud_base .LT. 2000.) THEN - !width_flx = MAX(MIN(1000.*(0.6*tanh((flt - 0.120)/0.03) + .5),1000.), 0.) - width_flx = MAX(MIN(1000.*(0.6*tanh((flt - 0.090)/0.03) + .5),1000.), 0.) - ELSE - width_flx = MAX(MIN(1000.*(0.6*tanh((flt - 0.040)/0.03) + .5),1000.), 0.) - !width_flx = MAX(MIN(1000.*(0.6*tanh((flt - 0.050)/0.03) + .5),1000.), 0.) + IF((landsea-1.5).LT.0)THEN + width_flx = MAX(MIN(1000.*(0.6*tanh((flt - 0.050)/0.03) + .5),1000.), 0.) + maxwidth = MIN(maxwidth,width_flx) ENDIF - maxwidth = MIN(maxwidth,width_flx) - ENDIF ! Convert maxwidth to number of plumes NUP2 = MIN(MAX(INT((maxwidth - MOD(maxwidth,100.))/100), 0), NUP2) @@ -5422,11 +5498,9 @@ SUBROUTINE DMP_mf( & N = C*l**d ! number density of plume n UPA(1,I) = N*l*l/(dx*dx) * dl ! fractional area of plume n ! Make updraft area (UPA) a function of the buoyancy flux -! acfac = .5*tanh((fltv - 0.05)/0.2) + .5 -! acfac = .5*tanh((fltv - 0.07)/0.09) + .5 ! acfac = .5*tanh((fltv - 0.03)/0.09) + .5 acfac = .5*tanh((fltv - 0.02)/0.09) + .5 -! acfac = .5*tanh((fltv - 0.015)/0.05) + .5 + UPA(1,I)=UPA(1,I)*acfac An2 = An2 + UPA(1,I) ! total fractional area of all plumes !print*," plume size=",l,"; area=",UPA(1,I),"; total=",An2 @@ -5451,10 +5525,10 @@ SUBROUTINE DMP_mf( & sigmaTH=csigma*thstar*(z0/pblh)**(-1./3.) wmin=MIN(sigmaW*pwmin,0.1) - wmax=MIN(sigmaW*pwmax,0.5) + wmax=MIN(sigmaW*pwmax,0.333) !recompute acfac for plume excess - acfac = .5*tanh((fltv - 0.08)/0.07) + .5 + acfac = .5*tanh((fltv - 0.03)/0.07) + .5 !SPECIFY SURFACE UPDRAFT PROPERTIES AT MODEL INTERFACE BETWEEN K = 1 & 2 DO I=1,NUP !NUP2 @@ -5508,7 +5582,8 @@ SUBROUTINE DMP_mf( & DO k=KTS+1,KTE-1 !w-dependency for entrainment a la Tian and Kuang (2016) !ENT(k,i) = 0.5/(MIN(MAX(UPW(K-1,I),0.75),1.5)*l) - ENT(k,i) = 0.35/(MIN(MAX(UPW(K-1,I),0.75),1.5)*l) + !ENT(k,i) = 0.35/(MIN(MAX(UPW(K-1,I),0.75),1.5)*l) + ENT(k,i) = 0.33/(MIN(MAX(UPW(K-1,I),0.666),2.0)*l) !Entrainment from Negggers (2015, JAMES) !ENT(k,i) = 0.02*l**-0.35 - 0.0009 !JOE - implement minimum background entrainment @@ -5518,7 +5593,7 @@ SUBROUTINE DMP_mf( & IF(ZW(k) >= MIN(pblh+1500., 3500.))THEN ENT(k,i)=ENT(k,i) + (ZW(k)-MIN(pblh+1500.,3500.))*5.0E-6 ENDIF - IF(UPW(K-1,I) > 2.0) ENT(k,i) = ENT(k,i) + EntThrottle*(UPW(K-1,I) - 2.0) + !IF(UPW(K-1,I) > 2.0) ENT(k,i) = ENT(k,i) + EntThrottle*(UPW(K-1,I) - 2.0) !SPP ENT(k,i) = ENT(k,i) * (1.0 - rstoch_col(k)) @@ -5735,8 +5810,12 @@ SUBROUTINE DMP_mf( & ! d(k)=thl(k) + dtz(k)*flt + tcd(k)*delt & ! & -dtz(k)*s_awthl(kts+1) + diss_heat(k)*delt*dheat_opt ! So, s_awthl(kts+1) must be less than flt - THVk = (THL(kts)*DZ(kts+1)+THL(kts+1)*DZ(kts))/(DZ(kts+1)+DZ(kts)) - flx1 = MAX(s_aw(kts+1)*(s_awthl(kts+1)/s_aw(kts+1) - THVk),0.0) + IF (s_aw(kts+1) /= 0.) THEN + THVk = (THL(kts)*DZ(kts+1)+THL(kts+1)*DZ(kts))/(DZ(kts+1)+DZ(kts)) + flx1 = MAX(s_aw(kts+1)*(s_awthl(kts+1)/s_aw(kts+1) - THVk),0.0) + ELSE + flx1 = 0.0 + ENDIF !flx1 = -dt/dz(kts)*s_awthl(kts+1) !flx1 = (s_awthl(kts+1)-s_awthl(kts))!/(0.5*(dz(k)+dz(k-1))) adjustment=1.0 diff --git a/physics/module_gfdl_cloud_microphys.F90 b/physics/module_gfdl_cloud_microphys.F90 index 23acefb9b..5750d27fd 100644 --- a/physics/module_gfdl_cloud_microphys.F90 +++ b/physics/module_gfdl_cloud_microphys.F90 @@ -1,6 +1,9 @@ !> \file gfdl_cloud_microphys.F90 -!! This file contains the column GFDL cloud microphysics ( Chen and Lin (2013) -!! \cite chen_and_lin_2013 ). +!! This file contains the full GFDL cloud microphysics (Chen and Lin (2013) +!! \cite chen_and_lin_2013 and Zhou et al. 2019 \cite zhou2019toward). +!! The module is paired with 'gfdl_fv_sat_adj', which performs the "fast" +!! processes +!>author Shian-Jiann Lin, Linjiong Zhou !*********************************************************************** !* GNU Lesser General Public License !* @@ -285,6 +288,18 @@ module gfdl_cloud_microphys_mod real :: log_10, tice0, t_wfr + integer :: reiflag = 1 + ! 1: Heymsfield and Mcfarquhar, 1996 + ! 2: Wyser, 1998 + + logical :: tintqs = .false. !< use temperature in the saturation mixing in PDF + + real :: rewmin = 5.0, rewmax = 10.0 + real :: reimin = 10.0, reimax = 150.0 + real :: rermin = 10.0, rermax = 10000.0 + real :: resmin = 150.0, resmax = 10000.0 + real :: regmin = 300.0, regmax = 10000.0 + ! ----------------------------------------------------------------------- ! namelist ! ----------------------------------------------------------------------- @@ -299,7 +314,9 @@ module gfdl_cloud_microphys_mod tau_i2s, tau_l2r, qi_lim, ql_gen, c_paut, c_psaci, c_pgacs, & z_slope_liq, z_slope_ice, prog_ccn, c_cracw, alin, clin, tice, & rad_snow, rad_graupel, rad_rain, cld_min, use_ppm, mono_prof, & - do_sedi_heat, sedi_transport, do_sedi_w, de_ice, icloud_f, irain_f, mp_print + do_sedi_heat, sedi_transport, do_sedi_w, de_ice, icloud_f, irain_f, & + mp_print, reiflag, rewmin, rewmax, reimin, reimax, rermin, rermax, & + resmin, resmax, regmin, regmax, tintqs public & mp_time, t_min, t_sub, tau_r2g, tau_smlt, tau_g2r, dw_land, dw_ocean, & @@ -311,7 +328,9 @@ module gfdl_cloud_microphys_mod tau_i2s, tau_l2r, qi_lim, ql_gen, c_paut, c_psaci, c_pgacs, & z_slope_liq, z_slope_ice, prog_ccn, c_cracw, alin, clin, tice, & rad_snow, rad_graupel, rad_rain, cld_min, use_ppm, mono_prof, & - do_sedi_heat, sedi_transport, do_sedi_w, de_ice, icloud_f, irain_f, mp_print + do_sedi_heat, sedi_transport, do_sedi_w, de_ice, icloud_f, irain_f, & + mp_print, reiflag, rewmin, rewmax, reimin, reimax, rermin, rermax, & + resmin, resmax, regmin, regmax, tintqs contains @@ -327,7 +346,7 @@ subroutine gfdl_cloud_microphys_mod_driver ( qv_dt, ql_dt, qr_dt, qi_dt, qs_dt, qg_dt, qa_dt, pt_dt, pt, w, & uin, vin, udt, vdt, dz, delp, area, dt_in, land, & rain, snow, ice, graupel, hydrostatic, phys_hydrostatic, & - p, lradar, refl_10cm, kdt, nsteps_per_reset) + p, lradar, refl_10cm,reset) implicit none @@ -357,7 +376,7 @@ subroutine gfdl_cloud_microphys_mod_driver ( real, intent (in), dimension (iis:iie, jjs:jje, kks:kke) :: p logical, intent (in) :: lradar real, intent (out), dimension (iis:iie, jjs:jje, kks:kke) :: refl_10cm - integer, intent (in) :: kdt, nsteps_per_reset + logical, intent (in) :: reset ! Local variables logical :: melti = .false. @@ -595,7 +614,7 @@ subroutine gfdl_cloud_microphys_mod_driver ( ! call mpp_clock_end (gfdl_mp_clock) if(lradar) then ! Only set melti to true at the output times - if(mod(kdt,nsteps_per_reset)==0)then + if (reset) then melti=.true. else melti=.false. @@ -3301,7 +3320,7 @@ subroutine fall_speed (ktop, kbot, den, qs, qi, qg, ql, tk, vts, vti, vtg) else tc (k) = tk (k) - tice vti (k) = (3. + log10 (qi (k) * den (k))) * (tc (k) * (aa * tc (k) + bb) + cc) + dd * tc (k) + ee - vti (k) = vi0 * exp (log_10 * vti (k)) + vti (k) = vi0 * exp (log_10 * vti (k)) * 0.9 vti (k) = min (vi_max, max (vf_min, vti (k))) endif enddo @@ -4683,127 +4702,141 @@ end subroutine interpolate_z !> \ingroup mod_gfdl_cloud_mp !! The subroutine 'cloud_diagnosis' diagnoses the radius of cloud !! species. -subroutine cloud_diagnosis (is, ie, js, je, den, qw, qi, qr, qs, qg, t, & +!>author Linjiong Zhoum, Shian-Jiann Lin +! ======================================================================= +subroutine cloud_diagnosis (is, ie, ks, ke, den, delp, lsm, qmw, qmi, qmr, qms, qmg, t, & rew, rei, rer, res, reg) -! qcw, qci, qcr, qcs, qcg, rew, rei, rer, res, reg) implicit none - integer, intent (in) :: is, ie, js, je + integer, intent (in) :: is, ie, ks, ke + integer, intent (in), dimension (is:ie) :: lsm ! land sea mask, 0: ocean, 1: land, 2: sea ice - real, intent (in), dimension (is:ie, js:je) :: den, t - real, intent (in), dimension (is:ie, js:je) :: qw, qi, qr, qs, qg ! units: kg / kg + real, intent (in), dimension (is:ie, ks:ke) :: den, delp, t + real, intent (in), dimension (is:ie, ks:ke) :: qmw, qmi, qmr, qms, qmg !< units: kg / kg -! real, intent (out), dimension (is:ie, js:je) :: qcw, qci, qcr, qcs, qcg ! units: kg / m^3 - real, dimension (is:ie, js:je) :: qcw, qci, qcr, qcs, qcg ! units: kg / m^3 - real, intent (out), dimension (is:ie, js:je) :: rew, rei, rer, res, reg ! units: micron + real, intent (out), dimension (is:ie, ks:ke) :: rew, rei, rer, res, reg !< units: micron - integer :: i, j + real, dimension (is:ie, ks:ke) :: qcw, qci, qcr, qcs, qcg !< units: g / m^2 + + integer :: i, k real :: lambdar, lambdas, lambdag + real :: dpg, rei_fac, mask, ccn, bw + real, parameter :: rho_0 = 50.e-3 real :: rhow = 1.0e3, rhor = 1.0e3, rhos = 1.0e2, rhog = 4.0e2 real :: n0r = 8.0e6, n0s = 3.0e6, n0g = 4.0e6 real :: alphar = 0.8, alphas = 0.25, alphag = 0.5 real :: gammar = 17.837789, gammas = 8.2850630, gammag = 11.631769 -! real :: qmin = 1.0e-5, ccn = 1.0e8, beta = 1.22 -! real :: qmin = 5.0e-6, ccn = 1.0e8, beta = 1.22 - real :: qmin = 9.0e-6, ccn = 1.0e8, beta = 1.22 -! real :: qmin = 1.0e-6, ccn = 1.0e8, beta = 1.22 -! real :: qmin = 1.0e-8, ccn = 1.0e8, beta = 1.22 -! real :: qmin = 1.0e-12, ccn = 1.0e8, beta = 1.22 - - ! real :: rewmin = 1.0, rewmax = 25.0 - ! real :: reimin = 10.0, reimax = 300.0 - ! real :: rermin = 25.0, rermax = 225.0 - ! real :: resmin = 300, resmax = 1000.0 - ! real :: regmin = 1000.0, regmax = 1.0e5 - real :: rewmin = 5.0, rewmax = 10.0 - real :: reimin = 10.0, reimax = 150.0 -! real :: rermin = 0.0, rermax = 10000.0 -! real :: resmin = 0.0, resmax = 10000.0 -! real :: regmin = 0.0, regmax = 10000.0 - real :: rermin = 50.0, rermax = 10000.0 - real :: resmin = 100.0, resmax = 10000.0 - real :: regmin = 300.0, regmax = 10000.0 + real :: qmin = 1.0e-12, beta = 1.22, qmin1 = 9.e-6 - do j = js, je + do k = ks, ke do i = is, ie + + dpg = abs (delp (i, k)) / grav + mask = min (max (real(lsm (i)), 0.0), 2.0) ! ----------------------------------------------------------------------- - ! cloud water (martin et al., 1994) + ! cloud water (Martin et al., 1994) ! ----------------------------------------------------------------------- - if (qw (i, j) .gt. qmin) then - qcw (i, j) = den (i, j) * qw (i, j) - rew (i, j) = exp (1.0 / 3.0 * log ((3 * qcw (i, j)) / (4 * pi * rhow * ccn))) * 1.0e6 - rew (i, j) = max (rewmin, min (rewmax, rew (i, j))) + ccn = 0.80 * (- 1.15e-3 * (ccn_o ** 2) + 0.963 * ccn_o + 5.30) * abs (mask - 1.0) + & + 0.67 * (- 2.10e-4 * (ccn_l ** 2) + 0.568 * ccn_l - 27.9) * (1.0 - abs (mask - 1.0)) + + if (qmw (i, k) .gt. qmin) then + qcw (i, k) = dpg * qmw (i, k) * 1.0e3 + rew (i, k) = exp (1.0 / 3.0 * log ((3.0 * den (i, k) * qmw (i, k)) / (4.0 * pi * rhow * ccn))) * 1.0e4 + rew (i, k) = max (rewmin, min (rewmax, rew (i, k))) else - qcw (i, j) = 0.0 - rew (i, j) = rewmin + qcw (i, k) = 0.0 + rew (i, k) = rewmin endif + + if (reiflag .eq. 1) then ! ----------------------------------------------------------------------- - ! cloud ice (heymsfield and mcfarquhar, 1996) + ! cloud ice (Heymsfield and Mcfarquhar, 1996) ! ----------------------------------------------------------------------- - if (qi (i, j) .gt. qmin) then - qci (i, j) = den (i, j) * qi (i, j) - if (t (i, j) - tice .lt. - 50) then - rei (i, j) = beta / 9.917 * exp ((1 - 0.891) * log (1.0e3 * qci (i, j))) * 1.0e3 - elseif (t (i, j) - tice .lt. - 40) then - rei (i, j) = beta / 9.337 * exp ((1 - 0.920) * log (1.0e3 * qci (i, j))) * 1.0e3 - elseif (t (i, j) - tice .lt. - 30) then - rei (i, j) = beta / 9.208 * exp ((1 - 0.945) * log (1.0e3 * qci (i, j))) * 1.0e3 + if (qmi (i, k) .gt. qmin1) then + qci (i, k) = dpg * qmi (i, k) * 1.0e3 + rei_fac = log (1.0e3 * qmi (i, k) * den (i, k)) + if (t (i, k) - tice .lt. - 50) then + rei (i, k) = beta / 9.917 * exp (0.109 * rei_fac) * 1.0e3 + elseif (t (i, k) - tice .lt. - 40) then + rei (i, k) = beta / 9.337 * exp (0.080 * rei_fac) * 1.0e3 + elseif (t (i, k) - tice .lt. - 30) then + rei (i, k) = beta / 9.208 * exp (0.055 * rei_fac) * 1.0e3 else - rei (i, j) = beta / 9.387 * exp ((1 - 0.969) * log (1.0e3 * qci (i, j))) * 1.0e3 + rei (i, k) = beta / 9.387 * exp (0.031 * rei_fac) * 1.0e3 endif - rei (i, j) = max (reimin, min (reimax, rei (i, j))) + rei (i, k) = max (reimin, min (reimax, rei (i, k))) else - qci (i, j) = 0.0 - rei (i, j) = reimin + qci (i, k) = 0.0 + rei (i, k) = reimin endif + endif + + if (reiflag .eq. 2) then + ! ----------------------------------------------------------------------- - ! rain (lin et al., 1983) + ! cloud ice (Wyser, 1998) ! ----------------------------------------------------------------------- - if (qr (i, j) .gt. qmin) then - qcr (i, j) = den (i, j) * qr (i, j) - lambdar = exp (0.25 * log (pi * rhor * n0r / qcr (i, j))) - rer (i, j) = 0.5 * exp (log (gammar / 6) / alphar) / lambdar * 1.0e6 - rer (i, j) = max (rermin, min (rermax, rer (i, j))) + if (qmi (i, k) .gt. qmin1) then + qci (i, k) = dpg * qmi (i, k) * 1.0e3 + bw = - 2. + 1.e-3 * log10 (den (i, k) * qmi (i, k) / rho_0) * max (0.0, tice - t (i, k)) ** 1.5 + rei (i, k) = 377.4 + bw * (203.3 + bw * (37.91 + 2.3696 * bw)) + rei (i, k) = max (reimin, min (reimax, rei (i, k))) else - qcr (i, j) = 0.0 - rer (i, j) = rermin + qci (i, k) = 0.0 + rei (i, k) = reimin + endif + endif ! ----------------------------------------------------------------------- - ! snow (lin et al., 1983) + ! rain (Lin et al., 1983) ! ----------------------------------------------------------------------- - if (qs (i, j) .gt. qmin) then - qcs (i, j) = den (i, j) * qs (i, j) - lambdas = exp (0.25 * log (pi * rhos * n0s / qcs (i, j))) - res (i, j) = 0.5 * exp (log (gammas / 6) / alphas) / lambdas * 1.0e6 - res (i, j) = max (resmin, min (resmax, res (i, j))) + if (qmr (i, k) .gt. qmin) then + qcr (i, k) = dpg * qmr (i, k) * 1.0e3 + lambdar = exp (0.25 * log (pi * rhor * n0r / qmr (i, k) / den (i, k))) + rer (i, k) = 0.5 * exp (log (gammar / 6) / alphar) / lambdar * 1.0e6 + rer (i, k) = max (rermin, min (rermax, rer (i, k))) else - qcs (i, j) = 0.0 - res (i, j) = resmin + qcr (i, k) = 0.0 + rer (i, k) = rermin endif ! ----------------------------------------------------------------------- - ! graupel (lin et al., 1983) + ! snow (Lin et al., 1983) ! ----------------------------------------------------------------------- - if (qg (i, j) .gt. qmin) then - qcg (i, j) = den (i, j) * qg (i, j) - lambdag = exp (0.25 * log (pi * rhog * n0g / qcg (i, j))) - reg (i, j) = 0.5 * exp (log (gammag / 6) / alphag) / lambdag * 1.0e6 - reg (i, j) = max (regmin, min (regmax, reg (i, j))) + if (qms (i, k) .gt. qmin1) then + qcs (i, k) = dpg * qms (i, k) * 1.0e3 + lambdas = exp (0.25 * log (pi * rhos * n0s / qms (i, k) / den (i, k))) + res (i, k) = 0.5 * exp (log (gammas / 6) / alphas) / lambdas * 1.0e6 + res (i, k) = max (resmin, min (resmax, res (i, k))) + else + qcs (i, k) = 0.0 + res (i, k) = resmin + endif + + ! ----------------------------------------------------------------------- + ! graupel (Lin et al., 1983) + ! ----------------------------------------------------------------------- + + if (qmg (i, k) .gt. qmin) then + qcg (i, k) = dpg * qmg (i, k) * 1.0e3 + lambdag = exp (0.25 * log (pi * rhog * n0g / qmg (i, k) / den (i, k))) + reg (i, k) = 0.5 * exp (log (gammag / 6) / alphag) / lambdag * 1.0e6 + reg (i, k) = max (regmin, min (regmax, reg (i, k))) else - qcg (i, j) = 0.0 - reg (i, j) = regmin + qcg (i, k) = 0.0 + reg (i, k) = regmin endif enddo diff --git a/physics/module_mp_thompson.F90 b/physics/module_mp_thompson.F90 index f958ab5e8..8a8755495 100644 --- a/physics/module_mp_thompson.F90 +++ b/physics/module_mp_thompson.F90 @@ -408,13 +408,14 @@ MODULE module_mp_thompson !>\ingroup aathompson !! This subroutine calculates simplified cloud species equations and create !! lookup tables in Thomspson scheme. -!>\section gen_thompson_init GSD thompson_init General Algorithm +!>\section gen_thompson_init thompson_init General Algorithm !> @{ SUBROUTINE thompson_init(nwfa2d, nifa2d, nwfa, nifa, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte, & - mpicomm, mpirank, mpiroot, threads) + mpicomm, mpirank, mpiroot, & + threads, errmsg, errflg) IMPLICIT NONE @@ -428,6 +429,8 @@ SUBROUTINE thompson_init(nwfa2d, nifa2d, nwfa, nifa, & REAL, DIMENSION(ims:ime,jms:jme), OPTIONAL, INTENT(IN) :: nwfa2d, nifa2d INTEGER, INTENT(IN) :: mpicomm, mpirank, mpiroot INTEGER, INTENT(IN) :: threads + CHARACTER(len=*), INTENT(INOUT) :: errmsg + INTEGER, INTENT(INOUT) :: errflg INTEGER:: i, j, k, l, m, n @@ -501,22 +504,22 @@ SUBROUTINE thompson_init(nwfa2d, nifa2d, nwfa, nifa, & !> - From Martin et al. (1994), assign gamma shape parameter mu for cloud !! drops according to general dispersion characteristics (disp=~0.25 -!! for Maritime and 0.45 for Continental). +!! for maritime and 0.45 for continental) !.. disp=SQRT((mu+2)/(mu+1) - 1) so mu varies from 15 for Maritime !.. to 2 for really dirty air. This not used in 2-moment cloud water !.. scheme and nu_c used instead and varies from 2 to 15 (integer-only). mu_c = MIN(15., (1000.E6/Nt_c + 2.)) -!> - Compute Schmidt number to one-third used numerous times. +!> - Compute Schmidt number to one-third used numerous times Sc3 = Sc**(1./3.) -!> - Compute min ice diam from mass, min snow/graupel mass from diam. +!> - Compute minimum ice diam from mass, min snow/graupel mass from diam D0i = (xm0i/am_i)**(1./bm_i) xm0s = am_s * D0s**bm_s xm0g = am_g * D0g**bm_g -!> - Compute constants various exponents and gamma() assoc with cloud, -!! rain, snow, and graupel. +!> - Compute constants various exponents and gamma() associated with cloud, +!! rain, snow, and graupel do n = 1, 15 cce(1,n) = n + 1. cce(2,n) = bm_r + n + 1. @@ -621,7 +624,7 @@ SUBROUTINE thompson_init(nwfa2d, nifa2d, nwfa, nifa, & ogg3 = 1./cgg(3) !+---+-----------------------------------------------------------------+ -!> - Simplify various rate eqns the best we can now. +!> - Simplify various rate equations !+---+-----------------------------------------------------------------+ !> - Compute rain collecting cloud water and cloud ice @@ -629,36 +632,36 @@ SUBROUTINE thompson_init(nwfa2d, nifa2d, nwfa, nifa, & t1_qr_qi = PI*.25*av_r * crg(9) t2_qr_qi = PI*.25*am_r*av_r * crg(8) -!> - Compute Graupel collecting cloud water +!> - Compute graupel collecting cloud water t1_qg_qc = PI*.25*av_g * cgg(9) -!> - Compute Snow collecting cloud water +!> - Compute snow collecting cloud water t1_qs_qc = PI*.25*av_s -!> - Compute Snow collecting cloud ice +!> - Compute snow collecting cloud ice t1_qs_qi = PI*.25*av_s -!> - Compute Evaporation of rain; ignore depositional growth of rain. +!> - Compute evaporation of rain; ignore depositional growth of rain t1_qr_ev = 0.78 * crg(10) t2_qr_ev = 0.308*Sc3*SQRT(av_r) * crg(11) -!> - Compute Sublimation/depositional growth of snow +!> - Compute sublimation/depositional growth of snow t1_qs_sd = 0.86 t2_qs_sd = 0.28*Sc3*SQRT(av_s) -!> - Compute Melting of snow +!> - Compute melting of snow t1_qs_me = PI*4.*C_sqrd*olfus * 0.86 t2_qs_me = PI*4.*C_sqrd*olfus * 0.28*Sc3*SQRT(av_s) -!> - Compute Sublimation/depositional growth of graupel +!> - Compute sublimation/depositional growth of graupel t1_qg_sd = 0.86 * cgg(10) t2_qg_sd = 0.28*Sc3*SQRT(av_g) * cgg(11) -!> - Compute Melting of graupel +!> - Compute melting of graupel t1_qg_me = PI*4.*C_cube*olfus * 0.86 * cgg(10) t2_qg_me = PI*4.*C_cube*olfus * 0.28*Sc3*SQRT(av_g) * cgg(11) -!> - Compute Constants for helping find lookup table indexes. +!> - Compute constants for helping find lookup table indexes nic2 = NINT(ALOG10(r_c(1))) nii2 = NINT(ALOG10(r_i(1))) nii3 = NINT(ALOG10(Nt_i(1))) @@ -669,7 +672,7 @@ SUBROUTINE thompson_init(nwfa2d, nifa2d, nwfa, nifa, & nig3 = NINT(ALOG10(N0g_exp(1))) niIN2 = NINT(ALOG10(Nt_IN(1))) -!> - Create bins of cloud water (from min diameter up to 100 microns). +!> - Create bins of cloud water (from min diameter up to 100 microns) Dc(1) = D0c*1.0d0 dtc(1) = D0c*1.0d0 do n = 2, nbc @@ -677,7 +680,7 @@ SUBROUTINE thompson_init(nwfa2d, nifa2d, nwfa, nifa, & dtc(n) = (Dc(n) - Dc(n-1)) enddo -!> - Create bins of cloud ice (from min diameter up to 5x min snow size). +!> - Create bins of cloud ice (from min diameter up to 5x min snow size) xDx(1) = D0i*1.0d0 xDx(nbi+1) = 5.0d0*D0s do n = 2, nbi @@ -689,7 +692,7 @@ SUBROUTINE thompson_init(nwfa2d, nifa2d, nwfa, nifa, & dti(n) = xDx(n+1) - xDx(n) enddo -!> - Create bins of rain (from min diameter up to 5 mm). +!> - Create bins of rain (from min diameter up to 5 mm) xDx(1) = D0r*1.0d0 xDx(nbr+1) = 0.005d0 do n = 2, nbr @@ -701,7 +704,7 @@ SUBROUTINE thompson_init(nwfa2d, nifa2d, nwfa, nifa, & dtr(n) = xDx(n+1) - xDx(n) enddo -!> - Create bins of snow (from min diameter up to 2 cm). +!> - Create bins of snow (from min diameter up to 2 cm) xDx(1) = D0s*1.0d0 xDx(nbs+1) = 0.02d0 do n = 2, nbs @@ -713,7 +716,7 @@ SUBROUTINE thompson_init(nwfa2d, nifa2d, nwfa, nifa, & dts(n) = xDx(n+1) - xDx(n) enddo -!> - Create bins of graupel (from min diameter up to 5 cm). +!> - Create bins of graupel (from min diameter up to 5 cm) xDx(1) = D0g*1.0d0 xDx(nbg+1) = 0.05d0 do n = 2, nbg @@ -725,7 +728,7 @@ SUBROUTINE thompson_init(nwfa2d, nifa2d, nwfa, nifa, & dtg(n) = xDx(n+1) - xDx(n) enddo -!> - Create bins of cloud droplet number concentration (1 to 3000 per cc). +!> - Create bins of cloud droplet number concentration (1 to 3000 per cc) xDx(1) = 1.0d0 xDx(nbc+1) = 3000.0d0 do n = 2, nbc @@ -738,7 +741,7 @@ SUBROUTINE thompson_init(nwfa2d, nifa2d, nwfa, nifa, & nic1 = DLOG(t_Nc(nbc)/t_Nc(1)) !+---+-----------------------------------------------------------------+ -!> - Create lookup tables for most costly calculations. +!> - Create lookup tables for most costly calculations !+---+-----------------------------------------------------------------+ ! Assign mpicomm to module variable @@ -870,27 +873,28 @@ SUBROUTINE thompson_init(nwfa2d, nifa2d, nwfa, nifa, & enddo enddo - if (mpirank==mpiroot) WRITE (*,*)'CREATING MICROPHYSICS LOOKUP TABLES ... ' - if (mpirank==mpiroot) WRITE (*,'(a, f5.2, a, f5.2, a, f5.2, a, f5.2)') & + if (mpirank==mpiroot) write (*,*)'creating microphysics lookup tables ... ' + if (mpirank==mpiroot) write (*,'(a, f5.2, a, f5.2, a, f5.2, a, f5.2)') & ' using: mu_c=',mu_c,' mu_i=',mu_i,' mu_r=',mu_r,' mu_g=',mu_g !> - Call table_ccnact() to read a static file containing CCN activation of aerosols. The !! data were created from a parcel model by Feingold & Heymsfield with -!! further changes by Eidhammer and Kriedenweis. +!! further changes by Eidhammer and Kriedenweis ! This computation is cheap compared to the others below, and ! doing it always ensures that the correct data is in the SIONlib ! file containing the precomputed tables *DH - WRITE (*,*) ' calling table_ccnAct routine' - call table_ccnAct + if (mpirank==mpiroot) write(0,*) ' calling table_ccnAct routine' + call table_ccnAct(errmsg,errflg) + if (.not. errflg==0) return -!> - Call table_efrw() and table_Efsw() to creat collision efficiency table -!! between rain/snow and cloud water. - WRITE (*,*)' creating qc collision eff tables' +!> - Call table_efrw() and table_efsw() to creat collision efficiency table +!! between rain/snow and cloud water + if (mpirank==mpiroot) write(0,*) ' creating qc collision eff tables' call table_Efrw call table_Efsw -!> - Call table_dropevap() to creat rain drop evaporation table. - WRITE(*,*) ' creating rain evap table' +!> - Call table_dropevap() to creat rain drop evaporation table + if (mpirank==mpiroot) write(0,*) ' creating rain evap table' call table_dropEvap call cpu_time(etime) @@ -898,7 +902,7 @@ SUBROUTINE thompson_init(nwfa2d, nifa2d, nwfa, nifa, & end if precomputed_tables_1 -!> - Call radar_init() to initialize various constants for computing radar reflectivity. +!> - Call radar_init() to initialize various constants for computing radar reflectivity call cpu_time(stime) xam_r = am_r xbm_r = bm_r @@ -920,39 +924,29 @@ SUBROUTINE thompson_init(nwfa2d, nifa2d, nwfa, nifa, & call cpu_time(stime) -!$OMP parallel num_threads(threads) - -!$OMP sections - -!$OMP section -!> - Call qr_acr_qg() to create rain collecting graupel & graupel collecting rain table. - WRITE (*,*) ' creating rain collecting graupel table' +!> - Call qr_acr_qg() to create rain collecting graupel & graupel collecting rain table + if (mpirank==mpiroot) write(0,*) ' creating rain collecting graupel table' call cpu_time(stime) call qr_acr_qg call cpu_time(etime) if (mpirank==mpiroot) print '("Computing rain collecting graupel table took ",f10.3," seconds.")', etime-stime -!$OMP section -!> - Call qr_acr_qs() to create rain collecting snow & snow collecting rain table. - WRITE (*,*) ' creating rain collecting snow table' +!> - Call qr_acr_qs() to create rain collecting snow & snow collecting rain table + if (mpirank==mpiroot) write (*,*) ' creating rain collecting snow table' call cpu_time(stime) call qr_acr_qs call cpu_time(etime) if (mpirank==mpiroot) print '("Computing rain collecting snow table took ",f10.3," seconds.")', etime-stime -!$OMP end sections - -!$OMP end parallel - -!> - Call freezeh2o() to create cloud water and rain freezing (Bigg, 1953) table. - WRITE (*,*) ' creating freezing of water drops table' +!> - Call freezeh2o() to create cloud water and rain freezing (Bigg, 1953) table + if (mpirank==mpiroot) write(0,*) ' creating freezing of water drops table' call cpu_time(stime) call freezeH2O(threads) call cpu_time(etime) if (mpirank==mpiroot) print '("Computing freezing of water drops table took ",f10.3," seconds.")', etime-stime -!> - Call qi_aut_qs() to create conversion of some ice mass into snow category. - WRITE (*,*) ' creating ice converting to snow table' +!> - Call qi_aut_qs() to create conversion of some ice mass into snow category + if (mpirank==mpiroot) write(0,*) ' creating ice converting to snow table' call cpu_time(stime) call qi_aut_qs call cpu_time(etime) @@ -984,17 +978,16 @@ SUBROUTINE thompson_init(nwfa2d, nifa2d, nwfa, nifa, & endif if_not_iiwarm - WRITE (*,*) ' ... DONE microphysical lookup tables' + if (mpirank==mpiroot) write(0,*) ' ... DONE microphysical lookup tables' endif if_micro_init END SUBROUTINE thompson_init - !> @} !>\ingroup aathompson !!This is a wrapper routine designed to transfer values from 3D to 1D. -!!\section gen_mpgtdriver GSD Thompson mp_gt_driver General Algorithm +!!\section gen_mpgtdriver Thompson mp_gt_driver General Algorithm !> @{ SUBROUTINE mp_gt_driver(qv, qc, qr, qi, qs, qg, ni, nr, nc, & nwfa, nifa, nwfa2d, nifa2d, & @@ -1014,7 +1007,7 @@ SUBROUTINE mp_gt_driver(qv, qc, qr, qi, qs, qg, ni, nr, nc, & ids,ide, jds,jde, kds,kde, & ! domain dims ims,ime, jms,jme, kms,kme, & ! memory dims its,ite, jts,jte, kts,kte, & ! tile dims - errmsg, errflg) + errmsg, errflg, reset) implicit none @@ -1031,7 +1024,7 @@ SUBROUTINE mp_gt_driver(qv, qc, qr, qi, qs, qg, ni, nr, nc, & REAL, DIMENSION(ims:ime, kms:kme, jms:jme), OPTIONAL, INTENT(INOUT):: & nc, nwfa, nifa REAL, DIMENSION(ims:ime, jms:jme), OPTIONAL, INTENT(IN):: nwfa2d, nifa2d - REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(OUT):: & + REAL, DIMENSION(ims:ime, kms:kme, jms:jme), OPTIONAL, INTENT(OUT):: & re_cloud, re_ice, re_snow INTEGER, INTENT(IN):: has_reqc, has_reqi, has_reqs #if ( WRF_CHEM == 1 ) @@ -1052,6 +1045,7 @@ SUBROUTINE mp_gt_driver(qv, qc, qr, qi, qs, qg, ni, nr, nc, & vt_dbz_wt LOGICAL, OPTIONAL, INTENT(IN) :: first_time_step REAL, INTENT(IN):: dt_in + LOGICAL, INTENT (IN) :: reset !..Local variables REAL, DIMENSION(kts:kte):: & @@ -1074,6 +1068,8 @@ SUBROUTINE mp_gt_driver(qv, qc, qr, qi, qs, qg, ni, nr, nc, & INTEGER:: i_start, j_start, i_end, j_end LOGICAL, OPTIONAL, INTENT(IN) :: diagflag INTEGER, OPTIONAL, INTENT(IN) :: do_radar_ref + logical :: melti = .false. + ! CCPP error handling character(len=*), optional, intent( out) :: errmsg integer, optional, intent( out) :: errflg @@ -1299,7 +1295,7 @@ SUBROUTINE mp_gt_driver(qv, qc, qr, qi, qs, qg, ni, nr, nc, & kmax_qc = k qc_max = qc1d(k) elseif (qc1d(k) .lt. 0.0) then - write(*,*) 'WARNING, negative qc ', qc1d(k), & + write(*,'(a,e16.7,a,3i8)') 'WARNING, negative qc ', qc1d(k), & ' at i,j,k=', i,j,k endif if (qr1d(k) .gt. qr_max) then @@ -1308,7 +1304,7 @@ SUBROUTINE mp_gt_driver(qv, qc, qr, qi, qs, qg, ni, nr, nc, & kmax_qr = k qr_max = qr1d(k) elseif (qr1d(k) .lt. 0.0) then - write(*,*) 'WARNING, negative qr ', qr1d(k), & + write(*,'(a,e16.7,a,3i8)') 'WARNING, negative qr ', qr1d(k), & ' at i,j,k=', i,j,k endif if (nr1d(k) .gt. nr_max) then @@ -1317,7 +1313,7 @@ SUBROUTINE mp_gt_driver(qv, qc, qr, qi, qs, qg, ni, nr, nc, & kmax_nr = k nr_max = nr1d(k) elseif (nr1d(k) .lt. 0.0) then - write(*,*) 'WARNING, negative nr ', nr1d(k), & + write(*,'(a,e16.7,a,3i8)') 'WARNING, negative nr ', nr1d(k), & ' at i,j,k=', i,j,k endif if (qs1d(k) .gt. qs_max) then @@ -1326,7 +1322,7 @@ SUBROUTINE mp_gt_driver(qv, qc, qr, qi, qs, qg, ni, nr, nc, & kmax_qs = k qs_max = qs1d(k) elseif (qs1d(k) .lt. 0.0) then - write(*,*) 'WARNING, negative qs ', qs1d(k), & + write(*,'(a,e16.7,a,3i8)') 'WARNING, negative qs ', qs1d(k), & ' at i,j,k=', i,j,k endif if (qi1d(k) .gt. qi_max) then @@ -1335,7 +1331,7 @@ SUBROUTINE mp_gt_driver(qv, qc, qr, qi, qs, qg, ni, nr, nc, & kmax_qi = k qi_max = qi1d(k) elseif (qi1d(k) .lt. 0.0) then - write(*,*) 'WARNING, negative qi ', qi1d(k), & + write(*,'(a,e16.7,a,3i8)') 'WARNING, negative qi ', qi1d(k), & ' at i,j,k=', i,j,k endif if (qg1d(k) .gt. qg_max) then @@ -1344,7 +1340,7 @@ SUBROUTINE mp_gt_driver(qv, qc, qr, qi, qs, qg, ni, nr, nc, & kmax_qg = k qg_max = qg1d(k) elseif (qg1d(k) .lt. 0.0) then - write(*,*) 'WARNING, negative qg ', qg1d(k), & + write(*,'(a,e16.7,a,3i8)') 'WARNING, negative qg ', qg1d(k), & ' at i,j,k=', i,j,k endif if (ni1d(k) .gt. ni_max) then @@ -1353,11 +1349,11 @@ SUBROUTINE mp_gt_driver(qv, qc, qr, qi, qs, qg, ni, nr, nc, & kmax_ni = k ni_max = ni1d(k) elseif (ni1d(k) .lt. 0.0) then - write(*,*) 'WARNING, negative ni ', ni1d(k), & + write(*,'(a,e16.7,a,3i8)') 'WARNING, negative ni ', ni1d(k), & ' at i,j,k=', i,j,k endif if (qv1d(k) .lt. 0.0) then - write(*,*) 'WARNING, negative qv ', qv1d(k), & + write(*,'(a,e16.7,a,3i8)') 'WARNING, negative qv ', qv1d(k), & ' at i,j,k=', i,j,k if (k.lt.kte-2 .and. k.gt.kts+1) then write(*,*) ' below and above are: ', qv(i,k-1,j), qv(i,k+1,j) @@ -1369,15 +1365,26 @@ SUBROUTINE mp_gt_driver(qv, qc, qr, qi, qs, qg, ni, nr, nc, & enddo !> - Call calc_refl10cm() + IF ( PRESENT (diagflag) ) THEN if (diagflag .and. do_radar_ref == 1) then +! + ! Only set melti to true at the output times + if (reset) then + melti=.true. + else + melti=.false. + endif +! if (present(vt_dbz_wt) .and. present(first_time_step)) then call calc_refl10cm (qv1d, qc1d, qr1d, nr1d, qs1d, qg1d, & - t1d, p1d, dBZ, kts, kte, i, j, & - vt_dbz_wt(i,:,j), first_time_step) + t1d, p1d, dBZ, kts, kte, i, j, & + melti, vt_dbz_wt(i,:,j), & + first_time_step) else - call calc_refl10cm (qv1d, qc1d, qr1d, nr1d, qs1d, qg1d, & - t1d, p1d, dBZ, kts, kte, i, j) + call calc_refl10cm (qv1d, qc1d, qr1d, nr1d, qs1d, qg1d, & + t1d, p1d, dBZ, kts, kte, i, j, & + melti) end if do k = kts, kte refl_10cm(i,k,j) = MAX(-35., dBZ(k)) @@ -1477,7 +1484,7 @@ END SUBROUTINE thompson_finalize !! Previously this code was based on Reisner et al (1998), but few of !! those pieces remain. A complete description is now found in !! Thompson et al. (2004, 2008)\cite Thompson_2004 \cite Thompson_2008. -!>\section gen_mp_thompson GSD mp_thompson General Algorithm +!>\section gen_mp_thompson mp_thompson General Algorithm !> @{ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & nr1d, nc1d, nwfa1d, nifa1d, t1d, p1d, w1d, dzq, & @@ -1486,11 +1493,9 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & rainprod, evapprod, & #endif kts, kte, dt, ii, jj) - ! DH* #ifdef MPI use mpi #endif - ! *DH implicit none !..Sub arguments @@ -1586,7 +1591,7 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & INTEGER:: idx_tc, idx_t, idx_s, idx_g1, idx_g, idx_r1, idx_r, & idx_i1, idx_i, idx_c, idx, idx_d, idx_n, idx_in - LOGICAL:: melti, no_micro + LOGICAL:: no_micro LOGICAL, DIMENSION(kts:kte):: L_qc, L_qi, L_qr, L_qs, L_qg LOGICAL:: debug_flag INTEGER:: nu_c @@ -3697,7 +3702,8 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & enddo end subroutine mp_thompson -! >@} +!>@} + !+---+-----------------------------------------------------------------+ !ctrlL !+---+-----------------------------------------------------------------+ @@ -3731,7 +3737,7 @@ subroutine qr_acr_qg call MPI_BARRIER(mpi_communicator,ierr) #endif IF ( lexist ) THEN - write(0,*) "ThompMP: read qr_acr_qg.dat instead of computing" + !write(0,*) "ThompMP: read qr_acr_qg.dat instead of computing" OPEN(63,file="qr_acr_qg.dat",form="unformatted",err=1234) !sms$serial begin READ(63,err=1234) tcg_racg @@ -3907,7 +3913,7 @@ subroutine qr_acr_qs call MPI_BARRIER(mpi_communicator,ierr) #endif IF ( lexist ) THEN - write(0,*) "ThompMP: read qr_acr_qs.dat instead of computing" + !write(0,*) "ThompMP: read qr_acr_qs.dat instead of computing" OPEN(63,file="qr_acr_qs.dat",form="unformatted",err=1234) !sms$serial begin READ(63,err=1234)tcs_racs1 @@ -4168,7 +4174,7 @@ subroutine freezeH2O(threads) call MPI_BARRIER(mpi_communicator,ierr) #endif IF ( lexist ) THEN - write(0,*) "ThompMP: read freezeH2O.dat instead of computing" + !write(0,*) "ThompMP: read freezeH2O.dat instead of computing" OPEN(63,file="freezeH2O.dat",form="unformatted",err=1234) !sms$serial begin READ(63,err=1234)tpi_qrfz @@ -4615,15 +4621,17 @@ end subroutine table_dropEvap !! vertical velocity, temperature, lognormal mean aerosol radius, and !! hygroscopicity, kappa. The data are read from external file and !! contain activated fraction of CCN for given conditions. - subroutine table_ccnAct + subroutine table_ccnAct(errmess,errflag) implicit none +!..Error handling variables + CHARACTER(len=*), INTENT(INOUT) :: errmess + INTEGER, INTENT(INOUT) :: errflag !..Local variables INTEGER:: iunit_mp_th1, i LOGICAL:: opened - CHARACTER*64 errmess iunit_mp_th1 = -1 DO i = 20,99 @@ -4651,19 +4659,11 @@ subroutine table_ccnAct RETURN 9009 CONTINUE WRITE( errmess , '(A,I2)' ) 'module_mp_thompson: error opening CCN_ACTIVATE.BIN on unit ',iunit_mp_th1 - write(0,*) errmess - ! DH* TEMPORARY FIX 20181203 - call sleep(5) - stop - ! *DH + errflag = 1 RETURN 9010 CONTINUE WRITE( errmess , '(A,I2)' ) 'module_mp_thompson: error reading CCN_ACTIVATE.BIN on unit ',iunit_mp_th1 - write(0,*) errmess - ! DH* TEMPORARY FIX 20181203 - call sleep(5) - stop - ! *DH + errflag = 1 RETURN end subroutine table_ccnAct @@ -4757,9 +4757,11 @@ end function activ_ncloud !+---+-----------------------------------------------------------------+ !+---+-----------------------------------------------------------------+ !>\ingroup aathompson +!! Returns the incomplete gamma function q(a,x) evaluated by its +!! continued fraction representation as gammcf. SUBROUTINE GCF(GAMMCF,A,X,GLN) -!> RETURNS THE INCOMPLETE GAMMA FUNCTION Q(A,X) EVALUATED BY ITS -!! CONTINUED FRACTION REPRESENTATION AS GAMMCF. ALSO RETURNS +! RETURNS THE INCOMPLETE GAMMA FUNCTION Q(A,X) EVALUATED BY ITS +! CONTINUED FRACTION REPRESENTATION AS GAMMCF. ALSO RETURNS ! --- LN(GAMMA(A)) AS GLN. THE CONTINUED FRACTION IS EVALUATED BY ! --- A MODIFIED LENTZ METHOD. ! --- USES GAMMLN @@ -4794,6 +4796,8 @@ END SUBROUTINE GCF ! (C) Copr. 1986-92 Numerical Recipes Software 2.02 !>\ingroup aathompson +!! Returns the incomplete gamma function p(a,x) evaluated by +!! its series representation as gamser. SUBROUTINE GSER(GAMSER,A,X,GLN) ! --- RETURNS THE INCOMPLETE GAMMA FUNCTION P(A,X) EVALUATED BY ITS ! --- ITS SERIES REPRESENTATION AS GAMSER. ALSO RETURNS LN(GAMMA(A)) @@ -4827,6 +4831,7 @@ END SUBROUTINE GSER ! (C) Copr. 1986-92 Numerical Recipes Software 2.02 !>\ingroup aathompson +!! Returns the value ln(gamma(xx)) for xx > 0. REAL FUNCTION GAMMLN(XX) ! --- RETURNS THE VALUE LN(GAMMA(XX)) FOR XX > 0. IMPLICIT NONE @@ -5212,8 +5217,9 @@ end subroutine calc_effectRad !! library of routines. The meltwater fraction is simply the amount !! of frozen species remaining from what initially existed at the !! melting level interface. - subroutine calc_refl10cm (qv1d, qc1d, qr1d, nr1d, qs1d, qg1d, & - t1d, p1d, dBZ, kts, kte, ii, jj, vt_dBZ, first_time_step) + subroutine calc_refl10cm (qv1d, qc1d, qr1d, nr1d, qs1d, qg1d, & + t1d, p1d, dBZ, kts, kte, ii, jj, melti, vt_dBZ, & + first_time_step) IMPLICIT NONE @@ -5246,7 +5252,7 @@ subroutine calc_refl10cm (qv1d, qc1d, qr1d, nr1d, qs1d, qg1d, & DOUBLE PRECISION:: fmelt_s, fmelt_g INTEGER:: i, k, k_0, kbot, n - LOGICAL:: melti + LOGICAL, INTENT(IN):: melti LOGICAL, DIMENSION(kts:kte):: L_qr, L_qs, L_qg DOUBLE PRECISION:: cback, x, eta, f_d @@ -5399,18 +5405,16 @@ subroutine calc_refl10cm (qv1d, qc1d, qr1d, nr1d, qs1d, qg1d, & !+---+-----------------------------------------------------------------+ !..Locate K-level of start of melting (k_0 is level above). !+---+-----------------------------------------------------------------+ - melti = .false. k_0 = kts - do k = kte-1, kts, -1 - if ( (temp(k).gt.273.15) .and. L_qr(k) & + if ( melti ) then + K_LOOP:do k = kte-1, kts, -1 + if ((temp(k).gt.273.15) .and. L_qr(k) & & .and. (L_qs(k+1).or.L_qg(k+1)) ) then - k_0 = MAX(k+1, k_0) - melti=.true. - goto 195 - endif - enddo - 195 continue - + k_0 = MAX(k+1, k_0) + EXIT K_LOOP + endif + enddo K_LOOP + endif !+---+-----------------------------------------------------------------+ !..Assume Rayleigh approximation at 10 cm wavelength. Rain (all temps) !.. and non-water-coated snow and graupel when below freezing are diff --git a/physics/module_mp_thompson_make_number_concentrations.F90 b/physics/module_mp_thompson_make_number_concentrations.F90 index ef6779a67..b31753aa2 100644 --- a/physics/module_mp_thompson_make_number_concentrations.F90 +++ b/physics/module_mp_thompson_make_number_concentrations.F90 @@ -79,6 +79,11 @@ elemental real function make_IceNumber (Q_ice, temp) 161.503, 168.262, 175.248, 182.473, 189.952, 197.699, & 205.728, 214.055, 222.694, 231.661, 240.971, 250.639 /) + if (Q_ice == 0) then + make_IceNumber = 0 + return + end if + !+---+-----------------------------------------------------------------+ !..From the model 3D temperature field, subtract 179K for which !.. index value of retab as a start. Value of corr is for @@ -133,6 +138,11 @@ elemental real function make_DropletNumber (Q_cloud, qnwfa) real:: q_nwfa, x1, xDc integer:: nu_c + if (Q_cloud == 0) then + make_DropletNumber = 0 + return + end if + !+---+ q_nwfa = MAX(99.E6, MIN(qnwfa,5.E10)) @@ -160,6 +170,11 @@ elemental real function make_RainNumber (Q_rain, temp) !real, parameter:: PI = 3.1415926536 real, parameter:: am_r = PI*1000./6. + if (Q_rain == 0) then + make_RainNumber = 0 + return + end if + !+---+-----------------------------------------------------------------+ !.. Not thrilled with it, but set Y-intercept parameter to Marshal-Palmer value !.. that basically assumes melting snow becomes typical rain. However, for @@ -172,7 +187,7 @@ elemental real function make_RainNumber (Q_rain, temp) N0 = 8.E6 if (temp .le. 271.15) then - N0 = 8.E8 + N0 = 8.E8 elseif (temp .gt. 271.15 .and. temp.lt.273.15) then N0 = 8. * 10**(279.15-temp) endif diff --git a/physics/module_nst_water_prop.f90 b/physics/module_nst_water_prop.f90 index 8b38ffb18..3f3916396 100644 --- a/physics/module_nst_water_prop.f90 +++ b/physics/module_nst_water_prop.f90 @@ -657,7 +657,8 @@ subroutine get_dtzm_point(xt,xz,dt_cool,zc,z1,z2,dtm) end subroutine get_dtzm_point !>\ingroup waterprop - subroutine get_dtzm_2d(xt,xz,dt_cool,zc,wet,icy,z1,z2,nx,ny,dtm) + subroutine get_dtzm_2d(xt,xz,dt_cool,zc,wet,z1,z2,nx,ny,dtm) +!subroutine get_dtzm_2d(xt,xz,dt_cool,zc,wet,icy,z1,z2,nx,ny,dtm) ! ===================================================================== ! ! ! ! description: get dtm = mean of dT(z) (z1 - z2) with NSST dT(z) ! @@ -695,7 +696,8 @@ subroutine get_dtzm_2d(xt,xz,dt_cool,zc,wet,icy,z1,z2,nx,ny,dtm) integer, intent(in) :: nx,ny real (kind=kind_phys), dimension(nx,ny), intent(in) :: xt,xz,dt_cool,zc - logical, dimension(nx,ny), intent(in) :: wet,icy + logical, dimension(nx,ny), intent(in) :: wet +! logical, dimension(nx,ny), intent(in) :: wet,icy real (kind=kind_phys), intent(in) :: z1,z2 real (kind=kind_phys), dimension(nx,ny), intent(out) :: dtm ! Local variables @@ -712,7 +714,8 @@ subroutine get_dtzm_2d(xt,xz,dt_cool,zc,wet,icy,z1,z2,nx,ny,dtm) ! dtw(i,j) = 0.0 dtc(i,j) = 0.0 - if ( wet(i,j) .and. .not.icy(i,j) ) then +! if ( wet(i,j) .and. .not.icy(i,j) ) then + if ( wet(i,j) ) then ! ! get the mean warming in the range of z=z1 to z=z2 ! @@ -752,10 +755,12 @@ subroutine get_dtzm_2d(xt,xz,dt_cool,zc,wet,icy,z1,z2,nx,ny,dtm) ! ! get the mean T departure from Tf in the range of z=z1 to z=z2 +! DH* NEED NTHREADS HERE! TODO !$omp parallel do private(j,i) do j = 1, ny do i= 1, nx - if ( wet(i,j) .and. .not.icy(i,j)) then +! if ( wet(i,j) .and. .not.icy(i,j)) then + if ( wet(i,j) ) then dtm(i,j) = dtw(i,j) - dtc(i,j) endif enddo diff --git a/physics/module_sf_noahmp_glacier.f90 b/physics/module_sf_noahmp_glacier.f90 new file mode 100644 index 000000000..1b9b3cf3f --- /dev/null +++ b/physics/module_sf_noahmp_glacier.f90 @@ -0,0 +1,3124 @@ +!> \file module_sf_noahmp_glacier.f90 +!! This file contains the NoahMP Glacier scheme. + +!>\ingroup NoahMP_LSM +module noahmp_glacier_globals + + implicit none + +! ================================================================================================== +!------------------------------------------------------------------------------------------! +! physical constants: ! +!------------------------------------------------------------------------------------------! + + real, parameter :: grav = 9.80616 !acceleration due to gravity (m/s2) + real, parameter :: sb = 5.67e-08 !stefan-boltzmann constant (w/m2/k4) + real, parameter :: vkc = 0.40 !von karman constant + real, parameter :: tfrz = 273.16 !freezing/melting point (k) + real, parameter :: hsub = 2.8440e06 !latent heat of sublimation (j/kg) + real, parameter :: hvap = 2.5104e06 !latent heat of vaporization (j/kg) + real, parameter :: hfus = 0.3336e06 !latent heat of fusion (j/kg) + real, parameter :: cwat = 4.188e06 !specific heat capacity of water (j/m3/k) + real, parameter :: cice = 2.094e06 !specific heat capacity of ice (j/m3/k) + real, parameter :: cpair = 1004.64 !heat capacity dry air at const pres (j/kg/k) + real, parameter :: tkwat = 0.6 !thermal conductivity of water (w/m/k) + real, parameter :: tkice = 2.2 !thermal conductivity of ice (w/m/k) + real, parameter :: tkair = 0.023 !thermal conductivity of air (w/m/k) + real, parameter :: rair = 287.04 !gas constant for dry air (j/kg/k) + real, parameter :: rw = 461.269 !gas constant for water vapor (j/kg/k) + real, parameter :: denh2o = 1000. !density of water (kg/m3) + real, parameter :: denice = 917. !density of ice (kg/m3) + +! =====================================options for different schemes================================ +! options for dynamic vegetation: +! 1 -> off (use table lai; use fveg = shdfac from input) +! 2 -> on (together with opt_crs = 1) +! 3 -> off (use table lai; calculate fveg) +! 4 -> off (use table lai; use maximum vegetation fraction) + + integer :: dveg != 2 ! + +! options for canopy stomatal resistance +! 1-> ball-berry; 2->jarvis + + integer :: opt_crs != 1 !(must 1 when dveg = 2) + +! options for soil moisture factor for stomatal resistance +! 1-> noah (soil moisture) +! 2-> clm (matric potential) +! 3-> ssib (matric potential) + + integer :: opt_btr != 1 !(suggested 1) + +! options for runoff and groundwater +! 1 -> topmodel with groundwater (niu et al. 2007 jgr) ; +! 2 -> topmodel with an equilibrium water table (niu et al. 2005 jgr) ; +! 3 -> original surface and subsurface runoff (free drainage) +! 4 -> bats surface and subsurface runoff (free drainage) + + integer :: opt_run != 1 !(suggested 1) + +! options for surface layer drag coeff (ch & cm) +! 1->m-o ; 2->original noah (chen97); 3->myj consistent; 4->ysu consistent. + + integer :: opt_sfc != 1 !(1 or 2 or 3 or 4) + +! options for supercooled liquid water (or ice fraction) +! 1-> no iteration (niu and yang, 2006 jhm); 2: koren's iteration + + integer :: opt_frz != 1 !(1 or 2) + +! options for frozen soil permeability +! 1 -> linear effects, more permeable (niu and yang, 2006, jhm) +! 2 -> nonlinear effects, less permeable (old) + + integer :: opt_inf != 1 !(suggested 1) + +! options for radiation transfer +! 1 -> modified two-stream (gap = f(solar angle, 3d structure ...)<1-fveg) +! 2 -> two-stream applied to grid-cell (gap = 0) +! 3 -> two-stream applied to vegetated fraction (gap=1-fveg) + + integer :: opt_rad != 1 !(suggested 1) + +! options for ground snow surface albedo +! 1-> bats; 2 -> class + + integer :: opt_alb != 2 !(suggested 2) + +! options for partitioning precipitation into rainfall & snowfall +! 1 -> jordan (1991); 2 -> bats: when sfctmp sfctmp zero heat flux from bottom (zbot and tbot not used) +! 2 -> tbot at zbot (8m) read from a file (original noah) + + integer :: opt_tbot != 2 !(suggested 2) + +! options for snow/soil temperature time scheme (only layer 1) +! 1 -> semi-implicit; 2 -> full implicit (original noah) + + integer :: opt_stc != 1 !(suggested 1) + +! adjustable parameters for snow processes + + real, parameter :: z0sno = 0.002 !snow surface roughness length (m) (0.002) + real, parameter :: ssi = 0.03 !liquid water holding capacity for snowpack (m3/m3) (0.03) + real, parameter :: swemx = 1.00 !new snow mass to fully cover old snow (mm) + !equivalent to 10mm depth (density = 100 kg/m3) + +!------------------------------------------------------------------------------------------! +end module noahmp_glacier_globals +!------------------------------------------------------------------------------------------! + +!>\ingroup NoahMP_LSM +module noahmp_glacier_routines + use noahmp_glacier_globals +#ifndef CCPP + use module_wrf_utl +#endif + implicit none + + public :: noahmp_options_glacier + public :: noahmp_glacier + + private :: atm_glacier + private :: energy_glacier + private :: thermoprop_glacier + private :: csnow_glacier + private :: radiation_glacier + private :: snow_age_glacier + private :: snowalb_bats_glacier + private :: snowalb_class_glacier + private :: glacier_flux + private :: sfcdif1_glacier + private :: tsnosoi_glacier + private :: hrt_glacier + private :: hstep_glacier + private :: rosr12_glacier + private :: phasechange_glacier + + private :: water_glacier + private :: snowwater_glacier + private :: snowfall_glacier + private :: combine_glacier + private :: divide_glacier + private :: combo_glacier + private :: compact_glacier + private :: snowh2o_glacier + + private :: error_glacier + +contains +! +! ================================================================================================== + +!>\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 : +#ifdef CCPP + emissi, fpice ,ch2b , esnow, errmsg, errflg) +#else + emissi, fpice ,ch2b , esnow) +#endif + + +! -------------------------------------------------------------------------------------------------- +! initial code: guo-yue niu, oct. 2007 +! modified to glacier: michael barlage, june 2012 +! -------------------------------------------------------------------------------------------------- + implicit none +! -------------------------------------------------------------------------------------------------- +! input + integer , intent(in) :: iloc !grid index + integer , intent(in) :: jloc !grid index + real , intent(in) :: cosz !cosine solar zenith angle [0-1] + integer , intent(in) :: nsnow !maximum no. of snow layers + integer , intent(in) :: nsoil !no. of soil layers + real , intent(in) :: dt !time step [sec] + real , intent(in) :: sfctmp !surface air temperature [k] + real , intent(in) :: sfcprs !pressure (pa) + real , intent(in) :: uu !wind speed in eastward dir (m/s) + real , intent(in) :: vv !wind speed in northward dir (m/s) + real , intent(in) :: q2 !mixing ratio (kg/kg) lowest model layer + real , intent(in) :: soldn !downward shortwave radiation (w/m2) + real , intent(in) :: prcp !precipitation rate (kg m-2 s-1) + real , intent(in) :: lwdn !downward longwave radiation (w/m2) + real , intent(in) :: tbot !bottom condition for soil temp. [k] + real , intent(in) :: zlvl !reference height (m) + real, dimension(-nsnow+1: 0), intent(in) :: ficeold!ice fraction at last timestep + real, dimension( 1:nsoil), intent(in) :: zsoil !layer-bottom depth from soil surf (m) + + +! input/output : need arbitary intial values + real , intent(inout) :: qsnow !snowfall [mm/s] + real , intent(inout) :: sneqvo !snow mass at last time step (mm) + real , intent(inout) :: albold !snow albedo at last time step (class type) + real , intent(inout) :: cm !momentum drag coefficient + real , intent(inout) :: ch !sensible heat exchange coefficient + +! prognostic variables + integer , intent(inout) :: isnow !actual no. of snow layers [-] + real , intent(inout) :: sneqv !snow water eqv. [mm] + real, dimension( 1:nsoil), intent(inout) :: smc !soil moisture (ice + liq.) [m3/m3] + real, dimension(-nsnow+1:nsoil), intent(inout) :: zsnso !layer-bottom depth from snow surf [m] + real , intent(inout) :: snowh !snow height [m] + real, dimension(-nsnow+1: 0), intent(inout) :: snice !snow layer ice [mm] + real, dimension(-nsnow+1: 0), intent(inout) :: snliq !snow layer liquid water [mm] + real , intent(inout) :: tg !ground temperature (k) + real, dimension(-nsnow+1:nsoil), intent(inout) :: stc !snow/soil temperature [k] + real, dimension( 1:nsoil), intent(inout) :: sh2o !liquid soil moisture [m3/m3] + real , intent(inout) :: tauss !non-dimensional snow age + real , intent(inout) :: qsfc !mixing ratio at lowest model layer + +! output + real , intent(out) :: fsa !total absorbed solar radiation (w/m2) + real , intent(out) :: fsr !total reflected solar radiation (w/m2) + real , intent(out) :: fira !total net lw rad (w/m2) [+ to atm] + real , intent(out) :: fsh !total sensible heat (w/m2) [+ to atm] + real , intent(out) :: fgev !ground evap heat (w/m2) [+ to atm] + real , intent(out) :: ssoil !ground heat flux (w/m2) [+ to soil] + real , intent(out) :: trad !surface radiative temperature (k) + real , intent(out) :: edir !soil surface evaporation rate (mm/s] + real , intent(out) :: runsrf !surface runoff [mm/s] + real , intent(out) :: runsub !baseflow (saturation excess) [mm/s] + real , intent(out) :: sag !solar rad absorbed by ground (w/m2) + real , intent(out) :: albedo !surface albedo [-] + real , intent(out) :: qsnbot !snowmelt [mm/s] + real , intent(out) :: ponding!surface ponding [mm] + real , intent(out) :: ponding1!surface ponding [mm] + real , intent(out) :: ponding2!surface ponding [mm] + real , intent(out) :: t2m !2-m air temperature over bare ground part [k] + real , intent(out) :: q2e + real , intent(out) :: emissi + real , intent(out) :: fpice + real , intent(out) :: ch2b + real , intent(out) :: esnow + +#ifdef CCPP + character(len=*), intent(inout) :: errmsg + integer, intent(inout) :: errflg +#endif + +! local + integer :: iz !do-loop index + integer, dimension(-nsnow+1:nsoil) :: imelt !phase change index [1-melt; 2-freeze] + real :: rhoair !density air (kg/m3) + real, dimension(-nsnow+1:nsoil) :: dzsnso !snow/soil layer thickness [m] + real :: thair !potential temperature (k) + real :: qair !specific humidity (kg/kg) (q2/(1+q2)) + real :: eair !vapor pressure air (pa) + real, dimension( 1: 2) :: solad !incoming direct solar rad (w/m2) + real, dimension( 1: 2) :: solai !incoming diffuse solar rad (w/m2) + real, dimension( 1:nsoil) :: sice !soil ice content (m3/m3) + real, dimension(-nsnow+1: 0) :: snicev !partial volume ice of snow [m3/m3] + real, dimension(-nsnow+1: 0) :: snliqv !partial volume liq of snow [m3/m3] + real, dimension(-nsnow+1: 0) :: epore !effective porosity [m3/m3] + real :: qdew !ground surface dew rate [mm/s] + real :: qvap !ground surface evap. rate [mm/s] + real :: lathea !latent heat [j/kg] + real :: qmelt !internal pack melt + real :: swdown !downward solar [w/m2] + real :: beg_wb !beginning water for error check + real :: zbot = -8.0 + + character*256 message + +! -------------------------------------------------------------------------------------------------- +! re-process atmospheric forcing + + call atm_glacier (sfcprs ,sfctmp ,q2 ,soldn ,cosz ,thair , & + qair ,eair ,rhoair ,solad ,solai ,swdown ) + + beg_wb = sneqv + +! snow/soil layer thickness (m); interface depth: zsnso < 0; layer thickness dzsnso > 0 + + do iz = isnow+1, nsoil + if(iz == isnow+1) then + dzsnso(iz) = - zsnso(iz) + else + dzsnso(iz) = zsnso(iz-1) - zsnso(iz) + end if + end do + +! 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 +#ifdef CCPP + tauss ,qsfc ,errmsg ,errflg , & !inout +#else + tauss ,qsfc , & !inout +#endif + imelt ,snicev ,snliqv ,epore ,qmelt ,ponding, & !out + sag ,fsa ,fsr ,fira ,fsh ,fgev , & !out + trad ,t2m ,ssoil ,lathea ,q2e ,emissi, ch2b ) !out + +#ifdef CCPP + if (errflg /= 0) return +#endif + + sice = max(0.0, smc - sh2o) + sneqvo = sneqv + + qvap = max( fgev/lathea, 0.) ! positive part of fgev [mm/s] > 0 + qdew = abs( min(fgev/lathea, 0.)) ! negative part of fgev [mm/s] > 0 + edir = qvap - qdew + +! 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 , & !inout + runsrf ,runsub ,qsnow ,ponding1 ,ponding2,qsnbot,fpice,esnow & !out + ) + +! if(maxval(sice) < 0.0001) then +! write(message,*) "glacier has melted at:",iloc,jloc," are you sure this should be a glacier point?" +! call wrf_debug(10,trim(message)) +! end if + +! water and energy balance check + + 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 ) +#else + runsrf ,runsub ,sneqv ,dt ,beg_wb ) +#endif + +#ifdef CCPP + if (errflg /= 0) return +#endif + + if(snowh <= 1.e-6 .or. sneqv <= 1.e-3) then + snowh = 0.0 + sneqv = 0.0 + end if + + if(swdown.ne.0.) then + albedo = fsr / swdown + else + albedo = -999.9 + end if + + + end subroutine noahmp_glacier +! ================================================================================================== +!>\ingroup NoahMP_LSM + subroutine atm_glacier (sfcprs ,sfctmp ,q2 ,soldn ,cosz ,thair , & + qair ,eair ,rhoair ,solad ,solai , & + swdown ) +! -------------------------------------------------------------------------------------------------- +! re-process atmospheric forcing +! -------------------------------------------------------------------------------------------------- + implicit none +! -------------------------------------------------------------------------------------------------- +! inputs + + real , intent(in) :: sfcprs !pressure (pa) + real , intent(in) :: sfctmp !surface air temperature [k] + real , intent(in) :: q2 !mixing ratio (kg/kg) + real , intent(in) :: soldn !downward shortwave radiation (w/m2) + real , intent(in) :: cosz !cosine solar zenith angle [0-1] + +! outputs + + real , intent(out) :: thair !potential temperature (k) + real , intent(out) :: qair !specific humidity (kg/kg) (q2/(1+q2)) + real , intent(out) :: eair !vapor pressure air (pa) + real, dimension( 1: 2), intent(out) :: solad !incoming direct solar radiation (w/m2) + real, dimension( 1: 2), intent(out) :: solai !incoming diffuse solar radiation (w/m2) + real , intent(out) :: rhoair !density air (kg/m3) + real , intent(out) :: swdown !downward solar filtered by sun angle [w/m2] + +!locals + + real :: pair !atm bottom level pressure (pa) +! -------------------------------------------------------------------------------------------------- + + pair = sfcprs ! atm bottom level pressure (pa) + thair = sfctmp * (sfcprs/pair)**(rair/cpair) +! qair = q2 / (1.0+q2) ! mixing ratio to specific humidity [kg/kg] + qair = q2 ! in wrf, driver converts to specific humidity + + eair = qair*sfcprs / (0.622+0.378*qair) + rhoair = (sfcprs-0.378*eair) / (rair*sfctmp) + + if(cosz <= 0.) then + swdown = 0. + else + swdown = soldn + end if + + solad(1) = swdown*0.7*0.5 ! direct vis + solad(2) = swdown*0.7*0.5 ! direct nir + solai(1) = swdown*0.3*0.5 ! diffuse vis + solai(2) = swdown*0.3*0.5 ! diffuse nir + + 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 +#ifdef CCPP + tauss ,qsfc ,errmsg, errflg, & !inout +#else + tauss ,qsfc , & !inout +#endif + imelt ,snicev ,snliqv ,epore ,qmelt ,ponding, & !out + sag ,fsa ,fsr ,fira ,fsh ,fgev , & !out + trad ,t2m ,ssoil ,lathea ,q2e ,emissi, ch2b ) !out + +! -------------------------------------------------------------------------------------------------- +! -------------------------------------------------------------------------------------------------- +! use noahmp_veg_parameters +! use noahmp_rad_parameters +! -------------------------------------------------------------------------------------------------- + implicit none +! -------------------------------------------------------------------------------------------------- +! inputs + integer , intent(in) :: nsnow !maximum no. of snow layers + integer , intent(in) :: nsoil !number of soil layers + integer , intent(in) :: isnow !actual no. of snow layers + real , intent(in) :: dt !time step [sec] + real , intent(in) :: qsnow !snowfall on the ground (mm/s) + real , intent(in) :: rhoair !density air (kg/m3) + real , intent(in) :: eair !vapor pressure air (pa) + real , intent(in) :: sfcprs !pressure (pa) + real , intent(in) :: qair !specific humidity (kg/kg) + real , intent(in) :: sfctmp !air temperature (k) + real , intent(in) :: lwdn !downward longwave radiation (w/m2) + real , intent(in) :: uu !wind speed in e-w dir (m/s) + real , intent(in) :: vv !wind speed in n-s dir (m/s) + real , dimension( 1: 2), intent(in) :: solad !incoming direct solar rad. (w/m2) + real , dimension( 1: 2), intent(in) :: solai !incoming diffuse solar rad. (w/m2) + real , intent(in) :: cosz !cosine solar zenith angle (0-1) + real , intent(in) :: zref !reference height (m) + real , intent(in) :: tbot !bottom condition for soil temp. (k) + real , intent(in) :: zbot !depth for tbot [m] + real , dimension(-nsnow+1:nsoil), intent(in) :: zsnso !layer-bottom depth from snow surf [m] + real , dimension(-nsnow+1:nsoil), intent(in) :: dzsnso !depth of snow & soil layer-bottom [m] + +! input & output + real , intent(inout) :: tg !ground temperature (k) + real , dimension(-nsnow+1:nsoil), intent(inout) :: stc !snow/soil temperature [k] + real , intent(inout) :: snowh !snow height [m] + real , intent(inout) :: sneqv !snow mass (mm) + real , intent(inout) :: sneqvo !snow mass at last time step (mm) + real , dimension( 1:nsoil), intent(inout) :: sh2o !liquid soil moisture [m3/m3] + real , dimension( 1:nsoil), intent(inout) :: smc !soil moisture (ice + liq.) [m3/m3] + real , dimension(-nsnow+1: 0), intent(inout) :: snice !snow ice mass (kg/m2) + real , dimension(-nsnow+1: 0), intent(inout) :: snliq !snow liq mass (kg/m2) + real , intent(inout) :: albold !snow albedo at last time step(class type) + real , intent(inout) :: cm !momentum drag coefficient + real , intent(inout) :: ch !sensible heat exchange coefficient + real , intent(inout) :: tauss !snow aging factor + real , intent(inout) :: qsfc !mixing ratio at lowest model layer + +#ifdef CCPP + character(len=*) , intent(inout) :: errmsg + integer , intent(inout) :: errflg +#endif + +! outputs + integer, dimension(-nsnow+1:nsoil), intent(out) :: imelt !phase change index [1-melt; 2-freeze] + real , dimension(-nsnow+1: 0), intent(out) :: snicev !partial volume ice [m3/m3] + real , dimension(-nsnow+1: 0), intent(out) :: snliqv !partial volume liq. water [m3/m3] + real , dimension(-nsnow+1: 0), intent(out) :: epore !effective porosity [m3/m3] + real , intent(out) :: qmelt !snowmelt [mm/s] + real , intent(out) :: ponding!pounding at ground [mm] + real , intent(out) :: sag !solar rad. absorbed by ground (w/m2) + real , intent(out) :: fsa !tot. absorbed solar radiation (w/m2) + real , intent(out) :: fsr !tot. reflected solar radiation (w/m2) + real , intent(out) :: fira !total net lw. rad (w/m2) [+ to atm] + real , intent(out) :: fsh !total sensible heat (w/m2) [+ to atm] + real , intent(out) :: fgev !ground evaporation (w/m2) [+ to atm] + real , intent(out) :: trad !radiative temperature (k) + real , intent(out) :: t2m !2 m height air temperature (k) + real , intent(out) :: ssoil !ground heat flux (w/m2) [+ to soil] + real , intent(out) :: lathea !latent heat vap./sublimation (j/kg) + real , intent(out) :: q2e + real , intent(out) :: emissi + real , intent(out) :: ch2b !sensible heat conductance, canopy air to zlvl air (m/s) + + +! local + real :: ur !wind speed at height zlvl (m/s) + real :: zlvl !reference height (m) + real :: rsurf !ground surface resistance (s/m) + real :: zpd !zero plane displacement (m) + real :: z0mg !z0 momentum, ground (m) + real :: emg !ground emissivity + real :: fire !emitted ir (w/m2) + real, dimension(-nsnow+1:nsoil) :: fact !temporary used in phase change + real, dimension(-nsnow+1:nsoil) :: df !thermal conductivity [w/m/k] + real, dimension(-nsnow+1:nsoil) :: hcpct !heat capacity [j/m3/k] + real :: gamma !psychrometric constant (pa/k) + real :: rhsur !raltive humidity in surface soil/snow air space (-) + +! --------------------------------------------------------------------------------------------------- + +! wind speed at reference height: ur >= 1 + + ur = max( sqrt(uu**2.+vv**2.), 1. ) + +! roughness length and displacement height + + z0mg = z0sno + zpd = snowh + + zlvl = zpd + zref + +! thermal properties of soil, snow, lake, and frozen soil + + call thermoprop_glacier (nsoil ,nsnow ,isnow ,dzsnso , & !in + dt ,snowh ,snice ,snliq , & !in + df ,hcpct ,snicev ,snliqv ,epore , & !out + fact ) !out + +! solar radiation: absorbed & reflected by the ground + + call radiation_glacier (dt ,tg ,sneqvo ,sneqv ,cosz , & !in + qsnow ,solad ,solai , & !in + albold ,tauss , & !inout + sag ,fsr ,fsa) !out + +! vegetation and ground emissivity + + emg = 0.98 + +! soil surface resistance for ground evap. + + rhsur = 1.0 + rsurf = 1.0 + +! set psychrometric constant + + lathea = hsub + gamma = cpair*sfcprs/(0.622*lathea) + +! 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 +#ifdef CCPP + cm ,ch ,tg ,qsfc ,errmsg ,errflg , & !inout +#else + cm ,ch ,tg ,qsfc , & !inout +#endif + fira ,fsh ,fgev ,ssoil , & !out + t2m ,q2e ,ch2b) !out + +!energy balance at surface: sag=(irb+shb+evb+ghb) + + fire = lwdn + fira + + if(fire <=0.) then +#ifdef CCPP + errflg = 1 + errmsg = "stop in noah-mp: emitted longwave <0" + return +#else + call wrf_error_fatal("stop in noah-mp: emitted longwave <0") +#endif + end if + + ! compute a net emissivity + emissi = emg + + ! when we're computing a trad, subtract from the emitted ir the + ! reflected portion of the incoming lwdn, so we're just + ! considering the ir originating in the canopy/ground system. + + trad = ( ( fire - (1-emissi)*lwdn ) / (emissi*sb) ) ** 0.25 + +! 3l snow & 4l soil temperatures + + call tsnosoi_glacier (nsoil ,nsnow ,isnow ,dt ,tbot , & !in + ssoil ,snowh ,zbot ,zsnso ,df , & !in + hcpct , & !in + stc ) !inout + +! adjusting snow surface temperature + if(opt_stc == 2) then + if (snowh > 0.05 .and. tg > tfrz) tg = tfrz + end if + +! energy released or consumed by snow & frozen soil + + call phasechange_glacier (nsnow ,nsoil ,isnow ,dt ,fact , & !in + dzsnso , & !in + stc ,snice ,snliq ,sneqv ,snowh , & !inout + smc ,sh2o , & !inout + qmelt ,imelt ,ponding ) !out + + + end subroutine energy_glacier +! ================================================================================================== +!>\ingroup NoahMP_LSM + subroutine thermoprop_glacier (nsoil ,nsnow ,isnow ,dzsnso , & !in + dt ,snowh ,snice ,snliq , & !in + df ,hcpct ,snicev ,snliqv ,epore , & !out + fact ) !out +! ------------------------------------------------------------------------------------------------- +! ------------------------------------------------------------------------------------------------- + implicit none +! -------------------------------------------------------------------------------------------------- +! inputs + integer , intent(in) :: nsoil !number of soil layers + integer , intent(in) :: nsnow !maximum no. of snow layers + integer , intent(in) :: isnow !actual no. of snow layers + real , intent(in) :: dt !time step [s] + real, dimension(-nsnow+1: 0), intent(in) :: snice !snow ice mass (kg/m2) + real, dimension(-nsnow+1: 0), intent(in) :: snliq !snow liq mass (kg/m2) + real, dimension(-nsnow+1:nsoil), intent(in) :: dzsnso !thickness of snow/soil layers [m] + real , intent(in) :: snowh !snow height [m] + +! outputs + real, dimension(-nsnow+1:nsoil), intent(out) :: df !thermal conductivity [w/m/k] + real, dimension(-nsnow+1:nsoil), intent(out) :: hcpct !heat capacity [j/m3/k] + real, dimension(-nsnow+1: 0), intent(out) :: snicev !partial volume of ice [m3/m3] + real, dimension(-nsnow+1: 0), intent(out) :: snliqv !partial volume of liquid water [m3/m3] + real, dimension(-nsnow+1: 0), intent(out) :: epore !effective porosity [m3/m3] + real, dimension(-nsnow+1:nsoil), intent(out) :: fact !computing energy for phase change +! -------------------------------------------------------------------------------------------------- +! locals + + integer :: iz, iz2 + real, dimension(-nsnow+1: 0) :: cvsno !volumetric specific heat (j/m3/k) + real, dimension(-nsnow+1: 0) :: tksno !snow thermal conductivity (j/m3/k) + real :: zmid !mid-point soil depth +! -------------------------------------------------------------------------------------------------- + +! compute snow thermal conductivity and heat capacity + + call csnow_glacier (isnow ,nsnow ,nsoil ,snice ,snliq ,dzsnso , & !in + tksno ,cvsno ,snicev ,snliqv ,epore ) !out + + do iz = isnow+1, 0 + df (iz) = tksno(iz) + hcpct(iz) = cvsno(iz) + end do + +! compute soil thermal properties (using noah glacial ice approximations) + + do iz = 1, nsoil + zmid = 0.5 * (dzsnso(iz)) + do iz2 = 1, iz-1 + zmid = zmid + dzsnso(iz2) + end do + hcpct(iz) = 1.e6 * ( 0.8194 + 0.1309*zmid ) + df(iz) = 0.32333 + ( 0.10073 * zmid ) + end do + +! combine a temporary variable used for melting/freezing of snow and frozen soil + + do iz = isnow+1,nsoil + fact(iz) = dt/(hcpct(iz)*dzsnso(iz)) + end do + +! snow/soil interface + + if(isnow == 0) then + df(1) = (df(1)*dzsnso(1)+0.35*snowh) / (snowh +dzsnso(1)) + else + df(1) = (df(1)*dzsnso(1)+df(0)*dzsnso(0)) / (dzsnso(0)+dzsnso(1)) + end if + + + end subroutine thermoprop_glacier +! ================================================================================================== +! -------------------------------------------------------------------------------------------------- +!>\ingroup NoahMP_LSM + subroutine csnow_glacier (isnow ,nsnow ,nsoil ,snice ,snliq ,dzsnso , & !in + tksno ,cvsno ,snicev ,snliqv ,epore ) !out +! -------------------------------------------------------------------------------------------------- +! snow bulk density,volumetric capacity, and thermal conductivity +!--------------------------------------------------------------------------------------------------- + implicit none +!--------------------------------------------------------------------------------------------------- +! inputs + + integer, intent(in) :: isnow !number of snow layers (-) + integer , intent(in) :: nsnow !maximum no. of snow layers + integer , intent(in) :: nsoil !number of soil layers + real, dimension(-nsnow+1: 0), intent(in) :: snice !snow ice mass (kg/m2) + real, dimension(-nsnow+1: 0), intent(in) :: snliq !snow liq mass (kg/m2) + real, dimension(-nsnow+1:nsoil), intent(in) :: dzsnso !snow/soil layer thickness [m] + +! outputs + + real, dimension(-nsnow+1: 0), intent(out) :: cvsno !volumetric specific heat (j/m3/k) + real, dimension(-nsnow+1: 0), intent(out) :: tksno !thermal conductivity (w/m/k) + real, dimension(-nsnow+1: 0), intent(out) :: snicev !partial volume of ice [m3/m3] + real, dimension(-nsnow+1: 0), intent(out) :: snliqv !partial volume of liquid water [m3/m3] + real, dimension(-nsnow+1: 0), intent(out) :: epore !effective porosity [m3/m3] + +! locals + + integer :: iz + real, dimension(-nsnow+1: 0) :: bdsnoi !bulk density of snow(kg/m3) + +!--------------------------------------------------------------------------------------------------- +! thermal capacity of snow + + do iz = isnow+1, 0 + snicev(iz) = min(1., snice(iz)/(dzsnso(iz)*denice) ) + epore(iz) = 1. - snicev(iz) + snliqv(iz) = min(epore(iz),snliq(iz)/(dzsnso(iz)*denh2o)) + enddo + + do iz = isnow+1, 0 + bdsnoi(iz) = (snice(iz)+snliq(iz))/dzsnso(iz) + cvsno(iz) = cice*snicev(iz)+cwat*snliqv(iz) +! cvsno(iz) = 0.525e06 ! constant + enddo + +! thermal conductivity of snow + + do iz = isnow+1, 0 + tksno(iz) = 3.2217e-6*bdsnoi(iz)**2. ! stieglitz(yen,1965) +! tksno(iz) = 2e-2+2.5e-6*bdsnoi(iz)*bdsnoi(iz) ! anderson, 1976 +! tksno(iz) = 0.35 ! constant +! tksno(iz) = 2.576e-6*bdsnoi(iz)**2. + 0.074 ! verseghy (1991) +! tksno(iz) = 2.22*(bdsnoi(iz)/1000.)**1.88 ! douvill(yen, 1981) + enddo + + 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) !out +! -------------------------------------------------------------------------------------------------- + implicit none +! -------------------------------------------------------------------------------------------------- +! input + real, intent(in) :: dt !time step [s] + real, intent(in) :: tg !ground temperature (k) + real, intent(in) :: sneqvo !snow mass at last time step(mm) + real, intent(in) :: sneqv !snow mass (mm) + real, intent(in) :: cosz !cosine solar zenith angle (0-1) + real, intent(in) :: qsnow !snowfall (mm/s) + real, dimension(1:2) , intent(in) :: solad !incoming direct solar radiation (w/m2) + real, dimension(1:2) , intent(in) :: solai !incoming diffuse solar radiation (w/m2) + +! inout + real, intent(inout) :: albold !snow albedo at last time step (class type) + real, intent(inout) :: tauss !non-dimensional snow age + +! output + real, intent(out) :: sag !solar radiation absorbed by ground (w/m2) + real, intent(out) :: fsr !total reflected solar radiation (w/m2) + real, intent(out) :: fsa !total absorbed solar radiation (w/m2) + +! local + integer :: ib !number of radiation bands + integer :: nband !number of radiation bands + real :: fage !snow age function (0 - new snow) + real, dimension(1:2) :: albsnd !snow albedo (direct) + real, dimension(1:2) :: albsni !snow albedo (diffuse) + real :: alb !current class albedo + real :: abs !temporary absorbed rad + real :: ref !temporary reflected rad + real :: fsno !snow-cover fraction, = 1 if any snow + real, dimension(1:2) :: albice !albedo land ice: 1=vis, 2=nir + + real,parameter :: mpe = 1.e-6 + +! -------------------------------------------------------------------------------------------------- + + nband = 2 + albsnd = 0.0 + albsni = 0.0 + albice(1) = 0.80 !albedo land ice: 1=vis, 2=nir + albice(2) = 0.55 + +! snow age + + call snow_age_glacier (dt,tg,sneqvo,sneqv,tauss,fage) + +! snow albedos: age even when sun is not present + + if(opt_alb == 1) & + call snowalb_bats_glacier (nband,cosz,fage,albsnd,albsni) + if(opt_alb == 2) then + call snowalb_class_glacier(nband,qsnow,dt,alb,albold,albsnd,albsni) + albold = alb + end if + +! zero summed solar fluxes + + sag = 0. + fsa = 0. + fsr = 0. + + fsno = 0.0 + if(sneqv > 0.0) fsno = 1.0 + +! loop over nband wavebands + + do ib = 1, nband + + albsnd(ib) = albice(ib)*(1.-fsno) + albsnd(ib)*fsno + albsni(ib) = albice(ib)*(1.-fsno) + albsni(ib)*fsno + +! solar radiation absorbed by ground surface + + abs = solad(ib)*(1.-albsnd(ib)) + solai(ib)*(1.-albsni(ib)) + sag = sag + abs + fsa = fsa + abs + + ref = solad(ib)*albsnd(ib) + solai(ib)*albsni(ib) + fsr = fsr + ref + + end do + + end subroutine radiation_glacier +! ================================================================================================== +!>\ingroup NoahMP_LSM + subroutine snow_age_glacier (dt,tg,sneqvo,sneqv,tauss,fage) +! -------------------------------------------------------------------------------------------------- + implicit none +! ------------------------ code history ------------------------------------------------------------ +! from bats +! ------------------------ input/output variables -------------------------------------------------- +!input + real, intent(in) :: dt !main time step (s) + real, intent(in) :: tg !ground temperature (k) + real, intent(in) :: sneqvo !snow mass at last time step(mm) + real, intent(in) :: sneqv !snow water per unit ground area (mm) + +! inout + real, intent(inout) :: tauss !non-dimensional snow age + +!output + real, intent(out) :: fage !snow age + +!local + real :: tage !total aging effects + real :: age1 !effects of grain growth due to vapor diffusion + real :: age2 !effects of grain growth at freezing of melt water + real :: age3 !effects of soot + real :: dela !temporary variable + real :: sge !temporary variable + real :: dels !temporary variable + real :: dela0 !temporary variable + real :: arg !temporary variable +! see yang et al. (1997) j.of climate for detail. +!--------------------------------------------------------------------------------------------------- + + if(sneqv.le.0.0) then + tauss = 0. + else if (sneqv.gt.800.) then + tauss = 0. + else +! tauss = 0. + dela0 = 1.e-6*dt + arg = 5.e3*(1./tfrz-1./tg) + age1 = exp(arg) + age2 = exp(amin1(0.,10.*arg)) + age3 = 0.3 + tage = age1+age2+age3 + dela = dela0*tage + dels = amax1(0.0,sneqv-sneqvo) / swemx + sge = (tauss+dela)*(1.0-dels) + tauss = amax1(0.,sge) + endif + + fage= tauss/(tauss+1.) + + end subroutine snow_age_glacier +! ================================================================================================== +! -------------------------------------------------------------------------------------------------- +!>\ingroup NoahMP_LSM + subroutine snowalb_bats_glacier (nband,cosz,fage,albsnd,albsni) +! -------------------------------------------------------------------------------------------------- + implicit none +! -------------------------------------------------------------------------------------------------- +! input + + integer,intent(in) :: nband !number of waveband classes + + real,intent(in) :: cosz !cosine solar zenith angle + real,intent(in) :: fage !snow age correction + +! output + + real, dimension(1:2),intent(out) :: albsnd !snow albedo for direct(1=vis, 2=nir) + real, dimension(1:2),intent(out) :: albsni !snow albedo for diffuse +! --------------------------------------------------------------------------------------------- + + real :: fzen !zenith angle correction + real :: cf1 !temperary variable + real :: sl2 !2.*sl + real :: sl1 !1/sl + real :: sl !adjustable parameter + real, parameter :: c1 = 0.2 !default in bats + real, parameter :: c2 = 0.5 !default in bats +! real, parameter :: c1 = 0.2 * 2. ! double the default to match sleepers river's +! real, parameter :: c2 = 0.5 * 2. ! snow surface albedo (double aging effects) +! --------------------------------------------------------------------------------------------- +! zero albedos for all points + + albsnd(1: nband) = 0. + albsni(1: nband) = 0. + +! when cosz > 0 + + sl=2.0 + sl1=1./sl + sl2=2.*sl + cf1=((1.+sl1)/(1.+sl2*cosz)-sl1) + fzen=amax1(cf1,0.) + + albsni(1)=0.95*(1.-c1*fage) + albsni(2)=0.65*(1.-c2*fage) + + albsnd(1)=albsni(1)+0.4*fzen*(1.-albsni(1)) ! vis direct + albsnd(2)=albsni(2)+0.4*fzen*(1.-albsni(2)) ! nir direct + + end subroutine snowalb_bats_glacier +! ================================================================================================== +! -------------------------------------------------------------------------------------------------- +!>\ingroup NoahMP_LSM + subroutine snowalb_class_glacier (nband,qsnow,dt,alb,albold,albsnd,albsni) +! -------------------------------------------------------------------------------------------------- + implicit none +! -------------------------------------------------------------------------------------------------- +! input + + integer,intent(in) :: nband !number of waveband classes + + real,intent(in) :: qsnow !snowfall (mm/s) + real,intent(in) :: dt !time step (sec) + real,intent(in) :: albold !snow albedo at last time step + +! in & out + + real, intent(inout) :: alb ! +! output + + real, dimension(1:2),intent(out) :: albsnd !snow albedo for direct(1=vis, 2=nir) + real, dimension(1:2),intent(out) :: albsni !snow albedo for diffuse +! --------------------------------------------------------------------------------------------- + +! --------------------------------------------------------------------------------------------- +! zero albedos for all points + + albsnd(1: nband) = 0. + albsni(1: nband) = 0. + +! when cosz > 0 + + alb = 0.55 + (albold-0.55) * exp(-0.01*dt/3600.) + +! 1 mm fresh snow(swe) -- 10mm snow depth, assumed the fresh snow density 100kg/m3 +! here assume 1cm snow depth will fully cover the old snow + + if (qsnow > 0.) then + alb = alb + min(qsnow*dt,swemx) * (0.84-alb)/(swemx) + endif + + albsni(1)= alb ! vis diffuse + albsni(2)= alb ! nir diffuse + albsnd(1)= alb ! vis direct + albsnd(2)= alb ! nir direct + + end subroutine snowalb_class_glacier +! ================================================================================================== +!>\ingroup NoahMP_LSM + 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 +#ifdef CCPP + cm ,ch ,tgb ,qsfc ,errmsg ,errflg , & !inout +#else + cm ,ch ,tgb ,qsfc , & !inout +#endif + irb ,shb ,evb ,ghb , & !out + t2mb ,q2b ,ehb2) !out + +! -------------------------------------------------------------------------------------------------- +! use newton-raphson iteration to solve ground (tg) temperature +! that balances the surface energy budgets for glacier. + +! bare soil: +! -sab + irb[tg] + shb[tg] + evb[tg] + ghb[tg] = 0 +! ---------------------------------------------------------------------- +! use module_model_constants +! ---------------------------------------------------------------------- + implicit none +! ---------------------------------------------------------------------- +! input + integer, intent(in) :: nsnow !maximum no. of snow layers + integer, intent(in) :: nsoil !number of soil layers + real, intent(in) :: emg !ground emissivity + integer, intent(in) :: isnow !actual no. of snow layers + real, dimension(-nsnow+1:nsoil), intent(in) :: df !thermal conductivity of snow/soil (w/m/k) + real, dimension(-nsnow+1:nsoil), intent(in) :: dzsnso !thickness of snow/soil layers (m) + real, intent(in) :: z0m !roughness length, momentum, ground (m) + real, intent(in) :: zlvl !reference height (m) + real, intent(in) :: zpd !zero plane displacement (m) + real, intent(in) :: qair !specific humidity at height zlvl (kg/kg) + real, intent(in) :: sfctmp !air temperature at reference height (k) + real, intent(in) :: rhoair !density air (kg/m3) + real, intent(in) :: sfcprs !density air (kg/m3) + real, intent(in) :: ur !wind speed at height zlvl (m/s) + real, intent(in) :: gamma !psychrometric constant (pa/k) + real, intent(in) :: rsurf !ground surface resistance (s/m) + real, intent(in) :: lwdn !atmospheric longwave radiation (w/m2) + real, intent(in) :: rhsur !raltive humidity in surface soil/snow air space (-) + real, intent(in) :: eair !vapor pressure air at height (pa) + real, dimension(-nsnow+1:nsoil), intent(in) :: stc !soil/snow temperature (k) + real, dimension( 1:nsoil), intent(in) :: smc !soil moisture + real, dimension( 1:nsoil), intent(in) :: sh2o !soil liquid water + real, intent(in) :: sag !solar radiation absorbed by ground (w/m2) + real, intent(in) :: snowh !actual snow depth [m] + real, intent(in) :: lathea !latent heat of vaporization/subli (j/kg) + +! input/output + real, intent(inout) :: cm !momentum drag coefficient + real, intent(inout) :: ch !sensible heat exchange coefficient + real, intent(inout) :: tgb !ground temperature (k) + real, intent(inout) :: qsfc !mixing ratio at lowest model layer + +#ifdef CCPP + character(len=*), intent(inout) :: errmsg + integer, intent(inout) :: errflg +#endif + +! output +! -sab + irb[tg] + shb[tg] + evb[tg] + ghb[tg] = 0 + real, intent(out) :: irb !net longwave rad (w/m2) [+ to atm] + real, intent(out) :: shb !sensible heat flux (w/m2) [+ to atm] + real, intent(out) :: evb !latent heat flux (w/m2) [+ to atm] + real, intent(out) :: ghb !ground heat flux (w/m2) [+ to soil] + real, intent(out) :: t2mb !2 m height air temperature (k) + real, intent(out) :: q2b !bare ground heat conductance + real, intent(out) :: ehb2 !sensible heat conductance for diagnostics + + +! local variables + integer :: niterb !number of iterations for surface temperature + real :: mpe !prevents overflow error if division by zero + real :: dtg !change in tg, last iteration (k) + integer :: mozsgn !number of times moz changes sign + real :: mozold !monin-obukhov stability parameter from prior iteration + real :: fm2 !monin-obukhov momentum adjustment at 2m + real :: fh2 !monin-obukhov heat adjustment at 2m + real :: ch2 !surface exchange at 2m + real :: h !temporary sensible heat flux (w/m2) + real :: fv !friction velocity (m/s) + real :: cir !coefficients for ir as function of ts**4 + real :: cgh !coefficients for st as function of ts + real :: csh !coefficients for sh as function of ts + real :: cev !coefficients for ev as function of esat[ts] + real :: cq2b ! + integer :: iter !iteration index + real :: z0h !roughness length, sensible heat, ground (m) + real :: moz !monin-obukhov stability parameter + real :: fm !momentum stability correction, weighted by prior iters + real :: fh !sen heat stability correction, weighted by prior iters + real :: ramb !aerodynamic resistance for momentum (s/m) + real :: rahb !aerodynamic resistance for sensible heat (s/m) + real :: rawb !aerodynamic resistance for water vapor (s/m) + real :: estg !saturation vapor pressure at tg (pa) + real :: destg !d(es)/dt at tg (pa/k) + real :: esatw !es for water + real :: esati !es for ice + real :: dsatw !d(es)/dt at tg (pa/k) for water + real :: dsati !d(es)/dt at tg (pa/k) for ice + real :: a !temporary calculation + real :: b !temporary calculation + real :: t, tdc !kelvin to degree celsius with limit -50 to +50 + real, dimension( 1:nsoil) :: sice !soil ice + + tdc(t) = min( 50., max(-50.,(t-tfrz)) ) + +! ----------------------------------------------------------------- +! initialization variables that do not depend on stability iteration +! ----------------------------------------------------------------- + niterb = 5 + mpe = 1e-6 + dtg = 0. + mozsgn = 0 + mozold = 0. + h = 0. + fv = 0.1 + + cir = emg*sb + cgh = 2.*df(isnow+1)/dzsnso(isnow+1) + +! ----------------------------------------------------------------- + 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 + qair ,sfctmp ,h ,rhoair ,mpe ,ur , & !in +#ifdef CCPP + & moz ,mozsgn ,fm ,fh ,fm2 ,fh2 ,errmsg, errflg, & !inout +#else + & moz ,mozsgn ,fm ,fh ,fm2 ,fh2 , & !inout +#endif + & fv ,cm ,ch ,ch2) !out + +#ifdef CCPP + if (errflg /= 0) return +#endif + 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 + 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 + 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)/(sfcprs-0.378*(estg*rhsur)) + + end do loop3 ! end stability iteration +! ----------------------------------------------------------------- + +! if snow on ground and tg > tfrz: reset tg = tfrz. reevaluate ground fluxes. + + sice = smc - sh2o + if(opt_stc == 1) then + if ((maxval(sice) > 0.0 .or. snowh > 0.0) .and. tgb > tfrz) then + tgb = tfrz + irb = cir * tgb**4 - emg*lwdn + shb = csh * (tgb - sfctmp) + evb = cev * (estg*rhsur - eair ) !estg reevaluate ? + ghb = sag - (irb+shb+evb) + end if + end if + +! 2m air temperature + ehb2 = fv*vkc/(log((2.+z0h)/z0h)-fh2) + cq2b = ehb2 + if (ehb2.lt.1.e-5 ) then + t2mb = tgb + q2b = qsfc + else + t2mb = tgb - shb/(rhoair*cpair) * 1./ehb2 + q2b = qsfc - evb/(lathea*rhoair)*(1./cq2b + rsurf) + endif + +! update ch + ch = 1./rahb + + end subroutine glacier_flux +! ================================================================================================== +!>\ingroup NoahMP_LSM + subroutine esat(t, esw, esi, desw, desi) +!--------------------------------------------------------------------------------------------------- +! use polynomials to calculate saturation vapor pressure and derivative with +! respect to temperature: over water when t > 0 c and over ice when t <= 0 c + implicit none +!--------------------------------------------------------------------------------------------------- +! in + + real, intent(in) :: t !temperature + +!out + + real, intent(out) :: esw !saturation vapor pressure over water (pa) + real, intent(out) :: esi !saturation vapor pressure over ice (pa) + real, intent(out) :: desw !d(esat)/dt over water (pa/k) + real, intent(out) :: desi !d(esat)/dt over ice (pa/k) + +! local + + real :: a0,a1,a2,a3,a4,a5,a6 !coefficients for esat over water + real :: b0,b1,b2,b3,b4,b5,b6 !coefficients for esat over ice + real :: c0,c1,c2,c3,c4,c5,c6 !coefficients for dsat over water + real :: d0,d1,d2,d3,d4,d5,d6 !coefficients for dsat over ice + + parameter (a0=6.107799961 , a1=4.436518521e-01, & + a2=1.428945805e-02, a3=2.650648471e-04, & + a4=3.031240396e-06, a5=2.034080948e-08, & + a6=6.136820929e-11) + + parameter (b0=6.109177956 , b1=5.034698970e-01, & + b2=1.886013408e-02, b3=4.176223716e-04, & + b4=5.824720280e-06, b5=4.838803174e-08, & + b6=1.838826904e-10) + + parameter (c0= 4.438099984e-01, c1=2.857002636e-02, & + c2= 7.938054040e-04, c3=1.215215065e-05, & + c4= 1.036561403e-07, c5=3.532421810e-10, & + c6=-7.090244804e-13) + + parameter (d0=5.030305237e-01, d1=3.773255020e-02, & + d2=1.267995369e-03, d3=2.477563108e-05, & + d4=3.005693132e-07, d5=2.158542548e-09, & + d6=7.131097725e-12) + + esw = 100.*(a0+t*(a1+t*(a2+t*(a3+t*(a4+t*(a5+t*a6)))))) + esi = 100.*(b0+t*(b1+t*(b2+t*(b3+t*(b4+t*(b5+t*b6)))))) + desw = 100.*(c0+t*(c1+t*(c2+t*(c3+t*(c4+t*(c5+t*c6)))))) + desi = 100.*(d0+t*(d1+t*(d2+t*(d3+t*(d4+t*(d5+t*d6)))))) + + end subroutine esat +! ================================================================================================== +!>\ingroup NoahMP_LSM + 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 +#else + & moz ,mozsgn ,fm ,fh ,fm2 ,fh2 , & !inout +#endif + & fv ,cm ,ch ,ch2 ) !out +! ------------------------------------------------------------------------------------------------- +! computing surface drag coefficient cm for momentum and ch for heat +! ------------------------------------------------------------------------------------------------- + implicit none +! ------------------------------------------------------------------------------------------------- +! inputs + integer, intent(in) :: iter !iteration index + real, intent(in) :: zlvl !reference height (m) + real, intent(in) :: zpd !zero plane displacement (m) + real, intent(in) :: z0h !roughness length, sensible heat, ground (m) + real, intent(in) :: z0m !roughness length, momentum, ground (m) + real, intent(in) :: qair !specific humidity at reference height (kg/kg) + real, intent(in) :: sfctmp !temperature at reference height (k) + real, intent(in) :: h !sensible heat flux (w/m2) [+ to atm] + real, intent(in) :: rhoair !density air (kg/m**3) + real, intent(in) :: mpe !prevents overflow error if division by zero + real, intent(in) :: ur !wind speed (m/s) + +! in & out + real, intent(inout) :: moz !monin-obukhov stability (z/l) + integer, intent(inout) :: mozsgn !number of times moz changes sign + real, intent(inout) :: fm !momentum stability correction, weighted by prior iters + real, intent(inout) :: fh !sen heat stability correction, weighted by prior iters + real, intent(inout) :: fm2 !sen heat stability correction, weighted by prior iters + real, intent(inout) :: fh2 !sen heat stability correction, weighted by prior iters + +#ifdef CCPP + character(len=*), intent(inout) :: errmsg + integer, intent(inout) :: errflg +#endif + +! outputs + real, intent(out) :: fv !friction velocity (m/s) + real, intent(out) :: cm !drag coefficient for momentum + real, intent(out) :: ch !drag coefficient for heat + real, intent(out) :: ch2 !drag coefficient for heat + +! locals + real :: mozold !monin-obukhov stability parameter from prior iteration + real :: tmpcm !temporary calculation for cm + real :: tmpch !temporary calculation for ch + real :: mol !monin-obukhov length (m) + real :: tvir !temporary virtual temperature (k) + real :: tmp1,tmp2,tmp3 !temporary calculation + real :: fmnew !stability correction factor, momentum, for current moz + real :: fhnew !stability correction factor, sen heat, for current moz + real :: moz2 !2/l + real :: tmpcm2 !temporary calculation for cm2 + real :: tmpch2 !temporary calculation for ch2 + real :: fm2new !stability correction factor, momentum, for current moz + real :: fh2new !stability correction factor, sen heat, for current moz + real :: tmp12,tmp22,tmp32 !temporary calculation + + real :: cmfm, chfh, cm2fm2, ch2fh2 + + +! ------------------------------------------------------------------------------------------------- +! monin-obukhov stability parameter moz for next iteration + + mozold = moz + + if(zlvl <= zpd) then + write(*,*) 'critical glacier problem: zlvl <= zpd; model stops', zlvl, zpd +#ifdef CCPP + errflg = 1 + errmsg = "stop in noah-mp glacier" + return +#else + call wrf_error_fatal("stop in noah-mp glacier") +#endif + endif + + tmpcm = log((zlvl-zpd) / z0m) + tmpch = log((zlvl-zpd) / z0h) + tmpcm2 = log((2.0 + z0m) / z0m) + tmpch2 = log((2.0 + z0h) / z0h) + + if(iter == 1) then + fv = 0.0 + moz = 0.0 + mol = 0.0 + moz2 = 0.0 + else + tvir = (1. + 0.61*qair) * sfctmp + tmp1 = vkc * (grav/tvir) * h/(rhoair*cpair) + if (abs(tmp1) .le. mpe) tmp1 = mpe + mol = -1. * fv**3 / tmp1 + moz = min( (zlvl-zpd)/mol, 1.) + moz2 = min( (2.0 + z0h)/mol, 1.) + endif + +! accumulate number of times moz changes sign. + + if (mozold*moz .lt. 0.) mozsgn = mozsgn+1 + if (mozsgn .ge. 2) then + moz = 0. + fm = 0. + fh = 0. + moz2 = 0. + fm2 = 0. + fh2 = 0. + endif + +! evaluate stability-dependent variables using moz from prior iteration + if (moz .lt. 0.) then + tmp1 = (1. - 16.*moz)**0.25 + tmp2 = log((1.+tmp1*tmp1)/2.) + tmp3 = log((1.+tmp1)/2.) + fmnew = 2.*tmp3 + tmp2 - 2.*atan(tmp1) + 1.5707963 + fhnew = 2*tmp2 + +! 2-meter + tmp12 = (1. - 16.*moz2)**0.25 + tmp22 = log((1.+tmp12*tmp12)/2.) + tmp32 = log((1.+tmp12)/2.) + fm2new = 2.*tmp32 + tmp22 - 2.*atan(tmp12) + 1.5707963 + fh2new = 2*tmp22 + else + fmnew = -5.*moz + fhnew = fmnew + fm2new = -5.*moz2 + fh2new = fm2new + endif + +! except for first iteration, weight stability factors for previous +! iteration to help avoid flip-flops from one iteration to the next + + if (iter == 1) then + fm = fmnew + fh = fhnew + fm2 = fm2new + fh2 = fh2new + else + fm = 0.5 * (fm+fmnew) + fh = 0.5 * (fh+fhnew) + fm2 = 0.5 * (fm2+fm2new) + fh2 = 0.5 * (fh2+fh2new) + endif + +! exchange coefficients + + fh = min(fh,0.9*tmpch) + fm = min(fm,0.9*tmpcm) + fh2 = min(fh2,0.9*tmpch2) + fm2 = min(fm2,0.9*tmpcm2) + + cmfm = tmpcm-fm + chfh = tmpch-fh + cm2fm2 = tmpcm2-fm2 + ch2fh2 = tmpch2-fh2 + if(abs(cmfm) <= mpe) cmfm = mpe + if(abs(chfh) <= mpe) chfh = mpe + if(abs(cm2fm2) <= mpe) cm2fm2 = mpe + if(abs(ch2fh2) <= mpe) ch2fh2 = mpe + cm = vkc*vkc/(cmfm*cmfm) + ch = vkc*vkc/(cmfm*chfh) + ch2 = vkc*vkc/(cm2fm2*ch2fh2) + +! friction velocity + + fv = ur * sqrt(cm) + ch2 = vkc*fv/ch2fh2 + + end subroutine sfcdif1_glacier +! ================================================================================================== +!>\ingroup NoahMP_LSM + subroutine tsnosoi_glacier (nsoil ,nsnow ,isnow ,dt ,tbot , & !in + ssoil ,snowh ,zbot ,zsnso ,df , & !in + hcpct , & !in + stc ) !inout +! -------------------------------------------------------------------------------------------------- +! compute snow (up to 3l) and soil (4l) temperature. note that snow temperatures +! during melting season may exceed melting point (tfrz) but later in phasechange +! subroutine the snow temperatures are reset to tfrz for melting snow. +! -------------------------------------------------------------------------------------------------- + implicit none +! -------------------------------------------------------------------------------------------------- +!input + + integer, intent(in) :: nsoil !no of soil layers (4) + integer, intent(in) :: nsnow !maximum no of snow layers (3) + integer, intent(in) :: isnow !actual no of snow layers + + real, intent(in) :: dt !time step (s) + real, intent(in) :: tbot ! + real, intent(in) :: ssoil !ground heat flux (w/m2) + real, intent(in) :: snowh !snow depth (m) + real, intent(in) :: zbot !from soil surface (m) + real, dimension(-nsnow+1:nsoil), intent(in) :: zsnso !layer-bot. depth from snow surf.(m) + real, dimension(-nsnow+1:nsoil), intent(in) :: df !thermal conductivity + real, dimension(-nsnow+1:nsoil), intent(in) :: hcpct !heat capacity (j/m3/k) + +!input and output + + real, dimension(-nsnow+1:nsoil), intent(inout) :: stc + +!local + + integer :: iz + real :: zbotsno !zbot from snow surface + real, dimension(-nsnow+1:nsoil) :: ai, bi, ci, rhsts + real :: eflxb !energy influx from soil bottom (w/m2) + real, dimension(-nsnow+1:nsoil) :: phi !light through water (w/m2) + +! ---------------------------------------------------------------------- + +! prescribe solar penetration into ice/snow + + phi(isnow+1:nsoil) = 0. + +! adjust zbot from soil surface to zbotsno from snow surface + + zbotsno = zbot - snowh !from snow surface + +! compute ice temperatures + + call hrt_glacier (nsnow ,nsoil ,isnow ,zsnso , & + stc ,tbot ,zbotsno ,df , & + hcpct ,ssoil ,phi , & + ai ,bi ,ci ,rhsts , & + eflxb ) + + call hstep_glacier (nsnow ,nsoil ,isnow ,dt , & + ai ,bi ,ci ,rhsts , & + stc ) + + end subroutine tsnosoi_glacier +! ================================================================================================== +! ---------------------------------------------------------------------- +!>\ingroup NoahMP_LSM + subroutine hrt_glacier (nsnow ,nsoil ,isnow ,zsnso , & !in + stc ,tbot ,zbot ,df , & !in + hcpct ,ssoil ,phi , & !in + ai ,bi ,ci ,rhsts , & !out + botflx ) !out +! ---------------------------------------------------------------------- +! ---------------------------------------------------------------------- +! calculate the right hand side of the time tendency term of the soil +! thermal diffusion equation. also to compute ( prepare ) the matrix +! coefficients for the tri-diagonal matrix of the implicit time scheme. +! ---------------------------------------------------------------------- + implicit none +! ---------------------------------------------------------------------- +! input + + integer, intent(in) :: nsoil !no of soil layers (4) + integer, intent(in) :: nsnow !maximum no of snow layers (3) + integer, intent(in) :: isnow !actual no of snow layers + real, intent(in) :: tbot !bottom soil temp. at zbot (k) + real, intent(in) :: zbot !depth of lower boundary condition (m) + !from soil surface not snow surface + real, intent(in) :: ssoil !ground heat flux (w/m2) + real, dimension(-nsnow+1:nsoil), intent(in) :: zsnso !depth of layer-bottom of snow/soil (m) + real, dimension(-nsnow+1:nsoil), intent(in) :: stc !snow/soil temperature (k) + real, dimension(-nsnow+1:nsoil), intent(in) :: df !thermal conductivity [w/m/k] + real, dimension(-nsnow+1:nsoil), intent(in) :: hcpct !heat capacity [j/m3/k] + real, dimension(-nsnow+1:nsoil), intent(in) :: phi !light through water (w/m2) + +! output + + real, dimension(-nsnow+1:nsoil), intent(out) :: rhsts !right-hand side of the matrix + real, dimension(-nsnow+1:nsoil), intent(out) :: ai !left-hand side coefficient + real, dimension(-nsnow+1:nsoil), intent(out) :: bi !left-hand side coefficient + real, dimension(-nsnow+1:nsoil), intent(out) :: ci !left-hand side coefficient + real, intent(out) :: botflx !energy influx from soil bottom (w/m2) + +! local + + integer :: k + real, dimension(-nsnow+1:nsoil) :: ddz + real, dimension(-nsnow+1:nsoil) :: denom + real, dimension(-nsnow+1:nsoil) :: dtsdz + real, dimension(-nsnow+1:nsoil) :: eflux + real :: temp1 +! ---------------------------------------------------------------------- + + do k = isnow+1, nsoil + if (k == isnow+1) then + denom(k) = - zsnso(k) * hcpct(k) + temp1 = - zsnso(k+1) + ddz(k) = 2.0 / temp1 + dtsdz(k) = 2.0 * (stc(k) - stc(k+1)) / temp1 + eflux(k) = df(k) * dtsdz(k) - ssoil - phi(k) + else if (k < nsoil) then + denom(k) = (zsnso(k-1) - zsnso(k)) * hcpct(k) + temp1 = zsnso(k-1) - zsnso(k+1) + ddz(k) = 2.0 / temp1 + dtsdz(k) = 2.0 * (stc(k) - stc(k+1)) / temp1 + eflux(k) = (df(k)*dtsdz(k) - df(k-1)*dtsdz(k-1)) - phi(k) + else if (k == nsoil) then + denom(k) = (zsnso(k-1) - zsnso(k)) * hcpct(k) + temp1 = zsnso(k-1) - zsnso(k) + if(opt_tbot == 1) then + botflx = 0. + end if + if(opt_tbot == 2) then + dtsdz(k) = (stc(k) - tbot) / ( 0.5*(zsnso(k-1)+zsnso(k)) - zbot) + botflx = -df(k) * dtsdz(k) + end if + eflux(k) = (-botflx - df(k-1)*dtsdz(k-1) ) - phi(k) + end if + end do + + do k = isnow+1, nsoil + if (k == isnow+1) then + ai(k) = 0.0 + ci(k) = - df(k) * ddz(k) / denom(k) + if (opt_stc == 1) then + bi(k) = - ci(k) + end if + if (opt_stc == 2) then + bi(k) = - ci(k) + df(k)/(0.5*zsnso(k)*zsnso(k)*hcpct(k)) + end if + else if (k < nsoil) then + ai(k) = - df(k-1) * ddz(k-1) / denom(k) + ci(k) = - df(k ) * ddz(k ) / denom(k) + bi(k) = - (ai(k) + ci (k)) + else if (k == nsoil) then + ai(k) = - df(k-1) * ddz(k-1) / denom(k) + ci(k) = 0.0 + bi(k) = - (ai(k) + ci(k)) + end if + rhsts(k) = eflux(k)/ (-denom(k)) + end do + + end subroutine hrt_glacier +! ================================================================================================== +! ---------------------------------------------------------------------- +!>\ingroup NoahMP_LSM + subroutine hstep_glacier (nsnow ,nsoil ,isnow ,dt , & !in + ai ,bi ,ci ,rhsts , & !inout + stc ) !inout +! ---------------------------------------------------------------------- +! calculate/update the soil temperature field. +! ---------------------------------------------------------------------- + implicit none +! ---------------------------------------------------------------------- +! input + + integer, intent(in) :: nsoil + integer, intent(in) :: nsnow + integer, intent(in) :: isnow + real, intent(in) :: dt + +! output & input + real, dimension(-nsnow+1:nsoil), intent(inout) :: ai + real, dimension(-nsnow+1:nsoil), intent(inout) :: bi + real, dimension(-nsnow+1:nsoil), intent(inout) :: ci + real, dimension(-nsnow+1:nsoil), intent(inout) :: stc + real, dimension(-nsnow+1:nsoil), intent(inout) :: rhsts + +! local + integer :: k + real, dimension(-nsnow+1:nsoil) :: rhstsin + real, dimension(-nsnow+1:nsoil) :: ciin +! ---------------------------------------------------------------------- + + do k = isnow+1,nsoil + rhsts(k) = rhsts(k) * dt + ai(k) = ai(k) * dt + bi(k) = 1. + bi(k) * dt + ci(k) = ci(k) * dt + end do + +! copy values for input variables before call to rosr12 + + do k = isnow+1,nsoil + rhstsin(k) = rhsts(k) + ciin(k) = ci(k) + end do + +! solve the tri-diagonal matrix equation + + call rosr12_glacier (ci,ai,bi,ciin,rhstsin,rhsts,isnow+1,nsoil,nsnow) + +! update snow & soil temperature + + do k = isnow+1,nsoil + stc (k) = stc (k) + ci (k) + end do + + end subroutine hstep_glacier +! ================================================================================================== +!>\ingroup NoahMP_LSM + subroutine rosr12_glacier (p,a,b,c,d,delta,ntop,nsoil,nsnow) +! ---------------------------------------------------------------------- +! subroutine rosr12 +! ---------------------------------------------------------------------- +! invert (solve) the tri-diagonal matrix problem shown below: +! ### ### ### ### ### ### +! #b(1), c(1), 0 , 0 , 0 , . . . , 0 # # # # # +! #a(2), b(2), c(2), 0 , 0 , . . . , 0 # # # # # +! # 0 , a(3), b(3), c(3), 0 , . . . , 0 # # # # d(3) # +! # 0 , 0 , a(4), b(4), c(4), . . . , 0 # # p(4) # # d(4) # +! # 0 , 0 , 0 , a(5), b(5), . . . , 0 # # p(5) # # d(5) # +! # . . # # . # = # . # +! # . . # # . # # . # +! # . . # # . # # . # +! # 0 , . . . , 0 , a(m-2), b(m-2), c(m-2), 0 # #p(m-2)# #d(m-2)# +! # 0 , . . . , 0 , 0 , a(m-1), b(m-1), c(m-1)# #p(m-1)# #d(m-1)# +! # 0 , . . . , 0 , 0 , 0 , a(m) , b(m) # # p(m) # # d(m) # +! ### ### ### ### ### ### +! ---------------------------------------------------------------------- + implicit none + + integer, intent(in) :: ntop + integer, intent(in) :: nsoil,nsnow + integer :: k, kk + + real, dimension(-nsnow+1:nsoil),intent(in):: a, b, d + real, dimension(-nsnow+1:nsoil),intent(inout):: c,p,delta + +! ---------------------------------------------------------------------- +! initialize eqn coef c for the lowest soil layer +! ---------------------------------------------------------------------- + c (nsoil) = 0.0 + p (ntop) = - c (ntop) / b (ntop) +! ---------------------------------------------------------------------- +! solve the coefs for the 1st soil layer +! ---------------------------------------------------------------------- + delta (ntop) = d (ntop) / b (ntop) +! ---------------------------------------------------------------------- +! solve the coefs for soil layers 2 thru nsoil +! ---------------------------------------------------------------------- + do k = ntop+1,nsoil + p (k) = - c (k) * ( 1.0 / (b (k) + a (k) * p (k -1)) ) + delta (k) = (d (k) - a (k)* delta (k -1))* (1.0/ (b (k) + a (k)& + * p (k -1))) + end do +! ---------------------------------------------------------------------- +! set p to delta for lowest soil layer +! ---------------------------------------------------------------------- + p (nsoil) = delta (nsoil) +! ---------------------------------------------------------------------- +! adjust p for soil layers 2 thru nsoil +! ---------------------------------------------------------------------- + do k = ntop+1,nsoil + kk = nsoil - k + (ntop-1) + 1 + p (kk) = p (kk) * p (kk +1) + delta (kk) + end do +! ---------------------------------------------------------------------- + end subroutine rosr12_glacier +! ---------------------------------------------------------------------- +! ================================================================================================== +!>\ingroup NoahMP_LSM + subroutine phasechange_glacier (nsnow ,nsoil ,isnow ,dt ,fact , & !in + dzsnso , & !in + stc ,snice ,snliq ,sneqv ,snowh , & !inout + smc ,sh2o , & !inout + qmelt ,imelt ,ponding ) !out +! ---------------------------------------------------------------------- +! melting/freezing of snow water and soil water +! ---------------------------------------------------------------------- + implicit none +! ---------------------------------------------------------------------- +! inputs + + integer, intent(in) :: nsnow !maximum no. of snow layers [=3] + integer, intent(in) :: nsoil !no. of soil layers [=4] + integer, intent(in) :: isnow !actual no. of snow layers [<=3] + real, intent(in) :: dt !land model time step (sec) + real, dimension(-nsnow+1:nsoil), intent(in) :: fact !temporary + real, dimension(-nsnow+1:nsoil), intent(in) :: dzsnso !snow/soil layer thickness [m] + +! inputs/outputs + + real, dimension(-nsnow+1:nsoil), intent(inout) :: stc !snow/soil layer temperature [k] + real, dimension(-nsnow+1:0) , intent(inout) :: snice !snow layer ice [mm] + real, dimension(-nsnow+1:0) , intent(inout) :: snliq !snow layer liquid water [mm] + real, intent(inout) :: sneqv + real, intent(inout) :: snowh + real, dimension( 1:nsoil), intent(inout) :: sh2o !soil liquid water [m3/m3] + real, dimension( 1:nsoil), intent(inout) :: smc !total soil water [m3/m3] + +! outputs + real, intent(out) :: qmelt !snowmelt rate [mm/s] + integer, dimension(-nsnow+1:nsoil), intent(out) :: imelt !phase change index + real, intent(out) :: ponding!snowmelt when snow has no layer [mm] + +! local + + integer :: j,k !do loop index + real, dimension(-nsnow+1:nsoil) :: hm !energy residual [w/m2] + real, dimension(-nsnow+1:nsoil) :: xm !melting or freezing water [kg/m2] + real, dimension(-nsnow+1:nsoil) :: wmass0 + real, dimension(-nsnow+1:nsoil) :: wice0 + real, dimension(-nsnow+1:nsoil) :: wliq0 + real, dimension(-nsnow+1:nsoil) :: mice !soil/snow ice mass [mm] + real, dimension(-nsnow+1:nsoil) :: mliq !soil/snow liquid water mass [mm] + real, dimension(-nsnow+1:nsoil) :: heatr !energy residual or loss after melting/freezing + real :: temp1 !temporary variables [kg/m2] + real :: propor + real :: xmf !total latent heat of phase change + +! ---------------------------------------------------------------------- +! initialization + + qmelt = 0. + ponding = 0. + xmf = 0. + + do j = isnow+1,0 ! all snow layers + mice(j) = snice(j) + mliq(j) = snliq(j) + end do + + do j = 1, nsoil ! all soil layers + mliq(j) = sh2o(j) * dzsnso(j) * 1000. + mice(j) = (smc(j) - sh2o(j)) * dzsnso(j) * 1000. + end do + + do j = isnow+1,nsoil ! all layers + imelt(j) = 0 + hm(j) = 0. + xm(j) = 0. + wice0(j) = mice(j) + wliq0(j) = mliq(j) + wmass0(j) = mice(j) + mliq(j) + enddo + + do j = isnow+1,nsoil + if (mice(j) > 0. .and. stc(j) >= tfrz) then ! melting + imelt(j) = 1 + endif + if (mliq(j) > 0. .and. stc(j) < tfrz) then ! freezing + imelt(j) = 2 + endif + + ! if snow exists, but its thickness is not enough to create a layer + if (isnow == 0 .and. sneqv > 0. .and. j == 1) then + if (stc(j) >= tfrz) then + imelt(j) = 1 + endif + endif + enddo + +! calculate the energy surplus and loss for melting and freezing + + do j = isnow+1,nsoil + if (imelt(j) > 0) then + hm(j) = (stc(j)-tfrz)/fact(j) + stc(j) = tfrz + endif + + if (imelt(j) == 1 .and. hm(j) < 0.) then + hm(j) = 0. + imelt(j) = 0 + endif + if (imelt(j) == 2 .and. hm(j) > 0.) then + hm(j) = 0. + imelt(j) = 0 + endif + xm(j) = hm(j)*dt/hfus + enddo + +! the rate of melting and freezing for snow without a layer, needs more work. + + if (isnow == 0 .and. sneqv > 0. .and. xm(1) > 0.) then + temp1 = sneqv + sneqv = max(0.,temp1-xm(1)) + propor = sneqv/temp1 + snowh = max(0.,propor * snowh) + heatr(1) = hm(1) - hfus*(temp1-sneqv)/dt + if (heatr(1) > 0.) then + xm(1) = heatr(1)*dt/hfus + hm(1) = heatr(1) + imelt(1) = 1 + else + xm(1) = 0. + hm(1) = 0. + imelt(1) = 0 + endif + qmelt = max(0.,(temp1-sneqv))/dt + xmf = hfus*qmelt + ponding = temp1-sneqv + endif + +! the rate of melting and freezing for snow and soil + + do j = isnow+1,nsoil + if (imelt(j) > 0 .and. abs(hm(j)) > 0.) then + + heatr(j) = 0. + if (xm(j) > 0.) then + mice(j) = max(0., wice0(j)-xm(j)) + heatr(j) = hm(j) - hfus*(wice0(j)-mice(j))/dt + else if (xm(j) < 0.) then + mice(j) = min(wmass0(j), wice0(j)-xm(j)) + heatr(j) = hm(j) - hfus*(wice0(j)-mice(j))/dt + endif + + mliq(j) = max(0.,wmass0(j)-mice(j)) + + if (abs(heatr(j)) > 0.) then + stc(j) = stc(j) + fact(j)*heatr(j) + if (j <= 0) then ! snow + if (mliq(j)*mice(j)>0.) stc(j) = tfrz + end if + endif + + if (j > 0) xmf = xmf + hfus * (wice0(j)-mice(j))/dt + + if (j < 1) then + qmelt = qmelt + max(0.,(wice0(j)-mice(j)))/dt + endif + endif + enddo + heatr = 0.0 + xm = 0.0 + +! deal with residuals in ice/soil + +! first remove excess heat by reducing temperature of layers + + if (any(stc(1:4) > tfrz) .and. any(stc(1:4) < tfrz)) then + do j = 1,nsoil + if ( stc(j) > tfrz ) then + heatr(j) = (stc(j)-tfrz)/fact(j) + do k = 1,nsoil + if (j .ne. k .and. stc(k) < tfrz .and. heatr(j) > 0.1) then + heatr(k) = (stc(k)-tfrz)/fact(k) + if (abs(heatr(k)) > heatr(j)) then ! layer absorbs all + heatr(k) = heatr(k) + heatr(j) + stc(k) = tfrz + heatr(k)*fact(k) + heatr(j) = 0.0 + else + heatr(j) = heatr(j) + heatr(k) + heatr(k) = 0.0 + stc(k) = tfrz + end if + end if + end do + stc(j) = tfrz + heatr(j)*fact(j) + end if + end do + end if + +! now remove excess cold by increasing temperature of layers (may not be necessary with above loop) + + if (any(stc(1:4) > tfrz) .and. any(stc(1:4) < tfrz)) then + do j = 1,nsoil + if ( stc(j) < tfrz ) then + heatr(j) = (stc(j)-tfrz)/fact(j) + do k = 1,nsoil + if (j .ne. k .and. stc(k) > tfrz .and. heatr(j) < -0.1) then + heatr(k) = (stc(k)-tfrz)/fact(k) + if (heatr(k) > abs(heatr(j))) then ! layer absorbs all + heatr(k) = heatr(k) + heatr(j) + stc(k) = tfrz + heatr(k)*fact(k) + heatr(j) = 0.0 + else + heatr(j) = heatr(j) + heatr(k) + heatr(k) = 0.0 + stc(k) = tfrz + end if + end if + end do + stc(j) = tfrz + heatr(j)*fact(j) + end if + end do + end if + +! now remove excess heat by melting ice + + if (any(stc(1:4) > tfrz) .and. any(mice(1:4) > 0.)) then + do j = 1,nsoil + if ( stc(j) > tfrz ) then + heatr(j) = (stc(j)-tfrz)/fact(j) + xm(j) = heatr(j)*dt/hfus + do k = 1,nsoil + if (j .ne. k .and. mice(k) > 0. .and. xm(j) > 0.1) then + if (mice(k) > xm(j)) then ! layer absorbs all + mice(k) = mice(k) - xm(j) + xmf = xmf + hfus * xm(j)/dt + stc(k) = tfrz + xm(j) = 0.0 + else + xm(j) = xm(j) - mice(k) + xmf = xmf + hfus * mice(k)/dt + mice(k) = 0.0 + stc(k) = tfrz + end if + mliq(k) = max(0.,wmass0(k)-mice(k)) + end if + end do + heatr(j) = xm(j)*hfus/dt + stc(j) = tfrz + heatr(j)*fact(j) + end if + end do + end if + +! now remove excess cold by freezing liquid of layers (may not be necessary with above loop) + + if (any(stc(1:4) < tfrz) .and. any(mliq(1:4) > 0.)) then + do j = 1,nsoil + if ( stc(j) < tfrz ) then + heatr(j) = (stc(j)-tfrz)/fact(j) + xm(j) = heatr(j)*dt/hfus + do k = 1,nsoil + if (j .ne. k .and. mliq(k) > 0. .and. xm(j) < -0.1) then + if (mliq(k) > abs(xm(j))) then ! layer absorbs all + mice(k) = mice(k) - xm(j) + xmf = xmf + hfus * xm(j)/dt + stc(k) = tfrz + xm(j) = 0.0 + else + xm(j) = xm(j) + mliq(k) + xmf = xmf - hfus * mliq(k)/dt + mice(k) = wmass0(k) + stc(k) = tfrz + end if + mliq(k) = max(0.,wmass0(k)-mice(k)) + end if + end do + heatr(j) = xm(j)*hfus/dt + stc(j) = tfrz + heatr(j)*fact(j) + end if + end do + end if + + do j = isnow+1,0 ! snow + snliq(j) = mliq(j) + snice(j) = mice(j) + end do + + do j = 1, nsoil ! soil + sh2o(j) = mliq(j) / (1000. * dzsnso(j)) + sh2o(j) = max(0.0,min(1.0,sh2o(j))) +! smc(j) = (mliq(j) + mice(j)) / (1000. * dzsnso(j)) + smc(j) = 1.0 + end do + + 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 , & !inout + runsrf ,runsub ,qsnow ,ponding1 ,ponding2,qsnbot,fpice,esnow & !out + ) !out +! ---------------------------------------------------------------------- +! code history: +! initial code: guo-yue niu, oct. 2007 +! ---------------------------------------------------------------------- + implicit none +! ---------------------------------------------------------------------- +! input + integer, intent(in) :: nsnow !maximum no. of snow layers + integer, intent(in) :: nsoil !no. of soil layers + integer, dimension(-nsnow+1:0) , intent(in) :: imelt !melting state index [1-melt; 2-freeze] + real, intent(in) :: dt !main time step (s) + real, intent(in) :: prcp !precipitation (mm/s) + real, intent(in) :: sfctmp !surface air temperature [k] + real, intent(in) :: qvap !soil surface evaporation rate[mm/s] + real, intent(in) :: qdew !soil surface dew rate[mm/s] + real, dimension(-nsnow+1: 0), intent(in) :: ficeold !ice fraction at last timestep + real, dimension( 1:nsoil), intent(in) :: zsoil !layer-bottom depth from soil surf (m) + +! input/output + integer, intent(inout) :: isnow !actual no. of snow layers + real, intent(inout) :: snowh !snow height [m] + real, intent(inout) :: sneqv !snow water eqv. [mm] + real, dimension(-nsnow+1: 0), intent(inout) :: snice !snow layer ice [mm] + real, dimension(-nsnow+1: 0), intent(inout) :: snliq !snow layer liquid water [mm] + real, dimension(-nsnow+1:nsoil), intent(inout) :: stc !snow/soil layer temperature [k] + real, dimension(-nsnow+1:nsoil), intent(inout) :: dzsnso !snow/soil layer thickness [m] + real, dimension( 1:nsoil), intent(inout) :: sh2o !soil liquid water content [m3/m3] + real, dimension( 1:nsoil), intent(inout) :: sice !soil ice content [m3/m3] + real , intent(inout) :: ponding ![mm] + real, dimension(-nsnow+1:nsoil), intent(inout) :: zsnso !layer-bottom depth from snow surf [m] + +! output + real, intent(out) :: runsrf !surface runoff [mm/s] + real, intent(out) :: runsub !baseflow (sturation excess) [mm/s] + real, intent(out) :: qsnow !snow at ground srf (mm/s) [+] + real, intent(out) :: ponding1 + real, intent(out) :: ponding2 + real, intent(out) :: qsnbot !melting water out of snow bottom [mm/s] + real, intent(out) :: fpice !precipitation frozen fraction + real, intent(out) :: esnow ! + +! local + real :: qrain !rain at ground srf (mm) [+] + real :: qseva !soil surface evap rate [mm/s] + real :: qsdew !soil surface dew rate [mm/s] + real :: qsnfro !snow surface frost rate[mm/s] + real :: qsnsub !snow surface sublimation rate [mm/s] + real :: snowhin !snow depth increasing rate (m/s) + real :: snoflow !glacier flow [mm/s] + real :: bdfall !density of new snow (mm water/m snow) + real :: replace !replacement water due to sublimation of glacier + real, dimension( 1:nsoil) :: sice_save !soil ice content [m3/m3] + real, dimension( 1:nsoil) :: sh2o_save !soil liquid water content [m3/m3] + integer :: ilev + + +! ---------------------------------------------------------------------- +! initialize + + snoflow = 0. + runsub = 0. + runsrf = 0. + sice_save = sice + sh2o_save = sh2o + +! -------------------------------------------------------------------- +! partition precipitation into rain and snow (from canwater) + +! jordan (1991) + + if(opt_snf == 1 .or. opt_snf == 4) then + if(sfctmp > tfrz+2.5)then + fpice = 0. + else + if(sfctmp <= tfrz+0.5)then + fpice = 1.0 + else if(sfctmp <= tfrz+2.)then + fpice = 1.-(-54.632 + 0.2*sfctmp) + else + fpice = 0.6 + endif + endif + endif + + if(opt_snf == 2) then + if(sfctmp >= tfrz+2.2) then + fpice = 0. + else + fpice = 1.0 + endif + endif + + if(opt_snf == 3) then + if(sfctmp >= tfrz) then + fpice = 0. + else + fpice = 1.0 + endif + endif +! print*, 'fpice: ',fpice + +! hedstrom nr and jw pomeroy (1998), hydrol. processes, 12, 1611-1625 +! fresh snow density + + bdfall = min(120.,67.92+51.25*exp((sfctmp-tfrz)/2.59)) !mb: change to min v3.7 + + qrain = prcp * (1.-fpice) + qsnow = prcp * fpice + snowhin = qsnow/bdfall +! print *, 'qrain, qsnow',qrain,qsnow,qrain*dt,qsnow*dt + +! sublimation, frost, evaporation, and dew + +! qsnsub = 0. +! if (sneqv > 0.) then +! qsnsub = min(qvap, sneqv/dt) +! endif +! qseva = qvap-qsnsub + +! qsnfro = 0. +! if (sneqv > 0.) then +! qsnfro = qdew +! endif +! qsdew = qdew - qsnfro + + qsnsub = qvap ! send total sublimation/frost to snowwater and deal with it there + qsnfro = qdew + esnow = qsnsub*2.83e+6 + + +! print *, 'qvap',qvap,qvap*dt +! print *, 'qsnsub',qsnsub,qsnsub*dt +! print *, 'qseva',qseva,qseva*dt +! print *, 'qsnfro',qsnfro,qsnfro*dt +! print *, 'qdew',qdew,qdew*dt +! print *, 'qsdew',qsdew,qsdew*dt +!print *, 'before snowwater', sneqv,snowh,snice,snliq,sh2o,sice + 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 + qsnbot ,snoflow,ponding1 ,ponding2) !out +!print *, 'after snowwater', sneqv,snowh,snice,snliq,sh2o,sice +!print *, 'ponding', ponding,ponding1,ponding2 + + !ponding: melting water from snow when there is no layer + + runsrf = (ponding+ponding1+ponding2)/dt + + if(isnow == 0) then + runsrf = runsrf + qsnbot + qrain + else + runsrf = runsrf + qsnbot + endif + + + replace = 0.0 + do ilev = 1,nsoil + replace = replace + dzsnso(ilev)*(sice(ilev) - sice_save(ilev) + sh2o(ilev) - sh2o_save(ilev)) + end do + replace = replace * 1000.0 / dt ! convert to [mm/s] + + sice = min(1.0,sice_save) + sh2o = 1.0 - sice +!print *, 'replace', replace + + ! use runsub as a water balancer, snoflow is snow that disappears, replace is + ! water from below that replaces glacier loss + + runsub = snoflow + replace + + 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 + qsnbot ,snoflow,ponding1 ,ponding2) !out +! ---------------------------------------------------------------------- + implicit none +! ---------------------------------------------------------------------- +! input + integer, intent(in) :: nsnow !maximum no. of snow layers + integer, intent(in) :: nsoil !no. of soil layers + integer, dimension(-nsnow+1:0) , intent(in) :: imelt !melting state index [0-no melt;1-melt] + real, intent(in) :: dt !time step (s) + real, intent(in) :: sfctmp !surface air temperature [k] + real, intent(in) :: snowhin!snow depth increasing rate (m/s) + real, intent(in) :: qsnow !snow at ground srf (mm/s) [+] + real, intent(in) :: qsnfro !snow surface frost rate[mm/s] + real, intent(in) :: qsnsub !snow surface sublimation rate[mm/s] + real, intent(in) :: qrain !snow surface rain rate[mm/s] + real, dimension(-nsnow+1:0) , intent(in) :: ficeold!ice fraction at last timestep + real, dimension( 1:nsoil), intent(in) :: zsoil !layer-bottom depth from soil surf (m) + +! input & output + integer, intent(inout) :: isnow !actual no. of snow layers + real, intent(inout) :: snowh !snow height [m] + real, intent(inout) :: sneqv !snow water eqv. [mm] + real, dimension(-nsnow+1: 0), intent(inout) :: snice !snow layer ice [mm] + real, dimension(-nsnow+1: 0), intent(inout) :: snliq !snow layer liquid water [mm] + real, dimension( 1:nsoil), intent(inout) :: sh2o !soil liquid moisture (m3/m3) + real, dimension( 1:nsoil), intent(inout) :: sice !soil ice moisture (m3/m3) + real, dimension(-nsnow+1:nsoil), intent(inout) :: stc !snow layer temperature [k] + real, dimension(-nsnow+1:nsoil), intent(inout) :: dzsnso !snow/soil layer thickness [m] + real, dimension(-nsnow+1:nsoil), intent(inout) :: zsnso !layer-bottom depth from snow surf [m] + +! output + real, intent(out) :: qsnbot !melting water out of snow bottom [mm/s] + real, intent(out) :: snoflow!glacier flow [mm] + real, intent(out) :: ponding1 + real, intent(out) :: ponding2 + +! local + integer :: iz + real :: bdsnow !bulk density of snow (kg/m3) +! ---------------------------------------------------------------------- + snoflow = 0.0 + ponding1 = 0.0 + ponding2 = 0.0 + + call snowfall_glacier (nsoil ,nsnow ,dt ,qsnow ,snowhin, & !in + sfctmp , & !in + isnow ,snowh ,dzsnso ,stc ,snice , & !inout + snliq ,sneqv ) !inout + + if(isnow < 0) then !when more than one layer + call compact_glacier (nsnow ,nsoil ,dt ,stc ,snice , & !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 divide_glacier (nsnow ,nsoil , & !in + isnow ,stc ,snice ,snliq ,dzsnso ) !inout + end if + +!set empty snow layers to zero + + do iz = -nsnow+1, isnow + snice(iz) = 0. + snliq(iz) = 0. + stc(iz) = 0. + dzsnso(iz)= 0. + 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 , & !inout + qsnbot ) !out + +!to obtain equilibrium state of snow in glacier region + + if(sneqv > 2000.) then ! 2000 mm -> maximum water depth + bdsnow = snice(0) / dzsnso(0) + snoflow = (sneqv - 2000.) + snice(0) = snice(0) - snoflow + dzsnso(0) = dzsnso(0) - snoflow/bdsnow + snoflow = snoflow / dt + end if + +! sum up snow mass for layered snow + + if(isnow /= 0) then + sneqv = 0. + do iz = isnow+1,0 + sneqv = sneqv + snice(iz) + snliq(iz) + enddo + end if + +! reset zsnso and layer thinkness dzsnso + + do iz = isnow+1, 0 + dzsnso(iz) = -dzsnso(iz) + end do + + dzsnso(1) = zsoil(1) + do iz = 2,nsoil + dzsnso(iz) = (zsoil(iz) - zsoil(iz-1)) + end do + + zsnso(isnow+1) = dzsnso(isnow+1) + do iz = isnow+2 ,nsoil + zsnso(iz) = zsnso(iz-1) + dzsnso(iz) + enddo + + do iz = isnow+1 ,nsoil + dzsnso(iz) = -dzsnso(iz) + end do + + end subroutine snowwater_glacier +! ================================================================================================== +!>\ingroup NoahMP_LSM + subroutine snowfall_glacier (nsoil ,nsnow ,dt ,qsnow ,snowhin , & !in + sfctmp , & !in + isnow ,snowh ,dzsnso ,stc ,snice , & !inout + snliq ,sneqv ) !inout +! ---------------------------------------------------------------------- +! snow depth and density to account for the new snowfall. +! new values of snow depth & density returned. +! ---------------------------------------------------------------------- + implicit none +! ---------------------------------------------------------------------- +! input + + integer, intent(in) :: nsoil !no. of soil layers + integer, intent(in) :: nsnow !maximum no. of snow layers + real, intent(in) :: dt !main time step (s) + real, intent(in) :: qsnow !snow at ground srf (mm/s) [+] + real, intent(in) :: snowhin!snow depth increasing rate (m/s) + real, intent(in) :: sfctmp !surface air temperature [k] + +! input and output + + integer, intent(inout) :: isnow !actual no. of snow layers + real, intent(inout) :: snowh !snow depth [m] + real, intent(inout) :: sneqv !swow water equivalent [m] + real, dimension(-nsnow+1:nsoil), intent(inout) :: dzsnso !thickness of snow/soil layers (m) + real, dimension(-nsnow+1:nsoil), intent(inout) :: stc !snow layer temperature [k] + real, dimension(-nsnow+1: 0), intent(inout) :: snice !snow layer ice [mm] + real, dimension(-nsnow+1: 0), intent(inout) :: snliq !snow layer liquid water [mm] + +! local + + integer :: newnode ! 0-no new layers, 1-creating new layers +! ---------------------------------------------------------------------- + newnode = 0 + +! shallow snow / no layer + + if(isnow == 0 .and. qsnow > 0.) then + snowh = snowh + snowhin * dt + sneqv = sneqv + qsnow * dt + end if + +! creating a new layer + + if(isnow == 0 .and. qsnow>0. .and. snowh >= 0.05) then + isnow = -1 + newnode = 1 + dzsnso(0)= snowh + snowh = 0. + stc(0) = min(273.16, sfctmp) ! temporary setup + snice(0) = sneqv + snliq(0) = 0. + end if + +! snow with layers + + if(isnow < 0 .and. newnode == 0 .and. qsnow > 0.) then + snice(isnow+1) = snice(isnow+1) + qsnow * dt + dzsnso(isnow+1) = dzsnso(isnow+1) + snowhin * dt + endif + +! ---------------------------------------------------------------------- + end subroutine snowfall_glacier +! ================================================================================================== +! ---------------------------------------------------------------------- +!>\ingroup NoahMP_LSM + subroutine compact_glacier (nsnow ,nsoil ,dt ,stc ,snice , & !in + snliq ,imelt ,ficeold, & !in + isnow ,dzsnso ) !inout +! ---------------------------------------------------------------------- +! ---------------------------------------------------------------------- + implicit none +! ---------------------------------------------------------------------- +! input + integer, intent(in) :: nsoil !no. of soil layers [ =4] + integer, intent(in) :: nsnow !maximum no. of snow layers [ =3] + integer, dimension(-nsnow+1:0) , intent(in) :: imelt !melting state index [0-no melt;1-melt] + real, intent(in) :: dt !time step (sec) + real, dimension(-nsnow+1:nsoil), intent(in) :: stc !snow layer temperature [k] + real, dimension(-nsnow+1: 0), intent(in) :: snice !snow layer ice [mm] + real, dimension(-nsnow+1: 0), intent(in) :: snliq !snow layer liquid water [mm] + real, dimension(-nsnow+1: 0), intent(in) :: ficeold!ice fraction at last timestep + +! input and output + integer, intent(inout) :: isnow ! actual no. of snow layers + real, dimension(-nsnow+1:nsoil), intent(inout) :: dzsnso ! snow layer thickness [m] + +! local + real, parameter :: c2 = 21.e-3 ![m3/kg] ! default 21.e-3 + real, parameter :: c3 = 2.5e-6 ![1/s] + real, parameter :: c4 = 0.04 ![1/k] + real, parameter :: c5 = 2.0 ! + real, parameter :: dm = 100.0 !upper limit on destructive metamorphism compaction [kg/m3] + real, parameter :: eta0 = 0.8e+6 !viscosity coefficient [kg-s/m2] + !according to anderson, it is between 0.52e6~1.38e6 + real :: burden !pressure of overlying snow [kg/m2] + real :: ddz1 !rate of settling of snow pack due to destructive metamorphism. + real :: ddz2 !rate of compaction of snow pack due to overburden. + real :: ddz3 !rate of compaction of snow pack due to melt [1/s] + real :: dexpf !expf=exp(-c4*(273.15-stc)). + real :: td !stc - tfrz [k] + real :: pdzdtc !nodal rate of change in fractional-thickness due to compaction [fraction/s] + real :: void !void (1 - snice - snliq) + real :: wx !water mass (ice + liquid) [kg/m2] + real :: bi !partial density of ice [kg/m3] + real, dimension(-nsnow+1:0) :: fice !fraction of ice at current time step + + integer :: j + +! ---------------------------------------------------------------------- + burden = 0.0 + + do j = isnow+1, 0 + + wx = snice(j) + snliq(j) + fice(j) = snice(j) / wx + void = 1. - (snice(j)/denice + snliq(j)/denh2o) / dzsnso(j) + + ! allow compaction only for non-saturated node and higher ice lens node. + if (void > 0.001 .and. snice(j) > 0.1) then + bi = snice(j) / dzsnso(j) + td = max(0.,tfrz-stc(j)) + dexpf = exp(-c4*td) + + ! settling as a result of destructive metamorphism + + ddz1 = -c3*dexpf + + if (bi > dm) ddz1 = ddz1*exp(-46.0e-3*(bi-dm)) + + ! liquid water term + + if (snliq(j) > 0.01*dzsnso(j)) ddz1=ddz1*c5 + + ! compaction due to overburden + + ddz2 = -(burden+0.5*wx)*exp(-0.08*td-c2*bi)/eta0 ! 0.5*wx -> self-burden + + ! compaction occurring during melt + + if (imelt(j) == 1) then + ddz3 = max(0.,(ficeold(j) - fice(j))/max(1.e-6,ficeold(j))) + ddz3 = - ddz3/dt ! sometimes too large + else + ddz3 = 0. + end if + + ! time rate of fractional change in dz (units of s-1) + + pdzdtc = (ddz1 + ddz2 + ddz3)*dt + pdzdtc = max(-0.5,pdzdtc) + + ! the change in dz due to compaction + + dzsnso(j) = dzsnso(j)*(1.+pdzdtc) + end if + + ! pressure of overlying snow + + burden = burden + wx + + end do + + 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 +! ---------------------------------------------------------------------- + implicit none +! ---------------------------------------------------------------------- +! input + + integer, intent(in) :: nsnow !maximum no. of snow layers + integer, intent(in) :: nsoil !no. of soil layers + +! input and output + + integer, intent(inout) :: isnow !actual no. of snow layers + real, dimension( 1:nsoil), intent(inout) :: sh2o !soil liquid moisture (m3/m3) + real, dimension( 1:nsoil), intent(inout) :: sice !soil ice moisture (m3/m3) + real, dimension(-nsnow+1:nsoil), intent(inout) :: stc !snow layer temperature [k] + real, dimension(-nsnow+1: 0), intent(inout) :: snice !snow layer ice [mm] + real, dimension(-nsnow+1: 0), intent(inout) :: snliq !snow layer liquid water [mm] + real, dimension(-nsnow+1:nsoil), intent(inout) :: dzsnso!snow layer depth [m] + real, intent(inout) :: sneqv !snow water equivalent [m] + real, intent(inout) :: snowh !snow depth [m] + real, intent(inout) :: ponding1 + real, intent(inout) :: ponding2 + +! local variables: + + integer :: i,j,k,l ! node indices + integer :: isnow_old ! number of top snow layer + integer :: mssi ! node index + integer :: neibor ! adjacent node selected for combination + real :: zwice ! total ice mass in snow + real :: zwliq ! total liquid water in snow + real :: dzmin(3) ! minimum of top snow layer + data dzmin /0.045, 0.05, 0.2/ +! data dzmin /0.025, 0.025, 0.1/ ! mb: change limit +!----------------------------------------------------------------------- + + isnow_old = isnow + + do j = isnow_old+1,0 + if (snice(j) <= .1) then + if(j /= 0) then + snliq(j+1) = snliq(j+1) + snliq(j) + snice(j+1) = snice(j+1) + snice(j) + else + if (isnow_old < -1) then + snliq(j-1) = snliq(j-1) + snliq(j) + snice(j-1) = snice(j-1) + snice(j) + else + ponding1 = ponding1 + snliq(j) ! isnow will get set to zero below + sneqv = snice(j) ! ponding will get added to ponding from + snowh = dzsnso(j) ! phasechange which should be zero here + snliq(j) = 0.0 ! because there it was only calculated + snice(j) = 0.0 ! for thin snow + dzsnso(j) = 0.0 + endif +! sh2o(1) = sh2o(1)+snliq(j)/(dzsnso(1)*1000.) +! sice(1) = sice(1)+snice(j)/(dzsnso(1)*1000.) + endif + + ! shift all elements above this down by one. + if (j > isnow+1 .and. isnow < -1) then + do i = j, isnow+2, -1 + stc(i) = stc(i-1) + snliq(i) = snliq(i-1) + snice(i) = snice(i-1) + dzsnso(i)= dzsnso(i-1) + end do + end if + isnow = isnow + 1 + end if + end do + +! to conserve water in case of too large surface sublimation + + if(sice(1) < 0.) then + sh2o(1) = sh2o(1) + sice(1) + sice(1) = 0. + end if + + if(isnow ==0) return ! mb: get out if no longer multi-layer + + sneqv = 0. + snowh = 0. + zwice = 0. + zwliq = 0. + + do j = isnow+1,0 + sneqv = sneqv + snice(j) + snliq(j) + snowh = snowh + dzsnso(j) + zwice = zwice + snice(j) + zwliq = zwliq + snliq(j) + end do + +! check the snow depth - all snow gone +! the liquid water assumes ponding on soil surface. + +! if (snowh < 0.025 .and. isnow < 0 ) then ! mb: change limit + if (snowh < 0.05 .and. isnow < 0 ) then + isnow = 0 + sneqv = zwice + ponding2 = ponding2 + zwliq ! limit of isnow < 0 means input ponding + if(sneqv <= 0.) snowh = 0. ! should be zero; see above + end if + +! if (snowh < 0.05 ) then +! isnow = 0 +! sneqv = zwice +! sh2o(1) = sh2o(1) + zwliq / (dzsnso(1) * 1000.) +! if(sneqv <= 0.) snowh = 0. +! end if + +! check the snow depth - snow layers combined + + if (isnow < -1) then + + isnow_old = isnow + mssi = 1 + + do i = isnow_old+1,0 + if (dzsnso(i) < dzmin(mssi)) then + + if (i == isnow+1) then + neibor = i + 1 + else if (i == 0) then + neibor = i - 1 + else + neibor = i + 1 + if ((dzsnso(i-1)+dzsnso(i)) < (dzsnso(i+1)+dzsnso(i))) neibor = i-1 + end if + + ! node l and j are combined and stored as node j. + if (neibor > i) then + j = neibor + l = i + else + j = i + l = neibor + end if + + call combo_glacier (dzsnso(j), snliq(j), snice(j), & + stc(j), dzsnso(l), snliq(l), snice(l), stc(l) ) + + ! now shift all elements above this down one. + if (j-1 > isnow+1) then + do k = j-1, isnow+2, -1 + stc(k) = stc(k-1) + snice(k) = snice(k-1) + snliq(k) = snliq(k-1) + dzsnso(k) = dzsnso(k-1) + end do + end if + + ! decrease the number of snow layers + isnow = isnow + 1 + if (isnow >= -1) exit + else + + ! the layer thickness is greater than the prescribed minimum value + mssi = mssi + 1 + + end if + end do + + end if + + end subroutine combine_glacier +! ================================================================================================== + +! ---------------------------------------------------------------------- +!>\ingroup NoahMP_LSM + subroutine combo_glacier(dz, wliq, wice, t, dz2, wliq2, wice2, t2) +! ---------------------------------------------------------------------- + implicit none +! ---------------------------------------------------------------------- + +! ----------------------------------------------------------------------s +! input + + real, intent(in) :: dz2 !nodal thickness of 2 elements being combined [m] + real, intent(in) :: wliq2 !liquid water of element 2 [kg/m2] + real, intent(in) :: wice2 !ice of element 2 [kg/m2] + real, intent(in) :: t2 !nodal temperature of element 2 [k] + real, intent(inout) :: dz !nodal thickness of 1 elements being combined [m] + real, intent(inout) :: wliq !liquid water of element 1 + real, intent(inout) :: wice !ice of element 1 [kg/m2] + real, intent(inout) :: t !node temperature of element 1 [k] + +! local + + real :: dzc !total thickness of nodes 1 and 2 (dzc=dz+dz2). + real :: wliqc !combined liquid water [kg/m2] + real :: wicec !combined ice [kg/m2] + real :: tc !combined node temperature [k] + real :: h !enthalpy of element 1 [j/m2] + real :: h2 !enthalpy of element 2 [j/m2] + real :: hc !temporary + +!----------------------------------------------------------------------- + + dzc = dz+dz2 + wicec = (wice+wice2) + wliqc = (wliq+wliq2) + h = (cice*wice+cwat*wliq) * (t-tfrz)+hfus*wliq + h2= (cice*wice2+cwat*wliq2) * (t2-tfrz)+hfus*wliq2 + + hc = h + h2 + if(hc < 0.)then + tc = tfrz + hc/(cice*wicec + cwat*wliqc) + else if (hc.le.hfus*wliqc) then + tc = tfrz + else + tc = tfrz + (hc - hfus*wliqc) / (cice*wicec + cwat*wliqc) + end if + + dz = dzc + wice = wicec + wliq = wliqc + t = tc + + end subroutine combo_glacier +! ================================================================================================== +!>\ingroup NoahMP_LSM + subroutine divide_glacier (nsnow ,nsoil , & !in + isnow ,stc ,snice ,snliq ,dzsnso ) !inout +! ---------------------------------------------------------------------- + implicit none +! ---------------------------------------------------------------------- +! input + + integer, intent(in) :: nsnow !maximum no. of snow layers [ =3] + integer, intent(in) :: nsoil !no. of soil layers [ =4] + +! input and output + + integer , intent(inout) :: isnow !actual no. of snow layers + real, dimension(-nsnow+1:nsoil), intent(inout) :: stc !snow layer temperature [k] + real, dimension(-nsnow+1: 0), intent(inout) :: snice !snow layer ice [mm] + real, dimension(-nsnow+1: 0), intent(inout) :: snliq !snow layer liquid water [mm] + real, dimension(-nsnow+1:nsoil), intent(inout) :: dzsnso!snow layer depth [m] + +! local variables: + + integer :: j !indices + integer :: msno !number of layer (top) to msno (bot) + real :: drr !thickness of the combined [m] + real, dimension( 1:nsnow) :: dz !snow layer thickness [m] + real, dimension( 1:nsnow) :: swice !partial volume of ice [m3/m3] + real, dimension( 1:nsnow) :: swliq !partial volume of liquid water [m3/m3] + real, dimension( 1:nsnow) :: tsno !node temperature [k] + real :: zwice !temporary + real :: zwliq !temporary + real :: propor!temporary + real :: dtdz !temporary +! ---------------------------------------------------------------------- + + do j = 1,nsnow + if (j <= abs(isnow)) then + dz(j) = dzsnso(j+isnow) + swice(j) = snice(j+isnow) + swliq(j) = snliq(j+isnow) + tsno(j) = stc(j+isnow) + end if + end do + + msno = abs(isnow) + + if (msno == 1) then + ! specify a new snow layer + if (dz(1) > 0.05) then + msno = 2 + dz(1) = dz(1)/2. + swice(1) = swice(1)/2. + swliq(1) = swliq(1)/2. + dz(2) = dz(1) + swice(2) = swice(1) + swliq(2) = swliq(1) + tsno(2) = tsno(1) + end if + end if + + if (msno > 1) then + if (dz(1) > 0.05) then + drr = dz(1) - 0.05 + propor = drr/dz(1) + zwice = propor*swice(1) + zwliq = propor*swliq(1) + propor = 0.05/dz(1) + swice(1) = propor*swice(1) + swliq(1) = propor*swliq(1) + dz(1) = 0.05 + + call combo_glacier (dz(2), swliq(2), swice(2), tsno(2), drr, & + zwliq, zwice, tsno(1)) + + ! subdivide a new layer +! if (msno <= 2 .and. dz(2) > 0.20) then ! mb: change limit + if (msno <= 2 .and. dz(2) > 0.10) then + msno = 3 + dtdz = (tsno(1) - tsno(2))/((dz(1)+dz(2))/2.) + dz(2) = dz(2)/2. + swice(2) = swice(2)/2. + swliq(2) = swliq(2)/2. + dz(3) = dz(2) + swice(3) = swice(2) + swliq(3) = swliq(2) + tsno(3) = tsno(2) - dtdz*dz(2)/2. + if (tsno(3) >= tfrz) then + tsno(3) = tsno(2) + else + tsno(2) = tsno(2) + dtdz*dz(2)/2. + endif + + end if + end if + end if + + if (msno > 2) then + if (dz(2) > 0.2) then + drr = dz(2) - 0.2 + propor = drr/dz(2) + zwice = propor*swice(2) + zwliq = propor*swliq(2) + propor = 0.2/dz(2) + swice(2) = propor*swice(2) + swliq(2) = propor*swliq(2) + dz(2) = 0.2 + call combo_glacier (dz(3), swliq(3), swice(3), tsno(3), drr, & + zwliq, zwice, tsno(2)) + end if + end if + + isnow = -msno + + do j = isnow+1,0 + dzsnso(j) = dz(j-isnow) + snice(j) = swice(j-isnow) + snliq(j) = swliq(j-isnow) + stc(j) = tsno(j-isnow) + end do + + +! do j = isnow+1,nsoil +! write(*,'(i5,7f10.3)') j, dzsnso(j), snice(j), snliq(j),stc(j) +! end do + + 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 , & !inout + qsnbot ) !out +! ---------------------------------------------------------------------- +! renew the mass of ice lens (snice) and liquid (snliq) of the +! surface snow layer resulting from sublimation (frost) / evaporation (dew) +! ---------------------------------------------------------------------- + implicit none +! ---------------------------------------------------------------------- +! input + + integer, intent(in) :: nsnow !maximum no. of snow layers[=3] + integer, intent(in) :: nsoil !no. of soil layers[=4] + real, intent(in) :: dt !time step + real, intent(in) :: qsnfro !snow surface frost rate[mm/s] + real, intent(in) :: qsnsub !snow surface sublimation rate[mm/s] + real, intent(in) :: qrain !snow surface rain rate[mm/s] + +! output + + real, intent(out) :: qsnbot !melting water out of snow bottom [mm/s] + +! input and output + + integer, intent(inout) :: isnow !actual no. of snow layers + real, dimension(-nsnow+1:nsoil), intent(inout) :: dzsnso ! snow layer depth [m] + real, intent(inout) :: snowh !snow height [m] + real, intent(inout) :: sneqv !snow water eqv. [mm] + real, dimension(-nsnow+1:0), intent(inout) :: snice !snow layer ice [mm] + real, dimension(-nsnow+1:0), intent(inout) :: snliq !snow layer liquid water [mm] + real, dimension( 1:nsoil), intent(inout) :: sh2o !soil liquid moisture (m3/m3) + real, dimension( 1:nsoil), intent(inout) :: sice !soil ice moisture (m3/m3) + real, dimension(-nsnow+1:nsoil), intent(inout) :: stc !snow layer temperature [k] + real, intent(inout) :: ponding1 + real, intent(inout) :: ponding2 + +! local variables: + + integer :: j !do loop/array indices + real :: qin !water flow into the element (mm/s) + real :: qout !water flow out of the element (mm/s) + real :: wgdif !ice mass after minus sublimation + real, dimension(-nsnow+1:0) :: vol_liq !partial volume of liquid water in layer + real, dimension(-nsnow+1:0) :: vol_ice !partial volume of ice lens in layer + real, dimension(-nsnow+1:0) :: epore !effective porosity = porosity - vol_ice + real :: propor, temp +! ---------------------------------------------------------------------- + +!for the case when sneqv becomes '0' after 'combine' + + if(sneqv == 0.) then + sice(1) = sice(1) + (qsnfro-qsnsub)*dt/(dzsnso(1)*1000.) + end if + +! for shallow snow without a layer +! snow surface sublimation may be larger than existing snow mass. to conserve water, +! excessive sublimation is used to reduce soil water. smaller time steps would tend +! to aviod this problem. + + if(isnow == 0 .and. sneqv > 0.) then + temp = sneqv + sneqv = sneqv - qsnsub*dt + qsnfro*dt + propor = sneqv/temp + snowh = max(0.,propor * snowh) + + if(sneqv < 0.) then + sice(1) = sice(1) + sneqv/(dzsnso(1)*1000.) + sneqv = 0. + snowh = 0. + end if + if(sice(1) < 0.) then + sh2o(1) = sh2o(1) + sice(1) + sice(1) = 0. + end if + end if + + if(snowh <= 1.e-8 .or. sneqv <= 1.e-6) then + snowh = 0.0 + sneqv = 0.0 + end if + +! for deep snow + + if ( isnow < 0 ) then !kwm added this if statement to prevent out-of-bounds array references + + wgdif = snice(isnow+1) - qsnsub*dt + qsnfro*dt + snice(isnow+1) = wgdif + if (wgdif < 1.e-6 .and. isnow <0) then + call combine_glacier (nsnow ,nsoil , & !in + isnow ,sh2o ,stc ,snice ,snliq , & !inout + dzsnso ,sice ,snowh ,sneqv , & !inout + ponding1, ponding2 ) !inout + endif + !kwm: subroutine combine can change isnow to make it 0 again? + if ( isnow < 0 ) then !kwm added this if statement to prevent out-of-bounds array references + snliq(isnow+1) = snliq(isnow+1) + qrain * dt + snliq(isnow+1) = max(0., snliq(isnow+1)) + endif + + endif !kwm -- can the endif be moved toward the end of the subroutine (just set qsnbot=0)? + +! porosity and partial volume + + !kwm looks to me like loop index / if test can be simplified. + + do j = -nsnow+1, 0 + if (j >= isnow+1) then + vol_ice(j) = min(1., snice(j)/(dzsnso(j)*denice)) + epore(j) = 1. - vol_ice(j) + vol_liq(j) = min(epore(j),snliq(j)/(dzsnso(j)*denh2o)) + end if + end do + + qin = 0. + qout = 0. + + !kwm looks to me like loop index / if test can be simplified. + + do j = -nsnow+1, 0 + if (j >= isnow+1) then + snliq(j) = snliq(j) + qin + if (j <= -1) then + if (epore(j) < 0.05 .or. epore(j+1) < 0.05) then + qout = 0. + else + qout = max(0.,(vol_liq(j)-ssi*epore(j))*dzsnso(j)) + qout = min(qout,(1.-vol_ice(j+1)-vol_liq(j+1))*dzsnso(j+1)) + end if + else + qout = max(0.,(vol_liq(j) - ssi*epore(j))*dzsnso(j)) + end if + qout = qout*1000. + snliq(j) = snliq(j) - qout + qin = qout + end if + end do + +! liquid water from snow bottom to soil + + qsnbot = qout / dt ! mm/s + + end subroutine snowh2o_glacier +! ********************* end of water subroutines ****************************************** +! ================================================================================================== +!>\ingroup NoahMP_LSM + 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 ) +#else + runsrf ,runsub ,sneqv ,dt ,beg_wb ) +#endif +! -------------------------------------------------------------------------------------------------- +! check surface energy balance and water balance +! -------------------------------------------------------------------------------------------------- + implicit none +! -------------------------------------------------------------------------------------------------- +! inputs + integer , intent(in) :: iloc !grid index + integer , intent(in) :: jloc !grid index + real , intent(in) :: swdown !downward solar filtered by sun angle [w/m2] + real , intent(in) :: fsa !total absorbed solar radiation (w/m2) + real , intent(in) :: fsr !total reflected solar radiation (w/m2) + real , intent(in) :: fira !total net longwave rad (w/m2) [+ to atm] + real , intent(in) :: fsh !total sensible heat (w/m2) [+ to atm] + real , intent(in) :: fgev !ground evaporation heat (w/m2) [+ to atm] + real , intent(in) :: ssoil !ground heat flux (w/m2) [+ to soil] + real , intent(in) :: sag + + real , intent(in) :: prcp !precipitation rate (kg m-2 s-1) + real , intent(in) :: edir !soil surface evaporation rate[mm/s] + real , intent(in) :: runsrf !surface runoff [mm/s] + real , intent(in) :: runsub !baseflow (saturation excess) [mm/s] + real , intent(in) :: sneqv !snow water eqv. [mm] + real , intent(in) :: dt !time step [sec] + real , intent(in) :: beg_wb !water storage at begin of a timesetp [mm] + +#ifdef CCPP + character(len=*) , intent(inout) :: errmsg + integer , intent(inout) :: errflg +#endif + + real :: end_wb !water storage at end of a timestep [mm] + real :: errwat !error in water balance [mm/timestep] + real :: erreng !error in surface energy balance [w/m2] + real :: errsw !error in shortwave radiation balance [w/m2] + character(len=256) :: message +! -------------------------------------------------------------------------------------------------- + errsw = swdown - (fsa + fsr) + if (errsw > 0.01) then ! w/m2 + write(*,*) "sag =",sag + write(*,*) "fsa =",fsa + write(*,*) "fsr =",fsr + write(message,*) 'errsw =',errsw +#ifdef CCPP + errflg = 1 + errmsg = trim(message)//NEW_LINE('A')//"radiation budget problem in noahmp glacier" + return +#else + call wrf_message(trim(message)) + call wrf_error_fatal("radiation budget problem in noahmp glacier") +#endif + end if + + erreng = sag-(fira+fsh+fgev+ssoil) + if(erreng > 0.01) then + write(message,*) 'erreng =',erreng +#ifdef CCPP + errmsg = trim(message) +#else + call wrf_message(trim(message)) +#endif + write(message,'(i6,1x,i6,1x,5f10.4)')iloc,jloc,sag,fira,fsh,fgev,ssoil +#ifdef CCPP + errflg = 1 + errmsg = trim(errmsg)//NEW_LINE('A')//"energy budget problem in noahmp glacier" + return +#else + call wrf_message(trim(message)) + call wrf_error_fatal("energy budget problem in noahmp glacier") +#endif + end if + + end_wb = sneqv + errwat = end_wb-beg_wb-(prcp-edir-runsrf-runsub)*dt + + + end subroutine error_glacier +! ================================================================================================== + +!>\ingroup NoahMP_LSM + subroutine noahmp_options_glacier(idveg ,iopt_crs ,iopt_btr ,iopt_run ,iopt_sfc ,iopt_frz , & + iopt_inf ,iopt_rad ,iopt_alb ,iopt_snf ,iopt_tbot, iopt_stc ) + + implicit none + + integer, intent(in) :: idveg !dynamic vegetation (1 -> off ; 2 -> on) with opt_crs = 1 + integer, intent(in) :: iopt_crs !canopy stomatal resistance (1-> ball-berry; 2->jarvis) + integer, intent(in) :: iopt_btr !soil moisture factor for stomatal resistance (1-> noah; 2-> clm; 3-> ssib) + integer, intent(in) :: iopt_run !runoff and groundwater (1->simgm; 2->simtop; 3->schaake96; 4->bats) + integer, intent(in) :: iopt_sfc !surface layer drag coeff (ch & cm) (1->m-o; 2->chen97) + integer, intent(in) :: iopt_frz !supercooled liquid water (1-> ny06; 2->koren99) + integer, intent(in) :: iopt_inf !frozen soil permeability (1-> ny06; 2->koren99) + integer, intent(in) :: iopt_rad !radiation transfer (1->gap=f(3d,cosz); 2->gap=0; 3->gap=1-fveg) + integer, intent(in) :: iopt_alb !snow surface albedo (1->bats; 2->class) + integer, intent(in) :: iopt_snf !rainfall & snowfall (1-jordan91; 2->bats; 3->noah) + integer, intent(in) :: iopt_tbot !lower boundary of soil temperature (1->zero-flux; 2->noah) + + integer, intent(in) :: iopt_stc !snow/soil temperature time scheme (only layer 1) + ! 1 -> semi-implicit; 2 -> full implicit (original noah) + +! ------------------------------------------------------------------------------------------------- + + dveg = idveg + + opt_crs = iopt_crs + opt_btr = iopt_btr + opt_run = iopt_run + opt_sfc = iopt_sfc + opt_frz = iopt_frz + opt_inf = iopt_inf + opt_rad = iopt_rad + opt_alb = iopt_alb + opt_snf = iopt_snf + opt_tbot = iopt_tbot + opt_stc = iopt_stc + + end subroutine noahmp_options_glacier + +end module noahmp_glacier_routines +! ================================================================================================== + +module module_sf_noahmp_glacier + + use noahmp_glacier_routines + use noahmp_glacier_globals + +end module module_sf_noahmp_glacier + diff --git a/physics/module_sf_noahmplsm.f90 b/physics/module_sf_noahmplsm.f90 new file mode 100644 index 000000000..a0612d417 --- /dev/null +++ b/physics/module_sf_noahmplsm.f90 @@ -0,0 +1,8526 @@ +!> \file module_sf_noahmplsm.f90 +!! This file contains the NoahMP land surface model. + +!>\ingroup NoahMP_LSM +module module_sf_noahmplsm +#ifndef CCPP + use module_wrf_utl +#endif + + implicit none + + public :: noahmp_options + public :: noahmp_sflx + + private :: atm + private :: phenology + private :: precip_heat + private :: energy + private :: thermoprop + private :: csnow + private :: tdfcnd + private :: radiation + private :: albedo + private :: snow_age + private :: snowalb_bats + private :: snowalb_class + private :: groundalb + private :: twostream + private :: surrad + private :: vege_flux + private :: sfcdif1 + private :: sfcdif2 + private :: stomata + private :: canres + private :: esat + private :: ragrb + private :: bare_flux + private :: tsnosoi + private :: hrt + private :: hstep + private :: rosr12 + private :: phasechange + private :: frh2o + + private :: water + private :: canwater + private :: snowwater + private :: snowfall + private :: combine + private :: divide + private :: combo + private :: compact + private :: snowh2o + private :: soilwater + private :: zwteq + private :: infil + private :: srt + private :: wdfcnd1 + private :: wdfcnd2 + private :: sstep + private :: groundwater + private :: shallowwatertable + + private :: carbon + private :: co2flux +! private :: bvocflux +! private :: ch4flux + + private :: error + +! =====================================options for different schemes================================ +! **recommended + + integer :: dveg ! options for dynamic vegetation: + ! 1 -> off (use table lai; use fveg = shdfac from input) + ! 2 -> on (together with opt_crs = 1) + ! 3 -> off (use table lai; calculate fveg) + ! **4 -> off (use table lai; use maximum vegetation fraction) + ! **5 -> on (use maximum vegetation fraction) + + integer :: opt_crs ! options for canopy stomatal resistance + ! **1 -> ball-berry + ! 2 -> jarvis + + integer :: opt_btr ! options for soil moisture factor for stomatal resistance + ! **1 -> noah (soil moisture) + ! 2 -> clm (matric potential) + ! 3 -> ssib (matric potential) + + integer :: opt_run ! options for runoff and groundwater + ! **1 -> topmodel with groundwater (niu et al. 2007 jgr) ; + ! 2 -> topmodel with an equilibrium water table (niu et al. 2005 jgr) ; + ! 3 -> original surface and subsurface runoff (free drainage) + ! 4 -> bats surface and subsurface runoff (free drainage) + ! 5 -> miguez-macho&fan groundwater scheme (miguez-macho et al. 2007 jgr; fan et al. 2007 jgr) + ! (needs further testing for public use) + + integer :: opt_sfc ! options for surface layer drag coeff (ch & cm) + ! **1 -> m-o + ! **2 -> original noah (chen97) + ! **3 -> myj consistent; 4->ysu consistent. mb: removed in v3.7 for further testing + + integer :: opt_frz ! options for supercooled liquid water (or ice fraction) + ! **1 -> no iteration (niu and yang, 2006 jhm) + ! 2 -> koren's iteration + + integer :: opt_inf ! options for frozen soil permeability + ! **1 -> linear effects, more permeable (niu and yang, 2006, jhm) + ! 2 -> nonlinear effects, less permeable (old) + + integer :: opt_rad ! options for radiation transfer + ! 1 -> modified two-stream (gap = f(solar angle, 3d structure ...)<1-fveg) + ! 2 -> two-stream applied to grid-cell (gap = 0) + ! **3 -> two-stream applied to vegetated fraction (gap=1-fveg) + + integer :: opt_alb ! options for ground snow surface albedo + ! 1 -> bats + ! **2 -> class + + integer :: opt_snf ! options for partitioning precipitation into rainfall & snowfall + ! **1 -> jordan (1991) + ! 2 -> bats: when sfctmp sfctmp < tfrz + ! 4 -> use wrf microphysics output + + integer :: opt_tbot ! options for lower boundary condition of soil temperature + ! 1 -> zero heat flux from bottom (zbot and tbot not used) + ! **2 -> tbot at zbot (8m) read from a file (original noah) + + integer :: opt_stc ! options for snow/soil temperature time scheme (only layer 1) + ! **1 -> semi-implicit; flux top boundary condition + ! 2 -> full implicit (original noah); temperature top boundary condition + ! 3 -> same as 1, but fsno for ts calculation (generally improves snow; v3.7) + +!------------------------------------------------------------------------------------------! +! physical constants: ! +!------------------------------------------------------------------------------------------! + + real, parameter :: grav = 9.80616 !acceleration due to gravity (m/s2) + real, parameter :: sb = 5.67e-08 !stefan-boltzmann constant (w/m2/k4) + real, parameter :: vkc = 0.40 !von karman constant + real, parameter :: tfrz = 273.16 !freezing/melting point (k) + real, parameter :: hsub = 2.8440e06 !latent heat of sublimation (j/kg) + real, parameter :: hvap = 2.5104e06 !latent heat of vaporization (j/kg) + real, parameter :: hfus = 0.3336e06 !latent heat of fusion (j/kg) + real, parameter :: cwat = 4.188e06 !specific heat capacity of water (j/m3/k) + real, parameter :: cice = 2.094e06 !specific heat capacity of ice (j/m3/k) + real, parameter :: cpair = 1004.64 !heat capacity dry air at const pres (j/kg/k) + real, parameter :: tkwat = 0.6 !thermal conductivity of water (w/m/k) + real, parameter :: tkice = 2.2 !thermal conductivity of ice (w/m/k) + real, parameter :: tkair = 0.023 !thermal conductivity of air (w/m/k) (not used mb: 20140718) + real, parameter :: rair = 287.04 !gas constant for dry air (j/kg/k) + real, parameter :: rw = 461.269 !gas constant for water vapor (j/kg/k) + real, parameter :: denh2o = 1000. !density of water (kg/m3) + real, parameter :: denice = 917. !density of ice (kg/m3) + + integer, private, parameter :: mband = 2 + + type noahmp_parameters ! define a noahmp parameters type + +!------------------------------------------------------------------------------------------! +! from the veg section of mptable.tbl +!------------------------------------------------------------------------------------------! + + logical :: urban_flag + integer :: iswater + integer :: isbarren + integer :: isice + integer :: eblforest + + real :: ch2op !maximum intercepted h2o per unit lai+sai (mm) + real :: dleaf !characteristic leaf dimension (m) + real :: z0mvt !momentum roughness length (m) + real :: hvt !top of canopy (m) + real :: hvb !bottom of canopy (m) + real :: den !tree density (no. of trunks per m2) + real :: rc !tree crown radius (m) + real :: mfsno !snowmelt m parameter () + real :: saim(12) !monthly stem area index, one-sided + real :: laim(12) !monthly leaf area index, one-sided + real :: sla !single-side leaf area per kg [m2/kg] + real :: dilefc !coeficient for leaf stress death [1/s] + real :: dilefw !coeficient for leaf stress death [1/s] + real :: fragr !fraction of growth respiration !original was 0.3 + real :: ltovrc !leaf turnover [1/s] + + real :: c3psn !photosynthetic pathway: 0. = c4, 1. = c3 + real :: kc25 !co2 michaelis-menten constant at 25c (pa) + real :: akc !q10 for kc25 + real :: ko25 !o2 michaelis-menten constant at 25c (pa) + real :: ako !q10 for ko25 + real :: vcmx25 !maximum rate of carboxylation at 25c (umol co2/m**2/s) + real :: avcmx !q10 for vcmx25 + real :: bp !minimum leaf conductance (umol/m**2/s) + real :: mp !slope of conductance-to-photosynthesis relationship + real :: qe25 !quantum efficiency at 25c (umol co2 / umol photon) + real :: aqe !q10 for qe25 + real :: rmf25 !leaf maintenance respiration at 25c (umol co2/m**2/s) + real :: rms25 !stem maintenance respiration at 25c (umol co2/kg bio/s) + real :: rmr25 !root maintenance respiration at 25c (umol co2/kg bio/s) + real :: arm !q10 for maintenance respiration + real :: folnmx !foliage nitrogen concentration when f(n)=1 (%) + real :: tmin !minimum temperature for photosynthesis (k) + + real :: xl !leaf/stem orientation index + real :: rhol(mband) !leaf reflectance: 1=vis, 2=nir + real :: rhos(mband) !stem reflectance: 1=vis, 2=nir + real :: taul(mband) !leaf transmittance: 1=vis, 2=nir + real :: taus(mband) !stem transmittance: 1=vis, 2=nir + + real :: mrp !microbial respiration parameter (umol co2 /kg c/ s) + real :: cwpvt !empirical canopy wind parameter + + real :: wrrat !wood to non-wood ratio + real :: wdpool !wood pool (switch 1 or 0) depending on woody or not [-] + real :: tdlef !characteristic t for leaf freezing [k] + + integer :: nroot !number of soil layers with root present + real :: rgl !parameter used in radiation stress function + real :: rsmin !minimum stomatal resistance [s m-1] + real :: hs !parameter used in vapor pressure deficit function + real :: topt !optimum transpiration air temperature [k] + real :: rsmax !maximal stomatal resistance [s m-1] + + real :: slarea + real :: eps(5) + +!------------------------------------------------------------------------------------------! +! from the rad section of mptable.tbl +!------------------------------------------------------------------------------------------! + + real :: albsat(mband) !saturated soil albedos: 1=vis, 2=nir + real :: albdry(mband) !dry soil albedos: 1=vis, 2=nir + real :: albice(mband) !albedo land ice: 1=vis, 2=nir + real :: alblak(mband) !albedo frozen lakes: 1=vis, 2=nir + real :: omegas(mband) !two-stream parameter omega for snow + real :: betads !two-stream parameter betad for snow + real :: betais !two-stream parameter betad for snow + real :: eg(2) !emissivity + +!------------------------------------------------------------------------------------------! +! from the globals section of mptable.tbl +!------------------------------------------------------------------------------------------! + + real :: co2 !co2 partial pressure + real :: o2 !o2 partial pressure + real :: timean !gridcell mean topgraphic index (global mean) + real :: fsatmx !maximum surface saturated fraction (global mean) + real :: z0sno !snow surface roughness length (m) (0.002) + real :: ssi !liquid water holding capacity for snowpack (m3/m3) + real :: swemx !new snow mass to fully cover old snow (mm) + +!------------------------------------------------------------------------------------------! +! from the soilparm.tbl tables, as functions of soil category. +!------------------------------------------------------------------------------------------! + real :: bexp !b parameter + real :: smcdry !dry soil moisture threshold where direct evap from top + !layer ends (volumetric) (not used mb: 20140718) + real :: smcwlt !wilting point soil moisture (volumetric) + real :: smcref !reference soil moisture (field capacity) (volumetric) + real :: smcmax !porosity, saturated value of soil moisture (volumetric) + real :: f1 !soil thermal diffusivity/conductivity coef (not used mb: 20140718) + real :: psisat !saturated soil matric potential + real :: dksat !saturated soil hydraulic conductivity + real :: dwsat !saturated soil hydraulic diffusivity + real :: quartz !soil quartz content +!------------------------------------------------------------------------------------------! +! from the genparm.tbl file +!------------------------------------------------------------------------------------------! + real :: slope !slope index (0 - 1) + real :: csoil !vol. soil heat capacity [j/m3/k] + real :: zbot !depth (m) of lower boundary soil temperature + real :: czil !calculate roughness length of heat + + real :: kdt !used in compute maximum infiltration rate (in infil) + real :: frzx !used in compute maximum infiltration rate (in infil) + + end type noahmp_parameters + +contains +! +!== begin noahmp_sflx ============================================================================== + +!>\ingroup NoahMP_LSM + subroutine noahmp_sflx (parameters, & + iloc , jloc , lat , yearlen , julian , cosz , & ! in : time/space-related + dt , dx , dz8w , nsoil , zsoil , nsnow , & ! in : model configuration + shdfac , shdmax , vegtyp , ice , ist , & ! in : vegetation/soil characteristics + smceq , & ! in : vegetation/soil characteristics + sfctmp , sfcprs , psfc , uu , vv , q2 , & ! in : forcing + qc , soldn , lwdn , & ! in : forcing + prcpconv, prcpnonc, prcpshcv, prcpsnow, prcpgrpl, prcphail, & ! in : forcing + tbot , co2air , o2air , foln , ficeold , zlvl , & ! in : forcing + lheatstrg , & ! in : canopy heat storage + albold , sneqvo , & ! in/out : + stc , sh2o , smc , tah , eah , fwet , & ! in/out : + canliq , canice , tv , tg , qsfc , qsnow , & ! in/out : + isnow , zsnso , snowh , sneqv , snice , snliq , & ! in/out : + zwt , wa , wt , wslake , lfmass , rtmass , & ! in/out : + stmass , wood , stblcp , fastcp , lai , sai , & ! in/out : + cm , ch , tauss , & ! in/out : + smcwtd ,deeprech , rech , cpfac , & ! in/out : + z0wrf , & + fsa , fsr , fira , fshx , 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 : + bgap , wgap , chv , chb , emissi , & ! out : + shg , shc , shb , evg , evb , ghv , & ! out : + ghb , irg , irc , irb , tr , evc , & ! out : + chleaf , chuc , chv2 , chb2 , fpice , pahv , & +#ifdef CCPP + pahg , pahb , pah , esnow, errmsg, errflg) +#else + pahg , pahb , pah , esnow) +#endif + +! -------------------------------------------------------------------------------------------------- +! initial code: guo-yue niu, oct. 2007 +! -------------------------------------------------------------------------------------------------- + implicit none +! -------------------------------------------------------------------------------------------------- +! input + type (noahmp_parameters), intent(in) :: parameters + + integer , intent(in) :: ice !ice (ice = 1) + integer , intent(in) :: ist !surface type 1->soil; 2->lake + integer , intent(in) :: vegtyp !vegetation type + integer , intent(in) :: nsnow !maximum no. of snow layers + integer , intent(in) :: nsoil !no. of soil layers + integer , intent(in) :: iloc !grid index + integer , intent(in) :: jloc !grid index + real , intent(in) :: dt !time step [sec] + real, dimension( 1:nsoil), intent(in) :: zsoil !layer-bottom depth from soil surf (m) + real , intent(in) :: q2 !mixing ratio (kg/kg) lowest model layer + real , intent(in) :: sfctmp !surface air temperature [k] + real , intent(in) :: uu !wind speed in eastward dir (m/s) + real , intent(in) :: vv !wind speed in northward dir (m/s) + real , intent(in) :: soldn !downward shortwave radiation (w/m2) + real , intent(in) :: lwdn !downward longwave radiation (w/m2) + real , intent(in) :: sfcprs !pressure (pa) + real , intent(inout) :: zlvl !reference height (m) + logical , intent(in) :: lheatstrg ! flag for canopy heat storage parameterization + real , intent(in) :: cosz !cosine solar zenith angle [0-1] + real , intent(in) :: tbot !bottom condition for soil temp. [k] + real , intent(in) :: foln !foliage nitrogen (%) [1-saturated] + real , intent(in) :: shdfac !green vegetation fraction [0.0-1.0] + integer , intent(in) :: yearlen!number of days in the particular year. + real , intent(in) :: julian !julian day of year (floating point) + real , intent(in) :: lat !latitude (radians) + real, dimension(-nsnow+1: 0), intent(in) :: ficeold!ice fraction at last timestep + real, dimension( 1:nsoil), intent(in) :: smceq !equilibrium soil water content [m3/m3] + real , intent(in) :: prcpconv ! convective precipitation entering [mm/s] ! mb/an : v3.7 + real , intent(in) :: prcpnonc ! non-convective precipitation entering [mm/s] ! mb/an : v3.7 + real , intent(in) :: prcpshcv ! shallow convective precip entering [mm/s] ! mb/an : v3.7 + real , intent(in) :: prcpsnow ! snow entering land model [mm/s] ! mb/an : v3.7 + real , intent(in) :: prcpgrpl ! graupel entering land model [mm/s] ! mb/an : v3.7 + real , intent(in) :: prcphail ! hail entering land model [mm/s] ! mb/an : v3.7 + +!jref:start; in + real , intent(in) :: qc !cloud water mixing ratio + real , intent(inout) :: qsfc !mixing ratio at lowest model layer + real , intent(in) :: psfc !pressure at lowest model layer + real , intent(in) :: dz8w !thickness of lowest layer + real , intent(in) :: dx + real , intent(in) :: shdmax !yearly max vegetation fraction +!jref:end + + +! input/output : need arbitary intial values + real , intent(inout) :: qsnow !snowfall [mm/s] + real , intent(inout) :: fwet !wetted or snowed fraction of canopy (-) + real , intent(inout) :: sneqvo !snow mass at last time step (mm) + real , intent(inout) :: eah !canopy air vapor pressure (pa) + real , intent(inout) :: tah !canopy air tmeperature (k) + real , intent(inout) :: albold !snow albedo at last time step (class type) + real , intent(inout) :: cm !momentum drag coefficient + real , intent(inout) :: ch !sensible heat exchange coefficient + real , intent(inout) :: tauss !non-dimensional snow age + +! prognostic variables + integer , intent(inout) :: isnow !actual no. of snow layers [-] + real , intent(inout) :: canliq !intercepted liquid water (mm) + real , intent(inout) :: canice !intercepted ice mass (mm) + real , intent(inout) :: sneqv !snow water eqv. [mm] + real, dimension( 1:nsoil), intent(inout) :: smc !soil moisture (ice + liq.) [m3/m3] + real, dimension(-nsnow+1:nsoil), intent(inout) :: zsnso !layer-bottom depth from snow surf [m] + real , intent(inout) :: snowh !snow height [m] + real, dimension(-nsnow+1: 0), intent(inout) :: snice !snow layer ice [mm] + real, dimension(-nsnow+1: 0), intent(inout) :: snliq !snow layer liquid water [mm] + real , intent(inout) :: tv !vegetation temperature (k) + real , intent(inout) :: tg !ground temperature (k) + real, dimension(-nsnow+1:nsoil), intent(inout) :: stc !snow/soil temperature [k] + real, dimension( 1:nsoil), intent(inout) :: sh2o !liquid soil moisture [m3/m3] + real , intent(inout) :: zwt !depth to water table [m] + real , intent(inout) :: wa !water storage in aquifer [mm] + real , intent(inout) :: wt !water in aquifer&saturated soil [mm] + real , intent(inout) :: wslake !lake water storage (can be neg.) (mm) + real, intent(inout) :: smcwtd !soil water content between bottom of the soil and water table [m3/m3] + real, intent(inout) :: deeprech !recharge to or from the water table when deep [m] + real, intent(inout) :: rech !recharge to or from the water table when shallow [m] (diagnostic) + real, intent(inout) :: cpfac ! heat capacity enhancement factor due to heat storage + +! output + real , intent(out) :: z0wrf !combined z0 sent to coupled model + real , intent(out) :: fsa !total absorbed solar radiation (w/m2) + real , intent(out) :: fsr !total reflected solar radiation (w/m2) + real , intent(out) :: fira !total net lw rad (w/m2) [+ to atm] + real , intent(out) :: fshx !total sensible heat (w/m2) [+ to atm] + real , intent(out) :: fcev !canopy evap heat (w/m2) [+ to atm] + real , intent(out) :: fgev !ground evap heat (w/m2) [+ to atm] + real , intent(out) :: fctr !transpiration heat (w/m2) [+ to atm] + real , intent(out) :: ssoil !ground heat flux (w/m2) [+ to soil] + real , intent(out) :: trad !surface radiative temperature (k) + real :: ts !surface temperature (k) + real , intent(out) :: ecan !evaporation of intercepted water (mm/s) + real , intent(out) :: etran !transpiration rate (mm/s) + real , intent(out) :: edir !soil surface evaporation rate (mm/s] + real , intent(out) :: runsrf !surface runoff [mm/s] + real , intent(out) :: runsub !baseflow (saturation excess) [mm/s] + real , intent(out) :: psn !total photosynthesis (umol co2/m2/s) [+] + real , intent(out) :: apar !photosyn active energy by canopy (w/m2) + real , intent(out) :: sav !solar rad absorbed by veg. (w/m2) + real , intent(out) :: sag !solar rad absorbed by ground (w/m2) + real , intent(out) :: fsno !snow cover fraction on the ground (-) + real , intent(out) :: fveg !green vegetation fraction [0.0-1.0] + real , intent(out) :: albedo !surface albedo [-] + real :: errwat !water error [kg m{-2}] + real , intent(out) :: qsnbot !snowmelt out bottom of pack [mm/s] + real , intent(out) :: ponding!surface ponding [mm] + real , intent(out) :: ponding1!surface ponding [mm] + real , intent(out) :: ponding2!surface ponding [mm] + real , intent(out) :: esnow + +!jref:start; output + real , intent(out) :: t2mv !2-m air temperature over vegetated part [k] + real , intent(out) :: t2mb !2-m air temperature over bare ground part [k] + real, intent(out) :: rssun !sunlit leaf stomatal resistance (s/m) + real, intent(out) :: rssha !shaded leaf stomatal resistance (s/m) + real, intent(out) :: bgap + real, intent(out) :: wgap + real, intent(out) :: tgv + real, intent(out) :: tgb + real :: q1 + real, intent(out) :: emissi +!jref:end +#ifdef CCPP + character(len=*), intent(inout) :: errmsg + integer, intent(inout) :: errflg +#endif + +! local + integer :: iz !do-loop index + integer, dimension(-nsnow+1:nsoil) :: imelt !phase change index [1-melt; 2-freeze] + real :: cmc !intercepted water (canice+canliq) (mm) + real :: taux !wind stress: e-w (n/m2) + real :: tauy !wind stress: n-s (n/m2) + real :: rhoair !density air (kg/m3) + real :: fsh !total sensible heat (w/m2) [+ to atm] +! real, dimension( 1: 5) :: vocflx !voc fluxes [ug c m-2 h-1] + real, dimension(-nsnow+1:nsoil) :: dzsnso !snow/soil layer thickness [m] + real :: thair !potential temperature (k) + real :: qair !specific humidity (kg/kg) (q2/(1+q2)) + real :: eair !vapor pressure air (pa) + real, dimension( 1: 2) :: solad !incoming direct solar rad (w/m2) + real, dimension( 1: 2) :: solai !incoming diffuse solar rad (w/m2) + real :: qprecc !convective precipitation (mm/s) + real :: qprecl !large-scale precipitation (mm/s) + real :: igs !growing season index (0=off, 1=on) + real :: elai !leaf area index, after burying by snow + real :: esai !stem area index, after burying by snow + real :: bevap !soil water evaporation factor (0 - 1) + real, dimension( 1:nsoil) :: btrani !soil water transpiration factor (0 - 1) + real :: btran !soil water transpiration factor (0 - 1) + real :: qin !groundwater recharge [mm/s] + real :: qdis !groundwater discharge [mm/s] + real, dimension( 1:nsoil) :: sice !soil ice content (m3/m3) + real, dimension(-nsnow+1: 0) :: snicev !partial volume ice of snow [m3/m3] + real, dimension(-nsnow+1: 0) :: snliqv !partial volume liq of snow [m3/m3] + real, dimension(-nsnow+1: 0) :: epore !effective porosity [m3/m3] + real :: totsc !total soil carbon (g/m2) + real :: totlb !total living carbon (g/m2) + real :: t2m !2-meter air temperature (k) + real :: qdew !ground surface dew rate [mm/s] + real :: qvap !ground surface evap. rate [mm/s] + real :: lathea !latent heat [j/kg] + real :: swdown !downward solar [w/m2] + real :: qmelt !snowmelt [mm/s] + real :: beg_wb !water storage at begin of a step [mm] + real,intent(out) :: irc !canopy net lw rad. [w/m2] [+ to atm] + real,intent(out) :: irg !ground net lw rad. [w/m2] [+ to atm] + real,intent(out) :: shc !canopy sen. heat [w/m2] [+ to atm] + real,intent(out) :: shg !ground sen. heat [w/m2] [+ to atm] + real,intent(out) :: evg !ground evap. heat [w/m2] [+ to atm] + real,intent(out) :: ghv !ground heat flux [w/m2] [+ to soil] + real,intent(out) :: irb !net longwave rad. [w/m2] [+ to atm] + real,intent(out) :: shb !sensible heat [w/m2] [+ to atm] + real,intent(out) :: evb !evaporation heat [w/m2] [+ to atm] + real,intent(out) :: ghb !ground heat flux [w/m2] [+ to soil] + real,intent(out) :: evc !canopy evap. heat [w/m2] [+ to atm] + real,intent(out) :: tr !transpiration heat [w/m2] [+ to atm] + real, intent(out) :: fpice !snow fraction in precipitation + real, intent(out) :: pahv !precipitation advected heat - vegetation net (w/m2) + real, intent(out) :: pahg !precipitation advected heat - under canopy net (w/m2) + real, intent(out) :: pahb !precipitation advected heat - bare ground net (w/m2) + real, intent(out) :: pah !precipitation advected heat - total (w/m2) + +!jref:start + real :: fsrv + real :: fsrg + real,intent(out) :: q2v + real,intent(out) :: q2b + real :: q2e + real :: qfx + real,intent(out) :: chv !sensible heat exchange coefficient over vegetated fraction + real,intent(out) :: chb !sensible heat exchange coefficient over bare-ground + real,intent(out) :: chleaf !leaf exchange coefficient + real,intent(out) :: chuc !under canopy exchange coefficient + real,intent(out) :: chv2 !sensible heat exchange coefficient over vegetated fraction + real,intent(out) :: chb2 !sensible heat exchange coefficient over bare-ground +!jref:end + +! carbon +! inputs + real , intent(in) :: co2air !atmospheric co2 concentration (pa) + real , intent(in) :: o2air !atmospheric o2 concentration (pa) + +! inputs and outputs : prognostic variables + real , intent(inout) :: lfmass !leaf mass [g/m2] + real , intent(inout) :: rtmass !mass of fine roots [g/m2] + real , intent(inout) :: stmass !stem mass [g/m2] + real , intent(inout) :: wood !mass of wood (incl. woody roots) [g/m2] + real , intent(inout) :: stblcp !stable carbon in deep soil [g/m2] + real , intent(inout) :: fastcp !short-lived carbon, shallow soil [g/m2] + real , intent(inout) :: lai !leaf area index [-] + real , intent(inout) :: sai !stem area index [-] + +! outputs + real , intent(out) :: nee !net ecosys exchange (g/m2/s co2) + real , intent(out) :: gpp !net instantaneous assimilation [g/m2/s c] + real , intent(out) :: npp !net primary productivity [g/m2/s c] + real :: autors !net ecosystem respiration (g/m2/s c) + real :: heters !organic respiration (g/m2/s c) + real :: troot !root-zone averaged temperature (k) + real :: bdfall !bulk density of new snow (kg/m3) ! mb/an: v3.7 + real :: rain !rain rate (mm/s) ! mb/an: v3.7 + real :: snow !liquid equivalent snow rate (mm/s) ! mb/an: v3.7 + real :: fp ! mb/an: v3.7 + real :: prcp ! mb/an: v3.7 +!more local variables for precip heat mb + real :: qintr !interception rate for rain (mm/s) + real :: qdripr !drip rate for rain (mm/s) + real :: qthror !throughfall for rain (mm/s) + real :: qints !interception (loading) rate for snowfall (mm/s) + real :: qdrips !drip (unloading) rate for intercepted snow (mm/s) + real :: qthros !throughfall of snowfall (mm/s) + real :: qrain !rain at ground srf (mm/s) [+] + real :: snowhin !snow depth increasing rate (m/s) + real :: latheav !latent heat vap./sublimation (j/kg) + real :: latheag !latent heat vap./sublimation (j/kg) + logical :: frozen_ground ! used to define latent heat pathway + logical :: frozen_canopy ! used to define latent heat pathway + + ! intent (out) variables need to be assigned a value. these normally get assigned values + ! only if dveg == 2. + nee = 0.0 + npp = 0.0 + gpp = 0.0 + pahv = 0. + pahg = 0. + pahb = 0. + pah = 0. + +! -------------------------------------------------------------------------------------------------- +! re-process atmospheric forcing + + call atm (parameters,sfcprs ,sfctmp ,q2 , & + prcpconv, prcpnonc,prcpshcv,prcpsnow,prcpgrpl,prcphail, & + soldn ,cosz ,thair ,qair , & + eair ,rhoair ,qprecc ,qprecl ,solad ,solai , & + swdown ,bdfall ,rain ,snow ,fp ,fpice , prcp ) + +! snow/soil layer thickness (m) + + do iz = isnow+1, nsoil + if(iz == isnow+1) then + dzsnso(iz) = - zsnso(iz) + else + dzsnso(iz) = zsnso(iz-1) - zsnso(iz) + end if + end do + +! root-zone temperature + + troot = 0. + do iz=1,parameters%nroot + troot = troot + stc(iz)*dzsnso(iz)/(-zsoil(parameters%nroot)) + enddo + +! total water storage for water balance check + + if(ist == 1) then + beg_wb = canliq + canice + sneqv + wa + do iz = 1,nsoil + beg_wb = beg_wb + smc(iz) * dzsnso(iz) * 1000. + end do + end if + +! vegetation phenology + + call phenology (parameters,vegtyp , snowh , tv , lat , yearlen , julian , & !in + lai , sai , troot , elai , esai ,igs) + +!input gvf should be consistent with lai + if(dveg == 1) then + fveg = shdfac + if(fveg <= 0.05) fveg = 0.05 + else if (dveg == 2 .or. dveg == 3) then + fveg = 1.-exp(-0.52*(lai+sai)) + if(fveg <= 0.05) fveg = 0.05 + else if (dveg == 4 .or. dveg == 5) then + fveg = shdmax + if(fveg <= 0.05) fveg = 0.05 + else + write(*,*) "-------- fatal called in sflx -----------" +#ifdef CCPP + errflg = 1 + errmsg = "namelist parameter dveg unknown" + return +#else + call wrf_error_fatal("namelist parameter dveg unknown") +#endif + endif + if(parameters%urban_flag .or. vegtyp == parameters%isbarren) fveg = 0.0 + if(elai+esai == 0.0) fveg = 0.0 + + call precip_heat(parameters,iloc ,jloc ,vegtyp ,dt ,uu ,vv , & !in + elai ,esai ,fveg ,ist , & !in + bdfall ,rain ,snow ,fp , & !in + canliq ,canice ,tv ,sfctmp ,tg , & !in + qintr ,qdripr ,qthror ,qints ,qdrips ,qthros , & !out + pahv ,pahg ,pahb ,qrain ,qsnow ,snowhin, & !out + fwet ,cmc ) !out + +! compute energy budget (momentum & energy fluxes and phase changes) + + call energy (parameters,ice ,vegtyp ,ist ,nsnow ,nsoil , & !in + isnow ,dt ,rhoair ,sfcprs ,qair , & !in + sfctmp ,thair ,lwdn ,uu ,vv ,zlvl , & !in + lheatstrg , & !in + co2air ,o2air ,solad ,solai ,cosz ,igs , & !in + eair ,tbot ,zsnso ,zsoil , & !in + elai ,esai ,fwet ,foln , & !in + fveg ,pahv ,pahg ,pahb , & !in + qsnow ,dzsnso ,lat ,canliq ,canice ,iloc, jloc , & !in + z0wrf , & + imelt ,snicev ,snliqv ,epore ,t2m ,fsno , & !out + sav ,sag ,qmelt ,fsa ,fsr ,taux , & !out + tauy ,fira ,fsh ,fshx ,fcev ,fgev ,fctr , & !out + trad ,psn ,apar ,ssoil ,btrani ,btran , & !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 +#ifdef CCPP + tauss ,cpfac ,errmsg ,errflg , & !inout +#else + tauss ,cpfac , & !inout +#endif +!jref:start + qc ,qsfc ,psfc , & !in + t2mv ,t2mb ,fsrv , & + fsrg ,rssun ,rssha ,bgap ,wgap, tgv,tgb,& + 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 +!jref:end +#ifdef CCPP + if (errflg /= 0) return +#endif + sice(:) = max(0.0, smc(:) - sh2o(:)) + sneqvo = sneqv + + qvap = max( fgev/latheag, 0.) ! positive part of fgev; barlage change to ground v3.6 + qdew = abs( min(fgev/latheag, 0.)) ! negative part of fgev + edir = qvap - qdew + +! compute water budgets (water storages, et components, and runoff) + + call water (parameters,vegtyp ,nsnow ,nsoil ,imelt ,dt ,uu , & !in + vv ,fcev ,fctr ,qprecc ,qprecl ,elai , & !in + esai ,sfctmp ,qvap ,qdew ,zsoil ,btrani , & !in + ficeold,ponding,tg ,ist ,fveg ,iloc,jloc , smceq , & !in + bdfall ,fp ,rain ,snow , & !in mb/an: v3.7 + qsnow ,qrain ,snowhin,latheav,latheag,frozen_canopy,frozen_ground, & !in mb + isnow ,canliq ,canice ,tv ,snowh ,sneqv , & !inout + snice ,snliq ,stc ,zsnso ,sh2o ,smc , & !inout + sice ,zwt ,wa ,wt ,dzsnso ,wslake , & !inout + smcwtd ,deeprech,rech , & !inout + cmc ,ecan ,etran ,fwet ,runsrf ,runsub , & !out + qin ,qdis ,ponding1 ,ponding2,& + qsnbot ,esnow ) !out + +! write(*,'(a20,10f15.5)') 'sflx:runoff=',runsrf*dt,runsub*dt,edir*dt + +! compute carbon budgets (carbon storages and co2 & bvoc fluxes) + + if (dveg == 2 .or. dveg == 5) then + call carbon (parameters,nsnow ,nsoil ,vegtyp ,dt ,zsoil , & !in + dzsnso ,stc ,smc ,tv ,tg ,psn , & !in + foln ,btran ,apar ,fveg ,igs , & !in + troot ,ist ,lat ,iloc ,jloc , & !in + lfmass ,rtmass ,stmass ,wood ,stblcp ,fastcp , & !inout + gpp ,npp ,nee ,autors ,heters ,totsc , & !out + totlb ,lai ,sai ) !out + end if + +! water and energy balance check + + call error (parameters,swdown ,fsa ,fsr ,fira ,fsh ,fcev , & !in + fgev ,fctr ,ssoil ,beg_wb ,canliq ,canice , & !in + sneqv ,wa ,smc ,dzsnso ,prcp ,ecan , & !in + etran ,edir ,runsrf ,runsub ,dt ,nsoil , & !in + nsnow ,ist ,errwat ,iloc , jloc ,fveg , & + sav ,sag ,fsrv ,fsrg ,zwt ,pah , & +#ifdef CCPP + pahv ,pahg ,pahb ,errmsg, errflg) !in ( except errwat [out] and errmsg, errflg [inout] ) +#else + pahv ,pahg ,pahb ) !in ( except errwat, which is out ) +#endif + +#ifdef CCPP + if (errflg /= 0) return +#endif + +! urban - jref + qfx = etran + ecan + edir + if ( parameters%urban_flag ) then + qsfc = (qfx/rhoair*ch) + qair + q2b = qsfc + end if + + if(snowh <= 1.e-6 .or. sneqv <= 1.e-3) then + snowh = 0.0 + sneqv = 0.0 + end if + + if(swdown.ne.0.) then + albedo = fsr / swdown + else + albedo = -999.9 + end if + + + end subroutine noahmp_sflx + +!== begin atm ====================================================================================== + +!>\ingroup NoahMP_LSM + subroutine atm (parameters,sfcprs ,sfctmp ,q2 , & + prcpconv,prcpnonc ,prcpshcv,prcpsnow,prcpgrpl,prcphail , & + soldn ,cosz ,thair ,qair , & + eair ,rhoair ,qprecc ,qprecl ,solad , solai , & + swdown ,bdfall ,rain ,snow ,fp , fpice ,prcp ) +! -------------------------------------------------------------------------------------------------- +! re-process atmospheric forcing +! ---------------------------------------------------------------------- + implicit none +! -------------------------------------------------------------------------------------------------- +! inputs + + type (noahmp_parameters), intent(in) :: parameters + real , intent(in) :: sfcprs !pressure (pa) + real , intent(in) :: sfctmp !surface air temperature [k] + real , intent(in) :: q2 !mixing ratio (kg/kg) + real , intent(in) :: prcpconv ! convective precipitation entering [mm/s] ! mb/an : v3.7 + real , intent(in) :: prcpnonc ! non-convective precipitation entering [mm/s] ! mb/an : v3.7 + real , intent(in) :: prcpshcv ! shallow convective precip entering [mm/s] ! mb/an : v3.7 + real , intent(in) :: prcpsnow ! snow entering land model [mm/s] ! mb/an : v3.7 + real , intent(in) :: prcpgrpl ! graupel entering land model [mm/s] ! mb/an : v3.7 + real , intent(in) :: prcphail ! hail entering land model [mm/s] ! mb/an : v3.7 + real , intent(in) :: soldn !downward shortwave radiation (w/m2) + real , intent(in) :: cosz !cosine solar zenith angle [0-1] + +! outputs + + real , intent(out) :: thair !potential temperature (k) + real , intent(out) :: qair !specific humidity (kg/kg) (q2/(1+q2)) + real , intent(out) :: eair !vapor pressure air (pa) + real , intent(out) :: rhoair !density air (kg/m3) + real , intent(out) :: qprecc !convective precipitation (mm/s) + real , intent(out) :: qprecl !large-scale precipitation (mm/s) + real, dimension( 1: 2), intent(out) :: solad !incoming direct solar radiation (w/m2) + real, dimension( 1: 2), intent(out) :: solai !incoming diffuse solar radiation (w/m2) + real , intent(out) :: swdown !downward solar filtered by sun angle [w/m2] + real , intent(out) :: bdfall !!bulk density of snowfall (kg/m3) ajn + real , intent(out) :: rain !rainfall (mm/s) ajn + real , intent(out) :: snow !liquid equivalent snowfall (mm/s) ajn + real , intent(out) :: fp !fraction of area receiving precipitation ajn + real , intent(out) :: fpice !fraction of ice ajn + real , intent(out) :: prcp !total precipitation [mm/s] ! mb/an : v3.7 + +!locals + + real :: pair !atm bottom level pressure (pa) + real :: prcp_frozen !total frozen precipitation [mm/s] ! mb/an : v3.7 + real, parameter :: rho_grpl = 500.0 ! graupel bulk density [kg/m3] ! mb/an : v3.7 + real, parameter :: rho_hail = 917.0 ! hail bulk density [kg/m3] ! mb/an : v3.7 +! -------------------------------------------------------------------------------------------------- + +!jref: seems like pair should be p1000mb?? + pair = sfcprs ! atm bottom level pressure (pa) + thair = sfctmp * (sfcprs/pair)**(rair/cpair) + + qair = q2 ! in wrf, driver converts to specific humidity + + eair = qair*sfcprs / (0.622+0.378*qair) + rhoair = (sfcprs-0.378*eair) / (rair*sfctmp) + + if(cosz <= 0.) then + swdown = 0. + else + swdown = soldn + end if + + solad(1) = swdown*0.7*0.5 ! direct vis + solad(2) = swdown*0.7*0.5 ! direct nir + solai(1) = swdown*0.3*0.5 ! diffuse vis + solai(2) = swdown*0.3*0.5 ! diffuse nir + + prcp = prcpconv + prcpnonc + prcpshcv + +! if(opt_snf == 4) then + qprecc = prcpconv + prcpshcv + qprecl = prcpnonc +! else +! qprecc = 0.10 * prcp ! should be from the atmospheric model +! qprecl = 0.90 * prcp ! should be from the atmospheric model +! end if + +! fractional area that receives precipitation (see, niu et al. 2005) + + fp = 0.0 + if(qprecc + qprecl > 0.) & + fp = (qprecc + qprecl) / (10.*qprecc + qprecl) + +! partition precipitation into rain and snow. moved from canwat mb/an: v3.7 + +! jordan (1991) + + if(opt_snf == 1) then + if(sfctmp > tfrz+2.5)then + fpice = 0. + else + if(sfctmp <= tfrz+0.5)then + fpice = 1.0 + else if(sfctmp <= tfrz+2.)then + fpice = 1.-(-54.632 + 0.2*sfctmp) + else + fpice = 0.6 + endif + endif + endif + + if(opt_snf == 2) then + if(sfctmp >= tfrz+2.2) then + fpice = 0. + else + fpice = 1.0 + endif + endif + + if(opt_snf == 3) then + if(sfctmp >= tfrz) then + fpice = 0. + else + fpice = 1.0 + endif + endif + +! hedstrom nr and jw pomeroy (1998), hydrol. processes, 12, 1611-1625 +! fresh snow density + + bdfall = min(120.,67.92+51.25*exp((sfctmp-tfrz)/2.59)) !mb/an: change to min + if(opt_snf == 4) then + prcp_frozen = prcpsnow + prcpgrpl + prcphail + if(prcpnonc > 0. .and. prcp_frozen > 0.) then + fpice = min(1.0,prcp_frozen/prcp) + fpice = max(0.0,fpice) + bdfall = bdfall*(prcpsnow/prcp_frozen) + rho_grpl*(prcpgrpl/prcp_frozen) + & + rho_hail*(prcphail/prcp_frozen) + else + fpice = 0.0 + endif + + endif + + rain = prcp * (1.-fpice) + snow = prcp * fpice + + + end subroutine atm + +!== begin phenology ================================================================================ + +!>\ingroup NoahMP_LSM + subroutine phenology (parameters,vegtyp , snowh , tv , lat , yearlen , julian , & !in + lai , sai , troot , elai , esai , igs) + +! -------------------------------------------------------------------------------------------------- +! vegetation phenology considering vegeation canopy being buries by snow and evolution in time +! -------------------------------------------------------------------------------------------------- + implicit none +! -------------------------------------------------------------------------------------------------- +! inputs + type (noahmp_parameters), intent(in) :: parameters + integer , intent(in ) :: vegtyp !vegetation type + real , intent(in ) :: snowh !snow height [m] + real , intent(in ) :: tv !vegetation temperature (k) + real , intent(in ) :: lat !latitude (radians) + integer , intent(in ) :: yearlen!number of days in the particular year + real , intent(in ) :: julian !julian day of year (fractional) ( 0 <= julian < yearlen ) + real , intent(in ) :: troot !root-zone averaged temperature (k) + real , intent(inout) :: lai !lai, unadjusted for burying by snow + real , intent(inout) :: sai !sai, unadjusted for burying by snow + +! outputs + real , intent(out ) :: elai !leaf area index, after burying by snow + real , intent(out ) :: esai !stem area index, after burying by snow + real , intent(out ) :: igs !growing season index (0=off, 1=on) + +! locals + + real :: db !thickness of canopy buried by snow (m) + real :: fb !fraction of canopy buried by snow + real :: snowhc !critical snow depth at which short vege + !is fully covered by snow + + integer :: k !index + integer :: it1,it2 !interpolation months + real :: day !current day of year ( 0 <= day < yearlen ) + real :: wt1,wt2 !interpolation weights + real :: t !current month (1.00, ..., 12.00) +! -------------------------------------------------------------------------------------------------- + + if ( dveg == 1 .or. dveg == 3 .or. dveg == 4 ) then + + if (lat >= 0.) then + ! northern hemisphere + day = julian + else + ! southern hemisphere. day is shifted by 1/2 year. + day = mod ( julian + ( 0.5 * yearlen ) , real(yearlen) ) + endif + + t = 12. * day / real(yearlen) + it1 = t + 0.5 + it2 = it1 + 1 + wt1 = (it1+0.5) - t + wt2 = 1.-wt1 + if (it1 .lt. 1) it1 = 12 + if (it2 .gt. 12) it2 = 1 + + lai = wt1*parameters%laim(it1) + wt2*parameters%laim(it2) + sai = wt1*parameters%saim(it1) + wt2*parameters%saim(it2) + endif + if (sai < 0.05) sai = 0.0 ! mb: sai check, change to 0.05 v3.6 + if (lai < 0.05 .or. sai == 0.0) lai = 0.0 ! mb: lai check + + if ( ( vegtyp == parameters%iswater ) .or. ( vegtyp == parameters%isbarren ) .or. & + ( vegtyp == parameters%isice ) .or. ( parameters%urban_flag ) ) then + lai = 0. + sai = 0. + endif + +!buried by snow + + db = min( max(snowh - parameters%hvb,0.), parameters%hvt-parameters%hvb ) + fb = db / max(1.e-06,parameters%hvt-parameters%hvb) + + if(parameters%hvt> 0. .and. parameters%hvt <= 1.0) then !mb: change to 1.0 and 0.2 to reflect + snowhc = parameters%hvt*exp(-snowh/0.2) ! changes to hvt in mptable + fb = min(snowh,snowhc)/snowhc + endif + + elai = lai*(1.-fb) + esai = sai*(1.-fb) + if (esai < 0.05) esai = 0.0 ! mb: esai check, change to 0.05 v3.6 + if (elai < 0.05 .or. esai == 0.0) elai = 0.0 ! mb: lai check + + if (tv .gt. parameters%tmin) then + igs = 1. + else + igs = 0. + endif + + end subroutine phenology + +!== begin precip_heat ============================================================================== + +!>\ingroup NoahMP_LSM + subroutine precip_heat (parameters,iloc ,jloc ,vegtyp ,dt ,uu ,vv , & !in + elai ,esai ,fveg ,ist , & !in + bdfall ,rain ,snow ,fp , & !in + canliq ,canice ,tv ,sfctmp ,tg , & !in + qintr ,qdripr ,qthror ,qints ,qdrips ,qthros , & !out + pahv ,pahg ,pahb ,qrain ,qsnow ,snowhin, & !out + fwet ,cmc ) !out + +! ------------------------ code history ------------------------------ +! michael barlage: oct 2013 - split canwater to calculate precip movement for +! tracking of advected heat +! -------------------------------------------------------------------------------------------------- + implicit none +! ------------------------ input/output variables -------------------- +! input + type (noahmp_parameters), intent(in) :: parameters + integer,intent(in) :: iloc !grid index + integer,intent(in) :: jloc !grid index + integer,intent(in) :: vegtyp !vegetation type + integer,intent(in) :: ist !surface type 1-soil; 2-lake + real, intent(in) :: dt !main time step (s) + real, intent(in) :: uu !u-direction wind speed [m/s] + real, intent(in) :: vv !v-direction wind speed [m/s] + real, intent(in) :: elai !leaf area index, after burying by snow + real, intent(in) :: esai !stem area index, after burying by snow + real, intent(in) :: fveg !greeness vegetation fraction (-) + real, intent(in) :: bdfall !bulk density of snowfall (kg/m3) + real, intent(in) :: rain !rainfall (mm/s) + real, intent(in) :: snow !snowfall (mm/s) + real, intent(in) :: fp !fraction of the gridcell that receives precipitation + real, intent(in) :: tv !vegetation temperature (k) + real, intent(in) :: sfctmp !model-level temperature (k) + real, intent(in) :: tg !ground temperature (k) + +! input & output + real, intent(inout) :: canliq !intercepted liquid water (mm) + real, intent(inout) :: canice !intercepted ice mass (mm) + +! output + real, intent(out) :: qintr !interception rate for rain (mm/s) + real, intent(out) :: qdripr !drip rate for rain (mm/s) + real, intent(out) :: qthror !throughfall for rain (mm/s) + real, intent(out) :: qints !interception (loading) rate for snowfall (mm/s) + real, intent(out) :: qdrips !drip (unloading) rate for intercepted snow (mm/s) + real, intent(out) :: qthros !throughfall of snowfall (mm/s) + real, intent(out) :: pahv !precipitation advected heat - vegetation net (w/m2) + real, intent(out) :: pahg !precipitation advected heat - under canopy net (w/m2) + real, intent(out) :: pahb !precipitation advected heat - bare ground net (w/m2) + real, intent(out) :: qrain !rain at ground srf (mm/s) [+] + real, intent(out) :: qsnow !snow at ground srf (mm/s) [+] + real, intent(out) :: snowhin !snow depth increasing rate (m/s) + real, intent(out) :: fwet !wetted or snowed fraction of the canopy (-) + real, intent(out) :: cmc !intercepted water (mm) +! -------------------------------------------------------------------- + +! ------------------------ local variables --------------------------- + real :: maxsno !canopy capacity for snow interception (mm) + real :: maxliq !canopy capacity for rain interception (mm) + real :: ft !temperature factor for unloading rate + real :: fv !wind factor for unloading rate + real :: pah_ac !precipitation advected heat - air to canopy (w/m2) + real :: pah_cg !precipitation advected heat - canopy to ground (w/m2) + real :: pah_ag !precipitation advected heat - air to ground (w/m2) + real :: icedrip !canice unloading +! -------------------------------------------------------------------- +! initialization + + qintr = 0. + qdripr = 0. + qthror = 0. + qintr = 0. + qints = 0. + qdrips = 0. + qthros = 0. + pah_ac = 0. + pah_cg = 0. + pah_ag = 0. + pahv = 0. + pahg = 0. + pahb = 0. + qrain = 0.0 + qsnow = 0.0 + snowhin = 0.0 + icedrip = 0.0 +! print*, "precip_heat begin canopy balance:",canliq+canice+(rain+snow)*dt +! print*, "precip_heat snow*3600.0:",snow*3600.0 +! print*, "precip_heat rain*3600.0:",rain*3600.0 +! print*, "precip_heat canice:",canice +! print*, "precip_heat canliq:",canliq + +! --------------------------- liquid water ------------------------------ +! maximum canopy water + + maxliq = parameters%ch2op * (elai+ esai) + +! average interception and throughfall + + if((elai+ esai).gt.0.) then + qintr = fveg * rain * fp ! interception capability + qintr = min(qintr, (maxliq - canliq)/dt * (1.-exp(-rain*dt/maxliq)) ) + qintr = max(qintr, 0.) + qdripr = fveg * rain - qintr + qthror = (1.-fveg) * rain + canliq=max(0.,canliq+qintr*dt) + else + qintr = 0. + qdripr = 0. + qthror = rain + if(canliq > 0.) then ! for case of canopy getting buried + qdripr = qdripr + canliq/dt + canliq = 0.0 + end if + end if + +! heat transported by liquid water + + pah_ac = fveg * rain * (cwat/1000.0) * (sfctmp - tv) + pah_cg = qdripr * (cwat/1000.0) * (tv - tg) + pah_ag = qthror * (cwat/1000.0) * (sfctmp - tg) +! print*, "precip_heat pah_ac:",pah_ac +! print*, "precip_heat pah_cg:",pah_cg +! print*, "precip_heat pah_ag:",pah_ag + +! --------------------------- canopy ice ------------------------------ +! for canopy ice + + maxsno = 6.6*(0.27+46./bdfall) * (elai+ esai) + + if((elai+ esai).gt.0.) then + qints = fveg * snow * fp + qints = min(qints, (maxsno - canice)/dt * (1.-exp(-snow*dt/maxsno)) ) + qints = max(qints, 0.) + ft = max(0.0,(tv - 270.15) / 1.87e5) + fv = sqrt(uu*uu + vv*vv) / 1.56e5 + ! mb: changed below to reflect the rain assumption that all precip gets intercepted + icedrip = max(0.,canice) * (fv+ft) !mb: removed /dt + qdrips = (fveg * snow - qints) + icedrip + qthros = (1.0-fveg) * snow + canice= max(0.,canice + (qints - icedrip)*dt) + else + qints = 0. + qdrips = 0. + qthros = snow + if(canice > 0.) then ! for case of canopy getting buried + qdrips = qdrips + canice/dt + canice = 0.0 + end if + endif +! print*, "precip_heat canopy through:",3600.0*(fveg * snow - qints) +! print*, "precip_heat canopy drip:",3600.0*max(0.,canice) * (fv+ft) + +! wetted fraction of canopy + + if(canice.gt.0.) then + fwet = max(0.,canice) / max(maxsno,1.e-06) + else + fwet = max(0.,canliq) / max(maxliq,1.e-06) + endif + fwet = min(fwet, 1.) ** 0.667 + +! total canopy water + + cmc = canliq + canice + +! heat transported by snow/ice + + pah_ac = pah_ac + fveg * snow * (cice/1000.0) * (sfctmp - tv) + pah_cg = pah_cg + qdrips * (cice/1000.0) * (tv - tg) + pah_ag = pah_ag + qthros * (cice/1000.0) * (sfctmp - tg) + + pahv = pah_ac - pah_cg + pahg = pah_cg + pahb = pah_ag + + if (fveg > 0.0 .and. fveg < 1.0) then + pahg = pahg / fveg ! these will be multiplied by fraction later + pahb = pahb / (1.0-fveg) + elseif (fveg <= 0.0) then + pahb = pahg + pahb ! for case of canopy getting buried + pahg = 0.0 + pahv = 0.0 + elseif (fveg >= 1.0) then + pahb = 0.0 + end if + + pahv = max(pahv,-20.0) ! put some artificial limits here for stability + pahv = min(pahv,20.0) + pahg = max(pahg,-20.0) + pahg = min(pahg,20.0) + pahb = max(pahb,-20.0) + pahb = min(pahb,20.0) + +! print*, 'precip_heat sfctmp,tv,tg:',sfctmp,tv,tg +! print*, 'precip_heat 3600.0*qints+qdrips+qthros:',3600.0*(qints+qdrips+qthros) +! print*, "precip_heat maxsno:",maxsno +! print*, "precip_heat pah_ac:",pah_ac +! print*, "precip_heat pah_cg:",pah_cg +! print*, "precip_heat pah_ag:",pah_ag + +! print*, "precip_heat pahv:",pahv +! print*, "precip_heat pahg:",pahg +! print*, "precip_heat pahb:",pahb +! print*, "precip_heat fveg:",fveg +! print*, "precip_heat qints*3600.0:",qints*3600.0 +! print*, "precip_heat qdrips*3600.0:",qdrips*3600.0 +! print*, "precip_heat qthros*3600.0:",qthros*3600.0 + +! rain or snow on the ground + + qrain = qdripr + qthror + qsnow = qdrips + qthros + snowhin = qsnow/bdfall + + if (ist == 2 .and. tg > tfrz) then + qsnow = 0. + snowhin = 0. + end if +! print*, "precip_heat qsnow*3600.0:",qsnow*3600.0 +! print*, "precip_heat qrain*3600.0:",qrain*3600.0 +! print*, "precip_heat snowhin:",snowhin +! print*, "precip_heat canice:",canice +! print*, "precip_heat canliq:",canliq +! print*, "precip_heat end canopy balance:",canliq+canice+(qrain+qsnow)*dt + + + end subroutine precip_heat + +!== begin error ==================================================================================== + +!>\ingroup NoahMP_LSM + subroutine error (parameters,swdown ,fsa ,fsr ,fira ,fsh ,fcev , & + fgev ,fctr ,ssoil ,beg_wb ,canliq ,canice , & + sneqv ,wa ,smc ,dzsnso ,prcp ,ecan , & + etran ,edir ,runsrf ,runsub ,dt ,nsoil , & + nsnow ,ist ,errwat, iloc ,jloc ,fveg , & + sav ,sag ,fsrv ,fsrg ,zwt ,pah , & +#ifdef CCPP + pahv ,pahg ,pahb ,errmsg, errflg) +#else + pahv ,pahg ,pahb ) +#endif +! -------------------------------------------------------------------------------------------------- +! check surface energy balance and water balance +! -------------------------------------------------------------------------------------------------- + implicit none +! -------------------------------------------------------------------------------------------------- +! inputs + type (noahmp_parameters), intent(in) :: parameters + integer , intent(in) :: nsnow !maximum no. of snow layers + integer , intent(in) :: nsoil !number of soil layers + integer , intent(in) :: ist !surface type 1->soil; 2->lake + integer , intent(in) :: iloc !grid index + integer , intent(in) :: jloc !grid index + real , intent(in) :: swdown !downward solar filtered by sun angle [w/m2] + real , intent(in) :: fsa !total absorbed solar radiation (w/m2) + real , intent(in) :: fsr !total reflected solar radiation (w/m2) + real , intent(in) :: fira !total net longwave rad (w/m2) [+ to atm] + real , intent(in) :: fsh !total sensible heat (w/m2) [+ to atm] + real , intent(in) :: fcev !canopy evaporation heat (w/m2) [+ to atm] + real , intent(in) :: fgev !ground evaporation heat (w/m2) [+ to atm] + real , intent(in) :: fctr !transpiration heat flux (w/m2) [+ to atm] + real , intent(in) :: ssoil !ground heat flux (w/m2) [+ to soil] + real , intent(in) :: fveg + real , intent(in) :: sav + real , intent(in) :: sag + real , intent(in) :: fsrv + real , intent(in) :: fsrg + real , intent(in) :: zwt + + real , intent(in) :: prcp !precipitation rate (kg m-2 s-1) + real , intent(in) :: ecan !evaporation of intercepted water (mm/s) + real , intent(in) :: etran !transpiration rate (mm/s) + real , intent(in) :: edir !soil surface evaporation rate[mm/s] + real , intent(in) :: runsrf !surface runoff [mm/s] + real , intent(in) :: runsub !baseflow (saturation excess) [mm/s] + real , intent(in) :: canliq !intercepted liquid water (mm) + real , intent(in) :: canice !intercepted ice mass (mm) + real , intent(in) :: sneqv !snow water eqv. [mm] + real, dimension( 1:nsoil), intent(in) :: smc !soil moisture (ice + liq.) [m3/m3] + real, dimension(-nsnow+1:nsoil), intent(in) :: dzsnso !snow/soil layer thickness [m] + real , intent(in) :: wa !water storage in aquifer [mm] + real , intent(in) :: dt !time step [sec] + real , intent(in) :: beg_wb !water storage at begin of a timesetp [mm] + real , intent(out) :: errwat !error in water balance [mm/timestep] + real, intent(in) :: pah !precipitation advected heat - total (w/m2) + real, intent(in) :: pahv !precipitation advected heat - total (w/m2) + real, intent(in) :: pahg !precipitation advected heat - total (w/m2) + real, intent(in) :: pahb !precipitation advected heat - total (w/m2) + +#ifdef CCPP + character(len=*) , intent(inout) :: errmsg + integer , intent(inout) :: errflg +#endif + + integer :: iz !do-loop index + real :: end_wb !water storage at end of a timestep [mm] + !kwm real :: errwat !error in water balance [mm/timestep] + real :: erreng !error in surface energy balance [w/m2] + real :: errsw !error in shortwave radiation balance [w/m2] + real :: fsrvg + character(len=256) :: message +! -------------------------------------------------------------------------------------------------- +!jref:start + errsw = swdown - (fsa + fsr) +! errsw = swdown - (sav+sag + fsrv+fsrg) +! write(*,*) "errsw =",errsw + if (abs(errsw) > 0.01) then ! w/m2 + write(*,*) "vegetation!" + write(*,*) "swdown*fveg =",swdown*fveg + write(*,*) "fveg*(sav+sag) =",fveg*sav + sag + write(*,*) "fveg*(fsrv +fsrg)=",fveg*fsrv + fsrg + write(*,*) "ground!" + write(*,*) "(1-.fveg)*swdown =",(1.-fveg)*swdown + write(*,*) "(1.-fveg)*sag =",(1.-fveg)*sag + write(*,*) "(1.-fveg)*fsrg=",(1.-fveg)*fsrg + write(*,*) "fsrv =",fsrv + write(*,*) "fsrg =",fsrg + write(*,*) "fsr =",fsr + write(*,*) "sav =",sav + write(*,*) "sag =",sag + write(*,*) "fsa =",fsa +!jref:end + write(message,*) 'errsw =',errsw +#ifdef CCPP + errflg = 1 + errmsg = trim(message)//NEW_LINE('A')//"stop in noah-mp" + return +#else + call wrf_message(trim(message)) + call wrf_error_fatal("stop in noah-mp") +#endif + end if + + erreng = sav+sag-(fira+fsh+fcev+fgev+fctr+ssoil) +pah +! erreng = fveg*sav+sag-(fira+fsh+fcev+fgev+fctr+ssoil) + if(abs(erreng) > 0.01) then + write(message,*) 'erreng =',erreng,' at i,j: ',iloc,jloc +#ifdef CCPP + errmsg = trim(message) +#else + call wrf_message(trim(message)) +#endif + write(message,'(a17,f10.4)') "net solar: ",fsa +#ifdef CCPP + errmsg = trim(errmsg)//NEW_LINE('A')//trim(message) +#else + call wrf_message(trim(message)) +#endif + write(message,'(a17,f10.4)') "net longwave: ",fira +#ifdef CCPP + errmsg = trim(errmsg)//NEW_LINE('A')//trim(message) +#else + call wrf_message(trim(message)) +#endif + write(message,'(a17,f10.4)') "total sensible: ",fsh +#ifdef CCPP + errmsg = trim(errmsg)//NEW_LINE('A')//trim(message) +#else + call wrf_message(trim(message)) +#endif + write(message,'(a17,f10.4)') "canopy evap: ",fcev +#ifdef CCPP + errmsg = trim(errmsg)//NEW_LINE('A')//trim(message) +#else + call wrf_message(trim(message)) +#endif + write(message,'(a17,f10.4)') "ground evap: ",fgev +#ifdef CCPP + errmsg = trim(errmsg)//NEW_LINE('A')//trim(message) +#else + call wrf_message(trim(message)) +#endif + write(message,'(a17,f10.4)') "transpiration: ",fctr +#ifdef CCPP + errmsg = trim(errmsg)//NEW_LINE('A')//trim(message) +#else + call wrf_message(trim(message)) +#endif + write(message,'(a17,f10.4)') "total ground: ",ssoil +#ifdef CCPP + errmsg = trim(errmsg)//NEW_LINE('A')//trim(message) +#else + call wrf_message(trim(message)) +#endif + write(message,'(a17,4f10.4)') "precip advected: ",pah,pahv,pahg,pahb +#ifdef CCPP + errmsg = trim(errmsg)//NEW_LINE('A')//trim(message) +#else + call wrf_message(trim(message)) +#endif + write(message,'(a17,f10.4)') "precip: ",prcp +#ifdef CCPP + errmsg = trim(errmsg)//NEW_LINE('A')//trim(message) +#else + call wrf_message(trim(message)) +#endif + write(message,'(a17,f10.4)') "veg fraction: ",fveg +#ifdef CCPP + errflg = 1 + errmsg = trim(errmsg)//NEW_LINE('A')//trim(message)//NEW_LINE('A')//"energy budget problem in noahmp lsm" + return +#else + call wrf_message(trim(message)) + call wrf_error_fatal("energy budget problem in noahmp lsm") +#endif + + end if + + if (ist == 1) then !soil + end_wb = canliq + canice + sneqv + wa + do iz = 1,nsoil + end_wb = end_wb + smc(iz) * dzsnso(iz) * 1000. + end do + errwat = end_wb-beg_wb-(prcp-ecan-etran-edir-runsrf-runsub)*dt + + else !kwm + errwat = 0.0 !kwm + endif + + end subroutine error + +!== begin energy =================================================================================== + +!>\ingroup NoahMP_LSM + subroutine energy (parameters,ice ,vegtyp ,ist ,nsnow ,nsoil , & !in + isnow ,dt ,rhoair ,sfcprs ,qair , & !in + sfctmp ,thair ,lwdn ,uu ,vv ,zref , & !in + lheatstrg , & !in + co2air ,o2air ,solad ,solai ,cosz ,igs , & !in + eair ,tbot ,zsnso ,zsoil , & !in + elai ,esai ,fwet ,foln , & !in + fveg ,pahv ,pahg ,pahb , & !in + qsnow ,dzsnso ,lat ,canliq ,canice ,iloc , jloc, & !in + z0wrf , & + imelt ,snicev ,snliqv ,epore ,t2m ,fsno , & !out + sav ,sag ,qmelt ,fsa ,fsr ,taux , & !out + tauy ,fira ,fsh ,fshx ,fcev ,fgev ,fctr , & !out + trad ,psn ,apar ,ssoil ,btrani ,btran , & !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 +#ifdef CCPP + tauss ,cpfac ,errmsg ,errflg, & !inout +#else + tauss ,cpfac , & !inout +#endif +!jref:start + qc ,qsfc ,psfc , & !in + t2mv ,t2mb ,fsrv , & + fsrg ,rssun ,rssha ,bgap ,wgap,tgv,tgb,& + q1 ,q2v ,q2b ,q2e ,chv ,chb, emissi,pah ,& + shg,shc,shb,evg,evb,ghv,ghb,irg,irc,irb,tr,evc,chleaf,chuc,chv2,chb2 ) !out +!jref:end + +! -------------------------------------------------------------------------------------------------- +! we use different approaches to deal with subgrid features of radiation transfer and turbulent +! transfer. we use 'tile' approach to compute turbulent fluxes, while we use modified two- +! stream to compute radiation transfer. tile approach, assemblying vegetation canopies together, +! may expose too much ground surfaces (either covered by snow or grass) to solar radiation. the +! modified two-stream assumes vegetation covers fully the gridcell but with gaps between tree +! crowns. +! -------------------------------------------------------------------------------------------------- +! turbulence transfer : 'tile' approach to compute energy fluxes in vegetated fraction and +! bare fraction separately and then sum them up weighted by fraction +! -------------------------------------- +! / o o o o o o o o / / +! / | | | | | | | | / / +! / o o o o o o o o / / +! / | | |tile1| | | | / tile2 / +! / o o o o o o o o / bare / +! / | | | vegetated | | / / +! / o o o o o o o o / / +! / | | | | | | | | / / +! -------------------------------------- +! -------------------------------------------------------------------------------------------------- +! radiation transfer : modified two-stream (yang and friedl, 2003, jgr; niu ang yang, 2004, jgr) +! -------------------------------------- two-stream treats leaves as +! / o o o o o o o o / cloud over the entire grid-cell, +! / | | | | | | | | / while the modified two-stream +! / o o o o o o o o / aggregates cloudy leaves into +! / | | | | | | | | / tree crowns with gaps (as shown in +! / o o o o o o o o / the left figure). we assume these +! / | | | | | | | | / tree crowns are evenly distributed +! / o o o o o o o o / within the gridcell with 100% veg +! / | | | | | | | | / fraction, but with gaps. the 'tile' +! -------------------------------------- approach overlaps too much shadows. +! -------------------------------------------------------------------------------------------------- + implicit none +! -------------------------------------------------------------------------------------------------- +! inputs + type (noahmp_parameters), intent(in) :: parameters + integer , intent(in) :: iloc + integer , intent(in) :: jloc + integer , intent(in) :: ice !ice (ice = 1) + integer , intent(in) :: vegtyp !vegetation physiology type + integer , intent(in) :: ist !surface type: 1->soil; 2->lake + integer , intent(in) :: nsnow !maximum no. of snow layers + integer , intent(in) :: nsoil !number of soil layers + integer , intent(in) :: isnow !actual no. of snow layers + real , intent(in) :: dt !time step [sec] + real , intent(in) :: qsnow !snowfall on the ground (mm/s) + real , intent(in) :: rhoair !density air (kg/m3) + real , intent(in) :: eair !vapor pressure air (pa) + real , intent(in) :: sfcprs !pressure (pa) + real , intent(in) :: qair !specific humidity (kg/kg) + real , intent(in) :: sfctmp !air temperature (k) + real , intent(in) :: thair !potential temperature (k) + real , intent(in) :: lwdn !downward longwave radiation (w/m2) + real , intent(in) :: uu !wind speed in e-w dir (m/s) + real , intent(in) :: vv !wind speed in n-s dir (m/s) + real , dimension( 1: 2), intent(in) :: solad !incoming direct solar rad. (w/m2) + real , dimension( 1: 2), intent(in) :: solai !incoming diffuse solar rad. (w/m2) + real , intent(in) :: cosz !cosine solar zenith angle (0-1) + real , intent(in) :: elai !lai adjusted for burying by snow + real , intent(in) :: esai !lai adjusted for burying by snow + real , intent(in) :: fwet !fraction of canopy that is wet [-] + real , intent(in) :: fveg !greeness vegetation fraction (-) + real , intent(in) :: lat !latitude (radians) + real , intent(in) :: canliq !canopy-intercepted liquid water (mm) + real , intent(in) :: canice !canopy-intercepted ice mass (mm) + real , intent(in) :: foln !foliage nitrogen (%) + real , intent(in) :: co2air !atmospheric co2 concentration (pa) + real , intent(in) :: o2air !atmospheric o2 concentration (pa) + real , intent(in) :: igs !growing season index (0=off, 1=on) + + real , intent(in) :: zref !reference height (m) + logical , intent(in) :: lheatstrg ! flag for canopy heat storage parameterization + real , intent(in) :: tbot !bottom condition for soil temp. (k) + real , dimension(-nsnow+1:nsoil), intent(in) :: zsnso !layer-bottom depth from snow surf [m] + real , dimension( 1:nsoil), intent(in) :: zsoil !layer-bottom depth from soil surf [m] + real , dimension(-nsnow+1:nsoil), intent(in) :: dzsnso !depth of snow & soil layer-bottom [m] + real, intent(in) :: pahv !precipitation advected heat - vegetation net (w/m2) + real, intent(in) :: pahg !precipitation advected heat - under canopy net (w/m2) + real, intent(in) :: pahb !precipitation advected heat - bare ground net (w/m2) + +!jref:start; in + real , intent(in) :: qc !cloud water mixing ratio + real , intent(inout) :: qsfc !mixing ratio at lowest model layer + real , intent(in) :: psfc !pressure at lowest model layer + real , intent(in) :: dx !horisontal resolution + real , intent(in) :: dz8w !thickness of lowest layer + real , intent(in) :: q2 !mixing ratio (kg/kg) +!jref:end + +! outputs + real , intent(out) :: z0wrf !combined z0 sent to coupled model + integer, dimension(-nsnow+1:nsoil), intent(out) :: imelt !phase change index [1-melt; 2-freeze] + real , dimension(-nsnow+1: 0), intent(out) :: snicev !partial volume ice [m3/m3] + real , dimension(-nsnow+1: 0), intent(out) :: snliqv !partial volume liq. water [m3/m3] + real , dimension(-nsnow+1: 0), intent(out) :: epore !effective porosity [m3/m3] + real , intent(out) :: fsno !snow cover fraction (-) + real , intent(out) :: qmelt !snowmelt [mm/s] + real , intent(out) :: ponding!pounding at ground [mm] + real , intent(out) :: sav !solar rad. absorbed by veg. (w/m2) + real , intent(out) :: sag !solar rad. absorbed by ground (w/m2) + real , intent(out) :: fsa !tot. absorbed solar radiation (w/m2) + real , intent(out) :: fsr !tot. reflected solar radiation (w/m2) + real , intent(out) :: taux !wind stress: e-w (n/m2) + real , intent(out) :: tauy !wind stress: n-s (n/m2) + real , intent(out) :: fira !total net lw. rad (w/m2) [+ to atm] + real , intent(out) :: fsh !total sensible heat (w/m2) [+ to atm] + real , intent(out) :: fshx !total sensible heat (w/m2) [+ to atm] + real , intent(out) :: fcev !canopy evaporation (w/m2) [+ to atm] + real , intent(out) :: fgev !ground evaporation (w/m2) [+ to atm] + real , intent(out) :: fctr !transpiration (w/m2) [+ to atm] + real , intent(out) :: trad !radiative temperature (k) + real , intent(out) :: t2m !2 m height air temperature (k) + real , intent(out) :: psn !total photosyn. (umolco2/m2/s) [+] + real , intent(out) :: apar !total photosyn. active energy (w/m2) + real , intent(out) :: ssoil !ground heat flux (w/m2) [+ to soil] + real , dimension( 1:nsoil), intent(out) :: btrani !soil water transpiration factor (0-1) + real , intent(out) :: btran !soil water transpiration factor (0-1) +! real , intent(out) :: lathea !latent heat vap./sublimation (j/kg) + real , intent(out) :: latheav !latent heat vap./sublimation (j/kg) + real , intent(out) :: latheag !latent heat vap./sublimation (j/kg) + logical , intent(out) :: frozen_ground ! used to define latent heat pathway + logical , intent(out) :: frozen_canopy ! used to define latent heat pathway + +!jref:start + real , intent(out) :: fsrv !veg. reflected solar radiation (w/m2) + real , intent(out) :: fsrg !ground reflected solar radiation (w/m2) + real, intent(out) :: rssun !sunlit leaf stomatal resistance (s/m) + real, intent(out) :: rssha !shaded leaf stomatal resistance (s/m) +!jref:end - out for debug + +!jref:start; output + real , intent(out) :: t2mv !2-m air temperature over vegetated part [k] + real , intent(out) :: t2mb !2-m air temperature over bare ground part [k] + real , intent(out) :: bgap + real , intent(out) :: wgap +!jref:end + +! input & output + real , intent(inout) :: ts !surface temperature (k) + real , intent(inout) :: tv !vegetation temperature (k) + real , intent(inout) :: tg !ground temperature (k) + real , dimension(-nsnow+1:nsoil), intent(inout) :: stc !snow/soil temperature [k] + real , intent(inout) :: snowh !snow height [m] + real , intent(inout) :: sneqv !snow mass (mm) + real , intent(inout) :: sneqvo !snow mass at last time step (mm) + real , dimension( 1:nsoil), intent(inout) :: sh2o !liquid soil moisture [m3/m3] + real , dimension( 1:nsoil), intent(inout) :: smc !soil moisture (ice + liq.) [m3/m3] + real , dimension(-nsnow+1: 0), intent(inout) :: snice !snow ice mass (kg/m2) + real , dimension(-nsnow+1: 0), intent(inout) :: snliq !snow liq mass (kg/m2) + real , intent(inout) :: eah !canopy air vapor pressure (pa) + real , intent(inout) :: tah !canopy air temperature (k) + real , intent(inout) :: albold !snow albedo at last time step(class type) + real , intent(inout) :: tauss !non-dimensional snow age + real , intent(inout) :: cpfac !heat capacity enhancement factor due to heat storage + real , intent(inout) :: cm !momentum drag coefficient + real , intent(inout) :: ch !sensible heat exchange coefficient + real , intent(inout) :: q1 +#ifdef CCPP + character(len=*) , intent(inout) :: errmsg + integer , intent(inout) :: errflg +#endif +! real :: q2e + real, intent(out) :: emissi + real, intent(out) :: pah !precipitation advected heat - total (w/m2) + +! local + integer :: iz !do-loop index + logical :: veg !true if vegetated surface + real :: ur !wind speed at height zlvl (m/s) + real :: zlvl !reference height (m) + real :: fsun !sunlit fraction of canopy [-] + real :: rb !leaf boundary layer resistance (s/m) + real :: rsurf !ground surface resistance (s/m) + real :: l_rsurf!dry-layer thickness for computing rsurf (sakaguchi and zeng, 2009) + real :: d_rsurf!reduced vapor diffusivity in soil for computing rsurf (sz09) + real :: bevap !soil water evaporation factor (0- 1) + real :: mol !monin-obukhov length (m) + real :: vai !sum of lai + stem area index [m2/m2] + real :: cwp !canopy wind extinction parameter + real :: zpd !zero plane displacement (m) + real :: z0m !z0 momentum (m) + real :: zpdg !zero plane displacement (m) + real :: z0mg !z0 momentum, ground (m) + real :: emv !vegetation emissivity + real :: emg !ground emissivity + real :: fire !emitted ir (w/m2) + + real :: laisun !sunlit leaf area index (m2/m2) + real :: laisha !shaded leaf area index (m2/m2) + real :: psnsun !sunlit photosynthesis (umolco2/m2/s) + real :: psnsha !shaded photosynthesis (umolco2/m2/s) +!jref:start - for debug +! real :: rssun !sunlit stomatal resistance (s/m) +! real :: rssha !shaded stomatal resistance (s/m) +!jref:end - for debug + real :: parsun !par absorbed per sunlit lai (w/m2) + real :: parsha !par absorbed per shaded lai (w/m2) + + real, dimension(-nsnow+1:nsoil) :: fact !temporary used in phase change + real, dimension(-nsnow+1:nsoil) :: df !thermal conductivity [w/m/k] + real, dimension(-nsnow+1:nsoil) :: hcpct !heat capacity [j/m3/k] + real :: bdsno !bulk density of snow (kg/m3) + real :: fmelt !melting factor for snow cover frac + real :: gx !temporary variable + real, dimension(-nsnow+1:nsoil) :: phi !light through water (w/m2) +! real :: gamma !psychrometric constant (pa/k) + real :: gammav !psychrometric constant (pa/k) + real :: gammag !psychrometric constant (pa/k) + real :: psi !surface layer soil matrix potential (m) + real :: rhsur !raltive humidity in surface soil/snow air space (-) + +! temperature and fluxes over vegetated fraction + + real :: tauxv !wind stress: e-w dir [n/m2] + real :: tauyv !wind stress: n-s dir [n/m2] + real,intent(out) :: irc !canopy net lw rad. [w/m2] [+ to atm] + real,intent(out) :: irg !ground net lw rad. [w/m2] [+ to atm] + real,intent(out) :: shc !canopy sen. heat [w/m2] [+ to atm] + real,intent(out) :: shg !ground sen. heat [w/m2] [+ to atm] +!jref:start + real,intent(out) :: q2v + real,intent(out) :: q2b + real,intent(out) :: q2e +!jref:end + real,intent(out) :: evc !canopy evap. heat [w/m2] [+ to atm] + real,intent(out) :: evg !ground evap. heat [w/m2] [+ to atm] + real,intent(out) :: tr !transpiration heat [w/m2] [+ to atm] + real,intent(out) :: ghv !ground heat flux [w/m2] [+ to soil] + real,intent(out) :: tgv !ground surface temp. [k] + real :: cmv !momentum drag coefficient + real,intent(out) :: chv !sensible heat exchange coefficient + +! temperature and fluxes over bare soil fraction + + real :: tauxb !wind stress: e-w dir [n/m2] + real :: tauyb !wind stress: n-s dir [n/m2] + real,intent(out) :: irb !net longwave rad. [w/m2] [+ to atm] + real,intent(out) :: shb !sensible heat [w/m2] [+ to atm] + real,intent(out) :: evb !evaporation heat [w/m2] [+ to atm] + real,intent(out) :: ghb !ground heat flux [w/m2] [+ to soil] + real,intent(out) :: tgb !ground surface temp. [k] + real :: cmb !momentum drag coefficient + real,intent(out) :: chb !sensible heat exchange coefficient + real,intent(out) :: chleaf !leaf exchange coefficient + real,intent(out) :: chuc !under canopy exchange coefficient +!jref:start + real,intent(out) :: chv2 !sensible heat conductance, canopy air to zlvl air (m/s) + real,intent(out) :: chb2 !sensible heat conductance, canopy air to zlvl air (m/s) + real :: noahmpres + +!jref:end + + real, parameter :: mpe = 1.e-6 + real, parameter :: psiwlt = -150. !metric potential for wilting point (m) + real, parameter :: z0 = 0.01 ! bare-soil roughness length (m) (i.e., under the canopy) +! +! parameters for heat storage parametrization +! + real, parameter :: z0min = 0.2 !minimum roughness length for heat storage + real, parameter :: z0max = 1.0 !maximum roughness length for heat storage + +! --------------------------------------------------------------------------------------------------- +! initialize fluxes from veg. fraction + + tauxv = 0. + tauyv = 0. + irc = 0. + shc = 0. + irg = 0. + shg = 0. + evg = 0. + evc = 0. + tr = 0. + ghv = 0. + psnsun = 0. + psnsha = 0. + t2mv = 0. + q2v = 0. + chv = 0. + chleaf = 0. + chuc = 0. + chv2 = 0. + +! wind speed at reference height: ur >= 1 + + ur = max( sqrt(uu**2.+vv**2.), 1. ) + +! vegetated or non-vegetated + + vai = elai + esai + veg = .false. + if(vai > 0.) veg = .true. + +! ground snow cover fraction [niu and yang, 2007, jgr] + + fsno = 0. + if(snowh.gt.0.) then + bdsno = sneqv / snowh + fmelt = (bdsno/100.)**parameters%mfsno + fsno = tanh( snowh /(2.5* z0 * fmelt)) + endif + +! ground roughness length + + if(ist == 2) then + if(tg .le. tfrz) then + z0mg = 0.01 * (1.0-fsno) + fsno * parameters%z0sno + else + z0mg = 0.01 + end if + else + z0mg = z0 * (1.0-fsno) + fsno * parameters%z0sno + end if + +! roughness length and displacement height + + zpdg = snowh + if(veg) then + z0m = parameters%z0mvt + zpd = 0.65 * parameters%hvt + if(snowh.gt.zpd) zpd = snowh + else + z0m = z0mg + zpd = zpdg + end if +! +! compute heat capacity enhancement factor as a function of z0m to mimic heat storage +! + if (lheatstrg .and. (.not. parameters%urban_flag) ) then + cpfac = (z0m - z0min) / (z0max - z0min) + cpfac = 1. + min(max(cpfac, 0.0), 1.0) + endif + + zlvl = max(zpd,parameters%hvt) + zref + if(zpdg >= zlvl) zlvl = zpdg + zref +! ur = ur*log(zlvl/z0m)/log(10./z0m) !input ur is at 10m + +! canopy wind absorption coeffcient + + cwp = parameters%cwpvt + +! thermal properties of soil, snow, lake, and frozen soil + + call thermoprop (parameters,nsoil ,nsnow ,isnow ,ist ,dzsnso , & !in + dt ,snowh ,snice ,snliq , & !in + smc ,sh2o ,tg ,stc ,ur , & !in + lat ,z0m ,zlvl ,vegtyp , & !in + df ,hcpct ,snicev ,snliqv ,epore , & !out + fact ) !out + +! solar radiation: absorbed & reflected by the ground and canopy + + call radiation (parameters,vegtyp ,ist ,ice ,nsoil , & !in + sneqvo ,sneqv ,dt ,cosz ,snowh , & !in + tg ,tv ,fsno ,qsnow ,fwet , & !in + elai ,esai ,smc ,solad ,solai , & !in + fveg ,iloc ,jloc , & !in + albold ,tauss , & !inout + fsun ,laisun ,laisha ,parsun ,parsha , & !out + sav ,sag ,fsr ,fsa ,fsrv , & + fsrg ,bgap ,wgap ) !out + +! vegetation and ground emissivity + + emv = 1. - exp(-(elai+esai)/1.0) + if (ice == 1) then + emg = 0.98*(1.-fsno) + 1.0*fsno + else + emg = parameters%eg(ist)*(1.-fsno) + 1.0*fsno + end if + +! soil moisture factor controlling stomatal resistance + + btran = 0. + + if(ist ==1 ) then + do iz = 1, parameters%nroot + if(opt_btr == 1) then ! noah + gx = (sh2o(iz)-parameters%smcwlt) / (parameters%smcref-parameters%smcwlt) + end if + if(opt_btr == 2) then ! clm + psi = max(psiwlt,-parameters%psisat*(max(0.01,sh2o(iz))/parameters%smcmax)**(-parameters%bexp) ) + gx = (1.-psi/psiwlt)/(1.+parameters%psisat/psiwlt) + end if + if(opt_btr == 3) then ! ssib + psi = max(psiwlt,-parameters%psisat*(max(0.01,sh2o(iz))/parameters%smcmax)**(-parameters%bexp) ) + gx = 1.-exp(-5.8*(log(psiwlt/psi))) + end if + + gx = min(1.,max(0.,gx)) + btrani(iz) = max(mpe,dzsnso(iz) / (-zsoil(parameters%nroot)) * gx) + btran = btran + btrani(iz) + end do + btran = max(mpe,btran) + + btrani(1:parameters%nroot) = btrani(1:parameters%nroot)/btran + end if + +! soil surface resistance for ground evap. + + bevap = max(0.0,sh2o(1)/parameters%smcmax) + if(ist == 2) then + rsurf = 1. ! avoid being divided by 0 + rhsur = 1.0 + else + + ! rsurf based on sakaguchi and zeng, 2009 + ! taking the "residual water content" to be the wilting point, + ! and correcting the exponent on the d term (typo in sz09 ?) + l_rsurf = (-zsoil(1)) * ( exp ( (1.0 - min(1.0,sh2o(1)/parameters%smcmax)) ** 5 ) - 1.0 ) / ( 2.71828 - 1.0 ) + d_rsurf = 2.2e-5 * parameters%smcmax * parameters%smcmax * ( 1.0 - parameters%smcwlt / parameters%smcmax ) ** (2.0+3.0/parameters%bexp) + rsurf = l_rsurf / d_rsurf + + ! older rsurf computations: + ! rsurf = fsno * 1. + (1.-fsno)* exp(8.25-4.225*bevap) !sellers (1992) + ! rsurf = fsno * 1. + (1.-fsno)* exp(8.25-6.0 *bevap) !adjusted to decrease rsurf for wet soil + + if(sh2o(1) < 0.01 .and. snowh == 0.) rsurf = 1.e6 + psi = -parameters%psisat*(max(0.01,sh2o(1))/parameters%smcmax)**(-parameters%bexp) + rhsur = fsno + (1.-fsno) * exp(psi*grav/(rw*tg)) + end if + +! urban - jref + if (parameters%urban_flag .and. snowh == 0. ) then + rsurf = 1.e6 + endif + +! set psychrometric constant + + if (tv .gt. tfrz) then ! barlage: add distinction between ground and + latheav = hvap ! vegetation in v3.6 + frozen_canopy = .false. + else + latheav = hsub + frozen_canopy = .true. + end if + gammav = cpair*cpfac*sfcprs/(0.622*latheav) + + if (tg .gt. tfrz) then + latheag = hvap + frozen_ground = .false. + else + latheag = hsub + frozen_ground = .true. + end if + gammag = cpair*cpfac*sfcprs/(0.622*latheag) + +! if (sfctmp .gt. tfrz) then +! lathea = hvap +! else +! lathea = hsub +! end if +! gamma = cpair*cpfac*sfcprs/(0.622*lathea) + +! surface temperatures of the ground and canopy and energy fluxes + + if (veg .and. fveg > 0) then + tgv = tg + cmv = cm + chv = ch +! YRQ +! write(*,*) 'cm,ch,tv,tgv, YRQ', cm,ch,tv,tgv + call vege_flux (parameters,nsnow ,nsoil ,isnow ,vegtyp ,veg , & !in + dt ,sav ,sag ,lwdn ,ur , & !in + uu ,vv ,sfctmp ,thair ,qair , & !in + eair ,rhoair ,snowh ,vai ,gammav ,gammag , & !in + fwet ,laisun ,laisha ,cwp ,dzsnso , & !in + zlvl ,cpfac ,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 ,tgv ,cmv , & !inout +#ifdef CCPP + chv ,dx ,dz8w ,errmsg ,errflg , & !inout +#else + chv ,dx ,dz8w , & !inout +#endif + tauxv ,tauyv ,irg ,irc ,shg , & !out + shc ,evg ,evc ,tr ,ghv , & !out + t2mv ,psnsun ,psnsha , & !out +!jref:start + qc ,qsfc ,psfc , & !in + q2v ,chv2, chleaf, chuc) !inout +!jref:end +#ifdef CCPP + if (errflg /= 0) return +#endif + end if + + tgb = tg + cmb = cm + chb = ch + 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 + emg ,stc ,df ,rsurf ,latheag , & !in + gammag ,rhsur ,iloc ,jloc ,q2 ,pahb , & !in +#ifdef CCPP + tgb ,cmb ,chb ,errmsg ,errflg , & !inout +#else + tgb ,cmb ,chb , & !inout +#endif + tauxb ,tauyb ,irb ,shb ,evb , & !out + ghb ,t2mb ,dx ,dz8w ,vegtyp , & !out +!jref:start + qc ,qsfc ,psfc , & !in + sfcprs ,q2b, chb2) !in +!jref:end +#ifdef CCPP + if (errflg /= 0) return +#endif +!energy balance at vege canopy: sav =(irc+shc+evc+tr) *fveg at fveg +!energy balance at vege ground: sag* fveg =(irg+shg+evg+ghv) *fveg at fveg +!energy balance at bare ground: sag*(1.-fveg)=(irb+shb+evb+ghb)*(1.-fveg) at 1-fveg + + if (veg .and. fveg > 0) then + taux = fveg * tauxv + (1.0 - fveg) * tauxb + tauy = fveg * tauyv + (1.0 - fveg) * tauyb + fira = fveg * irg + (1.0 - fveg) * irb + irc + fsh = fveg * shg + (1.0 - fveg) * shb + shc + fshx = fveg * shg/cpfac + (1.0 - fveg) * shb + shc/cpfac + fgev = fveg * evg + (1.0 - fveg) * evb + ssoil = fveg * ghv + (1.0 - fveg) * ghb + fcev = evc + fctr = tr + 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 + 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 + else + taux = tauxb + tauy = tauyb + fira = irb + fsh = shb + fshx = shb + fgev = evb + ssoil = ghb + tg = tgb + t2m = t2mb + fcev = 0. + fctr = 0. + pah = pahb + ts = tg + cm = cmb + ch = chb + q1 = qsfc + q2e = q2b + rssun = 0.0 + rssha = 0.0 + tgv = tgb + chv = chb + z0wrf = z0mg + end if + + fire = lwdn + fira + + if(fire <=0.) then + write(6,*) 'emitted longwave <0; skin t may be wrong due to inconsistent' + write(6,*) 'input of shdfac with lai' + write(6,*) iloc, jloc, 'shdfac=',fveg,'vai=',vai,'tv=',tv,'tg=',tg + write(6,*) 'lwdn=',lwdn,'fira=',fira,'snowh=',snowh +#ifdef CCPP + errflg = 1 + errmsg = "stop in noah-mp" + return +#else + call wrf_error_fatal("stop in noah-mp") +#endif + + end if + + ! compute a net emissivity + emissi = fveg * ( emg*(1-emv) + emv + emv*(1-emv)*(1-emg) ) + & + (1-fveg) * emg + + ! when we're computing a trad, subtract from the emitted ir the + ! reflected portion of the incoming lwdn, so we're just + ! considering the ir originating in the canopy/ground system. + + trad = ( ( fire - (1-emissi)*lwdn ) / (emissi*sb) ) ** 0.25 + + ! old trad calculation not taking into account emissivity: + ! trad = (fire/sb)**0.25 + + apar = parsun*laisun + parsha*laisha + psn = psnsun*laisun + psnsha*laisha + +! 3l snow & 4l soil temperatures + + call tsnosoi (parameters,ice ,nsoil ,nsnow ,isnow ,ist , & !in + tbot ,zsnso ,ssoil ,df ,hcpct , & !in + sag ,dt ,snowh ,dzsnso , & !in + tg ,iloc ,jloc , & !in +#ifdef CCPP + stc ,errmsg ,errflg ) !inout +#else + stc ) !inout +#endif + +#ifdef CCPP + if (errflg /= 0) return +#endif + +! adjusting snow surface temperature + if(opt_stc == 2) then + if (snowh > 0.05 .and. tg > tfrz) then + tgv = tfrz + tgb = tfrz + if (veg .and. fveg > 0) then + tg = fveg * tgv + (1.0 - fveg) * tgb + ts = fveg * tv + (1.0 - fveg) * tgb + else + tg = tgb + ts = tgb + end if + end if + end if + +! energy released or consumed by snow & frozen soil + + call phasechange (parameters,nsnow ,nsoil ,isnow ,dt ,fact , & !in + dzsnso ,hcpct ,ist ,iloc ,jloc , & !in + stc ,snice ,snliq ,sneqv ,snowh , & !inout +#ifdef CCPP + smc ,sh2o ,errmsg ,errflg , & !inout +#else + smc ,sh2o , & !inout +#endif + qmelt ,imelt ,ponding ) !out +#ifdef CCPP + if (errflg /= 0) return +#endif + + end subroutine energy + +!== begin thermoprop =============================================================================== + +!>\ingroup NoahMP_LSM + subroutine thermoprop (parameters,nsoil ,nsnow ,isnow ,ist ,dzsnso , & !in + dt ,snowh ,snice ,snliq , & !in + smc ,sh2o ,tg ,stc ,ur , & !in + lat ,z0m ,zlvl ,vegtyp , & !in + df ,hcpct ,snicev ,snliqv ,epore , & !out + fact ) !out +! ------------------------------------------------------------------------------------------------- + implicit none +! -------------------------------------------------------------------------------------------------- +! inputs + type (noahmp_parameters), intent(in) :: parameters + integer , intent(in) :: nsoil !number of soil layers + integer , intent(in) :: nsnow !maximum no. of snow layers + integer , intent(in) :: isnow !actual no. of snow layers + integer , intent(in) :: ist !surface type + real , intent(in) :: dt !time step [s] + real, dimension(-nsnow+1: 0), intent(in) :: snice !snow ice mass (kg/m2) + real, dimension(-nsnow+1: 0), intent(in) :: snliq !snow liq mass (kg/m2) + real, dimension(-nsnow+1:nsoil), intent(in) :: dzsnso !thickness of snow/soil layers [m] + real, dimension( 1:nsoil), intent(in) :: smc !soil moisture (ice + liq.) [m3/m3] + real, dimension( 1:nsoil), intent(in) :: sh2o !liquid soil moisture [m3/m3] + real , intent(in) :: snowh !snow height [m] + real, intent(in) :: tg !surface temperature (k) + real, dimension(-nsnow+1:nsoil), intent(in) :: stc !snow/soil/lake temp. (k) + real, intent(in) :: ur !wind speed at zlvl (m/s) + real, intent(in) :: lat !latitude (radians) + real, intent(in) :: z0m !roughness length (m) + real, intent(in) :: zlvl !reference height (m) + integer , intent(in) :: vegtyp !vegtyp type + +! outputs + real, dimension(-nsnow+1:nsoil), intent(out) :: df !thermal conductivity [w/m/k] + real, dimension(-nsnow+1:nsoil), intent(out) :: hcpct !heat capacity [j/m3/k] + real, dimension(-nsnow+1: 0), intent(out) :: snicev !partial volume of ice [m3/m3] + real, dimension(-nsnow+1: 0), intent(out) :: snliqv !partial volume of liquid water [m3/m3] + real, dimension(-nsnow+1: 0), intent(out) :: epore !effective porosity [m3/m3] + real, dimension(-nsnow+1:nsoil), intent(out) :: fact !computing energy for phase change +! -------------------------------------------------------------------------------------------------- +! locals + + integer :: iz + real, dimension(-nsnow+1: 0) :: cvsno !volumetric specific heat (j/m3/k) + real, dimension(-nsnow+1: 0) :: tksno !snow thermal conductivity (j/m3/k) + real, dimension( 1:nsoil) :: sice !soil ice content +! -------------------------------------------------------------------------------------------------- + +! compute snow thermal conductivity and heat capacity + + call csnow (parameters,isnow ,nsnow ,nsoil ,snice ,snliq ,dzsnso , & !in + tksno ,cvsno ,snicev ,snliqv ,epore ) !out + + do iz = isnow+1, 0 + df (iz) = tksno(iz) + hcpct(iz) = cvsno(iz) + end do + +! compute soil thermal properties + + do iz = 1, nsoil + sice(iz) = smc(iz) - sh2o(iz) + hcpct(iz) = sh2o(iz)*cwat + (1.0-parameters%smcmax)*parameters%csoil & + + (parameters%smcmax-smc(iz))*cpair + sice(iz)*cice + call tdfcnd (parameters,df(iz), smc(iz), sh2o(iz)) + end do + + if ( parameters%urban_flag ) then + do iz = 1,nsoil + df(iz) = 3.24 + end do + endif + +! heat flux reduction effect from the overlying green canopy, adapted from +! section 2.1.2 of peters-lidard et al. (1997, jgr, vol 102(d4)). +! not in use because of the separation of the canopy layer from the ground. +! but this may represent the effects of leaf litter (niu comments) +! df1 = df1 * exp (sbeta * shdfac) + +! compute lake thermal properties +! (no consideration of turbulent mixing for this version) + + if(ist == 2) then + do iz = 1, nsoil + if(stc(iz) > tfrz) then + hcpct(iz) = cwat + df(iz) = tkwat !+ keddy * cwat + else + hcpct(iz) = cice + df(iz) = tkice + end if + end do + end if + +! combine a temporary variable used for melting/freezing of snow and frozen soil + + do iz = isnow+1,nsoil + fact(iz) = dt/(hcpct(iz)*dzsnso(iz)) + end do + +! snow/soil interface + + if(isnow == 0) then + df(1) = (df(1)*dzsnso(1)+0.35*snowh) / (snowh +dzsnso(1)) + else + df(1) = (df(1)*dzsnso(1)+df(0)*dzsnso(0)) / (dzsnso(0)+dzsnso(1)) + end if + + + end subroutine thermoprop + +!== begin csnow ==================================================================================== + +!>\ingroup NoahMP_LSM + subroutine csnow (parameters,isnow ,nsnow ,nsoil ,snice ,snliq ,dzsnso , & !in + tksno ,cvsno ,snicev ,snliqv ,epore ) !out +! -------------------------------------------------------------------------------------------------- +! snow bulk density,volumetric capacity, and thermal conductivity +!--------------------------------------------------------------------------------------------------- + implicit none +!--------------------------------------------------------------------------------------------------- +! inputs + + type (noahmp_parameters), intent(in) :: parameters + integer, intent(in) :: isnow !number of snow layers (-) + integer , intent(in) :: nsnow !maximum no. of snow layers + integer , intent(in) :: nsoil !number of soil layers + real, dimension(-nsnow+1: 0), intent(in) :: snice !snow ice mass (kg/m2) + real, dimension(-nsnow+1: 0), intent(in) :: snliq !snow liq mass (kg/m2) + real, dimension(-nsnow+1:nsoil), intent(in) :: dzsnso !snow/soil layer thickness [m] + +! outputs + + real, dimension(-nsnow+1: 0), intent(out) :: cvsno !volumetric specific heat (j/m3/k) + real, dimension(-nsnow+1: 0), intent(out) :: tksno !thermal conductivity (w/m/k) + real, dimension(-nsnow+1: 0), intent(out) :: snicev !partial volume of ice [m3/m3] + real, dimension(-nsnow+1: 0), intent(out) :: snliqv !partial volume of liquid water [m3/m3] + real, dimension(-nsnow+1: 0), intent(out) :: epore !effective porosity [m3/m3] + +! locals + + integer :: iz + real, dimension(-nsnow+1: 0) :: bdsnoi !bulk density of snow(kg/m3) + +!--------------------------------------------------------------------------------------------------- +! thermal capacity of snow + + do iz = isnow+1, 0 + snicev(iz) = min(1., snice(iz)/(dzsnso(iz)*denice) ) + epore(iz) = 1. - snicev(iz) + snliqv(iz) = min(epore(iz),snliq(iz)/(dzsnso(iz)*denh2o)) + enddo + + do iz = isnow+1, 0 + bdsnoi(iz) = (snice(iz)+snliq(iz))/dzsnso(iz) + cvsno(iz) = cice*snicev(iz)+cwat*snliqv(iz) +! cvsno(iz) = 0.525e06 ! constant + enddo + +! thermal conductivity of snow + + do iz = isnow+1, 0 + tksno(iz) = 3.2217e-6*bdsnoi(iz)**2. ! stieglitz(yen,1965) +! tksno(iz) = 2e-2+2.5e-6*bdsnoi(iz)*bdsnoi(iz) ! anderson, 1976 +! tksno(iz) = 0.35 ! constant +! tksno(iz) = 2.576e-6*bdsnoi(iz)**2. + 0.074 ! verseghy (1991) +! tksno(iz) = 2.22*(bdsnoi(iz)/1000.)**1.88 ! douvill(yen, 1981) + enddo + + end subroutine csnow + +!== begin tdfcnd =================================================================================== + +!>\ingroup NoahMP_LSM + subroutine tdfcnd (parameters, df, smc, sh2o) +! -------------------------------------------------------------------------------------------------- +! calculate thermal diffusivity and conductivity of the soil. +! peters-lidard approach (peters-lidard et al., 1998) +! -------------------------------------------------------------------------------------------------- +! code history: +! june 2001 changes: frozen soil condition. +! -------------------------------------------------------------------------------------------------- + implicit none + type (noahmp_parameters), intent(in) :: parameters + real, intent(in) :: smc ! total soil water + real, intent(in) :: sh2o ! liq. soil water + real, intent(out) :: df ! thermal diffusivity + +! local variables + real :: ake + real :: gammd + real :: thkdry + real :: thko ! thermal conductivity for other soil components + real :: thkqtz ! thermal conductivity for quartz + real :: thksat ! + real :: thks ! thermal conductivity for the solids + real :: thkw ! water thermal conductivity + real :: satratio + real :: xu + real :: xunfroz +! -------------------------------------------------------------------------------------------------- +! we now get quartz as an input argument (set in routine redprm): +! data quartz /0.82, 0.10, 0.25, 0.60, 0.52, +! & 0.35, 0.60, 0.40, 0.82/ +! -------------------------------------------------------------------------------------------------- +! if the soil has any moisture content compute a partial sum/product +! otherwise use a constant value which works well with most soils +! -------------------------------------------------------------------------------------------------- +! quartz ....quartz content (soil type dependent) +! -------------------------------------------------------------------------------------------------- +! use as in peters-lidard, 1998 (modif. from johansen, 1975). + +! pablo grunmann, 08/17/98 +! refs.: +! farouki, o.t.,1986: thermal properties of soils. series on rock +! and soil mechanics, vol. 11, trans tech, 136 pp. +! johansen, o., 1975: thermal conductivity of soils. ph.d. thesis, +! university of trondheim, +! peters-lidard, c. d., et al., 1998: the effect of soil thermal +! conductivity parameterization on surface energy fluxes +! and temperatures. journal of the atmospheric sciences, +! vol. 55, pp. 1209-1224. +! -------------------------------------------------------------------------------------------------- +! needs parameters +! porosity(soil type): +! poros = smcmax +! saturation ratio: +! parameters w/(m.k) + satratio = smc / parameters%smcmax + thkw = 0.57 +! if (quartz .le. 0.2) thko = 3.0 + thko = 2.0 +! solids' conductivity +! quartz' conductivity + thkqtz = 7.7 + +! unfrozen fraction (from 1., i.e., 100%liquid, to 0. (100% frozen)) + thks = (thkqtz ** parameters%quartz)* (thko ** (1. - parameters%quartz)) + +! unfrozen volume for saturation (porosity*xunfroz) + xunfroz = sh2o / smc +! saturated thermal conductivity + xu = xunfroz * parameters%smcmax + +! dry density in kg/m3 + thksat = thks ** (1. - parameters%smcmax)* tkice ** (parameters%smcmax - xu)* thkw ** & + (xu) + +! dry thermal conductivity in w.m-1.k-1 + gammd = (1. - parameters%smcmax)*2700. + + thkdry = (0.135* gammd+ 64.7)/ (2700. - 0.947* gammd) +! frozen + if ( (sh2o + 0.0005) < smc ) then + ake = satratio +! unfrozen +! range of validity for the kersten number (ake) + else + +! kersten number (using "fine" formula, valid for soils containing at +! least 5% of particles with diameter less than 2.e-6 meters.) +! (for "coarse" formula, see peters-lidard et al., 1998). + + if ( satratio > 0.1 ) then + + ake = log10 (satratio) + 1.0 + +! use k = kdry + else + + ake = 0.0 + end if +! thermal conductivity + + end if + + df = ake * (thksat - thkdry) + thkdry + + + end subroutine tdfcnd + +!== begin radiation ================================================================================ + +!>\ingroup NoahMP_LSM + subroutine radiation (parameters,vegtyp ,ist ,ice ,nsoil , & !in + sneqvo ,sneqv ,dt ,cosz ,snowh , & !in + tg ,tv ,fsno ,qsnow ,fwet , & !in + elai ,esai ,smc ,solad ,solai , & !in + fveg ,iloc ,jloc , & !in + albold ,tauss , & !inout + fsun ,laisun ,laisha ,parsun ,parsha , & !out + sav ,sag ,fsr ,fsa ,fsrv , & + fsrg ,bgap ,wgap) !out +! -------------------------------------------------------------------------------------------------- + implicit none +! -------------------------------------------------------------------------------------------------- +! input + type (noahmp_parameters), intent(in) :: parameters + integer, intent(in) :: iloc + integer, intent(in) :: jloc + integer, intent(in) :: vegtyp !vegetation type + integer, intent(in) :: ist !surface type + integer, intent(in) :: ice !ice (ice = 1) + integer, intent(in) :: nsoil !number of soil layers + + real, intent(in) :: dt !time step [s] + real, intent(in) :: qsnow !snowfall (mm/s) + real, intent(in) :: sneqvo !snow mass at last time step(mm) + real, intent(in) :: sneqv !snow mass (mm) + real, intent(in) :: snowh !snow height (mm) + real, intent(in) :: cosz !cosine solar zenith angle (0-1) + real, intent(in) :: tg !ground temperature (k) + real, intent(in) :: tv !vegetation temperature (k) + real, intent(in) :: elai !lai, one-sided, adjusted for burying by snow + real, intent(in) :: esai !sai, one-sided, adjusted for burying by snow + real, intent(in) :: fwet !fraction of canopy that is wet + real, dimension(1:nsoil), intent(in) :: smc !volumetric soil water [m3/m3] + real, dimension(1:2) , intent(in) :: solad !incoming direct solar radiation (w/m2) + real, dimension(1:2) , intent(in) :: solai !incoming diffuse solar radiation (w/m2) + real, intent(in) :: fsno !snow cover fraction (-) + real, intent(in) :: fveg !green vegetation fraction [0.0-1.0] + +! inout + real, intent(inout) :: albold !snow albedo at last time step (class type) + real, intent(inout) :: tauss !non-dimensional snow age. + +! output + real, intent(out) :: fsun !sunlit fraction of canopy (-) + real, intent(out) :: laisun !sunlit leaf area (-) + real, intent(out) :: laisha !shaded leaf area (-) + real, intent(out) :: parsun !average absorbed par for sunlit leaves (w/m2) + real, intent(out) :: parsha !average absorbed par for shaded leaves (w/m2) + real, intent(out) :: sav !solar radiation absorbed by vegetation (w/m2) + real, intent(out) :: sag !solar radiation absorbed by ground (w/m2) + real, intent(out) :: fsa !total absorbed solar radiation (w/m2) + real, intent(out) :: fsr !total reflected solar radiation (w/m2) + +!jref:start + real, intent(out) :: fsrv !veg. reflected solar radiation (w/m2) + real, intent(out) :: fsrg !ground reflected solar radiation (w/m2) + real, intent(out) :: bgap + real, intent(out) :: wgap +!jref:end + +! local + real :: fage !snow age function (0 - new snow) + real, dimension(1:2) :: albgrd !ground albedo (direct) + real, dimension(1:2) :: albgri !ground albedo (diffuse) + real, dimension(1:2) :: albd !surface albedo (direct) + real, dimension(1:2) :: albi !surface albedo (diffuse) + real, dimension(1:2) :: fabd !flux abs by veg (per unit direct flux) + real, dimension(1:2) :: fabi !flux abs by veg (per unit diffuse flux) + real, dimension(1:2) :: ftdd !down direct flux below veg (per unit dir flux) + real, dimension(1:2) :: ftid !down diffuse flux below veg (per unit dir flux) + real, dimension(1:2) :: ftii !down diffuse flux below veg (per unit dif flux) +!jref:start + real, dimension(1:2) :: frevi + real, dimension(1:2) :: frevd + real, dimension(1:2) :: fregi + real, dimension(1:2) :: fregd +!jref:end + + real :: fsha !shaded fraction of canopy + real :: vai !total lai + stem area index, one sided + + real,parameter :: mpe = 1.e-6 + logical veg !true: vegetated for surface temperature calculation + +! -------------------------------------------------------------------------------------------------- + +! surface abeldo + + call albedo (parameters,vegtyp ,ist ,ice ,nsoil , & !in + dt ,cosz ,fage ,elai ,esai , & !in + tg ,tv ,snowh ,fsno ,fwet , & !in + smc ,sneqvo ,sneqv ,qsnow ,fveg , & !in + iloc ,jloc , & !in + albold ,tauss , & !inout + albgrd ,albgri ,albd ,albi ,fabd , & !out + fabi ,ftdd ,ftid ,ftii ,fsun , & !) !out + frevi ,frevd ,fregd ,fregi ,bgap , & !inout + wgap) + +! surface radiation + + fsha = 1.-fsun + laisun = elai*fsun + laisha = elai*fsha + vai = elai+ esai + if (vai .gt. 0.) then + veg = .true. + else + veg = .false. + end if + + call surrad (parameters,mpe ,fsun ,fsha ,elai ,vai , & !in + laisun ,laisha ,solad ,solai ,fabd , & !in + fabi ,ftdd ,ftid ,ftii ,albgrd , & !in + albgri ,albd ,albi ,iloc ,jloc , & !in + parsun ,parsha ,sav ,sag ,fsa , & !out + fsr , & !out + frevi ,frevd ,fregd ,fregi ,fsrv , & !inout + fsrg) + + end subroutine radiation + +!== begin albedo =================================================================================== + +!>\ingroup NoahMP_LSM + subroutine albedo (parameters,vegtyp ,ist ,ice ,nsoil , & !in + dt ,cosz ,fage ,elai ,esai , & !in + tg ,tv ,snowh ,fsno ,fwet , & !in + smc ,sneqvo ,sneqv ,qsnow ,fveg , & !in + iloc ,jloc , & !in + albold ,tauss , & !inout + albgrd ,albgri ,albd ,albi ,fabd , & !out + fabi ,ftdd ,ftid ,ftii ,fsun , & !out + frevi ,frevd ,fregd ,fregi ,bgap , & !out + wgap) + +! -------------------------------------------------------------------------------------------------- +! surface albedos. also fluxes (per unit incoming direct and diffuse +! radiation) reflected, transmitted, and absorbed by vegetation. +! also sunlit fraction of the canopy. +! -------------------------------------------------------------------------------------------------- + implicit none +! -------------------------------------------------------------------------------------------------- +! input + type (noahmp_parameters), intent(in) :: parameters + integer, intent(in) :: iloc + integer, intent(in) :: jloc + integer, intent(in) :: nsoil !number of soil layers + integer, intent(in) :: vegtyp !vegetation type + integer, intent(in) :: ist !surface type + integer, intent(in) :: ice !ice (ice = 1) + + real, intent(in) :: dt !time step [sec] + real, intent(in) :: qsnow !snowfall + real, intent(in) :: cosz !cosine solar zenith angle for next time step + real, intent(in) :: snowh !snow height (mm) + real, intent(in) :: tg !ground temperature (k) + real, intent(in) :: tv !vegetation temperature (k) + real, intent(in) :: elai !lai, one-sided, adjusted for burying by snow + real, intent(in) :: esai !sai, one-sided, adjusted for burying by snow + real, intent(in) :: fsno !fraction of grid covered by snow + real, intent(in) :: fwet !fraction of canopy that is wet + real, intent(in) :: sneqvo !snow mass at last time step(mm) + real, intent(in) :: sneqv !snow mass (mm) + real, intent(in) :: fveg !green vegetation fraction [0.0-1.0] + real, dimension(1:nsoil), intent(in) :: smc !volumetric soil water (m3/m3) + +! inout + real, intent(inout) :: albold !snow albedo at last time step (class type) + real, intent(inout) :: tauss !non-dimensional snow age + +! output + real, dimension(1: 2), intent(out) :: albgrd !ground albedo (direct) + real, dimension(1: 2), intent(out) :: albgri !ground albedo (diffuse) + real, dimension(1: 2), intent(out) :: albd !surface albedo (direct) + real, dimension(1: 2), intent(out) :: albi !surface albedo (diffuse) + real, dimension(1: 2), intent(out) :: fabd !flux abs by veg (per unit direct flux) + real, dimension(1: 2), intent(out) :: fabi !flux abs by veg (per unit diffuse flux) + real, dimension(1: 2), intent(out) :: ftdd !down direct flux below veg (per unit dir flux) + real, dimension(1: 2), intent(out) :: ftid !down diffuse flux below veg (per unit dir flux) + real, dimension(1: 2), intent(out) :: ftii !down diffuse flux below veg (per unit dif flux) + real, intent(out) :: fsun !sunlit fraction of canopy (-) +!jref:start + real, dimension(1: 2), intent(out) :: frevd + real, dimension(1: 2), intent(out) :: frevi + real, dimension(1: 2), intent(out) :: fregd + real, dimension(1: 2), intent(out) :: fregi + real, intent(out) :: bgap + real, intent(out) :: wgap +!jref:end + +! ------------------------------------------------------------------------ +! ------------------------ local variables ------------------------------- +! local + real :: fage !snow age function + real :: alb + integer :: ib !indices + integer :: nband !number of solar radiation wave bands + integer :: ic !direct beam: ic=0; diffuse: ic=1 + + real :: wl !fraction of lai+sai that is lai + real :: ws !fraction of lai+sai that is sai + real :: mpe !prevents overflow for division by zero + + real, dimension(1:2) :: rho !leaf/stem reflectance weighted by fraction lai and sai + real, dimension(1:2) :: tau !leaf/stem transmittance weighted by fraction lai and sai + real, dimension(1:2) :: ftdi !down direct flux below veg per unit dif flux = 0 + real, dimension(1:2) :: albsnd !snow albedo (direct) + real, dimension(1:2) :: albsni !snow albedo (diffuse) + + real :: vai !elai+esai + real :: gdir !average projected leaf/stem area in solar direction + real :: ext !optical depth direct beam per unit leaf + stem area + +! -------------------------------------------------------------------------------------------------- + + nband = 2 + mpe = 1.e-06 + bgap = 0. + wgap = 0. + +! initialize output because solar radiation only done if cosz > 0 + + do ib = 1, nband + albd(ib) = 0. + albi(ib) = 0. + albgrd(ib) = 0. + albgri(ib) = 0. + fabd(ib) = 0. + fabi(ib) = 0. + ftdd(ib) = 0. + ftid(ib) = 0. + ftii(ib) = 0. + if (ib.eq.1) fsun = 0. + end do + + if(cosz <= 0) goto 100 + +! weight reflectance/transmittance by lai and sai + + do ib = 1, nband + vai = elai + esai + wl = elai / max(vai,mpe) + ws = esai / max(vai,mpe) + rho(ib) = max(parameters%rhol(ib)*wl+parameters%rhos(ib)*ws, mpe) + tau(ib) = max(parameters%taul(ib)*wl+parameters%taus(ib)*ws, mpe) + end do + +! snow age + + call snow_age (parameters,dt,tg,sneqvo,sneqv,tauss,fage) + +! snow albedos: only if cosz > 0 and fsno > 0 + + if(opt_alb == 1) & + call snowalb_bats (parameters,nband, fsno,cosz,fage,albsnd,albsni) + if(opt_alb == 2) then + call snowalb_class (parameters,nband,qsnow,dt,alb,albold,albsnd,albsni,iloc,jloc) + albold = alb + end if + +! ground surface albedo + + call groundalb (parameters,nsoil ,nband ,ice ,ist , & !in + fsno ,smc ,albsnd ,albsni ,cosz , & !in + tg ,iloc ,jloc , & !in + albgrd ,albgri ) !out + +! loop over nband wavebands to calculate surface albedos and solar +! fluxes for unit incoming direct (ic=0) and diffuse flux (ic=1) + + do ib = 1, nband + ic = 0 ! direct + call twostream (parameters,ib ,ic ,vegtyp ,cosz ,vai , & !in + fwet ,tv ,albgrd ,albgri ,rho , & !in + tau ,fveg ,ist ,iloc ,jloc , & !in + fabd ,albd ,ftdd ,ftid ,gdir , &!) !out + frevd ,fregd ,bgap ,wgap) + + ic = 1 ! diffuse + call twostream (parameters,ib ,ic ,vegtyp ,cosz ,vai , & !in + fwet ,tv ,albgrd ,albgri ,rho , & !in + tau ,fveg ,ist ,iloc ,jloc , & !in + fabi ,albi ,ftdi ,ftii ,gdir , & !) !out + frevi ,fregi ,bgap ,wgap) + + end do + +! sunlit fraction of canopy. set fsun = 0 if fsun < 0.01. + + ext = gdir/cosz * sqrt(1.-rho(1)-tau(1)) + fsun = (1.-exp(-ext*vai)) / max(ext*vai,mpe) + ext = fsun + + if (ext .lt. 0.01) then + wl = 0. + else + wl = ext + end if + fsun = wl + +100 continue + + end subroutine albedo + +!== begin surrad =================================================================================== + +!>\ingroup NoahMP_LSM + subroutine surrad (parameters,mpe ,fsun ,fsha ,elai ,vai , & !in + laisun ,laisha ,solad ,solai ,fabd , & !in + fabi ,ftdd ,ftid ,ftii ,albgrd , & !in + albgri ,albd ,albi ,iloc ,jloc , & !in + parsun ,parsha ,sav ,sag ,fsa , & !out + fsr , & !) !out + frevi ,frevd ,fregd ,fregi ,fsrv , & + fsrg) !inout + +! -------------------------------------------------------------------------------------------------- + implicit none +! -------------------------------------------------------------------------------------------------- +! input + + type (noahmp_parameters), intent(in) :: parameters + integer, intent(in) :: iloc + integer, intent(in) :: jloc + real, intent(in) :: mpe !prevents underflow errors if division by zero + + real, intent(in) :: fsun !sunlit fraction of canopy + real, intent(in) :: fsha !shaded fraction of canopy + real, intent(in) :: elai !leaf area, one-sided + real, intent(in) :: vai !leaf + stem area, one-sided + real, intent(in) :: laisun !sunlit leaf area index, one-sided + real, intent(in) :: laisha !shaded leaf area index, one-sided + + real, dimension(1:2), intent(in) :: solad !incoming direct solar radiation (w/m2) + real, dimension(1:2), intent(in) :: solai !incoming diffuse solar radiation (w/m2) + real, dimension(1:2), intent(in) :: fabd !flux abs by veg (per unit incoming direct flux) + real, dimension(1:2), intent(in) :: fabi !flux abs by veg (per unit incoming diffuse flux) + real, dimension(1:2), intent(in) :: ftdd !down dir flux below veg (per incoming dir flux) + real, dimension(1:2), intent(in) :: ftid !down dif flux below veg (per incoming dir flux) + real, dimension(1:2), intent(in) :: ftii !down dif flux below veg (per incoming dif flux) + real, dimension(1:2), intent(in) :: albgrd !ground albedo (direct) + real, dimension(1:2), intent(in) :: albgri !ground albedo (diffuse) + real, dimension(1:2), intent(in) :: albd !overall surface albedo (direct) + real, dimension(1:2), intent(in) :: albi !overall surface albedo (diffuse) + + real, dimension(1:2), intent(in) :: frevd !overall surface albedo veg (direct) + real, dimension(1:2), intent(in) :: frevi !overall surface albedo veg (diffuse) + real, dimension(1:2), intent(in) :: fregd !overall surface albedo grd (direct) + real, dimension(1:2), intent(in) :: fregi !overall surface albedo grd (diffuse) + +! output + + real, intent(out) :: parsun !average absorbed par for sunlit leaves (w/m2) + real, intent(out) :: parsha !average absorbed par for shaded leaves (w/m2) + real, intent(out) :: sav !solar radiation absorbed by vegetation (w/m2) + real, intent(out) :: sag !solar radiation absorbed by ground (w/m2) + real, intent(out) :: fsa !total absorbed solar radiation (w/m2) + real, intent(out) :: fsr !total reflected solar radiation (w/m2) + real, intent(out) :: fsrv !reflected solar radiation by vegetation + real, intent(out) :: fsrg !reflected solar radiation by ground + +! ------------------------ local variables ---------------------------------------------------- + integer :: ib !waveband number (1=vis, 2=nir) + integer :: nband !number of solar radiation waveband classes + + real :: abs !absorbed solar radiation (w/m2) + real :: rnir !reflected solar radiation [nir] (w/m2) + real :: rvis !reflected solar radiation [vis] (w/m2) + real :: laifra !leaf area fraction of canopy + real :: trd !transmitted solar radiation: direct (w/m2) + real :: tri !transmitted solar radiation: diffuse (w/m2) + real, dimension(1:2) :: cad !direct beam absorbed by canopy (w/m2) + real, dimension(1:2) :: cai !diffuse radiation absorbed by canopy (w/m2) +! --------------------------------------------------------------------------------------------- + nband = 2 + +! zero summed solar fluxes + + sag = 0. + sav = 0. + fsa = 0. + +! loop over nband wavebands + + do ib = 1, nband + +! absorbed by canopy + + cad(ib) = solad(ib)*fabd(ib) + cai(ib) = solai(ib)*fabi(ib) + sav = sav + cad(ib) + cai(ib) + fsa = fsa + cad(ib) + cai(ib) + +! transmitted solar fluxes incident on ground + + trd = solad(ib)*ftdd(ib) + tri = solad(ib)*ftid(ib) + solai(ib)*ftii(ib) + +! solar radiation absorbed by ground surface + + abs = trd*(1.-albgrd(ib)) + tri*(1.-albgri(ib)) + sag = sag + abs + fsa = fsa + abs + end do + +! partition visible canopy absorption to sunlit and shaded fractions +! to get average absorbed par for sunlit and shaded leaves + + laifra = elai / max(vai,mpe) + if (fsun .gt. 0.) then + parsun = (cad(1)+fsun*cai(1)) * laifra / max(laisun,mpe) + parsha = (fsha*cai(1))*laifra / max(laisha,mpe) + else + parsun = 0. + parsha = (cad(1)+cai(1))*laifra /max(laisha,mpe) + endif + +! reflected solar radiation + + rvis = albd(1)*solad(1) + albi(1)*solai(1) + rnir = albd(2)*solad(2) + albi(2)*solai(2) + fsr = rvis + rnir + +! reflected solar radiation of veg. and ground (combined ground) + fsrv = frevd(1)*solad(1)+frevi(1)*solai(1)+frevd(2)*solad(2)+frevi(2)*solai(2) + fsrg = fregd(1)*solad(1)+fregi(1)*solai(1)+fregd(2)*solad(2)+fregi(2)*solai(2) + + + end subroutine surrad + +!== begin snow_age ================================================================================= + +!>\ingroup NoahMP_LSM + subroutine snow_age (parameters,dt,tg,sneqvo,sneqv,tauss,fage) +! ---------------------------------------------------------------------- + implicit none +! ------------------------ code history ------------------------------------------------------------ +! from bats +! ------------------------ input/output variables -------------------------------------------------- +!input + type (noahmp_parameters), intent(in) :: parameters + real, intent(in) :: dt !main time step (s) + real, intent(in) :: tg !ground temperature (k) + real, intent(in) :: sneqvo !snow mass at last time step(mm) + real, intent(in) :: sneqv !snow water per unit ground area (mm) + +!output + real, intent(out) :: fage !snow age + +!input/output + real, intent(inout) :: tauss !non-dimensional snow age +!local + real :: tage !total aging effects + real :: age1 !effects of grain growth due to vapor diffusion + real :: age2 !effects of grain growth at freezing of melt water + real :: age3 !effects of soot + real :: dela !temporary variable + real :: sge !temporary variable + real :: dels !temporary variable + real :: dela0 !temporary variable + real :: arg !temporary variable +! see yang et al. (1997) j.of climate for detail. +!--------------------------------------------------------------------------------------------------- + + if(sneqv.le.0.0) then + tauss = 0. + else if (sneqv.gt.800.) then + tauss = 0. + else + dela0 = 1.e-6*dt + arg = 5.e3*(1./tfrz-1./tg) + age1 = exp(arg) + age2 = exp(amin1(0.,10.*arg)) + age3 = 0.3 + tage = age1+age2+age3 + dela = dela0*tage + dels = amax1(0.0,sneqv-sneqvo) / parameters%swemx + sge = (tauss+dela)*(1.0-dels) + tauss = amax1(0.,sge) + endif + + fage= tauss/(tauss+1.) + + end subroutine snow_age + +!== begin snowalb_bats ============================================================================= + +!>\ingroup NoahMP_LSM + subroutine snowalb_bats (parameters,nband,fsno,cosz,fage,albsnd,albsni) +! -------------------------------------------------------------------------------------------------- + implicit none +! -------------------------------------------------------------------------------------------------- +! input + + type (noahmp_parameters), intent(in) :: parameters + integer,intent(in) :: nband !number of waveband classes + + real,intent(in) :: cosz !cosine solar zenith angle + real,intent(in) :: fsno !snow cover fraction (-) + real,intent(in) :: fage !snow age correction + +! output + + real, dimension(1:2),intent(out) :: albsnd !snow albedo for direct(1=vis, 2=nir) + real, dimension(1:2),intent(out) :: albsni !snow albedo for diffuse +! --------------------------------------------------------------------------------------------- + +! ------------------------ local variables ---------------------------------------------------- + integer :: ib !waveband class + + real :: fzen !zenith angle correction + real :: cf1 !temperary variable + real :: sl2 !2.*sl + real :: sl1 !1/sl + real :: sl !adjustable parameter + real, parameter :: c1 = 0.2 !default in bats + real, parameter :: c2 = 0.5 !default in bats +! real, parameter :: c1 = 0.2 * 2. ! double the default to match sleepers river's +! real, parameter :: c2 = 0.5 * 2. ! snow surface albedo (double aging effects) +! --------------------------------------------------------------------------------------------- +! zero albedos for all points + + albsnd(1: nband) = 0. + albsni(1: nband) = 0. + +! when cosz > 0 + + sl=2.0 + sl1=1./sl + sl2=2.*sl + cf1=((1.+sl1)/(1.+sl2*cosz)-sl1) + fzen=amax1(cf1,0.) + + albsni(1)=0.95*(1.-c1*fage) + albsni(2)=0.65*(1.-c2*fage) + + albsnd(1)=albsni(1)+0.4*fzen*(1.-albsni(1)) ! vis direct + albsnd(2)=albsni(2)+0.4*fzen*(1.-albsni(2)) ! nir direct + + end subroutine snowalb_bats + +!== begin snowalb_class ============================================================================ + +!>\ingroup NoahMP_LSM + subroutine snowalb_class (parameters,nband,qsnow,dt,alb,albold,albsnd,albsni,iloc,jloc) +! ---------------------------------------------------------------------- + implicit none +! -------------------------------------------------------------------------------------------------- +! input + + type (noahmp_parameters), intent(in) :: parameters + integer,intent(in) :: iloc !grid index + integer,intent(in) :: jloc !grid index + integer,intent(in) :: nband !number of waveband classes + + real,intent(in) :: qsnow !snowfall (mm/s) + real,intent(in) :: dt !time step (sec) + real,intent(in) :: albold !snow albedo at last time step + +! in & out + + real, intent(inout) :: alb ! +! output + + real, dimension(1:2),intent(out) :: albsnd !snow albedo for direct(1=vis, 2=nir) + real, dimension(1:2),intent(out) :: albsni !snow albedo for diffuse +! --------------------------------------------------------------------------------------------- + +! ------------------------ local variables ---------------------------------------------------- + integer :: ib !waveband class + +! --------------------------------------------------------------------------------------------- +! zero albedos for all points + + albsnd(1: nband) = 0. + albsni(1: nband) = 0. + +! when cosz > 0 + + alb = 0.55 + (albold-0.55) * exp(-0.01*dt/3600.) + +! 1 mm fresh snow(swe) -- 10mm snow depth, assumed the fresh snow density 100kg/m3 +! here assume 1cm snow depth will fully cover the old snow + + if (qsnow > 0.) then + alb = alb + min(qsnow,parameters%swemx/dt) * (0.84-alb)/(parameters%swemx/dt) + endif + + albsni(1)= alb ! vis diffuse + albsni(2)= alb ! nir diffuse + albsnd(1)= alb ! vis direct + albsnd(2)= alb ! nir direct + + end subroutine snowalb_class + +!== begin groundalb ================================================================================ + +!>\ingroup NoahMP_LSM + subroutine groundalb (parameters,nsoil ,nband ,ice ,ist , & !in + fsno ,smc ,albsnd ,albsni ,cosz , & !in + tg ,iloc ,jloc , & !in + albgrd ,albgri ) !out +! -------------------------------------------------------------------------------------------------- + implicit none +! -------------------------------------------------------------------------------------------------- +!input + + type (noahmp_parameters), intent(in) :: parameters + integer, intent(in) :: iloc !grid index + integer, intent(in) :: jloc !grid index + integer, intent(in) :: nsoil !number of soil layers + integer, intent(in) :: nband !number of solar radiation waveband classes + integer, intent(in) :: ice !value of ist for land ice + integer, intent(in) :: ist !surface type + real, intent(in) :: fsno !fraction of surface covered with snow (-) + real, intent(in) :: tg !ground temperature (k) + real, intent(in) :: cosz !cosine solar zenith angle (0-1) + real, dimension(1:nsoil), intent(in) :: smc !volumetric soil water content (m3/m3) + real, dimension(1: 2), intent(in) :: albsnd !direct beam snow albedo (vis, nir) + real, dimension(1: 2), intent(in) :: albsni !diffuse snow albedo (vis, nir) + +!output + + real, dimension(1: 2), intent(out) :: albgrd !ground albedo (direct beam: vis, nir) + real, dimension(1: 2), intent(out) :: albgri !ground albedo (diffuse: vis, nir) + +!local + + integer :: ib !waveband number (1=vis, 2=nir) + real :: inc !soil water correction factor for soil albedo + real :: albsod !soil albedo (direct) + real :: albsoi !soil albedo (diffuse) +! -------------------------------------------------------------------------------------------------- + + do ib = 1, nband + inc = max(0.11-0.40*smc(1), 0.) + if (ist .eq. 1) then !soil + albsod = min(parameters%albsat(ib)+inc,parameters%albdry(ib)) + albsoi = albsod + else if (tg .gt. tfrz) then !unfrozen lake, wetland + albsod = 0.06/(max(0.01,cosz)**1.7 + 0.15) + albsoi = 0.06 + else !frozen lake, wetland + albsod = parameters%alblak(ib) + albsoi = albsod + end if + +! increase desert and semi-desert albedos + +! if (ist .eq. 1 .and. isc .eq. 9) then +! albsod = albsod + 0.10 +! albsoi = albsoi + 0.10 +! end if + + albgrd(ib) = albsod*(1.-fsno) + albsnd(ib)*fsno + albgri(ib) = albsoi*(1.-fsno) + albsni(ib)*fsno + end do + + end subroutine groundalb + +!== begin twostream ================================================================================ + +!>\ingroup NoahMP_LSM + subroutine twostream (parameters,ib ,ic ,vegtyp ,cosz ,vai , & !in + fwet ,t ,albgrd ,albgri ,rho , & !in + tau ,fveg ,ist ,iloc ,jloc , & !in + fab ,fre ,ftd ,fti ,gdir , & !) !out + frev ,freg ,bgap ,wgap) + +! -------------------------------------------------------------------------------------------------- +! use two-stream approximation of dickinson (1983) adv geophysics +! 25:305-353 and sellers (1985) int j remote sensing 6:1335-1372 +! to calculate fluxes absorbed by vegetation, reflected by vegetation, +! and transmitted through vegetation for unit incoming direct or diffuse +! flux given an underlying surface with known albedo. +! -------------------------------------------------------------------------------------------------- + implicit none +! -------------------------------------------------------------------------------------------------- +! input + + type (noahmp_parameters), intent(in) :: parameters + integer, intent(in) :: iloc !grid index + integer, intent(in) :: jloc !grid index + integer, intent(in) :: ist !surface type + integer, intent(in) :: ib !waveband number + integer, intent(in) :: ic !0=unit incoming direct; 1=unit incoming diffuse + integer, intent(in) :: vegtyp !vegetation type + + real, intent(in) :: cosz !cosine of direct zenith angle (0-1) + real, intent(in) :: vai !one-sided leaf+stem area index (m2/m2) + real, intent(in) :: fwet !fraction of lai, sai that is wetted (-) + real, intent(in) :: t !surface temperature (k) + + real, dimension(1:2), intent(in) :: albgrd !direct albedo of underlying surface (-) + real, dimension(1:2), intent(in) :: albgri !diffuse albedo of underlying surface (-) + real, dimension(1:2), intent(in) :: rho !leaf+stem reflectance + real, dimension(1:2), intent(in) :: tau !leaf+stem transmittance + real, intent(in) :: fveg !green vegetation fraction [0.0-1.0] + +! output + + real, dimension(1:2), intent(out) :: fab !flux abs by veg layer (per unit incoming flux) + real, dimension(1:2), intent(out) :: fre !flux refl above veg layer (per unit incoming flux) + real, dimension(1:2), intent(out) :: ftd !down dir flux below veg layer (per unit in flux) + real, dimension(1:2), intent(out) :: fti !down dif flux below veg layer (per unit in flux) + real, intent(out) :: gdir !projected leaf+stem area in solar direction + real, dimension(1:2), intent(out) :: frev !flux reflected by veg layer (per unit incoming flux) + real, dimension(1:2), intent(out) :: freg !flux reflected by ground (per unit incoming flux) + +! local + real :: omega !fraction of intercepted radiation that is scattered + real :: omegal !omega for leaves + real :: betai !upscatter parameter for diffuse radiation + real :: betail !betai for leaves + real :: betad !upscatter parameter for direct beam radiation + real :: betadl !betad for leaves + real :: ext !optical depth of direct beam per unit leaf area + real :: avmu !average diffuse optical depth + + real :: coszi !0.001 <= cosz <= 1.000 + real :: asu !single scattering albedo + real :: chil ! -0.4 <= xl <= 0.6 + + real :: tmp0,tmp1,tmp2,tmp3,tmp4,tmp5,tmp6,tmp7,tmp8,tmp9 + real :: p1,p2,p3,p4,s1,s2,u1,u2,u3 + real :: b,c,d,d1,d2,f,h,h1,h2,h3,h4,h5,h6,h7,h8,h9,h10 + real :: phi1,phi2,sigma + real :: ftds,ftis,fres + real :: denfveg + real :: vai_spread +!jref:start + real :: freveg,frebar,ftdveg,ftiveg,ftdbar,ftibar + real :: thetaz +!jref:end + +! variables for the modified two-stream scheme +! niu and yang (2004), jgr + + real, parameter :: pai = 3.14159265 + real :: hd !crown depth (m) + real :: bb !vertical crown radius (m) + real :: thetap !angle conversion from sza + real :: fa !foliage volume density (m-1) + real :: newvai !effective lsai (-) + + real,intent(inout) :: bgap !between canopy gap fraction for beam (-) + real,intent(inout) :: wgap !within canopy gap fraction for beam (-) + + real :: kopen !gap fraction for diffue light (-) + real :: gap !total gap fraction for beam ( <=1-shafac ) + +! ----------------------------------------------------------------- +! compute within and between gaps + vai_spread = vai + if(vai == 0.0) then + gap = 1.0 + kopen = 1.0 + else + if(opt_rad == 1) then + denfveg = -log(max(1.0-fveg,0.01))/(pai*parameters%rc**2) + hd = parameters%hvt - parameters%hvb + bb = 0.5 * hd + thetap = atan(bb/parameters%rc * tan(acos(max(0.01,cosz))) ) + ! bgap = exp(-parameters%den * pai * parameters%rc**2/cos(thetap) ) + bgap = exp(-denfveg * pai * parameters%rc**2/cos(thetap) ) + fa = vai/(1.33 * pai * parameters%rc**3.0 *(bb/parameters%rc)*denfveg) + newvai = hd*fa + wgap = (1.0-bgap) * exp(-0.5*newvai/cosz) + gap = min(1.0-fveg, bgap+wgap) + + kopen = 0.05 + end if + + if(opt_rad == 2) then + gap = 0.0 + kopen = 0.0 + end if + + if(opt_rad == 3) then + gap = 1.0-fveg + kopen = 1.0-fveg + end if + end if + +! calculate two-stream parameters omega, betad, betai, avmu, gdir, ext. +! omega, betad, betai are adjusted for snow. values for omega*betad +! and omega*betai are calculated and then divided by the new omega +! because the product omega*betai, omega*betad is used in solution. +! also, the transmittances and reflectances (tau, rho) are linear +! weights of leaf and stem values. + + coszi = max(0.001, cosz) + chil = min( max(parameters%xl, -0.4), 0.6) + if (abs(chil) .le. 0.01) chil = 0.01 + phi1 = 0.5 - 0.633*chil - 0.330*chil*chil + phi2 = 0.877 * (1.-2.*phi1) + gdir = phi1 + phi2*coszi + ext = gdir/coszi + avmu = ( 1. - phi1/phi2 * log((phi1+phi2)/phi1) ) / phi2 + omegal = rho(ib) + tau(ib) + tmp0 = gdir + phi2*coszi + tmp1 = phi1*coszi + asu = 0.5*omegal*gdir/tmp0 * ( 1.-tmp1/tmp0*log((tmp1+tmp0)/tmp1) ) + betadl = (1.+avmu*ext)/(omegal*avmu*ext)*asu + betail = 0.5 * ( rho(ib)+tau(ib) + (rho(ib)-tau(ib)) & + * ((1.+chil)/2.)**2 ) / omegal + +! adjust omega, betad, and betai for intercepted snow + + if (t .gt. tfrz) then !no snow + tmp0 = omegal + tmp1 = betadl + tmp2 = betail + else + tmp0 = (1.-fwet)*omegal + fwet*parameters%omegas(ib) + tmp1 = ( (1.-fwet)*omegal*betadl + fwet*parameters%omegas(ib)*parameters%betads ) / tmp0 + tmp2 = ( (1.-fwet)*omegal*betail + fwet*parameters%omegas(ib)*parameters%betais ) / tmp0 + end if + + omega = tmp0 + betad = tmp1 + betai = tmp2 + +! absorbed, reflected, transmitted fluxes per unit incoming radiation + + b = 1. - omega + omega*betai + c = omega*betai + tmp0 = avmu*ext + d = tmp0 * omega*betad + f = tmp0 * omega*(1.-betad) + tmp1 = b*b - c*c + h = sqrt(tmp1) / avmu + sigma = tmp0*tmp0 - tmp1 + if ( abs (sigma) < 1.e-6 ) sigma = sign(1.e-6,sigma) + p1 = b + avmu*h + p2 = b - avmu*h + p3 = b + tmp0 + p4 = b - tmp0 + s1 = exp(-h*vai) + s2 = exp(-ext*vai) + if (ic .eq. 0) then + u1 = b - c/albgrd(ib) + u2 = b - c*albgrd(ib) + u3 = f + c*albgrd(ib) + else + u1 = b - c/albgri(ib) + u2 = b - c*albgri(ib) + u3 = f + c*albgri(ib) + end if + tmp2 = u1 - avmu*h + tmp3 = u1 + avmu*h + d1 = p1*tmp2/s1 - p2*tmp3*s1 + tmp4 = u2 + avmu*h + tmp5 = u2 - avmu*h + d2 = tmp4/s1 - tmp5*s1 + h1 = -d*p4 - c*f + tmp6 = d - h1*p3/sigma + tmp7 = ( d - c - h1/sigma*(u1+tmp0) ) * s2 + h2 = ( tmp6*tmp2/s1 - p2*tmp7 ) / d1 + h3 = - ( tmp6*tmp3*s1 - p1*tmp7 ) / d1 + h4 = -f*p3 - c*d + tmp8 = h4/sigma + tmp9 = ( u3 - tmp8*(u2-tmp0) ) * s2 + h5 = - ( tmp8*tmp4/s1 + tmp9 ) / d2 + h6 = ( tmp8*tmp5*s1 + tmp9 ) / d2 + h7 = (c*tmp2) / (d1*s1) + h8 = (-c*tmp3*s1) / d1 + h9 = tmp4 / (d2*s1) + h10 = (-tmp5*s1) / d2 + +! downward direct and diffuse fluxes below vegetation +! niu and yang (2004), jgr. + + if (ic .eq. 0) then + ftds = s2 *(1.0-gap) + gap + ftis = (h4*s2/sigma + h5*s1 + h6/s1)*(1.0-gap) + else + ftds = 0. + ftis = (h9*s1 + h10/s1)*(1.0-kopen) + kopen + end if + ftd(ib) = ftds + fti(ib) = ftis + +! flux reflected by the surface (veg. and ground) + + if (ic .eq. 0) then + fres = (h1/sigma + h2 + h3)*(1.0-gap ) + albgrd(ib)*gap + freveg = (h1/sigma + h2 + h3)*(1.0-gap ) + frebar = albgrd(ib)*gap !jref - separate veg. and ground reflection + else + fres = (h7 + h8) *(1.0-kopen) + albgri(ib)*kopen + freveg = (h7 + h8) *(1.0-kopen) + albgri(ib)*kopen + frebar = 0 !jref - separate veg. and ground reflection + end if + fre(ib) = fres + + frev(ib) = freveg + freg(ib) = frebar + +! flux absorbed by vegetation + + fab(ib) = 1. - fre(ib) - (1.-albgrd(ib))*ftd(ib) & + - (1.-albgri(ib))*fti(ib) + +!if(iloc == 1.and.jloc == 2) then +! write(*,'(a7,2i2,5(a6,f8.4),2(a9,f8.4))') "ib,ic: ",ib,ic," gap: ",gap," ftd: ",ftd(ib)," fti: ",fti(ib)," fre: ", & +! fre(ib)," fab: ",fab(ib)," albgrd: ",albgrd(ib)," albgri: ",albgri(ib) +!end if + + end subroutine twostream + +!== begin vege_flux ================================================================================ + +!>\ingroup NoahMP_LSM + subroutine vege_flux(parameters,nsnow ,nsoil ,isnow ,vegtyp ,veg , & !in + dt ,sav ,sag ,lwdn ,ur , & !in + uu ,vv ,sfctmp ,thair ,qair , & !in + eair ,rhoair ,snowh ,vai ,gammav ,gammag, & !in + fwet ,laisun ,laisha ,cwp ,dzsnso , & !in + zlvl ,cpfac , & !in + 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 +#ifdef CCPP + ch ,dx ,dz8w ,errmsg ,errflg , & !inout +#else + ch ,dx ,dz8w , & !inout +#endif + tauxv ,tauyv ,irg ,irc ,shg , & !out + shc ,evg ,evc ,tr ,gh , & !out + t2mv ,psnsun ,psnsha , & !out + qc ,qsfc ,psfc , & !in + q2v ,cah2 ,chleaf ,chuc ) !inout + +! -------------------------------------------------------------------------------------------------- +! use newton-raphson iteration to solve for vegetation (tv) and +! ground (tg) temperatures that balance the surface energy budgets + +! vegetated: +! -sav + irc[tv] + shc[tv] + evc[tv] + tr[tv] = 0 +! -sag + irg[tg] + shg[tg] + evg[tg] + gh[tg] = 0 +! -------------------------------------------------------------------------------------------------- + implicit none +! -------------------------------------------------------------------------------------------------- +! input + type (noahmp_parameters), intent(in) :: parameters + integer, intent(in) :: iloc !grid index + integer, intent(in) :: jloc !grid index + logical, intent(in) :: veg !true if vegetated surface + integer, intent(in) :: nsnow !maximum no. of snow layers + integer, intent(in) :: nsoil !number of soil layers + integer, intent(in) :: isnow !actual no. of snow layers + integer, intent(in) :: vegtyp !vegetation physiology type + real, intent(in) :: fveg !greeness vegetation fraction (-) + real, intent(in) :: sav !solar rad absorbed by veg (w/m2) + real, intent(in) :: sag !solar rad absorbed by ground (w/m2) + real, intent(in) :: lwdn !atmospheric longwave radiation (w/m2) + real, intent(in) :: ur !wind speed at height zlvl (m/s) + real, intent(in) :: uu !wind speed in eastward dir (m/s) + real, intent(in) :: vv !wind speed in northward dir (m/s) + real, intent(in) :: sfctmp !air temperature at reference height (k) + real, intent(in) :: thair !potential temp at reference height (k) + real, intent(in) :: eair !vapor pressure air at zlvl (pa) + real, intent(in) :: qair !specific humidity at zlvl (kg/kg) + real, intent(in) :: rhoair !density air (kg/m**3) + real, intent(in) :: dt !time step (s) + real, intent(in) :: fsno !snow fraction + + real, intent(in) :: snowh !actual snow depth [m] + real, intent(in) :: fwet !wetted fraction of canopy + real, intent(in) :: cwp !canopy wind parameter + + real, intent(in) :: vai !total leaf area index + stem area index + real, intent(in) :: laisun !sunlit leaf area index, one-sided (m2/m2) + real, intent(in) :: laisha !shaded leaf area index, one-sided (m2/m2) + real, intent(in) :: zlvl !reference height (m) + real, intent(in) :: cpfac !heat capacity enhancement factor due to heat storage + + real, intent(in) :: zpd !zero plane displacement (m) + real, intent(in) :: z0m !roughness length, momentum (m) + real, intent(in) :: z0mg !roughness length, momentum, ground (m) + real, intent(in) :: emv !vegetation emissivity + real, intent(in) :: emg !ground emissivity + + real, dimension(-nsnow+1:nsoil), intent(in) :: stc !soil/snow temperature (k) + real, dimension(-nsnow+1:nsoil), intent(in) :: df !thermal conductivity of snow/soil (w/m/k) + real, dimension(-nsnow+1:nsoil), intent(in) :: dzsnso !thinkness of snow/soil layers (m) + real, intent(in) :: canliq !intercepted liquid water (mm) + real, intent(in) :: canice !intercepted ice mass (mm) + real, intent(in) :: rsurf !ground surface resistance (s/m) +! real, intent(in) :: gamma !psychrometric constant (pa/k) +! real, intent(in) :: lathea !latent heat of vaporization/subli (j/kg) + real, intent(in) :: gammav !psychrometric constant (pa/k) + real, intent(in) :: latheav !latent heat of vaporization/subli (j/kg) + real, intent(in) :: gammag !psychrometric constant (pa/k) + real, intent(in) :: latheag !latent heat of vaporization/subli (j/kg) + real, intent(in) :: parsun !par absorbed per unit sunlit lai (w/m2) + real, intent(in) :: parsha !par absorbed per unit shaded lai (w/m2) + real, intent(in) :: foln !foliage nitrogen (%) + real, intent(in) :: co2air !atmospheric co2 concentration (pa) + real, intent(in) :: o2air !atmospheric o2 concentration (pa) + real, intent(in) :: igs !growing season index (0=off, 1=on) + real, intent(in) :: sfcprs !pressure (pa) + real, intent(in) :: btran !soil water transpiration factor (0 to 1) + real, intent(in) :: rhsur !raltive humidity in surface soil/snow air space (-) + + real , intent(in) :: qc !cloud water mixing ratio + real , intent(in) :: psfc !pressure at lowest model layer + real , intent(in) :: dx !grid spacing + real , intent(in) :: q2 !mixing ratio (kg/kg) + real , intent(in) :: dz8w !thickness of lowest layer + real , intent(inout) :: qsfc !mixing ratio at lowest model layer + real, intent(in) :: pahv !precipitation advected heat - canopy net in (w/m2) + real, intent(in) :: pahg !precipitation advected heat - ground net in (w/m2) + +! input/output + real, intent(inout) :: eah !canopy air vapor pressure (pa) + real, intent(inout) :: tah !canopy air temperature (k) + real, intent(inout) :: tv !vegetation temperature (k) + real, intent(inout) :: tg !ground temperature (k) + real, intent(inout) :: cm !momentum drag coefficient + real, intent(inout) :: ch !sensible heat exchange coefficient + +#ifdef CCPP + character(len=*), intent(inout) :: errmsg + integer, intent(inout) :: errflg +#endif + +! output +! -fsa + fira + fsh + (fcev + fctr + fgev) + fcst + ssoil = 0 + real, intent(out) :: tauxv !wind stress: e-w (n/m2) + real, intent(out) :: tauyv !wind stress: n-s (n/m2) + real, intent(out) :: irc !net longwave radiation (w/m2) [+= to atm] + real, intent(out) :: shc !sensible heat flux (w/m2) [+= to atm] + real, intent(out) :: evc !evaporation heat flux (w/m2) [+= to atm] + real, intent(out) :: irg !net longwave radiation (w/m2) [+= to atm] + real, intent(out) :: shg !sensible heat flux (w/m2) [+= to atm] + real, intent(out) :: evg !evaporation heat flux (w/m2) [+= to atm] + real, intent(out) :: tr !transpiration heat flux (w/m2)[+= to atm] + real, intent(out) :: gh !ground heat (w/m2) [+ = to soil] + real, intent(out) :: t2mv !2 m height air temperature (k) + real, intent(out) :: psnsun !sunlit leaf photosynthesis (umolco2/m2/s) + real, intent(out) :: psnsha !shaded leaf photosynthesis (umolco2/m2/s) + real, intent(out) :: chleaf !leaf exchange coefficient + real, intent(out) :: chuc !under canopy exchange coefficient + + real, intent(out) :: q2v + real :: cah !sensible heat conductance, canopy air to zlvl air (m/s) + real :: u10v !10 m wind speed in eastward dir (m/s) + real :: v10v !10 m wind speed in eastward dir (m/s) + real :: wspd + +! ------------------------ local variables ---------------------------------------------------- + real :: cw !water vapor exchange coefficient + real :: fv !friction velocity (m/s) + real :: wstar !friction velocity n vertical direction (m/s) (only for sfcdif2) + real :: z0h !roughness length, sensible heat (m) + real :: z0hg !roughness length, sensible heat (m) + real :: rb !bulk leaf boundary layer resistance (s/m) + real :: ramc !aerodynamic resistance for momentum (s/m) + real :: rahc !aerodynamic resistance for sensible heat (s/m) + real :: rawc !aerodynamic resistance for water vapor (s/m) + real :: ramg !aerodynamic resistance for momentum (s/m) + real :: rahg !aerodynamic resistance for sensible heat (s/m) + real :: rawg !aerodynamic resistance for water vapor (s/m) + + real, intent(out) :: rssun !sunlit leaf stomatal resistance (s/m) + real, intent(out) :: rssha !shaded leaf stomatal resistance (s/m) + + real :: mol !monin-obukhov length (m) + real :: dtv !change in tv, last iteration (k) + real :: dtg !change in tg, last iteration (k) + + real :: air,cir !coefficients for ir as function of ts**4 + real :: csh !coefficients for sh as function of ts + real :: cev !coefficients for ev as function of esat[ts] + real :: cgh !coefficients for st as function of ts + real :: atr,ctr !coefficients for tr as function of esat[ts] + real :: ata,bta !coefficients for tah as function of ts + real :: aea,bea !coefficients for eah as function of esat[ts] + + real :: estv !saturation vapor pressure at tv (pa) + real :: estg !saturation vapor pressure at tg (pa) + real :: destv !d(es)/dt at ts (pa/k) + real :: destg !d(es)/dt at tg (pa/k) + real :: esatw !es for water + real :: esati !es for ice + real :: dsatw !d(es)/dt at tg (pa/k) for water + real :: dsati !d(es)/dt at tg (pa/k) for ice + + real :: fm !momentum stability correction, weighted by prior iters + real :: fh !sen heat stability correction, weighted by prior iters + real :: fhg !sen heat stability correction, ground + real :: hcan !canopy height (m) [note: hcan >= z0mg] + + real :: a !temporary calculation + real :: b !temporary calculation + real :: cvh !sensible heat conductance, leaf surface to canopy air (m/s) + real :: caw !latent heat conductance, canopy air zlvl air (m/s) + real :: ctw !transpiration conductance, leaf to canopy air (m/s) + real :: cew !evaporation conductance, leaf to canopy air (m/s) + real :: cgw !latent heat conductance, ground to canopy air (m/s) + real :: cond !sum of conductances (s/m) + real :: uc !wind speed at top of canopy (m/s) + real :: kh !turbulent transfer coefficient, sensible heat, (m2/s) + real :: h !temporary sensible heat flux (w/m2) + real :: hg !temporary sensible heat flux (w/m2) + + real :: moz !monin-obukhov stability parameter + real :: mozg !monin-obukhov stability parameter + real :: mozold !monin-obukhov stability parameter from prior iteration + real :: fm2 !monin-obukhov momentum adjustment at 2m + real :: fh2 !monin-obukhov heat adjustment at 2m + real :: ch2 !surface exchange at 2m + real :: thstar !surface exchange at 2m + + real :: thvair + real :: thah + real :: rahc2 !aerodynamic resistance for sensible heat (s/m) + real :: rawc2 !aerodynamic resistance for water vapor (s/m) + real, intent(out):: cah2 !sensible heat conductance for diagnostics + real :: ch2v !exchange coefficient for 2m over vegetation. + real :: cq2v !exchange coefficient for 2m over vegetation. + real :: eah2 !2m vapor pressure over canopy + real :: qfx !moisture flux + real :: e1 + + + real :: vaie !total leaf area index + stem area index,effective + real :: laisune !sunlit leaf area index, one-sided (m2/m2),effective + real :: laishae !shaded leaf area index, one-sided (m2/m2),effective + + integer :: k !index + integer :: iter !iteration index + +!jref - niterc test from 5 to 20 + integer, parameter :: niterc = 20 !number of iterations for surface temperature +!jref - niterg test from 3-5 + integer, parameter :: niterg = 5 !number of iterations for ground temperature + integer :: mozsgn !number of times moz changes sign + real :: mpe !prevents overflow error if division by zero + + integer :: liter !last iteration + + + real :: t, tdc !kelvin to degree celsius with limit -50 to +50 + + character(len=80) :: message + + tdc(t) = min( 50., max(-50.,(t-tfrz)) ) +! --------------------------------------------------------------------------------------------- + + mpe = 1e-6 + liter = 0 + fv = 0.1 + +! --------------------------------------------------------------------------------------------- +! initialization variables that do not depend on stability iteration +! --------------------------------------------------------------------------------------------- + dtv = 0. + dtg = 0. + moz = 0. + mozsgn = 0 + mozold = 0. + hg = 0. + h = 0. + qfx = 0. + +! YRQ +! write(*,*) 'tv,tg,stc in input:YRQ', tv,tg,stc + +! convert grid-cell lai to the fractional vegetated area (fveg) + + vaie = min(6.,vai / fveg) + laisune = min(6.,laisun / fveg) + laishae = min(6.,laisha / fveg) + +! saturation vapor pressure at ground temperature + + t = tdc(tg) + call esat(t, esatw, esati, dsatw, dsati) + if (t .gt. 0.) then + estg = esatw + else + estg = esati + end if + +!jref - consistent surface specific humidity for sfcdif3 and sfcdif4 + + qsfc = 0.622*eair/(psfc-0.378*eair) + +! canopy height + + hcan = parameters%hvt + uc = ur*log(hcan/z0m)/log(zlvl/z0m) + uc = ur*log((hcan-zpd+z0m)/z0m)/log(zlvl/z0m) ! mb: add zpd v3.7 + if((hcan-zpd) <= 0.) then + write(message,*) "critical problem: hcan <= zpd" +#ifdef CCPP + errmsg = trim(message) +#else + call wrf_message ( message ) +#endif + write(message,*) 'i,j point=',iloc, jloc +#ifdef CCPP + errmsg = trim(errmsg)//NEW_LINE('A')//trim(message) +#else + call wrf_message ( message ) +#endif + write(message,*) 'hcan =',hcan +#ifdef CCPP + errmsg = trim(errmsg)//NEW_LINE('A')//trim(message) +#else + call wrf_message ( message ) +#endif + write(message,*) 'zpd =',zpd +#ifdef CCPP + errmsg = trim(errmsg)//NEW_LINE('A')//trim(message) +#else + call wrf_message ( message ) +#endif + write (message, *) 'snowh =',snowh +#ifdef CCPP + errflg = 1 + errmsg = trim(errmsg)//NEW_LINE('A')//trim(message)//NEW_LINE('A')//"critical problem in module_sf_noahmplsm:vegeflux" + return +#else + call wrf_message ( message ) + call wrf_error_fatal ( "critical problem in module_sf_noahmplsm:vegeflux" ) +#endif + + end if + +! prepare for longwave rad. + + air = -emv*(1.+(1.-emv)*(1.-emg))*lwdn - emv*emg*sb*tg**4 + cir = (2.-emv*(1.-emg))*emv*sb + +! --------------------------------------------------------------------------------------------- + loop1: do iter = 1, niterc ! begin stability iteration + + 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 + +! aerodyn resistances between heights zlvl and d+z0v + + if(opt_sfc == 1) then + call sfcdif1(parameters,iter ,sfctmp ,rhoair ,h ,qair , & !in + zlvl ,zpd ,z0m ,z0h ,ur , & !in + mpe ,iloc ,jloc , & !in +#ifdef CCPP + moz ,mozsgn ,fm ,fh ,fm2 ,fh2 ,errmsg ,errflg ,& !inout +#else + moz ,mozsgn ,fm ,fh ,fm2 ,fh2 , & !inout +#endif + cm ,ch ,fv ,ch2 ) !out +#ifdef CCPP + if (errflg /= 0) return +#endif + endif + + if(opt_sfc == 2) then + call sfcdif2(parameters,iter ,z0m ,tah ,thair ,ur , & !in + zlvl ,iloc ,jloc , & !in + cm ,ch ,moz ,wstar , & !in + fv ) !out + ! undo the multiplication by windspeed that sfcdif2 + ! applies to exchange coefficients ch and cm: + ch = ch / ur + cm = cm / ur + endif + + 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*cpfac*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*cpfac/gammav ! barlage: change to vegetation v3.6 + ctr = (1.-bea)*ctw*rhoair*cpair*cpfac/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*cpfac*cvh * ( tv-tah) + evc = fveg*rhoair*cpair*cpfac*cew * (estv-eah) / gammav ! barlage: change to v in v3.6 + tr = fveg*rhoair*cpair*cpfac*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) + + if (liter == 1) then + exit loop1 + endif + if (iter >= 5 .and. abs(dtv) <= 0.01 .and. liter == 0) then + liter = 1 + endif + + end do loop1 ! end stability iteration + +! under-canopy fluxes and tg + + air = - emg*(1.-emv)*lwdn - emg*emv*sb*tv**4 + cir = emg*sb + csh = rhoair*cpair*cpfac/rahg + cev = rhoair*cpair*cpfac / (gammag*(rawg+rsurf)) ! barlage: change to ground v3.6 + cgh = 2.*df(isnow+1)/dzsnso(isnow+1) +! write(*,*)'inside tg=',tg,'stc(1)=',stc(1) + + loop2: do iter = 1, niterg + + t = tdc(tg) + call esat(t, esatw, esati, dsatw, dsati) + if (t .gt. 0.) then + estg = esatw + destg = dsatw + else + estg = esati + destg = dsati + end if + + irg = cir*tg**4 + air + shg = csh * (tg - tah ) + evg = cev * (estg*rhsur - eah ) + gh = cgh * (tg - stc(isnow+1)) + + b = sag-irg-shg-evg-gh+pahg + a = 4.*cir*tg**3+csh+cev*destg+cgh + dtg = b/a + + irg = irg + 4.*cir*tg**3*dtg + shg = shg + csh*dtg + evg = evg + cev*destg*dtg + gh = gh + cgh*dtg + tg = tg + dtg + + end do loop2 + +! tah = (cah*sfctmp + cvh*tv + cgh*tg)/(cah + cvh + cgh) + +! if snow on ground and tg > tfrz: reset tg = tfrz. reevaluate ground fluxes. + + if(opt_stc == 1 .or. opt_stc == 3) then + if (snowh > 0.05 .and. tg > tfrz) then + tg = tfrz + if(opt_stc == 3) tg = (1.-fsno)*tg + fsno*tfrz ! mb: allow tg>0c during melt v3.7 + irg = cir*tg**4 - emg*(1.-emv)*lwdn - emg*emv*sb*tv**4 + shg = csh * (tg - tah) + evg = cev * (estg*rhsur - eah) + gh = sag+pahg - (irg+shg+evg) + end if + end if + +! wind stresses + + tauxv = -rhoair*cm*ur*uu + tauyv = -rhoair*cm*ur*vv + +! consistent vegetation air temperature and vapor pressure since tg is not consistent with the tah/eah +! calculation. +! tah = sfctmp + (shg+shc)/(rhoair*cpair*cpfac*cah) +! tah = sfctmp + (shg*fveg+shc)/(rhoair*cpair*cpfac*cah) ! ground flux need fveg +! eah = eair + (evc+fveg*(tr+evg))/(rhoair*caw*cpair*cpfac/gammag ) +! qfx = (qsfc-qair)*rhoair*cpfac*caw !*cpair/gammag + +! 2m temperature over vegetation ( corrected for low cq2v values ) + if (opt_sfc == 1 .or. opt_sfc == 2) then +! cah2 = fv*1./vkc*log((2.+z0h)/z0h) + cah2 = fv*vkc/log((2.+z0h)/z0h) + cah2 = fv*vkc/(log((2.+z0h)/z0h)-fh2) + cq2v = cah2 + if (cah2 .lt. 1.e-5 ) then + t2mv = tah +! q2v = (eah*0.622/(sfcprs - 0.378*eah)) + q2v = qsfc + else + t2mv = tah - (shg+shc/fveg)/(rhoair*cpair*cpfac) * 1./cah2 +! q2v = (eah*0.622/(sfcprs - 0.378*eah))- qfx/(rhoair*fv)* 1./vkc * log((2.+z0h)/z0h) + q2v = qsfc - ((evc+tr)/fveg+evg)/(latheav*rhoair) * 1./cq2v + endif + endif + +! update ch for output + ch = cah + chleaf = cvh + chuc = 1./rahg + + end subroutine vege_flux + +!== begin bare_flux ================================================================================ + +!>\ingroup NoahMP_LSM + subroutine bare_flux (parameters,nsnow ,nsoil ,isnow ,dt ,sag , & !in + lwdn ,ur ,uu ,vv ,sfctmp , & !in + thair ,qair ,eair ,rhoair ,snowh , & !in + dzsnso ,zlvl ,zpd ,z0m ,fsno , & !in + emg ,stc ,df ,rsurf ,lathea , & !in + gamma ,rhsur ,iloc ,jloc ,q2 ,pahb , & !in +#ifdef CCPP + tgb ,cm ,ch ,errmsg ,errflg , & !inout +#else + tgb ,cm ,ch , & !inout +#endif + tauxb ,tauyb ,irb ,shb ,evb , & !out + ghb ,t2mb ,dx ,dz8w ,ivgtyp , & !out + qc ,qsfc ,psfc , & !in + sfcprs ,q2b ,ehb2 ) !in + +! -------------------------------------------------------------------------------------------------- +! use newton-raphson iteration to solve ground (tg) temperature +! that balances the surface energy budgets for bare soil fraction. + +! bare soil: +! -sab + irb[tg] + shb[tg] + evb[tg] + ghb[tg] = 0 +! ---------------------------------------------------------------------- + implicit none +! ---------------------------------------------------------------------- +! input + type (noahmp_parameters), intent(in) :: parameters + integer , intent(in) :: iloc !grid index + integer , intent(in) :: jloc !grid index + integer, intent(in) :: nsnow !maximum no. of snow layers + integer, intent(in) :: nsoil !number of soil layers + integer, intent(in) :: isnow !actual no. of snow layers + real, intent(in) :: dt !time step (s) + real, intent(in) :: sag !solar radiation absorbed by ground (w/m2) + real, intent(in) :: lwdn !atmospheric longwave radiation (w/m2) + real, intent(in) :: ur !wind speed at height zlvl (m/s) + real, intent(in) :: uu !wind speed in eastward dir (m/s) + real, intent(in) :: vv !wind speed in northward dir (m/s) + real, intent(in) :: sfctmp !air temperature at reference height (k) + real, intent(in) :: thair !potential temperature at height zlvl (k) + real, intent(in) :: qair !specific humidity at height zlvl (kg/kg) + real, intent(in) :: eair !vapor pressure air at height (pa) + real, intent(in) :: rhoair !density air (kg/m3) + real, intent(in) :: snowh !actual snow depth [m] + real, dimension(-nsnow+1:nsoil), intent(in) :: dzsnso !thickness of snow/soil layers (m) + real, intent(in) :: zlvl !reference height (m) + real, intent(in) :: zpd !zero plane displacement (m) + real, intent(in) :: z0m !roughness length, momentum, ground (m) + real, intent(in) :: emg !ground emissivity + real, dimension(-nsnow+1:nsoil), intent(in) :: stc !soil/snow temperature (k) + real, dimension(-nsnow+1:nsoil), intent(in) :: df !thermal conductivity of snow/soil (w/m/k) + real, intent(in) :: rsurf !ground surface resistance (s/m) + real, intent(in) :: lathea !latent heat of vaporization/subli (j/kg) + real, intent(in) :: gamma !psychrometric constant (pa/k) + real, intent(in) :: rhsur !raltive humidity in surface soil/snow air space (-) + real, intent(in) :: fsno !snow fraction + +!jref:start; in + integer , intent(in) :: ivgtyp + real , intent(in) :: qc !cloud water mixing ratio + real , intent(inout) :: qsfc !mixing ratio at lowest model layer + real , intent(in) :: psfc !pressure at lowest model layer + real , intent(in) :: sfcprs !pressure at lowest model layer + real , intent(in) :: dx !horisontal grid spacing + real , intent(in) :: q2 !mixing ratio (kg/kg) + real , intent(in) :: dz8w !thickness of lowest layer +!jref:end + real, intent(in) :: pahb !precipitation advected heat - ground net in (w/m2) + +! input/output + real, intent(inout) :: tgb !ground temperature (k) + real, intent(inout) :: cm !momentum drag coefficient + real, intent(inout) :: ch !sensible heat exchange coefficient +#ifdef CCPP + character(len=*), intent(inout) :: errmsg + integer, intent(inout) :: errflg +#endif + +! output +! -sab + irb[tg] + shb[tg] + evb[tg] + ghb[tg] = 0 + + real, intent(out) :: tauxb !wind stress: e-w (n/m2) + real, intent(out) :: tauyb !wind stress: n-s (n/m2) + real, intent(out) :: irb !net longwave rad (w/m2) [+ to atm] + real, intent(out) :: shb !sensible heat flux (w/m2) [+ to atm] + real, intent(out) :: evb !latent heat flux (w/m2) [+ to atm] + real, intent(out) :: ghb !ground heat flux (w/m2) [+ to soil] + real, intent(out) :: t2mb !2 m height air temperature (k) +!jref:start + real, intent(out) :: q2b !bare ground heat conductance + real :: ehb !bare ground heat conductance + real :: u10b !10 m wind speed in eastward dir (m/s) + real :: v10b !10 m wind speed in eastward dir (m/s) + real :: wspd +!jref:end + +! local variables + + real :: taux !wind stress: e-w (n/m2) + real :: tauy !wind stress: n-s (n/m2) + real :: fira !total net longwave rad (w/m2) [+ to atm] + real :: fsh !total sensible heat flux (w/m2) [+ to atm] + real :: fgev !ground evaporation heat flux (w/m2)[+ to atm] + real :: ssoil !soil heat flux (w/m2) [+ to soil] + real :: fire !emitted ir (w/m2) + real :: trad !radiative temperature (k) + real :: tah !"surface" temperature at height z0h+zpd (k) + + real :: cw !water vapor exchange coefficient + real :: fv !friction velocity (m/s) + real :: wstar !friction velocity n vertical direction (m/s) (only for sfcdif2) + real :: z0h !roughness length, sensible heat, ground (m) + real :: rb !bulk leaf boundary layer resistance (s/m) + real :: ramb !aerodynamic resistance for momentum (s/m) + real :: rahb !aerodynamic resistance for sensible heat (s/m) + real :: rawb !aerodynamic resistance for water vapor (s/m) + real :: mol !monin-obukhov length (m) + real :: dtg !change in tg, last iteration (k) + + real :: cir !coefficients for ir as function of ts**4 + real :: csh !coefficients for sh as function of ts + real :: cev !coefficients for ev as function of esat[ts] + real :: cgh !coefficients for st as function of ts + +!jref:start + real :: rahb2 !aerodynamic resistance for sensible heat 2m (s/m) + real :: rawb2 !aerodynamic resistance for water vapor 2m (s/m) + real,intent(out) :: ehb2 !sensible heat conductance for diagnostics + real :: ch2b !exchange coefficient for 2m temp. + real :: cq2b !exchange coefficient for 2m temp. + real :: thvair !virtual potential air temp + real :: thgh !potential ground temp + real :: emb !momentum conductance + real :: qfx !moisture flux + real :: estg2 !saturation vapor pressure at 2m (pa) + integer :: vegtyp !vegetation type set to isbarren + real :: e1 +!jref:end + + real :: estg !saturation vapor pressure at tg (pa) + real :: destg !d(es)/dt at tg (pa/k) + real :: esatw !es for water + real :: esati !es for ice + real :: dsatw !d(es)/dt at tg (pa/k) for water + real :: dsati !d(es)/dt at tg (pa/k) for ice + + real :: a !temporary calculation + real :: b !temporary calculation + real :: h !temporary sensible heat flux (w/m2) + real :: moz !monin-obukhov stability parameter + real :: mozold !monin-obukhov stability parameter from prior iteration + real :: fm !momentum stability correction, weighted by prior iters + real :: fh !sen heat stability correction, weighted by prior iters + integer :: mozsgn !number of times moz changes sign + real :: fm2 !monin-obukhov momentum adjustment at 2m + real :: fh2 !monin-obukhov heat adjustment at 2m + real :: ch2 !surface exchange at 2m + + integer :: iter !iteration index + integer :: niterb !number of iterations for surface temperature + real :: mpe !prevents overflow error if division by zero +!jref:start +! data niterb /3/ + data niterb /5/ + save niterb + real :: t, tdc !kelvin to degree celsius with limit -50 to +50 + tdc(t) = min( 50., max(-50.,(t-tfrz)) ) + +! ----------------------------------------------------------------- +! initialization variables that do not depend on stability iteration +! ----------------------------------------------------------------- + mpe = 1e-6 + dtg = 0. + moz = 0. + mozsgn = 0 + mozold = 0. + h = 0. + qfx = 0. + fv = 0.1 + + cir = emg*sb + cgh = 2.*df(isnow+1)/dzsnso(isnow+1) + +! ----------------------------------------------------------------- + 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(opt_sfc == 1) then + call sfcdif1(parameters,iter ,sfctmp ,rhoair ,h ,qair , & !in + zlvl ,zpd ,z0m ,z0h ,ur , & !in + mpe ,iloc ,jloc , & !in +#ifdef CCPP + moz ,mozsgn ,fm ,fh ,fm2 ,fh2 ,errmsg ,errflg ,& !inout +#else + moz ,mozsgn ,fm ,fh ,fm2 ,fh2 , & !inout +#endif + cm ,ch ,fv ,ch2 ) !out +#ifdef CCPP + if (errflg /= 0) return +#endif + endif + + if(opt_sfc == 2) then + call sfcdif2(parameters,iter ,z0m ,tgb ,thair ,ur , & !in + zlvl ,iloc ,jloc , & !in + cm ,ch ,moz ,wstar , & !in + fv ) !out + ! undo the multiplication by windspeed that sfcdif2 + ! applies to exchange coefficients ch and cm: + ch = ch / ur + cm = cm / ur + if(snowh > 0.) then + cm = min(0.01,cm) ! cm & ch are too large, causing + ch = min(0.01,ch) ! computational instability + end if + + endif + + 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 loop3 ! end stability iteration +! ----------------------------------------------------------------- + +! if snow on ground and tg > tfrz: reset tg = tfrz. reevaluate ground fluxes. + + if(opt_stc == 1 .or. opt_stc == 3) then + if (snowh > 0.05 .and. tgb > tfrz) then + tgb = tfrz + if(opt_stc == 3) tgb = (1.-fsno)*tgb + fsno*tfrz ! mb: allow tg>0c during melt v3.7 + irb = cir * tgb**4 - emg*lwdn + shb = csh * (tgb - sfctmp) + evb = cev * (estg*rhsur - eair ) !estg reevaluate ? + ghb = sag+pahb - (irb+shb+evb) + end if + end if + +! wind stresses + + tauxb = -rhoair*cm*ur*uu + tauyb = -rhoair*cm*ur*vv + +!jref:start; errors in original equation corrected. +! 2m air temperature + if(opt_sfc == 1 .or. opt_sfc ==2) then + ehb2 = fv*vkc/log((2.+z0h)/z0h) + ehb2 = fv*vkc/(log((2.+z0h)/z0h)-fh2) + cq2b = ehb2 + if (ehb2.lt.1.e-5 ) then + t2mb = tgb + q2b = qsfc + else + t2mb = tgb - shb/(rhoair*cpair) * 1./ehb2 + q2b = qsfc - evb/(lathea*rhoair)*(1./cq2b + rsurf) + endif + if (parameters%urban_flag) q2b = qsfc + end if + +! update ch + ch = ehb + + end subroutine bare_flux + +!== begin ragrb ==================================================================================== + +!>\ingroup NoahMP_LSM + subroutine ragrb(parameters,iter ,vai ,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 +! -------------------------------------------------------------------------------------------------- +! compute under-canopy aerodynamic resistance rag and leaf boundary layer +! resistance rb +! -------------------------------------------------------------------------------------------------- + implicit none +! -------------------------------------------------------------------------------------------------- +! inputs + + type (noahmp_parameters), intent(in) :: parameters + integer, intent(in) :: iloc !grid index + integer, intent(in) :: jloc !grid index + integer, intent(in) :: iter !iteration index + integer, intent(in) :: vegtyp !vegetation physiology type + real, intent(in) :: vai !total lai + stem area index, one sided + real, intent(in) :: rhoair !density air (kg/m3) + real, intent(in) :: hg !ground sensible heat flux (w/m2) + real, intent(in) :: tv !vegetation temperature (k) + real, intent(in) :: tah !air temperature at height z0h+zpd (k) + real, intent(in) :: zpd !zero plane displacement (m) + real, intent(in) :: z0mg !roughness length, momentum, ground (m) + real, intent(in) :: hcan !canopy height (m) [note: hcan >= z0mg] + real, intent(in) :: uc !wind speed at top of canopy (m/s) + real, intent(in) :: z0h !roughness length, sensible heat (m) + real, intent(in) :: z0hg !roughness length, sensible heat, ground (m) + real, intent(in) :: fv !friction velocity (m/s) + real, intent(in) :: cwp !canopy wind parameter + real, intent(in) :: mpe !prevents overflow error if division by zero + +! in & out + + real, intent(inout) :: mozg !monin-obukhov stability parameter + real, intent(inout) :: fhg !stability correction + +! outputs + real :: ramg !aerodynamic resistance for momentum (s/m) + real :: rahg !aerodynamic resistance for sensible heat (s/m) + real :: rawg !aerodynamic resistance for water vapor (s/m) + real :: rb !bulk leaf boundary layer resistance (s/m) + + + real :: kh !turbulent transfer coefficient, sensible heat, (m2/s) + real :: tmp1 !temporary calculation + real :: tmp2 !temporary calculation + real :: tmprah2 !temporary calculation for aerodynamic resistances + real :: tmprb !temporary calculation for rb + real :: molg,fhgnew,cwpc +! -------------------------------------------------------------------------------------------------- +! stability correction to below canopy resistance + + mozg = 0. + molg = 0. + + if(iter > 1) then + tmp1 = vkc * (grav/tah) * hg/(rhoair*cpair) + if (abs(tmp1) .le. mpe) tmp1 = mpe + molg = -1. * fv**3 / tmp1 + mozg = min( (zpd-z0mg)/molg, 1.) + end if + + if (mozg < 0.) then + fhgnew = (1. - 15.*mozg)**(-0.25) + else + fhgnew = 1.+ 4.7*mozg + endif + + if (iter == 1) then + fhg = fhgnew + else + fhg = 0.5 * (fhg+fhgnew) + endif + + cwpc = (cwp * vai * hcan * fhg)**0.5 +! cwpc = (cwp*fhg)**0.5 + + tmp1 = exp( -cwpc*z0hg/hcan ) + tmp2 = exp( -cwpc*(z0h+zpd)/hcan ) + tmprah2 = hcan*exp(cwpc) / cwpc * (tmp1-tmp2) + +! aerodynamic resistances raw and rah between heights zpd+z0h and z0hg. + + kh = max ( vkc*fv*(hcan-zpd), mpe ) + ramg = 0. + rahg = tmprah2 / kh + rawg = rahg + +! leaf boundary layer resistance + + tmprb = cwpc*50. / (1. - exp(-cwpc/2.)) + rb = tmprb * sqrt(parameters%dleaf/uc) +! rb = 200 + + end subroutine ragrb + +!== begin sfcdif1 ================================================================================== + +!>\ingroup NoahMP_LSM + subroutine sfcdif1(parameters,iter ,sfctmp ,rhoair ,h ,qair , & !in + & zlvl ,zpd ,z0m ,z0h ,ur , & !in + & mpe ,iloc ,jloc , & !in +#ifdef CCPP + & moz ,mozsgn ,fm ,fh ,fm2,fh2,errmsg,errflg, & !inout +#else + & moz ,mozsgn ,fm ,fh ,fm2,fh2, & !inout +#endif + & cm ,ch ,fv ,ch2 ) !out +! ------------------------------------------------------------------------------------------------- +! computing surface drag coefficient cm for momentum and ch for heat +! ------------------------------------------------------------------------------------------------- + implicit none +! ------------------------------------------------------------------------------------------------- +! inputs + + type (noahmp_parameters), intent(in) :: parameters + integer, intent(in) :: iloc !grid index + integer, intent(in) :: jloc !grid index + integer, intent(in) :: iter !iteration index + real, intent(in) :: sfctmp !temperature at reference height (k) + real, intent(in) :: rhoair !density air (kg/m**3) + real, intent(in) :: h !sensible heat flux (w/m2) [+ to atm] + real, intent(in) :: qair !specific humidity at reference height (kg/kg) + real, intent(in) :: zlvl !reference height (m) + real, intent(in) :: zpd !zero plane displacement (m) + real, intent(in) :: z0h !roughness length, sensible heat, ground (m) + real, intent(in) :: z0m !roughness length, momentum, ground (m) + real, intent(in) :: ur !wind speed (m/s) + real, intent(in) :: mpe !prevents overflow error if division by zero +! in & out + + integer, intent(inout) :: mozsgn !number of times moz changes sign + real, intent(inout) :: moz !monin-obukhov stability (z/l) + real, intent(inout) :: fm !momentum stability correction, weighted by prior iters + real, intent(inout) :: fh !sen heat stability correction, weighted by prior iters + real, intent(inout) :: fm2 !sen heat stability correction, weighted by prior iters + real, intent(inout) :: fh2 !sen heat stability correction, weighted by prior iters +#ifdef CCPP + character(len=*), intent(inout) :: errmsg + integer, intent(inout) :: errflg +#endif + +! outputs + + real, intent(out) :: cm !drag coefficient for momentum + real, intent(out) :: ch !drag coefficient for heat + real, intent(out) :: fv !friction velocity (m/s) + real, intent(out) :: ch2 !drag coefficient for heat + +! locals + real :: mol !monin-obukhov length (m) + real :: tmpcm !temporary calculation for cm + real :: tmpch !temporary calculation for ch + real :: fmnew !stability correction factor, momentum, for current moz + real :: fhnew !stability correction factor, sen heat, for current moz + real :: mozold !monin-obukhov stability parameter from prior iteration + real :: tmp1,tmp2,tmp3,tmp4,tmp5 !temporary calculation + real :: tvir !temporary virtual temperature (k) + real :: moz2 !2/l + real :: tmpcm2 !temporary calculation for cm2 + real :: tmpch2 !temporary calculation for ch2 + real :: fm2new !stability correction factor, momentum, for current moz + real :: fh2new !stability correction factor, sen heat, for current moz + real :: tmp12,tmp22,tmp32 !temporary calculation + + real :: cmfm, chfh, cm2fm2, ch2fh2 +! ------------------------------------------------------------------------------------------------- +! monin-obukhov stability parameter moz for next iteration + + mozold = moz + + if(zlvl <= zpd) then + write(*,*) 'critical problem: zlvl <= zpd; model stops' +#ifdef CCPP + errflg = 1 + errmsg = "stop in noah-mp" + return +#else + call wrf_error_fatal("stop in noah-mp") +#endif + endif + + tmpcm = log((zlvl-zpd) / z0m) + tmpch = log((zlvl-zpd) / z0h) + tmpcm2 = log((2.0 + z0m) / z0m) + tmpch2 = log((2.0 + z0h) / z0h) + + if(iter == 1) then + fv = 0.0 + moz = 0.0 + mol = 0.0 + moz2 = 0.0 + else + tvir = (1. + 0.61*qair) * sfctmp + tmp1 = vkc * (grav/tvir) * h/(rhoair*cpair) + if (abs(tmp1) .le. mpe) tmp1 = mpe + mol = -1. * fv**3 / tmp1 + moz = min( (zlvl-zpd)/mol, 1.) + moz2 = min( (2.0 + z0h)/mol, 1.) + endif + +! accumulate number of times moz changes sign. + + if (mozold*moz .lt. 0.) mozsgn = mozsgn+1 + if (mozsgn .ge. 2) then + moz = 0. + fm = 0. + fh = 0. + moz2 = 0. + fm2 = 0. + fh2 = 0. + endif + +! evaluate stability-dependent variables using moz from prior iteration + if (moz .lt. 0.) then + tmp1 = (1. - 16.*moz)**0.25 + tmp2 = log((1.+tmp1*tmp1)/2.) + tmp3 = log((1.+tmp1)/2.) + fmnew = 2.*tmp3 + tmp2 - 2.*atan(tmp1) + 1.5707963 + fhnew = 2*tmp2 + +! 2-meter + tmp12 = (1. - 16.*moz2)**0.25 + tmp22 = log((1.+tmp12*tmp12)/2.) + tmp32 = log((1.+tmp12)/2.) + fm2new = 2.*tmp32 + tmp22 - 2.*atan(tmp12) + 1.5707963 + fh2new = 2*tmp22 + else + fmnew = -5.*moz + fhnew = fmnew + fm2new = -5.*moz2 + fh2new = fm2new + endif + +! except for first iteration, weight stability factors for previous +! iteration to help avoid flip-flops from one iteration to the next + + if (iter == 1) then + fm = fmnew + fh = fhnew + fm2 = fm2new + fh2 = fh2new + else + fm = 0.5 * (fm+fmnew) + fh = 0.5 * (fh+fhnew) + fm2 = 0.5 * (fm2+fm2new) + fh2 = 0.5 * (fh2+fh2new) + endif + +! exchange coefficients + + fh = min(fh,0.9*tmpch) + fm = min(fm,0.9*tmpcm) + fh2 = min(fh2,0.9*tmpch2) + fm2 = min(fm2,0.9*tmpcm2) + + cmfm = tmpcm-fm + chfh = tmpch-fh + cm2fm2 = tmpcm2-fm2 + ch2fh2 = tmpch2-fh2 + if(abs(cmfm) <= mpe) cmfm = mpe + if(abs(chfh) <= mpe) chfh = mpe + if(abs(cm2fm2) <= mpe) cm2fm2 = mpe + if(abs(ch2fh2) <= mpe) ch2fh2 = mpe + cm = vkc*vkc/(cmfm*cmfm) + ch = vkc*vkc/(cmfm*chfh) + ch2 = vkc*vkc/(cm2fm2*ch2fh2) + +! friction velocity + + fv = ur * sqrt(cm) + ch2 = vkc*fv/ch2fh2 + + end subroutine sfcdif1 + +!== begin sfcdif2 ================================================================================== + +!>\ingroup NoahMP_LSM + subroutine sfcdif2(parameters,iter ,z0 ,thz0 ,thlm ,sfcspd , & !in + zlm ,iloc ,jloc , & !in + akms ,akhs ,rlmo ,wstar2 , & !in + ustar ) !out + +! ------------------------------------------------------------------------------------------------- +! subroutine sfcdif (renamed sfcdif_off to avoid clash with eta pbl) +! ------------------------------------------------------------------------------------------------- +! calculate surface layer exchange coefficients via iterative process. +! see chen et al (1997, blm) +! ------------------------------------------------------------------------------------------------- + implicit none + type (noahmp_parameters), intent(in) :: parameters + integer, intent(in) :: iloc + integer, intent(in) :: jloc + integer, intent(in) :: iter + real, intent(in) :: zlm, z0, thz0, thlm, sfcspd + real, intent(inout) :: akms + real, intent(inout) :: akhs + real, intent(inout) :: rlmo + real, intent(inout) :: wstar2 + real, intent(out) :: ustar + + real zz, pslmu, pslms, pslhu, pslhs + real xx, pspmu, yy, pspms, psphu, psphs + real zilfc, zu, zt, rdz, cxch + real dthv, du2, btgh, zslu, zslt, rlogu, rlogt + real zetalt, zetalu, zetau, zetat, xlu4, xlt4, xu4, xt4 + + real xlu, xlt, xu, xt, psmz, simm, pshz, simh, ustark, rlmn, & + & rlma + + integer ilech, itr + + integer, parameter :: itrmx = 5 + real, parameter :: wwst = 1.2 + real, parameter :: wwst2 = wwst * wwst + real, parameter :: vkrm = 0.40 + real, parameter :: excm = 0.001 + real, parameter :: beta = 1.0 / 270.0 + real, parameter :: btg = beta * grav + real, parameter :: elfc = vkrm * btg + real, parameter :: wold = 0.15 + real, parameter :: wnew = 1.0 - wold + real, parameter :: pihf = 3.14159265 / 2. + real, parameter :: epsu2 = 1.e-4 + real, parameter :: epsust = 0.07 + real, parameter :: epsit = 1.e-4 + real, parameter :: epsa = 1.e-8 + real, parameter :: ztmin = -5.0 + real, parameter :: ztmax = 1.0 + real, parameter :: hpbl = 1000.0 + real, parameter :: sqvisc = 258.2 + real, parameter :: ric = 0.183 + real, parameter :: rric = 1.0 / ric + real, parameter :: fhneu = 0.8 + real, parameter :: rfc = 0.191 + real, parameter :: rfac = ric / ( fhneu * rfc * rfc ) + +! ---------------------------------------------------------------------- +! note: the two code blocks below define functions +! ---------------------------------------------------------------------- +! lech's surface functions + pslmu (zz)= -0.96* log (1.0-4.5* zz) + pslms (zz)= zz * rric -2.076* (1. -1./ (zz +1.)) + pslhu (zz)= -0.96* log (1.0-4.5* zz) + pslhs (zz)= zz * rfac -2.076* (1. -1./ (zz +1.)) +! paulson's surface functions + pspmu (xx)= -2.* log ( (xx +1.)*0.5) - log ( (xx * xx +1.)*0.5) & + & +2.* atan (xx) & + &- pihf + pspms (yy)= 5.* yy + psphu (xx)= -2.* log ( (xx * xx +1.)*0.5) + psphs (yy)= 5.* yy + +! this routine sfcdif can handle both over open water (sea, ocean) and +! over solid surface (land, sea-ice). +! ---------------------------------------------------------------------- +! ztfc: ratio of zoh/zom less or equal than 1 +! c......ztfc=0.1 +! czil: constant c in zilitinkevich, s. s.1995,:note about zt +! ---------------------------------------------------------------------- + ilech = 0 + +! ---------------------------------------------------------------------- + zilfc = - parameters%czil * vkrm * sqvisc + zu = z0 + rdz = 1./ zlm + cxch = excm * rdz + dthv = thlm - thz0 + +! beljars correction of ustar + du2 = max (sfcspd * sfcspd,epsu2) + btgh = btg * hpbl + + if(iter == 1) then + if (btgh * akhs * dthv .ne. 0.0) then + wstar2 = wwst2* abs (btgh * akhs * dthv)** (2./3.) + else + wstar2 = 0.0 + end if + ustar = max (sqrt (akms * sqrt (du2+ wstar2)),epsust) + rlmo = elfc * akhs * dthv / ustar **3 + end if + +! zilitinkevitch approach for zt + zt = max(1.e-6,exp (zilfc * sqrt (ustar * z0))* z0) + zslu = zlm + zu + zslt = zlm + zt + rlogu = log (zslu / zu) + rlogt = log (zslt / zt) + +! ---------------------------------------------------------------------- +! 1./monin-obukkhov length-scale +! ---------------------------------------------------------------------- + zetalt = max (zslt * rlmo,ztmin) + rlmo = zetalt / zslt + zetalu = zslu * rlmo + zetau = zu * rlmo + zetat = zt * rlmo + + if (ilech .eq. 0) then + if (rlmo .lt. 0.)then + xlu4 = 1. -16.* zetalu + xlt4 = 1. -16.* zetalt + xu4 = 1. -16.* zetau + xt4 = 1. -16.* zetat + xlu = sqrt (sqrt (xlu4)) + xlt = sqrt (sqrt (xlt4)) + xu = sqrt (sqrt (xu4)) + + xt = sqrt (sqrt (xt4)) + psmz = pspmu (xu) + simm = pspmu (xlu) - psmz + rlogu + pshz = psphu (xt) + simh = psphu (xlt) - pshz + rlogt + else + zetalu = min (zetalu,ztmax) + zetalt = min (zetalt,ztmax) + psmz = pspms (zetau) + simm = pspms (zetalu) - psmz + rlogu + pshz = psphs (zetat) + simh = psphs (zetalt) - pshz + rlogt + end if +! ---------------------------------------------------------------------- +! lech's functions +! ---------------------------------------------------------------------- + else + if (rlmo .lt. 0.)then + psmz = pslmu (zetau) + simm = pslmu (zetalu) - psmz + rlogu + pshz = pslhu (zetat) + simh = pslhu (zetalt) - pshz + rlogt + else + zetalu = min (zetalu,ztmax) + zetalt = min (zetalt,ztmax) + psmz = pslms (zetau) + simm = pslms (zetalu) - psmz + rlogu + pshz = pslhs (zetat) + simh = pslhs (zetalt) - pshz + rlogt + end if +! ---------------------------------------------------------------------- + end if + +! ---------------------------------------------------------------------- +! beljaars correction for ustar +! ---------------------------------------------------------------------- + ustar = max (sqrt (akms * sqrt (du2+ wstar2)),epsust) + +! zilitinkevitch fix for zt + zt = max(1.e-6,exp (zilfc * sqrt (ustar * z0))* z0) + zslt = zlm + zt +!----------------------------------------------------------------------- + rlogt = log (zslt / zt) + ustark = ustar * vkrm + akms = max (ustark / simm,cxch) +!----------------------------------------------------------------------- +! if statements to avoid tangent linear problems near zero +!----------------------------------------------------------------------- + akhs = max (ustark / simh,cxch) + + if (btgh * akhs * dthv .ne. 0.0) then + wstar2 = wwst2* abs (btgh * akhs * dthv)** (2./3.) + else + wstar2 = 0.0 + end if +!----------------------------------------------------------------------- + rlmn = elfc * akhs * dthv / ustar **3 +!----------------------------------------------------------------------- +! if(abs((rlmn-rlmo)/rlma).lt.epsit) go to 110 +!----------------------------------------------------------------------- + rlma = rlmo * wold+ rlmn * wnew +!----------------------------------------------------------------------- + rlmo = rlma + +! write(*,'(a20,10f15.6)')'sfcdif: rlmo=',rlmo,rlmn,elfc , akhs , dthv , ustar +! end do +! ---------------------------------------------------------------------- + end subroutine sfcdif2 + +!== begin esat ===================================================================================== + +!>\ingroup NoahMP_LSM + subroutine esat(t, esw, esi, desw, desi) +!--------------------------------------------------------------------------------------------------- +! use polynomials to calculate saturation vapor pressure and derivative with +! respect to temperature: over water when t > 0 c and over ice when t <= 0 c + implicit none +!--------------------------------------------------------------------------------------------------- +! in + + real, intent(in) :: t !temperature + +!out + + real, intent(out) :: esw !saturation vapor pressure over water (pa) + real, intent(out) :: esi !saturation vapor pressure over ice (pa) + real, intent(out) :: desw !d(esat)/dt over water (pa/k) + real, intent(out) :: desi !d(esat)/dt over ice (pa/k) + +! local + + real :: a0,a1,a2,a3,a4,a5,a6 !coefficients for esat over water + real :: b0,b1,b2,b3,b4,b5,b6 !coefficients for esat over ice + real :: c0,c1,c2,c3,c4,c5,c6 !coefficients for dsat over water + real :: d0,d1,d2,d3,d4,d5,d6 !coefficients for dsat over ice + + parameter (a0=6.107799961 , a1=4.436518521e-01, & + a2=1.428945805e-02, a3=2.650648471e-04, & + a4=3.031240396e-06, a5=2.034080948e-08, & + a6=6.136820929e-11) + + parameter (b0=6.109177956 , b1=5.034698970e-01, & + b2=1.886013408e-02, b3=4.176223716e-04, & + b4=5.824720280e-06, b5=4.838803174e-08, & + b6=1.838826904e-10) + + parameter (c0= 4.438099984e-01, c1=2.857002636e-02, & + c2= 7.938054040e-04, c3=1.215215065e-05, & + c4= 1.036561403e-07, c5=3.532421810e-10, & + c6=-7.090244804e-13) + + parameter (d0=5.030305237e-01, d1=3.773255020e-02, & + d2=1.267995369e-03, d3=2.477563108e-05, & + d4=3.005693132e-07, d5=2.158542548e-09, & + d6=7.131097725e-12) + + esw = 100.*(a0+t*(a1+t*(a2+t*(a3+t*(a4+t*(a5+t*a6)))))) + esi = 100.*(b0+t*(b1+t*(b2+t*(b3+t*(b4+t*(b5+t*b6)))))) + desw = 100.*(c0+t*(c1+t*(c2+t*(c3+t*(c4+t*(c5+t*c6)))))) + desi = 100.*(d0+t*(d1+t*(d2+t*(d3+t*(d4+t*(d5+t*d6)))))) + + end subroutine esat + +!== begin stomata ================================================================================== + +!>\ingroup NoahMP_LSM + subroutine stomata (parameters,vegtyp ,mpe ,apar ,foln ,iloc , jloc, & !in + tv ,ei ,ea ,sfctmp ,sfcprs , & !in + o2 ,co2 ,igs ,btran ,rb , & !in + rs ,psn ) !out +! -------------------------------------------------------------------------------------------------- + implicit none +! -------------------------------------------------------------------------------------------------- +! input + type (noahmp_parameters), intent(in) :: parameters + integer,intent(in) :: iloc !grid index + integer,intent(in) :: jloc !grid index + integer,intent(in) :: vegtyp !vegetation physiology type + + real, intent(in) :: igs !growing season index (0=off, 1=on) + real, intent(in) :: mpe !prevents division by zero errors + + real, intent(in) :: tv !foliage temperature (k) + real, intent(in) :: ei !vapor pressure inside leaf (sat vapor press at tv) (pa) + real, intent(in) :: ea !vapor pressure of canopy air (pa) + real, intent(in) :: apar !par absorbed per unit lai (w/m2) + real, intent(in) :: o2 !atmospheric o2 concentration (pa) + real, intent(in) :: co2 !atmospheric co2 concentration (pa) + real, intent(in) :: sfcprs !air pressure at reference height (pa) + real, intent(in) :: sfctmp !air temperature at reference height (k) + real, intent(in) :: btran !soil water transpiration factor (0 to 1) + real, intent(in) :: foln !foliage nitrogen concentration (%) + real, intent(in) :: rb !boundary layer resistance (s/m) + +! output + real, intent(out) :: rs !leaf stomatal resistance (s/m) + real, intent(out) :: psn !foliage photosynthesis (umol co2 /m2/ s) [always +] + +! in&out + real :: rlb !boundary layer resistance (s m2 / umol) +! --------------------------------------------------------------------------------------------- + +! ------------------------ local variables ---------------------------------------------------- + integer :: iter !iteration index + integer :: niter !number of iterations + + data niter /3/ + save niter + + real :: ab !used in statement functions + real :: bc !used in statement functions + real :: f1 !generic temperature response (statement function) + real :: f2 !generic temperature inhibition (statement function) + real :: tc !foliage temperature (degree celsius) + real :: cs !co2 concentration at leaf surface (pa) + real :: kc !co2 michaelis-menten constant (pa) + real :: ko !o2 michaelis-menten constant (pa) + real :: a,b,c,q !intermediate calculations for rs + real :: r1,r2 !roots for rs + real :: fnf !foliage nitrogen adjustment factor (0 to 1) + real :: ppf !absorb photosynthetic photon flux (umol photons/m2/s) + real :: wc !rubisco limited photosynthesis (umol co2/m2/s) + real :: wj !light limited photosynthesis (umol co2/m2/s) + real :: we !export limited photosynthesis (umol co2/m2/s) + real :: cp !co2 compensation point (pa) + real :: ci !internal co2 (pa) + real :: awc !intermediate calculation for wc + real :: vcmx !maximum rate of carbonylation (umol co2/m2/s) + real :: j !electron transport (umol co2/m2/s) + real :: cea !constrain ea or else model blows up + real :: cf !s m2/umol -> s/m + + f1(ab,bc) = ab**((bc-25.)/10.) + f2(ab) = 1. + exp((-2.2e05+710.*(ab+273.16))/(8.314*(ab+273.16))) + real :: t +! --------------------------------------------------------------------------------------------- + +! initialize rs=rsmax and psn=0 because will only do calculations +! for apar > 0, in which case rs <= rsmax and psn >= 0 + + cf = sfcprs/(8.314*sfctmp)*1.e06 + rs = 1./parameters%bp * cf + psn = 0. + + if (apar .le. 0.) return + + fnf = min( foln/max(mpe,parameters%folnmx), 1.0 ) + tc = tv-tfrz + ppf = 4.6*apar + j = ppf*parameters%qe25 + kc = parameters%kc25 * f1(parameters%akc,tc) + ko = parameters%ko25 * f1(parameters%ako,tc) + awc = kc * (1.+o2/ko) + cp = 0.5*kc/ko*o2*0.21 + vcmx = parameters%vcmx25 / f2(tc) * fnf * btran * f1(parameters%avcmx,tc) + +! first guess ci + + ci = 0.7*co2*parameters%c3psn + 0.4*co2*(1.-parameters%c3psn) + +! rb: s/m -> s m**2 / umol + + rlb = rb/cf + +! constrain ea + + cea = max(0.25*ei*parameters%c3psn+0.40*ei*(1.-parameters%c3psn), min(ea,ei) ) + +! ci iteration +!jref: c3psn is equal to 1 for all veg types. + do iter = 1, niter + wj = max(ci-cp,0.)*j/(ci+2.*cp)*parameters%c3psn + j*(1.-parameters%c3psn) + wc = max(ci-cp,0.)*vcmx/(ci+awc)*parameters%c3psn + vcmx*(1.-parameters%c3psn) + we = 0.5*vcmx*parameters%c3psn + 4000.*vcmx*ci/sfcprs*(1.-parameters%c3psn) + psn = min(wj,wc,we) * igs + + cs = max( co2-1.37*rlb*sfcprs*psn, mpe ) + a = parameters%mp*psn*sfcprs*cea / (cs*ei) + parameters%bp + b = ( parameters%mp*psn*sfcprs/cs + parameters%bp ) * rlb - 1. + c = -rlb + if (b .ge. 0.) then + q = -0.5*( b + sqrt(b*b-4.*a*c) ) + else + q = -0.5*( b - sqrt(b*b-4.*a*c) ) + end if + r1 = q/a + r2 = c/q + rs = max(r1,r2) + ci = max( cs-psn*sfcprs*1.65*rs, 0. ) + end do + +! rs, rb: s m**2 / umol -> s/m + + rs = rs*cf + + end subroutine stomata + +!== begin canres =================================================================================== + +!>\ingroup NoahMP_LSM + subroutine canres (parameters,par ,sfctmp,rcsoil ,eah ,sfcprs , & !in + rc ,psn ,iloc ,jloc ) !out + +! -------------------------------------------------------------------------------------------------- +! calculate canopy resistance which depends on incoming solar radiation, +! air temperature, atmospheric water vapor pressure deficit at the +! lowest model level, and soil moisture (preferably unfrozen soil +! moisture rather than total) +! -------------------------------------------------------------------------------------------------- +! source: jarvis (1976), noilhan and planton (1989, mwr), jacquemin and +! noilhan (1990, blm). chen et al (1996, jgr, vol 101(d3), 7251-7268), +! eqns 12-14 and table 2 of sec. 3.1.2 +! -------------------------------------------------------------------------------------------------- +!niu use module_noahlsm_utility +! -------------------------------------------------------------------------------------------------- + implicit none +! -------------------------------------------------------------------------------------------------- +! inputs + + type (noahmp_parameters), intent(in) :: parameters + integer, intent(in) :: iloc !grid index + integer, intent(in) :: jloc !grid index + real, intent(in) :: par !par absorbed per unit sunlit lai (w/m2) + real, intent(in) :: sfctmp !canopy air temperature + real, intent(in) :: sfcprs !surface pressure (pa) + real, intent(in) :: eah !water vapor pressure (pa) + real, intent(in) :: rcsoil !soil moisture stress factor + +!outputs + + real, intent(out) :: rc !canopy resistance per unit lai + real, intent(out) :: psn !foliage photosynthesis (umolco2/m2/s) + +!local + + real :: rcq + real :: rcs + real :: rct + real :: ff + real :: q2 !water vapor mixing ratio (kg/kg) + real :: q2sat !saturation q2 + real :: dqsdt2 !d(q2sat)/d(t) + +! rsmin, rsmax, topt, rgl, hs are canopy stress parameters set in redprm +! ---------------------------------------------------------------------- +! initialize canopy resistance multiplier terms. +! ---------------------------------------------------------------------- + rc = 0.0 + rcs = 0.0 + rct = 0.0 + rcq = 0.0 + +! compute q2 and q2sat + + q2 = 0.622 * eah / (sfcprs - 0.378 * eah) !specific humidity [kg/kg] + q2 = q2 / (1.0 + q2) !mixing ratio [kg/kg] + + call calhum(parameters,sfctmp, sfcprs, q2sat, dqsdt2) + +! contribution due to incoming solar radiation + + ff = 2.0 * par / parameters%rgl + rcs = (ff + parameters%rsmin / parameters%rsmax) / (1.0+ ff) + rcs = max (rcs,0.0001) + +! contribution due to air temperature + + rct = 1.0- 0.0016* ( (parameters%topt - sfctmp)**2.0) + rct = max (rct,0.0001) + +! contribution due to vapor pressure deficit + + rcq = 1.0/ (1.0+ parameters%hs * max(0.,q2sat-q2)) + rcq = max (rcq,0.01) + +! determine canopy resistance due to all factors + + rc = parameters%rsmin / (rcs * rct * rcq * rcsoil) + psn = -999.99 ! psn not applied for dynamic carbon + + end subroutine canres + +!== begin calhum =================================================================================== + +!>\ingroup NoahMP_LSM + subroutine calhum(parameters,sfctmp, sfcprs, q2sat, dqsdt2) + + implicit none + + type (noahmp_parameters), intent(in) :: parameters + real, intent(in) :: sfctmp, sfcprs + real, intent(out) :: q2sat, dqsdt2 + real, parameter :: a2=17.67,a3=273.15,a4=29.65, elwv=2.501e6, & + a23m4=a2*(a3-a4), e0=0.611, rv=461.0, & + epsilon=0.622 + real :: es, sfcprsx + +! q2sat: saturated mixing ratio + es = e0 * exp ( elwv/rv*(1./a3 - 1./sfctmp) ) +! convert sfcprs from pa to kpa + sfcprsx = sfcprs*1.e-3 + q2sat = epsilon * es / (sfcprsx-es) +! convert from g/g to g/kg + q2sat = q2sat * 1.e3 +! q2sat is currently a 'mixing ratio' + +! dqsdt2 is calculated assuming q2sat is a specific humidity + dqsdt2=(q2sat/(1+q2sat))*a23m4/(sfctmp-a4)**2 + +! dg q2sat needs to be in g/g when returned for sflx + q2sat = q2sat / 1.e3 + + end subroutine calhum + +!== begin tsnosoi ================================================================================== + +!>\ingroup NoahMP_LSM + subroutine tsnosoi (parameters,ice ,nsoil ,nsnow ,isnow ,ist , & !in + tbot ,zsnso ,ssoil ,df ,hcpct , & !in + sag ,dt ,snowh ,dzsnso , & !in + tg ,iloc ,jloc , & !in +#ifdef CCPP + stc ,errmsg ,errflg) !inout +#else + stc ) !inout +#endif +! -------------------------------------------------------------------------------------------------- +! compute snow (up to 3l) and soil (4l) temperature. note that snow temperatures +! during melting season may exceed melting point (tfrz) but later in phasechange +! subroutine the snow temperatures are reset to tfrz for melting snow. +! -------------------------------------------------------------------------------------------------- + implicit none +! -------------------------------------------------------------------------------------------------- +!input + + type (noahmp_parameters), intent(in) :: parameters + integer, intent(in) :: iloc + integer, intent(in) :: jloc + integer, intent(in) :: ice ! + integer, intent(in) :: nsoil !no of soil layers (4) + integer, intent(in) :: nsnow !maximum no of snow layers (3) + integer, intent(in) :: isnow !actual no of snow layers + integer, intent(in) :: ist !surface type + + real, intent(in) :: dt !time step (s) + real, intent(in) :: tbot ! + real, intent(in) :: ssoil !ground heat flux (w/m2) + real, intent(in) :: sag !solar rad. absorbed by ground (w/m2) + real, intent(in) :: snowh !snow depth (m) + real, intent(in) :: tg !ground temperature (k) + real, dimension(-nsnow+1:nsoil), intent(in) :: zsnso !layer-bot. depth from snow surf.(m) + real, dimension(-nsnow+1:nsoil), intent(in) :: dzsnso !snow/soil layer thickness (m) + real, dimension(-nsnow+1:nsoil), intent(in) :: df !thermal conductivity + real, dimension(-nsnow+1:nsoil), intent(in) :: hcpct !heat capacity (j/m3/k) + +!input and output + + real, dimension(-nsnow+1:nsoil), intent(inout) :: stc +#ifdef CCPP + character(len=*) , intent(inout) :: errmsg + integer , intent(inout) :: errflg +#endif + +!local + + integer :: iz + real :: zbotsno !zbot from snow surface + real, dimension(-nsnow+1:nsoil) :: ai, bi, ci, rhsts + real :: eflxb !energy influx from soil bottom (w/m2) + real, dimension(-nsnow+1:nsoil) :: phi !light through water (w/m2) + + real, dimension(-nsnow+1:nsoil) :: tbeg + real :: err_est !heat storage error (w/m2) + real :: ssoil2 !ground heat flux (w/m2) (for energy check) + real :: eflxb2 !heat flux from the bottom (w/m2) (for energy check) + character(len=256) :: message +! ---------------------------------------------------------------------- +! compute solar penetration through water, needs more work + + phi(isnow+1:nsoil) = 0. + +! adjust zbot from soil surface to zbotsno from snow surface + + zbotsno = parameters%zbot - snowh !from snow surface + +! snow/soil heat storage for energy balance check + + do iz = isnow+1, nsoil + tbeg(iz) = stc(iz) + enddo + +! compute soil temperatures + + call hrt (parameters,nsnow ,nsoil ,isnow ,zsnso , & + stc ,tbot ,zbotsno ,dt , & + df ,hcpct ,ssoil ,phi , & + ai ,bi ,ci ,rhsts , & + eflxb ) + + call hstep (parameters,nsnow ,nsoil ,isnow ,dt , & + ai ,bi ,ci ,rhsts , & + stc ) + +! update ground heat flux just for energy check, but not for final output +! otherwise, it would break the surface energy balance + + if(opt_tbot == 1) then + eflxb2 = 0. + else if(opt_tbot == 2) then + eflxb2 = df(nsoil)*(tbot-stc(nsoil)) / & + (0.5*(zsnso(nsoil-1)+zsnso(nsoil)) - zbotsno) + end if + + ! skip the energy balance check for now, until we can make it work + ! right for small time steps. + return + +! energy balance check + + err_est = 0.0 + do iz = isnow+1, nsoil + err_est = err_est + (stc(iz)-tbeg(iz)) * dzsnso(iz) * hcpct(iz) / dt + enddo + + if (opt_stc == 1) then ! semi-implicit + err_est = err_est - (ssoil +eflxb) + else ! full-implicit + ssoil2 = df(isnow+1)*(tg-stc(isnow+1))/(0.5*dzsnso(isnow+1)) !m. barlage + err_est = err_est - (ssoil2+eflxb2) + endif + + if (abs(err_est) > 1.) then ! w/m2 + write(message,*) 'tsnosoi is losing(-)/gaining(+) false energy',err_est,' w/m2' +#ifdef CCPP + errmsg = trim(message) +#else + call wrf_message(trim(message)) +#endif + write(message,'(i6,1x,i6,1x,i3,f18.13,5f20.12)') & + iloc, jloc, ist,err_est,ssoil,snowh,tg,stc(isnow+1),eflxb +#ifdef CCPP + errmsg = trim(errmsg)//NEW_LINE('A')//trim(message) +#else + call wrf_message(trim(message)) +#endif + !niu stop + end if + + end subroutine tsnosoi + +!== begin hrt ====================================================================================== + +!>\ingroup NoahMP_LSM + subroutine hrt (parameters,nsnow ,nsoil ,isnow ,zsnso , & + stc ,tbot ,zbot ,dt , & + df ,hcpct ,ssoil ,phi , & + ai ,bi ,ci ,rhsts , & + botflx ) +! ---------------------------------------------------------------------- +! ---------------------------------------------------------------------- +! calculate the right hand side of the time tendency term of the soil +! thermal diffusion equation. also to compute ( prepare ) the matrix +! coefficients for the tri-diagonal matrix of the implicit time scheme. +! ---------------------------------------------------------------------- + implicit none +! ---------------------------------------------------------------------- +! input + + type (noahmp_parameters), intent(in) :: parameters + integer, intent(in) :: nsoil !no of soil layers (4) + integer, intent(in) :: nsnow !maximum no of snow layers (3) + integer, intent(in) :: isnow !actual no of snow layers + real, intent(in) :: tbot !bottom soil temp. at zbot (k) + real, intent(in) :: zbot !depth of lower boundary condition (m) + !from soil surface not snow surface + real, intent(in) :: dt !time step (s) + real, intent(in) :: ssoil !ground heat flux (w/m2) + real, dimension(-nsnow+1:nsoil), intent(in) :: zsnso !depth of layer-bottom of snow/soil (m) + real, dimension(-nsnow+1:nsoil), intent(in) :: stc !snow/soil temperature (k) + real, dimension(-nsnow+1:nsoil), intent(in) :: df !thermal conductivity [w/m/k] + real, dimension(-nsnow+1:nsoil), intent(in) :: hcpct !heat capacity [j/m3/k] + real, dimension(-nsnow+1:nsoil), intent(in) :: phi !light through water (w/m2) + +! output + + real, dimension(-nsnow+1:nsoil), intent(out) :: rhsts !right-hand side of the matrix + real, dimension(-nsnow+1:nsoil), intent(out) :: ai !left-hand side coefficient + real, dimension(-nsnow+1:nsoil), intent(out) :: bi !left-hand side coefficient + real, dimension(-nsnow+1:nsoil), intent(out) :: ci !left-hand side coefficient + real, intent(out) :: botflx !energy influx from soil bottom (w/m2) + +! local + + integer :: k + real, dimension(-nsnow+1:nsoil) :: ddz + real, dimension(-nsnow+1:nsoil) :: dz + real, dimension(-nsnow+1:nsoil) :: denom + real, dimension(-nsnow+1:nsoil) :: dtsdz + real, dimension(-nsnow+1:nsoil) :: eflux + real :: temp1 +! ---------------------------------------------------------------------- + + do k = isnow+1, nsoil + if (k == isnow+1) then + denom(k) = - zsnso(k) * hcpct(k) + temp1 = - zsnso(k+1) + ddz(k) = 2.0 / temp1 + dtsdz(k) = 2.0 * (stc(k) - stc(k+1)) / temp1 + eflux(k) = df(k) * dtsdz(k) - ssoil - phi(k) + else if (k < nsoil) then + denom(k) = (zsnso(k-1) - zsnso(k)) * hcpct(k) + temp1 = zsnso(k-1) - zsnso(k+1) + ddz(k) = 2.0 / temp1 + dtsdz(k) = 2.0 * (stc(k) - stc(k+1)) / temp1 + eflux(k) = (df(k)*dtsdz(k) - df(k-1)*dtsdz(k-1)) - phi(k) + else if (k == nsoil) then + denom(k) = (zsnso(k-1) - zsnso(k)) * hcpct(k) + temp1 = zsnso(k-1) - zsnso(k) + if(opt_tbot == 1) then + botflx = 0. + end if + if(opt_tbot == 2) then + dtsdz(k) = (stc(k) - tbot) / ( 0.5*(zsnso(k-1)+zsnso(k)) - zbot) + botflx = -df(k) * dtsdz(k) + end if + eflux(k) = (-botflx - df(k-1)*dtsdz(k-1) ) - phi(k) + end if + end do + + do k = isnow+1, nsoil + if (k == isnow+1) then + ai(k) = 0.0 + ci(k) = - df(k) * ddz(k) / denom(k) + if (opt_stc == 1) then + bi(k) = - ci(k) + end if + if (opt_stc == 2) then + bi(k) = - ci(k) + df(k)/(0.5*zsnso(k)*zsnso(k)*hcpct(k)) + end if + else if (k < nsoil) then + ai(k) = - df(k-1) * ddz(k-1) / denom(k) + ci(k) = - df(k ) * ddz(k ) / denom(k) + bi(k) = - (ai(k) + ci (k)) + else if (k == nsoil) then + ai(k) = - df(k-1) * ddz(k-1) / denom(k) + ci(k) = 0.0 + bi(k) = - (ai(k) + ci(k)) + end if + rhsts(k) = eflux(k)/ (-denom(k)) + end do + + end subroutine hrt + +!== begin hstep ==================================================================================== + +!>\ingroup NoahMP_LSM + subroutine hstep (parameters,nsnow ,nsoil ,isnow ,dt , & + ai ,bi ,ci ,rhsts , & + stc ) +! ---------------------------------------------------------------------- +! calculate/update the soil temperature field. +! ---------------------------------------------------------------------- + implicit none +! ---------------------------------------------------------------------- +! input + + type (noahmp_parameters), intent(in) :: parameters + integer, intent(in) :: nsoil + integer, intent(in) :: nsnow + integer, intent(in) :: isnow + real, intent(in) :: dt + +! output & input + real, dimension(-nsnow+1:nsoil), intent(inout) :: rhsts + real, dimension(-nsnow+1:nsoil), intent(inout) :: ai + real, dimension(-nsnow+1:nsoil), intent(inout) :: bi + real, dimension(-nsnow+1:nsoil), intent(inout) :: ci + real, dimension(-nsnow+1:nsoil), intent(inout) :: stc + +! local + integer :: k + real, dimension(-nsnow+1:nsoil) :: rhstsin + real, dimension(-nsnow+1:nsoil) :: ciin +! ---------------------------------------------------------------------- + + do k = isnow+1,nsoil + rhsts(k) = rhsts(k) * dt + ai(k) = ai(k) * dt + bi(k) = 1. + bi(k) * dt + ci(k) = ci(k) * dt + end do + + +! copy values for input variables before call to rosr12 + + do k = isnow+1,nsoil + rhstsin(k) = rhsts(k) + ciin(k) = ci(k) + end do + +! solve the tri-diagonal matrix equation + + + call rosr12 (ci,ai,bi,ciin,rhstsin,rhsts,isnow+1,nsoil,nsnow) + +! update snow & soil temperature + + do k = isnow+1,nsoil + stc (k) = stc (k) + ci (k) + end do + + end subroutine hstep + +!== begin rosr12 =================================================================================== + +!>\ingroup NoahMP_LSM + subroutine rosr12 (p,a,b,c,d,delta,ntop,nsoil,nsnow) +! ---------------------------------------------------------------------- +! subroutine rosr12 +! ---------------------------------------------------------------------- +! invert (solve) the tri-diagonal matrix problem shown below: +! ### ### ### ### ### ### +! #b(1), c(1), 0 , 0 , 0 , . . . , 0 # # # # # +! #a(2), b(2), c(2), 0 , 0 , . . . , 0 # # # # # +! # 0 , a(3), b(3), c(3), 0 , . . . , 0 # # # # d(3) # +! # 0 , 0 , a(4), b(4), c(4), . . . , 0 # # p(4) # # d(4) # +! # 0 , 0 , 0 , a(5), b(5), . . . , 0 # # p(5) # # d(5) # +! # . . # # . # = # . # +! # . . # # . # # . # +! # . . # # . # # . # +! # 0 , . . . , 0 , a(m-2), b(m-2), c(m-2), 0 # #p(m-2)# #d(m-2)# +! # 0 , . . . , 0 , 0 , a(m-1), b(m-1), c(m-1)# #p(m-1)# #d(m-1)# +! # 0 , . . . , 0 , 0 , 0 , a(m) , b(m) # # p(m) # # d(m) # +! ### ### ### ### ### ### +! ---------------------------------------------------------------------- + implicit none + + integer, intent(in) :: ntop + integer, intent(in) :: nsoil,nsnow + integer :: k, kk + + real, dimension(-nsnow+1:nsoil),intent(in):: a, b, d + real, dimension(-nsnow+1:nsoil),intent(inout):: c,p,delta + +! ---------------------------------------------------------------------- +! initialize eqn coef c for the lowest soil layer +! ---------------------------------------------------------------------- + c (nsoil) = 0.0 + p (ntop) = - c (ntop) / b (ntop) +! ---------------------------------------------------------------------- +! solve the coefs for the 1st soil layer +! ---------------------------------------------------------------------- + delta (ntop) = d (ntop) / b (ntop) +! ---------------------------------------------------------------------- +! solve the coefs for soil layers 2 thru nsoil +! ---------------------------------------------------------------------- + do k = ntop+1,nsoil + p (k) = - c (k) * ( 1.0 / (b (k) + a (k) * p (k -1)) ) + delta (k) = (d (k) - a (k)* delta (k -1))* (1.0/ (b (k) + a (k)& + * p (k -1))) + end do +! ---------------------------------------------------------------------- +! set p to delta for lowest soil layer +! ---------------------------------------------------------------------- + p (nsoil) = delta (nsoil) +! ---------------------------------------------------------------------- +! adjust p for soil layers 2 thru nsoil +! ---------------------------------------------------------------------- + do k = ntop+1,nsoil + kk = nsoil - k + (ntop-1) + 1 + p (kk) = p (kk) * p (kk +1) + delta (kk) + end do +! ---------------------------------------------------------------------- + end subroutine rosr12 + +!== begin phasechange ============================================================================== + +!>\ingroup NoahMP_LSM + subroutine phasechange (parameters,nsnow ,nsoil ,isnow ,dt ,fact , & !in + dzsnso ,hcpct ,ist ,iloc ,jloc , & !in + stc ,snice ,snliq ,sneqv ,snowh , & !inout +#ifdef CCPP + smc ,sh2o ,errmsg ,errflg , & !inout +#else + smc ,sh2o , & !inout +#endif + qmelt ,imelt ,ponding ) !out +! ---------------------------------------------------------------------- +! melting/freezing of snow water and soil water +! ---------------------------------------------------------------------- + implicit none +! ---------------------------------------------------------------------- +! inputs + + type (noahmp_parameters), intent(in) :: parameters + integer, intent(in) :: iloc !grid index + integer, intent(in) :: jloc !grid index + integer, intent(in) :: nsnow !maximum no. of snow layers [=3] + integer, intent(in) :: nsoil !no. of soil layers [=4] + integer, intent(in) :: isnow !actual no. of snow layers [<=3] + integer, intent(in) :: ist !surface type: 1->soil; 2->lake + real, intent(in) :: dt !land model time step (sec) + real, dimension(-nsnow+1:nsoil), intent(in) :: fact !temporary + real, dimension(-nsnow+1:nsoil), intent(in) :: dzsnso !snow/soil layer thickness [m] + real, dimension(-nsnow+1:nsoil), intent(in) :: hcpct !heat capacity (j/m3/k) + +! outputs + integer, dimension(-nsnow+1:nsoil), intent(out) :: imelt !phase change index + real, intent(out) :: qmelt !snowmelt rate [mm/s] + real, intent(out) :: ponding!snowmelt when snow has no layer [mm] + +! inputs and outputs + + real, intent(inout) :: sneqv + real, intent(inout) :: snowh + real, dimension(-nsnow+1:nsoil), intent(inout) :: stc !snow/soil layer temperature [k] + real, dimension( 1:nsoil), intent(inout) :: sh2o !soil liquid water [m3/m3] + real, dimension( 1:nsoil), intent(inout) :: smc !total soil water [m3/m3] + real, dimension(-nsnow+1:0) , intent(inout) :: snice !snow layer ice [mm] + real, dimension(-nsnow+1:0) , intent(inout) :: snliq !snow layer liquid water [mm] +#ifdef CCPP + character(len=*) , intent(inout) :: errmsg + integer , intent(inout) :: errflg +#endif + +! local + + integer :: j !do loop index + real, dimension(-nsnow+1:nsoil) :: hm !energy residual [w/m2] + real, dimension(-nsnow+1:nsoil) :: xm !melting or freezing water [kg/m2] + real, dimension(-nsnow+1:nsoil) :: wmass0 + real, dimension(-nsnow+1:nsoil) :: wice0 + real, dimension(-nsnow+1:nsoil) :: wliq0 + real, dimension(-nsnow+1:nsoil) :: mice !soil/snow ice mass [mm] + real, dimension(-nsnow+1:nsoil) :: mliq !soil/snow liquid water mass [mm] + real, dimension(-nsnow+1:nsoil) :: supercool !supercooled water in soil (kg/m2) + real :: heatr !energy residual or loss after melting/freezing + real :: temp1 !temporary variables [kg/m2] + real :: propor + real :: smp !frozen water potential (mm) + real :: xmf !total latent heat of phase change + +! ---------------------------------------------------------------------- +! initialization + + qmelt = 0. + ponding = 0. + xmf = 0. + + do j = -nsnow+1, nsoil + supercool(j) = 0.0 + end do + + do j = isnow+1,0 ! all layers + mice(j) = snice(j) + mliq(j) = snliq(j) + end do + + do j = 1, nsoil ! soil + mliq(j) = sh2o(j) * dzsnso(j) * 1000. + mice(j) = (smc(j) - sh2o(j)) * dzsnso(j) * 1000. + end do + + do j = isnow+1,nsoil ! all layers + imelt(j) = 0 + hm(j) = 0. + xm(j) = 0. + wice0(j) = mice(j) + wliq0(j) = mliq(j) + wmass0(j) = mice(j) + mliq(j) + enddo + + if(ist == 1) then + do j = 1,nsoil + if (opt_frz == 1) then + if(stc(j) < tfrz) then + smp = hfus*(tfrz-stc(j))/(grav*stc(j)) !(m) + supercool(j) = parameters%smcmax*(smp/parameters%psisat)**(-1./parameters%bexp) + supercool(j) = supercool(j)*dzsnso(j)*1000. !(mm) + end if + end if + if (opt_frz == 2) then +#ifdef CCPP + call frh2o (parameters,supercool(j),stc(j),smc(j),sh2o(j),errmsg,errflg) + if (errflg /=0) return +#else + call frh2o (parameters,supercool(j),stc(j),smc(j),sh2o(j)) +#endif + supercool(j) = supercool(j)*dzsnso(j)*1000. !(mm) + end if + enddo + end if + + do j = isnow+1,nsoil + if (mice(j) > 0. .and. stc(j) >= tfrz) then !melting + imelt(j) = 1 + endif + if (mliq(j) > supercool(j) .and. stc(j) < tfrz) then + imelt(j) = 2 + endif + + ! if snow exists, but its thickness is not enough to create a layer + if (isnow == 0 .and. sneqv > 0. .and. j == 1) then + if (stc(j) >= tfrz) then + imelt(j) = 1 + endif + endif + enddo + +! calculate the energy surplus and loss for melting and freezing + + do j = isnow+1,nsoil + if (imelt(j) > 0) then + hm(j) = (stc(j)-tfrz)/fact(j) + stc(j) = tfrz + endif + + if (imelt(j) == 1 .and. hm(j) < 0.) then + hm(j) = 0. + imelt(j) = 0 + endif + if (imelt(j) == 2 .and. hm(j) > 0.) then + hm(j) = 0. + imelt(j) = 0 + endif + xm(j) = hm(j)*dt/hfus + enddo + +! the rate of melting and freezing for snow without a layer, needs more work. + + if (isnow == 0 .and. sneqv > 0. .and. xm(1) > 0.) then + temp1 = sneqv + sneqv = max(0.,temp1-xm(1)) + propor = sneqv/temp1 + snowh = max(0.,propor * snowh) + heatr = hm(1) - hfus*(temp1-sneqv)/dt + if (heatr > 0.) then + xm(1) = heatr*dt/hfus + hm(1) = heatr + else + xm(1) = 0. + hm(1) = 0. + endif + qmelt = max(0.,(temp1-sneqv))/dt + xmf = hfus*qmelt + ponding = temp1-sneqv + endif + +! the rate of melting and freezing for snow and soil + + do j = isnow+1,nsoil + if (imelt(j) > 0 .and. abs(hm(j)) > 0.) then + + heatr = 0. + if (xm(j) > 0.) then + mice(j) = max(0., wice0(j)-xm(j)) + heatr = hm(j) - hfus*(wice0(j)-mice(j))/dt + else if (xm(j) < 0.) then + if (j <= 0) then ! snow + mice(j) = min(wmass0(j), wice0(j)-xm(j)) + else ! soil + if (wmass0(j) < supercool(j)) then + mice(j) = 0. + else + mice(j) = min(wmass0(j) - supercool(j),wice0(j)-xm(j)) + mice(j) = max(mice(j),0.0) + endif + endif + heatr = hm(j) - hfus*(wice0(j)-mice(j))/dt + endif + + mliq(j) = max(0.,wmass0(j)-mice(j)) + + if (abs(heatr) > 0.) then + stc(j) = stc(j) + fact(j)*heatr + if (j <= 0) then ! snow + if (mliq(j)*mice(j)>0.) stc(j) = tfrz + end if + endif + + xmf = xmf + hfus * (wice0(j)-mice(j))/dt + + if (j < 1) then + qmelt = qmelt + max(0.,(wice0(j)-mice(j)))/dt + endif + endif + enddo + + do j = isnow+1,0 ! snow + snliq(j) = mliq(j) + snice(j) = mice(j) + end do + + do j = 1, nsoil ! soil + sh2o(j) = mliq(j) / (1000. * dzsnso(j)) + smc(j) = (mliq(j) + mice(j)) / (1000. * dzsnso(j)) + end do + + end subroutine phasechange + +!== begin frh2o ==================================================================================== + +!>\ingroup NoahMP_LSM + subroutine frh2o (parameters,free,tkelv,smc,sh2o,& +#ifdef CCPP + errmsg,errflg) +#else + ) +#endif + +! ---------------------------------------------------------------------- +! subroutine frh2o +! ---------------------------------------------------------------------- +! calculate amount of supercooled liquid soil water content if +! temperature is below 273.15k (tfrz). requires newton-type iteration +! to solve the nonlinear implicit equation given in eqn 17 of koren et al +! (1999, jgr, vol 104(d16), 19569-19585). +! ---------------------------------------------------------------------- +! new version (june 2001): much faster and more accurate newton +! iteration achieved by first taking log of eqn cited above -- less than +! 4 (typically 1 or 2) iterations achieves convergence. also, explicit +! 1-step solution option for special case of parameter ck=0, which +! reduces the original implicit equation to a simpler explicit form, +! known as the "flerchinger eqn". improved handling of solution in the +! limit of freezing point temperature tfrz. +! ---------------------------------------------------------------------- +! input: + +! tkelv.........temperature (kelvin) +! smc...........total soil moisture content (volumetric) +! sh2o..........liquid soil moisture content (volumetric) +! b.............soil type "b" parameter (from redprm) +! psisat........saturated soil matric potential (from redprm) + +! output: +! free..........supercooled liquid water content [m3/m3] +! ---------------------------------------------------------------------- + implicit none + type (noahmp_parameters), intent(in) :: parameters + real, intent(in) :: sh2o,smc,tkelv + real, intent(out) :: free +#ifdef CCPP + character(len=*), intent(inout) :: errmsg + integer, intent(inout) :: errflg +#endif + real :: bx,denom,df,dswl,fk,swl,swlk + integer :: nlog,kcount +! parameter(ck = 0.0) + real, parameter :: ck = 8.0, blim = 5.5, error = 0.005, & + dice = 920.0 + character(len=80) :: message + +! ---------------------------------------------------------------------- +! limits on parameter b: b < 5.5 (use parameter blim) +! simulations showed if b > 5.5 unfrozen water content is +! non-realistically high at very low temperatures. +! ---------------------------------------------------------------------- + bx = parameters%bexp +! ---------------------------------------------------------------------- +! initializing iterations counter and iterative solution flag. +! ---------------------------------------------------------------------- + + if (parameters%bexp > blim) bx = blim + nlog = 0 + +! ---------------------------------------------------------------------- +! if temperature not significantly below freezing (tfrz), sh2o = smc +! ---------------------------------------------------------------------- + kcount = 0 + if (tkelv > (tfrz- 1.e-3)) then + free = smc + else + +! ---------------------------------------------------------------------- +! option 1: iterated solution in koren et al, jgr, 1999, eqn 17 +! ---------------------------------------------------------------------- +! initial guess for swl (frozen content) +! ---------------------------------------------------------------------- + if (ck /= 0.0) then + swl = smc - sh2o +! ---------------------------------------------------------------------- +! keep within bounds. +! ---------------------------------------------------------------------- + if (swl > (smc -0.02)) swl = smc -0.02 +! ---------------------------------------------------------------------- +! start of iterations +! ---------------------------------------------------------------------- + if (swl < 0.) swl = 0. +1001 continue + if (.not.( (nlog < 10) .and. (kcount == 0))) goto 1002 + nlog = nlog +1 + df = alog ( ( parameters%psisat * grav / hfus ) * ( ( 1. + ck * swl )**2.) * & + ( parameters%smcmax / (smc - swl) )** bx) - alog ( - ( & + tkelv - tfrz)/ tkelv) + denom = 2. * ck / ( 1. + ck * swl ) + bx / ( smc - swl ) + swlk = swl - df / denom +! ---------------------------------------------------------------------- +! bounds useful for mathematical solution. +! ---------------------------------------------------------------------- + if (swlk > (smc -0.02)) swlk = smc - 0.02 + if (swlk < 0.) swlk = 0. + +! ---------------------------------------------------------------------- +! mathematical solution bounds applied. +! ---------------------------------------------------------------------- + dswl = abs (swlk - swl) +! if more than 10 iterations, use explicit method (ck=0 approx.) +! when dswl less or eq. error, no more iterations required. +! ---------------------------------------------------------------------- + swl = swlk + if ( dswl <= error ) then + kcount = kcount +1 + end if +! ---------------------------------------------------------------------- +! end of iterations +! ---------------------------------------------------------------------- +! bounds applied within do-block are valid for physical solution. +! ---------------------------------------------------------------------- + goto 1001 +1002 continue + free = smc - swl + end if +! ---------------------------------------------------------------------- +! end option 1 +! ---------------------------------------------------------------------- +! ---------------------------------------------------------------------- +! option 2: explicit solution for flerchinger eq. i.e. ck=0 +! in koren et al., jgr, 1999, eqn 17 +! apply physical bounds to flerchinger solution +! ---------------------------------------------------------------------- + if (kcount == 0) then + write(message, '("flerchinger used in new version. iterations=", i6)') nlog +#ifdef CCPP + errmsg = trim(message) +#else + call wrf_message(trim(message)) +#endif + fk = ( ( (hfus / (grav * ( - parameters%psisat)))* & + ( (tkelv - tfrz)/ tkelv))** ( -1/ bx))* parameters%smcmax + if (fk < 0.02) fk = 0.02 + free = min (fk, smc) +! ---------------------------------------------------------------------- +! end option 2 +! ---------------------------------------------------------------------- + end if + end if +! ---------------------------------------------------------------------- + end subroutine frh2o +! ---------------------------------------------------------------------- +! ================================================================================================== +! **********************end of energy subroutines*********************** +! ================================================================================================== + +!== begin water ==================================================================================== + +!>\ingroup NoahMP_LSM + subroutine water (parameters,vegtyp ,nsnow ,nsoil ,imelt ,dt ,uu , & !in + vv ,fcev ,fctr ,qprecc ,qprecl ,elai , & !in + esai ,sfctmp ,qvap ,qdew ,zsoil ,btrani , & !in + ficeold,ponding,tg ,ist ,fveg ,iloc ,jloc ,smceq , & !in + bdfall ,fp ,rain ,snow, & !in mb/an: v3.7 + qsnow ,qrain ,snowhin,latheav,latheag,frozen_canopy,frozen_ground, & !in mb + isnow ,canliq ,canice ,tv ,snowh ,sneqv , & !inout + snice ,snliq ,stc ,zsnso ,sh2o ,smc , & !inout + sice ,zwt ,wa ,wt ,dzsnso ,wslake , & !inout + smcwtd ,deeprech,rech , & !inout + cmc ,ecan ,etran ,fwet ,runsrf ,runsub , & !out + qin ,qdis ,ponding1 ,ponding2, & + qsnbot ,esnow) +! ---------------------------------------------------------------------- +! code history: +! initial code: guo-yue niu, oct. 2007 +! ---------------------------------------------------------------------- + implicit none +! ---------------------------------------------------------------------- +! input + type (noahmp_parameters), intent(in) :: parameters + integer, intent(in) :: iloc !grid index + integer, intent(in) :: jloc !grid index + integer, intent(in) :: vegtyp !vegetation type + integer, intent(in) :: nsnow !maximum no. of snow layers + integer , intent(in) :: ist !surface type 1-soil; 2-lake + integer, intent(in) :: nsoil !no. of soil layers + integer, dimension(-nsnow+1:0) , intent(in) :: imelt !melting state index [1-melt; 2-freeze] + real, intent(in) :: dt !main time step (s) + real, intent(in) :: uu !u-direction wind speed [m/s] + real, intent(in) :: vv !v-direction wind speed [m/s] + real, intent(in) :: fcev !canopy evaporation (w/m2) [+ to atm ] + real, intent(in) :: fctr !transpiration (w/m2) [+ to atm] + real, intent(in) :: qprecc !convective precipitation (mm/s) + real, intent(in) :: qprecl !large-scale precipitation (mm/s) + real, intent(in) :: elai !leaf area index, after burying by snow + real, intent(in) :: esai !stem area index, after burying by snow + real, intent(in) :: sfctmp !surface air temperature [k] + real, intent(in) :: qvap !soil surface evaporation rate[mm/s] + real, intent(in) :: qdew !soil surface dew rate[mm/s] + real, dimension( 1:nsoil), intent(in) :: zsoil !depth of layer-bottom from soil surface + real, dimension( 1:nsoil), intent(in) :: btrani !soil water stress factor (0 to 1) + real, dimension(-nsnow+1: 0), intent(in) :: ficeold !ice fraction at last timestep +! real , intent(in) :: ponding ![mm] + real , intent(in) :: tg !ground temperature (k) + real , intent(in) :: fveg !greeness vegetation fraction (-) + real , intent(in) :: bdfall !bulk density of snowfall (kg/m3) ! mb/an: v3.7 + real , intent(in) :: fp !fraction of the gridcell that receives precipitation ! mb/an: v3.7 + real , intent(in) :: rain !rainfall (mm/s) ! mb/an: v3.7 + real , intent(in) :: snow !snowfall (mm/s) ! mb/an: v3.7 + real, dimension( 1:nsoil), intent(in) :: smceq !equilibrium soil water content [m3/m3] (used in m-m&f groundwater dynamics) + real , intent(in) :: qsnow !snow at ground srf (mm/s) [+] + real , intent(in) :: qrain !rain at ground srf (mm) [+] + real , intent(in) :: snowhin !snow depth increasing rate (m/s) + +! input/output + integer, intent(inout) :: isnow !actual no. of snow layers + real, intent(inout) :: canliq !intercepted liquid water (mm) + real, intent(inout) :: canice !intercepted ice mass (mm) + real, intent(inout) :: tv !vegetation temperature (k) + real, intent(inout) :: snowh !snow height [m] + real, intent(inout) :: sneqv !snow water eqv. [mm] + real, dimension(-nsnow+1: 0), intent(inout) :: snice !snow layer ice [mm] + real, dimension(-nsnow+1: 0), intent(inout) :: snliq !snow layer liquid water [mm] + real, dimension(-nsnow+1:nsoil), intent(inout) :: stc !snow/soil layer temperature [k] + real, dimension(-nsnow+1:nsoil), intent(inout) :: zsnso !depth of snow/soil layer-bottom + real, dimension(-nsnow+1:nsoil), intent(inout) :: dzsnso !snow/soil layer thickness [m] + real, dimension( 1:nsoil), intent(inout) :: sh2o !soil liquid water content [m3/m3] + real, dimension( 1:nsoil), intent(inout) :: sice !soil ice content [m3/m3] + real, dimension( 1:nsoil), intent(inout) :: smc !total soil water content [m3/m3] + real, intent(inout) :: zwt !the depth to water table [m] + real, intent(inout) :: wa !water storage in aquifer [mm] + real, intent(inout) :: wt !water storage in aquifer + !+ stuarated soil [mm] + real, intent(inout) :: wslake !water storage in lake (can be -) (mm) + real , intent(inout) :: ponding ![mm] + real, intent(inout) :: smcwtd !soil water content between bottom of the soil and water table [m3/m3] + real, intent(inout) :: deeprech !recharge to or from the water table when deep [m] + real, intent(inout) :: rech !recharge to or from the water table when shallow [m] (diagnostic) + +! output + real, intent(out) :: cmc !intercepted water per ground area (mm) + real, intent(out) :: ecan !evap of intercepted water (mm/s) [+] + real, intent(out) :: etran !transpiration rate (mm/s) [+] + real, intent(out) :: fwet !wetted/snowed fraction of canopy (-) + real, intent(out) :: runsrf !surface runoff [mm/s] + real, intent(out) :: runsub !baseflow (sturation excess) [mm/s] + real, intent(out) :: qin !groundwater recharge [mm/s] + real, intent(out) :: qdis !groundwater discharge [mm/s] + real, intent(out) :: ponding1 + real, intent(out) :: ponding2 + real, intent(out) :: esnow + real, intent(out) :: qsnbot !melting water out of snow bottom [mm/s] + real , intent(in) :: latheav !latent heat vap./sublimation (j/kg) + real , intent(in) :: latheag !latent heat vap./sublimation (j/kg) + logical , intent(in) :: frozen_ground ! used to define latent heat pathway + logical , intent(in) :: frozen_canopy ! used to define latent heat pathway + + +! local + integer :: iz + real :: qinsur !water input on soil surface [m/s] + real :: qseva !soil surface evap rate [mm/s] + real :: qsdew !soil surface dew rate [mm/s] + real :: qsnfro !snow surface frost rate[mm/s] + real :: qsnsub !snow surface sublimation rate [mm/s] + real, dimension( 1:nsoil) :: etrani !transpiration rate (mm/s) [+] + real, dimension( 1:nsoil) :: wcnd !hydraulic conductivity (m/s) + real :: qdrain !soil-bottom free drainage [mm/s] + real :: snoflow !glacier flow [mm/s] + real :: fcrmax !maximum of fcr (-) + + real, parameter :: wslmax = 5000. !maximum lake water storage (mm) + + +! ---------------------------------------------------------------------- +! initialize + + etrani(1:nsoil) = 0. + snoflow = 0. + runsub = 0. + qinsur = 0. + +! canopy-intercepted snowfall/rainfall, drips, and throughfall + + call canwater (parameters,vegtyp ,dt , & !in + fcev ,fctr ,elai , & !in + esai ,tg ,fveg ,iloc , jloc, & !in + bdfall ,frozen_canopy , & !in + canliq ,canice ,tv , & !inout + cmc ,ecan ,etran , & !out + fwet ) !out + +! sublimation, frost, evaporation, and dew + + qsnsub = 0. + if (sneqv > 0.) then + qsnsub = min(qvap, sneqv/dt) + endif + qseva = qvap-qsnsub + esnow = qsnsub*2.83e+6 + + qsnfro = 0. + if (sneqv > 0.) then + qsnfro = qdew + endif + qsdew = qdew - qsnfro + + call snowwater (parameters,nsnow ,nsoil ,imelt ,dt ,zsoil , & !in + & sfctmp ,snowhin,qsnow ,qsnfro ,qsnsub , & !in + & qrain ,ficeold,iloc ,jloc , & !in + & isnow ,snowh ,sneqv ,snice ,snliq , & !inout + & sh2o ,sice ,stc ,zsnso ,dzsnso , & !inout + & qsnbot ,snoflow,ponding1 ,ponding2) !out + + if(frozen_ground) then + sice(1) = sice(1) + (qsdew-qseva)*dt/(dzsnso(1)*1000.) + qsdew = 0.0 + qseva = 0.0 + if(sice(1) < 0.) then + sh2o(1) = sh2o(1) + sice(1) + sice(1) = 0. + end if + end if + +! convert units (mm/s -> m/s) + + !ponding: melting water from snow when there is no layer + qinsur = (ponding+ponding1+ponding2)/dt * 0.001 +! qinsur = ponding/dt * 0.001 + + if(isnow == 0) then + qinsur = qinsur+(qsnbot + qsdew + qrain) * 0.001 + else + qinsur = qinsur+(qsnbot + qsdew) * 0.001 + endif + + qseva = qseva * 0.001 + + do iz = 1, parameters%nroot + etrani(iz) = etran * btrani(iz) * 0.001 + enddo + + +! lake/soil water balances + + if (ist == 2) then ! lake + runsrf = 0. + if(wslake >= wslmax) runsrf = qinsur*1000. !mm/s + wslake = wslake + (qinsur-qseva)*1000.*dt -runsrf*dt !mm + else ! soil + call soilwater (parameters,nsoil ,nsnow ,dt ,zsoil ,dzsnso , & !in + qinsur ,qseva ,etrani ,sice ,iloc , jloc , & !in + sh2o ,smc ,zwt ,vegtyp , & !inout + smcwtd, deeprech , & !inout + runsrf ,qdrain ,runsub ,wcnd ,fcrmax ) !out + + if(opt_run == 1) then + call groundwater (parameters,nsnow ,nsoil ,dt ,sice ,zsoil , & !in + stc ,wcnd ,fcrmax ,iloc ,jloc , & !in + sh2o ,zwt ,wa ,wt , & !inout + qin ,qdis ) !out + runsub = qdis !mm/s + end if + + if(opt_run == 3 .or. opt_run == 4) then + runsub = runsub + qdrain !mm/s + end if + + do iz = 1,nsoil + smc(iz) = sh2o(iz) + sice(iz) + enddo + + if(opt_run == 5) then + call shallowwatertable (parameters,nsnow ,nsoil, zsoil, dt , & !in + dzsnso ,smceq ,iloc , jloc , & !in + smc ,zwt ,smcwtd ,rech, qdrain ) !inout + + sh2o(nsoil) = smc(nsoil) - sice(nsoil) + runsub = runsub + qdrain !it really comes from subroutine watertable, which is not called with the same frequency as the soil routines here + wa = 0. + endif + + endif + + runsub = runsub + snoflow !mm/s + + end subroutine water + +!== begin canwater ================================================================================= + +!>\ingroup NoahMP_LSM + subroutine canwater (parameters,vegtyp ,dt , & !in + fcev ,fctr ,elai , & !in + esai ,tg ,fveg ,iloc , jloc , & !in + bdfall ,frozen_canopy , & !in + canliq ,canice ,tv , & !inout + cmc ,ecan ,etran , & !out + fwet ) !out + +! ------------------------ code history ------------------------------ +! canopy hydrology +! -------------------------------------------------------------------- + implicit none +! ------------------------ input/output variables -------------------- +! input + type (noahmp_parameters), intent(in) :: parameters + integer,intent(in) :: iloc !grid index + integer,intent(in) :: jloc !grid index + integer,intent(in) :: vegtyp !vegetation type + real, intent(in) :: dt !main time step (s) + real, intent(in) :: fcev !canopy evaporation (w/m2) [+ = to atm] + real, intent(in) :: fctr !transpiration (w/m2) [+ = to atm] + real, intent(in) :: elai !leaf area index, after burying by snow + real, intent(in) :: esai !stem area index, after burying by snow + real, intent(in) :: tg !ground temperature (k) + real, intent(in) :: fveg !greeness vegetation fraction (-) + logical , intent(in) :: frozen_canopy ! used to define latent heat pathway + real , intent(in) :: bdfall !bulk density of snowfall (kg/m3) ! mb/an: v3.7 + +! input & output + real, intent(inout) :: canliq !intercepted liquid water (mm) + real, intent(inout) :: canice !intercepted ice mass (mm) + real, intent(inout) :: tv !vegetation temperature (k) + +! output + real, intent(out) :: cmc !intercepted water (mm) + real, intent(out) :: ecan !evaporation of intercepted water (mm/s) [+] + real, intent(out) :: etran !transpiration rate (mm/s) [+] + real, intent(out) :: fwet !wetted or snowed fraction of the canopy (-) +! -------------------------------------------------------------------- + +! ------------------------ local variables --------------------------- + real :: maxsno !canopy capacity for snow interception (mm) + real :: maxliq !canopy capacity for rain interception (mm) + real :: qevac !evaporation rate (mm/s) + real :: qdewc !dew rate (mm/s) + real :: qfroc !frost rate (mm/s) + real :: qsubc !sublimation rate (mm/s) + real :: qmeltc !melting rate of canopy snow (mm/s) + real :: qfrzc !refreezing rate of canopy liquid water (mm/s) + real :: canmas !total canopy mass (kg/m2) +! -------------------------------------------------------------------- +! initialization + + ecan = 0.0 + +! --------------------------- liquid water ------------------------------ +! maximum canopy water + + maxliq = parameters%ch2op * (elai+ esai) + +! evaporation, transpiration, and dew + + if (.not.frozen_canopy) then ! barlage: change to frozen_canopy + etran = max( fctr/hvap, 0. ) + qevac = max( fcev/hvap, 0. ) + qdewc = abs( min( fcev/hvap, 0. ) ) + qsubc = 0. + qfroc = 0. + else + etran = max( fctr/hsub, 0. ) + qevac = 0. + qdewc = 0. + qsubc = max( fcev/hsub, 0. ) + qfroc = abs( min( fcev/hsub, 0. ) ) + endif + +! canopy water balance. for convenience allow dew to bring canliq above +! maxh2o or else would have to re-adjust drip + + qevac = min(canliq/dt,qevac) + canliq=max(0.,canliq+(qdewc-qevac)*dt) + if(canliq <= 1.e-06) canliq = 0.0 + +! --------------------------- canopy ice ------------------------------ +! for canopy ice + + maxsno = 6.6*(0.27+46./bdfall) * (elai+ esai) + + qsubc = min(canice/dt,qsubc) + canice= max(0.,canice + (qfroc-qsubc)*dt) + if(canice.le.1.e-6) canice = 0. + +! wetted fraction of canopy + + if(canice.gt.0.) then + fwet = max(0.,canice) / max(maxsno,1.e-06) + else + fwet = max(0.,canliq) / max(maxliq,1.e-06) + endif + fwet = min(fwet, 1.) ** 0.667 + +! phase change + + qmeltc = 0. + qfrzc = 0. + + if(canice.gt.1.e-6.and.tv.gt.tfrz) then + qmeltc = min(canice/dt,(tv-tfrz)*cice*canice/denice/(dt*hfus)) + canice = max(0.,canice - qmeltc*dt) + canliq = max(0.,canliq + qmeltc*dt) + tv = fwet*tfrz + (1.-fwet)*tv + endif + + if(canliq.gt.1.e-6.and.tv.lt.tfrz) then + qfrzc = min(canliq/dt,(tfrz-tv)*cwat*canliq/denh2o/(dt*hfus)) + canliq = max(0.,canliq - qfrzc*dt) + canice = max(0.,canice + qfrzc*dt) + tv = fwet*tfrz + (1.-fwet)*tv + endif + +! total canopy water + + cmc = canliq + canice + +! total canopy evaporation + + ecan = qevac + qsubc - qdewc - qfroc + + end subroutine canwater + +!== begin snowwater ================================================================================ + +!>\ingroup NoahMP_LSM + subroutine snowwater (parameters,nsnow ,nsoil ,imelt ,dt ,zsoil , & !in + sfctmp ,snowhin,qsnow ,qsnfro ,qsnsub , & !in + qrain ,ficeold,iloc ,jloc , & !in + isnow ,snowh ,sneqv ,snice ,snliq , & !inout + sh2o ,sice ,stc ,zsnso ,dzsnso , & !inout + qsnbot ,snoflow,ponding1 ,ponding2) !out +! ---------------------------------------------------------------------- + implicit none +! ---------------------------------------------------------------------- +! input + type (noahmp_parameters), intent(in) :: parameters + integer, intent(in) :: iloc !grid index + integer, intent(in) :: jloc !grid index + integer, intent(in) :: nsnow !maximum no. of snow layers + integer, intent(in) :: nsoil !no. of soil layers + integer, dimension(-nsnow+1:0) , intent(in) :: imelt !melting state index [0-no melt;1-melt] + real, intent(in) :: dt !time step (s) + real, dimension( 1:nsoil), intent(in) :: zsoil !depth of layer-bottom from soil surface + real, intent(in) :: sfctmp !surface air temperature [k] + real, intent(in) :: snowhin!snow depth increasing rate (m/s) + real, intent(in) :: qsnow !snow at ground srf (mm/s) [+] + real, intent(in) :: qsnfro !snow surface frost rate[mm/s] + real, intent(in) :: qsnsub !snow surface sublimation rate[mm/s] + real, intent(in) :: qrain !snow surface rain rate[mm/s] + real, dimension(-nsnow+1:0) , intent(in) :: ficeold!ice fraction at last timestep + +! input & output + integer, intent(inout) :: isnow !actual no. of snow layers + real, intent(inout) :: snowh !snow height [m] + real, intent(inout) :: sneqv !snow water eqv. [mm] + real, dimension(-nsnow+1: 0), intent(inout) :: snice !snow layer ice [mm] + real, dimension(-nsnow+1: 0), intent(inout) :: snliq !snow layer liquid water [mm] + real, dimension( 1:nsoil), intent(inout) :: sh2o !soil liquid moisture (m3/m3) + real, dimension( 1:nsoil), intent(inout) :: sice !soil ice moisture (m3/m3) + real, dimension(-nsnow+1:nsoil), intent(inout) :: stc !snow layer temperature [k] + real, dimension(-nsnow+1:nsoil), intent(inout) :: zsnso !depth of snow/soil layer-bottom + real, dimension(-nsnow+1:nsoil), intent(inout) :: dzsnso !snow/soil layer thickness [m] + +! output + real, intent(out) :: qsnbot !melting water out of snow bottom [mm/s] + real, intent(out) :: snoflow!glacier flow [mm] + real, intent(out) :: ponding1 + real, intent(out) :: ponding2 + +! local + integer :: iz,i + real :: bdsnow !bulk density of snow (kg/m3) +! ---------------------------------------------------------------------- + snoflow = 0.0 + ponding1 = 0.0 + ponding2 = 0.0 + + call snowfall (parameters,nsoil ,nsnow ,dt ,qsnow ,snowhin, & !in + sfctmp ,iloc ,jloc , & !in + isnow ,snowh ,dzsnso ,stc ,snice , & !inout + snliq ,sneqv ) !inout + +! mb: do each if block separately + + if(isnow < 0) & ! when multi-layer + call compact (parameters,nsnow ,nsoil ,dt ,stc ,snice , & !in + snliq ,zsoil ,imelt ,ficeold,iloc , jloc ,& !in + isnow ,dzsnso ,zsnso ) !inout + + if(isnow < 0) & !when multi-layer + call combine (parameters,nsnow ,nsoil ,iloc ,jloc , & !in + isnow ,sh2o ,stc ,snice ,snliq , & !inout + dzsnso ,sice ,snowh ,sneqv , & !inout + ponding1 ,ponding2) !out + + if(isnow < 0) & !when multi-layer + call divide (parameters,nsnow ,nsoil , & !in + isnow ,stc ,snice ,snliq ,dzsnso ) !inout + + call snowh2o (parameters,nsnow ,nsoil ,dt ,qsnfro ,qsnsub , & !in + qrain ,iloc ,jloc , & !in + isnow ,dzsnso ,snowh ,sneqv ,snice , & !inout + snliq ,sh2o ,sice ,stc , & !inout + qsnbot ,ponding1 ,ponding2) !out + +!set empty snow layers to zero + + do iz = -nsnow+1, isnow + snice(iz) = 0. + snliq(iz) = 0. + stc(iz) = 0. + dzsnso(iz)= 0. + zsnso(iz) = 0. + enddo + +!to obtain equilibrium state of snow in glacier region + + if(sneqv > 2000.) then ! 2000 mm -> maximum water depth + bdsnow = snice(0) / dzsnso(0) + snoflow = (sneqv - 2000.) + snice(0) = snice(0) - snoflow + dzsnso(0) = dzsnso(0) - snoflow/bdsnow + snoflow = snoflow / dt + end if + +! sum up snow mass for layered snow + + if(isnow < 0) then ! mb: only do for multi-layer + sneqv = 0. + do iz = isnow+1,0 + sneqv = sneqv + snice(iz) + snliq(iz) + enddo + end if + +! reset zsnso and layer thinkness dzsnso + + do iz = isnow+1, 0 + dzsnso(iz) = -dzsnso(iz) + end do + + dzsnso(1) = zsoil(1) + do iz = 2,nsoil + dzsnso(iz) = (zsoil(iz) - zsoil(iz-1)) + end do + + zsnso(isnow+1) = dzsnso(isnow+1) + do iz = isnow+2 ,nsoil + zsnso(iz) = zsnso(iz-1) + dzsnso(iz) + enddo + + do iz = isnow+1 ,nsoil + dzsnso(iz) = -dzsnso(iz) + end do + + end subroutine snowwater + +!== begin snowfall ================================================================================= + +!>\ingroup NoahMP_LSM + subroutine snowfall (parameters,nsoil ,nsnow ,dt ,qsnow ,snowhin , & !in + sfctmp ,iloc ,jloc , & !in + isnow ,snowh ,dzsnso ,stc ,snice , & !inout + snliq ,sneqv ) !inout +! ---------------------------------------------------------------------- +! snow depth and density to account for the new snowfall. +! new values of snow depth & density returned. +! ---------------------------------------------------------------------- + implicit none +! ---------------------------------------------------------------------- +! input + + type (noahmp_parameters), intent(in) :: parameters + integer, intent(in) :: iloc !grid index + integer, intent(in) :: jloc !grid index + integer, intent(in) :: nsoil !no. of soil layers + integer, intent(in) :: nsnow !maximum no. of snow layers + real, intent(in) :: dt !main time step (s) + real, intent(in) :: qsnow !snow at ground srf (mm/s) [+] + real, intent(in) :: snowhin!snow depth increasing rate (m/s) + real, intent(in) :: sfctmp !surface air temperature [k] + +! input and output + + integer, intent(inout) :: isnow !actual no. of snow layers + real, intent(inout) :: snowh !snow depth [m] + real, intent(inout) :: sneqv !swow water equivalent [m] + real, dimension(-nsnow+1:nsoil), intent(inout) :: dzsnso !thickness of snow/soil layers (m) + real, dimension(-nsnow+1:nsoil), intent(inout) :: stc !snow layer temperature [k] + real, dimension(-nsnow+1: 0), intent(inout) :: snice !snow layer ice [mm] + real, dimension(-nsnow+1: 0), intent(inout) :: snliq !snow layer liquid water [mm] + +! local + + integer :: newnode ! 0-no new layers, 1-creating new layers +! ---------------------------------------------------------------------- + newnode = 0 + +! shallow snow / no layer + + if(isnow == 0 .and. qsnow > 0.) then + snowh = snowh + snowhin * dt + sneqv = sneqv + qsnow * dt + end if + +! creating a new layer + + if(isnow == 0 .and. qsnow>0. .and. snowh >= 0.025) then !mb: change limit +! if(isnow == 0 .and. qsnow>0. .and. snowh >= 0.05) then + isnow = -1 + newnode = 1 + dzsnso(0)= snowh + snowh = 0. + stc(0) = min(273.16, sfctmp) ! temporary setup + snice(0) = sneqv + snliq(0) = 0. + end if + +! snow with layers + + if(isnow < 0 .and. newnode == 0 .and. qsnow > 0.) then + snice(isnow+1) = snice(isnow+1) + qsnow * dt + dzsnso(isnow+1) = dzsnso(isnow+1) + snowhin * dt + endif + +! ---------------------------------------------------------------------- + end subroutine snowfall + +!== begin combine ================================================================================== + +!>\ingroup NoahMP_LSM + subroutine combine (parameters,nsnow ,nsoil ,iloc ,jloc , & !in + isnow ,sh2o ,stc ,snice ,snliq , & !inout + dzsnso ,sice ,snowh ,sneqv , & !inout + ponding1 ,ponding2) !out +! ---------------------------------------------------------------------- + implicit none +! ---------------------------------------------------------------------- +! input + + type (noahmp_parameters), intent(in) :: parameters + integer, intent(in) :: iloc + integer, intent(in) :: jloc + integer, intent(in) :: nsnow !maximum no. of snow layers + integer, intent(in) :: nsoil !no. of soil layers + +! input and output + + integer, intent(inout) :: isnow !actual no. of snow layers + real, dimension( 1:nsoil), intent(inout) :: sh2o !soil liquid moisture (m3/m3) + real, dimension( 1:nsoil), intent(inout) :: sice !soil ice moisture (m3/m3) + real, dimension(-nsnow+1:nsoil), intent(inout) :: stc !snow layer temperature [k] + real, dimension(-nsnow+1: 0), intent(inout) :: snice !snow layer ice [mm] + real, dimension(-nsnow+1: 0), intent(inout) :: snliq !snow layer liquid water [mm] + real, dimension(-nsnow+1:nsoil), intent(inout) :: dzsnso!snow layer depth [m] + real, intent(inout) :: sneqv !snow water equivalent [m] + real, intent(inout) :: snowh !snow depth [m] + real, intent(out) :: ponding1 + real, intent(out) :: ponding2 + +! local variables: + + integer :: i,j,k,l ! node indices + integer :: isnow_old ! number of top snow layer + integer :: mssi ! node index + integer :: neibor ! adjacent node selected for combination + real :: zwice ! total ice mass in snow + real :: zwliq ! total liquid water in snow + + real :: dzmin(3) ! minimum of top snow layer +! data dzmin /0.045, 0.05, 0.2/ + data dzmin /0.025, 0.025, 0.1/ ! mb: change limit +!----------------------------------------------------------------------- + + isnow_old = isnow + + do j = isnow_old+1,0 + if (snice(j) <= .1) then + if(j /= 0) then + snliq(j+1) = snliq(j+1) + snliq(j) + snice(j+1) = snice(j+1) + snice(j) + else + if (isnow_old < -1) then ! mb/km: change to isnow + snliq(j-1) = snliq(j-1) + snliq(j) + snice(j-1) = snice(j-1) + snice(j) + else + if(snice(j) >= 0.) then + ponding1 = snliq(j) ! isnow will get set to zero below; ponding1 will get + sneqv = snice(j) ! added to ponding from phasechange ponding should be + snowh = dzsnso(j) ! zero here because it was calculated for thin snow + else ! snice over-sublimated earlier + ponding1 = snliq(j) + snice(j) + if(ponding1 < 0.) then ! if snice and snliq sublimates remove from soil + sice(1) = max(0.0,sice(1)+ponding1/(dzsnso(1)*1000.)) + ponding1 = 0.0 + end if + sneqv = 0.0 + snowh = 0.0 + end if + snliq(j) = 0.0 + snice(j) = 0.0 + dzsnso(j) = 0.0 + endif +! sh2o(1) = sh2o(1)+snliq(j)/(dzsnso(1)*1000.) +! sice(1) = sice(1)+snice(j)/(dzsnso(1)*1000.) + endif + + ! shift all elements above this down by one. + if (j > isnow+1 .and. isnow < -1) then + do i = j, isnow+2, -1 + stc(i) = stc(i-1) + snliq(i) = snliq(i-1) + snice(i) = snice(i-1) + dzsnso(i)= dzsnso(i-1) + end do + end if + isnow = isnow + 1 + end if + end do + +! to conserve water in case of too large surface sublimation + + if(sice(1) < 0.) then + sh2o(1) = sh2o(1) + sice(1) + sice(1) = 0. + end if + + if(isnow ==0) return ! mb: get out if no longer multi-layer + + sneqv = 0. + snowh = 0. + zwice = 0. + zwliq = 0. + + do j = isnow+1,0 + sneqv = sneqv + snice(j) + snliq(j) + snowh = snowh + dzsnso(j) + zwice = zwice + snice(j) + zwliq = zwliq + snliq(j) + end do + +! check the snow depth - all snow gone +! the liquid water assumes ponding on soil surface. + + if (snowh < 0.025 .and. isnow < 0 ) then ! mb: change limit +! if (snowh < 0.05 .and. isnow < 0 ) then + isnow = 0 + sneqv = zwice + ponding2 = zwliq ! limit of isnow < 0 means input ponding + if(sneqv <= 0.) snowh = 0. ! should be zero; see above + end if + +! if (snowh < 0.05 ) then +! isnow = 0 +! sneqv = zwice +! sh2o(1) = sh2o(1) + zwliq / (dzsnso(1) * 1000.) +! if(sneqv <= 0.) snowh = 0. +! end if + +! check the snow depth - snow layers combined + + if (isnow < -1) then + + isnow_old = isnow + mssi = 1 + + do i = isnow_old+1,0 + if (dzsnso(i) < dzmin(mssi)) then + + if (i == isnow+1) then + neibor = i + 1 + else if (i == 0) then + neibor = i - 1 + else + neibor = i + 1 + if ((dzsnso(i-1)+dzsnso(i)) < (dzsnso(i+1)+dzsnso(i))) neibor = i-1 + end if + + ! node l and j are combined and stored as node j. + if (neibor > i) then + j = neibor + l = i + else + j = i + l = neibor + end if + + call combo (parameters,dzsnso(j), snliq(j), snice(j), & + stc(j), dzsnso(l), snliq(l), snice(l), stc(l) ) + + ! now shift all elements above this down one. + if (j-1 > isnow+1) then + do k = j-1, isnow+2, -1 + stc(k) = stc(k-1) + snice(k) = snice(k-1) + snliq(k) = snliq(k-1) + dzsnso(k) = dzsnso(k-1) + end do + end if + + ! decrease the number of snow layers + isnow = isnow + 1 + if (isnow >= -1) exit + else + + ! the layer thickness is greater than the prescribed minimum value + mssi = mssi + 1 + + end if + end do + + end if + + end subroutine combine + +!== begin divide =================================================================================== + +!>\ingroup NoahMP_LSM + subroutine divide (parameters,nsnow ,nsoil , & !in + isnow ,stc ,snice ,snliq ,dzsnso ) !inout +! ---------------------------------------------------------------------- + implicit none +! ---------------------------------------------------------------------- +! input + + type (noahmp_parameters), intent(in) :: parameters + integer, intent(in) :: nsnow !maximum no. of snow layers [ =3] + integer, intent(in) :: nsoil !no. of soil layers [ =4] + +! input and output + + integer , intent(inout) :: isnow !actual no. of snow layers + real, dimension(-nsnow+1:nsoil), intent(inout) :: stc !snow layer temperature [k] + real, dimension(-nsnow+1: 0), intent(inout) :: snice !snow layer ice [mm] + real, dimension(-nsnow+1: 0), intent(inout) :: snliq !snow layer liquid water [mm] + real, dimension(-nsnow+1:nsoil), intent(inout) :: dzsnso!snow layer depth [m] + +! local variables: + + integer :: j !indices + integer :: msno !number of layer (top) to msno (bot) + real :: drr !thickness of the combined [m] + real, dimension( 1:nsnow) :: dz !snow layer thickness [m] + real, dimension( 1:nsnow) :: swice !partial volume of ice [m3/m3] + real, dimension( 1:nsnow) :: swliq !partial volume of liquid water [m3/m3] + real, dimension( 1:nsnow) :: tsno !node temperature [k] + real :: zwice !temporary + real :: zwliq !temporary + real :: propor!temporary + real :: dtdz !temporary +! ---------------------------------------------------------------------- + + do j = 1,nsnow + if (j <= abs(isnow)) then + dz(j) = dzsnso(j+isnow) + swice(j) = snice(j+isnow) + swliq(j) = snliq(j+isnow) + tsno(j) = stc(j+isnow) + end if + end do + + msno = abs(isnow) + + if (msno == 1) then + ! specify a new snow layer + if (dz(1) > 0.05) then + msno = 2 + dz(1) = dz(1)/2. + swice(1) = swice(1)/2. + swliq(1) = swliq(1)/2. + dz(2) = dz(1) + swice(2) = swice(1) + swliq(2) = swliq(1) + tsno(2) = tsno(1) + end if + end if + + if (msno > 1) then + if (dz(1) > 0.05) then + drr = dz(1) - 0.05 + propor = drr/dz(1) + zwice = propor*swice(1) + zwliq = propor*swliq(1) + propor = 0.05/dz(1) + swice(1) = propor*swice(1) + swliq(1) = propor*swliq(1) + dz(1) = 0.05 + + call combo (parameters,dz(2), swliq(2), swice(2), tsno(2), drr, & + zwliq, zwice, tsno(1)) + + ! subdivide a new layer + if (msno <= 2 .and. dz(2) > 0.20) then ! mb: change limit +! if (msno <= 2 .and. dz(2) > 0.10) then + msno = 3 + dtdz = (tsno(1) - tsno(2))/((dz(1)+dz(2))/2.) + dz(2) = dz(2)/2. + swice(2) = swice(2)/2. + swliq(2) = swliq(2)/2. + dz(3) = dz(2) + swice(3) = swice(2) + swliq(3) = swliq(2) + tsno(3) = tsno(2) - dtdz*dz(2)/2. + if (tsno(3) >= tfrz) then + tsno(3) = tsno(2) + else + tsno(2) = tsno(2) + dtdz*dz(2)/2. + endif + + end if + end if + end if + + if (msno > 2) then + if (dz(2) > 0.2) then + drr = dz(2) - 0.2 + propor = drr/dz(2) + zwice = propor*swice(2) + zwliq = propor*swliq(2) + propor = 0.2/dz(2) + swice(2) = propor*swice(2) + swliq(2) = propor*swliq(2) + dz(2) = 0.2 + call combo (parameters,dz(3), swliq(3), swice(3), tsno(3), drr, & + zwliq, zwice, tsno(2)) + end if + end if + + isnow = -msno + + do j = isnow+1,0 + dzsnso(j) = dz(j-isnow) + snice(j) = swice(j-isnow) + snliq(j) = swliq(j-isnow) + stc(j) = tsno(j-isnow) + end do + + +! do j = isnow+1,nsoil +! write(*,'(i5,7f10.3)') j, dzsnso(j), snice(j), snliq(j),stc(j) +! end do + + end subroutine divide + +!== begin combo ==================================================================================== + +!>\ingroup NoahMP_LSM + subroutine combo(parameters,dz, wliq, wice, t, dz2, wliq2, wice2, t2) +! ---------------------------------------------------------------------- + implicit none +! ---------------------------------------------------------------------- + +! ----------------------------------------------------------------------s +! input + + type (noahmp_parameters), intent(in) :: parameters + real, intent(in) :: dz2 !nodal thickness of 2 elements being combined [m] + real, intent(in) :: wliq2 !liquid water of element 2 [kg/m2] + real, intent(in) :: wice2 !ice of element 2 [kg/m2] + real, intent(in) :: t2 !nodal temperature of element 2 [k] + real, intent(inout) :: dz !nodal thickness of 1 elements being combined [m] + real, intent(inout) :: wliq !liquid water of element 1 + real, intent(inout) :: wice !ice of element 1 [kg/m2] + real, intent(inout) :: t !node temperature of element 1 [k] + +! local + + real :: dzc !total thickness of nodes 1 and 2 (dzc=dz+dz2). + real :: wliqc !combined liquid water [kg/m2] + real :: wicec !combined ice [kg/m2] + real :: tc !combined node temperature [k] + real :: h !enthalpy of element 1 [j/m2] + real :: h2 !enthalpy of element 2 [j/m2] + real :: hc !temporary + +!----------------------------------------------------------------------- + + dzc = dz+dz2 + wicec = (wice+wice2) + wliqc = (wliq+wliq2) + h = (cice*wice+cwat*wliq) * (t-tfrz)+hfus*wliq + h2= (cice*wice2+cwat*wliq2) * (t2-tfrz)+hfus*wliq2 + + hc = h + h2 + if(hc < 0.)then + tc = tfrz + hc/(cice*wicec + cwat*wliqc) + else if (hc.le.hfus*wliqc) then + tc = tfrz + else + tc = tfrz + (hc - hfus*wliqc) / (cice*wicec + cwat*wliqc) + end if + + dz = dzc + wice = wicec + wliq = wliqc + t = tc + + end subroutine combo + +!== begin compact ================================================================================== + +!>\ingroup NoahMP_LSM + subroutine compact (parameters,nsnow ,nsoil ,dt ,stc ,snice , & !in + snliq ,zsoil ,imelt ,ficeold,iloc , jloc , & !in + isnow ,dzsnso ,zsnso ) !inout +! ---------------------------------------------------------------------- + implicit none +! ---------------------------------------------------------------------- +! input + type (noahmp_parameters), intent(in) :: parameters + integer, intent(in) :: iloc !grid index + integer, intent(in) :: jloc !grid index + integer, intent(in) :: nsoil !no. of soil layers [ =4] + integer, intent(in) :: nsnow !maximum no. of snow layers [ =3] + integer, dimension(-nsnow+1:0) , intent(in) :: imelt !melting state index [0-no melt;1-melt] + real, intent(in) :: dt !time step (sec) + real, dimension(-nsnow+1:nsoil), intent(in) :: stc !snow layer temperature [k] + real, dimension(-nsnow+1: 0), intent(in) :: snice !snow layer ice [mm] + real, dimension(-nsnow+1: 0), intent(in) :: snliq !snow layer liquid water [mm] + real, dimension( 1:nsoil), intent(in) :: zsoil !depth of layer-bottom from soil srf + real, dimension(-nsnow+1: 0), intent(in) :: ficeold!ice fraction at last timestep + +! input and output + integer, intent(inout) :: isnow ! actual no. of snow layers + real, dimension(-nsnow+1:nsoil), intent(inout) :: dzsnso ! snow layer thickness [m] + real, dimension(-nsnow+1:nsoil), intent(inout) :: zsnso ! depth of snow/soil layer-bottom + +! local + real, parameter :: c2 = 21.e-3 ![m3/kg] ! default 21.e-3 + real, parameter :: c3 = 2.5e-6 ![1/s] + real, parameter :: c4 = 0.04 ![1/k] + real, parameter :: c5 = 2.0 ! + real, parameter :: dm = 100.0 !upper limit on destructive metamorphism compaction [kg/m3] + real, parameter :: eta0 = 0.8e+6 !viscosity coefficient [kg-s/m2] + !according to anderson, it is between 0.52e6~1.38e6 + real :: burden !pressure of overlying snow [kg/m2] + real :: ddz1 !rate of settling of snow pack due to destructive metamorphism. + real :: ddz2 !rate of compaction of snow pack due to overburden. + real :: ddz3 !rate of compaction of snow pack due to melt [1/s] + real :: dexpf !expf=exp(-c4*(273.15-stc)). + real :: td !stc - tfrz [k] + real :: pdzdtc !nodal rate of change in fractional-thickness due to compaction [fraction/s] + real :: void !void (1 - snice - snliq) + real :: wx !water mass (ice + liquid) [kg/m2] + real :: bi !partial density of ice [kg/m3] + real, dimension(-nsnow+1:0) :: fice !fraction of ice at current time step + + integer :: j + +! ---------------------------------------------------------------------- + burden = 0.0 + + do j = isnow+1, 0 + + wx = snice(j) + snliq(j) + fice(j) = snice(j) / wx + void = 1. - (snice(j)/denice + snliq(j)/denh2o) / dzsnso(j) + + ! allow compaction only for non-saturated node and higher ice lens node. + if (void > 0.001 .and. snice(j) > 0.1) then + bi = snice(j) / dzsnso(j) + td = max(0.,tfrz-stc(j)) + dexpf = exp(-c4*td) + + ! settling as a result of destructive metamorphism + + ddz1 = -c3*dexpf + + if (bi > dm) ddz1 = ddz1*exp(-46.0e-3*(bi-dm)) + + ! liquid water term + + if (snliq(j) > 0.01*dzsnso(j)) ddz1=ddz1*c5 + + ! compaction due to overburden + + ddz2 = -(burden+0.5*wx)*exp(-0.08*td-c2*bi)/eta0 ! 0.5*wx -> self-burden + + ! compaction occurring during melt + + if (imelt(j) == 1) then + ddz3 = max(0.,(ficeold(j) - fice(j))/max(1.e-6,ficeold(j))) + ddz3 = - ddz3/dt ! sometimes too large + else + ddz3 = 0. + end if + + ! time rate of fractional change in dz (units of s-1) + + pdzdtc = (ddz1 + ddz2 + ddz3)*dt + pdzdtc = max(-0.5,pdzdtc) + + ! the change in dz due to compaction + + dzsnso(j) = dzsnso(j)*(1.+pdzdtc) + end if + + ! pressure of overlying snow + + burden = burden + wx + + end do + + end subroutine compact + +!== begin snowh2o ================================================================================== + +!>\ingroup NoahMP_LSM + subroutine snowh2o (parameters,nsnow ,nsoil ,dt ,qsnfro ,qsnsub , & !in + qrain ,iloc ,jloc , & !in + isnow ,dzsnso ,snowh ,sneqv ,snice , & !inout + snliq ,sh2o ,sice ,stc , & !inout + qsnbot ,ponding1 ,ponding2) !out +! ---------------------------------------------------------------------- +! renew the mass of ice lens (snice) and liquid (snliq) of the +! surface snow layer resulting from sublimation (frost) / evaporation (dew) +! ---------------------------------------------------------------------- + implicit none +! ---------------------------------------------------------------------- +! input + + type (noahmp_parameters), intent(in) :: parameters + integer, intent(in) :: iloc !grid index + integer, intent(in) :: jloc !grid index + integer, intent(in) :: nsnow !maximum no. of snow layers[=3] + integer, intent(in) :: nsoil !no. of soil layers[=4] + real, intent(in) :: dt !time step + real, intent(in) :: qsnfro !snow surface frost rate[mm/s] + real, intent(in) :: qsnsub !snow surface sublimation rate[mm/s] + real, intent(in) :: qrain !snow surface rain rate[mm/s] + +! output + + real, intent(out) :: qsnbot !melting water out of snow bottom [mm/s] + +! input and output + + integer, intent(inout) :: isnow !actual no. of snow layers + real, dimension(-nsnow+1:nsoil), intent(inout) :: dzsnso ! snow layer depth [m] + real, intent(inout) :: snowh !snow height [m] + real, intent(inout) :: sneqv !snow water eqv. [mm] + real, dimension(-nsnow+1:0), intent(inout) :: snice !snow layer ice [mm] + real, dimension(-nsnow+1:0), intent(inout) :: snliq !snow layer liquid water [mm] + real, dimension( 1:nsoil), intent(inout) :: sh2o !soil liquid moisture (m3/m3) + real, dimension( 1:nsoil), intent(inout) :: sice !soil ice moisture (m3/m3) + real, dimension(-nsnow+1:nsoil), intent(inout) :: stc !snow layer temperature [k] + +! local variables: + + integer :: j !do loop/array indices + real :: qin !water flow into the element (mm/s) + real :: qout !water flow out of the element (mm/s) + real :: wgdif !ice mass after minus sublimation + real, dimension(-nsnow+1:0) :: vol_liq !partial volume of liquid water in layer + real, dimension(-nsnow+1:0) :: vol_ice !partial volume of ice lens in layer + real, dimension(-nsnow+1:0) :: epore !effective porosity = porosity - vol_ice + real :: propor, temp + real :: ponding1, ponding2 +! ---------------------------------------------------------------------- + +!for the case when sneqv becomes '0' after 'combine' + + if(sneqv == 0.) then + sice(1) = sice(1) + (qsnfro-qsnsub)*dt/(dzsnso(1)*1000.) ! barlage: sh2o->sice v3.6 + if(sice(1) < 0.) then + sh2o(1) = sh2o(1) + sice(1) + sice(1) = 0. + end if + end if + +! for shallow snow without a layer +! snow surface sublimation may be larger than existing snow mass. to conserve water, +! excessive sublimation is used to reduce soil water. smaller time steps would tend +! to aviod this problem. + + if(isnow == 0 .and. sneqv > 0.) then + temp = sneqv + sneqv = sneqv - qsnsub*dt + qsnfro*dt + propor = sneqv/temp + snowh = max(0.,propor * snowh) + + if(sneqv < 0.) then + sice(1) = sice(1) + sneqv/(dzsnso(1)*1000.) + sneqv = 0. + snowh = 0. + end if + if(sice(1) < 0.) then + sh2o(1) = sh2o(1) + sice(1) + sice(1) = 0. + end if + end if + + if(snowh <= 1.e-8 .or. sneqv <= 1.e-6) then + snowh = 0.0 + sneqv = 0.0 + end if + +! for deep snow + + if ( isnow < 0 ) then !kwm added this if statement to prevent out-of-bounds array references + + wgdif = snice(isnow+1) - qsnsub*dt + qsnfro*dt + snice(isnow+1) = wgdif + if (wgdif < 1.e-6 .and. isnow <0) then + call combine (parameters,nsnow ,nsoil ,iloc, jloc , & !in + isnow ,sh2o ,stc ,snice ,snliq , & !inout + dzsnso ,sice ,snowh ,sneqv , & !inout + ponding1, ponding2 ) !out + endif + !kwm: subroutine combine can change isnow to make it 0 again? + if ( isnow < 0 ) then !kwm added this if statement to prevent out-of-bounds array references + snliq(isnow+1) = snliq(isnow+1) + qrain * dt + snliq(isnow+1) = max(0., snliq(isnow+1)) + endif + + endif !kwm -- can the endif be moved toward the end of the subroutine (just set qsnbot=0)? + +! porosity and partial volume + + !kwm looks to me like loop index / if test can be simplified. + + do j = -nsnow+1, 0 + if (j >= isnow+1) then + vol_ice(j) = min(1., snice(j)/(dzsnso(j)*denice)) + epore(j) = 1. - vol_ice(j) + vol_liq(j) = min(epore(j),snliq(j)/(dzsnso(j)*denh2o)) + end if + end do + + qin = 0. + qout = 0. + + !kwm looks to me like loop index / if test can be simplified. + + do j = -nsnow+1, 0 + if (j >= isnow+1) then + snliq(j) = snliq(j) + qin + if (j <= -1) then + if (epore(j) < 0.05 .or. epore(j+1) < 0.05) then + qout = 0. + else + qout = max(0.,(vol_liq(j)-parameters%ssi*epore(j))*dzsnso(j)) + qout = min(qout,(1.-vol_ice(j+1)-vol_liq(j+1))*dzsnso(j+1)) + end if + else + qout = max(0.,(vol_liq(j) - parameters%ssi*epore(j))*dzsnso(j)) + end if + qout = qout*1000. + snliq(j) = snliq(j) - qout + qin = qout + end if + end do + +! liquid water from snow bottom to soil + + qsnbot = qout / dt ! mm/s + + end subroutine snowh2o + +!== begin soilwater ================================================================================ + +!>\ingroup NoahMP_LSM + subroutine soilwater (parameters,nsoil ,nsnow ,dt ,zsoil ,dzsnso , & !in + qinsur ,qseva ,etrani ,sice ,iloc , jloc, & !in + sh2o ,smc ,zwt ,vegtyp ,& !inout + smcwtd, deeprech ,& !inout + runsrf ,qdrain ,runsub ,wcnd ,fcrmax ) !out + +! ---------------------------------------------------------------------- +! calculate surface runoff and soil moisture. +! ---------------------------------------------------------------------- +! ---------------------------------------------------------------------- + implicit none +! ---------------------------------------------------------------------- +! input + type (noahmp_parameters), intent(in) :: parameters + integer, intent(in) :: iloc !grid index + integer, intent(in) :: jloc !grid index + integer, intent(in) :: nsoil !no. of soil layers + integer, intent(in) :: nsnow !maximum no. of snow layers + real, intent(in) :: dt !time step (sec) + real, intent(in) :: qinsur !water input on soil surface [mm/s] + real, intent(in) :: qseva !evap from soil surface [mm/s] + real, dimension(1:nsoil), intent(in) :: zsoil !depth of soil layer-bottom [m] + real, dimension(1:nsoil), intent(in) :: etrani !evapotranspiration from soil layers [mm/s] + real, dimension(-nsnow+1:nsoil), intent(in) :: dzsnso !snow/soil layer depth [m] + real, dimension(1:nsoil), intent(in) :: sice !soil ice content [m3/m3] + + integer, intent(in) :: vegtyp + +! input & output + real, dimension(1:nsoil), intent(inout) :: sh2o !soil liquid water content [m3/m3] + real, dimension(1:nsoil), intent(inout) :: smc !total soil water content [m3/m3] + real, intent(inout) :: zwt !water table depth [m] + real, intent(inout) :: smcwtd !soil moisture between bottom of the soil and the water table [m3/m3] + real , intent(inout) :: deeprech + +! output + real, intent(out) :: qdrain !soil-bottom free drainage [mm/s] + real, intent(out) :: runsrf !surface runoff [mm/s] + real, intent(out) :: runsub !subsurface runoff [mm/s] + real, intent(out) :: fcrmax !maximum of fcr (-) + real, dimension(1:nsoil), intent(out) :: wcnd !hydraulic conductivity (m/s) + +! local + integer :: k,iz !do-loop index + integer :: iter !iteration index + real :: dtfine !fine time step (s) + real, dimension(1:nsoil) :: rhstt !right-hand side term of the matrix + real, dimension(1:nsoil) :: ai !left-hand side term + real, dimension(1:nsoil) :: bi !left-hand side term + real, dimension(1:nsoil) :: ci !left-hand side term + + real :: fff !runoff decay factor (m-1) + real :: rsbmx !baseflow coefficient [mm/s] + real :: pddum !infiltration rate at surface (m/s) + real :: fice !ice fraction in frozen soil + real :: wplus !saturation excess of the total soil [m] + real :: rsat !accumulation of wplus (saturation excess) [m] + real :: sicemax!maximum soil ice content (m3/m3) + real :: sh2omin!minimum soil liquid water content (m3/m3) + real :: wtsub !sum of wcnd(k)*dzsnso(k) + real :: mh2o !water mass removal (mm) + real :: fsat !fractional saturated area (-) + real, dimension(1:nsoil) :: mliq ! + real :: xs ! + real :: watmin ! + real :: qdrain_save ! + real :: epore !effective porosity [m3/m3] + real, dimension(1:nsoil) :: fcr !impermeable fraction due to frozen soil + integer :: niter !iteration times soil moisture (-) + real :: smctot !2-m averaged soil moisture (m3/m3) + real :: dztot !2-m soil depth (m) + real, parameter :: a = 4.0 +! ---------------------------------------------------------------------- + runsrf = 0.0 + pddum = 0.0 + rsat = 0.0 + +! for the case when snowmelt water is too large + + do k = 1,nsoil + epore = max ( 1.e-4 , ( parameters%smcmax - sice(k) ) ) + rsat = rsat + max(0.,sh2o(k)-epore)*dzsnso(k) + sh2o(k) = min(epore,sh2o(k)) + end do + +!impermeable fraction due to frozen soil + + do k = 1,nsoil + fice = min(1.0,sice(k)/parameters%smcmax) + fcr(k) = max(0.0,exp(-a*(1.-fice))- exp(-a)) / & + (1.0 - exp(-a)) + end do + +! maximum soil ice content and minimum liquid water of all layers + + sicemax = 0.0 + fcrmax = 0.0 + sh2omin = parameters%smcmax + do k = 1,nsoil + if (sice(k) > sicemax) sicemax = sice(k) + if (fcr(k) > fcrmax) fcrmax = fcr(k) + if (sh2o(k) < sh2omin) sh2omin = sh2o(k) + end do + +!subsurface runoff for runoff scheme option 2 + + if(opt_run == 2) then + fff = 2.0 + rsbmx = 4.0 + call zwteq (parameters,nsoil ,nsnow ,zsoil ,dzsnso ,sh2o ,zwt) + runsub = (1.0-fcrmax) * rsbmx * exp(-parameters%timean) * exp(-fff*zwt) ! mm/s + end if + +!surface runoff and infiltration rate using different schemes + +!jref impermable surface at urban + if ( parameters%urban_flag ) fcr(1)= 0.95 + + if(opt_run == 1) then + fff = 6.0 + fsat = parameters%fsatmx*exp(-0.5*fff*(zwt-2.0)) + if(qinsur > 0.) then + runsrf = qinsur * ( (1.0-fcr(1))*fsat + fcr(1) ) + pddum = qinsur - runsrf ! m/s + end if + end if + + if(opt_run == 5) then + fff = 6.0 + fsat = parameters%fsatmx*exp(-0.5*fff*max(-2.0-zwt,0.)) + if(qinsur > 0.) then + runsrf = qinsur * ( (1.0-fcr(1))*fsat + fcr(1) ) + pddum = qinsur - runsrf ! m/s + end if + end if + + if(opt_run == 2) then + fff = 2.0 + fsat = parameters%fsatmx*exp(-0.5*fff*zwt) + if(qinsur > 0.) then + runsrf = qinsur * ( (1.0-fcr(1))*fsat + fcr(1) ) + pddum = qinsur - runsrf ! m/s + end if + end if + + if(opt_run == 3) then + call infil (parameters,nsoil ,dt ,zsoil ,sh2o ,sice , & !in + sicemax,qinsur , & !in + pddum ,runsrf ) !out + end if + + if(opt_run == 4) then + smctot = 0. + dztot = 0. + do k = 1,nsoil + dztot = dztot + dzsnso(k) + smctot = smctot + smc(k)*dzsnso(k) + if(dztot >= 2.0) exit + end do + smctot = smctot/dztot + fsat = max(0.01,smctot/parameters%smcmax) ** 4. !bats + + if(qinsur > 0.) then + runsrf = qinsur * ((1.0-fcr(1))*fsat+fcr(1)) + pddum = qinsur - runsrf ! m/s + end if + end if + +! determine iteration times and finer time step + + niter = 1 + + if(opt_inf == 1) then !opt_inf =2 may cause water imbalance + niter = 3 + if (pddum*dt>dzsnso(1)*parameters%smcmax ) then + niter = niter*2 + end if + end if + + dtfine = dt / niter + +! solve soil moisture + + qdrain_save = 0.0 + do iter = 1, niter + call srt (parameters,nsoil ,zsoil ,dtfine ,pddum ,etrani , & !in + qseva ,sh2o ,smc ,zwt ,fcr , & !in + sicemax,fcrmax ,iloc ,jloc ,smcwtd , & !in + rhstt ,ai ,bi ,ci ,qdrain , & !out + wcnd ) !out + + call sstep (parameters,nsoil ,nsnow ,dtfine ,zsoil ,dzsnso , & !in + sice ,iloc ,jloc ,zwt , & !in + sh2o ,smc ,ai ,bi ,ci , & !inout + rhstt ,smcwtd ,qdrain ,deeprech, & !inout + wplus) !out + rsat = rsat + wplus + qdrain_save = qdrain_save + qdrain + end do + + qdrain = qdrain_save/niter + + runsrf = runsrf * 1000. + rsat * 1000./dt ! m/s -> mm/s + qdrain = qdrain * 1000. + +!wrf_hydro_djg... +!yw infxsrt = runsrf * dt !mm/s -> mm + +! removal of soil water due to groundwater flow (option 2) + + if(opt_run == 2) then + wtsub = 0. + do k = 1, nsoil + wtsub = wtsub + wcnd(k)*dzsnso(k) + end do + + do k = 1, nsoil + mh2o = runsub*dt*(wcnd(k)*dzsnso(k))/wtsub ! mm + sh2o(k) = sh2o(k) - mh2o/(dzsnso(k)*1000.) + end do + end if + +! limit mliq to be greater than or equal to watmin. +! get water needed to bring mliq equal watmin from lower layer. + + if(opt_run /= 1) then + do iz = 1, nsoil + mliq(iz) = sh2o(iz)*dzsnso(iz)*1000. + end do + + watmin = 0.01 ! mm + do iz = 1, nsoil-1 + if (mliq(iz) .lt. 0.) then + xs = watmin-mliq(iz) + else + xs = 0. + end if + mliq(iz ) = mliq(iz ) + xs + mliq(iz+1) = mliq(iz+1) - xs + end do + + iz = nsoil + if (mliq(iz) .lt. watmin) then + xs = watmin-mliq(iz) + else + xs = 0. + end if + mliq(iz) = mliq(iz) + xs + runsub = runsub - xs/dt + if(opt_run == 5)deeprech = deeprech - xs*1.e-3 + + do iz = 1, nsoil + sh2o(iz) = mliq(iz) / (dzsnso(iz)*1000.) + end do + end if + + end subroutine soilwater + +!== begin zwteq ==================================================================================== + +!>\ingroup NoahMP_LSM + subroutine zwteq (parameters,nsoil ,nsnow ,zsoil ,dzsnso ,sh2o ,zwt) +! ---------------------------------------------------------------------- +! calculate equilibrium water table depth (niu et al., 2005) +! ---------------------------------------------------------------------- + implicit none +! ---------------------------------------------------------------------- +! input + + type (noahmp_parameters), intent(in) :: parameters + integer, intent(in) :: nsoil !no. of soil layers + integer, intent(in) :: nsnow !maximum no. of snow layers + real, dimension(1:nsoil), intent(in) :: zsoil !depth of soil layer-bottom [m] + real, dimension(-nsnow+1:nsoil), intent(in) :: dzsnso !snow/soil layer depth [m] + real, dimension(1:nsoil), intent(in) :: sh2o !soil liquid water content [m3/m3] + +! output + + real, intent(out) :: zwt !water table depth [m] + +! locals + + integer :: k !do-loop index + integer, parameter :: nfine = 100 !no. of fine soil layers of 6m soil + real :: wd1 !water deficit from coarse (4-l) soil moisture profile + real :: wd2 !water deficit from fine (100-l) soil moisture profile + real :: dzfine !layer thickness of the 100-l soil layers to 6.0 m + real :: temp !temporary variable + real, dimension(1:nfine) :: zfine !layer-bottom depth of the 100-l soil layers to 6.0 m +! ---------------------------------------------------------------------- + + wd1 = 0. + do k = 1,nsoil + wd1 = wd1 + (parameters%smcmax-sh2o(k)) * dzsnso(k) ! [m] + enddo + + dzfine = 3.0 * (-zsoil(nsoil)) / nfine + do k =1,nfine + zfine(k) = float(k) * dzfine + enddo + + zwt = -3.*zsoil(nsoil) - 0.001 ! initial value [m] + + wd2 = 0. + do k = 1,nfine + temp = 1. + (zwt-zfine(k))/parameters%psisat + wd2 = wd2 + parameters%smcmax*(1.-temp**(-1./parameters%bexp))*dzfine + if(abs(wd2-wd1).le.0.01) then + zwt = zfine(k) + exit + endif + enddo + + end subroutine zwteq + +!== begin infil ==================================================================================== + +!>\ingroup NoahMP_LSM + subroutine infil (parameters,nsoil ,dt ,zsoil ,sh2o ,sice , & !in + sicemax,qinsur , & !in + pddum ,runsrf ) !out +! -------------------------------------------------------------------------------- +! compute inflitration rate at soil surface and surface runoff +! -------------------------------------------------------------------------------- + implicit none +! -------------------------------------------------------------------------------- +! inputs + type (noahmp_parameters), intent(in) :: parameters + integer, intent(in) :: nsoil !no. of soil layers + real, intent(in) :: dt !time step (sec) + real, dimension(1:nsoil), intent(in) :: zsoil !depth of soil layer-bottom [m] + real, dimension(1:nsoil), intent(in) :: sh2o !soil liquid water content [m3/m3] + real, dimension(1:nsoil), intent(in) :: sice !soil ice content [m3/m3] + real, intent(in) :: qinsur !water input on soil surface [mm/s] + real, intent(in) :: sicemax!maximum soil ice content (m3/m3) + +! outputs + real, intent(out) :: runsrf !surface runoff [mm/s] + real, intent(out) :: pddum !infiltration rate at surface + +! locals + integer :: ialp1, j, jj, k + real :: val + real :: ddt + real :: px + real :: dt1, dd, dice + real :: fcr + real :: sum + real :: acrt + real :: wdf + real :: wcnd + real :: smcav + real :: infmax + real, dimension(1:nsoil) :: dmax + integer, parameter :: cvfrz = 3 +! -------------------------------------------------------------------------------- + + if (qinsur > 0.0) then + dt1 = dt /86400. + smcav = parameters%smcmax - parameters%smcwlt + +! maximum infiltration rate + + dmax(1)= -zsoil(1) * smcav + dice = -zsoil(1) * sice(1) + dmax(1)= dmax(1)* (1.0-(sh2o(1) + sice(1) - parameters%smcwlt)/smcav) + + dd = dmax(1) + + do k = 2,nsoil + dice = dice + (zsoil(k-1) - zsoil(k) ) * sice(k) + dmax(k) = (zsoil(k-1) - zsoil(k)) * smcav + dmax(k) = dmax(k) * (1.0-(sh2o(k) + sice(k) - parameters%smcwlt)/smcav) + dd = dd + dmax(k) + end do + + val = (1. - exp ( - parameters%kdt * dt1)) + ddt = dd * val + px = max(0.,qinsur * dt) + infmax = (px * (ddt / (px + ddt)))/ dt + +! impermeable fraction due to frozen soil + + fcr = 1. + if (dice > 1.e-2) then + acrt = cvfrz * parameters%frzx / dice + sum = 1. + ialp1 = cvfrz - 1 + do j = 1,ialp1 + k = 1 + do jj = j +1,ialp1 + k = k * jj + end do + sum = sum + (acrt ** (cvfrz - j)) / float(k) + end do + fcr = 1. - exp (-acrt) * sum + end if + +! correction of infiltration limitation + + infmax = infmax * fcr + +! jref for urban areas +! if ( parameters%urban_flag ) infmax == infmax * 0.05 + + call wdfcnd2 (parameters,wdf,wcnd,sh2o(1),sicemax) + infmax = max (infmax,wcnd) + infmax = min (infmax,px) + + runsrf= max(0., qinsur - infmax) + pddum = qinsur - runsrf + + end if + + end subroutine infil + +!== begin srt ====================================================================================== + +!>\ingroup NoahMP_LSM + subroutine srt (parameters,nsoil ,zsoil ,dt ,pddum ,etrani , & !in + qseva ,sh2o ,smc ,zwt ,fcr , & !in + sicemax,fcrmax ,iloc ,jloc ,smcwtd , & !in + rhstt ,ai ,bi ,ci ,qdrain , & !out + wcnd ) !out +! ---------------------------------------------------------------------- +! calculate the right hand side of the time tendency term of the soil +! water diffusion equation. also to compute ( prepare ) the matrix +! coefficients for the tri-diagonal matrix of the implicit time scheme. +! ---------------------------------------------------------------------- + implicit none +! ---------------------------------------------------------------------- +!input + + type (noahmp_parameters), intent(in) :: parameters + integer, intent(in) :: iloc !grid index + integer, intent(in) :: jloc !grid index + integer, intent(in) :: nsoil + real, dimension(1:nsoil), intent(in) :: zsoil + real, intent(in) :: dt + real, intent(in) :: pddum + real, intent(in) :: qseva + real, dimension(1:nsoil), intent(in) :: etrani + real, dimension(1:nsoil), intent(in) :: sh2o + real, dimension(1:nsoil), intent(in) :: smc + real, intent(in) :: zwt ! water table depth [m] + real, dimension(1:nsoil), intent(in) :: fcr + real, intent(in) :: fcrmax !maximum of fcr (-) + real, intent(in) :: sicemax!maximum soil ice content (m3/m3) + real, intent(in) :: smcwtd !soil moisture between bottom of the soil and the water table + +! output + + real, dimension(1:nsoil), intent(out) :: rhstt + real, dimension(1:nsoil), intent(out) :: ai + real, dimension(1:nsoil), intent(out) :: bi + real, dimension(1:nsoil), intent(out) :: ci + real, dimension(1:nsoil), intent(out) :: wcnd !hydraulic conductivity (m/s) + real, intent(out) :: qdrain !bottom drainage (m/s) + +! local + integer :: k + real, dimension(1:nsoil) :: ddz + real, dimension(1:nsoil) :: denom + real, dimension(1:nsoil) :: dsmdz + real, dimension(1:nsoil) :: wflux + real, dimension(1:nsoil) :: wdf + real, dimension(1:nsoil) :: smx + real :: temp1 + real :: smxwtd !soil moisture between bottom of the soil and water table + real :: smxbot !soil moisture below bottom to calculate flux + +! niu and yang (2006), j. of hydrometeorology +! ---------------------------------------------------------------------- + + if(opt_inf == 1) then + do k = 1, nsoil + call wdfcnd1 (parameters,wdf(k),wcnd(k),smc(k),fcr(k)) + smx(k) = smc(k) + end do + if(opt_run == 5)smxwtd=smcwtd + end if + + if(opt_inf == 2) then + do k = 1, nsoil + call wdfcnd2 (parameters,wdf(k),wcnd(k),sh2o(k),sicemax) + smx(k) = sh2o(k) + end do + if(opt_run == 5)smxwtd=smcwtd*sh2o(nsoil)/smc(nsoil) !same liquid fraction as in the bottom layer + end if + + do k = 1, nsoil + if(k == 1) then + denom(k) = - zsoil (k) + temp1 = - zsoil (k+1) + ddz(k) = 2.0 / temp1 + dsmdz(k) = 2.0 * (smx(k) - smx(k+1)) / temp1 + wflux(k) = wdf(k) * dsmdz(k) + wcnd(k) - pddum + etrani(k) + qseva + else if (k < nsoil) then + denom(k) = (zsoil(k-1) - zsoil(k)) + temp1 = (zsoil(k-1) - zsoil(k+1)) + ddz(k) = 2.0 / temp1 + dsmdz(k) = 2.0 * (smx(k) - smx(k+1)) / temp1 + wflux(k) = wdf(k ) * dsmdz(k ) + wcnd(k ) & + - wdf(k-1) * dsmdz(k-1) - wcnd(k-1) + etrani(k) + else + denom(k) = (zsoil(k-1) - zsoil(k)) + if(opt_run == 1 .or. opt_run == 2) then + qdrain = 0. + end if + if(opt_run == 3) then + qdrain = parameters%slope*wcnd(k) + end if + if(opt_run == 4) then + qdrain = (1.0-fcrmax)*wcnd(k) + end if + if(opt_run == 5) then !gmm new m-m&f water table dynamics formulation + temp1 = 2.0 * denom(k) + if(zwt < zsoil(nsoil)-denom(nsoil))then +!gmm interpolate from below, midway to the water table, to the middle of the auxiliary layer below the soil bottom + smxbot = smx(k) - (smx(k)-smxwtd) * denom(k) * 2./ (denom(k) + zsoil(k) - zwt) + else + smxbot = smxwtd + endif + dsmdz(k) = 2.0 * (smx(k) - smxbot) / temp1 + qdrain = wdf(k ) * dsmdz(k ) + wcnd(k ) + end if + wflux(k) = -(wdf(k-1)*dsmdz(k-1))-wcnd(k-1)+etrani(k) + qdrain + end if + end do + + do k = 1, nsoil + if(k == 1) then + ai(k) = 0.0 + bi(k) = wdf(k ) * ddz(k ) / denom(k) + ci(k) = - bi (k) + else if (k < nsoil) then + ai(k) = - wdf(k-1) * ddz(k-1) / denom(k) + ci(k) = - wdf(k ) * ddz(k ) / denom(k) + bi(k) = - ( ai (k) + ci (k) ) + else + ai(k) = - wdf(k-1) * ddz(k-1) / denom(k) + ci(k) = 0.0 + bi(k) = - ( ai (k) + ci (k) ) + end if + rhstt(k) = wflux(k) / (-denom(k)) + end do + +! ---------------------------------------------------------------------- + end subroutine srt + +!== begin sstep ==================================================================================== + +!>\ingroup NoahMP_LSM + subroutine sstep (parameters,nsoil ,nsnow ,dt ,zsoil ,dzsnso , & !in + sice ,iloc ,jloc ,zwt , & !in + sh2o ,smc ,ai ,bi ,ci , & !inout + rhstt ,smcwtd ,qdrain ,deeprech, & !inout + wplus ) !out + +! ---------------------------------------------------------------------- +! calculate/update soil moisture content values +! ---------------------------------------------------------------------- + implicit none +! ---------------------------------------------------------------------- +!input + + type (noahmp_parameters), intent(in) :: parameters + integer, intent(in) :: iloc !grid index + integer, intent(in) :: jloc !grid index + integer, intent(in) :: nsoil ! + integer, intent(in) :: nsnow ! + real, intent(in) :: dt + real, intent(in) :: zwt + real, dimension( 1:nsoil), intent(in) :: zsoil + real, dimension( 1:nsoil), intent(in) :: sice + real, dimension(-nsnow+1:nsoil), intent(in) :: dzsnso ! snow/soil layer thickness [m] + +!input and output + real, dimension(1:nsoil), intent(inout) :: sh2o + real, dimension(1:nsoil), intent(inout) :: smc + real, dimension(1:nsoil), intent(inout) :: ai + real, dimension(1:nsoil), intent(inout) :: bi + real, dimension(1:nsoil), intent(inout) :: ci + real, dimension(1:nsoil), intent(inout) :: rhstt + real , intent(inout) :: smcwtd + real , intent(inout) :: qdrain + real , intent(inout) :: deeprech + +!output + real, intent(out) :: wplus !saturation excess water (m) + +!local + integer :: k + real, dimension(1:nsoil) :: rhsttin + real, dimension(1:nsoil) :: ciin + real :: stot + real :: epore + real :: wminus +! ---------------------------------------------------------------------- + wplus = 0.0 + + do k = 1,nsoil + rhstt (k) = rhstt(k) * dt + ai (k) = ai(k) * dt + bi (k) = 1. + bi(k) * dt + ci (k) = ci(k) * dt + end do + +! copy values for input variables before calling rosr12 + + do k = 1,nsoil + rhsttin(k) = rhstt(k) + ciin(k) = ci(k) + end do + +! call rosr12 to solve the tri-diagonal matrix + + call rosr12 (ci,ai,bi,ciin,rhsttin,rhstt,1,nsoil,0) + + do k = 1,nsoil + sh2o(k) = sh2o(k) + ci(k) + enddo + +! excessive water above saturation in a layer is moved to +! its unsaturated layer like in a bucket + +!gmmwith opt_run=5 there is soil moisture below nsoil, to the water table + if(opt_run == 5) then + +!update smcwtd + + if(zwt < zsoil(nsoil)-dzsnso(nsoil))then +!accumulate qdrain to update deep water table and soil moisture later + deeprech = deeprech + dt * qdrain + else + smcwtd = smcwtd + dt * qdrain / dzsnso(nsoil) + wplus = max((smcwtd-parameters%smcmax), 0.0) * dzsnso(nsoil) + wminus = max((1.e-4-smcwtd), 0.0) * dzsnso(nsoil) + + smcwtd = max( min(smcwtd,parameters%smcmax) , 1.e-4) + sh2o(nsoil) = sh2o(nsoil) + wplus/dzsnso(nsoil) + +!reduce fluxes at the bottom boundaries accordingly + qdrain = qdrain - wplus/dt + deeprech = deeprech - wminus + endif + + endif + + do k = nsoil,2,-1 + epore = max ( 1.e-4 , ( parameters%smcmax - sice(k) ) ) + wplus = max((sh2o(k)-epore), 0.0) * dzsnso(k) + sh2o(k) = min(epore,sh2o(k)) + sh2o(k-1) = sh2o(k-1) + wplus/dzsnso(k-1) + end do + + epore = max ( 1.e-4 , ( parameters%smcmax - sice(1) ) ) + wplus = max((sh2o(1)-epore), 0.0) * dzsnso(1) + sh2o(1) = min(epore,sh2o(1)) + + end subroutine sstep + +!== begin wdfcnd1 ================================================================================== + +!>\ingroup NoahMP_LSM + subroutine wdfcnd1 (parameters,wdf,wcnd,smc,fcr) +! ---------------------------------------------------------------------- +! calculate soil water diffusivity and soil hydraulic conductivity. +! ---------------------------------------------------------------------- + implicit none +! ---------------------------------------------------------------------- +! input + type (noahmp_parameters), intent(in) :: parameters + real,intent(in) :: smc + real,intent(in) :: fcr + +! output + real,intent(out) :: wcnd + real,intent(out) :: wdf + +! local + real :: expon + real :: factr + real :: vkwgt +! ---------------------------------------------------------------------- + +! soil water diffusivity + + factr = max(0.01, smc/parameters%smcmax) + expon = parameters%bexp + 2.0 + wdf = parameters%dwsat * factr ** expon + wdf = wdf * (1.0 - fcr) + +! hydraulic conductivity + + expon = 2.0*parameters%bexp + 3.0 + wcnd = parameters%dksat * factr ** expon + wcnd = wcnd * (1.0 - fcr) + + end subroutine wdfcnd1 + +!== begin wdfcnd2 ================================================================================== + +!>\ingroup NoahMP_LSM + subroutine wdfcnd2 (parameters,wdf,wcnd,smc,sice) +! ---------------------------------------------------------------------- +! calculate soil water diffusivity and soil hydraulic conductivity. +! ---------------------------------------------------------------------- + implicit none +! ---------------------------------------------------------------------- +! input + type (noahmp_parameters), intent(in) :: parameters + real,intent(in) :: smc + real,intent(in) :: sice + +! output + real,intent(out) :: wcnd + real,intent(out) :: wdf + +! local + real :: expon + real :: factr + real :: vkwgt +! ---------------------------------------------------------------------- + +! soil water diffusivity + + factr = max(0.01, smc/parameters%smcmax) + expon = parameters%bexp + 2.0 + wdf = parameters%dwsat * factr ** expon + + if (sice > 0.0) then + vkwgt = 1./ (1. + (500.* sice)**3.) + wdf = vkwgt * wdf + (1.-vkwgt)*parameters%dwsat*(0.2/parameters%smcmax)**expon + end if + +! hydraulic conductivity + + expon = 2.0*parameters%bexp + 3.0 + wcnd = parameters%dksat * factr ** expon + + end subroutine wdfcnd2 + +!== begin groundwater ============================================================================== + +!>\ingroup NoahMP_LSM + subroutine groundwater(parameters,nsnow ,nsoil ,dt ,sice ,zsoil , & !in + stc ,wcnd ,fcrmax ,iloc ,jloc , & !in + sh2o ,zwt ,wa ,wt , & !inout + qin ,qdis ) !out +! ---------------------------------------------------------------------- + implicit none +! ---------------------------------------------------------------------- +! input + type (noahmp_parameters), intent(in) :: parameters + integer, intent(in) :: iloc !grid index + integer, intent(in) :: jloc !grid index + integer, intent(in) :: nsnow !maximum no. of snow layers + integer, intent(in) :: nsoil !no. of soil layers + real, intent(in) :: dt !timestep [sec] + real, intent(in) :: fcrmax!maximum fcr (-) + real, dimension( 1:nsoil), intent(in) :: sice !soil ice content [m3/m3] + real, dimension( 1:nsoil), intent(in) :: zsoil !depth of soil layer-bottom [m] + real, dimension( 1:nsoil), intent(in) :: wcnd !hydraulic conductivity (m/s) + real, dimension(-nsnow+1:nsoil), intent(in) :: stc !snow/soil temperature (k) + +! input and output + real, dimension( 1:nsoil), intent(inout) :: sh2o !liquid soil water [m3/m3] + real, intent(inout) :: zwt !the depth to water table [m] + real, intent(inout) :: wa !water storage in aquifer [mm] + real, intent(inout) :: wt !water storage in aquifer + !+ saturated soil [mm] +! output + real, intent(out) :: qin !groundwater recharge [mm/s] + real, intent(out) :: qdis !groundwater discharge [mm/s] + +! local + real :: fff !runoff decay factor (m-1) + real :: rsbmx !baseflow coefficient [mm/s] + integer :: iz !do-loop index + integer :: iwt !layer index above water table layer + real, dimension( 1:nsoil) :: dzmm !layer thickness [mm] + real, dimension( 1:nsoil) :: znode !node depth [m] + real, dimension( 1:nsoil) :: mliq !liquid water mass [kg/m2 or mm] + real, dimension( 1:nsoil) :: epore !effective porosity [-] + real, dimension( 1:nsoil) :: hk !hydraulic conductivity [mm/s] + real, dimension( 1:nsoil) :: smc !total soil water content [m3/m3] + real(kind=8) :: s_node!degree of saturation of iwt layer + real :: dzsum !cumulative depth above water table [m] + real :: smpfz !matric potential (frozen effects) [mm] + real :: ka !aquifer hydraulic conductivity [mm/s] + real :: wh_zwt!water head at water table [mm] + real :: wh !water head at layer above zwt [mm] + real :: ws !water used to fill air pore [mm] + real :: wtsub !sum of hk*dzmm + real :: watmin!minimum soil vol soil moisture [m3/m3] + real :: xs !excessive water above saturation [mm] + real, parameter :: rous = 0.2 !specific yield [-] + real, parameter :: cmic = 0.20 !microprore content (0.0-1.0) + !0.0-close to free drainage +! ------------------------------------------------------------- + qdis = 0.0 + qin = 0.0 + +! derive layer-bottom depth in [mm] +!kwm: derive layer thickness in mm + + dzmm(1) = -zsoil(1)*1.e3 + do iz = 2, nsoil + dzmm(iz) = 1.e3 * (zsoil(iz - 1) - zsoil(iz)) + enddo + +! derive node (middle) depth in [m] +!kwm: positive number, depth below ground surface in m + znode(1) = -zsoil(1) / 2. + do iz = 2, nsoil + znode(iz) = -zsoil(iz-1) + 0.5 * (zsoil(iz-1) - zsoil(iz)) + enddo + +! convert volumetric soil moisture "sh2o" to mass + + do iz = 1, nsoil + smc(iz) = sh2o(iz) + sice(iz) + mliq(iz) = sh2o(iz) * dzmm(iz) + epore(iz) = max(0.01,parameters%smcmax - sice(iz)) + hk(iz) = 1.e3*wcnd(iz) + enddo + +! the layer index of the first unsaturated layer, +! i.e., the layer right above the water table + + iwt = nsoil + do iz = 2,nsoil + if(zwt .le. -zsoil(iz) ) then + iwt = iz-1 + exit + end if + enddo + +! groundwater discharge [mm/s] + + fff = 6.0 + rsbmx = 5.0 + + qdis = (1.0-fcrmax)*rsbmx*exp(-parameters%timean)*exp(-fff*(zwt-2.0)) + +! matric potential at the layer above the water table + + s_node = min(1.0,smc(iwt)/parameters%smcmax ) + s_node = max(s_node,real(0.01,kind=8)) + smpfz = -parameters%psisat*1000.*s_node**(-parameters%bexp) ! m --> mm + smpfz = max(-120000.0,cmic*smpfz) + +! recharge rate qin to groundwater + + ka = hk(iwt) + + wh_zwt = - zwt * 1.e3 !(mm) + wh = smpfz - znode(iwt)*1.e3 !(mm) + qin = - ka * (wh_zwt-wh) /((zwt-znode(iwt))*1.e3) + qin = max(-10.0/dt,min(10./dt,qin)) + +! water storage in the aquifer + saturated soil + + wt = wt + (qin - qdis) * dt !(mm) + + if(iwt.eq.nsoil) then + wa = wa + (qin - qdis) * dt !(mm) + wt = wa + zwt = (-zsoil(nsoil) + 25.) - wa/1000./rous !(m) + mliq(nsoil) = mliq(nsoil) - qin * dt ! [mm] + + mliq(nsoil) = mliq(nsoil) + max(0.,(wa - 5000.)) + wa = min(wa, 5000.) + else + + if (iwt.eq.nsoil-1) then + zwt = -zsoil(nsoil) & + - (wt-rous*1000*25.) / (epore(nsoil))/1000. + else + ws = 0. ! water used to fill soil air pores + do iz = iwt+2,nsoil + ws = ws + epore(iz) * dzmm(iz) + enddo + zwt = -zsoil(iwt+1) & + - (wt-rous*1000.*25.-ws) /(epore(iwt+1))/1000. + endif + + wtsub = 0. + do iz = 1, nsoil + wtsub = wtsub + hk(iz)*dzmm(iz) + end do + + do iz = 1, nsoil ! removing subsurface runoff + mliq(iz) = mliq(iz) - qdis*dt*hk(iz)*dzmm(iz)/wtsub + end do + end if + + zwt = max(1.5,zwt) + +! +! limit mliq to be greater than or equal to watmin. +! get water needed to bring mliq equal watmin from lower layer. +! + watmin = 0.01 + do iz = 1, nsoil-1 + if (mliq(iz) .lt. 0.) then + xs = watmin-mliq(iz) + else + xs = 0. + end if + mliq(iz ) = mliq(iz ) + xs + mliq(iz+1) = mliq(iz+1) - xs + end do + + iz = nsoil + if (mliq(iz) .lt. watmin) then + xs = watmin-mliq(iz) + else + xs = 0. + end if + mliq(iz) = mliq(iz) + xs + wa = wa - xs + wt = wt - xs + + do iz = 1, nsoil + sh2o(iz) = mliq(iz) / dzmm(iz) + end do + + end subroutine groundwater + +!== begin shallowwatertable ======================================================================== + +!>\ingroup NoahMP_LSM + subroutine shallowwatertable (parameters,nsnow ,nsoil ,zsoil, dt , & !in + dzsnso ,smceq ,iloc ,jloc , & !in + smc ,wtd ,smcwtd ,rech, qdrain ) !inout +! ---------------------------------------------------------------------- +!diagnoses water table depth and computes recharge when the water table is within the resolved soil layers, +!according to the miguez-macho&fan scheme +! ---------------------------------------------------------------------- + implicit none +! ---------------------------------------------------------------------- +! input + type (noahmp_parameters), intent(in) :: parameters + integer, intent(in) :: nsnow !maximum no. of snow layers + integer, intent(in) :: nsoil !no. of soil layers + integer, intent(in) :: iloc,jloc + real, intent(in) :: dt + real, dimension( 1:nsoil), intent(in) :: zsoil !depth of soil layer-bottom [m] + real, dimension(-nsnow+1:nsoil), intent(in) :: dzsnso ! snow/soil layer thickness [m] + real, dimension( 1:nsoil), intent(in) :: smceq !equilibrium soil water content [m3/m3] + +! input and output + real, dimension( 1:nsoil), intent(inout) :: smc !total soil water content [m3/m3] + real, intent(inout) :: wtd !the depth to water table [m] + real, intent(inout) :: smcwtd !soil moisture between bottom of the soil and the water table [m3/m3] + real, intent(out) :: rech ! groundwater recharge (net vertical flux across the water table), positive up + real, intent(inout) :: qdrain + +! local + integer :: iz !do-loop index + integer :: iwtd !layer index above water table layer + integer :: kwtd !layer index where the water table layer is + real :: wtdold + real :: dzup + real :: smceqdeep + real, dimension( 0:nsoil) :: zsoil0 +! ------------------------------------------------------------- + + +zsoil0(1:nsoil) = zsoil(1:nsoil) +zsoil0(0) = 0. + +!find the layer where the water table is + do iz=nsoil,1,-1 + if(wtd + 1.e-6 < zsoil0(iz)) exit + enddo + iwtd=iz + + + kwtd=iwtd+1 !layer where the water table is + if(kwtd.le.nsoil)then !wtd in the resolved layers + wtdold=wtd + if(smc(kwtd).gt.smceq(kwtd))then + + if(smc(kwtd).eq.parameters%smcmax)then !wtd went to the layer above + wtd=zsoil0(iwtd) + rech=-(wtdold-wtd) * (parameters%smcmax-smceq(kwtd)) + iwtd=iwtd-1 + kwtd=kwtd-1 + if(kwtd.ge.1)then + if(smc(kwtd).gt.smceq(kwtd))then + wtdold=wtd + wtd = min( ( smc(kwtd)*dzsnso(kwtd) & + - smceq(kwtd)*zsoil0(iwtd) + parameters%smcmax*zsoil0(kwtd) ) / & + ( parameters%smcmax-smceq(kwtd) ), zsoil0(iwtd)) + rech=rech-(wtdold-wtd) * (parameters%smcmax-smceq(kwtd)) + endif + endif + else !wtd stays in the layer + wtd = min( ( smc(kwtd)*dzsnso(kwtd) & + - smceq(kwtd)*zsoil0(iwtd) + parameters%smcmax*zsoil0(kwtd) ) / & + ( parameters%smcmax-smceq(kwtd) ), zsoil0(iwtd)) + rech=-(wtdold-wtd) * (parameters%smcmax-smceq(kwtd)) + endif + + else !wtd has gone down to the layer below + wtd=zsoil0(kwtd) + rech=-(wtdold-wtd) * (parameters%smcmax-smceq(kwtd)) + kwtd=kwtd+1 + iwtd=iwtd+1 +!wtd crossed to the layer below. now adjust it there + if(kwtd.le.nsoil)then + wtdold=wtd + if(smc(kwtd).gt.smceq(kwtd))then + wtd = min( ( smc(kwtd)*dzsnso(kwtd) & + - smceq(kwtd)*zsoil0(iwtd) + parameters%smcmax*zsoil0(kwtd) ) / & + ( parameters%smcmax-smceq(kwtd) ) , zsoil0(iwtd) ) + else + wtd=zsoil0(kwtd) + endif + rech = rech - (wtdold-wtd) * & + (parameters%smcmax-smceq(kwtd)) + + else + wtdold=wtd +!restore smoi to equilibrium value with water from the ficticious layer below +! smcwtd=smcwtd-(smceq(nsoil)-smc(nsoil)) +! qdrain = qdrain - 1000 * (smceq(nsoil)-smc(nsoil)) * dzsnso(nsoil) / dt +! smc(nsoil)=smceq(nsoil) +!adjust wtd in the ficticious layer below + smceqdeep = parameters%smcmax * ( -parameters%psisat / ( -parameters%psisat - dzsnso(nsoil) ) ) ** (1./parameters%bexp) + wtd = min( ( smcwtd*dzsnso(nsoil) & + - smceqdeep*zsoil0(nsoil) + parameters%smcmax*(zsoil0(nsoil)-dzsnso(nsoil)) ) / & + ( parameters%smcmax-smceqdeep ) , zsoil0(nsoil) ) + rech = rech - (wtdold-wtd) * & + (parameters%smcmax-smceqdeep) + endif + + endif + elseif(wtd.ge.zsoil0(nsoil)-dzsnso(nsoil))then +!if wtd was already below the bottom of the resolved soil crust + wtdold=wtd + smceqdeep = parameters%smcmax * ( -parameters%psisat / ( -parameters%psisat - dzsnso(nsoil) ) ) ** (1./parameters%bexp) + if(smcwtd.gt.smceqdeep)then + wtd = min( ( smcwtd*dzsnso(nsoil) & + - smceqdeep*zsoil0(nsoil) + parameters%smcmax*(zsoil0(nsoil)-dzsnso(nsoil)) ) / & + ( parameters%smcmax-smceqdeep ) , zsoil0(nsoil) ) + rech = -(wtdold-wtd) * (parameters%smcmax-smceqdeep) + else + rech = -(wtdold-(zsoil0(nsoil)-dzsnso(nsoil))) * (parameters%smcmax-smceqdeep) + wtdold=zsoil0(nsoil)-dzsnso(nsoil) +!and now even further down + dzup=(smceqdeep-smcwtd)*dzsnso(nsoil)/(parameters%smcmax-smceqdeep) + wtd=wtdold-dzup + rech = rech - (parameters%smcmax-smceqdeep)*dzup + smcwtd=smceqdeep + endif + + + endif + +if(iwtd.lt.nsoil)smcwtd=parameters%smcmax + +end subroutine shallowwatertable + +! ================================================================================================== +! ********************* end of water subroutines ****************************************** +! ================================================================================================== + +!== begin carbon =================================================================================== + +!>\ingroup NoahMP_LSM + subroutine carbon (parameters,nsnow ,nsoil ,vegtyp ,dt ,zsoil , & !in + dzsnso ,stc ,smc ,tv ,tg ,psn , & !in + foln ,btran ,apar ,fveg ,igs , & !in + troot ,ist ,lat ,iloc ,jloc , & !in + lfmass ,rtmass ,stmass ,wood ,stblcp ,fastcp , & !inout + gpp ,npp ,nee ,autors ,heters ,totsc , & !out + totlb ,xlai ,xsai ) !out +! ------------------------------------------------------------------------------------------ + implicit none +! ------------------------------------------------------------------------------------------ +! inputs (carbon) + + type (noahmp_parameters), intent(in) :: parameters + integer , intent(in) :: iloc !grid index + integer , intent(in) :: jloc !grid index + integer , intent(in) :: vegtyp !vegetation type + integer , intent(in) :: nsnow !number of snow layers + integer , intent(in) :: nsoil !number of soil layers + real , intent(in) :: lat !latitude (radians) + real , intent(in) :: dt !time step (s) + real, dimension( 1:nsoil), intent(in) :: zsoil !depth of layer-bottom from soil surface + real, dimension(-nsnow+1:nsoil), intent(in) :: dzsnso !snow/soil layer thickness [m] + real, dimension(-nsnow+1:nsoil), intent(in) :: stc !snow/soil temperature [k] + real, dimension( 1:nsoil), intent(in) :: smc !soil moisture (ice + liq.) [m3/m3] + real , intent(in) :: tv !vegetation temperature (k) + real , intent(in) :: tg !ground temperature (k) + real , intent(in) :: foln !foliage nitrogen (%) + real , intent(in) :: btran !soil water transpiration factor (0 to 1) + real , intent(in) :: psn !total leaf photosyn (umolco2/m2/s) [+] + real , intent(in) :: apar !par by canopy (w/m2) + real , intent(in) :: igs !growing season index (0=off, 1=on) + real , intent(in) :: fveg !vegetation greenness fraction + real , intent(in) :: troot !root-zone averaged temperature (k) + integer , intent(in) :: ist !surface type 1->soil; 2->lake + +! input & output (carbon) + + real , intent(inout) :: lfmass !leaf mass [g/m2] + real , intent(inout) :: rtmass !mass of fine roots [g/m2] + real , intent(inout) :: stmass !stem mass [g/m2] + real , intent(inout) :: wood !mass of wood (incl. woody roots) [g/m2] + real , intent(inout) :: stblcp !stable carbon in deep soil [g/m2] + real , intent(inout) :: fastcp !short-lived carbon in shallow soil [g/m2] + +! outputs: (carbon) + + real , intent(out) :: gpp !net instantaneous assimilation [g/m2/s c] + real , intent(out) :: npp !net primary productivity [g/m2/s c] + real , intent(out) :: nee !net ecosystem exchange [g/m2/s co2] + real , intent(out) :: autors !net ecosystem respiration [g/m2/s c] + real , intent(out) :: heters !organic respiration [g/m2/s c] + real , intent(out) :: totsc !total soil carbon [g/m2 c] + real , intent(out) :: totlb !total living carbon ([g/m2 c] + real , intent(out) :: xlai !leaf area index [-] + real , intent(out) :: xsai !stem area index [-] +! real , intent(out) :: vocflx(5) ! voc fluxes [ug c m-2 h-1] + +! local variables + + integer :: j !do-loop index + real :: wroot !root zone soil water [-] + real :: wstres !water stress coeficient [-] (1. for wilting ) + real :: lapm !leaf area per unit mass [m2/g] +! ------------------------------------------------------------------------------------------ + + if ( ( vegtyp == parameters%iswater ) .or. ( vegtyp == parameters%isbarren ) .or. & + ( vegtyp == parameters%isice ) .or. (parameters%urban_flag) ) then + xlai = 0. + xsai = 0. + gpp = 0. + npp = 0. + nee = 0. + autors = 0. + heters = 0. + totsc = 0. + totlb = 0. + lfmass = 0. + rtmass = 0. + stmass = 0. + wood = 0. + stblcp = 0. + fastcp = 0. + + return + end if + + lapm = parameters%sla / 1000. ! m2/kg -> m2/g + +! water stress + + wstres = 1.- btran + + wroot = 0. + do j=1,parameters%nroot + wroot = wroot + smc(j)/parameters%smcmax * dzsnso(j) / (-zsoil(parameters%nroot)) + enddo + + call co2flux (parameters,nsnow ,nsoil ,vegtyp ,igs ,dt , & !in + dzsnso ,stc ,psn ,troot ,tv , & !in + wroot ,wstres ,foln ,lapm , & !in + lat ,iloc ,jloc ,fveg , & !in + xlai ,xsai ,lfmass ,rtmass ,stmass , & !inout + fastcp ,stblcp ,wood , & !inout + gpp ,npp ,nee ,autors ,heters , & !out + totsc ,totlb ) !out + +! call bvoc (parameters,vocflx, vegtyp, vegfac, apar, tv) +! call ch4 + + end subroutine carbon + +!== begin co2flux ================================================================================== + +!>\ingroup NoahMP_LSM + subroutine co2flux (parameters,nsnow ,nsoil ,vegtyp ,igs ,dt , & !in + dzsnso ,stc ,psn ,troot ,tv , & !in + wroot ,wstres ,foln ,lapm , & !in + lat ,iloc ,jloc ,fveg , & !in + xlai ,xsai ,lfmass ,rtmass ,stmass , & !inout + fastcp ,stblcp ,wood , & !inout + gpp ,npp ,nee ,autors ,heters , & !out + totsc ,totlb ) !out +! ----------------------------------------------------------------------------------------- +! the original code is from re dickinson et al.(1998), modifed by guo-yue niu, 2004 +! ----------------------------------------------------------------------------------------- + implicit none +! ----------------------------------------------------------------------------------------- + +! input + + type (noahmp_parameters), intent(in) :: parameters + integer , intent(in) :: iloc !grid index + integer , intent(in) :: jloc !grid index + integer , intent(in) :: vegtyp !vegetation physiology type + integer , intent(in) :: nsnow !number of snow layers + integer , intent(in) :: nsoil !number of soil layers + real , intent(in) :: dt !time step (s) + real , intent(in) :: lat !latitude (radians) + real , intent(in) :: igs !growing season index (0=off, 1=on) + real, dimension(-nsnow+1:nsoil), intent(in) :: dzsnso !snow/soil layer thickness [m] + real, dimension(-nsnow+1:nsoil), intent(in) :: stc !snow/soil temperature [k] + real , intent(in) :: psn !total leaf photosynthesis (umolco2/m2/s) + real , intent(in) :: troot !root-zone averaged temperature (k) + real , intent(in) :: tv !leaf temperature (k) + real , intent(in) :: wroot !root zone soil water + real , intent(in) :: wstres !soil water stress + real , intent(in) :: foln !foliage nitrogen (%) + real , intent(in) :: lapm !leaf area per unit mass [m2/g] + real , intent(in) :: fveg !vegetation greenness fraction + +! input and output + + real , intent(inout) :: xlai !leaf area index from leaf carbon [-] + real , intent(inout) :: xsai !stem area index from leaf carbon [-] + real , intent(inout) :: lfmass !leaf mass [g/m2] + real , intent(inout) :: rtmass !mass of fine roots [g/m2] + real , intent(inout) :: stmass !stem mass [g/m2] + real , intent(inout) :: fastcp !short lived carbon [g/m2] + real , intent(inout) :: stblcp !stable carbon pool [g/m2] + real , intent(inout) :: wood !mass of wood (incl. woody roots) [g/m2] + +! output + + real , intent(out) :: gpp !net instantaneous assimilation [g/m2/s] + real , intent(out) :: npp !net primary productivity [g/m2] + real , intent(out) :: nee !net ecosystem exchange (autors+heters-gpp) + real , intent(out) :: autors !net ecosystem resp. (maintance and growth) + real , intent(out) :: heters !organic respiration + real , intent(out) :: totsc !total soil carbon (g/m2) + real , intent(out) :: totlb !total living carbon (g/m2) + +! local + + real :: cflux !carbon flux to atmosphere [g/m2/s] + real :: lfmsmn !minimum leaf mass [g/m2] + real :: rswood !wood respiration [g/m2] + real :: rsleaf !leaf maintenance respiration per timestep [g/m2] + real :: rsroot !fine root respiration per time step [g/m2] + real :: nppl !leaf net primary productivity [g/m2/s] + real :: nppr !root net primary productivity [g/m2/s] + real :: nppw !wood net primary productivity [g/m2/s] + real :: npps !wood net primary productivity [g/m2/s] + real :: dielf !death of leaf mass per time step [g/m2] + + real :: addnpplf !leaf assimil after resp. losses removed [g/m2] + real :: addnppst !stem assimil after resp. losses removed [g/m2] + real :: carbfx !carbon assimilated per model step [g/m2] + real :: grleaf !growth respiration rate for leaf [g/m2/s] + real :: grroot !growth respiration rate for root [g/m2/s] + real :: grwood !growth respiration rate for wood [g/m2/s] + real :: grstem !growth respiration rate for stem [g/m2/s] + real :: leafpt !fraction of carbon allocated to leaves [-] + real :: lfdel !maximum leaf mass available to change [g/m2/s] + real :: lftovr !stem turnover per time step [g/m2] + real :: sttovr !stem turnover per time step [g/m2] + real :: wdtovr !wood turnover per time step [g/m2] + real :: rssoil !soil respiration per time step [g/m2] + real :: rttovr !root carbon loss per time step by turnover [g/m2] + real :: stablc !decay rate of fast carbon to slow carbon [g/m2/s] + real :: woodf !calculated wood to root ratio [-] + real :: nonlef !fraction of carbon to root and wood [-] + real :: rootpt !fraction of carbon flux to roots [-] + real :: woodpt !fraction of carbon flux to wood [-] + real :: stempt !fraction of carbon flux to stem [-] + real :: resp !leaf respiration [umol/m2/s] + real :: rsstem !stem respiration [g/m2/s] + + real :: fsw !soil water factor for microbial respiration + real :: fst !soil temperature factor for microbial respiration + real :: fnf !foliage nitrogen adjustemt to respiration (<= 1) + real :: tf !temperature factor + real :: rf !respiration reduction factor (<= 1) + real :: stdel + real :: stmsmn + real :: sapm !stem area per unit mass (m2/g) + real :: diest +! -------------------------- constants ------------------------------- + real :: bf !parameter for present wood allocation [-] + real :: rswoodc !wood respiration coeficient [1/s] + real :: stovrc !stem turnover coefficient [1/s] + real :: rsdryc !degree of drying that reduces soil respiration [-] + real :: rtovrc !root turnover coefficient [1/s] + real :: wstrc !water stress coeficient [-] + real :: laimin !minimum leaf area index [m2/m2] + real :: xsamin !minimum leaf area index [m2/m2] + real :: sc + real :: sd + real :: vegfrac + +! respiration as a function of temperature + + real :: r,x + r(x) = exp(0.08*(x-298.16)) +! --------------------------------------------------------------------------------- + +! constants + rtovrc = 2.0e-8 !original was 2.0e-8 + rsdryc = 40.0 !original was 40.0 + rswoodc = 3.0e-10 ! + bf = 0.90 !original was 0.90 ! carbon to roots + wstrc = 100.0 + laimin = 0.05 + xsamin = 0.05 ! mb: change to prevent vegetation from not growing back in spring + + sapm = 3.*0.001 ! m2/kg -->m2/g + lfmsmn = laimin/lapm + stmsmn = xsamin/sapm +! --------------------------------------------------------------------------------- + +! respiration + + if(igs .eq. 0.) then + rf = 0.5 + else + rf = 1.0 + endif + + fnf = min( foln/max(1.e-06,parameters%folnmx), 1.0 ) + tf = parameters%arm**( (tv-298.16)/10. ) + resp = parameters%rmf25 * tf * fnf * xlai * rf * (1.-wstres) ! umol/m2/s + rsleaf = min((lfmass-lfmsmn)/dt,resp*12.e-6) ! g/m2/s + + rsroot = parameters%rmr25*(rtmass*1e-3)*tf *rf* 12.e-6 ! g/m2/s + rsstem = parameters%rms25*((stmass-stmsmn)*1e-3)*tf *rf* 12.e-6 ! g/m2/s + rswood = rswoodc * r(tv) * wood*parameters%wdpool + +! carbon assimilation +! 1 mole -> 12 g carbon or 44 g co2; 1 umol -> 12.e-6 g carbon; + + carbfx = psn * 12.e-6 ! umol co2 /m2/ s -> g/m2/s carbon + +! fraction of carbon into leaf versus nonleaf + + leafpt = exp(0.01*(1.-exp(0.75*xlai))*xlai) + if(vegtyp == parameters%eblforest) leafpt = exp(0.01*(1.-exp(0.50*xlai))*xlai) + + nonlef = 1.0 - leafpt + stempt = xlai/10.0*leafpt + leafpt = leafpt - stempt + +! fraction of carbon into wood versus root + + if(wood.gt.0) then + woodf = (1.-exp(-bf*(parameters%wrrat*rtmass/wood))/bf)*parameters%wdpool + else + woodf = 0. + endif + + rootpt = nonlef*(1.-woodf) + woodpt = nonlef*woodf + +! leaf and root turnover per time step + + lftovr = parameters%ltovrc*5.e-7*lfmass + sttovr = parameters%ltovrc*5.e-7*stmass + rttovr = rtovrc*rtmass + wdtovr = 9.5e-10*wood + +! seasonal leaf die rate dependent on temp and water stress +! water stress is set to 1 at permanent wilting point + + sc = exp(-0.3*max(0.,tv-parameters%tdlef)) * (lfmass/120.) + sd = exp((wstres-1.)*wstrc) + dielf = lfmass*1.e-6*(parameters%dilefw * sd + parameters%dilefc*sc) + diest = stmass*1.e-6*(parameters%dilefw * sd + parameters%dilefc*sc) + +! calculate growth respiration for leaf, rtmass and wood + + grleaf = max(0.0,parameters%fragr*(leafpt*carbfx - rsleaf)) + grstem = max(0.0,parameters%fragr*(stempt*carbfx - rsstem)) + grroot = max(0.0,parameters%fragr*(rootpt*carbfx - rsroot)) + grwood = max(0.0,parameters%fragr*(woodpt*carbfx - rswood)) + +! impose lower t limit for photosynthesis + + addnpplf = max(0.,leafpt*carbfx - grleaf-rsleaf) + addnppst = max(0.,stempt*carbfx - grstem-rsstem) +! addnpplf = leafpt*carbfx - grleaf-rsleaf ! mb: test kjetil +! addnppst = stempt*carbfx - grstem-rsstem ! mb: test kjetil + if(tv.lt.parameters%tmin) addnpplf =0. + if(tv.lt.parameters%tmin) addnppst =0. + +! update leaf, root, and wood carbon +! avoid reducing leaf mass below its minimum value but conserve mass + + lfdel = (lfmass - lfmsmn)/dt + stdel = (stmass - stmsmn)/dt + dielf = min(dielf,lfdel+addnpplf-lftovr) + diest = min(diest,stdel+addnppst-sttovr) + +! net primary productivities + + nppl = max(addnpplf,-lfdel) + npps = max(addnppst,-stdel) + nppr = rootpt*carbfx - rsroot - grroot + nppw = woodpt*carbfx - rswood - grwood + +! masses of plant components + + lfmass = lfmass + (nppl-lftovr-dielf)*dt + stmass = stmass + (npps-sttovr-diest)*dt ! g/m2 + rtmass = rtmass + (nppr-rttovr) *dt + + if(rtmass.lt.0.0) then + rttovr = nppr + rtmass = 0.0 + endif + wood = (wood+(nppw-wdtovr)*dt)*parameters%wdpool + +! soil carbon budgets + + fastcp = fastcp + (rttovr+lftovr+sttovr+wdtovr+dielf+diest)*dt ! mb: add diest v3.7 + + fst = 2.0**( (stc(1)-283.16)/10. ) + fsw = wroot / (0.20+wroot) * 0.23 / (0.23+wroot) + rssoil = fsw * fst * parameters%mrp* max(0.,fastcp*1.e-3)*12.e-6 + + stablc = 0.1*rssoil + fastcp = fastcp - (rssoil + stablc)*dt + stblcp = stblcp + stablc*dt + +! total carbon flux + + cflux = - carbfx + rsleaf + rsroot + rswood + rsstem & ! mb: add rsstem,grstem,0.9*rssoil v3.7 + + 0.9*rssoil + grleaf + grroot + grwood + grstem ! g/m2/s + +! for outputs + + gpp = carbfx !g/m2/s c + npp = nppl + nppw + nppr +npps !g/m2/s c + autors = rsroot + rswood + rsleaf + rsstem + & !g/m2/s c mb: add rsstem, grstem v3.7 + grleaf + grroot + grwood + grstem !g/m2/s c mb: add 0.9* v3.7 + heters = 0.9*rssoil !g/m2/s c + nee = (autors + heters - gpp)*44./12. !g/m2/s co2 + totsc = fastcp + stblcp !g/m2 c + totlb = lfmass + rtmass +stmass + wood !g/m2 c mb: add stmass v3.7 + +! leaf area index and stem area index + + xlai = max(lfmass*lapm,laimin) + xsai = max(stmass*sapm,xsamin) + + end subroutine co2flux + +!== begin bvocflux ================================================================================= + +! subroutine bvocflux(parameters,vocflx, vegtyp, vegfrac, apar, tv ) +! +! ------------------------------------------------------------------------------------------ +! implicit none +! ------------------------------------------------------------------------------------------ +! +! ------------------------ code history --------------------------- +! source file: bvoc +! purpose: bvoc emissions +! description: +! volatile organic compound emission +! this code simulates volatile organic compound emissions +! following the algorithm presented in guenther, a., 1999: modeling +! biogenic volatile organic compound emissions to the atmosphere. in +! reactive hydrocarbons in the atmosphere, ch. 3 +! this model relies on the assumption that 90% of isoprene and monoterpene +! emissions originate from canopy foliage: +! e = epsilon * gamma * density * delta +! the factor delta (longterm activity factor) applies to isoprene emission +! from deciduous plants only. we neglect this factor at the present time. +! this factor is discussed in guenther (1997). +! subroutine written to operate at the patch level. +! in final implementation, remember: +! 1. may wish to call this routine only as freq. as rad. calculations +! 2. may wish to place epsilon values directly in pft-physiology file +! ------------------------ input/output variables ----------------- +! input +! integer ,intent(in) :: vegtyp !vegetation type +! real ,intent(in) :: vegfrac !green vegetation fraction [0.0-1.0] +! real ,intent(in) :: apar !photosynthesis active energy by canopy (w/m2) +! real ,intent(in) :: tv !vegetation canopy temperature (k) +! +! output +! real ,intent(out) :: vocflx(5) ! voc fluxes [ug c m-2 h-1] +! +! local variables +! +! real, parameter :: r = 8.314 ! univ. gas constant [j k-1 mol-1] +! real, parameter :: alpha = 0.0027 ! empirical coefficient +! real, parameter :: cl1 = 1.066 ! empirical coefficient +! real, parameter :: ct1 = 95000.0 ! empirical coefficient [j mol-1] +! real, parameter :: ct2 = 230000.0 ! empirical coefficient [j mol-1] +! real, parameter :: ct3 = 0.961 ! empirical coefficient +! real, parameter :: tm = 314.0 ! empirical coefficient [k] +! real, parameter :: tstd = 303.0 ! std temperature [k] +! real, parameter :: bet = 0.09 ! beta empirical coefficient [k-1] +! +! integer ivoc ! do-loop index +! integer ityp ! do-loop index +! real epsilon(5) +! real gamma(5) +! real density +! real elai +! real par,cl,reciprod,ct +! +! epsilon : +! +! do ivoc = 1, 5 +! epsilon(ivoc) = parameters%eps(vegtyp,ivoc) +! end do +! +! gamma : activity factor. units [dimensionless] +! +! reciprod = 1. / (r * tv * tstd) +! ct = exp(ct1 * (tv - tstd) * reciprod) / & +! (ct3 + exp(ct2 * (tv - tm) * reciprod)) +! +! par = apar * 4.6 ! (multiply w/m2 by 4.6 to get umol/m2/s) +! cl = alpha * cl1 * par * (1. + alpha * alpha * par * par)**(-0.5) +! +! gamma(1) = cl * ct ! for isoprenes +! +! do ivoc = 2, 5 +! gamma(ivoc) = exp(bet * (tv - tstd)) +! end do +! +! foliage density +! +! transform vegfrac to lai +! +! elai = max(0.0,-6.5/2.5*alog((1.-vegfrac))) +! density = elai / (parameters%slarea(vegtyp) * 0.5) +! +! calculate the voc flux +! +! do ivoc = 1, 5 +! vocflx(ivoc) = epsilon(ivoc) * gamma(ivoc) * density +! end do +! +! end subroutine bvocflux +! ================================================================================================== +! ********************************* end of carbon subroutines ***************************** +! ================================================================================================== + +!== begin noahmp_options =========================================================================== + +!>\ingroup NoahMP_LSM + subroutine noahmp_options(idveg ,iopt_crs ,iopt_btr ,iopt_run ,iopt_sfc ,iopt_frz , & + iopt_inf ,iopt_rad ,iopt_alb ,iopt_snf ,iopt_tbot, iopt_stc ) + + implicit none + + integer, intent(in) :: idveg !dynamic vegetation (1 -> off ; 2 -> on) with opt_crs = 1 + integer, intent(in) :: iopt_crs !canopy stomatal resistance (1-> ball-berry; 2->jarvis) + integer, intent(in) :: iopt_btr !soil moisture factor for stomatal resistance (1-> noah; 2-> clm; 3-> ssib) + integer, intent(in) :: iopt_run !runoff and groundwater (1->simgm; 2->simtop; 3->schaake96; 4->bats) + integer, intent(in) :: iopt_sfc !surface layer drag coeff (ch & cm) (1->m-o; 2->chen97) + integer, intent(in) :: iopt_frz !supercooled liquid water (1-> ny06; 2->koren99) + integer, intent(in) :: iopt_inf !frozen soil permeability (1-> ny06; 2->koren99) + integer, intent(in) :: iopt_rad !radiation transfer (1->gap=f(3d,cosz); 2->gap=0; 3->gap=1-fveg) + integer, intent(in) :: iopt_alb !snow surface albedo (1->bats; 2->class) + integer, intent(in) :: iopt_snf !rainfall & snowfall (1-jordan91; 2->bats; 3->noah) + integer, intent(in) :: iopt_tbot !lower boundary of soil temperature (1->zero-flux; 2->noah) + + integer, intent(in) :: iopt_stc !snow/soil temperature time scheme (only layer 1) + ! 1 -> semi-implicit; 2 -> full implicit (original noah) + +! ------------------------------------------------------------------------------------------------- + + dveg = idveg + + opt_crs = iopt_crs + opt_btr = iopt_btr + opt_run = iopt_run + opt_sfc = iopt_sfc + opt_frz = iopt_frz + opt_inf = iopt_inf + opt_rad = iopt_rad + opt_alb = iopt_alb + opt_snf = iopt_snf + opt_tbot = iopt_tbot + opt_stc = iopt_stc + + end subroutine noahmp_options + + +end module module_sf_noahmplsm + diff --git a/physics/module_sf_ruclsm.F90 b/physics/module_sf_ruclsm.F90 index 37a574495..7345f2667 100644 --- a/physics/module_sf_ruclsm.F90 +++ b/physics/module_sf_ruclsm.F90 @@ -2,8 +2,8 @@ !! This file is the entity of NOAA/ESRL/GSD RUC LSM Model(WRF version 4.0). !>\ingroup lsm_ruc_group -!!\brief This is the entity of RUC LSM model of physics subroutines. -!! It is a soil/veg/snowpack and ice/snowpack/land-surface model to update soil +!! This module contains the entity of the RUC LSM model, which is a +!! soil/veg/snowpack and ice/snowpack/land-surface model to update soil !! moisture, soil temperature, skin temperature, snowpack water content, snowdepth, !! and all terms of the surface energy balance and surface water balance. MODULE module_sf_ruclsm @@ -57,107 +57,6 @@ MODULE module_sf_ruclsm !>\ingroup lsm_ruc_group !> The RUN LSM model is described in Smirnova et al.(1997) !! \cite Smirnova_1997 and Smirnova et al.(2000) \cite Smirnova_2000 -!>\param dt time step(second) -!>\param ktau number of time step -!>\param nsl number of soil layers -!>\param graupelncv. -!>\param snowncv -!>\param rainncv one time step grid scale precipitation (mm/step) -!>\param raincv one time step convective precipitation (mm/step) -!>\param zs depth of soil levels (\f$m\f$) -!>\param rainbl accumulated rain in mm between the PBL calls -!>\param snow snow water equivalent (\f$mm\f$) -!>\param snowh -!>\param snowc flag indicating snow coverage (1 for snow cover) -!>\param frzfrac fraction of frozen precipitation -!>\param frpcpn -!>\param rhosnf -!>\param precipfr time step frozen precipitation (\f$mm\f$) -!>\param z3d height(\f$m\f$) -!>\param p8w 3D pressure (\f$Pa\f$) -!>\param t3d temperature (\f$K\f$) -!>\param qv3d 3D water vapor mixing ratio (\f$Kg Kg^{-1}\f$) -!>\param qc3d 3D cloud water mixing ratio (\f$Kg Kg^{-1}\f$) -!>\param rho3d 3D air density (\f$Kg m^{-3}\f$) -!>\param glw downward longwave flux at ground surface (\f$Wm^{-2}\f$) -!>\param gsw absorbed shortwave flux at ground surface (\f$Wm^{-2}\f$) -!>\param emiss surface emissivity (between 0 and 1) -!>\param chklowq is either 0 or 1 (so far set equal to 1).used only in MYJPBL -!>\param chs -!>\param flqc surface exchange coefficient for moisture(\f$Kg m^{-2} s^{-1}\f$) -!>\param flhc surface exchange coefficient for heat(\f$Wm^{-2}s^{-1}K^{-1}\f$) -!>\param mavail -!>\param canwat canopy moisture content (\f$mm\f$) -!>\param vegfra vegetation fraction (between 0 and 100) -!>\param alb surface albedo (between 0 and 1) -!>\param znt roughness length (\f$m\f$) -!>\param z0 -!>\param snoalb maximum snow albedo (between 0 and 1) -!>\param albbck snow-free albedo (between 0 and 1) -!>\param landusef -!>\param nlcat -!>\param soilctop -!>\param nscat -!>\param qsfc -!>\param qsg -!>\param qvg -!>\param qcg -!>\param dew -!>\param soilt1 -!>\param tsnav -!>\param tbot soil temperature at lower boundary (\f$K\f$) -!>\param ivgtyp USGS vegetation type (24 classes) -!>\param isltyp STASGO soil type (16 classes) -!>\param xland land mask (1 for land, 2 for water) -!>\param iswater -!>\param isice -!>\param xice -!>\param xice_threshold -!>\param cp heat capacity at constant pressure for dry air (\f$J Kg^{-1} K^{-1}\f$) -!>\param rv -!>\param rd -!>\param g0 acceleration due to gravity (\f$m s^{-2}\f$) -!>\param pi -!>\param lv latent heat of melting (\f$J Kg^{-1}\f$) -!>\param stbolt Stefan-Boltzmann constant (\f$W m^{-2} K^{-4}\f$) -!>\param soilmois soil moisture content (volumetric fraction) -!>\param sh2o -!>\param smavail -!>\param smmax -!>\param tso soil temperature (\f$K\f$) -!>\param soilt surface temperature (\f$K\f$) -!>\param hfx upward heat flux at the surface (\f$W m^{-2}\f$) -!>\param qfx upward moisture flux at the surface (\f$Kg m^{-2} s^{-1}\f$) -!>\param lh upward latent heat flux (\f$W m^{-2}\f$) -!>\param infiltr -!>\param runoff1 -!>\param runoff2 -!>\param acrunoff run-total surface runoff (\f$mm\f$) -!>\param sfcexc -!>\param sfcevp -!>\param grdflx soil heat flux (\f$W m^{-2}\f$; negative, if downward from surface) -!>\param snowfallac run-total snowfall accumulation (\f$m\f$) -!>\param acsnow run-total SWE of snowfall (\f$mm\f$) -!>\param snom -!>\param smfr3d -!>\param keepfr3dflag -!>\param myj -!>\param shdmin -!>\param shdmax -!>\param rdlai2d -!>\param ims start index for i in memory -!>\param ime end index for i in memory -!>\param jms start index for j in memory -!>\param jme end index for j in memory -!>\param kms start index for k in memory -!>\param kme end index for k in memory -!>\param its -!>\param ite -!>\param jts -!>\param jte -!>\param kts -!>\param kte -!! !>\section gen_lsmruc GSD RUC LSM General Algorithm !! @{ SUBROUTINE LSMRUC( & @@ -168,7 +67,7 @@ SUBROUTINE LSMRUC( & Z3D,P8W,T3D,QV3D,QC3D,RHO3D, & GLW,GSW,EMISS,CHKLOWQ, CHS, & FLQC,FLHC,MAVAIL,CANWAT,VEGFRA,ALB,ZNT, & - Z0,SNOALB,ALBBCK, & !Z0,SNOALB,ALBBCK,LAI, & + Z0,SNOALB,ALBBCK,LAI, & landusef, nlcat, & ! mosaic_lu, mosaic_soil, & soilctop, nscat, & QSFC,QSG,QVG,QCG,DEW,SOILT1,TSNAV, & @@ -319,6 +218,7 @@ SUBROUTINE LSMRUC( & CANWAT, & ! new SNOALB, & ALB, & + LAI, & EMISS, & MAVAIL, & SFCEXC, & @@ -370,7 +270,6 @@ SUBROUTINE LSMRUC( & PC, & SFCRUNOFF, & UDRUNOFF, & - LAI, & EMISSL, & ZNTL, & LMAVAIL, & @@ -532,8 +431,8 @@ SUBROUTINE LSMRUC( & !! or ~100 mm of snow height ! ! snowc(i,j) = min(1.,snow(i,j)/32.) - soilt1(i,j)=soilt(i,j) - if(snow(i,j).le.32.) soilt1(i,j)=tso(i,1,j) +! soilt1(i,j)=soilt(i,j) +! if(snow(i,j).le.32.) soilt1(i,j)=tso(i,1,j) !> - Initializing inside snow temp if it is not defined IF((soilt1(i,j) .LT. 170.) .or. (soilt1(i,j) .GT.400.)) THEN IF(snow(i,j).gt.32.) THEN @@ -551,7 +450,9 @@ SUBROUTINE LSMRUC( & patmb=P8w(i,kms,j)*1.e-2 QSG (i,j) = QSN(SOILT(i,j),TBQ)/PATMB IF((qvg(i,j) .LE. 0.) .or. (qvg(i,j) .GT.0.1)) THEN - qvg (i,j) = QSG(i,j)*mavail(i,j) + !17sept19 - bad approximation with very low mavail. + !qvg(i,j) = QSG(i,j)*mavail(i,j) + qvg (i,j) = qv3d(i,1,j) IF (debug_print ) THEN print *, & 'QVG is initialized in RUCLSM ', qvg(i,j),mavail(i,j),qsg(i,j),i,j @@ -852,7 +753,7 @@ SUBROUTINE LSMRUC( & meltfactor = 0.85 do k=2,nzs - if(zsmain(k).ge.1.0) then + if(zsmain(k).ge.1.1) then NROOT=K goto 111 endif @@ -7121,7 +7022,7 @@ END SUBROUTINE SOILVEGIN !> This subroutine computes liquid and forezen soil moisture from the !! total soil moisture, and also computes soil moisture availability in !! the top soil layer. - SUBROUTINE RUCLSMINIT( debug_print, & + SUBROUTINE RUCLSMINIT( debug_print, landmask, & nzs, isltyp, ivgtyp, xice, mavail, & sh2o, smfr3d, tslb, smois, & ims,ime, jms,jme, kms,kme, & @@ -7145,6 +7046,9 @@ SUBROUTINE RUCLSMINIT( debug_print, & INTENT(IN) :: TSLB, & SMOIS + REAL, DIMENSION( ims:ime, jms:jme ) , & + INTENT(IN) :: LANDMASK + INTEGER, DIMENSION( ims:ime, jms:jme ) , & INTENT(INOUT) :: ISLTYP,IVGTYP @@ -7173,6 +7077,9 @@ SUBROUTINE RUCLSMINIT( debug_print, & errflag = 0 DO j = jts,jtf DO i = its,itf + ! land-only version + IF ( LANDMASK( i,j ) .NE. 1 ) CYCLE + ! IF ( ISLTYP( i,j ) .LT. 0 ) THEN errflag = 1 print *, & @@ -7187,18 +7094,21 @@ SUBROUTINE RUCLSMINIT( debug_print, & ENDIF DO J=jts,jtf - DO I=its,itf + DO I=its,itf + + ! land-only version + IF ( LANDMASK( i,j ) .NE. 1 ) CYCLE !--- Computation of volumetric content of ice in soil !--- and initialize MAVAIL - if(ISLTYP(I,J) > 0) then - DQM = MAXSMC (ISLTYP(I,J)) - & - DRYSMC (ISLTYP(I,J)) - REF = REFSMC (ISLTYP(I,J)) - PSIS = - SATPSI (ISLTYP(I,J)) - QMIN = DRYSMC (ISLTYP(I,J)) - BCLH = BB (ISLTYP(I,J)) - endif + if(ISLTYP(I,J) > 0) then + DQM = MAXSMC (ISLTYP(I,J)) - & + DRYSMC (ISLTYP(I,J)) + REF = REFSMC (ISLTYP(I,J)) + PSIS = - SATPSI (ISLTYP(I,J)) + QMIN = DRYSMC (ISLTYP(I,J)) + BCLH = BB (ISLTYP(I,J)) + endif ! in Zobler classification isltyp=0 for water. Statsgo classification @@ -7678,8 +7588,8 @@ END SUBROUTINE SOILIN !+---+-----------------------------------------------------------------+ !>\ingroup lsm_ruc_group -!> THIS FUNCTION CALCULATES THE LIQUID SATURATION VAPOR MIXING RATIO AS -!! A FUNCTION OF TEMPERATURE AND PRESSURE (from Thompson scheme) +!> This function calculates the liquid saturation vapor mixing ratio as +!! a function of temperature and pressure (from Thompson scheme). REAL FUNCTION RSLF(P,T) IMPLICIT NONE diff --git a/physics/moninedmf.f b/physics/moninedmf.f index 918255a12..1084aa426 100644 --- a/physics/moninedmf.f +++ b/physics/moninedmf.f @@ -1,1219 +1,1179 @@ -!> \file moninedmf.f -!! Contains most of the hybrid eddy-diffusivity mass-flux scheme except for the -!! subroutine that calculates the mass flux and updraft properties. - -!> This module contains the CCPP-compliant hybrid eddy-diffusivity mass-flux -!! scheme. - module hedmf - - contains - - - subroutine hedmf_init () - end subroutine hedmf_init - - subroutine hedmf_finalize () - end subroutine hedmf_finalize - - -!> \defgroup HEDMF GFS moninedmf Main -!! @{ -!! \brief This subroutine contains all of logic for the -!! Hybrid EDMF PBL scheme except for the calculation of -!! the updraft properties and mass flux. -!! -!> \section arg_table_hedmf_run Argument Table -!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | -!! |----------------|-----------------------------------------------------------------------------|-------------------------------------------------------|---------------|------|-----------|-----------|--------|----------| -!! | ix | horizontal_dimension | horizontal dimension | count | 0 | integer | | in | F | -!! | im | horizontal_loop_extent | horizontal loop extent | count | 0 | integer | | in | F | -!! | km | vertical_dimension | vertical layer dimension | count | 0 | integer | | in | F | -!! | ntrac | number_of_vertical_diffusion_tracers | number of tracers to diffuse vertically | count | 0 | integer | | in | F | -!! | ntcw | index_for_liquid_cloud_condensate | cloud condensate index in tracer array | index | 0 | integer | | in | F | -!! | dv | tendency_of_y_wind_due_to_model_physics | updated tendency of the y wind | m s-2 | 2 | real | kind_phys | inout | F | -!! | du | tendency_of_x_wind_due_to_model_physics | updated tendency of the x wind | m s-2 | 2 | real | kind_phys | inout | F | -!! | tau | tendency_of_air_temperature_due_to_model_physics | updated tendency of the temperature | K s-1 | 2 | real | kind_phys | inout | F | -!! | rtg | tendency_of_vertically_diffused_tracer_concentration | updated tendency of the tracers due to vertical diffusion in PBL scheme | kg kg-1 s-1 | 3 | real | kind_phys | inout | F | -!! | u1 | x_wind | x component of layer wind | m s-1 | 2 | real | kind_phys | in | F | -!! | v1 | y_wind | y component of layer wind | m s-1 | 2 | real | kind_phys | in | F | -!! | t1 | air_temperature | layer mean air temperature | K | 2 | real | kind_phys | in | F | -!! | q1 | vertically_diffused_tracer_concentration | tracer concentration diffused by PBL scheme | kg kg-1 | 3 | real | kind_phys | in | F | -!! | swh | tendency_of_air_temperature_due_to_shortwave_heating_on_radiation_time_step | total sky shortwave heating rate | K s-1 | 2 | real | kind_phys | in | F | -!! | hlw | tendency_of_air_temperature_due_to_longwave_heating_on_radiation_time_step | total sky longwave heating rate | K s-1 | 2 | real | kind_phys | in | F | -!! | xmu | zenith_angle_temporal_adjustment_factor_for_shortwave_fluxes | zenith angle temporal adjustment factor for shortwave | none | 1 | real | kind_phys | in | F | -!! | psk | dimensionless_exner_function_at_lowest_model_interface | dimensionless Exner function at the surface interface | none | 1 | real | kind_phys | in | F | -!! | rbsoil | bulk_richardson_number_at_lowest_model_level | bulk Richardson number at the surface | none | 1 | real | kind_phys | in | F | -!! | zorl | surface_roughness_length | surface roughness length in cm | cm | 1 | real | kind_phys | in | F | -!! | u10m | x_wind_at_10m | x component of wind at 10 m | m s-1 | 1 | real | kind_phys | in | F | -!! | v10m | y_wind_at_10m | y component of wind at 10 m | m s-1 | 1 | real | kind_phys | in | F | -!! | fm | Monin-Obukhov_similarity_function_for_momentum | Monin-Obukhov similarity function for momentum | none | 1 | real | kind_phys | in | F | -!! | fh | Monin-Obukhov_similarity_function_for_heat | Monin-Obukhov similarity function for heat | none | 1 | real | kind_phys | in | F | -!! | tsea | surface_skin_temperature | surface skin temperature | K | 1 | real | kind_phys | in | F | -!! | heat | kinematic_surface_upward_sensible_heat_flux | kinematic surface upward sensible heat flux | K m s-1 | 1 | real | kind_phys | in | F | -!! | evap | kinematic_surface_upward_latent_heat_flux | kinematic surface upward latent heat flux | kg kg-1 m s-1 | 1 | real | kind_phys | in | F | -!! | stress | surface_wind_stress | surface wind stress | m2 s-2 | 1 | real | kind_phys | in | F | -!! | spd1 | wind_speed_at_lowest_model_layer | wind speed at lowest model level | m s-1 | 1 | real | kind_phys | in | F | -!! | kpbl | vertical_index_at_top_of_atmosphere_boundary_layer | PBL top model level index | index | 1 | integer | | out | F | -!! | prsi | air_pressure_at_interface | air pressure at model layer interfaces | Pa | 2 | real | kind_phys | in | F | -!! | del | air_pressure_difference_between_midlayers | pres(k) - pres(k+1) | Pa | 2 | real | kind_phys | in | F | -!! | prsl | air_pressure | mean layer pressure | Pa | 2 | real | kind_phys | in | F | -!! | prslk | dimensionless_exner_function_at_model_layers | Exner function at layers | none | 2 | real | kind_phys | in | F | -!! | phii | geopotential_at_interface | geopotential at model layer interfaces | m2 s-2 | 2 | real | kind_phys | in | F | -!! | phil | geopotential | geopotential at model layer centers | m2 s-2 | 2 | real | kind_phys | in | F | -!! | delt | time_step_for_physics | time step for physics | s | 0 | real | kind_phys | in | F | -!! | dspheat | flag_TKE_dissipation_heating | flag for using TKE dissipation heating | flag | 0 | logical | | in | F | -!! | dusfc | instantaneous_surface_x_momentum_flux | x momentum flux | Pa | 1 | real | kind_phys | out | F | -!! | dvsfc | instantaneous_surface_y_momentum_flux | y momentum flux | Pa | 1 | real | kind_phys | out | F | -!! | dtsfc | instantaneous_surface_upward_sensible_heat_flux | surface upward sensible heat flux | W m-2 | 1 | real | kind_phys | out | F | -!! | dqsfc | instantaneous_surface_upward_latent_heat_flux | surface upward latent heat flux | W m-2 | 1 | real | kind_phys | out | F | -!! | hpbl | atmosphere_boundary_layer_thickness | PBL thickness | m | 1 | real | kind_phys | out | F | -!! | hgamt | countergradient_mixing_term_for_temperature | countergradient mixing term for temperature | K | 1 | real | kind_phys | inout | F | -!! | hgamq | countergradient_mixing_term_for_water_vapor | countergradient mixing term for water vapor | kg kg-1 | 1 | real | kind_phys | inout | F | -!! | dkt | atmosphere_heat_diffusivity | diffusivity for heat | m2 s-1 | 2 | real | kind_phys | out | F | -!! | kinver | index_of_highest_temperature_inversion | index of highest temperature inversion | index | 1 | integer | | in | F | -!! | xkzm_m | atmosphere_momentum_diffusivity_background | background value of momentum diffusivity | m2 s-1 | 0 | real | kind_phys | in | F | -!! | xkzm_h | atmosphere_heat_diffusivity_background | background value of heat diffusivity | m2 s-1 | 0 | real | kind_phys | in | F | -!! | xkzm_s | diffusivity_background_sigma_level | sigma level threshold for background diffusivity | none | 0 | real | kind_phys | in | F | -!! | lprnt | flag_print | flag for printing diagnostics to output | flag | 0 | logical | | in | F | -!! | ipr | horizontal_index_of_printed_column | horizontal index of printed column | index | 0 | integer | | in | F | -!! | xkzminv | atmosphere_heat_diffusivity_background_maximum | maximum background value of heat diffusivity | m2 s-1 | 0 | real | kind_phys | in | F | -!! | moninq_fac | atmosphere_diffusivity_coefficient_factor | multiplicative constant for atmospheric diffusivities | none | 0 | real | kind_phys | in | F | -!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | -!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | -!! -!! \section general_edmf GFS Hybrid EDMF General Algorithm -!! -# Compute preliminary variables from input arguments. -!! -# Calculate the first estimate of the PBL height ("Predictor step"). -!! -# Calculate Monin-Obukhov similarity parameters. -!! -# Update thermal properties of surface parcel and recompute PBL height ("Corrector step"). -!! -# Determine whether stratocumulus layers exist and compute quantities needed for enhanced diffusion. -!! -# Calculate the inverse Prandtl number. -!! -# Compute diffusion coefficients below the PBL top. -!! -# Compute diffusion coefficients above the PBL top. -!! -# If the PBL is convective, call the mass flux scheme to replace the countergradient terms. -!! -# Compute enhanced diffusion coefficients related to stratocumulus-topped PBLs. -!! -# Solve for the temperature and moisture tendencies due to vertical mixing. -!! -# Calculate heating due to TKE dissipation and add to the tendency for temperature. -!! -# Solve for the horizontal momentum tendencies and add them to output tendency terms. -!! \section detailed_hedmf GFS Hybrid HEDMF Detailed Algorithm -!! @{ - subroutine hedmf_run (ix,im,km,ntrac,ntcw,dv,du,tau,rtg, & - & u1,v1,t1,q1,swh,hlw,xmu, & - & psk,rbsoil,zorl,u10m,v10m,fm,fh, & - & tsea,heat,evap,stress,spd1,kpbl, & - & prsi,del,prsl,prslk,phii,phil,delt,dspheat, & - & dusfc,dvsfc,dtsfc,dqsfc,hpbl,hgamt,hgamq,dkt, & - & kinver,xkzm_m,xkzm_h,xkzm_s,lprnt,ipr, & - & xkzminv,moninq_fac,errmsg,errflg) -! - use machine , only : kind_phys - use funcphys , only : fpvs - use physcons, grav => con_g, rd => con_rd, cp => con_cp - &, hvap => con_hvap, fv => con_fvirt - implicit none -! -! arguments -! - logical, intent(in) :: lprnt - integer, intent(in) :: ipr - integer, intent(in) :: ix, im, km, ntrac, ntcw, kinver(im) - integer, intent(out) :: kpbl(im) - -! - real(kind=kind_phys), intent(in) :: delt, xkzm_m, xkzm_h, xkzm_s - real(kind=kind_phys), intent(in) :: xkzminv, moninq_fac - real(kind=kind_phys), intent(inout) :: dv(im,km), du(im,km), & - & tau(im,km), rtg(im,km,ntrac) - real(kind=kind_phys), intent(in) :: & - & u1(ix,km), v1(ix,km), & - & t1(ix,km), q1(ix,km,ntrac), & - & swh(ix,km), hlw(ix,km), & - & xmu(im), psk(im), & - & rbsoil(im), zorl(im), & - & u10m(im), v10m(im), & - & fm(im), fh(im), & - & tsea(im), & - & heat(im), evap(im), & - & stress(im), spd1(im) - real(kind=kind_phys), intent(in) :: & - & prsi(ix,km+1), del(ix,km), & - & prsl(ix,km), prslk(ix,km), & - & phii(ix,km+1), phil(ix,km) - real(kind=kind_phys), intent(out) :: & - & dusfc(im), dvsfc(im), & - & dtsfc(im), dqsfc(im), & - & hpbl(im), dkt(im,km-1) - real(kind=kind_phys), intent(inout) :: & - & hgamt(im), hgamq(im) -! - logical, intent(in) :: dspheat -! flag for tke dissipative heating - character(len=*), intent(out) :: errmsg - integer, intent(out) :: errflg - -! -! locals - - integer i,iprt,is,iun,k,kk,km1,kmpbl,latd,lond - integer lcld(im),icld(im),kcld(im),krad(im) - integer kx1(im), kpblx(im) -! -! real(kind=kind_phys) betaq(im), betat(im), betaw(im), - real(kind=kind_phys) phih(im), phim(im), hpblx(im), & - & rbdn(im), rbup(im), & - & beta(im), sflux(im), & - & z0(im), crb(im), wstar(im), & - & zol(im), ustmin(im), ustar(im), & - & thermal(im),wscale(im), wscaleu(im) -! - real(kind=kind_phys) theta(im,km),thvx(im,km), thlvx(im,km), & - & qlx(im,km), thetae(im,km), & - & qtx(im,km), bf(im,km-1), diss(im,km), & - & radx(im,km-1), & - & govrth(im), hrad(im), & -! & hradm(im), radmin(im), vrad(im), & - & radmin(im), vrad(im), & - & zd(im), zdd(im), thlvx1(im) -! - real(kind=kind_phys) rdzt(im,km-1),dktx(im,km-1), & - & zi(im,km+1), zl(im,km), xkzo(im,km-1), & - & dku(im,km-1), xkzmo(im,km-1), & - & cku(im,km-1), ckt(im,km-1), & - & ti(im,km-1), shr2(im,km-1), & - & al(im,km-1), ad(im,km), & - & au(im,km-1), a1(im,km), & - & a2(im,km*ntrac) -! - real(kind=kind_phys) tcko(im,km), qcko(im,km,ntrac), & - & ucko(im,km), vcko(im,km), xmf(im,km) -! - real(kind=kind_phys) prinv(im), rent(im) -! - logical pblflg(im), sfcflg(im), scuflg(im), flg(im) - logical ublflg(im), pcnvflg(im) -! -! pcnvflg: true for convective(strongly unstable) pbl -! ublflg: true for unstable but not convective(strongly unstable) pbl -! - real(kind=kind_phys) aphi16, aphi5, bvf2, wfac, - & cfac, conq, cont, conw, - & dk, dkmax, dkmin, - & dq1, dsdz2, dsdzq, dsdzt, - & dsdzu, dsdzv, - & dsig, dt2, dthe1, dtodsd, - & dtodsu, dw2, dw2min, g, - & gamcrq, gamcrt, gocp, - & gravi, f0, - & prnum, prmax, prmin, pfac, crbcon, - & qmin, tdzmin, qtend, crbmin,crbmax, - & rbint, rdt, rdz, qlmin, - & ri, rimin, rl2, rlam, rlamun, - & rone, rzero, sfcfrac, - & spdk2, sri, zol1, zolcr, zolcru, - & robn, ttend, - & utend, vk, vk2, - & ust3, wst3, - & vtend, zfac, vpert, cteit, - & rentf1, rentf2, radfac, - & zfmin, zk, tem, tem1, tem2, - & xkzm, xkzmu, - & ptem, ptem1, ptem2, tx1(im), tx2(im) -! - real(kind=kind_phys) zstblmax,h1, h2, qlcr, actei, - & cldtime -cc - parameter(gravi=1.0/grav) - parameter(g=grav) - parameter(gocp=g/cp) - parameter(cont=cp/g,conq=hvap/g,conw=1.0/g) ! for del in pa -! parameter(cont=1000.*cp/g,conq=1000.*hvap/g,conw=1000./g) ! for del in kpa - parameter(rlam=30.0,vk=0.4,vk2=vk*vk) - parameter(prmin=0.25,prmax=4.,zolcr=0.2,zolcru=-0.5) - parameter(dw2min=0.0001,dkmin=0.0,dkmax=1000.,rimin=-100.) - parameter(crbcon=0.25,crbmin=0.15,crbmax=0.35) - parameter(wfac=7.0,cfac=6.5,pfac=2.0,sfcfrac=0.1) -! parameter(qmin=1.e-8,xkzm=1.0,zfmin=1.e-8,aphi5=5.,aphi16=16.) - parameter(qmin=1.e-8, zfmin=1.e-8,aphi5=5.,aphi16=16.) - parameter(tdzmin=1.e-3,qlmin=1.e-12,f0=1.e-4) - parameter(h1=0.33333333,h2=0.66666667) -! parameter(cldtime=500.,xkzminv=0.3) - parameter(cldtime=500.) -! parameter(cldtime=500.,xkzmu=3.0,xkzminv=0.3) -! parameter(gamcrt=3.,gamcrq=2.e-3,rlamun=150.0) - parameter(gamcrt=3.,gamcrq=0.,rlamun=150.0) - parameter(rentf1=0.2,rentf2=1.0,radfac=0.85) - parameter(iun=84) -! -! parameter (zstblmax = 2500., qlcr=1.0e-5) -! parameter (zstblmax = 2500., qlcr=3.0e-5) -! parameter (zstblmax = 2500., qlcr=3.5e-5) -! parameter (zstblmax = 2500., qlcr=1.0e-4) - parameter (zstblmax = 2500., qlcr=3.5e-5) -! parameter (actei = 0.23) - parameter (actei = 0.7) -c -c----------------------------------------------------------------------- -c - 601 format(1x,' moninp lat lon step hour ',3i6,f6.1) - 602 format(1x,' k',' z',' t',' th', - 1 ' tvh',' q',' u',' v', - 2 ' sp') - 603 format(1x,i5,8f9.1) - 604 format(1x,' sfc',9x,f9.1,18x,f9.1) - 605 format(1x,' k zl spd2 thekv the1v' - 1 ,' thermal rbup') - 606 format(1x,i5,6f8.2) - 607 format(1x,' kpbl hpbl fm fh hgamt', - 1 ' hgamq ws ustar cd ch') - 608 format(1x,i5,9f8.2) - 609 format(1x,' k pr dkt dku ',i5,3f8.2) - 610 format(1x,' k pr dkt dku ',i5,3f8.2,' l2 ri t2', - 1 ' sr2 ',2f8.2,2e10.2) -! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -! Initialize CCPP error handling variables - errmsg = '' - errflg = 0 - -!> ## Compute preliminary variables from input arguments - -! compute preliminary variables -! - if (ix .lt. im) stop -! -! iprt = 0 -! if(iprt.eq.1) then -!cc latd = 0 -! lond = 0 -! else -!cc latd = 0 -! lond = 0 -! endif -! - dt2 = delt - rdt = 1. / dt2 - km1 = km - 1 - kmpbl = km / 2 -!> - Compute physical height of the layer centers and interfaces from the geopotential height (zi and zl) - do k=1,km - do i=1,im - zi(i,k) = phii(i,k) * gravi - zl(i,k) = phil(i,k) * gravi - enddo - enddo - do i=1,im - zi(i,km+1) = phii(i,km+1) * gravi - enddo -!> - Compute reciprocal of \f$ \Delta z \f$ (rdzt) - do k = 1,km1 - do i=1,im - rdzt(i,k) = 1.0 / (zl(i,k+1) - zl(i,k)) - enddo - enddo -!> - Compute reciprocal of pressure (tx1, tx2) - do i=1,im - kx1(i) = 1 - tx1(i) = 1.0 / prsi(i,1) - tx2(i) = tx1(i) - enddo -!> - Compute background vertical diffusivities for scalars and momentum (xkzo and xkzmo) - do k = 1,km1 - do i=1,im - xkzo(i,k) = 0.0 - xkzmo(i,k) = 0.0 - if (k < kinver(i)) then -! vertical background diffusivity - ptem = prsi(i,k+1) * tx1(i) - tem1 = 1.0 - ptem - tem1 = tem1 * tem1 * 10.0 - xkzo(i,k) = xkzm_h * min(1.0, exp(-tem1)) - -! vertical background diffusivity for momentum - if (ptem >= xkzm_s) then - xkzmo(i,k) = xkzm_m - kx1(i) = k + 1 - else - if (k == kx1(i) .and. k > 1) tx2(i) = 1.0 / prsi(i,k) - tem1 = 1.0 - prsi(i,k+1) * tx2(i) - tem1 = tem1 * tem1 * 5.0 - xkzmo(i,k) = xkzm_m * min(1.0, exp(-tem1)) - endif - endif - enddo - enddo -! if (lprnt) then -! print *,' xkzo=',(xkzo(ipr,k),k=1,km1) -! print *,' xkzmo=',(xkzmo(ipr,k),k=1,km1) -! endif -! -! diffusivity in the inversion layer is set to be xkzminv (m^2/s) -!> - The background scalar vertical diffusivity is limited to be less than or equal to xkzminv - do k = 1,kmpbl - do i=1,im -! if(zi(i,k+1) > 200..and.zi(i,k+1) < zstblmax) then - if(zi(i,k+1) > 250.) then - tem1 = (t1(i,k+1)-t1(i,k)) * rdzt(i,k) - if(tem1 > 1.e-5) then - xkzo(i,k) = min(xkzo(i,k),xkzminv) - endif - endif - enddo - enddo -!> - Some output variables and logical flags are initialized - do i = 1,im - z0(i) = 0.01 * zorl(i) - dusfc(i) = 0. - dvsfc(i) = 0. - dtsfc(i) = 0. - dqsfc(i) = 0. - wscale(i)= 0. - wscaleu(i)= 0. - kpbl(i) = 1 - hpbl(i) = zi(i,1) - hpblx(i) = zi(i,1) - pblflg(i)= .true. - sfcflg(i)= .true. - if(rbsoil(i) > 0.) sfcflg(i) = .false. - ublflg(i)= .false. - pcnvflg(i)= .false. - scuflg(i)= .true. - if(scuflg(i)) then - radmin(i)= 0. - rent(i) = rentf1 - hrad(i) = zi(i,1) -! hradm(i) = zi(i,1) - krad(i) = 1 - icld(i) = 0 - lcld(i) = km1 - kcld(i) = km1 - zd(i) = 0. - endif - enddo -!> - Compute \f$\theta\f$ (theta), \f$q_l\f$ (qlx), \f$q_t\f$ (qtx), \f$\theta_e\f$ (thetae), \f$\theta_v\f$ (thvx), \f$\theta_{l,v}\f$ (thlvx) - do k = 1,km - do i = 1,im - theta(i,k) = t1(i,k) * psk(i) / prslk(i,k) - qlx(i,k) = max(q1(i,k,ntcw),qlmin) - qtx(i,k) = max(q1(i,k,1),qmin)+qlx(i,k) - ptem = qlx(i,k) - ptem1 = hvap*max(q1(i,k,1),qmin)/(cp*t1(i,k)) - thetae(i,k)= theta(i,k)*(1.+ptem1) - thvx(i,k) = theta(i,k)*(1.+fv*max(q1(i,k,1),qmin)-ptem) - ptem2 = theta(i,k)-(hvap/cp)*ptem - thlvx(i,k) = ptem2*(1.+fv*qtx(i,k)) - enddo - enddo -!> - Initialize diffusion coefficients to 0 and calculate the total radiative heating rate (dku, dkt, radx) - do k = 1,km1 - do i = 1,im - dku(i,k) = 0. - dkt(i,k) = 0. - dktx(i,k) = 0. - cku(i,k) = 0. - ckt(i,k) = 0. - tem = zi(i,k+1)-zi(i,k) - radx(i,k) = tem*(swh(i,k)*xmu(i)+hlw(i,k)) - enddo - enddo -!> - Set lcld to first index above 2.5km - do i=1,im - flg(i) = scuflg(i) - enddo - do k = 1, km1 - do i=1,im - if(flg(i).and.zl(i,k) >= zstblmax) then - lcld(i)=k - flg(i)=.false. - endif - enddo - enddo -! -! compute virtual potential temp gradient (bf) and winshear square -!> - Compute \f$\frac{\partial \theta_v}{\partial z}\f$ (bf) and the wind shear squared (shr2) - do k = 1, km1 - do i = 1, im - rdz = rdzt(i,k) - bf(i,k) = (thvx(i,k+1)-thvx(i,k))*rdz - ti(i,k) = 2./(t1(i,k)+t1(i,k+1)) - dw2 = (u1(i,k)-u1(i,k+1))**2 - & + (v1(i,k)-v1(i,k+1))**2 - shr2(i,k) = max(dw2,dw2min)*rdz*rdz - enddo - enddo -!> - Calculate \f$\frac{g}{\theta}\f$ (govrth), \f$\beta = \frac{\Delta t}{\Delta z}\f$ (beta), \f$u_*\f$ (ustar), total surface flux (sflux), and set pblflag to false if the total surface energy flux is into the surface - do i = 1,im - govrth(i) = g/theta(i,1) - enddo -! - do i=1,im - beta(i) = dt2 / (zi(i,2)-zi(i,1)) - enddo -! - do i=1,im - ustar(i) = sqrt(stress(i)) - enddo -! - do i = 1,im - sflux(i) = heat(i) + evap(i)*fv*theta(i,1) - if(.not.sfcflg(i) .or. sflux(i) <= 0.) pblflg(i)=.false. - enddo -!> ## Calculate the first estimate of the PBL height ("Predictor step") -!! The calculation of the boundary layer height follows Troen and Mahrt (1986) \cite troen_and_mahrt_1986 section 3. The approach is to find the level in the column where a modified bulk Richardson number exceeds a critical value. -!! -!! The temperature of the thermal is of primary importance. For the initial estimate of the PBL height, the thermal is assumed to have one of two temperatures. If the boundary layer is stable, the thermal is assumed to have a temperature equal to the surface virtual temperature. Otherwise, the thermal is assumed to have the same virtual potential temperature as the lowest model level. For the stable case, the critical bulk Richardson number becomes a function of the wind speed and roughness length, otherwise it is set to a tunable constant. -! compute the pbl height -! - do i=1,im - flg(i) = .false. - rbup(i) = rbsoil(i) -! - if(pblflg(i)) then - thermal(i) = thvx(i,1) - crb(i) = crbcon - else - thermal(i) = tsea(i)*(1.+fv*max(q1(i,1,1),qmin)) - tem = sqrt(u10m(i)**2+v10m(i)**2) - tem = max(tem, 1.) - robn = tem / (f0 * z0(i)) - tem1 = 1.e-7 * robn - crb(i) = 0.16 * (tem1 ** (-0.18)) - crb(i) = max(min(crb(i), crbmax), crbmin) - endif - enddo -!> Given the thermal's properties and the critical Richardson number, a loop is executed to find the first level above the surface where the modified Richardson number is greater than the critical Richardson number, using equation 10a from Troen and Mahrt (1986) \cite troen_and_mahrt_1986 (also equation 8 from Hong and Pan (1996) \cite hong_and_pan_1996): -!! \f[ -!! h = Ri\frac{T_0\left|\vec{v}(h)\right|^2}{g\left(\theta_v(h) - \theta_s\right)} -!! \f] -!! where \f$h\f$ is the PBL height, \f$Ri\f$ is the Richardson number, \f$T_0\f$ is the virtual potential temperature near the surface, \f$\left|\vec{v}\right|\f$ is the wind speed, and \f$\theta_s\f$ is for the thermal. Rearranging this equation to calculate the modified Richardson number at each level, k, for comparison with the critical value yields: -!! \f[ -!! Ri_k = gz(k)\frac{\left(\theta_v(k) - \theta_s\right)}{\theta_v(1)*\vec{v}(k)} -!! \f] - do k = 1, kmpbl - do i = 1, im - if(.not.flg(i)) then - rbdn(i) = rbup(i) - spdk2 = max((u1(i,k)**2+v1(i,k)**2),1.) - rbup(i) = (thvx(i,k)-thermal(i))* - & (g*zl(i,k)/thvx(i,1))/spdk2 - kpbl(i) = k - flg(i) = rbup(i) > crb(i) - endif - enddo - enddo -!> Once the level is found, some linear interpolation is performed to find the exact height of the boundary layer top (where \f$Ri = Ri_{cr}\f$) and the PBL height and the PBL top index are saved (hpblx and kpblx, respectively) - do i = 1,im - if(kpbl(i) > 1) then - k = kpbl(i) - if(rbdn(i) >= crb(i)) then - rbint = 0. - elseif(rbup(i) <= crb(i)) then - rbint = 1. - else - rbint = (crb(i)-rbdn(i))/(rbup(i)-rbdn(i)) - endif - hpbl(i) = zl(i,k-1) + rbint*(zl(i,k)-zl(i,k-1)) - if(hpbl(i) < zi(i,kpbl(i))) kpbl(i) = kpbl(i) - 1 - else - hpbl(i) = zl(i,1) - kpbl(i) = 1 - endif - kpblx(i) = kpbl(i) - hpblx(i) = hpbl(i) - enddo -! -! compute similarity parameters -!> ## Calculate Monin-Obukhov similarity parameters -!! Using the initial guess for the PBL height, Monin-Obukhov similarity parameters are calculated. They are needed to refine the PBL height calculation and for calculating diffusion coefficients. -!! -!! First, calculate the Monin-Obukhov nondimensional stability parameter, commonly referred to as \f$\zeta\f$ using the following equation from Businger et al. (1971) \cite businger_et_al_1971 (equation 28): -!! \f[ -!! \zeta = Ri_{sfc}\frac{F_m^2}{F_h} = \frac{z}{L} -!! \f] -!! where \f$F_m\f$ and \f$F_h\f$ are surface Monin-Obukhov stability functions calculated in sfc_diff.f and \f$L\f$ is the Obukhov length. Then, the nondimensional gradients of momentum and temperature (phim and phih) are calculated using equations 5 and 6 from Hong and Pan (1996) \cite hong_and_pan_1996 depending on the surface layer stability. Then, the velocity scale valid for the surface layer (\f$w_s\f$, wscale) is calculated using equation 3 from Hong and Pan (1996) \cite hong_and_pan_1996. For the neutral and unstable PBL above the surface layer, the convective velocity scale, \f$w_*\f$, is calculated according to: -!! \f[ -!! w_* = \left(\frac{g}{\theta_0}h\overline{w'\theta_0'}\right)^{1/3} -!! \f] -!! and the mixed layer velocity scale is then calculated with equation 6 from Troen and Mahrt (1986) \cite troen_and_mahrt_1986 -!! \f[ -!! w_s = (u_*^3 + 7\epsilon k w_*^3)^{1/3} -!! \f] - do i=1,im - zol(i) = max(rbsoil(i)*fm(i)*fm(i)/fh(i),rimin) - if(sfcflg(i)) then - zol(i) = min(zol(i),-zfmin) - else - zol(i) = max(zol(i),zfmin) - endif - zol1 = zol(i)*sfcfrac*hpbl(i)/zl(i,1) - if(sfcflg(i)) then -! phim(i) = (1.-aphi16*zol1)**(-1./4.) -! phih(i) = (1.-aphi16*zol1)**(-1./2.) - tem = 1.0 / (1. - aphi16*zol1) - phih(i) = sqrt(tem) - phim(i) = sqrt(phih(i)) - else - phim(i) = 1. + aphi5*zol1 - phih(i) = phim(i) - endif - wscale(i) = ustar(i)/phim(i) - ustmin(i) = ustar(i)/aphi5 - wscale(i) = max(wscale(i),ustmin(i)) - enddo - do i=1,im - if(pblflg(i)) then - if(zol(i) < zolcru .and. kpbl(i) > 1) then - pcnvflg(i) = .true. - else - ublflg(i) = .true. - endif - wst3 = govrth(i)*sflux(i)*hpbl(i) - wstar(i)= wst3**h1 - ust3 = ustar(i)**3. - wscaleu(i) = (ust3+wfac*vk*wst3*sfcfrac)**h1 - wscaleu(i) = max(wscaleu(i),ustmin(i)) - endif - enddo -! -! compute counter-gradient mixing term for heat and moisture -!> ## Update thermal properties of surface parcel and recompute PBL height ("Corrector step"). -!! Next, the counter-gradient terms for temperature and humidity are calculated using equation 4 of Hong and Pan (1996) \cite hong_and_pan_1996 and are used to calculate the "scaled virtual temperature excess near the surface" (equation 9 in Hong and Pan (1996) \cite hong_and_pan_1996) so that the properties of the thermal are updated to recalculate the PBL height. - do i = 1,im - if(ublflg(i)) then - hgamt(i) = min(cfac*heat(i)/wscaleu(i),gamcrt) - hgamq(i) = min(cfac*evap(i)/wscaleu(i),gamcrq) - vpert = hgamt(i) + hgamq(i)*fv*theta(i,1) - vpert = min(vpert,gamcrt) - thermal(i)= thermal(i)+max(vpert,0.) - hgamt(i) = max(hgamt(i),0.0) - hgamq(i) = max(hgamq(i),0.0) - endif - enddo -! -! enhance the pbl height by considering the thermal excess -!> The PBL height calculation follows the same procedure as the predictor step, except that it uses an updated virtual potential temperature for the thermal. - do i=1,im - flg(i) = .true. - if(ublflg(i)) then - flg(i) = .false. - rbup(i) = rbsoil(i) - endif - enddo - do k = 2, kmpbl - do i = 1, im - if(.not.flg(i)) then - rbdn(i) = rbup(i) - spdk2 = max((u1(i,k)**2+v1(i,k)**2),1.) - rbup(i) = (thvx(i,k)-thermal(i))* - & (g*zl(i,k)/thvx(i,1))/spdk2 - kpbl(i) = k - flg(i) = rbup(i) > crb(i) - endif - enddo - enddo - do i = 1,im - if(ublflg(i)) then - k = kpbl(i) - if(rbdn(i) >= crb(i)) then - rbint = 0. - elseif(rbup(i) <= crb(i)) then - rbint = 1. - else - rbint = (crb(i)-rbdn(i))/(rbup(i)-rbdn(i)) - endif - hpbl(i) = zl(i,k-1) + rbint*(zl(i,k)-zl(i,k-1)) - if(hpbl(i) < zi(i,kpbl(i))) kpbl(i) = kpbl(i) - 1 - if(kpbl(i) <= 1) then - ublflg(i) = .false. - pblflg(i) = .false. - endif - endif - enddo -! -! look for stratocumulus -!> ## Determine whether stratocumulus layers exist and compute quantities needed for enhanced diffusion -!! - Starting at the PBL top and going downward, if the level is less than 2.5 km and \f$q_l>q_{l,cr}\f$ then set kcld = k (find the cloud top index in the PBL). If no cloud water above the threshold is found, scuflg is set to F. - do i = 1, im - flg(i)=scuflg(i) - enddo - do k = kmpbl,1,-1 - do i = 1, im - if(flg(i) .and. k <= lcld(i)) then - if(qlx(i,k).ge.qlcr) then - kcld(i)=k - flg(i)=.false. - endif - endif - enddo - enddo - do i = 1, im - if(scuflg(i) .and. kcld(i)==km1) scuflg(i)=.false. - enddo -!> - Starting at the PBL top and going downward, if the level is less than the cloud top, find the level of the minimum radiative heating rate within the cloud. If the level of the minimum is the lowest model level or the minimum radiative heating rate is positive, then set scuflg to F. - do i = 1, im - flg(i)=scuflg(i) - enddo - do k = kmpbl,1,-1 - do i = 1, im - if(flg(i) .and. k <= kcld(i)) then - if(qlx(i,k) >= qlcr) then - if(radx(i,k) < radmin(i)) then - radmin(i)=radx(i,k) - krad(i)=k - endif - else - flg(i)=.false. - endif - endif - enddo - enddo - do i = 1, im - if(scuflg(i) .and. krad(i) <= 1) scuflg(i)=.false. - if(scuflg(i) .and. radmin(i)>=0.) scuflg(i)=.false. - enddo -!> - Starting at the PBL top and going downward, count the number of levels below the minimum radiative heating rate level that have cloud water above the threshold. If there are none, then set the scuflg to F. - do i = 1, im - flg(i)=scuflg(i) - enddo - do k = kmpbl,2,-1 - do i = 1, im - if(flg(i) .and. k <= krad(i)) then - if(qlx(i,k) >= qlcr) then - icld(i)=icld(i)+1 - else - flg(i)=.false. - endif - endif - enddo - enddo - do i = 1, im - if(scuflg(i) .and. icld(i) < 1) scuflg(i)=.false. - enddo -!> - Find the height of the interface where the minimum in radiative heating rate is located. If this height is less than the second model interface height, then set the scuflg to F. - do i = 1, im - if(scuflg(i)) then - hrad(i) = zi(i,krad(i)+1) -! hradm(i)= zl(i,krad(i)) - endif - enddo -! - do i = 1, im - if(scuflg(i) .and. hrad(i) - Calculate the hypothetical \f$\theta_v\f$ at the minimum radiative heating level that a parcel would reach due to radiative cooling after a typical cloud turnover time spent at that level. - do i = 1, im - if(scuflg(i)) then - k = krad(i) - tem = zi(i,k+1)-zi(i,k) - tem1 = cldtime*radmin(i)/tem - thlvx1(i) = thlvx(i,k)+tem1 -! if(thlvx1(i) > thlvx(i,k-1)) scuflg(i)=.false. - endif - enddo -!> - Determine the distance that a parcel would sink downwards starting from the level of minimum radiative heating rate by comparing the hypothetical minimum \f$\theta_v\f$ calculated above with the environmental \f$\theta_v\f$. - do i = 1, im - flg(i)=scuflg(i) - enddo - do k = kmpbl,1,-1 - do i = 1, im - if(flg(i) .and. k <= krad(i))then - if(thlvx1(i) <= thlvx(i,k))then - tem=zi(i,k+1)-zi(i,k) - zd(i)=zd(i)+tem - else - flg(i)=.false. - endif - endif - enddo - enddo -!> - Calculate the cloud thickness, where the cloud top is the in-cloud minimum radiative heating level and the bottom is determined previously. - do i = 1, im - if(scuflg(i))then - kk = max(1, krad(i)+1-icld(i)) - zdd(i) = hrad(i)-zi(i,kk) - endif - enddo -!> - Find the largest between the cloud thickness and the distance of a sinking parcel, then determine the smallest of that number and the height of the minimum in radiative heating rate. Set this number to \f$zd\f$. Using \f$zd\f$, calculate the characteristic velocity scale of cloud-top radiative cooling-driven turbulence. - do i = 1, im - if(scuflg(i))then - zd(i) = max(zd(i),zdd(i)) - zd(i) = min(zd(i),hrad(i)) - tem = govrth(i)*zd(i)*(-radmin(i)) - vrad(i)= tem**h1 - endif - enddo -! -! compute inverse prandtl number -!> ## Calculate the inverse Prandtl number -!! For an unstable PBL, the Prandtl number is calculated according to Hong and Pan (1996) \cite hong_and_pan_1996, equation 10, whereas for a stable boundary layer, the Prandtl number is simply \f$Pr = \frac{\phi_h}{\phi_m}\f$. - do i = 1, im - if(ublflg(i)) then - tem = phih(i)/phim(i)+cfac*vk*sfcfrac - else - tem = phih(i)/phim(i) - endif - prinv(i) = 1.0 / tem - prinv(i) = min(prinv(i),prmax) - prinv(i) = max(prinv(i),prmin) - enddo - do i = 1, im - if(zol(i) > zolcr) then - kpbl(i) = 1 - endif - enddo -! -! compute diffusion coefficients below pbl -!> ## Compute diffusion coefficients below the PBL top -!! Below the PBL top, the diffusion coefficients (\f$K_m\f$ and \f$K_h\f$) are calculated according to equation 2 in Hong and Pan (1996) \cite hong_and_pan_1996 where a different value for \f$w_s\f$ (PBL vertical velocity scale) is used depending on the PBL stability. \f$K_h\f$ is calculated from \f$K_m\f$ using the Prandtl number. The calculated diffusion coefficients are checked so that they are bounded by maximum values and the local background diffusion coefficients. - do k = 1, kmpbl - do i=1,im - if(k < kpbl(i)) then -! zfac = max((1.-(zi(i,k+1)-zl(i,1))/ -! 1 (hpbl(i)-zl(i,1))), zfmin) - zfac = max((1.-zi(i,k+1)/hpbl(i)), zfmin) - tem = zi(i,k+1) * (zfac**pfac) * moninq_fac ! lmh suggested by kg - if(pblflg(i)) then - tem1 = vk * wscaleu(i) * tem -! dku(i,k) = xkzmo(i,k) + tem1 -! dkt(i,k) = xkzo(i,k) + tem1 * prinv(i) - dku(i,k) = tem1 - dkt(i,k) = tem1 * prinv(i) - else - tem1 = vk * wscale(i) * tem -! dku(i,k) = xkzmo(i,k) + tem1 -! dkt(i,k) = xkzo(i,k) + tem1 * prinv(i) - dku(i,k) = tem1 - dkt(i,k) = tem1 * prinv(i) - endif - dku(i,k) = min(dku(i,k),dkmax) - dku(i,k) = max(dku(i,k),xkzmo(i,k)) - dkt(i,k) = min(dkt(i,k),dkmax) - dkt(i,k) = max(dkt(i,k),xkzo(i,k)) - dktx(i,k)= dkt(i,k) - endif - enddo - enddo -! -! compute diffusion coefficients based on local scheme above pbl -!> ## Compute diffusion coefficients above the PBL top -!! Diffusion coefficients above the PBL top are computed as a function of local stability (gradient Richardson number), shear, and a length scale from Louis (1979) \cite louis_1979 : -!! \f[ -!! K_{m,h}=l^2f_{m,h}(Ri_g)\left|\frac{\partial U}{\partial z}\right| -!! \f] -!! The functions used (\f$f_{m,h}\f$) depend on the local stability. First, the gradient Richardson number is calculated as -!! \f[ -!! Ri_g=\frac{\frac{g}{T}\frac{\partial \theta_v}{\partial z}}{\frac{\partial U}{\partial z}^2} -!! \f] -!! where \f$U\f$ is the horizontal wind. For the unstable case (\f$Ri_g < 0\f$), the Richardson number-dependent functions are given by -!! \f[ -!! f_h(Ri_g) = 1 + \frac{8\left|Ri_g\right|}{1 + 1.286\sqrt{\left|Ri_g\right|}}\\ -!! \f] -!! \f[ -!! f_m(Ri_g) = 1 + \frac{8\left|Ri_g\right|}{1 + 1.746\sqrt{\left|Ri_g\right|}}\\ -!! \f] -!! For the stable case, the following formulas are used -!! \f[ -!! f_h(Ri_g) = \frac{1}{\left(1 + 5Ri_g\right)^2}\\ -!! \f] -!! \f[ -!! Pr = \frac{K_h}{K_m} = 1 + 2.1Ri_g -!! \f] -!! The source for the formulas used for the Richardson number-dependent functions is unclear. They are different than those used in Hong and Pan (1996) \cite hong_and_pan_1996 as the previous documentation suggests. They follow equation 14 of Louis (1979) \cite louis_1979 for the unstable case, but it is unclear where the values of the coefficients \f$b\f$ and \f$c\f$ from that equation used in this scheme originate. Finally, the length scale, \f$l\f$ is calculated according to the following formula from Hong and Pan (1996) \cite hong_and_pan_1996 -!! \f[ -!! \frac{1}{l} = \frac{1}{kz} + \frac{1}{l_0}\\ -!! \f] -!! \f[ -!! or\\ -!! \f] -!! \f[ -!! l=\frac{l_0kz}{l_0+kz} -!! \f] -!! where \f$l_0\f$ is currently 30 m for stable conditions and 150 m for unstable. Finally, the diffusion coefficients are kept in a range bounded by the background diffusion and the maximum allowable values. - do k = 1, km1 - do i=1,im - if(k >= kpbl(i)) then - bvf2 = g*bf(i,k)*ti(i,k) - ri = max(bvf2/shr2(i,k),rimin) - zk = vk*zi(i,k+1) - if(ri < 0.) then ! unstable regime - rl2 = zk*rlamun/(rlamun+zk) - dk = rl2*rl2*sqrt(shr2(i,k)) - sri = sqrt(-ri) -! dku(i,k) = xkzmo(i,k) + dk*(1+8.*(-ri)/(1+1.746*sri)) -! dkt(i,k) = xkzo(i,k) + dk*(1+8.*(-ri)/(1+1.286*sri)) - dku(i,k) = dk*(1+8.*(-ri)/(1+1.746*sri)) - dkt(i,k) = dk*(1+8.*(-ri)/(1+1.286*sri)) - else ! stable regime - rl2 = zk*rlam/(rlam+zk) -!! tem = rlam * sqrt(0.01*prsi(i,k)) -!! rl2 = zk*tem/(tem+zk) - dk = rl2*rl2*sqrt(shr2(i,k)) - tem1 = dk/(1+5.*ri)**2 -! - if(k >= kpblx(i)) then - prnum = 1.0 + 2.1*ri - prnum = min(prnum,prmax) - else - prnum = 1.0 - endif -! dku(i,k) = xkzmo(i,k) + tem1 * prnum -! dkt(i,k) = xkzo(i,k) + tem1 - dku(i,k) = tem1 * prnum - dkt(i,k) = tem1 - endif -! - dku(i,k) = min(dku(i,k),dkmax) - dku(i,k) = max(dku(i,k),xkzmo(i,k)) - dkt(i,k) = min(dkt(i,k),dkmax) - dkt(i,k) = max(dkt(i,k),xkzo(i,k)) -! - endif -! - enddo - enddo -! -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -! compute components for mass flux mixing by large thermals -!> ## If the PBL is convective, call the mass flux scheme to replace the countergradient terms. -!! If the PBL is convective, the updraft properties are initialized to be the same as the state variables and the subroutine mfpbl is called. - do k = 1, km - do i = 1, im - if(pcnvflg(i)) then - tcko(i,k) = t1(i,k) - ucko(i,k) = u1(i,k) - vcko(i,k) = v1(i,k) - xmf(i,k) = 0. - endif - enddo - enddo - do kk = 1, ntrac - do k = 1, km - do i = 1, im - if(pcnvflg(i)) then - qcko(i,k,kk) = q1(i,k,kk) - endif - enddo - enddo - enddo -!> For details of the mfpbl subroutine, step into its documentation ::mfpbl - call mfpbl(im,ix,km,ntrac,dt2,pcnvflg, - & zl,zi,thvx,q1,t1,u1,v1,hpbl,kpbl, - & sflux,ustar,wstar,xmf,tcko,qcko,ucko,vcko) -! -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -! compute diffusion coefficients for cloud-top driven diffusion -! if the condition for cloud-top instability is met, -! increase entrainment flux at cloud top -! -!> ## Compute enhanced diffusion coefficients related to stratocumulus-topped PBLs -!! If a stratocumulus layer has been identified in the PBL, the diffusion coefficients in the PBL are modified in the following way. -!! -!! -# First, the criteria for CTEI is checked, using the threshold from equation 13 of Macvean and Mason (1990) \cite macvean_and_mason_1990. If the criteria is met, the cloud top diffusion is increased: -!! \f[ -!! K_h^{Sc} = -c\frac{\Delta F_R}{\rho c_p}\frac{1}{\frac{\partial \theta_v}{\partial z}} -!! \f] -!! where the constant \f$c\f$ is set to 0.2 if the CTEI criterion is not met and 1.0 if it is. -!! -!! -# Calculate the diffusion coefficients due to stratocumulus mixing according to equation 5 in Lock et al. (2000) \cite lock_et_al_2000 for every level below the stratocumulus top using the characteristic stratocumulus velocity scale previously calculated. The diffusion coefficient for momentum is calculated assuming a constant inverse Prandtl number of 0.75. - do i = 1, im - if(scuflg(i)) then - k = krad(i) - tem = thetae(i,k) - thetae(i,k+1) - tem1 = qtx(i,k) - qtx(i,k+1) - if (tem > 0. .and. tem1 > 0.) then - cteit= cp*tem/(hvap*tem1) - if(cteit > actei) rent(i) = rentf2 - endif - endif - enddo - do i = 1, im - if(scuflg(i)) then - k = krad(i) - tem1 = max(bf(i,k),tdzmin) - ckt(i,k) = -rent(i)*radmin(i)/tem1 - cku(i,k) = ckt(i,k) - endif - enddo -! - do k = 1, kmpbl - do i=1,im - if(scuflg(i) .and. k < krad(i)) then - tem1=hrad(i)-zd(i) - tem2=zi(i,k+1)-tem1 - if(tem2 > 0.) then - ptem= tem2/zd(i) - if(ptem.ge.1.) ptem= 1. - ptem= tem2*ptem*sqrt(1.-ptem) - ckt(i,k) = radfac*vk*vrad(i)*ptem - cku(i,k) = 0.75*ckt(i,k) - ckt(i,k) = max(ckt(i,k),dkmin) - ckt(i,k) = min(ckt(i,k),dkmax) - cku(i,k) = max(cku(i,k),dkmin) - cku(i,k) = min(cku(i,k),dkmax) - endif - endif - enddo - enddo -! -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -! -!> After \f$K_h^{Sc}\f$ has been determined from the surface to the top of the stratocumulus layer, it is added to the value for the diffusion coefficient calculated previously using surface-based mixing [see equation 6 of Lock et al. (2000) \cite lock_et_al_2000 ]. - do k = 1, kmpbl - do i=1,im - if(scuflg(i)) then - dkt(i,k) = dkt(i,k)+ckt(i,k) - dku(i,k) = dku(i,k)+cku(i,k) - dkt(i,k) = min(dkt(i,k),dkmax) - dku(i,k) = min(dku(i,k),dkmax) - endif - enddo - enddo -! -! compute tridiagonal matrix elements for heat and moisture -! -!> ## Solve for the temperature and moisture tendencies due to vertical mixing. -!! The tendencies of heat, moisture, and momentum due to vertical diffusion are calculated using a two-part process. First, a solution is obtained using an implicit time-stepping scheme, then the time tendency terms are "backed out". The tridiagonal matrix elements for the implicit solution for temperature and moisture are prepared in this section, with differing algorithms depending on whether the PBL was convective (substituting the mass flux term for counter-gradient term), unstable but not convective (using the computed counter-gradient terms), or stable (no counter-gradient terms). - do i=1,im - ad(i,1) = 1. - a1(i,1) = t1(i,1) + beta(i) * heat(i) - a2(i,1) = q1(i,1,1) + beta(i) * evap(i) - enddo - - if(ntrac >= 2) then - do k = 2, ntrac - is = (k-1) * km - do i = 1, im - a2(i,1+is) = q1(i,1,k) - enddo - enddo - endif -! - do k = 1,km1 - do i = 1,im - dtodsd = dt2/del(i,k) - dtodsu = dt2/del(i,k+1) - dsig = prsl(i,k)-prsl(i,k+1) - rdz = rdzt(i,k) - tem1 = dsig * dkt(i,k) * rdz - dsdz2 = tem1 * rdz - au(i,k) = -dtodsd*dsdz2 - al(i,k) = -dtodsu*dsdz2 -! - if(pcnvflg(i) .and. k < kpbl(i)) then - tem2 = dsig * rdz - ptem = 0.5 * tem2 * xmf(i,k) - ptem1 = dtodsd * ptem - ptem2 = dtodsu * ptem - ad(i,k) = ad(i,k)-au(i,k)-ptem1 - ad(i,k+1) = 1.-al(i,k)+ptem2 - au(i,k) = au(i,k)-ptem1 - al(i,k) = al(i,k)+ptem2 - ptem = tcko(i,k) + tcko(i,k+1) - dsdzt = tem1 * gocp - a1(i,k) = a1(i,k)+dtodsd*dsdzt-ptem1*ptem - a1(i,k+1) = t1(i,k+1)-dtodsu*dsdzt+ptem2*ptem - ptem = qcko(i,k,1) + qcko(i,k+1,1) - a2(i,k) = a2(i,k) - ptem1 * ptem - a2(i,k+1) = q1(i,k+1,1) + ptem2 * ptem - elseif(ublflg(i) .and. k < kpbl(i)) then - ptem1 = dsig * dktx(i,k) * rdz - tem = 1.0 / hpbl(i) - dsdzt = tem1 * gocp - ptem1 * hgamt(i) * tem - dsdzq = - ptem1 * hgamq(i) * tem - ad(i,k) = ad(i,k)-au(i,k) - ad(i,k+1) = 1.-al(i,k) - a1(i,k) = a1(i,k)+dtodsd*dsdzt - a1(i,k+1) = t1(i,k+1)-dtodsu*dsdzt - a2(i,k) = a2(i,k)+dtodsd*dsdzq - a2(i,k+1) = q1(i,k+1,1)-dtodsu*dsdzq - else - ad(i,k) = ad(i,k)-au(i,k) - ad(i,k+1) = 1.-al(i,k) - dsdzt = tem1 * gocp - a1(i,k) = a1(i,k)+dtodsd*dsdzt - a1(i,k+1) = t1(i,k+1)-dtodsu*dsdzt - a2(i,k+1) = q1(i,k+1,1) - endif -! - enddo - enddo -! - if(ntrac >= 2) then - do kk = 2, ntrac - is = (kk-1) * km - do k = 1, km1 - do i = 1, im - if(pcnvflg(i) .and. k < kpbl(i)) then - dtodsd = dt2/del(i,k) - dtodsu = dt2/del(i,k+1) - dsig = prsl(i,k)-prsl(i,k+1) - tem = dsig * rdzt(i,k) - ptem = 0.5 * tem * xmf(i,k) - ptem1 = dtodsd * ptem - ptem2 = dtodsu * ptem - tem1 = qcko(i,k,kk) + qcko(i,k+1,kk) - a2(i,k+is) = a2(i,k+is) - ptem1*tem1 - a2(i,k+1+is)= q1(i,k+1,kk) + ptem2*tem1 - else - a2(i,k+1+is) = q1(i,k+1,kk) - endif - enddo - enddo - enddo - endif -! -! solve tridiagonal problem for heat and moisture -! -!> The tridiagonal system is solved by calling the internal ::tridin subroutine. - call tridin(im,km,ntrac,al,ad,au,a1,a2,au,a1,a2) - -! -! recover tendencies of heat and moisture -! -!> After returning with the solution, the tendencies for temperature and moisture are recovered. - do k = 1,km - do i = 1,im - ttend = (a1(i,k)-t1(i,k)) * rdt - qtend = (a2(i,k)-q1(i,k,1))*rdt - tau(i,k) = tau(i,k)+ttend - rtg(i,k,1) = rtg(i,k,1)+qtend - dtsfc(i) = dtsfc(i)+cont*del(i,k)*ttend - dqsfc(i) = dqsfc(i)+conq*del(i,k)*qtend - enddo - enddo - if(ntrac >= 2) then - do kk = 2, ntrac - is = (kk-1) * km - do k = 1, km - do i = 1, im - qtend = (a2(i,k+is)-q1(i,k,kk))*rdt - rtg(i,k,kk) = rtg(i,k,kk)+qtend - enddo - enddo - enddo - endif -! -! compute tke dissipation rate -! -!> ## Calculate heating due to TKE dissipation and add to the tendency for temperature -!! Following Han et al. (2015) \cite han_et_al_2015 , turbulence dissipation contributes to the tendency of temperature in the following way. First, turbulence dissipation is calculated by equation 17 of Han et al. (2015) \cite han_et_al_2015 for the PBL and equation 16 for the surface layer. - if(dspheat) then -! - do k = 1,km1 - do i = 1,im - diss(i,k) = dku(i,k)*shr2(i,k)-g*ti(i,k)*dkt(i,k)*bf(i,k) -! diss(i,k) = dku(i,k)*shr2(i,k) - enddo - enddo -! -! add dissipative heating at the first model layer -! -!> Next, the temperature tendency is updated following equation 14. - do i = 1,im - tem = govrth(i)*sflux(i) - tem1 = tem + stress(i)*spd1(i)/zl(i,1) - tem2 = 0.5 * (tem1+diss(i,1)) - tem2 = max(tem2, 0.) - ttend = tem2 / cp - tau(i,1) = tau(i,1)+0.5*ttend - enddo -! -! add dissipative heating above the first model layer -! - do k = 2,km1 - do i = 1,im - tem = 0.5 * (diss(i,k-1)+diss(i,k)) - tem = max(tem, 0.) - ttend = tem / cp - tau(i,k) = tau(i,k) + 0.5*ttend - enddo - enddo -! - endif -! -! compute tridiagonal matrix elements for momentum -! -!> ## Solve for the horizontal momentum tendencies and add them to the output tendency terms -!! As with the temperature and moisture tendencies, the horizontal momentum tendencies are calculated by solving tridiagonal matrices after the matrices are prepared in this section. - do i=1,im - ad(i,1) = 1.0 + beta(i) * stress(i) / spd1(i) - a1(i,1) = u1(i,1) - a2(i,1) = v1(i,1) - enddo -! - do k = 1,km1 - do i=1,im - dtodsd = dt2/del(i,k) - dtodsu = dt2/del(i,k+1) - dsig = prsl(i,k)-prsl(i,k+1) - rdz = rdzt(i,k) - tem1 = dsig*dku(i,k)*rdz - dsdz2 = tem1 * rdz - au(i,k) = -dtodsd*dsdz2 - al(i,k) = -dtodsu*dsdz2 -! - if(pcnvflg(i) .and. k < kpbl(i)) then - tem2 = dsig * rdz - ptem = 0.5 * tem2 * xmf(i,k) - ptem1 = dtodsd * ptem - ptem2 = dtodsu * ptem - ad(i,k) = ad(i,k)-au(i,k)-ptem1 - ad(i,k+1) = 1.-al(i,k)+ptem2 - au(i,k) = au(i,k)-ptem1 - al(i,k) = al(i,k)+ptem2 - ptem = ucko(i,k) + ucko(i,k+1) - a1(i,k) = a1(i,k) - ptem1 * ptem - a1(i,k+1) = u1(i,k+1) + ptem2 * ptem - ptem = vcko(i,k) + vcko(i,k+1) - a2(i,k) = a2(i,k) - ptem1 * ptem - a2(i,k+1) = v1(i,k+1) + ptem2 * ptem - else - ad(i,k) = ad(i,k)-au(i,k) - ad(i,k+1) = 1.-al(i,k) - a1(i,k+1) = u1(i,k+1) - a2(i,k+1) = v1(i,k+1) - endif -! - enddo - enddo -! -! solve tridiagonal problem for momentum -! - call tridi2(im,km,al,ad,au,a1,a2,au,a1,a2) -! -! recover tendencies of momentum -! -!> Finally, the tendencies are recovered from the tridiagonal solutions. - do k = 1,km - do i = 1,im - utend = (a1(i,k)-u1(i,k))*rdt - vtend = (a2(i,k)-v1(i,k))*rdt - du(i,k) = du(i,k) + utend - dv(i,k) = dv(i,k) + vtend - dusfc(i) = dusfc(i) + conw*del(i,k)*utend - dvsfc(i) = dvsfc(i) + conw*del(i,k)*vtend -! -! for dissipative heating for ecmwf model -! -! tem1 = 0.5*(a1(i,k)+u1(i,k)) -! tem2 = 0.5*(a2(i,k)+v1(i,k)) -! diss(i,k) = -(tem1*utend+tem2*vtend) -! diss(i,k) = max(diss(i,k),0.) -! ttend = diss(i,k) / cp -! tau(i,k) = tau(i,k) + ttend -! - enddo - enddo -! -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -! - do i = 1, im - hpbl(i) = hpblx(i) - kpbl(i) = kpblx(i) - enddo -! -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - return - end subroutine hedmf_run -!> @} -!> @} - - end module hedmf +!> \file moninedmf.f +!! Contains most of the hybrid eddy-diffusivity mass-flux scheme except for the +!! subroutine that calculates the mass flux and updraft properties. + +!> This module contains the CCPP-compliant hybrid eddy-diffusivity mass-flux +!! scheme. + module hedmf + + contains + +!> \section arg_table_hedmf_init Argument Table +!! \htmlinclude hedmf_init.html +!! + subroutine hedmf_init (moninq_fac,errmsg,errflg) + use machine, only : kind_phys + implicit none + real(kind=kind_phys), intent(in ) :: moninq_fac + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + if (moninq_fac == 0) then + errflg = 1 + write(errmsg,'(*(a))') 'Logic error: moninq_fac == 0', + & ' is incompatible with hedmf' + end if + end subroutine hedmf_init + + subroutine hedmf_finalize () + end subroutine hedmf_finalize + + +!> \defgroup HEDMF GFS Hybrid Eddy-Diffusivity Mass-Flux (HEDMF) Scheme Module +!! @{ +!! \brief This subroutine contains all of logic for the +!! Hybrid EDMF PBL scheme except for the calculation of +!! the updraft properties and mass flux. +!! +!> \section arg_table_hedmf_run Argument Table +!! \htmlinclude hedmf_run.html +!! +!! \section general_edmf GFS Hybrid EDMF General Algorithm +!! -# Compute preliminary variables from input arguments. +!! -# Calculate the first estimate of the PBL height ("Predictor step"). +!! -# Calculate Monin-Obukhov similarity parameters. +!! -# Update thermal properties of surface parcel and recompute PBL height ("Corrector step"). +!! -# Determine whether stratocumulus layers exist and compute quantities needed for enhanced diffusion. +!! -# Calculate the inverse Prandtl number. +!! -# Compute diffusion coefficients below the PBL top. +!! -# Compute diffusion coefficients above the PBL top. +!! -# If the PBL is convective, call the mass flux scheme to replace the countergradient terms. +!! -# Compute enhanced diffusion coefficients related to stratocumulus-topped PBLs. +!! -# Solve for the temperature and moisture tendencies due to vertical mixing. +!! -# Calculate heating due to TKE dissipation and add to the tendency for temperature. +!! -# Solve for the horizontal momentum tendencies and add them to output tendency terms. +!! \section detailed_hedmf GFS Hybrid HEDMF Detailed Algorithm +!! @{ + subroutine hedmf_run (ix,im,km,ntrac,ntcw,dv,du,tau,rtg, & + & u1,v1,t1,q1,swh,hlw,xmu, & + & psk,rbsoil,zorl,u10m,v10m,fm,fh, & + & tsea,heat,evap,stress,spd1,kpbl, & + & prsi,del,prsl,prslk,phii,phil,delt,dspheat, & + & dusfc,dvsfc,dtsfc,dqsfc,hpbl,hgamt,hgamq,dkt, & + & kinver,xkzm_m,xkzm_h,xkzm_s,lprnt,ipr, & + & xkzminv,moninq_fac,errmsg,errflg) +! + use machine , only : kind_phys + use funcphys , only : fpvs + use physcons, grav => con_g, rd => con_rd, cp => con_cp + &, hvap => con_hvap, fv => con_fvirt + implicit none +! +! arguments +! + logical, intent(in) :: lprnt + integer, intent(in) :: ipr + integer, intent(in) :: ix, im, km, ntrac, ntcw, kinver(im) + integer, intent(out) :: kpbl(im) + +! + real(kind=kind_phys), intent(in) :: delt, xkzm_m, xkzm_h, xkzm_s + real(kind=kind_phys), intent(in) :: xkzminv, moninq_fac + real(kind=kind_phys), intent(inout) :: dv(im,km), du(im,km), & + & tau(im,km), rtg(im,km,ntrac) + real(kind=kind_phys), intent(in) :: & + & u1(ix,km), v1(ix,km), & + & t1(ix,km), q1(ix,km,ntrac), & + & swh(ix,km), hlw(ix,km), & + & xmu(im), psk(im), & + & rbsoil(im), zorl(im), & + & u10m(im), v10m(im), & + & fm(im), fh(im), & + & tsea(im), & + & heat(im), evap(im), & + & stress(im), spd1(im) + real(kind=kind_phys), intent(in) :: & + & prsi(ix,km+1), del(ix,km), & + & prsl(ix,km), prslk(ix,km), & + & phii(ix,km+1), phil(ix,km) + real(kind=kind_phys), intent(out) :: & + & dusfc(im), dvsfc(im), & + & dtsfc(im), dqsfc(im), & + & hpbl(im), dkt(im,km-1) + real(kind=kind_phys), intent(inout) :: & + & hgamt(im), hgamq(im) +! + logical, intent(in) :: dspheat +! flag for tke dissipative heating + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + +! +! locals + + integer i,iprt,is,iun,k,kk,km1,kmpbl,latd,lond + integer lcld(im),icld(im),kcld(im),krad(im) + integer kx1(im), kpblx(im) +! +! real(kind=kind_phys) betaq(im), betat(im), betaw(im), + real(kind=kind_phys) phih(im), phim(im), hpblx(im), & + & rbdn(im), rbup(im), & + & beta(im), sflux(im), & + & z0(im), crb(im), wstar(im), & + & zol(im), ustmin(im), ustar(im), & + & thermal(im),wscale(im), wscaleu(im) +! + real(kind=kind_phys) theta(im,km),thvx(im,km), thlvx(im,km), & + & qlx(im,km), thetae(im,km), & + & qtx(im,km), bf(im,km-1), diss(im,km), & + & radx(im,km-1), & + & govrth(im), hrad(im), & +! & hradm(im), radmin(im), vrad(im), & + & radmin(im), vrad(im), & + & zd(im), zdd(im), thlvx1(im) +! + real(kind=kind_phys) rdzt(im,km-1),dktx(im,km-1), & + & zi(im,km+1), zl(im,km), xkzo(im,km-1), & + & dku(im,km-1), xkzmo(im,km-1), & + & cku(im,km-1), ckt(im,km-1), & + & ti(im,km-1), shr2(im,km-1), & + & al(im,km-1), ad(im,km), & + & au(im,km-1), a1(im,km), & + & a2(im,km*ntrac) +! + real(kind=kind_phys) tcko(im,km), qcko(im,km,ntrac), & + & ucko(im,km), vcko(im,km), xmf(im,km) +! + real(kind=kind_phys) prinv(im), rent(im) +! + logical pblflg(im), sfcflg(im), scuflg(im), flg(im) + logical ublflg(im), pcnvflg(im) +! +! pcnvflg: true for convective(strongly unstable) pbl +! ublflg: true for unstable but not convective(strongly unstable) pbl +! + real(kind=kind_phys) aphi16, aphi5, bvf2, wfac, + & cfac, conq, cont, conw, + & dk, dkmax, dkmin, + & dq1, dsdz2, dsdzq, dsdzt, + & dsdzu, dsdzv, + & dsig, dt2, dthe1, dtodsd, + & dtodsu, dw2, dw2min, g, + & gamcrq, gamcrt, gocp, + & gravi, f0, + & prnum, prmax, prmin, pfac, crbcon, + & qmin, tdzmin, qtend, crbmin,crbmax, + & rbint, rdt, rdz, qlmin, + & ri, rimin, rl2, rlam, rlamun, + & rone, rzero, sfcfrac, + & spdk2, sri, zol1, zolcr, zolcru, + & robn, ttend, + & utend, vk, vk2, + & ust3, wst3, + & vtend, zfac, vpert, cteit, + & rentf1, rentf2, radfac, + & zfmin, zk, tem, tem1, tem2, + & xkzm, xkzmu, + & ptem, ptem1, ptem2, tx1(im), tx2(im) +! + real(kind=kind_phys) zstblmax,h1, h2, qlcr, actei, + & cldtime +cc + parameter(gravi=1.0/grav) + parameter(g=grav) + parameter(gocp=g/cp) + parameter(cont=cp/g,conq=hvap/g,conw=1.0/g) ! for del in pa +! parameter(cont=1000.*cp/g,conq=1000.*hvap/g,conw=1000./g) ! for del in kpa + parameter(rlam=30.0,vk=0.4,vk2=vk*vk) + parameter(prmin=0.25,prmax=4.,zolcr=0.2,zolcru=-0.5) + parameter(dw2min=0.0001,dkmin=0.0,dkmax=1000.,rimin=-100.) + parameter(crbcon=0.25,crbmin=0.15,crbmax=0.35) + parameter(wfac=7.0,cfac=6.5,pfac=2.0,sfcfrac=0.1) +! parameter(qmin=1.e-8,xkzm=1.0,zfmin=1.e-8,aphi5=5.,aphi16=16.) + parameter(qmin=1.e-8, zfmin=1.e-8,aphi5=5.,aphi16=16.) + parameter(tdzmin=1.e-3,qlmin=1.e-12,f0=1.e-4) + parameter(h1=0.33333333,h2=0.66666667) +! parameter(cldtime=500.,xkzminv=0.3) + parameter(cldtime=500.) +! parameter(cldtime=500.,xkzmu=3.0,xkzminv=0.3) +! parameter(gamcrt=3.,gamcrq=2.e-3,rlamun=150.0) + parameter(gamcrt=3.,gamcrq=0.,rlamun=150.0) + parameter(rentf1=0.2,rentf2=1.0,radfac=0.85) + parameter(iun=84) +! +! parameter (zstblmax = 2500., qlcr=1.0e-5) +! parameter (zstblmax = 2500., qlcr=3.0e-5) +! parameter (zstblmax = 2500., qlcr=3.5e-5) +! parameter (zstblmax = 2500., qlcr=1.0e-4) + parameter (zstblmax = 2500., qlcr=3.5e-5) +! parameter (actei = 0.23) + parameter (actei = 0.7) +c +c----------------------------------------------------------------------- +c + 601 format(1x,' moninp lat lon step hour ',3i6,f6.1) + 602 format(1x,' k',' z',' t',' th', + 1 ' tvh',' q',' u',' v', + 2 ' sp') + 603 format(1x,i5,8f9.1) + 604 format(1x,' sfc',9x,f9.1,18x,f9.1) + 605 format(1x,' k zl spd2 thekv the1v' + 1 ,' thermal rbup') + 606 format(1x,i5,6f8.2) + 607 format(1x,' kpbl hpbl fm fh hgamt', + 1 ' hgamq ws ustar cd ch') + 608 format(1x,i5,9f8.2) + 609 format(1x,' k pr dkt dku ',i5,3f8.2) + 610 format(1x,' k pr dkt dku ',i5,3f8.2,' l2 ri t2', + 1 ' sr2 ',2f8.2,2e10.2) +! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + +!> ## Compute preliminary variables from input arguments + +! compute preliminary variables +! + if (ix .lt. im) stop +! +! iprt = 0 +! if(iprt.eq.1) then +!cc latd = 0 +! lond = 0 +! else +!cc latd = 0 +! lond = 0 +! endif +! + dt2 = delt + rdt = 1. / dt2 + km1 = km - 1 + kmpbl = km / 2 +!> - Compute physical height of the layer centers and interfaces from the geopotential height (zi and zl) + do k=1,km + do i=1,im + zi(i,k) = phii(i,k) * gravi + zl(i,k) = phil(i,k) * gravi + enddo + enddo + do i=1,im + zi(i,km+1) = phii(i,km+1) * gravi + enddo +!> - Compute reciprocal of \f$ \Delta z \f$ (rdzt) + do k = 1,km1 + do i=1,im + rdzt(i,k) = 1.0 / (zl(i,k+1) - zl(i,k)) + enddo + enddo +!> - Compute reciprocal of pressure (tx1, tx2) + do i=1,im + kx1(i) = 1 + tx1(i) = 1.0 / prsi(i,1) + tx2(i) = tx1(i) + enddo +!> - Compute background vertical diffusivities for scalars and momentum (xkzo and xkzmo) + do k = 1,km1 + do i=1,im + xkzo(i,k) = 0.0 + xkzmo(i,k) = 0.0 + if (k < kinver(i)) then +! vertical background diffusivity + ptem = prsi(i,k+1) * tx1(i) + tem1 = 1.0 - ptem + tem1 = tem1 * tem1 * 10.0 + xkzo(i,k) = xkzm_h * min(1.0, exp(-tem1)) + +! vertical background diffusivity for momentum + if (ptem >= xkzm_s) then + xkzmo(i,k) = xkzm_m + kx1(i) = k + 1 + else + if (k == kx1(i) .and. k > 1) tx2(i) = 1.0 / prsi(i,k) + tem1 = 1.0 - prsi(i,k+1) * tx2(i) + tem1 = tem1 * tem1 * 5.0 + xkzmo(i,k) = xkzm_m * min(1.0, exp(-tem1)) + endif + endif + enddo + enddo +! if (lprnt) then +! print *,' xkzo=',(xkzo(ipr,k),k=1,km1) +! print *,' xkzmo=',(xkzmo(ipr,k),k=1,km1) +! endif +! +! diffusivity in the inversion layer is set to be xkzminv (m^2/s) +!> - The background scalar vertical diffusivity is limited to be less than or equal to xkzminv + do k = 1,kmpbl + do i=1,im +! if(zi(i,k+1) > 200..and.zi(i,k+1) < zstblmax) then + if(zi(i,k+1) > 250.) then + tem1 = (t1(i,k+1)-t1(i,k)) * rdzt(i,k) + if(tem1 > 1.e-5) then + xkzo(i,k) = min(xkzo(i,k),xkzminv) + endif + endif + enddo + enddo +!> - Some output variables and logical flags are initialized + do i = 1,im + z0(i) = 0.01 * zorl(i) + dusfc(i) = 0. + dvsfc(i) = 0. + dtsfc(i) = 0. + dqsfc(i) = 0. + wscale(i)= 0. + wscaleu(i)= 0. + kpbl(i) = 1 + hpbl(i) = zi(i,1) + hpblx(i) = zi(i,1) + pblflg(i)= .true. + sfcflg(i)= .true. + if(rbsoil(i) > 0.) sfcflg(i) = .false. + ublflg(i)= .false. + pcnvflg(i)= .false. + scuflg(i)= .true. + if(scuflg(i)) then + radmin(i)= 0. + rent(i) = rentf1 + hrad(i) = zi(i,1) +! hradm(i) = zi(i,1) + krad(i) = 1 + icld(i) = 0 + lcld(i) = km1 + kcld(i) = km1 + zd(i) = 0. + endif + enddo +!> - Compute \f$\theta\f$ (theta), \f$q_l\f$ (qlx), \f$q_t\f$ (qtx), \f$\theta_e\f$ (thetae), \f$\theta_v\f$ (thvx), \f$\theta_{l,v}\f$ (thlvx) + do k = 1,km + do i = 1,im + theta(i,k) = t1(i,k) * psk(i) / prslk(i,k) + qlx(i,k) = max(q1(i,k,ntcw),qlmin) + qtx(i,k) = max(q1(i,k,1),qmin)+qlx(i,k) + ptem = qlx(i,k) + ptem1 = hvap*max(q1(i,k,1),qmin)/(cp*t1(i,k)) + thetae(i,k)= theta(i,k)*(1.+ptem1) + thvx(i,k) = theta(i,k)*(1.+fv*max(q1(i,k,1),qmin)-ptem) + ptem2 = theta(i,k)-(hvap/cp)*ptem + thlvx(i,k) = ptem2*(1.+fv*qtx(i,k)) + enddo + enddo +!> - Initialize diffusion coefficients to 0 and calculate the total radiative heating rate (dku, dkt, radx) + do k = 1,km1 + do i = 1,im + dku(i,k) = 0. + dkt(i,k) = 0. + dktx(i,k) = 0. + cku(i,k) = 0. + ckt(i,k) = 0. + tem = zi(i,k+1)-zi(i,k) + radx(i,k) = tem*(swh(i,k)*xmu(i)+hlw(i,k)) + enddo + enddo +!> - Set lcld to first index above 2.5km + do i=1,im + flg(i) = scuflg(i) + enddo + do k = 1, km1 + do i=1,im + if(flg(i).and.zl(i,k) >= zstblmax) then + lcld(i)=k + flg(i)=.false. + endif + enddo + enddo +! +! compute virtual potential temp gradient (bf) and winshear square +!> - Compute \f$\frac{\partial \theta_v}{\partial z}\f$ (bf) and the wind shear squared (shr2) + do k = 1, km1 + do i = 1, im + rdz = rdzt(i,k) + bf(i,k) = (thvx(i,k+1)-thvx(i,k))*rdz + ti(i,k) = 2./(t1(i,k)+t1(i,k+1)) + dw2 = (u1(i,k)-u1(i,k+1))**2 + & + (v1(i,k)-v1(i,k+1))**2 + shr2(i,k) = max(dw2,dw2min)*rdz*rdz + enddo + enddo +!> - Calculate \f$\frac{g}{\theta}\f$ (govrth), \f$\beta = \frac{\Delta t}{\Delta z}\f$ (beta), \f$u_*\f$ (ustar), total surface flux (sflux), and set pblflag to false if the total surface energy flux is into the surface + do i = 1,im + govrth(i) = g/theta(i,1) + enddo +! + do i=1,im + beta(i) = dt2 / (zi(i,2)-zi(i,1)) + enddo +! + do i=1,im + ustar(i) = sqrt(stress(i)) + enddo +! + do i = 1,im + sflux(i) = heat(i) + evap(i)*fv*theta(i,1) + if(.not.sfcflg(i) .or. sflux(i) <= 0.) pblflg(i)=.false. + enddo +!> ## Calculate the first estimate of the PBL height ("Predictor step") +!! The calculation of the boundary layer height follows Troen and Mahrt (1986) \cite troen_and_mahrt_1986 section 3. The approach is to find the level in the column where a modified bulk Richardson number exceeds a critical value. +!! +!! The temperature of the thermal is of primary importance. For the initial estimate of the PBL height, the thermal is assumed to have one of two temperatures. If the boundary layer is stable, the thermal is assumed to have a temperature equal to the surface virtual temperature. Otherwise, the thermal is assumed to have the same virtual potential temperature as the lowest model level. For the stable case, the critical bulk Richardson number becomes a function of the wind speed and roughness length, otherwise it is set to a tunable constant. +! compute the pbl height +! + do i=1,im + flg(i) = .false. + rbup(i) = rbsoil(i) +! + if(pblflg(i)) then + thermal(i) = thvx(i,1) + crb(i) = crbcon + else + thermal(i) = tsea(i)*(1.+fv*max(q1(i,1,1),qmin)) + tem = sqrt(u10m(i)**2+v10m(i)**2) + tem = max(tem, 1.) + robn = tem / (f0 * z0(i)) + tem1 = 1.e-7 * robn + crb(i) = 0.16 * (tem1 ** (-0.18)) + crb(i) = max(min(crb(i), crbmax), crbmin) + endif + enddo +!> Given the thermal's properties and the critical Richardson number, a loop is executed to find the first level above the surface where the modified Richardson number is greater than the critical Richardson number, using equation 10a from Troen and Mahrt (1986) \cite troen_and_mahrt_1986 (also equation 8 from Hong and Pan (1996) \cite hong_and_pan_1996): +!! \f[ +!! h = Ri\frac{T_0\left|\vec{v}(h)\right|^2}{g\left(\theta_v(h) - \theta_s\right)} +!! \f] +!! where \f$h\f$ is the PBL height, \f$Ri\f$ is the Richardson number, \f$T_0\f$ is the virtual potential temperature near the surface, \f$\left|\vec{v}\right|\f$ is the wind speed, and \f$\theta_s\f$ is for the thermal. Rearranging this equation to calculate the modified Richardson number at each level, k, for comparison with the critical value yields: +!! \f[ +!! Ri_k = gz(k)\frac{\left(\theta_v(k) - \theta_s\right)}{\theta_v(1)*\vec{v}(k)} +!! \f] + do k = 1, kmpbl + do i = 1, im + if(.not.flg(i)) then + rbdn(i) = rbup(i) + spdk2 = max((u1(i,k)**2+v1(i,k)**2),1.) + rbup(i) = (thvx(i,k)-thermal(i))* + & (g*zl(i,k)/thvx(i,1))/spdk2 + kpbl(i) = k + flg(i) = rbup(i) > crb(i) + endif + enddo + enddo +!> Once the level is found, some linear interpolation is performed to find the exact height of the boundary layer top (where \f$Ri = Ri_{cr}\f$) and the PBL height and the PBL top index are saved (hpblx and kpblx, respectively) + do i = 1,im + if(kpbl(i) > 1) then + k = kpbl(i) + if(rbdn(i) >= crb(i)) then + rbint = 0. + elseif(rbup(i) <= crb(i)) then + rbint = 1. + else + rbint = (crb(i)-rbdn(i))/(rbup(i)-rbdn(i)) + endif + hpbl(i) = zl(i,k-1) + rbint*(zl(i,k)-zl(i,k-1)) + if(hpbl(i) < zi(i,kpbl(i))) kpbl(i) = kpbl(i) - 1 + else + hpbl(i) = zl(i,1) + kpbl(i) = 1 + endif + kpblx(i) = kpbl(i) + hpblx(i) = hpbl(i) + enddo +! +! compute similarity parameters +!> ## Calculate Monin-Obukhov similarity parameters +!! Using the initial guess for the PBL height, Monin-Obukhov similarity parameters are calculated. They are needed to refine the PBL height calculation and for calculating diffusion coefficients. +!! +!! First, calculate the Monin-Obukhov nondimensional stability parameter, commonly referred to as \f$\zeta\f$ using the following equation from Businger et al. (1971) \cite businger_et_al_1971 (equation 28): +!! \f[ +!! \zeta = Ri_{sfc}\frac{F_m^2}{F_h} = \frac{z}{L} +!! \f] +!! where \f$F_m\f$ and \f$F_h\f$ are surface Monin-Obukhov stability functions calculated in sfc_diff.f and \f$L\f$ is the Obukhov length. Then, the nondimensional gradients of momentum and temperature (phim and phih) are calculated using equations 5 and 6 from Hong and Pan (1996) \cite hong_and_pan_1996 depending on the surface layer stability. Then, the velocity scale valid for the surface layer (\f$w_s\f$, wscale) is calculated using equation 3 from Hong and Pan (1996) \cite hong_and_pan_1996. For the neutral and unstable PBL above the surface layer, the convective velocity scale, \f$w_*\f$, is calculated according to: +!! \f[ +!! w_* = \left(\frac{g}{\theta_0}h\overline{w'\theta_0'}\right)^{1/3} +!! \f] +!! and the mixed layer velocity scale is then calculated with equation 6 from Troen and Mahrt (1986) \cite troen_and_mahrt_1986 +!! \f[ +!! w_s = (u_*^3 + 7\epsilon k w_*^3)^{1/3} +!! \f] + do i=1,im + zol(i) = max(rbsoil(i)*fm(i)*fm(i)/fh(i),rimin) + if(sfcflg(i)) then + zol(i) = min(zol(i),-zfmin) + else + zol(i) = max(zol(i),zfmin) + endif + zol1 = zol(i)*sfcfrac*hpbl(i)/zl(i,1) + if(sfcflg(i)) then +! phim(i) = (1.-aphi16*zol1)**(-1./4.) +! phih(i) = (1.-aphi16*zol1)**(-1./2.) + tem = 1.0 / (1. - aphi16*zol1) + phih(i) = sqrt(tem) + phim(i) = sqrt(phih(i)) + else + phim(i) = 1. + aphi5*zol1 + phih(i) = phim(i) + endif + wscale(i) = ustar(i)/phim(i) + ustmin(i) = ustar(i)/aphi5 + wscale(i) = max(wscale(i),ustmin(i)) + enddo + do i=1,im + if(pblflg(i)) then + if(zol(i) < zolcru .and. kpbl(i) > 1) then + pcnvflg(i) = .true. + else + ublflg(i) = .true. + endif + wst3 = govrth(i)*sflux(i)*hpbl(i) + wstar(i)= wst3**h1 + ust3 = ustar(i)**3. + wscaleu(i) = (ust3+wfac*vk*wst3*sfcfrac)**h1 + wscaleu(i) = max(wscaleu(i),ustmin(i)) + endif + enddo +! +! compute counter-gradient mixing term for heat and moisture +!> ## Update thermal properties of surface parcel and recompute PBL height ("Corrector step"). +!! Next, the counter-gradient terms for temperature and humidity are calculated using equation 4 of Hong and Pan (1996) \cite hong_and_pan_1996 and are used to calculate the "scaled virtual temperature excess near the surface" (equation 9 in Hong and Pan (1996) \cite hong_and_pan_1996) so that the properties of the thermal are updated to recalculate the PBL height. + do i = 1,im + if(ublflg(i)) then + hgamt(i) = min(cfac*heat(i)/wscaleu(i),gamcrt) + hgamq(i) = min(cfac*evap(i)/wscaleu(i),gamcrq) + vpert = hgamt(i) + hgamq(i)*fv*theta(i,1) + vpert = min(vpert,gamcrt) + thermal(i)= thermal(i)+max(vpert,0.) + hgamt(i) = max(hgamt(i),0.0) + hgamq(i) = max(hgamq(i),0.0) + endif + enddo +! +! enhance the pbl height by considering the thermal excess +!> The PBL height calculation follows the same procedure as the predictor step, except that it uses an updated virtual potential temperature for the thermal. + do i=1,im + flg(i) = .true. + if(ublflg(i)) then + flg(i) = .false. + rbup(i) = rbsoil(i) + endif + enddo + do k = 2, kmpbl + do i = 1, im + if(.not.flg(i)) then + rbdn(i) = rbup(i) + spdk2 = max((u1(i,k)**2+v1(i,k)**2),1.) + rbup(i) = (thvx(i,k)-thermal(i))* + & (g*zl(i,k)/thvx(i,1))/spdk2 + kpbl(i) = k + flg(i) = rbup(i) > crb(i) + endif + enddo + enddo + do i = 1,im + if(ublflg(i)) then + k = kpbl(i) + if(rbdn(i) >= crb(i)) then + rbint = 0. + elseif(rbup(i) <= crb(i)) then + rbint = 1. + else + rbint = (crb(i)-rbdn(i))/(rbup(i)-rbdn(i)) + endif + hpbl(i) = zl(i,k-1) + rbint*(zl(i,k)-zl(i,k-1)) + if(hpbl(i) < zi(i,kpbl(i))) kpbl(i) = kpbl(i) - 1 + if(kpbl(i) <= 1) then + ublflg(i) = .false. + pblflg(i) = .false. + endif + endif + enddo +! +! look for stratocumulus +!> ## Determine whether stratocumulus layers exist and compute quantities needed for enhanced diffusion +!! - Starting at the PBL top and going downward, if the level is less than 2.5 km and \f$q_l>q_{l,cr}\f$ then set kcld = k (find the cloud top index in the PBL). If no cloud water above the threshold is found, scuflg is set to F. + do i = 1, im + flg(i)=scuflg(i) + enddo + do k = kmpbl,1,-1 + do i = 1, im + if(flg(i) .and. k <= lcld(i)) then + if(qlx(i,k).ge.qlcr) then + kcld(i)=k + flg(i)=.false. + endif + endif + enddo + enddo + do i = 1, im + if(scuflg(i) .and. kcld(i)==km1) scuflg(i)=.false. + enddo +!> - Starting at the PBL top and going downward, if the level is less than the cloud top, find the level of the minimum radiative heating rate within the cloud. If the level of the minimum is the lowest model level or the minimum radiative heating rate is positive, then set scuflg to F. + do i = 1, im + flg(i)=scuflg(i) + enddo + do k = kmpbl,1,-1 + do i = 1, im + if(flg(i) .and. k <= kcld(i)) then + if(qlx(i,k) >= qlcr) then + if(radx(i,k) < radmin(i)) then + radmin(i)=radx(i,k) + krad(i)=k + endif + else + flg(i)=.false. + endif + endif + enddo + enddo + do i = 1, im + if(scuflg(i) .and. krad(i) <= 1) scuflg(i)=.false. + if(scuflg(i) .and. radmin(i)>=0.) scuflg(i)=.false. + enddo +!> - Starting at the PBL top and going downward, count the number of levels below the minimum radiative heating rate level that have cloud water above the threshold. If there are none, then set the scuflg to F. + do i = 1, im + flg(i)=scuflg(i) + enddo + do k = kmpbl,2,-1 + do i = 1, im + if(flg(i) .and. k <= krad(i)) then + if(qlx(i,k) >= qlcr) then + icld(i)=icld(i)+1 + else + flg(i)=.false. + endif + endif + enddo + enddo + do i = 1, im + if(scuflg(i) .and. icld(i) < 1) scuflg(i)=.false. + enddo +!> - Find the height of the interface where the minimum in radiative heating rate is located. If this height is less than the second model interface height, then set the scuflg to F. + do i = 1, im + if(scuflg(i)) then + hrad(i) = zi(i,krad(i)+1) +! hradm(i)= zl(i,krad(i)) + endif + enddo +! + do i = 1, im + if(scuflg(i) .and. hrad(i) - Calculate the hypothetical \f$\theta_v\f$ at the minimum radiative heating level that a parcel would reach due to radiative cooling after a typical cloud turnover time spent at that level. + do i = 1, im + if(scuflg(i)) then + k = krad(i) + tem = zi(i,k+1)-zi(i,k) + tem1 = cldtime*radmin(i)/tem + thlvx1(i) = thlvx(i,k)+tem1 +! if(thlvx1(i) > thlvx(i,k-1)) scuflg(i)=.false. + endif + enddo +!> - Determine the distance that a parcel would sink downwards starting from the level of minimum radiative heating rate by comparing the hypothetical minimum \f$\theta_v\f$ calculated above with the environmental \f$\theta_v\f$. + do i = 1, im + flg(i)=scuflg(i) + enddo + do k = kmpbl,1,-1 + do i = 1, im + if(flg(i) .and. k <= krad(i))then + if(thlvx1(i) <= thlvx(i,k))then + tem=zi(i,k+1)-zi(i,k) + zd(i)=zd(i)+tem + else + flg(i)=.false. + endif + endif + enddo + enddo +!> - Calculate the cloud thickness, where the cloud top is the in-cloud minimum radiative heating level and the bottom is determined previously. + do i = 1, im + if(scuflg(i))then + kk = max(1, krad(i)+1-icld(i)) + zdd(i) = hrad(i)-zi(i,kk) + endif + enddo +!> - Find the largest between the cloud thickness and the distance of a sinking parcel, then determine the smallest of that number and the height of the minimum in radiative heating rate. Set this number to \f$zd\f$. Using \f$zd\f$, calculate the characteristic velocity scale of cloud-top radiative cooling-driven turbulence. + do i = 1, im + if(scuflg(i))then + zd(i) = max(zd(i),zdd(i)) + zd(i) = min(zd(i),hrad(i)) + tem = govrth(i)*zd(i)*(-radmin(i)) + vrad(i)= tem**h1 + endif + enddo +! +! compute inverse prandtl number +!> ## Calculate the inverse Prandtl number +!! For an unstable PBL, the Prandtl number is calculated according to Hong and Pan (1996) \cite hong_and_pan_1996, equation 10, whereas for a stable boundary layer, the Prandtl number is simply \f$Pr = \frac{\phi_h}{\phi_m}\f$. + do i = 1, im + if(ublflg(i)) then + tem = phih(i)/phim(i)+cfac*vk*sfcfrac + else + tem = phih(i)/phim(i) + endif + prinv(i) = 1.0 / tem + prinv(i) = min(prinv(i),prmax) + prinv(i) = max(prinv(i),prmin) + enddo + do i = 1, im + if(zol(i) > zolcr) then + kpbl(i) = 1 + endif + enddo +! +! compute diffusion coefficients below pbl +!> ## Compute diffusion coefficients below the PBL top +!! Below the PBL top, the diffusion coefficients (\f$K_m\f$ and \f$K_h\f$) are calculated according to equation 2 in Hong and Pan (1996) \cite hong_and_pan_1996 where a different value for \f$w_s\f$ (PBL vertical velocity scale) is used depending on the PBL stability. \f$K_h\f$ is calculated from \f$K_m\f$ using the Prandtl number. The calculated diffusion coefficients are checked so that they are bounded by maximum values and the local background diffusion coefficients. + do k = 1, kmpbl + do i=1,im + if(k < kpbl(i)) then +! zfac = max((1.-(zi(i,k+1)-zl(i,1))/ +! 1 (hpbl(i)-zl(i,1))), zfmin) + zfac = max((1.-zi(i,k+1)/hpbl(i)), zfmin) + tem = zi(i,k+1) * (zfac**pfac) * moninq_fac ! lmh suggested by kg + if(pblflg(i)) then + tem1 = vk * wscaleu(i) * tem +! dku(i,k) = xkzmo(i,k) + tem1 +! dkt(i,k) = xkzo(i,k) + tem1 * prinv(i) + dku(i,k) = tem1 + dkt(i,k) = tem1 * prinv(i) + else + tem1 = vk * wscale(i) * tem +! dku(i,k) = xkzmo(i,k) + tem1 +! dkt(i,k) = xkzo(i,k) + tem1 * prinv(i) + dku(i,k) = tem1 + dkt(i,k) = tem1 * prinv(i) + endif + dku(i,k) = min(dku(i,k),dkmax) + dku(i,k) = max(dku(i,k),xkzmo(i,k)) + dkt(i,k) = min(dkt(i,k),dkmax) + dkt(i,k) = max(dkt(i,k),xkzo(i,k)) + dktx(i,k)= dkt(i,k) + endif + enddo + enddo +! +! compute diffusion coefficients based on local scheme above pbl +!> ## Compute diffusion coefficients above the PBL top +!! Diffusion coefficients above the PBL top are computed as a function of local stability (gradient Richardson number), shear, and a length scale from Louis (1979) \cite louis_1979 : +!! \f[ +!! K_{m,h}=l^2f_{m,h}(Ri_g)\left|\frac{\partial U}{\partial z}\right| +!! \f] +!! The functions used (\f$f_{m,h}\f$) depend on the local stability. First, the gradient Richardson number is calculated as +!! \f[ +!! Ri_g=\frac{\frac{g}{T}\frac{\partial \theta_v}{\partial z}}{\frac{\partial U}{\partial z}^2} +!! \f] +!! where \f$U\f$ is the horizontal wind. For the unstable case (\f$Ri_g < 0\f$), the Richardson number-dependent functions are given by +!! \f[ +!! f_h(Ri_g) = 1 + \frac{8\left|Ri_g\right|}{1 + 1.286\sqrt{\left|Ri_g\right|}}\\ +!! \f] +!! \f[ +!! f_m(Ri_g) = 1 + \frac{8\left|Ri_g\right|}{1 + 1.746\sqrt{\left|Ri_g\right|}}\\ +!! \f] +!! For the stable case, the following formulas are used +!! \f[ +!! f_h(Ri_g) = \frac{1}{\left(1 + 5Ri_g\right)^2}\\ +!! \f] +!! \f[ +!! Pr = \frac{K_h}{K_m} = 1 + 2.1Ri_g +!! \f] +!! The source for the formulas used for the Richardson number-dependent functions is unclear. They are different than those used in Hong and Pan (1996) \cite hong_and_pan_1996 as the previous documentation suggests. They follow equation 14 of Louis (1979) \cite louis_1979 for the unstable case, but it is unclear where the values of the coefficients \f$b\f$ and \f$c\f$ from that equation used in this scheme originate. Finally, the length scale, \f$l\f$ is calculated according to the following formula from Hong and Pan (1996) \cite hong_and_pan_1996 +!! \f[ +!! \frac{1}{l} = \frac{1}{kz} + \frac{1}{l_0}\\ +!! \f] +!! \f[ +!! or\\ +!! \f] +!! \f[ +!! l=\frac{l_0kz}{l_0+kz} +!! \f] +!! where \f$l_0\f$ is currently 30 m for stable conditions and 150 m for unstable. Finally, the diffusion coefficients are kept in a range bounded by the background diffusion and the maximum allowable values. + do k = 1, km1 + do i=1,im + if(k >= kpbl(i)) then + bvf2 = g*bf(i,k)*ti(i,k) + ri = max(bvf2/shr2(i,k),rimin) + zk = vk*zi(i,k+1) + if(ri < 0.) then ! unstable regime + rl2 = zk*rlamun/(rlamun+zk) + dk = rl2*rl2*sqrt(shr2(i,k)) + sri = sqrt(-ri) +! dku(i,k) = xkzmo(i,k) + dk*(1+8.*(-ri)/(1+1.746*sri)) +! dkt(i,k) = xkzo(i,k) + dk*(1+8.*(-ri)/(1+1.286*sri)) + dku(i,k) = dk*(1+8.*(-ri)/(1+1.746*sri)) + dkt(i,k) = dk*(1+8.*(-ri)/(1+1.286*sri)) + else ! stable regime + rl2 = zk*rlam/(rlam+zk) +!! tem = rlam * sqrt(0.01*prsi(i,k)) +!! rl2 = zk*tem/(tem+zk) + dk = rl2*rl2*sqrt(shr2(i,k)) + tem1 = dk/(1+5.*ri)**2 +! + if(k >= kpblx(i)) then + prnum = 1.0 + 2.1*ri + prnum = min(prnum,prmax) + else + prnum = 1.0 + endif +! dku(i,k) = xkzmo(i,k) + tem1 * prnum +! dkt(i,k) = xkzo(i,k) + tem1 + dku(i,k) = tem1 * prnum + dkt(i,k) = tem1 + endif +! + dku(i,k) = min(dku(i,k),dkmax) + dku(i,k) = max(dku(i,k),xkzmo(i,k)) + dkt(i,k) = min(dkt(i,k),dkmax) + dkt(i,k) = max(dkt(i,k),xkzo(i,k)) +! + endif +! + enddo + enddo +! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! compute components for mass flux mixing by large thermals +!> ## If the PBL is convective, call the mass flux scheme to replace the countergradient terms. +!! If the PBL is convective, the updraft properties are initialized to be the same as the state variables and the subroutine mfpbl is called. + do k = 1, km + do i = 1, im + if(pcnvflg(i)) then + tcko(i,k) = t1(i,k) + ucko(i,k) = u1(i,k) + vcko(i,k) = v1(i,k) + xmf(i,k) = 0. + endif + enddo + enddo + do kk = 1, ntrac + do k = 1, km + do i = 1, im + if(pcnvflg(i)) then + qcko(i,k,kk) = q1(i,k,kk) + endif + enddo + enddo + enddo +!> For details of the mfpbl subroutine, step into its documentation ::mfpbl + call mfpbl(im,ix,km,ntrac,dt2,pcnvflg, + & zl,zi,thvx,q1,t1,u1,v1,hpbl,kpbl, + & sflux,ustar,wstar,xmf,tcko,qcko,ucko,vcko) +! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! compute diffusion coefficients for cloud-top driven diffusion +! if the condition for cloud-top instability is met, +! increase entrainment flux at cloud top +! +!> ## Compute enhanced diffusion coefficients related to stratocumulus-topped PBLs +!! If a stratocumulus layer has been identified in the PBL, the diffusion coefficients in the PBL are modified in the following way. +!! +!! -# First, the criteria for CTEI is checked, using the threshold from equation 13 of Macvean and Mason (1990) \cite macvean_and_mason_1990. If the criteria is met, the cloud top diffusion is increased: +!! \f[ +!! K_h^{Sc} = -c\frac{\Delta F_R}{\rho c_p}\frac{1}{\frac{\partial \theta_v}{\partial z}} +!! \f] +!! where the constant \f$c\f$ is set to 0.2 if the CTEI criterion is not met and 1.0 if it is. +!! +!! -# Calculate the diffusion coefficients due to stratocumulus mixing according to equation 5 in Lock et al. (2000) \cite lock_et_al_2000 for every level below the stratocumulus top using the characteristic stratocumulus velocity scale previously calculated. The diffusion coefficient for momentum is calculated assuming a constant inverse Prandtl number of 0.75. + do i = 1, im + if(scuflg(i)) then + k = krad(i) + tem = thetae(i,k) - thetae(i,k+1) + tem1 = qtx(i,k) - qtx(i,k+1) + if (tem > 0. .and. tem1 > 0.) then + cteit= cp*tem/(hvap*tem1) + if(cteit > actei) rent(i) = rentf2 + endif + endif + enddo + do i = 1, im + if(scuflg(i)) then + k = krad(i) + tem1 = max(bf(i,k),tdzmin) + ckt(i,k) = -rent(i)*radmin(i)/tem1 + cku(i,k) = ckt(i,k) + endif + enddo +! + do k = 1, kmpbl + do i=1,im + if(scuflg(i) .and. k < krad(i)) then + tem1=hrad(i)-zd(i) + tem2=zi(i,k+1)-tem1 + if(tem2 > 0.) then + ptem= tem2/zd(i) + if(ptem.ge.1.) ptem= 1. + ptem= tem2*ptem*sqrt(1.-ptem) + ckt(i,k) = radfac*vk*vrad(i)*ptem + cku(i,k) = 0.75*ckt(i,k) + ckt(i,k) = max(ckt(i,k),dkmin) + ckt(i,k) = min(ckt(i,k),dkmax) + cku(i,k) = max(cku(i,k),dkmin) + cku(i,k) = min(cku(i,k),dkmax) + endif + endif + enddo + enddo +! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! +!> After \f$K_h^{Sc}\f$ has been determined from the surface to the top of the stratocumulus layer, it is added to the value for the diffusion coefficient calculated previously using surface-based mixing [see equation 6 of Lock et al. (2000) \cite lock_et_al_2000 ]. + do k = 1, kmpbl + do i=1,im + if(scuflg(i)) then + dkt(i,k) = dkt(i,k)+ckt(i,k) + dku(i,k) = dku(i,k)+cku(i,k) + dkt(i,k) = min(dkt(i,k),dkmax) + dku(i,k) = min(dku(i,k),dkmax) + endif + enddo + enddo +! +! compute tridiagonal matrix elements for heat and moisture +! +!> ## Solve for the temperature and moisture tendencies due to vertical mixing. +!! The tendencies of heat, moisture, and momentum due to vertical diffusion are calculated using a two-part process. First, a solution is obtained using an implicit time-stepping scheme, then the time tendency terms are "backed out". The tridiagonal matrix elements for the implicit solution for temperature and moisture are prepared in this section, with differing algorithms depending on whether the PBL was convective (substituting the mass flux term for counter-gradient term), unstable but not convective (using the computed counter-gradient terms), or stable (no counter-gradient terms). + do i=1,im + ad(i,1) = 1. + a1(i,1) = t1(i,1) + beta(i) * heat(i) + a2(i,1) = q1(i,1,1) + beta(i) * evap(i) + enddo + + if(ntrac >= 2) then + do k = 2, ntrac + is = (k-1) * km + do i = 1, im + a2(i,1+is) = q1(i,1,k) + enddo + enddo + endif +! + do k = 1,km1 + do i = 1,im + dtodsd = dt2/del(i,k) + dtodsu = dt2/del(i,k+1) + dsig = prsl(i,k)-prsl(i,k+1) + rdz = rdzt(i,k) + tem1 = dsig * dkt(i,k) * rdz + dsdz2 = tem1 * rdz + au(i,k) = -dtodsd*dsdz2 + al(i,k) = -dtodsu*dsdz2 +! + if(pcnvflg(i) .and. k < kpbl(i)) then + tem2 = dsig * rdz + ptem = 0.5 * tem2 * xmf(i,k) + ptem1 = dtodsd * ptem + ptem2 = dtodsu * ptem + ad(i,k) = ad(i,k)-au(i,k)-ptem1 + ad(i,k+1) = 1.-al(i,k)+ptem2 + au(i,k) = au(i,k)-ptem1 + al(i,k) = al(i,k)+ptem2 + ptem = tcko(i,k) + tcko(i,k+1) + dsdzt = tem1 * gocp + a1(i,k) = a1(i,k)+dtodsd*dsdzt-ptem1*ptem + a1(i,k+1) = t1(i,k+1)-dtodsu*dsdzt+ptem2*ptem + ptem = qcko(i,k,1) + qcko(i,k+1,1) + a2(i,k) = a2(i,k) - ptem1 * ptem + a2(i,k+1) = q1(i,k+1,1) + ptem2 * ptem + elseif(ublflg(i) .and. k < kpbl(i)) then + ptem1 = dsig * dktx(i,k) * rdz + tem = 1.0 / hpbl(i) + dsdzt = tem1 * gocp - ptem1 * hgamt(i) * tem + dsdzq = - ptem1 * hgamq(i) * tem + ad(i,k) = ad(i,k)-au(i,k) + ad(i,k+1) = 1.-al(i,k) + a1(i,k) = a1(i,k)+dtodsd*dsdzt + a1(i,k+1) = t1(i,k+1)-dtodsu*dsdzt + a2(i,k) = a2(i,k)+dtodsd*dsdzq + a2(i,k+1) = q1(i,k+1,1)-dtodsu*dsdzq + else + ad(i,k) = ad(i,k)-au(i,k) + ad(i,k+1) = 1.-al(i,k) + dsdzt = tem1 * gocp + a1(i,k) = a1(i,k)+dtodsd*dsdzt + a1(i,k+1) = t1(i,k+1)-dtodsu*dsdzt + a2(i,k+1) = q1(i,k+1,1) + endif +! + enddo + enddo +! + if(ntrac >= 2) then + do kk = 2, ntrac + is = (kk-1) * km + do k = 1, km1 + do i = 1, im + if(pcnvflg(i) .and. k < kpbl(i)) then + dtodsd = dt2/del(i,k) + dtodsu = dt2/del(i,k+1) + dsig = prsl(i,k)-prsl(i,k+1) + tem = dsig * rdzt(i,k) + ptem = 0.5 * tem * xmf(i,k) + ptem1 = dtodsd * ptem + ptem2 = dtodsu * ptem + tem1 = qcko(i,k,kk) + qcko(i,k+1,kk) + a2(i,k+is) = a2(i,k+is) - ptem1*tem1 + a2(i,k+1+is)= q1(i,k+1,kk) + ptem2*tem1 + else + a2(i,k+1+is) = q1(i,k+1,kk) + endif + enddo + enddo + enddo + endif +! +! solve tridiagonal problem for heat and moisture +! +!> The tridiagonal system is solved by calling the internal ::tridin subroutine. + call tridin(im,km,ntrac,al,ad,au,a1,a2,au,a1,a2) + +! +! recover tendencies of heat and moisture +! +!> After returning with the solution, the tendencies for temperature and moisture are recovered. + do k = 1,km + do i = 1,im + ttend = (a1(i,k)-t1(i,k)) * rdt + qtend = (a2(i,k)-q1(i,k,1))*rdt + tau(i,k) = tau(i,k)+ttend + rtg(i,k,1) = rtg(i,k,1)+qtend + dtsfc(i) = dtsfc(i)+cont*del(i,k)*ttend + dqsfc(i) = dqsfc(i)+conq*del(i,k)*qtend + enddo + enddo + if(ntrac >= 2) then + do kk = 2, ntrac + is = (kk-1) * km + do k = 1, km + do i = 1, im + qtend = (a2(i,k+is)-q1(i,k,kk))*rdt + rtg(i,k,kk) = rtg(i,k,kk)+qtend + enddo + enddo + enddo + endif +! +! compute tke dissipation rate +! +!> ## Calculate heating due to TKE dissipation and add to the tendency for temperature +!! Following Han et al. (2016) \cite Han_2016 , turbulence dissipation contributes to the tendency of temperature in the following way. First, turbulence dissipation is calculated by equation 17 of Han et al. (2016) \cite Han_2016 for the PBL and equation 16 for the surface layer. + if(dspheat) then +! + do k = 1,km1 + do i = 1,im + diss(i,k) = dku(i,k)*shr2(i,k)-g*ti(i,k)*dkt(i,k)*bf(i,k) +! diss(i,k) = dku(i,k)*shr2(i,k) + enddo + enddo +! +! add dissipative heating at the first model layer +! +!> Next, the temperature tendency is updated following equation 14. + do i = 1,im + tem = govrth(i)*sflux(i) + tem1 = tem + stress(i)*spd1(i)/zl(i,1) + tem2 = 0.5 * (tem1+diss(i,1)) + tem2 = max(tem2, 0.) + ttend = tem2 / cp + tau(i,1) = tau(i,1)+0.5*ttend + enddo +! +! add dissipative heating above the first model layer +! + do k = 2,km1 + do i = 1,im + tem = 0.5 * (diss(i,k-1)+diss(i,k)) + tem = max(tem, 0.) + ttend = tem / cp + tau(i,k) = tau(i,k) + 0.5*ttend + enddo + enddo +! + endif +! +! compute tridiagonal matrix elements for momentum +! +!> ## Solve for the horizontal momentum tendencies and add them to the output tendency terms +!! As with the temperature and moisture tendencies, the horizontal momentum tendencies are calculated by solving tridiagonal matrices after the matrices are prepared in this section. + do i=1,im + ad(i,1) = 1.0 + beta(i) * stress(i) / spd1(i) + a1(i,1) = u1(i,1) + a2(i,1) = v1(i,1) + enddo +! + do k = 1,km1 + do i=1,im + dtodsd = dt2/del(i,k) + dtodsu = dt2/del(i,k+1) + dsig = prsl(i,k)-prsl(i,k+1) + rdz = rdzt(i,k) + tem1 = dsig*dku(i,k)*rdz + dsdz2 = tem1 * rdz + au(i,k) = -dtodsd*dsdz2 + al(i,k) = -dtodsu*dsdz2 +! + if(pcnvflg(i) .and. k < kpbl(i)) then + tem2 = dsig * rdz + ptem = 0.5 * tem2 * xmf(i,k) + ptem1 = dtodsd * ptem + ptem2 = dtodsu * ptem + ad(i,k) = ad(i,k)-au(i,k)-ptem1 + ad(i,k+1) = 1.-al(i,k)+ptem2 + au(i,k) = au(i,k)-ptem1 + al(i,k) = al(i,k)+ptem2 + ptem = ucko(i,k) + ucko(i,k+1) + a1(i,k) = a1(i,k) - ptem1 * ptem + a1(i,k+1) = u1(i,k+1) + ptem2 * ptem + ptem = vcko(i,k) + vcko(i,k+1) + a2(i,k) = a2(i,k) - ptem1 * ptem + a2(i,k+1) = v1(i,k+1) + ptem2 * ptem + else + ad(i,k) = ad(i,k)-au(i,k) + ad(i,k+1) = 1.-al(i,k) + a1(i,k+1) = u1(i,k+1) + a2(i,k+1) = v1(i,k+1) + endif +! + enddo + enddo +! +! solve tridiagonal problem for momentum +! + call tridi2(im,km,al,ad,au,a1,a2,au,a1,a2) +! +! recover tendencies of momentum +! +!> Finally, the tendencies are recovered from the tridiagonal solutions. + do k = 1,km + do i = 1,im + utend = (a1(i,k)-u1(i,k))*rdt + vtend = (a2(i,k)-v1(i,k))*rdt + du(i,k) = du(i,k) + utend + dv(i,k) = dv(i,k) + vtend + dusfc(i) = dusfc(i) + conw*del(i,k)*utend + dvsfc(i) = dvsfc(i) + conw*del(i,k)*vtend +! +! for dissipative heating for ecmwf model +! +! tem1 = 0.5*(a1(i,k)+u1(i,k)) +! tem2 = 0.5*(a2(i,k)+v1(i,k)) +! diss(i,k) = -(tem1*utend+tem2*vtend) +! diss(i,k) = max(diss(i,k),0.) +! ttend = diss(i,k) / cp +! tau(i,k) = tau(i,k) + ttend +! + enddo + enddo +! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! + do i = 1, im + hpbl(i) = hpblx(i) + kpbl(i) = kpblx(i) + enddo +! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + return + end subroutine hedmf_run +!> @} +!> @} + + end module hedmf diff --git a/physics/moninedmf.meta b/physics/moninedmf.meta new file mode 100644 index 000000000..6a6ccd183 --- /dev/null +++ b/physics/moninedmf.meta @@ -0,0 +1,518 @@ +[ccpp-arg-table] + name = hedmf_init + type = scheme +[moninq_fac] + standard_name = atmosphere_diffusivity_coefficient_factor + long_name = multiplicative constant for atmospheric diffusivities + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F + +######################################################################## +[ccpp-arg-table] + name = hedmf_run + type = scheme +[ix] + standard_name = horizontal_dimension + long_name = horizontal dimension + units = count + dimensions = () + type = integer + intent = in + optional = F +[im] + standard_name = horizontal_loop_extent + long_name = horizontal loop extent + units = count + dimensions = () + type = integer + intent = in + optional = F +[km] + standard_name = vertical_dimension + long_name = vertical layer dimension + units = count + dimensions = () + type = integer + intent = in + optional = F +[ntrac] + standard_name = number_of_vertical_diffusion_tracers + long_name = number of tracers to diffuse vertically + units = count + dimensions = () + type = integer + intent = in + optional = F +[ntcw] + standard_name = index_for_liquid_cloud_condensate + long_name = cloud condensate index in tracer array + units = index + dimensions = () + type = integer + intent = in + optional = F +[dv] + standard_name = tendency_of_y_wind_due_to_model_physics + long_name = updated tendency of the y wind + units = m s-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[du] + standard_name = tendency_of_x_wind_due_to_model_physics + long_name = updated tendency of the x wind + units = m s-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[tau] + standard_name = tendency_of_air_temperature_due_to_model_physics + long_name = updated tendency of the temperature + units = K s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[rtg] + standard_name = tendency_of_vertically_diffused_tracer_concentration + long_name = updated tendency of the tracers due to vertical diffusion in PBL scheme + units = kg kg-1 s-1 + dimensions = (horizontal_dimension,vertical_dimension,number_of_vertical_diffusion_tracers) + type = real + kind = kind_phys + intent = inout + optional = F +[u1] + standard_name = x_wind + long_name = x component of layer wind + units = m s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[v1] + standard_name = y_wind + long_name = y component of layer wind + units = m s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[t1] + standard_name = air_temperature + long_name = layer mean air temperature + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[q1] + standard_name = vertically_diffused_tracer_concentration + long_name = tracer concentration diffused by PBL scheme + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension,number_of_vertical_diffusion_tracers) + type = real + kind = kind_phys + intent = in + optional = F +[swh] + standard_name = tendency_of_air_temperature_due_to_shortwave_heating_on_radiation_timestep + long_name = total sky shortwave heating rate + units = K s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[hlw] + standard_name = tendency_of_air_temperature_due_to_longwave_heating_on_radiation_timestep + long_name = total sky longwave heating rate + units = K s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[xmu] + standard_name = zenith_angle_temporal_adjustment_factor_for_shortwave_fluxes + long_name = zenith angle temporal adjustment factor for shortwave + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[psk] + standard_name = dimensionless_exner_function_at_lowest_model_interface + long_name = dimensionless Exner function at the surface interface + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[rbsoil] + standard_name = bulk_richardson_number_at_lowest_model_level + long_name = bulk Richardson number at the surface + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[zorl] + standard_name = surface_roughness_length + long_name = surface roughness length in cm + units = cm + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[u10m] + standard_name = x_wind_at_10m + long_name = x component of wind at 10 m + units = m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[v10m] + standard_name = y_wind_at_10m + long_name = y component of wind at 10 m + units = m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[fm] + standard_name = Monin_Obukhov_similarity_function_for_momentum + long_name = Monin-Obukhov similarity function for momentum + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[fh] + standard_name = Monin_Obukhov_similarity_function_for_heat + long_name = Monin-Obukhov similarity function for heat + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[tsea] + standard_name = surface_skin_temperature + long_name = surface skin temperature + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[heat] + standard_name = kinematic_surface_upward_sensible_heat_flux + long_name = kinematic surface upward sensible heat flux + units = K m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[evap] + standard_name = kinematic_surface_upward_latent_heat_flux + long_name = kinematic surface upward latent heat flux + units = kg kg-1 m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[stress] + standard_name = surface_wind_stress + long_name = surface wind stress + units = m2 s-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[spd1] + standard_name = wind_speed_at_lowest_model_layer + long_name = wind speed at lowest model level + units = m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[kpbl] + standard_name = vertical_index_at_top_of_atmosphere_boundary_layer + long_name = PBL top model level index + units = index + dimensions = (horizontal_dimension) + type = integer + intent = out + optional = F +[prsi] + standard_name = air_pressure_at_interface + long_name = air pressure at model layer interfaces + units = Pa + dimensions = (horizontal_dimension,vertical_dimension_plus_one) + type = real + kind = kind_phys + intent = in + optional = F +[del] + standard_name = air_pressure_difference_between_midlayers + long_name = pres(k) - pres(k+1) + units = Pa + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[prsl] + standard_name = air_pressure + long_name = mean layer pressure + units = Pa + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[prslk] + standard_name = dimensionless_exner_function_at_model_layers + long_name = Exner function at layers + units = none + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[phii] + standard_name = geopotential_at_interface + long_name = geopotential at model layer interfaces + units = m2 s-2 + dimensions = (horizontal_dimension,vertical_dimension_plus_one) + type = real + kind = kind_phys + intent = in + optional = F +[phil] + standard_name = geopotential + long_name = geopotential at model layer centers + units = m2 s-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[delt] + standard_name = time_step_for_physics + long_name = time step for physics + units = s + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[dspheat] + standard_name = flag_TKE_dissipation_heating + long_name = flag for using TKE dissipation heating + units = flag + dimensions = () + type = logical + intent = in + optional = F +[dusfc] + standard_name = instantaneous_surface_x_momentum_flux + long_name = x momentum flux + units = Pa + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[dvsfc] + standard_name = instantaneous_surface_y_momentum_flux + long_name = y momentum flux + units = Pa + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[dtsfc] + standard_name = instantaneous_surface_upward_sensible_heat_flux + long_name = surface upward sensible heat flux + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[dqsfc] + standard_name = instantaneous_surface_upward_latent_heat_flux + long_name = surface upward latent heat flux + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[hpbl] + standard_name = atmosphere_boundary_layer_thickness + long_name = PBL thickness + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[hgamt] + standard_name = countergradient_mixing_term_for_temperature + long_name = countergradient mixing term for temperature + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[hgamq] + standard_name = countergradient_mixing_term_for_water_vapor + long_name = countergradient mixing term for water vapor + units = kg kg-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[dkt] + standard_name = atmosphere_heat_diffusivity + long_name = diffusivity for heat + units = m2 s-1 + dimensions = (horizontal_dimension,vertical_dimension_minus_one) + type = real + kind = kind_phys + intent = out + optional = F +[kinver] + standard_name = index_of_highest_temperature_inversion + long_name = index of highest temperature inversion + units = index + dimensions = (horizontal_dimension) + type = integer + intent = in + optional = F +[xkzm_m] + standard_name = atmosphere_momentum_diffusivity_background + long_name = background value of momentum diffusivity + units = m2 s-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[xkzm_h] + standard_name = atmosphere_heat_diffusivity_background + long_name = background value of heat diffusivity + units = m2 s-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[xkzm_s] + standard_name = diffusivity_background_sigma_level + long_name = sigma level threshold for background diffusivity + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[lprnt] + standard_name = flag_print + long_name = flag for printing diagnostics to output + units = flag + dimensions = () + type = logical + intent = in + optional = F +[ipr] + standard_name = horizontal_index_of_printed_column + long_name = horizontal index of printed column + units = index + dimensions = () + type = integer + intent = in + optional = F +[xkzminv] + standard_name = atmosphere_heat_diffusivity_background_maximum + long_name = maximum background value of heat diffusivity + units = m2 s-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[moninq_fac] + standard_name = atmosphere_diffusivity_coefficient_factor + long_name = multiplicative constant for atmospheric diffusivities + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F diff --git a/physics/moninedmf_hafs.f b/physics/moninedmf_hafs.f new file mode 100644 index 000000000..5c6ff85a8 --- /dev/null +++ b/physics/moninedmf_hafs.f @@ -0,0 +1,1555 @@ +!> \file moninedmf_hafs.f +!! Contains most of the hybrid eddy-diffusivity mass-flux scheme except for the +!! subroutine that calculates the mass flux and updraft properties. + +!> This module contains the CCPP-compliant hybrid eddy-diffusivity mass-flux +!! scheme. + module hedmf_hafs + + contains + +!> \section arg_table_hedmf_hafs_init Argument Table +!! \htmlinclude hedmf_hafs_init.html +!! + subroutine hedmf_hafs_init (moninq_fac,errmsg,errflg) + use machine, only : kind_phys + implicit none + real(kind=kind_phys), intent(in ) :: moninq_fac + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + if (moninq_fac == 0) then + errflg = 1 + write(errmsg,'(*(a))') 'Logic error: moninq_fac == 0', & + & ' is incompatible with moninedmf_hafs' + end if + end subroutine hedmf_hafs_init + + subroutine hedmf_hafs_finalize () + end subroutine hedmf_hafs_finalize + + +!> \defgroup HEDMF GFS Hybrid Eddy-Diffusivity Mass-Flux (HEDMF) Scheme Module +!! @{ +!! \brief This subroutine contains all of logic for the +!! Hybrid EDMF PBL scheme except for the calculation of +!! the updraft properties and mass flux. +!! +!> \section arg_table_hedmf_hafs_run Argument Table +!! \htmlinclude hedmf_hafs_run.html +!! +!! \section general_edmf GFS Hybrid EDMF General Algorithm +!! -# Compute preliminary variables from input arguments. +!! -# Calculate the first estimate of the PBL height ("Predictor step"). +!! -# Calculate Monin-Obukhov similarity parameters. +!! -# Update thermal properties of surface parcel and recompute PBL height ("Corrector step"). +!! -# Determine whether stratocumulus layers exist and compute quantities needed for enhanced diffusion. +!! -# Calculate the inverse Prandtl number. +!! -# Compute diffusion coefficients below the PBL top. +!! -# Compute diffusion coefficients above the PBL top. +!! -# If the PBL is convective, call the mass flux scheme to replace the countergradient terms. +!! -# Compute enhanced diffusion coefficients related to stratocumulus-topped PBLs. +!! -# Solve for the temperature and moisture tendencies due to vertical mixing. +!! -# Calculate heating due to TKE dissipation and add to the tendency for temperature. +!! -# Solve for the horizontal momentum tendencies and add them to output tendency terms. +!! \section detailed_hedmf GFS Hybrid HEDMF Detailed Algorithm +!! @{ + subroutine hedmf_hafs_run(ix,im,km,ntrac,ntcw,dv,du,tau,rtg, & + & u1,v1,t1,q1,swh,hlw,xmu, & + & psk,rbsoil,zorl,u10m,v10m,fm,fh, & + & tsea,heat,evap,stress,spd1,kpbl, & + & prsi,del,prsl,prslk,phii,phil,delt,dspheat, & + & dusfc,dvsfc,dtsfc,dqsfc,hpbl,hgamt,hgamq,dkt, & + & kinver,xkzm_m,xkzm_h,xkzm_s,lprnt,ipr, & + & xkzminv,moninq_fac,islimsk,errmsg,errflg) +! + use machine , only : kind_phys + use funcphys , only : fpvs + use physcons, grav => con_g, rd => con_rd, cp => con_cp & + &, hvap => con_hvap, fv => con_fvirt + implicit none +! +! arguments +! + logical, intent(in) :: lprnt + integer, intent(in) :: ipr + integer, intent(in) :: ix, im, km, ntrac, ntcw, kinver(im) + integer, intent(in) :: islimsk(1:im) + integer, intent(out) :: kpbl(im) + +! + real(kind=kind_phys), intent(in) :: delt, xkzm_m, xkzm_h, xkzm_s + real(kind=kind_phys), intent(in) :: xkzminv, moninq_fac + real(kind=kind_phys), intent(inout) :: dv(im,km), du(im,km), & + & tau(im,km), rtg(im,km,ntrac) + real(kind=kind_phys), intent(in) :: & + & u1(ix,km), v1(ix,km), & + & t1(ix,km), q1(ix,km,ntrac), & + & swh(ix,km), hlw(ix,km), & + & xmu(im), psk(im), & + & rbsoil(im), zorl(im), & + & u10m(im), v10m(im), & + & fm(im), fh(im), & + & tsea(im), & + & heat(im), evap(im), & + & stress(im), spd1(im) + real(kind=kind_phys), intent(in) :: & + & prsi(ix,km+1), del(ix,km), & + & prsl(ix,km), prslk(ix,km), & + & phii(ix,km+1), phil(ix,km) + real(kind=kind_phys), intent(out) :: & + & dusfc(im), dvsfc(im), & + & dtsfc(im), dqsfc(im), & + & hpbl(im), dkt(im,km-1) + + real(kind=kind_phys), intent(inout) :: & + & hgamt(im), hgamq(im) +! + logical, intent(in) :: dspheat +! flag for tke dissipative heating + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + +! +! locals +! + integer i,iprt,is,iun,k,kk,km1,kmpbl,latd,lond + integer lcld(im),icld(im),kcld(im),krad(im) + integer kx1(im), kpblx(im) +! +! real(kind=kind_phys) betaq(im), betat(im), betaw(im), + real(kind=kind_phys) phih(im), phim(im), hpblx(im), & + & rbdn(im), rbup(im), & + & beta(im), sflux(im), & + & z0(im), crb(im), wstar(im), & + & zol(im), ustmin(im), ustar(im), & + & thermal(im),wscale(im), wscaleu(im) +! + real(kind=kind_phys) theta(im,km),thvx(im,km), thlvx(im,km), & + & qlx(im,km), thetae(im,km), & + & qtx(im,km), bf(im,km-1), diss(im,km), & + & radx(im,km-1), & + & govrth(im), hrad(im), & +! & hradm(im), radmin(im), vrad(im), & + & radmin(im), vrad(im), & + & zd(im), zdd(im), thlvx1(im) +! + real(kind=kind_phys) rdzt(im,km-1),dktx(im,km-1), & + & zi(im,km+1), zl(im,km), xkzo(im,km-1), & + & dku(im,km-1), xkzmo(im,km-1), & + & cku(im,km-1), ckt(im,km-1), & + & ti(im,km-1), shr2(im,km-1), & + & al(im,km-1), ad(im,km), & + & au(im,km-1), a1(im,km), & + & a2(im,km*ntrac) +! + real(kind=kind_phys) tcko(im,km), qcko(im,km,ntrac), & + & ucko(im,km), vcko(im,km), xmf(im,km) +! + real(kind=kind_phys) prinv(im), rent(im) +! + logical pblflg(im), sfcflg(im), scuflg(im), flg(im) + logical ublflg(im), pcnvflg(im) +! +! pcnvflg: true for convective(strongly unstable) pbl +! ublflg: true for unstable but not convective(strongly unstable) pbl +! + real(kind=kind_phys) aphi16, aphi5, bvf2, wfac, + & cfac, conq, cont, conw, + & dk, dkmax, dkmin, + & dq1, dsdz2, dsdzq, dsdzt, + & dsdzu, dsdzv, + & dsig, dt2, dthe1, dtodsd, + & dtodsu, dw2, dw2min, g, + & gamcrq, gamcrt, gocp, + & gravi, f0, + & prnum, prmax, prmin, pfac, crbcon, + & qmin, tdzmin, qtend, crbmin,crbmax, + & rbint, rdt, rdz, qlmin, + & ri, rimin, rl2, rlam, rlamun, + & rone, rzero, sfcfrac, + & spdk2, sri, zol1, zolcr, zolcru, + & robn, ttend, + & utend, vk, vk2, + & ust3, wst3, + & vtend, zfac, vpert, cteit, + & rentf1, rentf2, radfac, + & zfmin, zk, tem, tem1, tem2, + & xkzm, xkzmu, + & ptem, ptem1, ptem2, tx1(im), tx2(im) +! + real(kind=kind_phys) zstblmax,h1, h2, qlcr, actei, + & cldtime + +!! for aplha + real(kind=kind_phys) WSPM(IM,KM-1) + integer kLOC ! RGF + real :: xDKU, ALPHA ! RGF + + integer :: useshape + real :: smax,ashape,sz2h, sksfc,skmax,ashape1,skminusk0, hmax + + +!cc + parameter(gravi=1.0/grav) + parameter(g=grav) + parameter(gocp=g/cp) + parameter(cont=cp/g,conq=hvap/g,conw=1.0/g) ! for del in pa +! parameter(cont=1000.*cp/g,conq=1000.*hvap/g,conw=1000./g) ! for del in kpa + parameter(rlam=30.0,vk=0.4,vk2=vk*vk) + parameter(prmin=0.25,prmax=4.,zolcr=0.2,zolcru=-0.5) + parameter(dw2min=0.0001,dkmin=0.0,dkmax=1000.,rimin=-100.) + parameter(crbcon=0.25,crbmin=0.15,crbmax=0.35) + parameter(wfac=7.0,cfac=6.5,pfac=2.0,sfcfrac=0.1) +! parameter(qmin=1.e-8,xkzm=1.0,zfmin=1.e-8,aphi5=5.,aphi16=16.) + parameter(qmin=1.e-8, zfmin=1.e-8,aphi5=5.,aphi16=16.) + parameter(tdzmin=1.e-3,qlmin=1.e-12,f0=1.e-4) + parameter(h1=0.33333333,h2=0.66666667) +! parameter(cldtime=500.,xkzminv=0.3) + parameter(cldtime=500.) +! parameter(cldtime=500.,xkzmu=3.0,xkzminv=0.3) +! parameter(gamcrt=3.,gamcrq=2.e-3,rlamun=150.0) + parameter(gamcrt=3.,gamcrq=0.,rlamun=150.0) + parameter(rentf1=0.2,rentf2=1.0,radfac=0.85) + parameter(iun=84) +! +! parameter (zstblmax = 2500., qlcr=1.0e-5) +! parameter (zstblmax = 2500., qlcr=3.0e-5) +! parameter (zstblmax = 2500., qlcr=3.5e-5) +! parameter (zstblmax = 2500., qlcr=1.0e-4) + parameter (zstblmax = 2500., qlcr=3.5e-5) +! parameter (actei = 0.23) + parameter (actei = 0.7) + +! HAFS PBL: height-dependent ALPHA + useshape=2 !0-- no change, origincal ALPHA adjustment,1-- shape1, 2-- shape2(adjust above sfc) + alpha=moninq_fac + + ! write(0,*)'in PBL,alpha=',alpha + + ! write(0,*)'islimsk=',(islimsk(i),i=1,im) + +c +c----------------------------------------------------------------------- +c + 601 format(1x,' moninp lat lon step hour ',3i6,f6.1) + 602 format(1x,' k',' z',' t',' th', + 1 ' tvh',' q',' u',' v', + 2 ' sp') + 603 format(1x,i5,8f9.1) + 604 format(1x,' sfc',9x,f9.1,18x,f9.1) + 605 format(1x,' k zl spd2 thekv the1v' + 1 ,' thermal rbup') + 606 format(1x,i5,6f8.2) + 607 format(1x,' kpbl hpbl fm fh hgamt', + 1 ' hgamq ws ustar cd ch') + 608 format(1x,i5,9f8.2) + 609 format(1x,' k pr dkt dku ',i5,3f8.2) + 610 format(1x,' k pr dkt dku ',i5,3f8.2,' l2 ri t2', + 1 ' sr2 ',2f8.2,2e10.2) +! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 +!> ## Compute preliminary variables from input arguments + +! compute preliminary variables +! + if (ix .lt. im) stop +! +! iprt = 0 +! if(iprt.eq.1) then +!cc latd = 0 +! lond = 0 +! else +!cc latd = 0 +! lond = 0 +! endif +! + dt2 = delt + rdt = 1. / dt2 + km1 = km - 1 + kmpbl = km / 2 +!> - Compute physical height of the layer centers and interfaces from the geopotential height (zi and zl) + do k=1,km + do i=1,im + zi(i,k) = phii(i,k) * gravi + zl(i,k) = phil(i,k) * gravi + enddo + enddo + do i=1,im + zi(i,km+1) = phii(i,km+1) * gravi + enddo +!> - Compute reciprocal of \f$ \Delta z \f$ (rdzt) + do k = 1,km1 + do i=1,im + rdzt(i,k) = 1.0 / (zl(i,k+1) - zl(i,k)) + enddo + enddo +!> - Compute reciprocal of pressure (tx1, tx2) + do i=1,im + kx1(i) = 1 + tx1(i) = 1.0 / prsi(i,1) + tx2(i) = tx1(i) + enddo +!> - Compute background vertical diffusivities for scalars and momentum (xkzo and xkzmo) + do k = 1,km1 + do i=1,im + xkzo(i,k) = 0.0 + xkzmo(i,k) = 0.0 + if (k < kinver(i)) then +! vertical background diffusivity + ptem = prsi(i,k+1) * tx1(i) + tem1 = 1.0 - ptem + tem1 = tem1 * tem1 * 10.0 + xkzo(i,k) = xkzm_h * min(1.0, exp(-tem1)) + +! vertical background diffusivity for momentum + if (ptem >= xkzm_s) then + xkzmo(i,k) = xkzm_m + kx1(i) = k + 1 + else + if (k == kx1(i) .and. k > 1) tx2(i) = 1.0 / prsi(i,k) + tem1 = 1.0 - prsi(i,k+1) * tx2(i) + tem1 = tem1 * tem1 * 5.0 + xkzmo(i,k) = xkzm_m * min(1.0, exp(-tem1)) + endif + endif + enddo + enddo + +! if (lprnt) then +! print *,' xkzo=',(xkzo(ipr,k),k=1,km1) +! print *,' xkzmo=',(xkzmo(ipr,k),k=1,km1) +! endif +! +! diffusivity in the inversion layer is set to be xkzminv (m^2/s) +!> - The background scalar vertical diffusivity is limited to be less than or equal to xkzminv + do k = 1,kmpbl + do i=1,im +! if(zi(i,k+1) > 200..and.zi(i,k+1) < zstblmax) then + if(zi(i,k+1) > 250.) then + tem1 = (t1(i,k+1)-t1(i,k)) * rdzt(i,k) + if(tem1 > 1.e-5) then + xkzo(i,k) = min(xkzo(i,k),xkzminv) + endif + endif + enddo + enddo +!> - Some output variables and logical flags are initialized + do i = 1,im + z0(i) = 0.01 * zorl(i) + dusfc(i) = 0. + dvsfc(i) = 0. + dtsfc(i) = 0. + dqsfc(i) = 0. + wscale(i)= 0. + wscaleu(i)= 0. + kpbl(i) = 1 + hpbl(i) = zi(i,1) + hpblx(i) = zi(i,1) + pblflg(i)= .true. + sfcflg(i)= .true. + if(rbsoil(i) > 0.) sfcflg(i) = .false. + ublflg(i)= .false. + pcnvflg(i)= .false. + scuflg(i)= .true. + if(scuflg(i)) then + radmin(i)= 0. + rent(i) = rentf1 + hrad(i) = zi(i,1) +! hradm(i) = zi(i,1) + krad(i) = 1 + icld(i) = 0 + lcld(i) = km1 + kcld(i) = km1 + zd(i) = 0. + endif + enddo +!> - Compute \f$\theta\f$ (theta), \f$q_l\f$ (qlx), \f$q_t\f$ (qtx), \f$\theta_e\f$ (thetae), \f$\theta_v\f$ (thvx), \f$\theta_{l,v}\f$ (thlvx) + do k = 1,km + do i = 1,im + theta(i,k) = t1(i,k) * psk(i) / prslk(i,k) + qlx(i,k) = max(q1(i,k,ntcw),qlmin) + qtx(i,k) = max(q1(i,k,1),qmin)+qlx(i,k) + ptem = qlx(i,k) + ptem1 = hvap*max(q1(i,k,1),qmin)/(cp*t1(i,k)) + thetae(i,k)= theta(i,k)*(1.+ptem1) + thvx(i,k) = theta(i,k)*(1.+fv*max(q1(i,k,1),qmin)-ptem) + ptem2 = theta(i,k)-(hvap/cp)*ptem + thlvx(i,k) = ptem2*(1.+fv*qtx(i,k)) + enddo + enddo +!> - Initialize diffusion coefficients to 0 and calculate the total radiative heating rate (dku, dkt, radx) + do k = 1,km1 + do i = 1,im + dku(i,k) = 0. + dkt(i,k) = 0. + dktx(i,k) = 0. + cku(i,k) = 0. + ckt(i,k) = 0. + tem = zi(i,k+1)-zi(i,k) + radx(i,k) = tem*(swh(i,k)*xmu(i)+hlw(i,k)) + enddo + enddo +!> - Set lcld to first index above 2.5km + do i=1,im + flg(i) = scuflg(i) + enddo + do k = 1, km1 + do i=1,im + if(flg(i).and.zl(i,k) >= zstblmax) then + lcld(i)=k + flg(i)=.false. + endif + enddo + enddo +! +! compute virtual potential temp gradient (bf) and winshear square +!> - Compute \f$\frac{\partial \theta_v}{\partial z}\f$ (bf) and the wind shear squared (shr2) + do k = 1, km1 + do i = 1, im + rdz = rdzt(i,k) + bf(i,k) = (thvx(i,k+1)-thvx(i,k))*rdz + ti(i,k) = 2./(t1(i,k)+t1(i,k+1)) + dw2 = (u1(i,k)-u1(i,k+1))**2 + & + (v1(i,k)-v1(i,k+1))**2 + shr2(i,k) = max(dw2,dw2min)*rdz*rdz + enddo + enddo +!> - Calculate \f$\frac{g}{\theta}\f$ (govrth), \f$\beta = \frac{\Delta t}{\Delta z}\f$ (beta), \f$u_*\f$ (ustar), total surface flux (sflux), and set pblflag to false if the total surface energy flux is into the surface + do i = 1,im + govrth(i) = g/theta(i,1) + enddo +! + do i=1,im + beta(i) = dt2 / (zi(i,2)-zi(i,1)) + enddo +! + do i=1,im + ustar(i) = sqrt(stress(i)) + enddo +! + do i = 1,im + sflux(i) = heat(i) + evap(i)*fv*theta(i,1) + if(.not.sfcflg(i) .or. sflux(i) <= 0.) pblflg(i)=.false. + enddo +!> ## Calculate the first estimate of the PBL height (``Predictor step") +!! The calculation of the boundary layer height follows Troen and Mahrt (1986) \cite troen_and_mahrt_1986 section 3. The approach is to find the level in the column where a modified bulk Richardson number exceeds a critical value. +!! +!! The temperature of the thermal is of primary importance. For the initial estimate of the PBL height, the thermal is assumed to have one of two temperatures. If the boundary layer is stable, the thermal is assumed to have a temperature equal to the surface virtual temperature. Otherwise, the thermal is assumed to have the same virtual potential temperature as the lowest model level. For the stable case, the critical bulk Richardson number becomes a function of the wind speed and roughness length, otherwise it is set to a tunable constant. +! compute the pbl height +! + do i=1,im + flg(i) = .false. + rbup(i) = rbsoil(i) + + IF ( ALPHA .GT. 0.0) THEN ! ALPHA + + if(pblflg(i)) then + thermal(i) = thvx(i,1) + crb(i) = crbcon + else + thermal(i) = tsea(i)*(1.+fv*max(q1(i,1,1),qmin)) + tem = sqrt(u10m(i)**2+v10m(i)**2) + tem = max(tem, 1.) + robn = tem / (f0 * z0(i)) + tem1 = 1.e-7 * robn + crb(i) = 0.16 * (tem1 ** (-0.18)) + crb(i) = max(min(crb(i), crbmax), crbmin) + endif + + ELSE +! use variable Ri for all conditions + if(pblflg(i)) then + thermal(i) = thvx(i,1) + else + thermal(i) = tsea(i)*(1.+fv*max(q1(i,1,1),qmin)) + endif + tem = sqrt(u10m(i)**2+v10m(i)**2) + tem = max(tem, 1.) + robn = tem / (f0 * z0(i)) + tem1 = 1.e-7 * robn +! crb(i) = 0.16 * (tem1 ** (-0.18)) + crb(i) = crbcon + IF(islimsk(i).ne.0) crb(I) = 0.16*(tem1)**(-0.18) + IF(islimsk(i).eq.0) crb(I) = 0.25*(tem1)**(-0.18) + crb(i) = max(min(crb(i), crbmax), crbmin) + ENDIF ! ALPHA + + enddo + +!> Given the thermal's properties and the critical Richardson number, a loop is executed to find the first level above the surface where the modified Richardson number is greater than the critical Richardson number, using equation 10a from Troen and Mahrt (1986) \cite troen_and_mahrt_1986 (also equation 8 from Hong and Pan (1996) \cite hong_and_pan_1996): +!! \f[ +!! h = Ri\frac{T_0\left|\vec{v}(h)\right|^2}{g\left(\theta_v(h) - \theta_s\right)} +!! \f] +!! where \f$h\f$ is the PBL height, \f$Ri\f$ is the Richardson number, \f$T_0\f$ is the virtual potential temperature near the surface, \f$\left|\vec{v}\right|\f$ is the wind speed, and \f$\theta_s\f$ is for the thermal. Rearranging this equation to calculate the modified Richardson number at each level, k, for comparison with the critical value yields: +!! \f[ +!! Ri_k = gz(k)\frac{\left(\theta_v(k) - \theta_s\right)}{\theta_v(1)*\vec{v}(k)} +!! \f] + do k = 1, kmpbl + do i = 1, im + if(.not.flg(i)) then + rbdn(i) = rbup(i) + spdk2 = max((u1(i,k)**2+v1(i,k)**2),1.) + rbup(i) = (thvx(i,k)-thermal(i))* + & (g*zl(i,k)/thvx(i,1))/spdk2 + kpbl(i) = k + flg(i) = rbup(i) > crb(i) + endif + enddo + enddo + +!> Once the level is found, some linear interpolation is performed to find the exact height of the boundary layer top (where \f$Ri = Ri_{cr}\f$) and the PBL height and the PBL top index are saved (hpblx and kpblx, respectively) + do i = 1,im + if(kpbl(i) > 1) then + k = kpbl(i) + if(rbdn(i) >= crb(i)) then + rbint = 0. + elseif(rbup(i) <= crb(i)) then + rbint = 1. + else + rbint = (crb(i)-rbdn(i))/(rbup(i)-rbdn(i)) + endif + hpbl(i) = zl(i,k-1) + rbint*(zl(i,k)-zl(i,k-1)) + if(hpbl(i) < zi(i,kpbl(i))) kpbl(i) = kpbl(i) - 1 + else + hpbl(i) = zl(i,1) + kpbl(i) = 1 + endif + kpblx(i) = kpbl(i) + hpblx(i) = hpbl(i) + enddo +! +! compute similarity parameters +!> ## Calculate Monin-Obukhov similarity parameters +!! Using the initial guess for the PBL height, Monin-Obukhov similarity parameters are calculated. They are needed to refine the PBL height calculation and for calculating diffusion coefficients. +!! +!! First, calculate the Monin-Obukhov nondimensional stability parameter, commonly referred to as \f$\zeta\f$ using the following equation from Businger et al. (1971) \cite businger_et_al_1971 (equation 28): +!! \f[ +!! \zeta = Ri_{sfc}\frac{F_m^2}{F_h} = \frac{z}{L} +!! \f] +!! where \f$F_m\f$ and \f$F_h\f$ are surface Monin-Obukhov stability functions calculated in sfc_diff.f and \f$L\f$ is the Obukhov length. Then, the nondimensional gradients of momentum and temperature (phim and phih) are calculated using equations 5 and 6 from Hong and Pan (1996) \cite hong_and_pan_1996 depending on the surface layer stability. Then, the velocity scale valid for the surface layer (\f$w_s\f$, wscale) is calculated using equation 3 from Hong and Pan (1996) \cite hong_and_pan_1996. For the neutral and unstable PBL above the surface layer, the convective velocity scale, \f$w_*\f$, is calculated according to: +!! \f[ +!! w_* = \left(\frac{g}{\theta_0}h\overline{w'\theta_0'}\right)^{1/3} +!! \f] +!! and the mixed layer velocity scale is then calculated with equation 6 from Troen and Mahrt (1986) \cite troen_and_mahrt_1986 +!! \f[ +!! w_s = (u_*^3 + 7\epsilon k w_*^3)^{1/3} +!! \f] + do i=1,im + zol(i) = max(rbsoil(i)*fm(i)*fm(i)/fh(i),rimin) + if(sfcflg(i)) then + zol(i) = min(zol(i),-zfmin) + else + zol(i) = max(zol(i),zfmin) + endif + zol1 = zol(i)*sfcfrac*hpbl(i)/zl(i,1) + if(sfcflg(i)) then +! phim(i) = (1.-aphi16*zol1)**(-1./4.) +! phih(i) = (1.-aphi16*zol1)**(-1./2.) + tem = 1.0 / (1. - aphi16*zol1) + phih(i) = sqrt(tem) + phim(i) = sqrt(phih(i)) + else + phim(i) = 1. + aphi5*zol1 + phih(i) = phim(i) + endif + wscale(i) = ustar(i)/phim(i) + ustmin(i) = ustar(i)/aphi5 + wscale(i) = max(wscale(i),ustmin(i)) + enddo + do i=1,im + if(pblflg(i)) then + if(zol(i) < zolcru .and. kpbl(i) > 1) then + pcnvflg(i) = .true. + else + ublflg(i) = .true. + endif + wst3 = govrth(i)*sflux(i)*hpbl(i) + wstar(i)= wst3**h1 + ust3 = ustar(i)**3. + wscaleu(i) = (ust3+wfac*vk*wst3*sfcfrac)**h1 + wscaleu(i) = max(wscaleu(i),ustmin(i)) + endif + enddo +! +! compute counter-gradient mixing term for heat and moisture +!> ## Update thermal properties of surface parcel and recompute PBL height ("Corrector step"). +!! Next, the counter-gradient terms for temperature and humidity are calculated using equation 4 of Hong and Pan (1996) \cite hong_and_pan_1996 and are used to calculate the "scaled virtual temperature excess near the surface" (equation 9 in Hong and Pan (1996) \cite hong_and_pan_1996) so that the properties of the thermal are updated to recalculate the PBL height. + do i = 1,im + if(ublflg(i)) then + hgamt(i) = min(cfac*heat(i)/wscaleu(i),gamcrt) + hgamq(i) = min(cfac*evap(i)/wscaleu(i),gamcrq) + vpert = hgamt(i) + hgamq(i)*fv*theta(i,1) + vpert = min(vpert,gamcrt) + thermal(i)= thermal(i)+max(vpert,0.) + hgamt(i) = max(hgamt(i),0.0) + hgamq(i) = max(hgamq(i),0.0) + endif + enddo +! +! enhance the pbl height by considering the thermal excess +!> The PBL height calculation follows the same procedure as the predictor step, except that it uses an updated virtual potential temperature for the thermal. + do i=1,im + flg(i) = .true. + if(ublflg(i)) then + flg(i) = .false. + rbup(i) = rbsoil(i) + endif + enddo + do k = 2, kmpbl + do i = 1, im + if(.not.flg(i)) then + rbdn(i) = rbup(i) + spdk2 = max((u1(i,k)**2+v1(i,k)**2),1.) + rbup(i) = (thvx(i,k)-thermal(i))* + & (g*zl(i,k)/thvx(i,1))/spdk2 + kpbl(i) = k + flg(i) = rbup(i) > crb(i) + endif + enddo + enddo + do i = 1,im + if(ublflg(i)) then + k = kpbl(i) + if(rbdn(i) >= crb(i)) then + rbint = 0. + elseif(rbup(i) <= crb(i)) then + rbint = 1. + else + rbint = (crb(i)-rbdn(i))/(rbup(i)-rbdn(i)) + endif + hpbl(i) = zl(i,k-1) + rbint*(zl(i,k)-zl(i,k-1)) + if(hpbl(i) < zi(i,kpbl(i))) kpbl(i) = kpbl(i) - 1 + if(kpbl(i) <= 1) then + ublflg(i) = .false. + pblflg(i) = .false. + endif + endif + enddo +! +! look for stratocumulus +!> ## Determine whether stratocumulus layers exist and compute quantities needed for enhanced diffusion +!! - Starting at the PBL top and going downward, if the level is less than 2.5 km and \f$q_l>q_{l,cr}\f$ then set kcld = k (find the cloud top index in the PBL). If no cloud water above the threshold is found, scuflg is set to F. + do i = 1, im + flg(i)=scuflg(i) + enddo + do k = kmpbl,1,-1 + do i = 1, im + if(flg(i) .and. k <= lcld(i)) then + if(qlx(i,k).ge.qlcr) then + kcld(i)=k + flg(i)=.false. + endif + endif + enddo + enddo + do i = 1, im + if(scuflg(i) .and. kcld(i)==km1) scuflg(i)=.false. + enddo +!> - Starting at the PBL top and going downward, if the level is less than the cloud top, find the level of the minimum radiative heating rate within the cloud. If the level of the minimum is the lowest model level or the minimum radiative heating rate is positive, then set scuflg to F. + do i = 1, im + flg(i)=scuflg(i) + enddo + do k = kmpbl,1,-1 + do i = 1, im + if(flg(i) .and. k <= kcld(i)) then + if(qlx(i,k) >= qlcr) then + if(radx(i,k) < radmin(i)) then + radmin(i)=radx(i,k) + krad(i)=k + endif + else + flg(i)=.false. + endif + endif + enddo + enddo + do i = 1, im + if(scuflg(i) .and. krad(i) <= 1) scuflg(i)=.false. + if(scuflg(i) .and. radmin(i)>=0.) scuflg(i)=.false. + enddo +!> - Starting at the PBL top and going downward, count the number of levels below the minimum radiative heating rate level that have cloud water above the threshold. If there are none, then set the scuflg to F. + do i = 1, im + flg(i)=scuflg(i) + enddo + do k = kmpbl,2,-1 + do i = 1, im + if(flg(i) .and. k <= krad(i)) then + if(qlx(i,k) >= qlcr) then + icld(i)=icld(i)+1 + else + flg(i)=.false. + endif + endif + enddo + enddo + do i = 1, im + if(scuflg(i) .and. icld(i) < 1) scuflg(i)=.false. + enddo +!> - Find the height of the interface where the minimum in radiative heating rate is located. If this height is less than the second model interface height, then set the scuflg to F. + do i = 1, im + if(scuflg(i)) then + hrad(i) = zi(i,krad(i)+1) +! hradm(i)= zl(i,krad(i)) + endif + enddo +! + do i = 1, im + if(scuflg(i) .and. hrad(i) - Calculate the hypothetical \f$\theta_v\f$ at the minimum radiative heating level that a parcel would reach due to radiative cooling after a typical cloud turnover time spent at that level. + do i = 1, im + if(scuflg(i)) then + k = krad(i) + tem = zi(i,k+1)-zi(i,k) + tem1 = cldtime*radmin(i)/tem + thlvx1(i) = thlvx(i,k)+tem1 +! if(thlvx1(i) > thlvx(i,k-1)) scuflg(i)=.false. + endif + enddo +!> - Determine the distance that a parcel would sink downwards starting from the level of minimum radiative heating rate by comparing the hypothetical minimum \f$\theta_v\f$ calculated above with the environmental \f$\theta_v\f$. + do i = 1, im + flg(i)=scuflg(i) + enddo + do k = kmpbl,1,-1 + do i = 1, im + if(flg(i) .and. k <= krad(i))then + if(thlvx1(i) <= thlvx(i,k))then + tem=zi(i,k+1)-zi(i,k) + zd(i)=zd(i)+tem + else + flg(i)=.false. + endif + endif + enddo + enddo +!> - Calculate the cloud thickness, where the cloud top is the in-cloud minimum radiative heating level and the bottom is determined previously. + do i = 1, im + if(scuflg(i))then + kk = max(1, krad(i)+1-icld(i)) + zdd(i) = hrad(i)-zi(i,kk) + endif + enddo +!> - Find the largest between the cloud thickness and the distance of a sinking parcel, then determine the smallest of that number and the height of the minimum in radiative heating rate. Set this number to \f$zd\f$. Using \f$zd\f$, calculate the characteristic velocity scale of cloud-top radiative cooling-driven turbulence. + do i = 1, im + if(scuflg(i))then + zd(i) = max(zd(i),zdd(i)) + zd(i) = min(zd(i),hrad(i)) + tem = govrth(i)*zd(i)*(-radmin(i)) + vrad(i)= tem**h1 + endif + enddo +! +! compute inverse prandtl number +!> ## Calculate the inverse Prandtl number +!! For an unstable PBL, the Prandtl number is calculated according to Hong and Pan (1996) \cite hong_and_pan_1996, equation 10, whereas for a stable boundary layer, the Prandtl number is simply \f$Pr = \frac{\phi_h}{\phi_m}\f$. + do i = 1, im + if(ublflg(i)) then + tem = phih(i)/phim(i)+cfac*vk*sfcfrac + else + tem = phih(i)/phim(i) + endif + prinv(i) = 1.0 / tem + prinv(i) = min(prinv(i),prmax) + prinv(i) = max(prinv(i),prmin) + enddo + do i = 1, im + if(zol(i) > zolcr) then + kpbl(i) = 1 + endif + enddo + +!!! HAFS PBL, Bgin adjustment +! RGF determine wspd at roughly 500 m above surface, or as close as possible, +! reuse SPDK2 +! zi(i,k) is AGL, right? May not matter if applied only to water grid points + if(moninq_fac.lt.0)then + + DO I=1,IM + SPDK2 = 0. + WSPM(i,1) = 0. + DO K = 1, KMPBL ! kmpbl is like a max possible pbl height + if(zi(i,k).le.500.and.zi(i,k+1).gt.500.)then ! find level bracketing 500 m + SPDK2 = SQRT(U1(i,k)*U1(i,k)+V1(i,k)*V1(i,k)) ! wspd near 500 m + WSPM(i,1) = SPDK2/0.6 ! now the Km limit for 500 m. just store in K=1 + WSPM(i,2) = float(k) ! height of level at gridpoint i. store in K=2 +! if(i.eq.25) print *,' IK ',i,k,' ZI ',zi(i,k), ' WSPM1 ',wspm(i,1),' +! KMPBL ',kmpbl,' KPBL ',kpbl(i) + endif + ENDDO + ENDDO ! i + + endif ! moninq_fac < 0 + + +! +! compute diffusion coefficients below pbl +!> ## Compute diffusion coefficients below the PBL top +!! Below the PBL top, the diffusion coefficients (\f$K_m\f$ and \f$K_h\f$) are calculated according to equation 2 in Hong and Pan (1996) \cite hong_and_pan_1996 where a different value for \f$w_s\f$ (PBL vertical velocity scale) is used depending on the PBL stability. \f$K_h\f$ is calculated from \f$K_m\f$ using the Prandtl number. The calculated diffusion coefficients are checked so that they are bounded by maximum values and the local background diffusion coefficients. + + IF (ALPHA > 0) THEN ! AAAAAAAAAAAAAAAAAAAAAAAAAAA + + do k = 1, kmpbl + do i=1,im + if(k < kpbl(i)) then +! zfac = max((1.-(zi(i,k+1)-zl(i,1))/ +! 1 (hpbl(i)-zl(i,1))), zfmin) + zfac = max((1.-zi(i,k+1)/hpbl(i)), zfmin) + tem = zi(i,k+1) * (zfac**pfac) * moninq_fac ! lmh suggested by kg + if(pblflg(i)) then + tem1 = vk * wscaleu(i) * tem +! dku(i,k) = xkzmo(i,k) + tem1 +! dkt(i,k) = xkzo(i,k) + tem1 * prinv(i) + dku(i,k) = tem1 + dkt(i,k) = tem1 * prinv(i) + else + tem1 = vk * wscale(i) * tem +! dku(i,k) = xkzmo(i,k) + tem1 +! dkt(i,k) = xkzo(i,k) + tem1 * prinv(i) + dku(i,k) = tem1 + dkt(i,k) = tem1 * prinv(i) + endif + dku(i,k) = min(dku(i,k),dkmax) + dku(i,k) = max(dku(i,k),xkzmo(i,k)) + dkt(i,k) = min(dkt(i,k),dkmax) + dkt(i,k) = max(dkt(i,k),xkzo(i,k)) + dktx(i,k)= dkt(i,k) + endif + enddo + enddo + + ELSE ! ALPHA <0 AAAAAAAAAAAAA + + do i=1,im + do k = 1, kmpbl + if(k < kpbl(i)) then +! zfac = max((1.-(zi(i,k+1)-zl(i,1))/ +! 1 (hpbl(i)-zl(i,1))), zfmin) + zfac = max((1.-zi(i,k+1)/hpbl(i)), zfmin) + ! tem = zi(i,k+1) * (zfac**pfac) * moninq_fac ! lmh suggested by kg + tem = zi(i,k+1) * (zfac**pfac) * abs( moninq_fac) + +!!!! CHANGES FOR HEIGHT-DEPENDENT K ADJUSTMENT, WANG W + if(useshape .ge. 1) then + sz2h=(ZI(I,K+1)-ZL(I,1))/(HPBL(I)-ZL(I,1)) + sz2h=max(sz2h,zfmin) + sz2h=min(sz2h,1.0) + zfac=(1.0-sz2h)**pfac +! smax=0.148 !! max value of this shape function + smax=0.148 !! max value of this shape function + hmax=0.333 !! roughly height if max K + skmax=hmax*(1.0-hmax)**pfac + sksfc=min(ZI(I,2)/HPBL(I),0.05) ! surface layer top, 0.05H or ZI(2) (Zi(1)=0) + sksfc=sksfc*(1-sksfc)**pfac + + zfac=max(zfac,zfmin) + ashape=max(ABS(moninq_fac),0.2) ! should not be smaller than 0.2, otherwise too much adjustment(?) + if(useshape ==1) then + ashape=( 1.0 - ((sz2h*zfac/smax)**0.25) + & *( 1.0 - ashape ) ) + tem = zi(i,k+1) * (zfac) * ashape + endif + + if (useshape == 2) then !only adjus K that is > K_surface_top + ashape1=1.0 + if (skmax > sksfc) ashape1=(skmax*ashape-sksfc)/ + & (skmax-sksfc) + skminusk0=ZI(I,K+1)*zfac - HPBL(i)*sksfc + tem = zi(i,k+1) * (zfac) ! no adjustment + if (skminusk0 > 0) then ! only adjust K which is > surface top K + tem = skminusk0*ashape1 + HPBL(i)*sksfc + endif + endif + endif ! endif useshape>1 +!!!! END OF CHAGES , WANG W + + + if(pblflg(i)) then + tem1 = vk * wscaleu(i) * tem +! dku(i,k) = xkzmo(i,k) + tem1 +! dkt(i,k) = xkzo(i,k) + tem1 * prinv(i) + dku(i,k) = tem1 + dkt(i,k) = tem1 * prinv(i) + else + tem1 = vk * wscale(i) * tem +! dku(i,k) = xkzmo(i,k) + tem1 +! dkt(i,k) = xkzo(i,k) + tem1 * prinv(i) + dku(i,k) = tem1 + dkt(i,k) = tem1 * prinv(i) + endif + dku(i,k) = min(dku(i,k),dkmax) + dku(i,k) = max(dku(i,k),xkzmo(i,k)) + dkt(i,k) = min(dkt(i,k),dkmax) + dkt(i,k) = max(dkt(i,k),xkzo(i,k)) + dktx(i,k)= dkt(i,k) + endif + enddo !K loop + +! possible modification of first guess DKU, under certain conditions +! (1) this applies only to columns over water + + IF(islimsk(i).eq.0)then ! sea only + +! (2) alpha test +! if alpha < 0, find alpha for each column and do the loop again +! if alpha > 0, we are finished + + + if(alpha.lt.0)then ! variable alpha test + +! k-level of layer around 500 m + kLOC = INT(WSPM(i,2)) +! print *,' kLOC ',kLOC,' KPBL ',KPBL(I) + +! (3) only do this IF KPBL(I) >= kLOC. Otherwise, we are finished, with DKU as +! if alpha = +1 + + if(KPBL(I).gt.kLOC)then + + xDKU = DKU(i,kLOC) ! Km at k-level +! (4) DKU check. +! WSPM(i,1) is the KM cap for the 500-m level. +! if DKU at 500-m level < WSPM(i,1), do not limit Km ANYWHERE. Alpha = +! abs(alpha). No need to recalc. +! if DKU at 500-m level > WSPM(i,1), then alpha = WSPM(i,1)/xDKU for entire +! column + if(xDKU.ge.WSPM(i,1)) then ! ONLY if DKU at 500-m exceeds cap, otherwise already done + + WSPM(i,3) = WSPM(i,1)/xDKU ! ratio of cap to Km at k-level, store in WSPM(i,3) + !WSPM(i,4) = amin1(WSPM(I,3),1.0) ! this is new column alpha. cap at 1. ! should never be needed + WSPM(i,4) = min(WSPM(I,3),1.0) ! this is new column alpha. cap at 1. ! should never be needed + !! recalculate K capped by WSPM(i,1) + do k = 1, kmpbl + if(k < kpbl(i)) then +! zfac = max((1.-(zi(i,k+1)-zl(i,1))/ +! 1 (hpbl(i)-zl(i,1))), zfmin) + zfac = max((1.-zi(i,k+1)/hpbl(i)), zfmin) + ! tem = zi(i,k+1) * (zfac**pfac) + tem = zi(i,k+1) * (zfac**pfac) * WSPM(i,4) + + +!!!! CHANGES FOR HEIGHT-DEPENDENT K ADJUSTMENT, WANG W + if(useshape .ge. 1) then + sz2h=(ZI(I,K+1)-ZL(I,1))/(HPBL(I)-ZL(I,1)) + sz2h=max(sz2h,zfmin) + sz2h=min(sz2h,1.0) + zfac=(1.0-sz2h)**pfac + smax=0.148 !! max value of this shape function + hmax=0.333 !! roughly height if max K + skmax=hmax*(1.0-hmax)**pfac + sksfc=min(ZI(I,2)/HPBL(I),0.05) ! surface layer top, 0.05H or ZI(2) (Zi(1)=0) + sksfc=sksfc*(1-sksfc)**pfac + + zfac=max(zfac,zfmin) + ashape=max(WSPM(i,4),0.2) !! adjustment coef should not smaller than 0.2 + if(useshape ==1) then + ashape=( 1.0 - ((sz2h*zfac/smax)**0.25) + & *( 1.0 - ashape ) ) + tem = zi(i,k+1) * (zfac) * ashape +! if(k ==5) write(0,*)'min alf, height-depend alf',WSPM(i,4),ashape + endif ! endif useshape=1 + + if (useshape == 2) then !only adjus K that is > K_surface_top + ashape1=1.0 + if (skmax > sksfc) ashape1=(skmax*ashape-sksfc)/ + & (skmax-sksfc) + + skminusk0=ZI(I,K+1)*zfac - HPBL(i)*sksfc + tem = zi(i,k+1) * (zfac) ! no adjustment +! if(k ==5) write(0,*)'before, dku,ashape,ashpe1', +! & tem*wscaleu(i)*vk,ashape,ashape1 + if (skminusk0 > 0) then ! only adjust K which is > surface top K + tem = skminusk0*ashape1 + HPBL(i)*sksfc + endif +! if(k ==5)write(0,*) +! & 'after,dku,k_sfc,skmax,sksfc,zi(2),hpbl' +! & ,tem*wscaleu(i)*vk,WSCALEU(I)*VK*HPBL(i)*sksfc, skmax, +! & sksfc,ZI(I,2),HPBL(I) + + endif ! endif useshape=2 + endif ! endif useshape>1 +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + + if(pblflg(i)) then + tem1 = vk * wscaleu(i) * tem +! dku(i,k) = xkzmo(i,k) + tem1 +! dkt(i,k) = xkzo(i,k) + tem1 * prinv(i) + dku(i,k) = tem1 + dkt(i,k) = tem1 * prinv(i) + else + tem1 = vk * wscale(i) * tem +! dku(i,k) = xkzmo(i,k) + tem1 +! dkt(i,k) = xkzo(i,k) + tem1 * prinv(i) + dku(i,k) = tem1 + dkt(i,k) = tem1 * prinv(i) + endif + dku(i,k) = min(dku(i,k),dkmax) + dku(i,k) = max(dku(i,k),xkzmo(i,k)) + dkt(i,k) = min(dkt(i,k),dkmax) + dkt(i,k) = max(dkt(i,k),xkzo(i,k)) + dktx(i,k)= dkt(i,k) + endif + enddo !K loop + endif ! xDKU.ge.WSPM(i,1) + endif ! KPBL(I).ge.kLOC + endif ! alpha < 0 + endif ! islimsk=0 + + enddo !I loop + ENDIF !AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA + +! +! compute diffusion coefficients based on local scheme above pbl +!> ## Compute diffusion coefficients above the PBL top +!! Diffusion coefficients above the PBL top are computed as a function of local stability (gradient Richardson number), shear, and a length scale from Louis (1979) \cite louis_1979 : +!! \f[ +!! K_{m,h}=l^2f_{m,h}(Ri_g)\left|\frac{\partial U}{\partial z}\right| +!! \f] +!! The functions used (\f$f_{m,h}\f$) depend on the local stability. First, the gradient Richardson number is calculated as +!! \f[ +!! Ri_g=\frac{\frac{g}{T}\frac{\partial \theta_v}{\partial z}}{\frac{\partial U}{\partial z}^2} +!! \f] +!! where \f$U\f$ is the horizontal wind. For the unstable case (\f$Ri_g < 0\f$), the Richardson number-dependent functions are given by +!! \f[ +!! f_h(Ri_g) = 1 + \frac{8\left|Ri_g\right|}{1 + 1.286\sqrt{\left|Ri_g\right|}}\\ +!! \f] +!! \f[ +!! f_m(Ri_g) = 1 + \frac{8\left|Ri_g\right|}{1 + 1.746\sqrt{\left|Ri_g\right|}}\\ +!! \f] +!! For the stable case, the following formulas are used +!! \f[ +!! f_h(Ri_g) = \frac{1}{\left(1 + 5Ri_g\right)^2}\\ +!! \f] +!! \f[ +!! Pr = \frac{K_h}{K_m} = 1 + 2.1Ri_g +!! \f] +!! The source for the formulas used for the Richardson number-dependent functions is unclear. They are different than those used in Hong and Pan (1996) \cite hong_and_pan_1996 as the previous documentation suggests. They follow equation 14 of Louis (1979) \cite louis_1979 for the unstable case, but it is unclear where the values of the coefficients \f$b\f$ and \f$c\f$ from that equation used in this scheme originate. Finally, the length scale, \f$l\f$ is calculated according to the following formula from Hong and Pan (1996) \cite hong_and_pan_1996 +!! \f[ +!! \frac{1}{l} = \frac{1}{kz} + \frac{1}{l_0}\\ +!! \f] +!! \f[ +!! or\\ +!! \f] +!! \f[ +!! l=\frac{l_0kz}{l_0+kz} +!! \f] +!! where \f$l_0\f$ is currently 30 m for stable conditions and 150 m for unstable. Finally, the diffusion coefficients are kept in a range bounded by the background diffusion and the maximum allowable values. + do k = 1, km1 + do i=1,im + if(k >= kpbl(i)) then + bvf2 = g*bf(i,k)*ti(i,k) + ri = max(bvf2/shr2(i,k),rimin) + zk = vk*zi(i,k+1) + if(ri < 0.) then ! unstable regime + rl2 = zk*rlamun/(rlamun+zk) + dk = rl2*rl2*sqrt(shr2(i,k)) + sri = sqrt(-ri) +! dku(i,k) = xkzmo(i,k) + dk*(1+8.*(-ri)/(1+1.746*sri)) +! dkt(i,k) = xkzo(i,k) + dk*(1+8.*(-ri)/(1+1.286*sri)) + dku(i,k) = dk*(1+8.*(-ri)/(1+1.746*sri)) + dkt(i,k) = dk*(1+8.*(-ri)/(1+1.286*sri)) + else ! stable regime + rl2 = zk*rlam/(rlam+zk) +!! tem = rlam * sqrt(0.01*prsi(i,k)) +!! rl2 = zk*tem/(tem+zk) + dk = rl2*rl2*sqrt(shr2(i,k)) + tem1 = dk/(1+5.*ri)**2 +! + if(k >= kpblx(i)) then + prnum = 1.0 + 2.1*ri + prnum = min(prnum,prmax) + else + prnum = 1.0 + endif +! dku(i,k) = xkzmo(i,k) + tem1 * prnum +! dkt(i,k) = xkzo(i,k) + tem1 + dku(i,k) = tem1 * prnum + dkt(i,k) = tem1 + endif +! + dku(i,k) = min(dku(i,k),dkmax) + dku(i,k) = max(dku(i,k),xkzmo(i,k)) + dkt(i,k) = min(dkt(i,k),dkmax) + dkt(i,k) = max(dkt(i,k),xkzo(i,k)) +! + endif +! + enddo + enddo +! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! compute components for mass flux mixing by large thermals +!> ## If the PBL is convective, call the mass flux scheme to replace the countergradient terms. +!! If the PBL is convective, the updraft properties are initialized to be the same as the state variables and the subroutine mfpbl is called. + do k = 1, km + do i = 1, im + if(pcnvflg(i)) then + tcko(i,k) = t1(i,k) + ucko(i,k) = u1(i,k) + vcko(i,k) = v1(i,k) + xmf(i,k) = 0. + endif + enddo + enddo + do kk = 1, ntrac + do k = 1, km + do i = 1, im + if(pcnvflg(i)) then + qcko(i,k,kk) = q1(i,k,kk) + endif + enddo + enddo + enddo +!> For details of the mfpbl subroutine, step into its documentation ::mfpbl + call mfpbl(im,ix,km,ntrac,dt2,pcnvflg, + & zl,zi,thvx,q1,t1,u1,v1,hpbl,kpbl, + & sflux,ustar,wstar,xmf,tcko,qcko,ucko,vcko) +! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! compute diffusion coefficients for cloud-top driven diffusion +! if the condition for cloud-top instability is met, +! increase entrainment flux at cloud top +! +!> ## Compute enhanced diffusion coefficients related to stratocumulus-topped PBLs +!! If a stratocumulus layer has been identified in the PBL, the diffusion coefficients in the PBL are modified in the following way. +!! +!! -# First, the criteria for CTEI is checked, using the threshold from equation 13 of Macvean and Mason (1990) \cite macvean_and_mason_1990. If the criteria is met, the cloud top diffusion is increased: +!! \f[ +!! K_h^{Sc} = -c\frac{\Delta F_R}{\rho c_p}\frac{1}{\frac{\partial \theta_v}{\partial z}} +!! \f] +!! where the constant \f$c\f$ is set to 0.2 if the CTEI criterion is not met and 1.0 if it is. +!! +!! -# Calculate the diffusion coefficients due to stratocumulus mixing according to equation 5 in Lock et al. (2000) \cite lock_et_al_2000 for every level below the stratocumulus top using the characteristic stratocumulus velocity scale previously calculated. The diffusion coefficient for momentum is calculated assuming a constant inverse Prandtl number of 0.75. + do i = 1, im + if(scuflg(i)) then + k = krad(i) + tem = thetae(i,k) - thetae(i,k+1) + tem1 = qtx(i,k) - qtx(i,k+1) + if (tem > 0. .and. tem1 > 0.) then + cteit= cp*tem/(hvap*tem1) + if(cteit > actei) rent(i) = rentf2 + endif + endif + enddo + do i = 1, im + if(scuflg(i)) then + k = krad(i) + tem1 = max(bf(i,k),tdzmin) + ckt(i,k) = -rent(i)*radmin(i)/tem1 + cku(i,k) = ckt(i,k) + endif + enddo +! + do k = 1, kmpbl + do i=1,im + if(scuflg(i) .and. k < krad(i)) then + tem1=hrad(i)-zd(i) + tem2=zi(i,k+1)-tem1 + if(tem2 > 0.) then + ptem= tem2/zd(i) + if(ptem.ge.1.) ptem= 1. + ptem= tem2*ptem*sqrt(1.-ptem) + ckt(i,k) = radfac*vk*vrad(i)*ptem + cku(i,k) = 0.75*ckt(i,k) + ckt(i,k) = max(ckt(i,k),dkmin) + ckt(i,k) = min(ckt(i,k),dkmax) + cku(i,k) = max(cku(i,k),dkmin) + cku(i,k) = min(cku(i,k),dkmax) + endif + endif + enddo + enddo +! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! +!> After \f$K_h^{Sc}\f$ has been determined from the surface to the top of the stratocumulus layer, it is added to the value for the diffusion coefficient calculated previously using surface-based mixing [see equation 6 of Lock et al. (2000) \cite lock_et_al_2000 ]. + do k = 1, kmpbl + do i=1,im + if(scuflg(i)) then + ! dkt(i,k) = dkt(i,k)+ckt(i,k) + ! dku(i,k) = dku(i,k)+cku(i,k) + !! if K needs to be adjusted by alpha, then no need to add this term + if(alpha .ge. 0.0) dkt(i,k) = dkt(i,k)+ckt(i,k) + if(alpha .ge. 0.0) dku(i,k) = dku(i,k)+cku(i,k) + + dkt(i,k) = min(dkt(i,k),dkmax) + dku(i,k) = min(dku(i,k),dkmax) + endif + enddo + enddo +! +! compute tridiagonal matrix elements for heat and moisture +! +!> ## Solve for the temperature and moisture tendencies due to vertical mixing. +!! The tendencies of heat, moisture, and momentum due to vertical diffusion are calculated using a two-part process. First, a solution is obtained using an implicit time-stepping scheme, then the time tendency terms are "backed out". The tridiagonal matrix elements for the implicit solution for temperature and moisture are prepared in this section, with differing algorithms depending on whether the PBL was convective (substituting the mass flux term for counter-gradient term), unstable but not convective (using the computed counter-gradient terms), or stable (no counter-gradient terms). + do i=1,im + ad(i,1) = 1. + a1(i,1) = t1(i,1) + beta(i) * heat(i) + a2(i,1) = q1(i,1,1) + beta(i) * evap(i) + enddo + + if(ntrac >= 2) then + do k = 2, ntrac + is = (k-1) * km + do i = 1, im + a2(i,1+is) = q1(i,1,k) + enddo + enddo + endif +! + do k = 1,km1 + do i = 1,im + dtodsd = dt2/del(i,k) + dtodsu = dt2/del(i,k+1) + dsig = prsl(i,k)-prsl(i,k+1) + rdz = rdzt(i,k) + tem1 = dsig * dkt(i,k) * rdz + dsdz2 = tem1 * rdz + au(i,k) = -dtodsd*dsdz2 + al(i,k) = -dtodsu*dsdz2 +! + if(pcnvflg(i) .and. k < kpbl(i)) then + tem2 = dsig * rdz + ptem = 0.5 * tem2 * xmf(i,k) + ptem1 = dtodsd * ptem + ptem2 = dtodsu * ptem + ad(i,k) = ad(i,k)-au(i,k)-ptem1 + ad(i,k+1) = 1.-al(i,k)+ptem2 + au(i,k) = au(i,k)-ptem1 + al(i,k) = al(i,k)+ptem2 + ptem = tcko(i,k) + tcko(i,k+1) + dsdzt = tem1 * gocp + a1(i,k) = a1(i,k)+dtodsd*dsdzt-ptem1*ptem + a1(i,k+1) = t1(i,k+1)-dtodsu*dsdzt+ptem2*ptem + ptem = qcko(i,k,1) + qcko(i,k+1,1) + a2(i,k) = a2(i,k) - ptem1 * ptem + a2(i,k+1) = q1(i,k+1,1) + ptem2 * ptem + elseif(ublflg(i) .and. k < kpbl(i)) then + ptem1 = dsig * dktx(i,k) * rdz + tem = 1.0 / hpbl(i) + dsdzt = tem1 * gocp - ptem1 * hgamt(i) * tem + dsdzq = - ptem1 * hgamq(i) * tem + ad(i,k) = ad(i,k)-au(i,k) + ad(i,k+1) = 1.-al(i,k) + a1(i,k) = a1(i,k)+dtodsd*dsdzt + a1(i,k+1) = t1(i,k+1)-dtodsu*dsdzt + a2(i,k) = a2(i,k)+dtodsd*dsdzq + a2(i,k+1) = q1(i,k+1,1)-dtodsu*dsdzq + else + ad(i,k) = ad(i,k)-au(i,k) + ad(i,k+1) = 1.-al(i,k) + dsdzt = tem1 * gocp + a1(i,k) = a1(i,k)+dtodsd*dsdzt + a1(i,k+1) = t1(i,k+1)-dtodsu*dsdzt + a2(i,k+1) = q1(i,k+1,1) + endif +! + enddo + enddo +! + if(ntrac >= 2) then + do kk = 2, ntrac + is = (kk-1) * km + do k = 1, km1 + do i = 1, im + if(pcnvflg(i) .and. k < kpbl(i)) then + dtodsd = dt2/del(i,k) + dtodsu = dt2/del(i,k+1) + dsig = prsl(i,k)-prsl(i,k+1) + tem = dsig * rdzt(i,k) + ptem = 0.5 * tem * xmf(i,k) + ptem1 = dtodsd * ptem + ptem2 = dtodsu * ptem + tem1 = qcko(i,k,kk) + qcko(i,k+1,kk) + a2(i,k+is) = a2(i,k+is) - ptem1*tem1 + a2(i,k+1+is)= q1(i,k+1,kk) + ptem2*tem1 + else + a2(i,k+1+is) = q1(i,k+1,kk) + endif + enddo + enddo + enddo + endif +! +! solve tridiagonal problem for heat and moisture +! +!> The tridiagonal system is solved by calling the internal ::tridin subroutine. + call tridin99(im,km,ntrac,al,ad,au,a1,a2,au,a1,a2) + +! +! recover tendencies of heat and moisture +! +!> After returning with the solution, the tendencies for temperature and moisture are recovered. + do k = 1,km + do i = 1,im + ttend = (a1(i,k)-t1(i,k)) * rdt + qtend = (a2(i,k)-q1(i,k,1))*rdt + tau(i,k) = tau(i,k)+ttend + rtg(i,k,1) = rtg(i,k,1)+qtend + dtsfc(i) = dtsfc(i)+cont*del(i,k)*ttend + dqsfc(i) = dqsfc(i)+conq*del(i,k)*qtend + enddo + enddo + if(ntrac >= 2) then + do kk = 2, ntrac + is = (kk-1) * km + do k = 1, km + do i = 1, im + qtend = (a2(i,k+is)-q1(i,k,kk))*rdt + rtg(i,k,kk) = rtg(i,k,kk)+qtend + enddo + enddo + enddo + endif +! +! compute tke dissipation rate +! +!> ## Calculate heating due to TKE dissipation and add to the tendency for temperature +!! Following Han et al. (2015) \cite han_et_al_2015 , turbulence dissipation contributes to the tendency of temperature in the following way. First, turbulence dissipation is calculated by equation 17 of Han et al. (2015) \cite han_et_al_2015 for the PBL and equation 16 for the surface layer. + if(dspheat) then +! + do k = 1,km1 + do i = 1,im + diss(i,k) = dku(i,k)*shr2(i,k)-g*ti(i,k)*dkt(i,k)*bf(i,k) +! diss(i,k) = dku(i,k)*shr2(i,k) + enddo + enddo +! +! add dissipative heating at the first model layer +! +!> Next, the temperature tendency is updated following equation 14. + do i = 1,im + tem = govrth(i)*sflux(i) + tem1 = tem + stress(i)*spd1(i)/zl(i,1) + tem2 = 0.5 * (tem1+diss(i,1)) + tem2 = max(tem2, 0.) + ttend = tem2 / cp + if (alpha .gt. 0.0) then + tau(i,1) = tau(i,1)+0.5*ttend + else + tau(i,1) = tau(i,1)+0.7*ttend ! in HWRF/HMON, use 0.7 + endif + enddo +! +! add dissipative heating above the first model layer +! + do k = 2,km1 + do i = 1,im + tem = 0.5 * (diss(i,k-1)+diss(i,k)) + tem = max(tem, 0.) + ttend = tem / cp + tau(i,k) = tau(i,k) + 0.5*ttend + enddo + enddo +! + endif +! +! compute tridiagonal matrix elements for momentum +! +!> ## Solve for the horizontal momentum tendencies and add them to the output tendency terms +!! As with the temperature and moisture tendencies, the horizontal momentum tendencies are calculated by solving tridiagonal matrices after the matrices are prepared in this section. + do i=1,im + ad(i,1) = 1.0 + beta(i) * stress(i) / spd1(i) + a1(i,1) = u1(i,1) + a2(i,1) = v1(i,1) + enddo +! + do k = 1,km1 + do i=1,im + dtodsd = dt2/del(i,k) + dtodsu = dt2/del(i,k+1) + dsig = prsl(i,k)-prsl(i,k+1) + rdz = rdzt(i,k) + tem1 = dsig*dku(i,k)*rdz + dsdz2 = tem1 * rdz + au(i,k) = -dtodsd*dsdz2 + al(i,k) = -dtodsu*dsdz2 +! + if(pcnvflg(i) .and. k < kpbl(i)) then + tem2 = dsig * rdz + ptem = 0.5 * tem2 * xmf(i,k) + ptem1 = dtodsd * ptem + ptem2 = dtodsu * ptem + ad(i,k) = ad(i,k)-au(i,k)-ptem1 + ad(i,k+1) = 1.-al(i,k)+ptem2 + au(i,k) = au(i,k)-ptem1 + al(i,k) = al(i,k)+ptem2 + ptem = ucko(i,k) + ucko(i,k+1) + a1(i,k) = a1(i,k) - ptem1 * ptem + a1(i,k+1) = u1(i,k+1) + ptem2 * ptem + ptem = vcko(i,k) + vcko(i,k+1) + a2(i,k) = a2(i,k) - ptem1 * ptem + a2(i,k+1) = v1(i,k+1) + ptem2 * ptem + else + ad(i,k) = ad(i,k)-au(i,k) + ad(i,k+1) = 1.-al(i,k) + a1(i,k+1) = u1(i,k+1) + a2(i,k+1) = v1(i,k+1) + endif +! + enddo + enddo +! +! solve tridiagonal problem for momentum +! + call tridi299(im,km,al,ad,au,a1,a2,au,a1,a2) +! +! recover tendencies of momentum +! +!> Finally, the tendencies are recovered from the tridiagonal solutions. + do k = 1,km + do i = 1,im + utend = (a1(i,k)-u1(i,k))*rdt + vtend = (a2(i,k)-v1(i,k))*rdt + du(i,k) = du(i,k) + utend + dv(i,k) = dv(i,k) + vtend + dusfc(i) = dusfc(i) + conw*del(i,k)*utend + dvsfc(i) = dvsfc(i) + conw*del(i,k)*vtend +! +! for dissipative heating for ecmwf model +! +! tem1 = 0.5*(a1(i,k)+u1(i,k)) +! tem2 = 0.5*(a2(i,k)+v1(i,k)) +! diss(i,k) = -(tem1*utend+tem2*vtend) +! diss(i,k) = max(diss(i,k),0.) +! ttend = diss(i,k) / cp +! tau(i,k) = tau(i,k) + ttend +! + enddo + enddo +! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! + do i = 1, im + hpbl(i) = hpblx(i) + kpbl(i) = kpblx(i) + enddo +! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + return + end subroutine hedmf_hafs_run + +!> @} + +c----------------------------------------------------------------------- +!> \ingroup PBL +!! \brief Routine to solve the tridiagonal system to calculate temperature and moisture at \f$ t + \Delta t \f$; part of two-part process to calculate time tendencies due to vertical diffusion. +!! +!! Origin of subroutine unknown. + subroutine tridi299(l,n,cl,cm,cu,r1,r2,au,a1,a2) +cc + use machine , only : kind_phys + implicit none + integer k,n,l,i + real(kind=kind_phys) fk +cc + real(kind=kind_phys) cl(l,2:n),cm(l,n),cu(l,n-1),r1(l,n),r2(l,n), & + & au(l,n-1),a1(l,n),a2(l,n) +c----------------------------------------------------------------------- + do i=1,l + fk = 1./cm(i,1) + au(i,1) = fk*cu(i,1) + a1(i,1) = fk*r1(i,1) + a2(i,1) = fk*r2(i,1) + enddo + do k=2,n-1 + do i=1,l + fk = 1./(cm(i,k)-cl(i,k)*au(i,k-1)) + au(i,k) = fk*cu(i,k) + a1(i,k) = fk*(r1(i,k)-cl(i,k)*a1(i,k-1)) + a2(i,k) = fk*(r2(i,k)-cl(i,k)*a2(i,k-1)) + enddo + enddo + do i=1,l + fk = 1./(cm(i,n)-cl(i,n)*au(i,n-1)) + a1(i,n) = fk*(r1(i,n)-cl(i,n)*a1(i,n-1)) + a2(i,n) = fk*(r2(i,n)-cl(i,n)*a2(i,n-1)) + enddo + do k=n-1,1,-1 + do i=1,l + a1(i,k) = a1(i,k)-au(i,k)*a1(i,k+1) + a2(i,k) = a2(i,k)-au(i,k)*a2(i,k+1) + enddo + enddo +c----------------------------------------------------------------------- + return + end subroutine tridi299 +c----------------------------------------------------------------------- +!> \ingroup PBL +!! \brief Routine to solve the tridiagonal system to calculate u- and v-momentum at \f$ t + \Delta t \f$; part of two-part process to calculate time tendencies due to vertical diffusion. +!! +!! Origin of subroutine unknown. + subroutine tridin99(l,n,nt,cl,cm,cu,r1,r2,au,a1,a2) +cc + use machine , only : kind_phys + implicit none + integer is,k,kk,n,nt,l,i + real(kind=kind_phys) fk(l) +cc + real(kind=kind_phys) cl(l,2:n), cm(l,n), cu(l,n-1), & + & r1(l,n), r2(l,n*nt), & + & au(l,n-1), a1(l,n), a2(l,n*nt), & + & fkk(l,2:n-1) +c----------------------------------------------------------------------- + do i=1,l + fk(i) = 1./cm(i,1) + au(i,1) = fk(i)*cu(i,1) + a1(i,1) = fk(i)*r1(i,1) + enddo + do k = 1, nt + is = (k-1) * n + do i = 1, l + a2(i,1+is) = fk(i) * r2(i,1+is) + enddo + enddo + do k=2,n-1 + do i=1,l + fkk(i,k) = 1./(cm(i,k)-cl(i,k)*au(i,k-1)) + au(i,k) = fkk(i,k)*cu(i,k) + a1(i,k) = fkk(i,k)*(r1(i,k)-cl(i,k)*a1(i,k-1)) + enddo + enddo + do kk = 1, nt + is = (kk-1) * n + do k=2,n-1 + do i=1,l + a2(i,k+is) = fkk(i,k)*(r2(i,k+is)-cl(i,k)*a2(i,k+is-1)) + enddo + enddo + enddo + do i=1,l + fk(i) = 1./(cm(i,n)-cl(i,n)*au(i,n-1)) + a1(i,n) = fk(i)*(r1(i,n)-cl(i,n)*a1(i,n-1)) + enddo + do k = 1, nt + is = (k-1) * n + do i = 1, l + a2(i,n+is) = fk(i)*(r2(i,n+is)-cl(i,n)*a2(i,n+is-1)) + enddo + enddo + do k=n-1,1,-1 + do i=1,l + a1(i,k) = a1(i,k) - au(i,k)*a1(i,k+1) + enddo + enddo + do kk = 1, nt + is = (kk-1) * n + do k=n-1,1,-1 + do i=1,l + a2(i,k+is) = a2(i,k+is) - au(i,k)*a2(i,k+is+1) + enddo + enddo + enddo +c----------------------------------------------------------------------- + return + end subroutine tridin99 + +!> @} + + end module hedmf_hafs diff --git a/physics/moninedmf_hafs.meta b/physics/moninedmf_hafs.meta new file mode 100644 index 000000000..0e0ed15ad --- /dev/null +++ b/physics/moninedmf_hafs.meta @@ -0,0 +1,526 @@ +[ccpp-arg-table] + name = hedmf_hafs_init + type = scheme +[moninq_fac] + standard_name = atmosphere_diffusivity_coefficient_factor + long_name = multiplicative constant for atmospheric diffusivities + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F + +######################################################################## +[ccpp-arg-table] + name = hedmf_hafs_run + type = scheme +[ix] + standard_name = horizontal_dimension + long_name = horizontal dimension + units = count + dimensions = () + type = integer + intent = in + optional = F +[im] + standard_name = horizontal_loop_extent + long_name = horizontal loop extent + units = count + dimensions = () + type = integer + intent = in + optional = F +[km] + standard_name = vertical_dimension + long_name = vertical layer dimension + units = count + dimensions = () + type = integer + intent = in + optional = F +[ntrac] + standard_name = number_of_vertical_diffusion_tracers + long_name = number of tracers to diffuse vertically + units = count + dimensions = () + type = integer + intent = in + optional = F +[ntcw] + standard_name = index_for_liquid_cloud_condensate + long_name = cloud condensate index in tracer array + units = index + dimensions = () + type = integer + intent = in + optional = F +[dv] + standard_name = tendency_of_y_wind_due_to_model_physics + long_name = updated tendency of the y wind + units = m s-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[du] + standard_name = tendency_of_x_wind_due_to_model_physics + long_name = updated tendency of the x wind + units = m s-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[tau] + standard_name = tendency_of_air_temperature_due_to_model_physics + long_name = updated tendency of the temperature + units = K s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[rtg] + standard_name = tendency_of_vertically_diffused_tracer_concentration + long_name = updated tendency of the tracers due to vertical diffusion in PBL scheme + units = kg kg-1 s-1 + dimensions = (horizontal_dimension,vertical_dimension,number_of_vertical_diffusion_tracers) + type = real + kind = kind_phys + intent = inout + optional = F +[u1] + standard_name = x_wind + long_name = x component of layer wind + units = m s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[v1] + standard_name = y_wind + long_name = y component of layer wind + units = m s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[t1] + standard_name = air_temperature + long_name = layer mean air temperature + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[q1] + standard_name = vertically_diffused_tracer_concentration + long_name = tracer concentration diffused by PBL scheme + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension,number_of_vertical_diffusion_tracers) + type = real + kind = kind_phys + intent = in + optional = F +[swh] + standard_name = tendency_of_air_temperature_due_to_shortwave_heating_on_radiation_timestep + long_name = total sky shortwave heating rate + units = K s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[hlw] + standard_name = tendency_of_air_temperature_due_to_longwave_heating_on_radiation_timestep + long_name = total sky longwave heating rate + units = K s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[xmu] + standard_name = zenith_angle_temporal_adjustment_factor_for_shortwave_fluxes + long_name = zenith angle temporal adjustment factor for shortwave + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[psk] + standard_name = dimensionless_exner_function_at_lowest_model_interface + long_name = dimensionless Exner function at the surface interface + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[rbsoil] + standard_name = bulk_richardson_number_at_lowest_model_level + long_name = bulk Richardson number at the surface + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[zorl] + standard_name = surface_roughness_length + long_name = surface roughness length in cm + units = cm + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[u10m] + standard_name = x_wind_at_10m + long_name = x component of wind at 10 m + units = m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[v10m] + standard_name = y_wind_at_10m + long_name = y component of wind at 10 m + units = m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[fm] + standard_name = Monin_Obukhov_similarity_function_for_momentum + long_name = Monin-Obukhov similarity function for momentum + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[fh] + standard_name = Monin_Obukhov_similarity_function_for_heat + long_name = Monin-Obukhov similarity function for heat + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[tsea] + standard_name = surface_skin_temperature + long_name = surface skin temperature + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[heat] + standard_name = kinematic_surface_upward_sensible_heat_flux + long_name = kinematic surface upward sensible heat flux + units = K m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[evap] + standard_name = kinematic_surface_upward_latent_heat_flux + long_name = kinematic surface upward latent heat flux + units = kg kg-1 m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[stress] + standard_name = surface_wind_stress + long_name = surface wind stress + units = m2 s-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[spd1] + standard_name = wind_speed_at_lowest_model_layer + long_name = wind speed at lowest model level + units = m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[kpbl] + standard_name = vertical_index_at_top_of_atmosphere_boundary_layer + long_name = PBL top model level index + units = index + dimensions = (horizontal_dimension) + type = integer + intent = out + optional = F +[prsi] + standard_name = air_pressure_at_interface + long_name = air pressure at model layer interfaces + units = Pa + dimensions = (horizontal_dimension,vertical_dimension_plus_one) + type = real + kind = kind_phys + intent = in + optional = F +[del] + standard_name = air_pressure_difference_between_midlayers + long_name = pres(k) - pres(k+1) + units = Pa + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[prsl] + standard_name = air_pressure + long_name = mean layer pressure + units = Pa + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[prslk] + standard_name = dimensionless_exner_function_at_model_layers + long_name = Exner function at layers + units = none + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[phii] + standard_name = geopotential_at_interface + long_name = geopotential at model layer interfaces + units = m2 s-2 + dimensions = (horizontal_dimension,vertical_dimension_plus_one) + type = real + kind = kind_phys + intent = in + optional = F +[phil] + standard_name = geopotential + long_name = geopotential at model layer centers + units = m2 s-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[delt] + standard_name = time_step_for_physics + long_name = time step for physics + units = s + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[dspheat] + standard_name = flag_TKE_dissipation_heating + long_name = flag for using TKE dissipation heating + units = flag + dimensions = () + type = logical + intent = in + optional = F +[dusfc] + standard_name = instantaneous_surface_x_momentum_flux + long_name = x momentum flux + units = Pa + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[dvsfc] + standard_name = instantaneous_surface_y_momentum_flux + long_name = y momentum flux + units = Pa + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[dtsfc] + standard_name = instantaneous_surface_upward_sensible_heat_flux + long_name = surface upward sensible heat flux + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[dqsfc] + standard_name = instantaneous_surface_upward_latent_heat_flux + long_name = surface upward latent heat flux + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[hpbl] + standard_name = atmosphere_boundary_layer_thickness + long_name = PBL thickness + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[hgamt] + standard_name = countergradient_mixing_term_for_temperature + long_name = countergradient mixing term for temperature + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[hgamq] + standard_name = countergradient_mixing_term_for_water_vapor + long_name = countergradient mixing term for water vapor + units = kg kg-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[dkt] + standard_name = atmosphere_heat_diffusivity + long_name = diffusivity for heat + units = m2 s-1 + dimensions = (horizontal_dimension,vertical_dimension_minus_one) + type = real + kind = kind_phys + intent = out + optional = F +[kinver] + standard_name = index_of_highest_temperature_inversion + long_name = index of highest temperature inversion + units = index + dimensions = (horizontal_dimension) + type = integer + intent = in + optional = F +[xkzm_m] + standard_name = atmosphere_momentum_diffusivity_background + long_name = background value of momentum diffusivity + units = m2 s-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[xkzm_h] + standard_name = atmosphere_heat_diffusivity_background + long_name = background value of heat diffusivity + units = m2 s-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[xkzm_s] + standard_name = diffusivity_background_sigma_level + long_name = sigma level threshold for background diffusivity + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[lprnt] + standard_name = flag_print + long_name = flag for printing diagnostics to output + units = flag + dimensions = () + type = logical + intent = in + optional = F +[ipr] + standard_name = horizontal_index_of_printed_column + long_name = horizontal index of printed column + units = index + dimensions = () + type = integer + intent = in + optional = F +[xkzminv] + standard_name = atmosphere_heat_diffusivity_background_maximum + long_name = maximum background value of heat diffusivity + units = m2 s-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[moninq_fac] + standard_name = atmosphere_diffusivity_coefficient_factor + long_name = multiplicative constant for atmospheric diffusivities + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[islimsk] + standard_name = sea_land_ice_mask + long_name = sea/land/ice mask (=0/1/2) + units = flag + dimensions = (horizontal_dimension) + type = integer + intent = in + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F diff --git a/physics/moninshoc.f b/physics/moninshoc.f index 05473db6c..eb6ccd7e7 100644 --- a/physics/moninshoc.f +++ b/physics/moninshoc.f @@ -22,75 +22,17 @@ end subroutine moninshoc_finalize ! for tke as in Deardorff (1980) - added tridi1 ! !> \section arg_table_moninshoc_run Argument Table -!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | -!! |----------------|-----------------------------------------------------------------------------|-------------------------------------------------------|---------------|------|-----------|-----------|--------|----------| -!! | ix | horizontal_dimension | horizontal dimension | count | 0 | integer | | in | F | -!! | im | horizontal_loop_extent | horizontal loop extent | count | 0 | integer | | in | F | -!! | km | vertical_dimension | vertical layer dimension | count | 0 | integer | | in | F | -!! | ntrac | number_of_vertical_diffusion_tracers | number of tracers to diffuse vertically | count | 0 | integer | | in | F | -!! | ntcw | index_for_liquid_cloud_condensate | cloud condensate index in tracer array | index | 0 | integer | | in | F | -!! | ncnd | number_of_tracers_for_cloud_condensate | number of tracers for cloud condensate | count | 0 | integer | | in | F | -!! | dv | tendency_of_y_wind_due_to_model_physics | updated tendency of the y wind | m s-2 | 2 | real | kind_phys | inout | F | -!! | du | tendency_of_x_wind_due_to_model_physics | updated tendency of the x wind | m s-2 | 2 | real | kind_phys | inout | F | -!! | tau | tendency_of_air_temperature_due_to_model_physics | updated tendency of the temperature | K s-1 | 2 | real | kind_phys | inout | F | -!! | rtg | tendency_of_vertically_diffused_tracer_concentration | updated tendency of the tracers due to vertical diffusion in PBL scheme | kg kg-1 s-1 | 3 | real | kind_phys | inout | F | -!! | u1 | x_wind | x component of layer wind | m s-1 | 2 | real | kind_phys | in | F | -!! | v1 | y_wind | y component of layer wind | m s-1 | 2 | real | kind_phys | in | F | -!! | t1 | air_temperature | layer mean air temperature | K | 2 | real | kind_phys | in | F | -!! | q1 | vertically_diffused_tracer_concentration | tracer concentration diffused by PBL scheme | kg kg-1 | 3 | real | kind_phys | in | F | -!! | tkh | atmosphere_heat_diffusivity_from_shoc | diffusivity for heat from the SHOC scheme | m2 s-1 | 2 | real | kind_phys | in | F | -!! | prnum | prandtl_number | turbulent Prandtl number | none | 2 | real | kind_phys | inout | F | -!! | ntke | index_for_turbulent_kinetic_energy | tracer index for turbulent kinetic energy | index | 0 | integer | | in | F | -!! | psk | dimensionless_exner_function_at_lowest_model_interface | dimensionless Exner function at the surface interface | none | 1 | real | kind_phys | in | F | -!! | rbsoil | bulk_richardson_number_at_lowest_model_level | bulk Richardson number at the surface | none | 1 | real | kind_phys | in | F | -!! | zorl | surface_roughness_length | surface roughness length in cm | cm | 1 | real | kind_phys | in | F | -!! | u10m | x_wind_at_10m | x component of wind at 10 m | m s-1 | 1 | real | kind_phys | in | F | -!! | v10m | y_wind_at_10m | y component of wind at 10 m | m s-1 | 1 | real | kind_phys | in | F | -!! | fm | Monin-Obukhov_similarity_function_for_momentum | Monin-Obukhov similarity function for momentum | none | 1 | real | kind_phys | in | F | -!! | fh | Monin-Obukhov_similarity_function_for_heat | Monin-Obukhov similarity function for heat | none | 1 | real | kind_phys | in | F | -!! | tsea | surface_skin_temperature | surface skin temperature | K | 1 | real | kind_phys | in | F | -!! | heat | kinematic_surface_upward_sensible_heat_flux | kinematic surface upward sensible heat flux | K m s-1 | 1 | real | kind_phys | in | F | -!! | evap | kinematic_surface_upward_latent_heat_flux | kinematic surface upward latent heat flux | kg kg-1 m s-1 | 1 | real | kind_phys | in | F | -!! | stress | surface_wind_stress | surface wind stress | m2 s-2 | 1 | real | kind_phys | in | F | -!! | spd1 | wind_speed_at_lowest_model_layer | wind speed at lowest model level | m s-1 | 1 | real | kind_phys | in | F | -!! | kpbl | vertical_index_at_top_of_atmosphere_boundary_layer | PBL top model level index | index | 1 | integer | | out | F | -!! | prsi | air_pressure_at_interface | air pressure at model layer interfaces | Pa | 2 | real | kind_phys | in | F | -!! | del | air_pressure_difference_between_midlayers | pres(k) - pres(k+1) | Pa | 2 | real | kind_phys | in | F | -!! | prsl | air_pressure | mean layer pressure | Pa | 2 | real | kind_phys | in | F | -!! | prslk | dimensionless_exner_function_at_model_layers | Exner function at layers | none | 2 | real | kind_phys | in | F | -!! | phii | geopotential_at_interface | geopotential at model layer interfaces | m2 s-2 | 2 | real | kind_phys | in | F | -!! | phil | geopotential | geopotential at model layer centers | m2 s-2 | 2 | real | kind_phys | in | F | -!! | delt | time_step_for_physics | time step for physics | s | 0 | real | kind_phys | in | F | -!! | dusfc | instantaneous_surface_x_momentum_flux | x momentum flux | Pa | 1 | real | kind_phys | out | F | -!! | dvsfc | instantaneous_surface_y_momentum_flux | y momentum flux | Pa | 1 | real | kind_phys | out | F | -!! | dtsfc | instantaneous_surface_upward_sensible_heat_flux | surface upward sensible heat flux | W m-2 | 1 | real | kind_phys | out | F | -!! | dqsfc | instantaneous_surface_upward_latent_heat_flux | surface upward latent heat flux | W m-2 | 1 | real | kind_phys | out | F | -!! | dkt | atmosphere_heat_diffusivity | diffusivity for heat | m2 s-1 | 2 | real | kind_phys | out | F | -!! | hpbl | atmosphere_boundary_layer_thickness | PBL thickness | m | 1 | real | kind_phys | out | F | -!! | kinver | index_of_highest_temperature_inversion | index of highest temperature inversion | index | 1 | integer | | in | F | -!! | xkzm_m | atmosphere_momentum_diffusivity_background | background value of momentum diffusivity | m2 s-1 | 0 | real | kind_phys | in | F | -!! | xkzm_h | atmosphere_heat_diffusivity_background | background value of heat diffusivity | m2 s-1 | 0 | real | kind_phys | in | F | -!! | xkzm_s | diffusivity_background_sigma_level | sigma level threshold for background diffusivity | none | 0 | real | kind_phys | in | F | -!! | lprnt | flag_print | flag for printing diagnostics to output | flag | 0 | logical | | in | F | -!! | ipr | horizontal_index_of_printed_column | horizontal index of printed column | index | 0 | integer | | in | F | -!! | me | mpi_rank | current MPI-rank | index | 0 | integer | | in | F | -!! | grav | gravitational_acceleration | gravitational acceleration | m s-2 | 0 | real | kind_phys | in | F | -!! | rd | gas_constant_dry_air | ideal gas constant for dry air | J kg-1 K-1 | 0 | real | kind_phys | in | F | -!! | cp | specific_heat_of_dry_air_at_constant_pressure | specific heat of dry air at constant pressure | J kg-1 K-1 | 0 | real | kind_phys | in | F | -!! | hvap | latent_heat_of_vaporization_of_water_at_0C | latent heat of evaporation/sublimation | J kg-1 | 0 | real | kind_phys | in | F | -!! | fv | ratio_of_vapor_to_dry_air_gas_constants_minus_one | (rv/rd) - 1 (rv = ideal gas constant for water vapor) | none | 0 | real | kind_phys | in | F | -!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | -!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | +!! \htmlinclude moninshoc_run.html !! subroutine moninshoc_run (ix,im,km,ntrac,ntcw,ncnd,dv,du,tau,rtg, - & u1,v1,t1,q1,tkh,prnum,ntke, - & psk,rbsoil,zorl,u10m,v10m,fm,fh, - & tsea,heat,evap,stress,spd1,kpbl, - & prsi,del,prsl,prslk,phii,phil,delt, - & dusfc,dvsfc,dtsfc,dqsfc,dkt,hpbl, - & kinver,xkzm_m,xkzm_h,xkzm_s,lprnt,ipr,me, - & grav, rd, cp, hvap, fv, - & errmsg,errflg) + & u1,v1,t1,q1,tkh,prnum,ntke, + & psk,rbsoil,zorl,u10m,v10m,fm,fh, + & tsea,heat,evap,stress,spd1,kpbl, + & prsi,del,prsl,prslk,phii,phil,delt, + & dusfc,dvsfc,dtsfc,dqsfc,dkt,hpbl, + & kinver,xkzm_m,xkzm_h,xkzm_s,xkzminv, + & grav, rd, cp, hvap, fv, + & errmsg,errflg) ! use machine , only : kind_phys use funcphys , only : fpvs @@ -99,13 +41,12 @@ subroutine moninshoc_run (ix,im,km,ntrac,ntcw,ncnd,dv,du,tau,rtg, ! ! arguments ! - logical, intent(in) :: lprnt integer, intent(in) :: ix, im, - & km, ntrac, ntcw, ncnd, ntke, ipr, me + & km, ntrac, ntcw, ncnd, ntke integer, dimension(im), intent(in) :: kinver real(kind=kind_phys), intent(in) :: delt, - & xkzm_m, xkzm_h, xkzm_s + & xkzm_m, xkzm_h, xkzm_s, xkzminv real(kind=kind_phys), intent(in) :: grav, & rd, cp, hvap, fv real(kind=kind_phys), dimension(im), intent(in) :: psk, @@ -116,12 +57,13 @@ subroutine moninshoc_run (ix,im,km,ntrac,ntcw,ncnd,dv,du,tau,rtg, real(kind=kind_phys), dimension(ix,km,ntrac), intent(in) :: q1 real(kind=kind_phys), dimension(im,km), intent(inout) :: du, dv, - & tau, prnum + & tau real(kind=kind_phys), dimension(im,km,ntrac), intent(inout) :: rtg integer, dimension(im), intent(out) :: kpbl real(kind=kind_phys), dimension(im), intent(out) :: dusfc, & dvsfc, dtsfc, dqsfc, hpbl + real(kind=kind_phys), dimension(im,km), intent(out) :: prnum real(kind=kind_phys), dimension(im,km-1), intent(out) :: dkt character(len=*), intent(out) :: errmsg @@ -150,14 +92,13 @@ subroutine moninshoc_run (ix,im,km,ntrac,ntcw,ncnd,dv,du,tau,rtg, &, spdk2, rbint, ri, zol1, robn, bvf2 ! real(kind=kind_phys), parameter :: zolcr=0.2, - & zolcru=-0.5, rimin=-100., sfcfrac=0.1, - & crbcon=0.25, crbmin=0.15, crbmax=0.35, - & qmin=1.e-8, zfmin=1.e-8, qlmin=1.e-12, - & aphi5=5., aphi16=16., f0=1.e-4 + & zolcru=-0.5, rimin=-100., sfcfrac=0.1, + & crbcon=0.25, crbmin=0.15, crbmax=0.35, + & qmin=1.e-8, zfmin=1.e-8, qlmin=1.e-12, + & aphi5=5., aphi16=16., f0=1.e-4 &, dkmin=0.0, dkmax=1000. -! &, dkmin=0.0, dkmax=1000., xkzminv=0.3 - &, prmin=0.25, prmax=4.0 - &, vk=0.4, cfac=6.5 +! &, dkmin=0.0, dkmax=1000., xkzminv=0.3 + &, prmin=0.25, prmax=4.0, vk=0.4, cfac=6.5 real(kind=kind_phys) :: gravi, cont, conq, conw, gocp gravi = 1.0/grav @@ -176,11 +117,12 @@ subroutine moninshoc_run (ix,im,km,ntrac,ntcw,ncnd,dv,du,tau,rtg, ! if (ix < im) stop ! -! if (lprnt) write(0,*)' in moninshoc tsea=',tsea(ipr) dt2 = delt rdt = 1. / dt2 km1 = km - 1 kmpbl = km / 2 +! + rtg = 0.0 ! do k=1,km do i=1,im @@ -208,7 +150,8 @@ subroutine moninshoc_run (ix,im,km,ntrac,ntcw,ncnd,dv,du,tau,rtg, do i=1,im xkzo(i,k) = 0.0 xkzmo(i,k) = 0.0 - if (k < kinver(i)) then +! if (k < kinver(i)) then + if (k <= kinver(i)) then ! vertical background diffusivity for heat and momentum tem1 = 1.0 - prsi(i,k+1) * tx1(i) tem1 = min(1.0, exp(-tem1 * tem1 * 10.0)) @@ -217,23 +160,19 @@ subroutine moninshoc_run (ix,im,km,ntrac,ntcw,ncnd,dv,du,tau,rtg, endif enddo enddo -! if (lprnt) then -! print *,' xkzo=',(xkzo(ipr,k),k=1,km1) -! print *,' xkzmo=',(xkzmo(ipr,k),k=1,km1) -! endif ! ! diffusivity in the inversion layer is set to be xkzminv (m^2/s) ! -! do k = 1,kmpbl -! do i=1,im -! if(zi(i,k+1) > 250.) then -! tem1 = (t1(i,k+1)-t1(i,k)) * rdzt(i,k) -! if(tem1 > 1.e-5) then -! xkzo(i,k) = min(xkzo(i,k),xkzminv) -! endif -! endif -! enddo -! enddo + do k = 1,kmpbl + do i=1,im + if(zi(i,k+1) > 250.) then + tem1 = (t1(i,k+1)-t1(i,k)) * rdzt(i,k) + if(tem1 > 1.e-5) then + xkzo(i,k) = min(xkzo(i,k),xkzminv) + endif + endif + enddo + enddo ! ! do i = 1,im @@ -264,7 +203,6 @@ subroutine moninshoc_run (ix,im,km,ntrac,ntcw,ncnd,dv,du,tau,rtg, enddo enddo ! -! if (lprnt) write(0,*)' heat=',heat(ipr),' evap=',evap(ipr) do i = 1,im sflux(i) = heat(i) + evap(i)*fv*theta(i,1) if(.not.sfcflg(i) .or. sflux(i) <= 0.) pblflg(i)=.false. @@ -433,8 +371,6 @@ subroutine moninshoc_run (ix,im,km,ntrac,ntcw,ncnd,dv,du,tau,rtg, a1(i,1) = t1(i,1) + beta(i) * heat(i) a2(i,1) = q1(i,1,1) + beta(i) * evap(i) enddo -! if (lprnt) write(0,*)' a1=',a1(ipr,1),' beta=',beta(ipr) -! &,' heat=',heat(ipr), ' t1=',t1(ipr,1) ntloc = 1 if(ntrac > 1) then @@ -499,8 +435,6 @@ subroutine moninshoc_run (ix,im,km,ntrac,ntcw,ncnd,dv,du,tau,rtg, ttend = (a1(i,k)-t1(i,k)) * rdt qtend = (a2(i,k)-q1(i,k,1)) * rdt tau(i,k) = tau(i,k) + ttend -! if(lprnt .and. i==ipr .and. k<11) write(0,*)' tau=',tau(ipr,k) -! &,' ttend=',ttend,' a1=',a1(ipr,k),' t1=',t1(ipr,k) rtg(i,k,1) = rtg(i,k,1) + qtend dtsfc(i) = dtsfc(i) + cont*del(i,k)*ttend dqsfc(i) = dqsfc(i) + conq*del(i,k)*qtend diff --git a/physics/moninshoc.meta b/physics/moninshoc.meta new file mode 100644 index 000000000..80d8f71fc --- /dev/null +++ b/physics/moninshoc.meta @@ -0,0 +1,488 @@ +[ccpp-arg-table] + name = moninshoc_run + type = scheme +[ix] + standard_name = horizontal_dimension + long_name = horizontal dimension + units = count + dimensions = () + type = integer + intent = in + optional = F +[im] + standard_name = horizontal_loop_extent + long_name = horizontal loop extent + units = count + dimensions = () + type = integer + intent = in + optional = F +[km] + standard_name = vertical_dimension + long_name = vertical layer dimension + units = count + dimensions = () + type = integer + intent = in + optional = F +[ntrac] + standard_name = number_of_vertical_diffusion_tracers + long_name = number of tracers to diffuse vertically + units = count + dimensions = () + type = integer + intent = in + optional = F +[ntcw] + standard_name = index_for_liquid_cloud_condensate + long_name = cloud condensate index in tracer array + units = index + dimensions = () + type = integer + intent = in + optional = F +[ncnd] + standard_name = number_of_tracers_for_cloud_condensate + long_name = number of tracers for cloud condensate + units = count + dimensions = () + type = integer + intent = in + optional = F +[dv] + standard_name = tendency_of_y_wind_due_to_model_physics + long_name = updated tendency of the y wind + units = m s-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[du] + standard_name = tendency_of_x_wind_due_to_model_physics + long_name = updated tendency of the x wind + units = m s-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[tau] + standard_name = tendency_of_air_temperature_due_to_model_physics + long_name = updated tendency of the temperature + units = K s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[rtg] + standard_name = tendency_of_vertically_diffused_tracer_concentration + long_name = updated tendency of the tracers due to vertical diffusion in PBL scheme + units = kg kg-1 s-1 + dimensions = (horizontal_dimension,vertical_dimension,number_of_vertical_diffusion_tracers) + type = real + kind = kind_phys + intent = inout + optional = F +[u1] + standard_name = x_wind + long_name = x component of layer wind + units = m s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[v1] + standard_name = y_wind + long_name = y component of layer wind + units = m s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[t1] + standard_name = air_temperature + long_name = layer mean air temperature + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[q1] + standard_name = vertically_diffused_tracer_concentration + long_name = tracer concentration diffused by PBL scheme + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension,number_of_vertical_diffusion_tracers) + type = real + kind = kind_phys + intent = in + optional = F +[tkh] + standard_name = atmosphere_heat_diffusivity_from_shoc + long_name = diffusivity for heat from the SHOC scheme + units = m2 s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[prnum] + standard_name = prandtl_number + long_name = turbulent Prandtl number + units = none + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[ntke] + standard_name = index_for_turbulent_kinetic_energy_vertical_diffusion_tracer + long_name = index for turbulent kinetic energy in the vertically diffused tracer array + units = index + dimensions = () + type = integer + intent = in + optional = F +[psk] + standard_name = dimensionless_exner_function_at_lowest_model_interface + long_name = dimensionless Exner function at the surface interface + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[rbsoil] + standard_name = bulk_richardson_number_at_lowest_model_level + long_name = bulk Richardson number at the surface + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[zorl] + standard_name = surface_roughness_length + long_name = surface roughness length in cm + units = cm + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[u10m] + standard_name = x_wind_at_10m + long_name = x component of wind at 10 m + units = m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[v10m] + standard_name = y_wind_at_10m + long_name = y component of wind at 10 m + units = m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[fm] + standard_name = Monin_Obukhov_similarity_function_for_momentum + long_name = Monin-Obukhov similarity function for momentum + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[fh] + standard_name = Monin_Obukhov_similarity_function_for_heat + long_name = Monin-Obukhov similarity function for heat + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[tsea] + standard_name = surface_skin_temperature + long_name = surface skin temperature + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[heat] + standard_name = kinematic_surface_upward_sensible_heat_flux + long_name = kinematic surface upward sensible heat flux + units = K m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[evap] + standard_name = kinematic_surface_upward_latent_heat_flux + long_name = kinematic surface upward latent heat flux + units = kg kg-1 m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[stress] + standard_name = surface_wind_stress + long_name = surface wind stress + units = m2 s-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[spd1] + standard_name = wind_speed_at_lowest_model_layer + long_name = wind speed at lowest model level + units = m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[kpbl] + standard_name = vertical_index_at_top_of_atmosphere_boundary_layer + long_name = PBL top model level index + units = index + dimensions = (horizontal_dimension) + type = integer + intent = out + optional = F +[prsi] + standard_name = air_pressure_at_interface + long_name = air pressure at model layer interfaces + units = Pa + dimensions = (horizontal_dimension,vertical_dimension_plus_one) + type = real + kind = kind_phys + intent = in + optional = F +[del] + standard_name = air_pressure_difference_between_midlayers + long_name = pres(k) - pres(k+1) + units = Pa + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[prsl] + standard_name = air_pressure + long_name = mean layer pressure + units = Pa + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[prslk] + standard_name = dimensionless_exner_function_at_model_layers + long_name = Exner function at layers + units = none + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[phii] + standard_name = geopotential_at_interface + long_name = geopotential at model layer interfaces + units = m2 s-2 + dimensions = (horizontal_dimension,vertical_dimension_plus_one) + type = real + kind = kind_phys + intent = in + optional = F +[phil] + standard_name = geopotential + long_name = geopotential at model layer centers + units = m2 s-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[delt] + standard_name = time_step_for_physics + long_name = time step for physics + units = s + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[dusfc] + standard_name = instantaneous_surface_x_momentum_flux + long_name = x momentum flux + units = Pa + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[dvsfc] + standard_name = instantaneous_surface_y_momentum_flux + long_name = y momentum flux + units = Pa + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[dtsfc] + standard_name = instantaneous_surface_upward_sensible_heat_flux + long_name = surface upward sensible heat flux + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[dqsfc] + standard_name = instantaneous_surface_upward_latent_heat_flux + long_name = surface upward latent heat flux + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[dkt] + standard_name = atmosphere_heat_diffusivity + long_name = diffusivity for heat + units = m2 s-1 + dimensions = (horizontal_dimension,vertical_dimension_minus_one) + type = real + kind = kind_phys + intent = out + optional = F +[hpbl] + standard_name = atmosphere_boundary_layer_thickness + long_name = PBL thickness + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[kinver] + standard_name = index_of_highest_temperature_inversion + long_name = index of highest temperature inversion + units = index + dimensions = (horizontal_dimension) + type = integer + intent = in + optional = F +[xkzm_m] + standard_name = atmosphere_momentum_diffusivity_background + long_name = background value of momentum diffusivity + units = m2 s-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[xkzm_h] + standard_name = atmosphere_heat_diffusivity_background + long_name = background value of heat diffusivity + units = m2 s-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[xkzm_s] + standard_name = diffusivity_background_sigma_level + long_name = sigma level threshold for background diffusivity + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[xkzminv] + standard_name = atmosphere_heat_diffusivity_background_maximum + long_name = max. background val. diffusivity in inversion layers + units = m2 s-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[grav] + standard_name = gravitational_acceleration + long_name = gravitational acceleration + units = m s-2 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[rd] + standard_name = gas_constant_dry_air + long_name = ideal gas constant for dry air + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[cp] + standard_name = specific_heat_of_dry_air_at_constant_pressure + long_name = specific heat of dry air at constant pressure + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[hvap] + standard_name = latent_heat_of_vaporization_of_water_at_0C + long_name = latent heat of evaporation/sublimation + units = J kg-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[fv] + standard_name = ratio_of_vapor_to_dry_air_gas_constants_minus_one + long_name = (rv/rd) - 1 (rv = ideal gas constant for water vapor) + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F diff --git a/physics/mp_fer_hires.F90 b/physics/mp_fer_hires.F90 new file mode 100644 index 000000000..95e521141 --- /dev/null +++ b/physics/mp_fer_hires.F90 @@ -0,0 +1,401 @@ +!>\file mp_fer_hires.F90 +!! This file contains + +! +module mp_fer_hires + + use machine, only : kind_phys + + use module_mp_fer_hires, only : ferrier_init_hr, FER_HIRES + + implicit none + + public :: mp_fer_hires_init, mp_fer_hires_run, mp_fer_hires_finalize + + private + + logical :: is_initialized = .False. + + ! * T_ICE - temperature (C) threshold at which all remaining liquid water + ! is glaciated to ice + ! * T_ICE_init - maximum temperature (C) at which ice nucleation occurs + REAL, PUBLIC, PARAMETER :: T_ICE=-40., & + T0C=273.15, & + T_ICEK=T0C+T_ICE + + contains + +!> This subroutine initialize constants & lookup tables for Ferrier-Aligao MP +!! scheme. +!> \section arg_table_mp_fer_hires_init Argument Table +!! \htmlinclude mp_fer_hires_init.html +!! + subroutine mp_fer_hires_init(ncol, nlev, dtp, imp_physics, & + imp_physics_fer_hires, & + restart, & + f_ice,f_rain,f_rimef, & + mpicomm, mpirank,mpiroot, & + threads, errmsg, errflg) + + USE machine, ONLY : kind_phys + USE MODULE_MP_FER_HIRES, ONLY : FERRIER_INIT_HR + implicit none + + integer, intent(in) :: ncol + integer, intent(in) :: nlev + real(kind_phys), intent(in) :: dtp + integer, intent(in) :: imp_physics + integer, intent(in) :: imp_physics_fer_hires + integer, intent(in) :: mpicomm + integer, intent(in) :: mpirank + integer, intent(in) :: mpiroot + integer, intent(in) :: threads + logical, intent(in) :: restart + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + real(kind_phys), intent(out), optional :: f_ice(1:ncol,1:nlev) + real(kind_phys), intent(out), optional :: f_rain(1:ncol,1:nlev) + real(kind_phys), intent(out), optional :: f_rimef(1:ncol,1:nlev) + + + ! Local variables + integer :: ims, ime, lm,i,k + !real(kind=kind_phys) :: DT_MICRO + + ! Initialize the CCPP error handling variables + errmsg = '' + errflg = 0 + + if (is_initialized) return + + ! Set internal dimensions + ims = 1 + ime = ncol + lm = nlev + + ! MZ* temporary + if (mpirank==mpiroot) then + write(0,*) ' -----------------------------------------------' + write(0,*) ' --- !!! WARNING !!! ---' + write(0,*) ' --- the CCPP Ferrier-Aligo MP scheme is ---' + write(0,*) ' --- currently under development, use at ---' + write(0,*) ' --- your own risk . ---' + write(0,*) ' -----------------------------------------------' + end if + ! MZ* temporary + + if (imp_physics /= imp_physics_fer_hires ) then + write(errmsg,'(*(a))') "Logic error: namelist choice of microphysics is different from Ferrier-Aligo MP" + errflg = 1 + return + end if + + !MZ: fer_hires_init() in HWRF + IF(.NOT.RESTART .AND. present(F_ICE)) THEN !HWRF + write(errmsg,'(*(a))') " WARNING: F_ICE,F_RAIN AND F_RIMEF IS REINITIALIZED " + DO K = 1,lm + DO I= ims,ime + F_ICE(i,k)=0. + F_RAIN(i,k)=0. + F_RIMEF(i,k)=1. + ENDDO + ENDDO + ENDIF + !MZ: fer_hires_init() in HWRF + + CALL FERRIER_INIT_HR(dtp,mpicomm,mpirank,mpiroot,threads,errmsg,errflg) + + if (mpirank==mpiroot) write (0,*)'F-A: FERRIER_INIT_HR finished ...' + if (errflg /= 0 ) return + + is_initialized = .true. + + + end subroutine mp_fer_hires_init + +!>\defgroup hafs_famp HAFS Ferrier-Aligo Cloud Microphysics Scheme +!> This is the CCPP-compliant FER_HIRES driver module. +!> \section arg_table_mp_fer_hires_run Argument Table +!! \htmlinclude mp_fer_hires_run.html +!! + SUBROUTINE mp_fer_hires_run(NCOL, NLEV, DT ,SPEC_ADV & + ,SLMSK & + ,PRSI,P_PHY & + ,T,Q,CWM & + ,TRAIN,SR & + ,F_ICE,F_RAIN,F_RIMEF & + ,QC,QR,QI,QG & ! wet mixing ratio + !,qc_m,qi_m,qr_m & + ,PREC &!,ACPREC -MZ:not used + ,mpirank, mpiroot, threads & + ,refl_10cm & + ,RHGRD,dx & + ,EPSQ,R_D,P608,CP,G & + ,errmsg,errflg) + +!----------------------------------------------------------------------- + USE MACHINE, ONLY: kind_phys +! + IMPLICIT NONE +! +!----------------------------------------------------------------------- +! + INTEGER,PARAMETER :: D_SS=1 +! +!------------------------ +!*** Argument Variables +!------------------------ + + integer, intent(in ) :: ncol + integer, intent(in ) :: nlev + real(kind_phys), intent(in ) :: dt + integer, intent(in ) :: threads + logical, intent(in ) :: spec_adv + integer, intent(in ) :: mpirank + integer, intent(in ) :: mpiroot + real(kind_phys), intent(in ) :: slmsk(1:ncol) + real(kind_phys), intent(in ) :: prsi(1:ncol,1:nlev+1) + real(kind_phys), intent(in ) :: p_phy(1:ncol,1:nlev) + real(kind_phys), intent(in ) :: epsq,r_d,p608,cp,g + real(kind_phys), intent(inout) :: t(1:ncol,1:nlev) + real(kind_phys), intent(inout) :: q(1:ncol,1:nlev) + real(kind_phys), intent(inout) :: cwm(1:ncol,1:nlev) + real(kind_phys), intent(inout) :: train(1:ncol,1:nlev) + real(kind_phys), intent(out ) :: sr(1:ncol) + real(kind_phys), intent(inout) :: f_ice(1:ncol,1:nlev) + real(kind_phys), intent(inout) :: f_rain(1:ncol,1:nlev) + real(kind_phys), intent(inout) :: f_rimef(1:ncol,1:nlev) + real(kind_phys), intent(inout) :: qc(1:ncol,1:nlev) + real(kind_phys), intent(inout) :: qr(1:ncol,1:nlev) + real(kind_phys), intent(inout) :: qi(1:ncol,1:nlev) + real(kind_phys), intent(inout) :: qg(1:ncol,1:nlev) ! QRIMEF + + real(kind_phys), intent(inout) :: prec(1:ncol) +! real(kind_phys) :: acprec(1:ncol) !MZ: change to local + real(kind_phys), intent(inout) :: refl_10cm(1:ncol,1:nlev) + real(kind_phys), intent(in ) :: rhgrd + real(kind_phys), intent(in ) :: dx(1:ncol) + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg +! +!--------------------- +!*** Local Variables +!--------------------- +! + integer :: I,J,K,N + integer :: lowlyr(1:ncol) + integer :: dx1 + !real(kind_phys) :: mprates(1:ncol,1:nlev,d_ss) + real(kind_phys) :: DTPHS,PCPCOL,RDTPHS,TNEW + real(kind_phys) :: ql(1:nlev),tl(1:nlev) + real(kind_phys) :: rainnc(1:ncol),rainncv(1:ncol) + real(kind_phys) :: snownc(1:ncol),snowncv(1:ncol) + real(kind_phys) :: graupelncv(1:ncol) + real(kind_phys) :: dz(1:ncol,1:nlev) + real(kind_phys) :: pi_phy(1:ncol,1:nlev) + real(kind_phys) :: rr(1:ncol,1:nlev) + real(kind_phys) :: th_phy(1:ncol,1:nlev) + real(kind_phys) :: R_G, CAPPA + +! Dimension + integer :: ims, ime, jms, jme, lm + +!----------------------------------------------------------------------- +!*********************************************************************** +!----------------------------------------------------------------------- + R_G=1./G + CAPPA=R_D/CP + + ! Initialize the CCPP error handling variables + errmsg = '' + errflg = 0 + + ! Check initialization state + if (.not. is_initialized) then + write(errmsg, fmt='((a))') 'mp_fer_hires_run called before mp_fer_hires_init' + errflg = 1 + return + end if + + +!ZM NTSD=ITIMESTEP +!ZM presume nphs=1 DTPHS=NPHS*DT + DTPHS=DT + RDTPHS=1./DTPHS +!ZM AVRAIN=AVRAIN+1. + +! Set internal dimensions + ims = 1 + ime = ncol + jms = 1 + jme = 1 + lm = nlev + +! Use the dx of the 1st i point to set an integer value of dx to be used for +! determining where RHgrd should be set to 0.98 in the coarse domain when running HAFS. + DX1=NINT(DX(1)) + +!----------------------------------------------------------------------- +!*** NOTE: THE NMMB HAS IJK STORAGE WITH LAYER 1 AT THE TOP. +!*** THE WRF PHYSICS DRIVERS HAVE IKJ STORAGE WITH LAYER 1 +!*** AT THE BOTTOM. +!----------------------------------------------------------------------- +!....................................................................... + DO I=IMS,IME +! + LOWLYR(I)=1 +! +!----------------------------------------------------------------------- +!*** FILL RAINNC WITH ZERO (NORMALLY CONTAINS THE NONCONVECTIVE +!*** ACCUMULATED RAIN BUT NOT YET USED BY NMM) +!*** COULD BE OBTAINED FROM ACPREC AND CUPREC (ACPREC-CUPREC) +!----------------------------------------------------------------------- +!..The NC variables were designed to hold simulation total accumulations +!.. whereas the NCV variables hold timestep only values, so change below +!.. to zero out only the timestep amount preparing to go into each +!.. micro routine while allowing NC vars to accumulate continually. +!.. But, the fact is, the total accum variables are local, never saved +!.. nor written so they go nowhere at the moment. +! + RAINNC (I)=0. ! NOT YET USED BY NMM + RAINNCv(I)=0. + SNOWNCv(I)=0. + graupelncv(i) = 0.0 +! +!----------------------------------------------------------------------- +!*** FILL THE SINGLE-COLUMN INPUT +!----------------------------------------------------------------------- +! + DO K=LM,1,-1 ! We are moving down from the top in the flipped arrays + +! +! TL(K)=T(I,K) +! QL(K)=AMAX1(Q(I,K),EPSQ) +! + RR(I,K)=P_PHY(I,K)/(R_D*T(I,K)*(P608*AMAX1(Q(I,K),EPSQ)+1.)) + PI_PHY(I,K)=(P_PHY(I,K)*1.E-5)**CAPPA + TH_PHY(I,K)=T(I,K)/PI_PHY(I,K) + DZ(I,K)=(PRSI(I,K)-PRSI(I,K+1))*R_G/RR(I,K) + +! +!*** CALL MICROPHYSICS + +!MZ* in HWRF +!-- 6/11/2010: Update cwm, F_ice, F_rain and F_rimef arrays + cwm(I,K)=QC(I,K)+QR(I,K)+QI(I,K) + IF (QI(I,K) <= EPSQ) THEN + F_ICE(I,K)=0. + F_RIMEF(I,K)=1. + IF (T(I,K) < T_ICEK) F_ICE(I,K)=1. + ELSE + F_ICE(I,K)=MAX( 0., MIN(1., QI(I,K)/cwm(I,K) ) ) + F_RIMEF(I,K)=QG(I,K)/QI(I,K) + ENDIF + IF (QR(I,K) <= EPSQ) THEN + F_RAIN(I,K)=0. + ELSE + F_RAIN(I,K)=QR(I,K)/(QR(I,K)+QC(I,K)) + ENDIF + + end do + enddo + +!--------------------------------------------------------------------- +!*** Update the rime factor array after 3d advection +!--------------------------------------------------------------------- +!MZ* in namphysics +! DO K=1,LM +! DO I=IMS,IME +! IF (QG(I,K)>EPSQ .AND. QI(I,K)>EPSQ) THEN +! F_RIMEF(I,K)=MIN(50.,MAX(1.,QG(I,K)/QI(I,K))) +! ELSE +! F_RIMEF(I,K)=1. +! ENDIF +! ENDDO +! ENDDO + + +!--------------------------------------------------------------------- + + CALL FER_HIRES( & + DT=dtphs,RHgrd=RHGRD & + ,DZ8W=dz,RHO_PHY=rr,P_PHY=p_phy,PI_PHY=pi_phy & + ,TH_PHY=th_phy,T_PHY=t & + ,Q=Q,QT=cwm & + ,LOWLYR=LOWLYR,SR=SR & + ,F_ICE_PHY=F_ICE,F_RAIN_PHY=F_RAIN & + ,F_RIMEF_PHY=F_RIMEF & + ,QC=QC,QR=QR,QS=QI & + ,RAINNC=rainnc,RAINNCV=rainncv & + ,threads=threads & + ,IMS=IMS,IME=IME,JMS=JMS,JME=JME,LM=LM & + ,D_SS=d_ss & + ,refl_10cm=refl_10cm,DX1=DX1) + + +!....................................................................... + +!MZ* +!Aligo Oct-23-2019 +! - Convert dry qc,qr,qi back to wet mixing ratio +! DO K = 1, LM +! DO I= IMS, IME +! qc_m(i,k) = qc(i,k)/(1.0_kind_phys+q(i,k)) +! qi_m(i,k) = qi(i,k)/(1.0_kind_phys+q(i,k)) +! qr_m(i,k) = qr(i,k)/(1.0_kind_phys+q(i,k)) +! ENDDO +! ENDDO + + + +!----------------------------------------------------------- + DO K=1,LM + DO I=IMS,IME + +!--------------------------------------------------------------------- +!*** Calculate graupel from total ice array and rime factor +!--------------------------------------------------------------------- + +!MZ + IF (SPEC_ADV) then + QG(I,K)=QI(I,K)*F_RIMEF(I,K) + ENDIF + +! +!----------------------------------------------------------------------- +!*** UPDATE TEMPERATURE, SPECIFIC HUMIDITY, CLOUD WATER, AND HEATING. +!----------------------------------------------------------------------- +! + TNEW=TH_PHY(I,K)*PI_PHY(I,K) + TRAIN(I,K)=TRAIN(I,K)+(TNEW-T(I,K))*RDTPHS + T(I,K)=TNEW + ENDDO + ENDDO + +!....................................................................... + +! +!----------------------------------------------------------------------- +!*** UPDATE PRECIPITATION +!----------------------------------------------------------------------- +! + DO I=IMS,IME + PCPCOL=RAINNCV(I)*1.E-3 !MZ:unit:m + PREC(I)=PREC(I)+PCPCOL +!MZ ACPREC(I)=ACPREC(I)+PCPCOL !MZ: not used +! +! NOTE: RAINNC IS ACCUMULATED INSIDE MICROPHYSICS BUT NMM ZEROES IT OUT ABOVE +! SINCE IT IS ONLY A LOCAL ARRAY FOR NOW +! + ENDDO +!----------------------------------------------------------------------- +! + end subroutine mp_fer_hires_run + + +!> \section arg_table_mp_fer_hires_finalize Argument Table +!! + subroutine mp_fer_hires_finalize () + end subroutine mp_fer_hires_finalize + +end module mp_fer_hires diff --git a/physics/mp_fer_hires.meta b/physics/mp_fer_hires.meta new file mode 100644 index 000000000..a7a33378a --- /dev/null +++ b/physics/mp_fer_hires.meta @@ -0,0 +1,426 @@ +[ccpp-arg-table] + name = mp_fer_hires_init + type = scheme +[ncol] + standard_name = horizontal_loop_extent + long_name = horizontal loop extent + units = count + dimensions = () + type = integer + intent = in + optional = F +[nlev] + standard_name = vertical_dimension + long_name = vertical layer dimension + units = count + dimensions = () + type = integer + intent = in + optional = F +[dtp] + standard_name = time_step_for_physics + long_name = physics timestep + units = s + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[imp_physics] + standard_name = flag_for_microphysics_scheme + long_name = choice of microphysics scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F +[imp_physics_fer_hires] + standard_name = flag_for_fer_hires_microphysics_scheme + long_name = choice of Ferrier-Aligo microphysics scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F +[restart] + standard_name = flag_for_restart + long_name = flag for restart (warmstart) or coldstart + units = flag + dimensions = () + type = logical + intent = in + optional = F +[f_ice] + standard_name = fraction_of_ice_water_cloud + long_name = fraction of ice water cloud + units = frac + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = T +[f_rain] + standard_name = fraction_of_rain_water_cloud + long_name = fraction of rain water cloud + units = frac + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = T +[f_rimef] + standard_name = rime_factor + long_name = rime factor + units = frac + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = T +[mpicomm] + standard_name = mpi_comm + long_name = MPI communicator + units = index + dimensions = () + type = integer + intent = in + optional = F +[mpirank] + standard_name = mpi_rank + long_name = current MPI-rank + units = index + dimensions = () + type = integer + intent = in + optional = F +[mpiroot] + standard_name = mpi_root + long_name = master MPI-rank + units = index + dimensions = () + type = integer + intent = in + optional = F +[threads] + standard_name = omp_threads + long_name = number of OpenMP threads available to scheme + units = count + dimensions = () + type = integer + intent = in + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F +######################################################################## +[ccpp-arg-table] + name = mp_fer_hires_finalize + type = scheme +######################################################################## +[ccpp-arg-table] + name = mp_fer_hires_run + type = scheme +[ncol] + standard_name = horizontal_loop_extent + long_name = horizontal loop extent + units = count + dimensions = () + type = integer + intent = in + optional = F +[nlev] + standard_name = vertical_dimension + long_name = vertical layer dimension + units = count + dimensions = () + type = integer + intent = in + optional = F +[dt] + standard_name = time_step_for_physics + long_name = physics time step + units = s + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[spec_adv] + standard_name = flag_for_individual_cloud_species_advected + long_name = flag for individual cloud species advected + units = flag + dimensions = () + type = logical + intent = in + optional = F +[slmsk] + standard_name = sea_land_ice_mask_real + long_name = landmask: sea/land/ice=0/1/2 + units = flag + dimensions = (horizontal_dimension) + type = real + kind= kind_phys + intent = in + optional = F +[prsi] + standard_name = air_pressure_at_interface + long_name = air pressure at model layer interfaces + units = Pa + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[p_phy] + standard_name = air_pressure + long_name = mean layer pressure + units = Pa + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[t] + standard_name = air_temperature_updated_by_physics + long_name = temperature updated by physics + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[q] + standard_name = water_vapor_specific_humidity_updated_by_physics + long_name = water vapor specific humidity updated by physics + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[cwm] + standard_name = total_cloud_condensate_mixing_ratio_updated_by_physics + long_name = total cloud condensate mixing ratio (except water vapor) updated by physics + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[train] + standard_name = accumulated_change_of_air_temperature_due_to_FA_scheme + long_name = accumulated change of air temperature due to FA MP scheme + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[sr] + standard_name = ratio_of_snowfall_to_rainfall + long_name = snow ratio: ratio of snow to total precipitation (explicit only) + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[f_ice] + standard_name = fraction_of_ice_water_cloud + long_name = fraction of ice water cloud + units = frac + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[f_rain] + standard_name = fraction_of_rain_water_cloud + long_name = fraction of rain water cloud + units = frac + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[f_rimef] + standard_name = rime_factor + long_name = rime factor + units = frac + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[qc] + standard_name = cloud_condensed_water_mixing_ratio_updated_by_physics + long_name = ratio of mass of cloud water to mass of dry air plus vapor (without condensates) updated by physics + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[qi] + standard_name = ice_water_mixing_ratio_updated_by_physics + long_name = ratio of mass of ice water to mass of dry air plus vapor (without condensates) updated by physics + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[qr] + standard_name = rain_water_mixing_ratio_updated_by_physics + long_name = ratio of mass of rain water to mass of dry air plus vapor (without condensates) updated by physics + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[qg] + standard_name = mass_weighted_rime_factor_updated_by_physics + long_name = mass weighted rime factor updated by physics + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[prec] + standard_name = lwe_thickness_of_explicit_precipitation_amount + long_name = explicit precipitation ( rain, ice, snow, graupel, ...) on physics timestep + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[mpirank] + standard_name = mpi_rank + long_name = current MPI-rank + units = index + dimensions = () + type = integer + intent = in + optional = F +[mpiroot] + standard_name = mpi_root + long_name = master MPI-rank + units = index + dimensions = () + type = integer + intent = in + optional = F +[threads] + standard_name = omp_threads + long_name = number of OpenMP threads available to scheme + units = count + dimensions = () + type = integer + intent = in + optional = F +[refl_10cm] + standard_name = radar_reflectivity_10cm + long_name = instantaneous refl_10cm + units = dBZ + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[rhgrd] + standard_name = fa_threshold_relative_humidity_for_onset_of_condensation + long_name = relative humidity threshold parameter for condensation for FA scheme + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[dx] + standard_name = cell_size + long_name = relative dx for the grid cell + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[EPSQ] + standard_name = minimum_value_of_specific_humidity + long_name = floor value for specific humidity + units = kg kg-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[R_D] + standard_name = gas_constant_dry_air + long_name = ideal gas constant for dry air + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[P608] + standard_name = ratio_of_vapor_to_dry_air_gas_constants_minus_one + long_name = (rv/rd) - 1 (rv = ideal gas constant for water vapor) + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[CP] + standard_name = specific_heat_of_dry_air_at_constant_pressure + long_name = specific heat of dry air at constant pressure + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[G] + standard_name = gravitational_acceleration + long_name = gravitational acceleration + units = m s-2 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F diff --git a/physics/mp_thompson.F90 b/physics/mp_thompson.F90 index e87847f95..2978b8df2 100644 --- a/physics/mp_thompson.F90 +++ b/physics/mp_thompson.F90 @@ -1,11 +1,9 @@ !>\file mp_thompson.F90 -!! This file contains NOAA/GSD's Thompson MP scheme. +!! This file contains aerosol-aware Thompson MP scheme. -!>\defgroup aathompson GSD Aerosol-Aware Thompson MP Module -!! -!! Last modified 4 Apr 2019: remove legacy debugging code D. Heinzeller -!> @{ +!>\defgroup aathompson Aerosol-Aware Thompson MP Module +!! This module contains the aerosol-aware Thompson microphysics scheme. module mp_thompson use machine, only : kind_phys @@ -25,23 +23,7 @@ module mp_thompson !> This subroutine is a wrapper around the actual mp_gt_driver(). #if 0 !! \section arg_table_mp_thompson_init Argument Table -!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | -!! |----------------------|-------------------------------------------------------|----------------------------------------------------------|------------|------|-----------|-----------|--------|----------| -!! | ncol | horizontal_loop_extent | horizontal loop extent | count | 0 | integer | | in | F | -!! | nlev | vertical_dimension | number of vertical levels | count | 0 | integer | | in | F | -!! | is_aerosol_aware | flag_for_aerosol_physics | flag for aerosol-aware physics | flag | 0 | logical | | in | F | -!! | nwfa2d | tendency_of_water_friendly_aerosols_at_surface | instantaneous fake water-friendly surface aerosol source | kg-1 s-1 | 1 | real | kind_phys | inout | T | -!! | nifa2d | tendency_of_ice_friendly_aerosols_at_surface | instantaneous fake ice-friendly surface aerosol source | kg-1 s-1 | 1 | real | kind_phys | inout | T | -!! | nwfa | water_friendly_aerosol_number_concentration | number concentration of water-friendly aerosols | kg-1 | 2 | real | kind_phys | inout | T | -!! | nifa | ice_friendly_aerosol_number_concentration | number concentration of ice-friendly aerosols | kg-1 | 2 | real | kind_phys | inout | T | -!! | mpicomm | mpi_comm | MPI communicator | index | 0 | integer | | in | F | -!! | mpirank | mpi_rank | current MPI-rank | index | 0 | integer | | in | F | -!! | mpiroot | mpi_root | master MPI-rank | index | 0 | integer | | in | F | -!! | threads | omp_threads | number of OpenMP threads available to scheme | count | 0 | integer | | in | F | -!! | imp_physics | flag_for_microphysics_scheme | choice of microphysics scheme | flag | 0 | integer | | in | F | -!! | imp_physics_thompson | flag_for_thompson_microphysics_scheme | choice of Thompson microphysics scheme | flag | 0 | integer | | in | F | -!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | -!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | +!! \htmlinclude mp_thompson_init.html !! #endif subroutine mp_thompson_init(ncol, nlev, is_aerosol_aware, & @@ -56,7 +38,6 @@ subroutine mp_thompson_init(ncol, nlev, is_aerosol_aware, & ! Interface variables integer, intent(in) :: ncol integer, intent(in) :: nlev - logical, intent(in) :: is_aerosol_aware real(kind_phys), optional, intent(inout) :: nwfa2d(1:ncol) real(kind_phys), optional, intent(inout) :: nifa2d(1:ncol) @@ -126,7 +107,7 @@ subroutine mp_thompson_init(ncol, nlev, is_aerosol_aware, & ims=ims, ime=ime, jms=jms, jme=jme, kms=kms, kme=kme, & its=its, ite=ite, jts=jts, jte=jte, kts=kts, kte=kte, & mpicomm=mpicomm, mpirank=mpirank, mpiroot=mpiroot, & - threads=threads) + threads=threads, errmsg=errmsg, errflg=errflg) if (errflg /= 0) return else if (is_aerosol_aware) then write(errmsg,fmt='(*(a))') 'Logic error in mp_thompson_init:', & @@ -139,7 +120,7 @@ subroutine mp_thompson_init(ncol, nlev, is_aerosol_aware, & ims=ims, ime=ime, jms=jms, jme=jme, kms=kms, kme=kme, & its=its, ite=ite, jts=jts, jte=jte, kts=kts, kte=kte, & mpicomm=mpicomm, mpirank=mpirank, mpiroot=mpiroot, & - threads=threads) + threads=threads, errmsg=errmsg, errflg=errflg) if (errflg /= 0) return end if @@ -149,62 +130,22 @@ end subroutine mp_thompson_init #if 0 -!! \section arg_table_mp_thompson_run Argument Table -!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | -!! |-----------------|-----------------------------------------------------------------------|-----------------------------------------------------------------------|------------|------|-----------|-----------|--------|----------| -!! | ncol | horizontal_loop_extent | horizontal loop extent | count | 0 | integer | | in | F | -!! | nlev | vertical_dimension | number of vertical levels | count | 0 | integer | | in | F | -!! | con_g | gravitational_acceleration | gravitational acceleration | m s-2 | 0 | real | kind_phys | in | F | -!! | con_rd | gas_constant_dry_air | ideal gas constant for dry air | J kg-1 K-1 | 0 | real | kind_phys | in | F | -!! | spechum | water_vapor_specific_humidity_updated_by_physics | water vapor specific humidity | kg kg-1 | 2 | real | kind_phys | inout | F | -!! | qc | cloud_condensed_water_mixing_ratio_updated_by_physics | cloud water mixing ratio wrt dry+vapor (no condensates) | kg kg-1 | 2 | real | kind_phys | inout | F | -!! | qr | rain_water_mixing_ratio_updated_by_physics | rain water mixing ratio wrt dry+vapor (no condensates) | kg kg-1 | 2 | real | kind_phys | inout | F | -!! | qi | ice_water_mixing_ratio_updated_by_physics | ice water mixing ratio wrt dry+vapor (no condensates) | kg kg-1 | 2 | real | kind_phys | inout | F | -!! | qs | snow_water_mixing_ratio_updated_by_physics | snow water mixing ratio wrt dry+vapor (no condensates) | kg kg-1 | 2 | real | kind_phys | inout | F | -!! | qg | graupel_mixing_ratio_updated_by_physics | graupel mixing ratio wrt dry+vapor (no condensates) | kg kg-1 | 2 | real | kind_phys | inout | F | -!! | ni | ice_number_concentration_updated_by_physics | ice number concentration | kg-1 | 2 | real | kind_phys | inout | F | -!! | nr | rain_number_concentration_updated_by_physics | rain number concentration | kg-1 | 2 | real | kind_phys | inout | F | -!! | is_aerosol_aware| flag_for_aerosol_physics | flag for aerosol-aware physics | flag | 0 | logical | | in | F | -!! | nc | cloud_droplet_number_concentration_updated_by_physics | cloud droplet number concentration | kg-1 | 2 | real | kind_phys | inout | T | -!! | nwfa | water_friendly_aerosol_number_concentration_updated_by_physics | number concentration of water-friendly aerosols | kg-1 | 2 | real | kind_phys | inout | T | -!! | nifa | ice_friendly_aerosol_number_concentration_updated_by_physics | number concentration of ice-friendly aerosols | kg-1 | 2 | real | kind_phys | inout | T | -!! | nwfa2d | tendency_of_water_friendly_aerosols_at_surface | instantaneous fake water-friendly surface aerosol source | kg-1 s-1 | 1 | real | kind_phys | in | T | -!! | nifa2d | tendency_of_ice_friendly_aerosols_at_surface | instantaneous fake ice-friendly surface aerosol source | kg-1 s-1 | 1 | real | kind_phys | in | T | -!! | tgrs | air_temperature_updated_by_physics | model layer mean temperature | K | 2 | real | kind_phys | inout | F | -!! | prsl | air_pressure | mean layer pressure | Pa | 2 | real | kind_phys | in | F | -!! | phii | geopotential_at_interface | geopotential at model layer interfaces | m2 s-2 | 2 | real | kind_phys | in | F | -!! | omega | omega | layer mean vertical velocity | Pa s-1 | 2 | real | kind_phys | in | F | -!! | dtp | time_step_for_physics | physics timestep | s | 0 | real | kind_phys | in | F | -!! | prcp | lwe_thickness_of_explicit_precipitation_amount | explicit precipitation (rain, ice, snow, graupel) on physics timestep | m | 1 | real | kind_phys | inout | F | -!! | rain | lwe_thickness_of_explicit_rain_amount | explicit rain fall on physics timestep | m | 1 | real | kind_phys | inout | F | -!! | graupel | lwe_thickness_of_graupel_amount | graupel fall on physics timestep | m | 1 | real | kind_phys | inout | F | -!! | ice | lwe_thickness_of_ice_amount | ice fall on physics timestep | m | 1 | real | kind_phys | inout | F | -!! | snow | lwe_thickness_of_snow_amount | snow fall on physics timestep | m | 1 | real | kind_phys | inout | F | -!! | sr | ratio_of_snowfall_to_rainfall | ratio of snowfall to large-scale rainfall | frac | 1 | real | kind_phys | out | F | -!! | refl_10cm | radar_reflectivity_10cm | instantaneous refl_10cm | dBZ | 2 | real | kind_phys | out | F | -!! | do_radar_ref | flag_for_radar_reflectivity | flag for radar reflectivity | flag | 0 | logical | | in | F | -!! | re_cloud | effective_radius_of_stratiform_cloud_liquid_water_particle_in_um | eff. radius of cloud liquid water particle in micrometer | um | 2 | real | kind_phys | none | F | -!! | re_ice | effective_radius_of_stratiform_cloud_ice_particle_in_um | eff. radius of cloud ice water particle in micrometer | um | 2 | real | kind_phys | none | F | -!! | re_snow | effective_radius_of_stratiform_cloud_snow_particle_in_um | effective radius of cloud snow particle in micrometers | um | 2 | real | kind_phys | none | F | -!! | mpicomm | mpi_comm | MPI communicator | index | 0 | integer | | in | F | -!! | mpirank | mpi_rank | current MPI-rank | index | 0 | integer | | in | F | -!! | mpiroot | mpi_root | master MPI-rank | index | 0 | integer | | in | F | -!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | -!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | +!> \section arg_table_mp_thompson_run Argument Table +!! \htmlinclude mp_thompson_run.html !! #endif !>\ingroup aathompson -!>\section gen_thompson_hrrr GSD Thompson MP General Algorithm +!>\section gen_thompson_hrrr Thompson MP General Algorithm !>@{ - subroutine mp_thompson_run(ncol, nlev, con_g, con_rd, & - spechum, qc, qr, qi, qs, qg, ni, nr, & - is_aerosol_aware, nc, nwfa, nifa, & - nwfa2d, nifa2d, & - tgrs, prsl, phii, omega, dtp, & - prcp, rain, graupel, ice, snow, sr, & - refl_10cm, do_radar_ref, & - re_cloud, re_ice, re_snow, & - mpicomm, mpirank, mpiroot, & + subroutine mp_thompson_run(ncol, nlev, con_g, con_rd, & + spechum, qc, qr, qi, qs, qg, ni, nr, & + is_aerosol_aware, nc, nwfa, nifa, & + nwfa2d, nifa2d, & + tgrs, prsl, phii, omega, dtp, & + prcp, rain, graupel, ice, snow, sr, & + refl_10cm, reset, do_radar_ref, & + re_cloud, re_ice, re_snow, & + mpicomm, mpirank, mpiroot, & errmsg, errflg) implicit none @@ -226,12 +167,12 @@ subroutine mp_thompson_run(ncol, nlev, con_g, con_rd, & real(kind_phys), intent(inout) :: ni(1:ncol,1:nlev) real(kind_phys), intent(inout) :: nr(1:ncol,1:nlev) ! Aerosols - logical, intent(in) :: is_aerosol_aware - real(kind_phys), optional, intent(inout) :: nc(1:ncol,1:nlev) - real(kind_phys), optional, intent(inout) :: nwfa(1:ncol,1:nlev) - real(kind_phys), optional, intent(inout) :: nifa(1:ncol,1:nlev) - real(kind_phys), optional, intent(in ) :: nwfa2d(1:ncol) - real(kind_phys), optional, intent(in ) :: nifa2d(1:ncol) + logical, intent(in) :: is_aerosol_aware,reset + real(kind_phys), optional, intent(inout) :: nc(:,:) + real(kind_phys), optional, intent(inout) :: nwfa(:,:) + real(kind_phys), optional, intent(inout) :: nifa(:,:) + real(kind_phys), optional, intent(in ) :: nwfa2d(:) + real(kind_phys), optional, intent(in ) :: nifa2d(:) ! State variables and timestep information real(kind_phys), intent(inout) :: tgrs(1:ncol,1:nlev) real(kind_phys), intent(in ) :: prsl(1:ncol,1:nlev) @@ -288,9 +229,6 @@ subroutine mp_thompson_run(ncol, nlev, con_g, con_rd, & integer :: do_radar_ref_mp ! integer instead of logical do_radar_ref ! Effective cloud radii logical :: do_effective_radii - real(kind_phys) :: re_cloud_mp(1:ncol,1:nlev) ! m - real(kind_phys) :: re_ice_mp(1:ncol,1:nlev) ! m - real(kind_phys) :: re_snow_mp(1:ncol,1:nlev) ! m integer :: has_reqc integer :: has_reqi integer :: has_reqs @@ -365,6 +303,10 @@ subroutine mp_thompson_run(ncol, nlev, con_g, con_rd, & has_reqc = 1 has_reqi = 1 has_reqs = 1 + ! Initialize to zero, intent(out) variables + re_cloud = 0 + re_ice = 0 + re_snow = 0 else if (.not.present(re_cloud) .and. .not.present(re_ice) .and. .not.present(re_snow)) then do_effective_radii = .false. has_reqc = 0 @@ -377,10 +319,6 @@ subroutine mp_thompson_run(ncol, nlev, con_g, con_rd, & errflg = 1 return end if - ! Initialize to zero, intent(out) variables - re_cloud_mp = 0 - re_ice_mp = 0 - re_snow_mp = 0 ! Set internal dimensions ids = 1 @@ -415,12 +353,12 @@ subroutine mp_thompson_run(ncol, nlev, con_g, con_rd, & graupelnc=graupel_mp, graupelncv=delta_graupel_mp, sr=sr, & refl_10cm=refl_10cm, & diagflag=diagflag, do_radar_ref=do_radar_ref_mp, & - re_cloud=re_cloud_mp, re_ice=re_ice_mp, re_snow=re_snow_mp, & + re_cloud=re_cloud, re_ice=re_ice, re_snow=re_snow, & has_reqc=has_reqc, has_reqi=has_reqi, has_reqs=has_reqs, & ids=ids, ide=ide, jds=jds, jde=jde, kds=kds, kde=kde, & ims=ims, ime=ime, jms=jms, jme=jme, kms=kms, kme=kme, & its=its, ite=ite, jts=jts, jte=jte, kts=kts, kte=kte, & - errmsg=errmsg, errflg=errflg) + errmsg=errmsg, errflg=errflg, reset=reset) else call mp_gt_driver(qv=qv_mp, qc=qc_mp, qr=qr_mp, qi=qi_mp, qs=qs_mp, qg=qg_mp, & @@ -432,12 +370,12 @@ subroutine mp_thompson_run(ncol, nlev, con_g, con_rd, & graupelnc=graupel_mp, graupelncv=delta_graupel_mp, sr=sr, & refl_10cm=refl_10cm, & diagflag=diagflag, do_radar_ref=do_radar_ref_mp, & - re_cloud=re_cloud_mp, re_ice=re_ice_mp, re_snow=re_snow_mp, & + re_cloud=re_cloud, re_ice=re_ice, re_snow=re_snow, & has_reqc=has_reqc, has_reqi=has_reqi, has_reqs=has_reqs, & ids=ids, ide=ide, jds=jds, jde=jde, kds=kds, kde=kde, & ims=ims, ime=ime, jms=jms, jme=jme, kms=kms, kme=kme, & its=its, ite=ite, jts=jts, jte=jte, kts=kts, kte=kte, & - errmsg=errmsg, errflg=errflg) + errmsg=errmsg, errflg=errflg, reset=reset) end if if (errflg/=0) return @@ -456,24 +394,14 @@ subroutine mp_thompson_run(ncol, nlev, con_g, con_rd, & graupel = max(0.0, delta_graupel_mp/1000.0_kind_phys) ice = max(0.0, delta_ice_mp/1000.0_kind_phys) snow = max(0.0, delta_snow_mp/1000.0_kind_phys) - rain = max(0.0, delta_rain_mp - (delta_graupel_mp + delta_ice_mp + delta_snow_mp)/1000.0_kind_phys) - - if (do_effective_radii) then - ! Convert m to micron - re_cloud = re_cloud_mp*1.0E6_kind_phys - re_ice = re_ice_mp*1.0E6_kind_phys - re_snow = re_snow_mp*1.0E6_kind_phys - end if + rain = max(0.0, (delta_rain_mp - (delta_graupel_mp + delta_ice_mp + delta_snow_mp))/1000.0_kind_phys) end subroutine mp_thompson_run !>@} #if 0 !! \section arg_table_mp_thompson_finalize Argument Table -!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | -!! |-----------------|---------------------------------------------------------------|--------------------------------------------------------|------------|------|-----------|-----------|--------|----------| -!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | -!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | +!! \htmlinclude mp_thompson_finalize.html !! #endif subroutine mp_thompson_finalize(errmsg, errflg) @@ -496,4 +424,3 @@ subroutine mp_thompson_finalize(errmsg, errflg) end subroutine mp_thompson_finalize end module mp_thompson -!> @} diff --git a/physics/mp_thompson.meta b/physics/mp_thompson.meta new file mode 100644 index 000000000..45113cbb2 --- /dev/null +++ b/physics/mp_thompson.meta @@ -0,0 +1,506 @@ +[ccpp-arg-table] + name = mp_thompson_init + type = scheme +[ncol] + standard_name = horizontal_loop_extent + long_name = horizontal loop extent + units = count + dimensions = () + type = integer + intent = in + optional = F +[nlev] + standard_name = vertical_dimension + long_name = number of vertical levels + units = count + dimensions = () + type = integer + intent = in + optional = F +[is_aerosol_aware] + standard_name = flag_for_aerosol_physics + long_name = flag for aerosol-aware physics + units = flag + dimensions = () + type = logical + intent = in + optional = F +[nwfa2d] + standard_name = tendency_of_water_friendly_aerosols_at_surface + long_name = instantaneous fake water-friendly surface aerosol source + units = kg-1 s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = T +[nifa2d] + standard_name = tendency_of_ice_friendly_aerosols_at_surface + long_name = instantaneous fake ice-friendly surface aerosol source + units = kg-1 s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = T +[nwfa] + standard_name = water_friendly_aerosol_number_concentration + long_name = number concentration of water-friendly aerosols + units = kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = T +[nifa] + standard_name = ice_friendly_aerosol_number_concentration + long_name = number concentration of ice-friendly aerosols + units = kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = T +[mpicomm] + standard_name = mpi_comm + long_name = MPI communicator + units = index + dimensions = () + type = integer + intent = in + optional = F +[mpirank] + standard_name = mpi_rank + long_name = current MPI-rank + units = index + dimensions = () + type = integer + intent = in + optional = F +[mpiroot] + standard_name = mpi_root + long_name = master MPI-rank + units = index + dimensions = () + type = integer + intent = in + optional = F +[threads] + standard_name = omp_threads + long_name = number of OpenMP threads available to scheme + units = count + dimensions = () + type = integer + intent = in + optional = F +[imp_physics] + standard_name = flag_for_microphysics_scheme + long_name = choice of microphysics scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F +[imp_physics_thompson] + standard_name = flag_for_thompson_microphysics_scheme + long_name = choice of Thompson microphysics scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F + +######################################################################## +[ccpp-arg-table] + name = mp_thompson_run + type = scheme +[ncol] + standard_name = horizontal_loop_extent + long_name = horizontal loop extent + units = count + dimensions = () + type = integer + intent = in + optional = F +[nlev] + standard_name = vertical_dimension + long_name = number of vertical levels + units = count + dimensions = () + type = integer + intent = in + optional = F +[con_g] + standard_name = gravitational_acceleration + long_name = gravitational acceleration + units = m s-2 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[con_rd] + standard_name = gas_constant_dry_air + long_name = ideal gas constant for dry air + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[spechum] + standard_name = water_vapor_specific_humidity_updated_by_physics + long_name = water vapor specific humidity + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[qc] + standard_name = cloud_condensed_water_mixing_ratio_updated_by_physics + long_name = cloud water mixing ratio wrt dry+vapor (no condensates) + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[qr] + standard_name = rain_water_mixing_ratio_updated_by_physics + long_name = rain water mixing ratio wrt dry+vapor (no condensates) + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[qi] + standard_name = ice_water_mixing_ratio_updated_by_physics + long_name = ice water mixing ratio wrt dry+vapor (no condensates) + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[qs] + standard_name = snow_water_mixing_ratio_updated_by_physics + long_name = snow water mixing ratio wrt dry+vapor (no condensates) + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[qg] + standard_name = graupel_mixing_ratio_updated_by_physics + long_name = graupel mixing ratio wrt dry+vapor (no condensates) + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[ni] + standard_name = ice_number_concentration_updated_by_physics + long_name = ice number concentration + units = kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[nr] + standard_name = rain_number_concentration_updated_by_physics + long_name = rain number concentration + units = kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[is_aerosol_aware] + standard_name = flag_for_aerosol_physics + long_name = flag for aerosol-aware physics + units = flag + dimensions = () + type = logical + intent = in + optional = F +[nc] + standard_name = cloud_droplet_number_concentration_updated_by_physics + long_name = cloud droplet number concentration + units = kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = T +[nwfa] + standard_name = water_friendly_aerosol_number_concentration_updated_by_physics + long_name = number concentration of water-friendly aerosols + units = kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = T +[nifa] + standard_name = ice_friendly_aerosol_number_concentration_updated_by_physics + long_name = number concentration of ice-friendly aerosols + units = kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = T +[nwfa2d] + standard_name = tendency_of_water_friendly_aerosols_at_surface + long_name = instantaneous fake water-friendly surface aerosol source + units = kg-1 s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = T +[nifa2d] + standard_name = tendency_of_ice_friendly_aerosols_at_surface + long_name = instantaneous fake ice-friendly surface aerosol source + units = kg-1 s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = T +[tgrs] + standard_name = air_temperature_updated_by_physics + long_name = model layer mean temperature + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[prsl] + standard_name = air_pressure + long_name = mean layer pressure + units = Pa + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[phii] + standard_name = geopotential_at_interface + long_name = geopotential at model layer interfaces + units = m2 s-2 + dimensions = (horizontal_dimension,vertical_dimension_plus_one) + type = real + kind = kind_phys + intent = in + optional = F +[omega] + standard_name = omega + long_name = layer mean vertical velocity + units = Pa s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[dtp] + standard_name = time_step_for_physics + long_name = physics timestep + units = s + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[prcp] + standard_name = lwe_thickness_of_explicit_precipitation_amount + long_name = explicit precipitation (rain, ice, snow, graupel) on physics timestep + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[rain] + standard_name = lwe_thickness_of_explicit_rain_amount + long_name = explicit rain fall on physics timestep + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[graupel] + standard_name = lwe_thickness_of_graupel_amount + long_name = graupel fall on physics timestep + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[ice] + standard_name = lwe_thickness_of_ice_amount + long_name = ice fall on physics timestep + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[snow] + standard_name = lwe_thickness_of_snow_amount + long_name = snow fall on physics timestep + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[sr] + standard_name = ratio_of_snowfall_to_rainfall + long_name = ratio of snowfall to large-scale rainfall + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[refl_10cm] + standard_name = radar_reflectivity_10cm + long_name = instantaneous refl_10cm + units = dBZ + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[reset] + standard_name = flag_for_resetting_radar_reflectivity_calculation + long_name = flag for resetting radar reflectivity calculation + units = flag + dimensions = () + type = logical + intent = in + optional = F +[do_radar_ref] + standard_name = flag_for_radar_reflectivity + long_name = flag for radar reflectivity + units = flag + dimensions = () + type = logical + intent = in + optional = F +[re_cloud] + standard_name = effective_radius_of_stratiform_cloud_liquid_water_particle_in_um + long_name = eff. radius of cloud liquid water particle in micrometer (meter here) + units = m + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[re_ice] + standard_name = effective_radius_of_stratiform_cloud_ice_particle_in_um + long_name = eff. radius of cloud ice water particle in micrometer (meter here) + units = m + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[re_snow] + standard_name = effective_radius_of_stratiform_cloud_snow_particle_in_um + long_name = effective radius of cloud snow particle in micrometer (meter here) + units = m + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[mpicomm] + standard_name = mpi_comm + long_name = MPI communicator + units = index + dimensions = () + type = integer + intent = in + optional = F +[mpirank] + standard_name = mpi_rank + long_name = current MPI-rank + units = index + dimensions = () + type = integer + intent = in + optional = F +[mpiroot] + standard_name = mpi_root + long_name = master MPI-rank + units = index + dimensions = () + type = integer + intent = in + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F + +######################################################################## +[ccpp-arg-table] + name = mp_thompson_finalize + type = scheme +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F diff --git a/physics/mp_thompson_post.F90 b/physics/mp_thompson_post.F90 index 67cbc5790..feb031a3e 100644 --- a/physics/mp_thompson_post.F90 +++ b/physics/mp_thompson_post.F90 @@ -18,23 +18,15 @@ module mp_thompson_post #if 0 !! \section arg_table_mp_thompson_post_init Argument Table -!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | -!! |-----------------|-------------------------------------------------------|----------------------------------------------------------|------------|------|-----------|-----------|--------|----------| -!! | ncol | horizontal_loop_extent | horizontal loop extent | count | 0 | integer | | in | F | -!! | area | cell_area | area of the grid cell | m2 | 1 | real | kind_phys | in | F | -!! | ttendlim | limit_for_temperature_tendency_for_microphysics | temperature tendency limiter per physics time step | K s-1 | 0 | real | kind_phys | in | F | -!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | -!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | +!! \htmlinclude mp_thompson_post_init.html !! #endif - subroutine mp_thompson_post_init(ncol, area, ttendlim, errmsg, errflg) + subroutine mp_thompson_post_init(ncol, ttendlim, errmsg, errflg) implicit none ! Interface variables integer, intent(in) :: ncol - ! DH* TODO: remove area and dx (also from metadata table) - real(kind_phys), dimension(1:ncol), intent(in) :: area real(kind_phys), intent(in) :: ttendlim ! CCPP error handling @@ -42,7 +34,6 @@ subroutine mp_thompson_post_init(ncol, area, ttendlim, errmsg, errflg) integer, intent( out) :: errflg ! Local variables - !real(kind_phys), dimension(1:ncol) :: dx integer :: i ! Initialize the CCPP error handling variables @@ -60,26 +51,7 @@ subroutine mp_thompson_post_init(ncol, area, ttendlim, errmsg, errflg) allocate(mp_tend_lim(1:ncol)) - !! Cell size in m as square root of cell area - !dx = sqrt(area) - do i=1,ncol - ! The column-dependent values that were set here previously - ! are replaced with a single value set in the namelist - ! input.nml.This value is independent of the grid spacing - ! (as opposed to setting it here on a per-column basis). - ! However, given that the timestep is the same for all grid - ! columns and determined by the smallest grid spacing in - ! the domain, it makes sense to use a single value. - ! - ! The values previously used in RAP/HRRR were - ! mp_tend_lim(i) = 0.07 ! [K/s], 3-km HRRR value - ! and - ! mp_tend_lim(i) = 0.002 ! [K/s], 13-km RAP value - ! - ! Our testing with FV3 has shown thus far that 0.002 is - ! too small for a 13km (C768) resolution and that 0.01 - ! works better. This is work in progress ... mp_tend_lim(i) = ttendlim end do @@ -91,23 +63,11 @@ end subroutine mp_thompson_post_init #if 0 !! \section arg_table_mp_thompson_post_run Argument Table -!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | -!! |-----------------|-------------------------------------------------------|----------------------------------------------------------|------------|------|-----------|-----------|--------|----------| -!! | ncol | horizontal_loop_extent | horizontal loop extent | count | 0 | integer | | in | F | -!! | nlev | vertical_dimension | number of vertical levels | count | 0 | integer | | in | F | -!! | tgrs_save | air_temperature_save | air temperature before entering a physics scheme | K | 2 | real | kind_phys | in | F | -!! | tgrs | air_temperature_updated_by_physics | model layer mean temperature | K | 2 | real | kind_phys | inout | F | -!! | prslk | dimensionless_exner_function_at_model_layers | dimensionless Exner function at model layer centers | none | 2 | real | kind_phys | in | F | -!! | dtp | time_step_for_physics | physics timestep | s | 0 | real | kind_phys | in | F | -!! | mpicomm | mpi_comm | MPI communicator | index | 0 | integer | | in | F | -!! | mpirank | mpi_rank | current MPI-rank | index | 0 | integer | | in | F | -!! | mpiroot | mpi_root | master MPI-rank | index | 0 | integer | | in | F | -!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | -!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | +!! \htmlinclude mp_thompson_post_run.html !! #endif subroutine mp_thompson_post_run(ncol, nlev, tgrs_save, tgrs, prslk, dtp, & - mpicomm, mpirank, mpiroot, errmsg, errflg) + kdt, mpicomm, mpirank, mpiroot, errmsg, errflg) implicit none @@ -118,6 +78,7 @@ subroutine mp_thompson_post_run(ncol, nlev, tgrs_save, tgrs, prslk, dtp, & real(kind_phys), dimension(1:ncol,1:nlev), intent(inout) :: tgrs real(kind_phys), dimension(1:ncol,1:nlev), intent(in) :: prslk real(kind_phys), intent(in) :: dtp + integer, intent(in) :: kdt ! MPI information integer, intent(in ) :: mpicomm integer, intent(in ) :: mpirank @@ -155,8 +116,8 @@ subroutine mp_thompson_post_run(ncol, nlev, tgrs_save, tgrs, prslk, dtp, & if (tgrs_save(i,k) + mp_tend(i,k)*prslk(i,k) .ne. tgrs(i,k)) then #ifdef DEBUG - write(0,*) "mp_thompson_post_run mp_tend limiter: i, k, t_old, t_new, t_lim:", & - & i, k, tgrs_save(i,k), tgrs(i,k), tgrs_save(i,k) + mp_tend(i,k)*prslk(i,k) + write(0,'(a,3i6,3e16.7)') "mp_thompson_post_run mp_tend limiter: kdt, i, k, t_old, t_new, t_lim:", & + & kdt, i, k, tgrs_save(i,k), tgrs(i,k), tgrs_save(i,k) + mp_tend(i,k)*prslk(i,k) #endif events = events + 1 end if @@ -165,17 +126,15 @@ subroutine mp_thompson_post_run(ncol, nlev, tgrs_save, tgrs, prslk, dtp, & end do if (events > 0) then - write(0,'(a,i0,a,i0,a)') "mp_thompson_post_run: mp_tend_lim applied ", events, "/", nlev*ncol, " times" + write(0,'(a,i0,a,i0,a,i0)') "mp_thompson_post_run: mp_tend_lim applied ", events, "/", nlev*ncol, & + & " times at timestep ", kdt end if end subroutine mp_thompson_post_run #if 0 !! \section arg_table_mp_thompson_post_finalize Argument Table -!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | -!! |-----------------|-------------------------------------------------------|----------------------------------------------------------|------------|------|-----------|-----------|--------|----------| -!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | -!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | +!! \htmlinclude mp_thompson_post_finalize.html !! #endif subroutine mp_thompson_post_finalize(errmsg, errflg) diff --git a/physics/mp_thompson_post.meta b/physics/mp_thompson_post.meta new file mode 100644 index 000000000..0f3cc6189 --- /dev/null +++ b/physics/mp_thompson_post.meta @@ -0,0 +1,165 @@ +[ccpp-arg-table] + name = mp_thompson_post_init + type = scheme +[ncol] + standard_name = horizontal_loop_extent + long_name = horizontal loop extent + units = count + dimensions = () + type = integer + intent = in + optional = F +[ttendlim] + standard_name = limit_for_temperature_tendency_for_microphysics + long_name = temperature tendency limiter per physics time step + units = K s-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F + +######################################################################## +[ccpp-arg-table] + name = mp_thompson_post_run + type = scheme +[ncol] + standard_name = horizontal_loop_extent + long_name = horizontal loop extent + units = count + dimensions = () + type = integer + intent = in + optional = F +[nlev] + standard_name = vertical_dimension + long_name = number of vertical levels + units = count + dimensions = () + type = integer + intent = in + optional = F +[tgrs_save] + standard_name = air_temperature_save + long_name = air temperature before entering a physics scheme + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[tgrs] + standard_name = air_temperature_updated_by_physics + long_name = model layer mean temperature + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[prslk] + standard_name = dimensionless_exner_function_at_model_layers + long_name = dimensionless Exner function at model layer centers + units = none + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[dtp] + standard_name = time_step_for_physics + long_name = physics timestep + units = s + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[kdt] + standard_name = index_of_time_step + long_name = current forecast iteration + units = index + dimensions = () + type = integer + intent = in + optional = F +[mpicomm] + standard_name = mpi_comm + long_name = MPI communicator + units = index + dimensions = () + type = integer + intent = in + optional = F +[mpirank] + standard_name = mpi_rank + long_name = current MPI-rank + units = index + dimensions = () + type = integer + intent = in + optional = F +[mpiroot] + standard_name = mpi_root + long_name = master MPI-rank + units = index + dimensions = () + type = integer + intent = in + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F + +######################################################################## +[ccpp-arg-table] + name = mp_thompson_post_finalize + type = scheme +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F diff --git a/physics/mp_thompson_pre.F90 b/physics/mp_thompson_pre.F90 index 51f621fc9..3654b6682 100644 --- a/physics/mp_thompson_pre.F90 +++ b/physics/mp_thompson_pre.F90 @@ -24,43 +24,11 @@ end subroutine mp_thompson_pre_init #if 0 !! \section arg_table_mp_thompson_pre_run Argument Table -!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | -!! |-----------------|-----------------------------------------------------------------------|----------------------------------------------------------|------------|------|-----------|-----------|--------|----------| -!! | ncol | horizontal_loop_extent | horizontal loop extent | count | 0 | integer | | in | F | -!! | nlev | vertical_dimension | number of vertical levels | count | 0 | integer | | in | F | -!! | kdt | index_of_time_step | current forecast iteration | index | 0 | integer | | in | F | -!! | con_g | gravitational_acceleration | gravitational acceleration | m s-2 | 0 | real | kind_phys | in | F | -!! | con_rd | gas_constant_dry_air | ideal gas constant for dry air | J kg-1 K-1 | 0 | real | kind_phys | in | F | -!! | spechum | water_vapor_specific_humidity_updated_by_physics | water vapor specific humidity | kg kg-1 | 2 | real | kind_phys | inout | F | -!! | qc | cloud_condensed_water_mixing_ratio_updated_by_physics | cloud water mixing ratio wrt dry+vapor (no condensates) | kg kg-1 | 2 | real | kind_phys | inout | F | -!! | qr | rain_water_mixing_ratio_updated_by_physics | rain water mixing ratio wrt dry+vapor (no condensates) | kg kg-1 | 2 | real | kind_phys | inout | F | -!! | qi | ice_water_mixing_ratio_updated_by_physics | ice water mixing ratio wrt dry+vapor (no condensates) | kg kg-1 | 2 | real | kind_phys | inout | F | -!! | qs | snow_water_mixing_ratio_updated_by_physics | snow water mixing ratio wrt dry+vapor (no condensates) | kg kg-1 | 2 | real | kind_phys | inout | F | -!! | qg | graupel_mixing_ratio_updated_by_physics | graupel mixing ratio wrt dry+vapor (no condensates) | kg kg-1 | 2 | real | kind_phys | inout | F | -!! | ni | ice_number_concentration_updated_by_physics | ice number concentration | kg-1 | 2 | real | kind_phys | inout | F | -!! | nr | rain_number_concentration_updated_by_physics | rain number concentration | kg-1 | 2 | real | kind_phys | inout | F | -!! | make_number_concentrations | flag_for_initial_number_concentration_calculation | flag for initial number concentration calculation | flag | 0 | logical | | in | F | -!! | is_aerosol_aware| flag_for_aerosol_physics | flag for aerosol-aware physics | flag | 0 | logical | | in | F | -!! | nc | cloud_droplet_number_concentration_updated_by_physics | cloud droplet number concentration | kg-1 | 2 | real | kind_phys | inout | T | -!! | nwfa | water_friendly_aerosol_number_concentration_updated_by_physics | number concentration of water-friendly aerosols | kg-1 | 2 | real | kind_phys | inout | T | -!! | nifa | ice_friendly_aerosol_number_concentration_updated_by_physics | number concentration of ice-friendly aerosols | kg-1 | 2 | real | kind_phys | inout | T | -!! | nwfa2d | tendency_of_water_friendly_aerosols_at_surface | instantaneous fake water-friendly surface aerosol source | kg-1 s-1 | 1 | real | kind_phys | inout | T | -!! | nifa2d | tendency_of_ice_friendly_aerosols_at_surface | instantaneous fake ice-friendly surface aerosol source | kg-1 s-1 | 1 | real | kind_phys | inout | T | -!! | tgrs | air_temperature_updated_by_physics | model layer mean temperature | K | 2 | real | kind_phys | in | F | -!! | tgrs_save | air_temperature_save | air temperature before entering a physics scheme | K | 2 | real | kind_phys | out | F | -!! | prsl | air_pressure | mean layer pressure | Pa | 2 | real | kind_phys | in | F | -!! | phil | geopotential | geopotential at model layer centers | m2 s-2 | 2 | real | kind_phys | in | F | -!! | area | cell_area | area of the grid cell | m2 | 1 | real | kind_phys | in | F | -!! | mpirank | mpi_rank | current MPI-rank | index | 0 | integer | | in | F | -!! | mpiroot | mpi_root | master MPI-rank | index | 0 | integer | | in | F | -!! | blkno | ccpp_block_number | for explicit data blocking: block number of this block | index | 0 | integer | | in | F | -!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | -!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | +!! \htmlinclude mp_thompson_pre_run.html !! #endif subroutine mp_thompson_pre_run(ncol, nlev, kdt, con_g, con_rd, & spechum, qc, qr, qi, qs, qg, ni, nr, & - make_number_concentrations, & is_aerosol_aware, nc, nwfa, nifa, nwfa2d, & nifa2d, tgrs, tgrs_save, prsl, phil, area, & mpirank, mpiroot, blkno, errmsg, errflg) @@ -83,14 +51,13 @@ subroutine mp_thompson_pre_run(ncol, nlev, kdt, con_g, con_rd, & real(kind_phys), intent(inout) :: qg(1:ncol,1:nlev) real(kind_phys), intent(inout) :: ni(1:ncol,1:nlev) real(kind_phys), intent(inout) :: nr(1:ncol,1:nlev) - logical, intent(in ) :: make_number_concentrations ! Aerosols logical, intent(in ) :: is_aerosol_aware - real(kind_phys), optional, intent(inout) :: nc(1:ncol,1:nlev) - real(kind_phys), optional, intent(inout) :: nwfa(1:ncol,1:nlev) - real(kind_phys), optional, intent(inout) :: nifa(1:ncol,1:nlev) - real(kind_phys), optional, intent(inout) :: nwfa2d(1:ncol) - real(kind_phys), optional, intent(inout) :: nifa2d(1:ncol) + real(kind_phys), optional, intent(inout) :: nc(:,:) + real(kind_phys), optional, intent(inout) :: nwfa(:,:) + real(kind_phys), optional, intent(inout) :: nifa(:,:) + real(kind_phys), optional, intent(inout) :: nwfa2d(:) + real(kind_phys), optional, intent(inout) :: nifa2d(:) ! State variables and timestep information real(kind_phys), intent(in ) :: tgrs(1:ncol,1:nlev) real(kind_phys), intent( out) :: tgrs_save(1:ncol,1:nlev) @@ -169,27 +136,17 @@ subroutine mp_thompson_pre_run(ncol, nlev, kdt, con_g, con_rd, & ! they also need to be switched back to mass/number per kg of air, because ! what is returned by the functions is in units of number per cubic meter. - if (make_number_concentrations) then - ! If qi is in boundary conditions but ni is not, calculate ni from qi, rho and tgrs - if (maxval(qi)>0.0 .and. maxval(ni)==0.0) then - ni = make_IceNumber(qi*rho, tgrs) * orho - end if - else - ! If qi is in boundary conditions but ni is not, reset qi to zero - if (maxval(qi)>0.0 .and. maxval(ni)==0.0) qi = 0.0 + ! If qi is in boundary conditions but ni is not, calculate ni from qi, rho and tgrs + if (maxval(qi)>0.0 .and. maxval(ni)==0.0) then + ni = make_IceNumber(qi*rho, tgrs) * orho end if ! If ni is in boundary conditions but qi is not, reset ni to zero if (maxval(ni)>0.0 .and. maxval(qi)==0.0) ni = 0.0 - if (make_number_concentrations) then - ! If qr is in boundary conditions but nr is not, calculate nr from qr, rho and tgrs - if (maxval(qr)>0.0 .and. maxval(nr)==0.0) then - nr = make_RainNumber(qr*rho, tgrs) * orho - end if - else - ! If qr is in boundary conditions but nr is not, reset qr to zero - if (maxval(qr)>0.0 .and. maxval(nr)==0.0) qr = 0.0 + ! If qr is in boundary conditions but nr is not, calculate nr from qr, rho and tgrs + if (maxval(qr)>0.0 .and. maxval(nr)==0.0) then + nr = make_RainNumber(qr*rho, tgrs) * orho end if ! If nr is in boundary conditions but qr is not, reset nr to zero @@ -298,14 +255,9 @@ subroutine mp_thompson_pre_run(ncol, nlev, kdt, con_g, con_rd, & endif endif - if (make_number_concentrations) then - ! If qc is in boundary conditions but nc is not, calculate nc from qc, rho and nwfa - if (maxval(qc)>0.0 .and. maxval(nc)==0.0) then - nc = make_DropletNumber(qc*rho, nwfa) * orho - end if - else - ! If qc is in boundary conditions but nc is not, reset qc to zero - if (maxval(qc)>0.0 .and. maxval(nc)==0.0) qc = 0.0 + ! If qc is in boundary conditions but nc is not, calculate nc from qc, rho and nwfa + if (maxval(qc)>0.0 .and. maxval(nc)==0.0) then + nc = make_DropletNumber(qc*rho, nwfa) * orho end if ! If nc is in boundary conditions but qc is not, reset nc to zero diff --git a/physics/mp_thompson_pre.meta b/physics/mp_thompson_pre.meta new file mode 100644 index 000000000..0fc225fa1 --- /dev/null +++ b/physics/mp_thompson_pre.meta @@ -0,0 +1,256 @@ +[ccpp-arg-table] + name = mp_thompson_pre_run + type = scheme +[ncol] + standard_name = horizontal_loop_extent + long_name = horizontal loop extent + units = count + dimensions = () + type = integer + intent = in + optional = F +[nlev] + standard_name = vertical_dimension + long_name = number of vertical levels + units = count + dimensions = () + type = integer + intent = in + optional = F +[kdt] + standard_name = index_of_time_step + long_name = current forecast iteration + units = index + dimensions = () + type = integer + intent = in + optional = F +[con_g] + standard_name = gravitational_acceleration + long_name = gravitational acceleration + units = m s-2 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[con_rd] + standard_name = gas_constant_dry_air + long_name = ideal gas constant for dry air + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[spechum] + standard_name = water_vapor_specific_humidity_updated_by_physics + long_name = water vapor specific humidity + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[qc] + standard_name = cloud_condensed_water_mixing_ratio_updated_by_physics + long_name = cloud water mixing ratio wrt dry+vapor (no condensates) + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[qr] + standard_name = rain_water_mixing_ratio_updated_by_physics + long_name = rain water mixing ratio wrt dry+vapor (no condensates) + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[qi] + standard_name = ice_water_mixing_ratio_updated_by_physics + long_name = ice water mixing ratio wrt dry+vapor (no condensates) + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[qs] + standard_name = snow_water_mixing_ratio_updated_by_physics + long_name = snow water mixing ratio wrt dry+vapor (no condensates) + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[qg] + standard_name = graupel_mixing_ratio_updated_by_physics + long_name = graupel mixing ratio wrt dry+vapor (no condensates) + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[ni] + standard_name = ice_number_concentration_updated_by_physics + long_name = ice number concentration + units = kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[nr] + standard_name = rain_number_concentration_updated_by_physics + long_name = rain number concentration + units = kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[is_aerosol_aware] + standard_name = flag_for_aerosol_physics + long_name = flag for aerosol-aware physics + units = flag + dimensions = () + type = logical + intent = in + optional = F +[nc] + standard_name = cloud_droplet_number_concentration_updated_by_physics + long_name = cloud droplet number concentration + units = kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = T +[nwfa] + standard_name = water_friendly_aerosol_number_concentration_updated_by_physics + long_name = number concentration of water-friendly aerosols + units = kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = T +[nifa] + standard_name = ice_friendly_aerosol_number_concentration_updated_by_physics + long_name = number concentration of ice-friendly aerosols + units = kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = T +[nwfa2d] + standard_name = tendency_of_water_friendly_aerosols_at_surface + long_name = instantaneous fake water-friendly surface aerosol source + units = kg-1 s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = T +[nifa2d] + standard_name = tendency_of_ice_friendly_aerosols_at_surface + long_name = instantaneous fake ice-friendly surface aerosol source + units = kg-1 s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = T +[tgrs] + standard_name = air_temperature_updated_by_physics + long_name = model layer mean temperature + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[tgrs_save] + standard_name = air_temperature_save + long_name = air temperature before entering a physics scheme + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[prsl] + standard_name = air_pressure + long_name = mean layer pressure + units = Pa + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[phil] + standard_name = geopotential + long_name = geopotential at model layer centers + units = m2 s-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[area] + standard_name = cell_area + long_name = area of the grid cell + units = m2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[mpirank] + standard_name = mpi_rank + long_name = current MPI-rank + units = index + dimensions = () + type = integer + intent = in + optional = F +[mpiroot] + standard_name = mpi_root + long_name = master MPI-rank + units = index + dimensions = () + type = integer + intent = in + optional = F +[blkno] + standard_name = ccpp_block_number + long_name = for explicit data blocking: block number of this block + units = index + dimensions = () + type = integer + intent = in + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F diff --git a/physics/multi_gases.F90 b/physics/multi_gases.F90 index 1e62c89a1..c660b7dfb 100644 --- a/physics/multi_gases.F90 +++ b/physics/multi_gases.F90 @@ -36,7 +36,7 @@ module ccpp_multi_gases_mod ! ! use machine, only: kind_dyn - ! DH* TODO - MAKE THIS INPUT ARGUMENTS *DH + ! DH* TODO - MAKE THIS INPUT ARGUMENTS use physcons, only : rdgas => con_rd_dyn, & cp_air => con_cp_dyn ! *DH diff --git a/physics/noahmp_tables.f90 b/physics/noahmp_tables.f90 new file mode 100644 index 000000000..7bab292fb --- /dev/null +++ b/physics/noahmp_tables.f90 @@ -0,0 +1,964 @@ +!> \file noahmp_tables.f90 +!! This file contains Fortran versions of the data tables included with NoahMP in mptable.tbl, soilparm.tbl, and genparm.tbl. + +!> \ingroup NoahMP_LSM +!! \brief Data from MPTABLE.TBL, SOILPARM.TBL, GENPARM.TBL for NoahMP +!! +!! Note that a subset of the data in the *.TBL files is represented in this file. For example, +!! only the data in the noah_mp_modis_parameters section of MPTABLE.TBL and the STAS section of +!! SOILPARM.TBL are included in this module. +module noahmp_tables + + implicit none + + integer :: i + integer, private, parameter :: mvt = 30 ! use 30 instead of 27 + integer, private, parameter :: mband = 2 + integer, private, parameter :: msc = 8 + integer, private, parameter :: max_soiltyp = 30 + integer, private, parameter :: slcats = 30 + real :: slope_table(9) !slope factor for soil drainage + +! crops + + integer, private, parameter :: ncrop = 5 + integer, private, parameter :: nstage = 8 + + +! mptable.tbl vegetation parameters + + integer :: isurban_table = 13 + integer :: iswater_table = 17 + integer :: isbarren_table = 16 + integer :: isice_table = 15 + integer :: eblforest_table = 2 + +! + real :: ch2op_table(mvt) !maximum intercepted h2o per unit lai+sai (mm) + + data ( ch2op_table(i),i=1,mvt) / 0.1, 0.1, 0.1, 0.1, 0.1, 0.1, & + & 0.1, 0.1, 0.1, 0.1, 0.1, 0.1, & + & 0.1, 0.1, 0.1, 0.1, 0.1, 0.1, & + & 0.1, 0.1, 0.0, 0.0, 0.0, 0.0, & + & 0.0, 0.0, 0.0, 0.0, 0.0, 0.0 / + + real :: dleaf_table(mvt) !characteristic leaf dimension (m) + data ( dleaf_table(i),i=1,mvt) / 0.04, 0.04, 0.04, 0.04, 0.04, 0.04, & + & 0.04, 0.04, 0.04, 0.04, 0.04, 0.04, & + & 0.04, 0.04, 0.04, 0.04, 0.04, 0.04, & + & 0.04, 0.04, 0.00, 0.00, 0.00, 0.00, & + & 0.00, 0.00, 0.00, 0.00, 0.00, 0.00 / + + real :: z0mvt_table(mvt) !momentum roughness length (m) + data ( z0mvt_table(i),i=1,mvt) / 1.09, 1.10, 0.85, 0.80, 0.80, 0.20, & + & 0.06, 0.60, 0.50, 0.12, 0.30, 0.15, & + & 1.00, 0.14, 0.00, 0.00, 0.00, 0.30, & + & 0.20, 0.03, 0.00, 0.00, 0.00, 0.00, & + & 0.00, 0.00, 0.00, 0.00, 0.00, 0.00 / + +! + + real :: hvt_table(mvt) !top of canopy (m) + data ( hvt_table(i),i=1,mvt) / 20.0, 20.0, 18.0, 16.0, 16.0, 1.10, & + & 1.10, 13.0, 10.0, 1.00, 5.00, 2.00, & + & 15.0, 1.50, 0.00, 0.00, 0.00, 4.00, & + & 2.00, 0.50, 0.00, 0.00, 0.00, 0.00, & + & 0.00, 0.00, 0.00, 0.00, 0.00, 0.00 / + + real :: hvb_table(mvt) !bottom of canopy (m) + data ( hvb_table(i),i=1,mvt) / 8.50, 8.00, 7.00, 11.5, 10.0, 0.10, & + & 0.10, 0.10, 0.10, 0.05, 0.10, 0.10, & + & 1.00, 0.10, 0.00, 0.00, 0.00, 0.30, & + & 0.20, 0.10, 0.00, 0.00, 0.00, 0.00, & + & 0.00, 0.00, 0.00, 0.00, 0.00, 0.00 / + + real :: den_table(mvt) !tree density (no. of trunks per m2) + data ( den_table (i),i=1,mvt) / 0.28, 0.02, 0.28, 0.10, 0.10, 10.0, & + & 10.0, 10.0, 0.02, 100., 5.05, 25.0, & + & 0.01, 25.0, 0.00, 0.01, 0.01, 1.00, & + & 1.00, 1.00, 0.00, 0.00, 0.00, 0.00, & + & 0.00, 0.00, 0.00, 0.00, 0.00, 0.00 / +! + real :: rc_table(mvt) !tree crown radius (m) + + data ( rc_table (i),i=1,mvt) / 1.20, 3.60, 1.20, 1.40, 1.40, 0.12, & + & 0.12, 0.12, 3.00, 0.03, 0.75, 0.08, & + & 1.00, 0.08, 0.00, 0.01, 0.01, 0.30, & + & 0.30, 0.30, 0.00, 0.00, 0.00, 0.00, & + & 0.00, 0.00, 0.00, 0.00, 0.00, 0.00 / + + real :: mfsno_table(mvt) !snowmelt curve parameter () + data ( mfsno_table(i),i=1,mvt) / 2.50, 2.50, 2.50, 2.50, 2.50, 2.50, & + & 2.50, 2.50, 2.50, 2.50, 2.50, 2.50, & + & 2.50, 2.50, 2.50, 2.50, 2.50, 2.50, & + & 2.50, 2.50, 0.00, 0.00, 0.00, 0.00, & + & 0.00, 0.00, 0.00, 0.00, 0.00, 0.00 / + +! + + real :: saim_table(mvt,12) !monthly stem area index, one-sided + + data (saim_table (i,1),i=1,mvt) / 0.4, 0.5, 0.3, 0.4, 0.4, 0.3, & + & 0.2, 0.4, 0.3, 0.3, 0.3, 0.3, & + & 0.0, 0.3, 0.0, 0.0, 0.0, 0.2, & + & 0.1, 0.0, 0.0, 0.0, 0.0, 0.0, & + & 0.0, 0.0, 0.0, 0.0, 0.0, 0.0 / + + +! &_______________________________________________________________________& + + data (saim_table (i,2),i=1,mvt) / 0.4, 0.5, 0.3, 0.4, 0.4, 0.3, & + & 0.2, 0.4, 0.3, 0.3, 0.3, 0.3, & + & 0.0, 0.3, 0.0, 0.0, 0.0, 0.2, & + & 0.1, 0.0, 0.0, 0.0, 0.0, 0.0, & + & 0.0, 0.0, 0.0, 0.0, 0.0, 0.0 / + + data (saim_table (i,3),i=1,mvt) / 0.4, 0.5, 0.3, 0.4, 0.4, 0.3, & + & 0.2, 0.4, 0.3, 0.3, 0.3, 0.3, & + & 0.0, 0.3, 0.0, 0.0, 0.0, 0.2, & + & 0.1, 0.0, 0.0, 0.0, 0.0, 0.0, & + & 0.0, 0.0, 0.0, 0.0, 0.0, 0.0 / + + data (saim_table (i,4),i=1,mvt) / 0.3, 0.5, 0.4, 0.4, 0.4, 0.3, & + & 0.2, 0.4, 0.3, 0.3, 0.3, 0.3, & + & 0.0, 0.3, 0.0, 0.0, 0.0, 0.2, & + & 0.1, 0.0, 0.0, 0.0, 0.0, 0.0, & + & 0.0, 0.0, 0.0, 0.0, 0.0, 0.0 / + +! &_______________________________________________________________________& + + data (saim_table (i,5),i=1,mvt) / 0.4, 0.5, 0.4, 0.4, 0.4, 0.3, & + & 0.2, 0.4, 0.3, 0.3, 0.3, 0.3, & + & 0.0, 0.3, 0.0, 0.0, 0.0, 0.2, & + & 0.1, 0.0, 0.0, 0.0, 0.0, 0.0, & + & 0.0, 0.0, 0.0, 0.0, 0.0, 0.0 / + + data (saim_table (i,6),i=1,mvt) / 0.5, 0.5, 0.7, 0.4, 0.4, 0.3, & + & 0.2, 0.4, 0.4, 0.4, 0.4, 0.3, & + & 0.0, 0.4, 0.0, 0.0, 0.0, 0.2, & + & 0.2, 0.0, 0.0, 0.0, 0.0, 0.0, & + & 0.0, 0.0, 0.0, 0.0, 0.0, 0.0 / + + data (saim_table (i,7),i=1,mvt) / 0.5, 0.5, 1.3, 0.9, 0.7, 0.6, & + & 0.4, 0.7, 0.8, 0.8, 0.6, 0.4, & + & 0.0, 0.6, 0.0, 0.0, 0.0, 0.4, & + & 0.4, 0.0, 0.0, 0.0, 0.0, 0.0, & + & 0.0, 0.0, 0.0, 0.0, 0.0, 0.0 / + +! &_______________________________________________________________________& + + data (saim_table (i,8),i=1,mvt) / 0.6, 0.5, 1.2, 1.2, 0.8, 0.9, & + & 0.6, 1.2, 1.2, 1.3, 0.9, 0.5, & + & 0.0, 0.9, 0.0, 0.0, 0.0, 0.6, & + & 0.6, 0.0, 0.0, 0.0, 0.0, 0.0, & + & 0.0, 0.0, 0.0, 0.0, 0.0, 0.0 / + + data (saim_table (i,9),i=1,mvt) / 0.6, 0.5, 1.0, 1.6, 1.0, 1.2, & + & 0.8, 1.4, 1.3, 1.1, 0.9, 0.4, & + & 0.0, 0.7, 0.0, 0.0, 0.0, 0.8, & + & 0.7, 0.0, 0.0, 0.0, 0.0, 0.0, & + & 0.0, 0.0, 0.0, 0.0, 0.0, 0.0 / + + data (saim_table (i,10),i=1,mvt) / 0.7, 0.5, 0.8, 1.4, 1.0, 0.9, & + & 0.7, 1.1, 0.7, 0.4, 0.6, 0.3, & + & 0.0, 0.3, 0.0, 0.0, 0.0, 0.7, & + & 0.5, 0.0, 0.0, 0.0, 0.0, 0.0, & + & 0.0, 0.0, 0.0, 0.0, 0.0, 0.0 / + +! &_______________________________________________________________________& + + data (saim_table (i,11),i=1,mvt) / 0.6, 0.5, 0.6, 0.6, 0.5, 0.4, & + & 0.3, 0.5, 0.4, 0.4, 0.4, 0.3, & + & 0.0, 0.3, 0.0, 0.0, 0.0, 0.3, & + & 0.3, 0.0, 0.0, 0.0, 0.0, 0.0, & + & 0.0, 0.0, 0.0, 0.0, 0.0, 0.0 / + + data (saim_table (i,12),i=1,mvt) / 0.5, 0.5, 0.5, 0.4, 0.4, 0.3, & + & 0.2, 0.4, 0.4, 0.4, 0.3, 0.3, & + & 0.0, 0.3, 0.0, 0.0, 0.0, 0.2, & + & 0.2, 0.0, 0.0, 0.0, 0.0, 0.0, & + & 0.0, 0.0, 0.0, 0.0, 0.0, 0.0 / + +!! lai + real :: laim_table(mvt,12) !monthly leaf area index, one-sided + + data (laim_table (i,1),i=1,mvt) / 4.0, 4.5, 0.0, 0.0, 2.0, 0.0, & + & 0.0, 0.2, 0.3, 0.4, 0.2, 0.0, & + & 0.0, 0.2, 0.0, 0.0, 0.0, 1.0, & + & 0.6, 0.0, 0.0, 0.0, 0.0, 0.0, & + & 0.0, 0.0, 0.0, 0.0, 0.0, 0.0 / + +! &_______________________________________________________________________& + + data (laim_table (i,2),i=1,mvt) / 4.0, 4.5, 0.0, 0.0, 2.0, 0.0, & + & 0.0, 0.2, 0.3, 0.5, 0.3, 0.0, & + & 0.0, 0.3, 0.0, 0.0, 0.0, 1.0, & + & 0.6, 0.0, 0.0, 0.0, 0.0, 0.0, & + & 0.0, 0.0, 0.0, 0.0, 0.0, 0.0 / + + data (laim_table (i,3),i=1,mvt) / 4.0, 4.5, 0.0, 0.3, 2.2, 0.3, & + & 0.2, 0.4, 0.5, 0.6, 0.3, 0.0, & + & 0.0, 0.3, 0.0, 0.0, 0.0, 1.1, & + & 0.7, 0.0, 0.0, 0.0, 0.0, 0.0, & + & 0.0, 0.0, 0.0, 0.0, 0.0, 0.0 / + + data (laim_table (i,4),i=1,mvt) / 4.0, 4.5, 0.6, 1.2, 2.6, 0.9, & + & 0.6, 1.0, 0.8, 0.7, 0.5, 0.0, & + & 0.0, 0.4, 0.0, 0.0, 0.0, 1.3, & + & 0.8, 0.0, 0.0, 0.0, 0.0, 0.0, & + & 0.0, 0.0, 0.0, 0.0, 0.0, 0.0 / + +! &_______________________________________________________________________& + + data (laim_table (i,5),i=1,mvt) / 4.0, 4.5, 1.2, 3.0, 3.5, 2.2, & + & 1.5, 2.4, 1.8, 1.2, 1.5, 1.0, & + & 0.0, 1.1, 0.0, 0.0, 0.0, 1.7, & + & 1.2, 0.0, 0.0, 0.0, 0.0, 0.0, & + & 0.0, 0.0, 0.0, 0.0, 0.0, 0.0 / + + data (laim_table (i,6),i=1,mvt) / 4.0, 4.5, 2.0, 4.7, 4.3, 3.5, & + & 2.3, 4.1, 3.6, 3.0, 2.9, 2.0, & + & 0.0, 2.5, 0.0, 0.0, 0.0, 2.1, & + & 1.8, 0.0, 0.0, 0.0, 0.0, 0.0, & + & 0.0, 0.0, 0.0, 0.0, 0.0, 0.0 / + + data (laim_table (i,7),i=1,mvt) / 4.0, 4.5, 2.6, 4.5, 4.3, 3.5, & + & 2.3, 4.1, 3.8, 3.5, 3.5, 3.0, & + & 0.0, 3.2, 0.0, 0.0, 0.0, 2.1, & + & 1.8, 0.0, 0.0, 0.0, 0.0, 0.0, & + & 0.0, 0.0, 0.0, 0.0, 0.0, 0.0 / + +! &_______________________________________________________________________& + + data (laim_table (i,8),i=1,mvt) / 4.0, 4.5, 1.7, 3.4, 3.7, 2.5, & + & 1.7, 2.7, 2.1, 1.5, 2.7, 3.0, & + & 0.0, 2.2, 0.0, 0.0, 0.0, 1.8, & + & 1.3, 0.0, 0.0, 0.0, 0.0, 0.0, & + & 0.0, 0.0, 0.0, 0.0, 0.0, 0.0 / + + data (laim_table (i,9),i=1,mvt) / 4.0, 4.5, 1.0, 1.2, 2.6, 0.9, & + & 0.6, 1.0, 0.9, 0.7, 1.2, 1.5, & + & 0.0, 1.1, 0.0, 0.0, 0.0, 1.3, & + & 0.8, 0.0, 0.0, 0.0, 0.0, 0.0, & + & 0.0, 0.0, 0.0, 0.0, 0.0, 0.0 / + + data (laim_table (i,10),i=1,mvt) / 4.0, 4.5, 0.5, 0.3, 2.2, 0.3, & + & 0.2, 0.4, 0.5, 0.6, 0.3, 0.0, & + & 0.0, 0.3, 0.0, 0.0, 0.0, 1.1, & + & 0.7, 0.0, 0.0, 0.0, 0.0, 0.0, & + & 0.0, 0.0, 0.0, 0.0, 0.0, 0.0 / + +! &_______________________________________________________________________& + + data (laim_table (i,11),i=1,mvt) / 4.0, 4.5, 0.2, 0.0, 2.0, 0.0, & + & 0.0, 0.2, 0.3, 0.5, 0.3, 0.0, & + & 0.0, 0.3, 0.0, 0.0, 0.0, 1.0, & + & 0.6, 0.0, 0.0, 0.0, 0.0, 0.0, & + & 0.0, 0.0, 0.0, 0.0, 0.0, 0.0 / + + data (laim_table (i,12),i=1,mvt) / 4.0, 4.5, 0.0, 0.0, 2.0, 0.0, & + & 0.0, 0.2, 0.3, 0.4, 0.2, 0.0, & + & 0.0, 0.2, 0.0, 0.0, 0.0, 1.0, & + & 0.6, 0.0, 0.0, 0.0, 0.0, 0.0, & + & 0.0, 0.0, 0.0, 0.0, 0.0, 0.0 / + + real :: sla_table(mvt) !single-side leaf area per kg [m2/kg] + data ( sla_table (i),i=1,mvt) / 80, 80, 80, 80, 80, 60, & + & 60, 60, 50, 60, 80, 80, & + & 60, 80, 0, 0, 0, 80, & + & 80, 80, 0, 0, 0, 0, & + & 0, 0, 0, 0, 0, 0 / + + real :: dilefc_table(mvt) !coeficient for leaf stress death [1/s] + data (dilefc_table (i),i=1,mvt) / 1.20, 0.50, 1.80, 0.60, 0.80, 0.20, & + & 0.20, 0.20, 0.50, 0.20, 0.4, 0.50, & + & 0.00, 0.35, 0.00, 0.00, 0.00, 0.30, & + & 0.40, 0.30, 0.00, 0.00, 0.00, 0.00, & + & 0.00, 0.00, 0.00, 0.00, 0.00, 0.00 / + + real :: dilefw_table(mvt) !coeficient for leaf stress death [1/s] + data (dilefw_table(i),i=1,mvt) / 0.20, 4.00, 0.20, 0.20, 0.20, 0.20, & + & 0.20, 0.20, 0.50, 0.10, 0.2, 0.20, & + & 0.00, 0.20, 0.00, 0.00, 0.00, 0.20, & + & 0.20, 0.20, 0.00, 0.00, 0.00, 0.00, & + & 0.00, 0.00, 0.00, 0.00, 0.00, 0.00 / + + real :: fragr_table(mvt) !fraction of growth respiration !original was 0.3 + data ( fragr_table(i),i=1,mvt) / 0.10, 0.20, 0.10, 0.20, 0.10, 0.20, & + & 0.20, 0.20, 0.20, 0.20, 0.1, 0.20, & + & 0.00, 0.20, 0.00, 0.10, 0.00, 0.10, & + & 0.10, 0.10, 0.00, 0.00, 0.00, 0.00, & + & 0.00, 0.00, 0.00, 0.00, 0.00, 0.00 / + + real :: ltovrc_table(mvt) !leaf turnover [1/s] + data ( ltovrc_table(i),i=1,mvt) / 0.5, 0.55, 0.2, 0.55, 0.5, 0.65, & + & 0.65, 0.65, 0.65, 0.50, 1.4, 1.6, & + & 0.0, 1.2, 0.0, 0.0, 0.0, 1.3, & + & 1.4, 1.0, 0.0, 0.0, 0.0, 0.0, & + & 0.0, 0.0, 0.0, 0.0, 0.0, 0.0 / + +! + real :: c3psn_table(mvt) !photosynthetic pathway: 0. = c4, 1. = c3 + data ( c3psn_table (i),i=1,mvt) / 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, & + & 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, & + & 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, & + & 1.0, 1.0, 0.0, 0.0, 0.0, 0.0, & + & 0.0, 0.0, 0.0, 0.0, 0.0, 0.0 / + + real :: kc25_table(mvt) !co2 michaelis-menten constant at 25c (pa) + data ( kc25_table (i),i=1,mvt) / 30.0, 30.0, 30.0, 30.0, 30.0, 30.0, & + & 30.0, 30.0, 30.0, 30.0, 30.0, 30.0, & + & 30.0, 30.0, 30.0, 30.0, 30.0, 30.0, & + & 30.0, 30.0, 0.00, 0.00, 0.00, 0.00, & + & 0.00, 0.00, 0.00, 0.00, 0.00, 0.00 / + + real :: akc_table(mvt) !q10 for kc25 + data ( akc_table (i),i=1,mvt) / 2.1, 2.1, 2.1, 2.1, 2.1, 2.1, & + & 2.1, 2.1, 2.1, 2.1, 2.1, 2.1, & + & 2.1, 2.1, 2.1, 2.1, 2.1, 2.1, & + & 2.1, 2.1, 0.0, 0.0, 0.0, 0.0, & + & 0.0, 0.0, 0.0, 0.0, 0.0, 0.0 / + + + real :: ko25_table(mvt) !o2 michaelis-menten constant at 25c (pa) + data ( ko25_table (i),i=1,mvt) / 3.e4, 3.e4, 3.e4, 3.e4, 3.e4, 3.e4, & + & 3.e4, 3.e4, 3.e4, 3.e4, 3.e4, 3.e4, & + & 3.e4, 3.e4, 3.e4, 3.e4, 3.e4, 3.e4, & + & 3.e4, 3.e4, 0.00, 0.00, 0.00, 0.00, & + & 0.00, 0.00, 0.00, 0.00, 0.00, 0.00 / + + + real :: ako_table(mvt) !q10 for ko25 + data ( ako_table (i),i=1,mvt) / 1.2, 1.2, 1.2, 1.2, 1.2, 1.2, & + & 1.2, 1.2, 1.2, 1.2, 1.2, 1.2, & + & 1.2, 1.2, 1.2, 1.2, 1.2, 1.2, & + & 1.2, 1.2, 0.0, 0.0, 0.0, 0.0, & + & 0.0, 0.0, 0.0, 0.0, 0.0, 0.0 / + + real :: vcmx25_table(mvt) !maximum rate of carboxylation at 25c (umol co2/m**2/s) + data ( vcmx25_table(i),i=1,mvt) / 50.0, 60.0, 60.0, 60.0, 55.0, 40.0, & + & 40.0, 40.0, 40.0, 40.0, 50.0, 80.0, & + & 0.00, 60.0, 0.00, 0.00, 0.00, 50.0, & + & 50.0, 50.0, 0.00, 0.00, 0.00, 0.00, & + & 0.00, 0.00, 0.00, 0.00, 0.00, 0.00 / + + + real :: avcmx_table(mvt) !q10 for vcmx25 + data ( avcmx_table (i),i=1,mvt) / 2.4, 2.4, 2.4, 2.4, 2.4, 2.4, & + & 2.4, 2.4, 2.4, 2.4, 2.4, 2.4, & + & 2.4, 2.4, 2.4, 2.4, 2.4, 2.4, & + & 2.4, 2.4, 0.0, 0.0, 0.0, 0.0, & + & 0.0, 0.0, 0.0, 0.0, 0.0, 0.0 / + + + + real :: bp_table(mvt) !minimum leaf conductance (umol/m**2/s) + data ( bp_table (i),i=1,mvt) / 2.e3, 2.e3, 2.e3, 2.e3, 2.e3, 2.e3, & + & 2.e3, 2.e3, 2.e3, 2.e3, 2.e3, 2.e3, & + & 1.e15, 2.e3,1.e15, 2.e3,1.e15, 2.e3, & + & 2.e3, 2.e3, 0.00, 0.00, 0.00, 0.00, & + & 0.00, 0.00, 0.00, 0.00, 0.00, 0.00 / + + real :: mp_table(mvt) !slope of conductance-to-photosynthesis relationship + data ( mp_table (i),i=1,mvt) / 6., 9., 6., 9., 9., 9., & + & 9., 9., 9., 9., 9., 9., & + & 9., 9., 9., 9., 9., 9., & + & 9., 9., 0.0, 0.0, 0.0, 0.0, & + & 0.0, 0.0, 0.0, 0.0, 0.0, 0.0 / + + real :: qe25_table(mvt) !quantum efficiency at 25c (umol co2 / umo photon) + data ( qe25_table (i),i=1,mvt) / 0.06, 0.06, 0.06, 0.06, 0.06, 0.06, & + & 0.06, 0.06, 0.06, 0.06, 0.06, 0.06, & + & 0.00, 0.06, 0.00, 0.06, 0.00, 0.06, & + & 0.06, 0.06, 0.00, 0.00, 0.00, 0.00, & + & 0.00, 0.00, 0.00, 0.00, 0.00, 0.00 / + + real :: aqe_table(mvt) !q10 for qe25 + data ( aqe_table (i),i=1,mvt) / 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, & + & 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, & + & 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, & + & 1.0, 1.0, 0.0, 0.0, 0.0, 0.0, & + & 0.0, 0.0, 0.0, 0.0, 0.0, 0.0 / + + real :: rmf25_table(mvt) !leaf maintenance respiration at 25c (umol co2/m**2/s) + data ( rmf25_table (i),i=1,mvt) / 3.00, 0.65, 4.00, 3.00, 3.00, 0.26, & + & 0.26, 0.26, 0.80, 1.80, 3.2, 1.00, & + & 0.00, 1.45, 0.00, 0.00, 0.00, 3.00, & + & 3.00, 3.00, 0.00, 0.00, 0.00, 0.00, & + & 0.00, 0.00, 0.00, 0.00, 0.00, 0.00 / + + real :: rms25_table(mvt) !stem maintenance respiration at 25c (umol co2/kg bio/s) + data ( rms25_table (i),i=1,mvt) / 0.90, 0.30, 0.64, 0.10, 0.80, 0.10, & + & 0.10, 0.10, 0.32, 0.10, 0.10, 0.10, & + & 0.00, 0.10, 0.00, 0.00, 0.00, 0.10, & + & 0.10, 0.00, 0.00, 0.00, 0.00, 0.00, & + & 0.00, 0.00, 0.00, 0.00, 0.00, 0.00 / + + real :: rmr25_table(mvt) !root maintenance respiration at 25c (umol co2/kg bio/s) + data ( rmr25_table (i),i=1,mvt) / 0.36, 0.05, 0.05, 0.01, 0.03, 0.00, & + & 0.00, 0.00, 0.01, 1.20, 0.0, 0.00, & + & 0.00, 0.00, 0.00, 0.00, 0.00, 2.11, & + & 2.11, 0.00, 0.00, 0.00, 0.00, 0.00, & + & 0.00, 0.00, 0.00, 0.00, 0.00, 0.00 / + + real :: arm_table(mvt) !q10 for maintenance respiration + data ( arm_table (i),i=1,mvt) / 2.0, 2.0, 2.0, 2.0, 2.0, 2.0, & + & 2.0, 2.0, 2.0, 2.0, 2.0, 2.0, & + & 2.0, 2.0, 2.0, 2.0, 2.0, 2.0, & + & 2.0, 2.0, 0.0, 0.0, 0.0, 0.0, & + & 0.0, 0.0, 0.0, 0.0, 0.0, 0.0 / + + real :: folnmx_table(mvt) !foliage nitrogen concentration when f(n)=1 (%) + data (folnmx_table (i),i=1,mvt) / 1.5, 1.5, 1.5, 1.5, 1.5, 1.5, & + & 1.5, 1.5, 1.5, 1.5, 1.5, 1.5, & + & 0.00, 1.5, 0.00, 1.5, 0.00, 1.5, & + & 1.5, 1.5, 0.0, 0.0, 0.0, 0.0, & + & 0.0, 0.0, 0.0, 0.0, 0.0, 0.0 / + + real :: tmin_table(mvt) !minimum temperature for photosynthesis (k) + data ( tmin_table (i),i=1,mvt) / 265, 273, 268, 273, 268, 273, & + & 273, 273, 273, 273, 268, 273, & + & 0, 273, 0, 0, 0, 268, & + & 268, 268, 0, 0, 0, 0, & + & 0, 0, 0, 0, 0, 0 / + + +! + real :: xl_table(mvt) !leaf/stem orientation index + data ( xl_table (i),i=1,mvt) / 0.010,0.010,0.010,0.250,0.250,0.010, & + & 0.010, 0.010, 0.010, -0.30, -0.025, -0.30, & + & 0.000, -0.30, 0.000, 0.000, 0.000, 0.250, & + & 0.250, 0.250, 0.000, 0.000, 0.000, 0.000, & + & 0.001, 0.001, 0.000, 0.000, 0.000, 0.000 / +! + real :: rhol_table(mvt,mband) !leaf reflectance: 1=vis, 2=nir + + data ( rhol_table (i,1),i=1,mvt) / 0.07, 0.10, 0.07, 0.10, 0.10, 0.07, & + & 0.07, 0.07, 0.10, 0.11, 0.105, 0.11, & + & 0.00, 0.11, 0.00, 0.00, 0.00, 0.10, & + & 0.10, 0.10, 0.00, 0.00, 0.00, 0.00, & + & 0.00, 0.00, 0.00, 0.00, 0.00, 0.00 / + +! &_______________________________________________________________________& + + data ( rhol_table (i,2),i=1,mvt) / 0.35, 0.45, 0.35, 0.45, 0.45, 0.35, & + & 0.35, 0.35, 0.45, 0.58, 0.515, 0.58, & + & 0.00, 0.58, 0.00, 0.00, 0.00, 0.45, & + & 0.45, 0.45, 0.00, 0.00, 0.00, 0.00, & + & 0.00, 0.00, 0.00, 0.00, 0.00, 0.00 / + + real :: rhos_table(mvt,mband) !stem reflectance: 1=vis, 2=nir + + data ( rhos_table (i,1),i=1,mvt) / 0.16, 0.16, 0.16, 0.16, 0.16, 0.16, & + & 0.16, 0.16, 0.16, 0.36, 0.26, 0.36, & + & 0.00, 0.36, 0.00, 0.00, 0.00, 0.16, & + & 0.16,0.16, 0.00, 0.00, 0.00, 0.00, & + & 0.00, 0.00, 0.00, 0.00, 0.00, 0.00 / + + data ( rhos_table (i,2),i=1,mvt) / 0.39, 0.39, 0.39, 0.39, 0.39, 0.39, & + & 0.39, 0.39, 0.39, 0.58, 0.485, 0.58, & + & 0.00, 0.58, 0.00, 0.00, 0.00, 0.39, & + & 0.39, 0.39, 0.00, 0.00, 0.00, 0.00, & + & 0.00, 0.00, 0.00, 0.00, 0.00, 0.00 / + +! &_______________________________________________________________________& + + real :: taul_table(mvt,mband) !leaf transmittance: 1=vis, 2=nir +! + data ( taul_table (i,1),i=1,mvt) / 0.05, 0.05, 0.05, 0.05, 0.05, 0.05, & + & 0.05, 0.05, 0.05, 0.07, 0.06, 0.07, & + & 0.00, 0.07, 0.00, 0.00, 0.00, 0.05, & + & 0.05, 0.05,0.00, 0.00, 0.00, 0.00, & + & 0.00, 0.00, 0.00, 0.00, 0.00, 0.00 / + + data ( taul_table (i,2),i=1,mvt) / 0.10, 0.25, 0.10, 0.25, 0.25, 0.10, & + & 0.10, 0.10, 0.25, 0.25, 0.25, 0.25, & + & 0.00, 0.25, 0.00, 0.00, 0.00, 0.25, & + & 0.25, 0.25, 0.00, 0.00, 0.00, 0.00, & + & 0.00, 0.00, 0.00, 0.00, 0.00, 0.00 / + + real :: taus_table(mvt,mband) !stem transmittance: 1=vis, 2=nir + data(taus_table (i,1),i=1,mvt) / 0.001,0.001,0.001,0.001,0.001, 0.001, & + & 0.001, 0.001, 0.001, 0.220, 0.1105,0.220, & + & 0.000, 0.220, 0.000, 0.000, 0.000, 0.001, & + & 0.001, 0.001, 0.000, 0.000, 0.000, 0.000, & + & 0.001, 0.001, 0.000, 0.000, 0.000, 0.000 / + + + data(taus_table (i,2),i=1,mvt) / 0.001,0.001,0.001,0.001,0.001, 0.001, & + & 0.001, 0.001, 0.001, 0.380, 0.1905, 0.380, & + & 0.000, 0.380, 0.000, 0.000, 0.000, 0.001, & + & 0.001, 0.001, 0.000, 0.000, 0.000, 0.000, & + & 0.001, 0.001, 0.000, 0.000, 0.000, 0.000 / + + + real :: mrp_table(mvt) !microbial respiration parameter (umol co2 /kg c/ s) + data ( mrp_table (i),i=1,mvt) / 0.37, 0.23, 0.37, 0.40, 0.30, 0.19, & + & 0.19, 0.19, 0.40, 0.17,0.285, 0.23, & + & 0.00, 0.23, 0.00, 0.00, 0.00, 0.23, & + & 0.20, 0.00, 0.00, 0.00, 0.00, 0.00, & + & 0.00, 0.00, 0.00, 0.00, 0.00, 0.00 / + +! + real :: cwpvt_table(mvt) !empirical canopy wind parameter + data ( cwpvt_table (i),i=1,mvt) / 0.18, 0.18, 0.18, 0.18, 0.18, 0.18, & + & 0.18, 0.18, 0.18, 0.18, 0.18, 0.18, & + & 0.18, 0.18, 0.18, 0.18, 0.18, 0.18, & + & 0.18, 0.18, 0.00, 0.00, 0.00, 0.00, & + & 0.00, 0.00, 0.00, 0.00, 0.00, 0.00 / + + + real :: wrrat_table(mvt) !wood to non-wood ratio + data ( wrrat_table (i),i=1,mvt) / 30.0, 30.0, 30.0, 30.0, 30.0, 3.00, & + & 3.00, 3.00, 3.00, 0.00, 15.0, 0.00, & + & 0.00, 0.00, 0.00, 0.00, 0.00, 3.00, & + & 3.00, 0.00, 0.00, 0.00, 0.00, 0.00, & + & 0.00, 0.00, 0.00, 0.00, 0.00, 0.00 / + + real :: wdpool_table(mvt) !wood pool (switch 1 or 0) depending on woody or not [-] + data ( wdpool_table(i),i=1,mvt) / 1.00, 1.00, 1.00, 1.00, 1.00, 1.00, & + & 1.00, 1.00, 1.00, 0.00, 0.5, 0.00, & + & 0.00, 0.00, 0.00, 0.00, 0.00, 1.00, & + & 1.00, 0.00, 0.00, 0.00, 0.00, 0.00, & + & 0.00, 0.00, 0.00, 0.00, 0.00, 0.00 / + + real :: tdlef_table(mvt) !characteristic t for leaf freezing [k] + data ( tdlef_table (i),i=1,mvt) / 278, 278, 268, 278, 268, 278, & + & 278, 278, 278, 278, 268, 278, & + & 278, 278, 0, 0, 0, 268, & + & 268, 268, 0, 0, 0, 0, & + & 0, 0, 0, 0, 0, 0 / + + + real :: nroot_table(mvt) !number of soil layers with root present + data ( nroot_table (i),i=1,mvt) / 4, 4, 4, 4, 4, 3, & + & 3, 3, 3, 3, 2, 3, & + & 1, 3, 1, 1, 0, 3, & + & 3, 2, 0, 0, 0, 0, & + & 0, 0, 0, 0, 0, 0 / + + real :: rgl_table(mvt) !parameter used in radiation stress function + data ( rgl_table (i),i=1,mvt) / 30.0, 30.0, 30.0, 30.0, 30.0, 100.0,& + & 100.0, 100.0, 65.0, 100.0, 65.0, 100.0, & + & 999.0, 100.0, 999.0, 999.0, 30.0, 100.0, & + & 100.0, 100.0, 0.00, 0.00, 0.00, 0.00, & + & 0.00, 0.00, 0.00, 0.00, 0.00, 0.00 / + + real :: rs_table(mvt) !minimum stomatal resistance [s m-1] + data ( rs_table (i),i=1,mvt) / 125.0, 150.0,150.0,100.0,125.0,300.0,& + & 170.0,300.0, 70.0, 40.0, 70.0, 40.0, & + & 200.0, 40.0, 999.0,999.0,100.0,150.0, & + & 150.0, 200.0,0.00, 0.00, 0.00, 0.00, & + & 0.00, 0.00, 0.00, 0.00, 0.00, 0.00 / + + real :: hs_table(mvt) !parameter used in vapor pressure deficit function + data ( hs_table (i),i=1,mvt) / 47.35,41.69,47.35,54.53,51.93,42.00, & + & 39.18, 42.00, 54.53, 36.35, 55.97, 36.25, & + & 999.0, 36.25, 999.0, 999.0, 51.75, 42.00, & + & 42.00, 42.00, 0.00, 0.00, 0.00, 0.00, & + & 0.00, 0.00, 0.00, 0.00, 0.00, 0.00 / + + + real :: topt_table(mvt) !optimum transpiration air temperature [k] + data ( topt_table (i),i=1,mvt) / 298.0,298.0,298.0,298.0,298.0,298.0, & + & 298.0, 298.0, 298.0, 298.0, 298.0, 298.0, & + & 298.0, 298.0, 298.0, 298.0, 298.0, 298.0, & + & 298.0, 298.0, 0.00, 0.00, 0.00, 0.00, & + & 0.00, 0.00, 0.00, 0.00, 0.00, 0.00 / + + real :: rsmax_table(mvt) !maximal stomatal resistance [s m-1] + data ( rsmax_table (i),i=1,mvt) / 5000., 5000.,5000.,5000.,5000.,5000.,& + & 5000., 5000., 5000., 5000., 5000., 5000., & + & 5000., 5000., 5000., 5000., 5000., 5000., & + & 5000., 5000., 0.00, 0.00, 0.00, 0.00, & + & 0.00, 0.00, 0.00, 0.00, 0.00, 0.00 / + +!!!!!!!!!!!!!! Wield not defined but read !!!!!!!!!!!!!!!!1 + + real :: slarea_table(mvt) + + data (slarea_table (i),i=1,mvt) / 0.0090,0.0200,0.0200,0.0258,0.0223, & + & 0.0227, 0.0188, 0.0227, 0.0236, 0.0060, & + & 0.0295, 0.0200, 0.0228, 0.0223, 0.02, & + & 0.02, 0.0422, 0.02, 0.02, 0.02, & + & 0.0, 0.0, 0.0, 0.0, 0.0, & + & 0.0, 0.0, 0.0, 0.0, 0.0 / + +! &_______________________________________________________________________& + + real :: esp1_table(mvt) + + data (esp1_table (i),i=1,mvt) / 0.46, 0.00, 0.00,46.86,30.98, 21.62, & + & 0.11, 21.62, 22.80, 0.02, 0.815, 0.00, & + & 41.87, 0.04, 0.0, 0.0, 2.31, 0.0, & + & 0.0, 0.0,0.0, 0.0, 0.0, 0.0, & + & 0.0, 0.0, 0.0, 0.0, 0.0, 0.0 / + + real :: esp2_table(mvt) + + data (esp2_table (i),i=1,mvt) / 3.34, 0.00, 0.00, 0.38, 0.96, 0.92, & + & 0.22, 0.92, 0.59, 0.05, 0.535, 0.00, & + & 0.98, 0.09, 0.0, 0.0, 1.47, 0.0, & + & 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, & + & 0.0, 0.0, 0.0, 0.0, 0.0, 0.0 / + + + real :: esp3_table(mvt) + + data (esp3_table (i),i=1,mvt) / 1.85, 0.00, 0.00, 1.84, 1.84, 1.73, & + & 1.26, 1.73, 1.37, 0.03, 0.605, 0.00, & + & 1.82, 0.05, 0.0, 0.0, 1.70, 0.0, & + & 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, & + & 0.0, 0.0, 0.0, 0.0, 0.0, 0.0 / + + +! &_______________________________________________________________________& + + real :: esp4_table(mvt) + + data (esp4_table (i),i=1,mvt) / 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, & + & 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, & + & 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, & + & 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, & + & 0.0, 0.0, 0.0, 0.0, 0.0, 0.0 / + real :: esp5_table(mvt) + + data (esp5_table (i),i=1,mvt) / 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, & + & 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, & + & 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, & + & 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, & + & 0.0, 0.0, 0.0, 0.0, 0.0, 0.0 / + +!!!!!!!!!!!!!!!!!!! what are the tables used for !!!!!!!!!!!!!! + +! soilparm.tbl parameters + + real :: bexp_table(max_soiltyp) + + data (bexp_table(i), i=1,slcats) /2.79, 4.26, 4.74, 5.33, 5.33, 5.25,& + & 6.77, 8.72, 8.17, 10.73, 10.39, 11.55, & + & 5.25, 0.0, 2.79, 4.26, 11.55, 2.79, & + & 2.79, 0.00, 0.00, 0.00, 0.00, 0.00, & + & 0.00, 0.00, 0.00, 0.00, 0.00, 0.00 / + + real :: smcdry_table(max_soiltyp) + data (smcdry_table(i), i=1,slcats) /0.010, 0.028, 0.047, 0.084, 0.084,& + & 0.066, 0.067, 0.120, 0.103, 0.100, 0.126, 0.138, & + & 0.066, 0.0, 0.006, 0.028, 0.030, 0.006, & + & 0.010, 0.000, 0.000, 0.000, 0.000, 0.000, & + & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000 / + + real :: f1_table(max_soiltyp) + + data (f1_table(i), i=1,slcats) /-0.472, -1.044, -0.569, 0.162, 0.162, & + & -0.327, -1.491, -1.118, -1.297, -3.209, -1.916, -2.138, & + & -0.327, 0.000, -1.111, -1.044, -10.472, -0.472, & + & -0.472, 0.000, 0.000, 0.000, 0.000, 0.000, & + & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000 / + + real :: smcmax_table(max_soiltyp) + + data (smcmax_table(i), i=1,slcats) /0.339, 0.421, 0.434, 0.476, 0.476,& + & 0.439, 0.404, 0.464, 0.465, 0.406, 0.468, 0.468, & + & 0.439, 1.000, 0.200, 0.421, 0.468, 0.200, & + & 0.339, 0.339, 0.000, 0.000, 0.000, 0.000, & + & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000 / + + real :: smcref_table(max_soiltyp) + + data (smcref_table(i), i=1,slcats) /0.236, 0.383, 0.383, 0.360, 0.383, & + & 0.329, 0.314, 0.387, 0.382, 0.338, 0.404, 0.412, & + & 0.329, 0.000, 0.170, 0.283, 0.454, 0.170, & + & 0.236, 0.000, 0.000, 0.000, 0.000, 0.000, & + & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000 / + + real :: psisat_table(max_soiltyp) + + data (psisat_table(i), i=1,slcats) /0.069, 0.036, 0.141, 0.759, 0.759, & + & 0.355, 0.135, 0.617, 0.263, 0.098, 0.324, 0.468, & + & 0.355, 0.00, 0.069, 0.036, 0.468, 0.069, & + & 0.069, 0.00, 0.00, 0.00, 0.00, 0.00, & + & 0.00, 0.00, 0.00, 0.00, 0.00, 0.00 / + + real :: dksat_table(max_soiltyp) + + data (dksat_table(i), i=1,slcats) /4.66e-5, 1.41e-5, 5.23e-6, 2.81e-6, & + & 2.81e-6, 3.38e-6, 4.45e-6, 2.03e-6, 2.45e-6,7.22e-6, & + & 1.34e-6, 9.74e-7, 3.38e-6, 0.00, 1.41e-4, & + & 1.41e-5, 9.74e-7, 1.41e-4, 4.66e-5,0.0, & + & 0.00, 0.00, 0.00, 0.00, 0.00, & + & 0.00, 0.00, 0.00, 0.00, 0.00 / + + real :: dwsat_table(max_soiltyp) + + data (dwsat_table(i), i=1,slcats) /0.608e-6, 0.514e-5, 0.805e-5, & + & 0.239e-4, 0.239e-4,0.143e-4, 0.99e-5, 0.237e-4, 0.113e-4, 0.187e-4, & + & 0.964e-5, 0.112e-4,0.143e-4,0.00, 0.136e-3, 0.514e-5, & + & 0.112e-4, 0.136e-3, 0.608e-6, 0.00, 0.00, & + & 0.00, 0.00, 0.00, 0.00, & + & 0.00, 0.00, 0.00, 0.00, 0.00 / + + real :: smcwlt_table(max_soiltyp) + + data (smcwlt_table(i), i=1,slcats) /0.010, 0.028, 0.047, 0.084, 0.084,& + & 0.066, 0.067, 0.120, 0.103, 0.100, 0.126, 0.138, & + & 0.066, 0.00, 0.006, 0.028, 0.03, 0.006, & + & 0.010, 0.000, 0.000, 0.000, 0.000, 0.000, & + & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000 / + + real :: quartz_table(max_soiltyp) + + data (quartz_table(i), i=1,slcats) /0.92, 0.82, 0.60, 0.25, 0.10, & + & 0.40, 0.60, 0.10, 0.35, 0.52, 0.10, & + & 0.25, 0.05, 0.60, 0.07, 0.25, 0.60, & + & 0.52, 0.92, 0.00, 0.00, 0.00, 0.00,0.00, & + & 0.00, 0.00, 0.00, 0.00, 0.00, 0.00 / + + +! genparm.tbl parameters + + data (slope_table(i), i=1,9) /0.1, 0.6, 1.0, 0.35, 0.55, 0.8, & + & 0.63, 0.0, 0.0 / + + real :: csoil_table = 2.00e+6 !soil heat capacity [j m-3 k-1] + real :: refdk_table = 2.0e-6 !parameter in the surface runoff parameterization + real :: refkdt_table = 3.0 !parameter in the surface runoff parameterization + real :: frzk_table =0.15 !frozen ground parameter + real :: zbot_table = -8.0 !depth [m] of lower boundary soil temperature + real :: czil_table = 0.075 !parameter used in the calculation of the roughness length for heat + +! mptable.tbl radiation parameters + +! &_______________________________________________________________________& + real :: albsat_table(msc,mband) !saturated soil albedos: 1=vis, 2=nir + data(albsat_table(i,1),i=1,8)/0.15,0.11,0.10,0.09,0.08,0.07,0.06,0.05/ + data(albsat_table(i,2),i=1,8)/0.30,0.22,0.20,0.18,0.16,0.14,0.12,0.10/ + + real :: albdry_table(msc,mband) !dry soil albedos: 1=vis, 2=nir + data(albdry_table(i,1),i=1,8)/0.27,0.22,0.20,0.18,0.16,0.14,0.12,0.10/ + data(albdry_table(i,2),i=1,8)/0.54,0.44,0.40,0.36,0.32,0.28,0.24,0.20/ + + real :: albice_table(mband) !albedo land ice: 1=vis, 2=nir + data (albice_table(i),i=1,mband) /0.80, 0.55/ + + real :: alblak_table(mband) !albedo frozen lakes: 1=vis, 2=nir + data (alblak_table(i),i=1,mband) /0.60, 0.40/ + + real :: omegas_table(mband) !two-stream parameter omega for snow + data (omegas_table(i),i=1,mband) /0.8, 0.4/ + + real :: betads_table = 0.5 !two-stream parameter betad for snow + real :: betais_table = 0.5 !two-stream parameter betad for snow + + real :: eg_table(2) !emissivity + data eg_table /0.97, 0.98 / + + real :: betads, betais + data betads, betais /0.5, 0.5/ + + +! mptable.tbl global parameters + + real :: co2_table = 395.e-06 !co2 partial pressure + real :: o2_table = 0.209 !o2 partial pressure + real :: timean_table = 10.5 !gridcell mean topgraphic index (global mean) + real :: fsatmx_table = 0.38 !maximum surface saturated fraction (global mean) + real :: z0sno_table = 0.002 !snow surface roughness length (m) (0.002) + real :: ssi_table = 0.03 !liquid water holding capacity for snowpack (m3/m3) (0.03) + real :: swemx_table = 1.00 !new snow mass to fully cover old snow (mm) + real :: rsurf_snow_table = 50.0 !surface resistance for snow(s/m) + + +! Noah mp crops +! mptable.tbl crop parameters +! ! NCROP = 5 +! 1: Corn +! 2: Soybean +! 3: Sorghum +! 4: Rice +! 5: Winter wheat + + +! &_______________________________________________________________________& + integer :: pltday_table(ncrop) ! planting date + data (pltday_table(i), i=1,5) /130,111,111,111,111/ + + integer :: hsday_table(ncrop) ! harvest date + data (hsday_table(i),i=1,5) /280,300,300,300,300/ + + real :: plantpop_table(ncrop) ! plant density [per ha] - used? + data (plantpop_table(i),i=1,5) /78.0,78.0,78.0,78.0,78.0/ + + real :: irri_table(ncrop) ! irrigation strategy 0= non-irrigation 1=irrigation (no water-stress) + data (irri_table(i),i=1,5) /0.0,0.0,0.0,0.0,0.0/ + + real :: gddtbase_table(ncrop) ! base temperature for gdd accumulation [c] + data (gddtbase_table(i),i=1,5) /10.0,10.0,10.0,10.0,10.0/ + + real :: gddtcut_table(ncrop) ! upper temperature for gdd accumulation [c] + data (gddtcut_table(i),i=1,5) /30.0,30.0,30.0,30.0,30.0/ + + real :: gdds1_table(ncrop) ! gdd from seeding to emergence + data (gdds1_table(i),i=1,5) /60.0,50.0,50.0,50.0,50.0/ + + real :: gdds2_table(ncrop) ! gdd from seeding to initial vegetative + data (gdds2_table(i),i=1,5) /675.0,718.0,718.0,718.0,718.0/ + + real :: gdds3_table(ncrop) ! gdd from seeding to post vegetative + data (gdds3_table(i),i=1,5) /1183.0,933.0,933.0,933.0,933.0/ + + real :: gdds4_table(ncrop) ! gdd from seeding to intial reproductive + data (gdds4_table(i),i=1,5) /1253.0,1103.0,1103.0,1103.0,1103.0/ + + real :: gdds5_table(ncrop) ! gdd from seeding to pysical maturity + data (gdds5_table(i),i=1,5) /1605.0,1555.0,1555.0,1555.0,1555.0/ + + integer :: c3c4_table(ncrop) ! photosynthetic pathway: 1. = c3 2. = c4 + data (c3c4_table(i),i=1,5) /2.0,1.0,2.0,2.0,2.0/ + + real :: aref_table(ncrop) ! reference maximum co2 assimulation rate + data (aref_table(i),i=1,5) /7.0,7.0,7.0,7.0,7.0/ + + real :: psnrf_table(ncrop) ! co2 assimulation reduction factor(0-1) (caused by non-modeling part,e.g.pest,weeds) + data (psnrf_table(i),i=1,5) /0.85,0.85,0.85,0.85,0.85/ + + real :: i2par_table(ncrop) ! fraction of incoming solar radiation to photosynthetically active radiation + data (i2par_table(i),i=1,5) / 0.5,0.5,0.5,0.5,0.5/ + + real :: tassim0_table(ncrop) ! minimum temperature for co2 assimulation [c] + data (tassim0_table(i),i=1,5) /8.0,8.0,8.0,8.0,8.0/ + + real :: tassim1_table(ncrop) ! co2 assimulation linearly increasing until temperature reaches t1 [c] + data (tassim1_table(i),i=1,5) /18.0,18.0,18.0,18.0,18.0/ + + real :: tassim2_table(ncrop) ! co2 assmilation rate remain at aref until temperature reaches t2 [c] + data (tassim2_table(i),i=1,5) /30.0,30.0,30.0,30.0,30.0/ + + real :: k_table(ncrop) ! light extinction coefficient + data ( k_table(i),i=1,5) /0.55,0.55,0.55,0.55,0.55/ + + real :: epsi_table(ncrop) ! initial light use efficiency + data (epsi_table(i),i=1,5) /12.5,12.5,12.5,12.5,12.5/ + + real :: q10mr_table(ncrop) ! q10 for maintainance respiration + data (q10mr_table(i),i=1,5) /2.0,2.0,2.0,2.0,2.0/ + + real :: foln_mx_table(ncrop) ! foliage nitrogen concentration when f(n)=1 (%) + data (foln_mx_table(i),i=1,5) /1.5,1.5,1.5,1.5,1.5/ + + real :: lefreez_table(ncrop) ! characteristic t for leaf freezing [k] + data (lefreez_table(i),i=1,5) /268,268,268,268,268/ + + + real :: dile_fc_table(ncrop,nstage) ! coeficient for temperature leaf stress death [1/s] + data (dile_fc_table(i,1),i=1,5) /0.0,0.0,0.0,0.0,0.0/ + data (dile_fc_table(i,2),i=1,5) /0.0,0.0,0.0,0.0,0.0/ + data (dile_fc_table(i,3),i=1,5) /0.0,0.0,0.0,0.0,0.0/ + data (dile_fc_table(i,4),i=1,5) /0.0,0.0,0.0,0.0,0.0/ + data (dile_fc_table(i,5),i=1,5) /0.5,0.5,0.5,0.5,0.5/ + data (dile_fc_table(i,6),i=1,5) /0.5,0.5,0.5,0.5,0.5/ + data (dile_fc_table(i,7),i=1,5) /0.0,0.0,0.0,0.0,0.0/ + data (dile_fc_table(i,8),i=1,5) /0.0,0.0,0.0,0.0,0.0/ + + real :: dile_fw_table(ncrop,nstage) ! coeficient for water leaf stress death [1/s] + data (dile_fw_table(i,1),i=1,5) /0.0,0.0,0.0,0.0,0.0/ + data (dile_fw_table(i,2),i=1,5) /0.0,0.0,0.0,0.0,0.0/ + data (dile_fw_table(i,3),i=1,5) /0.0,0.0,0.0,0.0,0.0/ + data (dile_fw_table(i,4),i=1,5) /0.0,0.0,0.0,0.0,0.0/ + data (dile_fw_table(i,5),i=1,5) /0.2,0.2,0.2,0.2,0.2/ + data (dile_fw_table(i,6),i=1,5) /0.2,0.2,0.2,0.2,0.2/ + data (dile_fw_table(i,7),i=1,5) /0.0,0.0,0.0,0.0,0.0/ + data (dile_fw_table(i,8),i=1,5) /0.0,0.0,0.0,0.0,0.0/ + + real :: fra_gr_table(ncrop) ! fraction of growth respiration + data (fra_gr_table(i),i=1,5) /0.2,0.2,0.2,0.2,0.2/ + + real :: lf_ovrc_table(ncrop,nstage) ! fraction of leaf turnover [1/s] + data (lf_ovrc_table(i,1),i=1,5) /0.0,0.0,0.0,0.0,0.0/ + data (lf_ovrc_table(i,2),i=1,5) /0.0,0.0,0.0,0.0,0.0/ + data (lf_ovrc_table(i,3),i=1,5) /0.0,0.0,0.0,0.0,0.0/ + data (lf_ovrc_table(i,4),i=1,5) /0.0,0.0,0.0,0.0,0.0/ + data (lf_ovrc_table(i,5),i=1,5) /0.2,0.48,0.48,0.48,0.48/ + data (lf_ovrc_table(i,6),i=1,5) /0.3,0.48,0.48,0.48,0.48/ + data (lf_ovrc_table(i,7),i=1,5) /0.0,0.0,0.0,0.0,0.0/ + data (lf_ovrc_table(i,8),i=1,5) /0.0,0.0,0.0,0.0,0.0/ + + real :: st_ovrc_table(ncrop,nstage) ! fraction of stem turnover [1/s] + data (st_ovrc_table(i,1),i=1,5) /0.0,0.0,0.0,0.0,0.0/ + data (st_ovrc_table(i,2),i=1,5) /0.0,0.0,0.0,0.0,0.0/ + data (st_ovrc_table(i,3),i=1,5) /0.0,0.0,0.0,0.0,0.0/ + data (st_ovrc_table(i,4),i=1,5) /0.0,0.0,0.0,0.0,0.0/ + data (st_ovrc_table(i,5),i=1,5) /0.12,0.12,0.12,0.12,0.12/ + data (st_ovrc_table(i,6),i=1,5) /0.06,0.06,0.06,0.06,0.06/ + data (st_ovrc_table(i,7),i=1,5) /0.0,0.0,0.0,0.0,0.0/ + data (st_ovrc_table(i,8),i=1,5) /0.0,0.0,0.0,0.0,0.0/ + + real :: rt_ovrc_table(ncrop,nstage) ! fraction of root tunrover [1/s] + data (rt_ovrc_table(i,1),i=1,5) /0.0,0.0,0.0,0.0,0.0/ + data (rt_ovrc_table(i,2),i=1,5) /0.0,0.0,0.0,0.0,0.0/ + data (rt_ovrc_table(i,3),i=1,5) /0.0,0.0,0.0,0.0,0.0/ + data (rt_ovrc_table(i,4),i=1,5) /0.0,0.0,0.0,0.0,0.0/ + data (rt_ovrc_table(i,5),i=1,5) /0.12,0.12,0.12,0.12,0.12/ + data (rt_ovrc_table(i,6),i=1,5) /0.06,0.06,0.06,0.06,0.06/ + data (rt_ovrc_table(i,7),i=1,5) /0.0,0.0,0.0,0.0,0.0/ + data (rt_ovrc_table(i,8),i=1,5) /0.0,0.0,0.0,0.0,0.0/ + + real :: lfmr25_table(ncrop) ! leaf maintenance respiration at 25c [umol co2/m**2 /s] + data (lfmr25_table(i),i=1,5) /1.0,1.0,1.0,1.0,1.0/ + + real :: stmr25_table(ncrop) ! stem maintenance respiration at 25c [umol co2/kg bio/s] + data (stmr25_table(i),i=1,5) /0.05,0.1,0.1,0.1,0.1/ + + real :: rtmr25_table(ncrop) ! root maintenance respiration at 25c [umol co2/kg bio/s] + data (rtmr25_table(i),i=1,5) /0.05,0.0,0.0,0.0,0.0/ + + real :: grainmr25_table(ncrop) ! grain maintenance respiration at 25c [umol co2/kg bio/s] + data (grainmr25_table(i),i=1,5) /0.0,0.1,0.1,0.1,0.1/ + + real :: lfpt_table(ncrop,nstage) ! fraction of carbohydrate flux to leaf + data (lfpt_table(i,1),i=1,5) /0.0,0.0,0.0,0.0,0.0/ + data (lfpt_table(i,2),i=1,5) /0.0,0.0,0.0,0.0,0.0/ + data (lfpt_table(i,3),i=1,5) /0.4,0.4,0.4,0.4,0.4/ + data (lfpt_table(i,4),i=1,5) /0.2,0.2,0.2,0.2,0.2/ + data (lfpt_table(i,5),i=1,5) /0.0,0.0,0.0,0.0,0.0/ + data (lfpt_table(i,6),i=1,5) /0.0,0.0,0.0,0.0,0.0/ + data (lfpt_table(i,7),i=1,5) /0.0,0.0,0.0,0.0,0.0/ + data (lfpt_table(i,8),i=1,5) /0.0,0.0,0.0,0.0,0.0/ + + + real :: stpt_table(ncrop,nstage) ! fraction of carbohydrate flux to stem + data (stpt_table(i,1),i=1,5) /0.0,0.0,0.0,0.0,0.0/ + data (stpt_table(i,2),i=1,5) /0.0,0.0,0.0,0.0,0.0/ + data (stpt_table(i,3),i=1,5) /0.2,0.2,0.2,0.2,0.2/ + data (stpt_table(i,4),i=1,5) /0.5,0.5,0.5,0.5,0.5/ + data (stpt_table(i,5),i=1,5) /0.0,0.15,0.15,0.15,0.15/ + data (stpt_table(i,6),i=1,5) /0.0,0.05,0.05,0.05,0.05/ + data (stpt_table(i,7),i=1,5) /0.0,0.0,0.0,0.0,0.0/ + data (stpt_table(i,8),i=1,5) /0.0,0.0,0.0,0.0,0.0/ + + + real :: rtpt_table(ncrop,nstage) ! fraction of carbohydrate flux to root + data (rtpt_table(i,1),i=1,5) /0.0,0.0,0.0,0.0,0.0/ + data (rtpt_table(i,2),i=1,5) /0.0,0.0,0.0,0.0,0.0/ + data (rtpt_table(i,3),i=1,5) /0.34,0.4,0.4,0.4,0.4/ + data (rtpt_table(i,4),i=1,5) /0.3,0.3,0.3,0.3,0.3/ + data (rtpt_table(i,5),i=1,5) /0.05,0.05,0.05,0.05,0.05/ + data (rtpt_table(i,6),i=1,5) /0.0,0.05,0.05,0.05,0.05/ + data (rtpt_table(i,7),i=1,5) /0.0,0.0,0.0,0.0,0.0/ + data (rtpt_table(i,8),i=1,5) /0.0,0.0,0.0,0.0,0.0/ + + real :: grainpt_table(ncrop,nstage) ! fraction of carbohydrate flux to grain + data (grainpt_table(i,1),i=1,5) /0.0,0.0,0.0,0.0,0.0/ + data (grainpt_table(i,2),i=1,5) /0.0,0.0,0.0,0.0,0.0/ + data (grainpt_table(i,3),i=1,5) /0.0,0.0,0.0,0.0,0.0/ + data (grainpt_table(i,4),i=1,5) /0.0,0.0,0.0,0.0,0.0/ + data (grainpt_table(i,5),i=1,5) /0.95,0.8,0.8,0.8,0.8/ + data (grainpt_table(i,6),i=1,5) /1.0,0.9,0.9,0.9,0.9/ + data (grainpt_table(i,7),i=1,5) /0.0,0.0,0.0,0.0,0.0/ + data (grainpt_table(i,8),i=1,5) /0.0,0.0,0.0,0.0,0.0/ + + real :: bio2lai_table(ncrop) ! leaf are per living leaf biomass [m^2/kg] + data (bio2lai_table(i),i=1,5) /0.035,0.015,0.015,0.015,0.015/ + +end module noahmp_tables + diff --git a/physics/ozphys.f b/physics/ozphys.f index 4acf87107..02296ee79 100644 --- a/physics/ozphys.f +++ b/physics/ozphys.f @@ -10,8 +10,25 @@ module ozphys ! \brief Brief description of the subroutine ! !> \section arg_table_ozphys_init Argument Table +!! \htmlinclude ozphys_init.html !! - subroutine ozphys_init() + subroutine ozphys_init(oz_phys, errmsg, errflg) + + implicit none + logical, intent(in) :: oz_phys + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + if (.not.oz_phys) then + write (errmsg,'(*(a))') 'Logic error: oz_phys == .false.' + errflg = 1 + return + endif + end subroutine ozphys_init ! \brief Brief description of the subroutine @@ -28,29 +45,7 @@ end subroutine ozphys_finalize !! Research Laboratory through CHEM2D chemistry model !! (McCormack et al. (2006) \cite mccormack_et_al_2006). !! \section arg_table_ozphys_run Argument Table -!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | -!! |----------------|---------------------------------------------------------------------------|----------------------------------------------------------------------------|---------|------|-----------|-----------|--------|----------| -!! | ix | horizontal_dimension | horizontal dimension | count | 0 | integer | | in | F | -!! | im | horizontal_loop_extent | horizontal loop extent | count | 0 | integer | | in | F | -!! | levs | vertical_dimension | number of vertical layers | count | 0 | integer | | in | F | -!! | ko3 | vertical_dimension_of_ozone_forcing_data | number of vertical layers in ozone forcing data | count | 0 | integer | | in | F | -!! | dt | time_step_for_physics | physics time step | s | 0 | real | kind_phys | in | F | -!! | oz | ozone_concentration_updated_by_physics | ozone concentration updated by physics | kg kg-1 | 2 | real | kind_phys | inout | F | -!! | tin | air_temperature_updated_by_physics | updated air temperature | K | 2 | real | kind_phys | in | F | -!! | po3 | natural_log_of_ozone_forcing_data_pressure_levels | natural log of ozone forcing data pressure levels | log(Pa) | 1 | real | kind_phys | in | F | -!! | prsl | air_pressure | mid-layer pressure | Pa | 2 | real | kind_phys | in | F | -!! | prdout | ozone_forcing | ozone forcing coefficients | various | 3 | real | kind_phys | in | F | -!! | oz_coeff | number_of_coefficients_in_ozone_forcing_data | number of coefficients in ozone forcing data | index | 0 | integer | | in | F | -!! | delp | air_pressure_difference_between_midlayers | difference between mid-layer pressures | Pa | 2 | real | kind_phys | in | F | -!! | ldiag3d | flag_diagnostics_3D | flag for calculating 3-D diagnostic fields | flag | 0 | logical | | in | F | -!! | ozp1 | cumulative_change_in_ozone_concentration_due_to_production_and_loss_rate | cumulative change in ozone concentration due to production and loss rate | kg kg-1 | 2 | real | kind_phys | inout | F | -!! | ozp2 | cumulative_change_in_ozone_concentration_due_to_ozone_mixing_ratio | cumulative change in ozone concentration due to ozone mixing ratio | kg kg-1 | 2 | real | kind_phys | inout | F | -!! | ozp3 | cumulative_change_in_ozone_concentration_due_to_temperature | cumulative change in ozone concentration due to temperature | kg kg-1 | 2 | real | kind_phys | inout | F | -!! | ozp4 | cumulative_change_in_ozone_concentration_due_to_overhead_ozone_column | cumulative change in ozone concentration due to overhead ozone column | kg kg-1 | 2 | real | kind_phys | inout | F | -!! | con_g | gravitational_acceleration | gravitational acceleration | m s-2 | 0 | real | kind_phys | in | F | -!! | me | mpi_rank | rank of the current MPI task | index | 0 | integer | | in | F | -!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | -!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | +!! \htmlinclude ozphys_run.html !! !> \section genal_ozphys GFS ozphys_run General Algorithm !> @{ diff --git a/physics/ozphys.meta b/physics/ozphys.meta new file mode 100644 index 000000000..9f7a3870d --- /dev/null +++ b/physics/ozphys.meta @@ -0,0 +1,219 @@ +[ccpp-arg-table] + name = ozphys_init + type = scheme +[oz_phys] + standard_name = flag_for_ozone_physics + long_name = flag for old (2006) ozone physics + units = flag + dimensions = () + type = logical + intent = in + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F + +######################################################################## +[ccpp-arg-table] + name = ozphys_finalize + type = scheme + +######################################################################## +[ccpp-arg-table] + name = ozphys_run + type = scheme +[ix] + standard_name = horizontal_dimension + long_name = horizontal dimension + units = count + dimensions = () + type = integer + intent = in + optional = F +[im] + standard_name = horizontal_loop_extent + long_name = horizontal loop extent + units = count + dimensions = () + type = integer + intent = in + optional = F +[levs] + standard_name = vertical_dimension + long_name = number of vertical layers + units = count + dimensions = () + type = integer + intent = in + optional = F +[ko3] + standard_name = vertical_dimension_of_ozone_forcing_data + long_name = number of vertical layers in ozone forcing data + units = count + dimensions = () + type = integer + intent = in + optional = F +[dt] + standard_name = time_step_for_physics + long_name = physics time step + units = s + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[oz] + standard_name = ozone_concentration_updated_by_physics + long_name = ozone concentration updated by physics + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[tin] + standard_name = air_temperature_updated_by_physics + long_name = updated air temperature + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[po3] + standard_name = natural_log_of_ozone_forcing_data_pressure_levels + long_name = natural log of ozone forcing data pressure levels + units = log(Pa) + dimensions = (vertical_dimension_of_ozone_forcing_data) + type = real + kind = kind_phys + intent = in + optional = F +[prsl] + standard_name = air_pressure + long_name = mid-layer pressure + units = Pa + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[prdout] + standard_name = ozone_forcing + long_name = ozone forcing coefficients + units = various + dimensions = (horizontal_dimension,vertical_dimension_of_ozone_forcing_data,number_of_coefficients_in_ozone_forcing_data) + type = real + kind = kind_phys + intent = in + optional = F +[oz_coeff] + standard_name = number_of_coefficients_in_ozone_forcing_data + long_name = number of coefficients in ozone forcing data + units = index + dimensions = () + type = integer + intent = in + optional = F +[delp] + standard_name = air_pressure_difference_between_midlayers + long_name = difference between mid-layer pressures + units = Pa + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[ldiag3d] + standard_name = flag_diagnostics_3D + long_name = flag for calculating 3-D diagnostic fields + units = flag + dimensions = () + type = logical + intent = in + optional = F +[ozp1] + standard_name = cumulative_change_in_ozone_concentration_due_to_production_and_loss_rate + long_name = cumulative change in ozone concentration due to production and loss rate + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[ozp2] + standard_name = cumulative_change_in_ozone_concentration_due_to_ozone_mixing_ratio + long_name = cumulative change in ozone concentration due to ozone mixing ratio + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[ozp3] + standard_name = cumulative_change_in_ozone_concentration_due_to_temperature + long_name = cumulative change in ozone concentration due to temperature + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[ozp4] + standard_name = cumulative_change_in_ozone_concentration_due_to_overhead_ozone_column + long_name = cumulative change in ozone concentration due to overhead ozone column + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[con_g] + standard_name = gravitational_acceleration + long_name = gravitational acceleration + units = m s-2 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[me] + standard_name = mpi_rank + long_name = rank of the current MPI task + units = index + dimensions = () + type = integer + intent = in + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F diff --git a/physics/ozphys_2015.f b/physics/ozphys_2015.f index 6eceaf203..3126313dc 100644 --- a/physics/ozphys_2015.f +++ b/physics/ozphys_2015.f @@ -8,8 +8,25 @@ module ozphys_2015 contains !> \section arg_table_ozphys_2015_init Argument Table +!! \htmlinclude ozphys_2015_init.html !! - subroutine ozphys_2015_init() + subroutine ozphys_2015_init(oz_phys_2015, errmsg, errflg) + + implicit none + logical, intent(in) :: oz_phys_2015 + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + if (.not.oz_phys_2015) then + write (errmsg,'(*(a))') 'Logic error: oz_phys_2015 == .false.' + errflg = 1 + return + endif + end subroutine ozphys_2015_init ! \brief Brief description of the subroutine @@ -20,36 +37,14 @@ subroutine ozphys_2015_finalize() end subroutine ozphys_2015_finalize -!>\defgroup GFS_ozphys_2015 GFS ozphys_2015 Main +!>\defgroup GFS_ozphys_2015 GFS Ozone Photochemistry (2015) Scheme Module !! \brief The operational GFS currently parameterizes ozone production and !! destruction based on monthly mean coefficients ( !! \c ozprdlos_2015_new_sbuvO3_tclm15_nuchem.f77) provided by Naval !! Research Laboratory through CHEM2D chemistry model !! (McCormack et al. (2006) \cite mccormack_et_al_2006). !! \section arg_table_ozphys_2015_run Argument Table -!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | -!! |----------------|--------------------------------------------------------------------------|----------------------------------------------------------------------------|---------|------|-----------|-----------|--------|----------| -!! | ix | horizontal_dimension | horizontal dimension | count | 0 | integer | | in | F | -!! | im | horizontal_loop_extent | horizontal loop extent | count | 0 | integer | | in | F | -!! | levs | vertical_dimension | number of vertical layers | count | 0 | integer | | in | F | -!! | ko3 | vertical_dimension_of_ozone_forcing_data | number of vertical layers in ozone forcing data | count | 0 | integer | | in | F | -!! | dt | time_step_for_physics | physics time step | s | 0 | real | kind_phys | in | F | -!! | oz | ozone_concentration_updated_by_physics | ozone concentration updated by physics | kg kg-1 | 2 | real | kind_phys | inout | F | -!! | tin | air_temperature_updated_by_physics | updated air temperature | K | 2 | real | kind_phys | in | F | -!! | po3 | natural_log_of_ozone_forcing_data_pressure_levels | natural log of ozone forcing data pressure levels | log(Pa) | 1 | real | kind_phys | in | F | -!! | prsl | air_pressure | mid-layer pressure | Pa | 2 | real | kind_phys | in | F | -!! | prdout | ozone_forcing | ozone forcing data | various | 3 | real | kind_phys | in | F | -!! | pl_coeff | number_of_coefficients_in_ozone_forcing_data | number of coefficients in ozone forcing data | index | 0 | integer | | in | F | -!! | delp | air_pressure_difference_between_midlayers | difference between mid-layer pressures | Pa | 2 | real | kind_phys | in | F | -!! | ldiag3d | flag_diagnostics_3D | flag for calculating 3-D diagnostic fields | flag | 0 | logical | | in | F | -!! | ozp1 | cumulative_change_in_ozone_concentration_due_to_production_and_loss_rate | cumulative change in ozone concentration due to production and loss rate | kg kg-1 | 2 | real | kind_phys | inout | F | -!! | ozp2 | cumulative_change_in_ozone_concentration_due_to_ozone_mixing_ratio | cumulative change in ozone concentration due to ozone mixing ratio | kg kg-1 | 2 | real | kind_phys | inout | F | -!! | ozp3 | cumulative_change_in_ozone_concentration_due_to_temperature | cumulative change in ozone concentration due to temperature | kg kg-1 | 2 | real | kind_phys | inout | F | -!! | ozp4 | cumulative_change_in_ozone_concentration_due_to_overhead_ozone_column | cumulative change in ozone concentration due to overhead ozone column | kg kg-1 | 2 | real | kind_phys | inout | F | -!! | con_g | gravitational_acceleration | gravitational acceleration | m s-2 | 0 | real | kind_phys | in | F | -!! | me | mpi_rank | rank of the current MPI task | index | 0 | integer | | in | F | -!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | -!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | +!! \htmlinclude ozphys_2015_run.html !! !> \section genal_ozphys_2015 GFS ozphys_2015_run General Algorithm !> @{ diff --git a/physics/ozphys_2015.meta b/physics/ozphys_2015.meta new file mode 100644 index 000000000..51f8e76f4 --- /dev/null +++ b/physics/ozphys_2015.meta @@ -0,0 +1,219 @@ +[ccpp-arg-table] + name = ozphys_2015_init + type = scheme +[oz_phys_2015] + standard_name = flag_for_2015_ozone_physics + long_name = flag for new (2015) ozone physics + units = flag + dimensions = () + type = logical + intent = in + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F + +######################################################################## +[ccpp-arg-table] + name = ozphys_2015_finalize + type = scheme + +######################################################################## +[ccpp-arg-table] + name = ozphys_2015_run + type = scheme +[ix] + standard_name = horizontal_dimension + long_name = horizontal dimension + units = count + dimensions = () + type = integer + intent = in + optional = F +[im] + standard_name = horizontal_loop_extent + long_name = horizontal loop extent + units = count + dimensions = () + type = integer + intent = in + optional = F +[levs] + standard_name = vertical_dimension + long_name = number of vertical layers + units = count + dimensions = () + type = integer + intent = in + optional = F +[ko3] + standard_name = vertical_dimension_of_ozone_forcing_data + long_name = number of vertical layers in ozone forcing data + units = count + dimensions = () + type = integer + intent = in + optional = F +[dt] + standard_name = time_step_for_physics + long_name = physics time step + units = s + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[oz] + standard_name = ozone_concentration_updated_by_physics + long_name = ozone concentration updated by physics + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[tin] + standard_name = air_temperature_updated_by_physics + long_name = updated air temperature + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[po3] + standard_name = natural_log_of_ozone_forcing_data_pressure_levels + long_name = natural log of ozone forcing data pressure levels + units = log(Pa) + dimensions = (vertical_dimension_of_ozone_forcing_data) + type = real + kind = kind_phys + intent = in + optional = F +[prsl] + standard_name = air_pressure + long_name = mid-layer pressure + units = Pa + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[prdout] + standard_name = ozone_forcing + long_name = ozone forcing data + units = various + dimensions = (horizontal_dimension,vertical_dimension_of_ozone_forcing_data,number_of_coefficients_in_ozone_forcing_data) + type = real + kind = kind_phys + intent = in + optional = F +[pl_coeff] + standard_name = number_of_coefficients_in_ozone_forcing_data + long_name = number of coefficients in ozone forcing data + units = index + dimensions = () + type = integer + intent = in + optional = F +[delp] + standard_name = air_pressure_difference_between_midlayers + long_name = difference between mid-layer pressures + units = Pa + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[ldiag3d] + standard_name = flag_diagnostics_3D + long_name = flag for calculating 3-D diagnostic fields + units = flag + dimensions = () + type = logical + intent = in + optional = F +[ozp1] + standard_name = cumulative_change_in_ozone_concentration_due_to_production_and_loss_rate + long_name = cumulative change in ozone concentration due to production and loss rate + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[ozp2] + standard_name = cumulative_change_in_ozone_concentration_due_to_ozone_mixing_ratio + long_name = cumulative change in ozone concentration due to ozone mixing ratio + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[ozp3] + standard_name = cumulative_change_in_ozone_concentration_due_to_temperature + long_name = cumulative change in ozone concentration due to temperature + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[ozp4] + standard_name = cumulative_change_in_ozone_concentration_due_to_overhead_ozone_column + long_name = cumulative change in ozone concentration due to overhead ozone column + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[con_g] + standard_name = gravitational_acceleration + long_name = gravitational acceleration + units = m s-2 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[me] + standard_name = mpi_rank + long_name = rank of the current MPI task + units = index + dimensions = () + type = integer + intent = in + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F diff --git a/physics/physcons.F90 b/physics/physcons.F90 index 9027f4cba..5fb993ac3 100644 --- a/physics/physcons.F90 +++ b/physics/physcons.F90 @@ -44,45 +44,47 @@ module physcons !> \name Math constants ! real(kind=kind_phys),parameter:: con_pi =3.1415926535897931 !< pi real(kind=kind_phys),parameter:: con_pi =4.0d0*atan(1.0d0) !< pi - real(kind=kind_phys),parameter:: con_sqrt2 =1.414214e+0 !< square root of 2 - real(kind=kind_phys),parameter:: con_sqrt3 =1.732051e+0 !< quare root of 3 + real(kind=kind_phys),parameter:: con_sqrt2 =1.414214e+0_kind_phys !< square root of 2 + real(kind=kind_phys),parameter:: con_sqrt3 =1.732051e+0_kind_phys !< quare root of 3 !> \name Geophysics/Astronomy constants - real(kind=kind_phys),parameter:: con_rerth =6.3712e+6 !< radius of earth (\f$m\f$) - real(kind=kind_phys),parameter:: con_g =9.80665e+0 !< gravity (\f$m/s^{2}\f$) - real(kind=kind_phys),parameter:: con_omega =7.2921e-5 !< ang vel of earth (\f$s^{-1}\f$) - real(kind=kind_phys),parameter:: con_p0 =1.01325e5 !< standard atmospheric pressure (\f$Pa\f$) -! real(kind=kind_phys),parameter:: con_solr =1.36822e+3 ! solar constant (W/m2)-aer(2001) - real(kind=kind_phys),parameter:: con_solr_old =1.3660e+3 !< solar constant (\f$W/m^{2}\f$)-Liu(2002) - real(kind=kind_phys),parameter:: con_solr =1.3608e+3 !< solar constant (\f$W/m^{2}\f$)-nasa-sorce Tim(2008) -! real(kind=kind_phys),parameter:: con_solr =1.36742732e+3 ! solar constant (W/m2)-gfdl(1989) - OPR as of Jan 2006 + real(kind=kind_phys),parameter:: con_rerth =6.3712e+6_kind_phys !< radius of earth (\f$m\f$) + real(kind=kind_phys),parameter:: con_g =9.80665e+0_kind_phys !< gravity (\f$m/s^{2}\f$) + real(kind=kind_phys),parameter:: con_omega =7.2921e-5_kind_phys !< ang vel of earth (\f$s^{-1}\f$) + real(kind=kind_phys),parameter:: con_p0 =1.01325e5_kind_phys !< standard atmospheric pressure (\f$Pa\f$) +! real(kind=kind_phys),parameter:: con_solr =1.36822e+3_kind_phys ! solar constant (W/m2)-aer(2001) + real(kind=kind_phys),parameter:: con_solr_old =1.3660e+3_kind_phys !< solar constant (\f$W/m^{2}\f$)-Liu(2002) + real(kind=kind_phys),parameter:: con_solr =1.3608e+3_kind_phys !< solar constant (\f$W/m^{2}\f$)-nasa-sorce Tim(2008) +! real(kind=kind_phys),parameter:: con_solr =1.36742732e+3_kind_phys ! solar constant (W/m2)-gfdl(1989) - OPR as of Jan 2006 ! Selected geophysics/astronomy constants with kind=kind_dyn - real(kind=kind_dyn), parameter:: con_g_dyn =9.80665e+0 !< gravity (\f$m/s^{2}\f$) + real(kind=kind_dyn), parameter:: con_g_dyn =9.80665e+0_kind_dyn !< gravity (\f$m/s^{2}\f$) !> \name Thermodynamics constants - real(kind=kind_phys),parameter:: con_rgas =8.314472 !< molar gas constant (\f$J/mol/K\f$) - real(kind=kind_phys),parameter:: con_rd =2.8705e+2 !< gas constant air (\f$J/kg/K\f$) - real(kind=kind_phys),parameter:: con_rv =4.6150e+2 !< gas constant H2O (\f$J/kg/K\f$) - real(kind=kind_phys),parameter:: con_cp =1.0046e+3 !< spec heat air at p (\f$J/kg/K\f$) - real(kind=kind_phys),parameter:: con_cv =7.1760e+2 !< spec heat air at v (\f$J/kg/K\f$) - real(kind=kind_phys),parameter:: con_cvap =1.8460e+3 !< spec heat H2O gas (\f$J/kg/K\f$) - real(kind=kind_phys),parameter:: con_cliq =4.1855e+3 !< spec heat H2O liq (\f$J/kg/K\f$) - real(kind=kind_phys),parameter:: con_csol =2.1060e+3 !< spec heat H2O ice (\f$J/kg/K\f$) - real(kind=kind_phys),parameter:: con_hvap =2.5000e+6 !< lat heat H2O cond (\f$J/kg\f$) - real(kind=kind_phys),parameter:: con_hfus =3.3358e+5 !< lat heat H2O fusion (\f$J/kg\f$) - real(kind=kind_phys),parameter:: con_psat =6.1078e+2 !< pres at H2O 3pt (\f$Pa\f$) - real(kind=kind_phys),parameter:: con_t0c =2.7315e+2 !< temp at 0C (K) - real(kind=kind_phys),parameter:: con_ttp =2.7316e+2 !< temp at H2O 3pt (K) - real(kind=kind_phys),parameter:: con_tice =2.7120e+2 !< temp freezing sea (K) - real(kind=kind_phys),parameter:: con_jcal =4.1855E+0 !< joules per calorie - real(kind=kind_phys),parameter:: con_rhw0 =1022.0 !< sea water reference density (\f$kg/m^{3}\f$) - real(kind=kind_phys),parameter:: con_epsq =1.0E-12 !< min q for computing precip type + real(kind=kind_phys),parameter:: con_rgas =8.314472_kind_phys !< molar gas constant (\f$J/mol/K\f$) + real(kind=kind_phys),parameter:: con_rd =2.8705e+2_kind_phys !< gas constant air (\f$J/kg/K\f$) + real(kind=kind_phys),parameter:: con_rv =4.6150e+2_kind_phys !< gas constant H2O (\f$J/kg/K\f$) + real(kind=kind_phys),parameter:: con_cp =1.0046e+3_kind_phys !< spec heat air at p (\f$J/kg/K\f$) + real(kind=kind_phys),parameter:: con_cv =7.1760e+2_kind_phys !< spec heat air at v (\f$J/kg/K\f$) + real(kind=kind_phys),parameter:: con_cvap =1.8460e+3_kind_phys !< spec heat H2O gas (\f$J/kg/K\f$) + real(kind=kind_phys),parameter:: con_cliq =4.1855e+3_kind_phys !< spec heat H2O liq (\f$J/kg/K\f$) + real(kind=kind_phys),parameter:: con_csol =2.1060e+3_kind_phys !< spec heat H2O ice (\f$J/kg/K\f$) + real(kind=kind_phys),parameter:: con_hvap =2.5000e+6_kind_phys !< lat heat H2O cond (\f$J/kg\f$) +! real(kind=kind_phys),parameter:: con_hvap =2.5010e+6_kind_phys ! from AMS + real(kind=kind_phys),parameter:: con_hfus =3.3358e+5_kind_phys !< lat heat H2O fusion (\f$J/kg\f$) +! real(kind=kind_phys),parameter:: con_hfus =3.3370e+5_kind_phys ! from AMS + real(kind=kind_phys),parameter:: con_psat =6.1078e+2_kind_phys !< pres at H2O 3pt (\f$Pa\f$) + real(kind=kind_phys),parameter:: con_t0c =2.7315e+2_kind_phys !< temp at 0C (K) + real(kind=kind_phys),parameter:: con_ttp =2.7316e+2_kind_phys !< temp at H2O 3pt (K) + real(kind=kind_phys),parameter:: con_tice =2.7120e+2_kind_phys !< temp freezing sea (K) + real(kind=kind_phys),parameter:: con_jcal =4.1855E+0_kind_phys !< joules per calorie + real(kind=kind_phys),parameter:: con_rhw0 =1022.0_kind_phys !< sea water reference density (\f$kg/m^{3}\f$) + real(kind=kind_phys),parameter:: con_epsq =1.0E-12_kind_phys !< min q for computing precip type ! Selected thermodynamics constants with kind=kind_dyn - real(kind=kind_dyn), parameter:: con_rd_dyn =2.8705e+2 !< gas constant air (\f$J/kg/K\f$) - real(kind=kind_dyn), parameter:: con_rv_dyn =4.6150e+2 !< gas constant H2O (\f$J/kg/K\f$) - real(kind=kind_dyn), parameter:: con_cp_dyn =1.0046e+3 !< spec heat air at p (\f$J/kg/K\f$) - real(kind=kind_dyn), parameter:: con_hvap_dyn =2.5000e+6 !< lat heat H2O cond (\f$J/kg\f$) - real(kind=kind_dyn), parameter:: con_hfus_dyn =3.3358e+5 !< lat heat H2O fusion (\f$J/kg\f$) + real(kind=kind_dyn), parameter:: con_rd_dyn =2.8705e+2_kind_dyn !< gas constant air (\f$J/kg/K\f$) + real(kind=kind_dyn), parameter:: con_rv_dyn =4.6150e+2_kind_dyn !< gas constant H2O (\f$J/kg/K\f$) + real(kind=kind_dyn), parameter:: con_cp_dyn =1.0046e+3_kind_dyn !< spec heat air at p (\f$J/kg/K\f$) + real(kind=kind_dyn), parameter:: con_hvap_dyn =2.5000e+6_kind_dyn !< lat heat H2O cond (\f$J/kg\f$) + real(kind=kind_dyn), parameter:: con_hfus_dyn =3.3358e+5_kind_dyn !< lat heat H2O fusion (\f$J/kg\f$) !> \name Secondary constants real(kind=kind_phys),parameter:: con_rocp =con_rd/con_cp @@ -96,23 +98,28 @@ module physcons real(kind=kind_phys),parameter:: con_xponb =-con_dldt/con_rv+con_hvap/(con_rv*con_ttp) !> \name Other Physics/Chemistry constants (source: 2002 CODATA) - real(kind=kind_phys),parameter:: con_c =2.99792458e+8 !< speed of light (\f$m/s\f$) - real(kind=kind_phys),parameter:: con_plnk =6.6260693e-34 !< planck constant (\f$J/s\f$) - real(kind=kind_phys),parameter:: con_boltz =1.3806505e-23 !< boltzmann constant (\f$J/K\f$) - real(kind=kind_phys),parameter:: con_sbc =5.670400e-8 !< stefan-boltzmann (\f$W/m^{2}/K^{4}\f$) - real(kind=kind_phys),parameter:: con_avgd =6.0221415e23 !< avogadro constant (\f$mol^{-1}\f$) - real(kind=kind_phys),parameter:: con_gasv =22413.996e-6 !< vol of ideal gas at 273.15K, 101.325kPa (\f$m^{3}/mol\f$) -! real(kind=kind_phys),parameter:: con_amd =28.970 !< molecular wght of dry air (g/mol) - real(kind=kind_phys),parameter:: con_amd =28.9644 !< molecular wght of dry air (\f$g/mol\f$) - real(kind=kind_phys),parameter:: con_amw =18.0154 !< molecular wght of water vapor (\f$g/mol\f$) - real(kind=kind_phys),parameter:: con_amo3 =47.9982 !< molecular wght of o3 (\f$g/mol\f$) -! real(kind=kind_phys),parameter:: con_amo3 =48.0 !< molecular wght of o3 (g/mol) - real(kind=kind_phys),parameter:: con_amco2 =44.011 !< molecular wght of co2 (\f$g/mol\f$) - real(kind=kind_phys),parameter:: con_amo2 =31.9999 !< molecular wght of o2 (\f$g/mol\f$) - real(kind=kind_phys),parameter:: con_amch4 =16.043 !< molecular wght of ch4 (\f$g/mol\f$) - real(kind=kind_phys),parameter:: con_amn2o =44.013 !< molecular wght of n2o (\f$g/mol\f$) - real(kind=kind_phys),parameter:: con_thgni =-38.15 !< temperature the H.G.Nuc. ice starts - real(kind=kind_phys),parameter:: cimin =0.15 !< minimum ice concentration + real(kind=kind_phys),parameter:: con_c =2.99792458e+8_kind_phys !< speed of light (\f$m/s\f$) + real(kind=kind_phys),parameter:: con_plnk =6.6260693e-34_kind_phys !< planck constant (\f$J/s\f$) + real(kind=kind_phys),parameter:: con_boltz =1.3806505e-23_kind_phys !< boltzmann constant (\f$J/K\f$) + real(kind=kind_phys),parameter:: con_sbc =5.670400e-8_kind_phys !< stefan-boltzmann (\f$W/m^{2}/K^{4}\f$) + real(kind=kind_phys),parameter:: con_avgd =6.0221415e23_kind_phys !< avogadro constant (\f$mol^{-1}\f$) + real(kind=kind_phys),parameter:: con_gasv =22413.996e-6_kind_phys !< vol of ideal gas at 273.15K, 101.325kPa (\f$m^{3}/mol\f$) +! real(kind=kind_phys),parameter:: con_amd =28.970_kind_phys !< molecular wght of dry air (g/mol) + real(kind=kind_phys),parameter:: con_amd =28.9644_kind_phys !< molecular wght of dry air (\f$g/mol\f$) + real(kind=kind_phys),parameter:: con_amw =18.0154_kind_phys !< molecular wght of water vapor (\f$g/mol\f$) + real(kind=kind_phys),parameter:: con_amo3 =47.9982_kind_phys !< molecular wght of o3 (\f$g/mol\f$) +! real(kind=kind_phys),parameter:: con_amo3 =48.0_kind_phys !< molecular wght of o3 (g/mol) + real(kind=kind_phys),parameter:: con_amco2 =44.011_kind_phys !< molecular wght of co2 (\f$g/mol\f$) + real(kind=kind_phys),parameter:: con_amo2 =31.9999_kind_phys !< molecular wght of o2 (\f$g/mol\f$) + real(kind=kind_phys),parameter:: con_amch4 =16.043_kind_phys !< molecular wght of ch4 (\f$g/mol\f$) + real(kind=kind_phys),parameter:: con_amn2o =44.013_kind_phys !< molecular wght of n2o (\f$g/mol\f$) + real(kind=kind_phys),parameter:: con_thgni =-38.15_kind_phys !< temperature the H.G.Nuc. ice starts + +!> minimum ice concentration + real(kind=kind_phys),parameter:: cimin =0.15 !< minimum ice concentration + +!> minimum aerosol concentration + real(kind=kind_phys),parameter:: qamin = 1.e-16_kind_phys !> \name Miscellaneous physics related constants (For WSM6; Moorthi - Jul 2014) ! integer, parameter :: max_lon=16000, max_lat=8000, min_lon=192, min_lat=94 @@ -123,12 +130,12 @@ module physcons ! real(kind=kind_phys), parameter:: rlapse = 0.65e-2, rhc_max = 0.9999999 ! new ! real(kind=kind_phys), parameter:: rlapse = 0.65e-2, rhc_max = 0.9900 - real(kind=kind_phys), parameter:: rlapse = 0.65e-2 - real(kind=kind_phys), parameter:: cb2mb = 10.0, pa2mb = 0.01 + real(kind=kind_phys), parameter:: rlapse = 0.65e-2_kind_phys + real(kind=kind_phys), parameter:: cb2mb = 10.0_kind_phys, pa2mb = 0.01_kind_phys ! for wsm6 - real(kind=kind_phys),parameter:: rhowater = 1000. !< density of water (kg/m^3) - real(kind=kind_phys),parameter:: rhosnow = 100. !< density of snow (kg/m^3) - real(kind=kind_phys),parameter:: rhoair = 1.28 !< density of air near surface (kg/m^3) + real(kind=kind_phys),parameter:: rhowater = 1000._kind_phys !< density of water (kg/m^3) + real(kind=kind_phys),parameter:: rhosnow = 100._kind_phys !< density of snow (kg/m^3) + real(kind=kind_phys),parameter:: rhoair = 1.28_kind_phys !< density of air near surface (kg/m^3) !........................................! end module physcons ! diff --git a/physics/precpd.f b/physics/precpd.f index 9e8f5b696..5e7018314 100644 --- a/physics/precpd.f +++ b/physics/precpd.f @@ -18,30 +18,7 @@ end subroutine zhaocarr_precpd_init !! precipitation (snow or rain) or evaporation of rain. !! !! \section arg_table_zhaocarr_precpd_run Argument Table -!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | -!! |----------------|---------------------------------------------------------------|-------------------------------------------------------------------|-------------|------|-----------|-----------|--------|----------| -!! | im | horizontal_loop_extent | horizontal loop extent | count | 0 | integer | | in | F | -!! | ix | horizontal_dimension | horizontal dimension | count | 0 | integer | | in | F | -!! | km | vertical_dimension | vertical layer dimension | count | 0 | integer | | in | F | -!! | dt | time_step_for_physics | physics time step | s | 0 | real | kind_phys | in | F | -!! | del | air_pressure_difference_between_midlayers | pressure level thickness | Pa | 2 | real | kind_phys | in | F | -!! | prsl | air_pressure | layer mean pressure | Pa | 2 | real | kind_phys | in | F | -!! | q | water_vapor_specific_humidity_updated_by_physics | water vapor specific humidity | kg kg-1 | 2 | real | kind_phys | inout | F | -!! | cwm | cloud_condensed_water_mixing_ratio_updated_by_physics | moist cloud condensed water mixing ratio | kg kg-1 | 2 | real | kind_phys | inout | F | -!! | t | air_temperature_updated_by_physics | layer mean air temperature | K | 2 | real | kind_phys | inout | F | -!! | rn | lwe_thickness_of_explicit_precipitation_amount | explicit precipitation amount on physics timestep | m | 1 | real | kind_phys | out | F | -!! | sr | ratio_of_snowfall_to_rainfall | ratio of snowfall to large-scale rainfall | frac | 1 | real | kind_phys | out | F | -!! | rainp | tendency_of_rain_water_mixing_ratio_due_to_microphysics | tendency of rain water mixing ratio due to microphysics | kg kg-1 s-1 | 2 | real | kind_phys | out | F | -!! | u00k | critical_relative_humidity | critical relative humidity | frac | 2 | real | kind_phys | in | F | -!! | psautco | coefficient_from_cloud_ice_to_snow | conversion coefficient from cloud ice to snow | none | 1 | real | kind_phys | in | F | -!! | prautco | coefficient_from_cloud_water_to_rain | conversion coefficient from cloud water to rain | none | 1 | real | kind_phys | in | F | -!! | evpco | coefficient_for_evaporation_of_rainfall | coefficient for evaporation of rainfall | none | 0 | real | kind_phys | in | F | -!! | wminco | cloud_condensed_water_conversion_threshold | conversion coefficient from cloud liquid and ice to precipitation | none | 1 | real | kind_phys | in | F | -!! | wk1 | grid_size_related_coefficient_used_in_scale-sensitive_schemes | grid size related coefficient used in scale-sensitive schemes | none | 1 | real | kind_phys | in | F | -!! | lprnt | flag_print | flag for printing diagnostics to output | flag | 0 | logical | | in | F | -!! | jpr | horizontal_index_of_printed_column | horizontal index of printed column | index | 0 | integer | | in | F | -!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | -!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | +!! \htmlinclude zhaocarr_precpd_run.html !! !> \section general_precpd GFS precpd Scheme General Algorithm !! The following two equations can be used to calculate the diff --git a/physics/precpd.meta b/physics/precpd.meta new file mode 100644 index 000000000..37a1850ab --- /dev/null +++ b/physics/precpd.meta @@ -0,0 +1,205 @@ +[ccpp-arg-table] + name = zhaocarr_precpd_init + type = scheme + +######################################################################## +[ccpp-arg-table] + name = zhaocarr_precpd_run + type = scheme +[im] + standard_name = horizontal_loop_extent + long_name = horizontal loop extent + units = count + dimensions = () + type = integer + intent = in + optional = F +[ix] + standard_name = horizontal_dimension + long_name = horizontal dimension + units = count + dimensions = () + type = integer + intent = in + optional = F +[km] + standard_name = vertical_dimension + long_name = vertical layer dimension + units = count + dimensions = () + type = integer + intent = in + optional = F +[dt] + standard_name = time_step_for_physics + long_name = physics time step + units = s + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[del] + standard_name = air_pressure_difference_between_midlayers + long_name = pressure level thickness + units = Pa + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[prsl] + standard_name = air_pressure + long_name = layer mean pressure + units = Pa + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[q] + standard_name = water_vapor_specific_humidity_updated_by_physics + long_name = water vapor specific humidity + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[cwm] + standard_name = cloud_condensed_water_mixing_ratio_updated_by_physics + long_name = moist cloud condensed water mixing ratio + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[t] + standard_name = air_temperature_updated_by_physics + long_name = layer mean air temperature + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[rn] + standard_name = lwe_thickness_of_explicit_precipitation_amount + long_name = explicit precipitation amount on physics timestep + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[sr] + standard_name = ratio_of_snowfall_to_rainfall + long_name = ratio of snowfall to large-scale rainfall + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[rainp] + standard_name = tendency_of_rain_water_mixing_ratio_due_to_microphysics + long_name = tendency of rain water mixing ratio due to microphysics + units = kg kg-1 s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[u00k] + standard_name = critical_relative_humidity + long_name = critical relative humidity + units = frac + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[psautco] + standard_name = coefficient_from_cloud_ice_to_snow + long_name = conversion coefficient from cloud ice to snow + units = none + dimensions = (2) + type = real + kind = kind_phys + intent = in + optional = F +[prautco] + standard_name = coefficient_from_cloud_water_to_rain + long_name = conversion coefficient from cloud water to rain + units = none + dimensions = (2) + type = real + kind = kind_phys + intent = in + optional = F +[evpco] + standard_name = coefficient_for_evaporation_of_rainfall + long_name = coefficient for evaporation of rainfall + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[wminco] + standard_name = cloud_condensed_water_conversion_threshold + long_name = conversion coefficient from cloud liquid and ice to precipitation + units = none + dimensions = (2) + type = real + kind = kind_phys + intent = in + optional = F +[wk1] + standard_name = grid_size_related_coefficient_used_in_scale_sensitive_schemes + long_name = grid size related coefficient used in scale-sensitive schemes + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[lprnt] + standard_name = flag_print + long_name = flag for printing diagnostics to output + units = flag + dimensions = () + type = logical + intent = in + optional = F +[jpr] + standard_name = horizontal_index_of_printed_column + long_name = horizontal index of printed column + units = index + dimensions = () + type = integer + intent = in + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F + +######################################################################## +[ccpp-arg-table] + name = zhaocarr_precpd_finalize + type = scheme diff --git a/physics/radcons.f90 b/physics/radcons.f90 index da90bcb74..b767d2192 100644 --- a/physics/radcons.f90 +++ b/physics/radcons.f90 @@ -60,7 +60,6 @@ module radcons !---------------------------- ! Module variable definitions !---------------------------- -! DH* CHECK IF THIS IS NEEDED/TRUE? !CCPP: copy from GFS_driver.F90 real(kind=kind_phys), parameter :: con_24 = 24.0_kind_phys real(kind=kind_phys), parameter :: con_hr = 3600.0_kind_phys diff --git a/physics/radiation_aerosols.f b/physics/radiation_aerosols.f index a6afff5d3..60bb50d34 100644 --- a/physics/radiation_aerosols.f +++ b/physics/radiation_aerosols.f @@ -123,20 +123,6 @@ !! \brief This module contains climatological atmospheric aerosol schemes for !! radiation computations. !! -!! GFS selection for Aerosol distribution (namelist control paramter - \b IAER = 111 -!! and \b IAERMDL =0; not available for the current operational GFS) -!! \n IAERMDL=0: OPAC-climatology tropospheric model (monthly mean, \f$15^o\f$ horizontal resolution) -!! \n IAERMDL=1: GOCART-climatology tropospheric aerosol model -!! \n IAERMDL=2: GOCART-climatology prognostic aerosol model -!! -!!\n \b Stratosphere: historical recorded volcanic forcing in four zonal mean bands (1850-2000) -!!\n \b IAER = abc of 3-digit integer flags: a-volcanic; b-LW; c-SW -!!\n a=0: include background stratospheric volcanic aerosol effect (if both b&c /=0) -!!\n a=1: include recorded stratospheric volcanic aerosol effect -!!\n b=0: no LW tropospheric aerosol effect -!!\n b=1: include LW tropospheric aerosol effect -!!\n c=0: no SW tropospheric aerosol effect -!!\n c=1: include SW tropospheric aerosol effect !! !!\version NCEP-Radiation_aerosols v5.2 Jan 2013 !! diff --git a/physics/radiation_astronomy.f b/physics/radiation_astronomy.f index 8a788b257..f1651ca84 100644 --- a/physics/radiation_astronomy.f +++ b/physics/radiation_astronomy.f @@ -611,7 +611,7 @@ subroutine sol_update & ! --- ... setting up calculation parameters used by subr coszmn - nswr = nint(deltsw / deltim) ! number of mdl t-step per sw call + nswr = max(1, nint(deltsw/deltim)) ! number of mdl t-step per sw call dtswh = deltsw / f3600 ! time length in hours ! if ( deltsw >= f3600 ) then ! for longer sw call interval @@ -624,7 +624,7 @@ subroutine sol_update & ! anginc = pid12 * dtswh / float(nstp-1) ! solar angle inc during each calc step - nstp = nswr + nstp = max(6, nswr) anginc = pid12 * dtswh / float(nstp) if ( me == 0 ) then @@ -870,7 +870,7 @@ subroutine coszmn & real (kind=kind_phys), intent(out) :: coszen(:), coszdg(:) ! --- locals: - real (kind=kind_phys) :: coszn, cns, ss, cc, solang, rstp + real (kind=kind_phys) :: coszn, cns, solang, rstp integer :: istsun(IM), i, it, j, lat @@ -886,12 +886,9 @@ subroutine coszmn & do it = 1, nstp cns = solang + (float(it)-0.5)*anginc + sollag - do i = 1, IM - ss = sinlat(i) * sindec - cc = coslat(i) * cosdec - - coszn = ss + cc * cos(cns + xlon(i)) + coszn = sindec * sinlat(i) + cosdec * coslat(i) & + & * cos(cns+xlon(i)) coszen(i) = coszen(i) + max(0.0, coszn) if (coszn > czlimt) istsun(i) = istsun(i) + 1 enddo diff --git a/physics/radiation_clouds.f b/physics/radiation_clouds.f index 7f8d49c23..49b394fe1 100644 --- a/physics/radiation_clouds.f +++ b/physics/radiation_clouds.f @@ -262,6 +262,7 @@ module module_radiation_clouds !!\n =8: Thompson microphysics !!\n =6: WSM6 microphysics !!\n =10: MG microphysics +!!\n =15: Ferrier-Aligo microphysics !!\param me print control flag !>\section gen_cld_init cld_init General Algorithm !! @{ @@ -350,6 +351,8 @@ subroutine cld_init & print *,' --- WSM6 cloud microphysics' elseif (imp_physics == 10) then print *,' --- MG cloud microphysics' + elseif (imp_physics == 15) then + print *,' --- Ferrier-Aligo cloud microphysics' else print *,' !!! ERROR in cloud microphysc specification!!!', & & ' imp_physics (NP3D) =',imp_physics @@ -845,6 +848,8 @@ end subroutine progcld1 !!\param delp (IX,NLAY), model layer pressure thickness in mb (100Pa) !!\param IX horizontal dimention !!\param NLAY,NLP1 vertical layer/level dimensions +!!\param lmfshal flag for mass-flux shallow convection scheme in the cloud fraction calculation +!!\param lmfdeep2 flag for mass-flux deep convection scheme in the cloud fraction calculation !!\param clouds (IX,NLAY,NF_CLDS), cloud profiles !!\n (:,:,1) - layer total cloud fraction !!\n (:,:,2) - layer cloud liq water path \f$(g/m^2)\f$ @@ -860,7 +865,7 @@ end subroutine progcld1 !!\param mbot (IX,3), vertical indices for low, mid, hi cloud bases !!\param de_lgth (IX), clouds decorrelation length (km) !>\section gen_progcld2 progcld2 General Algorithm -!! @{ +!> @{ subroutine progcld2 & & ( plyr,plvl,tlyr,tvly,qlyr,qstl,rhly,clw, & ! --- inputs: & xlat,xlon,slmsk,dz,delp, f_ice,f_rain,r_rime,flgmin, & @@ -1265,7 +1270,7 @@ subroutine progcld2 & return !................................... end subroutine progcld2 -!! @} +!> @} !----------------------------------- !> \ingroup module_radiation_clouds @@ -1279,6 +1284,8 @@ end subroutine progcld2 !!\param qstl (ix,nlay), layer saturate humidity in gm/gm !!\param rhly (ix,nlay), layer relative humidity (=qlyr/qstl) !!\param clw (ix,nlay), layer cloud condensate amount +!!\param cnvw (ix,nlay), layer convective cloud condensate +!!\param cnvc (ix,nlay), layer convective cloud cover !!\param xlat (ix), grid latitude in radians, default to pi/2 -> !! -pi/2 range, otherwise see in-line comment !!\param xlon (ix), grid longitude in radians (not used) @@ -1684,6 +1691,8 @@ end subroutine progcld3 !!\param xlon (ix), grid longitude in radians (not used) !!\param slmsk (ix), sea/land mask array (sea:0, land:1, sea-ice:2) !!\param cldtot (ix,nlay), layer total cloud fraction +!!\param dz (ix,nlay), layer thickness (km) +!!\param delp (ix,nlay), model layer pressure thickness in mb (100Pa) !!\param ix horizontal dimension !!\param nlay vertical layer dimension !!\param nlp1 vertical level dimension @@ -1700,6 +1709,7 @@ end subroutine progcld3 !!\param clds fraction of clouds for low, mid, hi cloud tops !!\param mtop vertical indices for low, mid, hi cloud tops !!\param mbot vertical indices for low, mid, hi cloud bases +!!\param de_lgth clouds decorrelation length (km) !>\section gen_progcld4 progcld4 General Algorithm !! @{ subroutine progcld4 & @@ -2014,6 +2024,8 @@ end subroutine progcld4 !! range, otherwise see in-line comment !>\param xlon (ix), grid longitude in radians (not used) !>\param slmsk (ix), sea/land mask array (sea:0, land:1, sea-ice:2) +!>\param dz layer thickness (km) +!>\param delp model layer pressure thickness in mb (100Pa) !>\param ntrac number of tracers minus one (Model%ntrac-1) !>\param ntcw tracer index for cloud liquid water minus one (Model%ntcw-1) !>\param ntiw tracer index for cloud ice water minus one (Model%ntiw-1) @@ -2037,6 +2049,7 @@ end subroutine progcld4 !>\param clds (ix,5), fraction of clouds for low, mid, hi, tot, bl !>\param mtop (ix,3), vertical indices for low, mid, hi cloud tops !>\param mbot (ix,3), vertical indices for low, mid, hi cloud bases +!>\param de_lgth clouds decorrelation length (km) !>\section gen_progcld4o progcld4o General Algorithm !! @{ subroutine progcld4o & @@ -2677,9 +2690,8 @@ end subroutine progcld5 !!\param plvl (IX,NLP1), model level pressure in mb (100Pa) !!\param tlyr (IX,NLAY), model layer mean temperature in K !!\param tvly (IX,NLAY), model layer virtual temperature in K -!!\param qlyr (IX,NLAY), layer specific humidity in gm/gm -!!\param clw (IX,NLAY), layer cloud liquid water amount -!!\param ciw (IX,NLAY), layer cloud ice water amount +!!\param ccnd (IX,NLAY), layer cloud condensate amount +!!\param ncnd number of layer cloud condensate types !!\param xlat (IX), grid latitude in radians, default to pi/2 -> !! -pi/2 range, otherwise see in-line comment !!\param xlon (IX), grid longitude in radians (not used) @@ -2741,26 +2753,27 @@ subroutine progclduni & ! ==================== 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 ! -! ccnd (IX,NLAY) : layer cloud condensate amount ! -! ncnd : number of layer cloud condensate types ! -! 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) ! -! IX : horizontal dimention ! -! NLAY,NLP1 : vertical layer/level dimensions ! -! cldtot : unified cloud fracrion from moist physics ! -! effrl (ix,nlay) : effective radius for liquid water ! -! effri (ix,nlay) : effective radius for ice water ! -! effrr (ix,nlay) : effective radius for rain water ! -! effrs (ix,nlay) : effective radius for snow water ! -! effr_in : logical - if .true. use input effective radii ! -! dz (ix,nlay) : layer thickness (km) ! -! delp (ix,nlay) : model layer pressure thickness in mb (100Pa) ! +! 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 ! +! ccnd (IX,NLAY,ncnd) : layer cloud condensate amount ! +! water, ice, rain, snow (+ graupel) ! +! ncnd : number of layer cloud condensate types (max of 4) ! +! 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) ! +! IX : horizontal dimention ! +! NLAY,NLP1 : vertical layer/level dimensions ! +! cldtot : unified cloud fracrion from moist physics ! +! effrl (ix,nlay) : effective radius for liquid water ! +! effri (ix,nlay) : effective radius for ice water ! +! effrr (ix,nlay) : effective radius for rain water ! +! effrs (ix,nlay) : effective radius for snow water ! +! effr_in : logical - if .true. use input effective radii ! +! dz (ix,nlay) : layer thickness (km) ! +! delp (ix,nlay) : model layer pressure thickness in mb (100Pa) ! ! ! ! output variables: ! ! clouds(IX,NLAY,NF_CLDS) : cloud profiles ! @@ -2818,7 +2831,7 @@ subroutine progclduni & ! --- local variables: real (kind=kind_phys), dimension(IX,NLAY) :: cldcnv, cwp, cip, & - & crp, csp, rew, rei, res, rer, tem2d + & crp, csp, rew, rei, res, rer real (kind=kind_phys), dimension(IX,NLAY,ncnd) :: cndf real (kind=kind_phys) :: ptop1(IX,NK_CLDS+1), rxlat(ix) @@ -2830,47 +2843,23 @@ subroutine progclduni & ! !===> ... begin here ! - do nf=1,nf_clds - do k=1,nlay - do i=1,ix - clouds(i,k,nf) = 0.0 - enddo +! 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 + 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 enddo enddo -! clouds(:,:,:) = 0.0 - - if (effr_in) then - do k = 1, NLAY - do i = 1, IX - 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) = effrl (i,k) - rei (i,k) = max(10.0, min(150.0,effri (i,k))) - rer (i,k) = effrr (i,k) - res (i,k) = effrs (i,k) - tem2d (i,k) = min( 1.0, max( 0.0,(con_ttp-tlyr(i,k))*0.05)) - enddo - enddo - else - do k = 1, NLAY - do i = 1, IX - 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) = reliq_def ! default liq radius to 10 micron - rei (i,k) = reice_def ! default ice radius to 50 micron - rer (i,k) = rrain_def ! default rain radius to 1000 micron - res (i,k) = rsnow_def ! default snow radius to 250 micron - tem2d (i,k) = min(1.0, max(0.0, (con_ttp-tlyr(i,k))*0.05)) - enddo - enddo - endif -! do n=1,ncnd do k = 1, NLAY do i = 1, IX @@ -2878,7 +2867,7 @@ subroutine progclduni & enddo enddo enddo - if ( lcrick ) then + if ( lcrick ) then ! vertical smoorthing do n=1,ncnd do i = 1, IX cndf(i,1,n) = 0.75*ccnd(i,1,n) + 0.25*ccnd(i,2,n) @@ -2893,54 +2882,25 @@ subroutine progclduni & enddo endif -!> - 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$ . - if (ncnd == 2) then - do k = 1, NLAY - do i = 1, IX - tem1 = gfac * delp(i,k) - cwp(i,k) = cndf(i,k,1) * tem1 - cip(i,k) = cndf(i,k,2) * tem1 - enddo + if (ncnd == 2) then + do k = 1, NLAY + do i = 1, IX + tem1 = gfac * delp(i,k) + cwp(i,k) = cndf(i,k,1) * tem1 + cip(i,k) = cndf(i,k,2) * tem1 enddo - elseif (ncnd == 4 .or. ncnd == 5) then - do k = 1, NLAY - do i = 1, IX - tem1 = gfac * delp(i,k) - cwp(i,k) = cndf(i,k,1) * tem1 - cip(i,k) = cndf(i,k,2) * tem1 - crp(i,k) = cndf(i,k,3) * tem1 - csp(i,k) = cndf(i,k,4) * tem1 - enddo + enddo + elseif (ncnd == 4) then + do k = 1, NLAY + do i = 1, IX + tem1 = gfac * delp(i,k) + cwp(i,k) = cndf(i,k,1) * tem1 + cip(i,k) = cndf(i,k,2) * tem1 + crp(i,k) = cndf(i,k,3) * tem1 + csp(i,k) = cndf(i,k,4) * tem1 enddo - endif - -!> -# Compute effective liquid cloud droplet radius over land. - - if(.not. effr_in) then - do i = 1, IX - if (nint(slmsk(i)) == 1) then - do k = 1, NLAY - rew(i,k) = 5.0 + 5.0 * tem2d(i,k) - enddo - endif enddo endif @@ -2969,10 +2929,39 @@ subroutine progclduni & enddo endif -!> - Compute effective ice cloud droplet radius following -!! Heymsfield and McFarquhar (1996) \cite heymsfield_and_mcfarquhar_1996. +! assign/calculate efective radii for cloud water, ice, rain, snow + + if (effr_in) then + do k = 1, NLAY + do i = 1, IX + rew(i,k) = effrl (i,k) + rei(i,k) = max(10.0, min(150.0,effri (i,k))) + rer(i,k) = effrr (i,k) + res(i,k) = effrs (i,k) + enddo + enddo + else + do k = 1, NLAY + do i = 1, IX + rew(i,k) = reliq_def ! default liq radius to 10 micron + rei(i,k) = reice_def ! default ice radius to 50 micron + rer(i,k) = rrain_def ! default rain radius to 1000 micron + res(i,k) = rsnow_def ! default snow radius to 250 micron + enddo + enddo +!> -# Compute effective liquid cloud droplet radius over land. + do i = 1, IX + if (nint(slmsk(i)) == 1) then + do k = 1, NLAY + tem1 = min(1.0, max(0.0, (con_ttp-tlyr(i,k))*0.05)) + rew(i,k) = 5.0 + 5.0 * tem1 + enddo + endif + enddo + +!> -# Compute effective ice cloud droplet radius following Heymsfield +!! and McFarquhar (1996) \cite heymsfield_and_mcfarquhar_1996. - if(.not. effr_in) then do k = 1, NLAY do i = 1, IX tem2 = tlyr(i,k) - con_ttp @@ -2997,7 +2986,6 @@ subroutine progclduni & enddo enddo endif - ! do k = 1, NLAY do i = 1, IX @@ -3013,8 +3001,24 @@ subroutine progclduni & enddo enddo -! --- ... estimate clouds decorrelation length in km -! this is only a tentative test, need to consider change later +!> -# 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 + +!> -# Estimate clouds decorrelation length in km +! this is only a tentative test, need to consider change later if ( iovr == 3 ) then do i = 1, ix diff --git a/physics/radlw_main.f b/physics/radlw_main.f index 23ed429e6..7b029f8b0 100644 --- a/physics/radlw_main.f +++ b/physics/radlw_main.f @@ -356,7 +356,7 @@ module rrtmg_lw subroutine rrtmg_lw_init () end subroutine rrtmg_lw_init -!> \defgroup module_radlw_main GFS radlw Main +!> \defgroup module_radlw_main GFS RRTMG Longwave Module !! \brief This module includes NCEP's modifications of the RRTMG-LW radiation !! code from AER. !! @@ -380,55 +380,7 @@ end subroutine rrtmg_lw_init !! This model is provided as is without any express or implied warranties. !! (http://www.rtweb.aer.com/) !! \section arg_table_rrtmg_lw_run Argument Table -!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | -!! |-----------------|-----------------------------------------------------------------------------------------------|-----------------------------------------------------------|---------|------|-------------|-----------|--------|----------| -!! | plyr | air_pressure_at_layer_for_radiation_in_hPa | air pressure layer | hPa | 2 | real | kind_phys | in | F | -!! | plvl | air_pressure_at_interface_for_radiation_in_hPa | air pressure level | hPa | 2 | real | kind_phys | in | F | -!! | tlyr | air_temperature_at_layer_for_radiation | air temperature layer | K | 2 | real | kind_phys | in | F | -!! | tlvl | air_temperature_at_interface_for_radiation | air temperature level | K | 2 | real | kind_phys | in | F | -!! | qlyr | water_vapor_specific_humidity_at_layer_for_radiation | specific humidity layer | kg kg-1 | 2 | real | kind_phys | in | F | -!! | olyr | ozone_concentration_at_layer_for_radiation | ozone concentration layer | kg kg-1 | 2 | real | kind_phys | in | F | -!! | gasvmr_co2 | volume_mixing_ratio_co2 | volume mixing ratio co2 | kg kg-1 | 2 | real | kind_phys | in | F | -!! | gasvmr_n2o | volume_mixing_ratio_n2o | volume mixing ratio no2 | kg kg-1 | 2 | real | kind_phys | in | F | -!! | gasvmr_ch4 | volume_mixing_ratio_ch4 | volume mixing ratio ch4 | kg kg-1 | 2 | real | kind_phys | in | F | -!! | gasvmr_o2 | volume_mixing_ratio_o2 | volume mixing ratio o2 | kg kg-1 | 2 | real | kind_phys | in | F | -!! | gasvmr_co | volume_mixing_ratio_co | volume mixing ratio co | kg kg-1 | 2 | real | kind_phys | in | F | -!! | gasvmr_cfc11 | volume_mixing_ratio_cfc11 | volume mixing ratio cfc11 | kg kg-1 | 2 | real | kind_phys | in | F | -!! | gasvmr_cfc12 | volume_mixing_ratio_cfc12 | volume mixing ratio cfc12 | kg kg-1 | 2 | real | kind_phys | in | F | -!! | gasvmr_cfc22 | volume_mixing_ratio_cfc22 | volume mixing ratio cfc22 | kg kg-1 | 2 | real | kind_phys | in | F | -!! | gasvmr_ccl4 | volume_mixing_ratio_ccl4 | volume mixing ratio ccl4 | kg kg-1 | 2 | real | kind_phys | in | F | -!! | icseed | seed_random_numbers_lw | seed for random number generation for longwave radiation | none | 1 | integer | | in | F | -!! | aeraod | aerosol_optical_depth_for_longwave_bands_01-16 | aerosol optical depth for longwave bands 01-16 | none | 3 | real | kind_phys | in | F | -!! | aerssa | aerosol_single_scattering_albedo_for_longwave_bands_01-16 | aerosol single scattering albedo for longwave bands 01-16 | frac | 3 | real | kind_phys | in | F | -!! | sfemis | surface_longwave_emissivity | surface emissivity | frac | 1 | real | kind_phys | in | F | -!! | sfgtmp | surface_ground_temperature_for_radiation | surface ground temperature for radiation | K | 1 | real | kind_phys | in | F | -!! | dzlyr | layer_thickness_for_radiation | layer thickness | km | 2 | real | kind_phys | in | F | -!! | delpin | layer_pressure_thickness_for_radiation | layer pressure thickness | hPa | 2 | real | kind_phys | in | F | -!! | de_lgth | cloud_decorrelation_length | cloud decorrelation length | km | 1 | real | kind_phys | in | F | -!! | npts | horizontal_loop_extent | horizontal dimension | count | 0 | integer | | in | F | -!! | nlay | adjusted_vertical_layer_dimension_for_radiation | number of vertical layers for radiation | count | 0 | integer | | in | F | -!! | nlp1 | adjusted_vertical_level_dimension_for_radiation | number of vertical levels for radiation | count | 0 | integer | | in | F | -!! | lprnt | flag_print | flag to print | flag | 0 | logical | | in | F | -!! | cld_cf | total_cloud_fraction | total cloud fraction | frac | 2 | real | kind_phys | in | F | -!! | lslwr | flag_to_calc_lw | flag to calculate LW irradiances | flag | 0 | logical | | in | F | -!! | hlwc | tendency_of_air_temperature_due_to_longwave_heating_on_radiation_time_step | longwave total sky heating rate | K s-1 | 2 | real | kind_phys | inout | F | -!! | topflx | lw_fluxes_top_atmosphere | longwave total sky fluxes at the top of the atm | W m-2 | 1 | topflw_type | | inout | F | -!! | sfcflx | lw_fluxes_sfc | longwave total sky fluxes at the Earth surface | W m-2 | 1 | sfcflw_type | | inout | F | -!! | cldtau | cloud_optical_depth_layers_at_10mu_band | approx 10mu band layer cloud optical depth | none | 2 | real | kind_phys | inout | F | -!! | hlw0 | tendency_of_air_temperature_due_to_longwave_heating_assuming_clear_sky_on_radiation_time_step | longwave clear sky heating rate | K s-1 | 2 | real | kind_phys | inout | T | -!! | hlwb | lw_heating_rate_spectral | longwave total sky heating rate (spectral) | K s-1 | 3 | real | kind_phys | inout | T | -!! | flxprf | lw_fluxes | lw fluxes total sky / csk and up / down at levels | W m-2 | 2 | proflw_type | | inout | T | -!! | cld_lwp | cloud_liquid_water_path | cloud liquid water path | g m-2 | 2 | real | kind_phys | in | T | -!! | cld_ref_liq | mean_effective_radius_for_liquid_cloud | mean effective radius for liquid cloud | micron | 2 | real | kind_phys | in | T | -!! | cld_iwp | cloud_ice_water_path | cloud ice water path | g m-2 | 2 | real | kind_phys | in | T | -!! | cld_ref_ice | mean_effective_radius_for_ice_cloud | mean effective radius for ice cloud | micron | 2 | real | kind_phys | in | T | -!! | cld_rwp | cloud_rain_water_path | cloud ice water path | g m-2 | 2 | real | kind_phys | in | T | -!! | cld_ref_rain | mean_effective_radius_for_rain_drop | mean effective radius for rain drop | micron | 2 | real | kind_phys | in | T | -!! | cld_swp | cloud_snow_water_path | cloud snow water path | g m-2 | 2 | real | kind_phys | in | T | -!! | cld_ref_snow | mean_effective_radius_for_snow_flake | mean effective radius for snow flake | micron | 2 | real | kind_phys | in | T | -!! | cld_od | cloud_optical_depth | cloud optical depth | none | 2 | real | kind_phys | in | T | -!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | -!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | +!! \htmlinclude rrtmg_lw_run.html !! !> \section gen_lwrad RRTMG Longwave Radiation Scheme General Algorithm !> @{ @@ -1848,6 +1800,8 @@ end subroutine cldprop !!\param cldf layer cloud fraction !!\param nlay number of model vertical layers !!\param ipseed permute seed for random num generator +!!\param dz layer thickness +!!\param de_lgth layer cloud decorrelation length (km) !!\param lcloudy sub-colum cloud profile flag array !!\section mcica_subcol_gen mcica_subcol General Algorithm !! @{ @@ -2086,7 +2040,7 @@ end subroutine mcica_subcol !! 4-h2o/ch4,5-n2o/co2,6-o3/co2 !!\n (:,:,n)n=1,2: the rates of ref press at !! the 2 sides of the layer -!!\param facij factors multiply the reference ks, i,j=0/1 for +!!\param fac00,fac01,fac10,fac11 factors multiply the reference ks, i,j=0/1 for !! lower/higher of the 2 appropriate temperatures !! and altitudes. !!\param selffac scale factor for w. v. self-continuum equals @@ -2102,8 +2056,7 @@ end subroutine mcica_subcol !!\param scaleminor,scaleminorn2 scale factors for minor gases !!\param indminor index of lower ref temp for minor gases !>\section setcoef_gen setcoef General Algorithm -!! -! ---------------------------------- +!> @{ subroutine setcoef & & ( pavel,tavel,tz,stemp,h2ovmr,colamt,coldry,colbrd, & ! --- inputs: & nlay, nlp1, & @@ -2360,6 +2313,7 @@ subroutine setcoef & return ! .................................. end subroutine setcoef +!> @} ! ---------------------------------- !>\ingroup module_radlw_main @@ -3768,7 +3722,7 @@ end subroutine rtrnmc !! 5-n2o/co2,6-o3/co2 !!\n (:,:,n)n=1,2: the rates of ref press at the 2 !! sides of the layer -!!\param facij factors multiply the reference ks, i,j of 0/1 +!!\param fac00,fac01,fac10,fac11 factors multiply the reference ks, i,j of 0/1 !! for lower/higher of the 2 appropriate !! temperatures and altitudes !!\param jp index of lower reference pressure diff --git a/physics/radlw_main.meta b/physics/radlw_main.meta new file mode 100644 index 000000000..73977e5cb --- /dev/null +++ b/physics/radlw_main.meta @@ -0,0 +1,390 @@ +[ccpp-arg-table] + name = rrtmg_lw_run + type = scheme +[plyr] + standard_name = air_pressure_at_layer_for_radiation_in_hPa + long_name = air pressure layer + units = hPa + dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + type = real + kind = kind_phys + intent = in + optional = F +[plvl] + standard_name = air_pressure_at_interface_for_radiation_in_hPa + long_name = air pressure level + units = hPa + dimensions = (horizontal_dimension,adjusted_vertical_level_dimension_for_radiation) + type = real + kind = kind_phys + intent = in + optional = F +[tlyr] + standard_name = air_temperature_at_layer_for_radiation + long_name = air temperature layer + units = K + dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + type = real + kind = kind_phys + intent = in + optional = F +[tlvl] + standard_name = air_temperature_at_interface_for_radiation + long_name = air temperature level + units = K + dimensions = (horizontal_dimension,adjusted_vertical_level_dimension_for_radiation) + type = real + kind = kind_phys + intent = in + optional = F +[qlyr] + standard_name = water_vapor_specific_humidity_at_layer_for_radiation + long_name = specific humidity layer + units = kg kg-1 + dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + type = real + kind = kind_phys + intent = in + optional = F +[olyr] + standard_name = ozone_concentration_at_layer_for_radiation + long_name = ozone concentration layer + units = kg kg-1 + dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + type = real + kind = kind_phys + intent = in + optional = F +[gasvmr_co2] + standard_name = volume_mixing_ratio_co2 + long_name = volume mixing ratio co2 + units = kg kg-1 + dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + type = real + kind = kind_phys + intent = in + optional = F +[gasvmr_n2o] + standard_name = volume_mixing_ratio_n2o + long_name = volume mixing ratio no2 + units = kg kg-1 + dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + type = real + kind = kind_phys + intent = in + optional = F +[gasvmr_ch4] + standard_name = volume_mixing_ratio_ch4 + long_name = volume mixing ratio ch4 + units = kg kg-1 + dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + type = real + kind = kind_phys + intent = in + optional = F +[gasvmr_o2] + standard_name = volume_mixing_ratio_o2 + long_name = volume mixing ratio o2 + units = kg kg-1 + dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + type = real + kind = kind_phys + intent = in + optional = F +[gasvmr_co] + standard_name = volume_mixing_ratio_co + long_name = volume mixing ratio co + units = kg kg-1 + dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + type = real + kind = kind_phys + intent = in + optional = F +[gasvmr_cfc11] + standard_name = volume_mixing_ratio_cfc11 + long_name = volume mixing ratio cfc11 + units = kg kg-1 + dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + type = real + kind = kind_phys + intent = in + optional = F +[gasvmr_cfc12] + standard_name = volume_mixing_ratio_cfc12 + long_name = volume mixing ratio cfc12 + units = kg kg-1 + dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + type = real + kind = kind_phys + intent = in + optional = F +[gasvmr_cfc22] + standard_name = volume_mixing_ratio_cfc22 + long_name = volume mixing ratio cfc22 + units = kg kg-1 + dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + type = real + kind = kind_phys + intent = in + optional = F +[gasvmr_ccl4] + standard_name = volume_mixing_ratio_ccl4 + long_name = volume mixing ratio ccl4 + units = kg kg-1 + dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + type = real + kind = kind_phys + intent = in + optional = F +[icseed] + standard_name = seed_random_numbers_lw + long_name = seed for random number generation for longwave radiation + units = none + dimensions = (horizontal_dimension) + type = integer + intent = in + optional = F +[aeraod] + standard_name = aerosol_optical_depth_for_longwave_bands_01_16 + long_name = aerosol optical depth for longwave bands 01-16 + units = none + dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation,number_of_aerosol_bands_for_longwave_radiation) + type = real + kind = kind_phys + intent = in + optional = F +[aerssa] + standard_name = aerosol_single_scattering_albedo_for_longwave_bands_01_16 + long_name = aerosol single scattering albedo for longwave bands 01-16 + units = frac + dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation,number_of_aerosol_bands_for_longwave_radiation) + type = real + kind = kind_phys + intent = in + optional = F +[sfemis] + standard_name = surface_longwave_emissivity + long_name = surface emissivity + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[sfgtmp] + standard_name = surface_ground_temperature_for_radiation + long_name = surface ground temperature for radiation + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[dzlyr] + standard_name = layer_thickness_for_radiation + long_name = layer thickness + units = km + dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + type = real + kind = kind_phys + intent = in + optional = F +[delpin] + standard_name = layer_pressure_thickness_for_radiation + long_name = layer pressure thickness + units = hPa + dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + type = real + kind = kind_phys + intent = in + optional = F +[de_lgth] + standard_name = cloud_decorrelation_length + long_name = cloud decorrelation length + units = km + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[npts] + standard_name = horizontal_loop_extent + long_name = horizontal dimension + units = count + dimensions = () + type = integer + intent = in + optional = F +[nlay] + standard_name = adjusted_vertical_layer_dimension_for_radiation + long_name = number of vertical layers for radiation + units = count + dimensions = () + type = integer + intent = in + optional = F +[nlp1] + standard_name = adjusted_vertical_level_dimension_for_radiation + long_name = number of vertical levels for radiation + units = count + dimensions = () + type = integer + intent = in + optional = F +[lprnt] + standard_name = flag_print + long_name = flag to print + units = flag + dimensions = () + type = logical + intent = in + optional = F +[cld_cf] + standard_name = total_cloud_fraction + long_name = total cloud fraction + units = frac + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[lslwr] + standard_name = flag_to_calc_lw + long_name = flag to calculate LW irradiances + units = flag + dimensions = () + type = logical + intent = in + optional = F +[hlwc] + standard_name = tendency_of_air_temperature_due_to_longwave_heating_on_radiation_time_step + long_name = longwave total sky heating rate + units = K s-1 + dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + type = real + kind = kind_phys + intent = inout + optional = F +[topflx] + standard_name = lw_fluxes_top_atmosphere + long_name = longwave total sky fluxes at the top of the atm + units = W m-2 + dimensions = (horizontal_dimension) + type = topflw_type + intent = inout + optional = F +[sfcflx] + standard_name = lw_fluxes_sfc + long_name = longwave total sky fluxes at the Earth surface + units = W m-2 + dimensions = (horizontal_dimension) + type = sfcflw_type + intent = inout + optional = F +[cldtau] + standard_name = cloud_optical_depth_layers_at_10mu_band + long_name = approx 10mu band layer cloud optical depth + units = none + dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + type = real + kind = kind_phys + intent = inout + optional = F +[hlw0] + standard_name = tendency_of_air_temperature_due_to_longwave_heating_assuming_clear_sky_on_radiation_time_step + long_name = longwave clear sky heating rate + units = K s-1 + dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + type = real + kind = kind_phys + intent = inout + optional = T +[cld_lwp] + standard_name = cloud_liquid_water_path + long_name = cloud liquid water path + units = g m-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = T +[cld_ref_liq] + standard_name = mean_effective_radius_for_liquid_cloud + long_name = mean effective radius for liquid cloud + units = micron + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = T +[cld_iwp] + standard_name = cloud_ice_water_path + long_name = cloud ice water path + units = g m-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = T +[cld_ref_ice] + standard_name = mean_effective_radius_for_ice_cloud + long_name = mean effective radius for ice cloud + units = micron + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = T +[cld_rwp] + standard_name = cloud_rain_water_path + long_name = cloud ice water path + units = g m-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = T +[cld_ref_rain] + standard_name = mean_effective_radius_for_rain_drop + long_name = mean effective radius for rain drop + units = micron + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = T +[cld_swp] + standard_name = cloud_snow_water_path + long_name = cloud snow water path + units = g m-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = T +[cld_ref_snow] + standard_name = mean_effective_radius_for_snow_flake + long_name = mean effective radius for snow flake + units = micron + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = T +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F diff --git a/physics/radlw_param.f b/physics/radlw_param.f index 47ed660d8..6c107a3d8 100644 --- a/physics/radlw_param.f +++ b/physics/radlw_param.f @@ -61,33 +61,45 @@ module module_radlw_parameters ! !........................................! +!! \section arg_table_module_radlw_parameters +!! \htmlinclude module_radlw_parameters.html +!! + use physparam, only : kind_phys implicit none ! public ! - type :: topflw_type !< define type construct for radiation fluxes at toa +!> derived type for LW fluxes at top of atmosphere +!! \section arg_table_topflw_type +!! \htmlinclude topflw_type.html +!! + type topflw_type !< define type construct for radiation fluxes at toa real (kind=kind_phys) :: upfxc !< total sky upward flux at toa real (kind=kind_phys) :: upfx0 !< clear sky upward flux at toa - end type + end type topflw_type ! - type :: sfcflw_type !< define type construct for radiation fluxes at surface +!> derived type for LW fluxes at surface +!! \section arg_table_sfcflw_type +!! \htmlinclude sfcflw_type.html +!! + type sfcflw_type !< define type construct for radiation fluxes at surface real (kind=kind_phys) :: upfxc !< total sky upward flux at sfc real (kind=kind_phys) :: upfx0 !< clear sky upward flux at sfc real (kind=kind_phys) :: dnfxc !< total sky downward flux at sfc real (kind=kind_phys) :: dnfx0 !< clear sky downward flux at sfc - end type + end type sfcflw_type ! - type :: proflw_type !< define type construct for optional radiation flux profiles + type proflw_type !< define type construct for optional radiation flux profiles real (kind=kind_phys) :: upfxc !< level up flux for total sky real (kind=kind_phys) :: dnfxc !< level down flux for total sky real (kind=kind_phys) :: upfx0 !< level up for clear sky real (kind=kind_phys) :: dnfx0 !< level down flux for clear sky - end type + end type proflw_type ! ! Parameter constants for LW band structures - integer, parameter :: NBANDS = 16 !< number of total spectral bands + integer, parameter :: NBANDS = 16 !< number of total spectral bands integer, parameter :: NGPTLW = 140 !< number of total g-points integer, parameter :: NTBL = 10000 !< lookup table dimension integer, parameter :: MAXGAS = 7 !< maximum number of absorbing gases diff --git a/physics/radlw_param.meta b/physics/radlw_param.meta new file mode 100644 index 000000000..a06a89512 --- /dev/null +++ b/physics/radlw_param.meta @@ -0,0 +1,25 @@ +[ccpp-arg-table] + name = topflw_type + type = ddt + +######################################################################## +[ccpp-arg-table] + name = sfcflw_type + type = ddt + +######################################################################## +[ccpp-arg-table] + name = module_radlw_parameters + type = module +[topflw_type] + standard_name = topflw_type + long_name = definition of type topflw_type + units = DDT + dimensions = () + type = topflw_type +[sfcflw_type] + standard_name = sfcflw_type + long_name = definition of type sfcflw_type + units = DDT + dimensions = () + type = sfcflw_type diff --git a/physics/radsw_main.f b/physics/radsw_main.f index 06c60bac8..b10541fb7 100644 --- a/physics/radsw_main.f +++ b/physics/radsw_main.f @@ -376,7 +376,7 @@ module rrtmg_sw subroutine rrtmg_sw_init () end subroutine rrtmg_sw_init -!> \defgroup module_radsw_main GFS radsw Main +!> \defgroup module_radsw_main GFS RRTMG Shortwave Module !! This module includes NCEP's modifications of the RRTMG-SW radiation !! code from AER. !! @@ -455,65 +455,7 @@ end subroutine rrtmg_sw_init !! (http://www.rtweb.aer.com/) !! !> \section arg_table_rrtmg_sw_run Argument Table -!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | -!! |-----------------|------------------------------------------------------------------------------------------------|--------------------------------------------------------------------------|---------|------|-------------|-----------|--------|----------| -!! | plyr | air_pressure_at_layer_for_radiation_in_hPa | air pressure layer | hPa | 2 | real | kind_phys | in | F | -!! | plvl | air_pressure_at_interface_for_radiation_in_hPa | air pressure level | hPa | 2 | real | kind_phys | in | F | -!! | tlyr | air_temperature_at_layer_for_radiation | air temperature layer | K | 2 | real | kind_phys | in | F | -!! | tlvl | air_temperature_at_interface_for_radiation | air temperature level | K | 2 | real | kind_phys | in | F | -!! | qlyr | water_vapor_specific_humidity_at_layer_for_radiation | specific humidity layer | kg kg-1 | 2 | real | kind_phys | in | F | -!! | olyr | ozone_concentration_at_layer_for_radiation | ozone concentration layer | kg kg-1 | 2 | real | kind_phys | in | F | -!! | gasvmr_co2 | volume_mixing_ratio_co2 | volume mixing ratio co2 | kg kg-1 | 2 | real | kind_phys | in | F | -!! | gasvmr_n2o | volume_mixing_ratio_n2o | volume mixing ratio no2 | kg kg-1 | 2 | real | kind_phys | in | F | -!! | gasvmr_ch4 | volume_mixing_ratio_ch4 | volume mixing ratio ch4 | kg kg-1 | 2 | real | kind_phys | in | F | -!! | gasvmr_o2 | volume_mixing_ratio_o2 | volume mixing ratio o2 | kg kg-1 | 2 | real | kind_phys | in | F | -!! | gasvmr_co | volume_mixing_ratio_co | volume mixing ratio co | kg kg-1 | 2 | real | kind_phys | in | F | -!! | gasvmr_cfc11 | volume_mixing_ratio_cfc11 | volume mixing ratio cfc11 | kg kg-1 | 2 | real | kind_phys | in | F | -!! | gasvmr_cfc12 | volume_mixing_ratio_cfc12 | volume mixing ratio cfc12 | kg kg-1 | 2 | real | kind_phys | in | F | -!! | gasvmr_cfc22 | volume_mixing_ratio_cfc22 | volume mixing ratio cfc22 | kg kg-1 | 2 | real | kind_phys | in | F | -!! | gasvmr_ccl4 | volume_mixing_ratio_ccl4 | volume mixing ratio ccl4 | kg kg-1 | 2 | real | kind_phys | in | F | -!! | icseed | seed_random_numbers_sw | seed for random number generation for shortwave radiation | none | 1 | integer | | in | F | -!! | aeraod | aerosol_optical_depth_for_shortwave_bands_01-16 | aerosol optical depth for shortwave bands 01-16 | none | 3 | real | kind_phys | in | F | -!! | aerssa | aerosol_single_scattering_albedo_for_shortwave_bands_01-16 | aerosol single scattering albedo for shortwave bands 01-16 | frac | 3 | real | kind_phys | in | F | -!! | aerasy | aerosol_asymmetry_parameter_for_shortwave_bands_01-16 | aerosol asymmetry paramter for shortwave bands 01-16 | none | 3 | real | kind_phys | in | F | -!! | sfcalb_nir_dir | surface_albedo_due_to_near_IR_direct | surface albedo due to near IR direct beam | frac | 1 | real | kind_phys | in | F | -!! | sfcalb_nir_dif | surface_albedo_due_to_near_IR_diffused | surface albedo due to near IR diffused beam | frac | 1 | real | kind_phys | in | F | -!! | sfcalb_uvis_dir | surface_albedo_due_to_UV_and_VIS_direct | surface albedo due to UV+VIS direct beam | frac | 1 | real | kind_phys | in | F | -!! | sfcalb_uvis_dif | surface_albedo_due_to_UV_and_VIS_diffused | surface albedo due to UV+VIS diffused beam | frac | 1 | real | kind_phys | in | F | -!! | dzlyr | layer_thickness_for_radiation | layer thickness | km | 2 | real | kind_phys | in | F | -!! | delpin | layer_pressure_thickness_for_radiation | layer pressure thickness | hPa | 2 | real | kind_phys | in | F | -!! | de_lgth | cloud_decorrelation_length | cloud decorrelation length | km | 1 | real | kind_phys | in | F | -!! | cosz | cosine_of_zenith_angle | cosine of the solar zenit angle | none | 1 | real | kind_phys | in | F | -!! | solcon | solar_constant | solar constant | W m-2 | 0 | real | kind_phys | in | F | -!! | nday | daytime_points_dimension | daytime points dimension | count | 0 | integer | | in | F | -!! | idxday | daytime_points | daytime points | index | 1 | integer | | in | F | -!! | npts | horizontal_loop_extent | horizontal dimension | count | 0 | integer | | in | F | -!! | nlay | adjusted_vertical_layer_dimension_for_radiation | number of vertical layers for radiation | count | 0 | integer | | in | F | -!! | nlp1 | adjusted_vertical_level_dimension_for_radiation | number of vertical levels for radiation | count | 0 | integer | | in | F | -!! | lprnt | flag_print | flag to print | flag | 0 | logical | | in | F | -!! | cld_cf | total_cloud_fraction | total cloud fraction | frac | 2 | real | kind_phys | in | F | -!! | lsswr | flag_to_calc_sw | flag to calculate SW irradiances | flag | 0 | logical | | in | F | -!! | hswc | tendency_of_air_temperature_due_to_shortwave_heating_on_radiation_time_step | shortwave total sky heating rate | K s-1 | 2 | real | kind_phys | inout | F | -!! | topflx | sw_fluxes_top_atmosphere | shortwave total sky fluxes at the top of the atm | W m-2 | 1 | topfsw_type | | inout | F | -!! | sfcflx | sw_fluxes_sfc | shortwave total sky fluxes at the Earth surface | W m-2 | 1 | sfcfsw_type | | inout | F | -!! | cldtau | cloud_optical_depth_layers_at_0.55mu_band | approx .55mu band layer cloud optical depth | none | 2 | real | kind_phys | inout | F | -!! | hsw0 | tendency_of_air_temperature_due_to_shortwave_heating_assuming_clear_sky_on_radiation_time_step | shortwave clear sky heating rate | K s-1 | 2 | real | kind_phys | inout | T | -!! | hswb | sw_heating_rate_spectral | shortwave total sky heating rate (spectral) | K s-1 | 3 | real | kind_phys | inout | T | -!! | flxprf | sw_fluxes | sw fluxes total sky / csk and up / down at levels | W m-2 | 2 | profsw_type | | inout | T | -!! | fdncmp | components_of_surface_downward_shortwave_fluxes | derived type for special components of surface downward shortwave fluxes | W m-2 | 1 | cmpfsw_type | | inout | T | -!! | cld_lwp | cloud_liquid_water_path | cloud liquid water path | g m-2 | 2 | real | kind_phys | in | T | -!! | cld_ref_liq | mean_effective_radius_for_liquid_cloud | mean effective radius for liquid cloud | micron | 2 | real | kind_phys | in | T | -!! | cld_iwp | cloud_ice_water_path | cloud ice water path | g m-2 | 2 | real | kind_phys | in | T | -!! | cld_ref_ice | mean_effective_radius_for_ice_cloud | mean effective radius for ice cloud | micron | 2 | real | kind_phys | in | T | -!! | cld_rwp | cloud_rain_water_path | cloud rain water path | g m-2 | 2 | real | kind_phys | in | T | -!! | cld_ref_rain | mean_effective_radius_for_rain_drop | mean effective radius for rain drop | micron | 2 | real | kind_phys | in | T | -!! | cld_swp | cloud_snow_water_path | cloud snow water path | g m-2 | 2 | real | kind_phys | in | T | -!! | cld_ref_snow | mean_effective_radius_for_snow_flake | mean effective radius for snow flake | micron | 2 | real | kind_phys | in | T | -!! | cld_od | cloud_optical_depth | cloud optical depth | none | 2 | real | kind_phys | in | T | -!! | cld_ssa | cloud_single_scattering_albedo | cloud single scattering albedo | frac | 2 | real | kind_phys | in | T | -!! | cld_asy | cloud_asymmetry_parameter | cloud asymmetry parameter | none | 2 | real | kind_phys | in | T | -!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | -!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | +!! \htmlinclude rrtmg_sw_run.html !! !> \section gen_swrad RRTMG Shortwave Radiation Scheme General Algorithm !> @{ @@ -1586,6 +1528,8 @@ end subroutine rswinit !!\param nlay vertical layer number !!\param ipseed permutation seed for generating random numbers !! (isubcsw>0) +!!\param dz layer thickness (km) +!!\param delgth layer cloud decorrelation length (km) !!\param taucw cloud optical depth, w/o delta scaled !!\param ssacw weighted cloud single scattering albedo !! (ssa = ssacw / taucw) @@ -1974,9 +1918,11 @@ end subroutine cldprop !!\param cldf layer cloud fraction !!\param nlay number of model vertical layers !!\param ipseed permute seed for random num generator +!!\param dz layer thickness (km) +!!\param de_lgth layer cloud decorrelation length (km) !!\param lcloudy sub-colum cloud profile flag array !!\section mcica_sw_gen mcica_subcol General Algorithm -!! @{ +!> @{ ! ---------------------------------- subroutine mcica_subcol & & ( cldf, nlay, ipseed, dz, de_lgth, & ! --- inputs @@ -2184,7 +2130,7 @@ subroutine mcica_subcol & return ! .................................. end subroutine mcica_subcol -!! @} +!> @} ! ---------------------------------- !>\ingroup module_radsw_main @@ -2199,7 +2145,7 @@ end subroutine mcica_subcol !!\param jp indices of lower reference pressure !!\param jt,jt1 indices of lower reference temperatures at !! levels of jp and jp+1 -!!\param facij factors mltiply the reference ks,i,j=0/1 for +!!\param fac00,fac01,fac10,fac11 factors mltiply the reference ks,i,j=0/1 for !! lower/higher of the 2 appropriate temperature !! and altitudes. !!\param selffac scale factor for w. v. self-continuum equals @@ -4004,7 +3950,7 @@ end subroutine vrtqdr !! are for h2o, co2, o3, n2o, ch4, and o2, !! respectively \f$(mol/cm^2)\f$ !!\param colmol total column amount (dry air+water vapor) -!!\param facij for each layer, these are factors that are +!!\param fac00,fac01,fac10,fac11 for each layer, these are factors that are !! needed to compute the interpolation factors !! that multiply the appropriate reference !! k-values. a value of 0/1 for i,j indicates diff --git a/physics/radsw_main.meta b/physics/radsw_main.meta new file mode 100644 index 000000000..c5cbe768a --- /dev/null +++ b/physics/radsw_main.meta @@ -0,0 +1,459 @@ +[ccpp-arg-table] + name = rrtmg_sw_run + type = scheme +[plyr] + standard_name = air_pressure_at_layer_for_radiation_in_hPa + long_name = air pressure layer + units = hPa + dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + type = real + kind = kind_phys + intent = in + optional = F +[plvl] + standard_name = air_pressure_at_interface_for_radiation_in_hPa + long_name = air pressure level + units = hPa + dimensions = (horizontal_dimension,adjusted_vertical_level_dimension_for_radiation) + type = real + kind = kind_phys + intent = in + optional = F +[tlyr] + standard_name = air_temperature_at_layer_for_radiation + long_name = air temperature layer + units = K + dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + type = real + kind = kind_phys + intent = in + optional = F +[tlvl] + standard_name = air_temperature_at_interface_for_radiation + long_name = air temperature level + units = K + dimensions = (horizontal_dimension,adjusted_vertical_level_dimension_for_radiation) + type = real + kind = kind_phys + intent = in + optional = F +[qlyr] + standard_name = water_vapor_specific_humidity_at_layer_for_radiation + long_name = specific humidity layer + units = kg kg-1 + dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + type = real + kind = kind_phys + intent = in + optional = F +[olyr] + standard_name = ozone_concentration_at_layer_for_radiation + long_name = ozone concentration layer + units = kg kg-1 + dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + type = real + kind = kind_phys + intent = in + optional = F +[gasvmr_co2] + standard_name = volume_mixing_ratio_co2 + long_name = volume mixing ratio co2 + units = kg kg-1 + dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + type = real + kind = kind_phys + intent = in + optional = F +[gasvmr_n2o] + standard_name = volume_mixing_ratio_n2o + long_name = volume mixing ratio no2 + units = kg kg-1 + dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + type = real + kind = kind_phys + intent = in + optional = F +[gasvmr_ch4] + standard_name = volume_mixing_ratio_ch4 + long_name = volume mixing ratio ch4 + units = kg kg-1 + dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + type = real + kind = kind_phys + intent = in + optional = F +[gasvmr_o2] + standard_name = volume_mixing_ratio_o2 + long_name = volume mixing ratio o2 + units = kg kg-1 + dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + type = real + kind = kind_phys + intent = in + optional = F +[gasvmr_co] + standard_name = volume_mixing_ratio_co + long_name = volume mixing ratio co + units = kg kg-1 + dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + type = real + kind = kind_phys + intent = in + optional = F +[gasvmr_cfc11] + standard_name = volume_mixing_ratio_cfc11 + long_name = volume mixing ratio cfc11 + units = kg kg-1 + dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + type = real + kind = kind_phys + intent = in + optional = F +[gasvmr_cfc12] + standard_name = volume_mixing_ratio_cfc12 + long_name = volume mixing ratio cfc12 + units = kg kg-1 + dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + type = real + kind = kind_phys + intent = in + optional = F +[gasvmr_cfc22] + standard_name = volume_mixing_ratio_cfc22 + long_name = volume mixing ratio cfc22 + units = kg kg-1 + dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + type = real + kind = kind_phys + intent = in + optional = F +[gasvmr_ccl4] + standard_name = volume_mixing_ratio_ccl4 + long_name = volume mixing ratio ccl4 + units = kg kg-1 + dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + type = real + kind = kind_phys + intent = in + optional = F +[icseed] + standard_name = seed_random_numbers_sw + long_name = seed for random number generation for shortwave radiation + units = none + dimensions = (horizontal_dimension) + type = integer + intent = in + optional = F +[aeraod] + standard_name = aerosol_optical_depth_for_shortwave_bands_01_16 + long_name = aerosol optical depth for shortwave bands 01-16 + units = none + dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation,number_of_aerosol_bands_for_shortwave_radiation) + type = real + kind = kind_phys + intent = in + optional = F +[aerssa] + standard_name = aerosol_single_scattering_albedo_for_shortwave_bands_01_16 + long_name = aerosol single scattering albedo for shortwave bands 01-16 + units = frac + dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation,number_of_aerosol_bands_for_shortwave_radiation) + type = real + kind = kind_phys + intent = in + optional = F +[aerasy] + standard_name = aerosol_asymmetry_parameter_for_shortwave_bands_01_16 + long_name = aerosol asymmetry paramter for shortwave bands 01-16 + units = none + dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation,number_of_aerosol_bands_for_shortwave_radiation) + type = real + kind = kind_phys + intent = in + optional = F +[sfcalb_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_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[sfcalb_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_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[sfcalb_uvis_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_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[sfcalb_uvis_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_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[dzlyr] + standard_name = layer_thickness_for_radiation + long_name = layer thickness + units = km + dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + type = real + kind = kind_phys + intent = in + optional = F +[delpin] + standard_name = layer_pressure_thickness_for_radiation + long_name = layer pressure thickness + units = hPa + dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + type = real + kind = kind_phys + intent = in + optional = F +[de_lgth] + standard_name = cloud_decorrelation_length + long_name = cloud decorrelation length + units = km + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[cosz] + standard_name = cosine_of_zenith_angle + long_name = cosine of the solar zenit angle + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[solcon] + standard_name = solar_constant + long_name = solar constant + units = W m-2 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[nday] + standard_name = daytime_points_dimension + long_name = daytime points dimension + units = count + dimensions = () + type = integer + intent = in + optional = F +[idxday] + standard_name = daytime_points + long_name = daytime points + units = index + dimensions = (horizontal_dimension) + type = integer + intent = in + optional = F +[npts] + standard_name = horizontal_loop_extent + long_name = horizontal dimension + units = count + dimensions = () + type = integer + intent = in + optional = F +[nlay] + standard_name = adjusted_vertical_layer_dimension_for_radiation + long_name = number of vertical layers for radiation + units = count + dimensions = () + type = integer + intent = in + optional = F +[nlp1] + standard_name = adjusted_vertical_level_dimension_for_radiation + long_name = number of vertical levels for radiation + units = count + dimensions = () + type = integer + intent = in + optional = F +[lprnt] + standard_name = flag_print + long_name = flag to print + units = flag + dimensions = () + type = logical + intent = in + optional = F +[cld_cf] + standard_name = total_cloud_fraction + long_name = total cloud fraction + units = frac + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[lsswr] + standard_name = flag_to_calc_sw + long_name = flag to calculate SW irradiances + units = flag + dimensions = () + type = logical + intent = in + optional = F +[hswc] + standard_name = tendency_of_air_temperature_due_to_shortwave_heating_on_radiation_time_step + long_name = shortwave total sky heating rate + units = K s-1 + dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + type = real + kind = kind_phys + intent = inout + optional = F +[topflx] + standard_name = sw_fluxes_top_atmosphere + long_name = shortwave total sky fluxes at the top of the atm + units = W m-2 + dimensions = (horizontal_dimension) + type = topfsw_type + intent = inout + optional = F +[sfcflx] + standard_name = sw_fluxes_sfc + long_name = shortwave total sky fluxes at the Earth surface + units = W m-2 + dimensions = (horizontal_dimension) + type = sfcfsw_type + intent = inout + optional = F +[cldtau] + standard_name = cloud_optical_depth_layers_at_0p55mu_band + long_name = approx .55mu band layer cloud optical depth + units = none + dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + type = real + kind = kind_phys + intent = inout + optional = F +[hsw0] + standard_name = tendency_of_air_temperature_due_to_shortwave_heating_assuming_clear_sky_on_radiation_time_step + long_name = shortwave clear sky heating rate + units = K s-1 + dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + type = real + kind = kind_phys + intent = inout + optional = T +[fdncmp] + standard_name = components_of_surface_downward_shortwave_fluxes + long_name = derived type for special components of surface downward shortwave fluxes + units = W m-2 + dimensions = (horizontal_dimension) + type = cmpfsw_type + intent = inout + optional = T +[cld_lwp] + standard_name = cloud_liquid_water_path + long_name = cloud liquid water path + units = g m-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = T +[cld_ref_liq] + standard_name = mean_effective_radius_for_liquid_cloud + long_name = mean effective radius for liquid cloud + units = micron + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = T +[cld_iwp] + standard_name = cloud_ice_water_path + long_name = cloud ice water path + units = g m-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = T +[cld_ref_ice] + standard_name = mean_effective_radius_for_ice_cloud + long_name = mean effective radius for ice cloud + units = micron + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = T +[cld_rwp] + standard_name = cloud_rain_water_path + long_name = cloud rain water path + units = g m-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = T +[cld_ref_rain] + standard_name = mean_effective_radius_for_rain_drop + long_name = mean effective radius for rain drop + units = micron + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = T +[cld_swp] + standard_name = cloud_snow_water_path + long_name = cloud snow water path + units = g m-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = T +[cld_ref_snow] + standard_name = mean_effective_radius_for_snow_flake + long_name = mean effective radius for snow flake + units = micron + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = T +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F diff --git a/physics/radsw_param.f b/physics/radsw_param.f index d4e697711..93608eb65 100644 --- a/physics/radsw_param.f +++ b/physics/radsw_param.f @@ -62,6 +62,10 @@ module module_radsw_parameters ! !........................................! +!! \section arg_table_module_radsw_parameters +!! \htmlinclude module_radsw_parameters.html +!! + use physparam, only : kind_phys implicit none @@ -69,37 +73,46 @@ module module_radsw_parameters ! public ! !> derived type for SW fluxes at TOA - type :: topfsw_type +!! \section arg_table_topfsw_type +!! \htmlinclude topfsw_type.html +!! + type topfsw_type real (kind=kind_phys) :: upfxc !< total-sky upward flux real (kind=kind_phys) :: dnfxc !< total-sky downward flux real (kind=kind_phys) :: upfx0 !< clear-sky upward flux - end type + end type topfsw_type ! !> derived type for SW fluxes at surface - type :: sfcfsw_type +!! \section arg_table_sfcfsw_type +!! \htmlinclude sfcfsw_type.html +!! + type sfcfsw_type real (kind=kind_phys) :: upfxc !< total-sky upward flux real (kind=kind_phys) :: dnfxc !< total-sky downward flux real (kind=kind_phys) :: upfx0 !< clear-sky upward flux real (kind=kind_phys) :: dnfx0 !< clear-sky downward flux - end type + end type sfcfsw_type ! !> derived type for SW fluxes' column profiles (at layer interfaces) - type :: profsw_type + type profsw_type real (kind=kind_phys) :: upfxc !< total-sky upward flux real (kind=kind_phys) :: dnfxc !< total-sky downward flux real (kind=kind_phys) :: upfx0 !< clear-sky upward flux real (kind=kind_phys) :: dnfx0 !< clear-sky downward flux - end type + end type profsw_type ! !> derived type for special components of surface SW fluxes - type :: cmpfsw_type +!! \section arg_table_cmpfsw_type +!! \htmlinclude cmpfsw_type.html +!! + type cmpfsw_type real (kind=kind_phys) :: uvbfc !< total-sky downward flux cover UV-B spectrum real (kind=kind_phys) :: uvbf0 !< clear-sky downward flux cover UV-B spectrum real (kind=kind_phys) :: nirbm !< total-sky downward flux for near-IR direct beam real (kind=kind_phys) :: nirdf !< total-sky downward flux for near-IR diffused part real (kind=kind_phys) :: visbm !< total-sky downward flux for UV+Visible direct real (kind=kind_phys) :: visdf !< total-sky downward flux for UV+Visible diffused - end type + end type cmpfsw_type ! ! Parameter constants for SW band structures @@ -142,8 +155,8 @@ module module_radsw_parameters ! & NS23, NS24, NS25, NS26, NS27, NS28, NS29 / !> reverse checking of band index for each g-point - integer, dimension(NGPTSW) :: NGB - data NGB(:) / 16,16,16,16,16,16, & ! band 16 + integer, dimension(NGPTSW), parameter :: NGB = & + & (/ 16,16,16,16,16,16, & ! band 16 & 17,17,17,17,17,17,17,17,17,17,17,17, & ! band 17 & 18,18,18,18,18,18,18,18, & ! band 18 & 19,19,19,19,19,19,19,19, & ! band 19 @@ -156,16 +169,15 @@ module module_radsw_parameters ! & 26,26,26,26,26,26, & ! band 26 & 27,27,27,27,27,27,27,27, & ! band 27 & 28,28,28,28,28,28, & ! band 28 - & 29,29,29,29,29,29,29,29,29,29,29,29 / ! band 29 + & 29,29,29,29,29,29,29,29,29,29,29,29 /) ! band 29 !> \name Starting/ending wavenumber for each of the SW bands - real (kind=kind_phys), dimension(NBANDS):: wvnum1, wvnum2 - data wvnum1(:) / & - & 2600.0, 3250.0, 4000.0, 4650.0, 5150.0, 6150.0, 7700.0, & - & 8050.0,12850.0,16000.0,22650.0,29000.0,38000.0, 820.0 / - data wvnum2(:) / & - & 3250.0, 4000.0, 4650.0, 5150.0, 6150.0, 7700.0, 8050.0, & - & 12850.0,16000.0,22650.0,29000.0,38000.0,50000.0, 2600.0 / + real (kind=kind_phys), dimension(NBANDS), parameter :: wvnum1 = & + & (/ 2600.0, 3250.0, 4000.0, 4650.0, 5150.0, 6150.0, 7700.0, & + & 8050.0,12850.0,16000.0,22650.0,29000.0,38000.0, 820.0 /) + real (kind=kind_phys), dimension(NBANDS), parameter :: wvnum2 = & + & (/ 3250.0, 4000.0, 4650.0, 5150.0, 6150.0, 7700.0, 8050.0, & + & 12850.0,16000.0,22650.0,29000.0,38000.0,50000.0, 2600.0 /) ! !........................................! diff --git a/physics/radsw_param.meta b/physics/radsw_param.meta new file mode 100644 index 000000000..9f7c8a35a --- /dev/null +++ b/physics/radsw_param.meta @@ -0,0 +1,36 @@ +[ccpp-arg-table] + name = topfsw_type + type = ddt + +######################################################################## +[ccpp-arg-table] + name = sfcfsw_type + type = ddt + +######################################################################## +[ccpp-arg-table] + name = cmpfsw_type + type = ddt + +######################################################################## +[ccpp-arg-table] + name = module_radsw_parameters + type = module +[topfsw_type] + standard_name = topfsw_type + long_name = definition of type topfsw_type + units = DDT + dimensions = () + type = topfsw_type +[sfcfsw_type] + standard_name = sfcfsw_type + long_name = definition of type sfcfsw_type + units = DDT + dimensions = () + type = sfcfsw_type +[cmpfsw_type] + standard_name = cmpfsw_type + long_name = definition of type cmpfsw_type + units = DDT + dimensions = () + type = cmpfsw_type diff --git a/physics/rascnv.F90 b/physics/rascnv.F90 new file mode 100644 index 000000000..be3b928a8 --- /dev/null +++ b/physics/rascnv.F90 @@ -0,0 +1,4158 @@ +!> \file rascnv.F90 +!! This file contains the entire Relaxed Arakawa-Schubert convection +!! parameteriztion + + module rascnv + + USE machine , ONLY : kind_phys + implicit none + public :: rascnv_init, rascnv_run, rascnv_finalize + private + logical :: is_initialized = .False. +! + integer, parameter :: nrcmax=32 ! Maximum # of random clouds per 1200s + + integer, parameter :: idnmax=999 + real (kind=kind_phys), parameter :: delt_c=1800.0/3600.0 & +! Adjustment time scales in hrs for deep and shallow clouds +! &, adjts_d=3.0, adjts_s=0.5 +! &, adjts_d=2.5, adjts_s=0.5 + &, adjts_d=2.0, adjts_s=0.5 +! + logical, parameter :: fix_ncld_hr=.true. + +! + real (kind=kind_phys), parameter :: ZERO=0.0, HALF=0.5 & + &, pt25=0.25 & + &, ONE=1.0, TWO=2.0, FOUR=4.& + &, twoo3=two/3.0 & + &, FOUR_P2=4.E2, ONE_M10=1.E-10 & + &, ONE_M6=1.E-6, ONE_M5=1.E-5 & + &, ONE_M2=1.E-2, ONE_M1=1.E-1 & + &, oneolog10=one/log(10.0) & + &, facmb = 0.01 & ! conversion factor from Pa to hPa (or mb) + &, cmb2pa = 100.0 ! Conversion from hPa to Pa +! + real(kind=kind_phys), parameter :: frac=0.5, crtmsf=0.0 & + &, rhfacs=0.70, rhfacl=0.70 & + &, face=5.0, delx=10000.0 & + &, ddfac=face*delx*0.001 & + &, max_neg_bouy=0.15 & +! &, max_neg_bouy=pt25 & + &, testmb=0.1, testmbi=one/testmb & + &, dpd=0.5, rknob=1.0, eknob=1.0 + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + logical, parameter :: do_aw=.true., cumfrc=.true. & + &, updret=.false., vsmooth=.false. & + &, wrkfun=.false., crtfun=.true. & + &, calkbl=.true., botop=.true., revap=.true. & + &, advcld=.true., advups=.false.,advtvd=.true. +! &, advcld=.true., advups=.true., advtvd=.false. +! &, advcld=.true., advups=.false.,advtvd=.false. + + + real(kind=kind_phys), parameter :: TF=233.16, TCR=273.16 & + &, TCRF=1.0/(TCR-TF), TCL=2.0 + +! +! For pressure gradient force in momentum mixing +! real (kind=kind_phys), parameter :: pgftop=0.80, pgfbot=0.30 & +! No pressure gradient force in momentum mixing + real (kind=kind_phys), parameter :: pgftop=0.0, pgfbot=0.0 & +! real (kind=kind_phys), parameter :: pgftop=0.55, pgfbot=0.55 & + &, pgfgrad=(pgfbot-pgftop)*0.001 & + &, cfmax=0.1 +! +! For Tilting Angle Specification +! + real(kind=kind_phys) REFP(6), REFR(6), TLAC(8), PLAC(8), TLBPL(7) & + &, drdp(5) +! + DATA PLAC/100.0, 200.0, 300.0, 400.0, 500.0, 600.0, 700.0, 800.0/ + DATA TLAC/ 35.0, 25.0, 20.0, 17.5, 15.0, 12.5, 10.0, 7.5/ + DATA REFP/500.0, 300.0, 250.0, 200.0, 150.0, 100.0/ + DATA REFR/ 1.0, 2.0, 3.0, 4.0, 6.0, 8.0/ +! + real(kind=kind_phys) AC(16), AD(16) +! + integer, parameter :: nqrp=500001 + real(kind=kind_phys) C1XQRP, C2XQRP, TBQRP(NQRP), TBQRA(NQRP) & + &, TBQRB(NQRP) +! + integer, parameter :: nvtp=10001 + real(kind=kind_phys) C1XVTP, C2XVTP, TBVTP(NVTP) +! + real(kind=kind_phys) afc, facdt, & + grav, cp, alhl, alhf, rgas, rkap, nu, pi, & + t0c, rv, cvap, cliq, csol, ttp, eps, epsm1,& +! + ONEBG, GRAVCON, onebcp, GRAVFAC, ELOCP, & + ELFOCP, oneoalhl, CMPOR, picon, zfac, & + deg2rad, PIINV, testmboalhl, & + rvi, facw, faci, hsub, tmix, DEN + + + contains + +! ----------------------------------------------------------------------- +! CCPP entry points for gfdl cloud microphysics +! ----------------------------------------------------------------------- + +!>\brief The subroutine initializes rascnv +!! +!> \section arg_table_rascnv_init Argument Table +!! \htmlinclude rascnv_init.html +!! + subroutine rascnv_init(me, dt, con_g, con_cp, con_rd, & + con_rv, con_hvap, con_hfus, con_fvirt, & + con_t0c, con_ttp, con_cvap, con_cliq, & + con_csol, con_eps, con_epsm1, & + errmsg, errflg) +! + Implicit none +! + integer, intent(in) :: me + real(kind=kind_phys), intent(in) :: dt, & + con_g, con_cp, con_rd, con_rv, con_hvap, & + con_hfus, con_fvirt, con_t0c, con_cvap, con_cliq, & + con_csol, con_ttp, con_eps, con_epsm1 + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg +! + real(kind=kind_phys), parameter :: actp=1.7, facm=1.00 +! + real(kind=kind_phys) PH(15), A(15) +! + DATA PH/150.0, 200.0, 250.0, 300.0, 350.0, 400.0, 450.0, 500.0 & + &, 550.0, 600.0, 650.0, 700.0, 750.0, 800.0, 850.0/ +! + DATA A/ 1.6851, 1.1686, 0.7663, 0.5255, 0.4100, 0.3677 & + &, 0.3151, 0.2216, 0.1521, 0.1082, 0.0750, 0.0664 & + &, 0.0553, 0.0445, 0.0633/ +! + real(kind=kind_phys) tem, actop, tem1, tem2 + integer i, l + logical first + data first/.true./ +! +! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + if (is_initialized) return +! set critical workfunction arrays + ACTOP = ACTP*FACM + DO L=1,15 + A(L) = A(L)*FACM + ENDDO + DO L=2,15 + TEM = one / (PH(L) - PH(L-1)) + AC(L) = (PH(L)*A(L-1) - PH(L-1)*A(L)) * TEM + AD(L) = (A(L) - A(L-1)) * TEM + ENDDO + AC(1) = ACTOP + AC(16) = A(15) + AD(1) = zero + AD(16) = zero +! + CALL SETQRP + CALL SETVTP +! + do i=1,7 + tlbpl(i) = (tlac(i)-tlac(i+1)) / (plac(i)-plac(i+1)) + enddo + do i=1,5 + drdp(i) = (REFR(i+1)-REFR(i)) / (REFP(i+1)-REFP(i)) + enddo +! +! VTP = 36.34*SQRT(1.2)* (0.001)**0.1364 +! + AFC = -(1.01097E-4*DT)*(3600./DT)**0.57777778 +! + grav = con_g ; cp = con_cp ; alhl = con_hvap + alhf = con_hfus ; rgas = con_rd + nu = con_FVirt ; t0c = con_t0c + rv = con_rv ; cvap = con_cvap + cliq = con_cliq ; csol = con_csol ; ttp = con_ttp + eps = con_eps ; epsm1 = con_epsm1 +! + pi = four*atan(one) ; PIINV = one/PI + ONEBG = ONE / GRAV ; GRAVCON = cmb2pa * ONEBG + onebcp = one / cp ; GRAVFAC = GRAV / CMB2PA + rkap = rgas * onebcp ; deg2rad = pi/180.d0 + ELOCP = ALHL * onebcp ; ELFOCP = (ALHL+ALHF) * onebcp + oneoalhl = one/alhl ; CMPOR = CMB2PA / RGAS + picon = half*pi*onebg ; zfac = 0.28888889E-4 * ONEBG + testmboalhl = testmb/alhl +! + rvi = one/rv ; facw=CVAP-CLIQ + faci = CVAP-CSOL ; hsub=alhl+alhf + tmix = TTP-20.0 ; DEN=one/(TTP-TMIX) +! + + if (me == 0) write(0,*) ' NO DOWNDRAFT FOR CLOUD TYPES' & + &, ' DETRAINING AT NORMALIZED PRESSURE ABOVE ',DPD +! + is_initialized = .true. + +! + end subroutine rascnv_init +! +!! \section arg_table_rascnv_finalize Argument Table +!! \htmlinclude rascnv_finalize.html +!! + subroutine rascnv_finalize (errmsg, errflg) + + implicit none + + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + end subroutine rascnv_finalize +!! +!! +!!===================================================================== ! +!! rascnv_run: ! +!! ! +!! program history log: ! +!! Oct 2019 -- shrinivas moorthi ! +!! ! +!! ! +!! ==================== defination of variables ==================== +!! ! +!! ! +!! inputs: size +!! ! +!! im - integer, horiz dimension and num of used pts 1 ! +!! ix - integer, maximum horiz dimension 1 ! +!! k - integer, vertical dimension 1 ! +!! dt - real, time step in seconds 1 ! +!! dtf - real, dynamics time step in seconds 1 ! +!! rannum - real, array holding random numbers between 0 an 1 (ix,nrcm) ! +!! tin - real, input temperature (K) +!! qin - real, input specific humidity (kg/kg) +!! uin - real, input zonal wind component +!! vin - real, input meridional wind component +!! ccin - real, input condensates+tracers +!! fscav - real +!! prsi - real, layer interface pressure +!! prsl - real, layer mid pressure +!! prsik - real, layer interface Exner function +!! prslk - real, layer mid Exner function +!! phil - real, layer mid geopotential height +!! phii - real, layer interface geopotential height +!! kpbl - integer pbl top index +!! cdrag - real, drag coefficient +!! rainc - real, convectinve rain (m/sec) +!! kbot - integer, cloud bottom index +!! ktop - integer, cloud top index +!! knv - integer, 0 - no convvection; 1 - convection +!! ddvel - downdraft induced surface wind +!! flipv - logical, true if input data from bottom to top +!! me - integer, current pe number +!! area - real, grid area +!! ccwf - real, multiplication factor for critical workfunction +!! nrcm - integer, number of random numbers at each grid point +!! rhc - real, critical relative humidity +!! ud_mf - real, updraft mass flux +!! dd_mf - real, downdraft mass flux +!! dt_mf - real, detrained mass flux +!! qw0 - real, min cloud water before autoconversion +!! qi0 - real, min cloud ice before autoconversion +!! dlqfac - real,fraction of condensated detrained in layers +!! kdt - integer, current teime step +!! revap - logial, when true reevaporate falling rain/snow +!! qlcn - real +!! qicn - real +!! w_upi - real +!! cf_upi - real +!! cnv_mfd - real +!! cnv_dqldt- real +!! clcn - real +!! cnv_fice - real +!! cnv_ndrop- real +!! cnv_nice - real +!! mp_phys - integer, microphysics option +!! mp_phys_mg - integer, flag for MG microphysics option +!! trcmin - real, floor value for tracers +!! ntk - integer, index representing TKE in the tracer array +!! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +!! \section arg_table_rascnv_run Argument Table +!! \htmlinclude rascnv_run.html +!! + subroutine rascnv_run(IM, IX, k, ntr, dt, dtf & + &, ccwf, area, dxmin, dxinv & + &, psauras, prauras, wminras, dlqf, flipv & + &, me, rannum, nrcm, mp_phys, mp_phys_mg & + &, ntk, kdt, rhc & + &, tin, qin, uin, vin, ccin, fscav & + &, prsi, prsl, prsik, prslk, phil, phii & + &, KPBL, CDRAG, RAINC, kbot, ktop, kcnv & + &, DDVEL, ud_mf, dd_mf, dt_mf & + &, QLCN, QICN, w_upi, cf_upi, CNV_MFD & + &, CNV_DQLDT,CLCN,CNV_FICE,CNV_NDROP,CNV_NICE & + &, errmsg, errflg) +! +!********************************************************************* +!********************************************************************* +!************ Relaxed Arakawa-Schubert ****************** +!************ Parameterization ****************** +!************ Plug Compatible Driver ****************** +!************ 23 May 2002 ****************** +!************ ****************** +!************ Developed By ****************** +!************ ****************** +!************ Shrinivas Moorthi ****************** +!************ ****************** +!************ EMC/NCEP ****************** +!********************************************************************* +!********************************************************************* +! +! + Implicit none +! + LOGICAL FLIPV +! +! input +! + integer, intent(in) :: im, ix, k, ntr, me, nrcm, ntk, kdt & + &, mp_phys, mp_phys_mg + integer, dimension(im) :: kbot, ktop, kcnv, kpbl +! + real(kind=kind_phys), intent(in) :: dxmin, dxinv, ccwf(2) & + &, psauras(2), prauras(2) & + &, wminras(2), dlqf(2) +! + real(kind=kind_phys), dimension(ix,k) :: tin, qin, uin, vin & + &, prsl, prslk, phil + real(kind=kind_phys), dimension(ix,k+1) :: prsi, prsik, phii + real(kind=kind_phys), dimension(im,k) :: ud_mf, dd_mf, dt_mf & + &, rhc, qlcn, qicn, w_upi & + &, cnv_mfd & + &, cnv_dqldt, clcn & + &, cnv_fice, cnv_ndrop & + &, cnv_nice, cf_upi + real(kind=kind_phys), dimension(im) :: area, cdrag & + &, rainc, ddvel + real(kind=kind_phys), dimension(ix,nrcm):: rannum + real(kind=kind_phys) ccin(ix,k,ntr+2) + real(kind=kind_phys) trcmin(ntr+2) + + real(kind=kind_phys) DT, dtf, qw0, qi0 +! +! Added for aerosol scavenging for GOCART +! + real(kind=kind_phys), intent(in) :: fscav(ntr) + +! &, ctei_r(im), ctei_rm + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg +! +! locals +! + real(kind=kind_phys), dimension(k) :: toi, qoi, tcu, qcu & + &, pcu, clw, cli, qii, qli& + &, phi_l, prsm,psjm & + &, alfinq, alfind, rhc_l & + &, qoi_l, qli_l, qii_l + real(kind=kind_phys), dimension(k+1) :: prs, psj, phi_h, flx, flxd + + + integer, dimension(100) :: ic + real(kind=kind_phys), parameter :: clwmin=1.0e-10 +! + real(kind=kind_phys), allocatable :: ALFINT(:,:), uvi(:,:) & + &, trcfac(:,:), rcu(:,:) + real(kind=kind_phys) dtvd(2,4) +! &, DPI(K) + real(kind=kind_phys) CFAC, TEM, sgc, ccwfac, tem1, tem2, rain & + &, wfnc,tla,pl,qiid,qlid, c0, c0i, dlq_fac, sumq& + &, rainp +! integer :: nrcmax ! Maximum # of random clouds per 1200s +! + Integer KCR, KFX, NCMX, NC, KTEM, I, ii, Lm1, l & + &, ntrc, ia, ll, km1, kp1, ipt, lv, KBL, n & + &, KRMIN, KRMAX, KFMAX, kblmx, irnd,ib & + &, kblmn, ksfc, ncrnd + real(kind=kind_phys) sgcs(k,im) +! +! Scavenging related parameters +! + real fscav_(ntr+2) ! Fraction scavenged per km +! + fscav_ = zero ! By default no scavenging + if (ntr > 0) then + do i=1,ntr + fscav_(i) = fscav(i) + enddo + endif + trcmin = -99999.0 + if (ntk-2 > 0) trcmin(ntk-2) = 1.0d-4 + +!> - Initialize CCPP error handling variables + + errmsg = '' + errflg = 0 +! + km1 = k - 1 + kp1 = k + 1 + if (flipv) then + ksfc = 1 + else + ksfc = kp1 + endif +! + ntrc = ntr + IF (CUMFRC) THEN + ntrc = ntrc + 2 + ENDIF + if (ntrc > 0) then + if (.not. allocated(trcfac)) allocate (trcfac(k,ntrc)) + if (.not. allocated(uvi)) allocate (uvi(k,ntrc)) + if (.not. allocated(rcu)) allocate (rcu(k,ntrc)) + do n=1, ntrc + do l=1,k + trcfac(l,n) = one ! For other tracers + rcu(l,n) = zero + enddo + enddo + endif +! +!!!!! initialization for microphysics ACheng + if(mp_phys == 10) then + do l=1,K + do i=1,im + QLCN(i,l) = zero + QICN(i,l) = zero + w_upi(i,l) = zero + cf_upi(i,l) = zero + CNV_MFD(i,l) = zero +! CNV_PRC3(i,l) = zero + CNV_DQLDT(i,l) = zero + CLCN(i,l) = zero + CNV_FICE(i,l) = zero + CNV_NDROP(i,l) = zero + CNV_NICE(i,l) = zero + enddo + enddo + endif +! + if (.not. allocated(alfint)) allocate(alfint(k,ntrc+4)) +! +! call set_ras_afc(dt) +! AFC = -(1.04E-4*DT)*(3600./DT)**0.578 +! AFC = -(1.01097E-4*DT)*(3600./DT)**0.57777778 +! + do l=1,k + do i=1,im + ud_mf(i,l) = zero + dd_mf(i,l) = zero + dt_mf(i,l) = zero + enddo + enddo + DO IPT=1,IM + + tem1 = max(zero, min(one, (log(area(ipt)) - dxmin) * dxinv)) + tem2 = one - tem1 + ccwfac = ccwf(1)*tem1 + ccwf(2)*tem2 + dlq_fac = dlqf(1)*tem1 + dlqf(2)*tem2 + tem = one + dlq_fac + c0i = (psauras(1)*tem1 + psauras(2)*tem2) * tem + c0 = (prauras(1)*tem1 + prauras(2)*tem2) * tem + if (ccwfac == zero) ccwfac = half + +! +! ctei = .false. +! if (ctei_r(ipt) > ctei_rm) ctei = .true. +! +! Compute NCRND : +! if flipv is true, then input variables are from bottom +! to top while RAS goes top to bottom +! + tem = one / prsi(ipt,ksfc) + + KRMIN = 1 + KRMAX = km1 + KFMAX = KRMAX + kblmx = 1 + kblmn = 1 + DO L=1,KM1 + ll = l + if (flipv) ll = kp1 -l ! Input variables are bottom to top! + SGC = prsl(ipt,ll) * tem + sgcs(l,ipt) = sgc + IF (SGC <= 0.050) KRMIN = L +! IF (SGC <= 0.700) KRMAX = L +! IF (SGC <= 0.800) KRMAX = L + IF (SGC <= 0.760) KRMAX = L +! IF (SGC <= 0.930) KFMAX = L + IF (SGC <= 0.970) KFMAX = L ! Commented on 20060202 +! IF (SGC <= 0.700) kblmx = L ! Commented on 20101015 + IF (SGC <= 0.600) kblmx = L ! +! IF (SGC <= 0.650) kblmx = L ! Commented on 20060202 + IF (SGC <= 0.980) kblmn = L ! + ENDDO + krmin = max(krmin,2) + +! + if (fix_ncld_hr) then +!!! NCRND = min(nrcmax, (KRMAX-KRMIN+1)) * (DTF/1200) + 0.50001 + NCRND = min(nrcmax, (KRMAX-KRMIN+1)) * (DTF/1800) + 0.10001 +! NCRND = min(nrcmax, (KRMAX-KRMIN+1)) * (DTF/1200) + 0.10001 +! NCRND = min(nrcmax, (KRMAX-KRMIN+1)) * (DTF/900) + 0.50001 +! NCRND = min(nrcmax, (KRMAX-KRMIN+1)) * (DTF/600) + 0.50001 +! NCRND = min(nrcmax, (KRMAX-KRMIN+1)) * (DTF/360) + 0.50001 +! & + 0.50001 +! NCRND = min(nrcmax, (KRMAX-KRMIN+1)) * min(1.0,DTF/360) + 0.1 + facdt = delt_c / dt + else + NCRND = min(nrcmax, (KRMAX-KRMIN+1)) + facdt = one / 3600.0 + endif + NCRND = min(nrcm,max(NCRND, 1)) +! + KCR = MIN(K,KRMAX) + KTEM = MIN(K,KFMAX) + KFX = KTEM - KCR + + IF (KFX > 0) THEN + IF (BOTOP) THEN + DO NC=1,KFX + IC(NC) = KTEM + 1 - NC + ENDDO + ELSE + DO NC=KFX,1,-1 + IC(NC) = KTEM + 1 - NC + ENDDO + ENDIF + ENDIF +! + NCMX = KFX + NCRND + IF (NCRND > 0) THEN + DO I=1,NCRND + II = mod(i-1,nrcm) + 1 + IRND = (RANNUM(ipt,II)-0.0005)*(KCR-KRMIN+1) + IC(KFX+I) = IRND + KRMIN + ENDDO + ENDIF +! + do l=1,k + CLW(l) = zero + CLI(l) = zero + ! to be zero i.e. no environmental condensate!!! + QII(l) = zero + QLI(l) = zero +! Initialize heating, drying, cloudiness etc. + tcu(l) = zero + qcu(l) = zero + pcu(l) = zero + flx(l) = zero + flxd(l) = zero + do n=1,ntrc + rcu(l,n) = zero + enddo + enddo + flx(kp1) = zero + flxd(kp1) = zero + rain = zero +! + if (flipv) then ! Input variables are bottom to top! + do l=1,k + ll = kp1 - l + ! Transfer input prognostic data into local variable + toi(l) = tin(ipt,ll) + qoi(l) = qin(ipt,ll) + + PRSM(L) = prsl(ipt,ll) * facmb + PSJM(L) = prslk(ipt,ll) + phi_l(L) = phil(ipt,ll) + rhc_l(L) = rhc(ipt,ll) +! + if (ntrc > ntr) then ! CUMFRC is true + uvi(l,ntr+1) = uin(ipt,ll) + uvi(l,ntr+2) = vin(ipt,ll) + endif +! + if (ntr > 0) then ! tracers such as O3, dust etc + do n=1,ntr + uvi(l,n) = ccin(ipt,ll,n+2) + if (abs(uvi(l,n)) < 1.0e-20) uvi(l,n) = zero + enddo + endif + enddo + do l=1,kp1 + ll = kp1 + 1 - l ! Input variables are bottom to top! + PRS(LL) = prsi(ipt,L) * facmb + PSJ(LL) = prsik(ipt,L) + phi_h(LL) = phii(ipt,L) + enddo +! + if (ccin(ipt,1,2) <= -999.0) then ! input ice/water are together + do l=1,k + ll = kp1 -l + tem = ccin(ipt,ll,1) & + & * MAX(ZERO, MIN(ONE, (TCR-toi(L))*TCRF)) + ccin(ipt,ll,2) = ccin(ipt,ll,1) - tem + ccin(ipt,ll,1) = tem + enddo + endif + if (advcld) then + do l=1,k + ll = kp1 -l ! Input variables are bottom to top! + QII(L) = ccin(ipt,ll,1) + QLI(L) = ccin(ipt,ll,2) + enddo + endif + KBL = MAX(MIN(k, kp1-KPBL(ipt)), k/2) +! + else ! Input variables are top to bottom! + + do l=1,k + ! Transfer input prognostic data into local variable + toi(l) = tin(ipt,l) + qoi(l) = qin(ipt,l) + + PRSM(L) = prsl(ipt, L) * facmb + PSJM(L) = prslk(ipt,L) + phi_l(L) = phil(ipt,L) + rhc_l(L) = rhc(ipt,L) +! + if (ntrc > ntr) then ! CUMFRC is true + uvi(l,ntr+1) = uin(ipt,l) + uvi(l,ntr+2) = vin(ipt,l) + endif +! + if (ntr > 0) then ! tracers such as O3, dust etc + do n=1,ntr + uvi(l,n) = ccin(ipt,l,n+2) + if (abs(uvi(l,n)) < 1.0e-20) uvi(l,n) = zero + enddo + endif + enddo + DO L=1,kp1 + PRS(L) = prsi(ipt,L) * facmb + PSJ(L) = prsik(ipt,L) + phi_h(L) = phii(ipt,L) + ENDDO +! + if (ccin(ipt,1,2) <= -999.0) then ! input ice/water are together + do l=1,k + tem = ccin(ipt,l,1) & + & * MAX(ZERO, MIN(ONE, (TCR-toi(L))*TCRF)) + ccin(ipt,l,2) = ccin(ipt,l,1) - tem + ccin(ipt,l,1) = tem + enddo + endif + if (advcld) then + do l=1,k + QII(L) = ccin(ipt,l,1) + QLI(L) = ccin(ipt,l,2) + enddo + endif +! + KBL = KPBL(ipt) +! + endif ! end of if (flipv) then +! +! do l=k,kctop(1),-1 +!! DPI(L) = 1.0 / (PRS(L+1) - PRS(L)) +! enddo +! +! print *,' ipt=',ipt + + if (advups) then ! For first order upstream for updraft + alfint(:,:) = one + elseif (advtvd) then ! TVD flux limiter scheme for updraft + alfint(:,:) = one + l = krmin + lm1 = l - 1 + dtvd(1,1) = cp*(toi(l)-toi(lm1)) + phi_l(l)-phi_l(lm1) & + & + alhl*(qoi(l)-qoi(lm1)) + dtvd(1,2) = qoi(l) - qoi(lm1) + dtvd(1,3) = qli(l) - qli(lm1) + dtvd(1,4) = qii(l) - qii(lm1) + do l=krmin+1,k + lm1 = l - 1 + +! write(0,*)' toi=',toi(l),toi(lm1),' phi_l=',phi_l(l),phi_l(lm1) +! &,' qoi=',qoi(l),qoi(lm1),' cp=',cp,' alhl=',alhl + + dtvd(2,1) = cp*(toi(l)-toi(lm1)) + phi_l(l)-phi_l(lm1) & + & + alhl*(qoi(l)-qoi(lm1)) + +! write(0,*)' l=',l,' dtvd=',dtvd(:,1) + + if (abs(dtvd(2,1)) > 1.0e-10) then + tem1 = dtvd(1,1) / dtvd(2,1) + tem2 = abs(tem1) + alfint(l,1) = one - half*(tem1 + tem2)/(one + tem2) ! for h + endif + +! write(0,*)' alfint=',alfint(l,1),' l=',l,' ipt=',ipt + + dtvd(1,1) = dtvd(2,1) +! + dtvd(2,2) = qoi(l) - qoi(lm1) + +! write(0,*)' l=',l,' dtvd2=',dtvd(:,2) + + if (abs(dtvd(2,2)) > 1.0e-10) then + tem1 = dtvd(1,2) / dtvd(2,2) + tem2 = abs(tem1) + alfint(l,2) = one - half*(tem1 + tem2)/(one + tem2) ! for q + endif + dtvd(1,2) = dtvd(2,2) +! + dtvd(2,3) = qli(l) - qli(lm1) + +! write(0,*)' l=',l,' dtvd3=',dtvd(:,3) + + if (abs(dtvd(2,3)) > 1.0e-10) then + tem1 = dtvd(1,3) / dtvd(2,3) + tem2 = abs(tem1) + alfint(l,3) = one - half*(tem1 + tem2)/(one + tem2) ! for ql + endif + dtvd(1,3) = dtvd(2,3) +! + dtvd(2,4) = qii(l) - qii(lm1) + +! write(0,*)' l=',l,' dtvd4=',dtvd(:,4) + + if (abs(dtvd(2,4)) > 1.0e-10) then + tem1 = dtvd(1,4) / dtvd(2,4) + tem2 = abs(tem1) + alfint(l,4) = one - half*(tem1 + tem2)/(one + tem2) ! for qi + endif + dtvd(1,4) = dtvd(2,4) + enddo +! + if (ntrc > 0) then + do n=1,ntrc + l = krmin + dtvd(1,1) = uvi(l,n) - uvi(l-1,n) + do l=krmin+1,k + dtvd(2,1) = uvi(l,n) - uvi(l-1,n) + +! write(0,*)' l=',l,' dtvdn=',dtvd(:,1),' n=',n,' l=',l + + if (abs(dtvd(2,1)) > 1.0e-10) then + tem1 = dtvd(1,1) / dtvd(2,1) + tem2 = abs(tem1) + alfint(l,n+4) = one - half*(tem1 + tem2)/(one + tem2) ! for tracers + endif + dtvd(1,1) = dtvd(2,1) + enddo + enddo + endif + else + alfint(:,:) = half ! For second order scheme + endif + alfind(:) = half +! +! write(0,*)' after alfint for ipt=',ipt + +! Resolution dependent press grad correction momentum mixing + + if (CUMFRC) then + do l=krmin,k + tem = one - max(pgfbot, min(pgftop, pgftop+pgfgrad*prsm(l))) + trcfac(l,ntr+1) = tem + trcfac(l,ntr+2) = tem + enddo + endif +! +! if (calkbl) kbl = k + + if (calkbl) then + kbl = kblmn + else + kbl = min(kbl, kblmn) + endif +! + DO NC=1,NCMX ! multi cloud loop +! + IB = IC(NC) ! cloud top level index + if (ib > kbl-1) cycle + +! +!**************************************************************************** +! if (advtvd) then ! TVD flux limiter scheme for updraft +! l = ib +! lm1 = l - 1 +! dtvd(1,1) = cp*(toi(l)-toi(lm1)) + phi_l(l)-phi_l(lm1) +! & + alhl*(qoi(l)-qoi(lm1)) +! dtvd(1,2) = qoi(l) - qoi(lm1) +! dtvd(1,3) = qli(l) - qli(lm1) +! dtvd(1,4) = qii(l) - qii(lm1) +! do l=ib+1,k +! lm1 = l - 1 +! dtvd(2,1) = cp*(toi(l)-toi(lm1)) + phi_l(l)-phi_l(lm1) +! & + alhl*(qoi(l)-qoi(lm1)) +! if (abs(dtvd(2,1)) > 1.0e-10) then +! tem1 = dtvd(1,1) / dtvd(2,1) +! tem2 = abs(tem1) +! alfint(l,1) = 1.0 - 0.5*(tem1 + tem2)/(1.0 + tem2) ! for h +! endif +! dtvd(1,1) = dtvd(2,1) +! +! dtvd(2,2) = qoi(l) - qoi(lm1) +! if (abs(dtvd(2,2)) > 1.0e-10) then +! tem1 = dtvd(1,2) / dtvd(2,2) +! tem2 = abs(tem1) +! alfint(l,2) = 1.0 - 0.5*(tem1 + tem2)/(1.0 + tem2) ! for q +! endif +! dtvd(1,2) = dtvd(2,2) +! +! dtvd(2,3) = qli(l) - qli(lm1) +! if (abs(dtvd(2,3)) > 1.0e-10) then +! tem1 = dtvd(1,3) / dtvd(2,3) +! tem2 = abs(tem1) +! alfint(l,3) = 1.0 - 0.5*(tem1 + tem2)/(1.0 + tem2) ! for ql +! endif +! dtvd(1,3) = dtvd(2,3) +! +! dtvd(2,4) = qii(l) - qii(lm1) +! if (abs(dtvd(2,4)) > 1.0e-10) then +! tem1 = dtvd(1,4) / dtvd(2,4) +! tem2 = abs(tem1) +! alfint(l,4) = 1.0 - 0.5*(tem1 + tem2)/(1.0 + tem2) ! for qi +! endif +! dtvd(1,4) = dtvd(2,4) +! enddo +! +! if (ntrc > 0) then +! do n=1,ntrc +! l = ib +! dtvd(1,1) = uvi(l,n) - uvi(l-1,n) +! do l=ib+1,k +! dtvd(2,1) = uvi(l,n) - uvi(l-1,n) +! if (abs(dtvd(2,1)) > 1.0e-10) then +! tem1 = dtvd(1,1) / dtvd(2,1) +! tem2 = abs(tem1) +! alfint(l,n+4) = 1.0 - 0.5*(tem1 + tem2)/(1.0 + tem2) ! for tracers +! endif +! dtvd(1,1) = dtvd(2,1) +! enddo +! enddo +! endif +! endif +!**************************************************************************** +! + WFNC = zero + do L=IB,KP1 + FLX(L) = zero + FLXD(L) = zero + enddo +! + TLA = -10.0 +! + qiid = qii(ib) ! cloud top level ice before convection + qlid = qli(ib) ! cloud top level water before convection +! + rainp = rain + + CALL CLOUD(K, KP1, IB, ntrc, kblmx, kblmn & + &, FRAC, MAX_NEG_BOUY, vsmooth, do_aw & + &, REVAP, WRKFUN, CALKBL, CRTFUN & + &, DT, KDT, TLA, DPD & + &, ALFINT, rhfacl, rhfacs, area(ipt) & + &, ccwfac, CDRAG(ipt), trcfac & + &, alfind, rhc_l, phi_l, phi_h, PRS, PRSM,sgcs(1,ipt) & + &, TOI, QOI, UVI, QLI, QII, KBL, DDVEL(ipt) & + &, TCU, QCU, RCU, PCU, FLX, FLXD, RAIN, WFNC, fscav_ & + &, trcmin, ntk-2, c0, wminras(1), c0i, wminras(2) & + &, dlq_fac) +! &, ctei) + +! + if (flipv) then + do L=IB,K + ll = kp1 -l ! Input variables are bottom to top! + ud_mf(ipt,ll) = ud_mf(ipt,ll) + flx(l+1) + dd_mf(ipt,ll) = dd_mf(ipt,ll) + flxd(l+1) + enddo + ll = kp1 - ib + dt_mf(ipt,ll) = dt_mf(ipt,ll) + flx(ib) + + if (mp_phys == 10) then ! Anning Cheng for microphysics 11/14/2015 + + CNV_MFD(ipt,ll) = CNV_MFD(ipt,ll) + flx(ib)/dt + +! CNV_DQLDT(ipt,ll) = CNV_DQLDT(ipt,ll) +! & + max(0.,(QLI(ib)+QII(ib)-qiid-qlid))/dt + CNV_DQLDT(ipt,ll) = CNV_DQLDT(ipt,ll) + flx(ib)* & + & max(0.,(QLI(ib)+QII(ib)-qiid-qlid))/dt +! & max(0.,(QLI(ib)+QII(ib)))/dt/3. + if(flx(ib)<0) write(*,*)"AAA666", flx(ib),QLI(ib),QII(ib) & + & ,ipt,ll + endif + + else + + do L=IB,K + ud_mf(ipt,l) = ud_mf(ipt,l) + flx(l+1) + dd_mf(ipt,l) = dd_mf(ipt,l) + flxd(l+1) + enddo + dt_mf(ipt,ib) = dt_mf(ipt,ib) + flx(ib) + + if (mp_phys == 10) then ! Anning Cheng for microphysics 11/14/2015 + CNV_MFD(ipt,ib) = CNV_MFD(ipt,ib) + flx(ib)/dt +! CNV_DQLDT(ipt,ib) = CNV_DQLDT(ipt,ib) +! & + max(0.,(QLI(ib)+QII(ib)-qiid-qlid))/dt + CNV_DQLDT(ipt,ib) = CNV_DQLDT(ipt,ib) + flx(ib)* & + & max(0.,(QLI(ib)+QII(ib)-qiid-qlid))/dt +! & max(0.,(QLI(ib)+QII(ib)))/dt/3. + if(flx(ib)<0) write(*,*)"AAA666", flx(ib),QLI(ib),QII(ib) & + & ,ipt,ib + endif + endif +! +! +! Warning!!!! +! ------------ +! By doing the following, CLOUD does not contain environmental +! condensate! +! + if (.not. advcld) then + do l=1,K + clw(l) = clw(l) + QLI(L) + cli(l) = cli(l) + QII(L) + QLI(L) = zero + QII(L) = zero + enddo + endif +! + ENDDO ! End of the NC loop! +! + RAINC(ipt) = rain * 0.001 ! Output rain is in meters + + ktop(ipt) = kp1 + kbot(ipt) = 0 + + kcnv(ipt) = 0 + + + do l=k,1,-1 +! qli(l) = max(qli(l), zero) +! qii(l) = max(qii(l), zero) +! clw(i) = max(clw(i), zero) +! cli(i) = max(cli(i), zero) + + if (sgcs(l,ipt) < 0.93 .and. abs(tcu(l)) > one_m10) then +! if (sgcs(l,ipt) < 0.90 .and. tcu(l) .ne. 0.0) then +! if (sgcs(l,ipt) < 0.85 .and. tcu(l) .ne. 0.0) then + kcnv(ipt) = 1 + endif +! New test for convective clouds ! added in 08/21/96 + if (clw(l)+cli(l) > zero .OR. & + & qli(l)+qii(l) > clwmin) ktop(ipt) = l + enddo + do l=1,km1 + if (clw(l)+cli(l) > zero .OR. & + & qli(l)+qii(l) > clwmin) kbot(ipt) = l + enddo +! + if (flipv) then + do l=1,k + ll = kp1 - l + tin(ipt,ll) = toi(l) ! Temperature + qin(ipt,ll) = qoi(l) ! Specific humidity + uin(ipt,ll) = uvi(l,ntr+1) ! U momentum + vin(ipt,ll) = uvi(l,ntr+2) ! V momentum + +!! for 2M microphysics, always output these variables + if (mp_phys == 10) then + if (advcld) then + QLCN(ipt,ll) = max(qli(l)-ccin(ipt,ll,2), zero) + QICN(ipt,ll) = max(qii(l)-ccin(ipt,ll,1), zero) + CNV_FICE(ipt,ll) = QICN(ipt,ll) & + & / max(1.e-10,QLCN(ipt,ll)+QICN(ipt,ll)) + else + QLCN(ipt,ll) = qli(l) + QICN(ipt,ll) = qii(l) + CNV_FICE(ipt,ll) = qii(l)/max(1.e-10,qii(l)+qli(l)) + endif + cf_upi(ipt,ll) = max(zero,min(0.02*log(one+ & + & 500*ud_mf(ipt,ll)/dt), cfmax)) +! & 500*ud_mf(ipt,ll)/dt), 0.60)) + CLCN(ipt,ll) = cf_upi(ipt,ll) !downdraft is below updraft + w_upi(ipt,ll) = ud_mf(ipt,ll)*toi(l)*rgas / & + & (dt*max(cf_upi(ipt,ll),1.e-12)*prsl(ipt,ll)) + endif + + if (ntr > 0) then + do n=1,ntr + ccin(ipt,ll,n+2) = uvi(l,n) ! Tracers + enddo + endif + enddo + if (advcld) then + do l=1,k + ll = kp1 - l + ccin(ipt,ll,1) = qii(l) ! Cloud ice + ccin(ipt,ll,2) = qli(l) ! Cloud water + enddo + else + do l=1,k + ll = kp1 - l + ccin(ipt,ll,1) = ccin(ipt,ll,1) + cli(l) + ccin(ipt,ll,2) = ccin(ipt,ll,2) + clw(l) + enddo + endif +! + ktop(ipt) = kp1 - ktop(ipt) + kbot(ipt) = kp1 - kbot(ipt) +! + else + + do l=1,k + tin(ipt,l) = toi(l) ! Temperature + qin(ipt,l) = qoi(l) ! Specific humidity + uin(ipt,l) = uvi(l,ntr+1) ! U momentum + vin(ipt,l) = uvi(l,ntr+2) ! V momentum + +!! for 2M microphysics, always output these variables + if (mp_phys == 10) then + if (advcld) then + QLCN(ipt,l) = max(qli(l)-ccin(ipt,l,2), zero) + QICN(ipt,l) = max(qii(l)-ccin(ipt,l,1), zero) + CNV_FICE(ipt,l) = QICN(ipt,l) & + & / max(1.e-10,QLCN(ipt,l)+QICN(ipt,l)) + else + QLCN(ipt,l) = qli(l) + QICN(ipt,l) = qii(l) + CNV_FICE(ipt,l) = qii(l)/max(1.e-10,qii(l)+qli(l)) + endif +!! CNV_PRC3(ipt,l) = PCU(l)/dt +! CNV_PRC3(ipt,l) = zero +! if(PCU(l) < zero) write(*,*)"AAA777",PCU(l),ipt,l + cf_upi(ipt,l) = max(zero,min(0.02*log(one+ & + & 500*ud_mf(ipt,l)/dt), cfmax)) +! & 500*ud_mf(ipt,l)/dt), 0.60)) + CLCN(ipt,l) = cf_upi(ipt,l) !downdraft is below updraft + w_upi(ipt,l) = ud_mf(ipt,l)*toi(l)*rgas / & + & (dt*max(cf_upi(ipt,l),1.e-12)*prsl(ipt,l)) + endif + + if (ntr > 0) then + do n=1,ntr + ccin(ipt,l,n+2) = uvi(l,n) ! Tracers + enddo + endif + enddo + if (advcld) then + do l=1,k + ccin(ipt,l,1) = qii(l) ! Cloud ice + ccin(ipt,l,2) = qli(l) ! Cloud water + enddo + else + do l=1,k + ccin(ipt,l,1) = ccin(ipt,l,1) + cli(l) + ccin(ipt,l,2) = ccin(ipt,l,2) + clw(l) + enddo + endif + endif +! +! Velocity scale from the downdraft! +! + DDVEL(ipt) = DDVEL(ipt) * DDFAC * GRAV / (prs(KP1)-prs(K)) +! + ENDDO ! End of the IPT Loop! + + deallocate (alfint, uvi, trcfac, rcu) +! + RETURN + end subroutine rascnv_run + SUBROUTINE CLOUD( & + & K, KP1, KD, NTRC, KBLMX, kblmn & + &, FRACBL, MAX_NEG_BOUY, vsmooth, do_aw & + &, REVAP, WRKFUN, CALKBL, CRTFUN & + &, DT, KDT, TLA, DPD & + &, ALFINT, RHFACL, RHFACS, area, ccwf, cd, trcfac & + &, alfind, rhc_ls, phil, phih, prs, prsm, sgcs & + &, TOI, QOI, ROI, QLI, QII, KPBL, DSFC & + &, TCU, QCU, RCU, PCU, FLX, FLXD, CUP, WFNC,fscav_ & + &, trcmin, ntk, c0, qw0, c0i, qi0, dlq_fac) +! &, ctei) + +! +!*********************************************************************** +!******************** Relaxed Arakawa-Schubert ************************ +!****************** Plug Compatible Scalar Version ********************* +!************************ SUBROUTINE CLOUD **************************** +!************************ October 2004 **************************** +!******************** VERSION 2.0 (modified) ************************* +!************* Shrinivas.Moorthi@noaa.gov (301) 683-3718 ***** ******** +!*********************************************************************** +!*References: +!----------- +! NOAA Technical Report NWS/NCEP 99-01: +! Documentation of Version 2 of Relaxed-Arakawa-Schubert +! Cumulus Parameterization with Convective Downdrafts, June 1999. +! by S. Moorthi and M. J. Suarez. +! +! Relaxed Arakawa-Schubert Cumulus Parameterization (Version 2) +! with Convective Downdrafts - Unpublished Manuscript (2002) +! by Shrinivas Moorthi and Max J. Suarez. +! +!*********************************************************************** +! +!===> UPDATES CLOUD TENDENCIES DUE TO A SINGLE CLOUD +!===> DETRAINING AT LEVEL KD. +! +!*********************************************************************** +! +!===> TOI(K) INOUT TEMPERATURE KELVIN +!===> QOI(K) INOUT SPECIFIC HUMIDITY NON-DIMENSIONAL +!===> ROI(K,NTRC)INOUT TRACER ARBITRARY +!===> QLI(K) INOUT LIQUID WATER NON-DIMENSIONAL +!===> QII(K) INOUT ICE NON-DIMENSIONAL + +!===> PRS(KP1) INPUT PRESSURE @ EDGES MB +!===> PRSM(K) INPUT PRESSURE @ LAYERS MB +!===> SGCS(K) INPUT Local sigma +!===> PHIH(KP1) INPUT GEOPOTENTIAL @ EDGES IN MKS units +!===> PHIL(K) INPUT GEOPOTENTIAL @ LAYERS IN MKS units +!===> PRJ(KP1) INPUT (P/P0)^KAPPA @ EDGES NON-DIMENSIONAL +!===> PRJM(K) INPUT (P/P0)^KAPPA @ LAYERS NON-DIMENSIONAL + +!===> K INPUT THE RISE & THE INDEX OF THE SUBCLOUD LAYER +!===> KD INPUT DETRAINMENT LEVEL ( 1<= KD < K ) +!===> NTRC INPUT NUMBER OF TRACERS. MAY BE ZERO. +!===> kblmx INPUT highest level the pbl can take +!===> kblmn INPUT lowest level the pbl can take +!===> DPD INPUT Critical normalized pressure (i.e. sigma) at the cloud top +! No downdraft calculation if the cloud top pressure is higher +! than DPD*PRS(KP1) +! +!===> TCU(K ) UPDATE TEMPERATURE TENDENCY DEG +!===> QCU(K ) UPDATE WATER VAPOR TENDENCY (G/G) +!===> RCU(K,NTRC)UPDATE TRACER TENDENCIES ND +!===> PCU(K) UPDATE PRECIP @ BASE OF LAYER KG/M^2 +!===> FLX(K ) UPDATE MASS FLUX @ TOP OF LAYER KG/M^2 +!===> CUP UPDATE PRECIPITATION AT THE SURFACE KG/M^2 +! + IMPLICIT NONE +! + real (kind=kind_phys), parameter :: RHMAX=1.0 & ! MAX RELATIVE HUMIDITY + &, QUAD_LAM=1.0 & ! MASK FOR QUADRATIC LAMBDA + &, RHRAM=0.05 & ! PBL RELATIVE HUMIDITY RAMP +! &, RHRAM=0.15 !& ! PBL RELATIVE HUMIDITY RAMP + &, HCRITD=4000.0 & ! Critical Moist Static Energy for Deep clouds + &, HCRITS=2000.0 & ! Critical Moist Static Energy for Shallow clouds + &, pcrit_lcl=250.0 & ! Critical pressure difference between boundary layer top + ! layer top and lifting condensation level (hPa) +! &, hpert_fac=1.01 !& ! Perturbation on hbl when ctei=.true. +! &, hpert_fac=1.005 !& ! Perturbation on hbl when ctei=.true. + &, qudfac=quad_lam*half & + &, shalfac=3.0 & +! &, qudfac=quad_lam*pt25, shalfac=3.0 !& ! Yogesh's + &, c0ifac=0.07 & ! following Han et al, 2016 MWR + &, dpnegcr = 150.0 +! &, dpnegcr = 100.0 +! &, dpnegcr = 200.0 +! + real(kind=kind_phys), parameter :: ERRMIN=0.0001 & + &, ERRMI2=0.1*ERRMIN & +! &, rainmin=1.0e-9 !& + &, rainmin=1.0e-8 & + &, oneopt9=1.0/0.09 & + &, oneopt4=1.0/0.04 + real(kind=kind_phys), parameter :: almax=1.0e-2 & + &, almin1=0.0, almin2=0.0 + real(kind=kind_phys), parameter :: bldmax = 300.0, bldmin=25.0 +! +! INPUT ARGUMENTS + +! LOGICAL REVAP, WRKFUN, CALKBL, CRTFUN, CALCUP, ctei + LOGICAL REVAP, WRKFUN, CALKBL, CRTFUN, CALCUP + logical vsmooth, do_aw + INTEGER K, KP1, KD, NTRC, kblmx, kblmn, ntk + + + real(kind=kind_phys), dimension(K) :: TOI, QOI, PRSM, QLI, QII& + &, PHIL, SGCS, rhc_ls & + &, alfind + real(kind=kind_phys), dimension(KP1) :: PRS, PHIH + real(kind=kind_phys), dimension(K,NTRC) :: ROI, trcfac + real(kind=kind_phys), dimension(ntrc) :: trcmin + real(kind=kind_phys) :: CD, DSFC + INTEGER :: KPBL, KBL, KB1, kdt + + real(kind=kind_phys) ALFINT(K,NTRC+4) + real(kind=kind_phys) FRACBL, MAX_NEG_BOUY, DPD & + &, RHFACL, RHFACS, area, ccwf & + &, c0, qw0, c0i, qi0, dlq_fac + +! UPDATE ARGUMENTS + + real(kind=kind_phys), dimension(K) :: TCU, QCU, TCD, QCD, PCU + real(kind=kind_phys), dimension(KP1) :: FLX, FLXD + real(kind=kind_phys), dimension(K,NTRC) :: RCU + real(kind=kind_phys) :: CUP +! +! TEMPORARY WORK SPACE + + real(kind=kind_phys), dimension(KD:K) :: HOL, QOL, HST, QST & + &, TOL, GMH, AKT, AKC, BKC, LTL, RNN & + &, FCO, PRI, QIL, QLL, ZET, XI, RNS & + &, Q0U, Q0D, vtf, CIL, CLL, ETAI, dlq & + &, wrk1, wrk2, dhdp, qrb, qrt, evp & + &, ghd, gsd, etz, cldfr, sigf, rho + + real(kind=kind_phys), dimension(KD:KP1) :: GAF, GMS, GAM, DLB & + &, DLT, ETA, PRL, BUY, ETD, HOD, QOD, wvl + real(kind=kind_phys), dimension(KD:K-1) :: etzi + + real(kind=kind_phys) fscav_(ntrc) + + LOGICAL ep_wfn, cnvflg, LOWEST, DDFT, UPDRET + + real(kind=kind_phys) ALM, DET, HCC, CLP & + &, HSU, HSD, QTL, QTV & + &, AKM, WFN, HOS, QOS & + &, AMB, TX1, TX2, TX3 & + &, TX4, TX5, QIS, QLS & + &, HBL, QBL, RBL(NTRC), wcbase & + &, QLB, QIB, PRIS & + &, WFNC, TX6, ACR & + &, TX7, TX8, TX9, RHC & + &, hstkd, qstkd, ltlkd, q0ukd, q0dkd, dlbkd & + &, qtp, qw00, qi00, qrbkd & + &, hstold, rel_fac, prism & + &, TL, PL, QL, QS, DQS, ST1, SGN, TAU, & + & QTVP, HB, QB, TB, QQQ, & + & HCCP, DS, DH, AMBMAX, X00, EPP, QTLP, & + & DPI, DPHIB, DPHIT, DEL_ETA, DETP, & + & TEM, TEM1, TEM2, TEM3, TEM4, & + & ST2, ST3, ST4, ST5, & + & ERRH, ERRW, ERRE, TEM5, & + & TEM6, HBD, QBD, st1s, shal_fac, hmax, hmin, & + & dhdpmn, avt, avq, avr, avh & + &, TRAIN, DOF, CLDFRD, tla, gmf & + &, FAC, RSUM1, RSUM2, RSUM3, dpneg, hcrit & + &, ACTEVAP,AREARAT,DELTAQ,MASS,MASSINV,POTEVAP & + &, TEQ,QSTEQ,DQDT,QEQ & + &, CLFRAC, DT, clvfr, delzkm, fnoscav, delp +! &, CLFRAC, DT, clf, clvfr, delzkm, fnoscav, delp +! &, almin1, almin2 + + INTEGER I, L, N, KD1, II, iwk, idh, lcon & + &, IT, KM1, KTEM, KK, KK1, LM1, LL, LP1, kbls, kmxh & + &, kblh, kblm, kblpmn, kmax, kmaxm1, kmaxp1, klcl, kmin, kmxb +! +!*********************************************************************** +! +! almin2 = 0.2 * sqrt(pi/area) +! almin1 = almin2 + + KM1 = K - 1 + KD1 = KD + 1 + + do l=1,K + tcd(L) = zero + qcd(L) = zero + enddo +! + CLDFRD = zero + DOF = zero + PRL(KP1) = PRS(KP1) +! + DO L=KD,K + RNN(L) = zero + ZET(L) = zero + XI(L) = zero +! + TOL(L) = TOI(L) + QOL(L) = QOI(L) + PRL(L) = PRS(L) + CLL(L) = QLI(L) + CIL(L) = QII(L) + BUY(L) = zero + + wvl(l) = zero + ENDDO + wvl(kp1) = zero +! + if (vsmooth) then + do l=kd,k + wrk1(l) = tol(l) + wrk2(l) = qol(l) + enddo + do l=kd1,km1 + tol(l) = pt25*wrk1(l-1) + half*wrk1(l) + pt25*wrk1(l+1) + qol(l) = pt25*wrk2(l-1) + half*wrk2(l) + pt25*wrk2(l+1) + enddo + endif +! + DO L=KD, K + DPI = ONE / (PRL(L+1) - PRL(L)) + PRI(L) = GRAVFAC * DPI +! + PL = PRSM(L) + TL = TOL(L) + + rho(l) = cmb2pa * pl / (rgas*tl*(one+nu*qol(l))) + + AKT(L) = (PRL(L+1) - PL) * DPI +! + CALL QSATCN(TL, PL, QS, DQS) +! + QST(L) = QS + GAM(L) = DQS * ELOCP + ST1 = ONE + GAM(L) + GAF(L) = ONEOALHL * GAM(L) / ST1 + + QL = MAX(MIN(QS*RHMAX,QOL(L)), ONE_M10) + QOL(L) = QL + + TEM = CP * TL + LTL(L) = TEM * ST1 / (ONE+NU*(QST(L)+TL*DQS)) + vtf(L) = one + NU * QL + ETA(L) = ONE / (LTL(L) * VTF(L)) + + HOL(L) = TEM + QL * ALHL + HST(L) = TEM + QS * ALHL +! + ENDDO +! + ETA(KP1) = ZERO + GMS(K) = ZERO +! + AKT(KD) = HALF + GMS(KD) = ZERO +! + CLP = ZERO +! + GAM(KP1) = GAM(K) + GAF(KP1) = GAF(K) +! + DO L=K,KD1,-1 + DPHIB = PHIL(L) - PHIH(L+1) + DPHIT = PHIH(L) - PHIL(L) +! + DLB(L) = DPHIB * ETA(L) ! here eta contains 1/(L*(1+nu*q)) + DLT(L) = DPHIT * ETA(L) +! + QRB(L) = DPHIB + QRT(L) = DPHIT +! + ETA(L) = ETA(L+1) + DPHIB + + HOL(L) = HOL(L) + ETA(L) + hstold = hst(l) + HST(L) = HST(L) + ETA(L) +! + ETA(L) = ETA(L) + DPHIT + ENDDO +! +! For the cloud top layer +! + L = KD + + DPHIB = PHIL(L) - PHIH(L+1) +! + DLB(L) = DPHIB * ETA(L) +! + QRB(L) = DPHIB + QRT(L) = DPHIB +! + ETA(L) = ETA(L+1) + DPHIB + + HOL(L) = HOL(L) + ETA(L) + HST(L) = HST(L) + ETA(L) +! +! To determine KBL internally -- If KBL is defined externally +! the following two loop should be skipped +! + hcrit = hcritd + if (sgcs(kd) > 0.65) hcrit = hcrits + IF (CALKBL) THEN + KTEM = MAX(KD+1, KBLMX) + hmin = hol(k) + kmin = k + do l=km1,kd,-1 + if (hmin > hol(l)) then + hmin = hol(l) + kmin = l + endif + enddo + if (kmin == k) return + hmax = hol(k) + kmax = k + do l=km1,ktem,-1 + if (hmax < hol(l)) then + hmax = hol(l) + kmax = l + endif + enddo + kmxb = kmax + if (kmax < kmin) then + kmax = k + kmxb = k + hmax = hol(kmax) + elseif (kmax < k) then + do l=kmax+1,k + if (abs(hol(kmax)-hol(l)) > half * hcrit) then + kmxb = l - 1 + exit + endif + enddo + endif + kmaxm1 = kmax - 1 + kmaxp1 = kmax + 1 + kblpmn = kmax +! + dhdp(kmax:k) = zero + dhdpmn = dhdp(kmax) + do l=kmaxm1,ktem,-1 + dhdp(l) = (HOL(L)-HOL(L+1)) / (PRL(L+2)-PRL(L)) + if (dhdp(l) < dhdpmn) then + dhdpmn = dhdp(l) + kblpmn = l + 1 + elseif (dhdp(l) > zero .and. l <= kmin) then + exit + endif + enddo + kbl = kmax + if (kblpmn < kmax) then + do l=kblpmn,kmaxm1 + if (hmax-hol(l) < half*hcrit) then + kbl = l + exit + endif + enddo + endif + +! + klcl = kd1 + if (kmax > kd1) then + do l=kmaxm1,kd1,-1 + if (hmax > hst(l)) then + klcl = l+1 + exit + endif + enddo + endif +! if (klcl == kd .or. klcl < ktem) return + +! This is to handle mid-level convection from quasi-uniform h + + if (kmax < kmxb) then + kmax = max(kd1, min(kmxb,k)) + kmaxm1 = kmax - 1 + kmaxp1 = kmax + 1 + endif + + +! if (prl(Kmaxp1) - prl(klcl) > 250.0 ) return + + ii = max(kbl,kd1) + kbl = max(klcl,kd1) + tem = min(50.0,max(10.0,(prl(kmaxp1)-prl(kd))*0.10)) + if (prl(kmaxp1) - prl(ii) > tem .and. ii > kbl) kbl = ii + + + if (kbl .ne. ii) then + if (PRL(kmaxp1)-PRL(KBL) > bldmax) kbl = max(kbl,ii) + endif + if (kbl < ii) then + if (hol(ii)-hol(ii-1) > half*hcrit) kbl = ii + endif + + if (prl(kbl) - prl(klcl) > pcrit_lcl) return +! +! KBL = min(kmax, MAX(KBL,KBLMX)) + KBL = min(kblmn, MAX(KBL,KBLMX)) +! kbl = min(kblh,kbl) +!!! +! tem1 = max(prl(kP1)-prl(k), & +! & min((prl(kbl) - prl(kd))*0.05, 10.0)) +!! & min((prl(kbl) - prl(kd))*0.05, 20.0)) +!! & min((prl(kbl) - prl(kd))*0.05, 30.0)) +! if (prl(kp1)-prl(kbl) < tem1) then +! KTEM = MAX(KD+1, KBLMX) +! do l=k,KTEM,-1 +! tem = prl(kp1) - prl(l) +! if (tem > tem1) then +! kbl = min(kbl,l) +! exit +! endif +! enddo +! endif +! if (kbl == kblmx .and. kmax >= km1) kbl = k - 1 +!!! + + KPBL = KBL + + ELSE + KBL = KPBL + ENDIF +! + KBL = min(kmax,MAX(KBL,KD+2)) + KB1 = KBL - 1 +!! + + if (PRL(Kmaxp1)-PRL(KBL) > bldmax .or. kb1 <= kd ) then +! & .or. PRL(Kmaxp1)-PRL(KBL) < bldmin) then + return + endif +! +! + PRIS = ONE / (PRL(KP1)-PRL(KBL)) + PRISM = ONE / (PRL(Kmaxp1)-PRL(KBL)) + TX1 = ETA(KBL) ! geopotential height at KBL +! + GMS(KBL) = zero + XI(KBL) = zero + ZET(KBL) = zero +! + shal_fac = one +! if (prl(kbl)-prl(kd) < 300.0 .and. kmax == k) shal_fac = shalfac + if (prl(kbl)-prl(kd) < 350.0 .and. kmax == k) shal_fac = shalfac + DO L=Kmax,KD,-1 + IF (L >= KBL) THEN + ETA(L) = (PRL(Kmaxp1)-PRL(L)) * PRISM + ELSE + ZET(L) = (ETA(L) - TX1) * ONEBG + XI(L) = ZET(L) * ZET(L) * (QUDFAC*shal_fac) + ETA(L) = ZET(L) - ZET(L+1) + GMS(L) = XI(L) - XI(L+1) + ENDIF + ENDDO + if (kmax < k) then + do l=kmaxp1,kp1 + eta(l) = zero + enddo + endif +! + HBL = HOL(Kmax) * ETA(Kmax) + QBL = QOL(Kmax) * ETA(Kmax) + QLB = CLL(Kmax) * ETA(Kmax) + QIB = CIL(Kmax) * ETA(Kmax) + TX1 = QST(Kmax) * ETA(Kmax) +! + DO L=Kmaxm1,KBL,-1 + TEM = ETA(L) - ETA(L+1) + HBL = HBL + HOL(L) * TEM + QBL = QBL + QOL(L) * TEM + QLB = QLB + CLL(L) * TEM + QIB = QIB + CIL(L) * TEM + TX1 = TX1 + QST(L) * TEM + ENDDO + +! if (ctei .and. sgcs(kd) > 0.65) then +! hbl = hbl * hpert_fac +! qbl = qbl * hpert_fac +! endif + +! Find Min value of HOL in TX2 + TX2 = HOL(KD) + IDH = KD1 + DO L=KD1,KB1 + IF (HOL(L) < TX2) THEN + TX2 = HOL(L) + IDH = L ! Level of minimum moist static energy! + ENDIF + ENDDO + IDH = 1 +! IDH = MAX(KD1, IDH) + IDH = MAX(KD, IDH) ! Moorthi May, 31, 2019 +! + TEM1 = HBL - HOL(KD) + TEM = HBL - HST(KD1) - LTL(KD1) * NU *(QOL(KD1)-QST(KD1)) + LOWEST = KD == KB1 + + lcon = kd + do l=kb1,kd1,-1 + if (hbl >= hst(l)) then + lcon = l + exit + endif + enddo +! + if (lcon == kd .or. kbl <= kd .or. prl(kbl)-prsm(lcon) > 150.0) & + & return +! + TX1 = RHFACS - QBL / TX1 ! Average RH + + cnvflg = (TEM > ZERO .OR. (LOWEST .AND. TEM1 >= ZERO)) & + & .AND. TX1 < RHRAM + + IF (.NOT. cnvflg) RETURN +! + RHC = MAX(ZERO, MIN(ONE, EXP(-20.0*TX1) )) +! + wcbase = 0.1 + if (ntrc > 0) then + DO N=1,NTRC + RBL(N) = ROI(Kmax,N) * ETA(Kmax) + ENDDO + DO N=1,NTRC + DO L=KmaxM1,KBL,-1 + RBL(N) = RBL(N) + ROI(L,N)*(ETA(L)-ETA(L+1)) + ENDDO + ENDDO +! +! if (ntk > 0 .and. do_aw) then + if (ntk > 0) then + if (rbl(ntk) > 0.0) then + wcbase = min(2.0, max(wcbase, sqrt(twoo3*rbl(ntk)))) +! wcbase = min(1.0, max(wcbase, sqrt(twoo3*rbl(ntk)))) + endif + endif + + endif +! + TX4 = zero + TX5 = zero +! + TX3 = QST(KBL) - GAF(KBL) * HST(KBL) + DO L=KBL,K + QIL(L) = MAX(ZERO, MIN(ONE, (TCR-TCL-TOL(L))*TCRF)) + ENDDO +! + DO L=KB1,KD1,-1 + lp1 = l + 1 + TEM = QST(L) - GAF(L) * HST(L) + TEM1 = (TX3 + TEM) * half + ST2 = (GAF(L)+GAF(LP1)) * half +! + FCO(LP1) = TEM1 + ST2 * HBL + + RNN(LP1) = ZET(LP1) * TEM1 + ST2 * TX4 + GMH(LP1) = XI(LP1) * TEM1 + ST2 * TX5 +! + TX3 = TEM + TX4 = TX4 + ETA(L) * HOL(L) + TX5 = TX5 + GMS(L) * HOL(L) +! + QIL(L) = MAX(ZERO, MIN(ONE, (TCR-TCL-TOL(L))*TCRF)) + QLL(LP1) = (half*ALHF) * ST2 * (QIL(L)+QIL(LP1)) + ONE + ENDDO +! +! FOR THE CLOUD TOP -- L=KD +! + L = KD +! + lp1 = l + 1 + TEM = QST(L) - GAF(L) * HST(L) + TEM1 = (TX3 + TEM) * half + ST2 = (GAF(L)+GAF(LP1)) * half +! + FCO(LP1) = TEM1 + ST2 * HBL + RNN(LP1) = ZET(LP1) * TEM1 + ST2 * TX4 + GMH(LP1) = XI(LP1) * TEM1 + ST2 * TX5 +! + FCO(L) = TEM + GAF(L) * HBL + RNN(L) = TEM * ZET(L) + (TX4 + ETA(L)*HOL(L)) * GAF(L) + GMH(L) = TEM * XI(L) + (TX5 + GMS(L)*HOL(L)) * GAF(L) +! +! Replace FCO for the Bottom +! + FCO(KBL) = QBL + RNN(KBL) = zero + GMH(KBL) = zero +! + QIL(KD) = MAX(ZERO, MIN(ONE, (TCR-TCL-TOL(KD))*TCRF)) + QLL(KD1) = (half*ALHF) * ST2 * (QIL(KD) + QIL(KD1)) + ONE + QLL(KD ) = ALHF * GAF(KD) * QIL(KD) + ONE +! + st1 = qil(kd) + st2 = c0i * st1 * exp(c0ifac*min(tol(kd)-t0c,0.0)) + tem = c0 * (one-st1) + tem2 = st2*qi0 + tem*qw0 +! + DO L=KD,KB1 + lp1 = l + 1 + tx2 = akt(l) * eta(l) + tx1 = tx2 * tem2 + q0u(l) = tx1 + FCO(L) = FCO(LP1) - FCO(L) + tx1 + RNN(L) = RNN(LP1) - RNN(L) & + & + ETA(L)*(QOL(L)+CLL(L)+CIL(L)) + tx1*zet(l) + GMH(L) = GMH(LP1) - GMH(L) & + & + GMS(L)*(QOL(L)+CLL(L)+CIL(L)) + tx1*xi(l) +! + tem1 = (one-akt(l)) * eta(l) + + AKT(L) = QLL(L) + (st2 + tem) * tx2 + + AKC(L) = one / AKT(L) +! + st1 = half * (qil(l)+qil(lp1)) + st2 = c0i * st1 * exp(c0ifac*min(tol(lp1)-t0c,0.0)) + tem = c0 * (one-st1) + tem2 = st2*qi0 + tem*qw0 +! + BKC(L) = QLL(LP1) - (st2 + tem) * tem1 +! + tx1 = tem1*tem2 + q0d(l) = tx1 + FCO(L) = FCO(L) + tx1 + RNN(L) = RNN(L) + tx1*zet(lp1) + GMH(L) = GMH(L) + tx1*xi(lp1) + ENDDO + + qw00 = qw0 + qi00 = qi0 + ii = 0 + 777 continue +! + ep_wfn = .false. + RNN(KBL) = zero + TX3 = bkc(kb1) * (QIB + QLB) + TX4 = zero + TX5 = zero + DO L=KB1,KD1,-1 + TEM = BKC(L-1) * AKC(L) + TX3 = (TX3 + FCO(L)) * TEM + TX4 = (TX4 + RNN(L)) * TEM + TX5 = (TX5 + GMH(L)) * TEM + ENDDO + IF (KD < KB1) THEN + HSD = HST(KD1) + LTL(KD1) * NU *(QOL(KD1)-QST(KD1)) + ELSE + HSD = HBL + ENDIF +! + TX3 = (TX3 + FCO(KD)) * AKC(KD) + TX4 = (TX4 + RNN(KD)) * AKC(KD) + TX5 = (TX5 + GMH(KD)) * AKC(KD) + ALM = ALHF*QIL(KD) - LTL(KD) * VTF(KD) +! + HSU = HST(KD) + LTL(KD) * NU * (QOL(KD)-QST(KD)) + +! +!===> VERTICAL INTEGRALS NEEDED TO COMPUTE THE ENTRAINMENT PARAMETER +! + TX1 = ALM * TX4 + TX2 = ALM * TX5 + + DO L=KD,KB1 + TAU = HOL(L) - HSU + TX1 = TX1 + TAU * ETA(L) + TX2 = TX2 + TAU * GMS(L) + ENDDO +! +! MODIFY HSU TO INCLUDE CLOUD LIQUID WATER AND ICE TERMS +! + HSU = HSU - ALM * TX3 +! + CLP = ZERO + ALM = -100.0 + HOS = HOL(KD) + QOS = QOL(KD) + QIS = CIL(KD) + QLS = CLL(KD) + + cnvflg = HBL > HSU .and. abs(tx1) > 1.0e-4 + +!*********************************************************************** + + ST1 = HALF*(HSU + HSD) + + IF (cnvflg) THEN +! +! STANDARD CASE: +! CLOUD CAN BE NEUTRALLY BOUYANT AT MIDDLE OF LEVEL KD W/ +VE LAMBDA. +! EPP < .25 IS REQUIRED TO HAVE REAL ROOTS. +! + clp = one + st2 = hbl - hsu + + if (tx2 == zero) then + alm = - st2 / tx1 + if (alm > almax) alm = -100.0 + else + x00 = tx2 + tx2 + epp = tx1 * tx1 - (x00+x00)*st2 + if (epp > zero) then + x00 = one / x00 + tem = sqrt(epp) + tem1 = (-tx1-tem)*x00 + tem2 = (-tx1+tem)*x00 + if (tem1 > almax) tem1 = -100.0 + if (tem2 > almax) tem2 = -100.0 + alm = max(tem1,tem2) + + endif + endif + +! +! CLIP CASE: +! NON-ENTRAINIG CLOUD DETRAINS IN LOWER HALF OF TOP LAYER. +! NO CLOUDS ARE ALLOWED TO DETRAIN BELOW THE TOP LAYER. +! + ELSEIF (HBL <= HSU .AND. HBL > ST1) THEN + ALM = ZERO +! CLP = (HBL-ST1) / (HSU-ST1) ! commented on Jan 16, 2010 + ENDIF +! + cnvflg = .TRUE. + IF (ALMIN1 > zero) THEN + IF (ALM >= ALMIN1) cnvflg = .FALSE. + ELSE + LOWEST = KD == KB1 + IF ( (ALM > ZERO) .OR. & + & (.NOT. LOWEST .AND. ALM == ZERO) ) cnvflg = .FALSE. + ENDIF +! +!===> IF NO SOUNDING MEETS SECOND CONDITION, RETURN +! + IF (cnvflg) THEN + IF (ii > 0 .or. (qw00 == zero .and. qi00 == zero)) RETURN + CLP = one + ep_wfn = .true. + GO TO 888 + ENDIF +! + st1s = ONE + IF(CLP > ZERO .AND. CLP < ONE) THEN + ST1 = HALF*(ONE+CLP) + ST2 = ONE - ST1 + st1s = st1 + hstkd = hst(kd) + qstkd = qst(kd) + ltlkd = ltl(kd) + q0ukd = q0u(kd) + q0dkd = q0d(kd) + dlbkd = dlb(kd) + qrbkd = qrb(kd) +! + HST(KD) = HST(KD)*ST1 + HST(KD1)*ST2 + HOS = HOL(KD)*ST1 + HOL(KD1)*ST2 + QST(KD) = QST(KD)*ST1 + QST(KD1)*ST2 + QOS = QOL(KD)*ST1 + QOL(KD1)*ST2 + QLS = CLL(KD)*ST1 + CLL(KD1)*ST2 + QIS = CIL(KD)*ST1 + CIL(KD1)*ST2 + LTL(KD) = LTL(KD)*ST1 + LTL(KD1)*ST2 +! + DLB(KD) = DLB(KD)*CLP + qrb(KD) = qrb(KD)*CLP + ETA(KD) = ETA(KD)*CLP + GMS(KD) = GMS(KD)*CLP + Q0U(KD) = Q0U(KD)*CLP + Q0D(KD) = Q0D(KD)*CLP + ENDIF +! +! +!*********************************************************************** +! +! Critical workfunction is included in this version +! + ACR = zero + TEM = PRL(KD1) - (PRL(KD1)-PRL(KD)) * CLP * HALF + tx1 = PRL(KBL) - TEM + tx2 = min(900.0, max(tx1,100.0)) + tem1 = log(tx2*0.01) * oneolog10 + tem2 = one - tem1 + if ( kdt == 1 ) then +! rel_fac = (dt * facdt) / (tem1*12.0 + tem2*3.0) + rel_fac = (dt * facdt) / (tem1*6.0 + tem2*adjts_s) + else + rel_fac = (dt * facdt) / (tem1*adjts_d + tem2*adjts_s) + endif +! +! rel_fac = max(zero, min(one,rel_fac)) + rel_fac = max(zero, min(half,rel_fac)) + + IF (CRTFUN) THEN + iwk = tem*0.02-0.999999999 + iwk = MAX(1, MIN(iwk, 16)) + ACR = tx1 * (AC(iwk) + tem * AD(iwk)) * CCWF + ENDIF +! +!===> NORMALIZED MASSFLUX +! +! ETA IS THE THICKNESS COMING IN AND normalized MASS FLUX GOING OUT. +! GMS IS THE THICKNESS SQUARE ; IT IS LATER REUSED FOR GAMMA_S +! +! ETA(K) = ONE + + DO L=KB1,KD,-1 + ETA(L) = ETA(L+1) + ALM * (ETA(L) + ALM * GMS(L)) + ETAI(L) = one / ETA(L) + ENDDO + ETAI(KBL) = one + +! +!===> CLOUD WORKFUNCTION +! + WFN = ZERO + AKM = ZERO + DET = ZERO + HCC = HBL + cnvflg = .FALSE. + QTL = QST(KB1) - GAF(KB1)*HST(KB1) + TX1 = HBL +! + qtv = qbl + det = qlb + qib +! + tx2 = zero + dpneg = zero +! + DO L=KB1,KD1,-1 + lm1 = l - 1 + lp1 = l + 1 + DEL_ETA = ETA(L) - ETA(LP1) + HCCP = HCC + DEL_ETA*HOL(L) +! + QTLP = QST(LM1) - GAF(LM1)*HST(LM1) + QTVP = half * ((QTLP+QTL)*ETA(L) & + & + (GAF(L)+GAF(LM1))*HCCP) + ST1 = ETA(L)*Q0U(L) + ETA(LP1)*Q0D(L) + DETP = (BKC(L)*DET - (QTVP-QTV) & + & + DEL_ETA*(QOL(L)+CLL(L)+CIL(L)) + ST1) * AKC(L) + + TEM1 = AKT(L) - QLL(L) + TEM2 = QLL(LP1) - BKC(L) + RNS(L) = TEM1*DETP + TEM2*DET - ST1 + + qtp = half * (qil(L)+qil(LM1)) + tem2 = min(qtp*(detp-eta(l)*qw00), & + & (one-qtp)*(detp-eta(l)*qi00)) + st1 = min(tx2,tem2) + tx2 = tem2 +! + IF (rns(l) < zero .or. st1 < zero) ep_wfn = .TRUE. + IF (DETP <= ZERO) cnvflg = .TRUE. + + ST1 = HST(L) - LTL(L)*NU*(QST(L)-QOL(L)) + + + TEM2 = HCCP + DETP * QTP * ALHF +! + ST2 = LTL(L) * VTF(L) + TEM5 = CLL(L) + CIL(L) + TEM3 = (TX1 - ETA(LP1)*ST1 - ST2*(DET-TEM5*eta(lp1))) * DLB(L) + TEM4 = (TEM2 - ETA(L )*ST1 - ST2*(DETP-TEM5*eta(l))) * DLT(L) +! + ST1 = TEM3 + TEM4 + + WFN = WFN + ST1 + AKM = AKM - min(ST1,ZERO) + + if (st1 < zero .and. wfn < zero) then + dpneg = dpneg + prl(lp1) - prl(l) + endif + + BUY(L) = half * (tem3/(eta(lp1)*qrb(l)) + tem4/(eta(l)*qrt(l))) +! + HCC = HCCP + DET = DETP + QTL = QTLP + QTV = QTVP + TX1 = TEM2 + + ENDDO + + DEL_ETA = ETA(KD) - ETA(KD1) + HCCP = HCC + DEL_ETA*HOS +! + QTLP = QST(KD) - GAF(KD)*HST(KD) + QTVP = QTLP*ETA(KD) + GAF(KD)*HCCP + ST1 = ETA(KD)*Q0U(KD) + ETA(KD1)*Q0D(KD) + DETP = (BKC(KD)*DET - (QTVP-QTV) & + & + DEL_ETA*(QOS+QLS+QIS) + ST1) * AKC(KD) +! + TEM1 = AKT(KD) - QLL(KD) + TEM2 = QLL(KD1) - BKC(KD) + RNS(KD) = TEM1*DETP + TEM2*DET - ST1 +! + IF (rns(kd) < zero) ep_wfn = .TRUE. + IF (DETP <= ZERO) cnvflg = .TRUE. +! + 888 continue + + if (ep_wfn) then + IF ((qw00 == zero .and. qi00 == zero)) RETURN + if (ii == 0) then + ii = 1 + if (clp > zero .and. clp < one) then + hst(kd) = hstkd + qst(kd) = qstkd + ltl(kd) = ltlkd + q0u(kd) = q0ukd + q0d(kd) = q0dkd + dlb(kd) = dlbkd + qrb(kd) = qrbkd + endif + do l=kd,kb1 + lp1 = l + 1 + FCO(L) = FCO(L) - q0u(l) - q0d(l) + RNN(L) = RNN(L) - q0u(l)*zet(l) - q0d(l)*zet(lp1) + GMH(L) = GMH(L) - q0u(l)*xi(l) - q0d(l)*zet(lp1) + ETA(L) = ZET(L) - ZET(LP1) + GMS(L) = XI(L) - XI(LP1) + Q0U(L) = zero + Q0D(L) = zero + ENDDO + qw00 = zero + qi00 = zero + + go to 777 + else + cnvflg = .true. + endif + endif +! +! +! ST1 = 0.5 * (HST(KD) - LTL(KD)*NU*(QST(KD)-QOS) & +! & + HST(KD1) - LTL(KD1)*NU*(QST(KD1)-QOL(KD1))) +! + ST1 = HST(KD) - LTL(KD)*NU*(QST(KD)-QOS) + ST2 = LTL(KD) * VTF(KD) + TEM5 = (QLS + QIS) * eta(kd1) + ST1 = HALF * (TX1-ETA(KD1)*ST1-ST2*(DET-TEM5))*DLB(KD) +! + WFN = WFN + ST1 + AKM = AKM - min(ST1,ZERO) ! Commented on 08/26/02 - does not include top +! + + BUY(KD) = ST1 / (ETA(KD1)*qrb(kd)) +! + DET = DETP + HCC = HCCP + AKM = AKM / WFN + + +!*********************************************************************** +! + IF (WRKFUN) THEN ! If only to calculate workfunction save it and return + IF (WFN >= zero) WFNC = WFN + RETURN + ELSEIF (.NOT. CRTFUN) THEN + ACR = WFNC + ENDIF +! +!===> THIRD CHECK BASED ON CLOUD WORKFUNCTION +! + CALCUP = .FALSE. + + TEM = max(0.05, MIN(CD*200.0, MAX_NEG_BOUY)) + IF (.not. cnvflg .and. WFN > ACR .and. & + & dpneg < dpnegcr .and. AKM <= TEM) CALCUP = .TRUE. + +! +!===> IF NO SOUNDING MEETS THIRD CONDITION, RETURN +! + IF (.NOT. CALCUP) RETURN +! +! This is for not LL - 20050601 +! IF (ALMIN2 .NE. zero) THEN +! IF (ALMIN1 .NE. ALMIN2) ST1 = one / max(ONE_M10,(ALMIN2-ALMIN1)) +! IF (ALM < ALMIN2) THEN +! CLP = CLP * max(zero, min(one,(0.3 + 0.7*(ALM-ALMIN1)*ST1))) +!! CLP = CLP * max(0.0, min(1.0,(0.2 + 0.8*(ALM-ALMIN1)*ST1))) +!! CLP = CLP * max(0.0, min(1.0,(0.1 + 0.9*(ALM-ALMIN1)*ST1))) +! ENDIF +! ENDIF +! + CLP = CLP * RHC + dlq = zero + tem = one / (one + dlq_fac) + do l=kd,kb1 + rnn(l) = rns(l) * tem + dlq(l) = rns(l) * tem * dlq_fac + enddo + DO L=KBL,K + RNN(L) = zero + ENDDO +! +! If downdraft is to be invoked, do preliminary check to see +! if enough rain is available and then call DDRFT. +! + DDFT = .FALSE. + IF (dpd > zero) THEN + TRAIN = zero + IF (CLP > zero) THEN + DO L=KD,KB1 + TRAIN = TRAIN + RNN(L) + ENDDO + ENDIF + + PL = (PRL(KD1) + PRL(KD))*HALF + IF (TRAIN > 1.0E-4 .AND. PL <= dpd*prl(kp1)) DDFT = .TRUE. + ENDIF +! + IF (DDFT) THEN ! Downdraft scheme based on (Cheng and Arakawa, 1997) + CALL DDRFT( & + & K, KP1, KD & + &, TLA, ALFIND, wcbase & + &, TOL, QOL, HOL, PRL, QST, HST, GAM, GAF & +! &, TOL, QOL, HOL, PRL, QST, HST, GAM, GAF, HBL, QBL & + &, QRB, QRT, BUY, KBL, IDH, ETA, RNN, ETAI & + &, ALM, WFN, TRAIN, DDFT & + &, ETD, HOD, QOD, EVP, DOF, CLDFR, ETZ & + &, GMS, GSD, GHD, wvl) + + ENDIF +! +! No Downdraft case (including case with no downdraft solution) +! --------------------------------------------------------- +! + IF (.NOT. DDFT) THEN + DO L=KD,KP1 + ETD(L) = zero + HOD(L) = zero + QOD(L) = zero + wvl(l) = zero + ENDDO + DO L=KD,K + EVP(L) = zero + ETZ(L) = zero + ENDDO + + ENDIF + +! +!===> CALCULATE GAMMAS i.e. TENDENCIES PER UNIT CLOUD BASE MASSFLUX +! Includes downdraft terms! + + avh = zero + +! +! Fraction of detrained condensate evaporated +! +! tem1 = max(ZERO, min(HALF, (prl(kd)-FOUR_P2)*ONE_M2)) +! tem1 = max(ZERO, min(HALF, (prl(kd)-300.0)*0.005)) + tem1 = zero +! tem1 = 1.0 +! if (kd1 == kbl) tem1 = 0.0 +! + tem2 = one - tem1 + TEM = DET * QIL(KD) + + + st1 = (HCC+ALHF*TEM-ETA(KD)*HST(KD)) / (one+gam(KD)) + DS = ETA(KD1) * (HOS- HOL(KD)) - ALHL*(QOS - QOL(KD)) + DH = ETA(KD1) * (HOS- HOL(KD)) + + + GMS(KD) = (DS + st1 - tem1*det*alhl-tem*alhf) * PRI(KD) + GMH(KD) = PRI(KD) * (HCC-ETA(KD)*HOS + DH) + +! +! TENDENCY FOR SUSPENDED ENVIRONMENTAL ICE AND/OR LIQUID WATER +! + QLL(KD) = (tem2*(DET-TEM) + ETA(KD1)*(QLS-CLL(KD)) & + & + (one-QIL(KD))*dlq(kd) - ETA(KD)*QLS ) * PRI(KD) + + QIL(KD) = (tem2*TEM + ETA(KD1)*(QIS-CIL(KD)) & + & + QIL(KD)*dlq(kd) - ETA(KD)*QIS ) * PRI(KD) +! + GHD(KD) = zero + GSD(KD) = zero +! + DO L=KD1,K + lm1 = l - 1 + ST1 = ONE - ALFINT(L,1) + ST2 = ONE - ALFINT(L,2) + ST3 = ONE - ALFINT(L,3) + ST4 = ONE - ALFINT(L,4) + ST5 = ONE - ALFIND(L) + HB = ALFINT(L,1)*HOL(LM1) + ST1*HOL(L) + QB = ALFINT(L,2)*QOL(LM1) + ST2*QOL(L) + + TEM = ALFINT(L,4)*CIL(LM1) + ST4*CIL(L) + TEM2 = ALFINT(L,3)*CLL(LM1) + ST3*CLL(L) + + TEM1 = ETA(L) * (TEM - CIL(L)) + TEM3 = ETA(L) * (TEM2 - CLL(L)) + + HBD = ALFIND(L)*HOL(LM1) + ST5*HOL(L) + QBD = ALFIND(L)*QOL(LM1) + ST5*QOL(L) + + TEM5 = ETD(L) * (HOD(L) - HBD) + TEM6 = ETD(L) * (QOD(L) - QBD) +! + DH = ETA(L) * (HB - HOL(L)) + TEM5 + DS = DH - ALHL * (ETA(L) * (QB - QOL(L)) + TEM6) + + GMH(L) = DH * PRI(L) + GMS(L) = DS * PRI(L) + +! + GHD(L) = TEM5 * PRI(L) + GSD(L) = (TEM5 - ALHL * TEM6) * PRI(L) +! + QLL(L) = (TEM3 + (one-QIL(L))*dlq(l)) * PRI(L) + QIL(L) = (TEM1 + QIL(L)*dlq(l)) * PRI(L) + + TEM1 = ETA(L) * (CIL(LM1) - TEM) + TEM3 = ETA(L) * (CLL(LM1) - TEM2) + + DH = ETA(L) * (HOL(LM1) - HB) - TEM5 + DS = DH - ALHL * ETA(L) * (QOL(LM1) - QB) & + & + ALHL * (TEM6 - EVP(LM1)) + + GMH(LM1) = GMH(LM1) + DH * PRI(LM1) + GMS(LM1) = GMS(LM1) + DS * PRI(LM1) +! + GHD(LM1) = GHD(LM1) - TEM5 * PRI(LM1) + GSD(LM1) = GSD(LM1) - (TEM5-ALHL*(TEM6-EVP(LM1))) * PRI(LM1) + + QIL(LM1) = QIL(LM1) + TEM1 * PRI(LM1) + QLL(LM1) = QLL(LM1) + TEM3 * PRI(LM1) +! + avh = avh + gmh(lm1)*(prs(l)-prs(lm1)) + + ENDDO +! + HBD = HOL(K) + QBD = QOL(K) + TEM5 = ETD(KP1) * (HOD(KP1) - HBD) + TEM6 = ETD(KP1) * (QOD(KP1) - QBD) + DH = - TEM5 + DS = DH + ALHL * TEM6 + TEM1 = DH * PRI(K) + TEM2 = (DS - ALHL * EVP(K)) * PRI(K) + GMH(K) = GMH(K) + TEM1 + GMS(K) = GMS(K) + TEM2 + GHD(K) = GHD(K) + TEM1 + GSD(K) = GSD(K) + TEM2 + +! + avh = avh + gmh(K)*(prs(KP1)-prs(K)) +! + tem4 = - GRAVFAC * pris + TX1 = DH * tem4 + TX2 = DS * tem4 +! + DO L=KBL,K + GMH(L) = GMH(L) + TX1 + GMS(L) = GMS(L) + TX2 + GHD(L) = GHD(L) + TX1 + GSD(L) = GSD(L) + TX2 +! + avh = avh + tx1*(prs(l+1)-prs(l)) + ENDDO + +! +!*********************************************************************** +!*********************************************************************** + +!===> KERNEL (AKM) CALCULATION BEGINS + +!===> MODIFY SOUNDING WITH UNIT MASS FLUX +! + DO L=KD,K + + TEM1 = GMH(L) + TEM2 = GMS(L) + HOL(L) = HOL(L) + TEM1*TESTMB + QOL(L) = QOL(L) + (TEM1-TEM2) * TESTMBOALHL + HST(L) = HST(L) + TEM2*(ONE+GAM(L))*TESTMB + QST(L) = QST(L) + TEM2*GAM(L) * TESTMBOALHL + CLL(L) = CLL(L) + QLL(L) * TESTMB + CIL(L) = CIL(L) + QIL(L) * TESTMB + ENDDO +! + if (alm > zero) then + HOS = HOS + GMH(KD) * TESTMB + QOS = QOS + (GMH(KD)-GMS(KD)) * TESTMBOALHL + QLS = QLS + QLL(KD) * TESTMB + QIS = QIS + QIL(KD) * TESTMB + else + st2 = one - st1s + HOS = HOS + (st1s*GMH(KD)+st2*GMH(KD1)) * TESTMB + QOS = QOS + (st1s * (GMH(KD)-GMS(KD)) & + & + st2 * (GMH(KD1)-GMS(KD1))) * TESTMBOALHL + HST(kd) = HST(kd) + (st1s*GMS(kd)*(ONE+GAM(kd)) & + & + st2*gms(kd1)*(ONE+GAM(kd1))) * TESTMB + QST(kd) = QST(kd) + (st1s*GMS(kd)*GAM(kd) & + & + st2*gms(kd1)*gam(kd1)) * TESTMBOALHL + + QLS = QLS + (st1s*QLL(KD)+st2*QLL(KD1)) * TESTMB + QIS = QIS + (st1s*QIL(KD)+st2*QIL(KD1)) * TESTMB + endif + +! + TEM = PRL(Kmaxp1) - PRL(Kmax) + HBL = HOL(Kmax) * TEM + QBL = QOL(Kmax) * TEM + QLB = CLL(Kmax) * TEM + QIB = CIL(Kmax) * TEM + DO L=KmaxM1,KBL,-1 + TEM = PRL(L+1) - PRL(L) + HBL = HBL + HOL(L) * TEM + QBL = QBL + QOL(L) * TEM + QLB = QLB + CLL(L) * TEM + QIB = QIB + CIL(L) * TEM + ENDDO + HBL = HBL * PRISM + QBL = QBL * PRISM + QLB = QLB * PRISM + QIB = QIB * PRISM + +! if (ctei .and. sgcs(kd) > 0.65) then +! hbl = hbl * hpert_fac +! qbl = qbl * hpert_fac +! endif + + +!*********************************************************************** + +!===> CLOUD WORKFUNCTION FOR MODIFIED SOUNDING, THEN KERNEL (AKM) +! + AKM = ZERO + TX1 = ZERO + QTL = QST(KB1) - GAF(KB1)*HST(KB1) + QTV = QBL + HCC = HBL + TX2 = HCC + TX4 = (ALHF*half)*MAX(ZERO,MIN(ONE,(TCR-TCL-TOL(KB1))*TCRF)) +! + qtv = qbl + tx1 = qib + qlb +! + + DO L=KB1,KD1,-1 + lm1 = l - 1 + lp1 = l + 1 + DEL_ETA = ETA(L) - ETA(LP1) + HCCP = HCC + DEL_ETA*HOL(L) +! + QTLP = QST(LM1) - GAF(LM1)*HST(LM1) + QTVP = half * ((QTLP+QTL)*ETA(L) + (GAF(L)+GAF(LM1))*HCCP) + + DETP = (BKC(L)*TX1 - (QTVP-QTV) & + & + DEL_ETA*(QOL(L)+CLL(L)+CIL(L)) & + & + ETA(L)*Q0U(L) + ETA(LP1)*Q0D(L)) * AKC(L) + IF (DETP <= ZERO) cnvflg = .TRUE. + + ST1 = HST(L) - LTL(L)*NU*(QST(L)-QOL(L)) + + TEM2 = (ALHF*half)*MAX(ZERO,MIN(ONE,(TCR-TCL-TOL(LM1))*TCRF)) + TEM1 = HCCP + DETP * (TEM2+TX4) + + ST2 = LTL(L) * VTF(L) + TEM5 = CLL(L) + CIL(L) + AKM = AKM + & + & ( (TX2 -ETA(LP1)*ST1-ST2*(TX1-TEM5*eta(lp1))) * DLB(L) & + & + (TEM1 -ETA(L )*ST1-ST2*(DETP-TEM5*eta(l))) * DLT(L) ) +! + HCC = HCCP + TX1 = DETP + TX2 = TEM1 + QTL = QTLP + QTV = QTVP + TX4 = TEM2 + ENDDO +! + if (cnvflg) return +! +! Eventhough we ignore the change in lambda, we still assume +! that the cLoud-top contribution is zero; as though we still +! had non-bouyancy there. +! +! + ST1 = HST(KD) - LTL(KD)*NU*(QST(KD)-QOS) + ST2 = LTL(KD) * VTF(KD) + TEM5 = (QLS + QIS) * eta(kd1) + AKM = AKM + HALF * (TX2-ETA(KD1)*ST1-ST2*(TX1-TEM5)) * DLB(KD) +! + AKM = (AKM - WFN) * TESTMBI + + +!*********************************************************************** + +!===> MASS FLUX +! + AMB = - (WFN-ACR) / AKM +! +!===> RELAXATION AND CLIPPING FACTORS +! + AMB = AMB * CLP * rel_fac + +!!! if (DDFT) AMB = MIN(AMB, ONE/CLDFRD) + +!===> SUB-CLOUD LAYER DEPTH LIMIT ON MASS FLUX + + AMBMAX = (PRL(KMAXP1)-PRL(KBL))*(FRACBL*GRAVCON) + AMB = MAX(MIN(AMB, AMBMAX),ZERO) + + +!*********************************************************************** +!*************************RESULTS*************************************** +!*********************************************************************** + +!===> PRECIPITATION AND CLW DETRAINMENT +! + if (amb > zero) then + +! +! if (wvl(kd) > zero) then +! tx1 = one - amb * eta(kd) / (rho(kd)*wvl(kd)) +! sigf(kd) = max(zero, min(one, tx1 * tx1)) +! endif + if (do_aw) then + tx1 = (0.2 / max(alm, 1.0e-5)) + tx2 = one - min(one, pi * tx1 * tx1 / area) + + tx2 = tx2 * tx2 + +! comnet out the following for now - 07/23/18 +! do l=kd1,kbl +! lp1 = min(K, l+1) +! if (wvl(l) > zero .and. wvl(lp1) > zero) then +! tx1 = one - amb * (eta(l)+eta(lp1)) +! & / ((wvl(l)+wvl(lp1))*rho(l)*grav) +! sigf(l) = max(zero, min(one, tx1 * tx1)) +! else +! sigf(l) = min(one,tx2) +! endif +! sigf(l) = max(sigf(l), tx2) +! enddo +! sigf(kd) = sigf(kd1) +! if (kbl < k) then +! sigf(kbl+1:k) = sigf(kbl) +! endif + sigf(kd:k) = tx2 + else + sigf(kd:k) = one + endif +! + avt = zero + avq = zero + avr = dof * sigf(kbl) +! + DSFC = DSFC + AMB * ETD(K) * (one/DT) * sigf(kbl) +! + DO L=K,KD,-1 + PCU(L) = PCU(L) + AMB*RNN(L)*sigf(l) ! (A40) + avr = avr + rnn(l) * sigf(l) + ENDDO + pcu(k) = pcu(k) + amb * dof * sigf(kbl) +! +!===> TEMPARATURE AND Q CHANGE AND CLOUD MASS FLUX DUE TO CLOUD TYPE KD +! + TX1 = AMB * ONEBCP + TX2 = AMB * ONEOALHL + DO L=KD,K + delp = prs(l+1) - prs(l) + tx3 = amb * sigf(l) + ST1 = GMS(L) * TX1 * sigf(l) + TOI(L) = TOI(L) + ST1 + TCU(L) = TCU(L) + ST1 + TCD(L) = TCD(L) + GSD(L) * TX1 * sigf(l) +! + st1 = st1 - ELOCP * (QIL(L) + QLL(L)) * tx3 + + avt = avt + st1 * delp + + FLX(L) = FLX(L) + ETA(L) * tx3 + FLXD(L) = FLXD(L) + ETD(L) * tx3 +! + QII(L) = QII(L) + QIL(L) * tx3 + TEM = zero + + QLI(L) = QLI(L) + QLL(L) * tx3 + TEM + + ST1 = (GMH(L)-GMS(L)) * TX2 * sigf(l) + + QOI(L) = QOI(L) + ST1 + QCU(L) = QCU(L) + ST1 + QCD(L) = QCD(L) + (GHD(L)-GSD(L)) * TX2 * sigf(l) +! + avq = avq + (st1 + (QLL(L)+QIL(L))*tx3) * delp +! avq = avq + st1 * (prs(l+1)-prs(l)) +! avr = avr + (QLL(L) + QIL(L)*(1+alhf/alhl)) + avr = avr + (QLL(L) + QIL(L)) * delp * sigf(l) * gravcon + +! Correction for negative condensate! + if (qii(l) < zero) then + tem = qii(l) * elfocp + QOI(L) = QOI(L) + qii(l) + qcu(l) = qcu(l) + qii(l) + toi(l) = toi(l) - tem + tcu(l) = tcu(l) - tem + qii(l) = zero + endif + if (qli(l) < zero) then + tem = qli(l) * elocp + QOI(L) = QOI(L) + qli(l) + qcu(l) = qcu(l) + qli(l) + toi(l) = toi(l) - tem + tcu(l) = tcu(l) - tem + qli(l) = zero + endif + + ENDDO + avr = avr * amb +! +! Correction for negative condensate! +! if (advcld) then +! do l=kd,k +! if (qli(l) < zero) then +! qoi(l) = qoi(l) + qli(l) +! toi(l) = toi(l) - (alhl/cp) * qli(l) +! qli(l) = zero +! endif +! if (qii(l) < zero) then +! qoi(l) = qoi(l) + qii(l) +! toi(l) = toi(l) - ((alhl+alhf)/cp) * qii(l) +! qii(l) = zero +! endif +! enddo +! endif + +! +! + TX1 = zero + TX2 = zero +! + IF (REVAP) THEN ! REEVAPORATION OF FALLING CONVECTIVE RAIN +! + tem = zero + do l=kd,kbl + IF (L < IDH .or. (.not. DDFT)) THEN + tem = tem + amb * rnn(l) * sigf(l) + endif + enddo + tem = tem + amb * dof * sigf(kbl) + tem = tem * (3600.0/dt) + tem1 = sqrt(max(one, min(100.0,(6.25E10/max(area,one))))) ! 20110530 + + clfrac = max(ZERO, min(half, rknob*clf(tem)*tem1)) + + DO L=KD,KBL ! Testing on 20070926 +! for L=KD,K + IF (L >= IDH .AND. DDFT) THEN + tem = amb * sigf(l) + TX2 = TX2 + tem * RNN(L) + CLDFRD = MIN(tem*CLDFR(L), clfrac) + ELSE + TX1 = TX1 + AMB * RNN(L) * sigf(l) + ENDIF + tx4 = zfac * phil(l) + tx4 = (one - tx4 * (one - half*tx4)) * afc +! + IF (TX1 > zero .OR. TX2 > zero) THEN + TEQ = TOI(L) + QEQ = QOI(L) + PL = half * (PRL(L+1)+PRL(L)) + + ST1 = MAX(ZERO, MIN(ONE, (TCR-TEQ)*TCRF)) + ST2 = ST1*ELFOCP + (one-ST1)*ELOCP + + CALL QSATCN ( TEQ,PL,QSTEQ,DQDT) +! + DELTAQ = half * (QSTEQ*rhc_ls(l)-QEQ) / (one+ST2*DQDT) +! + QEQ = QEQ + DELTAQ + TEQ = TEQ - DELTAQ*ST2 +! + TEM1 = MAX(ZERO, MIN(ONE, (TCR-TEQ)*TCRF)) + TEM2 = TEM1*ELFOCP + (one-TEM1)*ELOCP + + CALL QSATCN ( TEQ,PL,QSTEQ,DQDT) +! + DELTAQ = (QSTEQ*rhc_ls(l)-QEQ) / (one+TEM2*DQDT) +! + QEQ = QEQ + DELTAQ + TEQ = TEQ - DELTAQ*TEM2 + + IF (QEQ > QOI(L)) THEN + POTEVAP = (QEQ-QOI(L))*(PRL(L+1)-PRL(L))*GRAVCON + + tem4 = zero + if (tx1 > zero) & + & TEM4 = POTEVAP * (one - EXP( tx4*TX1**0.57777778 ) ) + ACTEVAP = MIN(TX1, TEM4*CLFRAC) + + + if (tx1 < rainmin*dt) actevap = min(tx1, potevap) +! + tem4 = zero + if (tx2 > zero) & + & TEM4 = POTEVAP * (one - EXP( tx4*TX2**0.57777778 ) ) + TEM4 = min(MIN(TX2, TEM4*CLDFRD), potevap-actevap) + if (tx2 < rainmin*dt) tem4 = min(tx2, potevap-actevap) +! + TX1 = TX1 - ACTEVAP + TX2 = TX2 - TEM4 + ST1 = (ACTEVAP+TEM4) * PRI(L) + QOI(L) = QOI(L) + ST1 + QCU(L) = QCU(L) + ST1 +! + + ST1 = ST1 * ELOCP + TOI(L) = TOI(L) - ST1 + TCU(L) = TCU(L) - ST1 + ENDIF + ENDIF + ENDDO +! + CUP = CUP + TX1 + TX2 + DOF * AMB * sigf(kbl) + ELSE + DO L=KD,K + TX1 = TX1 + AMB * RNN(L) * sigf(l) + ENDDO + CUP = CUP + TX1 + DOF * AMB * sigf(kbl) + ENDIF + +! +! Convective transport (mixing) of passive tracers +! + if (NTRC > 0) then + do l=kd,km1 + if (etz(l) /= zero) etzi(l) = one / etz(l) + enddo + DO N=1,NTRC ! Tracer loop ; first two are u and v + + DO L=KD,K + HOL(L) = ROI(L,N) + ENDDO +! + HCC = RBL(N) + HOD(KD) = HOL(KD) +! Compute downdraft properties for the tracer + DO L=KD1,K + lm1 = l - 1 + ST1 = ONE - ALFIND(L) + HB = ALFIND(L) * HOL(LM1) + ST1 * HOL(L) + IF (ETZ(LM1) /= ZERO) THEN + TEM = ETZI(LM1) + IF (ETD(L) > ETD(LM1)) THEN + HOD(L) = (ETD(LM1)*(HOD(LM1)-HOL(LM1)) & + & + ETD(L) *(HOL(LM1)-HB) + ETZ(LM1)*HB) * TEM + ELSE + HOD(L) = (ETD(LM1)*(HOD(LM1)-HB) + ETZ(LM1)*HB) * TEM + ENDIF + ELSE + HOD(L) = HB + ENDIF + ENDDO + + DO L=KB1,KD,-1 + HCC = HCC + (ETA(L)-ETA(L+1))*HOL(L) + ENDDO +! +! Scavenging -- fscav - fraction scavenged [km-1] +! delz - distance from the entrainment to detrainment layer [km] +! fnoscav - the fraction not scavenged +! following Liu et al. [JGR,2001] Eq 1 + + if (FSCAV_(N) > zero) then + DELZKM = ( PHIL(KD) - PHIH(KD1) ) *(onebg*0.001) + FNOSCAV = exp(- FSCAV_(N) * DELZKM) + else + FNOSCAV = one + endif + + GMH(KD) = PRI(KD) * (HCC-ETA(KD)*HOL(KD)) * trcfac(kd,n) & + & * FNOSCAV + DO L=KD1,K + if (FSCAV_(N) > zero) then + DELZKM = ( PHIL(KD) - PHIH(L+1) ) *(onebg*0.001) + FNOSCAV = exp(- FSCAV_(N) * DELZKM) + endif + lm1 = l - 1 + ST1 = ONE - ALFINT(L,N+4) + ST2 = ONE - ALFIND(L) + HB = ALFINT(L,N+4) * HOL(LM1) + ST1 * HOL(L) + HBD = ALFIND(L) * HOL(LM1) + ST2 * HOL(L) + TEM5 = ETD(L) * (HOD(L) - HBD) + DH = ETA(L) * (HB - HOL(L)) * FNOSCAV + TEM5 + GMH(L ) = DH * PRI(L) * trcfac(l,n) + DH = ETA(L) * (HOL(LM1) - HB) * FNOSCAV - TEM5 + GMH(LM1) = GMH(LM1) + DH * PRI(LM1) * trcfac(l,n) + ENDDO +! + st2 = zero + DO L=KD,K + ST1 = GMH(L)*AMB*sigf(l) + st2 + st3 = HOL(L) + st1 + st2 = st3 - trcmin(n) ! if trcmin is defined limit change + if (st2 < zero) then + ROI(L,N) = trcmin(n) + RCU(L,N) = RCU(L,N) + ST1 + if (l < k) & + & st2 = st2 * (prl(l+1)-prl(l))*pri(l+1) * (cmb2pa/grav) + else + ROI(L,N) = ST3 + RCU(L,N) = RCU(L,N) + ST1 + st2 = zero + endif + + ENDDO + ENDDO ! Tracer loop NTRC + endif + endif ! amb > zero + + RETURN + end subroutine cloud + + SUBROUTINE DDRFT( & + & K, KP1, KD & + &, TLA, ALFIND, wcbase & + &, TOL, QOL, HOL, PRL, QST, HST, GAM, GAF & +! &, TOL, QOL, HOL, PRL, QST, HST, GAM, GAF, HBL, QBL& + &, QRB, QRT, BUY, KBL, IDH, ETA, RNN, ETAI & + &, ALM, WFN, TRAIN, DDFT & + &, ETD, HOD, QOD, EVP, DOF, CLDFRD, WCB & + &, GMS, GSD, GHD, wvlu) + +! +!*********************************************************************** +!******************** Cumulus Downdraft Subroutine ********************* +!****************** Based on Cheng and Arakawa (1997) ****** ********** +!************************ SUBROUTINE DDRFT **************************** +!************************* October 2004 ****************************** +!*********************************************************************** +!*********************************************************************** +!************* Shrinivas.Moorthi@noaa.gov (301) 683-3718 *************** +!*********************************************************************** +!*********************************************************************** +!23456789012345678901234567890123456789012345678901234567890123456789012 +! +!===> TOL(K) INPUT TEMPERATURE KELVIN +!===> QOL(K) INPUT SPECIFIC HUMIDITY NON-DIMENSIONAL + +!===> PRL(KP1) INPUT PRESSURE @ EDGES MB + +!===> K INPUT THE RISE & THE INDEX OF THE SUBCLOUD LAYER +!===> KD INPUT DETRAINMENT LEVEL ( 1<= KD < K ) +! + IMPLICIT NONE +! +! INPUT ARGUMENTS +! + INTEGER K, KP1, KD, KBL + real(kind=kind_phys) ALFIND(K), wcbase + + real(kind=kind_phys), dimension(kd:k) :: HOL, QOL, HST, QST & + &, TOL, QRB, QRT, RNN & + &, RNS, ETAI + real(kind=kind_phys), dimension(kd:kp1) :: GAF, BUY, GAM, ETA & + &, PRL +! +! real(kind=kind_phys) HBL, QBL, PRIS & +! &, TRAIN, WFN, ALM +! +! TEMPORARY WORK SPACE +! + real(kind=kind_phys), dimension(KD:K) :: RNF, WCB, EVP, STLT & + &, GHD, GSD, CLDFRD & + &, GQW, QRPI, QRPS, BUD + + real(kind=kind_phys), dimension(KD:KP1) :: QRP, WVL, WVLU, ETD & + &, HOD, QOD, ROR, GMS + + real(kind=kind_phys) TL, PL, QL, QS, DQS, ST1 & + &, QQQ, DEL_ETA, HB, QB, TB & + &, TEM, TEM1, TEM2, TEM3, TEM4, ST2 & + &, ERRMIN, ERRMI2, ERRH, ERRW, ERRE, TEM5 & + &, TEM6, HBD, QBD, TX1, TX2, TX3 & + &, TX4, TX5, TX6, TX7, TX8, TX9 & + &, WFN, ALM, AL2 & + &, TRAIN, GMF, ONPG, CTLA, VTRM & + &, RPART, QRMIN, AA1, BB1, CC1, DD1 & +! &, WC2MIN, WCMIN, WCBASE, F2, F3, F5 & + &, WC2MIN, WCMIN, F2, F3, F5 & + &, GMF1, GMF5, QRAF, QRBF, del_tla & + &, TLA, STLA, CTL2, CTL3 & +! &, TLA, STLA, CTL2, CTL3, ASIN & +! &, RNT, RNB, ERRQ, RNTP, QRPF, VTPF & + &, RNT, RNB, ERRQ, RNTP & + &, EDZ, DDZ, CE, QHS, FAC, FACG & + &, RSUM1, RSUM2, RSUM3, CEE, DOF, DOFW +! &, sialf + + INTEGER I, L, N, IX, KD1, II, kb1, IP1, JJ, ntla & + &, IT, KM1, KTEM, KK, KK1, LM1, LL, LP1 & + &, IDW, IDH, IDN(K), idnm, itr +! + parameter (ERRMIN=0.0001, ERRMI2=0.1*ERRMIN) +! parameter (ERRMIN=0.00001, ERRMI2=0.1*ERRMIN) +! +! real (kind=kind_phys), parameter :: PIINV=one/PI, pio2=half*pi +! + parameter (ONPG=one+half, GMF=one/ONPG, RPART=zero) +! parameter (ONPG=1.0+0.5, GMF=1.0/ONPG, RPART=1.0) +! parameter (ONPG=1.0+0.5, GMF=1.0/ONPG, RPART=0.5) +! PARAMETER (AA1=1.0, BB1=1.5, CC1=1.1, DD1=0.85, F3=CC1, F5=2.5) +! PARAMETER (AA1=2.0, BB1=1.5, CC1=1.1, DD1=0.85, F3=CC1, F5=2.5) + PARAMETER (AA1=1.0, BB1=1.0, CC1=1.0, DD1=1.0, F3=CC1, F5=1.0) + parameter (QRMIN=1.0E-6, WC2MIN=0.01, GMF1=GMF/AA1, GMF5=GMF/F5) +! parameter (QRMIN=1.0E-6, WC2MIN=1.00, GMF1=GMF/AA1, GMF5=GMF/F5) + parameter (WCMIN=sqrt(wc2min)) +! parameter (sialf=0.5) +! + integer, parameter :: itrmu=25, itrmd=25 & + &, itrmin=15, itrmnd=12, numtla=2 + +! uncentering for vvel in dd + real(kind=kind_phys), parameter :: ddunc1=0.25, ddunc2=one-ddunc1 & +! &, ddunc1=0.4, ddunc2=one-ddunc1 & +! &, ddunc1=0.3, ddunc2=one-ddunc1 & + &, VTPEXP=-0.3636 & + &, VTP=36.34*SQRT(1.2)*(0.001)**0.1364 +! +! real(kind=kind_phys) EM(K*K), ELM(K) + real(kind=kind_phys) ELM(K), AA(KD:K,KD:KP1), QW(KD:K,KD:K) & + &, VT(2), VRW(2), TRW(2), QA(3), WA(3) + + LOGICAL SKPUP, cnvflg, DDFT, UPDRET, DDLGK + +!*********************************************************************** + + + KD1 = KD + 1 + KM1 = K - 1 + KB1 = KBL - 1 +! +! VTP = 36.34*SQRT(1.2)* (0.001)**0.1364 +! VTPEXP = -0.3636 +! PIINV = 1.0 / PI +! PICON = PIO2 * ONEBG +! +! Compute Rain Water Budget of the Updraft (Cheng and Arakawa, 1997) +! + CLDFRD = zero + RNTP = zero + DOF = zero + ERRQ = 10.0 + RNB = zero + RNT = zero + TX2 = PRL(KBL) +! + TX1 = (PRL(KD) + PRL(KD1)) * half + ROR(KD) = CMPOR*TX1 / (TOL(KD)*(one+NU*QOL(KD))) +! GMS(KD) = VTP * ROR(KD) ** VTPEXP + GMS(KD) = VTP * VTPF(ROR(KD)) +! + QRP(KD) = QRMIN +! + TEM = TOL(K) * (one + NU * QOL(K)) + ROR(KP1) = half * CMPOR * (PRL(KP1)+PRL(K)) / TEM + GMS(KP1) = VTP * VTPF(ROR(KP1)) + QRP(KP1) = QRMIN +! + kk = kbl + DO L=KD1,K + TEM = half * (TOL(L)+TOL(L-1)) & + & * (one + (half*NU) * (QOL(L)+QOL(L-1))) + ROR(L) = CMPOR * PRL(L) / TEM +! GMS(L) = VTP * ROR(L) ** VTPEXP + GMS(L) = VTP * VTPF(ROR(L)) + QRP(L) = QRMIN + if (buy(l) <= zero .and. kk == KBL) then + kk = l + endif + ENDDO + if (kk /= kbl) then + do l=kk,kbl + buy(l) = 0.9 * buy(l-1) + enddo + endif +! + do l=kd,k + qrpi(l) = buy(l) + enddo + do l=kd1,kb1 + buy(l) = 0.25 * (qrpi(l-1)+qrpi(l)+qrpi(l)+qrpi(l+1)) + enddo + +! +! CALL ANGRAD(TX1, ALM, STLA, CTL2, AL2, PI, TLA, TX2, WFN, TX3) + tx1 = 1000.0 + tx1 - prl(kp1) +! CALL ANGRAD(TX1, ALM, AL2, TLA, TX2, WFN, TX3) + CALL ANGRAD(TX1, ALM, AL2, TLA) +! +! Following Ucla approach for rain profile +! + F2 = (BB1+BB1)*ONEBG/(PI*0.2) +! WCMIN = SQRT(WC2MIN) +! WCBASE = WCMIN +! +! del_tla = TLA * 0.2 +! del_tla = TLA * 0.25 + del_tla = TLA * 0.3 + TLA = TLA - DEL_TLA +! + DO L=KD,K + RNF(L) = zero + RNS(L) = zero + STLT(L) = zero + GQW(L) = zero + QRP(L) = QRMIN + DO N=KD,K + QW(N,L) = zero + ENDDO + ENDDO +! DO L=KD,KP1 +! WVL(L) = zero +! ENDDO +! +!-----QW(N,L) = D(W(N)*W(N))/DQR(L) +! + KK = KBL + QW(KD,KD) = -QRB(KD) * GMF1 + GHD(KD) = ETA(KD) * ETA(KD) + GQW(KD) = QW(KD,KD) * GHD(KD) + GSD(KD) = ETAI(KD) * ETAI(KD) +! + GQW(KK) = - QRB(KK-1) * (GMF1+GMF1) +! + WCB(KK) = WCBASE * WCBASE + + TX1 = WCB(KK) + GSD(KK) = one + GHD(KK) = one +! + TEM = GMF1 + GMF1 + DO L=KB1,KD1,-1 + GHD(L) = ETA(L) * ETA(L) + GSD(L) = ETAI(L) * ETAI(L) + GQW(L) = - GHD(L) * (QRB(L-1)+QRT(L)) * TEM + QW(L,L) = - QRT(L) * TEM +! + st1 = half * (eta(l) + eta(l+1)) + TX1 = TX1 + BUY(L) * TEM * (qrb(l)+qrt(l)) * st1 * st1 + WCB(L) = TX1 * GSD(L) + ENDDO +! + TEM1 = (QRB(KD) + QRT(KD1) + QRT(KD1)) * GMF1 + GQW(KD1) = - GHD(KD1) * TEM1 + QW(KD1,KD1) = - QRT(KD1) * TEM + st1 = half * (eta(kd) + eta(kd1)) + WCB(KD) = (TX1 + BUY(KD)*TEM*qrb(kd)*st1*st1) * GSD(KD) +! + DO L=KD1,KBL + DO N=KD,L-1 + QW(N,L) = GQW(L) * GSD(N) + ENDDO + ENDDO + QW(KBL,KBL) = zero +! + do ntla=1,numtla ! numtla is the the maximimu number of tilting angle tries + ! ------ +! if (errq < 1.0 .or. tla > 45.0) cycle + if (errq < 0.1 .or. tla > 45.0) cycle +! + tla = tla + del_tla + STLA = SIN(TLA*deg2rad) ! sine of tilting angle + CTL2 = one - STLA * STLA ! cosine square of tilting angle +! + STLA = F2 * STLA * AL2 + CTL2 = DD1 * CTL2 + CTL3 = 0.1364 * CTL2 +! + DO L=KD,K + RNF(L) = zero + STLT(L) = zero + QRP(L) = QRMIN + ENDDO + DO L=KD,KP1 + WVL(L) = zero + ENDDO + WVL(KBL) = WCBASE + STLT(KBL) = one / WCBASE +! + DO L=KD,KP1 + DO N=KD,K + AA(N,L) = zero + ENDDO + ENDDO +! + SKPUP = .FALSE. +! + DO ITR=1,ITRMU ! Rain Profile Iteration starts! + IF (.NOT. SKPUP) THEN +! wvlu = wvl +! +!-----CALCULATING THE VERTICAL VELOCITY +! + TX1 = zero + QRPI(KBL) = one / QRP(KBL) + DO L=KB1,KD,-1 + TX1 = TX1 + QRP(L+1)*GQW(L+1) + ST1 = WCB(L) + QW(L,L)*QRP(L) + TX1*GSD(L) +! if (st1 > wc2min) then + if (st1 > zero) then + WVL(L) = max(ddunc1*SQRT(ST1) + ddunc2*WVL(L), wcmin) +! WVL(L) = SQRT(ST1) +! WVL(L) = max(half * (SQRT(ST1) + WVL(L)), wcmin) +! qrp(l) = half*((wvl(l)*wvl(l)-wcb(l)-tx1*gsd(l))/qw(l,l)& +! & + qrp(l)) + else + +! wvl(l) = 0.5*(wcmin+wvl(l)) +! wvl(l) = max(half*(wvl(l) + wvl(l+1)), wcmin) + wvl(l) = max(wvl(l),wcmin) + qrp(l) = (wvl(l)*wvl(l) - wcb(l) - tx1*gsd(l))/qw(l,l) +! qrp(l) = half*((wvl(l)*wvl(l)-wcb(l)-tx1*gsd(l))/qw(l,l)& +! & + qrp(l)) + endif + qrp(l) = max(qrp(l), qrmin) + + STLT(L) = one / WVL(L) + QRPI(L) = one / QRP(L) + ENDDO +! +!-----CALCULATING TRW, VRW AND OF +! +! VT(1) = GMS(KD) * QRP(KD)**0.1364 + VT(1) = GMS(KD) * QRPF(QRP(KD)) + TRW(1) = ETA(KD) * QRP(KD) * STLT(KD) + TX6 = TRW(1) * VT(1) + VRW(1) = F3*WVL(KD) - CTL2*VT(1) + BUD(KD) = STLA * TX6 * QRB(KD) * half + RNF(KD) = BUD(KD) + DOF = 1.1364 * BUD(KD) * QRPI(KD) + DOFW = -BUD(KD) * STLT(KD) +! + RNT = TRW(1) * VRW(1) + TX2 = zero + TX4 = zero + RNB = RNT + TX1 = half + TX8 = zero +! + IF (RNT >= zero) THEN + TX3 = (RNT-CTL3*TX6) * QRPI(KD) + TX5 = CTL2 * TX6 * STLT(KD) + ELSE + TX3 = zero + TX5 = zero + RNT = zero + RNB = zero + ENDIF +! + DO L=KD1,KB1 + KTEM = MAX(L-2, KD) + LL = L - 1 +! +! VT(2) = GMS(L) * QRP(L)**0.1364 + VT(2) = GMS(L) * QRPF(QRP(L)) + TRW(2) = ETA(L) * QRP(L) * STLT(L) + VRW(2) = F3*WVL(L) - CTL2*VT(2) + QQQ = STLA * TRW(2) * VT(2) + ST1 = TX1 * QRB(LL) + BUD(L) = QQQ * (ST1 + QRT(L)) +! + QA(2) = DOF + WA(2) = DOFW + DOF = 1.1364 * BUD(L) * QRPI(L) + DOFW = -BUD(L) * STLT(L) +! + RNF(LL) = RNF(LL) + QQQ * ST1 + RNF(L) = QQQ * QRT(L) +! + TEM3 = VRW(1) + VRW(2) + TEM4 = TRW(1) + TRW(2) +! + TX6 = pt25 * TEM3 * TEM4 + TEM4 = TEM4 * CTL3 +! +!-----BY QR ABOVE +! +! TEM1 = pt25*(TRW(1)*TEM3 - TEM4*VT(1))*TX7 + TEM1 = pt25*(TRW(1)*TEM3 - TEM4*VT(1))*QRPI(LL) + ST1 = pt25*(TRW(1)*(CTL2*VT(1)-VRW(2)) & + & * STLT(LL) + F3*TRW(2)) +!-----BY QR BELOW + TEM2 = pt25*(TRW(2)*TEM3 - TEM4*VT(2))*QRPI(L) + ST2 = pt25*(TRW(2)*(CTL2*VT(2)-VRW(1)) & + & * STLT(L) + F3*TRW(1)) +! +! From top to the KBL-2 layer +! + QA(1) = TX2 + QA(2) = QA(2) + TX3 - TEM1 + QA(3) = -TEM2 +! + WA(1) = TX4 + WA(2) = WA(2) + TX5 - ST1 + WA(3) = -ST2 +! + TX2 = TEM1 + TX3 = TEM2 + TX4 = ST1 + TX5 = ST2 +! + VT(1) = VT(2) + TRW(1) = TRW(2) + VRW(1) = VRW(2) +! + IF (WVL(KTEM) == WCMIN) WA(1) = zero + IF (WVL(LL) == WCMIN) WA(2) = zero + IF (WVL(L) == WCMIN) WA(3) = zero + DO N=KTEM,KBL + AA(LL,N) = (WA(1)*QW(KTEM,N) * STLT(KTEM) & + & + WA(2)*QW(LL,N) * STLT(LL) & + & + WA(3)*QW(L,N) * STLT(L) ) * half + ENDDO + AA(LL,KTEM) = AA(LL,KTEM) + QA(1) + AA(LL,LL) = AA(LL,LL) + QA(2) + AA(LL,L) = AA(LL,L) + QA(3) + BUD(LL) = (TX8 + RNN(LL)) * half & + & - RNB + TX6 - BUD(LL) + AA(LL,KBL+1) = BUD(LL) + RNB = TX6 + TX1 = one + TX8 = RNN(LL) + ENDDO + L = KBL + LL = L - 1 +! VT(2) = GMS(L) * QRP(L)**0.1364 + VT(2) = GMS(L) * QRPF(QRP(L)) + TRW(2) = ETA(L) * QRP(L) * STLT(L) + VRW(2) = F3*WVL(L) - CTL2*VT(2) + ST1 = STLA * TRW(2) * VT(2) * QRB(LL) + BUD(L) = ST1 + + QA(2) = DOF + WA(2) = DOFW + DOF = 1.1364 * BUD(L) * QRPI(L) + DOFW = -BUD(L) * STLT(L) +! + RNF(LL) = RNF(LL) + ST1 +! + TEM3 = VRW(1) + VRW(2) + TEM4 = TRW(1) + TRW(2) +! + TX6 = pt25 * TEM3 * TEM4 + TEM4 = TEM4 * CTL3 +! +!-----BY QR ABOVE +! + TEM1 = pt25*(TRW(1)*TEM3 - TEM4*VT(1))*QRPI(LL) + ST1 = pt25*(TRW(1)*(CTL2*VT(1)-VRW(2)) & + & * STLT(LL) + F3*TRW(2)) +!-----BY QR BELOW + TEM2 = pt25*(TRW(2)*TEM3 - TEM4*VT(2))*QRPI(L) + ST2 = pt25*(TRW(2)*(CTL2*VT(2)-VRW(1)) & + & * STLT(L) + F3*TRW(1)) +! +! For the layer next to the top of the boundary layer +! + QA(1) = TX2 + QA(2) = QA(2) + TX3 - TEM1 + QA(3) = -TEM2 +! + WA(1) = TX4 + WA(2) = WA(2) + TX5 - ST1 + WA(3) = -ST2 +! + TX2 = TEM1 + TX3 = TEM2 + TX4 = ST1 + TX5 = ST2 +! + IDW = MAX(L-2, KD) +! + IF (WVL(IDW) == WCMIN) WA(1) = zero + IF (WVL(LL) == WCMIN) WA(2) = zero + IF (WVL(L) == WCMIN) WA(3) = zero +! + KK = IDW + DO N=KK,L + AA(LL,N) = (WA(1)*QW(KK,N) * STLT(KK) & + & + WA(2)*QW(LL,N) * STLT(LL) & + & + WA(3)*QW(L,N) * STLT(L) ) * half + + ENDDO +! + AA(LL,IDW) = AA(LL,IDW) + QA(1) + AA(LL,LL) = AA(LL,LL) + QA(2) + AA(LL,L) = AA(LL,L) + QA(3) + BUD(LL) = (TX8+RNN(LL)) * half - RNB + TX6 - BUD(LL) +! + AA(LL,L+1) = BUD(LL) +! + RNB = TRW(2) * VRW(2) +! +! For the top of the boundary layer +! + IF (RNB < zero) THEN + KK = KBL + TEM = VT(2) * TRW(2) + QA(2) = (RNB - CTL3*TEM) * QRPI(KK) + WA(2) = CTL2 * TEM * STLT(KK) + ELSE + RNB = zero + QA(2) = zero + WA(2) = zero + ENDIF +! + QA(1) = TX2 + QA(2) = DOF + TX3 - QA(2) + QA(3) = zero +! + WA(1) = TX4 + WA(2) = DOFW + TX5 - WA(2) + WA(3) = zero +! + KK = KBL + IF (WVL(KK-1) == WCMIN) WA(1) = zero + IF (WVL(KK) == WCMIN) WA(2) = zero +! + DO II=1,2 + N = KK + II - 2 + AA(KK,N) = (WA(1)*QW(KK-1,N) * STLT(KK-1) & + & + WA(2)*QW(KK,N) * STLT(KK)) * half + ENDDO + FAC = half + LL = KBL + L = LL + 1 + LM1 = LL - 1 + AA(LL,LM1) = AA(LL,LM1) + QA(1) + AA(LL,LL) = AA(LL,LL) + QA(2) + BUD(LL) = half*RNN(LM1) - TX6 + RNB - BUD(LL) + AA(LL,LL+1) = BUD(LL) +! +!-----SOLVING THE BUDGET EQUATIONS FOR DQR +! + DO L=KD1,KBL + LM1 = L - 1 + cnvflg = ABS(AA(LM1,LM1)) < ABS(AA(L,LM1)) + DO N=LM1,KBL+1 + IF (cnvflg) THEN + TX1 = AA(LM1,N) + AA(LM1,N) = AA(L,N) + AA(L,N) = TX1 + ENDIF + ENDDO + TX1 = AA(L,LM1) / AA(LM1,LM1) + DO N=L,KBL+1 + AA(L,N) = AA(L,N) - TX1 * AA(LM1,N) + ENDDO + ENDDO +! +!-----BACK SUBSTITUTION AND CHECK IF THE SOLUTION CONVERGES +! + KK = KBL + KK1 = KK + 1 + AA(KK,KK1) = AA(KK,KK1) / AA(KK,KK) ! Qr correction ! + TX2 = ABS(AA(KK,KK1)) * QRPI(KK) ! Error Measure ! +! + KK = KBL + 1 + DO L=KB1,KD,-1 + LP1 = L + 1 + TX1 = zero + DO N=LP1,KBL + TX1 = TX1 + AA(L,N) * AA(N,KK) + ENDDO + AA(L,KK) = (AA(L,KK) - TX1) / AA(L,L) ! Qr correction ! + TX2 = MAX(TX2, ABS(AA(L,KK))*QRPI(L)) ! Error Measure ! + ENDDO +! +! tem = 0.5 + if (tx2 > one .and. abs(errq-tx2) > 0.1) then + tem = half +!! elseif (tx2 < 0.1) then +!! tem = 1.2 + else + tem = one + endif +! + DO L=KD,KBL +! QRP(L) = MAX(QRP(L)+AA(L,KBL+1), QRMIN) + QRP(L) = MAX(QRP(L)+AA(L,KBL+1)*tem, QRMIN) + ENDDO +! + IF (ITR < ITRMIN) THEN + TEM = ABS(ERRQ-TX2) + IF (TEM >= ERRMI2 .AND. TX2 >= ERRMIN) THEN + ERRQ = TX2 ! Further iteration ! + ELSE + SKPUP = .TRUE. ! Converges ! + ERRQ = zero ! Rain profile exists! + ENDIF + ELSE + TEM = ERRQ - TX2 +! IF (TEM < ZERO .AND. ERRQ > 0.1) THEN + IF (TEM < ZERO .AND. ERRQ > 0.5) THEN +! IF (TEM < ZERO .and. & +! & (ntla < numtla .or. ERRQ > 0.5)) THEN + SKPUP = .TRUE. ! No convergence ! + ERRQ = 10.0 ! No rain profile! +!!!! ELSEIF (ABS(TEM) < ERRMI2 .OR. TX2 < ERRMIN) THEN + ELSEIF (TX2 < ERRMIN) THEN + SKPUP = .TRUE. ! Converges ! + ERRQ = zero ! Rain profile exists! + elseif (tem < zero .and. errq < 0.1) then + skpup = .true. +! if (ntla == numtla .or. tem > -0.003) then + errq = zero +! else +! errq = 10.0 +! endif + ELSE + ERRQ = TX2 ! Further iteration ! +! if (itr == itrmu .and. ERRQ > ERRMIN*10 & +! & .and. ntla == 1) ERRQ = 10.0 + ENDIF + ENDIF +! + ENDIF ! SKPUP ENDIF! +! + ENDDO ! End of the ITR Loop!! +! + IF (ERRQ < 0.1) THEN + DDFT = .TRUE. + RNB = - RNB +! do l=kd1,kb1-1 +! if (wvl(l)-wcbase < 1.0E-9) ddft = .false. +! enddo + ELSE + DDFT = .FALSE. + ENDIF + + enddo ! End of ntla loop +! +! Caution !! Below is an adjustment to rain flux to maintain +! conservation of precip! +! + IF (DDFT) THEN + TX1 = zero + DO L=KD,KB1 + TX1 = TX1 + RNF(L) + ENDDO + TX1 = TRAIN / (TX1+RNT+RNB) + IF (ABS(TX1-one) < 0.2) THEN + RNT = MAX(RNT*TX1,ZERO) + RNB = RNB * TX1 + DO L=KD,KB1 + RNF(L) = RNF(L) * TX1 + ENDDO +! rain flux adjustment is over + + ELSE + DDFT = .FALSE. + ERRQ = 10.0 + ENDIF + ENDIF +! + DOF = zero + IF (.NOT. DDFT) then + wvlu(kd:kp1) = zero + RETURN ! Rain profile did not converge! + ! No down draft for this case - rerurn + ! ------------------------------------ +! + else ! rain profile converged - do downdraft calculation + ! ------------------------------------------------ + + wvlu(kd:kp1) = wvl(kd:kp1) ! save updraft vertical velocity for output + +! +! Downdraft calculation begins +! ---------------------------- +! + DO L=KD,K + WCB(L) = zero + ENDDO +! + ERRQ = 10.0 +! At this point stlt contains inverse of updraft vertical velocity 1/Wu. + + KK = MAX(KB1,KD1) + DO L=KK,K + STLT(L) = STLT(L-1) + ENDDO + TEM = stla / BB1 ! this is 2/(pi*radius*grav) +! + DO L=KD,K + IF (L <= KBL) THEN + STLT(L) = ETA(L) * STLT(L) * TEM / ROR(L) + ELSE + STLT(L) = zero + ENDIF + ENDDO + + rsum1 = zero + rsum2 = zero +! + IDN(:) = idnmax + DO L=KD,KP1 + ETD(L) = zero + WVL(L) = zero +! QRP(L) = zero + ENDDO + DO L=KD,K + EVP(L) = zero + BUY(L) = zero + QRP(L+1) = zero + ENDDO + HOD(KD) = HOL(KD) + QOD(KD) = QOL(KD) + TX1 = zero +!!! TX1 = STLT(KD)*QRB(KD)*ONE ! sigma at the top +! TX1 = MIN(STLT(KD)*QRB(KD)*ONE, ONE) ! sigma at the top +! TX1 = MIN(STLT(KD)*QRB(KD)*0.5, ONE) ! sigma at the top + RNTP = zero + TX5 = TX1 + QA(1) = zero +! +! Here we assume RPART of detrained rain RNT goes to Pd +! + IF (RNT > zero) THEN + if (TX1 > zero) THEN + QRP(KD) = (RPART*RNT / (ROR(KD)*TX1*GMS(KD))) & + & ** (one/1.1364) + else + tx1 = RPART*RNT / (ROR(KD)*GMS(KD)*QRP(KD)**1.1364) + endif + RNTP = (one - RPART) * RNT + BUY(KD) = - ROR(KD) * TX1 * QRP(KD) + ELSE + QRP(KD) = zero + ENDIF +! +! L-loop for the downdraft iteration from KD1 to KP1 (bottom surface) +! +! BUD(KD) = ROR(KD) + idnm = 1 + DO L=KD1,KP1 + + QA(1) = zero + ddlgk = idn(idnm) == idnmax + if (.not. ddlgk) cycle + IF (L <= K) THEN + ST1 = one - ALFIND(L) + WA(1) = ALFIND(L)*HOL(L-1) + ST1*HOL(L) + WA(2) = ALFIND(L)*QOL(L-1) + ST1*QOL(L) + WA(3) = ALFIND(L)*TOL(L-1) + ST1*TOL(L) + QA(2) = ALFIND(L)*HST(L-1) + ST1*HST(L) + QA(3) = ALFIND(L)*QST(L-1) + ST1*QST(L) + ELSE + WA(1) = HOL(K) + WA(2) = QOL(K) + WA(3) = TOL(K) + QA(2) = HST(K) + QA(3) = QST(K) + ENDIF +! + FAC = two + IF (L == KD1) FAC = one + + FACG = FAC * half * GMF5 ! 12/17/97 +! +! DDLGK = IDN(idnm) == 99 + + BUD(KD) = ROR(L) + + TX1 = TX5 + WVL(L) = MAX(WVL(L-1),ONE_M1) + + QRP(L) = MAX(QRP(L-1),QRP(L)) +! +! VT(1) = GMS(L-1) * QRP(L-1) ** 0.1364 + VT(1) = GMS(L-1) * QRPF(QRP(L-1)) + RNT = ROR(L-1) * (WVL(L-1)+VT(1))*QRP(L-1) + +! + +! TEM = MAX(ALM, 2.5E-4) * MAX(ETA(L), 1.0) + TEM = MAX(ALM,ONE_M6) * MAX(ETA(L), ONE) +! TEM = MAX(ALM, 1.0E-5) * MAX(ETA(L), 1.0) + TRW(1) = PICON*TEM*(QRB(L-1)+QRT(L-1)) + TRW(2) = one / TRW(1) +! + VRW(1) = half * (GAM(L-1) + GAM(L)) + VRW(2) = one / (VRW(1) + VRW(1)) +! + TX4 = (QRT(L-1)+QRB(L-1))*(ONEBG*FAC*500.00*EKNOB) +! + DOFW = one / (WA(3) * (one + NU*WA(2))) ! 1.0 / TVbar! +! + ETD(L) = ETD(L-1) + HOD(L) = HOD(L-1) + QOD(L) = QOD(L-1) +! + ERRQ = 10.0 + +! + IF (L <= KBL) THEN + TX3 = STLT(L-1) * QRT(L-1) * (half*FAC) + TX8 = STLT(L) * QRB(L-1) * (half*FAC) + TX9 = TX8 + TX3 + ELSE + TX3 = zero + TX8 = zero + TX9 = zero + ENDIF +! + TEM = WVL(L-1) + VT(1) + IF (TEM > zero) THEN + TEM1 = one / (TEM*ROR(L-1)) + TX3 = VT(1) * TEM1 * ROR(L-1) * TX3 + TX6 = TX1 * TEM1 + ELSE + TX6 = one + ENDIF +! + IF (L == KD1) THEN + IF (RNT > zero) THEN + TEM = MAX(QRP(L-1),QRP(L)) + WVL(L) = TX1 * TEM * QRB(L-1)*(FACG*5.0) + ENDIF + WVL(L) = MAX(ONE_M2, WVL(L)) + TRW(1) = TRW(1) * half + TRW(2) = TRW(2) + TRW(2) + ELSE + IF (DDLGK) EVP(L-1) = EVP(L-2) + ENDIF +! +! No downdraft above level IDH +! + + IF (L < IDH) THEN + + ETD(L) = zero + HOD(L) = WA(1) + QOD(L) = WA(2) + EVP(L-1) = zero + WVL(L) = zero + QRP(L) = zero + BUY(L) = zero + TX5 = TX9 + ERRQ = zero + RNTP = RNTP + RNT * TX1 + RNT = zero + WCB(L-1) = zero + +! ENDIF +! BUD(KD) = ROR(L) +! +! Iteration loop for a given level L begins +! + else + DO ITR=1,ITRMD +! +! cnvflg = DDLGK .AND. (ERRQ > ERRMIN) + cnvflg = ERRQ > ERRMIN + IF (cnvflg) THEN +! +! VT(1) = GMS(L) * QRP(L) ** 0.1364 + VT(1) = GMS(L) * QRPF(QRP(L)) + TEM = WVL(L) + VT(1) +! + IF (TEM > zero) THEN + ST1 = ROR(L) * TEM * QRP(L) + RNT + IF (ST1 /= zero) ST1 = two * EVP(L-1) / ST1 + TEM1 = one / (TEM*ROR(L)) + TEM2 = VT(1) * TEM1 * ROR(L) * TX8 + ELSE + TEM1 = zero + TEM2 = TX8 + ST1 = zero + ENDIF +! + st2 = tx5 + TEM = ROR(L)*WVL(L) - ROR(L-1)*WVL(L-1) + if (tem > zero) then + TX5 = (TX1 - ST1 + TEM2 + TX3)/(one+tem*tem1) + else + TX5 = TX1 - tem*tx6 - ST1 + TEM2 + TX3 + endif + TX5 = MAX(TX5,ZERO) + tx5 = half * (tx5 + st2) +! +! qqq = 1.0 + tem * tem1 * (1.0 - sialf) +! +! if (qqq > 0.0) then +! TX5 = (TX1 - sialf*tem*tx6 - ST1 + TEM2 + TX3) / qqq +! else +! TX5 = (TX1 - tem*tx6 - ST1 + TEM2 + TX3) +! endif +! + TEM1 = ETD(L) + ETD(L) = ROR(L) * TX5 * MAX(WVL(L),ZERO) +! + if (etd(l) > zero) etd(l) = half * (etd(l) + tem1) +! + + DEL_ETA = ETD(L) - ETD(L-1) + +! TEM = DEL_ETA * TRW(2) +! TEM2 = MAX(MIN(TEM, 1.0), -1.0) +! IF (ABS(TEM) > 1.0 .AND. ETD(L) > 0.0 ) THEN +! DEL_ETA = TEM2 * TRW(1) +! ETD(L) = ETD(L-1) + DEL_ETA +! ENDIF +! IF (WVL(L) > 0.0) TX5 = ETD(L) / (ROR(L)*WVL(L)) +! + ERRE = ETD(L) - TEM1 +! + tem = max(abs(del_eta), trw(1)) + tem2 = del_eta / tem + TEM1 = SQRT(MAX((tem+DEL_ETA)*(tem-DEL_ETA),ZERO)) +! TEM1 = SQRT(MAX((TRW(1)+DEL_ETA)*(TRW(1)-DEL_ETA),0.0)) + + EDZ = (half + ASIN(TEM2)*PIINV)*DEL_ETA + TEM1*PIINV + + DDZ = EDZ - DEL_ETA + WCB(L-1) = ETD(L) + DDZ +! + TEM1 = HOD(L) + IF (DEL_ETA > zero) THEN + QQQ = one / (ETD(L) + DDZ) + HOD(L) = (ETD(L-1)*HOD(L-1) + DEL_ETA*HOL(L-1) & + & + DDZ*WA(1)) * QQQ + QOD(L) = (ETD(L-1)*QOD(L-1) + DEL_ETA*QOL(L-1) & + & + DDZ*WA(2)) * QQQ + ELSEif((ETD(L-1) + EDZ) > zero) then + QQQ = one / (ETD(L-1) + EDZ) + HOD(L) = (ETD(L-1)*HOD(L-1) + EDZ*WA(1)) * QQQ + QOD(L) = (ETD(L-1)*QOD(L-1) + EDZ*WA(2)) * QQQ + ENDIF + ERRH = HOD(L) - TEM1 + ERRQ = ABS(ERRH/HOD(L)) + ABS(ERRE/MAX(ETD(L),ONE_M5)) + DOF = DDZ + VT(2) = QQQ +! + DDZ = DOF + TEM4 = QOD(L) + TEM1 = VRW(1) +! + QHS = QA(3) + half * (GAF(L-1)+GAF(L)) * (HOD(L)-QA(2)) +! +! First iteration ! +! + ST2 = PRL(L) * (QHS + TEM1 * (QHS-QOD(L))) + TEM2 = ROR(L) * QRP(L) + CALL QRABF(TEM2,QRAF,QRBF) + TEM6 = TX5 * (1.6 + 124.9 * QRAF) * QRBF * TX4 +! + CE = TEM6 * ST2 / ((5.4E5*ST2 + 2.55E6)*(ETD(L)+DDZ)) +! + TEM2 = - ((one+TEM1)*(QHS+CE) + TEM1*QOD(L)) + TEM3 = (one + TEM1) * QHS * (QOD(L)+CE) + TEM = MAX(TEM2*TEM2 - four*TEM1*TEM3,ZERO) + QOD(L) = MAX(TEM4, (- TEM2 - SQRT(TEM)) * VRW(2)) +! +! +! second iteration ! +! + ST2 = PRL(L) * (QHS + TEM1 * (QHS-QOD(L))) + CE = TEM6 * ST2 / ((5.4E5*ST2 + 2.55E6)*(ETD(L)+DDZ)) +! CEE = CE * (ETD(L)+DDZ) +! + + + TEM2 = - ((one+TEM1)*(QHS+CE) + TEM1*tem4) + TEM3 = (one + TEM1) * QHS * (tem4+CE) + TEM = MAX(TEM2*TEM2 - four*TEM1*TEM3,ZERO) + QOD(L) = MAX(TEM4, (- TEM2 - SQRT(TEM)) * VRW(2)) +! Evaporation in Layer L-1 +! + EVP(L-1) = (QOD(L)-TEM4) * (ETD(L)+DDZ) +! Calculate Pd (L+1/2) + QA(1) = TX1*RNT + RNF(L-1) - EVP(L-1) +! + if (qa(1) > zero) then + IF (ETD(L) > zero) THEN + TEM = QA(1) / (ETD(L)+ROR(L)*TX5*VT(1)) + QRP(L) = MAX(TEM,ZERO) + ELSEIF (TX5 > zero) THEN + QRP(L) = (MAX(ZERO,QA(1)/(ROR(L)*TX5*GMS(L)))) & + & ** (one/1.1364) + ELSE + QRP(L) = zero + ENDIF + else + qrp(l) = half * qrp(l) + endif +! Compute Buoyancy + TEM1 = WA(3) + (HOD(L)-WA(1)-ALHL*(QOD(L)-WA(2))) & + & * onebcp + TEM1 = TEM1 * (one + NU*QOD(L)) + ROR(L) = CMPOR * PRL(L) / TEM1 + TEM1 = TEM1 * DOFW +!!! TEM1 = TEM1 * (1.0 + NU*QOD(L)) * DOFW + + BUY(L) = (TEM1 - one - QRP(L)) * ROR(L) * TX5 +! Compute W (L+1/2) + + TEM1 = WVL(L) + WVL(L) = VT(2) * (ETD(L-1)*WVL(L-1) - FACG & + & * (BUY(L-1)*QRT(L-1)+BUY(L)*QRB(L-1))) +! + if (wvl(l) < zero) then +! WVL(L) = max(wvl(l), 0.1*tem1) +! WVL(L) = 0.5*tem1 +! WVL(L) = 0.1*tem1 +! WVL(L) = 0.0 + WVL(L) = 1.0e-10 + else + WVL(L) = half*(WVL(L)+TEM1) + endif + +! +! WVL(L) = max(0.5*(WVL(L)+TEM1), 0.0) + + ERRW = WVL(L) - TEM1 +! + ERRQ = ERRQ + ABS(ERRW/MAX(WVL(L),ONE_M5)) + +! IF (ITR >= MIN(ITRMIN,ITRMD/2)) THEN + IF (ITR >= MIN(ITRMND,ITRMD/2)) THEN + IF (ETD(L-1) == zero .AND. ERRQ > 0.2) THEN + ROR(L) = BUD(KD) + ETD(L) = zero + WVL(L) = zero + ERRQ = zero + HOD(L) = WA(1) + QOD(L) = WA(2) +! TX5 = TX1 + TX9 + if (L <= KBL) then + TX5 = TX9 + else + TX5 = (STLT(KB1) * QRT(KB1) & + & + STLT(KBL) * QRB(KB1)) * (0.5*FAC) + endif + + EVP(L-1) = zero + TEM = MAX(TX1*RNT+RNF(L-1),ZERO) + QA(1) = TEM - EVP(L-1) +! IF (QA(1) > 0.0) THEN + + QRP(L) = (QA(1) / (ROR(L)*TX5*GMS(L))) & + & ** (one/1.1364) +! endif + BUY(L) = - ROR(L) * TX5 * QRP(L) + WCB(L-1) = zero + ENDIF +! + DEL_ETA = ETD(L) - ETD(L-1) + IF(DEL_ETA < zero .AND. ERRQ > 0.1) THEN + ROR(L) = BUD(KD) + ETD(L) = zero + WVL(L) = zero +!!!!! TX5 = TX1 + TX9 + CLDFRD(L-1) = TX5 +! + DEL_ETA = - ETD(L-1) + EDZ = zero + DDZ = -DEL_ETA + WCB(L-1) = DDZ +! + HOD(L) = HOD(L-1) + QOD(L) = QOD(L-1) +! + TEM4 = QOD(L) + TEM1 = VRW(1) +! + QHS = QA(3) + half * (GAF(L-1)+GAF(L)) & + & * (HOD(L)-QA(2)) + +! +! First iteration ! +! + ST2 = PRL(L) * (QHS + TEM1 * (QHS-QOD(L))) + TEM2 = ROR(L) * QRP(L-1) + CALL QRABF(TEM2,QRAF,QRBF) + TEM6 = TX5 * (1.6 + 124.9 * QRAF) * QRBF * TX4 +! + CE = TEM6*ST2/((5.4E5*ST2 + 2.55E6)*(ETD(L)+DDZ)) +! + + TEM2 = - ((one+TEM1)*(QHS+CE) + TEM1*QOD(L)) + TEM3 = (one + TEM1) * QHS * (QOD(L)+CE) + TEM = MAX(TEM2*TEM2 -FOUR*TEM1*TEM3,ZERO) + QOD(L) = MAX(TEM4, (- TEM2 - SQRT(TEM)) * VRW(2)) +! +! second iteration ! +! + ST2 = PRL(L) * (QHS + TEM1 * (QHS-QOD(L))) + CE = TEM6*ST2/((5.4E5*ST2 + 2.55E6)*(ETD(L)+DDZ)) +! CEE = CE * (ETD(L)+DDZ) +! + + + TEM2 = - ((one+TEM1)*(QHS+CE) + TEM1*tem4) + TEM3 = (one + TEM1) * QHS * (tem4+CE) + TEM = MAX(TEM2*TEM2 -FOUR*TEM1*TEM3,ZERO) + QOD(L) = MAX(TEM4, (- TEM2 - SQRT(TEM)) * VRW(2)) + +! Evaporation in Layer L-1 +! + EVP(L-1) = (QOD(L)-TEM4) * (ETD(L)+DDZ) + +! Calculate Pd (L+1/2) +! RNN(L-1) = TX1*RNT + RNF(L-1) - EVP(L-1) + + QA(1) = TX1*RNT + RNF(L-1) + EVP(L-1) = min(EVP(L-1), QA(1)) + QA(1) = QA(1) - EVP(L-1) + qrp(l) = zero + +! +! IF (QA(1) > 0.0) THEN +!! RNS(L-1) = QA(1) +!!! tx5 = tx9 +! QRP(L) = (QA(1) / (ROR(L)*TX5*GMS(L))) & +! & ** (1.0/1.1364) +! endif +! ERRQ = 0.0 +! Compute Buoyancy +! TEM1 = WA(3)+(HOD(L)-WA(1)-ALHL*(QOD(L)-WA(2))) & +! & * (1.0/CP) +! TEM1 = TEM1 * (1.0 + NU*QOD(L)) * DOFW +! BUY(L) = (TEM1 - 1.0 - QRP(L)) * ROR(L) * TX5 +! +! IF (QA(1) > 0.0) RNS(L) = QA(1) + + IF (L .LE. K) THEN + RNS(L) = QA(1) + QA(1) = zero + ENDIF + tx5 = tx9 + ERRQ = zero + QRP(L) = zero + BUY(L) = zero +! + ENDIF + ENDIF + ENDIF +! + ENDDO ! End of the iteration loop for a given L! + IF (L <= K) THEN + IF (ETD(L-1) == zero .AND. ERRQ > 0.1 .and. l <= kbl) THEN +!!! & .AND. ERRQ > ERRMIN*10.0 .and. l <= kbl) THEN +! & .AND. ERRQ > ERRMIN*10.0) THEN + ROR(L) = BUD(KD) + HOD(L) = WA(1) + QOD(L) = WA(2) + TX5 = TX9 ! Does not make too much difference! +! TX5 = TX1 + TX9 + EVP(L-1) = zero +! EVP(L-1) = CEE * (1.0 - qod(l)/qa(3)) + QA(1) = TX1*RNT + RNF(L-1) + EVP(L-1) = min(EVP(L-1), QA(1)) + QA(1) = QA(1) - EVP(L-1) + +! QRP(L) = 0.0 +! if (tx5 == 0.0 .or. gms(l) == 0.0) then +! write(0,*)' Ctx5=',tx5,' gms=',gms(l),' ror=',ror(l) & +! &, ' L=',L,' QA=',QA(1),' tx1=',tx1,' tx9=',tx9 & +! &, ' kbl=',kbl,' etd1=',etd(l-1),' DEL_ETA=',DEL_ETA +! endif +! IF (QA(1) > 0.0) THEN + + QRP(L) = (QA(1) / (ROR(L)*TX5*GMS(L))) & + & ** (one/1.1364) +! ENDIF + ETD(L) = zero + WVL(L) = zero + ST1 = one - ALFIND(L) + + ERRQ = zero + BUY(L) = - ROR(L) * TX5 * QRP(L) + WCB(L-1) = zero + ENDIF + ENDIF +! + LL = MIN(IDN(idnm), KP1) + IF (ERRQ < one .AND. L <= LL) THEN + IF (ETD(L-1) > zero .AND. ETD(L) == zero) THEN + IDN(idnm) = L + wvl(l) = zero + if (L < KBL .or. tx5 > zero) idnm = idnm + 1 + errq = zero + ENDIF + if (etd(l) == zero .and. l > kbl) then + idn(idnm) = l + if (tx5 > zero) idnm = idnm + 1 + endif + ENDIF + +! +! If downdraft properties are not obtainable, (i.e.solution does +! not converge) , no downdraft is assumed +! +! IF (ERRQ > ERRMIN*100.0 .AND. IDN(idnm) == 99) & + IF (ERRQ > 0.1 .AND. IDN(idnm) == idnmax) DDFT = .FALSE. +! + DOF = zero + IF (.NOT. DDFT) RETURN +! +! if (ddlgk .or. l .le. idn(idnm)) then +! rsum2 = rsum2 + evp(l-1) +! write(0,*)' rsum1=',rsum1,' rsum2=',rsum2,' L=',L,' qa=',qa(1)& +! &, ' evp=',evp(l-1) +! else +! rsum1 = rsum1 + rnf(l-1) +! write(0,*)' rsum1=',rsum1,' rsum2=',rsum2,' L=',L,' rnf=', & +! & rnf(l-1) +! endif + + endif ! if (l < idh) + ENDDO ! End of the L Loop of downdraft ! + + TX1 = zero + + DOF = QA(1) +! +! write(0,*)' dof=',dof,' rntp=',rntp,' rnb=',rnb +! write(0,*)' total=',(rsum1+dof+rntp+rnb) +! + dof = max(dof, zero) + RNN(KD) = RNTP + TX1 = EVP(KD) + TX2 = RNTP + RNB + DOF + + II = IDH + IF (II >= KD1+1) THEN + RNN(KD) = RNN(KD) + RNF(KD) + TX2 = TX2 + RNF(KD) + RNN(II-1) = zero + TX1 = EVP(II-1) + ENDIF + DO L=KD,K + II = IDH + + IF (L > KD1 .AND. L < II) THEN + RNN(L-1) = RNF(L-1) + TX2 = TX2 + RNN(L-1) + ELSEIF (L >= II .AND. L < IDN(idnm)) THEN + rnn(l) = rns(l) + tx2 = tx2 + rnn(l) + TX1 = TX1 + EVP(L) + ELSEIF (L >= IDN(idnm)) THEN + ETD(L+1) = zero + HOD(L+1) = zero + QOD(L+1) = zero + EVP(L) = zero + RNN(L) = RNF(L) + RNS(L) + TX2 = TX2 + RNN(L) + ENDIF + ENDDO +! +! For Downdraft case the rain is that falls thru the bottom + + L = KBL + + RNN(L) = RNN(L) + RNB + CLDFRD(L) = TX5 + +! +! Caution !! Below is an adjustment to rain flux to maintain +! conservation of precip! + +! + IF (TX1 > zero) THEN + TX1 = (TRAIN - TX2) / TX1 + ELSE + TX1 = zero + ENDIF + + DO L=KD,K + EVP(L) = EVP(L) * TX1 + ENDDO + + ENDIF ! if (.not. DDFT) loop endif +! +!*********************************************************************** +!*********************************************************************** + + RETURN + end subroutine ddrft + + SUBROUTINE QSATCN(TT,P,Q,DQDT) +! + USE FUNCPHYS , ONLY : fpvs + + implicit none +! + real(kind=kind_phys) TT, P, Q, DQDT +! +! real(kind=kind_phys), parameter :: ZERO=0.0, ONE=1.0 & +! &, rvi=one/rv, facw=CVAP-CLIQ & +! &, faci=CVAP-CSOL, hsub=alhl+alhf & +! &, tmix=TTP-20.0 & +! &, DEN=one/(TTP-TMIX) +! + real(kind=kind_phys) es, d, hlorv, W +! +! es = 10.0 * fpvs(tt) ! fpvs is in centibars! + es = min(p, 0.01 * fpvs(tt)) ! fpvs is in Pascals! +! D = one / max(p+epsm1*es,ONE_M10) + D = one / (p+epsm1*es) +! + q = MIN(eps*es*D, ONE) +! + W = max(ZERO, min(ONE, (TT - TMIX)*DEN)) + hlorv = ( W * (alhl + FACW * (tt-ttp)) & + & + (one-W) * (hsub + FACI * (tt-ttp)) ) * RVI + dqdt = p * q * hlorv * D / (tt*tt) +! + return + end subroutine qsatcn + + SUBROUTINE ANGRAD(PRES, ALM, AL2, TLA) + implicit none + + real(kind=kind_phys) PRES, ALM, AL2, TLA, TEM +! + integer i +! + IF (TLA < 0.0) THEN + IF (PRES <= PLAC(1)) THEN + TLA = TLAC(1) + ELSEIF (PRES <= PLAC(2)) THEN + TLA = TLAC(2) + (PRES-PLAC(2))*tlbpl(1) + ELSEIF (PRES <= PLAC(3)) THEN + TLA = TLAC(3) + (PRES-PLAC(3))*tlbpl(2) + ELSEIF (PRES <= PLAC(4)) THEN + TLA = TLAC(4) + (PRES-PLAC(4))*tlbpl(3) + ELSEIF (PRES <= PLAC(5)) THEN + TLA = TLAC(5) + (PRES-PLAC(5))*tlbpl(4) + ELSEIF (PRES <= PLAC(6)) THEN + TLA = TLAC(6) + (PRES-PLAC(6))*tlbpl(5) + ELSEIF (PRES <= PLAC(7)) THEN + TLA = TLAC(7) + (PRES-PLAC(7))*tlbpl(6) + ELSEIF (PRES <= PLAC(8)) THEN + TLA = TLAC(8) + (PRES-PLAC(8))*tlbpl(7) + ELSE + TLA = TLAC(8) + ENDIF + ENDIF + IF (PRES >= REFP(1)) THEN + TEM = REFR(1) + ELSEIF (PRES >= REFP(2)) THEN + TEM = REFR(1) + (PRES-REFP(1)) * drdp(1) + ELSEIF (PRES >= REFP(3)) THEN + TEM = REFR(2) + (PRES-REFP(2)) * drdp(2) + ELSEIF (PRES >= REFP(4)) THEN + TEM = REFR(3) + (PRES-REFP(3)) * drdp(3) + ELSEIF (PRES >= REFP(5)) THEN + TEM = REFR(4) + (PRES-REFP(4)) * drdp(4) + ELSEIF (PRES >= REFP(6)) THEN + TEM = REFR(5) + (PRES-REFP(5)) * drdp(5) + ELSE + TEM = REFR(6) + ENDIF +! + tem = 2.0E-4 / tem + al2 = min(4.0*tem, max(alm, tem)) +! + RETURN + end subroutine angrad + + SUBROUTINE SETQRP + implicit none + + real(kind=kind_phys) tem2,tem1,x,xinc,xmax,xmin + integer jx +! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +! XMIN = 1.0E-6 + XMIN = 0.0 + XMAX = 5.0 + XINC = (XMAX-XMIN)/(NQRP-1) + C2XQRP = one / XINC + C1XQRP = one - XMIN*C2XQRP + TEM1 = 0.001 ** 0.2046 + TEM2 = 0.001 ** 0.525 + DO JX=1,NQRP + X = XMIN + (JX-1)*XINC + TBQRP(JX) = X ** 0.1364 + TBQRA(JX) = TEM1 * X ** 0.2046 + TBQRB(JX) = TEM2 * X ** 0.525 + ENDDO +! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + RETURN + end subroutine setqrp + + SUBROUTINE QRABF(QRP,QRAF,QRBF) + implicit none +! + real(kind=kind_phys) QRP, QRAF, QRBF, XJ, REAL_NQRP + INTEGER JX +! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + REAL_NQRP = REAL(NQRP) + XJ = MIN(MAX(C1XQRP+C2XQRP*QRP,ONE),REAL_NQRP) + JX = MIN(XJ,NQRP-ONE) + XJ = XJ - JX + QRAF = TBQRA(JX) + XJ * (TBQRA(JX+1)-TBQRA(JX)) + QRBF = TBQRB(JX) + XJ * (TBQRB(JX+1)-TBQRB(JX)) +! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + RETURN + end subroutine qrabf + + SUBROUTINE SETVTP + implicit none + + real(kind=kind_phys), parameter :: vtpexp=-0.3636, one=1.0 + real(kind=kind_phys) xinc,x,xmax,xmin + integer jx +! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + XMIN = 0.05 + XMAX = 1.5 + XINC = (XMAX-XMIN)/(NVTP-1) + C2XVTP = one / XINC + C1XVTP = one - XMIN*C2XVTP + DO JX=1,NVTP + X = XMIN + (JX-1)*XINC + TBVTP(JX) = X ** VTPEXP + ENDDO +! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + RETURN + end subroutine setvtp +! + real(kind=kind_phys) FUNCTION QRPF(QRP) +! + implicit none + + real(kind=kind_phys) QRP, XJ, REAL_NQRP + INTEGER JX +! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + REAL_NQRP = REAL(NQRP) + XJ = MIN(MAX(C1XQRP+C2XQRP*QRP,ONE),REAL_NQRP) +! XJ = MIN(MAX(C1XQRP+C2XQRP*QRP,ONE),FLOAT(NQRP)) + JX = MIN(XJ,NQRP-ONE) + QRPF = TBQRP(JX) + (XJ-JX) * (TBQRP(JX+1)-TBQRP(JX)) +! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + RETURN + end function qrpf + + real(kind=kind_phys) FUNCTION VTPF(ROR) +! + implicit none + real(kind=kind_phys) ROR, XJ, REAL_NVTP + INTEGER JX +! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + REAL_NVTP = REAL(NVTP) + XJ = MIN(MAX(C1XVTP+C2XVTP*ROR,ONE),REAL_NVTP) + JX = MIN(XJ,NVTP-ONE) + VTPF = TBVTP(JX) + (XJ-JX) * (TBVTP(JX+1)-TBVTP(JX)) +! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + RETURN + end function vtpf + + real(kind=kind_phys) FUNCTION CLF(PRATE) +! + implicit none + real(kind=kind_phys) PRATE +! + real (kind=kind_phys), parameter :: ccf1=0.30, ccf2=0.09 & + &, ccf3=0.04, ccf4=0.01 & + &, pr1=1.0, pr2=5.0 & + &, pr3=20.0 +! + if (prate < pr1) then + clf = ccf1 + elseif (prate < pr2) then + clf = ccf2 + elseif (prate < pr3) then + clf = ccf3 + else + clf = ccf4 + endif +! + RETURN + end function clf + end module rascnv diff --git a/physics/rascnv.meta b/physics/rascnv.meta new file mode 100644 index 000000000..0a201e74d --- /dev/null +++ b/physics/rascnv.meta @@ -0,0 +1,687 @@ +[ccpp-arg-table] + name = rascnv_init + type = scheme +[me] + standard_name = mpi_rank + long_name = current MPI-rank + units = index + dimensions = () + type = integer + intent = in + optional = F +[dt] + standard_name = time_step_for_physics + long_name = physics time step + units = s + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[con_g] + standard_name = gravitational_acceleration + long_name = gravitational acceleration + units = m s-2 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[con_cp] + standard_name = specific_heat_of_dry_air_at_constant_pressure + long_name = specific heat of dry air at constant pressure + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[con_rd] + standard_name = gas_constant_dry_air + long_name = ideal gas constant for dry air + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[con_rv] + standard_name = gas_constant_water_vapor + long_name = ideal gas constant for water vapor + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[con_hvap] + standard_name = latent_heat_of_vaporization_of_water_at_0C + long_name = latent heat of evaporation/sublimation + units = J kg-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[con_hfus] + standard_name = latent_heat_of_fusion_of_water_at_0C + long_name = latent heat of fusion + units = J kg-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[con_fvirt] + standard_name = ratio_of_vapor_to_dry_air_gas_constants_minus_one + long_name = (rv/rd) - 1 (rv = ideal gas constant for water vapor) + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[con_t0c] + standard_name = temperature_at_zero_celsius + long_name = temperature at 0 degrees Celsius + units = K + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[con_ttp] + standard_name = triple_point_temperature_of_water + long_name = triple point temperature of water + units = K + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[con_cvap] + standard_name = specific_heat_of_water_vapor_at_constant_pressure + long_name = specific heat of water vapor at constant pressure + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[con_cliq] + standard_name = specific_heat_of_liquid_water_at_constant_pressure + long_name = specific heat of liquid water at constant pressure + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[con_csol] + standard_name = specific_heat_of_ice_at_constant_pressure + long_name = specific heat of ice at constant pressure + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[con_eps] + standard_name = ratio_of_dry_air_to_water_vapor_gas_constants + long_name = rd/rv + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[con_epsm1] + standard_name = ratio_of_dry_air_to_water_vapor_gas_constants_minus_one + long_name = (rd/rv) - 1 + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F + +######################################################################## +[ccpp-arg-table] + name = rascnv_finalize + type = scheme +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F + +######################################################################## +[ccpp-arg-table] + name = rascnv_run + type = scheme +[im] + standard_name = horizontal_loop_extent + long_name = horizontal loop extent + units = count + dimensions = () + type = integer + intent = in + optional = F +[ix] + standard_name = horizontal_dimension + long_name = horizontal dimension + units = count + dimensions = () + type = integer + intent = in + optional = F +[k] + standard_name = vertical_dimension + long_name = vertical layer dimension + units = count + dimensions = () + type = integer + intent = in + optional = F +[ntr] + standard_name = number_of_tracers_for_samf + long_name = number of tracers for scale-aware mass flux schemes + units = count + dimensions = () + type = integer + intent = in + optional = F +[dt] + standard_name = time_step_for_physics + long_name = physics time step + units = s + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[dtf] + standard_name = time_step_for_dynamics + long_name = dynamics timestep + units = s + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[ccwf] + standard_name = multiplication_factor_for_critical_cloud_workfunction + long_name = multiplication factor for tical_cloud_workfunction + units = none + dimensions = (2) + type = real + kind = kind_phys + intent = in + optional = F +[area] + standard_name = cell_area + long_name = area of the grid cell + units = m2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[dxmin] + standard_name = minimum_scaling_factor_for_critical_relative_humidity + long_name = minimum scaling factor for critical relative humidity + units = m2 rad-2 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[dxinv] + standard_name = inverse_scaling_factor_for_critical_relative_humidity + long_name = inverse scaling factor for critical relative humidity + units = rad2 m-2 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[psauras] + standard_name = coefficient_from_cloud_ice_to_snow_ras + long_name = conversion coefficient from cloud ice to snow in ras + units = none + dimensions = (2) + type = real + kind = kind_phys + intent = in + optional = F +[prauras] + standard_name = coefficient_from_cloud_water_to_rain_ras + long_name = conversion coefficient from cloud water to rain in ras + units = none + dimensions = (2) + type = real + kind = kind_phys + intent = in + optional = F +[wminras] + standard_name = cloud_condensed_water_ice_conversion_threshold_ras + long_name = conversion coefficient from cloud liquid and ice to precipitation in ras + units = none + dimensions = (2) + type = real + kind = kind_phys + intent = in + optional = F +[dlqf] + standard_name = condensate_fraction_detrained_in_updraft_layers + long_name = condensate fraction detrained with in a updraft layers + units = none + dimensions = (2) + type = real + kind = kind_phys + intent = in + optional = F +[flipv] + standard_name = flag_flip + long_name = vertical flip logical + units = flag + dimensions = () + type = logical + intent = in + optional = F +[me] + standard_name = mpi_rank + long_name = current MPI-rank + units = index + dimensions = () + type = integer + intent = in + optional = F +[rannum] + standard_name = random_number_array + long_name = random number array (0-1) + units = none + dimensions = (horizontal_dimension,array_dimension_of_random_number) + type = real + kind = kind_phys + intent = in + optional = F +[nrcm] + standard_name = array_dimension_of_random_number + long_name = second dimension of random number stream for RAS + units = count + dimensions = () + type = integer + intent = in + optional = F +[mp_phys] + standard_name = flag_for_microphysics_scheme + long_name = choice of microphysics scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F +[mp_phys_mg] + standard_name = flag_for_morrison_gettelman_microphysics_scheme + long_name = choice of Morrison-Gettelman microphysics scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F +[ntk] + standard_name = index_for_turbulent_kinetic_energy_convective_transport_tracer + long_name = index for turbulent kinetic energy in the convectively transported tracer array + units = index + dimensions = () + type = integer + intent = in + optional = F +[kdt] + standard_name = index_of_time_step + long_name = current forecast iteration + units = index + dimensions = () + type = integer + intent = in + optional = F +[rhc] + standard_name = critical_relative_humidity + long_name = critical relative humidity + units = frac + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[tin] + standard_name = air_temperature_updated_by_physics + long_name = updated temperature + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[qin] + standard_name = water_vapor_specific_humidity_updated_by_physics + long_name = updated vapor specific humidity + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[uin] + standard_name = x_wind_updated_by_physics + long_name = updated x-direction wind + units = m s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[vin] + standard_name = y_wind_updated_by_physics + long_name = updated y-direction wind + units = m s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[ccin] + standard_name = convective_transportable_tracers + long_name = array to contain cloud water and other convective trans. tracers + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension,tracer_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[fscav] + standard_name = coefficients_for_aerosol_scavenging + long_name = array of aerosol scavenging coefficients + units = none + dimensions = (number_of_chemical_tracers) + type = real + kind = kind_phys + intent = in + optional = F +[prsi] + standard_name = air_pressure_at_interface + long_name = air pressure at model layer interfaces + units = Pa + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[prsl] + standard_name = air_pressure + long_name = mean layer pressure + units = Pa + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[prsik] + standard_name = dimensionless_exner_function_at_model_interfaces + long_name = dimensionless Exner function at model layer interfaces + units = none + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[prslk] + standard_name = dimensionless_exner_function_at_model_layers + long_name = dimensionless Exner function at model layer centers + units = none + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[phil] + standard_name = geopotential + long_name = geopotential at model layer centers + units = m2 s-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[phii] + standard_name = geopotential_at_interface + long_name = geopotential at model layer interfaces + units = m2 s-2 + dimensions = (horizontal_dimension,vertical_dimension_plus_one) + type = real + kind = kind_phys + intent = in + optional = F +[kpbl] + standard_name = vertical_index_at_top_of_atmosphere_boundary_layer + long_name = vertical index at top atmospheric boundary layer + units = index + dimensions = (horizontal_dimension) + type = integer + intent = in + optional = F +[cdrag] + standard_name = surface_drag_coefficient_for_momentum_in_air + long_name = surface exchange coeff for momentum + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[rainc] + standard_name = lwe_thickness_of_deep_convective_precipitation_amount + long_name = deep convective rainfall amount on physics timestep + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[kbot] + standard_name = vertical_index_at_cloud_base + long_name = index for cloud base + units = index + dimensions = (horizontal_dimension) + type = integer + intent = out + optional = F +[ktop] + standard_name = vertical_index_at_cloud_top + long_name = index for cloud top + units = index + dimensions = (horizontal_dimension) + type = integer + intent = out + optional = F +[kcnv] + standard_name = flag_deep_convection + long_name = deep convection: 0=no, 1=yes + units = flag + dimensions = (horizontal_dimension) + type = integer + intent = inout + optional = F +[ddvel] + standard_name = surface_wind_enhancement_due_to_convection + long_name = surface wind enhancement due to convection + units = m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[ud_mf] + standard_name = instantaneous_atmosphere_updraft_convective_mass_flux + long_name = (updraft mass flux) * dt + units = kg m-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[dd_mf] + standard_name = instantaneous_atmosphere_downdraft_convective_mass_flux + long_name = (downdraft mass flux) * dt + units = kg m-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[dt_mf] + standard_name = instantaneous_atmosphere_detrainment_convective_mass_flux + long_name = (detrainment mass flux) * dt + units = kg m-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[qlcn] + standard_name = mass_fraction_of_convective_cloud_liquid_water + long_name = mass fraction of convective cloud liquid water + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[qicn] + standard_name = mass_fraction_of_convective_cloud_ice + long_name = mass fraction of convective cloud ice water + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[w_upi] + standard_name = vertical_velocity_for_updraft + long_name = vertical velocity for updraft + units = m s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[cf_upi] + standard_name = convective_cloud_fraction_for_microphysics + long_name = convective cloud fraction for microphysics + units = frac + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[cnv_mfd] + standard_name = detrained_mass_flux + long_name = detrained mass flux + units = kg m-2 s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[cnv_dqldt] + standard_name = tendency_of_cloud_water_due_to_convective_microphysics + long_name = tendency of cloud water due to convective microphysics + units = kg m-2 s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[clcn] + standard_name = convective_cloud_volume_fraction + long_name = convective cloud volume fraction + units = frac + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[cnv_fice] + standard_name = ice_fraction_in_convective_tower + long_name = ice fraction in convective tower + units = frac + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[cnv_ndrop] + standard_name = number_concentration_of_cloud_liquid_water_particles_for_detrainment + long_name = droplet number concentration in convective detrainment + units = m-3 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[cnv_nice] + standard_name = number_concentration_of_ice_crystals_for_detrainment + long_name = crystal number concentration in convective detrainment + units = m-3 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F diff --git a/physics/rayleigh_damp.f b/physics/rayleigh_damp.f index 1e5711347..3231a16d8 100644 --- a/physics/rayleigh_damp.f +++ b/physics/rayleigh_damp.f @@ -11,7 +11,7 @@ module rayleigh_damp subroutine rayleigh_damp_init () end subroutine rayleigh_damp_init -!>\defgroup rayleigh_main GFS Rayleigh Damping Main +!>\defgroup rayleigh_main GFS Rayleigh Damping Module !!\brief This is the Rayleigh friction calculation with total energy conservation. !! !! Role of Rayleigh friction, it attempts to resolve two issues: @@ -19,26 +19,7 @@ end subroutine rayleigh_damp_init !! - The winter-summer zonal wind drag in the strato-mesosphere !! !! \section arg_table_rayleigh_damp_run Argument Table -!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | -!! |----------------|------------------------------------------------------|------------------------------------------------------|------------|------|-----------|-----------|--------|----------| -!! | lsidea | flag_idealized_physics | flag for idealized physics | flag | 0 | logical | | in | F | -!! | im | horizontal_loop_extent | horizontal loop extent | count | 0 | integer | | in | F | -!! | ix | horizontal_dimension | horizontal dimension | count | 0 | integer | | in | F | -!! | km | vertical_dimension | number of vertical layers | count | 0 | integer | | in | F | -!! | A | tendency_of_y_wind_due_to_model_physics | meridional wind tendency due to model physics | m s-2 | 2 | real | kind_phys | inout | F | -!! | B | tendency_of_x_wind_due_to_model_physics | zonal wind tendency due to model physics | m s-2 | 2 | real | kind_phys | inout | F | -!! | C | tendency_of_air_temperature_due_to_model_physics | air temperature tendency due to model physics | K s-1 | 2 | real | kind_phys | inout | F | -!! | u1 | x_wind | zonal wind | m s-1 | 2 | real | kind_phys | in | F | -!! | v1 | y_wind | meridional wind | m s-1 | 2 | real | kind_phys | in | F | -!! | dt | time_step_for_physics | physics time step | s | 0 | real | kind_phys | in | F | -!! | cp | specific_heat_of_dry_air_at_constant_pressure | specific heat of dry air at constant pressure | J kg-1 K-1 | 0 | real | kind_phys | in | F | -!! | levr | number_of_vertical_layers_for_radiation_calculations | number of vertical layers for radiation calculations | count | 0 | integer | | in | F | -!! | pgr | surface_air_pressure | surface pressure | Pa | 1 | real | kind_phys | in | F | -!! | prsl | air_pressure | mid-layer pressure | Pa | 2 | real | kind_phys | in | F | -!! | prslrd0 | pressure_cutoff_for_rayleigh_damping | pressure level above which to apply Rayleigh damping | Pa | 0 | real | kind_phys | in | F | -!! | ral_ts | time_scale_for_rayleigh_damping | time scale for Rayleigh damping | d | 0 | real | kind_phys | in | F | -!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | -!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | +!! \htmlinclude rayleigh_damp_run.html !! !>\section gen_ray_damp_run GFS rayleigh_damp_runGeneral Algorithm !> @{ diff --git a/physics/rayleigh_damp.meta b/physics/rayleigh_damp.meta new file mode 100644 index 000000000..ec08802e8 --- /dev/null +++ b/physics/rayleigh_damp.meta @@ -0,0 +1,169 @@ +[ccpp-arg-table] + name = rayleigh_damp_init + type = scheme + +######################################################################## +[ccpp-arg-table] + name = rayleigh_damp_run + type = scheme +[lsidea] + standard_name = flag_idealized_physics + long_name = flag for idealized physics + units = flag + dimensions = () + type = logical + intent = in + optional = F +[im] + standard_name = horizontal_loop_extent + long_name = horizontal loop extent + units = count + dimensions = () + type = integer + intent = in + optional = F +[ix] + standard_name = horizontal_dimension + long_name = horizontal dimension + units = count + dimensions = () + type = integer + intent = in + optional = F +[km] + standard_name = vertical_dimension + long_name = number of vertical layers + units = count + dimensions = () + type = integer + intent = in + optional = F +[A] + standard_name = tendency_of_y_wind_due_to_model_physics + long_name = meridional wind tendency due to model physics + units = m s-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[B] + standard_name = tendency_of_x_wind_due_to_model_physics + long_name = zonal wind tendency due to model physics + units = m s-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[C] + standard_name = tendency_of_air_temperature_due_to_model_physics + long_name = air temperature tendency due to model physics + units = K s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[u1] + standard_name = x_wind + long_name = zonal wind + units = m s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[v1] + standard_name = y_wind + long_name = meridional wind + units = m s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[dt] + standard_name = time_step_for_physics + long_name = physics time step + units = s + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[cp] + standard_name = specific_heat_of_dry_air_at_constant_pressure + long_name = specific heat of dry air at constant pressure + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[levr] + standard_name = number_of_vertical_layers_for_radiation_calculations + long_name = number of vertical layers for radiation calculations + units = count + dimensions = () + type = integer + intent = in + optional = F +[pgr] + standard_name = surface_air_pressure + long_name = surface pressure + units = Pa + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[prsl] + standard_name = air_pressure + long_name = mid-layer pressure + units = Pa + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[prslrd0] + standard_name = pressure_cutoff_for_rayleigh_damping + long_name = pressure level above which to apply Rayleigh damping + units = Pa + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[ral_ts] + standard_name = time_scale_for_rayleigh_damping + long_name = time scale for Rayleigh damping + units = d + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F + +######################################################################## +[ccpp-arg-table] + name = rayleigh_damp_finalize + type = scheme diff --git a/physics/rrtmg_lw_post.F90 b/physics/rrtmg_lw_post.F90 index 0eacfe2ef..971b278dd 100644 --- a/physics/rrtmg_lw_post.F90 +++ b/physics/rrtmg_lw_post.F90 @@ -13,21 +13,7 @@ end subroutine rrtmg_lw_post_init ! PGI compiler does not accept lines longer than 264 characters, remove during pre-processing #ifndef __PGI !> \section arg_table_rrtmg_lw_post_run Argument Table -!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | -!! |-----------------|-----------------------------------------------------------------------------------------------|------------------------------------------------------------------------------|----------|------|-----------------------|-----------|-----------|----------| -!! | Model | GFS_control_type_instance | Fortran DDT containing FV3-GFS model control parameters | DDT | 0 | GFS_control_type | | in | F | -!! | Grid | GFS_grid_type_instance | Fortran DDT containing FV3-GFS grid and interpolation related data | DDT | 0 | GFS_grid_type | | in | F | -!! | Radtend | GFS_radtend_type_instance | Fortran DDT containing FV3-GFS fields targetted for diagnostic output | DDT | 0 | GFS_radtend_type | | inout | F | -!! | Coupling | GFS_coupling_type_instance | Fortran DDT containing FV3-GFS fields to/from coupling with other components | DDT | 0 | GFS_coupling_type | | inout | F | -!! | im | horizontal_loop_extent | horizontal loop extent | count | 0 | integer | | in | F | -!! | ltp | extra_top_layer | extra top layers | none | 0 | integer | | in | F | -!! | lm | vertical_layer_dimension_for_radiation | number of vertical layers for radiation calculation | count | 0 | integer | | in | F | -!! | kd | vertical_index_difference_between_inout_and_local | vertical index difference between in/out and local | index | 0 | integer | | in | F | -!! | tsfa | surface_air_temperature_for_radiation | lowest model layer air temperature for radiation | K | 1 | real | kind_phys | in | F | -!! | htlwc | tendency_of_air_temperature_due_to_longwave_heating_on_radiation_time_step | total sky heating rate due to longwave radiation | K s-1 | 2 | real | kind_phys | in | F | -!! | htlw0 | tendency_of_air_temperature_due_to_longwave_heating_assuming_clear_sky_on_radiation_time_step | clear sky heating rate due to longwave radiation | K s-1 | 2 | real | kind_phys | in | F | -!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | -!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | +!! \htmlinclude rrtmg_lw_post_run.html !! #endif subroutine rrtmg_lw_post_run (Model, Grid, Radtend, Coupling, & diff --git a/physics/rrtmg_lw_post.meta b/physics/rrtmg_lw_post.meta new file mode 100644 index 000000000..92b4003d7 --- /dev/null +++ b/physics/rrtmg_lw_post.meta @@ -0,0 +1,121 @@ +[ccpp-arg-table] + name = rrtmg_lw_post_init + type = scheme + +######################################################################## +[ccpp-arg-table] + name = rrtmg_lw_post_run + type = scheme +[Model] + standard_name = GFS_control_type_instance + long_name = Fortran DDT containing FV3-GFS model control parameters + units = DDT + dimensions = () + type = GFS_control_type + intent = in + optional = F +[Grid] + standard_name = GFS_grid_type_instance + long_name = Fortran DDT containing FV3-GFS grid and interpolation related data + units = DDT + dimensions = () + type = GFS_grid_type + intent = in + optional = F +[Radtend] + standard_name = GFS_radtend_type_instance + long_name = Fortran DDT containing FV3-GFS fields targetted for diagnostic output + units = DDT + dimensions = () + type = GFS_radtend_type + intent = inout + optional = F +[Coupling] + standard_name = GFS_coupling_type_instance + long_name = Fortran DDT containing FV3-GFS fields to/from coupling with other components + units = DDT + dimensions = () + type = GFS_coupling_type + intent = inout + optional = F +[im] + standard_name = horizontal_loop_extent + long_name = horizontal loop extent + units = count + dimensions = () + type = integer + intent = in + optional = F +[ltp] + standard_name = extra_top_layer + long_name = extra top layers + units = none + dimensions = () + type = integer + intent = in + optional = F +[lm] + standard_name = number_of_vertical_layers_for_radiation_calculations + long_name = number of vertical layers for radiation calculation + units = count + dimensions = () + type = integer + intent = in + optional = F +[kd] + standard_name = vertical_index_difference_between_inout_and_local + long_name = vertical index difference between in/out and local + units = index + dimensions = () + type = integer + intent = in + optional = F +[tsfa] + standard_name = surface_air_temperature_for_radiation + long_name = lowest model layer air temperature for radiation + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[htlwc] + standard_name = tendency_of_air_temperature_due_to_longwave_heating_on_radiation_time_step + long_name = total sky heating rate due to longwave radiation + units = K s-1 + dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + type = real + kind = kind_phys + intent = in + optional = F +[htlw0] + standard_name = tendency_of_air_temperature_due_to_longwave_heating_assuming_clear_sky_on_radiation_time_step + long_name = clear sky heating rate due to longwave radiation + units = K s-1 + dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + type = real + kind = kind_phys + intent = in + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F + +######################################################################## +[ccpp-arg-table] + name = rrtmg_lw_post_finalize + type = scheme diff --git a/physics/rrtmg_lw_pre.F90 b/physics/rrtmg_lw_pre.F90 index b45a2932f..5f128a79a 100644 --- a/physics/rrtmg_lw_pre.F90 +++ b/physics/rrtmg_lw_pre.F90 @@ -12,17 +12,7 @@ subroutine rrtmg_lw_pre_init () end subroutine rrtmg_lw_pre_init !> \section arg_table_rrtmg_lw_pre_run Argument Table -!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | -!! |----------------|-------------------------------------------|--------------------------------------------------------------------|----------|------|-----------------------|-----------|--------|----------| -!! | Model | GFS_control_type_instance | Fortran DDT containing FV3-GFS model control parameters | DDT | 0 | GFS_control_type | | in | F | -!! | Grid | GFS_grid_type_instance | Fortran DDT containing FV3-GFS grid and interpolation related data | DDT | 0 | GFS_grid_type | | in | F | -!! | Sfcprop | GFS_sfcprop_type_instance | Fortran DDT containing FV3-GFS surface fields | DDT | 0 | GFS_sfcprop_type | | in | F | -!! | Radtend | GFS_radtend_type_instance | Fortran DDT containing FV3-GFS radiation tendencies | DDT | 0 | GFS_radtend_type | | inout | F | -!! | im | horizontal_loop_extent | horizontal loop extent | count | 0 | integer | | in | F | -!! | tsfg | surface_ground_temperature_for_radiation | surface ground temperature for radiation | K | 1 | real | kind_phys | in | F | -!! | tsfa | surface_air_temperature_for_radiation | lowest model layer air temperature for radiation | K | 1 | real | kind_phys | in | F | -!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | -!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | +!! \htmlinclude rrtmg_lw_pre_run.html !! subroutine rrtmg_lw_pre_run (Model, Grid, Sfcprop, Radtend, im, tsfg, tsfa, errmsg, errflg) @@ -53,7 +43,7 @@ subroutine rrtmg_lw_pre_run (Model, Grid, Sfcprop, Radtend, im, tsfg, tsfa, errm !! emissivity for LW radiation. call setemis (Grid%xlon, Grid%xlat, Sfcprop%slmsk, & ! --- inputs Sfcprop%snowd, Sfcprop%sncovr, Sfcprop%zorl, & - tsfg, tsfa, Sfcprop%hprim, IM, & + tsfg, tsfa, Sfcprop%hprime(:,1), IM, & Radtend%semis) ! --- outputs endif diff --git a/physics/rrtmg_lw_pre.meta b/physics/rrtmg_lw_pre.meta new file mode 100644 index 000000000..6b4488b26 --- /dev/null +++ b/physics/rrtmg_lw_pre.meta @@ -0,0 +1,88 @@ +[ccpp-arg-table] + name = rrtmg_lw_pre_init + type = scheme + +######################################################################## +[ccpp-arg-table] + name = rrtmg_lw_pre_run + type = scheme +[Model] + standard_name = GFS_control_type_instance + long_name = Fortran DDT containing FV3-GFS model control parameters + units = DDT + dimensions = () + type = GFS_control_type + intent = in + optional = F +[Grid] + standard_name = GFS_grid_type_instance + long_name = Fortran DDT containing FV3-GFS grid and interpolation related data + units = DDT + dimensions = () + type = GFS_grid_type + intent = in + optional = F +[Sfcprop] + standard_name = GFS_sfcprop_type_instance + long_name = Fortran DDT containing FV3-GFS surface fields + units = DDT + dimensions = () + type = GFS_sfcprop_type + intent = in + optional = F +[Radtend] + standard_name = GFS_radtend_type_instance + long_name = Fortran DDT containing FV3-GFS radiation tendencies + units = DDT + dimensions = () + type = GFS_radtend_type + intent = inout + optional = F +[im] + standard_name = horizontal_loop_extent + long_name = horizontal loop extent + units = count + dimensions = () + type = integer + intent = in + optional = F +[tsfg] + standard_name = surface_ground_temperature_for_radiation + long_name = surface ground temperature for radiation + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[tsfa] + standard_name = surface_air_temperature_for_radiation + long_name = lowest model layer air temperature for radiation + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F + +######################################################################## +[ccpp-arg-table] + name = rrtmg_lw_pre_finalize + type = scheme diff --git a/physics/rrtmg_sw_post.F90 b/physics/rrtmg_sw_post.F90 index a80c62652..e11491d48 100644 --- a/physics/rrtmg_sw_post.F90 +++ b/physics/rrtmg_sw_post.F90 @@ -12,27 +12,7 @@ end subroutine rrtmg_sw_post_init ! PGI compiler does not accept lines longer than 264 characters, remove during pre-processing #ifndef __PGI !> \section arg_table_rrtmg_sw_post_run Argument Table -!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | -!! |----------------|------------------------------------------------------------------------------------------------|------------------------------------------------------------------------------|----------|------|-----------------------|-----------|--------|----------| -!! | Model | GFS_control_type_instance | Fortran DDT containing FV3-GFS model control parameters | DDT | 0 | GFS_control_type | | in | F | -!! | Grid | GFS_grid_type_instance | Fortran DDT containing FV3-GFS grid and interpolation related data | DDT | 0 | GFS_grid_type | | in | F | -!! | Diag | GFS_diag_type_instance | Fortran DDT containing FV3-GFS diagnotics data | DDT | 0 | GFS_diag_type | | inout | F | -!! | Radtend | GFS_radtend_type_instance | Fortran DDT containing FV3-GFS fields targetted for diagnostic output | DDT | 0 | GFS_radtend_type | | inout | F | -!! | Coupling | GFS_coupling_type_instance | Fortran DDT containing FV3-GFS fields to/from coupling with other components | DDT | 0 | GFS_coupling_type | | inout | F | -!! | im | horizontal_loop_extent | horizontal loop extent | count | 0 | integer | | in | F | -!! | ltp | extra_top_layer | extra top layers | none | 0 | integer | | in | F | -!! | nday | daytime_points_dimension | daytime points dimension | count | 0 | integer | | in | F | -!! | lm | vertical_layer_dimension_for_radiation | number of vertical layers for radiation calculation | count | 0 | integer | | in | F | -!! | kd | vertical_index_difference_between_inout_and_local | vertical index difference between in/out and local | index | 0 | integer | | in | F | -!! | htswc | tendency_of_air_temperature_due_to_shortwave_heating_on_radiation_time_step | total sky heating rate due to shortwave radiation | K s-1 | 2 | real | kind_phys | in | F | -!! | htsw0 | tendency_of_air_temperature_due_to_shortwave_heating_assuming_clear_sky_on_radiation_time_step | clear sky heating rates due to shortwave radiation | K s-1 | 2 | real | kind_phys | in | F | -!! | sfcalb1 | surface_albedo_due_to_near_IR_direct | surface albedo due to near IR direct beam | frac | 1 | real | kind_phys | in | F | -!! | sfcalb2 | surface_albedo_due_to_near_IR_diffused | surface albedo due to near IR diffused beam | frac | 1 | real | kind_phys | in | F | -!! | sfcalb3 | surface_albedo_due_to_UV_and_VIS_direct | surface albedo due to UV+VIS direct beam | frac | 1 | real | kind_phys | in | F | -!! | sfcalb4 | surface_albedo_due_to_UV_and_VIS_diffused | surface albedo due to UV+VIS diffused beam | frac | 1 | real | kind_phys | in | F | -!! | scmpsw | components_of_surface_downward_shortwave_fluxes | derived type for special components of surface downward shortwave fluxes | W m-2 | 1 | cmpfsw_type | | inout | F | -!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | -!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | +!! \htmlinclude rrtmg_sw_post_run.html !! #endif subroutine rrtmg_sw_post_run (Model, Grid, Diag, Radtend, Coupling, & diff --git a/physics/rrtmg_sw_post.meta b/physics/rrtmg_sw_post.meta new file mode 100644 index 000000000..28b54b5bf --- /dev/null +++ b/physics/rrtmg_sw_post.meta @@ -0,0 +1,172 @@ +[ccpp-arg-table] + name = rrtmg_sw_post_init + type = scheme + +######################################################################## +[ccpp-arg-table] + name = rrtmg_sw_post_run + type = scheme +[Model] + standard_name = GFS_control_type_instance + long_name = Fortran DDT containing FV3-GFS model control parameters + units = DDT + dimensions = () + type = GFS_control_type + intent = in + optional = F +[Grid] + standard_name = GFS_grid_type_instance + long_name = Fortran DDT containing FV3-GFS grid and interpolation related data + units = DDT + dimensions = () + type = GFS_grid_type + intent = in + optional = F +[Diag] + standard_name = GFS_diag_type_instance + long_name = Fortran DDT containing FV3-GFS diagnotics data + units = DDT + dimensions = () + type = GFS_diag_type + intent = inout + optional = F +[Radtend] + standard_name = GFS_radtend_type_instance + long_name = Fortran DDT containing FV3-GFS fields targetted for diagnostic output + units = DDT + dimensions = () + type = GFS_radtend_type + intent = inout + optional = F +[Coupling] + standard_name = GFS_coupling_type_instance + long_name = Fortran DDT containing FV3-GFS fields to/from coupling with other components + units = DDT + dimensions = () + type = GFS_coupling_type + intent = inout + optional = F +[im] + standard_name = horizontal_loop_extent + long_name = horizontal loop extent + units = count + dimensions = () + type = integer + intent = in + optional = F +[ltp] + standard_name = extra_top_layer + long_name = extra top layers + units = none + dimensions = () + type = integer + intent = in + optional = F +[nday] + standard_name = daytime_points_dimension + long_name = daytime points dimension + units = count + dimensions = () + type = integer + intent = in + optional = F +[lm] + standard_name = number_of_vertical_layers_for_radiation_calculations + long_name = number of vertical layers for radiation calculation + units = count + dimensions = () + type = integer + intent = in + optional = F +[kd] + standard_name = vertical_index_difference_between_inout_and_local + long_name = vertical index difference between in/out and local + units = index + dimensions = () + type = integer + intent = in + optional = F +[htswc] + standard_name = tendency_of_air_temperature_due_to_shortwave_heating_on_radiation_time_step + long_name = total sky heating rate due to shortwave radiation + units = K s-1 + dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + type = real + kind = kind_phys + intent = in + optional = F +[htsw0] + standard_name = tendency_of_air_temperature_due_to_shortwave_heating_assuming_clear_sky_on_radiation_time_step + long_name = clear sky heating rates due to shortwave radiation + units = K s-1 + dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + type = real + kind = kind_phys + intent = in + optional = F +[sfcalb1] + standard_name = surface_albedo_due_to_near_IR_direct + long_name = surface albedo due to near IR direct beam + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[sfcalb2] + standard_name = surface_albedo_due_to_near_IR_diffused + long_name = surface albedo due to near IR diffused beam + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[sfcalb3] + standard_name = surface_albedo_due_to_UV_and_VIS_direct + long_name = surface albedo due to UV+VIS direct beam + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[sfcalb4] + standard_name = surface_albedo_due_to_UV_and_VIS_diffused + long_name = surface albedo due to UV+VIS diffused beam + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[scmpsw] + standard_name = components_of_surface_downward_shortwave_fluxes + long_name = derived type for special components of surface downward shortwave fluxes + units = W m-2 + dimensions = (horizontal_dimension) + type = cmpfsw_type + intent = inout + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F + +######################################################################## +[ccpp-arg-table] + name = rrtmg_sw_post_finalize + type = scheme diff --git a/physics/rrtmg_sw_pre.F90 b/physics/rrtmg_sw_pre.F90 index 2a9665ad1..8eeb16430 100644 --- a/physics/rrtmg_sw_pre.F90 +++ b/physics/rrtmg_sw_pre.F90 @@ -12,24 +12,7 @@ subroutine rrtmg_sw_pre_init () end subroutine rrtmg_sw_pre_init !> \section arg_table_rrtmg_sw_pre_run Argument Table -!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | -!! |----------------|-------------------------------------------|--------------------------------------------------------------------|----------|------|------------------|-----------|--------|----------| -!! | Model | GFS_control_type_instance | Fortran DDT containing FV3-GFS model control parameters | DDT | 0 | GFS_control_type | | in | F | -!! | Grid | GFS_grid_type_instance | Fortran DDT containing FV3-GFS grid and interpolation related data | DDT | 0 | GFS_grid_type | | in | F | -!! | Sfcprop | GFS_sfcprop_type_instance | Fortran DDT containing FV3-GFS surface fields | DDT | 0 | GFS_sfcprop_type | | in | F | -!! | Radtend | GFS_radtend_type_instance | Fortran DDT containing FV3-GFS radiation tendencies | DDT | 0 | GFS_radtend_type | | inout | F | -!! | im | horizontal_loop_extent | horizontal loop extent | count | 0 | integer | | in | F | -!! | nday | daytime_points_dimension | daytime points dimension | count | 0 | integer | | out | F | -!! | idxday | daytime_points | daytime points | index | 1 | integer | | out | F | -!! | tsfg | surface_ground_temperature_for_radiation | surface ground temperature for radiation | K | 1 | real | kind_phys | in | F | -!! | tsfa | surface_air_temperature_for_radiation | lowest model layer air temperature for radiation | K | 1 | real | kind_phys | in | F | -!! | sfcalb1 | surface_albedo_due_to_near_IR_direct | surface albedo due to near IR direct beam | frac | 1 | real | kind_phys | out | F | -!! | sfcalb2 | surface_albedo_due_to_near_IR_diffused | surface albedo due to near IR diffused beam | frac | 1 | real | kind_phys | out | F | -!! | sfcalb3 | surface_albedo_due_to_UV_and_VIS_direct | surface albedo due to UV+VIS direct beam | frac | 1 | real | kind_phys | out | F | -!! | sfcalb4 | surface_albedo_due_to_UV_and_VIS_diffused | surface albedo due to UV+VIS diffused beam | frac | 1 | real | kind_phys | out | F | -!! | alb1d | surface_albedo_perturbation | surface albedo perturbation | frac | 1 | real | kind_phys | in | F | -!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | -!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | +!! \htmlinclude rrtmg_sw_pre_run.html !! subroutine rrtmg_sw_pre_run (Model, Grid, Sfcprop, Radtend, im, & nday, idxday, tsfg, tsfa, sfcalb1, sfcalb2, sfcalb3, sfcalb4, & @@ -83,13 +66,13 @@ subroutine rrtmg_sw_pre_run (Model, Grid, Sfcprop, Radtend, im, & !> - Call module_radiation_surface::setalb() to setup surface albedo. !! for SW radiation. - call setalb (Sfcprop%slmsk, Sfcprop%snowd, Sfcprop%sncovr,& ! --- inputs: - Sfcprop%snoalb, Sfcprop%zorl, Radtend%coszen,& - tsfg, tsfa, Sfcprop%hprim, Sfcprop%alvsf, & - Sfcprop%alnsf, Sfcprop%alvwf, Sfcprop%alnwf, & - Sfcprop%facsf, Sfcprop%facwf, Sfcprop%fice, & - Sfcprop%tisfc, IM, & - alb1d, Model%pertalb, & ! mg, sfc-perts + call setalb (Sfcprop%slmsk, Sfcprop%snowd, Sfcprop%sncovr, & ! --- inputs: + Sfcprop%snoalb, Sfcprop%zorl, Radtend%coszen, & + tsfg, tsfa, Sfcprop%hprime(:,1), Sfcprop%alvsf, & + Sfcprop%alnsf, Sfcprop%alvwf, Sfcprop%alnwf, & + Sfcprop%facsf, Sfcprop%facwf, Sfcprop%fice, & + Sfcprop%tisfc, IM, & + alb1d, Model%pertalb, & ! mg, sfc-perts sfcalb) ! --- outputs !> -# Approximate mean surface albedo from vis- and nir- diffuse values. diff --git a/physics/rrtmg_sw_pre.meta b/physics/rrtmg_sw_pre.meta new file mode 100644 index 000000000..6a68a8cd6 --- /dev/null +++ b/physics/rrtmg_sw_pre.meta @@ -0,0 +1,149 @@ +[ccpp-arg-table] + name = rrtmg_sw_pre_init + type = scheme + +######################################################################## +[ccpp-arg-table] + name = rrtmg_sw_pre_run + type = scheme +[Model] + standard_name = GFS_control_type_instance + long_name = Fortran DDT containing FV3-GFS model control parameters + units = DDT + dimensions = () + type = GFS_control_type + intent = in + optional = F +[Grid] + standard_name = GFS_grid_type_instance + long_name = Fortran DDT containing FV3-GFS grid and interpolation related data + units = DDT + dimensions = () + type = GFS_grid_type + intent = in + optional = F +[Sfcprop] + standard_name = GFS_sfcprop_type_instance + long_name = Fortran DDT containing FV3-GFS surface fields + units = DDT + dimensions = () + type = GFS_sfcprop_type + intent = in + optional = F +[Radtend] + standard_name = GFS_radtend_type_instance + long_name = Fortran DDT containing FV3-GFS radiation tendencies + units = DDT + dimensions = () + type = GFS_radtend_type + intent = inout + optional = F +[im] + standard_name = horizontal_loop_extent + long_name = horizontal loop extent + units = count + dimensions = () + type = integer + intent = in + optional = F +[nday] + standard_name = daytime_points_dimension + long_name = daytime points dimension + units = count + dimensions = () + type = integer + intent = out + optional = F +[idxday] + standard_name = daytime_points + long_name = daytime points + units = index + dimensions = (horizontal_dimension) + type = integer + intent = out + optional = F +[tsfg] + standard_name = surface_ground_temperature_for_radiation + long_name = surface ground temperature for radiation + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[tsfa] + standard_name = surface_air_temperature_for_radiation + long_name = lowest model layer air temperature for radiation + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[sfcalb1] + standard_name = surface_albedo_due_to_near_IR_direct + long_name = surface albedo due to near IR direct beam + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[sfcalb2] + standard_name = surface_albedo_due_to_near_IR_diffused + long_name = surface albedo due to near IR diffused beam + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[sfcalb3] + standard_name = surface_albedo_due_to_UV_and_VIS_direct + long_name = surface albedo due to UV+VIS direct beam + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[sfcalb4] + standard_name = surface_albedo_due_to_UV_and_VIS_diffused + long_name = surface albedo due to UV+VIS diffused beam + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[alb1d] + standard_name = surface_albedo_perturbation + long_name = surface albedo perturbation + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F + +######################################################################## +[ccpp-arg-table] + name = rrtmg_sw_pre_finalize + type = scheme diff --git a/physics/samfaerosols.F b/physics/samfaerosols.F new file mode 100644 index 000000000..fea4b5ead --- /dev/null +++ b/physics/samfaerosols.F @@ -0,0 +1,813 @@ + module samfcnv_aerosols + + implicit none + + private + + public :: samfdeepcnv_aerosols, samfshalcnv_aerosols + + contains + + subroutine samfdeepcnv_aerosols(im, ix, km, itc, ntc, ntr, delt, + & xlamde, xlamdd, cnvflg, jmin, kb, kmax, kbcon, ktcon, fscav, + & edto, xlamd, xmb, c0t, eta, etad, zi, xlamue, xlamud, delp, + & qtr, qaero) + + use machine , only : kind_phys + use physcons, only : g => con_g, qamin + + implicit none + +c -- input arguments + integer, intent(in) :: im, + & ix, km, itc, ntc, ntr + real(kind=kind_phys), intent(in) :: delt, + & xlamde, xlamdd + logical, dimension(im), intent(in) :: cnvflg + integer, dimension(im), intent(in) :: jmin, + & kb, kmax, kbcon, ktcon + real(kind=kind_phys), dimension(im), intent(in) :: edto, + & xlamd, xmb + real(kind=kind_phys), dimension(ntc), intent(in) :: fscav + real(kind=kind_phys), dimension(im,km), intent(in) :: c0t, + & eta, etad, zi, xlamue, xlamud + real(kind=kind_phys), dimension(ix,km), intent(in) :: delp + real(kind=kind_phys), dimension(ix,km,ntr+2), intent(in) :: qtr +c -- output arguments + real(kind=kind_phys), dimension(im,km,ntc), intent(out) :: qaero + +c -- local variables +c -- general variables + integer :: i, indx, it, k, kk, km1, kp1, n + real(kind=kind_phys) :: adw, aup, dtime_max, dv1q, dv2q, dv3q, + & dtovdz, dz, factor, ptem, ptem1, qamax, tem, tem1 + real(kind=kind_phys), dimension(ix,km) :: xmbp +c -- chemical transport variables + real(kind=kind_phys), dimension(im,km,ntc) :: ctro2, ecko2, ecdo2, + & dellae2 +c -- additional variables for tracers for wet deposition, + real(kind=kind_phys), dimension(im,km,ntc) :: chem_c, chem_pw, + & wet_dep +c -- if reevaporation is enabled, uncomment lines below +c real(kind=kind_phys), dimension(im,ntc) :: pwav +c real(kind=kind_phys), dimension(im,km) :: pwdper +c real(kind=kind_phys), dimension(im,km,ntr) :: chem_pwd +c -- additional variables for fct + real(kind=kind_phys), dimension(im,km) :: flx_lo, totlout, clipout + + real(kind=kind_phys), parameter :: one = 1.0_kind_phys + real(kind=kind_phys), parameter :: half = 0.5_kind_phys + real(kind=kind_phys), parameter :: quarter = 0.25_kind_phys + real(kind=kind_phys), parameter :: zero = 0.0_kind_phys + real(kind=kind_phys), parameter :: epsil = 1.e-22_kind_phys ! prevent division by zero + +c -- begin + +c -- check if aerosols are present + if ( ntc <= 0 .or. itc <= 0 .or. ntr <= 0 ) return + if ( ntr < itc + ntc - 3 ) return + +c -- initialize work variables + km1 = km - 1 + + chem_c = zero + chem_pw = zero + ctro2 = zero + dellae2 = zero + ecdo2 = zero + ecko2 = zero + qaero = zero + +c -- set work arrays + + do n = 1, ntc + it = n + itc - 1 + do k = 1, km + do i = 1, im + if (k <= kmax(i)) qaero(i,k,n) = max(qamin, qtr(i,k,it)) + enddo + enddo + enddo + + do k = 1, km + do i = 1, im + xmbp(i,k) = g * xmb(i) / delp(i,k) + enddo + enddo + + do n = 1, ntc +c -- interface level + do k = 1, km1 + kp1 = k + 1 + do i = 1, im + if (kp1 <= kmax(i)) ctro2(i,k,n) = + & half * (qaero(i,k,n) + qaero(i,kp1,n)) + enddo + enddo +c -- top level + do i = 1, im + ctro2(i,kmax(i),n) = qaero(i,kmax(i),n) + enddo + enddo + + do n = 1, ntc + do k = 1, km + do i = 1, im + if (cnvflg(i) .and. (k <= kb(i))) + & ecko2(i,k,n) = ctro2(i,k,n) + enddo + enddo + enddo + + do n = 1, ntc + do i = 1, im + if (cnvflg(i)) ecdo2(i,jmin(i),n) = ctro2(i,jmin(i),n) + enddo + enddo + +c do chemical tracers, first need to know how much reevaporates + +c aerosol re-evaporation is set to zero for now +c uncomment and edit the following code to enable re-evaporation +c chem_pwd = zero +c pwdper = zero +c pwav = zero +c do i = 1, im +c do k=1,jmin(i) +c pwdper(i,k)= -edto(i)*pwdo(i,k)/pwavo(i) +c enddo +c enddo +c +c calculate include mixing ratio (ecko2), how much goes into +c rainwater to be rained out (chem_pw), and total scavenged, +c if not reevaporated (pwav) + + do n = 1, ntc + do k = 2, km1 + kk = k - 1 + do i = 1, im + if (cnvflg(i)) then + if ((k > kb(i)) .and. (k < ktcon(i))) then + dz = zi(i,k) - zi(i,kk) + tem = half * (xlamue(i,k)+xlamue(i,kk)) * dz + tem1 = quarter * (xlamud(i,k)+xlamud(i,kk)) * dz + factor = one + tem - tem1 + +c if conserved (not scavenging) then + ecko2(i,k,n) = ((one-tem1)*ecko2(i,kk,n) + & + half*tem*(ctro2(i,k,n)+ctro2(i,kk,n)))/factor + +c how much will be scavenged +c +c this choice was used in GF, and is also described in a +c successful implementation into CESM in GRL (Yu et al. 2019), +c it uses dimesnsionless scavenging coefficients (fscav), +c but includes henry coeffs with gas phase chemistry + +c fraction fscav is going into liquid + chem_c(i,k,n)=fscav(n)*ecko2(i,k,n) + +c of that part is going into rain out (chem_pw) + tem=chem_c(i,k,n)/(one+c0t(i,k)*dz) + chem_pw(i,k,n)=c0t(i,k)*dz*tem*eta(i,kk) !etah + ecko2(i,k,n)=tem+ecko2(i,k,n)-chem_c(i,k,n) + +c pwav needed fo reevaporation in downdraft +c if including reevaporation, please uncomment code below +c pwav(i,n)=pwav(i,n)+chem_pw(i,k,n) + endif + endif + enddo + enddo + do k = 1, km1 + do i = 1, im + if (k >= ktcon(i)) ecko2(i,k,n)=ctro2(i,k,n) + enddo + enddo + enddo + +c reevaporation of some, pw and pwd terms needed later for dellae2 + + do n = 1, ntc + do k = km1, 1, -1 + kp1 = k + 1 + do i = 1, im + if (cnvflg(i) .and. (k < jmin(i))) then + dz = zi(i,kp1) - zi(i,k) + if (k >= kbcon(i)) then + tem = xlamde * dz + tem1 = half * xlamdd * dz + else + tem = xlamde * dz + tem1 = half * (xlamd(i)+xlamdd) * dz + endif + factor = one + tem - tem1 + ecdo2(i,k,n) = ((one-tem1)*ecdo2(i,kp1,n) + & +half*tem*(ctro2(i,k,n)+ctro2(i,kp1,n)))/factor +c if including reevaporation, please uncomment code below +c ecdo2(i,k,n)=ecdo2(i,k,n)+pwdper(i,kp1)*pwav(i,n) +c chem_pwd(i,k,n)=max(zero,pwdper(i,kp1)*pwav(i,n)) + endif + enddo + enddo + enddo + + do n = 1, ntc + do i = 1, im + if (cnvflg(i)) then +c subsidence term treated in fct routine + dellae2(i,1,n) = edto(i)*etad(i,1)*ecdo2(i,1,n)*xmbp(i,1) + endif + enddo + enddo + + do n = 1, ntc + do i = 1, im + if (cnvflg(i)) then + k = ktcon(i) + kk = k - 1 +c for the subsidence term already is considered + dellae2(i,k,n) = eta(i,kk) * ecko2(i,kk,n) * xmbp(i,k) + endif + enddo + enddo + +c --- for updraft & downdraft vertical transport +c +c initialize maximum allowed timestep for upstream difference approach +c + dtime_max=delt + do k=2,km1 + kk = k - 1 + do i = 1, im + if (kk < ktcon(i)) dtime_max = min(dtime_max,half*delp(i,kk)) + enddo + enddo + +c now for every chemistry tracer + do n = 1, ntc + do k = 2, km1 + kk = k - 1 + do i = 1, im + if (cnvflg(i) .and. (k < ktcon(i))) then + dz = zi(i,k) - zi(i,kk) + aup = one + if (k <= kb(i)) aup = zero + adw = one + if (k > jmin(i)) adw = zero + + dv1q = half * (ecko2(i,k,n) + ecko2(i,kk,n)) + dv2q = half * (ctro2(i,k,n) + ctro2(i,kk,n)) + dv3q = half * (ecdo2(i,k,n) + ecdo2(i,kk,n)) + + tem = half * (xlamue(i,k) + xlamue(i,kk)) + tem1 = half * (xlamud(i,k) + xlamud(i,kk)) + + if (k <= kbcon(i)) then + ptem = xlamde + ptem1 = xlamd(i) + xlamdd + else + ptem = xlamde + ptem1 = xlamdd + endif + dellae2(i,k,n) = dellae2(i,k,n) + +c detrainment from updraft + & ( aup*tem1*eta(i,kk)*dv1q +c entrainement into up and downdraft + & - (aup*tem*eta(i,kk)+adw*edto(i)*ptem*etad(i,k))*dv2q +c detrainment from downdraft + & + (adw*edto(i)*ptem1*etad(i,k)*dv3q) ) * dz * xmbp(i,k) + + wet_dep(i,k,n)=chem_pw(i,k,n)*g/delp(i,k) + +c sinks from where updraft and downdraft start + if (k == jmin(i)+1) then + dellae2(i,k,n) = dellae2(i,k,n) + & -edto(i)*etad(i,kk)*ctro2(i,kk,n)*xmbp(i,k) + endif + if (k == kb(i))then + dellae2(i,k,n) = dellae2(i,k,n) + & -eta(i,k)*ctro2(i,k,n)*xmbp(i,k) + endif + endif + enddo + enddo + + do i = 1, im + if (cnvflg(i)) then + if (kb(i) == 1) then + k=kb(i) + dellae2(i,k,n) = dellae2(i,k,n) + & -eta(i,k)*ctro2(i,k,n)*xmbp(i,k) + endif + endif + enddo + + enddo + +c for every tracer... + + do n = 1, ntc + flx_lo = zero + totlout = zero + clipout = zero +c compute low-order mass flux, upstream + do k = 2, km1 + kk = k - 1 + do i = 1, im + if (cnvflg(i) .and. (kk < ktcon(i))) then + tem = zero + if (kk >= kb(i) ) tem = eta(i,kk) + if (kk <= jmin(i)) tem = tem - edto(i)*etad(i,kk) +c low-order flux,upstream + if (tem > zero) then + flx_lo(i,k) = -xmb(i) * tem * qaero(i,k,n) + elseif (tem < zero) then + flx_lo(i,k) = -xmb(i) * tem * qaero(i,kk,n) + endif + endif + enddo + enddo + +c --- make sure low-ord fluxes don't violate positive-definiteness + do k=1,km1 + kp1 = k + 1 + do i=1,im + if (cnvflg(i) .and. (k <= ktcon(i))) then +c time step / grid spacing + dtovdz = g * dtime_max / abs(delp(i,k)) +c total flux out + totlout(i,k)=max(zero,flx_lo(i,kp1))-min(zero,flx_lo(i,k)) + clipout(i,k)=min(one ,qaero(i,k,n)/max(epsil,totlout(i,k)) + & / (1.0001_kind_phys*dtovdz)) + endif + enddo + enddo + +c recompute upstream mass fluxes + do k = 2, km1 + kk = k - 1 + do i = 1, im + if (cnvflg(i) .and. (kk < ktcon(i))) then + tem = zero + if (kk >= kb(i) ) tem = eta(i,kk) + if (kk <= jmin(i)) tem = tem - edto(i)*etad(i,kk) + if (tem > zero) then + flx_lo(i,k) = flx_lo(i,k) * clipout(i,k) + elseif (tem < zero) then + flx_lo(i,k) = flx_lo(i,k) * clipout(i,kk) + endif + endif + enddo + enddo + +c --- a positive-definite low-order (diffusive) solution for the subsidnce fluxes + do k=1,km1 + kp1 = k + 1 + do i=1,im + if (cnvflg(i) .and. (k <= ktcon(i))) then + dtovdz = g * dtime_max / abs(delp(i,k)) ! time step /grid spacing + dellae2(i,k,n) = dellae2(i,k,n) + & -(flx_lo(i,kp1)-flx_lo(i,k))*dtovdz/dtime_max + endif + enddo + enddo + + enddo ! ctr + +c convert wet deposition to total mass deposited over dt and dp + + do n = 1, ntc + do k = 1, km + do i = 1, im + if (cnvflg(i) .and. (k < ktcon(i))) + & wet_dep(i,k,n) = wet_dep(i,k,n)*xmb(i)*delt*delp(i,k) + enddo + enddo + enddo + +c compute final aerosol concentrations + + do n = 1, ntc + do k = 1, km + do i = 1, im + if (cnvflg(i) .and. (k <= min(kmax(i),ktcon(i)))) then + qaero(i,k,n) = qaero(i,k,n) + dellae2(i,k,n) * delt + if (qaero(i,k,n) < zero) then +c add negative mass to wet deposition + wet_dep(i,k,n) = wet_dep(i,k,n)-qaero(i,k,n)*delp(i,k) + qaero(i,k,n) = qamin + endif + endif + enddo + enddo + enddo + + return + end subroutine samfdeepcnv_aerosols + + subroutine samfshalcnv_aerosols(im, ix, km, itc, ntc, ntr, delt, + & cnvflg, kb, kmax, kbcon, ktcon, fscav, + & xmb, c0t, eta, zi, xlamue, xlamud, delp, + & qtr, qaero) + + use machine , only : kind_phys + use physcons, only : g => con_g, qamin + + implicit none + +c -- input arguments + integer, intent(in) :: im, + & ix, km, itc, ntc, ntr + real(kind=kind_phys), intent(in) :: delt +! & xlamde, xlamdd + logical, dimension(im), intent(in) :: cnvflg +! integer, dimension(im), intent(in) :: jmin, + integer, dimension(im), intent(in) :: + & kb, kmax, kbcon, ktcon + real(kind=kind_phys), dimension(im), intent(in) :: + & xmb, xlamud + real(kind=kind_phys), dimension(ntc), intent(in) :: fscav + real(kind=kind_phys), dimension(im,km), intent(in) :: c0t, + & eta, zi, xlamue !, xlamud + real(kind=kind_phys), dimension(ix,km), intent(in) :: delp + real(kind=kind_phys), dimension(ix,km,ntr+2), intent(in) :: qtr +c -- output arguments + real(kind=kind_phys), dimension(im,km,ntc), intent(out) :: qaero + +c -- local variables +c -- general variables + integer :: i, indx, it, k, kk, km1, kp1, n +! real(kind=kind_phys) :: adw, aup, dtime_max, dv1q, dv2q, dv3q, + real(kind=kind_phys) :: aup, dtime_max, dv1q, dv2q, dv3q, + & dtovdz, dz, factor, ptem, ptem1, qamax, tem, tem1 + real(kind=kind_phys), dimension(ix,km) :: xmbp +c -- chemical transport variables + real(kind=kind_phys), dimension(im,km,ntc) :: ctro2,ecko2,dellae2 +c -- additional variables for tracers for wet deposition, + real(kind=kind_phys), dimension(im,km,ntc) :: chem_c, chem_pw, + & wet_dep +c -- if reevaporation is enabled, uncomment lines below +c real(kind=kind_phys), dimension(im,ntc) :: pwav +c real(kind=kind_phys), dimension(im,km) :: pwdper +c real(kind=kind_phys), dimension(im,km,ntr) :: chem_pwd +c -- additional variables for fct + real(kind=kind_phys), dimension(im,km) :: flx_lo, totlout, clipout + + real(kind=kind_phys), parameter :: one = 1.0_kind_phys + real(kind=kind_phys), parameter :: half = 0.5_kind_phys + real(kind=kind_phys), parameter :: quarter = 0.25_kind_phys + real(kind=kind_phys), parameter :: zero = 0.0_kind_phys + real(kind=kind_phys), parameter :: epsil = 1.e-22_kind_phys ! prevent division by zero + real(kind=kind_phys), parameter :: escav = 0.8_kind_phys ! wet scavenging efficiency + +c -- begin + +c -- check if aerosols are present + if ( ntc <= 0 .or. itc <= 0 .or. ntr <= 0 ) return + if ( ntr < itc + ntc - 3 ) return + +c -- initialize work variables + km1 = km - 1 + + chem_c = zero + chem_pw = zero + ctro2 = zero + dellae2 = zero + !ecdo2 = zero + ecko2 = zero + qaero = zero + +c -- set work arrays + + do n = 1, ntc + it = n + itc - 1 + do k = 1, km + do i = 1, im + if (k <= kmax(i)) qaero(i,k,n) = max(qamin, qtr(i,k,it)) + enddo + enddo + enddo + + do k = 1, km + do i = 1, im + xmbp(i,k) = g * xmb(i) / delp(i,k) + enddo + enddo + + do n = 1, ntc +c -- interface level + do k = 1, km1 + kp1 = k + 1 + do i = 1, im + if (kp1 <= kmax(i)) ctro2(i,k,n) = + & half * (qaero(i,k,n) + qaero(i,kp1,n)) + enddo + enddo +c -- top level + do i = 1, im + ctro2(i,kmax(i),n) = qaero(i,kmax(i),n) + enddo + enddo + + do n = 1, ntc + do k = 1, km + do i = 1, im + if (cnvflg(i) .and. (k <= kb(i))) + & ecko2(i,k,n) = ctro2(i,k,n) + enddo + enddo + enddo + + !do n = 1, ntc + ! do i = 1, im + ! if (cnvflg(i)) ecdo2(i,jmin(i),n) = ctro2(i,jmin(i),n) + ! enddo + !enddo + +c do chemical tracers, first need to know how much reevaporates + +c aerosol re-evaporation is set to zero for now +c uncomment and edit the following code to enable re-evaporation +c chem_pwd = zero +c pwdper = zero +c pwav = zero +c do i = 1, im +c do k=1,jmin(i) +c pwdper(i,k)= -edto(i)*pwdo(i,k)/pwavo(i) +c enddo +c enddo +c +c calculate include mixing ratio (ecko2), how much goes into +c rainwater to be rained out (chem_pw), and total scavenged, +c if not reevaporated (pwav) + + do n = 1, ntc + do k = 2, km1 + kk = k - 1 + do i = 1, im + if (cnvflg(i)) then + if ((k > kb(i)) .and. (k < ktcon(i))) then + dz = zi(i,k) - zi(i,kk) + tem = half * (xlamue(i,k)+xlamue(i,kk)) * dz +! tem1 = quarter * (xlamud(i,k)+xlamud(i,kk)) * dz + tem1 = quarter * (xlamud(i )+xlamud(i )) * dz + factor = one + tem - tem1 + +c if conserved (not scavenging) then + ecko2(i,k,n) = ((one-tem1)*ecko2(i,kk,n) + & + half*tem*(ctro2(i,k,n)+ctro2(i,kk,n)))/factor + +c how much will be scavenged +c +c this choice was used in GF, and is also described in a +c successful implementation into CESM in GRL (Yu et al. 2019), +c it uses dimesnsionless scavenging coefficients (fscav), +c but includes henry coeffs with gas phase chemistry + +c fraction fscav is going into liquid + chem_c(i,k,n)=escav*fscav(n)*ecko2(i,k,n) + +c of that part is going into rain out (chem_pw) + tem=chem_c(i,k,n)/(one+c0t(i,k)*dz) + chem_pw(i,k,n)=c0t(i,k)*dz*tem*eta(i,kk) !etah + ecko2(i,k,n)=tem+ecko2(i,k,n)-chem_c(i,k,n) + +c pwav needed fo reevaporation in downdraft +c if including reevaporation, please uncomment code below +c pwav(i,n)=pwav(i,n)+chem_pw(i,k,n) + endif + endif + enddo + enddo + do k = 1, km1 + do i = 1, im + if (k >= ktcon(i)) ecko2(i,k,n)=ctro2(i,k,n) + enddo + enddo + enddo + +c reevaporation of some, pw and pwd terms needed later for dellae2 + +! do n = 1, ntc +! do k = km1, 1, -1 +! kp1 = k + 1 +! do i = 1, im +! if (cnvflg(i) .and. (k < jmin(i))) then +! dz = zi(i,kp1) - zi(i,k) +! if (k >= kbcon(i)) then +! tem = xlamde * dz +! tem1 = half * xlamdd * dz +! else +! tem = xlamde * dz +! tem1 = half * (xlamd(i)+xlamdd) * dz +! endif +! factor = one + tem - tem1 +! ecdo2(i,k,n) = ((one-tem1)*ecdo2(i,kp1,n) +! & +half*tem*(ctro2(i,k,n)+ctro2(i,kp1,n)))/factor +c if including reevaporation, please uncomment code below +c ecdo2(i,k,n)=ecdo2(i,k,n)+pwdper(i,kp1)*pwav(i,n) +c chem_pwd(i,k,n)=max(zero,pwdper(i,kp1)*pwav(i,n)) +! endif +! enddo +! enddo +! enddo + +! do n = 1, ntc +! do i = 1, im +! if (cnvflg(i)) then +c subsidence term treated in fct routine +! dellae2(i,1,n) = edto(i)*etad(i,1)*ecdo2(i,1,n)*xmbp(i,1) +! endif +! enddo +! enddo + + do n = 1, ntc + do i = 1, im + if (cnvflg(i)) then + k = ktcon(i) + kk = k - 1 +c for the subsidence term already is considered + dellae2(i,k,n) = eta(i,kk) * ecko2(i,kk,n) * xmbp(i,k) + endif + enddo + enddo + +c --- for updraft & downdraft vertical transport +c +c initialize maximum allowed timestep for upstream difference approach +c + dtime_max=delt + do k=2,km1 + kk = k - 1 + do i = 1, im + if (kk < ktcon(i)) dtime_max = min(dtime_max,half*delp(i,kk)) + enddo + enddo + +c now for every chemistry tracer + do n = 1, ntc + do k = 2, km1 + kk = k - 1 + do i = 1, im + if (cnvflg(i) .and. (k < ktcon(i))) then + dz = zi(i,k) - zi(i,kk) + aup = one + if (k <= kb(i)) aup = zero +! adw = one +! if (k > jmin(i)) adw = zero + + dv1q = half * (ecko2(i,k,n) + ecko2(i,kk,n)) + dv2q = half * (ctro2(i,k,n) + ctro2(i,kk,n)) +c dv3q = half * (ecdo2(i,k,n) + ecdo2(i,kk,n)) + + tem = half * (xlamue(i,k) + xlamue(i,kk)) + !tem1 = half * (xlamud(i,k) + xlamud(i,kk)) + tem1 = half * (xlamud(i ) + xlamud(i )) + +! if (k <= kbcon(i)) then +! ptem = xlamde +! ptem1 = xlamd(i) + xlamdd +! else +! ptem = xlamde +! ptem1 = xlamdd +! endif + dellae2(i,k,n) = dellae2(i,k,n) + +c detrainment from updraft + & ( aup*tem1*eta(i,kk)*dv1q +c entrainement into up and downdraft +! & - (aup*tem*eta(i,kk)+adw*edto(i)*ptem*etad(i,k))*dv2q + & - (aup*tem*eta(i,kk))*dv2q +c detrainment from downdraft +! & + (adw*edto(i)*ptem1*etad(i,k)*dv3q) + & ) * dz * xmbp(i,k) + + wet_dep(i,k,n)=chem_pw(i,k,n)*g/delp(i,k) + +c sinks from where updraft and downdraft start +! if (k == jmin(i)+1) then +! dellae2(i,k,n) = dellae2(i,k,n) +! & -edto(i)*etad(i,kk)*ctro2(i,kk,n)*xmbp(i,k) +! endif + if (k == kb(i))then + dellae2(i,k,n) = dellae2(i,k,n) + & -eta(i,k)*ctro2(i,k,n)*xmbp(i,k) + endif + endif + enddo + enddo + + do i = 1, im + if (cnvflg(i)) then + if (kb(i) == 1) then + k=kb(i) + dellae2(i,k,n) = dellae2(i,k,n) + & -eta(i,k)*ctro2(i,k,n)*xmbp(i,k) + endif + endif + enddo + + enddo + +c for every tracer... + + do n = 1, ntc + flx_lo = zero + totlout = zero + clipout = zero +c compute low-order mass flux, upstream + do k = 2, km1 + kk = k - 1 + do i = 1, im + if (cnvflg(i) .and. (kk < ktcon(i))) then + tem = zero + if (kk >= kb(i) ) tem = eta(i,kk) +! if (kk <= jmin(i)) tem = tem - edto(i)*etad(i,kk) +c low-order flux,upstream + if (tem > zero) then + flx_lo(i,k) = -xmb(i) * tem * qaero(i,k,n) + elseif (tem < zero) then + flx_lo(i,k) = -xmb(i) * tem * qaero(i,kk,n) + endif + endif + enddo + enddo + +c --- make sure low-ord fluxes don't violate positive-definiteness + do k=1,km1 + kp1 = k + 1 + do i=1,im + if (cnvflg(i) .and. (k <= ktcon(i))) then +c time step / grid spacing + dtovdz = g * dtime_max / abs(delp(i,k)) +c total flux out + totlout(i,k)=max(zero,flx_lo(i,kp1))-min(zero,flx_lo(i,k)) + clipout(i,k)=min(one ,qaero(i,k,n)/max(epsil,totlout(i,k)) + & / (1.0001_kind_phys*dtovdz)) + endif + enddo + enddo + +c recompute upstream mass fluxes + do k = 2, km1 + kk = k - 1 + do i = 1, im + if (cnvflg(i) .and. (kk < ktcon(i))) then + tem = zero + if (kk >= kb(i) ) tem = eta(i,kk) +! if (kk <= jmin(i)) tem = tem - edto(i)*etad(i,kk) + if (tem > zero) then + flx_lo(i,k) = flx_lo(i,k) * clipout(i,k) + elseif (tem < zero) then + flx_lo(i,k) = flx_lo(i,k) * clipout(i,kk) + endif + endif + enddo + enddo + +c --- a positive-definite low-order (diffusive) solution for the subsidnce fluxes + do k=1,km1 + kp1 = k + 1 + do i=1,im + if (cnvflg(i) .and. (k <= ktcon(i))) then + dtovdz = g * dtime_max / abs(delp(i,k)) ! time step /grid spacing + dellae2(i,k,n) = dellae2(i,k,n) + & -(flx_lo(i,kp1)-flx_lo(i,k))*dtovdz/dtime_max + endif + enddo + enddo + + enddo ! ctr + +c convert wet deposition to total mass deposited over dt and dp + + do n = 1, ntc + do k = 1, km + do i = 1, im + if (cnvflg(i) .and. (k < ktcon(i))) + & wet_dep(i,k,n) = wet_dep(i,k,n)*xmb(i)*delt*delp(i,k) + enddo + enddo + enddo + +c compute final aerosol concentrations + + do n = 1, ntc + do k = 1, km + do i = 1, im + if (cnvflg(i) .and. (k <= min(kmax(i),ktcon(i)))) then + qaero(i,k,n) = qaero(i,k,n) + dellae2(i,k,n) * delt + if (qaero(i,k,n) < zero) then +c add negative mass to wet deposition + wet_dep(i,k,n) = wet_dep(i,k,n)-qaero(i,k,n)*delp(i,k) + qaero(i,k,n) = qamin + endif + endif + enddo + enddo + enddo + + return + end subroutine samfshalcnv_aerosols + + end module samfcnv_aerosols \ No newline at end of file diff --git a/physics/samfdeepcnv.f b/physics/samfdeepcnv.f index 4577d96d3..83e1efb80 100644 --- a/physics/samfdeepcnv.f +++ b/physics/samfdeepcnv.f @@ -6,6 +6,8 @@ !! convection scheme. module samfdeepcnv + use samfcnv_aerosols, only : samfdeepcnv_aerosols + contains !> \brief Brief description of the subroutine @@ -23,7 +25,7 @@ end subroutine samfdeepcnv_init subroutine samfdeepcnv_finalize() end subroutine samfdeepcnv_finalize -!> \defgroup SAMFdeep GFS samfdeepcnv Main +!> \defgroup SAMFdeep GFS Scale-Aware Mass-Flux Deep Convection Scheme Module !! @{ !> \brief This subroutine contains the entirety of the SAMF deep convection !! scheme. @@ -49,73 +51,7 @@ end subroutine samfdeepcnv_finalize !! of the large-scale environment due to the cumulus convection. !! !! \section arg_table_samfdeepcnv_run Argument Table -!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | -!! |----------------|----------------------------------------------------------------|----------------------------------------------------------------------------------------------------------|-------------|------|-----------|-----------|--------|----------| -!! | im | horizontal_loop_extent | horizontal loop extent | count | 0 | integer | | in | F | -!! | ix | horizontal_dimension | horizontal dimension | count | 0 | integer | | in | F | -!! | km | vertical_dimension | vertical layer dimension | count | 0 | integer | | in | F | -!! | cliq | specific_heat_of_liquid_water_at_constant_pressure | specific heat of liquid water at constant pressure | J kg-1 K-1 | 0 | real | kind_phys | in | F | -!! | cp | specific_heat_of_dry_air_at_constant_pressure | specific heat of dry air at constant pressure | J kg-1 K-1 | 0 | real | kind_phys | in | F | -!! | cvap | specific_heat_of_water_vapor_at_constant_pressure | specific heat of water vapor at constant pressure | J kg-1 K-1 | 0 | real | kind_phys | in | F | -!! | eps | ratio_of_dry_air_to_water_vapor_gas_constants | rd/rv | none | 0 | real | kind_phys | in | F | -!! | epsm1 | ratio_of_dry_air_to_water_vapor_gas_constants_minus_one | (rd/rv) - 1 | none | 0 | real | kind_phys | in | F | -!! | fv | ratio_of_vapor_to_dry_air_gas_constants_minus_one | (rv/rd) - 1 (rv = ideal gas constant for water vapor) | none | 0 | real | kind_phys | in | F | -!! | grav | gravitational_acceleration | gravitational acceleration | m s-2 | 0 | real | kind_phys | in | F | -!! | hvap | latent_heat_of_vaporization_of_water_at_0C | latent heat of evaporation/sublimation | J kg-1 | 0 | real | kind_phys | in | F | -!! | rd | gas_constant_dry_air | ideal gas constant for dry air | J kg-1 K-1 | 0 | real | kind_phys | in | F | -!! | rv | gas_constant_water_vapor | ideal gas constant for water vapor | J kg-1 K-1 | 0 | real | kind_phys | in | F | -!! | t0c | temperature_at_zero_celsius | temperature at 0 degrees Celsius | K | 0 | real | kind_phys | in | F | -!! | delt | time_step_for_physics | physics time step | s | 0 | real | kind_phys | in | F | -!! | ntk | index_for_turbulent_kinetic_energy_convective_transport_tracer | index for turbulent kinetic energy in the convectively transported tracer array | index | 0 | integer | | in | F | -!! | ntr | number_of_tracers_for_samf | number of tracers for scale-aware mass flux schemes | count | 0 | integer | | in | F | -!! | delp | air_pressure_difference_between_midlayers | pres(k) - pres(k+1) | Pa | 2 | real | kind_phys | in | F | -!! | prslp | air_pressure | mean layer pressure | Pa | 2 | real | kind_phys | in | F | -!! | psp | surface_air_pressure | surface pressure | Pa | 1 | real | kind_phys | in | F | -!! | phil | geopotential | layer geopotential | m2 s-2 | 2 | real | kind_phys | in | F | -!! | qtr | convective_transportable_tracers | array to contain cloud water and other convective trans. tracers | kg kg-1 | 3 | real | kind_phys | inout | F | -!! | q1 | water_vapor_specific_humidity_updated_by_physics | updated vapor specific humidity | kg kg-1 | 2 | real | kind_phys | inout | F | -!! | t1 | air_temperature_updated_by_physics | updated temperature | K | 2 | real | kind_phys | inout | F | -!! | u1 | x_wind_updated_by_physics | updated x-direction wind | m s-1 | 2 | real | kind_phys | inout | F | -!! | v1 | y_wind_updated_by_physics | updated y-direction wind | m s-1 | 2 | real | kind_phys | inout | F | -!! | do_ca | flag_for_cellular_automata | cellular automata main switch | flag | 0 | logical | | in | F | -!! | ca_deep | fraction_of_cellular_automata_for_deep_convection | fraction of cellular automata for deep convection | frac | 1 | real | kind_phys | in | F | -!! | cldwrk | cloud_work_function | cloud work function | m2 s-2 | 1 | real | kind_phys | out | F | -!! | rn | lwe_thickness_of_deep_convective_precipitation_amount | deep convective rainfall amount on physics timestep | m | 1 | real | kind_phys | out | F | -!! | kbot | vertical_index_at_cloud_base | index for cloud base | index | 1 | integer | | out | F | -!! | ktop | vertical_index_at_cloud_top | index for cloud top | index | 1 | integer | | out | F | -!! | kcnv | flag_deep_convection | deep convection: 0=no, 1=yes | flag | 1 | integer | | inout | F | -!! | islimsk | sea_land_ice_mask | landmask: sea/land/ice=0/1/2 | flag | 1 | integer | | in | F | -!! | garea | cell_area | grid cell area | m2 | 1 | real | kind_phys | in | F | -!! | dot | omega | layer mean vertical velocity | Pa s-1 | 2 | real | kind_phys | in | F | -!! | ncloud | number_of_hydrometeors | number of hydrometeors | count | 0 | integer | | in | F | -!! | ud_mf | instantaneous_atmosphere_updraft_convective_mass_flux | (updraft mass flux) * delt | kg m-2 | 2 | real | kind_phys | out | F | -!! | dd_mf | instantaneous_atmosphere_downdraft_convective_mass_flux | (downdraft mass flux) * delt | kg m-2 | 2 | real | kind_phys | out | F | -!! | dt_mf | instantaneous_atmosphere_detrainment_convective_mass_flux | (detrainment mass flux) * delt | kg m-2 | 2 | real | kind_phys | out | F | -!! | cnvw | convective_cloud_water_mixing_ratio | moist convective cloud water mixing ratio | kg kg-1 | 2 | real | kind_phys | inout | F | -!! | cnvc | convective_cloud_cover | convective cloud cover | frac | 2 | real | kind_phys | inout | F | -!! | qlcn | mass_fraction_of_convective_cloud_liquid_water | mass fraction of convective cloud liquid water | kg kg-1 | 2 | real | kind_phys | inout | F | -!! | qicn | mass_fraction_of_convective_cloud_ice | mass fraction of convective cloud ice water | kg kg-1 | 2 | real | kind_phys | inout | F | -!! | w_upi | vertical_velocity_for_updraft | vertical velocity for updraft | m s-1 | 2 | real | kind_phys | inout | F | -!! | cf_upi | convective_cloud_fraction_for_microphysics | convective cloud fraction for microphysics | frac | 2 | real | kind_phys | inout | F | -!! | cnv_mfd | detrained_mass_flux | detrained mass flux | kg m-2 s-1 | 2 | real | kind_phys | inout | F | -!! | cnv_dqldt | tendency_of_cloud_water_due_to_convective_microphysics | tendency of cloud water due to convective microphysics | kg m-2 s-1 | 2 | real | kind_phys | inout | F | -!! | clcn | convective_cloud_volume_fraction | convective cloud volume fraction | frac | 2 | real | kind_phys | inout | F | -!! | cnv_fice | ice_fraction_in_convective_tower | ice fraction in convective tower | frac | 2 | real | kind_phys | inout | F | -!! | cnv_ndrop | number_concentration_of_cloud_liquid_water_particles_for_detrainment | droplet number concentration in convective detrainment | m-3 | 2 | real | kind_phys | inout | F | -!! | cnv_nice | number_concentration_of_ice_crystals_for_detrainment | crystal number concentration in convective detrainment | m-3 | 2 | real | kind_phys | inout | F | -!! | mp_phys | flag_for_microphysics_scheme | choice of microphysics scheme | flag | 0 | integer | | in | F | -!! | mp_phys_mg | flag_for_morrison_gettelman_microphysics_scheme | choice of Morrison-Gettelman rmicrophysics scheme | flag | 0 | integer | | in | F | -!! | clam | entrainment_rate_coefficient_deep_convection | entrainment rate coefficient for deep conv. | none | 0 | real | kind_phys | in | F | -!! | c0s | rain_conversion_parameter_deep_convection | convective rain conversion parameter for deep conv. | m-1 | 0 | real | kind_phys | in | F | -!! | c1 | detrainment_conversion_parameter_deep_convection | convective detrainment conversion parameter for deep conv. | m-1 | 0 | real | kind_phys | in | F | -!! | betal | downdraft_fraction_reaching_surface_over_land_deep_convection | downdraft fraction reaching surface over land for deep conv. | frac | 0 | real | kind_phys | in | F | -!! | betas | downdraft_fraction_reaching_surface_over_ocean_deep_convection | downdraft fraction reaching surface over ocean for deep conv. | frac | 0 | real | kind_phys | in | F | -!! | evfact | rain_evaporation_coefficient_deep_convection | convective rain evaporation coefficient for deep conv. | frac | 0 | real | kind_phys | in | F | -!! | evfactl | rain_evaporation_coefficient_over_land_deep_convection | convective rain evaporation coefficient over land for deep conv. | frac | 0 | real | kind_phys | in | F | -!! | pgcon | momentum_transport_reduction_factor_pgf_deep_convection | reduction factor in momentum transport due to deep conv. induced pressure gradient force | frac | 0 | real | kind_phys | in | F | -!! | asolfac | aerosol_aware_parameter_deep_convection | aerosol-aware parameter inversely proportional to CCN number concentraion from Lim (2011) for deep conv. | none | 0 | real | kind_phys | in | F | -!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | -!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | +!! \htmlinclude samfdeepcnv_run.html !! !! \section general_samfdeep GFS samfdeepcnv General Algorithm !! -# Compute preliminary quantities needed for static, dynamic, and feedback control portions of the algorithm. @@ -132,10 +68,10 @@ end subroutine samfdeepcnv_finalize !! !! \section samfdeep_detailed GFS samfdeepcnv Detailed Algorithm !! @{ - subroutine samfdeepcnv_run (im,ix,km,cliq,cp,cvap, & + subroutine samfdeepcnv_run (im,ix,km,itc,ntc,cliq,cp,cvap, & & eps,epsm1,fv,grav,hvap,rd,rv, & & t0c,delt,ntk,ntr,delp, & - & prslp,psp,phil,qtr,q1,t1,u1,v1, & + & prslp,psp,phil,qtr,q1,t1,u1,v1,fscav, & & do_ca,ca_deep,cldwrk,rn,kbot,ktop,kcnv,islimsk,garea, & & dot,ncloud,ud_mf,dd_mf,dt_mf,cnvw,cnvc, & & QLCN, QICN, w_upi, cf_upi, CNV_MFD, & @@ -148,17 +84,19 @@ subroutine samfdeepcnv_run (im,ix,km,cliq,cp,cvap, & implicit none ! - integer, intent(in) :: im, ix, km, ntk, ntr, ncloud + integer, intent(in) :: im, ix, km, itc, ntc, ntk, ntr, ncloud integer, intent(in) :: islimsk(im) real(kind=kind_phys), intent(in) :: cliq, cp, cvap, eps, epsm1, & & fv, grav, hvap, rd, rv, t0c real(kind=kind_phys), intent(in) :: delt real(kind=kind_phys), intent(in) :: psp(im), delp(ix,km), & & prslp(ix,km), garea(im), dot(ix,km), phil(ix,km) + real(kind=kind_phys), dimension(:), intent(in) :: fscav real(kind=kind_phys), intent(in) :: ca_deep(ix) logical, intent(in) :: do_ca integer, intent(inout) :: kcnv(im) + ! DH* TODO - check dimensions of qtr, ntr+2 correct? *DH real(kind=kind_phys), intent(inout) :: qtr(ix,km,ntr+2), & & q1(ix,km), t1(ix,km), u1(ix,km), v1(ix,km), & & cnvw(ix,km), cnvc(ix,km) @@ -167,10 +105,14 @@ subroutine samfdeepcnv_run (im,ix,km,cliq,cp,cvap, & real(kind=kind_phys), intent(out) :: cldwrk(im), & & rn(im), & & ud_mf(im,km),dd_mf(im,km), dt_mf(im,km) - - real(kind=kind_phys), dimension(im,km), intent(inout) :: & + + ! GJF* These variables are conditionally allocated depending on whether the + ! Morrison-Gettelman microphysics is used, so they must be declared + ! using assumed shape. + real(kind=kind_phys), dimension(:,:), intent(inout) :: & & qlcn, qicn, w_upi, cnv_mfd, cnv_dqldt, clcn & &, cnv_fice, cnv_ndrop, cnv_nice, cf_upi + ! *GJF integer :: mp_phys, mp_phys_mg real(kind=kind_phys), intent(in) :: clam, c0s, c1, & @@ -285,6 +227,8 @@ subroutine samfdeepcnv_run (im,ix,km,cliq,cp,cvap, & real(kind=kind_phys) pfld(im,km), to(im,km), qo(im,km), & uo(im,km), vo(im,km), qeso(im,km), & ctr(im,km,ntr), ctro(im,km,ntr) +! for aerosol transport + real(kind=kind_phys) qaero(im,km,ntc) ! for updraft velocity calculation real(kind=kind_phys) wu2(im,km), buo(im,km), drag(im,km) real(kind=kind_phys) wc(im), scaldfunc(im), sigmagfm(im) @@ -307,7 +251,7 @@ subroutine samfdeepcnv_run (im,ix,km,cliq,cp,cvap, & & tx1(im), sumx(im), cnvwt(im,km) ! &, rhbar(im) ! - logical totflg, cnvflg(im), asqecflg(im), flg(im) + logical do_aerosols, totflg, cnvflg(im), asqecflg(im), flg(im) ! ! asqecflg: flag for the quasi-equilibrium assumption of Arakawa-Schubert ! @@ -334,6 +278,11 @@ subroutine samfdeepcnv_run (im,ix,km,cliq,cp,cvap, & fact2 = hvap/rv-fact1*t0c ! c----------------------------------------------------------------------- +!> ## Determine whether to perform aerosol transport + do_aerosols = (itc > 0) .and. (ntc > 0) .and. (ntr > 0) + if (do_aerosols) do_aerosols = (ntr >= itc + ntc - 3) +! +c----------------------------------------------------------------------- !> ## Compute preliminary quantities needed for static, dynamic, and feedback control portions of the algorithm. !> - Convert input pressure terms to centibar units. !************************************************************************ @@ -1605,22 +1554,22 @@ subroutine samfdeepcnv_run (im,ix,km,cliq,cp,cvap, & enddo enddo do i = 1, im - betamn = betas - if(islimsk(i) == 1) betamn = betal - if(ntk > 0) then - betamx = betamn + dbeta - if(tkemean(i) > tkemx) then - beta = betamn - else if(tkemean(i) < tkemn) then - beta = betamx + if(cnvflg(i)) then + betamn = betas + if(islimsk(i) == 1) betamn = betal + if(ntk > 0) then + betamx = betamn + dbeta + if(tkemean(i) > tkemx) then + beta = betamn + else if(tkemean(i) < tkemn) then + beta = betamx + else + tem = (betamx - betamn) * (tkemean(i) - tkemn) + beta = betamx - tem / dtke + endif else - tem = (betamx - betamn) * (tkemean(i) - tkemn) - beta = betamx - tem / dtke + beta = betamn endif - else - beta = betamn - endif - if(cnvflg(i)) then dz = (sumx(i)+zi(i,1))/float(kbcon(i)) tem = 1./float(kbcon(i)) xlamd(i) = (1.-beta**tem)/dz @@ -2454,6 +2403,23 @@ subroutine samfdeepcnv_run (im,ix,km,cliq,cp,cvap, & xmb(i) = min(xmb(i),xmbmax(i)) endif enddo + +!> - If stochastic physics using cellular automata is .true. then perturb the mass-flux here: + + if(do_ca)then + do i=1,im + xmb(i) = xmb(i)*(1.0 + ca_deep(i)*5.) + enddo + endif + +!> - Transport aerosols if present + + if (do_aerosols) + & call samfdeepcnv_aerosols(im, ix, km, itc, ntc, ntr, delt, + & xlamde, xlamdd, cnvflg, jmin, kb, kmax, kbcon, ktcon, fscav, + & edto, xlamd, xmb, c0t, eta, etad, zi, xlamue, xlamud, delp, + & qtr, qaero) + c c restore to,qo,uo,vo to t1,q1,u1,v1 in case convection stops c @@ -2736,6 +2702,20 @@ subroutine samfdeepcnv_run (im,ix,km,cliq,cp,cvap, & enddo enddo enddo + +!> - Store aerosol concentrations if present + if (do_aerosols) then + do n = 1, ntc + kk = n + itc - 1 + do k = 1, km + do i = 1, im + if(cnvflg(i) .and. rn(i) > 0.) then + if (k <= kmax(i)) qtr(i,k,kk) = qaero(i,k,n) + endif + enddo + enddo + enddo + endif ! ! hchuang code change ! diff --git a/physics/samfdeepcnv.meta b/physics/samfdeepcnv.meta new file mode 100644 index 000000000..3b54998fc --- /dev/null +++ b/physics/samfdeepcnv.meta @@ -0,0 +1,609 @@ +[ccpp-arg-table] + name = samfdeepcnv_init + type = scheme + +######################################################################## +[ccpp-arg-table] + name = samfdeepcnv_finalize + type = scheme + +######################################################################## +[ccpp-arg-table] + name = samfdeepcnv_run + type = scheme +[im] + standard_name = horizontal_loop_extent + long_name = horizontal loop extent + units = count + dimensions = () + type = integer + intent = in + optional = F +[ix] + standard_name = horizontal_dimension + long_name = horizontal dimension + units = count + dimensions = () + type = integer + intent = in + optional = F +[km] + standard_name = vertical_dimension + long_name = vertical layer dimension + units = count + dimensions = () + type = integer + intent = in + optional = F +[itc] + standard_name = number_of_aerosol_tracers_for_convection + long_name = number of aerosol tracers transported/scavenged by convection + units = count + dimensions = () + type = integer + intent = in + optional = F +[ntc] + standard_name = number_of_chemical_tracers + long_name = number of chemical tracers + units = count + dimensions = () + type = integer + intent = in + optional = F +[cliq] + standard_name = specific_heat_of_liquid_water_at_constant_pressure + long_name = specific heat of liquid water at constant pressure + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[cp] + standard_name = specific_heat_of_dry_air_at_constant_pressure + long_name = specific heat of dry air at constant pressure + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[cvap] + standard_name = specific_heat_of_water_vapor_at_constant_pressure + long_name = specific heat of water vapor at constant pressure + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[eps] + standard_name = ratio_of_dry_air_to_water_vapor_gas_constants + long_name = rd/rv + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[epsm1] + standard_name = ratio_of_dry_air_to_water_vapor_gas_constants_minus_one + long_name = (rd/rv) - 1 + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[fv] + standard_name = ratio_of_vapor_to_dry_air_gas_constants_minus_one + long_name = (rv/rd) - 1 (rv = ideal gas constant for water vapor) + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[grav] + standard_name = gravitational_acceleration + long_name = gravitational acceleration + units = m s-2 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[hvap] + standard_name = latent_heat_of_vaporization_of_water_at_0C + long_name = latent heat of evaporation/sublimation + units = J kg-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[rd] + standard_name = gas_constant_dry_air + long_name = ideal gas constant for dry air + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[rv] + standard_name = gas_constant_water_vapor + long_name = ideal gas constant for water vapor + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[t0c] + standard_name = temperature_at_zero_celsius + long_name = temperature at 0 degrees Celsius + units = K + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[delt] + standard_name = time_step_for_physics + long_name = physics time step + units = s + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[ntk] + standard_name = index_for_turbulent_kinetic_energy_convective_transport_tracer + long_name = index for turbulent kinetic energy in the convectively transported tracer array + units = index + dimensions = () + type = integer + intent = in + optional = F +[ntr] + standard_name = number_of_tracers_for_samf + long_name = number of tracers for scale-aware mass flux schemes + units = count + dimensions = () + type = integer + intent = in + optional = F +[delp] + standard_name = air_pressure_difference_between_midlayers + long_name = pres(k) - pres(k+1) + units = Pa + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[prslp] + standard_name = air_pressure + long_name = mean layer pressure + units = Pa + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[psp] + standard_name = surface_air_pressure + long_name = surface pressure + units = Pa + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[phil] + standard_name = geopotential + long_name = layer geopotential + units = m2 s-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[qtr] + standard_name = convective_transportable_tracers + long_name = array to contain cloud water and other convective trans. tracers + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension,number_of_tracers_for_convective_transport) + type = real + kind = kind_phys + intent = inout + optional = F +[q1] + standard_name = water_vapor_specific_humidity_updated_by_physics + long_name = updated vapor specific humidity + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[t1] + standard_name = air_temperature_updated_by_physics + long_name = updated temperature + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[u1] + standard_name = x_wind_updated_by_physics + long_name = updated x-direction wind + units = m s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[v1] + standard_name = y_wind_updated_by_physics + long_name = updated y-direction wind + units = m s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[fscav] + standard_name = coefficients_for_aerosol_scavenging + long_name = array of aerosol scavenging coefficients + units = none + dimensions = (number_of_chemical_tracers) + type = real + kind = kind_phys + intent = in + optional = F +[do_ca] + standard_name = flag_for_cellular_automata + long_name = cellular automata main switch + units = flag + dimensions = () + type = logical + intent = in + optional = F +[ca_deep] + standard_name = fraction_of_cellular_automata_for_deep_convection + long_name = fraction of cellular automata for deep convection + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[cldwrk] + standard_name = cloud_work_function + long_name = cloud work function + units = m2 s-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[rn] + standard_name = lwe_thickness_of_deep_convective_precipitation_amount + long_name = deep convective rainfall amount on physics timestep + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[kbot] + standard_name = vertical_index_at_cloud_base + long_name = index for cloud base + units = index + dimensions = (horizontal_dimension) + type = integer + intent = out + optional = F +[ktop] + standard_name = vertical_index_at_cloud_top + long_name = index for cloud top + units = index + dimensions = (horizontal_dimension) + type = integer + intent = out + optional = F +[kcnv] + standard_name = flag_deep_convection + long_name = deep convection: 0=no, 1=yes + units = flag + dimensions = (horizontal_dimension) + type = integer + intent = inout + optional = F +[islimsk] + standard_name = sea_land_ice_mask + long_name = landmask: sea/land/ice=0/1/2 + units = flag + dimensions = (horizontal_dimension) + type = integer + intent = in + optional = F +[garea] + standard_name = cell_area + long_name = grid cell area + units = m2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[dot] + standard_name = omega + long_name = layer mean vertical velocity + units = Pa s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[ncloud] + standard_name = number_of_hydrometeors + long_name = number of hydrometeors + units = count + dimensions = () + type = integer + intent = in + optional = F +[ud_mf] + standard_name = instantaneous_atmosphere_updraft_convective_mass_flux + long_name = (updraft mass flux) * delt + units = kg m-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[dd_mf] + standard_name = instantaneous_atmosphere_downdraft_convective_mass_flux + long_name = (downdraft mass flux) * delt + units = kg m-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[dt_mf] + standard_name = instantaneous_atmosphere_detrainment_convective_mass_flux + long_name = (detrainment mass flux) * delt + units = kg m-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[cnvw] + standard_name = convective_cloud_water_mixing_ratio + long_name = moist convective cloud water mixing ratio + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[cnvc] + standard_name = convective_cloud_cover + long_name = convective cloud cover + units = frac + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[qlcn] + standard_name = mass_fraction_of_convective_cloud_liquid_water + long_name = mass fraction of convective cloud liquid water + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[qicn] + standard_name = mass_fraction_of_convective_cloud_ice + long_name = mass fraction of convective cloud ice water + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[w_upi] + standard_name = vertical_velocity_for_updraft + long_name = vertical velocity for updraft + units = m s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[cf_upi] + standard_name = convective_cloud_fraction_for_microphysics + long_name = convective cloud fraction for microphysics + units = frac + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[cnv_mfd] + standard_name = detrained_mass_flux + long_name = detrained mass flux + units = kg m-2 s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[cnv_dqldt] + standard_name = tendency_of_cloud_water_due_to_convective_microphysics + long_name = tendency of cloud water due to convective microphysics + units = kg m-2 s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[clcn] + standard_name = convective_cloud_volume_fraction + long_name = convective cloud volume fraction + units = frac + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[cnv_fice] + standard_name = ice_fraction_in_convective_tower + long_name = ice fraction in convective tower + units = frac + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[cnv_ndrop] + standard_name = number_concentration_of_cloud_liquid_water_particles_for_detrainment + long_name = droplet number concentration in convective detrainment + units = m-3 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[cnv_nice] + standard_name = number_concentration_of_ice_crystals_for_detrainment + long_name = crystal number concentration in convective detrainment + units = m-3 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[mp_phys] + standard_name = flag_for_microphysics_scheme + long_name = choice of microphysics scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F +[mp_phys_mg] + standard_name = flag_for_morrison_gettelman_microphysics_scheme + long_name = choice of Morrison-Gettelman microphysics scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F +[clam] + standard_name = entrainment_rate_coefficient_deep_convection + long_name = entrainment rate coefficient for deep conv. + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[c0s] + standard_name = rain_conversion_parameter_deep_convection + long_name = convective rain conversion parameter for deep conv. + units = m-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[c1] + standard_name = detrainment_conversion_parameter_deep_convection + long_name = convective detrainment conversion parameter for deep conv. + units = m-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[betal] + standard_name = downdraft_fraction_reaching_surface_over_land_deep_convection + long_name = downdraft fraction reaching surface over land for deep conv. + units = frac + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[betas] + standard_name = downdraft_fraction_reaching_surface_over_ocean_deep_convection + long_name = downdraft fraction reaching surface over ocean for deep conv. + units = frac + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[evfact] + standard_name = rain_evaporation_coefficient_deep_convection + long_name = convective rain evaporation coefficient for deep conv. + units = frac + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[evfactl] + standard_name = rain_evaporation_coefficient_over_land_deep_convection + long_name = convective rain evaporation coefficient over land for deep conv. + units = frac + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[pgcon] + standard_name = momentum_transport_reduction_factor_pgf_deep_convection + long_name = reduction factor in momentum transport due to deep conv. induced pressure gradient force + units = frac + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[asolfac] + standard_name = aerosol_aware_parameter_deep_convection + long_name = aerosol-aware parameter inversely proportional to CCN number concentraion from Lim (2011) for deep conv. + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F diff --git a/physics/samfshalcnv.f b/physics/samfshalcnv.f index de64cf211..ed80a2f54 100644 --- a/physics/samfshalcnv.f +++ b/physics/samfshalcnv.f @@ -5,6 +5,8 @@ !! shallow convection scheme. module samfshalcnv + use samfcnv_aerosols, only : samfshalcnv_aerosols + contains !> \brief Brief description of the subroutine @@ -23,7 +25,7 @@ subroutine samfshalcnv_finalize() end subroutine samfshalcnv_finalize -!> \defgroup SAMF_shal GFS samfshalcnv Main +!> \defgroup SAMF_shal GFS Scale-Aware Mass-Flux Shallow Convection Scheme Module !! @{ !> \brief This subroutine contains the entirety of the SAMF shallow convection !! scheme. @@ -37,54 +39,7 @@ end subroutine samfshalcnv_finalize !! magnitude compared to the deep scheme. !! !! \section arg_table_samfshalcnv_run Argument Table -!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | -!! |----------------|------------------------------------------------------------|----------------------------------------------------------------------------------------------------------|-------------|------|-----------|-----------|--------|----------| -!! | im | horizontal_loop_extent | horizontal loop extent | count | 0 | integer | | in | F | -!! | ix | horizontal_dimension | horizontal dimension | count | 0 | integer | | in | F | -!! | km | vertical_dimension | vertical layer dimension | count | 0 | integer | | in | F | -!! | cliq | specific_heat_of_liquid_water_at_constant_pressure | specific heat of liquid water at constant pressure | J kg-1 K-1 | 0 | real | kind_phys | in | F | -!! | cp | specific_heat_of_dry_air_at_constant_pressure | specific heat of dry air at constant pressure | J kg-1 K-1 | 0 | real | kind_phys | in | F | -!! | cvap | specific_heat_of_water_vapor_at_constant_pressure | specific heat of water vapor at constant pressure | J kg-1 K-1 | 0 | real | kind_phys | in | F | -!! | eps | ratio_of_dry_air_to_water_vapor_gas_constants | rd/rv | none | 0 | real | kind_phys | in | F | -!! | epsm1 | ratio_of_dry_air_to_water_vapor_gas_constants_minus_one | (rd/rv) - 1 | none | 0 | real | kind_phys | in | F | -!! | fv | ratio_of_vapor_to_dry_air_gas_constants_minus_one | (rv/rd) - 1 (rv = ideal gas constant for water vapor) | none | 0 | real | kind_phys | in | F | -!! | grav | gravitational_acceleration | gravitational acceleration | m s-2 | 0 | real | kind_phys | in | F | -!! | hvap | latent_heat_of_vaporization_of_water_at_0C | latent heat of evaporation/sublimation | J kg-1 | 0 | real | kind_phys | in | F | -!! | rd | gas_constant_dry_air | ideal gas constant for dry air | J kg-1 K-1 | 0 | real | kind_phys | in | F | -!! | rv | gas_constant_water_vapor | ideal gas constant for water vapor | J kg-1 K-1 | 0 | real | kind_phys | in | F | -!! | t0c | temperature_at_zero_celsius | temperature at 0 degrees Celsius | K | 0 | real | kind_phys | in | F | -!! | delt | time_step_for_physics | physics time step | s | 0 | real | kind_phys | in | F | -!! | ntk | index_for_turbulent_kinetic_energy_convective_transport_tracer | index for turbulent kinetic energy in the convectively transported tracer array | index | 0 | integer | | in | F | -!! | ntr | number_of_tracers_for_samf | number of tracers for scale-aware mass flux schemes | count | 0 | integer | | in | F | -!! | delp | air_pressure_difference_between_midlayers | pres(k) - pres(k+1) | Pa | 2 | real | kind_phys | in | F | -!! | prslp | air_pressure | mean layer pressure | Pa | 2 | real | kind_phys | in | F | -!! | psp | surface_air_pressure | surface pressure | Pa | 1 | real | kind_phys | in | F | -!! | phil | geopotential | layer geopotential | m2 s-2 | 2 | real | kind_phys | in | F | -!! | qtr | convective_transportable_tracers | array to contain cloud water and other convective trans. tracers | kg kg-1 | 3 | real | kind_phys | inout | F | -!! | q1 | water_vapor_specific_humidity_updated_by_physics | updated vapor specific humidity | kg kg-1 | 2 | real | kind_phys | inout | F | -!! | t1 | air_temperature_updated_by_physics | updated temperature | K | 2 | real | kind_phys | inout | F | -!! | u1 | x_wind_updated_by_physics | updated x-direction wind | m s-1 | 2 | real | kind_phys | inout | F | -!! | v1 | y_wind_updated_by_physics | updated y-direction wind | m s-1 | 2 | real | kind_phys | inout | F | -!! | rn | lwe_thickness_of_shallow_convective_precipitation_amount | shallow convective rainfall amount on physics timestep | m | 1 | real | kind_phys | out | F | -!! | kbot | vertical_index_at_cloud_base | index at cloud base | index | 1 | integer | | out | F | -!! | ktop | vertical_index_at_cloud_top | index at cloud top | index | 1 | integer | | out | F | -!! | kcnv | flag_deep_convection | deep convection: 0=no, 1=yes | flag | 1 | integer | | inout | F | -!! | islimsk | sea_land_ice_mask | landmask: sea/land/ice=0/1/2 | flag | 1 | integer | | in | F | -!! | garea | cell_area | grid cell area | m2 | 1 | real | kind_phys | in | F | -!! | dot | omega | layer mean vertical velocity | Pa s-1 | 2 | real | kind_phys | in | F | -!! | ncloud | number_of_hydrometeors | number of hydrometeors | count | 0 | integer | | in | F | -!! | hpbl | atmosphere_boundary_layer_thickness | PBL top height | m | 1 | real | kind_phys | in | F | -!! | ud_mf | instantaneous_atmosphere_updraft_convective_mass_flux | (updraft mass flux) * delt | kg m-2 | 2 | real | kind_phys | out | F | -!! | dt_mf | instantaneous_atmosphere_detrainment_convective_mass_flux | (detrainment mass flux) * delt | kg m-2 | 2 | real | kind_phys | out | F | -!! | cnvw | convective_cloud_water_mixing_ratio | moist convective cloud water mixing ratio | kg kg-1 | 2 | real | kind_phys | out | F | -!! | cnvc | convective_cloud_cover | convective cloud cover | frac | 2 | real | kind_phys | out | F | -!! | clam | entrainment_rate_coefficient_shallow_convection | entrainment rate coefficient for shal conv. | none | 0 | real | kind_phys | in | F | -!! | c0s | rain_conversion_parameter_shallow_convection | convective rain conversion parameter for shal conv. | m-1 | 0 | real | kind_phys | in | F | -!! | c1 | detrainment_conversion_parameter_shallow_convection | convective detrainment conversion parameter for shal conv. | m-1 | 0 | real | kind_phys | in | F | -!! | pgcon | momentum_transport_reduction_factor_pgf_shallow_convection | reduction factor in momentum transport due to shal conv. induced pressure gradient force | frac | 0 | real | kind_phys | in | F | -!! | asolfac | aerosol_aware_parameter_shallow_convection | aerosol-aware parameter inversely proportional to CCN number concentraion from Lim (2011) for shal conv. | none | 0 | real | kind_phys | in | F | -!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | -!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | +!! \htmlinclude samfshalcnv_run.html !! !! \section gen_samfshalcnv GFS samfshalcnv General Algorithm !! -# Compute preliminary quantities needed for the static and feedback control portions of the algorithm. @@ -94,10 +49,10 @@ end subroutine samfshalcnv_finalize !! -# For the "feedback control", calculate updated values of the state variables by multiplying the cloud base mass flux and the tendencies calculated per unit cloud base mass flux from the static control. !! \section det_samfshalcnv GFS samfshalcnv Detailed Algorithm !! @{ - subroutine samfshalcnv_run(im,ix,km,cliq,cp,cvap, & + subroutine samfshalcnv_run(im,ix,km,itc,ntc,cliq,cp,cvap, & & eps,epsm1,fv,grav,hvap,rd,rv, & & t0c,delt,ntk,ntr,delp, & - & prslp,psp,phil,qtr,q1,t1,u1,v1, & + & prslp,psp,phil,qtr,q1,t1,u1,v1,fscav, & & rn,kbot,ktop,kcnv,islimsk,garea, & & dot,ncloud,hpbl,ud_mf,dt_mf,cnvw,cnvc, & & clam,c0s,c1,pgcon,asolfac,errmsg,errflg) @@ -107,7 +62,7 @@ subroutine samfshalcnv_run(im,ix,km,cliq,cp,cvap, & implicit none ! - integer, intent(in) :: im, ix, km, ntk, ntr, ncloud + integer, intent(in) :: im, ix, km, itc, ntc, ntk, ntr, ncloud integer, intent(in) :: islimsk(im) real(kind=kind_phys), intent(in) :: cliq, cp, cvap, & & eps, epsm1, fv, grav, hvap, rd, rv, t0c @@ -115,7 +70,9 @@ subroutine samfshalcnv_run(im,ix,km,cliq,cp,cvap, & real(kind=kind_phys), intent(in) :: psp(im), delp(ix,km), & & prslp(ix,km), garea(im), hpbl(im), dot(ix,km), phil(ix,km) ! + real(kind=kind_phys), dimension(:), intent(in) :: fscav integer, intent(inout) :: kcnv(im) + ! DH* TODO - check dimensions of qtr, ntr+2 correct? *DH real(kind=kind_phys), intent(inout) :: qtr(ix,km,ntr+2), & & q1(ix,km), t1(ix,km), u1(ix,km), v1(ix,km) ! @@ -221,6 +178,8 @@ subroutine samfshalcnv_run(im,ix,km,cliq,cp,cvap, & real(kind=kind_phys) pfld(im,km), to(im,km), qo(im,km), & uo(im,km), vo(im,km), qeso(im,km), & ctr(im,km,ntr), ctro(im,km,ntr) +! for aerosol transport + real(kind=kind_phys) qaero(im,km,ntc) ! for updraft velocity calculation real(kind=kind_phys) wu2(im,km), buo(im,km), drag(im,km) real(kind=kind_phys) wc(im), scaldfunc(im), sigmagfm(im) @@ -239,7 +198,7 @@ subroutine samfshalcnv_run(im,ix,km,cliq,cp,cvap, & & zi(im,km), pwo(im,km), c0t(im,km), & sumx(im), tx1(im), cnvwt(im,km) ! - logical totflg, cnvflg(im), flg(im) + logical do_aerosols, totflg, cnvflg(im), flg(im) ! real(kind=kind_phys) tf, tcr, tcrf parameter (tf=233.16, tcr=263.16, tcrf=1.0/(tcr-tf)) @@ -256,6 +215,11 @@ subroutine samfshalcnv_run(im,ix,km,cliq,cp,cvap, & fact1 = (cvap-cliq)/rv fact2 = hvap/rv-fact1*t0c +c----------------------------------------------------------------------- +!> ## Determine whether to perform aerosol transport + do_aerosols = (itc > 0) .and. (ntc > 0) .and. (ntr > 0) + if (do_aerosols) do_aerosols = (ntr >= itc + ntc - 3) +! !************************************************************************ ! convert input Pa terms to Cb terms -- Moorthi !> ## Compute preliminary quantities needed for the static and feedback control portions of the algorithm. @@ -1536,6 +1500,17 @@ subroutine samfshalcnv_run(im,ix,km,cliq,cp,cvap, & xmb(i) = min(xmb(i),xmbmax(i)) endif enddo +! +!> - Transport aerosols if present +! + if (do_aerosols) + & call samfshalcnv_aerosols(im, ix, km, itc, ntc, ntr, delt, +! & xlamde, xlamdd, cnvflg, jmin, kb, kmax, kbcon, ktcon, fscav, + & cnvflg, kb, kmax, kbcon, ktcon, fscav, +! & edto, xlamd, xmb, c0t, eta, etad, zi, xlamue, xlamud, delp, + & xmb, c0t, eta, zi, xlamue, xlamud, delp, + & qtr, qaero) +! !> ## For the "feedback control", calculate updated values of the state variables by multiplying the cloud base mass flux and the tendencies calculated per unit cloud base mass flux from the static control. !! - Recalculate saturation specific humidity. c @@ -1774,6 +1749,19 @@ subroutine samfshalcnv_run(im,ix,km,cliq,cp,cvap, & enddo ! endif +!> - Store aerosol concentrations if present + if (do_aerosols) then + do n = 1, ntc + kk = n + itc - 1 + do k = 1, km + do i = 1, im + if(cnvflg(i) .and. rn(i) > 0.) then + if (k <= kmax(i)) qtr(i,k,kk) = qaero(i,k,n) + endif + enddo + enddo + enddo + endif ! ! hchuang code change ! @@ -1823,105 +1811,3 @@ end subroutine samfshalcnv_run !! @} end module samfshalcnv -!> This module contains the CCPP-compliant scale-aware mass-flux shallow convection -!! post interstitial codes. - module samfshalcnv_post - contains - -!! \section arg_table_samfshalcnv_post_run Argument Table -!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | -!! |----------------|-----------------------------------------------------------------------|----------------------------------------------------------------------|---------|------|------------------|-----------|--------|----------| -!! | im | horizontal_loop_extent | horizontal loop extent | count | 0 | integer | | in | F | -!! | levs | vertical_dimension | vertical layer dimension | count | 0 | integer | | in | F | -!! | lssav | flag_diagnostics | logical flag for storing diagnostics | flag | 0 | logical | | in | F | -!! | shcnvcw | flag_shallow_convective_cloud | flag for shallow convective cloud | | 0 | logical | | in | F | -!! | frain | dynamics_to_physics_timestep_ratio | ratio of dynamics timestep to physics timestep | none | 0 | real | kind_phys | in | F | -!! | rain1 | lwe_thickness_of_shallow_convective_precipitation_amount | shallow convective rainfall amount on physics timestep | m | 1 | real | kind_phys | in | F | -!! | npdf3d | number_of_3d_arrays_associated_with_pdf-based_clouds | number of 3d arrays associated with pdf based clouds/mp | count | 0 | integer | | in | F | -!! | num_p3d | array_dimension_of_3d_arrays_for_microphysics | number of 3D arrays needed for microphysics | count | 0 | integer | | in | F | -!! | ncnvcld3d | number_of_convective_3d_cloud_fields | number of convective 3d clouds fields | count | 0 | integer | | in | F | -!! | cnvc | convective_cloud_cover | convective cloud cover | frac | 2 | real | kind_phys | in | F | -!! | cnvw | convective_cloud_water_mixing_ratio | moist convective cloud water mixing ratio | kg kg-1 | 2 | real | kind_phys | in | F | -!! | rainc | lwe_thickness_of_convective_precipitation_amount_on_dynamics_timestep | convective rain at this time step | m | 1 | real | kind_phys | inout | F | -!! | cnvprcp | cumulative_lwe_thickness_of_convective_precipitation_amount | cumulative convective precipitation | m | 1 | real | kind_phys | inout | F | -!! | cnvprcpb | cumulative_lwe_thickness_of_convective_precipitation_amount_in_bucket | cumulative convective precipitation in bucket | m | 1 | real | kind_phys | inout | F | -!! | cnvw_phy_f3d | convective_cloud_water_mixing_ratio_in_phy_f3d | convective cloud water mixing ratio in the phy_f3d array | kg kg-1 | 2 | real | kind_phys | inout | F | -!! | cnvc_phy_f3d | convective_cloud_cover_in_phy_f3d | convective cloud cover in the phy_f3d array | frac | 2 | real | kind_phys | inout | F | -!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | -!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | -!! - subroutine samfshalcnv_post_run (im, levs, lssav, shcnvcw, frain, - & rain1, npdf3d, num_p3d, ncnvcld3d, cnvc, cnvw, - & rainc, cnvprcp, cnvprcpb, cnvw_phy_f3d, cnvc_phy_f3d, - & errmsg, errflg) - - use machine, only: kind_phys - - implicit none -! - integer, intent(in) :: im, levs - integer, intent(in) :: npdf3d, num_p3d, ncnvcld3d - logical, intent(in) :: lssav, shcnvcw - real(kind=kind_phys), intent(in) :: frain - real(kind=kind_phys), dimension(im), intent(in) :: rain1 - real(kind=kind_phys), dimension(im,levs), intent(in) :: cnvw, - & cnvc - - real(kind=kind_phys), dimension(im), intent(inout) :: rainc, - & cnvprcp, cnvprcpb - ! DH* The following arrays may not be allocated, depending on certain flags and microphysics schemes. - ! Since Intel 15 crashes when passing unallocated arrays to arrays defined with explicit shape, - ! use assumed-shape arrays. Note that Intel 18 and GNU 6.2.0-8.1.0 tolerate explicit-shape arrays - ! as long as these do not get used when not allocated. - real(kind=kind_phys), dimension(:,:), intent(inout) :: - & cnvw_phy_f3d, cnvc_phy_f3d - ! *DH - - character(len=*), intent(out) :: errmsg - integer, intent(out) :: errflg - - real(kind=kind_phys), dimension(im) :: raincs - integer :: i, k - - ! Initialize CCPP error handling variables - errmsg = '' - errflg = 0 - - do i=1,im - raincs(i) = frain * rain1(i) - rainc(i) = rainc(i) + raincs(i) - enddo - if (lssav) then - do i=1,im - cnvprcp(i) = cnvprcp(i) + raincs(i) - cnvprcpb(i) = cnvprcpb(i) + raincs(i) - enddo - endif -! in mfshalcnv, 'cnvw' and 'cnvc' are set to zero before computation starts: - if (shcnvcw .and. num_p3d == 4 .and. npdf3d == 3) then - do k=1,levs - do i=1,im - cnvw_phy_f3d(i,k) = cnvw_phy_f3d(i,k) + cnvw(i,k) - cnvc_phy_f3d(i,k) = cnvc_phy_f3d(i,k) + cnvc(i,k) - enddo - enddo - elseif (npdf3d == 0 .and. ncnvcld3d == 1) then - do k=1,levs - do i=1,im - cnvw_phy_f3d(i,k) = cnvw_phy_f3d(i,k) + cnvw(i,k) - enddo - enddo - endif - end subroutine samfshalcnv_post_run - -!! \section arg_table_sasas_shal_post_init Argument Table -!! - subroutine samfshalcnv_post_init () - end subroutine samfshalcnv_post_init - -!! \section arg_table_sasas_shal_post_finalize Argument Table -!! - subroutine samfshalcnv_post_finalize () - end subroutine samfshalcnv_post_finalize - - end module samfshalcnv_post diff --git a/physics/samfshalcnv.meta b/physics/samfshalcnv.meta new file mode 100644 index 000000000..5189afd95 --- /dev/null +++ b/physics/samfshalcnv.meta @@ -0,0 +1,441 @@ +[ccpp-arg-table] + name = samfshalcnv_init + type = scheme + +######################################################################## +[ccpp-arg-table] + name = samfshalcnv_finalize + type = scheme + +######################################################################## +[ccpp-arg-table] + name = samfshalcnv_run + type = scheme +[im] + standard_name = horizontal_loop_extent + long_name = horizontal loop extent + units = count + dimensions = () + type = integer + intent = in + optional = F +[ix] + standard_name = horizontal_dimension + long_name = horizontal dimension + units = count + dimensions = () + type = integer + intent = in + optional = F +[km] + standard_name = vertical_dimension + long_name = vertical layer dimension + units = count + dimensions = () + type = integer + intent = in + optional = F +[itc] + standard_name = number_of_aerosol_tracers_for_convection + long_name = number of aerosol tracers transported/scavenged by convection + units = count + dimensions = () + type = integer + intent = in + optional = F +[ntc] + standard_name = number_of_chemical_tracers + long_name = number of chemical tracers + units = count + dimensions = () + type = integer + intent = in + optional = F +[cliq] + standard_name = specific_heat_of_liquid_water_at_constant_pressure + long_name = specific heat of liquid water at constant pressure + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[cp] + standard_name = specific_heat_of_dry_air_at_constant_pressure + long_name = specific heat of dry air at constant pressure + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[cvap] + standard_name = specific_heat_of_water_vapor_at_constant_pressure + long_name = specific heat of water vapor at constant pressure + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[eps] + standard_name = ratio_of_dry_air_to_water_vapor_gas_constants + long_name = rd/rv + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[epsm1] + standard_name = ratio_of_dry_air_to_water_vapor_gas_constants_minus_one + long_name = (rd/rv) - 1 + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[fv] + standard_name = ratio_of_vapor_to_dry_air_gas_constants_minus_one + long_name = (rv/rd) - 1 (rv = ideal gas constant for water vapor) + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[grav] + standard_name = gravitational_acceleration + long_name = gravitational acceleration + units = m s-2 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[hvap] + standard_name = latent_heat_of_vaporization_of_water_at_0C + long_name = latent heat of evaporation/sublimation + units = J kg-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[rd] + standard_name = gas_constant_dry_air + long_name = ideal gas constant for dry air + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[rv] + standard_name = gas_constant_water_vapor + long_name = ideal gas constant for water vapor + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[t0c] + standard_name = temperature_at_zero_celsius + long_name = temperature at 0 degrees Celsius + units = K + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[delt] + standard_name = time_step_for_physics + long_name = physics time step + units = s + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[ntk] + standard_name = index_for_turbulent_kinetic_energy_convective_transport_tracer + long_name = index for turbulent kinetic energy in the convectively transported tracer array + units = index + dimensions = () + type = integer + intent = in + optional = F +[ntr] + standard_name = number_of_tracers_for_samf + long_name = number of tracers for scale-aware mass flux schemes + units = count + dimensions = () + type = integer + intent = in + optional = F +[delp] + standard_name = air_pressure_difference_between_midlayers + long_name = pres(k) - pres(k+1) + units = Pa + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[prslp] + standard_name = air_pressure + long_name = mean layer pressure + units = Pa + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[psp] + standard_name = surface_air_pressure + long_name = surface pressure + units = Pa + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[phil] + standard_name = geopotential + long_name = layer geopotential + units = m2 s-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[qtr] + standard_name = convective_transportable_tracers + long_name = array to contain cloud water and other convective trans. tracers + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension,number_of_tracers_for_convective_transport) + type = real + kind = kind_phys + intent = inout + optional = F +[q1] + standard_name = water_vapor_specific_humidity_updated_by_physics + long_name = updated vapor specific humidity + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[t1] + standard_name = air_temperature_updated_by_physics + long_name = updated temperature + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[u1] + standard_name = x_wind_updated_by_physics + long_name = updated x-direction wind + units = m s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[v1] + standard_name = y_wind_updated_by_physics + long_name = updated y-direction wind + units = m s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[fscav] + standard_name = coefficients_for_aerosol_scavenging + long_name = array of aerosol scavenging coefficients + units = none + dimensions = (number_of_chemical_tracers) + type = real + kind = kind_phys + intent = in + optional = F +[rn] + standard_name = lwe_thickness_of_shallow_convective_precipitation_amount + long_name = shallow convective rainfall amount on physics timestep + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[kbot] + standard_name = vertical_index_at_cloud_base + long_name = index at cloud base + units = index + dimensions = (horizontal_dimension) + type = integer + intent = out + optional = F +[ktop] + standard_name = vertical_index_at_cloud_top + long_name = index at cloud top + units = index + dimensions = (horizontal_dimension) + type = integer + intent = out + optional = F +[kcnv] + standard_name = flag_deep_convection + long_name = deep convection: 0=no, 1=yes + units = flag + dimensions = (horizontal_dimension) + type = integer + intent = inout + optional = F +[islimsk] + standard_name = sea_land_ice_mask + long_name = landmask: sea/land/ice=0/1/2 + units = flag + dimensions = (horizontal_dimension) + type = integer + intent = in + optional = F +[garea] + standard_name = cell_area + long_name = grid cell area + units = m2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[dot] + standard_name = omega + long_name = layer mean vertical velocity + units = Pa s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[ncloud] + standard_name = number_of_hydrometeors + long_name = number of hydrometeors + units = count + dimensions = () + type = integer + intent = in + optional = F +[hpbl] + standard_name = atmosphere_boundary_layer_thickness + long_name = PBL top height + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[ud_mf] + standard_name = instantaneous_atmosphere_updraft_convective_mass_flux + long_name = (updraft mass flux) * delt + units = kg m-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[dt_mf] + standard_name = instantaneous_atmosphere_detrainment_convective_mass_flux + long_name = (detrainment mass flux) * delt + units = kg m-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[cnvw] + standard_name = convective_cloud_water_mixing_ratio + long_name = moist convective cloud water mixing ratio + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[cnvc] + standard_name = convective_cloud_cover + long_name = convective cloud cover + units = frac + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[clam] + standard_name = entrainment_rate_coefficient_shallow_convection + long_name = entrainment rate coefficient for shal conv. + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[c0s] + standard_name = rain_conversion_parameter_shallow_convection + long_name = convective rain conversion parameter for shal conv. + units = m-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[c1] + standard_name = detrainment_conversion_parameter_shallow_convection + long_name = convective detrainment conversion parameter for shal conv. + units = m-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[pgcon] + standard_name = momentum_transport_reduction_factor_pgf_shallow_convection + long_name = reduction factor in momentum transport due to shal conv. induced pressure gradient force + units = frac + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[asolfac] + standard_name = aerosol_aware_parameter_shallow_convection + long_name = aerosol-aware parameter inversely proportional to CCN number concentraion from Lim (2011) for shal conv. + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F diff --git a/physics/sascnvn.F b/physics/sascnvn.F new file mode 100644 index 000000000..79c1bdc36 --- /dev/null +++ b/physics/sascnvn.F @@ -0,0 +1,2155 @@ +!> \defgroup SAS Simplified Arakawa-Schubert Deep Convection +!! @{ +!! \brief The Simplified Arakawa-Schubert scheme parameterizes the effect of deep convection on the environment (represented by the model state variables) in the following way. First, a simple cloud model is used to determine the change in model state variables due to one entraining/detraining cloud type, per unit cloud-base mass flux. Next, the total change in state variables is retrieved by determining the actual cloud base mass flux using the quasi-equilibrium assumption, whereby convection is assumed to be steady-state. This implies that the generation of the cloud work function (interpreted as entrainment-moderated convective available potential energy (CAPE)) by the large scale dynamics is in balance with the consumption of the cloud work function by the convection. +!! +!! The SAS scheme uses the working concepts put forth in Arakawa and Schubert (1974) \cite arakawa_and_schubert_1974 but includes modifications and simplifications from Grell (1993) \cite grell_1993 such as saturated downdrafts and only one cloud type (the deepest possible), rather than a spectrum based on cloud top heights or assumed entrainment rates. The scheme was implemented for the GFS in 1995 by Pan and Wu \cite pan_and_wu_1995, with further modifications discussed in Han and Pan (2011) \cite han_and_pan_2011 , including the calculation of cloud top, a greater CFL-criterion-based maximum cloud base mass flux, updated cloud model entrainment and detrainment, improved convective transport of horizontal momentum, a more general triggering function, and the inclusion of convective overshooting. +!! +!! \section diagram Calling Hierarchy Diagram +!! \image html SAS_Flowchart.png "Diagram depicting how the SAS deep convection scheme is called from the GSM physics time loop" height=2cm +!! \section intraphysics Intraphysics Communication +!! This space is reserved for a description of how this scheme uses information from other scheme types and/or how information calculated in this scheme is used in other scheme types. + +!> \file sascnvn.F +!! Contains the entire SAS deep convection scheme. + module sascnvn + + implicit none + + private + + public :: sascnvn_init, sascnvn_run, sascnvn_finalize + + contains + +!! +!! \section arg_table_sascnvn_init Argument Table +!! \htmlinclude sascnvn_init.html +!! + subroutine sascnvn_init(imfdeepcnv,imfdeepcnv_sas,errmsg,errflg) +! + integer, intent(in) :: imfdeepcnv, imfdeepcnv_sas + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg +! +! initialize CCPP error handling variables + errmsg = '' + errflg = 0 +! + if (imfdeepcnv/=imfdeepcnv_sas) then + write(errmsg,'(*(a))') 'Logic error: sascnvn incompatible with',& + & ' value of imfdeepcnv' + errflg = 1 + return + endif +! + end subroutine sascnvn_init + +! \brief This subroutine is empty since there are no procedures that need to be done to finalize the sascnvn code. +!! +!! \section arg_table_sascnvn_finalize Argument Table +!! + subroutine sascnvn_finalize + end subroutine sascnvn_finalize + +!> \brief This subroutine contains the entirety of the SAS deep convection scheme. +!! +!! As in Grell (1993) \cite grell_1993 , the SAS convective scheme can be described in terms of three types of "controls": static, dynamic, and feedback. The static control component consists of the simple entraining/detraining updraft/downdraft cloud model and is used to determine the cloud properties, convective precipitation, as well as the convective cloud top height. The dynamic control is the determination of the potential energy available for convection to "consume", or how primed the large-scale environment is for convection to occur due to changes by the dyanmics of the host model. The feedback control is the determination of how the parameterized convection changes the large-scale environment (the host model state variables) given the changes to the state variables per unit cloud base mass flux calculated in the static control portion and the deduced cloud base mass flux determined from the dynamic control. +!! +!! \param[in] im number of used points +!! \param[in] ix horizontal dimension +!! \param[in] km vertical layer dimension +!! \param[in] jcap number of spectral wave trancation +!! \param[in] delt physics time step in seconds +!! \param[in] delp pressure difference between level k and k+1 (Pa) +!! \param[in] prslp mean layer presure (Pa) +!! \param[in] psp surface pressure (Pa) +!! \param[in] phil layer geopotential (\f$m^2/s^2\f$) +!! \param[inout] qlc cloud water (kg/kg) +!! \param[inout] qli ice (kg/kg) +!! \param[inout] q1 updated tracers (kg/kg) +!! \param[inout] t1 updated temperature (K) +!! \param[inout] u1 updated zonal wind (\f$m s^{-1}\f$) +!! \param[inout] v1 updated meridional wind (\f$m s^{-1}\f$) +!! \param[out] cldwrk cloud workfunction (\f$m^2/s^2\f$) +!! \param[out] rn convective rain (m) +!! \param[out] kbot index for cloud base +!! \param[out] ktop index for cloud top +!! \param[out] kcnv flag to denote deep convection (0=no, 1=yes) +!! \param[in] islimsk sea/land/ice mask (=0/1/2) +!! \param[in] dot layer mean vertical velocity (Pa/s) +!! \param[in] ncloud number of cloud species +!! \param[out] ud_mf updraft mass flux multiplied by time step (\f$kg/m^2\f$) +!! \param[out] dd_mf downdraft mass flux multiplied by time step (\f$kg/m^2\f$) +!! \param[out] dt_mf ud_mf at cloud top (\f$kg/m^2\f$) +!! \param[out] cnvw convective cloud water (kg/kg) +!! \param[out] cnvc convective cloud cover (unitless) +!! +!! \section general General Algorithm +!! -# Compute preliminary quantities needed for static, dynamic, and feedback control portions of the algorithm. +!! -# Perform calculations related to the updraft of the entraining/detraining cloud model ("static control"). +!! -# Perform calculations related to the downdraft of the entraining/detraining cloud model ("static control"). +!! -# Using the updated temperature and moisture profiles that were modified by the convection on a short time-scale, recalculate the total cloud work function to determine the change in the cloud work function due to convection, or the stabilizing effect of the cumulus. +!! -# For the "dynamic control", using a reference cloud work function, estimate the change in cloud work function due to the large-scale dynamics. Following the quasi-equilibrium assumption, calculate the cloud base mass flux required to keep the large-scale convective destabilization in balance with the stabilization effect of the convection. +!! -# For the "feedback control", calculate updated values of the state variables by multiplying the cloud base mass flux and the tendencies calculated per unit cloud base mass flux from the static control. +!! \section detailed Detailed Algorithm +!! +!! \section arg_table_sascnvn_run Argument Table +!! \htmlinclude sascnvn_run.html +!! +!! @{ + subroutine sascnvn_run( + & grav,cp,hvap,rv,fv,t0c,rgas,cvap,cliq,eps,epsm1, & + & im,ix,km,jcap,delt,delp,prslp,psp,phil,qlc,qli, & + & q1,t1,u1,v1,cldwrk,rn,kbot,ktop,kcnv,islimsk, & + & dot,ncloud,ud_mf,dd_mf,dt_mf,cnvw,cnvc, & + & qlcn,qicn,w_upi,cf_upi,cnv_mfd, & + & cnv_dqldt,clcn,cnv_fice,cnv_ndrop,cnv_nice,mp_phys, & + & mp_phys_mg,clam,c0,c1,betal,betas,evfact,evfactl,pgcon, & + & errmsg,errflg) +! + use machine , only : kind_phys + use funcphys , only : fpvs +! use physcons, grav => con_g, cp => con_cp, hvap => con_hvap & +! &, rv => con_rv, fv => con_fvirt, t0c => con_t0c & +! &, cvap => con_cvap, cliq => con_cliq & +! &, eps => con_eps, epsm1 => con_epsm1,rgas => con_rd + implicit none +! +! Interface variables +! + real(kind=kind_phys), intent(in) :: grav, cp, hvap, rv, fv, t0c, & + & rgas, cvap, cliq, eps, epsm1 + integer, intent(in) :: im, ix, km, jcap, ncloud, & + & mp_phys, mp_phys_mg + integer, intent(inout) :: kbot(:), ktop(:), kcnv(:) + integer, intent(in) :: islimsk(:) + real(kind=kind_phys), intent(in) :: delt, clam, c0, c1, pgcon + real(kind=kind_phys), intent(in) :: betal, betas, evfact, evfactl + real(kind=kind_phys), intent(in) :: psp(:), delp(:,:), & + & prslp(:,:), dot(:,:), & + & phil(:,:) + real(kind=kind_phys), intent(inout) :: & + & qlc(:,:), qli(:,:), & + & q1(:,:), t1(:,:), & + & u1(:,:), v1(:,:), & + & cnvw(:,:), cnvc(:,:) + real(kind=kind_phys), intent(out) :: cldwrk(:), rn(:), & + & ud_mf(:,:), dd_mf(:,:), & + & dt_mf(:,:) + real(kind=kind_phys), intent(inout) :: & + & qlcn(:,:), qicn(:,:), & + & w_upi(:,:), cnv_mfd(:,:), & + & cnv_dqldt(:,:), clcn(:,:), & + & cnv_fice(:,:), cnv_ndrop(:,:),& + & cnv_nice(:,:), cf_upi(:,:) + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg +! +! Local variables +! + integer i, indx, jmn, k, kk, km1 +! integer latd,lond +! + real(kind=kind_phys) cxlamu, xlamde, xlamdd +! +! real(kind=kind_phys) detad + real(kind=kind_phys) adw, aup, aafac, + & beta, + & dellat, delta, + & desdt, dg, + & dh, dhh, dp, + & dq, dqsdp, dqsdt, dt, + & dt2, dtmax, dtmin, dv1h, + & dv1q, dv2h, dv2q, dv1u, + & dv1v, dv2u, dv2v, dv3q, + & dv3h, dv3u, dv3v, + & dz, dz1, e1, edtmax, + & edtmaxl, edtmaxs, el2orc, elocp, + & es, etah, cthk, dthk, + & evef, fact1, + & fact2, factor, fjcap, fkm, + & g, gamma, pprime, + & qlk, qrch, qs, + & rain, rfact, shear, tem1, + & val, val1, + & val2, w1, w1l, w1s, + & w2, w2l, w2s, w3, + & w3l, w3s, w4, w4l, + & w4s, xdby, xpw, xpwd, + & xqrch, mbdt, tem, + & ptem, ptem1 +! + integer kb(im), kbcon(im), kbcon1(im), + & ktcon(im), ktcon1(im), + & jmin(im), lmin(im), kbmax(im), + & kbm(im), kmax(im) +! + real(kind=kind_phys) ps(im), del(ix,km), prsl(ix,km) +! + real(kind=kind_phys) aa1(im), acrt(im), acrtfct(im), + & delhbar(im), delq(im), delq2(im), + & delqbar(im), delqev(im), deltbar(im), + & deltv(im), dtconv(im), edt(im), + & edto(im), edtx(im), fld(im), + & hcdo(im,km), hmax(im), hmin(im), + & ucdo(im,km), vcdo(im,km),aa2(im), + & pbcdif(im), pdot(im), po(im,km), + & pwavo(im), pwevo(im), xlamud(im), + & qcdo(im,km), qcond(im), qevap(im), + & rntot(im), vshear(im), xaa0(im), + & xk(im), xlamd(im), + & xmb(im), xmbmax(im), xpwav(im), + & xpwev(im), delubar(im),delvbar(im) +! + real(kind=kind_phys) cincr, cincrmax, cincrmin +! +! physical parameters +! parameter(g=grav) +! parameter(elocp=hvap/cp, +! & el2orc=hvap*hvap/(rv*cp)) +! parameter(c0=.002,c1=.002,delta=fv) +! parameter(delta=fv) +! parameter(fact1=(cvap-cliq)/rv,fact2=hvap/rv-fact1*t0c) + parameter(cthk=150.,cincrmax=180.,cincrmin=120.,dthk=25.) +! + real(kind=kind_phys) pfld(im,km), to(im,km), qo(im,km), + & uo(im,km), vo(im,km), qeso(im,km) +! cloud water +! real(kind=kind_phys) tvo(im,km) + real(kind=kind_phys) qlko_ktcon(im), dellal(im,km), tvo(im,km), + & dbyo(im,km), zo(im,km), xlamue(im,km), + & fent1(im,km), fent2(im,km), frh(im,km), + & heo(im,km), heso(im,km), + & qrcd(im,km), dellah(im,km), dellaq(im,km), + & dellau(im,km), dellav(im,km), hcko(im,km), + & ucko(im,km), vcko(im,km), qcko(im,km), + & eta(im,km), etad(im,km), zi(im,km), + & qrcko(im,km), qrcdo(im,km), + & pwo(im,km), pwdo(im,km), + & tx1(im), sumx(im), cnvwt(im,km) +! &, rhbar(im) +! + logical totflg, cnvflg(im), flg(im) +! + real(kind=kind_phys) pcrit(15), acritt(15), acrit(15) +! save pcrit, acritt + data pcrit/850.,800.,750.,700.,650.,600.,550.,500.,450.,400., + & 350.,300.,250.,200.,150./ + data acritt/.0633,.0445,.0553,.0664,.075,.1082,.1521,.2216, + & .3151,.3677,.41,.5255,.7663,1.1686,1.6851/ +! gdas derived acrit +! data acritt/.203,.515,.521,.566,.625,.665,.659,.688, +! & .743,.813,.886,.947,1.138,1.377,1.896/ + real(kind=kind_phys) tf, tcr, tcrf + parameter (tf=233.16, tcr=263.16, tcrf=1.0/(tcr-tf)) +! +!----------------------------------------------------------------------- +!************************************************************************ +! replace (derived) constants above with regular variables + g = grav + elocp = hvap/cp + el2orc = hvap*hvap/(rv*cp) + delta = fv + fact1 = (cvap-cliq)/rv + fact2 = hvap/rv-fact1*t0c +!************************************************************************ +! initialize CCPP error handling variables + errmsg = '' + errflg = 0 +!************************************************************************ +!> ## Compute preliminary quantities needed for static, dynamic, and feedback control portions of the algorithm. +!> - Convert input pressure terms to centibar units. +!************************************************************************ +! convert input pa terms to cb terms -- moorthi + ps = psp * 0.001 + prsl = prslp * 0.001 + del = delp * 0.001 +!************************************************************************ +! +! + km1 = km - 1 +!> - Initialize column-integrated and other single-value-per-column variable arrays. +! +! initialize arrays +! + do i=1,im + cnvflg(i) = .true. + rn(i)=0. + kbot(i)=km+1 + ktop(i)=0 + kbcon(i)=km + ktcon(i)=1 + dtconv(i) = 3600. + cldwrk(i) = 0. + pdot(i) = 0. + pbcdif(i)= 0. + lmin(i) = 1 + jmin(i) = 1 + qlko_ktcon(i) = 0. + edt(i) = 0. + edto(i) = 0. + edtx(i) = 0. + acrt(i) = 0. + acrtfct(i) = 1. + aa1(i) = 0. + aa2(i) = 0. + xaa0(i) = 0. + pwavo(i)= 0. + pwevo(i)= 0. + xpwav(i)= 0. + xpwev(i)= 0. + vshear(i) = 0. + enddo +!> - Initialize convective cloud water and cloud cover to zero. + do k = 1, km + do i = 1, im + cnvw(i,k) = 0. + cnvc(i,k) = 0. + enddo + enddo +!> - Initialize updraft, downdraft, detrainment mass fluxes to zero. +! hchuang code change + do k = 1, km + do i = 1, im + ud_mf(i,k) = 0. + dd_mf(i,k) = 0. + dt_mf(i,k) = 0. + if(mp_phys == mp_phys_mg) then + qlcn(i,k) = 0.0 + qicn(i,k) = 0.0 + w_upi(i,k) = 0.0 + cf_upi(i,k) = 0.0 + cnv_mfd(i,k) = 0.0 +! cnv_prc3(i,k) = 0.0 + cnv_dqldt(i,k) = 0.0 + clcn(i,k) = 0.0 + cnv_fice(i,k) = 0.0 + cnv_ndrop(i,k) = 0.0 + cnv_nice(i,k) = 0.0 + end if + enddo + enddo +!> - Initialize the reference cloud work function, define min/max convective adjustment timescales, and tunable parameters. +! + do k = 1, 15 + acrit(k) = acritt(k) * (975. - pcrit(k)) + enddo + dt2 = delt + val = 1200. + dtmin = max(dt2, val ) + val = 3600. + dtmax = max(dt2, val ) +! model tunable parameters are all here + mbdt = 10. + edtmaxl = .3 + edtmaxs = .3 +! clam = .1 + aafac = .1 +! betal = .15 +! betas = .15 +! betal = .05 +! betas = .05 +! evef = 0.07 +! evfact = 0.3 +! evfactl = 0.3 +! + cxlamu = 1.0e-4 + xlamde = 1.0e-4 + xlamdd = 1.0e-4 +! +! pgcon = 0.7 ! gregory et al. (1997, qjrms) +! pgcon = 0.55 ! zhang & wu (2003,jas) + fjcap = (float(jcap) / 126.) ** 2 + val = 1. + fjcap = max(fjcap,val) + fkm = (float(km) / 28.) ** 2 + fkm = max(fkm,val) + w1l = -8.e-3 + w2l = -4.e-2 + w3l = -5.e-3 + w4l = -5.e-4 + w1s = -2.e-4 + w2s = -2.e-3 + w3s = -1.e-3 + w4s = -2.e-5 +!> - Determine maximum indices for the parcel starting point (kbm), LFC (kbmax), and cloud top (kmax). +! +! define top layer for search of the downdraft originating layer +! and the maximum thetae for updraft +! + do i=1,im + kbmax(i) = km + kbm(i) = km + kmax(i) = km + tx1(i) = 1.0 / ps(i) + enddo +! + do k = 1, km + do i=1,im + if (prsl(i,k)*tx1(i) .gt. 0.04) kmax(i) = k + 1 + if (prsl(i,k)*tx1(i) .gt. 0.45) kbmax(i) = k + 1 + if (prsl(i,k)*tx1(i) .gt. 0.70) kbm(i) = k + 1 + enddo + enddo + do i=1,im + kmax(i) = min(km,kmax(i)) + kbmax(i) = min(kbmax(i),kmax(i)) + kbm(i) = min(kbm(i),kmax(i)) + enddo +! +! hydrostatic height assume zero terr and initially assume +! updraft entrainment rate as an inverse function of height +! +!> - Calculate hydrostatic height at layer centers assuming a flat surface (no terrain) from the geopotential. + do k = 1, km + do i=1,im + zo(i,k) = phil(i,k) / g + enddo + enddo +!> - Calculate interface height and the initial entrainment rate as an inverse function of height. + do k = 1, km1 + do i=1,im + zi(i,k) = 0.5*(zo(i,k)+zo(i,k+1)) + xlamue(i,k) = clam / zi(i,k) + enddo + enddo +!> - Convert prsl from centibar to millibar, set normalized mass fluxes to 1, cloud properties to 0, and save model state variables (after advection/turbulence). +! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! convert surface pressure to mb from cb +! + do k = 1, km + do i = 1, im + if (k .le. kmax(i)) then + pfld(i,k) = prsl(i,k) * 10.0 + eta(i,k) = 1. + fent1(i,k)= 1. + fent2(i,k)= 1. + frh(i,k) = 0. + hcko(i,k) = 0. + qcko(i,k) = 0. + qrcko(i,k)= 0. + ucko(i,k) = 0. + vcko(i,k) = 0. + etad(i,k) = 1. + hcdo(i,k) = 0. + qcdo(i,k) = 0. + ucdo(i,k) = 0. + vcdo(i,k) = 0. + qrcd(i,k) = 0. + qrcdo(i,k)= 0. + dbyo(i,k) = 0. + pwo(i,k) = 0. + pwdo(i,k) = 0. + dellal(i,k) = 0. + to(i,k) = t1(i,k) + qo(i,k) = q1(i,k) + uo(i,k) = u1(i,k) + vo(i,k) = v1(i,k) +! uo(i,k) = u1(i,k) * rcs(i) +! vo(i,k) = v1(i,k) * rcs(i) + cnvwt(i,k)= 0. + endif + enddo + enddo +! +! column variables +! p is pressure of the layer (mb) +! t is temperature at t-dt (k)..tn +! q is mixing ratio at t-dt (kg/kg)..qn +! to is temperature at t+dt (k)... this is after advection and turbulan +! qo is mixing ratio at t+dt (kg/kg)..q1 +! +!> - Calculate saturation mixing ratio and enforce minimum moisture values. + do k = 1, km + do i=1,im + if (k .le. kmax(i)) then + qeso(i,k) = 0.01 * fpvs(to(i,k)) ! fpvs is in pa + qeso(i,k) = eps * qeso(i,k) / (pfld(i,k) + epsm1*qeso(i,k)) + val1 = 1.e-8 + qeso(i,k) = max(qeso(i,k), val1) + val2 = 1.e-10 + qo(i,k) = max(qo(i,k), val2 ) +! qo(i,k) = min(qo(i,k),qeso(i,k)) +! tvo(i,k) = to(i,k) + delta * to(i,k) * qo(i,k) + endif + enddo + enddo +! +! compute moist static energy +! +!> - Calculate moist static energy (heo) and saturation moist static energy (heso). + do k = 1, km + do i=1,im + if (k .le. kmax(i)) then +! tem = g * zo(i,k) + cp * to(i,k) + tem = phil(i,k) + cp * to(i,k) + heo(i,k) = tem + hvap * qo(i,k) + heso(i,k) = tem + hvap * qeso(i,k) +! heo(i,k) = min(heo(i,k),heso(i,k)) + endif + enddo + enddo + +!> ## Perform calculations related to the updraft of the entraining/detraining cloud model ("static control"). +! +! determine level with largest moist static energy +! this is the level where updraft starts +! +!> - Search below index "kbm" for the level of maximum moist static energy. + do i=1,im + hmax(i) = heo(i,1) + kb(i) = 1 + enddo + do k = 2, km + do i=1,im + if (k .le. kbm(i)) then + if(heo(i,k).gt.hmax(i)) then + kb(i) = k + hmax(i) = heo(i,k) + endif + endif + enddo + enddo +!> - Calculate the temperature, water vapor mixing ratio, and pressure at interface levels. +! + do k = 1, km1 + do i=1,im + if (k .le. kmax(i)-1) then + dz = .5 * (zo(i,k+1) - zo(i,k)) + dp = .5 * (pfld(i,k+1) - pfld(i,k)) + es = 0.01 * fpvs(to(i,k+1)) ! fpvs is in pa + pprime = pfld(i,k+1) + epsm1 * es + qs = eps * es / pprime + dqsdp = - qs / pprime + desdt = es * (fact1 / to(i,k+1) + fact2 / (to(i,k+1)**2)) + dqsdt = qs * pfld(i,k+1) * desdt / (es * pprime) + gamma = el2orc * qeso(i,k+1) / (to(i,k+1)**2) + dt = (g * dz + hvap * dqsdp * dp) / (cp * (1. + gamma)) + dq = dqsdt * dt + dqsdp * dp + to(i,k) = to(i,k+1) + dt + qo(i,k) = qo(i,k+1) + dq + po(i,k) = .5 * (pfld(i,k) + pfld(i,k+1)) + endif + enddo + enddo +!> - Recalculate saturation mixing ratio, moist static energy, saturation moist static energy, and horizontal momentum on interface levels. Enforce minimum mixing ratios and calculate \f$(1 - RH)\f$. +! + do k = 1, km1 + do i=1,im + if (k .le. kmax(i)-1) then + qeso(i,k) = 0.01 * fpvs(to(i,k)) ! fpvs is in pa + qeso(i,k) = eps * qeso(i,k) / (po(i,k) + epsm1*qeso(i,k)) + val1 = 1.e-8 + qeso(i,k) = max(qeso(i,k), val1) + val2 = 1.e-10 + qo(i,k) = max(qo(i,k), val2 ) +! qo(i,k) = min(qo(i,k),qeso(i,k)) + frh(i,k) = 1. - min(qo(i,k)/qeso(i,k), 1.) + heo(i,k) = .5 * g * (zo(i,k) + zo(i,k+1)) + + & cp * to(i,k) + hvap * qo(i,k) + heso(i,k) = .5 * g * (zo(i,k) + zo(i,k+1)) + + & cp * to(i,k) + hvap * qeso(i,k) + uo(i,k) = .5 * (uo(i,k) + uo(i,k+1)) + vo(i,k) = .5 * (vo(i,k) + vo(i,k+1)) + endif + enddo + enddo +! +! look for the level of free convection as cloud base +! +!> - Search below the index "kbmax" for the level of free convection (LFC) where the condition \f$h_b > h^*\f$ is first met, where \f$h_b, h^*\f$ are the state moist static energy at the parcel's starting level and saturation moist static energy, respectively. Set "kbcon" to the index of the LFC. + do i=1,im + flg(i) = .true. + kbcon(i) = kmax(i) + enddo + do k = 1, km1 + do i=1,im + if (flg(i).and.k.le.kbmax(i)) then + if(k.gt.kb(i).and.heo(i,kb(i)).gt.heso(i,k)) then + kbcon(i) = k + flg(i) = .false. + endif + endif + enddo + enddo +!> - If no LFC, return to the calling routine without modifying state variables. +! + do i=1,im + if(kbcon(i).eq.kmax(i)) cnvflg(i) = .false. + enddo +!! + totflg = .true. + do i=1,im + totflg = totflg .and. (.not. cnvflg(i)) + enddo + if(totflg) return +!! +! +! determine critical convective inhibition +! as a function of vertical velocity at cloud base. +! +!> - Determine the vertical pressure velocity at the LFC. After Han and Pan (2011) \cite han_and_pan_2011 , determine the maximum pressure thickness between a parcel's starting level and the LFC. If a parcel doesn't reach the LFC within the critical thickness, then the convective inhibition is deemed too great for convection to be triggered, and the subroutine returns to the calling routine without modifying the state variables. + do i=1,im + if(cnvflg(i)) then +! pdot(i) = 10.* dot(i,kbcon(i)) + pdot(i) = 0.01 * dot(i,kbcon(i)) ! now dot is in pa/s + endif + enddo + do i=1,im + if(cnvflg(i)) then + if(islimsk(i) == 1) then + w1 = w1l + w2 = w2l + w3 = w3l + w4 = w4l + else + w1 = w1s + w2 = w2s + w3 = w3s + w4 = w4s + endif + if(pdot(i).le.w4) then + tem = (pdot(i) - w4) / (w3 - w4) + elseif(pdot(i).ge.-w4) then + tem = - (pdot(i) + w4) / (w4 - w3) + else + tem = 0. + endif + val1 = -1. + tem = max(tem,val1) + val2 = 1. + tem = min(tem,val2) + tem = 1. - tem + tem1= .5*(cincrmax-cincrmin) + cincr = cincrmax - tem * tem1 + pbcdif(i) = pfld(i,kb(i)) - pfld(i,kbcon(i)) + if(pbcdif(i).gt.cincr) then + cnvflg(i) = .false. + endif + endif + enddo +!! + totflg = .true. + do i=1,im + totflg = totflg .and. (.not. cnvflg(i)) + enddo + if(totflg) return +!! +! +! assume that updraft entrainment rate above cloud base is +! same as that at cloud base +! +!> - Calculate the entrainment rate according to Han and Pan (2011) \cite han_and_pan_2011 , equation 8, after Bechtold et al. (2008) \cite bechtold_et_al_2008, equation 2 given by: +!! \f[ +!! \epsilon = \epsilon_0F_0 + d_1\left(1-RH\right)F_1 +!! \f] +!! where \f$\epsilon_0\f$ is the cloud base entrainment rate, \f$d_1\f$ is a tunable constant, and \f$F_0=\left(\frac{q_s}{q_{s,b}}\right)^2\f$ and \f$F_1=\left(\frac{q_s}{q_{s,b}}\right)^3\f$ where \f$q_s\f$ and \f$q_{s,b}\f$ are the saturation specific humidities at a given level and cloud base, respectively. The detrainment rate in the cloud is assumed to be equal to the entrainment rate at cloud base. + do k = 2, km1 + do i=1,im + if(cnvflg(i).and. + & (k.gt.kbcon(i).and.k.lt.kmax(i))) then + xlamue(i,k) = xlamue(i,kbcon(i)) + endif + enddo + enddo +! +! assume the detrainment rate for the updrafts to be same as +! the entrainment rate at cloud base +! +!> - The updraft detrainment rate is set constant and equal to the entrainment rate at cloud base. + do i = 1, im + if(cnvflg(i)) then + xlamud(i) = xlamue(i,kbcon(i)) + endif + enddo +! +! functions rapidly decreasing with height, mimicking a cloud ensemble +! (bechtold et al., 2008) +! + do k = 2, km1 + do i=1,im + if(cnvflg(i).and. + & (k.gt.kbcon(i).and.k.lt.kmax(i))) then + tem = qeso(i,k)/qeso(i,kbcon(i)) + fent1(i,k) = tem**2 + fent2(i,k) = tem**3 + endif + enddo + enddo +! +! final entrainment rate as the sum of turbulent part and organized entrainment +! depending on the environmental relative humidity +! (bechtold et al., 2008) +! + do k = 2, km1 + do i=1,im + if(cnvflg(i).and. + & (k.ge.kbcon(i).and.k.lt.kmax(i))) then + tem = cxlamu * frh(i,k) * fent2(i,k) + xlamue(i,k) = xlamue(i,k)*fent1(i,k) + tem + endif + enddo + enddo +! +! determine updraft mass flux for the subcloud layers +! +!> - Calculate the normalized mass flux for subcloud and in-cloud layers according to Pan and Wu (1995) \cite pan_and_wu_1995 equation 1: +!! \f[ +!! \frac{1}{\eta}\frac{\partial \eta}{\partial z} = \lambda_e - \lambda_d +!! \f] +!! where \f$\eta\f$ is the normalized mass flux, \f$\lambda_e\f$ is the entrainment rate and \f$\lambda_d\f$ is the detrainment rate. + do k = km1, 1, -1 + do i = 1, im + if (cnvflg(i)) then + if(k.lt.kbcon(i).and.k.ge.kb(i)) then + dz = zi(i,k+1) - zi(i,k) + ptem = 0.5*(xlamue(i,k)+xlamue(i,k+1))-xlamud(i) + eta(i,k) = eta(i,k+1) / (1. + ptem * dz) + endif + endif + enddo + enddo +! +! compute mass flux above cloud base +! + do k = 2, km1 + do i = 1, im + if(cnvflg(i))then + if(k.gt.kbcon(i).and.k.lt.kmax(i)) then + dz = zi(i,k) - zi(i,k-1) + ptem = 0.5*(xlamue(i,k)+xlamue(i,k-1))-xlamud(i) + eta(i,k) = eta(i,k-1) * (1 + ptem * dz) + endif + endif + enddo + enddo +! +! compute updraft cloud properties +! +!> - Set initial cloud properties equal to the state variables at cloud base. + do i = 1, im + if(cnvflg(i)) then + indx = kb(i) + hcko(i,indx) = heo(i,indx) + ucko(i,indx) = uo(i,indx) + vcko(i,indx) = vo(i,indx) + pwavo(i) = 0. + endif + enddo +! +! cloud property is modified by the entrainment process +! +!> - Calculate the cloud properties as a parcel ascends, modified by entrainment and detrainment. Discretization follows Appendix B of Grell (1993) \cite grell_1993 . Following Han and Pan (2006) \cite han_and_pan_2006, the convective momentum transport is reduced by the convection-induced pressure gradient force by the constant "pgcon", currently set to 0.55 after Zhang and Wu (2003) \cite zhang_and_wu_2003 . + do k = 2, km1 + do i = 1, im + if (cnvflg(i)) then + if(k.gt.kb(i).and.k.lt.kmax(i)) then + dz = zi(i,k) - zi(i,k-1) + tem = 0.5 * (xlamue(i,k)+xlamue(i,k-1)) * dz + tem1 = 0.5 * xlamud(i) * dz + factor = 1. + tem - tem1 + ptem = 0.5 * tem + pgcon + ptem1= 0.5 * tem - pgcon + hcko(i,k) = ((1.-tem1)*hcko(i,k-1)+tem*0.5* + & (heo(i,k)+heo(i,k-1)))/factor + ucko(i,k) = ((1.-tem1)*ucko(i,k-1)+ptem*uo(i,k) + & +ptem1*uo(i,k-1))/factor + vcko(i,k) = ((1.-tem1)*vcko(i,k-1)+ptem*vo(i,k) + & +ptem1*vo(i,k-1))/factor + dbyo(i,k) = hcko(i,k) - heso(i,k) + endif + endif + enddo + enddo +! +! taking account into convection inhibition due to existence of +! dry layers below cloud base +! +!> - With entrainment, recalculate the LFC as the first level where buoyancy is positive. The difference in pressure levels between LFCs calculated with/without entrainment must be less than a threshold (currently 25 hPa). Otherwise, convection is inhibited and the scheme returns to the calling routine without modifying the state variables. This is the subcloud dryness trigger modification discussed in Han and Pan (2011) \cite han_and_pan_2011. + do i=1,im + flg(i) = cnvflg(i) + kbcon1(i) = kmax(i) + enddo + do k = 2, km1 + do i=1,im + if (flg(i).and.k.lt.kmax(i)) then + if(k.ge.kbcon(i).and.dbyo(i,k).gt.0.) then + kbcon1(i) = k + flg(i) = .false. + endif + endif + enddo + enddo + do i=1,im + if(cnvflg(i)) then + if(kbcon1(i).eq.kmax(i)) cnvflg(i) = .false. + endif + enddo + do i=1,im + if(cnvflg(i)) then + tem = pfld(i,kbcon(i)) - pfld(i,kbcon1(i)) + if(tem.gt.dthk) then + cnvflg(i) = .false. + endif + endif + enddo +!! + totflg = .true. + do i = 1, im + totflg = totflg .and. (.not. cnvflg(i)) + enddo + if(totflg) return +!! +! +! determine first guess cloud top as the level of zero buoyancy +! +!> - Calculate the cloud top as the first level where parcel buoyancy becomes negative. If the thickness of the calculated convection is less than a threshold (currently 150 hPa), then convection is inhibited, and the scheme returns to the calling routine. + do i = 1, im + flg(i) = cnvflg(i) + ktcon(i) = 1 + enddo + do k = 2, km1 + do i = 1, im + if (flg(i).and.k .lt. kmax(i)) then + if(k.gt.kbcon1(i).and.dbyo(i,k).lt.0.) then + ktcon(i) = k + flg(i) = .false. + endif + endif + enddo + enddo +! + do i = 1, im + if(cnvflg(i)) then + tem = pfld(i,kbcon(i))-pfld(i,ktcon(i)) + if(tem.lt.cthk) cnvflg(i) = .false. + endif + enddo +!! + totflg = .true. + do i = 1, im + totflg = totflg .and. (.not. cnvflg(i)) + enddo + if(totflg) return +!! +! +! search for downdraft originating level above theta-e minimum +! +!> - To originate the downdraft, search for the level above the minimum in moist static energy. Return to the calling routine without modification if this level is determined to be outside of the convective cloud layers. + do i = 1, im + if(cnvflg(i)) then + hmin(i) = heo(i,kbcon1(i)) + lmin(i) = kbmax(i) + jmin(i) = kbmax(i) + endif + enddo + do k = 2, km1 + do i = 1, im + if (cnvflg(i) .and. k .le. kbmax(i)) then + if(k.gt.kbcon1(i).and.heo(i,k).lt.hmin(i)) then + lmin(i) = k + 1 + hmin(i) = heo(i,k) + endif + endif + enddo + enddo +! +! make sure that jmin(i) is within the cloud +! + do i = 1, im + if(cnvflg(i)) then + jmin(i) = min(lmin(i),ktcon(i)-1) + jmin(i) = max(jmin(i),kbcon1(i)+1) + if(jmin(i).ge.ktcon(i)) cnvflg(i) = .false. + endif + enddo +! +! specify upper limit of mass flux at cloud base +! +!> - Calculate the maximum value of the cloud base mass flux using the CFL-criterion-based formula of Han and Pan (2011) \cite han_and_pan_2011, equation 7. + do i = 1, im + if(cnvflg(i)) then +! xmbmax(i) = .1 +! + k = kbcon(i) + dp = 1000. * del(i,k) + xmbmax(i) = dp / (g * dt2) +! +! tem = dp / (g * dt2) +! xmbmax(i) = min(tem, xmbmax(i)) + endif + enddo +! +! compute cloud moisture property and precipitation +! +!> - Initialize the cloud moisture at cloud base and set the cloud work function to zero. + do i = 1, im + if (cnvflg(i)) then + aa1(i) = 0. + qcko(i,kb(i)) = qo(i,kb(i)) + qrcko(i,kb(i)) = qo(i,kb(i)) +! rhbar(i) = 0. + endif + enddo +!> - Calculate the moisture content of the entraining/detraining parcel (qcko) and the value it would have if just saturated (qrch), according to equation A.14 in Grell (1993) \cite grell_1993 . Their difference is the amount of convective cloud water (qlk = rain + condensate). Determine the portion of convective cloud water that remains suspended and the portion that is converted into convective precipitation (pwo). Calculate and save the negative cloud work function (aa1) due to water loading. The liquid water in the updraft layer is assumed to be detrained from the layers above the level of the minimum moist static energy into the grid-scale cloud water (dellal). + do k = 2, km1 + do i = 1, im + if (cnvflg(i)) then + if(k.gt.kb(i).and.k.lt.ktcon(i)) then + dz = zi(i,k) - zi(i,k-1) + gamma = el2orc * qeso(i,k) / (to(i,k)**2) + qrch = qeso(i,k) + & + gamma * dbyo(i,k) / (hvap * (1. + gamma)) +! + tem = 0.5 * (xlamue(i,k)+xlamue(i,k-1)) * dz + tem1 = 0.5 * xlamud(i) * dz + factor = 1. + tem - tem1 + qcko(i,k) = ((1.-tem1)*qcko(i,k-1)+tem*0.5* + & (qo(i,k)+qo(i,k-1)))/factor + qrcko(i,k) = qcko(i,k) +! + dq = eta(i,k) * (qcko(i,k) - qrch) +! +! rhbar(i) = rhbar(i) + qo(i,k) / qeso(i,k) +! +! check if there is excess moisture to release latent heat +! + if(k.ge.kbcon(i).and.dq.gt.0.) then + etah = .5 * (eta(i,k) + eta(i,k-1)) + dp = 1000. * del(i,k) + if(ncloud.gt.0..and.k.gt.jmin(i)) then + qlk = dq / (eta(i,k) + etah * (c0 + c1) * dz) + dellal(i,k) = etah * c1 * dz * qlk * g / dp + else + qlk = dq / (eta(i,k) + etah * c0 * dz) + endif + aa1(i) = aa1(i) - dz * g * qlk + qcko(i,k) = qlk + qrch + pwo(i,k) = etah * c0 * dz * qlk + pwavo(i) = pwavo(i) + pwo(i,k) +! cnvwt(i,k) = (etah*qlk + pwo(i,k)) * g / dp + cnvwt(i,k) = etah * qlk * g / dp + endif + endif + endif + enddo + enddo +! +! do i = 1, im +! if(cnvflg(i)) then +! indx = ktcon(i) - kb(i) - 1 +! rhbar(i) = rhbar(i) / float(indx) +! endif +! enddo +! +! calculate cloud work function +! +!> - Calculate the cloud work function according to Pan and Wu (1995) \cite pan_and_wu_1995 equation 4: +!! \f[ +!! A_u=\int_{z_0}^{z_t}\frac{g}{c_pT(z)}\frac{\eta}{1 + \gamma}[h(z)-h^*(z)]dz +!! \f] +!! (discretized according to Grell (1993) \cite grell_1993 equation B.10 using B.2 and B.3 of Arakawa and Schubert (1974) \cite arakawa_and_schubert_1974 and assuming \f$\eta=1\f$) where \f$A_u\f$ is the updraft cloud work function, \f$z_0\f$ and \f$z_t\f$ are cloud base and cloud top, respectively, \f$\gamma = \frac{L}{c_p}\left(\frac{\partial \overline{q_s}}{\partial T}\right)_p\f$ and other quantities are previously defined. + do k = 2, km1 + do i = 1, im + if (cnvflg(i)) then + if(k.ge.kbcon(i).and.k.lt.ktcon(i)) then + dz1 = zo(i,k+1) - zo(i,k) + gamma = el2orc * qeso(i,k) / (to(i,k)**2) + rfact = 1. + delta * cp * gamma + & * to(i,k) / hvap + aa1(i) = aa1(i) + + & dz1 * (g / (cp * to(i,k))) + & * dbyo(i,k) / (1. + gamma) + & * rfact + val = 0. + aa1(i)=aa1(i)+ + & dz1 * g * delta * + & max(val,(qeso(i,k) - qo(i,k))) + endif + endif + enddo + enddo +!> - If the updraft cloud work function is negative, convection does not occur, and the scheme returns to the calling routine. + do i = 1, im + if(cnvflg(i).and.aa1(i).le.0.) cnvflg(i) = .false. + enddo +!! + totflg = .true. + do i=1,im + totflg = totflg .and. (.not. cnvflg(i)) + enddo + if(totflg) return +!! +! +! estimate the onvective overshooting as the level +! where the [aafac * cloud work function] becomes zero, +! which is the final cloud top +! +!> - Continue calculating the cloud work function past the point of neutral buoyancy to represent overshooting according to Han and Pan (2011) \cite han_and_pan_2011 . Convective overshooting stops when \f$ cA_u < 0\f$ where \f$c\f$ is currently 10%, or when 10% of the updraft cloud work function has been consumed by the stable buoyancy force. + do i = 1, im + if (cnvflg(i)) then + aa2(i) = aafac * aa1(i) + endif + enddo +! + do i = 1, im + flg(i) = cnvflg(i) + ktcon1(i) = kmax(i) - 1 + enddo + do k = 2, km1 + do i = 1, im + if (flg(i)) then + if(k.ge.ktcon(i).and.k.lt.kmax(i)) then + dz1 = zo(i,k+1) - zo(i,k) + gamma = el2orc * qeso(i,k) / (to(i,k)**2) + rfact = 1. + delta * cp * gamma + & * to(i,k) / hvap + aa2(i) = aa2(i) + + & dz1 * (g / (cp * to(i,k))) + & * dbyo(i,k) / (1. + gamma) + & * rfact + if(aa2(i).lt.0.) then + ktcon1(i) = k + flg(i) = .false. + endif + endif + endif + enddo + enddo +! +! compute cloud moisture property, detraining cloud water +! and precipitation in overshooting layers +! +!> - For the overshooting convection, calculate the moisture content of the entraining/detraining parcel as before. Partition convective cloud water and precipitation and detrain convective cloud water above the mimimum in moist static energy. + do k = 2, km1 + do i = 1, im + if (cnvflg(i)) then + if(k.ge.ktcon(i).and.k.lt.ktcon1(i)) then + dz = zi(i,k) - zi(i,k-1) + gamma = el2orc * qeso(i,k) / (to(i,k)**2) + qrch = qeso(i,k) + & + gamma * dbyo(i,k) / (hvap * (1. + gamma)) +! + tem = 0.5 * (xlamue(i,k)+xlamue(i,k-1)) * dz + tem1 = 0.5 * xlamud(i) * dz + factor = 1. + tem - tem1 + qcko(i,k) = ((1.-tem1)*qcko(i,k-1)+tem*0.5* + & (qo(i,k)+qo(i,k-1)))/factor + qrcko(i,k) = qcko(i,k) +! + dq = eta(i,k) * (qcko(i,k) - qrch) +! +! check if there is excess moisture to release latent heat +! + if(dq.gt.0.) then + etah = .5 * (eta(i,k) + eta(i,k-1)) + dp = 1000. * del(i,k) + if(ncloud.gt.0.) then + qlk = dq / (eta(i,k) + etah * (c0 + c1) * dz) + dellal(i,k) = etah * c1 * dz * qlk * g / dp + else + qlk = dq / (eta(i,k) + etah * c0 * dz) + endif + qcko(i,k) = qlk + qrch + pwo(i,k) = etah * c0 * dz * qlk + pwavo(i) = pwavo(i) + pwo(i,k) +! cnvwt(i,k) = (etah*qlk + pwo(i,k)) * g / dp + cnvwt(i,k) = etah * qlk * g / dp + endif + endif + endif + enddo + enddo +! +! exchange ktcon with ktcon1 +! +!> - Swap the indices of the convective cloud top (ktcon) and the overshooting convection top (ktcon1) to use the same cloud top level in the calculations of \f$A^+\f$ and \f$A^*\f$. + do i = 1, im + if(cnvflg(i)) then + kk = ktcon(i) + ktcon(i) = ktcon1(i) + ktcon1(i) = kk + endif + enddo +! +! this section is ready for cloud water +! +!> - Separate the total updraft cloud water at cloud top into vapor and condensate. + if(ncloud.gt.0) then +! +! compute liquid and vapor separation at cloud top +! + do i = 1, im + if(cnvflg(i)) then + k = ktcon(i) - 1 + gamma = el2orc * qeso(i,k) / (to(i,k)**2) + qrch = qeso(i,k) + & + gamma * dbyo(i,k) / (hvap * (1. + gamma)) + dq = qcko(i,k) - qrch +! +! check if there is excess moisture to release latent heat +! + if(dq.gt.0.) then + qlko_ktcon(i) = dq + qcko(i,k) = qrch + endif + endif + enddo + endif +! +! if(lat.eq.latd.and.lon.eq.lond.and.cnvflg(i)) then +! print *, ' aa1(i) before dwndrft =', aa1(i) +! endif +! +!------- downdraft calculations +! +!--- compute precipitation efficiency in terms of windshear +! +!> ## Perform calculations related to the downdraft of the entraining/detraining cloud model ("static control"). +!! - First, in order to calculate the downdraft mass flux (as a fraction of the updraft mass flux), calculate the wind shear and precipitation efficiency according to equation 58 in Fritsch and Chappell (1980) \cite fritsch_and_chappell_1980 : +!! \f[ +!! E = 1.591 - 0.639\frac{\Delta V}{\Delta z} + 0.0953\left(\frac{\Delta V}{\Delta z}\right)^2 - 0.00496\left(\frac{\Delta V}{\Delta z}\right)^3 +!! \f] +!! where \f$\Delta V\f$ is the integrated horizontal shear over the cloud depth, \f$\Delta z\f$, (the ratio is converted to units of \f$10^{-3} s^{-1}\f$). The variable "edto" is \f$1-E\f$ and is constrained to the range \f$[0,0.9]\f$. + do i = 1, im + if(cnvflg(i)) then + vshear(i) = 0. + endif + enddo + do k = 2, km + do i = 1, im + if (cnvflg(i)) then + if(k.gt.kb(i).and.k.le.ktcon(i)) then + shear= sqrt((uo(i,k)-uo(i,k-1)) ** 2 + & + (vo(i,k)-vo(i,k-1)) ** 2) + vshear(i) = vshear(i) + shear + endif + endif + enddo + enddo + do i = 1, im + if(cnvflg(i)) then + vshear(i) = 1.e3 * vshear(i) / (zi(i,ktcon(i))-zi(i,kb(i))) + e1=1.591-.639*vshear(i) + & +.0953*(vshear(i)**2)-.00496*(vshear(i)**3) + edt(i)=1.-e1 + val = .9 + edt(i) = min(edt(i),val) + val = .0 + edt(i) = max(edt(i),val) + edto(i)=edt(i) + edtx(i)=edt(i) + endif + enddo +! +! determine detrainment rate between 1 and kbcon +! +!> - Next, calculate the variable detrainment rate between the surface and the LFC according to: +!! \f[ +!! \lambda_d = \frac{1-\beta^{\frac{1}{k_{LFC}}}}{\overline{\Delta z}} +!! \f] +!! \f$\lambda_d\f$ is the detrainment rate, \f$\beta\f$ is a constant currently set to 0.05, \f$k_{LFC}\f$ is the vertical index of the LFC level, and \f$\overline{\Delta z}\f$ is the average vertical grid spacing below the LFC. + do i = 1, im + if(cnvflg(i)) then + sumx(i) = 0. + endif + enddo + do k = 1, km1 + do i = 1, im + if(cnvflg(i).and.k.ge.1.and.k.lt.kbcon(i)) then + dz = zi(i,k+1) - zi(i,k) + sumx(i) = sumx(i) + dz + endif + enddo + enddo + do i = 1, im + beta = betas + if(islimsk(i) == 1) beta = betal + if(cnvflg(i)) then + dz = (sumx(i)+zi(i,1))/float(kbcon(i)) + tem = 1./float(kbcon(i)) + xlamd(i) = (1.-beta**tem)/dz + endif + enddo +! +! determine downdraft mass flux +! +!> - Calculate the normalized downdraft mass flux from equation 1 of Pan and Wu (1995) \cite pan_and_wu_1995 . Downdraft entrainment and detrainment rates are constants from the downdraft origination to the LFC. + do k = km1, 1, -1 + do i = 1, im + if (cnvflg(i) .and. k .le. kmax(i)-1) then + if(k.lt.jmin(i).and.k.ge.kbcon(i)) then + dz = zi(i,k+1) - zi(i,k) + ptem = xlamdd - xlamde + etad(i,k) = etad(i,k+1) * (1. - ptem * dz) + else if(k.lt.kbcon(i)) then + dz = zi(i,k+1) - zi(i,k) + ptem = xlamd(i) + xlamdd - xlamde + etad(i,k) = etad(i,k+1) * (1. - ptem * dz) + endif + endif + enddo + enddo +! +!--- downdraft moisture properties +! +!> - Set initial cloud downdraft properties equal to the state variables at the downdraft origination level. + do i = 1, im + if(cnvflg(i)) then + jmn = jmin(i) + hcdo(i,jmn) = heo(i,jmn) + qcdo(i,jmn) = qo(i,jmn) + qrcdo(i,jmn)= qo(i,jmn) + ucdo(i,jmn) = uo(i,jmn) + vcdo(i,jmn) = vo(i,jmn) + pwevo(i) = 0. + endif + enddo +!j +!> - Calculate the cloud properties as a parcel descends, modified by entrainment and detrainment. Discretization follows Appendix B of Grell (1993) \cite grell_1993 . + do k = km1, 1, -1 + do i = 1, im + if (cnvflg(i) .and. k.lt.jmin(i)) then + dz = zi(i,k+1) - zi(i,k) + if(k.ge.kbcon(i)) then + tem = xlamde * dz + tem1 = 0.5 * xlamdd * dz + else + tem = xlamde * dz + tem1 = 0.5 * (xlamd(i)+xlamdd) * dz + endif + factor = 1. + tem - tem1 + ptem = 0.5 * tem - pgcon + ptem1= 0.5 * tem + pgcon + hcdo(i,k) = ((1.-tem1)*hcdo(i,k+1)+tem*0.5* + & (heo(i,k)+heo(i,k+1)))/factor + ucdo(i,k) = ((1.-tem1)*ucdo(i,k+1)+ptem*uo(i,k+1) + & +ptem1*uo(i,k))/factor + vcdo(i,k) = ((1.-tem1)*vcdo(i,k+1)+ptem*vo(i,k+1) + & +ptem1*vo(i,k))/factor + dbyo(i,k) = hcdo(i,k) - heso(i,k) + endif + enddo + enddo +! +!> - Compute the amount of moisture that is necessary to keep the downdraft saturated. + do k = km1, 1, -1 + do i = 1, im + if (cnvflg(i).and.k.lt.jmin(i)) then + gamma = el2orc * qeso(i,k) / (to(i,k)**2) + qrcdo(i,k) = qeso(i,k)+ + & (1./hvap)*(gamma/(1.+gamma))*dbyo(i,k) +! detad = etad(i,k+1) - etad(i,k) +! + dz = zi(i,k+1) - zi(i,k) + if(k.ge.kbcon(i)) then + tem = xlamde * dz + tem1 = 0.5 * xlamdd * dz + else + tem = xlamde * dz + tem1 = 0.5 * (xlamd(i)+xlamdd) * dz + endif + factor = 1. + tem - tem1 + qcdo(i,k) = ((1.-tem1)*qrcdo(i,k+1)+tem*0.5* + & (qo(i,k)+qo(i,k+1)))/factor +! +! pwdo(i,k) = etad(i,k+1) * qcdo(i,k+1) - +! & etad(i,k) * qrcdo(i,k) +! pwdo(i,k) = pwdo(i,k) - detad * +! & .5 * (qrcdo(i,k) + qrcdo(i,k+1)) +! + pwdo(i,k) = etad(i,k) * (qcdo(i,k) - qrcdo(i,k)) + pwevo(i) = pwevo(i) + pwdo(i,k) + endif + enddo + enddo +! +!--- final downdraft strength dependent on precip +!--- efficiency (edt), normalized condensate (pwav), and +!--- evaporate (pwev) +! +!> - Update the precipitation efficiency (edto) based on the ratio of normalized cloud condensate (pwavo) to normalized cloud evaporate (pwevo). + do i = 1, im + edtmax = edtmaxl + if(islimsk(i) == 0) edtmax = edtmaxs + if(cnvflg(i)) then + if(pwevo(i).lt.0.) then + edto(i) = -edto(i) * pwavo(i) / pwevo(i) + edto(i) = min(edto(i),edtmax) + else + edto(i) = 0. + endif + endif + enddo +! +!--- downdraft cloudwork functions +! +!> - Calculate downdraft cloud work function (\f$A_d\f$) according to equation A.42 (discretized by B.11) in Grell (1993) \cite grell_1993 . Add it to the updraft cloud work function, \f$A_u\f$. + do k = km1, 1, -1 + do i = 1, im + if (cnvflg(i) .and. k .lt. jmin(i)) then + gamma = el2orc * qeso(i,k) / to(i,k)**2 + dhh=hcdo(i,k) + dt=to(i,k) + dg=gamma + dh=heso(i,k) + dz=-1.*(zo(i,k+1)-zo(i,k)) + aa1(i)=aa1(i)+edto(i)*dz*(g/(cp*dt))*((dhh-dh)/(1.+dg)) + & *(1.+delta*cp*dg*dt/hvap) + val=0. + aa1(i)=aa1(i)+edto(i)* + & dz*g*delta*max(val,(qeso(i,k)-qo(i,k))) + endif + enddo + enddo +!> - Check for negative total cloud work function; if found, return to calling routine without modifying state variables. + do i = 1, im + if(cnvflg(i).and.aa1(i).le.0.) then + cnvflg(i) = .false. + endif + enddo +!! + totflg = .true. + do i=1,im + totflg = totflg .and. (.not. cnvflg(i)) + enddo + if(totflg) return +!! +! +!--- what would the change be, that a cloud with unit mass +!--- will do to the environment? +! +!> - Calculate the change in moist static energy, moisture mixing ratio, and horizontal winds per unit cloud base mass flux near the surface using equations B.18 and B.19 from Grell (1993) \cite grell_1993, for all layers below cloud top from equations B.14 and B.15, and for the cloud top from B.16 and B.17. + do k = 1, km + do i = 1, im + if(cnvflg(i) .and. k .le. kmax(i)) then + dellah(i,k) = 0. + dellaq(i,k) = 0. + dellau(i,k) = 0. + dellav(i,k) = 0. + endif + enddo + enddo + do i = 1, im + if(cnvflg(i)) then + dp = 1000. * del(i,1) + dellah(i,1) = edto(i) * etad(i,1) * (hcdo(i,1) + & - heo(i,1)) * g / dp + dellaq(i,1) = edto(i) * etad(i,1) * (qrcdo(i,1) + & - qo(i,1)) * g / dp + dellau(i,1) = edto(i) * etad(i,1) * (ucdo(i,1) + & - uo(i,1)) * g / dp + dellav(i,1) = edto(i) * etad(i,1) * (vcdo(i,1) + & - vo(i,1)) * g / dp + endif + enddo +! +!--- changed due to subsidence and entrainment +! + do k = 2, km1 + do i = 1, im + if (cnvflg(i).and.k.lt.ktcon(i)) then + aup = 1. + if(k.le.kb(i)) aup = 0. + adw = 1. + if(k.gt.jmin(i)) adw = 0. + dp = 1000. * del(i,k) + dz = zi(i,k) - zi(i,k-1) +! + dv1h = heo(i,k) + dv2h = .5 * (heo(i,k) + heo(i,k-1)) + dv3h = heo(i,k-1) + dv1q = qo(i,k) + dv2q = .5 * (qo(i,k) + qo(i,k-1)) + dv3q = qo(i,k-1) + dv1u = uo(i,k) + dv2u = .5 * (uo(i,k) + uo(i,k-1)) + dv3u = uo(i,k-1) + dv1v = vo(i,k) + dv2v = .5 * (vo(i,k) + vo(i,k-1)) + dv3v = vo(i,k-1) +! + tem = 0.5 * (xlamue(i,k)+xlamue(i,k-1)) + tem1 = xlamud(i) +! + if(k.le.kbcon(i)) then + ptem = xlamde + ptem1 = xlamd(i)+xlamdd + else + ptem = xlamde + ptem1 = xlamdd + endif +! + dellah(i,k) = dellah(i,k) + + & ((aup*eta(i,k)-adw*edto(i)*etad(i,k))*dv1h + & - (aup*eta(i,k-1)-adw*edto(i)*etad(i,k-1))*dv3h + & - (aup*tem*eta(i,k-1)+adw*edto(i)*ptem*etad(i,k))*dv2h*dz + & + aup*tem1*eta(i,k-1)*.5*(hcko(i,k)+hcko(i,k-1))*dz + & + adw*edto(i)*ptem1*etad(i,k)*.5*(hcdo(i,k)+hcdo(i,k-1))*dz + & ) *g/dp +! + dellaq(i,k) = dellaq(i,k) + + & ((aup*eta(i,k)-adw*edto(i)*etad(i,k))*dv1q + & - (aup*eta(i,k-1)-adw*edto(i)*etad(i,k-1))*dv3q + & - (aup*tem*eta(i,k-1)+adw*edto(i)*ptem*etad(i,k))*dv2q*dz + & + aup*tem1*eta(i,k-1)*.5*(qrcko(i,k)+qcko(i,k-1))*dz + & + adw*edto(i)*ptem1*etad(i,k)*.5*(qrcdo(i,k)+qcdo(i,k-1))*dz + & ) *g/dp +! + dellau(i,k) = dellau(i,k) + + & ((aup*eta(i,k)-adw*edto(i)*etad(i,k))*dv1u + & - (aup*eta(i,k-1)-adw*edto(i)*etad(i,k-1))*dv3u + & - (aup*tem*eta(i,k-1)+adw*edto(i)*ptem*etad(i,k))*dv2u*dz + & + aup*tem1*eta(i,k-1)*.5*(ucko(i,k)+ucko(i,k-1))*dz + & + adw*edto(i)*ptem1*etad(i,k)*.5*(ucdo(i,k)+ucdo(i,k-1))*dz + & - pgcon*(aup*eta(i,k-1)-adw*edto(i)*etad(i,k))*(dv1u-dv3u) + & ) *g/dp +! + dellav(i,k) = dellav(i,k) + + & ((aup*eta(i,k)-adw*edto(i)*etad(i,k))*dv1v + & - (aup*eta(i,k-1)-adw*edto(i)*etad(i,k-1))*dv3v + & - (aup*tem*eta(i,k-1)+adw*edto(i)*ptem*etad(i,k))*dv2v*dz + & + aup*tem1*eta(i,k-1)*.5*(vcko(i,k)+vcko(i,k-1))*dz + & + adw*edto(i)*ptem1*etad(i,k)*.5*(vcdo(i,k)+vcdo(i,k-1))*dz + & - pgcon*(aup*eta(i,k-1)-adw*edto(i)*etad(i,k))*(dv1v-dv3v) + & ) *g/dp +! + endif + enddo + enddo +! +!------- cloud top +! + do i = 1, im + if(cnvflg(i)) then + indx = ktcon(i) + dp = 1000. * del(i,indx) + dv1h = heo(i,indx-1) + dellah(i,indx) = eta(i,indx-1) * + & (hcko(i,indx-1) - dv1h) * g / dp + dv1q = qo(i,indx-1) + dellaq(i,indx) = eta(i,indx-1) * + & (qcko(i,indx-1) - dv1q) * g / dp + dv1u = uo(i,indx-1) + dellau(i,indx) = eta(i,indx-1) * + & (ucko(i,indx-1) - dv1u) * g / dp + dv1v = vo(i,indx-1) + dellav(i,indx) = eta(i,indx-1) * + & (vcko(i,indx-1) - dv1v) * g / dp +! +! cloud water +! + dellal(i,indx) = eta(i,indx-1) * + & qlko_ktcon(i) * g / dp + endif + enddo +! +!------- final changed variable per unit mass flux +! +!> - Calculate the change in the temperature and moisture profiles per unit cloud base mass flux. + do k = 1, km + do i = 1, im + if (cnvflg(i).and.k .le. kmax(i)) then + if(k.gt.ktcon(i)) then + qo(i,k) = q1(i,k) + to(i,k) = t1(i,k) + endif + if(k.le.ktcon(i)) then + qo(i,k) = dellaq(i,k) * mbdt + q1(i,k) + dellat = (dellah(i,k) - hvap * dellaq(i,k)) / cp + to(i,k) = dellat * mbdt + t1(i,k) + val = 1.e-10 + qo(i,k) = max(qo(i,k), val ) + endif + endif + enddo + enddo +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! +!--- the above changed environment is now used to calulate the +!--- effect the arbitrary cloud (with unit mass flux) +!--- would have on the stability, +!--- which then is used to calculate the real mass flux, +!--- necessary to keep this change in balance with the large-scale +!--- destabilization. +! +!--- environmental conditions again, first heights +! +!> ## Using the updated temperature and moisture profiles that were modified by the convection on a short time-scale, recalculate the total cloud work function to determine the change in the cloud work function due to convection, or the stabilizing effect of the cumulus. +!! - Using notation from Pan and Wu (1995) \cite pan_and_wu_1995, the previously calculated cloud work function is denoted by \f$A^+\f$. Now, it is necessary to use the entraining/detraining cloud model ("static control") to determine the cloud work function of the environment after the stabilization of the arbitrary convective element (per unit cloud base mass flux) has been applied, denoted by \f$A^*\f$. +!! - Recalculate saturation specific humidity. + do k = 1, km + do i = 1, im + if(cnvflg(i) .and. k .le. kmax(i)) then + qeso(i,k) = 0.01 * fpvs(to(i,k)) ! fpvs is in pa + qeso(i,k) = eps * qeso(i,k) / (pfld(i,k)+epsm1*qeso(i,k)) + val = 1.e-8 + qeso(i,k) = max(qeso(i,k), val ) +! tvo(i,k) = to(i,k) + delta * to(i,k) * qo(i,k) + endif + enddo + enddo +! +!--- moist static energy +! +!! - Recalculate moist static energy and saturation moist static energy. + do k = 1, km1 + do i = 1, im + if(cnvflg(i) .and. k .le. kmax(i)-1) then + dz = .5 * (zo(i,k+1) - zo(i,k)) + dp = .5 * (pfld(i,k+1) - pfld(i,k)) + es = 0.01 * fpvs(to(i,k+1)) ! fpvs is in pa + pprime = pfld(i,k+1) + epsm1 * es + qs = eps * es / pprime + dqsdp = - qs / pprime + desdt = es * (fact1 / to(i,k+1) + fact2 / (to(i,k+1)**2)) + dqsdt = qs * pfld(i,k+1) * desdt / (es * pprime) + gamma = el2orc * qeso(i,k+1) / (to(i,k+1)**2) + dt = (g * dz + hvap * dqsdp * dp) / (cp * (1. + gamma)) + dq = dqsdt * dt + dqsdp * dp + to(i,k) = to(i,k+1) + dt + qo(i,k) = qo(i,k+1) + dq + po(i,k) = .5 * (pfld(i,k) + pfld(i,k+1)) + endif + enddo + enddo + do k = 1, km1 + do i = 1, im + if(cnvflg(i) .and. k .le. kmax(i)-1) then + qeso(i,k) = 0.01 * fpvs(to(i,k)) ! fpvs is in pa + qeso(i,k) = eps * qeso(i,k) / (po(i,k) + epsm1 * qeso(i,k)) + val1 = 1.e-8 + qeso(i,k) = max(qeso(i,k), val1) + val2 = 1.e-10 + qo(i,k) = max(qo(i,k), val2 ) +! qo(i,k) = min(qo(i,k),qeso(i,k)) + heo(i,k) = .5 * g * (zo(i,k) + zo(i,k+1)) + + & cp * to(i,k) + hvap * qo(i,k) + heso(i,k) = .5 * g * (zo(i,k) + zo(i,k+1)) + + & cp * to(i,k) + hvap * qeso(i,k) + endif + enddo + enddo + do i = 1, im + if(cnvflg(i)) then + k = kmax(i) + heo(i,k) = g * zo(i,k) + cp * to(i,k) + hvap * qo(i,k) + heso(i,k) = g * zo(i,k) + cp * to(i,k) + hvap * qeso(i,k) +! heo(i,k) = min(heo(i,k),heso(i,k)) + endif + enddo +! +!**************************** static control +! +!------- moisture and cloud work functions +! +!> - As before, recalculate the updraft cloud work function. + do i = 1, im + if(cnvflg(i)) then + xaa0(i) = 0. + xpwav(i) = 0. + endif + enddo +! + do i = 1, im + if(cnvflg(i)) then + indx = kb(i) + hcko(i,indx) = heo(i,indx) + qcko(i,indx) = qo(i,indx) + endif + enddo + do k = 2, km1 + do i = 1, im + if (cnvflg(i)) then + if(k.gt.kb(i).and.k.le.ktcon(i)) then + dz = zi(i,k) - zi(i,k-1) + tem = 0.5 * (xlamue(i,k)+xlamue(i,k-1)) * dz + tem1 = 0.5 * xlamud(i) * dz + factor = 1. + tem - tem1 + hcko(i,k) = ((1.-tem1)*hcko(i,k-1)+tem*0.5* + & (heo(i,k)+heo(i,k-1)))/factor + endif + endif + enddo + enddo + do k = 2, km1 + do i = 1, im + if (cnvflg(i)) then + if(k.gt.kb(i).and.k.lt.ktcon(i)) then + dz = zi(i,k) - zi(i,k-1) + gamma = el2orc * qeso(i,k) / (to(i,k)**2) + xdby = hcko(i,k) - heso(i,k) + xqrch = qeso(i,k) + & + gamma * xdby / (hvap * (1. + gamma)) +! + tem = 0.5 * (xlamue(i,k)+xlamue(i,k-1)) * dz + tem1 = 0.5 * xlamud(i) * dz + factor = 1. + tem - tem1 + qcko(i,k) = ((1.-tem1)*qcko(i,k-1)+tem*0.5* + & (qo(i,k)+qo(i,k-1)))/factor +! + dq = eta(i,k) * (qcko(i,k) - xqrch) +! + if(k.ge.kbcon(i).and.dq.gt.0.) then + etah = .5 * (eta(i,k) + eta(i,k-1)) + if(ncloud.gt.0..and.k.gt.jmin(i)) then + qlk = dq / (eta(i,k) + etah * (c0 + c1) * dz) + else + qlk = dq / (eta(i,k) + etah * c0 * dz) + endif + if(k.lt.ktcon1(i)) then + xaa0(i) = xaa0(i) - dz * g * qlk + endif + qcko(i,k) = qlk + xqrch + xpw = etah * c0 * dz * qlk + xpwav(i) = xpwav(i) + xpw + endif + endif + if(k.ge.kbcon(i).and.k.lt.ktcon1(i)) then + dz1 = zo(i,k+1) - zo(i,k) + gamma = el2orc * qeso(i,k) / (to(i,k)**2) + rfact = 1. + delta * cp * gamma + & * to(i,k) / hvap + xaa0(i) = xaa0(i) + & + dz1 * (g / (cp * to(i,k))) + & * xdby / (1. + gamma) + & * rfact + val=0. + xaa0(i)=xaa0(i)+ + & dz1 * g * delta * + & max(val,(qeso(i,k) - qo(i,k))) + endif + endif + enddo + enddo +! +!------- downdraft calculations +! +!--- downdraft moisture properties +! +!> - As before, recalculate the downdraft cloud work function. + do i = 1, im + if(cnvflg(i)) then + jmn = jmin(i) + hcdo(i,jmn) = heo(i,jmn) + qcdo(i,jmn) = qo(i,jmn) + qrcd(i,jmn) = qo(i,jmn) + xpwev(i) = 0. + endif + enddo +! + do k = km1, 1, -1 + do i = 1, im + if (cnvflg(i) .and. k.lt.jmin(i)) then + dz = zi(i,k+1) - zi(i,k) + if(k.ge.kbcon(i)) then + tem = xlamde * dz + tem1 = 0.5 * xlamdd * dz + else + tem = xlamde * dz + tem1 = 0.5 * (xlamd(i)+xlamdd) * dz + endif + factor = 1. + tem - tem1 + hcdo(i,k) = ((1.-tem1)*hcdo(i,k+1)+tem*0.5* + & (heo(i,k)+heo(i,k+1)))/factor + endif + enddo + enddo +! + do k = km1, 1, -1 + do i = 1, im + if (cnvflg(i) .and. k .lt. jmin(i)) then + dq = qeso(i,k) + dt = to(i,k) + gamma = el2orc * dq / dt**2 + dh = hcdo(i,k) - heso(i,k) + qrcd(i,k)=dq+(1./hvap)*(gamma/(1.+gamma))*dh +! detad = etad(i,k+1) - etad(i,k) +! + dz = zi(i,k+1) - zi(i,k) + if(k.ge.kbcon(i)) then + tem = xlamde * dz + tem1 = 0.5 * xlamdd * dz + else + tem = xlamde * dz + tem1 = 0.5 * (xlamd(i)+xlamdd) * dz + endif + factor = 1. + tem - tem1 + qcdo(i,k) = ((1.-tem1)*qrcd(i,k+1)+tem*0.5* + & (qo(i,k)+qo(i,k+1)))/factor +! +! xpwd = etad(i,k+1) * qcdo(i,k+1) - +! & etad(i,k) * qrcd(i,k) +! xpwd = xpwd - detad * +! & .5 * (qrcd(i,k) + qrcd(i,k+1)) +! + xpwd = etad(i,k) * (qcdo(i,k) - qrcd(i,k)) + xpwev(i) = xpwev(i) + xpwd + endif + enddo + enddo +! + do i = 1, im + edtmax = edtmaxl + if(islimsk(i) == 0) edtmax = edtmaxs + if(cnvflg(i)) then + if(xpwev(i).ge.0.) then + edtx(i) = 0. + else + edtx(i) = -edtx(i) * xpwav(i) / xpwev(i) + edtx(i) = min(edtx(i),edtmax) + endif + endif + enddo +! +! +!--- downdraft cloudwork functions +! +! + do k = km1, 1, -1 + do i = 1, im + if (cnvflg(i) .and. k.lt.jmin(i)) then + gamma = el2orc * qeso(i,k) / to(i,k)**2 + dhh=hcdo(i,k) + dt= to(i,k) + dg= gamma + dh= heso(i,k) + dz=-1.*(zo(i,k+1)-zo(i,k)) + xaa0(i)=xaa0(i)+edtx(i)*dz*(g/(cp*dt))*((dhh-dh)/(1.+dg)) + & *(1.+delta*cp*dg*dt/hvap) + val=0. + xaa0(i)=xaa0(i)+edtx(i)* + & dz*g*delta*max(val,(qeso(i,k)-qo(i,k))) + endif + enddo + enddo +! +! calculate critical cloud work function +! +!> ## For the "dynamic control", using a reference cloud work function, estimate the change in cloud work function due to the large-scale dynamics. Following the quasi-equilibrium assumption, calculate the cloud base mass flux required to keep the large-scale convective destabilization in balance with the stabilization effect of the convection. +!! - Calculate the reference, or "critical", cloud work function derived from observations, denoted by \f$A^0\f$. + do i = 1, im + if(cnvflg(i)) then + if(pfld(i,ktcon(i)).lt.pcrit(15))then + acrt(i)=acrit(15)*(975.-pfld(i,ktcon(i))) + & /(975.-pcrit(15)) + else if(pfld(i,ktcon(i)).gt.pcrit(1))then + acrt(i)=acrit(1) + else + k = int((850. - pfld(i,ktcon(i)))/50.) + 2 + k = min(k,15) + k = max(k,2) + acrt(i)=acrit(k)+(acrit(k-1)-acrit(k))* + & (pfld(i,ktcon(i))-pcrit(k))/(pcrit(k-1)-pcrit(k)) + endif + endif + enddo +!> - Calculate a correction factor, "acrtfct", that is a function of the cloud base vertical velocity, to multiply the critical cloud work function. + do i = 1, im + if(cnvflg(i)) then + if(islimsk(i) == 1) then + w1 = w1l + w2 = w2l + w3 = w3l + w4 = w4l + else + w1 = w1s + w2 = w2s + w3 = w3s + w4 = w4s + endif +! +! modify critical cloud workfunction by cloud base vertical velocity +! + if(pdot(i).le.w4) then + acrtfct(i) = (pdot(i) - w4) / (w3 - w4) + elseif(pdot(i).ge.-w4) then + acrtfct(i) = - (pdot(i) + w4) / (w4 - w3) + else + acrtfct(i) = 0. + endif + val1 = -1. + acrtfct(i) = max(acrtfct(i),val1) + val2 = 1. + acrtfct(i) = min(acrtfct(i),val2) + acrtfct(i) = 1. - acrtfct(i) +! +! modify acrtfct(i) by colume mean rh if rhbar(i) is greater than 80 percent +! +! if(rhbar(i).ge..8) then +! acrtfct(i) = acrtfct(i) * (.9 - min(rhbar(i),.9)) * 10. +! endif +! +! modify adjustment time scale by cloud base vertical velocity +! +!> - Also, modify the time scale over which the large-scale destabilization takes place (dtconv) according to the cloud base vertical velocity, ensuring that this timescale stays between previously calculated minimum and maximum values. + dtconv(i) = dt2 + max((1800. - dt2),0.) * + & (pdot(i) - w2) / (w1 - w2) +! dtconv(i) = max(dtconv(i), dt2) +! dtconv(i) = 1800. * (pdot(i) - w2) / (w1 - w2) + dtconv(i) = max(dtconv(i),dtmin) + dtconv(i) = min(dtconv(i),dtmax) +! + endif + enddo +! +!--- large scale forcing +! +!> - Calculate the large scale destabilization as in equation 5 of Pan and Wu (1995) \cite pan_and_wu_1995 : +!! \f[ +!! \frac{\partial A}{\partial t}_{LS}=\frac{A^+-cA^0}{\Delta t_{LS}} +!! \f] +!! where \f$c\f$ is the correction factor "acrtfct", \f$\Delta t_{LS}\f$ is the modified timescale over which the environment is destabilized, and the other quantities have been previously defined. + do i= 1, im + if(cnvflg(i)) then + fld(i)=(aa1(i)-acrt(i)* acrtfct(i))/dtconv(i) + if(fld(i).le.0.) cnvflg(i) = .false. + endif +!> - Calculate the stabilization effect of the convection (per unit cloud base mass flux) as in equation 6 of Pan and Wu (1995) \cite pan_and_wu_1995 : +!! \f[ +!! \frac{\partial A}{\partial t}_{cu}=\frac{A^*-A^+}{\Delta t_{cu}} +!! \f] +!! \f$\Delta t_{cu}\f$ is the short timescale of the convection. + if(cnvflg(i)) then +! xaa0(i) = max(xaa0(i),0.) + xk(i) = (xaa0(i) - aa1(i)) / mbdt + if(xk(i).ge.0.) cnvflg(i) = .false. + endif +! +!--- kernel, cloud base mass flux +! +!> - The cloud base mass flux (xmb) is then calculated from equation 7 of Pan and Wu (1995) \cite pan_and_wu_1995 +!! \f[ +!! M_c=\frac{-\frac{\partial A}{\partial t}_{LS}}{\frac{\partial A}{\partial t}_{cu}} +!! \f] + if(cnvflg(i)) then + xmb(i) = -fld(i) / xk(i) + xmb(i) = min(xmb(i),xmbmax(i)) + endif + enddo +!! +!> - If the large scale destabilization is less than zero, or the stabilization by the convection is greater than zero, then the scheme returns to the calling routine without modifying the state variables. + totflg = .true. + do i=1,im + totflg = totflg .and. (.not. cnvflg(i)) + enddo + if(totflg) return +!! +! +! restore to,qo,uo,vo to t1,q1,u1,v1 in case convection stops +! + + do k = 1, km + do i = 1, im + if (cnvflg(i) .and. k .le. kmax(i)) then + to(i,k) = t1(i,k) + qo(i,k) = q1(i,k) + uo(i,k) = u1(i,k) + vo(i,k) = v1(i,k) + qeso(i,k) = 0.01 * fpvs(t1(i,k)) ! fpvs is in pa + qeso(i,k) = eps * qeso(i,k) / (pfld(i,k) + epsm1*qeso(i,k)) + val = 1.e-8 + qeso(i,k) = max(qeso(i,k), val ) + endif + enddo + enddo +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! +!--- feedback: simply the changes from the cloud with unit mass flux +!--- multiplied by the mass flux necessary to keep the +!--- equilibrium with the larger-scale. +! +!> ## For the "feedback" control, calculate updated values of the state variables by multiplying the cloud base mass flux and the tendencies calculated per unit cloud base mass flux from the static control. +!> - Calculate the temperature tendency from the moist static energy and specific humidity tendencies. +!> - Update the temperature, specific humidity, and horiztonal wind state variables by multiplying the cloud base mass flux-normalized tendencies by the cloud base mass flux. +!> - Accumulate column-integrated tendencies. + do i = 1, im + delhbar(i) = 0. + delqbar(i) = 0. + deltbar(i) = 0. + delubar(i) = 0. + delvbar(i) = 0. + qcond(i) = 0. + enddo + do k = 1, km + do i = 1, im + if (cnvflg(i) .and. k .le. kmax(i)) then + if(k.le.ktcon(i)) then + dellat = (dellah(i,k) - hvap * dellaq(i,k)) / cp + t1(i,k) = t1(i,k) + dellat * xmb(i) * dt2 + q1(i,k) = q1(i,k) + dellaq(i,k) * xmb(i) * dt2 +! tem = 1./rcs(i) +! u1(i,k) = u1(i,k) + dellau(i,k) * xmb(i) * dt2 * tem +! v1(i,k) = v1(i,k) + dellav(i,k) * xmb(i) * dt2 * tem + u1(i,k) = u1(i,k) + dellau(i,k) * xmb(i) * dt2 + v1(i,k) = v1(i,k) + dellav(i,k) * xmb(i) * dt2 + dp = 1000. * del(i,k) + delhbar(i) = delhbar(i) + dellah(i,k)*xmb(i)*dp/g + delqbar(i) = delqbar(i) + dellaq(i,k)*xmb(i)*dp/g + deltbar(i) = deltbar(i) + dellat*xmb(i)*dp/g + delubar(i) = delubar(i) + dellau(i,k)*xmb(i)*dp/g + delvbar(i) = delvbar(i) + dellav(i,k)*xmb(i)*dp/g + endif + endif + enddo + enddo +!> - Recalculate saturation specific humidity using the updated temperature. + do k = 1, km + do i = 1, im + if (cnvflg(i) .and. k .le. kmax(i)) then + if(k.le.ktcon(i)) then + qeso(i,k) = 0.01 * fpvs(t1(i,k)) ! fpvs is in pa + qeso(i,k) = eps * qeso(i,k)/(pfld(i,k) + epsm1*qeso(i,k)) + val = 1.e-8 + qeso(i,k) = max(qeso(i,k), val ) + endif + endif + enddo + enddo +! +!> - Add up column-integrated convective precipitation by multiplying the normalized value by the cloud base mass flux. + do i = 1, im + rntot(i) = 0. + delqev(i) = 0. + delq2(i) = 0. + flg(i) = cnvflg(i) + enddo + do k = km, 1, -1 + do i = 1, im + if (cnvflg(i) .and. k .le. kmax(i)) then + if(k.lt.ktcon(i)) then + aup = 1. + if(k.le.kb(i)) aup = 0. + adw = 1. + if(k.ge.jmin(i)) adw = 0. + rain = aup * pwo(i,k) + adw * edto(i) * pwdo(i,k) + rntot(i) = rntot(i) + rain * xmb(i) * .001 * dt2 + endif + endif + enddo + enddo +!> - Determine the evaporation of the convective precipitation and update the integrated convective precipitation. +!> - Update state temperature and moisture to account for evaporation of convective precipitation. +!> - Update column-integrated tendencies to account for evaporation of convective precipitation. + do k = km, 1, -1 + do i = 1, im + if (k .le. kmax(i)) then + deltv(i) = 0. + delq(i) = 0. + qevap(i) = 0. + if(cnvflg(i).and.k.lt.ktcon(i)) then + aup = 1. + if(k.le.kb(i)) aup = 0. + adw = 1. + if(k.ge.jmin(i)) adw = 0. + rain = aup * pwo(i,k) + adw * edto(i) * pwdo(i,k) + rn(i) = rn(i) + rain * xmb(i) * .001 * dt2 + endif + if(flg(i).and.k.lt.ktcon(i)) then + evef = edt(i) * evfact + if(islimsk(i) == 1) evef=edt(i) * evfactl +! if(islimsk(i) == 1) evef=.07 +! if(islimsk(i) == 1) evef = 0. + qcond(i) = evef * (q1(i,k) - qeso(i,k)) + & / (1. + el2orc * qeso(i,k) / t1(i,k)**2) + dp = 1000. * del(i,k) + if(rn(i).gt.0..and.qcond(i).lt.0.) then + qevap(i) = -qcond(i) * (1.-exp(-.32*sqrt(dt2*rn(i)))) + qevap(i) = min(qevap(i), rn(i)*1000.*g/dp) + delq2(i) = delqev(i) + .001 * qevap(i) * dp / g + endif + if(rn(i).gt.0..and.qcond(i).lt.0..and. + & delq2(i).gt.rntot(i)) then + qevap(i) = 1000.* g * (rntot(i) - delqev(i)) / dp + flg(i) = .false. + endif + if(rn(i).gt.0..and.qevap(i).gt.0.) then + q1(i,k) = q1(i,k) + qevap(i) + t1(i,k) = t1(i,k) - elocp * qevap(i) + rn(i) = rn(i) - .001 * qevap(i) * dp / g + deltv(i) = - elocp*qevap(i)/dt2 + delq(i) = + qevap(i)/dt2 + delqev(i) = delqev(i) + .001*dp*qevap(i)/g + endif + dellaq(i,k) = dellaq(i,k) + delq(i) / xmb(i) + delqbar(i) = delqbar(i) + delq(i)*dp/g + deltbar(i) = deltbar(i) + deltv(i)*dp/g + endif + endif + enddo + enddo +! +! do i = 1, im +! if(me.eq.31.and.cnvflg(i)) then +! if(cnvflg(i)) then +! print *, ' deep delhbar, delqbar, deltbar = ', +! & delhbar(i),hvap*delqbar(i),cp*deltbar(i) +! print *, ' deep delubar, delvbar = ',delubar(i),delvbar(i) +! print *, ' precip =', hvap*rn(i)*1000./dt2 +! print*,'pdif= ',pfld(i,kbcon(i))-pfld(i,ktcon(i)) +! endif +! enddo +! +! precipitation rate converted to actual precip +! in unit of m instead of kg +! + do i = 1, im + if(cnvflg(i)) then +! +! in the event of upper level rain evaporation and lower level downdraft +! moistening, rn can become negative, in this case, we back out of the +! heating and the moistening +! + + if(rn(i).lt.0..and..not.flg(i)) rn(i) = 0. + if(rn(i).le.0.) then + rn(i) = 0. + else + ktop(i) = ktcon(i) + kbot(i) = kbcon(i) + kcnv(i) = 1 + cldwrk(i) = aa1(i) + endif + endif + enddo +! +! convective cloud water +! +!> - Calculate convective cloud water. + do k = 1, km + do i = 1, im + if (cnvflg(i) .and. rn(i).gt.0.) then + if (k.ge.kbcon(i).and.k.lt.ktcon(i)) then + cnvw(i,k) = cnvwt(i,k) * xmb(i) * dt2 + endif + endif + enddo + enddo +! +! convective cloud cover +! +!> - Calculate convective cloud cover. + do k = 1, km + do i = 1, im + if (cnvflg(i) .and. rn(i).gt.0.) then + if (k.ge.kbcon(i).and.k.lt.ktcon(i)) then + cnvc(i,k) = 0.04 * log(1. + 675. * eta(i,k) * xmb(i)) + cnvc(i,k) = min(cnvc(i,k), 0.6) + cnvc(i,k) = max(cnvc(i,k), 0.0) + endif + endif + enddo + enddo + +! +! cloud water +! +!> - Separate detrained cloud water into liquid and ice species as a function of temperature only. + if (ncloud.gt.0) then +! + do k = 1, km + do i = 1, im + if (cnvflg(i) .and. rn(i).gt.0.) then + if (k.gt.kb(i).and.k.le.ktcon(i)) then + tem = dellal(i,k) * xmb(i) * dt2 + tem1 = max(0.0, min(1.0, (tcr-t1(i,k))*tcrf)) + if (qlc(i,k) .gt. -999.0) then + qli(i,k) = qli(i,k) + tem * tem1 ! ice + qlc(i,k) = qlc(i,k) + tem *(1.0-tem1) ! water + else + qli(i,k) = qli(i,k) + tem + endif + endif + endif + enddo + enddo +! + endif +! +!> - If convective precipitation is zero or negative, reset the updated state variables back to their original values (negating convective changes). + do k = 1, km + do i = 1, im + if(cnvflg(i).and.rn(i).le.0.) then + if (k .le. kmax(i)) then + t1(i,k) = to(i,k) + q1(i,k) = qo(i,k) + u1(i,k) = uo(i,k) + v1(i,k) = vo(i,k) + endif + endif + enddo + enddo +! +! hchuang code change +! +!> - Calculate the updraft convective mass flux. + do k = 1, km + do i = 1, im + if(cnvflg(i).and.rn(i).gt.0.) then + if(k.ge.kb(i) .and. k.lt.ktop(i)) then + ud_mf(i,k) = eta(i,k) * xmb(i) * dt2 + endif + endif + enddo + enddo +!> - Calculate the detrainment mass flux at cloud top. + do i = 1, im + if(cnvflg(i).and.rn(i).gt.0.) then + k = ktop(i)-1 + dt_mf(i,k) = ud_mf(i,k) + endif + enddo +!> - Calculate the downdraft convective mass flux. + do k = 1, km + do i = 1, im + if(cnvflg(i).and.rn(i).gt.0.) then + if(k.ge.1 .and. k.le.jmin(i)) then + dd_mf(i,k) = edto(i) * etad(i,k) * xmb(i) * dt2 + endif + endif + enddo + enddo + + if(mp_phys == mp_phys_mg) then + do k=1,km + do i=1,im + qlcn(i,k) = qlc(i,k) + qicn(i,k) = qli(i,k) + cf_upi(i,k) = cnvc(i,k) + w_upi(i,k) = ud_mf(i,k)*t1(i,k)*rgas / + & (dt2*max(cf_upi(i,k),1.e-12)*prslp(i,k)) + cnv_mfd(i,k) = ud_mf(i,k)/dt2 + clcn(i,k) = cnvc(i,k) + cnv_fice(i,k) = qicn(i,k) + & / max(1.e-10,qlcn(i,k)+qicn(i,k)) + enddo + enddo + endif + +!! + return +!> @} +!! @} + end subroutine sascnvn_run + + end module sascnvn +! \section original Original Documentation +! Penetrative convection is simulated following Pan and Wu (1994), which is based on Arakawa and Schubert(1974) as simplified by Grell (1993) and with a saturated downdraft. Convection occurs when the cloud work function (CWF) exceeds a certain threshold. Mass flux of the cloud is determined using a quasi-equilibrium assumption based on this threshold CWF. The CWF is a function of temperature and moisture in each air column of the model gridpoint. The temperature and moisture profiles are adjusted towards the equilibrium CWF within a specified time scale using the deduced mass flux. A major simplification of the original Arakawa-Shubert scheme is to consider only the deepest cloud and not the spectrum of clouds. The cloud model incorporates a downdraft mechanism as well as the evaporation of precipitation. Entrainment of the updraft and detrainment of the downdraft in the sub-cloud layers are included. Downdraft strength is based on the vertical wind shear through the cloud. The critical CWF is a function of the cloud base vertical motion. As the large-scale rising motion becomes strong, the CWF [similar to convective available potential energy (CAPE)] is allowed to approach zero (therefore approaching neutral stability). +! +! Mass fluxes induced in the updraft and the downdraft are allowed to transport momentum. The momentum exchange is calculated through the mass flux formulation in a manner similar to that for heat and moisture. The effect of the convection-induced pressure gradient force on cumulus momentum transport is parameterized in terms of mass flux and vertical wind shear (Han and Pan, 2006). As a result, the cumulus momentum exchange is reduced by about 55 % compared to the full exchange. +! +! The entrainment rate in cloud layers is dependent upon environmental humidity (Han and Pan, 2010). A drier environment increases the entrainment, suppressing the convection. The entrainment rate in sub-cloud layers is given as inversely proportional to height. The detrainment rate is assumed to be a constant in all layers and equal to the entrainment rate value at cloud base, which is O(10-4). The liquid water in the updraft layer is assumed to be detrained from the layers above the level of the minimum moist static energy into the grid-scale cloud water with conversion parameter of 0.002 m-1, which is same as the rain conversion parameter. +! +! Following Han and Pan (2010), the trigger condition is that a parcel lifted from the convection starting level without entrainment must reach its level of free convection within 120-180 hPa of ascent, proportional to the large-scale vertical velocity. This is intended to produce more convection in large-scale convergent regions but less convection in large-scale subsidence regions. Another important trigger mechanism is to include the effect of environmental humidity in the sub-cloud layer, taking into account convection inhibition due to existence of dry layers below cloud base. On the other hand, the cloud parcel might overshoot beyond the level of neutral buoyancy due to its inertia, eventually stopping its overshoot at cloud top. The CWF is used to model the overshoot. The overshoot of the cloud top is stopped at the height where a parcel lifted from the neutral buoyancy level with energy equal to 10% of the CWF would first have zero energy. +! +! Deep convection parameterization (SAS) modifications include: +! - Detraining cloud water from every updraft layer +! - Starting convection from the level of maximum moist static energy within PBL +! - Random cloud top is eliminated and only deepest cloud is considered +! - Cloud water is detrained from every cloud layer +! - Finite entrainment and detrainment rates for heat, moisture, and momentum are specified +! - Similar to shallow convection scheme, +! - entrainment rate is given to be inversely proportional to height in sub-cloud layers +! - detrainment rate is set to be a constant as entrainment rate at the cloud base. +! -Above cloud base, an organized entrainment is added, which is a function of environmental relative humidity diff --git a/physics/sascnvn.meta b/physics/sascnvn.meta new file mode 100644 index 000000000..f330dd94d --- /dev/null +++ b/physics/sascnvn.meta @@ -0,0 +1,583 @@ +[ccpp-arg-table] + name = sascnvn_init + type = scheme +[imfdeepcnv] + standard_name = flag_for_mass_flux_deep_convection_scheme + long_name = flag for mass-flux deep convection scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F +[imfdeepcnv_sas] + standard_name = flag_for_sas_deep_convection_scheme + long_name = flag for SAS deep convection scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F + +######################################################################## +[ccpp-arg-table] + name = sascnvn_finalize + type = scheme + +######################################################################## +[ccpp-arg-table] + name = sascnvn_run + type = scheme +[grav] + standard_name = gravitational_acceleration + long_name = gravitational acceleration + units = m s-2 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[cp] + standard_name = specific_heat_of_dry_air_at_constant_pressure + long_name = specific heat of dry air at constant pressure + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[hvap] + standard_name = latent_heat_of_vaporization_of_water_at_0C + long_name = latent heat of evaporation/sublimation + units = J kg-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[rv] + standard_name = gas_constant_water_vapor + long_name = ideal gas constant for water vapor + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[fv] + standard_name = ratio_of_vapor_to_dry_air_gas_constants_minus_one + long_name = (rv/rd) - 1 (rv = ideal gas constant for water vapor) + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[t0c] + standard_name = temperature_at_zero_celsius + long_name = temperature at 0 degrees Celsius + units = K + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[rgas] + standard_name = gas_constant_dry_air + long_name = ideal gas constant for dry air + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[cvap] + standard_name = specific_heat_of_water_vapor_at_constant_pressure + long_name = specific heat of water vapor at constant pressure + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[cliq] + standard_name = specific_heat_of_liquid_water_at_constant_pressure + long_name = specific heat of liquid water at constant pressure + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[eps] + standard_name = ratio_of_dry_air_to_water_vapor_gas_constants + long_name = rd/rv + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[epsm1] + standard_name = ratio_of_dry_air_to_water_vapor_gas_constants_minus_one + long_name = (rd/rv) - 1 + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[im] + standard_name = horizontal_loop_extent + long_name = horizontal loop extent + units = count + dimensions = () + type = integer + intent = in + optional = F +[ix] + standard_name = horizontal_dimension + long_name = horizontal_dimension + units = count + dimensions = () + type = integer + intent = in + optional = F +[km] + standard_name = vertical_dimension + long_name = number of vertical levels + units = count + dimensions = () + type = integer + intent = in + optional = F +[jcap] + standard_name = number_of_spectral_wave_trancation_for_sas + long_name = number of spectral wave trancation used only by sascnv and sascnvn + units = count + dimensions = () + type = integer + intent = in + optional = F +[delt] + standard_name = time_step_for_physics + long_name = physics timestep + units = s + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[delp] + standard_name = air_pressure_difference_between_midlayers + long_name = air pressure difference between midlayers + units = Pa + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[prslp] + standard_name = air_pressure + long_name = mean layer pressure + units = Pa + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[psp] + standard_name = surface_air_pressure + long_name = surface pressure + units = Pa + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[phil] + standard_name = geopotential + long_name = geopotential at model layer centers + units = m2 s-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[qlc] + standard_name = cloud_condensed_water_mixing_ratio_convective_transport_tracer + long_name = ratio of mass of cloud water to mass of dry air plus vapor (without condensates) in the convectively transported tracer array + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[qli] + standard_name = ice_water_mixing_ratio_convective_transport_tracer + long_name = ratio of mass of ice water to mass of dry air plus vapor (without condensates) in the convectively transported tracer array + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[q1] + standard_name = water_vapor_specific_humidity_updated_by_physics + long_name = water vapor specific humidity updated by physics + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[t1] + standard_name = air_temperature_updated_by_physics + long_name = temperature updated by physics + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[u1] + standard_name = x_wind_updated_by_physics + long_name = zonal wind updated by physics + units = m s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[v1] + standard_name = y_wind_updated_by_physics + long_name = meridional wind updated by physics + units = m s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[cldwrk] + standard_name = cloud_work_function + long_name = cloud work function + units = m2 s-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[rn] + standard_name = lwe_thickness_of_deep_convective_precipitation_amount + long_name = deep convective rainfall amount on physics timestep + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[kbot] + standard_name = vertical_index_at_cloud_base + long_name = index for cloud base + units = index + dimensions = (horizontal_dimension) + type = integer + intent = inout + optional = F +[ktop] + standard_name = vertical_index_at_cloud_top + long_name = index for cloud top + units = index + dimensions = (horizontal_dimension) + type = integer + intent = inout + optional = F +[kcnv] + standard_name = flag_deep_convection + long_name = deep convection: 0=no, 1=yes + units = flag + dimensions = (horizontal_dimension) + type = integer + intent = inout + optional = F +[islimsk] + standard_name = sea_land_ice_mask + long_name = landmask: sea/land/ice=0/1/2 + units = flag + dimensions = (horizontal_dimension) + type = integer + intent = in + optional = F +[dot] + standard_name = omega + long_name = layer mean vertical velocity + units = Pa s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[ncloud] + standard_name = number_of_hydrometeors + long_name = number of hydrometeors + units = count + dimensions = () + type = integer + intent = in + optional = F +[ud_mf] + standard_name = instantaneous_atmosphere_updraft_convective_mass_flux + long_name = (updraft mass flux) * delt + units = kg m-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[dd_mf] + standard_name = instantaneous_atmosphere_downdraft_convective_mass_flux + long_name = (downdraft mass flux) * delt + units = kg m-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[dt_mf] + standard_name = instantaneous_atmosphere_detrainment_convective_mass_flux + long_name = (detrainment mass flux) * delt + units = kg m-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[cnvw] + standard_name = convective_cloud_water_mixing_ratio + long_name = moist convective cloud water mixing ratio + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[cnvc] + standard_name = convective_cloud_cover + long_name = convective cloud cover + units = frac + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[qlcn] + standard_name = mass_fraction_of_convective_cloud_liquid_water + long_name = mass fraction of convective cloud liquid water + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[qicn] + standard_name = mass_fraction_of_convective_cloud_ice + long_name = mass fraction of convective cloud ice water + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[w_upi] + standard_name = vertical_velocity_for_updraft + long_name = vertical velocity for updraft + units = m s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[cf_upi] + standard_name = convective_cloud_fraction_for_microphysics + long_name = convective cloud fraction for microphysics + units = frac + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[cnv_mfd] + standard_name = detrained_mass_flux + long_name = detrained mass flux + units = kg m-2 s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[cnv_dqldt] + standard_name = tendency_of_cloud_water_due_to_convective_microphysics + long_name = tendency of cloud water due to convective microphysics + units = kg m-2 s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[clcn] + standard_name = convective_cloud_volume_fraction + long_name = convective cloud volume fraction + units = frac + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[cnv_fice] + standard_name = ice_fraction_in_convective_tower + long_name = ice fraction in convective tower + units = frac + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[cnv_ndrop] + standard_name = number_concentration_of_cloud_liquid_water_particles_for_detrainment + long_name = droplet number concentration in convective detrainment + units = m-3 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[cnv_nice] + standard_name = number_concentration_of_ice_crystals_for_detrainment + long_name = crystal number concentration in convective detrainment + units = m-3 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[mp_phys] + standard_name = flag_for_microphysics_scheme + long_name = choice of microphysics scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F +[mp_phys_mg] + standard_name = flag_for_morrison_gettelman_microphysics_scheme + long_name = choice of Morrison-Gettelman microphysics scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F +[clam] + standard_name = entrainment_rate_coefficient_deep_convection + long_name = entrainment rate coefficient for deep convection + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[c0] + standard_name = rain_conversion_parameter_deep_convection + long_name = convective rain conversion parameter for deep convection + units = m-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[c1] + standard_name = detrainment_conversion_parameter_deep_convection + long_name = convective detrainment conversion parameter for deep convection + units = m-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[betal] + standard_name = downdraft_fraction_reaching_surface_over_land_deep_convection + long_name = downdraft fraction reaching surface over land for deep convection + units = frac + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[betas] + standard_name = downdraft_fraction_reaching_surface_over_ocean_deep_convection + long_name = downdraft fraction reaching surface over ocean for deep convection + units = frac + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[evfact] + standard_name = rain_evaporation_coefficient_deep_convection + long_name = convective rain evaporation coefficient for deep convection + units = frac + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[evfactl] + standard_name = rain_evaporation_coefficient_over_land_deep_convection + long_name = convective rain evaporation coefficient over land for deep convection + units = frac + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[pgcon] + standard_name = momentum_transport_reduction_factor_pgf_deep_convection + long_name = reduction factor in momentum transport due to deep convection induced pressure gradient force + units = frac + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F diff --git a/physics/satmedmfvdif.F b/physics/satmedmfvdif.F index 2e2d472ac..5900349e9 100644 --- a/physics/satmedmfvdif.F +++ b/physics/satmedmfvdif.F @@ -4,94 +4,53 @@ !! eddy-diffusion mass-flux (TKE-EDMF) parameterization (by Jongil Han). module satmedmfvdif + contains - subroutine satmedmfvdif_init () +!> \section arg_table_satmedmfvdif_init Argument Table +!! \htmlinclude satmedmfvdif_init.html +!! + subroutine satmedmfvdif_init (isatmedmf,isatmedmf_vdif, + & errmsg,errflg) + + integer, intent(in) :: isatmedmf,isatmedmf_vdif + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + +! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + if (.not. isatmedmf==isatmedmf_vdif) then + write(errmsg,fmt='(*(a))') 'Logic error: satmedmfvdif is ', + & 'called, but isatmedmf/=isatmedmf_vdif.' + errflg = 1 + return + end if + end subroutine satmedmfvdif_init subroutine satmedmfvdif_finalize () end subroutine satmedmfvdif_finalize -!> \defgroup satmedmf GFS satmedmfvdif Main +!> \defgroup satmedmf GFS Scale-aware TKE-based Moist Eddy-Diffusivity Mass-flux (TKE-EDMF) Scheme Module !! @{ !! \brief This subroutine contains all of the logic for the !! scale-aware TKE-based moist eddy-diffusion mass-flux (TKE-EDMF) scheme. !! !> \section arg_table_satmedmfvdif_run Argument Table -!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | -!! |----------------|-----------------------------------------------------------------------------|-------------------------------------------------------|---------------|------|-----------|-----------|--------|----------| -!! | ix | horizontal_dimension | horizontal dimension | count | 0 | integer | | in | F | -!! | im | horizontal_loop_extent | horizontal loop extent | count | 0 | integer | | in | F | -!! | km | vertical_dimension | vertical layer dimension | count | 0 | integer | | in | F | -!! | ntrac | number_of_vertical_diffusion_tracers | number of tracers to diffuse vertically | count | 0 | integer | | in | F | -!! | ntcw | index_for_liquid_cloud_condensate | tracer index for cloud condensate (or liquid water) | index | 0 | integer | | in | F | -!! | ntiw | index_for_ice_cloud_condensate_vertical_diffusion_tracer | tracer index for ice water in the vertically diffused tracer array | index | 0 | integer | | in | F | -!! | ntke | index_for_turbulent_kinetic_energy_vertical_diffusion_tracer | index for turbulent kinetic energy in the vertically diffused tracer array | index | 0 | integer | | in | F | -!! | grav | gravitational_acceleration | gravitational acceleration | m s-2 | 0 | real | kind_phys | in | F | -!! | rd | gas_constant_dry_air | ideal gas constant for dry air | J kg-1 K-1 | 0 | real | kind_phys | in | F | -!! | cp | specific_heat_of_dry_air_at_constant_pressure | specific heat of dry air at constant pressure | J kg-1 K-1 | 0 | real | kind_phys | in | F | -!! | rv | gas_constant_water_vapor | ideal gas constant for water vapor | J kg-1 K-1 | 0 | real | kind_phys | in | F | -!! | hvap | latent_heat_of_vaporization_of_water_at_0C | latent heat of evaporation/sublimation | J kg-1 | 0 | real | kind_phys | in | F | -!! | hfus | latent_heat_of_fusion_of_water_at_0C | latent heat of fusion | J kg-1 | 0 | real | kind_phys | in | F | -!! | fv | ratio_of_vapor_to_dry_air_gas_constants_minus_one | (rv/rd) - 1 (rv = ideal gas constant for water vapor) | none | 0 | real | kind_phys | in | F | -!! | eps | ratio_of_dry_air_to_water_vapor_gas_constants | rd/rv | none | 0 | real | kind_phys | in | F | -!! | epsm1 | ratio_of_dry_air_to_water_vapor_gas_constants_minus_one | (rd/rv) - 1 | none | 0 | real | kind_phys | in | F | -!! | dv | tendency_of_y_wind_due_to_model_physics | updated tendency of the y wind | m s-2 | 2 | real | kind_phys | inout | F | -!! | du | tendency_of_x_wind_due_to_model_physics | updated tendency of the x wind | m s-2 | 2 | real | kind_phys | inout | F | -!! | tdt | tendency_of_air_temperature_due_to_model_physics | updated tendency of the temperature | K s-1 | 2 | real | kind_phys | inout | F | -!! | rtg | tendency_of_vertically_diffused_tracer_concentration | updated tendency of the tracers due to vertical diffusion in PBL scheme | kg kg-1 s-1 | 3 | real | kind_phys | inout | F | -!! | u1 | x_wind | x component of layer wind | m s-1 | 2 | real | kind_phys | in | F | -!! | v1 | y_wind | y component of layer wind | m s-1 | 2 | real | kind_phys | in | F | -!! | t1 | air_temperature | layer mean air temperature | K | 2 | real | kind_phys | in | F | -!! | q1 | vertically_diffused_tracer_concentration | tracer concentration diffused by PBL scheme | kg kg-1 | 3 | real | kind_phys | in | F | -!! | swh | tendency_of_air_temperature_due_to_shortwave_heating_on_radiation_time_step | total sky shortwave heating rate | K s-1 | 2 | real | kind_phys | in | F | -!! | hlw | tendency_of_air_temperature_due_to_longwave_heating_on_radiation_time_step | total sky longwave heating rate | K s-1 | 2 | real | kind_phys | in | F | -!! | xmu | zenith_angle_temporal_adjustment_factor_for_shortwave_fluxes | zenith angle temporal adjustment factor for shortwave | none | 1 | real | kind_phys | in | F | -!! | garea | cell_area | area of the grid cell | m2 | 1 | real | kind_phys | in | F | -!! | psk | dimensionless_exner_function_at_lowest_model_interface | dimensionless Exner function at the surface interface | none | 1 | real | kind_phys | in | F | -!! | rbsoil | bulk_richardson_number_at_lowest_model_level | bulk Richardson number at the surface | none | 1 | real | kind_phys | in | F | -!! | zorl | surface_roughness_length | surface roughness length in cm | cm | 1 | real | kind_phys | in | F | -!! | u10m | x_wind_at_10m | x component of wind at 10 m | m s-1 | 1 | real | kind_phys | in | F | -!! | v10m | y_wind_at_10m | y component of wind at 10 m | m s-1 | 1 | real | kind_phys | in | F | -!! | fm | Monin-Obukhov_similarity_function_for_momentum | Monin-Obukhov similarity function for momentum | none | 1 | real | kind_phys | in | F | -!! | fh | Monin-Obukhov_similarity_function_for_heat | Monin-Obukhov similarity function for heat | none | 1 | real | kind_phys | in | F | -!! | tsea | surface_skin_temperature | surface skin temperature | K | 1 | real | kind_phys | in | F | -!! | heat | kinematic_surface_upward_sensible_heat_flux | kinematic surface upward sensible heat flux | K m s-1 | 1 | real | kind_phys | in | F | -!! | evap | kinematic_surface_upward_latent_heat_flux | kinematic surface upward latent heat flux | kg kg-1 m s-1 | 1 | real | kind_phys | in | F | -!! | stress | surface_wind_stress | surface wind stress | m2 s-2 | 1 | real | kind_phys | in | F | -!! | spd1 | wind_speed_at_lowest_model_layer | wind speed at lowest model level | m s-1 | 1 | real | kind_phys | in | F | -!! | kpbl | vertical_index_at_top_of_atmosphere_boundary_layer | PBL top model level index | index | 1 | integer | | out | F | -!! | prsi | air_pressure_at_interface | air pressure at model layer interfaces | Pa | 2 | real | kind_phys | in | F | -!! | del | air_pressure_difference_between_midlayers | pres(k) - pres(k+1) | Pa | 2 | real | kind_phys | in | F | -!! | prsl | air_pressure | mean layer pressure | Pa | 2 | real | kind_phys | in | F | -!! | prslk | dimensionless_exner_function_at_model_layers | Exner function at layers | none | 2 | real | kind_phys | in | F | -!! | phii | geopotential_at_interface | geopotential at model layer interfaces | m2 s-2 | 2 | real | kind_phys | in | F | -!! | phil | geopotential | geopotential at model layer centers | m2 s-2 | 2 | real | kind_phys | in | F | -!! | delt | time_step_for_physics | time step for physics | s | 0 | real | kind_phys | in | F | -!! | dspheat | flag_TKE_dissipation_heating | flag for using TKE dissipation heating | flag | 0 | logical | | in | F | -!! | dusfc | instantaneous_surface_x_momentum_flux | x momentum flux | Pa | 1 | real | kind_phys | out | F | -!! | dvsfc | instantaneous_surface_y_momentum_flux | y momentum flux | Pa | 1 | real | kind_phys | out | F | -!! | dtsfc | instantaneous_surface_upward_sensible_heat_flux | surface upward sensible heat flux | W m-2 | 1 | real | kind_phys | out | F | -!! | dqsfc | instantaneous_surface_upward_latent_heat_flux | surface upward latent heat flux | W m-2 | 1 | real | kind_phys | out | F | -!! | hpbl | atmosphere_boundary_layer_thickness | PBL thickness | m | 1 | real | kind_phys | out | F | -!! | kinver | index_of_highest_temperature_inversion | index of highest temperature inversion | index | 1 | integer | | in | F | -!! | xkzm_m | atmosphere_momentum_diffusivity_background | background value of momentum diffusivity | m2 s-1 | 0 | real | kind_phys | in | F | -!! | xkzm_h | atmosphere_heat_diffusivity_background | background value of heat diffusivity | m2 s-1 | 0 | real | kind_phys | in | F | -!! | xkzm_s | diffusivity_background_sigma_level | sigma level threshold for background diffusivity | none | 0 | real | kind_phys | in | F | -!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | -!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | +!! \htmlinclude satmedmfvdif_run.html !! !!\section gen_satmedmfvdif GFS satmedmfvdif General Algorithm !! satmedmfvdif_run() computes subgrid vertical turbulence mixing -!! using scale-aware TKE-based moist eddy-diffusion mass-flux (EDMF) parameterization -!! (Han and Bretherton (2019)). -!! -# For the convective boundary layer, the scheme adopts -!! EDMF parameterization (Siebesma et al., 2007) to take -!! into account nonlocal transport by large eddies (mfpblt.f). -!! -# A new mass-flux parameterization for stratocumulus-top-induced turbulence -!! mixing has been introduced (previously, it was eddy diffusion form) -!! [mfscu.f]. -!! -# For local turbulence mixing, a TKE closure model is used. +!! using the scale-aware TKE-based moist eddy-diffusion mass-flux (EDMF) parameterization of +!! Han and Bretherton (2019) \cite Han_2019 . +!! -# The local turbulent mixing is represented by an eddy-diffusivity scheme which +!! is a function of a prognostic TKE. +!! -# For the convective boundary layer, nonlocal transport by large eddies +!! (mfpblt.f), is represented using a mass flux approach (Siebesma et al.(2007) \cite Siebesma_2007 ). +!! -# A mass-flux approach is also used to represent the stratocumulus-top-induced turbulence +!! (mfscu.f). !! \section detail_satmedmfvidf GFS satmedmfvdif Detailed Algorithm !> @{ subroutine satmedmfvdif_run(ix,im,km,ntrac,ntcw,ntiw,ntke, & @@ -287,7 +246,7 @@ subroutine satmedmfvdif_run(ix,im,km,ntrac,ntcw,ntiw,ntke, & kmpbl = km / 2 kmscu = km / 2 !> - Compute physical height of the layer centers and interfaces from -!! the geopotential height (zi and zl) +!! the geopotential height (\p zi and \p zl) do k=1,km do i=1,im zi(i,k) = phii(i,k) * gravi @@ -308,12 +267,12 @@ subroutine satmedmfvdif_run(ix,im,km,ntrac,ntcw,ntiw,ntke, & zm(i,k) = zi(i,k+1) enddo enddo -!> - Compute horizontal grid size (gdx) +!> - Compute horizontal grid size (\p gdx) do i=1,im gdx(i) = sqrt(garea(i)) enddo !> - Initialize tke value at vertical layer centers and interfaces -!! from tracer (tke and tkeh) +!! from tracer (\p tke and \p tkeh) do k=1,km do i=1,im tke(i,k) = max(q1(i,k,ntke), tkmin) @@ -449,7 +408,6 @@ subroutine satmedmfvdif_run(ix,im,km,ntrac,ntcw,ntiw,ntke, & ! !> - Compute an empirical cloud fraction based on !! Xu and Randall (1996) \cite xu_and_randall_1996 -!! (see \ref cld_fra). do k = 1, km do i = 1, im plyr(i,k) = 0.01 * prsl(i,k) ! pa to mb (hpa) @@ -520,7 +478,7 @@ subroutine satmedmfvdif_run(ix,im,km,ntrac,ntcw,ntiw,ntke, & if(.not.sfcflg(i) .or. sflux(i) <= 0.) pblflg(i)=.false. enddo ! -!> - Compute critical bulk richardson number (\f$Rb_{cr}\f$) (crb) +!> - Compute critical bulk Richardson number (\f$Rb_{cr}\f$) (crb) !! - For the unstable PBL, crb is a constant (0.25) !! - For the stable boundary layer (SBL), \f$Rb_{cr}\f$ varies !! with the surface Rossby number, \f$R_{0}\f$, as given by @@ -573,7 +531,7 @@ subroutine satmedmfvdif_run(ix,im,km,ntrac,ntcw,ntiw,ntke, & enddo enddo ! -! Find pbl height based on bulk richardson number (mrf pbl scheme) +! Find pbl height based on bulk Richardson number (mrf pbl scheme) ! and also for diagnostic purpose ! ! @@ -584,7 +542,7 @@ subroutine satmedmfvdif_run(ix,im,km,ntrac,ntcw,ntiw,ntke, & !> - Given the thermal's properties and the critical Richardson number, !! a loop is executed to find the first level above the surface (kpblx) where !! the modified Richardson number is greater than the critical Richardson -!! number, using equation 10a from Toen and Mahrt (1996) \cite troen_and_mahrt_1986 +!! number, using equation 10a from Troen and Mahrt (1996) \cite troen_and_mahrt_1986 !! (also equation 8 from Hong and Pan (1996) \cite hong_and_pan_1996): do k = 1, kmpbl do i = 1, im @@ -1548,68 +1506,5 @@ subroutine satmedmfvdif_run(ix,im,km,ntrac,ntcw,ntiw,ntke, & return end subroutine satmedmfvdif_run !> @} -! -!----------------------------------------------------------------------- -!----------------------------------------------------------------------- -!>\ingroup satmedmf -!! This subroutine solves tridiagonal problem for TKE. - subroutine tridit(l,n,nt,cl,cm,cu,rt,au,at) -!----------------------------------------------------------------------- -!! - use machine , only : kind_phys - implicit none - integer is,k,kk,n,nt,l,i - real(kind=kind_phys) fk(l) -!! - real(kind=kind_phys) cl(l,2:n), cm(l,n), cu(l,n-1), & - & rt(l,n*nt), & - & au(l,n-1), at(l,n*nt), & - & fkk(l,2:n-1) -!----------------------------------------------------------------------- - do i=1,l - fk(i) = 1./cm(i,1) - au(i,1) = fk(i)*cu(i,1) - enddo - do k = 1, nt - is = (k-1) * n - do i = 1, l - at(i,1+is) = fk(i) * rt(i,1+is) - enddo - enddo - do k=2,n-1 - do i=1,l - fkk(i,k) = 1./(cm(i,k)-cl(i,k)*au(i,k-1)) - au(i,k) = fkk(i,k)*cu(i,k) - enddo - enddo - do kk = 1, nt - is = (kk-1) * n - do k=2,n-1 - do i=1,l - at(i,k+is) = fkk(i,k)*(rt(i,k+is)-cl(i,k)*at(i,k+is-1)) - enddo - enddo - enddo - do i=1,l - fk(i) = 1./(cm(i,n)-cl(i,n)*au(i,n-1)) - enddo - do k = 1, nt - is = (k-1) * n - do i = 1, l - at(i,n+is) = fk(i)*(rt(i,n+is)-cl(i,n)*at(i,n+is-1)) - enddo - enddo - do kk = 1, nt - is = (kk-1) * n - do k=n-1,1,-1 - do i=1,l - at(i,k+is) = at(i,k+is) - au(i,k)*at(i,k+is+1) - enddo - enddo - enddo -!----------------------------------------------------------------------- - return - end subroutine tridit -!> @} end module satmedmfvdif diff --git a/physics/satmedmfvdif.meta b/physics/satmedmfvdif.meta new file mode 100644 index 000000000..dcf307e55 --- /dev/null +++ b/physics/satmedmfvdif.meta @@ -0,0 +1,570 @@ +[ccpp-arg-table] + name = satmedmfvdif_init + type = scheme +[isatmedmf] + standard_name = choice_of_scale_aware_TKE_moist_EDMF_PBL + long_name = choice of scale-aware TKE moist EDMF PBL scheme + units = none + dimensions = () + type = integer + intent = in + optional = F +[isatmedmf_vdif] + standard_name = choice_of_original_scale_aware_TKE_moist_EDMF_PBL + long_name = choice of original scale-aware TKE moist EDMF PBL scheme + units = none + dimensions = () + type = integer + intent = in + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F + +##################################################################### +[ccpp-arg-table] + name = satmedmfvdif_run + type = scheme +[ix] + standard_name = horizontal_dimension + long_name = horizontal dimension + units = count + dimensions = () + type = integer + intent = in + optional = F +[im] + standard_name = horizontal_loop_extent + long_name = horizontal loop extent + units = count + dimensions = () + type = integer + intent = in + optional = F +[km] + standard_name = vertical_dimension + long_name = vertical layer dimension + units = count + dimensions = () + type = integer + intent = in + optional = F +[ntrac] + standard_name = number_of_vertical_diffusion_tracers + long_name = number of tracers to diffuse vertically + units = count + dimensions = () + type = integer + intent = in + optional = F +[ntcw] + standard_name = index_for_liquid_cloud_condensate + long_name = tracer index for cloud condensate (or liquid water) + units = index + dimensions = () + type = integer + intent = in + optional = F +[ntiw] + standard_name = index_for_ice_cloud_condensate_vertical_diffusion_tracer + long_name = tracer index for ice water in the vertically diffused tracer array + units = index + dimensions = () + type = integer + intent = in + optional = F +[ntke] + standard_name = index_for_turbulent_kinetic_energy_vertical_diffusion_tracer + long_name = index for turbulent kinetic energy in the vertically diffused tracer array + units = index + dimensions = () + type = integer + intent = in + optional = F +[grav] + standard_name = gravitational_acceleration + long_name = gravitational acceleration + units = m s-2 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[rd] + standard_name = gas_constant_dry_air + long_name = ideal gas constant for dry air + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[cp] + standard_name = specific_heat_of_dry_air_at_constant_pressure + long_name = specific heat of dry air at constant pressure + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[rv] + standard_name = gas_constant_water_vapor + long_name = ideal gas constant for water vapor + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[hvap] + standard_name = latent_heat_of_vaporization_of_water_at_0C + long_name = latent heat of evaporation/sublimation + units = J kg-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[hfus] + standard_name = latent_heat_of_fusion_of_water_at_0C + long_name = latent heat of fusion + units = J kg-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[fv] + standard_name = ratio_of_vapor_to_dry_air_gas_constants_minus_one + long_name = (rv/rd) - 1 (rv = ideal gas constant for water vapor) + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[eps] + standard_name = ratio_of_dry_air_to_water_vapor_gas_constants + long_name = rd/rv + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[epsm1] + standard_name = ratio_of_dry_air_to_water_vapor_gas_constants_minus_one + long_name = (rd/rv) - 1 + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[dv] + standard_name = tendency_of_y_wind_due_to_model_physics + long_name = updated tendency of the y wind + units = m s-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[du] + standard_name = tendency_of_x_wind_due_to_model_physics + long_name = updated tendency of the x wind + units = m s-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[tdt] + standard_name = tendency_of_air_temperature_due_to_model_physics + long_name = updated tendency of the temperature + units = K s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[rtg] + standard_name = tendency_of_vertically_diffused_tracer_concentration + long_name = updated tendency of the tracers due to vertical diffusion in PBL scheme + units = kg kg-1 s-1 + dimensions = (horizontal_dimension,vertical_dimension,number_of_vertical_diffusion_tracers) + type = real + kind = kind_phys + intent = inout + optional = F +[u1] + standard_name = x_wind + long_name = x component of layer wind + units = m s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[v1] + standard_name = y_wind + long_name = y component of layer wind + units = m s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[t1] + standard_name = air_temperature + long_name = layer mean air temperature + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[q1] + standard_name = vertically_diffused_tracer_concentration + long_name = tracer concentration diffused by PBL scheme + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension,number_of_vertical_diffusion_tracers) + type = real + kind = kind_phys + intent = in + optional = F +[swh] + standard_name = tendency_of_air_temperature_due_to_shortwave_heating_on_radiation_timestep + long_name = total sky shortwave heating rate + units = K s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[hlw] + standard_name = tendency_of_air_temperature_due_to_longwave_heating_on_radiation_timestep + long_name = total sky longwave heating rate + units = K s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[xmu] + standard_name = zenith_angle_temporal_adjustment_factor_for_shortwave_fluxes + long_name = zenith angle temporal adjustment factor for shortwave + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[garea] + standard_name = cell_area + long_name = area of the grid cell + units = m2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[psk] + standard_name = dimensionless_exner_function_at_lowest_model_interface + long_name = dimensionless Exner function at the surface interface + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[rbsoil] + standard_name = bulk_richardson_number_at_lowest_model_level + long_name = bulk Richardson number at the surface + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[zorl] + standard_name = surface_roughness_length + long_name = surface roughness length in cm + units = cm + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[u10m] + standard_name = x_wind_at_10m + long_name = x component of wind at 10 m + units = m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[v10m] + standard_name = y_wind_at_10m + long_name = y component of wind at 10 m + units = m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[fm] + standard_name = Monin_Obukhov_similarity_function_for_momentum + long_name = Monin-Obukhov similarity function for momentum + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[fh] + standard_name = Monin_Obukhov_similarity_function_for_heat + long_name = Monin-Obukhov similarity function for heat + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[tsea] + standard_name = surface_skin_temperature + long_name = surface skin temperature + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[heat] + standard_name = kinematic_surface_upward_sensible_heat_flux + long_name = kinematic surface upward sensible heat flux + units = K m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[evap] + standard_name = kinematic_surface_upward_latent_heat_flux + long_name = kinematic surface upward latent heat flux + units = kg kg-1 m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[stress] + standard_name = surface_wind_stress + long_name = surface wind stress + units = m2 s-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[spd1] + standard_name = wind_speed_at_lowest_model_layer + long_name = wind speed at lowest model level + units = m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[kpbl] + standard_name = vertical_index_at_top_of_atmosphere_boundary_layer + long_name = PBL top model level index + units = index + dimensions = (horizontal_dimension) + type = integer + intent = out + optional = F +[prsi] + standard_name = air_pressure_at_interface + long_name = air pressure at model layer interfaces + units = Pa + dimensions = (horizontal_dimension,vertical_dimension_plus_one) + type = real + kind = kind_phys + intent = in + optional = F +[del] + standard_name = air_pressure_difference_between_midlayers + long_name = pres(k) - pres(k+1) + units = Pa + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[prsl] + standard_name = air_pressure + long_name = mean layer pressure + units = Pa + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[prslk] + standard_name = dimensionless_exner_function_at_model_layers + long_name = Exner function at layers + units = none + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[phii] + standard_name = geopotential_at_interface + long_name = geopotential at model layer interfaces + units = m2 s-2 + dimensions = (horizontal_dimension,vertical_dimension_plus_one) + type = real + kind = kind_phys + intent = in + optional = F +[phil] + standard_name = geopotential + long_name = geopotential at model layer centers + units = m2 s-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[delt] + standard_name = time_step_for_physics + long_name = time step for physics + units = s + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[dspheat] + standard_name = flag_TKE_dissipation_heating + long_name = flag for using TKE dissipation heating + units = flag + dimensions = () + type = logical + intent = in + optional = F +[dusfc] + standard_name = instantaneous_surface_x_momentum_flux + long_name = x momentum flux + units = Pa + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[dvsfc] + standard_name = instantaneous_surface_y_momentum_flux + long_name = y momentum flux + units = Pa + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[dtsfc] + standard_name = instantaneous_surface_upward_sensible_heat_flux + long_name = surface upward sensible heat flux + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[dqsfc] + standard_name = instantaneous_surface_upward_latent_heat_flux + long_name = surface upward latent heat flux + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[hpbl] + standard_name = atmosphere_boundary_layer_thickness + long_name = PBL thickness + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[kinver] + standard_name = index_of_highest_temperature_inversion + long_name = index of highest temperature inversion + units = index + dimensions = (horizontal_dimension) + type = integer + intent = in + optional = F +[xkzm_m] + standard_name = atmosphere_momentum_diffusivity_background + long_name = background value of momentum diffusivity + units = m2 s-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[xkzm_h] + standard_name = atmosphere_heat_diffusivity_background + long_name = background value of heat diffusivity + units = m2 s-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[xkzm_s] + standard_name = diffusivity_background_sigma_level + long_name = sigma level threshold for background diffusivity + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F diff --git a/physics/satmedmfvdifq.F b/physics/satmedmfvdifq.F new file mode 100644 index 000000000..30e195cde --- /dev/null +++ b/physics/satmedmfvdifq.F @@ -0,0 +1,1513 @@ +!> \file satmedmfvdifq.F +!! This file contains the CCPP-compliant SATMEDMF scheme (updated version) which +!! computes subgrid vertical turbulence mixing using scale-aware TKE-based moist +!! eddy-diffusion mass-flux (TKE-EDMF) parameterization (by Jongil Han). + + module satmedmfvdifq + + contains + +!> \defgroup satmedmfvdifq GFS Scale-aware TKE-based Moist Eddy-Diffusivity Mass-flux (TKE-EDMF, updated version) Scheme Module +!! @{ +!! \brief This subroutine contains all of the logic for the +!! scale-aware TKE-based moist eddy-diffusion mass-flux (TKE-EDMF, updated version) scheme. +!! For local turbulence mixing, a TKE closure model is used. +!! Updated version of satmedmfvdif.f (May 2019) to have better low level +!! inversion, to reduce the cold bias in lower troposphere, +!! and to reduce the negative wind speed bias in upper troposphere + +!> \section arg_table_satmedmfvdifq_init Argument Table +!! \htmlinclude satmedmfvdifq_init.html +!! + subroutine satmedmfvdifq_init (isatmedmf,isatmedmf_vdifq, + & errmsg,errflg) + + integer, intent(in) :: isatmedmf,isatmedmf_vdifq + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + +! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + if (.not. isatmedmf==isatmedmf_vdifq) then + write(errmsg,fmt='(*(a))') 'Logic error: satmedmfvdif is ', + & 'called, but isatmedmf/=isatmedmf_vdifq.' + errflg = 1 + return + end if + + end subroutine satmedmfvdifq_init + + subroutine satmedmfvdifq_finalize () + end subroutine satmedmfvdifq_finalize + +!> \section arg_table_satmedmfvdifq_run Argument Table +!! \htmlinclude satmedmfvdifq_run.html +!! +!!\section gen_satmedmfvdifq GFS satmedmfvdifq General Algorithm +!! satmedmfvdifq_run() computes subgrid vertical turbulence mixing +!! using the scale-aware TKE-based moist eddy-diffusion mass-flux (EDMF) parameterization of +!! Han and Bretherton (2019) \cite Han_2019 . +!! -# The local turbulent mixing is represented by an eddy-diffusivity scheme which +!! is a function of a prognostic TKE. +!! -# For the convective boundary layer, nonlocal transport by large eddies +!! (mfpbltq.f), is represented using a mass flux approach (Siebesma et al.(2007) \cite Siebesma_2007 ). +!! -# A mass-flux approach is also used to represent the stratocumulus-top-induced turbulence +!! (mfscuq.f). +!! \section detail_satmedmfvidfq GFS satmedmfvdifq Detailed Algorithm +!! @{ + subroutine satmedmfvdifq_run(ix,im,km,ntrac,ntcw,ntiw,ntke, & + & grav,rd,cp,rv,hvap,hfus,fv,eps,epsm1, & + & dv,du,tdt,rtg,u1,v1,t1,q1,swh,hlw,xmu,garea, & + & psk,rbsoil,zorl,u10m,v10m,fm,fh, & + & tsea,heat,evap,stress,spd1,kpbl, & + & prsi,del,prsl,prslk,phii,phil,delt, & + & dspheat,dusfc,dvsfc,dtsfc,dqsfc,hpbl, & + & kinver,xkzm_m,xkzm_h,xkzm_s,dspfac,bl_upfr,bl_dnfr, & + & errmsg,errflg) +! + use machine , only : kind_phys + use funcphys , only : fpvs +! + implicit none +! +!---------------------------------------------------------------------- + integer, intent(in) :: ix, im, km, ntrac, ntcw, ntiw, ntke + integer, intent(in) :: kinver(im) + integer, intent(out) :: kpbl(im) +! + real(kind=kind_phys), intent(in) :: grav,rd,cp,rv,hvap,hfus,fv, & + & eps,epsm1 + real(kind=kind_phys), intent(in) :: delt, xkzm_m, xkzm_h, xkzm_s + real(kind=kind_phys), intent(in) :: dspfac, bl_upfr, bl_dnfr + real(kind=kind_phys), intent(inout) :: dv(im,km), du(im,km), & + & tdt(im,km), rtg(im,km,ntrac) + real(kind=kind_phys), intent(in) :: & + & u1(ix,km), v1(ix,km), & + & t1(ix,km), q1(ix,km,ntrac), & + & swh(ix,km), hlw(ix,km), & + & xmu(im), garea(im), & + & psk(ix), rbsoil(im), & + & zorl(im), tsea(im), & + & u10m(im), v10m(im), & + & fm(im), fh(im), & + & evap(im), heat(im), & + & stress(im), spd1(im), & + & prsi(ix,km+1), del(ix,km), & + & prsl(ix,km), prslk(ix,km), & + & phii(ix,km+1), phil(ix,km) + real(kind=kind_phys), intent(out) :: & + & dusfc(im), dvsfc(im), & + & dtsfc(im), dqsfc(im), & + & hpbl(im) +! + logical, intent(in) :: dspheat + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + +! flag for tke dissipative heating +! +!---------------------------------------------------------------------- +!*** +!*** local variables +!*** + integer i,is,k,kk,n,ndt,km1,kmpbl,kmscu,ntrac1 + integer lcld(im),kcld(im),krad(im),mrad(im) + integer kx1(im), kpblx(im) +! + real(kind=kind_phys) tke(im,km), tkeh(im,km-1) +! + real(kind=kind_phys) theta(im,km),thvx(im,km), thlvx(im,km), + & qlx(im,km), thetae(im,km),thlx(im,km), + & slx(im,km), svx(im,km), qtx(im,km), + & tvx(im,km), pix(im,km), radx(im,km-1), + & dku(im,km-1),dkt(im,km-1), dkq(im,km-1), + & cku(im,km-1),ckt(im,km-1) +! + real(kind=kind_phys) plyr(im,km), rhly(im,km), cfly(im,km), + & qstl(im,km) +! + real(kind=kind_phys) dtdz1(im), gdx(im), + & phih(im), phim(im), prn(im,km-1), + & rbdn(im), rbup(im), thermal(im), + & ustar(im), wstar(im), hpblx(im), + & ust3(im), wst3(im), + & z0(im), crb(im), + & hgamt(im), hgamq(im), + & wscale(im),vpert(im), + & zol(im), sflux(im), + & tx1(im), tx2(im) +! + real(kind=kind_phys) radmin(im) +! + real(kind=kind_phys) zi(im,km+1), zl(im,km), zm(im,km), + & xkzo(im,km-1),xkzmo(im,km-1), + & xkzm_hx(im), xkzm_mx(im), tkmnz(im,km-1), + & rdzt(im,km-1),rlmnz(im,km), + & al(im,km-1), ad(im,km), au(im,km-1), + & f1(im,km), f2(im,km*(ntrac-1)) +! + real(kind=kind_phys) elm(im,km), ele(im,km), + & ckz(im,km), chz(im,km), frik(im), + & diss(im,km-1),prod(im,km-1), + & bf(im,km-1), shr2(im,km-1), + & xlamue(im,km-1), xlamde(im,km-1), + & gotvx(im,km), rlam(im,km-1) +! +! variables for updrafts (thermals) +! + real(kind=kind_phys) tcko(im,km), qcko(im,km,ntrac), + & ucko(im,km), vcko(im,km), + & buou(im,km), xmf(im,km) +! +! variables for stratocumulus-top induced downdrafts +! + real(kind=kind_phys) tcdo(im,km), qcdo(im,km,ntrac), + & ucdo(im,km), vcdo(im,km), + & buod(im,km), xmfd(im,km) +! + logical pblflg(im), sfcflg(im), flg(im) + logical scuflg(im), pcnvflg(im) + logical mlenflg +! +! pcnvflg: true for unstable pbl +! + real(kind=kind_phys) aphi16, aphi5, + & wfac, cfac, + & gamcrt, gamcrq, sfcfrac, + & conq, cont, conw, + & dsdz2, dsdzt, dkmax, + & dsig, dt2, dtodsd, + & dtodsu, g, factor, dz, + & gocp, gravi, zol1, zolcru, + & buop, shrp, dtn, + & prnum, prmax, prmin, prtke, + & prscu, pr0, ri, + & dw2, dw2min, zk, + & elmfac, elefac, dspmax, + & alp, clwt, cql, + & f0, robn, crbmin, crbmax, + & es, qs, value, onemrh, + & cfh, gamma, elocp, el2orc, + & epsi, beta, chx, cqx, + & rdt, rdz, qmin, qlmin, + & rimin, rbcr, rbint, tdzmin, + & rlmn, rlmn1, rlmn2, + & rlmx, elmx, + & ttend, utend, vtend, qtend, + & zfac, zfmin, vk, spdk2, + & tkmin, tkminx, xkzinv, xkgdx, + & zlup, zldn, bsum, + & tem, tem1, tem2, + & ptem, ptem0, ptem1, ptem2 +! + real(kind=kind_phys) ck0, ck1, ch0, ch1, ce0, rchck +! + real(kind=kind_phys) qlcr, zstblmax +! + real(kind=kind_phys) h1 +!! + parameter(wfac=7.0,cfac=3.0) + parameter(gamcrt=3.,gamcrq=0.,sfcfrac=0.1) + parameter(vk=0.4,rimin=-100.) + parameter(rbcr=0.25,zolcru=-0.02,tdzmin=1.e-3) + parameter(rlmn=30.,rlmn1=5.,rlmn2=10.) + parameter(rlmx=300.,elmx=300.) + parameter(prmin=0.25,prmax=4.0) + parameter(pr0=1.0,prtke=1.0,prscu=0.67) + parameter(f0=1.e-4,crbmin=0.15,crbmax=0.35) + parameter(tkmin=1.e-9,tkminx=0.2,dspmax=10.0) + parameter(qmin=1.e-8,qlmin=1.e-12,zfmin=1.e-8) + parameter(aphi5=5.,aphi16=16.) + parameter(elmfac=1.0,elefac=1.0,cql=100.) + parameter(dw2min=1.e-4,dkmax=1000.,xkgdx=5000.) + parameter(qlcr=3.5e-5,zstblmax=2500.,xkzinv=0.1) + parameter(h1=0.33333333) + parameter(ck0=0.4,ck1=0.15,ch0=0.4,ch1=0.15) + parameter(ce0=0.4) + parameter(rchck=1.5,ndt=20) + + gravi=1.0/grav + g=grav + gocp=g/cp + cont=cp/g + conq=hvap/g + conw=1.0/g ! for del in pa +! parameter(cont=1000.*cp/g,conq=1000.*hvap/g,conw=1000./g) !kpa + elocp=hvap/cp + el2orc=hvap*hvap/(rv*cp) +! +!************************************************************************ +! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + +!> ## Compute preliminary variables from input arguments + dt2 = delt + rdt = 1. / dt2 +! +! the code is written assuming ntke=ntrac +! if ntrac > ntke, the code needs to be modified +! + ntrac1 = ntrac - 1 + km1 = km - 1 + kmpbl = km / 2 + kmscu = km / 2 +!> - Compute physical height of the layer centers and interfaces from +!! the geopotential height (\p zi and \p zl) + do k=1,km + do i=1,im + zi(i,k) = phii(i,k) * gravi + zl(i,k) = phil(i,k) * gravi + xmf(i,k) = 0. + xmfd(i,k) = 0. + buou(i,k) = 0. + buod(i,k) = 0. + ckz(i,k) = ck1 + chz(i,k) = ch1 + rlmnz(i,k) = rlmn + enddo + enddo + do i=1,im + frik(i) = 1.0 + enddo + do i=1,im + zi(i,km+1) = phii(i,km+1) * gravi + enddo + do k=1,km + do i=1,im + zm(i,k) = zi(i,k+1) + enddo + enddo +!> - Compute horizontal grid size (\p gdx) + do i=1,im + gdx(i) = sqrt(garea(i)) + enddo +!> - Initialize tke value at vertical layer centers and interfaces +!! from tracer (\p tke and \p tkeh) + do k=1,km + do i=1,im + tke(i,k) = max(q1(i,k,ntke), tkmin) + enddo + enddo + do k=1,km1 + do i=1,im + tkeh(i,k) = 0.5 * (tke(i,k) + tke(i,k+1)) + enddo + enddo +!> - Compute reciprocal of \f$ \Delta z \f$ (rdzt) + do k = 1,km1 + do i=1,im + rdzt(i,k) = 1.0 / (zl(i,k+1) - zl(i,k)) + prn(i,k) = pr0 + enddo + enddo +! +!> - Compute reciprocal of pressure (tx1, tx2) + +!> - Compute minimum turbulent mixing length (rlmnz) + +!> - Compute background vertical diffusivities for scalars and momentum (xkzo and xkzmo) + +!> - set background diffusivities as a function of +!! horizontal grid size with xkzm_h & xkzm_m for gdx >= 25km +!! and 0.01 for gdx=5m, i.e., +!! \n xkzm_hx = 0.01 + (xkzm_h - 0.01)/(xkgdx-5.) * (gdx-5.) +!! \n xkzm_mx = 0.01 + (xkzm_h - 0.01)/(xkgdx-5.) * (gdx-5.) + + do i=1,im + kx1(i) = 1 + tx1(i) = 1.0 / prsi(i,1) + tx2(i) = tx1(i) + if(gdx(i) >= xkgdx) then + xkzm_hx(i) = xkzm_h + xkzm_mx(i) = xkzm_m + else + tem = 1. / (xkgdx - 5.) + tem1 = (xkzm_h - 0.01) * tem + tem2 = (xkzm_m - 0.01) * tem + ptem = gdx(i) - 5. + xkzm_hx(i) = 0.01 + tem1 * ptem + xkzm_mx(i) = 0.01 + tem2 * ptem + endif + enddo + do k = 1,km1 + do i=1,im + xkzo(i,k) = 0.0 + xkzmo(i,k) = 0.0 + if (k < kinver(i)) then +! minimum turbulent mixing length + ptem = prsl(i,k) * tx1(i) + tem1 = 1.0 - ptem + tem2 = tem1 * tem1 * 2.5 + tem2 = min(1.0, exp(-tem2)) + rlmnz(i,k)= rlmn * tem2 + rlmnz(i,k)= max(rlmnz(i,k), rlmn1) +! vertical background diffusivity + ptem = prsi(i,k+1) * tx1(i) + tem1 = 1.0 - ptem + tem2 = tem1 * tem1 * 10.0 + tem2 = min(1.0, exp(-tem2)) + xkzo(i,k) = xkzm_hx(i) * tem2 +! vertical background diffusivity for momentum + if (ptem >= xkzm_s) then + xkzmo(i,k) = xkzm_mx(i) + kx1(i) = k + 1 + else + if (k == kx1(i) .and. k > 1) tx2(i) = 1.0 / prsi(i,k) + tem1 = 1.0 - prsi(i,k+1) * tx2(i) + tem1 = tem1 * tem1 * 5.0 + xkzmo(i,k) = xkzm_mx(i) * min(1.0, exp(-tem1)) + endif + endif + enddo + enddo + +!> - Some output variables and logical flags are initialized + do i = 1,im + z0(i) = 0.01 * zorl(i) + dusfc(i) = 0. + dvsfc(i) = 0. + dtsfc(i) = 0. + dqsfc(i) = 0. + kpbl(i) = 1 + hpbl(i) = 0. + kpblx(i) = 1 + hpblx(i) = 0. + pblflg(i)= .true. + sfcflg(i)= .true. + if(rbsoil(i) > 0.) sfcflg(i) = .false. + pcnvflg(i)= .false. + scuflg(i)= .true. + if(scuflg(i)) then + radmin(i)= 0. + mrad(i) = km1 + krad(i) = 1 + lcld(i) = km1 + kcld(i) = km1 + endif + enddo + +!> - Compute \f$\theta\f$(theta), and \f$q_l\f$(qlx), \f$\theta_e\f$(thetae), +!! \f$\theta_v\f$(thvx),\f$\theta_{l,v}\f$ (thlvx) including ice water + do k=1,km + do i=1,im + pix(i,k) = psk(i) / prslk(i,k) + theta(i,k) = t1(i,k) * pix(i,k) + if(ntiw > 0) then + tem = max(q1(i,k,ntcw),qlmin) + tem1 = max(q1(i,k,ntiw),qlmin) + qlx(i,k) = tem + tem1 + ptem = hvap*tem + (hvap+hfus)*tem1 + slx(i,k) = cp * t1(i,k) + phil(i,k) - ptem + else + qlx(i,k) = max(q1(i,k,ntcw),qlmin) + slx(i,k) = cp * t1(i,k) + phil(i,k) - hvap*qlx(i,k) + endif + tem2 = 1.+fv*max(q1(i,k,1),qmin)-qlx(i,k) + thvx(i,k) = theta(i,k) * tem2 + tvx(i,k) = t1(i,k) * tem2 + qtx(i,k) = max(q1(i,k,1),qmin)+qlx(i,k) + thlx(i,k) = theta(i,k) - pix(i,k)*elocp*qlx(i,k) + thlvx(i,k) = thlx(i,k) * (1. + fv * qtx(i,k)) + svx(i,k) = cp * tvx(i,k) + ptem1 = elocp * pix(i,k) * max(q1(i,k,1),qmin) + thetae(i,k)= theta(i,k) + ptem1 + gotvx(i,k) = g / tvx(i,k) + enddo + enddo + +!> - Compute an empirical cloud fraction based on +!! Xu and Randall (1996) \cite xu_and_randall_1996 + do k = 1, km + do i = 1, im + plyr(i,k) = 0.01 * prsl(i,k) ! pa to mb (hpa) +! --- ... compute relative humidity + es = 0.01 * fpvs(t1(i,k)) ! fpvs in pa + qs = max(qmin, eps * es / (plyr(i,k) + epsm1*es)) + rhly(i,k) = max(0.0, min(1.0, max(qmin, q1(i,k,1))/qs)) + qstl(i,k) = qs + enddo + enddo +! + do k = 1, km + do i = 1, im + cfly(i,k) = 0. + clwt = 1.0e-6 * (plyr(i,k)*0.001) + if (qlx(i,k) > clwt) then + onemrh= max(1.e-10, 1.0-rhly(i,k)) + tem1 = min(max((onemrh*qstl(i,k))**0.49,0.0001),1.0) + tem1 = cql / tem1 + value = max(min( tem1*qlx(i,k), 50.0), 0.0) + tem2 = sqrt(sqrt(rhly(i,k))) + cfly(i,k) = min(max(tem2*(1.0-exp(-value)), 0.0), 1.0) + endif + enddo + enddo +! +!> - Compute buoyancy modified by clouds +! + do k = 1, km1 + do i = 1, im + tem = 0.5 * (svx(i,k) + svx(i,k+1)) + tem1 = 0.5 * (t1(i,k) + t1(i,k+1)) + tem2 = 0.5 * (qstl(i,k) + qstl(i,k+1)) + cfh = min(cfly(i,k+1),0.5*(cfly(i,k)+cfly(i,k+1))) + alp = g / tem + gamma = el2orc * tem2 / (tem1**2) + epsi = tem1 / elocp + beta = (1. + gamma*epsi*(1.+fv)) / (1. + gamma) + chx = cfh * alp * beta + (1. - cfh) * alp + cqx = cfh * alp * hvap * (beta - epsi) + cqx = cqx + (1. - cfh) * fv * g + ptem1 = (slx(i,k+1)-slx(i,k))*rdzt(i,k) + ptem2 = (qtx(i,k+1)-qtx(i,k))*rdzt(i,k) + bf(i,k) = chx * ptem1 + cqx * ptem2 + enddo + enddo +! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! +!> - Initialize diffusion coefficients to 0 and calculate the total +!! radiative heating rate (dku, dkt, radx) + do k=1,km1 + do i=1,im + dku(i,k) = 0. + dkt(i,k) = 0. + dkq(i,k) = 0. + cku(i,k) = 0. + ckt(i,k) = 0. + tem = zi(i,k+1)-zi(i,k) + radx(i,k) = tem*(swh(i,k)*xmu(i)+hlw(i,k)) + enddo + enddo +!> - Compute stable/unstable PBL flag (pblflg) based on the total +!! surface energy flux (\e false if the total surface energy flux +!! is into the surface) + do i = 1,im + sflux(i) = heat(i) + evap(i)*fv*theta(i,1) + if(.not.sfcflg(i) .or. sflux(i) <= 0.) pblflg(i)=.false. + enddo +! +!> ## Calculate the PBL height +!! The calculation of the boundary layer height follows Troen and Mahrt (1986) \cite troen_and_mahrt_1986 section 3. The approach is to find the level in the column where a modified bulk Richardson number exceeds a critical value. +!! - Compute critical bulk Richardson number (\f$Rb_{cr}\f$) (crb) +!! - For the unstable PBL, crb is a constant (0.25) +!! - For the stable boundary layer (SBL), \f$Rb_{cr}\f$ varies +!! with the surface Rossby number, \f$R_{0}\f$, as given by +!! Vickers and Mahrt (2004) \cite Vickers_2004 +!! \f[ +!! Rb_{cr}=0.16(10^{-7}R_{0})^{-0.18} +!! \f] +!! \f[ +!! R_{0}=\frac{U_{10}}{f_{0}z_{0}} +!! \f] +!! where \f$U_{10}\f$ is the wind speed at 10m above the ground surface, +!! \f$f_0\f$ the Coriolis parameter, and \f$z_{0}\f$ the surface roughness +!! length. To avoid too much variation, we restrict \f$Rb_{cr}\f$ to vary +!! within the range of 0.15~0.35 + do i = 1,im + if(pblflg(i)) then +! thermal(i) = thvx(i,1) + thermal(i) = thlvx(i,1) + crb(i) = rbcr + else + thermal(i) = tsea(i)*(1.+fv*max(q1(i,1,1),qmin)) + tem = sqrt(u10m(i)**2+v10m(i)**2) + tem = max(tem, 1.) + robn = tem / (f0 * z0(i)) + tem1 = 1.e-7 * robn + crb(i) = 0.16 * (tem1 ** (-0.18)) + crb(i) = max(min(crb(i), crbmax), crbmin) + endif + enddo +!> - Compute \f$\frac{\Delta t}{\Delta z}\f$ , \f$u_*\f$ + do i=1,im + dtdz1(i) = dt2 / (zi(i,2)-zi(i,1)) + enddo +! + do i=1,im + ustar(i) = sqrt(stress(i)) + enddo +! +!> - Compute buoyancy \f$\frac{\partial \theta_v}{\partial z}\f$ (bf) +!! and the wind shear squared (shr2) +! + do k = 1, km1 + do i = 1, im + rdz = rdzt(i,k) +! bf(i,k) = gotvx(i,k)*(thvx(i,k+1)-thvx(i,k))*rdz + dw2 = (u1(i,k)-u1(i,k+1))**2 + & + (v1(i,k)-v1(i,k+1))**2 + shr2(i,k) = max(dw2,dw2min)*rdz*rdz + enddo + enddo +! +! Find pbl height based on bulk richardson number (mrf pbl scheme) +! and also for diagnostic purpose +! + do i=1,im + flg(i) = .false. + rbup(i) = rbsoil(i) + enddo +!> - Given the thermal's properties and the critical Richardson number, +!! a loop is executed to find the first level above the surface (kpblx) where +!! the modified Richardson number is greater than the critical Richardson +!! number, using equation 10a from Troen and Mahrt (1996) \cite troen_and_mahrt_1986 +!! (also equation 8 from Hong and Pan (1996) \cite hong_and_pan_1996): + do k = 1, kmpbl + do i = 1, im + if(.not.flg(i)) then + rbdn(i) = rbup(i) + spdk2 = max((u1(i,k)**2+v1(i,k)**2),1.) +! rbup(i) = (thvx(i,k)-thermal(i))* +! & (g*zl(i,k)/thvx(i,1))/spdk2 + rbup(i) = (thlvx(i,k)-thermal(i))* + & (g*zl(i,k)/thlvx(i,1))/spdk2 + kpblx(i) = k + flg(i) = rbup(i) > crb(i) + endif + enddo + enddo +!> - Once the level is found, some linear interpolation is performed to find +!! the exact height of the boundary layer top (where \f$R_{i} > Rb_{cr}\f$) +!! and the PBL height (hpbl and kpbl) and the PBL top index are saved. + do i = 1,im + if(kpblx(i) > 1) then + k = kpblx(i) + if(rbdn(i) >= crb(i)) then + rbint = 0. + elseif(rbup(i) <= crb(i)) then + rbint = 1. + else + rbint = (crb(i)-rbdn(i))/(rbup(i)-rbdn(i)) + endif + hpblx(i) = zl(i,k-1) + rbint*(zl(i,k)-zl(i,k-1)) + if(hpblx(i) < zi(i,kpblx(i))) kpblx(i)=kpblx(i)-1 + else + hpblx(i) = zl(i,1) + kpblx(i) = 1 + endif + hpbl(i) = hpblx(i) + kpbl(i) = kpblx(i) + if(kpbl(i) <= 1) pblflg(i)=.false. + enddo +! +!> ## Compute Monin-Obukhov similarity parameters +!! - Calculate the Monin-Obukhov nondimensional stability paramter, commonly +!! referred to as \f$\zeta\f$ using the following equation from Businger et al.(1971) \cite businger_et_al_1971 +!! (eqn 28): +!! \f[ +!! \zeta = Ri_{sfc}\frac{F_m^2}{F_h} = \frac{z}{L} +!! \f] +!! where \f$F_m\f$ and \f$F_h\f$ are surface Monin-Obukhov stability functions calculated in sfc_diff.f and +!! \f$L\f$ is the Obukhov length. + do i=1,im + zol(i) = max(rbsoil(i)*fm(i)*fm(i)/fh(i),rimin) + if(sfcflg(i)) then + zol(i) = min(zol(i),-zfmin) + else + zol(i) = max(zol(i),zfmin) + endif +!> - Calculate the nondimensional gradients of momentum and temperature (\f$\phi_m\f$ (phim) and \f$\phi_h\f$(phih)) are calculated using +!! eqns 5 and 6 from Hong and Pan (1996) \cite hong_and_pan_1996 depending on the surface layer stability: +!! - For the unstable and neutral conditions: +!! \f[ +!! \phi_m=(1-16\frac{0.1h}{L})^{-1/4} +!! \phi_h=(1-16\frac{0.1h}{L})^{-1/2} +!! \f] +!! - For the stable regime +!! \f[ +!! \phi_m=\phi_t=(1+5\frac{0.1h}{L}) +!! \f] + zol1 = zol(i)*sfcfrac*hpbl(i)/zl(i,1) + if(sfcflg(i)) then + tem = 1.0 / (1. - aphi16*zol1) + phih(i) = sqrt(tem) + phim(i) = sqrt(phih(i)) + else + phim(i) = 1. + aphi5*zol1 + phih(i) = phim(i) + endif + enddo +! +!> - The \f$z/L\f$ (zol) is used as the stability criterion for the PBL.Currently, +!! strong unstable (convective) PBL for \f$z/L < -0.02\f$ and weakly and moderately +!! unstable PBL for \f$0>z/L>-0.02\f$ +!> - Compute the velocity scale \f$w_s\f$ (wscale) (eqn 22 of Han et al. 2019). It +!! is represented by the value scaled at the top of the surface layer: +!! \f[ +!! w_s=(u_*^3+7\alpha\kappa w_*^3)^{1/3} +!! \f] +!! where \f$u_*\f$ (ustar) is the surface friction velocity,\f$\alpha\f$ is the ratio +!! of the surface layer height to the PBL height (specified as sfcfrac =0.1), +!! \f$\kappa =0.4\f$ is the von Karman constant, and \f$w_*\f$ is the convective velocity +!! scale defined as eqn23 of Han et al.(2019): +!! \f[ +!! w_{*}=[(g/T)\overline{(w'\theta_v^{'})}_0h]^{1/3} +!! \f] + do i=1,im + if(pblflg(i)) then + if(zol(i) < zolcru) then + pcnvflg(i) = .true. + endif + wst3(i) = gotvx(i,1)*sflux(i)*hpbl(i) + wstar(i)= wst3(i)**h1 + ust3(i) = ustar(i)**3. + wscale(i)=(ust3(i)+wfac*vk*wst3(i)*sfcfrac)**h1 + ptem = ustar(i)/aphi5 + wscale(i) = max(wscale(i),ptem) + endif + enddo +! +!> ## The counter-gradient terms for temperature and humidity are calculated. +!! - Equation 4 of Hong and Pan (1996) \cite hong_and_pan_1996 and are used to calculate the "scaled virtual temperature excess near the surface" (equation 9 in Hong and Pan (1996) \cite hong_and_pan_1996) for use in the mass-flux algorithm. +! + do i = 1,im + if(pcnvflg(i)) then + hgamt(i) = heat(i)/wscale(i) + hgamq(i) = evap(i)/wscale(i) + vpert(i) = hgamt(i) + hgamq(i)*fv*theta(i,1) + vpert(i) = max(vpert(i),0.) + vpert(i) = min(cfac*vpert(i),gamcrt) + endif + enddo +! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! look for stratocumulus +!> ## Determine whether stratocumulus layers exist and compute quantities +!! - Starting at the PBL top and going downward, if the level is less than 2.5 km +!! and \f$q_l\geq q_{lcr}\f$ then set kcld = k (find the cloud top index in the PBL. +!! If no cloud water above the threshold is hound, \e scuflg is set to F. + do i=1,im + flg(i) = scuflg(i) + enddo + do k = 1, km1 + do i=1,im + if(flg(i).and.zl(i,k) >= zstblmax) then + lcld(i)=k + flg(i)=.false. + endif + enddo + enddo + do i = 1, im + flg(i)=scuflg(i) + enddo + do k = kmscu,1,-1 + do i = 1, im + if(flg(i) .and. k <= lcld(i)) then + if(qlx(i,k) >= qlcr) then + kcld(i)=k + flg(i)=.false. + endif + endif + enddo + enddo + do i = 1, im + if(scuflg(i) .and. kcld(i)==km1) scuflg(i)=.false. + enddo +!> - Starting at the PBL top and going downward, if the level is less +!! than the cloud top, find the level of the minimum radiative heating +!! rate wihin the cloud. If the level of the minimum is the lowest model +!! level or the minimum radiative heating rate is positive, then set +!! scuflg to F. + do i = 1, im + flg(i)=scuflg(i) + enddo + do k = kmscu,1,-1 + do i = 1, im + if(flg(i) .and. k <= kcld(i)) then + if(qlx(i,k) >= qlcr) then + if(radx(i,k) < radmin(i)) then + radmin(i)=radx(i,k) + krad(i)=k + endif + else + flg(i)=.false. + endif + endif + enddo + enddo + do i = 1, im + if(scuflg(i) .and. krad(i) <= 1) scuflg(i)=.false. + if(scuflg(i) .and. radmin(i)>=0.) scuflg(i)=.false. + enddo +! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +!> ## Compute components for mass flux mixing by large thermals +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +!> - If the PBL is convective, the updraft properties are initialized +!! to be the same as the state variables. + do k = 1, km + do i = 1, im + if(pcnvflg(i)) then + tcko(i,k) = t1(i,k) + ucko(i,k) = u1(i,k) + vcko(i,k) = v1(i,k) + endif + if(scuflg(i)) then + tcdo(i,k) = t1(i,k) + ucdo(i,k) = u1(i,k) + vcdo(i,k) = v1(i,k) + endif + enddo + enddo + do kk = 1, ntrac1 + do k = 1, km + do i = 1, im + if(pcnvflg(i)) then + qcko(i,k,kk) = q1(i,k,kk) + endif + if(scuflg(i)) then + qcdo(i,k,kk) = q1(i,k,kk) + endif + enddo + enddo + enddo +!> - Call mfpbltq(), which is an EDMF parameterization (Siebesma et al.(2007) \cite Siebesma_2007) +!! to take into account nonlocal transport by large eddies. For details of the mfpbltq subroutine, step into its documentation ::mfpbltq + call mfpbltq(im,ix,km,kmpbl,ntcw,ntrac1,dt2, + & pcnvflg,zl,zm,q1,t1,u1,v1,plyr,pix,thlx,thvx, + & gdx,hpbl,kpbl,vpert,buou,xmf, + & tcko,qcko,ucko,vcko,xlamue,bl_upfr) +!> - Call mfscuq(), which is a new mass-flux parameterization for +!! stratocumulus-top-induced turbulence mixing. For details of the mfscuq subroutine, step into its documentation ::mfscuq + call mfscuq(im,ix,km,kmscu,ntcw,ntrac1,dt2, + & scuflg,zl,zm,q1,t1,u1,v1,plyr,pix, + & thlx,thvx,thlvx,gdx,thetae, + & krad,mrad,radmin,buod,xmfd, + & tcdo,qcdo,ucdo,vcdo,xlamde,bl_dnfr) +! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +!> ## Compute Prandtl number \f$P_r\f$ (prn) and exchange coefficient varying with height + do k = 1, kmpbl + do i = 1, im + if(k < kpbl(i)) then + tem = phih(i)/phim(i) + ptem = sfcfrac*hpbl(i) + tem1 = max(zi(i,k+1)-ptem, 0.) + tem2 = tem1 / (hpbl(i) - ptem) + if(pcnvflg(i)) then + tem = min(tem, pr0) + prn(i,k) = tem + (pr0 - tem) * tem2 + else + tem = max(tem, pr0) + prn(i,k) = tem + endif + prn(i,k) = min(prn(i,k),prmax) + prn(i,k) = max(prn(i,k),prmin) +! + ckz(i,k) = ck0 + (ck1 - ck0) * tem2 + ckz(i,k) = max(min(ckz(i,k), ck0), ck1) + chz(i,k) = ch0 + (ch1 - ch0) * tem2 + chz(i,k) = max(min(chz(i,k), ch0), ch1) +! + endif + enddo + enddo +! +! background diffusivity decreasing with increasing surface layer stability +! +! do i = 1, im +! if(.not.sfcflg(i)) then +! tem = (1. + 5. * rbsoil(i))**2. +!! tem = (1. + 5. * zol(i))**2. +! frik(i) = 0.1 + 0.9 / tem +! endif +! enddo +! +! do k = 1,km1 +! do i=1,im +! xkzo(i,k) = frik(i) * xkzo(i,k) +! xkzmo(i,k)= frik(i) * xkzmo(i,k) +! enddo +! enddo +! +!> ## The background vertical diffusivities in the inversion layers are limited +!! to be less than or equal to xkzinv +! + do k = 1,km1 + do i=1,im +! tem1 = (tvx(i,k+1)-tvx(i,k)) * rdzt(i,k) +! if(tem1 > 1.e-5) then + tem1 = tvx(i,k+1)-tvx(i,k) + if(tem1 > 0.) then + xkzo(i,k) = min(xkzo(i,k), xkzinv) + xkzmo(i,k) = min(xkzmo(i,k), xkzinv) + rlmnz(i,k) = min(rlmnz(i,k), rlmn2) + endif + enddo + enddo +! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +!> ## Compute an asymtotic mixing length +! + do k = 1, km1 + do i = 1, im + zlup = 0.0 + bsum = 0.0 + mlenflg = .true. + do n = k, km1 + if(mlenflg) then + dz = zl(i,n+1) - zl(i,n) + ptem = gotvx(i,n)*(thvx(i,n+1)-thvx(i,k))*dz +! ptem = gotvx(i,n)*(thlvx(i,n+1)-thlvx(i,k))*dz + bsum = bsum + ptem + zlup = zlup + dz + if(bsum >= tke(i,k)) then + if(ptem >= 0.) then + tem2 = max(ptem, zfmin) + else + tem2 = min(ptem, -zfmin) + endif + ptem1 = (bsum - tke(i,k)) / tem2 + zlup = zlup - ptem1 * dz + zlup = max(zlup, 0.) + mlenflg = .false. + endif + endif + enddo + zldn = 0.0 + bsum = 0.0 + mlenflg = .true. + do n = k, 1, -1 + if(mlenflg) then + if(n == 1) then + dz = zl(i,1) + tem1 = tsea(i)*(1.+fv*max(q1(i,1,1),qmin)) + else + dz = zl(i,n) - zl(i,n-1) + tem1 = thvx(i,n-1) +! tem1 = thlvx(i,n-1) + endif + ptem = gotvx(i,n)*(thvx(i,k)-tem1)*dz +! ptem = gotvx(i,n)*(thlvx(i,k)-tem1)*dz + bsum = bsum + ptem + zldn = zldn + dz + if(bsum >= tke(i,k)) then + if(ptem >= 0.) then + tem2 = max(ptem, zfmin) + else + tem2 = min(ptem, -zfmin) + endif + ptem1 = (bsum - tke(i,k)) / tem2 + zldn = zldn - ptem1 * dz + zldn = max(zldn, 0.) + mlenflg = .false. + endif + endif + enddo +! + tem = 0.5 * (zi(i,k+1)-zi(i,k)) + tem1 = min(tem, rlmnz(i,k)) +!> - Following Bougeault and Lacarrere(1989), the characteristic length +!! scale (\f$l_2\f$) (eqn 10 in Han et al.(2019) \cite Han_2019) is given by: +!!\f[ +!! l_2=min(l_{up},l_{down}) +!!\f] +!! and dissipation length scale \f$l_d\f$ is given by: +!!\f[ +!! l_d=(l_{up}l_{down})^{1/2} +!!\f] +!! where \f$l_{up}\f$ and \f$l_{down}\f$ are the distances that a parcel +!! having an initial TKE can travel upward and downward before being stopped +!! by buoyancy effects. + ptem2 = min(zlup,zldn) + rlam(i,k) = elmfac * ptem2 + rlam(i,k) = max(rlam(i,k), tem1) + rlam(i,k) = min(rlam(i,k), rlmx) +! + ptem2 = sqrt(zlup*zldn) + ele(i,k) = elefac * ptem2 + ele(i,k) = max(ele(i,k), tem1) + ele(i,k) = min(ele(i,k), elmx) +! + enddo + enddo +!> - Compute the surface layer length scale (\f$l_1\f$) following +!! Nakanishi (2001) \cite Nakanish_2001 (eqn 9 of Han et al.(2019) \cite Han_2019) + do k = 1, km1 + do i = 1, im + tem = vk * zl(i,k) + if (zol(i) < 0.) then + ptem = 1. - 100. * zol(i) + ptem1 = ptem**0.2 + zk = tem * ptem1 + elseif (zol(i) >= 1.) then + zk = tem / 3.7 + else + ptem = 1. + 2.7 * zol(i) + zk = tem / ptem + endif + elm(i,k) = zk*rlam(i,k)/(rlam(i,k)+zk) +! + dz = zi(i,k+1) - zi(i,k) + tem = max(gdx(i),dz) + elm(i,k) = min(elm(i,k), tem) + ele(i,k) = min(ele(i,k), tem) +! + enddo + enddo + do i = 1, im + elm(i,km) = elm(i,km1) + ele(i,km) = ele(i,km1) + enddo +! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +!> ## Compute eddy diffusivities +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! + do k = 1, km1 + do i = 1, im + tem = 0.5 * (elm(i,k) + elm(i,k+1)) + tem = tem * sqrt(tkeh(i,k)) + ri = max(bf(i,k)/shr2(i,k),rimin) + if(k < kpbl(i)) then + if(pcnvflg(i)) then + dku(i,k) = ckz(i,k) * tem + dkt(i,k) = dku(i,k) / prn(i,k) + else + if(ri < 0.) then ! unstable regime + dku(i,k) = ckz(i,k) * tem + dkt(i,k) = dku(i,k) / prn(i,k) + else ! stable regime + dkt(i,k) = chz(i,k) * tem + dku(i,k) = dkt(i,k) * prn(i,k) + endif + endif + else + if(ri < 0.) then ! unstable regime + dku(i,k) = ck1 * tem + dkt(i,k) = rchck * dku(i,k) + else ! stable regime + dkt(i,k) = ch1 * tem + prnum = 1.0 + 2.1 * ri + prnum = min(prnum,prmax) + dku(i,k) = dkt(i,k) * prnum + endif + endif +! + if(scuflg(i)) then + if(k >= mrad(i) .and. k < krad(i)) then + tem1 = ckz(i,k) * tem + ptem1 = tem1 / prscu + dku(i,k) = max(dku(i,k), tem1) + dkt(i,k) = max(dkt(i,k), ptem1) + endif + endif +! + dkq(i,k) = prtke * dkt(i,k) +! + dkt(i,k) = min(dkt(i,k),dkmax) + dkt(i,k) = max(dkt(i,k),xkzo(i,k)) + dkq(i,k) = min(dkq(i,k),dkmax) + dkq(i,k) = max(dkq(i,k),xkzo(i,k)) + dku(i,k) = min(dku(i,k),dkmax) + dku(i,k) = max(dku(i,k),xkzmo(i,k)) +! + enddo + enddo +!> ## Compute TKE. +!! - Compute a minimum TKE deduced from background diffusivity for momentum. +! + do k = 1, km1 + do i = 1, im + if(k == 1) then + tem = ckz(i,1) + tem1 = 0.5 * xkzmo(i,1) + else + tem = 0.5 * (ckz(i,k-1) + ckz(i,k)) + tem1 = 0.5 * (xkzmo(i,k-1) + xkzmo(i,k)) + endif + ptem = tem1 / (tem * elm(i,k)) + tkmnz(i,k) = ptem * ptem + tkmnz(i,k) = min(tkmnz(i,k), tkminx) + tkmnz(i,k) = max(tkmnz(i,k), tkmin) + enddo + enddo +! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +!> - Compute buoyancy and shear productions of TKE +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! + do k = 1, km1 + do i = 1, im + if (k == 1) then + tem = -dkt(i,1) * bf(i,1) +! if(pcnvflg(i)) then +! ptem1 = xmf(i,1) * buou(i,1) +! else + ptem1 = 0. +! endif + if(scuflg(i) .and. mrad(i) == 1) then + ptem2 = xmfd(i,1) * buod(i,1) + else + ptem2 = 0. + endif + tem = tem + ptem1 + ptem2 + buop = 0.5 * (gotvx(i,1) * sflux(i) + tem) +! + tem1 = dku(i,1) * shr2(i,1) +! + tem = (u1(i,2)-u1(i,1))*rdzt(i,1) +! if(pcnvflg(i)) then +! ptem = xmf(i,1) * tem +! ptem1 = 0.5 * ptem * (u1(i,2)-ucko(i,2)) +! else + ptem1 = 0. +! endif + if(scuflg(i) .and. mrad(i) == 1) then + ptem = ucdo(i,1)+ucdo(i,2)-u1(i,1)-u1(i,2) + ptem = 0.5 * tem * xmfd(i,1) * ptem + else + ptem = 0. + endif + ptem1 = ptem1 + ptem +! + tem = (v1(i,2)-v1(i,1))*rdzt(i,1) +! if(pcnvflg(i)) then +! ptem = xmf(i,1) * tem +! ptem2 = 0.5 * ptem * (v1(i,2)-vcko(i,2)) +! else + ptem2 = 0. +! endif + if(scuflg(i) .and. mrad(i) == 1) then + ptem = vcdo(i,1)+vcdo(i,2)-v1(i,1)-v1(i,2) + ptem = 0.5 * tem * xmfd(i,1) * ptem + else + ptem = 0. + endif + ptem2 = ptem2 + ptem +! +! tem2 = stress(i)*spd1(i)/zl(i,1) + tem2 = stress(i)*ustar(i)*phim(i)/(vk*zl(i,1)) + shrp = 0.5 * (tem1 + ptem1 + ptem2 + tem2) + else + tem1 = -dkt(i,k-1) * bf(i,k-1) + tem2 = -dkt(i,k) * bf(i,k) + tem = 0.5 * (tem1 + tem2) + if(pcnvflg(i) .and. k <= kpbl(i)) then + ptem = 0.5 * (xmf(i,k-1) + xmf(i,k)) + ptem1 = ptem * buou(i,k) + else + ptem1 = 0. + endif + if(scuflg(i)) then + if(k >= mrad(i) .and. k < krad(i)) then + ptem0 = 0.5 * (xmfd(i,k-1) + xmfd(i,k)) + ptem2 = ptem0 * buod(i,k) + else + ptem2 = 0. + endif + else + ptem2 = 0. + endif + buop = tem + ptem1 + ptem2 +! + tem1 = dku(i,k-1) * shr2(i,k-1) + tem2 = dku(i,k) * shr2(i,k) + tem = 0.5 * (tem1 + tem2) + tem1 = (u1(i,k+1)-u1(i,k))*rdzt(i,k) + tem2 = (u1(i,k)-u1(i,k-1))*rdzt(i,k-1) + if(pcnvflg(i) .and. k <= kpbl(i)) then + ptem = xmf(i,k) * tem1 + xmf(i,k-1) * tem2 + ptem1 = 0.5 * ptem * (u1(i,k)-ucko(i,k)) + else + ptem1 = 0. + endif + if(scuflg(i)) then + if(k >= mrad(i) .and. k < krad(i)) then + ptem0 = xmfd(i,k) * tem1 + xmfd(i,k-1) * tem2 + ptem2 = 0.5 * ptem0 * (ucdo(i,k)-u1(i,k)) + else + ptem2 = 0. + endif + else + ptem2 = 0. + endif + shrp = tem + ptem1 + ptem2 + tem1 = (v1(i,k+1)-v1(i,k))*rdzt(i,k) + tem2 = (v1(i,k)-v1(i,k-1))*rdzt(i,k-1) + if(pcnvflg(i) .and. k <= kpbl(i)) then + ptem = xmf(i,k) * tem1 + xmf(i,k-1) * tem2 + ptem1 = 0.5 * ptem * (v1(i,k)-vcko(i,k)) + else + ptem1 = 0. + endif + if(scuflg(i)) then + if(k >= mrad(i) .and. k < krad(i)) then + ptem0 = xmfd(i,k) * tem1 + xmfd(i,k-1) * tem2 + ptem2 = 0.5 * ptem0 * (vcdo(i,k)-v1(i,k)) + else + ptem2 = 0. + endif + else + ptem2 = 0. + endif + shrp = shrp + ptem1 + ptem2 + endif + prod(i,k) = buop + shrp + enddo + enddo +! +!---------------------------------------------------------------------- +!> - First predict tke due to tke production & dissipation(diss) +! + dtn = dt2 / float(ndt) + do n = 1, ndt + do k = 1,km1 + do i=1,im + tem = sqrt(tke(i,k)) + ptem = ce0 / ele(i,k) + diss(i,k) = ptem * tke(i,k) * tem + tem1 = prod(i,k) + tke(i,k) / dtn + diss(i,k)=max(min(diss(i,k), tem1), 0.) + tke(i,k) = tke(i,k) + dtn * (prod(i,k)-diss(i,k)) +! tke(i,k) = max(tke(i,k), tkmin) + tke(i,k) = max(tke(i,k), tkmnz(i,k)) + enddo + enddo + enddo +! +!> - Compute updraft & downdraft properties for TKE +! + do k = 1, km + do i = 1, im + if(pcnvflg(i)) then + qcko(i,k,ntke) = tke(i,k) + endif + if(scuflg(i)) then + qcdo(i,k,ntke) = tke(i,k) + endif + enddo + enddo + do k = 2, kmpbl + do i = 1, im + if (pcnvflg(i) .and. k <= kpbl(i)) then + dz = zl(i,k) - zl(i,k-1) + tem = 0.5 * xlamue(i,k-1) * dz + factor = 1. + tem + qcko(i,k,ntke)=((1.-tem)*qcko(i,k-1,ntke)+tem* + & (tke(i,k)+tke(i,k-1)))/factor + endif + enddo + enddo + do k = kmscu, 1, -1 + do i = 1, im + if (scuflg(i) .and. k < krad(i)) then + if(k >= mrad(i)) then + dz = zl(i,k+1) - zl(i,k) + tem = 0.5 * xlamde(i,k) * dz + factor = 1. + tem + qcdo(i,k,ntke)=((1.-tem)*qcdo(i,k+1,ntke)+tem* + & (tke(i,k)+tke(i,k+1)))/factor + endif + endif + enddo + enddo +! +!---------------------------------------------------------------------- +!> - Compute tridiagonal matrix elements for turbulent kinetic energy +! + do i=1,im + ad(i,1) = 1.0 + f1(i,1) = tke(i,1) + enddo +! + do k = 1,km1 + do i=1,im + dtodsd = dt2/del(i,k) + dtodsu = dt2/del(i,k+1) + dsig = prsl(i,k)-prsl(i,k+1) + rdz = rdzt(i,k) + tem1 = dsig * dkq(i,k) * rdz + dsdz2 = tem1 * rdz + au(i,k) = -dtodsd*dsdz2 + al(i,k) = -dtodsu*dsdz2 + ad(i,k) = ad(i,k)-au(i,k) + ad(i,k+1)= 1.-al(i,k) + tem2 = dsig * rdz +! + if(pcnvflg(i) .and. k < kpbl(i)) then + ptem = 0.5 * tem2 * xmf(i,k) + ptem1 = dtodsd * ptem + ptem2 = dtodsu * ptem + tem = tke(i,k) + tke(i,k+1) + ptem = qcko(i,k,ntke) + qcko(i,k+1,ntke) + f1(i,k) = f1(i,k)-(ptem-tem)*ptem1 + f1(i,k+1) = tke(i,k+1)+(ptem-tem)*ptem2 + else + f1(i,k+1) = tke(i,k+1) + endif +! + if(scuflg(i)) then + if(k >= mrad(i) .and. k < krad(i)) then + ptem = 0.5 * tem2 * xmfd(i,k) + ptem1 = dtodsd * ptem + ptem2 = dtodsu * ptem + tem = tke(i,k) + tke(i,k+1) + ptem = qcdo(i,k,ntke) + qcdo(i,k+1,ntke) + f1(i,k) = f1(i,k) + (ptem - tem) * ptem1 + f1(i,k+1) = f1(i,k+1) - (ptem - tem) * ptem2 + endif + endif +! + enddo + enddo +c +!> - Call tridit() to solve tridiagonal problem for TKE +c + call tridit(im,km,1,al,ad,au,f1,au,f1) +c +!> - Recover the tendency of tke +c + do k = 1,km + do i = 1,im +! f1(i,k) = max(f1(i,k), tkmin) + qtend = (f1(i,k)-q1(i,k,ntke))*rdt + rtg(i,k,ntke) = rtg(i,k,ntke)+qtend + enddo + enddo +c +!> ## Compute tridiagonal matrix elements for heat and moisture +c + do i=1,im + ad(i,1) = 1. + f1(i,1) = t1(i,1) + dtdz1(i) * heat(i) + f2(i,1) = q1(i,1,1) + dtdz1(i) * evap(i) + enddo + if(ntrac1 >= 2) then + do kk = 2, ntrac1 + is = (kk-1) * km + do i = 1, im + f2(i,1+is) = q1(i,1,kk) + enddo + enddo + endif +c + do k = 1,km1 + do i = 1,im + dtodsd = dt2/del(i,k) + dtodsu = dt2/del(i,k+1) + dsig = prsl(i,k)-prsl(i,k+1) + rdz = rdzt(i,k) + tem1 = dsig * dkt(i,k) * rdz + dsdzt = tem1 * gocp + dsdz2 = tem1 * rdz + au(i,k) = -dtodsd*dsdz2 + al(i,k) = -dtodsu*dsdz2 + ad(i,k) = ad(i,k)-au(i,k) + ad(i,k+1)= 1.-al(i,k) + tem2 = dsig * rdz +! + if(pcnvflg(i) .and. k < kpbl(i)) then + ptem = 0.5 * tem2 * xmf(i,k) + ptem1 = dtodsd * ptem + ptem2 = dtodsu * ptem + tem = t1(i,k) + t1(i,k+1) + ptem = tcko(i,k) + tcko(i,k+1) + f1(i,k) = f1(i,k)+dtodsd*dsdzt-(ptem-tem)*ptem1 + f1(i,k+1) = t1(i,k+1)-dtodsu*dsdzt+(ptem-tem)*ptem2 + tem = q1(i,k,1) + q1(i,k+1,1) + ptem = qcko(i,k,1) + qcko(i,k+1,1) + f2(i,k) = f2(i,k) - (ptem - tem) * ptem1 + f2(i,k+1) = q1(i,k+1,1) + (ptem - tem) * ptem2 + else + f1(i,k) = f1(i,k)+dtodsd*dsdzt + f1(i,k+1) = t1(i,k+1)-dtodsu*dsdzt + f2(i,k+1) = q1(i,k+1,1) + endif +! + if(scuflg(i)) then + if(k >= mrad(i) .and. k < krad(i)) then + ptem = 0.5 * tem2 * xmfd(i,k) + ptem1 = dtodsd * ptem + ptem2 = dtodsu * ptem + ptem = tcdo(i,k) + tcdo(i,k+1) + tem = t1(i,k) + t1(i,k+1) + f1(i,k) = f1(i,k) + (ptem - tem) * ptem1 + f1(i,k+1) = f1(i,k+1) - (ptem - tem) * ptem2 + tem = q1(i,k,1) + q1(i,k+1,1) + ptem = qcdo(i,k,1) + qcdo(i,k+1,1) + f2(i,k) = f2(i,k) + (ptem - tem) * ptem1 + f2(i,k+1) = f2(i,k+1) - (ptem - tem) * ptem2 + endif + endif + enddo + enddo +! + if(ntrac1 >= 2) then + do kk = 2, ntrac1 + is = (kk-1) * km + do k = 1, km1 + do i = 1, im + if(pcnvflg(i) .and. k < kpbl(i)) then + dtodsd = dt2/del(i,k) + dtodsu = dt2/del(i,k+1) + dsig = prsl(i,k)-prsl(i,k+1) + tem = dsig * rdzt(i,k) + ptem = 0.5 * tem * xmf(i,k) + ptem1 = dtodsd * ptem + ptem2 = dtodsu * ptem + tem1 = qcko(i,k,kk) + qcko(i,k+1,kk) + tem2 = q1(i,k,kk) + q1(i,k+1,kk) + f2(i,k+is) = f2(i,k+is) - (tem1 - tem2) * ptem1 + f2(i,k+1+is)= q1(i,k+1,kk) + (tem1 - tem2) * ptem2 + else + f2(i,k+1+is) = q1(i,k+1,kk) + endif +! + if(scuflg(i)) then + if(k >= mrad(i) .and. k < krad(i)) then + dtodsd = dt2/del(i,k) + dtodsu = dt2/del(i,k+1) + dsig = prsl(i,k)-prsl(i,k+1) + tem = dsig * rdzt(i,k) + ptem = 0.5 * tem * xmfd(i,k) + ptem1 = dtodsd * ptem + ptem2 = dtodsu * ptem + tem1 = qcdo(i,k,kk) + qcdo(i,k+1,kk) + tem2 = q1(i,k,kk) + q1(i,k+1,kk) + f2(i,k+is) = f2(i,k+is) + (tem1 - tem2) * ptem1 + f2(i,k+1+is)= f2(i,k+1+is) - (tem1 - tem2) * ptem2 + endif + endif +! + enddo + enddo + enddo + endif +c +!> - Call tridin() to solve tridiagonal problem for heat and moisture +c + call tridin(im,km,ntrac1,al,ad,au,f1,f2,au,f1,f2) +c +!> - Recover the tendencies of heat and moisture +c + do k = 1,km + do i = 1,im + ttend = (f1(i,k)-t1(i,k))*rdt + qtend = (f2(i,k)-q1(i,k,1))*rdt + tdt(i,k) = tdt(i,k)+ttend + rtg(i,k,1) = rtg(i,k,1)+qtend + dtsfc(i) = dtsfc(i)+cont*del(i,k)*ttend + dqsfc(i) = dqsfc(i)+conq*del(i,k)*qtend + enddo + enddo +! + if(ntrac1 >= 2) then + do kk = 2, ntrac1 + is = (kk-1) * km + do k = 1, km + do i = 1, im + qtend = (f2(i,k+is)-q1(i,k,kk))*rdt + rtg(i,k,kk) = rtg(i,k,kk)+qtend + enddo + enddo + enddo + endif +! +!> ## Add TKE dissipative heating to temperature tendency +! + if(dspheat) then + do k = 1,km1 + do i = 1,im +! tem = min(diss(i,k), dspmax) +! ttend = tem / cp + ttend = diss(i,k) / cp + tdt(i,k) = tdt(i,k) + dspfac * ttend + enddo + enddo + endif +c +!> ## Compute tridiagonal matrix elements for momentum +c + do i=1,im + ad(i,1) = 1.0 + dtdz1(i) * stress(i) / spd1(i) + f1(i,1) = u1(i,1) + f2(i,1) = v1(i,1) + enddo +c + do k = 1,km1 + do i=1,im + dtodsd = dt2/del(i,k) + dtodsu = dt2/del(i,k+1) + dsig = prsl(i,k)-prsl(i,k+1) + rdz = rdzt(i,k) + tem1 = dsig * dku(i,k) * rdz + dsdz2 = tem1*rdz + au(i,k) = -dtodsd*dsdz2 + al(i,k) = -dtodsu*dsdz2 + ad(i,k) = ad(i,k)-au(i,k) + ad(i,k+1)= 1.-al(i,k) + tem2 = dsig * rdz +! + if(pcnvflg(i) .and. k < kpbl(i)) then + ptem = 0.5 * tem2 * xmf(i,k) + ptem1 = dtodsd * ptem + ptem2 = dtodsu * ptem + tem = u1(i,k) + u1(i,k+1) + ptem = ucko(i,k) + ucko(i,k+1) + f1(i,k) = f1(i,k) - (ptem - tem) * ptem1 + f1(i,k+1) = u1(i,k+1) + (ptem - tem) * ptem2 + tem = v1(i,k) + v1(i,k+1) + ptem = vcko(i,k) + vcko(i,k+1) + f2(i,k) = f2(i,k) - (ptem - tem) * ptem1 + f2(i,k+1) = v1(i,k+1) + (ptem - tem) * ptem2 + else + f1(i,k+1) = u1(i,k+1) + f2(i,k+1) = v1(i,k+1) + endif +! + if(scuflg(i)) then + if(k >= mrad(i) .and. k < krad(i)) then + ptem = 0.5 * tem2 * xmfd(i,k) + ptem1 = dtodsd * ptem + ptem2 = dtodsu * ptem + tem = u1(i,k) + u1(i,k+1) + ptem = ucdo(i,k) + ucdo(i,k+1) + f1(i,k) = f1(i,k) + (ptem - tem) *ptem1 + f1(i,k+1) = f1(i,k+1) - (ptem - tem) *ptem2 + tem = v1(i,k) + v1(i,k+1) + ptem = vcdo(i,k) + vcdo(i,k+1) + f2(i,k) = f2(i,k) + (ptem - tem) * ptem1 + f2(i,k+1) = f2(i,k+1) - (ptem - tem) * ptem2 + endif + endif +! + enddo + enddo +c +!> - Call tridi2() to solve tridiagonal problem for momentum +c + call tridi2(im,km,al,ad,au,f1,f2,au,f1,f2) +c +!> - Recover the tendencies of momentum +c + do k = 1,km + do i = 1,im + utend = (f1(i,k)-u1(i,k))*rdt + vtend = (f2(i,k)-v1(i,k))*rdt + du(i,k) = du(i,k)+utend + dv(i,k) = dv(i,k)+vtend + dusfc(i) = dusfc(i)+conw*del(i,k)*utend + dvsfc(i) = dvsfc(i)+conw*del(i,k)*vtend + enddo + enddo +! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +!> ## Save PBL height for diagnostic purpose +! + do i = 1, im + hpbl(i) = hpblx(i) + kpbl(i) = kpblx(i) + enddo +! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + return + end subroutine satmedmfvdifq_run +!> @} +!! @} + end module satmedmfvdifq diff --git a/physics/satmedmfvdifq.meta b/physics/satmedmfvdifq.meta new file mode 100644 index 000000000..d6b1d66ea --- /dev/null +++ b/physics/satmedmfvdifq.meta @@ -0,0 +1,597 @@ +[ccpp-arg-table] + name = satmedmfvdifq_init + type = scheme +[isatmedmf] + standard_name = choice_of_scale_aware_TKE_moist_EDMF_PBL + long_name = choice of scale-aware TKE moist EDMF PBL scheme + units = none + dimensions = () + type = integer + intent = in + optional = F +[isatmedmf_vdifq] + standard_name = choice_of_updated_scale_aware_TKE_moist_EDMF_PBL + long_name = choice of updated scale-aware TKE moist EDMF PBL scheme + units = none + dimensions = () + type = integer + intent = in + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F + +##################################################################### +[ccpp-arg-table] + name = satmedmfvdifq_run + type = scheme +[ix] + standard_name = horizontal_dimension + long_name = horizontal dimension + units = count + dimensions = () + type = integer + intent = in + optional = F +[im] + standard_name = horizontal_loop_extent + long_name = horizontal loop extent + units = count + dimensions = () + type = integer + intent = in + optional = F +[km] + standard_name = vertical_dimension + long_name = vertical layer dimension + units = count + dimensions = () + type = integer + intent = in + optional = F +[ntrac] + standard_name = number_of_vertical_diffusion_tracers + long_name = number of tracers to diffuse vertically + units = count + dimensions = () + type = integer + intent = in + optional = F +[ntcw] + standard_name = index_for_liquid_cloud_condensate + long_name = tracer index for cloud condensate (or liquid water) + units = index + dimensions = () + type = integer + intent = in + optional = F +[ntiw] + standard_name = index_for_ice_cloud_condensate_vertical_diffusion_tracer + long_name = tracer index for ice water in the vertically diffused tracer array + units = index + dimensions = () + type = integer + intent = in + optional = F +[ntke] + standard_name = index_for_turbulent_kinetic_energy_vertical_diffusion_tracer + long_name = index for turbulent kinetic energy in the vertically diffused tracer array + units = index + dimensions = () + type = integer + intent = in + optional = F +[grav] + standard_name = gravitational_acceleration + long_name = gravitational acceleration + units = m s-2 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[rd] + standard_name = gas_constant_dry_air + long_name = ideal gas constant for dry air + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[cp] + standard_name = specific_heat_of_dry_air_at_constant_pressure + long_name = specific heat of dry air at constant pressure + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[rv] + standard_name = gas_constant_water_vapor + long_name = ideal gas constant for water vapor + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[hvap] + standard_name = latent_heat_of_vaporization_of_water_at_0C + long_name = latent heat of evaporation/sublimation + units = J kg-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[hfus] + standard_name = latent_heat_of_fusion_of_water_at_0C + long_name = latent heat of fusion + units = J kg-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[fv] + standard_name = ratio_of_vapor_to_dry_air_gas_constants_minus_one + long_name = (rv/rd) - 1 (rv = ideal gas constant for water vapor) + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[eps] + standard_name = ratio_of_dry_air_to_water_vapor_gas_constants + long_name = rd/rv + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[epsm1] + standard_name = ratio_of_dry_air_to_water_vapor_gas_constants_minus_one + long_name = (rd/rv) - 1 + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[dv] + standard_name = tendency_of_y_wind_due_to_model_physics + long_name = updated tendency of the y wind + units = m s-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[du] + standard_name = tendency_of_x_wind_due_to_model_physics + long_name = updated tendency of the x wind + units = m s-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[tdt] + standard_name = tendency_of_air_temperature_due_to_model_physics + long_name = updated tendency of the temperature + units = K s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[rtg] + standard_name = tendency_of_vertically_diffused_tracer_concentration + long_name = updated tendency of the tracers due to vertical diffusion in PBL scheme + units = kg kg-1 s-1 + dimensions = (horizontal_dimension,vertical_dimension,number_of_vertical_diffusion_tracers) + type = real + kind = kind_phys + intent = inout + optional = F +[u1] + standard_name = x_wind + long_name = x component of layer wind + units = m s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[v1] + standard_name = y_wind + long_name = y component of layer wind + units = m s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[t1] + standard_name = air_temperature + long_name = layer mean air temperature + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[q1] + standard_name = vertically_diffused_tracer_concentration + long_name = tracer concentration diffused by PBL scheme + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension,number_of_vertical_diffusion_tracers) + type = real + kind = kind_phys + intent = in + optional = F +[swh] + standard_name = tendency_of_air_temperature_due_to_shortwave_heating_on_radiation_timestep + long_name = total sky shortwave heating rate + units = K s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[hlw] + standard_name = tendency_of_air_temperature_due_to_longwave_heating_on_radiation_timestep + long_name = total sky longwave heating rate + units = K s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[xmu] + standard_name = zenith_angle_temporal_adjustment_factor_for_shortwave_fluxes + long_name = zenith angle temporal adjustment factor for shortwave + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[garea] + standard_name = cell_area + long_name = area of the grid cell + units = m2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[psk] + standard_name = dimensionless_exner_function_at_lowest_model_interface + long_name = dimensionless Exner function at the surface interface + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[rbsoil] + standard_name = bulk_richardson_number_at_lowest_model_level + long_name = bulk Richardson number at the surface + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[zorl] + standard_name = surface_roughness_length + long_name = surface roughness length in cm + units = cm + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[u10m] + standard_name = x_wind_at_10m + long_name = x component of wind at 10 m + units = m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[v10m] + standard_name = y_wind_at_10m + long_name = y component of wind at 10 m + units = m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[fm] + standard_name = Monin_Obukhov_similarity_function_for_momentum + long_name = Monin-Obukhov similarity function for momentum + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[fh] + standard_name = Monin_Obukhov_similarity_function_for_heat + long_name = Monin-Obukhov similarity function for heat + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[tsea] + standard_name = surface_skin_temperature + long_name = surface skin temperature + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[heat] + standard_name = kinematic_surface_upward_sensible_heat_flux + long_name = kinematic surface upward sensible heat flux + units = K m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[evap] + standard_name = kinematic_surface_upward_latent_heat_flux + long_name = kinematic surface upward latent heat flux + units = kg kg-1 m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[stress] + standard_name = surface_wind_stress + long_name = surface wind stress + units = m2 s-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[spd1] + standard_name = wind_speed_at_lowest_model_layer + long_name = wind speed at lowest model level + units = m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[kpbl] + standard_name = vertical_index_at_top_of_atmosphere_boundary_layer + long_name = PBL top model level index + units = index + dimensions = (horizontal_dimension) + type = integer + intent = out + optional = F +[prsi] + standard_name = air_pressure_at_interface + long_name = air pressure at model layer interfaces + units = Pa + dimensions = (horizontal_dimension,vertical_dimension_plus_one) + type = real + kind = kind_phys + intent = in + optional = F +[del] + standard_name = air_pressure_difference_between_midlayers + long_name = pres(k) - pres(k+1) + units = Pa + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[prsl] + standard_name = air_pressure + long_name = mean layer pressure + units = Pa + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[prslk] + standard_name = dimensionless_exner_function_at_model_layers + long_name = Exner function at layers + units = none + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[phii] + standard_name = geopotential_at_interface + long_name = geopotential at model layer interfaces + units = m2 s-2 + dimensions = (horizontal_dimension,vertical_dimension_plus_one) + type = real + kind = kind_phys + intent = in + optional = F +[phil] + standard_name = geopotential + long_name = geopotential at model layer centers + units = m2 s-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[delt] + standard_name = time_step_for_physics + long_name = time step for physics + units = s + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[dspheat] + standard_name = flag_TKE_dissipation_heating + long_name = flag for using TKE dissipation heating + units = flag + dimensions = () + type = logical + intent = in + optional = F +[dusfc] + standard_name = instantaneous_surface_x_momentum_flux + long_name = x momentum flux + units = Pa + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[dvsfc] + standard_name = instantaneous_surface_y_momentum_flux + long_name = y momentum flux + units = Pa + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[dtsfc] + standard_name = instantaneous_surface_upward_sensible_heat_flux + long_name = surface upward sensible heat flux + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[dqsfc] + standard_name = instantaneous_surface_upward_latent_heat_flux + long_name = surface upward latent heat flux + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[hpbl] + standard_name = atmosphere_boundary_layer_thickness + long_name = PBL thickness + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[kinver] + standard_name = index_of_highest_temperature_inversion + long_name = index of highest temperature inversion + units = index + dimensions = (horizontal_dimension) + type = integer + intent = in + optional = F +[xkzm_m] + standard_name = atmosphere_momentum_diffusivity_background + long_name = background value of momentum diffusivity + units = m2 s-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[xkzm_h] + standard_name = atmosphere_heat_diffusivity_background + long_name = background value of heat diffusivity + units = m2 s-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[xkzm_s] + standard_name = diffusivity_background_sigma_level + long_name = sigma level threshold for background diffusivity + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[dspfac] + standard_name = tke_dissipative_heating_factor + long_name = tke dissipative heating factor + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[bl_upfr] + standard_name = updraft_fraction_in_boundary_layer_mass_flux_scheme + long_name = updraft fraction in boundary layer mass flux scheme + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[bl_dnfr] + standard_name = downdraft_fraction_in_boundary_layer_mass_flux_scheme + long_name = downdraft fraction in boundary layer mass flux scheme + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F diff --git a/physics/set_soilveg.f b/physics/set_soilveg.f index 60a6395b8..efef0f24b 100644 --- a/physics/set_soilveg.f +++ b/physics/set_soilveg.f @@ -136,8 +136,9 @@ subroutine set_soilveg(me,isot,ivet,nlunit) ! ---------------------------------------------------------------------- defined_veg=20 - NROOT_DATA =(/4,4,4,4,4,3,3,3,3,3,3,3,1,3,2, - & 3,0,3,3,2,0,0,0,0,0,0,0,0,0,0/) + NROOT_DATA =(/4, 4, 4, 4, 4, 3, 3, 3, 3, 3, 3, 3, 1, 3, 2, + & 3, 1, 3, 3, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0/) +! & 3, 0, 3, 3, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0/) ! Moorthi ! ---------------------------------------------------------------------- ! VEGETATION CLASS-RELATED ARRAYS ! ---------------------------------------------------------------------- diff --git a/physics/sfc_cice.f b/physics/sfc_cice.f new file mode 100644 index 000000000..d0aaee476 --- /dev/null +++ b/physics/sfc_cice.f @@ -0,0 +1,157 @@ +!> \file sfc_cice.f +!! This file contains the sfc_sice for coupling to CICE + +!> This module contains the CCPP-compliant GFS sea ice post +!! interstitial codes, which returns updated ice thickness and +!! concentration to global arrays where there is no ice, and +!! set temperature to surface skin temperature. + +!> This module contains the CCPP-compliant GFS sea ice scheme. + module sfc_cice + + contains + + subroutine sfc_cice_init + end subroutine sfc_cice_init +! + subroutine sfc_cice_finalize + end subroutine sfc_cice_finalize + + +!> \defgroup sfc_sice for coupling to CICE +!! @{ +!! \section diagram Calling Hierarchy Diagram +!! \section intraphysics Intraphysics Communication +!! +!> \brief Brief description of the subroutine +!! +!! \section arg_table_sfc_cice_run Arguments +!! \htmlinclude sfc_cice_run.html +!! + +!! +!! \section general General Algorithm +!! \section detailed Detailed Algorithm +!! @{ + + +!! use physcons, only : hvap => con_hvap, cp => con_cp, & +!! & rvrdm1 => con_fvirt, rd => con_rd +! +!----------------------------------- + subroutine sfc_cice_run & +! --- inputs: + & ( im, cplflx, hvap, cp, rvrdm1, rd, & + & t1, q1, cm, ch, prsl1, & + & wind, flag_cice, flag_iter, dqsfc, dtsfc, & + & dusfc, dvsfc, & +! --- outputs: + & qsurf, cmm, chh, evap, hflx, stress, & + & errmsg, errflg + & ) + +! ===================================================================== ! +! description: ! +! Sep 2015 -- Xingren Wu created from sfc_sice for coupling to CICE ! +! ! +! usage: ! +! ! +! call sfc_cice ! +! inputs: ! +! ( im, cplflx, hvap, cp, rvrdm1, rd, ! +! t1, q1, cm, ch, prsl1, ! +! wind, flag_cice, flag_iter, dqsfc, dtsfc, ! +! dusfc, dvsfc, ! +! outputs: ! +! qsurf, cmm, chh, evap, hflx, stress) ! +! ! +! ==================== defination of variables ==================== ! +! ! +! inputs: +! im, - integer, horiz dimension +!! u1, v1 - real, u/v component of surface layer wind +! t1 - real, surface layer mean temperature ( k ) +! q1 - real, surface layer mean specific humidity +! cm - real, surface exchange coeff for momentum (m/s) +! ch - real, surface exchange coeff heat & moisture(m/s) +! prsl1 - real, surface layer mean pressure +! wind - real, wind speed (m/s) +! flag_iter- logical +! dqsfc - real, latent heat flux +! dtsfc - real, sensible heat flux +! dusfc - real, zonal momentum stress +! dvsfc - real, meridional momentum stress +! outputs: +! qsurf - real, specific humidity at sfc +! cmm - real, ? +! chh - real, ? +! evap - real, evaperation from latent heat +! hflx - real, sensible heat +! stress - real, surface stress +! ==================== end of description ===================== ! +! +! + use machine , only : kind_phys + implicit none + + real (kind=kind_phys), intent(in) :: hvap, cp, rvrdm1, rd + +! --- inputs: + integer, intent(in) :: im + logical, intent(in) :: cplflx + +! real (kind=kind_phys), dimension(im), intent(in) :: u1, v1, & + real (kind=kind_phys), dimension(im), intent(in) :: & + & t1, q1, cm, ch, prsl1, wind, dqsfc, dtsfc, dusfc, dvsfc + + logical, intent(in) :: flag_cice(im), flag_iter(im) + +! --- outputs: + real (kind=kind_phys), dimension(im), intent(out) :: qsurf, & + & cmm, chh, evap, hflx, stress +! + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + +! --- locals: + + real (kind=kind_phys) :: rho, tem + + real(kind=kind_phys) :: cpinv, hvapi, elocp + + integer :: i + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 +! + if (.not. cplflx) return +! + cpinv = 1.0/cp + hvapi = 1.0/hvap + elocp = hvap/cp +! + do i = 1, im + if (flag_cice(i) .and. flag_iter(i)) then + + rho = prsl1(i) & + & / (rd * t1(i) * (1.0 + rvrdm1*max(q1(i), 1.0e-8))) + + cmm(i) = wind(i) * cm(i) + chh(i) = wind(i) * ch(i) * rho + + qsurf(i) = q1(i) + dqsfc(i) / (hvap*chh(i)) + tem = 1.0 / rho + hflx(i) = dtsfc(i) * tem * cpinv + evap(i) = dqsfc(i) * tem * hvapi + stress(i) = sqrt(dusfc(i)*dusfc(i) + dvsfc(i)*dvsfc(i)) * tem + endif + enddo + + return +!----------------------------------- + end subroutine sfc_cice_run +!----------------------------------- + +!> @} + end module sfc_cice diff --git a/physics/sfc_cice.meta b/physics/sfc_cice.meta new file mode 100644 index 000000000..543e4d78b --- /dev/null +++ b/physics/sfc_cice.meta @@ -0,0 +1,232 @@ +[ccpp-arg-table] + name = sfc_cice_run + type = scheme +[im] + standard_name = horizontal_loop_extent + long_name = horizontal loop extent + units = count + dimensions = () + type = integer + intent = in + optional = F +[cplflx] + standard_name = flag_for_flux_coupling + long_name = flag controlling cplflx collection (default off) + units = flag + dimensions = () + type = logical + intent = in + optional = F +[hvap] + standard_name = latent_heat_of_vaporization_of_water_at_0C + long_name = latent heat of evaporation/sublimation + units = J kg-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[cp] + standard_name = specific_heat_of_dry_air_at_constant_pressure + long_name = specific heat of dry air at constant pressure + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[rvrdm1] + standard_name = ratio_of_vapor_to_dry_air_gas_constants_minus_one + long_name = (rv/rd) - 1 (rv = ideal gas constant for water vapor) + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[rd] + standard_name = gas_constant_dry_air + long_name = ideal gas constant for dry air + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[t1] + standard_name = air_temperature_at_lowest_model_layer + long_name = surface layer mean temperature + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[q1] + standard_name = water_vapor_specific_humidity_at_lowest_model_layer + long_name = surface layer mean specific humidity + units = kg kg-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[cm] + standard_name = surface_drag_coefficient_for_momentum_in_air_over_ice + long_name = surface exchange coeff for momentum over ice + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[ch] + standard_name = surface_drag_coefficient_for_heat_and_moisture_in_air_over_ice + long_name = surface exchange coeff heat & moisture over ice + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[prsl1] + standard_name = air_pressure_at_lowest_model_layer + long_name = surface layer mean pressure + units = Pa + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[wind] + standard_name = wind_speed_at_lowest_model_layer + long_name = wind speed at lowest model level + units = m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[flag_cice] + standard_name = flag_for_cice + long_name = flag for cice + units = flag + dimensions = (horizontal_dimension) + type = logical + intent = in + optional = F +[flag_iter] + standard_name = flag_for_iteration + long_name = flag for iteration + units = flag + dimensions = (horizontal_dimension) + type = logical + intent = in + optional = F +[dqsfc] + standard_name = surface_upward_latent_heat_flux_for_coupling_interstitial + long_name = sfc latent heat flux for coupling interstitial + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[dtsfc] + standard_name = surface_upward_sensible_heat_flux_for_coupling_interstitial + long_name = sfc sensible heat flux for coupling interstitial + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[dusfc] + standard_name = surface_x_momentum_flux_for_coupling_interstitial + long_name = sfc x momentum flux for coupling interstitial + units = Pa + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[dvsfc] + standard_name = surface_y_momentum_flux_for_coupling_interstitial + long_name = sfc y momentum flux for coupling interstitial + units = Pa + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[qsurf] + standard_name = surface_specific_humidity_over_ice + long_name = surface air saturation specific humidity over ice + units = kg kg-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[cmm] + standard_name = surface_drag_wind_speed_for_momentum_in_air_over_ice + long_name = momentum exchange coefficient over ice + units = m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[chh] + standard_name = surface_drag_mass_flux_for_heat_and_moisture_in_air_over_ice + long_name = thermal exchange coefficient over ice + units = kg m-2 s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[evap] + standard_name = kinematic_surface_upward_latent_heat_flux_over_ice + long_name = kinematic surface upward latent heat flux over ice + units = kg kg-1 m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[hflx] + standard_name = kinematic_surface_upward_sensible_heat_flux_over_ice + long_name = kinematic surface upward sensible heat flux over ice + units = K m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[stress] + standard_name = surface_wind_stress_over_ice + long_name = surface wind stress over ice + units = m2 s-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F diff --git a/physics/sfc_diag.f b/physics/sfc_diag.f index 86fb9f39b..b78c9b2f7 100644 --- a/physics/sfc_diag.f +++ b/physics/sfc_diag.f @@ -16,41 +16,15 @@ end subroutine sfc_diag_finalize !> \brief Brief description of the subroutine !! !! \section arg_table_sfc_diag_run Arguments -!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | -!! |----------------|------------------------------------------------------------------------------|-------------------------------------------------------------|---------------|------|-----------|-----------|--------|----------| -!! | im | horizontal_loop_extent | horizontal loop extent | count | 0 | integer | | in | F | -!! | grav | gravitational_acceleration | gravitational acceleration | m s-2 | 0 | real | kind_phys | in | F | -!! | cp | specific_heat_of_dry_air_at_constant_pressure | specific heat of dry air at constant pressure | J kg-1 K-1 | 0 | real | kind_phys | in | F | -!! | eps | ratio_of_dry_air_to_water_vapor_gas_constants | rd/rv | none | 0 | real | kind_phys | in | F | -!! | epsm1 | ratio_of_dry_air_to_water_vapor_gas_constants_minus_one | (rd/rv) - 1 | none | 0 | real | kind_phys | in | F | -!! | ps | surface_air_pressure | surface pressure | Pa | 1 | real | kind_phys | in | F | -!! | u1 | x_wind_at_lowest_model_layer_updated_by_physics | x component of 1st model layer wind | m s-1 | 1 | real | kind_phys | in | F | -!! | v1 | y_wind_at_lowest_model_layer_updated_by_physics | y component of 1st model layer wind | m s-1 | 1 | real | kind_phys | in | F | -!! | t1 | air_temperature_at_lowest_model_layer_updated_by_physics | 1st model layer air temperature | K | 1 | real | kind_phys | in | F | -!! | q1 | water_vapor_specific_humidity_at_lowest_model_layer_updated_by_physics | 1st model layer specific humidity | kg kg-1 | 1 | real | kind_phys | in | F | -!! | tskin | surface_skin_temperature | surface skin temperature | K | 1 | real | kind_phys | in | F | -!! | qsurf | surface_specific_humidity | surface specific humidity | kg kg-1 | 1 | real | kind_phys | in | F | -!! | f10m | ratio_of_wind_at_lowest_model_layer_and_wind_at_10m | ratio of fm10 and fm | ratio | 1 | real | kind_phys | out | F | -!! | u10m | x_wind_at_10m | x component of wind at 10 m | m s-1 | 1 | real | kind_phys | out | F | -!! | v10m | y_wind_at_10m | y component of wind at 10 m | m s-1 | 1 | real | kind_phys | out | F | -!! | t2m | temperature_at_2m | temperature at 2 m | K | 1 | real | kind_phys | out | F | -!! | q2m | specific_humidity_at_2m | specific humidity at 2 m | kg kg-1 | 1 | real | kind_phys | out | F | -!! | prslki | ratio_of_exner_function_between_midlayer_and_interface_at_lowest_model_layer | Exner function ratio bt midlayer and interface at 1st layer | ratio | 1 | real | kind_phys | in | F | -!! | evap | kinematic_surface_upward_latent_heat_flux | surface upward evaporation flux | kg kg-1 m s-1 | 1 | real | kind_phys | in | F | -!! | fm | Monin-Obukhov_similarity_function_for_momentum | Monin-Obukhov similarity parameter for momentum | none | 1 | real | kind_phys | in | F | -!! | fh | Monin-Obukhov_similarity_function_for_heat | Monin-Obukhov similarity parameter for heat | none | 1 | real | kind_phys | in | F | -!! | fm10 | Monin-Obukhov_similarity_function_for_momentum_at_10m | Monin-Obukhov similarity parameter for momentum | none | 1 | real | kind_phys | in | F | -!! | fh2 | Monin-Obukhov_similarity_function_for_heat_at_2m | Monin-Obukhov similarity parameter for heat | none | 1 | real | kind_phys | in | F | -!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | -!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | +!! \htmlinclude sfc_diag_run.html !! !! \section general General Algorithm !! \section detailed Detailed Algorithm !! @{ subroutine sfc_diag_run & - & (im,grav,cp,eps,epsm1,ps,u1,v1,t1,q1, & - & tskin,qsurf,f10m,u10m,v10m,t2m,q2m, & - & prslki,evap,fm,fh,fm10,fh2,errmsg,errflg & + & (im,grav,cp,eps,epsm1,ps,u1,v1,t1,q1,prslki, & + & evap,fm,fh,fm10,fh2,tskin,qsurf, & + & f10m,u10m,v10m,t2m,q2m,errmsg,errflg & & ) ! use machine , only : kind_phys @@ -70,7 +44,7 @@ subroutine sfc_diag_run & ! locals ! real(kind=kind_phys), parameter :: qmin=1.0e-8 - integer ::k,i + integer :: k,i ! real(kind=kind_phys) :: fhi, qss, wrk ! real(kind=kind_phys) sig2k, fhi, qss @@ -100,7 +74,11 @@ subroutine sfc_diag_run & ! t2m(i) = t2m(i) * sig2k wrk = 1.0 - fhi +#ifdef GSD_SURFACE_FLUXES_BUGFIX + t2m(i) = tskin(i)*wrk + t1(i)*fhi - (grav+grav)/cp +#else t2m(i) = tskin(i)*wrk + t1(i)*prslki(i)*fhi - (grav+grav)/cp +#endif if(evap(i) >= 0.) then ! for evaporation>0, use inferred qsurf to deduce q2m q2m(i) = qsurf(i)*wrk + max(qmin,q1(i))*fhi diff --git a/physics/sfc_diag.meta b/physics/sfc_diag.meta new file mode 100644 index 000000000..0e9699faf --- /dev/null +++ b/physics/sfc_diag.meta @@ -0,0 +1,226 @@ +[ccpp-arg-table] + name = sfc_diag_run + type = scheme +[im] + standard_name = horizontal_loop_extent + long_name = horizontal loop extent + units = count + dimensions = () + type = integer + intent = in + optional = F +[grav] + standard_name = gravitational_acceleration + long_name = gravitational acceleration + units = m s-2 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[cp] + standard_name = specific_heat_of_dry_air_at_constant_pressure + long_name = specific heat of dry air at constant pressure + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[eps] + standard_name = ratio_of_dry_air_to_water_vapor_gas_constants + long_name = rd/rv + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[epsm1] + standard_name = ratio_of_dry_air_to_water_vapor_gas_constants_minus_one + long_name = (rd/rv) - 1 + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[ps] + standard_name = surface_air_pressure + long_name = surface pressure + units = Pa + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[u1] + standard_name = x_wind_at_lowest_model_layer_updated_by_physics + long_name = x component of 1st model layer wind + units = m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[v1] + standard_name = y_wind_at_lowest_model_layer_updated_by_physics + long_name = y component of 1st model layer wind + units = m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[t1] + standard_name = air_temperature_at_lowest_model_layer_updated_by_physics + long_name = 1st model layer air temperature + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[q1] + standard_name = water_vapor_specific_humidity_at_lowest_model_layer_updated_by_physics + long_name = 1st model layer specific humidity + units = kg kg-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[prslki] + standard_name = ratio_of_exner_function_between_midlayer_and_interface_at_lowest_model_layer + long_name = Exner function ratio bt midlayer and interface at 1st layer + units = ratio + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[evap] + standard_name = kinematic_surface_upward_latent_heat_flux + long_name = surface upward evaporation flux + units = kg kg-1 m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[fm] + standard_name = Monin_Obukhov_similarity_function_for_momentum + long_name = Monin-Obukhov similarity parameter for momentum + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[fh] + standard_name = Monin_Obukhov_similarity_function_for_heat + long_name = Monin-Obukhov similarity parameter for heat + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[fm10] + standard_name = Monin_Obukhov_similarity_function_for_momentum_at_10m + long_name = Monin-Obukhov similarity parameter for momentum + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[fh2] + standard_name = Monin_Obukhov_similarity_function_for_heat_at_2m + long_name = Monin-Obukhov similarity parameter for heat + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[tskin] + standard_name = surface_skin_temperature + long_name = surface skin temperature + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[qsurf] + standard_name = surface_specific_humidity + long_name = surface specific humidity + units = kg kg-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[f10m] + standard_name = ratio_of_wind_at_lowest_model_layer_and_wind_at_10m + long_name = ratio of fm10 and fm + units = ratio + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[u10m] + standard_name = x_wind_at_10m + long_name = x component of wind at 10 m + units = m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[v10m] + standard_name = y_wind_at_10m + long_name = y component of wind at 10 m + units = m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[t2m] + standard_name = temperature_at_2m + long_name = temperature at 2 m + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[q2m] + standard_name = specific_humidity_at_2m + long_name = specific humidity at 2 m + units = kg kg-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F diff --git a/physics/sfc_diag_post.F90 b/physics/sfc_diag_post.F90 index 80c90eadb..767e98db5 100644 --- a/physics/sfc_diag_post.F90 +++ b/physics/sfc_diag_post.F90 @@ -12,43 +12,24 @@ subroutine sfc_diag_post_finalize() end subroutine sfc_diag_post_finalize #if 0 !> \section arg_table_sfc_diag_post_run Argument Table -!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | -!! |----------------|---------------------------------------------------------------------------------------------------------------------|-------------------------------------------------------------------------------------|-------------|------|------------|-----------|--------|----------| -!! | im | horizontal_loop_extent | horizontal loop extent | count | 0 | integer | | in | F | -!! | lssav | flag_diagnostics | logical flag for storing diagnostics | flag | 0 | logical | | in | F | -!! | dtf | time_step_for_dynamics | dynamics timestep | s | 0 | real | kind_phys | in | F | -!! | con_eps | ratio_of_dry_air_to_water_vapor_gas_constants | rd/rv | none | 0 | real | kind_phys | in | F | -!! | con_epsm1 | ratio_of_dry_air_to_water_vapor_gas_constants_minus_one | (rd/rv) - 1 | none | 0 | real | kind_phys | in | F | -!! | pgr | surface_air_pressure | surface pressure | Pa | 1 | real | kind_phys | in | F | -!! | t2m | temperature_at_2m | 2 meter temperature | K | 1 | real | kind_phys | in | F | -!! | q2m | specific_humidity_at_2m | 2 meter specific humidity | kg kg-1 | 1 | real | kind_phys | in | F | -!! | u10m | x_wind_at_10m | 10 meter u wind speed | m s-1 | 1 | real | kind_phys | in | F | -!! | v10m | y_wind_at_10m | 10 meter v wind speed | m s-1 | 1 | real | kind_phys | in | F | -!! | tmpmin | minimum_temperature_at_2m | min temperature at 2m height | K | 1 | real | kind_phys | inout | F | -!! | tmpmax | maximum_temperature_at_2m | max temperature at 2m height | K | 1 | real | kind_phys | inout | F | -!! | spfhmin | minimum_specific_humidity_at_2m | minimum specific humidity at 2m height | kg kg-1 | 1 | real | kind_phys | inout | F | -!! | spfhmax | maximum_specific_humidity_at_2m | maximum specific humidity at 2m height | kg kg-1 | 1 | real | kind_phys | inout | F | -!! | wind10mmax | maximum_wind_at_10m | maximum wind speed at 10 m | m s-1 | 1 | real | kind_phys | inout | F | -!! | u10mmax | maximum_x_wind_at_10m | maximum x wind at 10 m | m s-1 | 1 | real | kind_phys | inout | F | -!! | v10mmax | maximum_y_wind_at_10m | maximum y wind at 10 m | m s-1 | 1 | real | kind_phys | inout | F | -!! | dpt2m | dewpoint_temperature_at_2m | 2 meter dewpoint temperature | K | 1 | real | kind_phys | inout | F | -!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | -!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | +!! \htmlinclude sfc_diag_post_run.html !! #endif - subroutine sfc_diag_post_run (im, lssav, dtf, con_eps, con_epsm1, pgr, & - t2m, q2m, u10m, v10m, tmpmin, tmpmax, spfhmin, spfhmax,& + 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,& wind10mmax, u10mmax, v10mmax, dpt2m, errmsg, errflg) use machine, only: kind_phys implicit none - integer, intent(in) :: im + integer, intent(in) :: im, lsm, lsm_noahmp logical, intent(in) :: lssav real(kind=kind_phys), intent(in) :: dtf, con_eps, con_epsm1 - real(kind=kind_phys), dimension(im), intent(in) :: pgr, t2m, q2m, u10m, v10m - real(kind=kind_phys), dimension(im), intent(inout) :: tmpmin, tmpmax, spfhmin, spfhmax + logical , dimension(im), intent(in) :: dry + real(kind=kind_phys), dimension(im), intent(in) :: pgr, u10m, v10m + real(kind=kind_phys), dimension(:) , intent(in) :: t2mmp, q2mp + real(kind=kind_phys), dimension(im), intent(inout) :: t2m, q2m, tmpmin, tmpmax, spfhmin, spfhmax real(kind=kind_phys), dimension(im), intent(inout) :: wind10mmax, u10mmax, v10mmax, dpt2m character(len=*), intent(out) :: errmsg @@ -61,6 +42,15 @@ subroutine sfc_diag_post_run (im, lssav, dtf, con_eps, con_epsm1, pgr, & 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 new file mode 100644 index 000000000..6c863a6af --- /dev/null +++ b/physics/sfc_diag_post.meta @@ -0,0 +1,222 @@ +[ccpp-arg-table] + name = sfc_diag_post_run + type = scheme +[im] + standard_name = horizontal_loop_extent + long_name = horizontal loop extent + units = count + dimensions = () + type = integer + intent = in + optional = F +[lsm] + standard_name = flag_for_land_surface_scheme + long_name = flag for land surface model + units = flag + dimensions = () + type = integer + intent = in + optional = F +[lsm_noahmp] + standard_name = flag_for_noahmp_land_surface_scheme + long_name = flag for NOAH MP land surface model + units = flag + dimensions = () + type = integer + intent = in + optional = F +[dry] + standard_name = flag_nonzero_land_surface_fraction + long_name = flag indicating presence of some land surface area fraction + units = flag + dimensions = (horizontal_dimension) + type = logical + intent = in + optional = F +[lssav] + standard_name = flag_diagnostics + long_name = logical flag for storing diagnostics + units = flag + dimensions = () + type = logical + intent = in + optional = F +[dtf] + standard_name = time_step_for_dynamics + long_name = dynamics timestep + units = s + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[con_eps] + standard_name = ratio_of_dry_air_to_water_vapor_gas_constants + long_name = rd/rv + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[con_epsm1] + standard_name = ratio_of_dry_air_to_water_vapor_gas_constants_minus_one + long_name = (rd/rv) - 1 + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[pgr] + standard_name = surface_air_pressure + long_name = surface pressure + units = Pa + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[t2mmp] + standard_name = temperature_at_2m_from_noahmp + long_name = 2 meter temperature from noahmp + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[q2mp] + standard_name = specific_humidity_at_2m_from_noahmp + long_name = 2 meter specific humidity from noahmp + units = kg kg-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[t2m] + standard_name = temperature_at_2m + long_name = 2 meter temperature + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[q2m] + standard_name = specific_humidity_at_2m + long_name = 2 meter specific humidity + units = kg kg-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[u10m] + standard_name = x_wind_at_10m + long_name = 10 meter u wind speed + units = m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[v10m] + standard_name = y_wind_at_10m + long_name = 10 meter v wind speed + units = m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[tmpmin] + standard_name = minimum_temperature_at_2m + long_name = min temperature at 2m height + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[tmpmax] + standard_name = maximum_temperature_at_2m + long_name = max temperature at 2m height + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[spfhmin] + standard_name = minimum_specific_humidity_at_2m + long_name = minimum specific humidity at 2m height + units = kg kg-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[spfhmax] + standard_name = maximum_specific_humidity_at_2m + long_name = maximum specific humidity at 2m height + units = kg kg-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[wind10mmax] + standard_name = maximum_wind_at_10m + long_name = maximum wind speed at 10 m + units = m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[u10mmax] + standard_name = maximum_x_wind_at_10m + long_name = maximum x wind at 10 m + units = m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[v10mmax] + standard_name = maximum_y_wind_at_10m + long_name = maximum y wind at 10 m + units = m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[dpt2m] + standard_name = dewpoint_temperature_at_2m + long_name = 2 meter dewpoint temperature + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F diff --git a/physics/sfc_diff.f b/physics/sfc_diff.f index ff503d3b2..60d5ceeea 100644 --- a/physics/sfc_diff.f +++ b/physics/sfc_diff.f @@ -24,7 +24,7 @@ end subroutine sfc_diff_init subroutine sfc_diff_finalize end subroutine sfc_diff_finalize -!> \defgroup GFS_diff_main GFS sfc_diff Main +!> \defgroup GFS_diff_main GFS Surface Layer Scheme Module !> @{ !> \brief This subroutine calculates surface roughness length. !! @@ -32,76 +32,7 @@ end subroutine sfc_diff_finalize !! based on the surface sublayer scheme in !! Zeng and Dickinson (1998) \cite zeng_and_dickinson_1998. !> \section arg_table_sfc_diff_run Argument Table -!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | -!! |----------------|------------------------------------------------------------------------------|------------------------------------------------------------------|------------|------|-----------|-----------|--------|----------| -!! | im | horizontal_loop_extent | horizontal loop extent | count | 0 | integer | | in | F | -!! | rvrdm1 | ratio_of_vapor_to_dry_air_gas_constants_minus_one | (rv/rd) - 1 (rv = ideal gas constant for water vapor) | none | 0 | real | kind_phys | in | F | -!! | eps | ratio_of_dry_air_to_water_vapor_gas_constants | rd/rv | none | 0 | real | kind_phys | in | F | -!! | epsm1 | ratio_of_dry_air_to_water_vapor_gas_constants_minus_one | (rd/rv) - 1 | none | 0 | real | kind_phys | in | F | -!! | grav | gravitational_acceleration | gravitational acceleration | m s-2 | 0 | real | kind_phys | in | F | -!! | ps | surface_air_pressure | surface pressure | Pa | 1 | real | kind_phys | in | F | -!! | u1 | x_wind_at_lowest_model_layer | x component of 1st model layer wind | m s-1 | 1 | real | kind_phys | in | F | -!! | v1 | y_wind_at_lowest_model_layer | y component of 1st model layer wind | m s-1 | 1 | real | kind_phys | in | F | -!! | t1 | air_temperature_at_lowest_model_layer | 1st model layer air temperature | K | 1 | real | kind_phys | in | F | -!! | q1 | water_vapor_specific_humidity_at_lowest_model_layer | 1st model layer specific humidity | kg kg-1 | 1 | real | kind_phys | in | F | -!! | z1 | height_above_ground_at_lowest_model_layer | height above ground at 1st model layer | m | 1 | real | kind_phys | in | F | -!! | prsl1 | air_pressure_at_lowest_model_layer | Model layer 1 mean pressure | Pa | 1 | real | kind_phys | in | F | -!! | prslki | ratio_of_exner_function_between_midlayer_and_interface_at_lowest_model_layer | Exner function ratio bt midlayer and interface at 1st layer | ratio | 1 | real | kind_phys | in | F | -!! | ddvel | surface_wind_enhancement_due_to_convection | surface wind enhancement due to convection | m s-1 | 1 | real | kind_phys | in | F | -!! | sigmaf | bounded_vegetation_area_fraction | areal fractional cover of green vegetation bounded on the bottom | frac | 1 | real | kind_phys | in | F | -!! | vegtype | vegetation_type_classification | vegetation type at each grid cell | index | 1 | integer | | in | F | -!! | shdmax | maximum_vegetation_area_fraction | max fractnl cover of green veg | frac | 1 | real | kind_phys | in | F | -!! | ivegsrc | vegetation_type_dataset_choice | land use dataset choice | index | 0 | integer | | in | F | -!! | z0pert | perturbation_of_momentum_roughness_length | perturbation of momentum roughness length | frac | 1 | real | kind_phys | in | F | -!! | ztpert | perturbation_of_heat_to_momentum_roughness_length_ratio | perturbation of heat to momentum roughness length ratio | frac | 1 | real | kind_phys | in | F | -!! | flag_iter | flag_for_iteration | flag for iteration | flag | 1 | logical | | in | F | -!! | redrag | flag_for_reduced_drag_coefficient_over_sea | flag for reduced drag coefficient over sea | flag | 0 | logical | | in | F | -!! | wet | flag_nonzero_wet_surface_fraction | flag indicating presence of some ocean or lake surface area fraction | flag | 1 | logical | | in | F | -!! | dry | flag_nonzero_land_surface_fraction | flag indicating presence of some land surface area fraction | flag | 1 | logical | | in | F | -!! | icy | flag_nonzero_sea_ice_surface_fraction | flag indicating presence of some sea ice surface area fraction | flag | 1 | logical | | in | F | -!! | fice | sea_ice_concentration | ice fraction over open water | frac | 1 | real | kind_phys | in | F | -!! | tskin_ocn | surface_skin_temperature_over_ocean_interstitial | surface skin temperature over ocean (temporary use as interstitial) | K | 1 | real | kind_phys | in | F | -!! | tskin_lnd | surface_skin_temperature_over_land_interstitial | surface skin temperature over land (temporary use as interstitial) | K | 1 | real | kind_phys | in | F | -!! | tskin_ice | surface_skin_temperature_over_ice_interstitial | surface skin temperature over ice (temporary use as interstitial) | K | 1 | real | kind_phys | in | F | -!! | tsurf_ocn | surface_skin_temperature_after_iteration_over_ocean | surface skin temperature after iteration over ocean | K | 1 | real | kind_phys | in | F | -!! | tsurf_lnd | surface_skin_temperature_after_iteration_over_land | surface skin temperature after iteration over land | K | 1 | real | kind_phys | in | F | -!! | tsurf_ice | surface_skin_temperature_after_iteration_over_ice | surface skin temperature after iteration over ice | K | 1 | real | kind_phys | in | F | -!! | snwdph_ocn | surface_snow_thickness_water_equivalent_over_ocean | water equivalent snow depth over ocean | mm | 1 | real | kind_phys | in | F | -!! | snwdph_lnd | surface_snow_thickness_water_equivalent_over_land | water equivalent snow depth over land | mm | 1 | real | kind_phys | in | F | -!! | snwdph_ice | surface_snow_thickness_water_equivalent_over_ice | water equivalent snow depth over ice | mm | 1 | real | kind_phys | in | F | -!! | z0rl_ocn | surface_roughness_length_over_ocean_interstitial | surface roughness length over ocean (temporary use as interstitial) | cm | 1 | real | kind_phys | inout | F | -!! | z0rl_lnd | surface_roughness_length_over_land_interstitial | surface roughness length over land (temporary use as interstitial) | cm | 1 | real | kind_phys | inout | F | -!! | z0rl_ice | surface_roughness_length_over_ice_interstitial | surface roughness length over ice (temporary use as interstitial) | cm | 1 | real | kind_phys | inout | F | -!! | ustar_ocn | surface_friction_velocity_over_ocean | surface friction velocity over ocean | m s-1 | 1 | real | kind_phys | inout | F | -!! | ustar_lnd | surface_friction_velocity_over_land | surface friction velocity over land | m s-1 | 1 | real | kind_phys | inout | F | -!! | ustar_ice | surface_friction_velocity_over_ice | surface friction velocity over ice | m s-1 | 1 | real | kind_phys | inout | F | -!! | cm_ocn | surface_drag_coefficient_for_momentum_in_air_over_ocean | surface exchange coeff for momentum over ocean | none | 1 | real | kind_phys | inout | F | -!! | cm_lnd | surface_drag_coefficient_for_momentum_in_air_over_land | surface exchange coeff for momentum over land | none | 1 | real | kind_phys | inout | F | -!! | cm_ice | surface_drag_coefficient_for_momentum_in_air_over_ice | surface exchange coeff for momentum over ice | none | 1 | real | kind_phys | inout | F | -!! | ch_ocn | surface_drag_coefficient_for_heat_and_moisture_in_air_over_ocean | surface exchange coeff heat & moisture over ocean | none | 1 | real | kind_phys | inout | F | -!! | ch_lnd | surface_drag_coefficient_for_heat_and_moisture_in_air_over_land | surface exchange coeff heat & moisture over land | none | 1 | real | kind_phys | inout | F | -!! | ch_ice | surface_drag_coefficient_for_heat_and_moisture_in_air_over_ice | surface exchange coeff heat & moisture over ice | none | 1 | real | kind_phys | inout | F | -!! | rb_ocn | bulk_richardson_number_at_lowest_model_level_over_ocean | bulk Richardson number at the surface over ocean | none | 1 | real | kind_phys | inout | F | -!! | rb_lnd | bulk_richardson_number_at_lowest_model_level_over_land | bulk Richardson number at the surface over land | none | 1 | real | kind_phys | inout | F | -!! | rb_ice | bulk_richardson_number_at_lowest_model_level_over_ice | bulk Richardson number at the surface over ice | none | 1 | real | kind_phys | inout | F | -!! | stress_ocn | surface_wind_stress_over_ocean | surface wind stress over ocean | m2 s-2 | 1 | real | kind_phys | inout | F | -!! | stress_lnd | surface_wind_stress_over_land | surface wind stress over land | m2 s-2 | 1 | real | kind_phys | inout | F | -!! | stress_ice | surface_wind_stress_over_ice | surface wind stress over ice | m2 s-2 | 1 | real | kind_phys | inout | F | -!! | fm_ocn | Monin-Obukhov_similarity_function_for_momentum_over_ocean | Monin-Obukhov similarity function for momentum over ocean | none | 1 | real | kind_phys | inout | F | -!! | fm_lnd | Monin-Obukhov_similarity_function_for_momentum_over_land | Monin-Obukhov similarity function for momentum over land | none | 1 | real | kind_phys | inout | F | -!! | fm_ice | Monin-Obukhov_similarity_function_for_momentum_over_ice | Monin-Obukhov similarity function for momentum over ice | none | 1 | real | kind_phys | inout | F | -!! | fh_ocn | Monin-Obukhov_similarity_function_for_heat_over_ocean | Monin-Obukhov similarity function for heat over ocean | none | 1 | real | kind_phys | inout | F | -!! | fh_lnd | Monin-Obukhov_similarity_function_for_heat_over_land | Monin-Obukhov similarity function for heat over land | none | 1 | real | kind_phys | inout | F | -!! | fh_ice | Monin-Obukhov_similarity_function_for_heat_over_ice | Monin-Obukhov similarity function for heat over ice | none | 1 | real | kind_phys | inout | F | -!! | fm10_ocn | Monin-Obukhov_similarity_function_for_momentum_at_10m_over_ocean | Monin-Obukhov similarity parameter for momentum at 10m over ocean | none | 1 | real | kind_phys | inout | F | -!! | fm10_lnd | Monin-Obukhov_similarity_function_for_momentum_at_10m_over_land | Monin-Obukhov similarity parameter for momentum at 10m over land | none | 1 | real | kind_phys | inout | F | -!! | fm10_ice | Monin-Obukhov_similarity_function_for_momentum_at_10m_over_ice | Monin-Obukhov similarity parameter for momentum at 10m over ice | none | 1 | real | kind_phys | inout | F | -!! | fh2_ocn | Monin-Obukhov_similarity_function_for_heat_at_2m_over_ocean | Monin-Obukhov similarity parameter for heat at 2m over ocean | none | 1 | real | kind_phys | inout | F | -!! | fh2_lnd | Monin-Obukhov_similarity_function_for_heat_at_2m_over_land | Monin-Obukhov similarity parameter for heat at 2m over land | none | 1 | real | kind_phys | inout | F | -!! | fh2_ice | Monin-Obukhov_similarity_function_for_heat_at_2m_over_ice | Monin-Obukhov similarity parameter for heat at 2m over ice | none | 1 | real | kind_phys | inout | F | -!! | wind | wind_speed_at_lowest_model_layer | wind speed at lowest model level | m s-1 | 1 | real | kind_phys | inout | F | -!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | -!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | +!! \htmlinclude sfc_diff_run.html !! !> \section general_diff GFS Surface Layer Scheme General Algorithm !! - Calculate the thermal roughness length formulation over the ocean (see eq. (25) and (26) @@ -130,12 +61,13 @@ end subroutine sfc_diff_finalize !! - Calculate the exchange coefficients:\f$cm\f$, \f$ch\f$, and \f$stress\f$ as inputs of other \a sfc schemes. !! subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) - & ps,u1,v1,t1,q1,z1, & !intent(in) - & prsl1,prslki,ddvel, & !intent(in) + & ps,t1,q1,z1,wind, & !intent(in) + & prsl1,prslki,prsik1,prslk1, & !intent(in) & sigmaf,vegtype,shdmax,ivegsrc, & !intent(in) & z0pert,ztpert, & ! mg, sfc-perts !intent(in) & flag_iter,redrag, & !intent(in) - & wet,dry,icy,fice, & !intent(in) + & u10m,v10m,sfc_z0_type, & !hafs,z0 type !intent(in) + & wet,dry,icy, & !intent(in) & tskin_ocn, tskin_lnd, tskin_ice, & !intent(in) & tsurf_ocn, tsurf_lnd, tsurf_ice, & !intent(in) & snwdph_ocn,snwdph_lnd,snwdph_ice, & !intent(in) @@ -149,29 +81,28 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) & fh_ocn, fh_lnd, fh_ice, & !intent(inout) & fm10_ocn, fm10_lnd, fm10_ice, & !intent(inout) & fh2_ocn, fh2_lnd, fh2_ice, & !intent(inout) - & wind , & !intent(inout) & errmsg, errflg) !intent(out) ! - use funcphys, only : fpvs - implicit none ! integer, intent(in) :: im, ivegsrc - integer, dimension(im), intent(in) :: vegtype + integer, intent(in) :: sfc_z0_type ! option for calculating surface roughness length over ocean + + integer, dimension(im), intent(in) :: vegtype logical, intent(in) :: redrag ! reduced drag coeff. flag for high wind over sea (j.han) - logical, dimension(im), intent(in) :: flag_iter, wet, dry, icy ! added by s.lu + logical, dimension(im), intent(in) :: flag_iter, wet, dry, icy + real(kind=kind_phys), dimension(im), intent(in) :: u10m,v10m real(kind=kind_phys), intent(in) :: rvrdm1, eps, epsm1, grav real(kind=kind_phys), dimension(im), intent(in) :: & - & ps,u1,v1,t1,q1,z1,prsl1,prslki,ddvel, & - & sigmaf,shdmax, & + & ps,t1,q1,z1,prsl1,prslki,prsik1,prslk1, & + & wind,sigmaf,shdmax, & & z0pert,ztpert ! mg, sfc-perts real(kind=kind_phys), dimension(im), intent(in) :: & & tskin_ocn, tskin_lnd, tskin_ice, & & tsurf_ocn, tsurf_lnd, tsurf_ice, & - & snwdph_ocn,snwdph_lnd,snwdph_ice, & - & fice + & snwdph_ocn,snwdph_lnd,snwdph_ice real(kind=kind_phys), dimension(im), intent(inout) :: & & z0rl_ocn, z0rl_lnd, z0rl_ice, & @@ -183,8 +114,7 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) & fm_ocn, fm_lnd, fm_ice, & & fh_ocn, fh_lnd, fh_ice, & & fm10_ocn, fm10_lnd, fm10_ice, & - & fh2_ocn, fh2_lnd, fh2_ice, & - & wind + & fh2_ocn, fh2_lnd, fh2_ice character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg ! @@ -192,13 +122,10 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) ! integer i ! - real(kind=kind_phys) :: qs1, rat, thv1, restar, - & czilc, tem1, tem2 + real(kind=kind_phys) :: rat, thv1, restar, wind10m, + & czilc, tem1, tem2, virtfac - real(kind=kind_phys) :: tvs_ocn, tvs_lnd, tvs_ice, & - & z0_ocn, z0_lnd, z0_ice, & - & z0max_ocn,z0max_lnd,z0max_ice, & - & ztmax_ocn,ztmax_lnd,ztmax_ice + real(kind=kind_phys) :: tvs, z0, z0max, ztmax ! real(kind=kind_phys), parameter :: & charnock=.014, z0s_max=.317e-2 &! a limiting value at high winds over sea @@ -229,176 +156,203 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) ! ps is in pascals, wind is wind speed, ! surface roughness length is converted to m from cm ! - do i=1,im - ztmax_ocn = 0.; ztmax_lnd = 0.; ztmax_ice = 0. +! write(0,*)'in sfc_diff, sfc_z0_type=',sfc_z0_type + + do i=1,im if(flag_iter(i)) then - wind(i) = max(sqrt(u1(i)*u1(i) + v1(i)*v1(i)) - & + max(0.0, min(ddvel(i), 30.0)), 1.0) - tem1 = 1.0 + rvrdm1 * max(q1(i),1.e-8) - thv1 = t1(i) * prslki(i) * tem1 - tvs_ocn = 0.5 * (tsurf_ocn(i)+tskin_ocn(i)) * tem1 - tvs_lnd = 0.5 * (tsurf_lnd(i)+tskin_lnd(i)) * tem1 - tvs_ice = 0.5 * (tsurf_ice(i)+tskin_ice(i)) * tem1 - qs1 = fpvs(t1(i)) - qs1 = max(1.0e-8, eps * qs1 / (prsl1(i) + epsm1 * qs1)) - - z0_ocn = 0.01 * z0rl_ocn(i) - z0max_ocn = max(1.0e-6, min(z0_ocn,z1(i))) - z0_lnd = 0.01 * z0rl_lnd(i) - z0max_lnd = max(1.0e-6, min(z0_lnd,z1(i))) - z0_ice = 0.01 * z0rl_ice(i) - z0max_ice = max(1.0e-6, min(z0_ice,z1(i))) + virtfac = 1.0 + rvrdm1 * max(q1(i),1.e-8) + thv1 = t1(i) * prslki(i) * virtfac ! compute stability dependent exchange coefficients ! this portion of the code is presently suppressed ! - - if (wet(i) .and. fice(i) < 1.) then ! some open ocean - ustar_ocn(i) = sqrt(grav * z0_ocn / charnock) - -!** test xubin's new z0 - -! ztmax = z0max - - restar = max(ustar_ocn(i)*z0max_ocn*visi, 0.000001) - -! restar = log(restar) -! restar = min(restar,5.) -! restar = max(restar,-5.) -! rat = aa1 + (bb1 + cc1*restar) * restar -! rat = rat / (1. + (bb2 + cc2*restar) * restar)) -! rat taken from zeng, zhao and dickinson 1997 - - rat = min(7.0, 2.67 * sqrt(sqrt(restar)) - 2.57) - ztmax_ocn = z0max_ocn * exp(-rat) - endif ! Open ocean - if (dry(i) .or. icy(i)) then ! over land or sea ice -!** xubin's new z0 over land and sea ice - tem1 = 1.0 - shdmax(i) - tem2 = tem1 * tem1 - tem1 = 1.0 - tem2 + if (dry(i)) then ! Some land +#ifdef GSD_SURFACE_FLUXES_BUGFIX + tvs = 0.5 * (tsurf_lnd(i)+tskin_lnd(i))/prsik1(i) * virtfac +#else + tvs = 0.5 * (tsurf_lnd(i)+tskin_lnd(i)) * virtfac +#endif + z0max = max(1.0e-6, min(0.01 * z0rl_lnd(i), z1(i))) +!** xubin's new z0 over land + tem1 = 1.0 - shdmax(i) + tem2 = tem1 * tem1 + tem1 = 1.0 - tem2 if( ivegsrc == 1 ) then if (vegtype(i) == 10) then - z0max_lnd = exp( tem2*log01 + tem1*log07 ) + z0max = exp( tem2*log01 + tem1*log07 ) elseif (vegtype(i) == 6) then - z0max_lnd = exp( tem2*log01 + tem1*log05 ) + z0max = exp( tem2*log01 + tem1*log05 ) elseif (vegtype(i) == 7) then ! z0max = exp( tem2*log01 + tem1*log01 ) - z0max_lnd = 0.01 + z0max = 0.01 elseif (vegtype(i) == 16) then ! z0max = exp( tem2*log01 + tem1*log01 ) - z0max_lnd = 0.01 + z0max = 0.01 else - z0max_lnd = exp( tem2*log01 + tem1*log(z0max_lnd) ) + z0max = exp( tem2*log01 + tem1*log(z0max) ) endif elseif (ivegsrc == 2 ) then - if (vegtype(i) == 7) then - z0max_lnd = exp( tem2*log01 + tem1*log07 ) - elseif (vegtype(i) == 8) then - z0max_lnd = exp( tem2*log01 + tem1*log05 ) - elseif (vegtype(i) == 9) then -! z0max = exp( tem2*log01 + tem1*log01 ) - z0max_lnd = 0.01 - elseif (vegtype(i) == 11) then -! z0max = exp( tem2*log01 + tem1*log01 ) - z0max_lnd = 0.01 - else - z0max_lnd = exp( tem2*log01 + tem1*log(z0max_lnd) ) - endif - - endif ! over land or sea ice - - z0max_ice = z0max_lnd + if (vegtype(i) == 7) then + z0max = exp( tem2*log01 + tem1*log07 ) + elseif (vegtype(i) == 8) then + z0max = exp( tem2*log01 + tem1*log05 ) + elseif (vegtype(i) == 9) then +! z0max = exp( tem2*log01 + tem1*log01 ) + z0max = 0.01 + elseif (vegtype(i) == 11) then +! z0max = exp( tem2*log01 + tem1*log01 ) + z0max = 0.01 + else + z0max = exp( tem2*log01 + tem1*log(z0max) ) + endif + endif ! mg, sfc-perts: add surface perturbations to z0max over land - if (dry(i) .and. z0pert(i) /= 0.0 ) then - z0max_lnd = z0max_lnd * (10.**z0pert(i)) + if (z0pert(i) /= 0.0 ) then + z0max = z0max * (10.**z0pert(i)) endif - z0max_lnd = max(z0max_lnd,1.0e-6) - z0max_ice = max(z0max_ice,1.0e-6) + z0max = max(z0max, 1.0e-6) ! czilc = 10.0 ** (- (0.40/0.07) * z0) ! fei's canopy height dependance of czil czilc = 0.8 - tem1 = 1.0 - sigmaf(i) - ztmax_lnd = z0max_lnd*exp( - tem1*tem1 + tem1 = 1.0 - sigmaf(i) + ztmax = z0max*exp( - tem1*tem1 & * czilc*ca*sqrt(ustar_lnd(i)*(0.01/1.5e-05))) - ztmax_ice = z0max_ice*exp( - tem1*tem1 - & * czilc*ca*sqrt(ustar_ice(i)*(0.01/1.5e-05))) ! mg, sfc-perts: add surface perturbations to ztmax/z0max ratio over land - if (dry(i) .and. ztpert(i) /= 0.0) then - ztmax_lnd = ztmax_lnd * (10.**ztpert(i)) + if (ztpert(i) /= 0.0) then + ztmax = ztmax * (10.**ztpert(i)) endif + ztmax = max(ztmax, 1.0e-6) +! + call stability +! --- inputs: + & (z1(i), snwdph_lnd(i), thv1, wind(i), + & z0max, ztmax, tvs, grav, +! --- outputs: + & rb_lnd(i), fm_lnd(i), fh_lnd(i), fm10_lnd(i), fh2_lnd(i), + & cm_lnd(i), ch_lnd(i), stress_lnd(i), ustar_lnd(i)) + endif ! Dry points + if (icy(i)) then ! Some ice + tvs = 0.5 * (tsurf_ice(i)+tskin_ice(i)) * virtfac + z0max = max(1.0e-6, min(0.01 * z0rl_ice(i), z1(i))) +!** xubin's new z0 over land and sea ice + tem1 = 1.0 - shdmax(i) + tem2 = tem1 * tem1 + tem1 = 1.0 - tem2 - endif ! end of if(sfctype flags) then + if( ivegsrc == 1 ) then - ztmax_ocn = max(ztmax_ocn,1.0e-6) - ztmax_lnd = max(ztmax_lnd,1.0e-6) - ztmax_ice = max(ztmax_ice,1.0e-6) + z0max = exp( tem2*log01 + tem1*log(z0max) ) + elseif (ivegsrc == 2 ) then + z0max = exp( tem2*log01 + tem1*log(z0max) ) + endif -! BWG begin "stability" block, 2019-03-23 - if (wet(i) .and. fice(i) < 1.) then ! Some open ocean - call stability -! --- inputs: - & (z1(i),snwdph_ocn(i),thv1,wind(i), - & z0max_ocn,ztmax_ocn,tvs_ocn,grav, -! --- outputs: - & rb_ocn(i),fm_ocn(i),fh_ocn(i),fm10_ocn(i),fh2_ocn(i), - & cm_ocn(i),ch_ocn(i),stress_ocn(i),ustar_ocn(i)) - endif ! Open ocean points + z0max = max(z0max, 1.0e-6) - if (dry(i)) then ! Some land - call stability -! --- inputs: - & (z1(i),snwdph_lnd(i),thv1,wind(i), - & z0max_lnd,ztmax_lnd,tvs_lnd,grav, -! --- outputs: - & rb_lnd(i),fm_lnd(i),fh_lnd(i),fm10_lnd(i),fh2_lnd(i), - & cm_lnd(i),ch_lnd(i),stress_lnd(i),ustar_lnd(i)) - endif ! Dry points +! czilc = 10.0 ** (- (0.40/0.07) * z0) ! fei's canopy height +! dependance of czil + czilc = 0.8 - if (icy(i)) then ! Some ice - call stability + tem1 = 1.0 - sigmaf(i) + ztmax = z0max*exp( - tem1*tem1 + & * czilc*ca*sqrt(ustar_ice(i)*(0.01/1.5e-05))) + ztmax = max(ztmax, 1.0e-6) +! + call stability ! --- inputs: - & (z1(i),snwdph_ice(i),thv1,wind(i), - & z0max_ice,ztmax_ice,tvs_ice,grav, + & (z1(i), snwdph_ice(i), thv1, wind(i), + & z0max, ztmax, tvs, grav, ! --- outputs: - & rb_ice(i),fm_ice(i),fh_ice(i),fm10_ice(i),fh2_ice(i), - & cm_ice(i),ch_ice(i),stress_ice(i),ustar_ice(i)) + & rb_ice(i), fm_ice(i), fh_ice(i), fm10_ice(i), fh2_ice(i), + & cm_ice(i), ch_ice(i), stress_ice(i), ustar_ice(i)) endif ! Icy points ! BWG: Everything from here to end of subroutine was after ! the stuff now put into "stability" + if (wet(i)) then ! Some open ocean + tvs = 0.5 * (tsurf_ocn(i)+tskin_ocn(i)) * virtfac + z0 = 0.01 * z0rl_ocn(i) + z0max = max(1.0e-6, min(z0,z1(i))) + ustar_ocn(i) = sqrt(grav * z0 / charnock) + wind10m = sqrt(u10m(i)*u10m(i)+v10m(i)*v10m(i)) + +!** test xubin's new z0 + +! ztmax = z0max + + restar = max(ustar_ocn(i)*z0max*visi, 0.000001) + +! restar = log(restar) +! restar = min(restar,5.) +! restar = max(restar,-5.) +! rat = aa1 + (bb1 + cc1*restar) * restar +! rat = rat / (1. + (bb2 + cc2*restar) * restar)) +! rat taken from zeng, zhao and dickinson 1997 + + rat = min(7.0, 2.67 * sqrt(sqrt(restar)) - 2.57) + ztmax = max(z0max * exp(-rat), 1.0e-6) +! + if (sfc_z0_type == 6) then + call znot_t_v6(wind10m, ztmax) ! 10-m wind,m/s, ztmax(m) + else if (sfc_z0_type == 7) then + call znot_t_v7(wind10m, ztmax) ! 10-m wind,m/s, ztmax(m) + else if (sfc_z0_type > 0) then + write(0,*)'no option for sfc_z0_type=',sfc_z0_type + stop + endif +! + call stability +! --- inputs: + & (z1(i), snwdph_ocn(i), thv1, wind(i), + & z0max, ztmax, tvs, grav, +! --- outputs: + & rb_ocn(i), fm_ocn(i), fh_ocn(i), fm10_ocn(i), fh2_ocn(i), + & cm_ocn(i), ch_ocn(i), stress_ocn(i), ustar_ocn(i)) ! ! update z0 over ocean ! - if (wet(i) .and. fice(i) < 1.) then - z0_ocn = (charnock / grav) * ustar_ocn(i) * ustar_ocn(i) + if (sfc_z0_type >= 0) then + if (sfc_z0_type == 0) then + z0 = (charnock / grav) * ustar_ocn(i) * ustar_ocn(i) ! mbek -- toga-coare flux algorithm -! z0 = (charnock / grav) * ustar(i)*ustar(i) + arnu/ustar(i) +! z0 = (charnock / grav) * ustar(i)*ustar(i) + arnu/ustar(i) ! new implementation of z0 -! cc = ustar(i) * z0 / rnu -! pp = cc / (1. + cc) -! ff = grav * arnu / (charnock * ustar(i) ** 3) -! z0 = arnu / (ustar(i) * ff ** pp) - - if (redrag) then - z0rl_ocn(i) = 100.0 * max(min(z0_ocn, z0s_max), 1.e-7) - else - z0rl_ocn(i) = 100.0 * max(min(z0_ocn,.1), 1.e-7) +! cc = ustar(i) * z0 / rnu +! pp = cc / (1. + cc) +! ff = grav * arnu / (charnock * ustar(i) ** 3) +! z0 = arnu / (ustar(i) * ff ** pp) + + if (redrag) then + z0rl_ocn(i) = 100.0 * max(min(z0, z0s_max), 1.e-7) + else + z0rl_ocn(i) = 100.0 * max(min(z0,.1), 1.e-7) + endif + + elseif (sfc_z0_type == 6) then ! wang + call znot_m_v6(wind10m, z0) ! wind, m/s, z0, m + z0rl_ocn(i) = 100.0 * z0 ! cm + elseif (sfc_z0_type == 7) then ! wang + call znot_m_v7(wind10m, z0) ! wind, m/s, z0, m + z0rl_ocn(i) = 100.0 * z0 ! cm + else + z0rl_ocn(i) = 1.0e-4 + endif + endif endif ! end of if(open ocean) +! endif ! end of if(flagiter) loop enddo @@ -409,8 +363,11 @@ end subroutine sfc_diff_run !---------------------------------------- !>\ingroup GFS_diff_main subroutine stability & - & ( z1, snwdph, thv1, wind, z0max, ztmax, tvs, grav, & ! --- inputs: - & rb, fm, fh, fm10, fh2, cm, ch, stress, ustar) ! --- outputs: +! --- inputs: + & ( z1, snwdph, thv1, wind, z0max, ztmax, tvs, grav, & +! --- outputs: + & rb, fm, fh, fm10, fh2, cm, ch, stress, ustar) +!----- ! --- inputs: real(kind=kind_phys), intent(in) :: & @@ -449,14 +406,19 @@ subroutine stability & dtv = thv1 - tvs adtv = max(abs(dtv),0.001) dtv = sign(1.,dtv) * adtv +#ifdef GSD_SURFACE_FLUXES_BUGFIX + rb = max(-5000.0, grav * dtv * z1 + & / (thv1 * wind * wind)) +#else rb = max(-5000.0, (grav+grav) * dtv * z1 & / ((thv1 + tvs) * wind * wind)) +#endif tem1 = 1.0 / z0max tem2 = 1.0 / ztmax - fm = log((z0max+z1) * tem1) - fh = log((ztmax+z1) * tem2) - fm10 = log((z0max+10.) * tem1) - fh2 = log((ztmax+2.) * tem2) + fm = log((z0max+z1) * tem1) + fh = log((ztmax+z1) * tem2) + fm10 = log((z0max+10.) * tem1) + fh2 = log((ztmax+2.) * tem2) hlinf = rb * fm * fm / fh hlinf = min(max(hlinf,ztmin1),ztmax1) ! @@ -561,5 +523,232 @@ subroutine stability & end subroutine stability !--------------------------------- + +!! add fitted z0,zt curves for hurricane application (used in HWRF/HMON) +!! Weiguo Wang, 2019-0425 + + SUBROUTINE znot_m_v6(uref, znotm) + use machine , only : kind_phys + IMPLICIT NONE +! Calculate areodynamical roughness over water with input 10-m wind +! For low-to-moderate winds, try to match the Cd-U10 relationship from COARE V3.5 (Edson et al. 2013) +! For high winds, try to fit available observational data +! +! Bin Liu, NOAA/NCEP/EMC 2017 +! +! uref(m/s) : wind speed at 10-m height +! znotm(meter): areodynamical roughness scale over water +! + + REAL(kind=kind_phys), INTENT(IN) :: uref + REAL(kind=kind_phys), INTENT(OUT):: znotm + real(kind=kind_phys), parameter :: p13 = -1.296521881682694e-02, + & p12 = 2.855780863283819e-01, p11 = -1.597898515251717e+00, + & p10 = -8.396975715683501e+00, + + & p25 = 3.790846746036765e-10, p24 = 3.281964357650687e-09, + & p23 = 1.962282433562894e-07, p22 = -1.240239171056262e-06, + & p21 = 1.739759082358234e-07, p20 = 2.147264020369413e-05, + + & p35 = 1.840430200185075e-07, p34 = -2.793849676757154e-05, + & p33 = 1.735308193700643e-03, p32 = -6.139315534216305e-02, + & p31 = 1.255457892775006e+00, p30 = -1.663993561652530e+01, + + & p40 = 4.579369142033410e-04 + + + if (uref >= 0.0 .and. uref <= 6.5 ) then + znotm = exp(p10 + uref * (p11 + uref * (p12 + uref*p13))) + elseif (uref > 6.5 .and. uref <= 15.7) then + znotm = p20 + uref * (p21 + uref * (p22 + uref * (p23 + & + uref * (p24 + uref * p25)))) + elseif (uref > 15.7 .and. uref <= 53.0) then + znotm = exp( p30 + uref * (p31 + uref * (p32 + uref * (p33 + & + uref * (p34 + uref * p35))))) + elseif ( uref > 53.0) then + znotm = p40 + else + print*, 'Wrong input uref value:',uref + endif + + END SUBROUTINE znot_m_v6 + + SUBROUTINE znot_t_v6(uref, znott) + use machine , only : kind_phys + IMPLICIT NONE +! Calculate scalar roughness over water with input 10-m wind +! For low-to-moderate winds, try to match the Ck-U10 relationship from COARE algorithm +! For high winds, try to retain the Ck-U10 relationship of FY2015 HWRF +! +! Bin Liu, NOAA/NCEP/EMC 2017 +! +! uref(m/s) : wind speed at 10-m height +! znott(meter): scalar roughness scale over water +! + + REAL(kind=kind_phys), INTENT(IN) :: uref + REAL(kind=kind_phys), INTENT(OUT):: znott + real(kind=kind_phys), parameter :: p00 = 1.100000000000000e-04, + & p15 = -9.144581627678278e-10, p14 = 7.020346616456421e-08, + & p13 = -2.155602086883837e-06, p12 = 3.333848806567684e-05, + & p11 = -2.628501274963990e-04, p10 = 8.634221567969181e-04, + + & p25 = -8.654513012535990e-12, p24 = 1.232380050058077e-09, + & p23 = -6.837922749505057e-08, p22 = 1.871407733439947e-06, + & p21 = -2.552246987137160e-05, p20 = 1.428968311457630e-04, + + & p35 = 3.207515102100162e-12, p34 = -2.945761895342535e-10, + & p33 = 8.788972147364181e-09, p32 = -3.814457439412957e-08, + & p31 = -2.448983648874671e-06, p30 = 3.436721779020359e-05, + + & p45 = -3.530687797132211e-11, p44 = 3.939867958963747e-09, + & p43 = -1.227668406985956e-08, p42 = -1.367469811838390e-05, + & p41 = 5.988240863928883e-04, p40 = -7.746288511324971e-03, + + & p56 = -1.187982453329086e-13, p55 = 4.801984186231693e-11, + & p54 = -8.049200462388188e-09, p53 = 7.169872601310186e-07, + & p52 = -3.581694433758150e-05, p51 = 9.503919224192534e-04, + & p50 = -1.036679430885215e-02, + + & p60 = 4.751256171799112e-05 + + if (uref >= 0.0 .and. uref < 5.9 ) then + znott = p00 + elseif (uref >= 5.9 .and. uref <= 15.4) then + znott = p10 + uref * (p11 + uref * (p12 + uref * (p13 + & + uref * (p14 + uref * p15)))) + elseif (uref > 15.4 .and. uref <= 21.6) then + znott = p20 + uref * (p21 + uref * (p22 + uref * (p23 + & + uref * (p24 + uref * p25)))) + elseif (uref > 21.6 .and. uref <= 42.2) then + znott = p30 + uref * (p31 + uref * (p32 + uref * (p33 + & + uref * (p34 + uref * p35)))) + elseif ( uref > 42.2 .and. uref <= 53.3) then + znott = p40 + uref * (p41 + uref * (p42 + uref * (p43 + & + uref * (p44 + uref * p45)))) + elseif ( uref > 53.3 .and. uref <= 80.0) then + znott = p50 + uref * (p51 + uref * (p52 + uref * (p53 + & + uref * (p54 + uref * (p55 + uref * p56))))) + elseif ( uref > 80.0) then + znott = p60 + else + print*, 'Wrong input uref value:',uref + endif + + END SUBROUTINE znot_t_v6 + + + SUBROUTINE znot_m_v7(uref, znotm) + use machine , only : kind_phys + IMPLICIT NONE +! Calculate areodynamical roughness over water with input 10-m wind +! For low-to-moderate winds, try to match the Cd-U10 relationship from COARE V3.5 (Edson et al. 2013) +! For high winds, try to fit available observational data +! Comparing to znot_t_v6, slightly decrease Cd for higher wind speed +! +! Bin Liu, NOAA/NCEP/EMC 2018 +! +! uref(m/s) : wind speed at 10-m height +! znotm(meter): areodynamical roughness scale over water +! + + REAL(kind=kind_phys), INTENT(IN) :: uref + REAL(kind=kind_phys), INTENT(OUT):: znotm + + real(kind=kind_phys), parameter :: p13 = -1.296521881682694e-02, + & p12 = 2.855780863283819e-01, p11 = -1.597898515251717e+00, + & p10 = -8.396975715683501e+00, + + & p25 = 3.790846746036765e-10, p24 = 3.281964357650687e-09, + & p23 = 1.962282433562894e-07, p22 = -1.240239171056262e-06, + & p21 = 1.739759082358234e-07, p20 = 2.147264020369413e-05, + + & p35 = 1.897534489606422e-07, p34 = -3.019495980684978e-05, + & p33 = 1.931392924987349e-03, p32 = -6.797293095862357e-02, + & p31 = 1.346757797103756e+00, p30 = -1.707846930193362e+01, + + & p40 = 3.371427455376717e-04 + + if (uref >= 0.0 .and. uref <= 6.5 ) then + znotm = exp( p10 + uref * (p11 + uref * (p12 + uref * p13))) + elseif (uref > 6.5 .and. uref <= 15.7) then + znotm = p20 + uref * (p21 + uref * (p22 + uref * (p23 + & + uref * (p24 + uref * p25)))) + elseif (uref > 15.7 .and. uref <= 53.0) then + znotm = exp( p30 + uref * (p31 + uref * (p32 + uref * (p33 + & + uref * (p34 + uref * p35))))) + elseif ( uref > 53.0) then + znotm = p40 + else + print*, 'Wrong input uref value:',uref + endif + + END SUBROUTINE znot_m_v7 + SUBROUTINE znot_t_v7(uref, znott) + use machine , only : kind_phys + IMPLICIT NONE +! Calculate scalar roughness over water with input 10-m wind +! For low-to-moderate winds, try to match the Ck-U10 relationship from COARE algorithm +! For high winds, try to retain the Ck-U10 relationship of FY2015 HWRF +! To be compatible with the slightly decreased Cd for higher wind speed +! +! Bin Liu, NOAA/NCEP/EMC 2018 +! +! uref(m/s) : wind speed at 10-m height +! znott(meter): scalar roughness scale over water +! + + REAL(kind=kind_phys), INTENT(IN) :: uref + REAL(kind=kind_phys), INTENT(OUT):: znott + + real(kind=kind_phys), parameter :: p00 = 1.100000000000000e-04, + + & p15 = -9.193764479895316e-10, p14 = 7.052217518653943e-08, + & p13 = -2.163419217747114e-06, p12 = 3.342963077911962e-05, + & p11 = -2.633566691328004e-04, p10 = 8.644979973037803e-04, + + & p25 = -9.402722450219142e-12, p24 = 1.325396583616614e-09, + & p23 = -7.299148051141852e-08, p22 = 1.982901461144764e-06, + & p21 = -2.680293455916390e-05, p20 = 1.484341646128200e-04, + + & p35 = 7.921446674311864e-12, p34 = -1.019028029546602e-09, + & p33 = 5.251986927351103e-08, p32 = -1.337841892062716e-06, + & p31 = 1.659454106237737e-05, p30 = -7.558911792344770e-05, + + & p45 = -2.694370426850801e-10, p44 = 5.817362913967911e-08, + & p43 = -5.000813324746342e-06, p42 = 2.143803523428029e-04, + & p41 = -4.588070983722060e-03, p40 = 3.924356617245624e-02, + + & p56 = -1.663918773476178e-13, p55 = 6.724854483077447e-11, + & p54 = -1.127030176632823e-08, p53 = 1.003683177025925e-06, + & p52 = -5.012618091180904e-05, p51 = 1.329762020689302e-03, + & p50 = -1.450062148367566e-02, p60 = 6.840803042788488e-05 + + if (uref >= 0.0 .and. uref < 5.9 ) then + znott = p00 + elseif (uref >= 5.9 .and. uref <= 15.4) then + znott = p10 + uref * (p11 + uref * (p12 + uref * (p13 + & + uref * (p14 + uref * p15)))) + elseif (uref > 15.4 .and. uref <= 21.6) then + znott = p20 + uref * (p21 + uref * (p22 + uref * (p23 + & + uref * (p24 + uref * p25)))) + elseif (uref > 21.6 .and. uref <= 42.6) then + znott = p30 + uref * (p31 + uref * (p32 + uref * (p33 + & + uref * (p34 + uref * p35)))) + elseif ( uref > 42.6 .and. uref <= 53.0) then + znott = p40 + uref * (p41 + uref * (p42 + uref * (p43 + & + uref * (p44 + uref * p45)))) + elseif ( uref > 53.0 .and. uref <= 80.0) then + znott = p50 + uref * (p51 + uref * (p52 + uref * (p53 + & + uref * (p54 + uref * (p55 + uref * p56))))) + elseif ( uref > 80.0) then + znott = p60 + else + print*, 'Wrong input uref value:',uref + endif + + END SUBROUTINE znot_t_v7 + + !--------------------------------- end module sfc_diff diff --git a/physics/sfc_diff.meta b/physics/sfc_diff.meta new file mode 100644 index 000000000..232b0050f --- /dev/null +++ b/physics/sfc_diff.meta @@ -0,0 +1,614 @@ +[ccpp-arg-table] + name = sfc_diff_run + type = scheme +[im] + standard_name = horizontal_loop_extent + long_name = horizontal loop extent + units = count + dimensions = () + type = integer + intent = in + optional = F +[rvrdm1] + standard_name = ratio_of_vapor_to_dry_air_gas_constants_minus_one + long_name = (rv/rd) - 1 (rv = ideal gas constant for water vapor) + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[eps] + standard_name = ratio_of_dry_air_to_water_vapor_gas_constants + long_name = rd/rv + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[epsm1] + standard_name = ratio_of_dry_air_to_water_vapor_gas_constants_minus_one + long_name = (rd/rv) - 1 + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[grav] + standard_name = gravitational_acceleration + long_name = gravitational acceleration + units = m s-2 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[ps] + standard_name = surface_air_pressure + long_name = surface pressure + units = Pa + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[t1] + standard_name = air_temperature_at_lowest_model_layer + long_name = 1st model layer air temperature + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[q1] + standard_name = water_vapor_specific_humidity_at_lowest_model_layer + long_name = 1st model layer specific humidity + units = kg kg-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[z1] + standard_name = height_above_ground_at_lowest_model_layer + long_name = height above ground at 1st model layer + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[wind] + standard_name = wind_speed_at_lowest_model_layer + long_name = wind speed at lowest model level + units = m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[prsl1] + standard_name = air_pressure_at_lowest_model_layer + long_name = Model layer 1 mean pressure + units = Pa + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[prslki] + standard_name = ratio_of_exner_function_between_midlayer_and_interface_at_lowest_model_layer + long_name = Exner function ratio bt midlayer and interface at 1st layer + units = ratio + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[prsik1] + standard_name = dimensionless_exner_function_at_lowest_model_interface + long_name = dimensionless Exner function at the ground surface + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[prslk1] + standard_name = dimensionless_exner_function_at_lowest_model_layer + long_name = dimensionless Exner function at the lowest model layer + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[sigmaf] + standard_name = bounded_vegetation_area_fraction + long_name = areal fractional cover of green vegetation bounded on the bottom + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[vegtype] + standard_name = vegetation_type_classification + long_name = vegetation type at each grid cell + units = index + dimensions = (horizontal_dimension) + type = integer + intent = in + optional = F +[shdmax] + standard_name = maximum_vegetation_area_fraction + long_name = max fractnl cover of green veg + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[ivegsrc] + standard_name = vegetation_type_dataset_choice + long_name = land use dataset choice + units = index + dimensions = () + type = integer + intent = in + optional = F +[z0pert] + standard_name = perturbation_of_momentum_roughness_length + long_name = perturbation of momentum roughness length + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[ztpert] + standard_name = perturbation_of_heat_to_momentum_roughness_length_ratio + long_name = perturbation of heat to momentum roughness length ratio + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[flag_iter] + standard_name = flag_for_iteration + long_name = flag for iteration + units = flag + dimensions = (horizontal_dimension) + type = logical + intent = in + optional = F +[redrag] + standard_name = flag_for_reduced_drag_coefficient_over_sea + long_name = flag for reduced drag coefficient over sea + units = flag + dimensions = () + type = logical + intent = in + optional = F +[u10m] + standard_name = x_wind_at_10m + long_name = 10 meter u wind speed + units = m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[v10m] + standard_name = y_wind_at_10m + long_name = 10 meter v wind speed + units = m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[sfc_z0_type] + standard_name = flag_for_surface_roughness_option_over_ocean + long_name = surface roughness options over ocean + units = flag + dimensions = () + type = integer + intent = in + optional = F +[wet] + standard_name = flag_nonzero_wet_surface_fraction + long_name = flag indicating presence of some ocean or lake surface area fraction + units = flag + dimensions = (horizontal_dimension) + type = logical + intent = in + optional = F +[dry] + standard_name = flag_nonzero_land_surface_fraction + long_name = flag indicating presence of some land surface area fraction + units = flag + dimensions = (horizontal_dimension) + type = logical + intent = in + optional = F +[icy] + standard_name = flag_nonzero_sea_ice_surface_fraction + long_name = flag indicating presence of some sea ice surface area fraction + units = flag + dimensions = (horizontal_dimension) + type = logical + intent = in + optional = F +[tskin_ocn] + standard_name = surface_skin_temperature_over_ocean_interstitial + long_name = surface skin temperature over ocean (temporary use as interstitial) + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[tskin_lnd] + standard_name = surface_skin_temperature_over_land_interstitial + long_name = surface skin temperature over land (temporary use as interstitial) + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[tskin_ice] + standard_name = surface_skin_temperature_over_ice_interstitial + long_name = surface skin temperature over ice (temporary use as interstitial) + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[tsurf_ocn] + standard_name = surface_skin_temperature_after_iteration_over_ocean + long_name = surface skin temperature after iteration over ocean + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[tsurf_lnd] + standard_name = surface_skin_temperature_after_iteration_over_land + long_name = surface skin temperature after iteration over land + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[tsurf_ice] + standard_name = surface_skin_temperature_after_iteration_over_ice + long_name = surface skin temperature after iteration over ice + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[snwdph_ocn] + standard_name = surface_snow_thickness_water_equivalent_over_ocean + long_name = water equivalent snow depth over ocean + units = mm + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[snwdph_lnd] + standard_name = surface_snow_thickness_water_equivalent_over_land + long_name = water equivalent snow depth over land + units = mm + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[snwdph_ice] + standard_name = surface_snow_thickness_water_equivalent_over_ice + long_name = water equivalent snow depth over ice + units = mm + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[z0rl_ocn] + standard_name = surface_roughness_length_over_ocean_interstitial + long_name = surface roughness length over ocean (temporary use as interstitial) + units = cm + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[z0rl_lnd] + standard_name = surface_roughness_length_over_land_interstitial + long_name = surface roughness length over land (temporary use as interstitial) + units = cm + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[z0rl_ice] + standard_name = surface_roughness_length_over_ice_interstitial + long_name = surface roughness length over ice (temporary use as interstitial) + units = cm + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[ustar_ocn] + standard_name = surface_friction_velocity_over_ocean + long_name = surface friction velocity over ocean + units = m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[ustar_lnd] + standard_name = surface_friction_velocity_over_land + long_name = surface friction velocity over land + units = m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[ustar_ice] + standard_name = surface_friction_velocity_over_ice + long_name = surface friction velocity over ice + units = m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[cm_ocn] + standard_name = surface_drag_coefficient_for_momentum_in_air_over_ocean + long_name = surface exchange coeff for momentum over ocean + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[cm_lnd] + standard_name = surface_drag_coefficient_for_momentum_in_air_over_land + long_name = surface exchange coeff for momentum over land + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[cm_ice] + standard_name = surface_drag_coefficient_for_momentum_in_air_over_ice + long_name = surface exchange coeff for momentum over ice + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[ch_ocn] + standard_name = surface_drag_coefficient_for_heat_and_moisture_in_air_over_ocean + long_name = surface exchange coeff heat & moisture over ocean + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[ch_lnd] + standard_name = surface_drag_coefficient_for_heat_and_moisture_in_air_over_land + long_name = surface exchange coeff heat & moisture over land + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[ch_ice] + standard_name = surface_drag_coefficient_for_heat_and_moisture_in_air_over_ice + long_name = surface exchange coeff heat & moisture over ice + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[rb_ocn] + standard_name = bulk_richardson_number_at_lowest_model_level_over_ocean + long_name = bulk Richardson number at the surface over ocean + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[rb_lnd] + 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_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[rb_ice] + standard_name = bulk_richardson_number_at_lowest_model_level_over_ice + long_name = bulk Richardson number at the surface over ice + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[stress_ocn] + standard_name = surface_wind_stress_over_ocean + long_name = surface wind stress over ocean + units = m2 s-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[stress_lnd] + standard_name = surface_wind_stress_over_land + long_name = surface wind stress over land + units = m2 s-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[stress_ice] + standard_name = surface_wind_stress_over_ice + long_name = surface wind stress over ice + units = m2 s-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[fm_ocn] + standard_name = Monin_Obukhov_similarity_function_for_momentum_over_ocean + long_name = Monin-Obukhov similarity function for momentum over ocean + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[fm_lnd] + standard_name = Monin_Obukhov_similarity_function_for_momentum_over_land + long_name = Monin-Obukhov similarity function for momentum over land + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[fm_ice] + standard_name = Monin_Obukhov_similarity_function_for_momentum_over_ice + long_name = Monin-Obukhov similarity function for momentum over ice + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[fh_ocn] + standard_name = Monin_Obukhov_similarity_function_for_heat_over_ocean + long_name = Monin-Obukhov similarity function for heat over ocean + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[fh_lnd] + standard_name = Monin_Obukhov_similarity_function_for_heat_over_land + long_name = Monin-Obukhov similarity function for heat over land + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[fh_ice] + standard_name = Monin_Obukhov_similarity_function_for_heat_over_ice + long_name = Monin-Obukhov similarity function for heat over ice + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[fm10_ocn] + standard_name = Monin_Obukhov_similarity_function_for_momentum_at_10m_over_ocean + long_name = Monin-Obukhov similarity parameter for momentum at 10m over ocean + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[fm10_lnd] + 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_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[fm10_ice] + standard_name = Monin_Obukhov_similarity_function_for_momentum_at_10m_over_ice + long_name = Monin-Obukhov similarity parameter for momentum at 10m over ice + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[fh2_ocn] + standard_name = Monin_Obukhov_similarity_function_for_heat_at_2m_over_ocean + long_name = Monin-Obukhov similarity parameter for heat at 2m over ocean + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[fh2_lnd] + 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_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[fh2_ice] + standard_name = Monin_Obukhov_similarity_function_for_heat_at_2m_over_ice + long_name = Monin-Obukhov similarity parameter for heat at 2m over ice + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F diff --git a/physics/sfc_drv.f b/physics/sfc_drv.f index 51ed2fe98..75afaa6ff 100644 --- a/physics/sfc_drv.f +++ b/physics/sfc_drv.f @@ -17,14 +17,7 @@ module lsm_noah !>\ingroup Noah_LSM !! This subroutine contains the CCPP-compliant lsm_noah_init to initialize soil vegetation. !! \section arg_table_lsm_noah_init Argument Table -!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | -!! |----------------|-------------------------------------------------------------|---------------------------------------------------------|------------|------|-----------|-----------|--------|----------| -!! | me | mpi_rank | current MPI-rank | index | 0 | integer | | in | F | -!! | isot | soil_type_dataset_choice | soil type dataset choice | index | 0 | integer | | in | F | -!! | ivegsrc | vegetation_type_dataset_choice | land use dataset choice | index | 0 | integer | | in | F | -!! | nlunit | iounit_namelist | fortran unit number for file opens | none | 0 | integer | | in | F | -!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | -!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | +!! \htmlinclude lsm_noah_init.html !! subroutine lsm_noah_init(me, isot, ivegsrc, nlunit, & errmsg, errflg) @@ -46,10 +39,7 @@ end subroutine lsm_noah_init !! \section arg_table_lsm_noah_finalize Argument Table -!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | -!! |----------------|-------------------------------------------------------------|--------------------------------------------|------------|------|-----------|-----------|--------|----------| -!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | -!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | +!! \htmlinclude lsm_noah_finalize.html !! subroutine lsm_noah_finalize(errmsg, errflg) @@ -72,9 +62,9 @@ end subroutine lsm_noah_finalize ! ! ! call sfc_drv ! ! --- inputs: ! -! ( im, km, ps, u1, v1, t1, q1, soiltyp, vegtype, sigmaf, ! +! ( im, km, ps, t1, q1, soiltyp, vegtype, sigmaf, ! ! sfcemis, dlwflx, dswsfc, snet, delt, tg3, cm, ch, ! -! prsl1, prslki, zf, land, ddvel, slopetyp, ! +! prsl1, prslki, zf, land, wind, slopetyp, ! ! shdmin, shdmax, snoalb, sfalb, flag_iter, flag_guess, ! ! lheatstrg, isot, ivegsrc, ! ! --- in/outs: ! @@ -104,7 +94,6 @@ end subroutine lsm_noah_finalize ! im - integer, horiz dimention and num of used pts 1 ! ! km - integer, vertical soil layer dimension 1 ! ! ps - real, surface pressure (pa) im ! -! u1, v1 - real, u/v component of surface layer wind im ! ! t1 - real, surface layer mean temperature (k) im ! ! q1 - real, surface layer mean specific humidity im ! ! soiltyp - integer, soil type (integer index) im ! @@ -122,7 +111,7 @@ end subroutine lsm_noah_finalize ! prslki - real, dimensionless exner function at layer 1 im ! ! zf - real, height of bottom layer (m) im ! ! land - logical, = T if a point with any land im ! -! ddvel - real, im ! +! wind - real, wind speed (m/s) im ! ! slopetyp - integer, class of sfc slope (integer index) im ! ! shdmin - real, min fractional coverage of green veg im ! ! shdmax - real, max fractnl cover of green veg (not used) im ! @@ -176,93 +165,15 @@ end subroutine lsm_noah_finalize !! variables for return to the parent model suite including unit conversion, as well !! as diagnotics calculation. !! \section arg_table_lsm_noah_run Argument Table -!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | -!! |----------------|------------------------------------------------------------------------------|-----------------------------------------------------------------|---------------|------|-----------|-----------|--------|----------| -!! | im | horizontal_loop_extent | horizontal loop extent | count | 0 | integer | | in | F | -!! | km | soil_vertical_dimension | soil vertical layer dimension | count | 0 | integer | | in | F | -!! | grav | gravitational_acceleration | gravitational acceleration | m s-2 | 0 | real | kind_phys | in | F | -!! | cp | specific_heat_of_dry_air_at_constant_pressure | specific heat of dry air at constant pressure | J kg-1 K-1 | 0 | real | kind_phys | in | F | -!! | hvap | latent_heat_of_vaporization_of_water_at_0C | latent heat of evaporation/sublimation | J kg-1 | 0 | real | kind_phys | in | F | -!! | rd | gas_constant_dry_air | ideal gas constant for dry air | J kg-1 K-1 | 0 | real | kind_phys | in | F | -!! | eps | ratio_of_dry_air_to_water_vapor_gas_constants | rd/rv | none | 0 | real | kind_phys | in | F | -!! | epsm1 | ratio_of_dry_air_to_water_vapor_gas_constants_minus_one | (rd/rv) - 1 | none | 0 | real | kind_phys | in | F | -!! | rvrdm1 | ratio_of_vapor_to_dry_air_gas_constants_minus_one | (rv/rd) - 1 (rv = ideal gas constant for water vapor) | none | 0 | real | kind_phys | in | F | -!! | ps | surface_air_pressure | surface pressure | Pa | 1 | real | kind_phys | in | F | -!! | u1 | x_wind_at_lowest_model_layer | x component of 1st model layer wind | m s-1 | 1 | real | kind_phys | in | F | -!! | v1 | y_wind_at_lowest_model_layer | y component of 1st model layer wind | m s-1 | 1 | real | kind_phys | in | F | -!! | t1 | air_temperature_at_lowest_model_layer | 1st model layer air temperature | K | 1 | real | kind_phys | in | F | -!! | q1 | water_vapor_specific_humidity_at_lowest_model_layer | 1st model layer specific humidity | kg kg-1 | 1 | real | kind_phys | in | F | -!! | soiltyp | soil_type_classification | soil type at each grid cell | index | 1 | integer | | in | F | -!! | vegtype | vegetation_type_classification | vegetation type at each grid cell | index | 1 | integer | | in | F | -!! | sigmaf | bounded_vegetation_area_fraction | areal fractional cover of green vegetation bounded on the bottom| frac | 1 | real | kind_phys | in | F | -!! | sfcemis | surface_longwave_emissivity | surface longwave emissivity | frac | 1 | real | kind_phys | in | F | -!! | dlwflx | surface_downwelling_longwave_flux_absorbed_by_ground | total sky surface downward longwave flux absorbed by the ground | W m-2 | 1 | real | kind_phys | in | F | -!! | dswsfc | surface_downwelling_shortwave_flux | total sky surface downward shortwave flux | W m-2 | 1 | real | kind_phys | in | F | -!! | snet | surface_net_downwelling_shortwave_flux | total sky surface net shortwave flux | W m-2 | 1 | real | kind_phys | in | F | -!! | delt | time_step_for_dynamics | dynamics time step | s | 0 | real | kind_phys | in | F | -!! | tg3 | deep_soil_temperature | bottom soil temperature | K | 1 | real | kind_phys | in | F | -!! | cm | surface_drag_coefficient_for_momentum_in_air_over_land | surface exchange coeff for momentum over land | none | 1 | real | kind_phys | in | F | -!! | ch | surface_drag_coefficient_for_heat_and_moisture_in_air_over_land | surface exchange coeff heat & moisture over land | none | 1 | real | kind_phys | in | F | -!! | prsl1 | air_pressure_at_lowest_model_layer | Model layer 1 mean pressure | Pa | 1 | real | kind_phys | in | F | -!! | prslki | ratio_of_exner_function_between_midlayer_and_interface_at_lowest_model_layer | Exner function ratio bt midlayer and interface at 1st layer | ratio | 1 | real | kind_phys | in | F | -!! | zf | height_above_ground_at_lowest_model_layer | height above ground at 1st model layer | m | 1 | real | kind_phys | in | F | -!! | land | flag_nonzero_land_surface_fraction | flag indicating presence of some land surface area fraction | flag | 1 | logical | | in | F | -!! | ddvel | surface_wind_enhancement_due_to_convection | surface wind enhancement due to convection | m s-1 | 1 | real | kind_phys | in | F | -!! | slopetyp | surface_slope_classification | surface slope type at each grid cell | index | 1 | integer | | in | F | -!! | shdmin | minimum_vegetation_area_fraction | min fractional coverage of green veg | frac | 1 | real | kind_phys | in | F | -!! | shdmax | maximum_vegetation_area_fraction | max fractnl cover of green veg (not used) | frac | 1 | real | kind_phys | in | F | -!! | snoalb | upper_bound_on_max_albedo_over_deep_snow | upper bound on max albedo over deep snow | frac | 1 | real | kind_phys | in | F | -!! | sfalb | surface_diffused_shortwave_albedo | mean surface diffused shortwave albedo | frac | 1 | real | kind_phys | in | F | -!! | flag_iter | flag_for_iteration | flag for iteration | flag | 1 | logical | | in | F | -!! | flag_guess | flag_for_guess_run | flag for guess run | flag | 1 | logical | | in | F | -!! | lheatstrg | flag_for_canopy_heat_storage | flag for canopy heat storage parameterization | flag | 0 | logical | | in | F | -!! | isot | soil_type_dataset_choice | soil type dataset choice | index | 0 | integer | | in | F | -!! | ivegsrc | vegetation_type_dataset_choice | land use dataset choice | index | 0 | integer | | in | F | -!! | bexppert | perturbation_of_soil_type_b_parameter | perturbation of soil type "b" parameter | frac | 1 | real | kind_phys | in | F | -!! | xlaipert | perturbation_of_leaf_area_index | perturbation of leaf area index | frac | 1 | real | kind_phys | in | F | -!! | vegfpert | perturbation_of_vegetation_fraction | perturbation of vegetation fraction | frac | 1 | real | kind_phys | in | F | -!! | pertvegf | magnitude_of_perturbation_of_vegetation_fraction | magnitude of perturbation of vegetation fraction | frac | 1 | real | kind_phys | in | F | -!! | weasd | water_equivalent_accumulated_snow_depth_over_land | water equiv of acc snow depth over land | mm | 1 | real | kind_phys | inout | F | -!! | snwdph | surface_snow_thickness_water_equivalent_over_land | water equivalent snow depth over land | mm | 1 | real | kind_phys | inout | F | -!! | tskin | surface_skin_temperature_over_land_interstitial | surface skin temperature over land (temporary use as interstitial) | K | 1 | real | kind_phys | inout | F | -!! | tprcp | nonnegative_lwe_thickness_of_precipitation_amount_on_dynamics_timestep_over_land | total precipitation amount in each time step over land | m | 1 | real | kind_phys | inout | F | -!! | srflag | flag_for_precipitation_type | flag for snow or rain precipitation | flag | 1 | real | kind_phys | inout | F | -!! | smc | volume_fraction_of_soil_moisture | volumetric fraction of soil moisture | frac | 2 | real | kind_phys | inout | F | -!! | stc | soil_temperature | soil temperature | K | 2 | real | kind_phys | inout | F | -!! | slc | volume_fraction_of_unfrozen_soil_moisture | volume fraction of unfrozen soil moisture | frac | 2 | real | kind_phys | inout | F | -!! | canopy | canopy_water_amount | canopy moisture content | kg m-2 | 1 | real | kind_phys | inout | F | -!! | trans | transpiration_flux | total plant transpiration rate | kg m-2 s-1 | 1 | real | kind_phys | inout | F | -!! | tsurf | surface_skin_temperature_after_iteration_over_land | surface skin temperature after iteration over land | K | 1 | real | kind_phys | inout | F | -!! | zorl | surface_roughness_length_over_land_interstitial | surface roughness length over land (temporary use as interstitial) | cm | 1 | real | kind_phys | inout | F | -!! | sncovr1 | surface_snow_area_fraction_over_land | surface snow area fraction | frac | 1 | real | kind_phys | inout | F | -!! | qsurf | surface_specific_humidity_over_land | surface air saturation specific humidity over land | kg kg-1 | 1 | real | kind_phys | inout | F | -!! | gflux | upward_heat_flux_in_soil_over_land | soil heat flux over land | W m-2 | 1 | real | kind_phys | inout | F | -!! | drain | subsurface_runoff_flux | subsurface runoff flux | g m-2 s-1 | 1 | real | kind_phys | inout | F | -!! | evap | kinematic_surface_upward_latent_heat_flux_over_land | kinematic surface upward latent heat flux over land | kg kg-1 m s-1 | 1 | real | kind_phys | inout | F | -!! | hflx | kinematic_surface_upward_sensible_heat_flux_over_land | kinematic surface upward sensible heat flux over land | K m s-1 | 1 | real | kind_phys | inout | F | -!! | ep | surface_upward_potential_latent_heat_flux_over_land | surface upward potential latent heat flux over land | W m-2 | 1 | real | kind_phys | inout | F | -!! | runoff | surface_runoff_flux | surface runoff flux | g m-2 s-1 | 1 | real | kind_phys | inout | F | -!! | cmm | surface_drag_wind_speed_for_momentum_in_air_over_land | momentum exchange coefficient over land | m s-1 | 1 | real | kind_phys | inout | F | -!! | chh | surface_drag_mass_flux_for_heat_and_moisture_in_air_over_land | thermal exchange coefficient over land | kg m-2 s-1 | 1 | real | kind_phys | inout | F | -!! | evbs | soil_upward_latent_heat_flux | soil upward latent heat flux | W m-2 | 1 | real | kind_phys | inout | F | -!! | evcw | canopy_upward_latent_heat_flux | canopy upward latent heat flux | W m-2 | 1 | real | kind_phys | inout | F | -!! | sbsno | snow_deposition_sublimation_upward_latent_heat_flux | latent heat flux from snow depo/subl | W m-2 | 1 | real | kind_phys | inout | F | -!! | snowc | surface_snow_area_fraction | surface snow area fraction | frac | 1 | real | kind_phys | inout | F | -!! | stm | soil_moisture_content | soil moisture content | kg m-2 | 1 | real | kind_phys | inout | F | -!! | snohf | snow_freezing_rain_upward_latent_heat_flux | latent heat flux due to snow and frz rain | W m-2 | 1 | real | kind_phys | inout | F | -!! | smcwlt2 | volume_fraction_of_condensed_water_in_soil_at_wilting_point | soil water fraction at wilting point | frac | 1 | real | kind_phys | inout | F | -!! | smcref2 | threshold_volume_fraction_of_condensed_water_in_soil | soil moisture threshold | frac | 1 | real | kind_phys | inout | F | -!! | wet1 | normalized_soil_wetness | normalized soil wetness | frac | 1 | real | kind_phys | inout | F | -!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | -!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | +!! \htmlinclude lsm_noah_run.html !! !> \section general_noah_drv GFS sfc_drv General Algorithm !> @{ subroutine lsm_noah_run & - & ( im, km, grav, cp, hvap, rd, eps, epsm1, rvrdm1, ps, u1, & ! --- inputs: - & v1, t1, q1, soiltyp, vegtype, sigmaf, & + & ( im, km, grav, cp, hvap, rd, eps, epsm1, rvrdm1, ps, & ! --- inputs: + & t1, q1, soiltyp, vegtype, sigmaf, & & sfcemis, dlwflx, dswsfc, snet, delt, tg3, cm, ch, & - & prsl1, prslki, zf, land, ddvel, slopetyp, & + & prsl1, prslki, zf, land, wind, slopetyp, & & shdmin, shdmax, snoalb, sfalb, flag_iter, flag_guess, & & lheatstrg, isot, ivegsrc, & & bexppert, xlaipert, vegfpert,pertvegf, & ! sfc perts, mgehne @@ -300,9 +211,9 @@ subroutine lsm_noah_run & integer, dimension(im), intent(in) :: soiltyp, vegtype, slopetyp - real (kind=kind_phys), dimension(im), intent(in) :: ps, u1, v1, & + real (kind=kind_phys), dimension(im), intent(in) :: ps, & & t1, q1, sigmaf, sfcemis, dlwflx, dswsfc, snet, tg3, cm, & - & ch, prsl1, prslki, ddvel, shdmin, shdmax, & + & ch, prsl1, prslki, wind, shdmin, shdmax, & & snoalb, sfalb, zf, & & bexppert, xlaipert, vegfpert @@ -330,7 +241,7 @@ subroutine lsm_noah_run & ! --- locals: real (kind=kind_phys), dimension(im) :: rch, rho, & - & q0, qs1, theta1, wind, weasd_old, snwdph_old, & + & q0, qs1, theta1, weasd_old, snwdph_old, & & tprcp_old, srflag_old, tskin_old, canopy_old real (kind=kind_phys), dimension(km) :: et, sldpth, stsoil, & @@ -407,9 +318,6 @@ subroutine lsm_noah_run & do i = 1, im if (flag_iter(i) .and. land(i)) then - wind(i) = max(sqrt( u1(i)*u1(i) + v1(i)*v1(i) ) & - & + max(0.0, min(ddvel(i), 30.0)), 1.0) - q0(i) = max(q1(i), 1.e-8) !* q1=specific humidity at level 1 (kg/kg) theta1(i) = t1(i) * prslki(i) !* adiabatic temp at level 1 (k) @@ -514,13 +422,12 @@ subroutine lsm_noah_run & !! 0.5 and the perturbations go to zero as vegetation fraction approaches its upper !! or lower bound. vegfp = vegfpert(i) ! sfc-perts, mgehne - ! sfc perts, mgehne if (pertvegf(1)>0.0) then ! compute beta distribution parameters for vegetation fraction mv = shdfac sv = pertvegf(1)*mv*(1.-mv) - alphav = mv*mv*(1.-mv)/(sv*sv)-mv - betav = alphav*(1.-mv)/mv + alphav = mv*mv*(1.0-mv)/(sv*sv)-mv + betav = alphav*(1.0-mv)/mv ! compute beta distribution value corresponding ! to the given percentile albPpert to use as new albedo call ppfbet(vegfp,alphav,betav,iflag,vegftmp) @@ -615,7 +522,7 @@ subroutine lsm_noah_run & trans(i) = ett sbsno(i) = esnow snowc(i) = sncovr - stm(i) = soilm + stm(i) = soilm * 1000.0 ! unit conversion (from m to kg m-2) snohf(i) = flx1 + flx2 + flx3 smcwlt2(i) = smcwlt @@ -631,7 +538,7 @@ subroutine lsm_noah_run & enddo wet1(i) = smsoil(1) / smcmax !Sarah Lu added 09/09/2010 (for GOCART) -! --- ... unit conversion (from m s-1 to mm s-1) +! --- ... unit conversion (from m s-1 to mm s-1 and kg m-2 s-1) runoff(i) = runoff1 * 1000.0 drain (i) = runoff2 * 1000.0 diff --git a/physics/sfc_drv.meta b/physics/sfc_drv.meta new file mode 100644 index 000000000..7728ee375 --- /dev/null +++ b/physics/sfc_drv.meta @@ -0,0 +1,742 @@ +[ccpp-arg-table] + name = lsm_noah_init + type = scheme +[me] + standard_name = mpi_rank + long_name = current MPI-rank + units = index + dimensions = () + type = integer + intent = in + optional = F +[isot] + standard_name = soil_type_dataset_choice + long_name = soil type dataset choice + units = index + dimensions = () + type = integer + intent = in + optional = F +[ivegsrc] + standard_name = vegetation_type_dataset_choice + long_name = land use dataset choice + units = index + dimensions = () + type = integer + intent = in + optional = F +[nlunit] + standard_name = iounit_namelist + long_name = fortran unit number for file opens + units = none + dimensions = () + type = integer + intent = in + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F + +######################################################################## +[ccpp-arg-table] + name = lsm_noah_finalize + type = scheme +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F + +######################################################################## +[ccpp-arg-table] + name = lsm_noah_run + type = scheme +[im] + standard_name = horizontal_loop_extent + long_name = horizontal loop extent + units = count + dimensions = () + type = integer + intent = in + optional = F +[km] + standard_name = soil_vertical_dimension + long_name = soil vertical layer dimension + units = count + dimensions = () + type = integer + intent = in + optional = F +[grav] + standard_name = gravitational_acceleration + long_name = gravitational acceleration + units = m s-2 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[cp] + standard_name = specific_heat_of_dry_air_at_constant_pressure + long_name = specific heat of dry air at constant pressure + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[hvap] + standard_name = latent_heat_of_vaporization_of_water_at_0C + long_name = latent heat of evaporation/sublimation + units = J kg-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[rd] + standard_name = gas_constant_dry_air + long_name = ideal gas constant for dry air + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[eps] + standard_name = ratio_of_dry_air_to_water_vapor_gas_constants + long_name = rd/rv + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[epsm1] + standard_name = ratio_of_dry_air_to_water_vapor_gas_constants_minus_one + long_name = (rd/rv) - 1 + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[rvrdm1] + standard_name = ratio_of_vapor_to_dry_air_gas_constants_minus_one + long_name = (rv/rd) - 1 (rv = ideal gas constant for water vapor) + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[ps] + standard_name = surface_air_pressure + long_name = surface pressure + units = Pa + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[t1] + standard_name = air_temperature_at_lowest_model_layer + long_name = 1st model layer air temperature + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[q1] + standard_name = water_vapor_specific_humidity_at_lowest_model_layer + long_name = 1st model layer specific humidity + units = kg kg-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[soiltyp] + standard_name = soil_type_classification + long_name = soil type at each grid cell + units = index + dimensions = (horizontal_dimension) + type = integer + intent = in + optional = F +[vegtype] + standard_name = vegetation_type_classification + long_name = vegetation type at each grid cell + units = index + dimensions = (horizontal_dimension) + type = integer + intent = in + optional = F +[sigmaf] + standard_name = bounded_vegetation_area_fraction + long_name = areal fractional cover of green vegetation bounded on the bottom + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[sfcemis] + standard_name = surface_longwave_emissivity_over_land_interstitial + long_name = surface lw emissivity in fraction over land (temporary use as interstitial) + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[dlwflx] + standard_name = surface_downwelling_longwave_flux_absorbed_by_ground_over_land + long_name = total sky surface downward longwave flux absorbed by the ground over land + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[dswsfc] + standard_name = surface_downwelling_shortwave_flux + long_name = total sky surface downward shortwave flux + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[snet] + standard_name = surface_net_downwelling_shortwave_flux + long_name = total sky surface net shortwave flux + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[delt] + standard_name = time_step_for_dynamics + long_name = dynamics time step + units = s + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[tg3] + standard_name = deep_soil_temperature + long_name = bottom soil temperature + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[cm] + standard_name = surface_drag_coefficient_for_momentum_in_air_over_land + long_name = surface exchange coeff for momentum over land + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[ch] + standard_name = surface_drag_coefficient_for_heat_and_moisture_in_air_over_land + long_name = surface exchange coeff heat & moisture over land + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[prsl1] + standard_name = air_pressure_at_lowest_model_layer + long_name = Model layer 1 mean pressure + units = Pa + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[prslki] + standard_name = ratio_of_exner_function_between_midlayer_and_interface_at_lowest_model_layer + long_name = Exner function ratio bt midlayer and interface at 1st layer + units = ratio + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[zf] + standard_name = height_above_ground_at_lowest_model_layer + long_name = height above ground at 1st model layer + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[land] + standard_name = flag_nonzero_land_surface_fraction + long_name = flag indicating presence of some land surface area fraction + units = flag + dimensions = (horizontal_dimension) + type = logical + intent = in + optional = F +[wind] + standard_name = wind_speed_at_lowest_model_layer + long_name = wind speed at lowest model level + units = m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[slopetyp] + standard_name = surface_slope_classification + long_name = surface slope type at each grid cell + units = index + dimensions = (horizontal_dimension) + type = integer + intent = in + optional = F +[shdmin] + standard_name = minimum_vegetation_area_fraction + long_name = min fractional coverage of green veg + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[shdmax] + standard_name = maximum_vegetation_area_fraction + long_name = max fractnl cover of green veg (not used) + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[snoalb] + standard_name = upper_bound_on_max_albedo_over_deep_snow + long_name = upper bound on max albedo over deep snow + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[sfalb] + standard_name = surface_diffused_shortwave_albedo + long_name = mean surface diffused shortwave albedo + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[flag_iter] + standard_name = flag_for_iteration + long_name = flag for iteration + units = flag + dimensions = (horizontal_dimension) + type = logical + intent = in + optional = F +[flag_guess] + standard_name = flag_for_guess_run + long_name = flag for guess run + units = flag + dimensions = (horizontal_dimension) + type = logical + intent = in + optional = F +[lheatstrg] + standard_name = flag_for_canopy_heat_storage + long_name = flag for canopy heat storage parameterization + units = flag + dimensions = () + type = logical + intent = in + optional = F +[isot] + standard_name = soil_type_dataset_choice + long_name = soil type dataset choice + units = index + dimensions = () + type = integer + intent = in + optional = F +[ivegsrc] + standard_name = vegetation_type_dataset_choice + long_name = land use dataset choice + units = index + dimensions = () + type = integer + intent = in + optional = F +[bexppert] + standard_name = perturbation_of_soil_type_b_parameter + long_name = perturbation of soil type "b" parameter + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[xlaipert] + standard_name = perturbation_of_leaf_area_index + long_name = perturbation of leaf area index + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[vegfpert] + standard_name = perturbation_of_vegetation_fraction + long_name = perturbation of vegetation fraction + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[pertvegf] + standard_name = magnitude_of_perturbation_of_vegetation_fraction + long_name = magnitude of perturbation of vegetation fraction + units = frac + dimensions = (5) + type = real + kind = kind_phys + intent = in + optional = F +[weasd] + standard_name = water_equivalent_accumulated_snow_depth_over_land + long_name = water equiv of acc snow depth over land + units = mm + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[snwdph] + standard_name = surface_snow_thickness_water_equivalent_over_land + long_name = water equivalent snow depth over land + units = mm + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[tskin] + standard_name = surface_skin_temperature_over_land_interstitial + long_name = surface skin temperature over land (temporary use as interstitial) + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[tprcp] + standard_name = nonnegative_lwe_thickness_of_precipitation_amount_on_dynamics_timestep_over_land + long_name = total precipitation amount in each time step over land + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[srflag] + standard_name = flag_for_precipitation_type + long_name = flag for snow or rain precipitation + units = flag + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[smc] + standard_name = volume_fraction_of_soil_moisture + long_name = volumetric fraction of soil moisture + units = frac + dimensions = (horizontal_dimension,soil_vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[stc] + standard_name = soil_temperature + long_name = soil temperature + units = K + dimensions = (horizontal_dimension,soil_vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[slc] + standard_name = volume_fraction_of_unfrozen_soil_moisture + long_name = volume fraction of unfrozen soil moisture + units = frac + dimensions = (horizontal_dimension,soil_vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[canopy] + standard_name = canopy_water_amount + long_name = canopy moisture content + units = kg m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[trans] + standard_name = transpiration_flux + long_name = total plant transpiration rate + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[tsurf] + standard_name = surface_skin_temperature_after_iteration_over_land + long_name = surface skin temperature after iteration over land + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[zorl] + standard_name = surface_roughness_length_over_land_interstitial + long_name = surface roughness length over land (temporary use as interstitial) + units = cm + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[sncovr1] + standard_name = surface_snow_area_fraction_over_land + long_name = surface snow area fraction + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[qsurf] + standard_name = surface_specific_humidity_over_land + long_name = surface air saturation specific humidity over land + units = kg kg-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[gflux] + standard_name = upward_heat_flux_in_soil_over_land + long_name = soil heat flux over land + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[drain] + standard_name = subsurface_runoff_flux + long_name = subsurface runoff flux + units = kg m-2 s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[evap] + standard_name = kinematic_surface_upward_latent_heat_flux_over_land + long_name = kinematic surface upward latent heat flux over land + units = kg kg-1 m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[hflx] + standard_name = kinematic_surface_upward_sensible_heat_flux_over_land + long_name = kinematic surface upward sensible heat flux over land + units = K m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[ep] + standard_name = surface_upward_potential_latent_heat_flux_over_land + long_name = surface upward potential latent heat flux over land + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[runoff] + standard_name = surface_runoff_flux + long_name = surface runoff flux + units = kg m-2 s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[cmm] + standard_name = surface_drag_wind_speed_for_momentum_in_air_over_land + long_name = momentum exchange coefficient over land + units = m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[chh] + standard_name = surface_drag_mass_flux_for_heat_and_moisture_in_air_over_land + long_name = thermal exchange coefficient over land + units = kg m-2 s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[evbs] + standard_name = soil_upward_latent_heat_flux + long_name = soil upward latent heat flux + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[evcw] + standard_name = canopy_upward_latent_heat_flux + long_name = canopy upward latent heat flux + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[sbsno] + standard_name = snow_deposition_sublimation_upward_latent_heat_flux + long_name = latent heat flux from snow depo/subl + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[snowc] + standard_name = surface_snow_area_fraction + long_name = surface snow area fraction + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[stm] + standard_name = soil_moisture_content + long_name = soil moisture content + units = kg m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[snohf] + standard_name = snow_freezing_rain_upward_latent_heat_flux + long_name = latent heat flux due to snow and frz rain + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[smcwlt2] + standard_name = volume_fraction_of_condensed_water_in_soil_at_wilting_point + long_name = soil water fraction at wilting point + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[smcref2] + standard_name = threshold_volume_fraction_of_condensed_water_in_soil + long_name = soil moisture threshold + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[wet1] + standard_name = normalized_soil_wetness + long_name = normalized soil wetness + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F diff --git a/physics/sfc_drv_ruc.F90 b/physics/sfc_drv_ruc.F90 index f7899a75d..3b4b8a118 100644 --- a/physics/sfc_drv_ruc.F90 +++ b/physics/sfc_drv_ruc.F90 @@ -21,14 +21,7 @@ module lsm_ruc !> This subroutine calls set_soilveg_ruc() to specify vegetation and soil parameters for !! a given soil and land-use classification. !! \section arg_table_lsm_ruc_init Argument Table -!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | -!! |----------------|-------------------------------------------------------------|---------------------------------------------------------|------------|------|-----------|-----------|--------|----------| -!! | me | mpi_rank | current MPI-rank | index | 0 | integer | | in | F | -!! | isot | soil_type_dataset_choice | soil type dataset choice | index | 0 | integer | | in | F | -!! | ivegsrc | vegetation_type_dataset_choice | land use dataset choice | index | 0 | integer | | in | F | -!! | nlunit | iounit_namelist | fortran unit number for file opens | none | 0 | integer | | in | F | -!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | -!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | +!! \htmlinclude lsm_ruc_init.html !! subroutine lsm_ruc_init (me, isot, ivegsrc, nlunit, & & errmsg, errflg) @@ -49,10 +42,7 @@ subroutine lsm_ruc_init (me, isot, ivegsrc, nlunit, & end subroutine lsm_ruc_init !! \section arg_table_lsm_ruc_finalize Argument Table -!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | -!! |----------------|-------------------------------------------------------------|--------------------------------------------|------------|------|-----------|-----------|--------|----------| -!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | -!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | +!! \htmlinclude lsm_ruc_finalize.html !! subroutine lsm_ruc_finalize (errmsg, errflg) @@ -79,7 +69,6 @@ end subroutine lsm_ruc_finalize ! im - integer, horiz dimention and num of used pts 1 ! ! km - integer, vertical soil layer dimension 9 ! ! ps - real, surface pressure (pa) im ! -! u1, v1 - real, u/v component of surface layer wind im ! ! t1 - real, surface layer mean temperature (k) im ! ! q1 - real, surface layer mean specific humidity im ! ! soiltyp - integer, soil type (integer index) im ! @@ -96,7 +85,7 @@ end subroutine lsm_ruc_finalize ! prsl1 - real, sfc layer 1 mean pressure (pa) im ! ! prslki - real, dimensionless exner function at layer 1 im ! ! zf - real, height of bottom layer (m) im ! -! islmsk - integer, sea/land/ice mask (=0/1/2) im ! +! wind real, surface layer wind speed (m/s) im ! ! slopetyp - integer, class of sfc slope (integer index) im ! ! shdmin - real, min fractional coverage of green veg im ! ! shdmax - real, max fractnl cover of green veg (not used) im ! @@ -114,8 +103,8 @@ end subroutine lsm_ruc_finalize ! snwdph - real, snow depth (water equiv) over land im ! ! tskin - real, ground surface skin temperature ( k ) im ! ! tprcp - real, total precipitation im ! -! srflag - real, snow/rain flag for precipitation im ! -! sr - real, mixed-phase precipitation fraction im ! +! srflag - real, snow/rain flag for precipitation or mixed-phase +! precipitation fraction (depends on MP) im ! ! tslb - real, soil temp (k) im,km ! ! sh2o - real, liquid soil moisture im,km ! ! canopy - real, canopy moisture content (mm) im ! @@ -134,140 +123,38 @@ end subroutine lsm_ruc_finalize ! sbsno - real, sublimation/deposit from snopack (m/s) im ! ! stm - real, total soil column moisture content (m) im ! ! zorl - real, surface roughness im ! -! wet1 - real, normalized soil wetness im ! +! wetness - real, normalized soil wetness im ! ! ! ! ==================== end of description ===================== ! !> \defgroup lsm_ruc_group GSD RUC LSM Model -!! This module contains GSD RUC Land Surface Model +!! This module contains the RUC Land Surface Model developed by NOAA/GSD +!! (Smirnova et al. 2016 \cite Smirnova_2016). #if 0 !> \section arg_table_lsm_ruc_run Argument Table -!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | -!! |-----------------|------------------------------------------------------------------------------|-----------------------------------------------------------------|---------------|------|-----------|-----------|--------|----------| -!! | delt | time_step_for_dynamics | physics time step | s | 0 | real | kind_phys | in | F | -!! | me | mpi_rank | current MPI-rank | index | 0 | integer | | in | F | -!! | kdt | index_of_time_step | current number of time steps | index | 0 | integer | | in | F | -!! | iter | ccpp_loop_counter | loop counter for subcycling loops in CCPP | index | 0 | integer | | in | F | -!! | im | horizontal_loop_extent | horizontal loop extent | count | 0 | integer | | in | F | -!! | nlev | vertical_dimension | number of vertical levels | count | 0 | integer | | in | F | -!! | lsm_ruc | flag_for_ruc_land_surface_scheme | flag for RUC land surface model | flag | 0 | integer | | in | F | -!! | lsm | flag_for_land_surface_scheme | flag for land surface model | flag | 0 | integer | | in | F | -!! | do_mynnsfclay | do_mynnsfclay | flag to activate MYNN surface layer | flag | 0 | logical | | in | F | -!! | lsoil_ruc | soil_vertical_dimension_for_land_surface_model | number of soil layers internal to land surface model | count | 0 | integer | | in | F | -!! | lsoil | soil_vertical_dimension | soil vertical layer dimension | count | 0 | integer | | in | F | -!! | zs | depth_of_soil_levels_for_land_surface_model | depth of soil levels for land surface model | m | 1 | real | kind_phys | inout | F | -!! | islmsk | sea_land_ice_mask | landmask: sea/land/ice=0/1/2 | flag | 1 | integer | | in | F | -!! | con_cp | specific_heat_of_dry_air_at_constant_pressure | specific heat !of dry air at constant pressure | J kg-1 K-1 | 0 | real | kind_phys | in | F | -!! | con_g | gravitational_acceleration | gravitational acceleration | m s-2 | 0 | real | kind_phys | in | F | -!! | con_pi | pi | ratio of a circle's circumference to its diameter | radians | 0 | real | kind_phys | in | F | -!! | con_rd | gas_constant_dry_air | ideal gas constant for dry air | J kg-1 K-1 | 0 | real | kind_phys | in | F | -!! | con_rv | gas_constant_water_vapor | ideal gas constant for water vapor | J kg-1 K-1 | 0 | real | kind_phys | in | F | -!! | con_hvap | latent_heat_of_vaporization_of_water_at_0C | latent heat of vaporization/sublimation (hvap) | J kg-1 | 0 | real | kind_phys | in | F | -!! | con_fvirt | ratio_of_vapor_to_dry_air_gas_constants_minus_one | rv/rd - 1 (rv = ideal gas constant for water vapor) | none | 0 | real | kind_phys | in | F | -!! | land | flag_nonzero_land_surface_fraction | flag indicating presence of some land surface area fraction | flag | 1 | logical | | in | F | -!! | rainnc | lwe_thickness_of_explicit_rainfall_amount_from_previous_timestep | explicit rainfall from previous timestep | m | 1 | real | kind_phys | in | F | -!! | rainc | lwe_thickness_of_convective_precipitation_amount_from_previous_timestep | convective_precipitation_amount from previous timestep | m | 1 | real | kind_phys | in | F | -!! | ice | lwe_thickness_of_ice_amount_from_previous_timestep | ice amount from previous timestep | m | 1 | real | kind_phys | in | F | -!! | snow | lwe_thickness_of_snow_amount_from_previous_timestep | snow amount from previous timestep | m | 1 | real | kind_phys | in | F | -!! | graupel | lwe_thickness_of_graupel_amount_from_previous_timestep | graupel amount from previous timestep | m | 1 | real | kind_phys | in | F | -!! | srflag | flag_for_precipitation_type | snow/rain flag for precipitation | flag | 1 | real | kind_phys | in | F | -!! | sncovr1 | surface_snow_area_fraction_over_land | surface snow area fraction | frac | 1 | real | kind_phys | inout | F | -!! | weasd | water_equivalent_accumulated_snow_depth_over_land | water equiv of acc snow depth over land | mm | 1 | real | kind_phys | inout | F | -!! | snwdph | surface_snow_thickness_water_equivalent_over_land | water equivalent snow depth over land | mm | 1 | real | kind_phys | inout | F | -!! | sr | ratio_of_snowfall_to_rainfall | snow ratio: ratio of snow to total precipitation | frac | 1 | real | kind_phys | in | F | -!! | rhosnf | density_of_frozen_precipitation | density of frozen precipitation | kg m-3 | 1 | real | kind_phys | out | F | -!! | zf | height_above_ground_at_lowest_model_layer | layer 1 height above ground (not MSL) | m | 1 | real | kind_phys | in | F | -!! | u1 | x_wind_at_lowest_model_layer | zonal wind at lowest model layer | m s-1 | 1 | real | kind_phys | in | F | -!! | v1 | y_wind_at_lowest_model_layer | meridional wind at lowest model layer | m s-1 | 1 | real | kind_phys | in | F | -!! | prsl1 | air_pressure_at_lowest_model_layer | mean pressure at lowest model layer | Pa | 1 | real | kind_phys | in | F | -!! | ddvel | surface_wind_enhancement_due_to_convection | surface wind enhancement due to convection | m s-1 | 1 | real | kind_phys | in | F | -!! | t1 | air_temperature_at_lowest_model_layer | mean temperature at lowest model layer | K | 1 | real | kind_phys | in | F | -!! | q1 | water_vapor_specific_humidity_at_lowest_model_layer | water vapor specific humidity at lowest model layer | kg kg-1 | 1 | real | kind_phys | in | F | -!! | qc | cloud_condensed_water_mixing_ratio_at_lowest_model_layer | moist (dry+vapor, no condensates) mixing ratio of cloud water at lowest model layer | kg kg-1 | 1 | real | kind_phys | in | F | -!! | dlwflx | surface_downwelling_longwave_flux | surface downwelling longwave flux at current time | W m-2 | 1 | real | kind_phys | in | F | -!! | dswsfc | surface_downwelling_shortwave_flux | surface downwelling shortwave flux at current time | W m-2 | 1 | real | kind_phys | in | F | -!! | snet | surface_net_downwelling_shortwave_flux | surface net downwelling shortwave flux at current time | W m-2 | 1 | real | kind_phys | in | F | -!! | sfcemis | surface_longwave_emissivity | surface lw emissivity in fraction | frac | 1 | real | kind_phys | inout | F | -!! | wspd | wind_speed_at_lowest_model_layer | wind speed at lowest model level | m s-1 | 1 | real | kind_phys | inout | F | -!! | cm | surface_drag_coefficient_for_momentum_in_air | surface exchange coeff for momentum | none | 1 | real | kind_phys | in | F | -!! | ch | surface_drag_coefficient_for_heat_and_moisture_in_air | surface exchange coeff heat & moisture | none | 1 | real | kind_phys | in | F | -!! | chh | surface_drag_mass_flux_for_heat_and_moisture_in_air_over_land | thermal exchange coefficient over land | kg m-2 s-1 | 1 | real | kind_phys | inout | F | -!! | cmm | surface_drag_wind_speed_for_momentum_in_air_over_land | momentum exchange coefficient over land | m s-1 | 1 | real | kind_phys | inout | F | -!! | wet1 | normalized_soil_wetness | normalized soil wetness | frac | 1 | real | kind_phys | inout | F | -!! | canopy | canopy_water_amount | canopy water amount | kg m-2 | 1 | real | kind_phys | inout | F | -!! | sigmaf | vegetation_area_fraction | areal fractional cover of green vegetation | frac | 1 | real | kind_phys | in | F | -!! | sfalb | surface_diffused_shortwave_albedo | mean surface diffused sw albedo | frac | 1 | real | kind_phys | inout | F | -!! | alvwf | mean_vis_albedo_with_weak_cosz_dependency | mean vis albedo with weak cosz dependency | frac | 1 | real | kind_phys | in | F | -!! | alnwf | mean_nir_albedo_with_weak_cosz_dependency | mean nir albedo with weak cosz dependency | frac | 1 | real | kind_phys | in | F | -!! | snoalb | upper_bound_on_max_albedo_over_deep_snow | maximum snow albedo | frac | 1 | real | kind_phys | in | F | -!! | zorl | surface_roughness_length_over_land_interstitial | surface roughness length over land (temporary use as interstitial)| cm | 1 | real | kind_phys | inout | F | -!! | qsurf | surface_specific_humidity_over_land | surface air saturation specific humidity over land | kg kg-1 | 1 | real | kind_phys | inout | F | -!! | sfcqc | cloud_condensed_water_mixing_ratio_at_surface | moist cloud water mixing ratio at surface | kg kg-1 | 1 | real | kind_phys | inout | F | -!! | sfcqv | water_vapor_mixing_ratio_at_surface | water vapor mixing ratio at surface | kg kg-1 | 1 | real | kind_phys | inout | F | -!! | sfcdew | surface_condensation_mass | surface condensation mass | kg m-2 | 1 | real | kind_phys | inout | F | -!! | tg3 | deep_soil_temperature | deep soil temperature | K | 1 | real | kind_phys | in | F | -!! | smc | volume_fraction_of_soil_moisture | total soil moisture | frac | 2 | real | kind_phys | inout | F | -!! | slc | volume_fraction_of_unfrozen_soil_moisture | liquid soil moisture | frac | 2 | real | kind_phys | inout | F | -!! | stc | soil_temperature | soil temperature | K | 2 | real | kind_phys | inout | F | -!! | smcwlt2 | volume_fraction_of_condensed_water_in_soil_at_wilting_point | soil water fraction at wilting point | frac | 1 | real | kind_phys | inout | F | -!! | smcref2 | threshold_volume_fraction_of_condensed_water_in_soil | soil moisture threshold | frac | 1 | real | kind_phys | inout | F | -!! | vegtype | vegetation_type_classification | vegetation type at each grid cell | index | 1 | integer | | in | F | -!! | soiltyp | soil_type_classification | soil type at each grid cell | index | 1 | integer | | in | F | -!! | isot | soil_type_dataset_choice | soil type dataset choice | index | 0 | integer | | in | F | -!! | ivegsrc | vegetation_type_dataset_choice | land use dataset choice | index | 0 | integer | | in | F | -!! | fice | sea_ice_concentration | ice fraction over open water | frac | 1 | real | kind_phys | in | F | -!! | keepfr | flag_for_frozen_soil_physics | flag for frozen soil physics (RUC) | flag | 2 | real | kind_phys | inout | F | -!! | smois | volume_fraction_of_soil_moisture_for_land_surface_model | volumetric fraction of soil moisture for lsm | frac | 2 | real | kind_phys | inout | F | -!! | sh2o | volume_fraction_of_unfrozen_soil_moisture_for_land_surface_model | volume fraction of unfrozen soil moisture for lsm | frac | 2 | real | kind_phys | inout | F | -!! | smfrkeep | volume_fraction_of_frozen_soil_moisture_for_land_surface_model | volume fraction of frozen soil moisture for lsm | frac | 2 | real | kind_phys | inout | F | -!! | tslb | soil_temperature_for_land_surface_model | soil temperature for land surface model | K | 2 | real | kind_phys | inout | F | -!! | stm | soil_moisture_content | soil moisture content | kg m-2 | 1 | real | kind_phys | inout | F | -!! | tskin | surface_skin_temperature_over_land_interstitial | surface skin temperature over land (temporary use as interstitial)| K | 1 | real | kind_phys | inout | F | -!! | tsurf | surface_skin_temperature_after_iteration_over_land | surface skin temperature after iteration over land | K | 1 | real | kind_phys | inout | F | -!! | tice | sea_ice_temperature | sea ice surface skin temperature | K | 1 | real | kind_phys | inout | F | -!! | tsnow | snow_temperature_bottom_first_layer | snow temperature at the bottom of first snow layer | K | 1 | real | kind_phys | inout | F | -!! | snowfallac | total_accumulated_snowfall | run-total snow accumulation on the ground | kg m-2 | 1 | real | kind_phys | inout | F | -!! | acsnow | accumulated_water_equivalent_of_frozen_precip | snow water equivalent of run-total frozen precip | kg m-2 | 1 | real | kind_phys | inout | F | -!! | evap | kinematic_surface_upward_latent_heat_flux_over_land | kinematic surface upward evaporation flux over land | kg kg-1 m s-1 | 1 | real | kind_phys | out | F | -!! | hflx | kinematic_surface_upward_sensible_heat_flux_over_land | kinematic surface upward sensible heat flux over land | K m s-1 | 1 | real | kind_phys | out | F | -!! | evbs | soil_upward_latent_heat_flux | soil upward latent heat flux | W m-2 | 1 | real | kind_phys | out | F | -!! | evcw | canopy_upward_latent_heat_flux | canopy upward latent heat flux | W m-2 | 1 | real | kind_phys | out | F | -!! | sbsno | snow_deposition_sublimation_upward_latent_heat_flux | latent heat flux from snow depo/subl | W m-2 | 1 | real | kind_phys | out | F | -!! | trans | transpiration_flux | total plant transpiration rate | kg m-2 s-1 | 1 | real | kind_phys | out | F | -!! | runof | surface_runoff_flux | surface runoff flux | g m-2 s-1 | 1 | real | kind_phys | out | F | -!! | drain | subsurface_runoff_flux | subsurface runoff flux | g m-2 s-1 | 1 | real | kind_phys | out | F | -!! | runoff | total_runoff | total water runoff | kg m-2 | 1 | real | kind_phys | inout | F | -!! | srunoff | surface_runoff | surface water runoff (from lsm) | kg m-2 | 1 | real | kind_phys | inout | F | -!! | gflux | upward_heat_flux_in_soil_over_land | soil heat flux over land | W m-2 | 1 | real | kind_phys | out | F | -!! | shdmin | minimum_vegetation_area_fraction | min fractional coverage of green vegetation | frac | 1 | real | kind_phys | in | F | -!! | shdmax | maximum_vegetation_area_fraction | max fractional coverage of green vegetation | frac | 1 | real | kind_phys | in | F | -!! | flag_iter | flag_for_iteration | flag for iteration | flag | 1 | logical | | in | F | -!! | flag_guess | flag_for_guess_run | flag for guess run | flag | 1 | logical | | in | F | -!! | flag_init | flag_for_first_time_step | flag signaling first time step for time integration loop | flag | 0 | logical | | in | F | -!! | flag_restart | flag_for_restart | flag for restart (warmstart) or coldstart | flag | 0 | logical | | in | F | -!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | -!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | +!! \htmlinclude lsm_ruc_run.html !! #endif !>\section gen_lsmruc GSD RUC LSM General Algorithm - subroutine lsm_ruc_run & ! --- inputs - & ( iter, me, kdt, im, nlev, lsoil_ruc, lsoil, zs, & - & u1, v1, t1, q1, qc, soiltyp, vegtype, sigmaf, & +! DH* TODO - make order of arguments the same as in the metadata table + subroutine lsm_ruc_run & ! inputs + & ( iter, me, master, kdt, im, nlev, lsoil_ruc, lsoil, zs, & + & t1, q1, qc, soiltyp, vegtype, sigmaf, laixy, & & sfcemis, dlwflx, dswsfc, snet, delt, tg3, cm, ch, & - & prsl1, zf, islmsk, ddvel, shdmin, shdmax, alvwf, alnwf, & + & prsl1, zf, wind, shdmin, shdmax, alvwf, alnwf, & & snoalb, sfalb, flag_iter, flag_guess, isot, ivegsrc, fice, & - & smc, stc, slc, lsm_ruc, lsm, land, & - & smcwlt2, smcref2, wspd, do_mynnsfclay, & + & smc, stc, slc, lsm_ruc, lsm, land, islimsk, rdlai, & + & imp_physics, imp_physics_gfdl, imp_physics_thompson, & + & smcwlt2, smcref2, do_mynnsfclay, & & con_cp, con_rv, con_rd, con_g, con_pi, con_hvap, con_fvirt,& ! constants - & weasd, snwdph, tskin, & ! in/outs + & weasd, snwdph, tskin, tskin_ocn, & ! in/outs & rainnc, rainc, ice, snow, graupel, & ! in - & srflag, sr, & ! in/outs - & smois, tslb, sh2o, keepfr, smfrkeep, & ! on RUC levels + & srflag, smois, tslb, sh2o, keepfr, smfrkeep, & ! in/outs, on RUC levels & canopy, trans, tsurf, tsnow, zorl, & & sfcqc, sfcdew, tice, sfcqv, & - & sncovr1, qsurf, gflux, drain, evap, hflx, & ! --- outputs + & sncovr1, qsurf, gflux, drain, evap, hflx, & ! outputs & rhosnf, runof, runoff, srunoff, & - & chh, cmm, evbs, evcw, sbsno, stm, wet1, & + & chh, cmm, evbs, evcw, sbsno, stm, wetness, & & acsnow, snowfallac, & & flag_init, flag_restart, errmsg, errflg & & ) @@ -279,33 +166,38 @@ subroutine lsm_ruc_run & ! --- inpu real(kind=kind_phys), parameter :: stbolt = 5.670400e-8 ! --- input: - integer, intent(in) :: me + integer, intent(in) :: me, master integer, intent(in) :: im, nlev, iter, lsoil_ruc, lsoil, kdt, isot, ivegsrc integer, intent(in) :: lsm_ruc, lsm + integer, intent(in) :: imp_physics, imp_physics_gfdl, imp_physics_thompson real (kind=kind_phys), dimension(im,lsoil), intent(inout) :: smc,stc,slc - real (kind=kind_phys), dimension(im), intent(in) :: u1, v1,& + real (kind=kind_phys), dimension(im), intent(in) :: & & t1, sigmaf, sfcemis, dlwflx, dswsfc, snet, tg3, cm, & - & ch, prsl1, ddvel, shdmin, shdmax, & - & snoalb, alvwf, alnwf, zf, qc, q1, wspd + & ch, prsl1, wind, shdmin, shdmax, & + & snoalb, alvwf, alnwf, zf, qc, q1 + + real (kind=kind_phys), dimension(:), intent(in) :: laixy - integer, dimension(im), intent(in) :: islmsk real (kind=kind_phys), intent(in) :: delt real (kind=kind_phys), intent(in) :: con_cp, con_rv, con_g, & con_pi, con_rd, & con_hvap, con_fvirt logical, dimension(im), intent(in) :: flag_iter, flag_guess, land + integer, dimension(im), intent(in) :: islimsk ! sea/land/ice mask (=0/1/2) logical, intent(in) :: do_mynnsfclay + logical, intent(in) :: rdlai + ! --- in/out: integer, dimension(im), intent(inout) :: soiltyp, vegtype real (kind=kind_phys), dimension(lsoil_ruc) :: dzs real (kind=kind_phys), dimension(lsoil_ruc), intent(inout ) :: zs real (kind=kind_phys), dimension(im), intent(inout) :: weasd, & - & snwdph, tskin, & - & srflag, sr, canopy, trans, tsurf, zorl, tsnow, & + & snwdph, tskin, tskin_ocn, & + & srflag, canopy, trans, tsurf, zorl, tsnow, & & sfcqc, sfcqv, sfcdew, fice, tice, sfalb, smcwlt2, smcref2 ! --- in real (kind=kind_phys), dimension(im), intent(in) :: & @@ -319,7 +211,7 @@ subroutine lsm_ruc_run & ! --- inpu real (kind=kind_phys), dimension(im), intent(inout) :: sncovr1, & & qsurf , gflux , evap , runof , drain , & & runoff, srunoff, hflx, cmm, chh, & - & rhosnf, evbs, evcw, sbsno, stm, wet1, & + & rhosnf, evbs, evcw, sbsno, stm, wetness, & & acsnow, snowfallac logical, intent(in) :: flag_init, flag_restart @@ -328,10 +220,10 @@ subroutine lsm_ruc_run & ! --- inpu ! --- locals: real (kind=kind_phys), dimension(im) :: rch, rho, & - & q0, qs1, wind, weasd_old, snwdph_old, & - & tprcp_old, srflag_old, sr_old, tskin_old, canopy_old, & + & q0, qs1, weasd_old, snwdph_old, & + & tprcp_old, srflag_old, tskin_old, canopy_old, & & tsnow_old, snowfallac_old, acsnow_old, sfalb_old, & - & sfcqv_old, sfcqc_old, wet1_old, zorl_old, sncovr1_old + & sfcqv_old, sfcqc_old, wetness_old, zorl_old, sncovr1_old real (kind=kind_phys), dimension(lsoil_ruc) :: et @@ -404,39 +296,32 @@ subroutine lsm_ruc_run & ! --- inpu allocate(landusef(im,nlcat,1)) if(debug_print) then - print *,'RUC LSM run' - print *,'noah soil temp',ipr,stc(ipr,:) - print *,'noah soil mois',ipr,smc(ipr,:) - print *,'soiltyp=',ipr,soiltyp(ipr) - print *,'vegtype=',ipr,vegtype(ipr) - print *,'kdt, iter =',kdt,iter - print *,'flag_init =',flag_init - print *,'flag_restart =',flag_restart + write (0,*)'RUC LSM run' + write (0,*)'noah soil temp',ipr,stc(ipr,:) + write (0,*)'noah soil mois',ipr,smc(ipr,:) + write (0,*)'soiltyp=',ipr,soiltyp(ipr) + write (0,*)'vegtype=',ipr,vegtype(ipr) + write (0,*)'kdt, iter =',kdt,iter + write (0,*)'flag_init =',flag_init + write (0,*)'flag_restart =',flag_restart endif !> - Call rucinit() at the first time step and the first interation !! for RUC initialization,then overwrite Noah soil fields !! with initialized RUC soil fields for output. if(flag_init .and. iter==1) then - !print *,'RUC LSM initialization, kdt=', kdt + if (debug_print) write (0,'(a,i0,a,l)') 'RUC LSM initialization, kdt = ', kdt, ', flag_restart = ', flag_restart call rucinit (flag_restart, im, lsoil_ruc, lsoil, nlev, & ! in isot, soiltyp, vegtype, fice, & ! in - islmsk, tskin, tg3, & ! in + land, tskin, tskin_ocn, tg3, & ! in smc, slc, stc, & ! in smcref2, smcwlt2, & ! inout lsm_ruc, lsm, & ! in - zs, sh2o, smfrkeep, tslb, smois, wet1, & ! out - errmsg, errflg) - - !do i = 1, im ! n - horizontal loop - ! overwrite Noah soil fields with initialized RUC soil fields for output - !do k = 1, lsoil - ! smc(i,k) = smois(i,k) - ! slc(i,k) = sh2o(i,k) - ! stc(i,k) = tslb(i,k) - !enddo - !enddo ! i + zs, sh2o, smfrkeep, tslb, smois, wetness, & ! out + me, master, errmsg, errflg) + + xlai = 0. endif ! flag_init=.true.,iter=1 !-- end of initialization @@ -474,6 +359,10 @@ subroutine lsm_ruc_run & ! --- inpu llanduse = 'MODI-RUC' ! IGBP iswater = 17 isice = 15 + else + write(errmsg, '(a,i0)') 'Logic error in sfc_drv_ruc_run: iswater/isice not configured for ivegsrc=', ivegsrc + errflg = 1 + return endif fractional_seaice = 1 @@ -502,26 +391,35 @@ subroutine lsm_ruc_run & ! --- inpu !> - Set flag for land and ice points. !- 10may19 - ice points are turned off. flag(i) = land(i) + if (land(i) .and. (vegtype(i)==iswater .or. (vegtype(i)==isice.and.islimsk(i)==2))) then + !write(errmsg,'(a,i0,a,i0)') 'Logic error in sfc_drv_ruc_run: for i=', i, & + ! ', land(i) is true but vegtype(i) is water or ice: ', vegtype(i) + !errflg = 1 + !return + if(flag_init .and. iter==1) then + write(0,'(a,i0,a,i0)') 'Warning: in sfc_drv_ruc_run: for i=', i, & + ', land(i) is true but vegtype(i) is water or ice: ', vegtype(i) + end if + end if enddo do i = 1, im ! i - horizontal loop if (flag(i) .and. flag_guess(i)) then !> - Save land-related prognostic fields for guess run. - !if(me==0 .and. i==ipr) print *,'before call to RUC guess run', i + !if(me==0 .and. i==ipr) write (0,*)'before call to RUC guess run', i 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) - sr_old(i) = sr(i) tsnow_old(i) = tsnow(i) snowfallac_old(i) = snowfallac(i) acsnow_old(i) = acsnow(i) sfalb_old(i) = sfalb(i) sfcqv_old(i) = sfcqv(i) sfcqc_old(i) = sfcqc(i) - wet1_old(i) = wet1(i) + wetness_old(i) = wetness(i) zorl_old(i) = zorl(i) sncovr1_old(i) = sncovr1(i) do k = 1, lsoil_ruc @@ -539,7 +437,7 @@ subroutine lsm_ruc_run & ! --- inpu do j = 1, 1 do i = 1, im ! i - horizontal loop if (flag_iter(i) .and. flag(i)) then - !if(me==0 .and. i==ipr) print *,'iter run', iter, i, flag_iter(i),flag_guess(i) + !if(me==0 .and. i==ipr) write (0,*)'iter run', iter, i, flag_iter(i),flag_guess(i) evap (i) = 0.0 hflx (i) = 0.0 gflux(i) = 0.0 @@ -580,15 +478,7 @@ subroutine lsm_ruc_run & ! --- inpu do i = 1, im if (flag_iter(i) .and. flag(i)) then - !if (do_mynnsfclay) then - ! WARNING - used of wspd computed in MYNN sfc leads to massive cooling. - ! wind(i) = wspd(i) - !else - wind(i) = max(sqrt( u1(i)*u1(i) + v1(i)*v1(i) ) & - + max(0.0, min(ddvel(i), 30.0)), 1.0) - !endif q0(i) = max(q1(i)/(1.-q1(i)), 1.e-8) !* q1=specific humidity at level 1 (kg/kg) - rho(i) = prsl1(i) / (con_rd*t1(i)*(1.0+con_fvirt*q0(i))) qs1(i) = rslf(prsl1(i),t1(i)) !* qs1=sat. mixing ratio at level 1 (kg/kg) q0 (i) = min(qs1(i), q0(i)) @@ -606,29 +496,32 @@ subroutine lsm_ruc_run & ! --- inpu !!\n \a lsoil_ruc - number of soil layers (= 6 or 9) !!\n \a zs - the depth of each soil level (\f$m\f$) - ! DH* TODO - TEST FOR DIFFERENT PHYSICS AND SET ACCORDINGLY? - frpcpn = .true. ! .true. if mixed phase precipitation available (Thompson) + ! Set flag for mixed phase precipitation depending on microphysics scheme. + ! For GFDL and Thompson, srflag is fraction of frozen precip for convective+explicit precip. + if (imp_physics==imp_physics_gfdl .or. imp_physics==imp_physics_thompson) then + frpcpn = .true. + else + frpcpn = .false. + endif do j = 1, 1 ! 1:1 do i = 1, im ! i - horizontal loop if (flag_iter(i) .and. flag(i)) then - if(.not.frpcpn) then ! no mixed-phase precipitation available - if (srflag(i) == 1.0) then ! snow phase - ffrozp(i,j) = 1.0 - elseif (srflag(i) == 0.0) then ! rain phase - ffrozp(i,j) = 0.0 - endif - else ! mixed-phase precipitation is available - ffrozp(i,j) = sr(i) - endif ! frpcpn + if (frpcpn) then + ffrozp(i,j) = srflag(i) + else + ffrozp(i,j) = real(nint(srflag(i)),kind_phys) + endif + + !tgs - rdlai is .false. when the LAI data is not available in the + ! - INPUT/sfc_data.nc - !tgs - for now set rdlai2d to .false., WRF has LAI maps, and RUC LSM - ! uses rdlai2d = .true. - rdlai2d = .false. - !if( .not. rdlai2d) xlai = lai_data(vtype) + rdlai2d = rdlai - conflx2(i,1,j) = zf(i) ! first atm. level above ground surface + conflx2(i,1,j) = zf(i) * 2. ! factor 2. is needed to get the height of + ! atm. forcing inside RUC LSM (inherited + ! from WRF) !> - 2. forcing data (f): !!\n \a sfcprs - pressure at height zf above ground (pascals) @@ -665,13 +558,15 @@ subroutine lsm_ruc_run & ! --- inpu !prcp(i,j) = rhoh2o * tprcp(i) ! tprcp in [m] - convective plus explicit !raincv(i,j) = rhoh2o * rainc(i) ! total time-step convective precip !rainncv(i,j) = rhoh2o * max(rain(i)-rainc(i),0.0) ! total time-step explicit precip - !graupelncv(i,j) = rhoh2o * graupel(i) - !snowncv(i,j) = rhoh2o * snow(i) - prcp(i,j) = rhoh2o * (rainc(i)+rainnc(i)) ! tprcp in [m] - convective plus explicit - raincv(i,j) = rhoh2o * rainc(i) ! total time-step convective precip - rainncv(i,j) = rhoh2o * rainnc(i) ! total time-step explicit precip + prcp(i,j) = rhoh2o * (rainc(i)+rainnc(i)) ! [mm] - convective plus explicit + raincv(i,j) = rhoh2o * rainc(i) ! [mm] - total time-step convective precip + rainncv(i,j) = rhoh2o * rainnc(i) ! [mm] - total time-step explicit precip graupelncv(i,j) = rhoh2o * graupel(i) snowncv(i,j) = rhoh2o * snow(i) + !if(prcp(i,j) > 0. .and. i==21) then + !print *,'prcp(i,j),rainncv(i,j),graupelncv(i,j),snowncv(i,j),ffrozp(i,j)',i,j, & + ! prcp(i,j),rainncv(i,j),graupelncv(i,j),snowncv(i,j),ffrozp(i,j) + !endif ! ice not used ! precipfr(i,j) = rainncv(i,j) * ffrozp(i,j) @@ -694,37 +589,13 @@ subroutine lsm_ruc_run & ! --- inpu if(ivegsrc == 1) then ! IGBP - MODIS !> - Prepare land/ice/water masks for RUC LSM - !SLMSK0 - SEA(0),LAND(1),ICE(2) MASK - IF (LAND(I)) then - ! when LAND fraction is .true. + !> - for land only vtype(i,j) = vegtype(i) stype(i,j) = soiltyp(i) xland(i,j) = 1. xice(i,j) = 0. - ELSE - if(islmsk(i) == 0.) then - vtype(i,j) = 17 ! 17 - water (oceans and lakes) in MODIS - stype(i,j) = 14 - xland(i,j) = 2. ! xland = 2 for water - xice(i,j) = 0. - elseif(islmsk(i) == 1.) then ! land - vtype(i,j) = vegtype(i) - stype(i,j) = soiltyp(i) - xland(i,j) = 1. - xice(i,j) = 0. - elseif(islmsk(i) == 2) then ! ice - vtype(i,j) = 15 ! MODIS - if(isot == 0) then - stype(i,j) = 9 ! ZOBLER - else - stype(i,j) = 16 ! STASGO - endif - xland(i,j) = 1. - xice(i,j) = fice(i) ! fraction of sea-ice - endif - ENDIF ! land=.true. else - print *,'MODIS landuse is not available' + write (0,*)'MODIS landuse is not available' endif ! --- units % @@ -738,6 +609,8 @@ subroutine lsm_ruc_run & ! --- inpu albbck(i,j) = max(0.01, 0.5 * (alvwf(i) + alnwf(i))) alb(i,j) = sfalb(i) + if(rdlai2d) xlai(i,j) = laixy(i) + tbot(i,j) = tg3(i) !> - 4. history (state) variables (h): @@ -777,8 +650,8 @@ subroutine lsm_ruc_run & ! --- inpu if(stype(i,j) .ne. 14) then ! land - if (wet1(i) > 0.) then - wet(i,j) = wet1(i) + if (wetness(i) > 0.) then + wet(i,j) = wetness(i) else wet(i,j) = max(0.0001,smsoil(i,1,j)/0.3) endif @@ -823,101 +696,101 @@ subroutine lsm_ruc_run & ! --- inpu znt(i,j) = zorl(i)/100. if(debug_print) then - !if(me==0 .and. i==ipr) then - print *,'before RUC smsoil = ',smsoil(i,:,j), i,j - print *,'stsoil = ',stsoil(i,:,j), i,j - print *,'soilt = ',soilt(i,j), i,j - print *,'wet = ',wet(i,j), i,j - print *,'soilt1 = ',soilt1(i,j), i,j - print *,'delt =',delt - print *,'kdt =',kdt - print *,'flag_init =',flag_init - print *,'flag_restart =',flag_restart - print *,'nsoil =',nsoil - print *,'frpcpn =',frpcpn - print *,'zs =',zs - print *,'graupelncv(i,j) =',i,j,graupelncv(i,j) - print *,'snowncv(i,j) =',i,j,snowncv(i,j) - print *,'rainncv(i,j) =',i,j,rainncv(i,j) - print *,'raincv(i,j) =',i,j,raincv(i,j) - print *,'prcp(i,j) =',i,j,prcp(i,j) - print *,'sneqv(i,j) =',i,j,sneqv(i,j) - print *,'snowh(i,j) =',i,j,snowh(i,j) - print *,'sncovr(i,j) =',i,j,sncovr(i,j) - print *,'ffrozp(i,j) =',i,j,ffrozp(i,j) - print *,'conflx2(i,1,j) =',i,j,conflx2(i,1,j) - print *,'sfcprs(i,1,j) =',i,j,sfcprs(i,1,j) - print *,'sfctmp(i,1,j) =',i,j,sfctmp(i,1,j) - print *,'q2(i,1,j) =',i,j,q2(i,1,j) - print *,'qcatm(i,1,j) =',i,j,qcatm(i,1,j) - print *,'rho2(i,1,j) =',i,j,rho2(i,1,j) - print *,'lwdn(i,j) =',i,j,lwdn(i,j) - print *,'solnet(i,j) =',i,j,solnet(i,j) - print *,'sfcems(i,j) =',i,j,sfcems(i,j) - print *,'chklowq(i,j) =',i,j,chklowq(i,j) - print *,'chs(i,j) =',i,j,chs(i,j) - print *,'flqc(i,j) =',i,j,flqc(i,j) - print *,'flhc(i,j) =',i,j,flhc(i,j) - print *,'wet(i,j) =',i,j,wet(i,j) - print *,'cmc(i,j) =',i,j,cmc(i,j) - print *,'shdfac(i,j) =',i,j,shdfac(i,j) - print *,'alb(i,j) =',i,j,alb(i,j) - print *,'znt(i,j) =',i,j,znt(i,j) - print *,'z0(i,j) =',i,j,z0(i,j) - print *,'snoalb1d(i,j) =',i,j,snoalb1d(i,j) - print *,'alb(i,j) =',i,j,alb(i,j) - print *,'landusef(i,:,j) =',i,j,landusef(i,:,j) - print *,'soilctop(i,:,j) =',i,j,soilctop(i,:,j) - print *,'nlcat=',nlcat - print *,'nscat=',nscat - print *,'qsfc(i,j) =',i,j,qsfc(i,j) - print *,'qvg(i,j) =',i,j,qvg(i,j) - print *,'qsg(i,j) =',i,j,qsg(i,j) - print *,'qcg(i,j) =',i,j,qcg(i,j) - print *,'dew(i,j) =',i,j,dew(i,j) - print *,'soilt(i,j) =',i,j,soilt(i,j) - print *,'tskin(i) =',i,j,tskin(i) - print *,'soilt1(i,j) =',i,j,soilt1(i,j) - print *,'tsnav(i,j) =',i,j,tsnav(i,j) - print *,'tbot(i,j) =',i,j,tbot(i,j) - print *,'vtype(i,j) =',i,j,vtype(i,j) - print *,'stype(i,j) =',i,j,stype(i,j) - print *,'xland(i,j) =',i,j,xland(i,j) - print *,'xice(i,j) =',i,j,xice(i,j) - print *,'iswater=',iswater - print *,'isice=',isice - print *,'xice_threshold=',xice_threshold - print *,'con_cp=',con_cp - print *,'con_rv=',con_rv - print *,'con_rd=',con_rd - print *,'con_g=',con_g - print *,'con_pi=',con_pi - print *,'con_hvap=',con_hvap - print *,'stbolt=',stbolt - print *,'smsoil(i,:,j)=',i,j,smsoil(i,:,j) - print *,'slsoil(i,:,j)=',i,j,slsoil(i,:,j) - print *,'stsoil(i,:,j)=',i,j,stsoil(i,:,j) - print *,'smfrsoil(i,:,j)=',i,j,smfrsoil(i,:,j) - print *,'keepfrsoil(i,:,j)=',i,j,keepfrsoil(i,:,j) - print *,'soilm(i,j) =',i,j,soilm(i,j) - print *,'smmax(i,j) =',i,j,smmax(i,j) - print *,'hfx(i,j) =',i,j,hfx(i,j) - print *,'qfx(i,j) =',i,j,qfx(i,j) - print *,'lh(i,j) =',i,j,lh(i,j) - print *,'infiltr(i,j) =',i,j,infiltr(i,j) - print *,'runoff1(i,j) =',i,j,runoff1(i,j) - print *,'runoff2(i,j) =',i,j,runoff2(i,j) - print *,'acrunoff(i,j) =',i,j,acrunoff(i,j) - print *,'sfcexc(i,j) =',i,j,sfcexc(i,j) - print *,'acceta(i,j) =',i,j,acceta(i,j) - print *,'ssoil(i,j) =',i,j,ssoil(i,j) - print *,'snfallac(i,j) =',i,j,snfallac(i,j) - print *,'acsn(i,j) =',i,j,acsn(i,j) - print *,'snomlt(i,j) =',i,j,snomlt(i,j) - print *,'shdmin1d(i,j) =',i,j,shdmin1d(i,j) - print *,'shdmax1d(i,j) =',i,j,shdmax1d(i,j) - print *,'rdlai2d =',rdlai2d - !endif + if(me==0 .and. i==ipr) then + write (0,*)'before RUC smsoil = ',smsoil(i,:,j), i,j + write (0,*)'stsoil = ',stsoil(i,:,j), i,j + write (0,*)'soilt = ',soilt(i,j), i,j + write (0,*)'wet = ',wet(i,j), i,j + write (0,*)'soilt1 = ',soilt1(i,j), i,j + write (0,*)'delt =',delt + write (0,*)'kdt =',kdt + write (0,*)'flag_init =',flag_init + write (0,*)'flag_restart =',flag_restart + write (0,*)'nsoil =',nsoil + write (0,*)'frpcpn =',frpcpn + write (0,*)'zs =',zs + write (0,*)'graupelncv(i,j) =',i,j,graupelncv(i,j) + write (0,*)'snowncv(i,j) =',i,j,snowncv(i,j) + write (0,*)'rainncv(i,j) =',i,j,rainncv(i,j) + write (0,*)'raincv(i,j) =',i,j,raincv(i,j) + write (0,*)'prcp(i,j) =',i,j,prcp(i,j) + write (0,*)'sneqv(i,j) =',i,j,sneqv(i,j) + write (0,*)'snowh(i,j) =',i,j,snowh(i,j) + write (0,*)'sncovr(i,j) =',i,j,sncovr(i,j) + write (0,*)'ffrozp(i,j) =',i,j,ffrozp(i,j) + write (0,*)'conflx2(i,1,j) =',i,j,conflx2(i,1,j) + write (0,*)'sfcprs(i,1,j) =',i,j,sfcprs(i,1,j) + write (0,*)'sfctmp(i,1,j) =',i,j,sfctmp(i,1,j) + write (0,*)'q2(i,1,j) =',i,j,q2(i,1,j) + write (0,*)'qcatm(i,1,j) =',i,j,qcatm(i,1,j) + write (0,*)'rho2(i,1,j) =',i,j,rho2(i,1,j) + write (0,*)'lwdn(i,j) =',i,j,lwdn(i,j) + write (0,*)'solnet(i,j) =',i,j,solnet(i,j) + write (0,*)'sfcems(i,j) =',i,j,sfcems(i,j) + write (0,*)'chklowq(i,j) =',i,j,chklowq(i,j) + write (0,*)'chs(i,j) =',i,j,chs(i,j) + write (0,*)'flqc(i,j) =',i,j,flqc(i,j) + write (0,*)'flhc(i,j) =',i,j,flhc(i,j) + write (0,*)'wet(i,j) =',i,j,wet(i,j) + write (0,*)'cmc(i,j) =',i,j,cmc(i,j) + write (0,*)'shdfac(i,j) =',i,j,shdfac(i,j) + write (0,*)'alb(i,j) =',i,j,alb(i,j) + write (0,*)'znt(i,j) =',i,j,znt(i,j) + write (0,*)'z0(i,j) =',i,j,z0(i,j) + write (0,*)'snoalb1d(i,j) =',i,j,snoalb1d(i,j) + write (0,*)'alb(i,j) =',i,j,alb(i,j) + write (0,*)'landusef(i,:,j) =',i,j,landusef(i,:,j) + write (0,*)'soilctop(i,:,j) =',i,j,soilctop(i,:,j) + write (0,*)'nlcat=',nlcat + write (0,*)'nscat=',nscat + write (0,*)'qsfc(i,j) =',i,j,qsfc(i,j) + write (0,*)'qvg(i,j) =',i,j,qvg(i,j) + write (0,*)'qsg(i,j) =',i,j,qsg(i,j) + write (0,*)'qcg(i,j) =',i,j,qcg(i,j) + write (0,*)'dew(i,j) =',i,j,dew(i,j) + write (0,*)'soilt(i,j) =',i,j,soilt(i,j) + write (0,*)'tskin(i) =',i,j,tskin(i) + write (0,*)'soilt1(i,j) =',i,j,soilt1(i,j) + write (0,*)'tsnav(i,j) =',i,j,tsnav(i,j) + write (0,*)'tbot(i,j) =',i,j,tbot(i,j) + write (0,*)'vtype(i,j) =',i,j,vtype(i,j) + write (0,*)'stype(i,j) =',i,j,stype(i,j) + write (0,*)'xland(i,j) =',i,j,xland(i,j) + write (0,*)'xice(i,j) =',i,j,xice(i,j) + write (0,*)'iswater=',iswater + write (0,*)'isice=',isice + write (0,*)'xice_threshold=',xice_threshold + write (0,*)'con_cp=',con_cp + write (0,*)'con_rv=',con_rv + write (0,*)'con_rd=',con_rd + write (0,*)'con_g=',con_g + write (0,*)'con_pi=',con_pi + write (0,*)'con_hvap=',con_hvap + write (0,*)'stbolt=',stbolt + write (0,*)'smsoil(i,:,j)=',i,j,smsoil(i,:,j) + write (0,*)'slsoil(i,:,j)=',i,j,slsoil(i,:,j) + write (0,*)'stsoil(i,:,j)=',i,j,stsoil(i,:,j) + write (0,*)'smfrsoil(i,:,j)=',i,j,smfrsoil(i,:,j) + write (0,*)'keepfrsoil(i,:,j)=',i,j,keepfrsoil(i,:,j) + write (0,*)'soilm(i,j) =',i,j,soilm(i,j) + write (0,*)'smmax(i,j) =',i,j,smmax(i,j) + write (0,*)'hfx(i,j) =',i,j,hfx(i,j) + write (0,*)'qfx(i,j) =',i,j,qfx(i,j) + write (0,*)'lh(i,j) =',i,j,lh(i,j) + write (0,*)'infiltr(i,j) =',i,j,infiltr(i,j) + write (0,*)'runoff1(i,j) =',i,j,runoff1(i,j) + write (0,*)'runoff2(i,j) =',i,j,runoff2(i,j) + write (0,*)'acrunoff(i,j) =',i,j,acrunoff(i,j) + write (0,*)'sfcexc(i,j) =',i,j,sfcexc(i,j) + write (0,*)'acceta(i,j) =',i,j,acceta(i,j) + write (0,*)'ssoil(i,j) =',i,j,ssoil(i,j) + write (0,*)'snfallac(i,j) =',i,j,snfallac(i,j) + write (0,*)'acsn(i,j) =',i,j,acsn(i,j) + write (0,*)'snomlt(i,j) =',i,j,snomlt(i,j) + write (0,*)'shdmin1d(i,j) =',i,j,shdmin1d(i,j) + write (0,*)'shdmax1d(i,j) =',i,j,shdmax1d(i,j) + write (0,*)'rdlai2d =',rdlai2d + endif endif !> - Call RUC LSM lsmruc(). @@ -933,8 +806,7 @@ subroutine lsm_ruc_run & ! --- inpu & chs(i,j), flqc(i,j), flhc(i,j), & ! --- input/outputs: & wet(i,j), cmc(i,j), shdfac(i,j), alb(i,j), znt(i,j), & - & z0(i,j), snoalb1d(i,j), albbck(i,j), & -! & z0, snoalb1d, alb, xlai, & + & z0(i,j), snoalb1d(i,j), albbck(i,j), xlai(i,j), & & landusef(i,:,j), nlcat, & ! --- mosaic_lu and mosaic_soil are moved to the namelist ! & mosaic_lu, mosaic_soil, & @@ -957,39 +829,39 @@ subroutine lsm_ruc_run & ! --- inpu & its,ite, jts,jte, kts,kte ) if(debug_print) then - print *,'after sneqv(i,j) =',i,j,sneqv(i,j) - print *,'after snowh(i,j) =',i,j,snowh(i,j) - print *,'after sncovr(i,j) =',i,j,sncovr(i,j) - print *,'after vtype(i,j) =',i,j,vtype(i,j) - print *,'after stype(i,j) =',i,j,stype(i,j) - print *,'after wet(i,j) =',i,j,wet(i,j) - print *,'after cmc(i,j) =',i,j,cmc(i,j) - print *,'after qsfc(i,j) =',i,j,qsfc(i,j) - print *,'after qvg(i,j) =',i,j,qvg(i,j) - print *,'after qsg(i,j) =',i,j,qsg(i,j) - print *,'after qcg(i,j) =',i,j,qcg(i,j) - print *,'after dew(i,j) =',i,j,dew(i,j) - print *,'after soilt(i,j) =',i,j,soilt(i,j) - print *,'after tskin(i) =',i,j,tskin(i) - print *,'after soilt1(i,j) =',i,j,soilt1(i,j) - print *,'after tsnav(i,j) =',i,j,tsnav(i,j) - print *,'after smsoil(i,:,j)=',i,j,smsoil(i,:,j) - print *,'after slsoil(i,:,j)=',i,j,slsoil(i,:,j) - print *,'after stsoil(i,:,j)=',i,j,stsoil(i,:,j) - print *,'after smfrsoil(i,:,j)=',i,j,smfrsoil(i,:,j) - print *,'after keepfrsoil(i,:,j)=',i,j,keepfrsoil(i,:,j) - print *,'after soilm(i,j) =',i,j,soilm(i,j) - print *,'after smmax(i,j) =',i,j,smmax(i,j) - print *,'after hfx(i,j) =',i,j,hfx(i,j) - print *,'after qfx(i,j) =',i,j,qfx(i,j) - print *,'after lh(i,j) =',i,j,lh(i,j) - print *,'after infiltr(i,j) =',i,j,infiltr(i,j) - print *,'after runoff1(i,j) =',i,j,runoff1(i,j) - print *,'after runoff2(i,j) =',i,j,runoff2(i,j) - print *,'after ssoil(i,j) =',i,j,ssoil(i,j) - print *,'after snfallac(i,j) =',i,j,snfallac(i,j) - print *,'after acsn(i,j) =',i,j,acsn(i,j) - print *,'after snomlt(i,j) =',i,j,snomlt(i,j) + write (0,*)'after sneqv(i,j) =',i,j,sneqv(i,j) + write (0,*)'after snowh(i,j) =',i,j,snowh(i,j) + write (0,*)'after sncovr(i,j) =',i,j,sncovr(i,j) + write (0,*)'after vtype(i,j) =',i,j,vtype(i,j) + write (0,*)'after stype(i,j) =',i,j,stype(i,j) + write (0,*)'after wet(i,j) =',i,j,wet(i,j) + write (0,*)'after cmc(i,j) =',i,j,cmc(i,j) + write (0,*)'after qsfc(i,j) =',i,j,qsfc(i,j) + write (0,*)'after qvg(i,j) =',i,j,qvg(i,j) + write (0,*)'after qsg(i,j) =',i,j,qsg(i,j) + write (0,*)'after qcg(i,j) =',i,j,qcg(i,j) + write (0,*)'after dew(i,j) =',i,j,dew(i,j) + write (0,*)'after soilt(i,j) =',i,j,soilt(i,j) + write (0,*)'after tskin(i) =',i,j,tskin(i) + write (0,*)'after soilt1(i,j) =',i,j,soilt1(i,j) + write (0,*)'after tsnav(i,j) =',i,j,tsnav(i,j) + write (0,*)'after smsoil(i,:,j)=',i,j,smsoil(i,:,j) + write (0,*)'after slsoil(i,:,j)=',i,j,slsoil(i,:,j) + write (0,*)'after stsoil(i,:,j)=',i,j,stsoil(i,:,j) + write (0,*)'after smfrsoil(i,:,j)=',i,j,smfrsoil(i,:,j) + write (0,*)'after keepfrsoil(i,:,j)=',i,j,keepfrsoil(i,:,j) + write (0,*)'after soilm(i,j) =',i,j,soilm(i,j) + write (0,*)'after smmax(i,j) =',i,j,smmax(i,j) + write (0,*)'after hfx(i,j) =',i,j,hfx(i,j) + write (0,*)'after qfx(i,j) =',i,j,qfx(i,j) + write (0,*)'after lh(i,j) =',i,j,lh(i,j) + write (0,*)'after infiltr(i,j) =',i,j,infiltr(i,j) + write (0,*)'after runoff1(i,j) =',i,j,runoff1(i,j) + write (0,*)'after runoff2(i,j) =',i,j,runoff2(i,j) + write (0,*)'after ssoil(i,j) =',i,j,ssoil(i,j) + write (0,*)'after snfallac(i,j) =',i,j,snfallac(i,j) + write (0,*)'after acsn(i,j) =',i,j,acsn(i,j) + write (0,*)'after snomlt(i,j) =',i,j,snomlt(i,j) endif @@ -1004,12 +876,12 @@ subroutine lsm_ruc_run & ! --- inpu ! if(debug_print) then !if(me==0.and.i==ipr) then - print *,'after RUC smsoil = ',smsoil(i,:,j), i, j - print *,'stsoil = ',stsoil(i,:,j), i,j - print *,'soilt = ',soilt(i,j), i,j - print *,'wet = ',wet(i,j), i,j - print *,'soilt1 = ',soilt1(i,j), i,j - print *,'rhosnfr = ',rhosnfr(i,j), i,j + write (0,*)'after RUC smsoil = ',smsoil(i,:,j), i, j + write (0,*)'stsoil = ',stsoil(i,:,j), i,j + write (0,*)'soilt = ',soilt(i,j), i,j + write (0,*)'wet = ',wet(i,j), i,j + write (0,*)'soilt1 = ',soilt1(i,j), i,j + write (0,*)'rhosnfr = ',rhosnfr(i,j), i,j !endif endif @@ -1030,11 +902,11 @@ subroutine lsm_ruc_run & ! --- inpu stm(i) = soilm(i,j) tsurf(i) = soilt(i,j) tice(i) = tsurf(i) - ! --- ... units [m/s] = [g m-2 s-1] - runof (i) = runoff1(i,j) - drain (i) = runoff2(i,j) + + runof (i) = runoff1(i,j) * 1000.0 ! unit conversion (from m s-1 to mm s-1 and kg m-2 s-1) + drain (i) = runoff2(i,j) * 1000.0 ! unit conversion (from m s-1 to mm s-1 and kg m-2 s-1) - wet1(i) = wet(i,j) + wetness(i) = wet(i,j) ! State variables tsnow(i) = soilt1(i,j) @@ -1043,8 +915,8 @@ subroutine lsm_ruc_run & ! --- inpu rhosnf(i) = rhosnfr(i,j) ! --- ... accumulated total runoff and surface runoff - runoff(i) = runoff(i) + (drain(i)+runof(i)) * delt * 0.001 ! kg m-2 - srunoff(i) = srunoff(i) + runof(i) * delt * 0.001 ! kg m-2 + runoff(i) = runoff(i) + (drain(i)+runof(i)) * delt ! kg m-2 + srunoff(i) = srunoff(i) + runof(i) * delt ! kg m-2 ! --- ... accumulated frozen precipitation (accumulation in lsmruc) snowfallac(i) = snfallac(i,j) ! kg m-2 @@ -1069,12 +941,6 @@ subroutine lsm_ruc_run & ! --- inpu smfrkeep(i,k) = smfrsoil(i,k,j) enddo - !do k = 1, lsoil - ! smc(i,k) = smsoil(i,k,j) - ! slc(i,k) = slsoil(i,k,j) - ! stc(i,k) = stsoil(i,k,j) - !enddo - ! --- ... do not return the following output fields to parent model ! ec - canopy water evaporation (m s-1) ! edir - direct soil evaporation (m s-1) @@ -1102,9 +968,9 @@ subroutine lsm_ruc_run & ! --- inpu do j = 1, 1 do i = 1, im if (flag(i)) then - if(debug_print) print *,'end ',i,flag_guess(i),flag_iter(i) + if(debug_print) write (0,*)'end ',i,flag_guess(i),flag_iter(i) if (flag_guess(i)) then - if(debug_print) print *,'guess run' + if(debug_print) write (0,*)'guess run' weasd(i) = weasd_old(i) snwdph(i) = snwdph_old(i) tskin(i) = tskin_old(i) @@ -1117,7 +983,7 @@ subroutine lsm_ruc_run & ! --- inpu sfalb(i) = sfalb_old(i) sfcqv(i) = sfcqv_old(i) sfcqc(i) = sfcqc_old(i) - wet1(i) = wet1_old(i) + wetness(i) = wetness_old(i) zorl(i) = zorl_old(i) sncovr1(i) = sncovr1_old(i) do k = 1, lsoil_ruc @@ -1128,7 +994,7 @@ subroutine lsm_ruc_run & ! --- inpu smfrkeep(i,k) = smfrkeep_old(i,k) enddo else - if(debug_print) print *,'iter run', i,j, tskin(i),tsurf(i) + if(debug_print) write (0,*)'iter run', i,j, tskin(i),tsurf(i) tskin(i) = tsurf(i) tice (i) = tsurf(i) endif @@ -1139,6 +1005,32 @@ subroutine lsm_ruc_run & ! --- inpu deallocate(soilctop) deallocate(landusef) ! + !! Update standard (Noah LSM) soil variables for physics + !! that require these variables (e.g. sfc_sice), independent + !! of whether it is a land point or not + !do i = 1, im + ! if (land(i)) then + ! do k = 1, lsoil + ! smc(i,k) = smois(i,k) + ! slc(i,k) = sh2o(i,k) + ! stc(i,k) = tslb(i,k) + ! enddo + ! endif + !enddo + ! + !write(0,*) "DH DEBUG: i, k, land(i), smc(i,k), slc(i,k), stc(i,k):" + !do i = 1, im + ! do k = 1, lsoil + ! write(0,'(2i5,1x,l,1x,3e20.10)'), i, k, land(i), smc(i,k), slc(i,k), stc(i,k) + ! smc(i,k) = smois(i,k) + ! slc(i,k) = sh2o(i,k) + ! stc(i,k) = tslb(i,k) + ! enddo + !enddo + + !call sleep(20) + !stop + return !................................... end subroutine lsm_ruc_run @@ -1148,12 +1040,12 @@ end subroutine lsm_ruc_run !! This subroutine contains RUC LSM initialization. subroutine rucinit (restart, im, lsoil_ruc, lsoil, nlev, & ! in isot, soiltyp, vegtype, fice, & ! in - islmsk, tsurf, tg3, & ! in - smc, slc, stc, & ! in + land, tsurf, tsurf_ocn, & ! in + tg3, smc, slc, stc, & ! in smcref2, smcwlt2, & ! inout lsm_ruc, lsm, & ! in - zs, sh2o, smfrkeep, tslb, smois, wet1, & ! out - errmsg, errflg) + zs, sh2o, smfrkeep, tslb, smois, & ! out + wetness, me, master, errmsg, errflg) implicit none @@ -1164,8 +1056,8 @@ subroutine rucinit (restart, im, lsoil_ruc, lsoil, nlev, & ! in integer, intent(in ) :: im, nlev integer, intent(in ) :: lsoil_ruc integer, intent(in ) :: lsoil - integer, dimension(im), intent(in ) :: islmsk - real (kind=kind_phys), dimension(im), intent(in ) :: tsurf + logical, dimension(im), intent(in ) :: land + real (kind=kind_phys), dimension(im), intent(in ) :: tsurf, tsurf_ocn real (kind=kind_phys), dimension(im), intent(inout) :: smcref2 real (kind=kind_phys), dimension(im), intent(inout) :: smcwlt2 real (kind=kind_phys), dimension(im), intent(in ) :: tg3 @@ -1175,7 +1067,7 @@ subroutine rucinit (restart, im, lsoil_ruc, lsoil, nlev, & ! in integer, dimension(im), intent(inout) :: soiltyp integer, dimension(im), intent(inout) :: vegtype - real (kind=kind_phys), dimension(im), intent(inout) :: wet1 + real (kind=kind_phys), dimension(im), intent(inout) :: wetness real (kind=kind_phys), dimension(im), intent(inout) :: fice real (kind=kind_phys), dimension(im,lsoil_ruc), intent(inout) :: smois! ruc real (kind=kind_phys), dimension(im,lsoil_ruc), intent(inout) :: tslb ! ruc @@ -1184,10 +1076,12 @@ subroutine rucinit (restart, im, lsoil_ruc, lsoil, nlev, & ! in real (kind=kind_phys), dimension(1:lsoil_ruc), intent (out) :: zs + integer, intent(in ) :: me + integer, intent(in ) :: master character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg -! local +!> local logical :: debug_print logical :: smadj ! for soil mosture adjustment logical :: swi_init ! for initialization in terms of SWI (soil wetness index) @@ -1224,6 +1118,7 @@ subroutine rucinit (restart, im, lsoil_ruc, lsoil, nlev, & ! in integer, dimension(1:lsoil) :: st_levels_input ! 4 - for Noah lsm integer, dimension(1:lsoil) :: sm_levels_input ! 4 - for Noah lsm + integer :: ii,jj ! Initialize the CCPP error handling variables errmsg = '' errflg = 0 @@ -1237,7 +1132,8 @@ subroutine rucinit (restart, im, lsoil_ruc, lsoil, nlev, & ! in errflg = 1 return else if (debug_print) then - write(0,*) 'Start of RUC LSM initialization' + write (0,*) 'Start of RUC LSM initialization' + write (0,*)'lsoil, lsoil_ruc =',lsoil, lsoil_ruc endif ipr = 10 @@ -1270,89 +1166,82 @@ subroutine rucinit (restart, im, lsoil_ruc, lsoil, nlev, & ! in ! For restart runs, can assume that RUC soul data is provided if (.not.restart) then - flag_soil_layers = 1 ! =1 for input from the Noah LSM - flag_soil_levels = 0 ! =1 for input from RUC LSM flag_sst = 0 num_soil_layers = lsoil ! 4 - for Noah lsm - ! for Noah input set smadj and swi_init to .true. - smadj = .true. - swi_init = .true. - - if(lsoil == 4 ) then ! for Noah input - st_levels_input = (/ 5, 25, 70, 150/) ! Noah soil levels - sm_levels_input = (/ 5, 25, 70, 150/) ! Noah soil levels + if( lsoil_ruc == lsoil) then + ! RUC LSM input + smadj = .false. + swi_init = .false. + flag_soil_layers = 0 ! =1 for input from the Noah LSM + flag_soil_levels = 1 ! =1 for input from RUC LSM else + ! for Noah input set smadj and swi_init to .true. + smadj = .true. + swi_init = .true. + flag_soil_layers = 1 ! =1 for input from the Noah LSM + flag_soil_levels = 0 ! =1 for input from RUC LSM + endif + + if(lsoil == 4 ) then ! for Noah input + st_levels_input = (/ 5, 25, 70, 150/) ! Noah centers of soil layers + sm_levels_input = (/ 5, 25, 70, 150/) ! Noah centers of soil layers + elseif(lsoil /= lsoil_ruc) then write(errmsg,'(a,i0,a)') & - 'WARNING in lsm_ruc_init: non-Noah input, lsoil=', lsoil + 'WARNING in lsm_ruc_init: non-Noah and non-RUC input, lsoil=', lsoil errflg = 1 return endif else - ! For RUC input data, return here + ! For RUC restart data, return here return endif if(debug_print) then - print *,'Land mask islmsk(ipr) ==', ipr, islmsk(ipr) - print *,'Noah smc(ipr,:) ==', ipr, smc(ipr,:) - print *,'Noah stc(ipr,:) ==', ipr, stc(ipr,:) - print *,'Noah vegtype(ipr) ==', ipr, vegtype(ipr) - print *,'Noah soiltyp(ipr) ==', ipr, soiltyp(ipr) - print *,'its,ite,jts,jte ',its,ite,jts,jte + write (0,*)'smc(ipr,:) ==', ipr, smc(ipr,:) + write (0,*)'stc(ipr,:) ==', ipr, stc(ipr,:) + write (0,*)'vegtype(ipr) ==', ipr, vegtype(ipr) + write (0,*)'soiltyp(ipr) ==', ipr, soiltyp(ipr) + write (0,*)'its,ite,jts,jte ',its,ite,jts,jte endif - ! Noah lsm input - if ( flag_soil_layers == 1 ) then do j=jts,jte ! do i=its,ite ! i = horizontal loop - tsk(i,j) = tsurf(i) - tbot(i,j)=tg3(i) - - !SLMSK - SEA(0),LAND(1),ICE(2) MASK - if(islmsk(i) == 0) then - ivgtyp(i,j)= 17 ! 17 - water (oceans and lakes) in MODIS - isltyp(i,j)=14 - xice(i,j)=0. - landmask(i,j)=0. - elseif(islmsk(i) == 1) then ! land + ! land only version + if (land(i)) then + tsk(i,j) = tsurf(i) + sst(i,j) = tsurf_ocn(i) + tbot(i,j)= tg3(i) ivgtyp(i,j)=vegtype(i) isltyp(i,j)=soiltyp(i) landmask(i,j)=1. xice(i,j)=0. - elseif(islmsk(i) == 2) then ! ice - ivgtyp(i,j)=15 ! MODIS - !> -- number of soil categories - if(isot == 1) then - isltyp(i,j) = 16 ! STATSGO - else - isltyp(i,j) = 9 ! ZOBLER - endif - landmask(i,j)=1. - xice(i,j)=fice(i) - endif + else + landmask(i,j)=0. + endif ! land(i) - sst(i,j) = tsk(i,j) + enddo + enddo + + if ( flag_soil_layers == 1 ) then + ! Noah lsm input + do j=jts,jte ! + do i=its,ite ! i = horizontal loop + + if (land(i)) then st_input(i,1,j)=tsk(i,j) sm_input(i,1,j)=0. !--- initialize smcwlt2 and smcref2 with Noah values - if(islmsk(i) == 0 .or. islmsk(i) == 2) then - !water and sea ice - smcref2 (i) = 1. - smcwlt2 (i) = 0. - else - !land - smcref2 (i) = REFSMCnoah(soiltyp(i)) - smcwlt2 (i) = WLTSMCnoah(soiltyp(i)) - endif + smcref2 (i) = REFSMCnoah(soiltyp(i)) + smcwlt2 (i) = WLTSMCnoah(soiltyp(i)) do k=1,lsoil st_input(i,k+1,j)=stc(i,k) @@ -1369,12 +1258,14 @@ subroutine rucinit (restart, im, lsoil_ruc, lsoil, nlev, & ! in sm_input(i,k,j)=0. enddo + endif ! land(i) + enddo ! i - horizontal loop enddo ! jme if(debug_print) then - print *,'st_input=',ipr, st_input(ipr,:,1) - print *,'sm_input=',ipr, sm_input(ipr,:,1) + write (0,*)'st_input=',ipr, st_input(ipr,:,1) + write (0,*)'sm_input=',ipr, sm_input(ipr,:,1) endif CALL init_soil_3_real ( tsk , tbot , dumsm , dumt , & @@ -1392,34 +1283,30 @@ subroutine rucinit (restart, im, lsoil_ruc, lsoil, nlev, & ! in do j=jts,jte do i=its,ite + if (land(i)) then do k=1,lsoil_ruc ! convert from SWI to RUC volumetric soil moisture if(swi_init) then - if(islmsk(i) == 1) then - !land soilm(i,k,j)= dumsm(i,k,j) * & (refsmc(isltyp(i,j))-drysmc(isltyp(i,j))) & + drysmc(isltyp(i,j)) - else - soilm(i,k,j)= 1. - endif else soilm(i,k,j)= dumsm(i,k,j) endif soiltemp(i,k,j) = dumt(i,k,j) enddo + endif ! land(i) enddo enddo if(debug_print) then - print *,'tsk(i,j),tbot(i,j),sst(i,j),landmask(i,j)' & + write (0,*)'tsk(i,j),tbot(i,j),sst(i,j),landmask(i,j)' & ,ipr,1,tsk(ipr,1),tbot(ipr,1),sst(ipr,1),landmask(ipr,1) - print *,'islmsk(ipr)=',ipr,islmsk(ipr) - print *,'tsurf(ipr)=',ipr,tsurf(ipr) - print *,'stc(ipr)=',ipr,stc(ipr,:) - print *,'smc(ipr)=',ipr,smc(ipr,:) - print *,'soilt(1,:,ipr)',ipr,soiltemp(ipr,:,1) - print *,'soilm(1,:,ipr)',ipr,soilm(ipr,:,1) + write (0,*)'tsurf(ipr)=',ipr,tsurf(ipr) + write (0,*)'stc(ipr)=',ipr,stc(ipr,:) + write (0,*)'smc(ipr)=',ipr,smc(ipr,:) + write (0,*)'soilt(1,:,ipr)',ipr,soiltemp(ipr,:,1) + write (0,*)'soilm(1,:,ipr)',ipr,soilm(ipr,:,1) endif ! debug_print ! smadj should be true when the Noah LSM is used to initialize RUC @@ -1430,7 +1317,8 @@ subroutine rucinit (restart, im, lsoil_ruc, lsoil, nlev, & ! in do j=jts,jte do i=its,ite - IF ( islmsk(i) == 1 ) then ! Land + if (land(i)) then + ! initialize factor do k=1,lsoil_ruc factorsm(k)=1. @@ -1446,9 +1334,9 @@ subroutine rucinit (restart, im, lsoil_ruc, lsoil, nlev, & ! in if(debug_print) then if(i==ipr) then - print *,'from Noah to RUC: RUC bucket and Noah bucket at', & + write (0,*)'from Noah to RUC: RUC bucket and Noah bucket at', & i,j,smtotr(i,j),smtotn(i,j) - print *,'before smois=',i,j,soilm(i,:,j) + write (0,*)'before smois=',i,j,soilm(i,:,j) endif endif @@ -1469,46 +1357,79 @@ subroutine rucinit (restart, im, lsoil_ruc, lsoil, nlev, & ! in soilm(i,k,j) = factorsm(k) * soilm(i,k,j) enddo if(debug_print) then - if(i==ipr) print *,'after smois=',i,j,soilm(i,:,j) + if(i==ipr) write (0,*)'after smois=',i,j,soilm(i,:,j) endif smtotr(i,j) = 0. do k=1,lsoil_ruc - 1 smtotr(i,j)=smtotr(i,j) + soilm(i,k,j) *dzs(k) enddo if(debug_print) then - if(i==ipr)print *,'after correction: RUC bucket and Noah bucket at', & + if(i==ipr) write (0,*)'after correction: RUC bucket and Noah bucket at', & i,j,smtotr(i,j),smtotn(i,j) endif - ENDIF ! land + + endif ! land(i) enddo enddo endif ! smadj==.true. - ! Initialize liquid and frozen soil moisture from total soil moisture - ! and soil temperature, and also soil moisture availability in the top - ! layer - call ruclsminit( debug_print, & - lsoil_ruc, isltyp, ivgtyp, xice, mavail, & - soilh2o, smfr, soiltemp, soilm, & - ims,ime, jms,jme, kms,kme, & - its,ite, jts,jte, kts,kte ) - + elseif (flag_soil_layers==0) then + ! RUC LSM input + if(debug_print) write (0,*)' RUC LSM input for soil variables' do j=jts,jte do i=its,ite - wet1(i) = mavail(i,j) - do k = 1, lsoil_ruc - smois(i,k) = soilm(i,k,j) - tslb(i,k) = soiltemp(i,k,j) - sh2o(i,k) = soilh2o(i,k,j) - smfrkeep(i,k) = smfr(i,k,j) + do k=1,lsoil_ruc + soilm(i,k,j) = smc(i,k) + soiltemp(i,k,j) = stc(i,k) enddo enddo enddo endif ! flag_soil_layers==1 + + ! Initialize liquid and frozen soil moisture from total soil moisture + ! and soil temperature, and also soil moisture availability in the top + ! layer + call ruclsminit( debug_print, landmask, & + lsoil_ruc, isltyp, ivgtyp, xice, mavail, & + soilh2o, smfr, soiltemp, soilm, & + ims,ime, jms,jme, kms,kme, & + its,ite, jts,jte, kts,kte ) + + do j=jts,jte + do i=its,ite + if (land(i)) then + wetness(i) = mavail(i,j) + do k = 1, lsoil_ruc + smois(i,k) = soilm(i,k,j) + tslb(i,k) = soiltemp(i,k,j) + sh2o(i,k) = soilh2o(i,k,j) + smfrkeep(i,k) = smfr(i,k,j) + enddo + endif ! land(i) + enddo + enddo + + ! For non-land points, set RUC LSM fields to input (Noah or RUC) fields + do i=1,im + if (.not.land(i)) then + do k=1,min(lsoil,lsoil_ruc) + smois(i,k) = smc(i,k) + tslb(i,k) = stc(i,k) + sh2o(i,k) = slc(i,k) + enddo + endif + enddo + + if(debug_print) then + write (0,*)'End of RUC LSM initialization' + write (0,*)'tslb(ipr)=',ipr,tslb(ipr,:) + write (0,*)'smois(ipr)=',ipr,smois(ipr,:) + endif ! debug_print + end subroutine rucinit diff --git a/physics/sfc_drv_ruc.meta b/physics/sfc_drv_ruc.meta new file mode 100644 index 000000000..6eaadfbb4 --- /dev/null +++ b/physics/sfc_drv_ruc.meta @@ -0,0 +1,1004 @@ +[ccpp-arg-table] + name = lsm_ruc_init + type = scheme +[me] + standard_name = mpi_rank + long_name = current MPI-rank + units = index + dimensions = () + type = integer + intent = in + optional = F +[isot] + standard_name = soil_type_dataset_choice + long_name = soil type dataset choice + units = index + dimensions = () + type = integer + intent = in + optional = F +[ivegsrc] + standard_name = vegetation_type_dataset_choice + long_name = land use dataset choice + units = index + dimensions = () + type = integer + intent = in + optional = F +[nlunit] + standard_name = iounit_namelist + long_name = fortran unit number for file opens + units = none + dimensions = () + type = integer + intent = in + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F + +######################################################################## +[ccpp-arg-table] + name = lsm_ruc_finalize + type = scheme +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F + +######################################################################## +[ccpp-arg-table] + name = lsm_ruc_run + type = scheme +[delt] + standard_name = time_step_for_dynamics + long_name = physics time step + units = s + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[me] + standard_name = mpi_rank + long_name = current MPI-rank + units = index + dimensions = () + type = integer + intent = in + optional = F +[master] + standard_name = mpi_root + long_name = master MPI-rank + units = index + dimensions = () + type = integer + intent = in + optional = F +[kdt] + standard_name = index_of_time_step + long_name = current number of time steps + units = index + dimensions = () + type = integer + intent = in + optional = F +[iter] + standard_name = ccpp_loop_counter + long_name = loop counter for subcycling loops in CCPP + units = index + dimensions = () + type = integer + intent = in + optional = F +[im] + standard_name = horizontal_loop_extent + long_name = horizontal loop extent + units = count + dimensions = () + type = integer + intent = in + optional = F +[nlev] + standard_name = vertical_dimension + long_name = number of vertical levels + units = count + dimensions = () + type = integer + intent = in + optional = F +[lsm_ruc] + standard_name = flag_for_ruc_land_surface_scheme + long_name = flag for RUC land surface model + units = flag + dimensions = () + type = integer + intent = in + optional = F +[lsm] + standard_name = flag_for_land_surface_scheme + long_name = flag for land surface model + units = flag + dimensions = () + type = integer + intent = in + optional = F +[imp_physics] + standard_name = flag_for_microphysics_scheme + long_name = choice of microphysics scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F +[imp_physics_gfdl] + standard_name = flag_for_gfdl_microphysics_scheme + long_name = choice of GFDL microphysics scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F +[imp_physics_thompson] + standard_name = flag_for_thompson_microphysics_scheme + long_name = choice of Thompson microphysics scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F +[do_mynnsfclay] + standard_name = do_mynnsfclay + long_name = flag to activate MYNN surface layer + units = flag + dimensions = () + type = logical + intent = in + optional = F +[lsoil_ruc] + standard_name = soil_vertical_dimension_for_land_surface_model + long_name = number of soil layers internal to land surface model + units = count + dimensions = () + type = integer + intent = in + optional = F +[lsoil] + standard_name = soil_vertical_dimension + long_name = soil vertical layer dimension + units = count + dimensions = () + type = integer + intent = in + optional = F +[rdlai] + standard_name = flag_for_reading_leaf_area_index_from_input + long_name = flag for reading leaf area index from initial conditions for RUC LSM + units = flag + dimensions = () + type = logical +[zs] + standard_name = depth_of_soil_levels_for_land_surface_model + long_name = depth of soil levels for land surface model + units = m + dimensions = (soil_vertical_dimension_for_land_surface_model) + type = real + kind = kind_phys + intent = inout + optional = F +[con_cp] + standard_name = specific_heat_of_dry_air_at_constant_pressure + long_name = specific heat !of dry air at constant pressure + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[con_g] + standard_name = gravitational_acceleration + long_name = gravitational acceleration + units = m s-2 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[con_pi] + standard_name = pi + long_name = ratio of a circle's circumference to its diameter + units = radians + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[con_rd] + standard_name = gas_constant_dry_air + long_name = ideal gas constant for dry air + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[con_rv] + standard_name = gas_constant_water_vapor + long_name = ideal gas constant for water vapor + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[con_hvap] + standard_name = latent_heat_of_vaporization_of_water_at_0C + long_name = latent heat of vaporization/sublimation (hvap) + units = J kg-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[con_fvirt] + standard_name = ratio_of_vapor_to_dry_air_gas_constants_minus_one + long_name = rv/rd - 1 (rv = ideal gas constant for water vapor) + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[land] + standard_name = flag_nonzero_land_surface_fraction + long_name = flag indicating presence of some land surface area fraction + units = flag + dimensions = (horizontal_dimension) + type = logical + intent = in + optional = F +[islimsk] + standard_name = sea_land_ice_mask + long_name = sea/land/ice mask (=0/1/2) + units = flag + dimensions = (horizontal_dimension) + type = integer + intent = in + optional = F +[rainnc] + standard_name = lwe_thickness_of_explicit_rainfall_amount_from_previous_timestep + long_name = explicit rainfall from previous timestep + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[rainc] + standard_name = lwe_thickness_of_convective_precipitation_amount_from_previous_timestep + long_name = convective_precipitation_amount from previous timestep + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[ice] + standard_name = lwe_thickness_of_ice_amount_from_previous_timestep + long_name = ice amount from previous timestep + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[snow] + standard_name = lwe_thickness_of_snow_amount_from_previous_timestep + long_name = snow amount from previous timestep + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[graupel] + standard_name = lwe_thickness_of_graupel_amount_from_previous_timestep + long_name = graupel amount from previous timestep + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[srflag] + standard_name = flag_for_precipitation_type + long_name = snow/rain flag for precipitation + units = flag + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[sncovr1] + standard_name = surface_snow_area_fraction_over_land + long_name = surface snow area fraction + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[weasd] + standard_name = water_equivalent_accumulated_snow_depth_over_land + long_name = water equiv of acc snow depth over land + units = mm + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[snwdph] + standard_name = surface_snow_thickness_water_equivalent_over_land + long_name = water equivalent snow depth over land + units = mm + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[rhosnf] + standard_name = density_of_frozen_precipitation + long_name = density of frozen precipitation + units = kg m-3 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[zf] + standard_name = height_above_ground_at_lowest_model_layer + long_name = layer 1 height above ground (not MSL) + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[prsl1] + standard_name = air_pressure_at_lowest_model_layer + long_name = mean pressure at lowest model layer + units = Pa + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[wind] + standard_name = wind_speed_at_lowest_model_layer + long_name = wind speed at lowest model level + units = m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[t1] + standard_name = air_temperature_at_lowest_model_layer + long_name = mean temperature at lowest model layer + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[q1] + standard_name = water_vapor_specific_humidity_at_lowest_model_layer + long_name = water vapor specific humidity at lowest model layer + units = kg kg-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[qc] + standard_name = cloud_condensed_water_mixing_ratio_at_lowest_model_layer + long_name = ratio of mass of cloud water to mass of dry air plus vapor (without condensates) at lowest model layer + units = kg kg-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[dlwflx] + standard_name = surface_downwelling_longwave_flux + long_name = surface downwelling longwave flux at current time + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[dswsfc] + standard_name = surface_downwelling_shortwave_flux + long_name = surface downwelling shortwave flux at current time + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[snet] + standard_name = surface_net_downwelling_shortwave_flux + long_name = surface net downwelling shortwave flux at current time + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[sfcemis] + standard_name = surface_longwave_emissivity_over_land_interstitial + long_name = surface lw emissivity in fraction over land (temporary use as interstitial) + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[cm] + standard_name = surface_drag_coefficient_for_momentum_in_air_over_land + long_name = surface exchange coeff for momentum over land + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[ch] + standard_name = surface_drag_coefficient_for_heat_and_moisture_in_air_over_land + long_name = surface exchange coeff heat & moisture over land + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[chh] + standard_name = surface_drag_mass_flux_for_heat_and_moisture_in_air_over_land + long_name = thermal exchange coefficient over land + units = kg m-2 s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[cmm] + standard_name = surface_drag_wind_speed_for_momentum_in_air_over_land + long_name = momentum exchange coefficient over land + units = m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[wetness] + standard_name = normalized_soil_wetness_for_land_surface_model + long_name = normalized soil wetness + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[canopy] + standard_name = canopy_water_amount + long_name = canopy water amount + units = kg m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[sigmaf] + standard_name = vegetation_area_fraction + long_name = areal fractional cover of green vegetation + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[laixy] + standard_name = leaf_area_index + long_name = leaf area index + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + optional = F +[sfalb] + standard_name = surface_diffused_shortwave_albedo + long_name = mean surface diffused sw albedo + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[alvwf] + standard_name = mean_vis_albedo_with_weak_cosz_dependency + long_name = mean vis albedo with weak cosz dependency + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[alnwf] + standard_name = mean_nir_albedo_with_weak_cosz_dependency + long_name = mean nir albedo with weak cosz dependency + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[snoalb] + standard_name = upper_bound_on_max_albedo_over_deep_snow + long_name = maximum snow albedo + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[zorl] + standard_name = surface_roughness_length_over_land_interstitial + long_name = surface roughness length over land (temporary use as interstitial) + units = cm + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[qsurf] + standard_name = surface_specific_humidity_over_land + long_name = surface air saturation specific humidity over land + units = kg kg-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[sfcqc] + standard_name = cloud_condensed_water_mixing_ratio_at_surface + long_name = moist cloud water mixing ratio at surface + units = kg kg-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[sfcqv] + standard_name = water_vapor_mixing_ratio_at_surface + long_name = water vapor mixing ratio at surface + units = kg kg-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[sfcdew] + standard_name = surface_condensation_mass + long_name = surface condensation mass + units = kg m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[tg3] + standard_name = deep_soil_temperature + long_name = deep soil temperature + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[smc] + standard_name = volume_fraction_of_soil_moisture + long_name = total soil moisture + units = frac + dimensions = (horizontal_dimension,soil_vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[slc] + standard_name = volume_fraction_of_unfrozen_soil_moisture + long_name = liquid soil moisture + units = frac + dimensions = (horizontal_dimension,soil_vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[stc] + standard_name = soil_temperature + long_name = soil temperature + units = K + dimensions = (horizontal_dimension,soil_vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[smcwlt2] + standard_name = volume_fraction_of_condensed_water_in_soil_at_wilting_point + long_name = soil water fraction at wilting point + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[smcref2] + standard_name = threshold_volume_fraction_of_condensed_water_in_soil + long_name = soil moisture threshold + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[vegtype] + standard_name = vegetation_type_classification + long_name = vegetation type at each grid cell + units = index + dimensions = (horizontal_dimension) + type = integer + intent = in + optional = F +[soiltyp] + standard_name = soil_type_classification + long_name = soil type at each grid cell + units = index + dimensions = (horizontal_dimension) + type = integer + intent = in + optional = F +[isot] + standard_name = soil_type_dataset_choice + long_name = soil type dataset choice + units = index + dimensions = () + type = integer + intent = in + optional = F +[ivegsrc] + standard_name = vegetation_type_dataset_choice + long_name = land use dataset choice + units = index + dimensions = () + type = integer + intent = in + optional = F +[fice] + standard_name = sea_ice_concentration + long_name = ice fraction over open water + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[keepfr] + standard_name = flag_for_frozen_soil_physics + long_name = flag for frozen soil physics (RUC) + units = flag + dimensions = (horizontal_dimension,soil_vertical_dimension_for_land_surface_model) + type = real + kind = kind_phys + intent = inout + optional = F +[smois] + standard_name = volume_fraction_of_soil_moisture_for_land_surface_model + long_name = volumetric fraction of soil moisture for lsm + units = frac + dimensions = (horizontal_dimension,soil_vertical_dimension_for_land_surface_model) + type = real + kind = kind_phys + intent = inout + optional = F +[sh2o] + standard_name = volume_fraction_of_unfrozen_soil_moisture_for_land_surface_model + long_name = volume fraction of unfrozen soil moisture for lsm + units = frac + dimensions = (horizontal_dimension,soil_vertical_dimension_for_land_surface_model) + type = real + kind = kind_phys + intent = inout + optional = F +[smfrkeep] + standard_name = volume_fraction_of_frozen_soil_moisture_for_land_surface_model + long_name = volume fraction of frozen soil moisture for lsm + units = frac + dimensions = (horizontal_dimension,soil_vertical_dimension_for_land_surface_model) + type = real + kind = kind_phys + intent = inout + optional = F +[tslb] + standard_name = soil_temperature_for_land_surface_model + long_name = soil temperature for land surface model + units = K + dimensions = (horizontal_dimension,soil_vertical_dimension_for_land_surface_model) + type = real + kind = kind_phys + intent = inout + optional = F +[stm] + standard_name = soil_moisture_content + long_name = soil moisture content + units = kg m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[tskin] + standard_name = surface_skin_temperature_over_land_interstitial + long_name = surface skin temperature over land use as interstitial + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[tskin_ocn] + standard_name = surface_skin_temperature_over_ocean_interstitial + long_name = surface skin temperature over ocean (temporary use as interstitial) + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[tsurf] + standard_name = surface_skin_temperature_after_iteration_over_land + long_name = surface skin temperature after iteration over land + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[tice] + standard_name = sea_ice_temperature_interstitial + long_name = sea ice surface skin temperature use as interstitial + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[tsnow] + standard_name = snow_temperature_bottom_first_layer + long_name = snow temperature at the bottom of first snow layer + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[snowfallac] + standard_name = total_accumulated_snowfall + long_name = run-total snow accumulation on the ground + units = kg m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[acsnow] + standard_name = accumulated_water_equivalent_of_frozen_precip + long_name = snow water equivalent of run-total frozen precip + units = kg m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[evap] + standard_name = kinematic_surface_upward_latent_heat_flux_over_land + long_name = kinematic surface upward evaporation flux over land + units = kg kg-1 m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[hflx] + standard_name = kinematic_surface_upward_sensible_heat_flux_over_land + long_name = kinematic surface upward sensible heat flux over land + units = K m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[evbs] + standard_name = soil_upward_latent_heat_flux + long_name = soil upward latent heat flux + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[evcw] + standard_name = canopy_upward_latent_heat_flux + long_name = canopy upward latent heat flux + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[sbsno] + standard_name = snow_deposition_sublimation_upward_latent_heat_flux + long_name = latent heat flux from snow depo/subl + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[trans] + standard_name = transpiration_flux + long_name = total plant transpiration rate + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[runof] + standard_name = surface_runoff_flux + long_name = surface runoff flux + units = kg m-2 s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[drain] + standard_name = subsurface_runoff_flux + long_name = subsurface runoff flux + units = kg m-2 s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[runoff] + standard_name = total_runoff + long_name = total water runoff + units = kg m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[srunoff] + standard_name = surface_runoff + long_name = surface water runoff (from lsm) + units = kg m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[gflux] + standard_name = upward_heat_flux_in_soil_over_land + long_name = soil heat flux over land + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[shdmin] + standard_name = minimum_vegetation_area_fraction + long_name = min fractional coverage of green vegetation + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[shdmax] + standard_name = maximum_vegetation_area_fraction + long_name = max fractional coverage of green vegetation + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[flag_iter] + standard_name = flag_for_iteration + long_name = flag for iteration + units = flag + dimensions = (horizontal_dimension) + type = logical + intent = in + optional = F +[flag_guess] + standard_name = flag_for_guess_run + long_name = flag for guess run + units = flag + dimensions = (horizontal_dimension) + type = logical + intent = in + optional = F +[flag_init] + standard_name = flag_for_first_time_step + long_name = flag signaling first time step for time integration loop + units = flag + dimensions = () + type = logical + intent = in + optional = F +[flag_restart] + standard_name = flag_for_restart + long_name = flag for restart (warmstart) or coldstart + units = flag + dimensions = () + type = logical + intent = in + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F diff --git a/physics/sfc_noahmp_drv.f b/physics/sfc_noahmp_drv.f new file mode 100644 index 000000000..5ddd5aefc --- /dev/null +++ b/physics/sfc_noahmp_drv.f @@ -0,0 +1,1251 @@ +!> \file sfc_noahmp_drv.f +!! This file contains the NoahMP land surface scheme driver. + +!>\defgroup NoahMP_LSM NoahMP LSM Model +!! \brief This is the NoahMP LSM driver module, with the functionality of +!! preparing variables to run the NoahMP LSM subroutine noahmp_sflx(), calling NoahMP LSM and post-processing +!! variables for return to the parent model suite including unit conversion, as well +!! as diagnotics calculation. + +!> This module contains the CCPP-compliant NoahMP land surface model driver. + module noahmpdrv + + implicit none + + private + + public :: noahmpdrv_init, noahmpdrv_run, noahmpdrv_finalize + + contains + +!> \ingroup NoahMP_LSM +!! \brief This subroutine is called during the CCPP initialization phase and calls set_soilveg() to +!! initialize soil and vegetation parameters for the chosen soil and vegetation data sources. +!! \section arg_table_noahmpdrv_init Argument Table +!! \htmlinclude noahmpdrv_init.html +!! + subroutine noahmpdrv_init(me, isot, ivegsrc, nlunit, errmsg, & + & errflg) + + use set_soilveg_mod, only: set_soilveg + + implicit none + + integer, intent(in) :: me, isot, ivegsrc, nlunit + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + !--- initialize soil vegetation + call set_soilveg(me, isot, ivegsrc, nlunit) + + end subroutine noahmpdrv_init + + subroutine noahmpdrv_finalize + end subroutine noahmpdrv_finalize + +!> \ingroup NoahMP_LSM +!! \brief This subroutine is the main CCPP entry point for the NoahMP LSM. +!! \section arg_table_noahmpdrv_run Argument Table +!! \htmlinclude noahmpdrv_run.html +!! +!! \section general_noahmpdrv NoahMP Driver General Algorithm +!! @{ +!! - Initialize CCPP error handling variables. +!! - Set a flag to only continue with each grid cell if the fraction of land is non-zero. +!! - This driver may be called as part of an iterative loop. If called as the first "guess" run, +!! save land-related prognostic fields to restore. +!! - Initialize output variables to zero and prepare variables for input into the NoahMP LSM. +!! - Call transfer_mp_parameters() to fill a derived datatype for input into the NoahMP LSM. +!! - Call noahmp_options() to set module-level scheme options for the NoahMP LSM. +!! - If the vegetation type is ice for the grid cell, call noahmp_options_glacier() to set +!! module-level scheme options for NoahMP Glacier and call noahmp_glacier(). +!! - For other vegetation types, call noahmp_sflx(), the entry point of the NoahMP LSM. +!! - Set output variables from the output of noahmp_glacier() and/or noahmp_sflx(). +!! - Call penman() to calculate potential evaporation. +!! - Calculate the surface specific humidity and convert surface sensible and latent heat fluxes in W m-2 from their kinematic values. +!! - If a "guess" run, restore the land-related prognostic fields. +! ! +! lheatstrg- logical, flag for canopy heat storage 1 ! +! parameterization ! +! ! +!----------------------------------- + subroutine noahmpdrv_run & +!................................... +! --- inputs: + & ( im, km, itime, ps, u1, v1, t1, q1, soiltyp, vegtype, & + & sigmaf, sfcemis, dlwflx, dswsfc, snet, delt, tg3, cm, ch, & + & prsl1, prslki, zf, dry, wind, slopetyp, & + & shdmin, shdmax, snoalb, sfalb, flag_iter, flag_guess, & + & lheatstrg, & + & 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, & + & 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, & + +! --- in/outs: + & weasd, snwdph, tskin, tprcp, srflag, smc, stc, slc, & + & canopy, trans, tsurf, zorl, & + +! --- Noah MP specific + + & snowxy, tvxy, tgxy, canicexy, canliqxy, eahxy, tahxy, cmxy,& + & chxy, fwetxy, sneqvoxy, alboldxy, qsnowxy, wslakexy, zwtxy,& + & waxy, wtxy, tsnoxy, zsnsoxy, snicexy, snliqxy, lfmassxy, & + & rtmassxy, stmassxy, woodxy, stblcpxy, fastcpxy, xlaixy, & + & xsaixy, taussxy, smoiseq, smcwtdxy, deeprechxy, rechxy, & + +! --- outputs: + & sncovr1, qsurf, gflux, drain, evap, hflx, ep, runoff, & + & cmm, chh, evbs, evcw, sbsno, snowc, stm, snohf, & + & smcwlt2, smcref2, wet1, t2mmp, q2mp, errmsg, errflg) +! +! + use machine , only : kind_phys +! use date_def, only : idate + use funcphys, only : fpvs + + 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 + + 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, parameter :: undefined = -1.e36 + + real :: dz8w = undefined + real :: dx = undefined + real :: qc = undefined + real :: foln = 1.0 ! foliage + integer :: nsoil = 4 ! hardwired to Noah + integer :: nsnow = 3 ! max. snow layers + integer :: ist = 1 ! soil type, 1 soil; 2 lake; 14 is water + integer :: isc = 4 ! middle day soil color: soil 1-9 lightest + + real(kind=kind_phys), save :: zsoil(4),sldpth(4) + data zsoil / -0.1, -0.4, -1.0, -2.0 / + data sldpth /0.1, 0.3, 0.6, 1.0 / +! data dzs /0.1, 0.3, 0.6, 1.0 / + +! +! --- input: +! + + integer, intent(in) :: im, km, itime + + integer, dimension(im), intent(in) :: soiltyp, vegtype, slopetyp + + real (kind=kind_phys), dimension(im), intent(in) :: ps, u1, v1, & + & t1, q1, sigmaf, sfcemis, dlwflx, dswsfc, snet, tg3, cm, & + & ch, prsl1, prslki, wind, shdmin, shdmax, & + & snoalb, sfalb, zf, & + & rainn_mp,rainc_mp,snow_mp,graupel_mp,ice_mp + + logical, dimension(im), intent(in) :: dry + + real (kind=kind_phys),dimension(im),intent(in) :: xlatin,xcoszin + + integer, intent(in) :: idveg, iopt_crs,iopt_btr,iopt_run, & + & iopt_sfc,iopt_frz,iopt_inf,iopt_rad, & + & iopt_alb,iopt_snf,iopt_tbot,iopt_stc + + real (kind=kind_phys), intent(in) :: julian + integer, intent(in) :: iyrlen + + + real (kind=kind_phys), intent(in) :: delt + logical, dimension(im), intent(in) :: flag_iter, flag_guess + + logical, intent(in) :: lheatstrg + + real (kind=kind_phys), intent(in) :: con_hvap, con_cp, con_jcal, & + & rhoh2o, con_eps, con_epsm1, con_fvirt, & + & con_rd, con_hfus + +! --- in/out: + real (kind=kind_phys), dimension(im), intent(inout) :: weasd, & + & snwdph, tskin, tprcp, srflag, canopy, trans, tsurf, zorl + + real (kind=kind_phys), dimension(im,km), intent(inout) :: & + & smc, stc, slc + + real (kind=kind_phys), dimension(im), intent(inout) :: snowxy, & + & tvxy,tgxy,canicexy,canliqxy,eahxy,tahxy, & + & cmxy,chxy,fwetxy,sneqvoxy,alboldxy,qsnowxy, & + & wslakexy,zwtxy,waxy,wtxy,lfmassxy,rtmassxy, & + & stmassxy,woodxy,stblcpxy,fastcpxy,xlaixy, & + & xsaixy,taussxy,smcwtdxy,deeprechxy,rechxy + + real (kind=kind_phys),dimension(im,-2:0),intent(inout) :: tsnoxy + real (kind=kind_phys),dimension(im,-2:0),intent(inout) :: snicexy + real (kind=kind_phys),dimension(im,-2:0),intent(inout) :: snliqxy + real (kind=kind_phys),dimension(im,1:4), intent(inout) :: smoiseq + real (kind=kind_phys),dimension(im,-2:4),intent(inout) :: zsnsoxy + + integer, dimension(im) :: jsnowxy + real (kind=kind_phys),dimension(im) :: snodep + real (kind=kind_phys),dimension(im,-2:4) :: tsnsoxy + +! --- output: + + real (kind=kind_phys), dimension(im), intent(out) :: sncovr1, & + & qsurf, gflux, drain, evap, hflx, ep, runoff, cmm, chh, & + & evbs, evcw, sbsno, snowc, stm, snohf, smcwlt2, smcref2, wet1 + real (kind=kind_phys), dimension(:), intent(out) :: t2mmp, q2mp + +! error messages + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + +! --- locals: + real (kind=kind_phys), dimension(im) :: rch, rho, & + & q0, qs1, theta1, tv1, weasd_old, snwdph_old, & + & tprcp_old, srflag_old, tskin_old, canopy_old + + real (kind=kind_phys), dimension(km) :: et,stsoil,smsoil, slsoil + + real (kind=kind_phys),dimension(im,km) :: smc_old,stc_old,slc_old + + real (kind=kind_phys), dimension(im) :: snow_old, tv_old,tg_old, & + & canice_old,canliq_old,eah_old,tah_old,fwet_old,sneqvo_old, & + & albold_old,qsnow_old,wslake_old,zwt_old,wa_old,wt_old, & + & lfmass_old,rtmass_old,stmass_old,wood_old,stblcp_old, & + & fastcp_old,xlai_old,xsai_old,tauss_old,smcwtd_old, & + & deeprech_old,rech_old + + real(kind=kind_phys),dimension(im,1:4) :: smoiseq_old + real(kind=kind_phys),dimension(im,-2:0) :: tsno_old + real(kind=kind_phys),dimension(im,-2:0) :: snice_old + real(kind=kind_phys),dimension(im,-2:0) :: snliq_old + real(kind=kind_phys),dimension(im,-2:4) :: zsnso_old + real(kind=kind_phys),dimension(im,-2:4) :: tsnso_old + + + real (kind=kind_phys) :: alb, albedo, beta, chx, cmx, cmc, & + & dew, drip, dqsdt2, ec, edir, ett, eta, esnow, etp, & + & flx1, flx2, flx3, ffrozp, lwdn, pc, prcp, ptu, q2, & + & q2sat, solnet, rc, rcs, rct, rcq, rcsoil, rsmin, & + & runoff1, runoff2, runoff3, sfcspd, sfcprs, sfctmp, & + & sfcems, sheat, shdfac, shdmin1d, shdmax1d, smcwlt, & + & smcdry, smcref, smcmax, sneqv, snoalb1d, snowh, & + & snomlt, sncovr, soilw, soilm, ssoil, tsea, th2, & + & xlai, zlvl, swdn, tem, psfc,fdown,t2v,tbot + + real (kind=kind_phys) :: pconv,pnonc,pshcv,psnow,pgrpl,phail + real (kind=kind_phys) :: lat,cosz,uu,vv,swe + integer :: isnowx + + real (kind=kind_phys) :: tvx,tgx,canicex,canliqx,eahx, & + & tahx,fwetx,sneqvox,alboldx,qsnowx,wslakex,zwtx, & + & wax,wtx,lfmassx, rtmassx,stmassx, woodx,stblcpx, & + & fastcpx,xlaix,xsaix,taussx,smcwtdx,deeprechx,rechx, & + & qsfc1d + + real (kind=kind_phys), dimension(-2:0) :: tsnox, snicex, snliqx + real (kind=kind_phys), dimension(-2:0) :: ficeold + real (kind=kind_phys), dimension( km ) :: smoiseqx + real (kind=kind_phys), dimension(-2:4) :: zsnsox + real (kind=kind_phys), dimension(-2:4) :: tsnsox + + real (kind=kind_phys) :: z0wrf,fsa,fsr,fira,fsh,fcev,fgev, & + & fctr,ecan,etran,trad,tgb,tgv,t2mv, & + & t2mb,q2v,q2b,runsrf,runsub,apar, & + & psn,sav,sag,fsno,nee,gpp,npp,fveg, & + & qsnbot,ponding,ponding1,ponding2, & + & rssun,rssha,bgap,wgap,chv,chb,emissi, & + & shg,shc,shb,evg,evb,ghv,ghb,irg,irc, & + & irb,tr,evc,chleaf,chuc,chv2,chb2, & + & fpice,pahv,pahg,pahb,pah,co2pp,o2pp,ch2b + + real (kind=kind_phys) :: cpfac + + integer :: i, k, ice, stype, vtype ,slope,nroot,couple + logical :: flag(im) + logical :: snowng,frzgra + + ! --- local derived constants: + + real(kind=kind_phys) :: cpinv, hvapi, convrad, elocp + + type(noahmp_parameters) :: parameters + +! +!===> ... begin here +! + cpinv = 1.0/con_cp + hvapi = 1.0/con_hvap + convrad = con_jcal*1.e4/60.0 + elocp = con_hvap/con_cp + +! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + +! --- ... set flag for land points + + do i = 1, im + flag(i) = dry(i) + enddo + +! --- ... save land-related prognostic fields for guess run + + do i = 1, im + if (flag(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) + enddo + +! + do k = 1, km + smoiseq_old(i,k) = smoiseq(i,k) + enddo + + 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) + enddo + + do k = -2,4 + zsnso_old (i,k) = zsnsoxy(i,k) + enddo + + endif + enddo + +! +! call to init MP options +! +! &_________________________________________________________________ & + +! --- ... initialization block + + do i = 1, im + if (flag_iter(i) .and. flag(i)) then + ep(i) = 0.0 + evap (i) = 0.0 + hflx (i) = 0.0 + gflux(i) = 0.0 + drain(i) = 0.0 + canopy(i) = max(canopy(i), 0.0) + + evbs (i) = 0.0 + evcw (i) = 0.0 + trans(i) = 0.0 + sbsno(i) = 0.0 + snowc(i) = 0.0 + snohf(i) = 0.0 + endif + enddo + +! --- ... initialize variables + + do i = 1, im + if (flag_iter(i) .and. flag(i)) then + q0(i) = max(q1(i), 1.e-8) !* q1=specific humidity at level 1 (kg/kg) + theta1(i) = t1(i) * prslki(i) !* adiabatic temp at level 1 (k) + + tv1(i) = t1(i) * (1.0 + con_fvirt*q0(i)) + rho(i) = prsl1(i) / (con_rd * tv1(i)) + qs1(i) = fpvs( t1(i) ) !* qs1=sat. humidity at level 1 (kg/kg) + qs1(i) = con_eps*qs1(i) / (prsl1(i) + con_epsm1*qs1(i)) + qs1(i) = max(qs1(i), 1.e-8) + q0 (i) = min(qs1(i), q0(i)) + + if (vegtype(i) == isice_table ) then + if (weasd(i) < 0.1) then + weasd(i) = 0.1 + endif + endif + + endif + enddo + +! --- ... noah: prepare variables to run noah lsm +! 1. configuration information (c): +! ------------------------------ +! couple - couple-uncouple flag (=1: coupled, =0: uncoupled) +! ffrozp - fraction for snow-rain (1.=snow, 0.=rain, 0-1 mixed)) +! ice - sea-ice flag (=1: sea-ice, =0: land) +! dt - timestep (sec) (dt should not exceed 3600 secs) = delt +! zlvl - height (m) above ground of atmospheric forcing variables +! nsoil - number of soil layers (at least 2) +! sldpth - the thickness of each soil layer (m) + + do i = 1, im + + if (flag_iter(i) .and. flag(i)) then + + + couple = 1 + + ice = 0 + nsoil = km + snowng = .false. + frzgra = .false. + + +! if (srflag(i) == 1.0) then ! snow phase +! ffrozp = 1.0 +! elseif (srflag(i) == 0.0) then ! rain phase +! ffrozp = 0.0 +! endif +! use srflag directly to allow fractional rain/snow + ffrozp = srflag(i) + + zlvl = zf(i) + +! 2. forcing data (f): +! ----------------- +! lwdn - lw dw radiation flux (w/m2) +! solnet - net sw radiation flux (dn-up) (w/m2) +! sfcprs - pressure at height zlvl above ground (pascals) +! prcp - precip rate (kg m-2 s-1) +! sfctmp - air temperature (k) at height zlvl above ground +! th2 - air potential temperature (k) at height zlvl above ground +! q2 - mixing ratio at height zlvl above ground (kg kg-1) + + lat = xlatin(i) ! in radian + cosz = xcoszin(i) + + lwdn = dlwflx(i) !..downward lw flux at sfc in w/m2 + swdn = dswsfc(i) !..downward sw flux at sfc in w/m2 + solnet = snet(i) !..net sw rad flx (dn-up) at sfc in w/m2 + sfcems = sfcemis(i) + + sfctmp = t1(i) + sfcprs = prsl1(i) + psfc = ps(i) + prcp = rhoh2o * tprcp(i) / delt + + if (prcp > 0.0) then + if (ffrozp > 0.0) then ! rain/snow flag, one condition is enough? + snowng = .true. + qsnowxy(i) = ffrozp * prcp/10.0 !still use rho water? + else + if (sfctmp <= 275.15) frzgra = .true. + endif + endif + + th2 = theta1(i) + q2 = q0(i) + +! 3. other forcing (input) data (i): +! ------------------------------ +! sfcspd - wind speed (m s-1) at height zlvl above ground +! q2sat - sat mixing ratio at height zlvl above ground (kg kg-1) +! dqsdt2 - slope of sat specific humidity curve at t=sfctmp (kg kg-1 k-1) + + uu = u1(i) + vv = v1(i) + + sfcspd = wind(i) + q2sat = qs1(i) + dqsdt2 = q2sat * a23m4/(sfctmp-a4)**2 + +! 4. canopy/soil characteristics (s): +! -------------------------------- +! vegtyp - vegetation type (integer index) -> vtype +! soiltyp - soil type (integer index) -> stype +! slopetyp- class of sfc slope (integer index) -> slope +! shdfac - areal fractional coverage of green vegetation (0.0-1.0) +! shdmin - minimum areal fractional coverage of green vegetation -> shdmin1d +! ptu - photo thermal unit (plant phenology for annuals/crops) +! alb - backround snow-free surface albedo (fraction) +! snoalb - upper bound on maximum albedo over deep snow -> snoalb1d +! tbot - bottom soil temperature (local yearly-mean sfc air temp) + + vtype = vegtype(i) + stype = soiltyp(i) + slope = slopetyp(i) + shdfac= sigmaf(i) + + shdmin1d = shdmin(i) + shdmax1d = shdmax(i) + snoalb1d = snoalb(i) + + alb = sfalb(i) + + tbot = tg3(i) + ptu = 0.0 + + + cmc = canopy(i)/1000. ! convert from mm to m + tsea = tsurf(i) ! clu_q2m_iter + + snowh = snwdph(i) * 0.001 ! convert from mm to m + sneqv = weasd(i) * 0.001 ! convert from mm to m + + + +! 5. history (state) variables (h): +! ------------------------------ +! cmc - canopy moisture content (m) +! t1 - ground/canopy/snowpack) effective skin temperature (k) -> tsea +! stc(nsoil) - soil temp (k) -> stsoil +! smc(nsoil) - total soil moisture content (volumetric fraction) -> smsoil +! sh2o(nsoil)- unfrozen soil moisture content (volumetric fraction) -> slsoil +! snowh - actual snow depth (m) +! sneqv - liquid water-equivalent snow depth (m) +! albedo - surface albedo including snow effect (unitless fraction) +! ch - surface exchange coefficient for heat and moisture (m s-1) -> chx +! cm - surface exchange coefficient for momentum (m s-1) -> cmx + + isnowx = nint(snowxy(i)) + tvx = tvxy(i) + tgx = tgxy(i) + canliqx = canliqxy(i) !in mm + canicex = canicexy(i) + + eahxy(i) = (ps(i)*q2)/(0.622+q2) ! use q0 to reinit; + eahx = eahxy(i) + tahx = tahxy(i) + + co2pp = co2_table * sfcprs + o2pp = o2_table * sfcprs + fwetx = fwetxy(i) + + sneqvox = sneqvoxy(i) + alboldx = alboldxy(i) + + qsnowx = qsnowxy(i) + wslakex = wslakexy(i) + + zwtx = zwtxy(i) + wax = waxy(i) + wtx = waxy(i) + + do k = -2,0 + tsnsoxy(i,k) = tsnoxy(i,k) + enddo + + do k = 1,4 + tsnsoxy(i,k) = stc(i,k) + enddo + + do k = -2,0 + snicex(k) = snicexy(i,k) ! in k/m3; mm + snliqx(k) = snliqxy(i,k) ! in k/m3; mm + tsnox (k) = tsnoxy(i,k) + + ficeold(k) = 0.0 ! derived + + if (snicex(k) > 0.0 ) then + ficeold(k) = snicex(k) /(snicex(k)+snliqx(k)) + + endif + enddo + + do k = -2, km + zsnsox(k) = zsnsoxy(i,k) + tsnsox(k) = tsnsoxy(i,k) + enddo + + lfmassx = lfmassxy(i) + rtmassx = rtmassxy(i) + stmassx = stmassxy(i) + + woodx = woodxy(i) + stblcpx = stblcpxy(i) + fastcpx = fastcpxy(i) + + xsaix = xsaixy(i) + xlaix = xlaixy(i) + + taussx = taussxy(i) + + qsfc1d = undefined ! derive later, it is an in/out? + swe = weasd(i) + + do k = 1, km + smoiseqx(k) = smoiseq(i,k) + enddo + + smcwtdx = smcwtdxy(i) + rechx = rechxy(i) + deeprechx = deeprechxy(i) +!-- +! the optional details for precip +!-- + +! pconv = 0. ! convective - may introduce later +! pnonc = (1 - ffrozp) * prcp ! large scale total in mm/s; +! pshcv = 0. +! psnow = ffrozp * prcp /10.0 ! snow = qsnowx? +! pgrpl = 0. +! phail = 0. + pnonc = rainn_mp(i) + pconv = rainc_mp(i) + pshcv = 0. + psnow = snow_mp(i) + pgrpl = graupel_mp(i) + phail = ice_mp(i) +! +!-- old +! + do k = 1, km +! stsoil(k) = stc(i,k) + smsoil(k) = smc(i,k) + slsoil(k) = slc(i,k) + enddo + + snowh = snwdph(i) * 0.001 ! convert from mm to m + + if (swe /= 0.0 .and. snowh == 0.0) then + snowh = 10.0 * swe /1000.0 + endif + + chx = chxy(i) ! maybe chxy + cmx = cmxy(i) + + chh(i) = ch(i) * wind(i) * rho(i) + cmm(i) = cm(i) * wind(i) + + + + call transfer_mp_parameters(vtype,stype,slope,isc,parameters) + + call noahmp_options(idveg ,iopt_crs,iopt_btr,iopt_run,iopt_sfc, & + & iopt_frz,iopt_inf,iopt_rad,iopt_alb,iopt_snf,iopt_tbot,iopt_stc) + +! +! initialize heat capacity enhancement factor for heat storage parameterization +! + cpfac = 1.0 + + if ( vtype == isice_table ) then + + ice = -1 + tbot = min(tbot,263.15) + + call noahmp_options_glacier & + & (idveg ,iopt_crs ,iopt_btr, iopt_run ,iopt_sfc ,iopt_frz, & + & iopt_inf ,iopt_rad ,iopt_alb ,iopt_snf ,iopt_tbot, iopt_stc ) + + call noahmp_glacier ( & + & i ,1 ,cosz ,nsnow ,nsoil ,delt , & ! in : time/space/model-related + & sfctmp ,sfcprs ,uu ,vv ,q2 ,swdn , & ! in : forcing + & prcp ,lwdn ,tbot ,zlvl ,ficeold ,zsoil , & ! in : forcing + & qsnowx ,sneqvox ,alboldx ,cmx ,chx ,isnowx, & ! in/out :sneqvox + alboldx -LST + & swe ,smsoil ,zsnsox ,snowh ,snicex ,snliqx , & ! in/out : sneqvx + snowhx are avgd + & tgx ,tsnsox ,slsoil ,taussx ,qsfc1d , & ! in/out : + & fsa ,fsr ,fira ,fsh ,fgev ,ssoil , & ! out : + & trad ,edir ,runsrf ,runsub ,sag ,albedo , & ! out : albedo is surface albedo + & qsnbot ,ponding ,ponding1,ponding2,t2mb ,q2b , & ! out : +#ifdef CCPP + & emissi ,fpice ,ch2b ,esnow, errmsg, errflg ) +#else + & emissi ,fpice ,ch2b ,esnow ) +#endif + +#ifdef CCPP + if (errflg /= 0) return +#endif +! +! in/out and outs +! + + fsno = 1.0 + + tvx = undefined + canicex = undefined + canliqx = undefined + eahx = undefined + tahx = undefined + + fwetx = undefined + wslakex = undefined + zwtx = undefined + wax = undefined + wtx = undefined + + lfmassx = undefined + rtmassx = undefined + stmassx = undefined + woodx = undefined + stblcpx = undefined + fastcpx = undefined + xlaix = undefined + xsaix = undefined + + smcwtdx = 0.0 + rechx = 0.0 + deeprechx = 0.0 + + do k = 1,4 + smoiseqx(k) = smsoil(k) + enddo + + fctr = undefined + fcev = undefined + + z0wrf = 0.002 + + eta = fgev + t2mmp(i) = t2mb + q2mp(i) = q2b +! +! Non-glacial case +! + else + ice = 0 + +! write(*,*)'tsnsox(1)=',tsnsox,'tgx=',tgx + call noahmp_sflx (parameters ,& + & i , 1 , lat , iyrlen , julian , cosz ,& ! in : time/space-related + & delt , dx , dz8w , nsoil , zsoil , nsnow ,& ! in : model configuration + & shdfac , shdmax1d, vtype , ice , ist ,& ! in : vegetation/soil + & smoiseqx ,& ! in + & sfctmp , sfcprs , psfc , uu , vv , q2 ,& ! in : forcing + & qc , swdn , lwdn ,& ! in : forcing + & pconv , pnonc , pshcv , psnow , pgrpl , phail ,& ! in : forcing + & tbot , co2pp , o2pp , foln , ficeold , zlvl ,& ! in : forcing + & lheatstrg ,& ! in : canopy heat storage + & alboldx , sneqvox ,& ! in/out : + & tsnsox , slsoil , smsoil , tahx , eahx , fwetx ,& ! in/out : + & canliqx , canicex , tvx , tgx , qsfc1d , qsnowx ,& ! in/out : + & isnowx , zsnsox , snowh , swe , snicex , snliqx ,& ! in/out : + & zwtx , wax , wtx , wslakex , lfmassx , rtmassx,& ! in/out : + & stmassx , woodx , stblcpx , fastcpx , xlaix ,xsaix ,& ! in/out : + & cmx , chx , taussx ,& ! in/out : + & smcwtdx ,deeprechx, rechx , cpfac ,& ! in/out : + & z0wrf ,& ! 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 : + & bgap , wgap , chv , chb , emissi ,& ! out : + & shg , shc , shb , evg , evb , ghv ,&! out : + & ghb , irg , irc , irb , tr , evc ,& ! out : + & chleaf , chuc , chv2 , chb2 , fpice , pahv ,& ! out +#ifdef CCPP + & pahg , pahb , pah , esnow, errmsg, errflg ) +#else + & pahg , pahb , pah , esnow ) +#endif + +#ifdef CCPP + if (errflg /= 0) return +#endif + + eta = fcev + fgev + fctr ! the flux w/m2 + + t2mmp(i) = t2mv*fveg+t2mb*(1-fveg) + q2mp(i) = q2v*fveg+q2b*(1-fveg) + + endif ! glacial split ends + +! +! mp in/out +! + snowxy (i) = float(isnowx) + tvxy (i) = tvx + tgxy (i) = tgx + canliqxy (i) = canliqx + canicexy (i) = canicex + eahxy (i) = eahx + tahxy (i) = tahx + + cmxy (i) = cmx + chxy (i) = chx + + fwetxy (i) = fwetx + sneqvoxy (i) = sneqvox + alboldxy (i) = alboldx + qsnowxy (i) = qsnowx + + wslakexy (i) = wslakex + zwtxy (i) = zwtx + waxy (i) = wax + wtxy (i) = wtx + + do k = -2,0 + tsnoxy (i,k) = tsnsox(k) + snicexy (i,k) = snicex (k) + snliqxy (i,k) = snliqx (k) + enddo + + do k = -2,4 + zsnsoxy (i,k) = zsnsox(k) + enddo + + lfmassxy (i) = lfmassx + rtmassxy (i) = rtmassx + stmassxy (i) = stmassx + woodxy (i) = woodx + stblcpxy (i) = stblcpx + fastcpxy (i) = fastcpx + + xlaixy (i) = xlaix + xsaixy (i) = xsaix + + taussxy (i) = taussx + + rechxy (i) = rechx + deeprechxy(i) = deeprechx + smcwtdxy(i) = smcwtdx + smoiseq(i,1:4) = smoiseqx(1:4) + +! +! generic in/outs +! + do k = 1, km + stc(i,k) = tsnsox(k) + smc(i,k) = smsoil(k) + slc(i,k) = slsoil(k) + enddo + + canopy(i) = canicex + canliqx + weasd(i) = swe + snwdph(i) = snowh * 1000.0 + +! write(*,*) 'swe,snowh,can' +! write (*,*) swe,snowh*1000.0,canopy(i) +! + smcmax = smcmax_table(stype) + smcref = smcref_table(stype) + smcwlt = smcdry_table(stype) +! +! outs +! + wet1(i) = smsoil(1) / smcmax + smcwlt2(i) = smcwlt + smcref2(i) = smcref + + runoff(i) = runsrf + drain(i) = runsub + + zorl(i) = z0wrf * 100.0 + + sncovr1(i) = fsno + snowc (i) = fsno + + sbsno(i) = esnow + gflux(i) = -1.0*ssoil + hflx(i) = fsh + evbs(i) = fgev + evcw(i) = fcev + trans(i) = fctr + evap(i) = eta + +! write(*,*) 'vtype, stype are',vtype,stype +! write(*,*) 'fsh,gflx,eta',fsh,ssoil,eta +! write(*,*) 'esnow,runsrf,runsub',esnow,runsrf,runsub +! write(*,*) 'evbs,evcw,trans',fgev,fcev,fctr +! write(*,*) 'snowc',fsno + + tsurf(i) = trad + + stm(i) = (0.1*smsoil(1)+0.3*smsoil(2)+0.6*smsoil(3)+ & + & 1.0*smsoil(4))*1000.0 ! unit conversion from m to kg m-2 +! + snohf (i) = qsnbot * con_hfus ! only part of it but is diagnostic +! write(*,*) 'snohf',snohf(i) + + fdown = fsa + lwdn + t2v = sfctmp * (1.0 + 0.61*q2) +! ssoil = -1.0 *ssoil + + call penman (sfctmp,sfcprs,chx,t2v,th2,prcp,fdown,ssoil, & + & cpfac,q2,q2sat,etp,snowng,frzgra,ffrozp,dqsdt2,emissi,fsno) + + ep(i) = etp + + endif ! end if_flag_iter_and_flag_block + enddo ! end do_i_loop + +! --- ... compute qsurf (specific humidity at sfc) + + do i = 1, im + if (flag_iter(i) .and. flag(i)) then + rch(i) = rho(i) * con_cp * ch(i) * wind(i) + qsurf(i) = q1(i) + evap(i) / (elocp * rch(i)) + endif + enddo + + do i = 1, im + if (flag_iter(i) .and. flag(i)) then + tem = 1.0 / rho(i) + hflx(i) = hflx(i) * tem * cpinv + evap(i) = evap(i) * tem * hvapi + endif + enddo + +! --- ... restore land-related prognostic fields for guess run + + do i = 1, im + if (flag(i)) then + if (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) + deeprechxy(i) = deeprech_old(i) + rechxy(i) = rech_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) + enddo +! + do k = 1, km + smoiseq(i,k) = smoiseq_old(i,k) + enddo + + 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) + enddo + + do k = -2,4 + zsnsoxy(i,k) = zsnso_old(i,k) + enddo + else + tskin(i) = tsurf(i) + endif + endif + enddo +! + return +!................................... + end subroutine noahmpdrv_run +!> @} +!----------------------------------- + +!> \ingroup NoahMP_LSM +!! \brief This subroutine fills in a derived data type of type noahmp_parameters with data +!! from the module \ref noahmp_tables. + subroutine transfer_mp_parameters (vegtype,soiltype,slopetype, & + & soilcolor,parameters) + + use noahmp_tables + use module_sf_noahmplsm + + implicit none + + integer, intent(in) :: vegtype + integer, intent(in) :: soiltype + integer, intent(in) :: slopetype + integer, intent(in) :: soilcolor + + type (noahmp_parameters), intent(out) :: parameters + + real :: refdk + real :: refkdt + real :: frzk + real :: frzfact + + parameters%iswater = iswater_table + parameters%isbarren = isbarren_table + parameters%isice = isice_table + parameters%eblforest = eblforest_table + +!-----------------------------------------------------------------------& + parameters%urban_flag = .false. + if( vegtype == isurban_table .or. vegtype == 31 & + & .or.vegtype == 32 .or. vegtype == 33) then + parameters%urban_flag = .true. + endif + +!------------------------------------------------------------------------------------------! +! transfer veg parameters +!------------------------------------------------------------------------------------------! + + parameters%ch2op = ch2op_table(vegtype) !maximum intercepted h2o per unit lai+sai (mm) + parameters%dleaf = dleaf_table(vegtype) !characteristic leaf dimension (m) + parameters%z0mvt = z0mvt_table(vegtype) !momentum roughness length (m) + parameters%hvt = hvt_table(vegtype) !top of canopy (m) + parameters%hvb = hvb_table(vegtype) !bottom of canopy (m) + parameters%den = den_table(vegtype) !tree density (no. of trunks per m2) + parameters%rc = rc_table(vegtype) !tree crown radius (m) + parameters%mfsno = mfsno_table(vegtype) !snowmelt m parameter () + parameters%saim = saim_table(vegtype,:) !monthly stem area index, one-sided + parameters%laim = laim_table(vegtype,:) !monthly leaf area index, one-sided + parameters%sla = sla_table(vegtype) !single-side leaf area per kg [m2/kg] + parameters%dilefc = dilefc_table(vegtype) !coeficient for leaf stress death [1/s] + parameters%dilefw = dilefw_table(vegtype) !coeficient for leaf stress death [1/s] + parameters%fragr = fragr_table(vegtype) !fraction of growth respiration !original was 0.3 + parameters%ltovrc = ltovrc_table(vegtype) !leaf turnover [1/s] + + parameters%c3psn = c3psn_table(vegtype) !photosynthetic pathway: 0. = c4, 1. = c3 + parameters%kc25 = kc25_table(vegtype) !co2 michaelis-menten constant at 25c (pa) + parameters%akc = akc_table(vegtype) !q10 for kc25 + parameters%ko25 = ko25_table(vegtype) !o2 michaelis-menten constant at 25c (pa) + parameters%ako = ako_table(vegtype) !q10 for ko25 + parameters%vcmx25 = vcmx25_table(vegtype) !maximum rate of carboxylation at 25c (umol co2/m**2/s) + parameters%avcmx = avcmx_table(vegtype) !q10 for vcmx25 + parameters%bp = bp_table(vegtype) !minimum leaf conductance (umol/m**2/s) + parameters%mp = mp_table(vegtype) !slope of conductance-to-photosynthesis relationship + parameters%qe25 = qe25_table(vegtype) !quantum efficiency at 25c (umol co2 / umol photon) + parameters%aqe = aqe_table(vegtype) !q10 for qe25 + parameters%rmf25 = rmf25_table(vegtype) !leaf maintenance respiration at 25c (umol co2/m**2/s) + parameters%rms25 = rms25_table(vegtype) !stem maintenance respiration at 25c (umol co2/kg bio/s) + parameters%rmr25 = rmr25_table(vegtype) !root maintenance respiration at 25c (umol co2/kg bio/s) + parameters%arm = arm_table(vegtype) !q10 for maintenance respiration + parameters%folnmx = folnmx_table(vegtype) !foliage nitrogen concentration when f(n)=1 (%) + parameters%tmin = tmin_table(vegtype) !minimum temperature for photosynthesis (k) + + parameters%xl = xl_table(vegtype) !leaf/stem orientation index + parameters%rhol = rhol_table(vegtype,:) !leaf reflectance: 1=vis, 2=nir + parameters%rhos = rhos_table(vegtype,:) !stem reflectance: 1=vis, 2=nir + parameters%taul = taul_table(vegtype,:) !leaf transmittance: 1=vis, 2=nir + parameters%taus = taus_table(vegtype,:) !stem transmittance: 1=vis, 2=nir + + parameters%mrp = mrp_table(vegtype) !microbial respiration parameter (umol co2 /kg c/ s) + parameters%cwpvt = cwpvt_table(vegtype) !empirical canopy wind parameter + + parameters%wrrat = wrrat_table(vegtype) !wood to non-wood ratio + parameters%wdpool = wdpool_table(vegtype) !wood pool (switch 1 or 0) depending on woody or not [-] + parameters%tdlef = tdlef_table(vegtype) !characteristic t for leaf freezing [k] + + parameters%nroot = nroot_table(vegtype) !number of soil layers with root present + parameters%rgl = rgl_table(vegtype) !parameter used in radiation stress function + parameters%rsmin = rs_table(vegtype) !minimum stomatal resistance [s m-1] + parameters%hs = hs_table(vegtype) !parameter used in vapor pressure deficit function + parameters%topt = topt_table(vegtype) !optimum transpiration air temperature [k] + parameters%rsmax = rsmax_table(vegtype) !maximal stomatal resistance [s m-1] + +!------------------------------------------------------------------------------------------! +! transfer rad parameters +!------------------------------------------------------------------------------------------! + + parameters%albsat = albsat_table(soilcolor,:) + parameters%albdry = albdry_table(soilcolor,:) + parameters%albice = albice_table + parameters%alblak = alblak_table + parameters%omegas = omegas_table + parameters%betads = betads_table + parameters%betais = betais_table + parameters%eg = eg_table + +!------------------------------------------------------------------------------------------! +! transfer global parameters +!------------------------------------------------------------------------------------------! + + parameters%co2 = co2_table + parameters%o2 = o2_table + parameters%timean = timean_table + parameters%fsatmx = fsatmx_table + parameters%z0sno = z0sno_table + parameters%ssi = ssi_table + parameters%swemx = swemx_table + +! ---------------------------------------------------------------------- +! transfer soil parameters +! ---------------------------------------------------------------------- + + parameters%bexp = bexp_table (soiltype) + parameters%dksat = dksat_table (soiltype) + parameters%dwsat = dwsat_table (soiltype) + parameters%f1 = f1_table (soiltype) + parameters%psisat = psisat_table (soiltype) + parameters%quartz = quartz_table (soiltype) + parameters%smcdry = smcdry_table (soiltype) + parameters%smcmax = smcmax_table (soiltype) + parameters%smcref = smcref_table (soiltype) + parameters%smcwlt = smcwlt_table (soiltype) + +! ---------------------------------------------------------------------- +! transfer genparm parameters +! ---------------------------------------------------------------------- + parameters%csoil = csoil_table + parameters%zbot = zbot_table + parameters%czil = czil_table + + frzk = frzk_table + refdk = refdk_table + refkdt = refkdt_table + parameters%kdt = refkdt * parameters%dksat / refdk + parameters%slope = slope_table(slopetype) + + if(parameters%urban_flag)then ! hardcoding some urban parameters for soil + parameters%smcmax = 0.45 + parameters%smcref = 0.42 + parameters%smcwlt = 0.40 + parameters%smcdry = 0.40 + parameters%csoil = 3.e6 + endif + + ! adjust frzk parameter to actual soil type: frzk * frzfact + +!-----------------------------------------------------------------------& + if(soiltype /= 14) then + frzfact = (parameters%smcmax / parameters%smcref) & + & * (0.412 / 0.468) + parameters%frzx = frzk * frzfact + end if + + end subroutine transfer_mp_parameters + +!-----------------------------------------------------------------------& + +!> \ingroup NoahMP_LSM +!! brief Calculate potential evaporation for the current point. Various +!! partial sums/products are also calculated and passed back to the +!! calling routine for later use. + subroutine penman (sfctmp,sfcprs,ch,t2v,th2,prcp,fdown,ssoil, & + & cpfac,q2,q2sat,etp,snowng,frzgra,ffrozp, & + & dqsdt2,emissi_in,sncovr) + +! etp is calcuated right after ssoil + +! ---------------------------------------------------------------------- +! subroutine penman +! ---------------------------------------------------------------------- + implicit none + logical, intent(in) :: snowng, frzgra + real, intent(in) :: ch, dqsdt2,fdown,prcp,ffrozp, & + & q2, q2sat,ssoil,cpfac, sfcprs, sfctmp, & + & t2v, th2,emissi_in,sncovr + real, intent(out) :: etp + real :: epsca,flx2,rch,rr,t24 + real :: a, delta, fnet,rad,rho,emissi,elcp1,lvs + real :: elcpx + + real, parameter :: elcp = 2.4888e+3, lsubc = 2.501000e+6,cp = 1004.6 + real, parameter :: lsubs = 2.83e+6, rd = 287.05, cph2o = 4.1855e+3 + real, parameter :: cpice = 2.106e+3, lsubf = 3.335e5 + real, parameter :: sigma = 5.6704e-8 + +! ---------------------------------------------------------------------- +! executable code begins here: +! ---------------------------------------------------------------------- +! ---------------------------------------------------------------------- +! prepare partial quantities for penman equation. +! ---------------------------------------------------------------------- + emissi=emissi_in + elcpx = elcp / cpfac +! elcp1 = (1.0-sncovr)*elcpx + sncovr*elcpx*lsubs/lsubc + lvs = (1.0-sncovr)*lsubc + sncovr*lsubs + + flx2 = 0.0 + delta = elcpx * dqsdt2 +! delta = elcp1 * dqsdt2 + t24 = sfctmp * sfctmp * sfctmp * sfctmp + rr = t24 * 6.48e-8 / (sfcprs * ch) + 1.0 +! rr = emissi*t24 * 6.48e-8 / (sfcprs * ch) + 1.0 + rho = sfcprs / (rd * t2v) + +! ---------------------------------------------------------------------- +! adjust the partial sums / products with the latent heat +! effects caused by falling precipitation. +! ---------------------------------------------------------------------- + rch = rho * cp * cpfac * ch + if (.not. snowng) then + if (prcp > 0.0) rr = rr + cph2o * prcp / rch + else +! ---- ... fractional snowfall/rainfall + rr = rr + (cpice*ffrozp+cph2o*(1.-ffrozp)) & + & *prcp/rch + end if + +! ---------------------------------------------------------------------- +! include the latent heat effects of frzng rain converting to ice on +! impact in the calculation of flx2 and fnet. +! ---------------------------------------------------------------------- +! fnet = fdown - sigma * t24- ssoil + fnet = fdown - emissi*sigma * t24- ssoil + if (frzgra) then + flx2 = - lsubf * prcp + fnet = fnet - flx2 +! ---------------------------------------------------------------------- +! finish penman equation calculations. +! ---------------------------------------------------------------------- + end if + rad = fnet / rch + th2- sfctmp + a = elcpx * (q2sat - q2) +! a = elcp1 * (q2sat - q2) + epsca = (a * rr + rad * delta) / (delta + rr) + etp = epsca * rch / lsubc +! etp = epsca * rch / lvs + +! ---------------------------------------------------------------------- + end subroutine penman + + end module noahmpdrv diff --git a/physics/sfc_noahmp_drv.meta b/physics/sfc_noahmp_drv.meta new file mode 100644 index 000000000..066bc1e87 --- /dev/null +++ b/physics/sfc_noahmp_drv.meta @@ -0,0 +1,1212 @@ +[ccpp-arg-table] + name = noahmpdrv_init + type = scheme +[me] + standard_name = mpi_rank + long_name = current MPI-rank + units = index + dimensions = () + type = integer + intent = in + optional = F +[isot] + standard_name = soil_type_dataset_choice + long_name = soil type dataset choice + units = index + dimensions = () + type = integer + intent = in + optional = F +[ivegsrc] + standard_name = vegetation_type_dataset_choice + long_name = land use dataset choice + units = index + dimensions = () + type = integer + intent = in + optional = F +[nlunit] + standard_name = iounit_namelist + long_name = fortran unit number for file opens + units = none + dimensions = () + type = integer + intent = in + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F + +######################################################################## +[ccpp-arg-table] + name = noahmpdrv_run + type = scheme +[im] + standard_name = horizontal_dimension + long_name = horizontal dimension + units = count + dimensions = () + type = integer + intent = in + optional = F +[km] + standard_name = soil_vertical_dimension + long_name = soil vertical layer dimension + units = count + dimensions = () + type = integer + intent = in + optional = F +[itime] + standard_name = index_of_time_step + long_name = current forecast iteration + units = index + dimensions = () + type = integer + intent = in + optional = F +[ps] + standard_name = surface_air_pressure + long_name = surface pressure + units = Pa + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[u1] + standard_name = x_wind_at_lowest_model_layer + long_name = zonal wind at lowest model layer + units = m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[v1] + standard_name = y_wind_at_lowest_model_layer + long_name = meridional wind at lowest model layer + units = m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent= in + optional = F +[t1] + standard_name = air_temperature_at_lowest_model_layer + long_name = mean temperature at lowest model layer + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent= in + optional = F +[q1] + standard_name = water_vapor_specific_humidity_at_lowest_model_layer + long_name = water vapor specific humidity at lowest model layer + units = kg kg-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent= in + optional = F +[soiltyp] + standard_name = soil_type_classification + long_name = soil type at each grid cell + units = index + dimensions = (horizontal_dimension) + type = integer + intent= in + optional = F +[vegtype] + standard_name = vegetation_type_classification + long_name = vegetation type at each grid cell + units = index + dimensions = (horizontal_dimension) + type = integer + intent= in + optional = F +[sigmaf] + standard_name = bounded_vegetation_area_fraction + long_name = areal fractional cover of green vegetation bounded on the bottom + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent= in + optional = F +[sfcemis] + standard_name = surface_longwave_emissivity_over_land_interstitial + long_name = surface lw emissivity in fraction over land (temporary use as interstitial) + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[dlwflx] + standard_name = surface_downwelling_longwave_flux_absorbed_by_ground_over_land + long_name = total sky surface downward longwave flux absorbed by the ground over land + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[dswsfc] + standard_name = surface_downwelling_shortwave_flux + long_name = surface downwelling shortwave flux at current time + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent= in + optional = F +[snet] + standard_name = surface_net_downwelling_shortwave_flux + long_name = surface net downwelling shortwave flux at current time + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[delt] + standard_name = time_step_for_dynamics + long_name = dynamics timestep + units = s + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[tg3] + standard_name = deep_soil_temperature + long_name = deep soil temperature + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[cm] + standard_name = surface_drag_coefficient_for_momentum_in_air_over_land + long_name = surface exchange coeff for momentum over land + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[ch] + standard_name = surface_drag_coefficient_for_heat_and_moisture_in_air_over_land + long_name = surface exchange coeff heat & moisture over land + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[prsl1] + standard_name = air_pressure_at_lowest_model_layer + long_name = mean pressure at lowest model layer + units = Pa + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[prslki] + standard_name = ratio_of_exner_function_between_midlayer_and_interface_at_lowest_model_layer + long_name = Exner function ratio bt midlayer and interface at 1st layer + units = ratio + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[zf] + standard_name = height_above_ground_at_lowest_model_layer + long_name = layer 1 height above ground (not MSL) + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[dry] + standard_name = flag_nonzero_land_surface_fraction + long_name = flag indicating presence of some land surface area fraction + units = flag + dimensions = (horizontal_dimension) + type = logical + intent = in + optional = F +[wind] + standard_name = wind_speed_at_lowest_model_layer + long_name = wind speed at lowest model level + units = m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[slopetyp] + standard_name = surface_slope_classification + long_name = surface slope type at each grid cell + units = index + dimensions = (horizontal_dimension) + type = integer + intent = in + optional = F +[shdmin] + standard_name = minimum_vegetation_area_fraction + long_name = min fractional coverage of green vegetation + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[shdmax] + standard_name = maximum_vegetation_area_fraction + long_name = max fractional coverage of green vegetation + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[snoalb] + standard_name = upper_bound_on_max_albedo_over_deep_snow + long_name = maximum snow albedo + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[sfalb] + standard_name = surface_diffused_shortwave_albedo + long_name = mean surface diffused sw albedo + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[flag_iter] + standard_name = flag_for_iteration + long_name = flag for iteration + units = flag + dimensions = (horizontal_dimension) + type = logical + intent = in + optional = F +[flag_guess] + standard_name = flag_for_guess_run + long_name = flag for guess run + units = flag + dimensions = (horizontal_dimension) + type = logical + intent = in + optional = F +[lheatstrg] + standard_name = flag_for_canopy_heat_storage + long_name = flag for canopy heat storage parameterization + units = flag + dimensions = () + type = logical + intent = in + optional = F +[idveg] + standard_name = flag_for_dynamic_vegetation_option + long_name = choice for dynamic vegetation option (see noahmp module for definition) + units = index + dimensions = () + type = integer + intent = in + optional = F +[iopt_crs] + standard_name = flag_for_canopy_stomatal_resistance_option + long_name = choice for canopy stomatal resistance option (see noahmp module for definition) + units = index + dimensions = () + type = integer + intent = in + optional = F +[iopt_btr] + standard_name = flag_for_soil_moisture_factor_stomatal_resistance_option + long_name = choice for soil moisture factor for canopy stomatal resistance option (see noahmp module for definition) + units = index + dimensions = () + type = integer + intent = in + optional = F +[iopt_run] + standard_name = flag_for_runoff_and_groundwater_option + long_name = choice for runoff and groundwater option (see noahmp module for definition) + units = index + dimensions = () + type = integer + intent = in + optional = F +[iopt_sfc] + standard_name = flag_for_surface_layer_drag_coefficient_option + long_name = choice for surface layer drag coefficient option (see noahmp module for definition) + units = index + dimensions = () + type = integer + intent = in + optional = F +[iopt_frz] + standard_name = flag_for_supercooled_liquid_water_option + long_name = choice for supercooled liquid water option (see noahmp module for definition) + units = index + dimensions = () + type = integer + intent = in + optional = F +[iopt_inf] + standard_name = flag_for_frozen_soil_permeability_option + long_name = choice for frozen soil permeability option (see noahmp module for definition) + units = index + dimensions = () + type = integer + intent = in + optional = F +[iopt_rad] + standard_name = flag_for_radiation_transfer_option + long_name = choice for radiation transfer option (see noahmp module for definition) + units = index + dimensions = () + type = integer + intent = in + optional = F +[iopt_alb] + standard_name = flag_for_ground_snow_surface_albedo_option + long_name = choice for ground snow surface albedo option (see noahmp module for definition) + units = index + dimensions = () + type = integer + intent = in + optional = F +[iopt_snf] + standard_name = flag_for_precipitation_partition_option + long_name = choice for precipitation partition option (see noahmp module for definition) + units = index + dimensions = () + type = integer + intent = in + optional = F +[iopt_tbot] + standard_name = flag_for_lower_boundary_soil_temperature_option + long_name = choice for lower boundary soil temperature option (see noahmp module for definition) + units = index + dimensions = () + type = integer + intent = in + optional = F +[iopt_stc] + standard_name = flag_for_soil_and_snow_temperature_time_stepping_option + long_name = choice for soil and snow temperature time stepping option (see noahmp module for definition) + units = index + dimensions = () + type = integer + intent = in + optional = F +[xlatin] + standard_name = latitude + long_name = latitude + units = radians + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[xcoszin] + standard_name = instantaneous_cosine_of_zenith_angle + long_name = cosine of zenith angle at current time + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[iyrlen] + standard_name = number_of_days_in_year + long_name = number of days in a year + units = days + dimensions = () + type = integer + intent = in + optional = F +[julian] + standard_name = julian_day + long_name = julian day + units = days + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[rainn_mp] + standard_name = explicit_rainfall_rate_from_previous_timestep + long_name = explicit rainfall rate previous timestep + units = mm s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[rainc_mp] + standard_name = convective_precipitation_rate_from_previous_timestep + long_name = convective precipitation rate from previous timestep + units = mm s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[snow_mp] + standard_name = snow_precipitation_rate_from_previous_timestep + long_name = snow precipitation rate from previous timestep + units = mm s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[graupel_mp] + standard_name = graupel_precipitation_rate_from_previous_timestep + long_name = graupel precipitation rate from previous timestep + units = mm s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[ice_mp] + standard_name = ice_precipitation_rate_from_previous_timestep + long_name = ice precipitation rate from previous timestep + units = mm s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[con_hvap] + standard_name = latent_heat_of_vaporization_of_water_at_0C + long_name = latent heat of evaporation/sublimation + units = J kg-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[con_cp] + standard_name = specific_heat_of_dry_air_at_constant_pressure + long_name = specific heat of dry air at constant pressure + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[con_jcal] + standard_name = joules_per_calorie_constant + long_name = joules per calorie constant + units = J cal-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[rhoh2o] + standard_name = liquid_water_density + long_name = density of liquid water + units = kg m-3 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[con_eps] + standard_name = ratio_of_dry_air_to_water_vapor_gas_constants + long_name = rd/rv + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[con_epsm1] + standard_name = ratio_of_dry_air_to_water_vapor_gas_constants_minus_one + long_name = (rd/rv) - 1 + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[con_fvirt] + standard_name = ratio_of_vapor_to_dry_air_gas_constants_minus_one + long_name = (rv/rd) - 1 (rv = ideal gas constant for water vapor) + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[con_rd] + standard_name = gas_constant_dry_air + long_name = ideal gas constant for dry air + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[con_hfus] + standard_name = latent_heat_of_fusion_of_water_at_0C + long_name = latent heat of fusion + units = J kg-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[weasd] + standard_name = water_equivalent_accumulated_snow_depth_over_land + long_name = water equiv of acc snow depth over land + units = mm + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[snwdph] + standard_name = surface_snow_thickness_water_equivalent_over_land + long_name = water equivalent snow depth over land + units = mm + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[tskin] + standard_name = surface_skin_temperature_over_land_interstitial + long_name = surface skin temperature over land (temporary use as interstitial) + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[tprcp] + standard_name = nonnegative_lwe_thickness_of_precipitation_amount_on_dynamics_timestep_over_land + long_name = total precipitation amount in each time step over land + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[srflag] + standard_name = flag_for_precipitation_type + long_name = snow/rain flag for precipitation + units = flag + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[smc] + standard_name = volume_fraction_of_soil_moisture + long_name = total soil moisture + units = frac + dimensions = (horizontal_dimension,soil_vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[stc] + standard_name = soil_temperature + long_name = soil temperature + units = K + dimensions = (horizontal_dimension,soil_vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[slc] + standard_name = volume_fraction_of_unfrozen_soil_moisture + long_name = liquid soil moisture + units = frac + dimensions = (horizontal_dimension,soil_vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[canopy] + standard_name = canopy_water_amount + long_name = canopy water amount + units = kg m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[trans] + standard_name = transpiration_flux + long_name = total plant transpiration rate + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[tsurf] + standard_name = surface_skin_temperature_after_iteration_over_land + long_name = surface skin temperature after iteration over land + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[zorl] + standard_name = surface_roughness_length_over_land_interstitial + long_name = surface roughness length over land (temporary use as interstitial) + units = cm + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[snowxy] + standard_name = number_of_snow_layers + long_name = number of snow layers + units = count + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[tvxy] + standard_name = vegetation_temperature + long_name = vegetation temperature + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[tgxy] + standard_name = ground_temperature_for_noahmp + long_name = ground temperature for noahmp + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[canicexy] + standard_name = canopy_intercepted_ice_mass + long_name = canopy intercepted ice mass + units = mm + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[canliqxy] + standard_name = canopy_intercepted_liquid_water + long_name = canopy intercepted liquid water + units = mm + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[eahxy] + standard_name = canopy_air_vapor_pressure + long_name = canopy air vapor pressure + units = Pa + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[tahxy] + standard_name = canopy_air_temperature + long_name = canopy air temperature + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[cmxy] + standard_name = surface_drag_coefficient_for_momentum_for_noahmp + long_name = surface drag coefficient for momentum for noahmp + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[chxy] + standard_name = surface_drag_coefficient_for_heat_and_moisture_for_noahmp + long_name = surface exchange coeff heat & moisture for noahmp + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[fwetxy] + standard_name = area_fraction_of_wet_canopy + long_name = area fraction of canopy that is wetted/snowed + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[sneqvoxy] + standard_name = snow_mass_at_previous_time_step + long_name = snow mass at previous time step + units = mm + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[alboldxy] + standard_name = snow_albedo_at_previous_time_step + long_name = snow albedo at previous time step + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[qsnowxy] + standard_name = snow_precipitation_rate_at_surface + long_name = snow precipitation rate at surface + units = mm s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[wslakexy] + standard_name = lake_water_storage + long_name = lake water storage + units = mm + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[zwtxy] + standard_name = water_table_depth + long_name = water table depth + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[waxy] + standard_name = water_storage_in_aquifer + long_name = water storage in aquifer + units = mm + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[wtxy] + standard_name = water_storage_in_aquifer_and_saturated_soil + long_name = water storage in aquifer and saturated soil + units = mm + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[tsnoxy] + standard_name = snow_temperature + long_name = snow_temperature + units = K + dimensions = (horizontal_dimension, -2:0) + type = real + kind = kind_phys + intent = inout + optional = F +[zsnsoxy] + standard_name = layer_bottom_depth_from_snow_surface + long_name = depth from the top of the snow surface at the bottom of the layer + units = m + dimensions = (horizontal_dimension, -2:4) + type = real + kind = kind_phys + intent = inout + optional = F +[snicexy] + standard_name = snow_layer_ice + long_name = snow_layer_ice + units = mm + dimensions = (horizontal_dimension, -2:0) + type = real + kind = kind_phys + intent = inout + optional = F +[snliqxy] + standard_name = snow_layer_liquid_water + long_name = snow layer liquid water + units = mm + dimensions = (horizontal_dimension, -2:0) + type = real + kind = kind_phys + intent = inout + optional = F +[lfmassxy] + standard_name = leaf_mass + long_name = leaf mass + units = g m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[rtmassxy] + standard_name = fine_root_mass + long_name = fine root mass + units = g m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[stmassxy] + standard_name = stem_mass + long_name = stem mass + units = g m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[woodxy] + standard_name = wood_mass + long_name = wood mass including woody roots + units = g m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[stblcpxy] + standard_name = slow_soil_pool_mass_content_of_carbon + long_name = stable carbon in deep soil + units = g m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[fastcpxy] + standard_name = fast_soil_pool_mass_content_of_carbon + long_name = short-lived carbon in shallow soil + units = g m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[xlaixy] + standard_name = leaf_area_index + long_name = leaf area index + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[xsaixy] + standard_name = stem_area_index + long_name = stem area index + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[taussxy] + standard_name = nondimensional_snow_age + long_name = non-dimensional snow age + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[smoiseq] + standard_name = equilibrium_soil_water_content + long_name = equilibrium soil water content + units = m3 m-3 + dimensions = (horizontal_dimension,soil_vertical_dimension_for_land_surface_model) + type = real + kind = kind_phys + intent = inout + optional = F +[smcwtdxy] + standard_name = soil_water_content_between_soil_bottom_and_water_table + long_name = soil water content between the bottom of the soil and the water table + units = m3 m-3 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[deeprechxy] + standard_name = water_table_recharge_when_deep + long_name = recharge to or from the water table when deep + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[rechxy] + standard_name = water_table_recharge_when_shallow + long_name = recharge to or from the water table when shallow + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[sncovr1] + standard_name = surface_snow_area_fraction_over_land + long_name = surface snow area fraction + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[qsurf] + standard_name = surface_specific_humidity_over_land + long_name = surface air saturation specific humidity over land + units = kg kg-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[gflux] + standard_name = upward_heat_flux_in_soil_over_land + long_name = soil heat flux over land + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[drain] + standard_name = subsurface_runoff_flux + long_name = subsurface runoff flux + units = kg m-2 s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[evap] + standard_name = kinematic_surface_upward_latent_heat_flux_over_land + long_name = kinematic surface upward latent heat flux over land + units = kg kg-1 m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[hflx] + standard_name = kinematic_surface_upward_sensible_heat_flux_over_land + long_name = kinematic surface upward sensible heat flux over land + units = K m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[ep] + standard_name = surface_upward_potential_latent_heat_flux_over_land + long_name = surface upward potential latent heat flux over land + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[runoff] + standard_name = surface_runoff_flux + long_name = surface runoff flux + units = kg m-2 s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[cmm] + standard_name = surface_drag_wind_speed_for_momentum_in_air_over_land + long_name = momentum exchange coefficient over land + units = m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[chh] + standard_name = surface_drag_mass_flux_for_heat_and_moisture_in_air_over_land + long_name = thermal exchange coefficient over land + units = kg m-2 s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[evbs] + standard_name = soil_upward_latent_heat_flux + long_name = soil upward latent heat flux + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[evcw] + standard_name = canopy_upward_latent_heat_flux + long_name = canopy upward latent heat flux + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[sbsno] + standard_name = snow_deposition_sublimation_upward_latent_heat_flux + long_name = latent heat flux from snow depo/subl + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[snowc] + standard_name = surface_snow_area_fraction + long_name = surface snow area fraction + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[stm] + standard_name = soil_moisture_content + long_name = soil moisture + units = kg m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[snohf] + standard_name = snow_freezing_rain_upward_latent_heat_flux + long_name = latent heat flux due to snow and frz rain + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[smcwlt2] + standard_name = volume_fraction_of_condensed_water_in_soil_at_wilting_point + long_name = wilting point (volumetric) + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[smcref2] + standard_name = threshold_volume_fraction_of_condensed_water_in_soil + long_name = soil moisture threshold (volumetric) + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[wet1] + standard_name = normalized_soil_wetness + long_name = normalized soil wetness + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[t2mmp] + standard_name = temperature_at_2m_from_noahmp + long_name = 2 meter temperature from noahmp + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[q2mp] + standard_name = specific_humidity_at_2m_from_noahmp + long_name = 2 meter specific humidity from noahmp + units = kg kg-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F diff --git a/physics/sfc_nst.f b/physics/sfc_nst.f index a0e60f380..ed6387afb 100644 --- a/physics/sfc_nst.f +++ b/physics/sfc_nst.f @@ -21,97 +21,29 @@ end subroutine sfc_nst_init subroutine sfc_nst_finalize end subroutine sfc_nst_finalize -!>\defgroup gfs_nst_main GFS sfc_nst Main +!>\defgroup gfs_nst_main GFS Near-Surface Sea Temperature Scheme Module !> \brief This subroutine calls the Thermal Skin-layer and Diurnal Thermocline models to update the NSST profile. !! \section arg_table_sfc_nst_run Argument Table -!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | -!! |----------------|------------------------------------------------------------------------------|-------------------------------------------------------------|---------------|------|-----------|-----------|--------|----------| -!! | im | horizontal_loop_extent | horizontal loop extent | count | 0 | integer | | in | F | -!! | hvap | latent_heat_of_vaporization_of_water_at_0C | latent heat of evaporation/sublimation | J kg-1 | 0 | real | kind_phys | in | F | -!! | cp | specific_heat_of_dry_air_at_constant_pressure | specific heat of dry air at constant pressure | J kg-1 K-1 | 0 | real | kind_phys | in | F | -!! | hfus | latent_heat_of_fusion_of_water_at_0C | latent heat of fusion | J kg-1 | 0 | real | kind_phys | in | F | -!! | jcal | joules_per_calorie_constant | joules per calorie constant | J cal-1 | 0 | real | kind_phys | in | F | -!! | eps | ratio_of_dry_air_to_water_vapor_gas_constants | rd/rv | none | 0 | real | kind_phys | in | F | -!! | epsm1 | ratio_of_dry_air_to_water_vapor_gas_constants_minus_one | (rd/rv) - 1 | none | 0 | real | kind_phys | in | F | -!! | rvrdm1 | ratio_of_vapor_to_dry_air_gas_constants_minus_one | (rv/rd) - 1 (rv = ideal gas constant for water vapor) | none | 0 | real | kind_phys | in | F | -!! | rd | gas_constant_dry_air | ideal gas constant for dry air | J kg-1 K-1 | 0 | real | kind_phys | in | F | -!! | rhw0 | sea_water_reference_density | sea water reference density | kg m-3 | 0 | real | kind_phys | in | F | -!! | sbc | steffan_boltzmann_constant | Steffan-Boltzmann constant | W m-2 K-4 | 0 | real | kind_phys | in | F | -!! | pi | pi | ratio of a circle's circumference to its diameter | radians | 0 | real | kind_phys | in | F | -!! | ps | surface_air_pressure | surface pressure | Pa | 1 | real | kind_phys | in | F | -!! | u1 | x_wind_at_lowest_model_layer | x component of surface layer wind | m s-1 | 1 | real | kind_phys | in | F | -!! | v1 | y_wind_at_lowest_model_layer | y component of surface layer wind | m s-1 | 1 | real | kind_phys | in | F | -!! | t1 | air_temperature_at_lowest_model_layer | surface layer mean temperature | K | 1 | real | kind_phys | in | F | -!! | q1 | water_vapor_specific_humidity_at_lowest_model_layer | surface layer mean specific humidity | kg kg-1 | 1 | real | kind_phys | in | F | -!! | tref | sea_surface_reference_temperature | reference/foundation temperature | K | 1 | real | kind_phys | in | F | -!! | cm | surface_drag_coefficient_for_momentum_in_air_over_ocean | surface exchange coeff for momentum over ocean | none | 1 | real | kind_phys | in | F | -!! | ch | surface_drag_coefficient_for_heat_and_moisture_in_air_over_ocean | surface exchange coeff heat & moisture over ocean | none | 1 | real | kind_phys | in | F | -!! | prsl1 | air_pressure_at_lowest_model_layer | surface layer mean pressure | Pa | 1 | real | kind_phys | in | F | -!! | prslki | ratio_of_exner_function_between_midlayer_and_interface_at_lowest_model_layer | Exner function ratio bt midlayer and interface at 1st layer | ratio | 1 | real | kind_phys | in | F | -!! | wet | flag_nonzero_wet_surface_fraction | flag indicating presence of some ocean or lake surface area fraction | flag | 1 | logical | | in | F | -!! | icy | flag_nonzero_sea_ice_surface_fraction | flag indicating presence of some sea ice surface area fraction | flag | 1 | logical | | in | F | -!! | xlon | longitude | longitude | radians | 1 | real | kind_phys | in | F | -!! | sinlat | sine_of_latitude | sine of latitude | none | 1 | real | kind_phys | in | F | -!! | stress | surface_wind_stress_over_ocean | surface wind stress over ocean | m2 s-2 | 1 | real | kind_phys | in | F | -!! | sfcemis | surface_longwave_emissivity | surface longwave emissivity | frac | 1 | real | kind_phys | in | F | -!! | dlwflx | surface_downwelling_longwave_flux_absorbed_by_ground | total sky sfc downward lw flux absorbed by the ocean | W m-2 | 1 | real | kind_phys | in | F | -!! | sfcnsw | surface_net_downwelling_shortwave_flux | total sky sfc net sw flx into ocean | W m-2 | 1 | real | kind_phys | in | F | -!! | rain | nonnegative_lwe_thickness_of_precipitation_amount_on_dynamics_timestep_over_ocean | total precipitation amount in each time step over ocean | m | 1 | real | kind_phys | in | F | -!! | timestep | time_step_for_dynamics | timestep interval | s | 0 | real | kind_phys | in | F | -!! | kdt | index_of_time_step | current time step index | index | 0 | integer | | in | F | -!! | solhr | forecast_hour | fcst hour at the end of prev time step | h | 0 | real | kind_phys | in | F | -!! | xcosz | instantaneous_cosine_of_zenith_angle | cosine of solar zenith angle | none | 1 | real | kind_phys | in | F | -!! | ddvel | surface_wind_enhancement_due_to_convection | wind enhancement due to convection | m s-1 | 1 | real | kind_phys | in | F | -!! | flag_iter | flag_for_iteration | flag for iteration | flag | 1 | logical | | in | F | -!! | flag_guess | flag_for_guess_run | flag for guess run | flag | 1 | logical | | in | F | -!! | nstf_name1 | flag_for_nsstm_run | NSSTM flag: off/uncoupled/coupled=0/1/2 | flag | 0 | integer | | in | F | -!! | nstf_name4 | vertical_temperature_average_range_lower_bound | zsea1 | mm | 0 | integer | | in | F | -!! | nstf_name5 | vertical_temperature_average_range_upper_bound | zsea2 | mm | 0 | integer | | in | F | -!! | lprnt | flag_print | flag for printing diagnostics to output | flag | 0 | logical | | in | F | -!! | ipr | horizontal_index_of_printed_column | horizontal index of printed column | index | 0 | integer | | in | F | -!! | tskin | surface_skin_temperature_for_nsst | ocean surface skin temperature | K | 1 | real | kind_phys | inout | F | -!! | tsurf | surface_skin_temperature_after_iteration_over_ocean | surface skin temperature after iteration over ocean | K | 1 | real | kind_phys | inout | F | -!! | xt | diurnal_thermocline_layer_heat_content | heat content in diurnal thermocline layer | K m | 1 | real | kind_phys | inout | F | -!! | xs | sea_water_salinity | salinity content in diurnal thermocline layer | ppt m | 1 | real | kind_phys | inout | F | -!! | xu | diurnal_thermocline_layer_x_current | u-current content in diurnal thermocline layer | m2 s-1 | 1 | real | kind_phys | inout | F | -!! | xv | diurnal_thermocline_layer_y_current | v-current content in diurnal thermocline layer | m2 s-1 | 1 | real | kind_phys | inout | F | -!! | xz | diurnal_thermocline_layer_thickness | diurnal thermocline layer thickness | m | 1 | real | kind_phys | inout | F | -!! | zm | ocean_mixed_layer_thickness | mixed layer thickness | m | 1 | real | kind_phys | inout | F | -!! | xtts | sensitivity_of_dtl_heat_content_to_surface_temperature | d(xt)/d(ts) | m | 1 | real | kind_phys | inout | F | -!! | xzts | sensitivity_of_dtl_thickness_to_surface_temperature | d(xz)/d(ts) | m K-1 | 1 | real | kind_phys | inout | F | -!! | dt_cool | sub-layer_cooling_amount | sub-layer cooling amount | K | 1 | real | kind_phys | inout | F | -!! | z_c | sub-layer_cooling_thickness | sub-layer cooling thickness | m | 1 | real | kind_phys | inout | F | -!! | c_0 | coefficient_c_0 | coefficient1 to calculate d(tz)/d(ts) | none | 1 | real | kind_phys | inout | F | -!! | c_d | coefficient_c_d | coefficient2 to calculate d(tz)/d(ts) | none | 1 | real | kind_phys | inout | F | -!! | w_0 | coefficient_w_0 | coefficient3 to calculate d(tz)/d(ts) | none | 1 | real | kind_phys | inout | F | -!! | w_d | coefficient_w_d | coefficient4 to calculate d(tz)/d(ts) | none | 1 | real | kind_phys | inout | F | -!! | d_conv | free_convection_layer_thickness | thickness of free convection layer | m | 1 | real | kind_phys | inout | F | -!! | ifd | index_of_dtlm_start | index to start dtlm run or not | index | 1 | real | kind_phys | inout | F | -!! | qrain | sensible_heat_flux_due_to_rainfall | sensible heat flux due to rainfall | W | 1 | real | kind_phys | inout | F | -!! | qsurf | surface_specific_humidity_over_ocean | surface air saturation specific humidity over ocean | kg kg-1 | 1 | real | kind_phys | inout | F | -!! | gflux | upward_heat_flux_in_soil_over_ocean | soil heat flux over ocean | W m-2 | 1 | real | kind_phys | inout | F | -!! | cmm | surface_drag_wind_speed_for_momentum_in_air_over_ocean | momentum exchange coefficient over ocean | m s-1 | 1 | real | kind_phys | inout | F | -!! | chh | surface_drag_mass_flux_for_heat_and_moisture_in_air_over_ocean | thermal exchange coefficient over ocean | kg m-2 s-1 | 1 | real | kind_phys | inout | F | -!! | evap | kinematic_surface_upward_latent_heat_flux_over_ocean | kinematic surface upward latent heat flux over ocean | kg kg-1 m s-1 | 1 | real | kind_phys | inout | F | -!! | hflx | kinematic_surface_upward_sensible_heat_flux_over_ocean | kinematic surface upward sensible heat flux over ocean | K m s-1 | 1 | real | kind_phys | inout | F | -!! | ep | surface_upward_potential_latent_heat_flux_over_ocean | surface upward potential latent heat flux over ocean | W m-2 | 1 | real | kind_phys | inout | F | -!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | -!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | +!! \htmlinclude sfc_nst_run.html !! !! \section NSST_general_algorithm GFS Near-Surface Sea Temperature Scheme General Algorithm !> @{ subroutine sfc_nst_run & +! --- inputs: & ( im, hvap, cp, hfus, jcal, eps, epsm1, rvrdm1, rd, rhw0, & & pi, sbc, ps, u1, v1, t1, q1, tref, cm, ch, & - & prsl1, prslki, wet, icy, xlon, sinlat, stress, & + & prsl1, prslki, prsik1, prslk1, wet, xlon, sinlat, & + & stress, & & sfcemis, dlwflx, sfcnsw, rain, timestep, kdt, solhr,xcosz, & - & ddvel, flag_iter, flag_guess, nstf_name1, nstf_name4, & - & nstf_name5, lprnt, ipr, & ! inputs from here and above + & wind, flag_iter, flag_guess, nstf_name1, nstf_name4, & + & nstf_name5, lprnt, ipr, & +! --- input/output: & tskin, tsurf, xt, xs, xu, xv, xz, zm, xtts, xzts, dt_cool, & - & z_c, c_0, c_d, w_0, w_d, d_conv, ifd, qrain, & ! in/outs from here and above - & qsurf, gflux, cmm, chh, evap, hflx, ep, errmsg, errflg & ! outputs + & z_c, c_0, c_d, w_0, w_d, d_conv, ifd, qrain, & +! --- outputs: + & qsurf, gflux, cmm, chh, evap, hflx, ep, errmsg, errflg & & ) - +! ! ===================================================================== ! ! description: ! ! ! @@ -121,9 +53,9 @@ subroutine sfc_nst_run & ! call sfc_nst ! ! inputs: ! ! ( im, ps, u1, v1, t1, q1, tref, cm, ch, ! -! prsl1, prslki, iwet, iice, xlon, sinlat, stress, ! +! prsl1, prslki, wet, xlon, sinlat, stress, ! ! sfcemis, dlwflx, sfcnsw, rain, timestep, kdt,solhr,xcosz, ! -! ddvel, flag_iter, flag_guess, nstf_name1, nstf_name4, ! +! wind, flag_iter, flag_guess, nstf_name1, nstf_name4, ! ! nstf_name5, lprnt, ipr, ! ! input/outputs: ! ! tskin, tsurf, xt, xs, xu, xv, xz, zm, xtts, xzts, dt_cool, ! @@ -165,25 +97,22 @@ subroutine sfc_nst_run & ! ch - real, surface exchange coeff heat & moisture(m/s) im ! ! prsl1 - real, surface layer mean pressure (pa) im ! ! prslki - real, im ! -! wet - logical, =T if any ocn/lak water (F otherwise) im ! -! icy - logical, =T if "enough" ice (F otherwise) im ! +! prsik1 - real, im ! +! prslk1 - real, im ! +! wet - logical, =T if any ocn/lake water (F otherwise) im ! +! icy - logical, =T if any ice im ! ! xlon - real, longitude (radians) im ! ! sinlat - real, sin of latitude im ! ! stress - real, wind stress (n/m**2) im ! ! sfcemis - real, sfc lw emissivity (fraction) im ! ! dlwflx - real, total sky sfc downward lw flux (w/m**2) im ! ! sfcnsw - real, total sky sfc netsw flx into ocean (w/m**2) im ! -! DH* -! The actual unit of rain passed in is m ! see below line 438, qrain(i) = ... -! where 1000*rain in the nominator converts m to kg m^2; there is still a -! time unit 's' missing. Need to double-check what is going on. -! *DH ! rain - real, rainfall rate (kg/m**2/s) im ! ! timestep - real, timestep interval (second) 1 ! ! kdt - integer, time step counter 1 ! ! solhr - real, fcst hour at the end of prev time step 1 ! ! xcosz - real, consine of solar zenith angle 1 ! -! ddvel - real, wind enhancement due to convection (m/s) im ! +! wind - real, wind speed (m/s) im ! ! flag_iter- logical, execution or not im ! ! when iter = 1, flag_iter = .true. for all grids im ! ! when iter = 2, flag_iter = .true. when wind < 2 im ! @@ -262,13 +191,14 @@ subroutine sfc_nst_run & real (kind=kind_phys), intent(in) :: hvap, cp, hfus, jcal, eps, & & epsm1, rvrdm1, rd, rhw0, sbc, pi real (kind=kind_phys), dimension(im), intent(in) :: ps, u1, v1, & - & t1, q1, tref, cm, ch, prsl1, prslki, xlon,xcosz, & - & sinlat, stress, sfcemis, dlwflx, sfcnsw, rain, ddvel + & t1, q1, tref, cm, ch, prsl1, prslki, prsik1, prslk1, & + & xlon,xcosz, & + & sinlat, stress, sfcemis, dlwflx, sfcnsw, rain, wind real (kind=kind_phys), intent(in) :: timestep real (kind=kind_phys), intent(in) :: solhr - logical, dimension(im), intent(in) :: flag_iter, flag_guess, wet, & - & icy + logical, dimension(im), intent(in) :: flag_iter, flag_guess, wet +! &, icy logical, intent(in) :: lprnt ! --- input/outputs: @@ -290,7 +220,7 @@ subroutine sfc_nst_run & integer :: k,i ! real (kind=kind_phys), dimension(im) :: q0, qss, rch, - & rho_a, theta1, tv1, wind, wndmag + & rho_a, theta1, tv1, wndmag real(kind=kind_phys) elocp,tem,cpinv,hvapi ! @@ -322,22 +252,24 @@ subroutine sfc_nst_run & errmsg = '' errflg = 0 - cpinv=1.0/cp - hvapi=1.0/hvap - elocp=hvap/cp + cpinv = 1.0/cp + hvapi = 1.0/hvap + elocp = hvap/cp sss = 34.0 ! temporarily, when sea surface salinity data is not ready ! ! flag for open water and where the iteration is on ! do i = 1, im - flag(i) = wet(i) .and. .not.icy(i) .and. flag_iter(i) +! flag(i) = wet(i) .and. .not.icy(i) .and. flag_iter(i) + flag(i) = wet(i) .and. flag_iter(i) enddo ! ! save nst-related prognostic fields for guess run ! do i=1, im - if(wet(i) .and. .not.icy(i) .and. flag_guess(i)) then +! if(wet(i) .and. .not.icy(i) .and. flag_guess(i)) then + if(wet(i) .and. flag_guess(i)) then xt_old(i) = xt(i) xs_old(i) = xs(i) xu_old(i) = xu(i) @@ -364,11 +296,13 @@ subroutine sfc_nst_run & nswsfc(i) = sfcnsw(i) ! net solar radiation at the air-sea surface (positive downward) wndmag(i) = sqrt(u1(i)*u1(i) + v1(i)*v1(i)) - wind(i) = wndmag(i) + max( 0.0, min( ddvel(i), 30.0 ) ) - wind(i) = max( wind(i), 1.0 ) q0(i) = max(q1(i), 1.0e-8) +#ifdef GSD_SURFACE_FLUXES_BUGFIX + theta1(i) = t1(i) / prslk1(i) ! potential temperature at the middle of lowest model layer +#else theta1(i) = t1(i) * prslki(i) +#endif tv1(i) = t1(i) * (1.0 + rvrdm1*q0(i)) rho_a(i) = prsl1(i) / (rd*tv1(i)) qss(i) = fpvs(tsurf(i)) ! pa @@ -389,7 +323,11 @@ subroutine sfc_nst_run & ! at previous time step evap(i) = elocp * rch(i) * (qss(i) - q0(i)) qsurf(i) = qss(i) +#ifdef GSD_SURFACE_FLUXES_BUGFIX + hflx(i) = rch(i) * (tsurf(i)/prsik1(i) - theta1(i)) +#else hflx(i) = rch(i) * (tsurf(i) - theta1(i)) +#endif ! if (lprnt .and. i == ipr) print *,' tskin=',tskin(i),' theta1=', ! & theta1(i),' hflx=',hflx(i),' t1=',t1(i),'prslki=',prslki(i) @@ -620,8 +558,8 @@ subroutine sfc_nst_run & & zsea1,zsea2,dtz) tsurf(i) = max(271.2, tref(i) + dtz ) - if (lprnt .and. i == ipr) print *,' tsurf=',tsurf(i),' tref=', - &tref(i),' xz=',xz(i),' dt_cool=',dt_cool(i) +! if (lprnt .and. i == ipr) print *,' tsurf=',tsurf(i),' tref=', +! &tref(i),' xz=',xz(i),' dt_cool=',dt_cool(i) !> - Call cal_w() to calculate \a w_0 and \a w_d. if ( xt(i) > 0.0 ) then @@ -646,8 +584,9 @@ subroutine sfc_nst_run & ! restore nst-related prognostic fields for guess run do i=1, im - if(wet(i) .and. .not.icy(i)) then - if(flag_guess(i)) then ! when it is guess of +! if (wet(i) .and. .not.icy(i)) then + if (wet(i)) then + if (flag_guess(i)) then ! when it is guess of xt(i) = xt_old(i) xs(i) = xs_old(i) xu(i) = xu_old(i) @@ -667,9 +606,9 @@ subroutine sfc_nst_run & ! if ( nstf_name1 > 1 ) then tskin(i) = tsurf(i) - endif ! if ( nstf_name1 > 1 then - endif ! if(flag_guess(i)) then - endif ! if(wet(i) .and. .not.icy(i)) then + endif ! if nstf_name1 > 1 then + endif ! if flag_guess(i) then + endif ! if wet(i) .and. .not.icy(i) then enddo ! if (lprnt .and. i == ipr) print *,' beg xz8=',xz(i) @@ -683,7 +622,11 @@ subroutine sfc_nst_run & qss(i) = eps*qss(i) / (ps(i) + epsm1*qss(i)) qsurf(i) = qss(i) evap(i) = elocp*rch(i) * (qss(i) - q0(i)) +#ifdef GSD_SURFACE_FLUXES_BUGFIX + hflx(i) = rch(i) * (tskin(i)/prsik1(i) - theta1(i)) +#else hflx(i) = rch(i) * (tskin(i) - theta1(i)) +#endif endif enddo endif ! if ( nstf_name1 > 1 ) then @@ -727,48 +670,13 @@ subroutine sfc_nst_pre_finalize end subroutine sfc_nst_pre_finalize !! \section arg_table_sfc_nst_pre_run Argument Table -!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | -!! |----------------|-------------------------------------------------------------------|-----------------------------------------------------------------------|---------------|------|-------------|-----------|--------|----------| -!! | im | horizontal_loop_extent | horizontal loop extent | count | 0 | integer | | in | F | -!! | rlapse | air_temperature_lapse_rate_constant | environmental air temperature lapse rate constant | K m-1 | 0 | real | kind_phys | in | F | -!! | icy | flag_nonzero_sea_ice_surface_fraction | flag indicating presence of some sea ice surface area fraction | flag | 1 | logical | | in | F | -!! | wet | flag_nonzero_wet_surface_fraction | flag indicating presence of some ocean or lake surface area fraction | flag | 1 | logical | | in | F | -!! | zorl_ocn | surface_roughness_length_over_ocean_interstitial | surface roughness length over ocean (temporary use as interstitial) | cm | 1 | real | kind_phys | inout | F | -!! | zorl_ice | surface_roughness_length_over_ice_interstitial | surface roughness length over ice (temporary use as interstitial) | cm | 1 | real | kind_phys | in | F | -!! | cd_ocn | surface_drag_coefficient_for_momentum_in_air_over_ocean | surface exchange coeff for momentum over ocean | none | 1 | real | kind_phys | inout | F | -!! | cd_ice | surface_drag_coefficient_for_momentum_in_air_over_ice | surface exchange coeff for momentum over ice | none | 1 | real | kind_phys | in | F | -!! | cdq_ocn | surface_drag_coefficient_for_heat_and_moisture_in_air_over_ocean | surface exchange coeff heat & moisture over ocean | none | 1 | real | kind_phys | inout | F | -!! | cdq_ice | surface_drag_coefficient_for_heat_and_moisture_in_air_over_ice | surface exchange coeff heat & moisture over ice | none | 1 | real | kind_phys | in | F | -!! | rb_ocn | bulk_richardson_number_at_lowest_model_level_over_ocean | bulk Richardson number at the surface over ocean | none | 1 | real | kind_phys | inout | F | -!! | rb_ice | bulk_richardson_number_at_lowest_model_level_over_ice | bulk Richardson number at the surface over ice | none | 1 | real | kind_phys | in | F | -!! | stress_ocn | surface_wind_stress_over_ocean | surface wind stress over ocean | m2 s-2 | 1 | real | kind_phys | inout | F | -!! | stress_ice | surface_wind_stress_over_ice | surface wind stress over ice | m2 s-2 | 1 | real | kind_phys | in | F | -!! | ffmm_ocn | Monin-Obukhov_similarity_function_for_momentum_over_ocean | Monin-Obukhov similarity function for momentum over ocean | none | 1 | real | kind_phys | inout | F | -!! | ffmm_ice | Monin-Obukhov_similarity_function_for_momentum_over_ice | Monin-Obukhov similarity function for momentum over ice | none | 1 | real | kind_phys | in | F | -!! | ffhh_ocn | Monin-Obukhov_similarity_function_for_heat_over_ocean | Monin-Obukhov similarity function for heat over ocean | none | 1 | real | kind_phys | inout | F | -!! | ffhh_ice | Monin-Obukhov_similarity_function_for_heat_over_ice | Monin-Obukhov similarity function for heat over ice | none | 1 | real | kind_phys | in | F | -!! | uustar_ocn | surface_friction_velocity_over_ocean | surface friction velocity over ocean | m s-1 | 1 | real | kind_phys | inout | F | -!! | uustar_ice | surface_friction_velocity_over_ice | surface friction velocity over ice | m s-1 | 1 | real | kind_phys | in | F | -!! | fm10_ocn | Monin-Obukhov_similarity_function_for_momentum_at_10m_over_ocean | Monin-Obukhov similarity parameter for momentum at 10m over ocean | none | 1 | real | kind_phys | inout | F | -!! | fm10_ice | Monin-Obukhov_similarity_function_for_momentum_at_10m_over_ice | Monin-Obukhov similarity parameter for momentum at 10m over ice | none | 1 | real | kind_phys | in | F | -!! | fh2_ocn | Monin-Obukhov_similarity_function_for_heat_at_2m_over_ocean | Monin-Obukhov similarity parameter for heat at 2m over ocean | none | 1 | real | kind_phys | inout | F | -!! | fh2_ice | Monin-Obukhov_similarity_function_for_heat_at_2m_over_ice | Monin-Obukhov similarity parameter for heat at 2m over ice | none | 1 | real | kind_phys | in | F | -!! | oro | orography | orography | m | 1 | real | kind_phys | in | F | -!! | oro_uf | orography_unfiltered | unfiltered orographyo | m | 1 | real | kind_phys | in | F | -!! | tsfc_ocn | surface_skin_temperature_over_ocean_interstitial | surface skin temperature over ocean (temporary use as interstitial) | K | 1 | real | kind_phys | in | F | -!! | tsurf_ocn | surface_skin_temperature_after_iteration_over_ocean | surface skin temperature after iteration over ocean | K | 1 | real | kind_phys | inout | F | -!! | tseal | surface_skin_temperature_for_nsst | ocean surface skin temperature | K | 1 | real | kind_phys | inout | F | -!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | -!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | +!! \htmlinclude sfc_nst_pre_run.html !! !> \section NSST_general_pre_algorithm General Algorithm !! @{ subroutine sfc_nst_pre_run - & (im, rlapse, icy, wet, zorl_ocn, zorl_ice, cd_ocn, cd_ice, - & cdq_ocn, cdq_ice, rb_ocn, rb_ice, stress_ocn, stress_ice, - & ffmm_ocn, ffmm_ice, ffhh_ocn, ffhh_ice, uustar_ocn, - & uustar_ice, fm10_ocn, fm10_ice, fh2_ocn, fh2_ice, oro, - & oro_uf, tsfc_ocn, tsurf_ocn, tseal, errmsg, errflg) + & (im, wet, tsfc_ocn, tsurf_ocn, tseal, xt, xz, dt_cool, + & z_c, tref, cplflx, errmsg, errflg) use machine , only : kind_phys @@ -776,16 +684,14 @@ subroutine sfc_nst_pre_run ! --- inputs: integer, intent(in) :: im - logical, dimension(im), intent(in) :: icy, wet - real (kind=kind_phys), intent(in) :: rlapse - real (kind=kind_phys), dimension(im), intent(in) :: zorl_ice, - & cd_ice, cdq_ice, rb_ice, stress_ice, ffmm_ice, ffhh_ice, - & uustar_ice, fm10_ice, fh2_ice, oro, oro_uf, tsfc_ocn + logical, dimension(im), intent(in) :: wet + real (kind=kind_phys), dimension(im), intent(in) :: + & tsfc_ocn, xt, xz, dt_cool, z_c + logical, intent(in) :: cplflx ! --- input/outputs: - real (kind=kind_phys), dimension(im), intent(inout) :: tsurf_ocn, - & zorl_ocn, cd_ocn, cdq_ocn, rb_ocn, stress_ocn, ffmm_ocn, - & ffhh_ocn, uustar_ocn, fm10_ocn, fh2_ocn, tseal + real (kind=kind_phys), dimension(im), intent(inout) :: + & tsurf_ocn, tseal, tref ! --- outputs: character(len=*), intent(out) :: errmsg @@ -793,34 +699,47 @@ subroutine sfc_nst_pre_run ! --- locals integer :: i - real(kind=kind_phys) :: tem + real(kind=kind_phys), parameter :: zero = 0.0d0, + & one = 1.0d0, + & half = 0.5d0, + & omz1 = 10.0d0 + real(kind=kind_phys) :: tem1, tem2, dt_warm ! Initialize CCPP error handling variables errmsg = '' errflg = 0 do i=1,im - if(icy(i)) then - zorl_ocn(i) = zorl_ice(i) - cd_ocn(i) = cd_ice(i) - cdq_ocn(i) = cdq_ice(i) - rb_ocn(i) = rb_ice(i) - stress_ocn(i) = stress_ice(i) - ffmm_ocn(i) = ffmm_ice(i) - ffhh_ocn(i) = ffhh_ice(i) - uustar_ocn(i) = uustar_ice(i) - fm10_ocn(i) = fm10_ice(i) - fh2_ocn(i) = fh2_ice(i) + if (wet(i)) then +! tem = (oro(i)-oro_uf(i)) * rlapse + ! DH* 20190927 simplyfing this code because tem is zero + !tem = zero + !tseal(i) = tsfc_ocn(i) + tem + tseal(i) = tsfc_ocn(i) + !tsurf_ocn(i) = tsurf_ocn(i) + tem + ! *DH endif enddo - do i=1,im - if (wet(i) .and. .not. icy(i)) then - tem = (oro(i)-oro_uf(i)) * rlapse - tseal(i) = tsfc_ocn(i) + tem - tsurf_ocn(i) = tsurf_ocn(i) + tem - endif - enddo + if (cplflx) then + tem1 = half / omz1 + do i=1,im + if (wet(i)) then + tem2 = one / xz(i) + dt_warm = (xt(i)+xt(i)) * tem2 + if ( xz(i) > omz1) then + tref(i) = tseal(i) - (one-half*omz1*tem2) * dt_warm & + & + z_c(i)*dt_cool(i)*tem1 + else + tref(i) = tseal(i) - (xz(i)*dt_warm & + & - z_c(i)*dt_cool(i))*tem1 + endif + tseal(i) = tref(i) + dt_warm - dt_cool(i) +! - (Sfcprop%oro(i)-Sfcprop%oro_uf(i))*rlapse + tsurf_ocn(i) = tseal(i) + endif + enddo + endif return end subroutine sfc_nst_pre_run @@ -851,28 +770,7 @@ end subroutine sfc_nst_post_finalize !> \brief Brief description of the subroutine !! !! \section arg_table_sfc_nst_post_run Argument Table -!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | -!! |----------------|--------------------------------------------------------|----------------------------------------------------------------------|---------|------|-----------|-----------|--------|----------| -!! | im | horizontal_loop_extent | horizontal loop extent | count | 0 | integer | | in | F | -!! | rlapse | air_temperature_lapse_rate_constant | environmental air temperature lapse rate constant | K m-1 | 0 | real | kind_phys | in | F | -!! | wet | flag_nonzero_wet_surface_fraction | flag indicating presence of some ocean or lake surface area fraction | flag | 1 | logical | | in | F | -!! | icy | flag_nonzero_sea_ice_surface_fraction | flag indicating presence of some sea ice surface area fraction | flag | 1 | logical | | in | F | -!! | oro | orography | orography | m | 1 | real | kind_phys | in | F | -!! | oro_uf | orography_unfiltered | unfiltered orography | m | 1 | real | kind_phys | in | F | -!! | nstf_name1 | flag_for_nsstm_run | NSSTM flag: off/uncoupled/coupled=0/1/2 | flag | 0 | integer | | in | F | -!! | nstf_name4 | vertical_temperature_average_range_lower_bound | zsea1 | mm | 0 | integer | | in | F | -!! | nstf_name5 | vertical_temperature_average_range_upper_bound | zsea2 | mm | 0 | integer | | in | F | -!! | xt | diurnal_thermocline_layer_heat_content | heat content in diurnal thermocline layer | K m | 1 | real | kind_phys | in | F | -!! | xz | diurnal_thermocline_layer_thickness | diurnal thermocline layer thickness | m | 1 | real | kind_phys | in | F | -!! | dt_cool | sub-layer_cooling_amount | sub-layer cooling amount | K | 1 | real | kind_phys | in | F | -!! | z_c | sub-layer_cooling_thickness | sub-layer cooling thickness | m | 1 | real | kind_phys | in | F | -!! | tref | sea_surface_reference_temperature | reference/foundation temperature | K | 1 | real | kind_phys | in | F | -!! | xlon | longitude | longitude | radians | 1 | real | kind_phys | in | F | -!! | tsurf_ocn | surface_skin_temperature_after_iteration_over_ocean | surface skin temperature after iteration over ocean | K | 1 | real | kind_phys | inout | F | -!! | tsfc_ocn | surface_skin_temperature_over_ocean_interstitial | surface skin temperature over ocean (temporary use as interstitial) | K | 1 | real | kind_phys | inout | F | -!! | dtzm | mean_change_over_depth_in_sea_water_temperature | mean of dT(z) (zsea1 to zsea2) | K | 1 | real | kind_phys | out | F | -!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | -!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | +!! \htmlinclude sfc_nst_post_run.html !! ! \section NSST_general_post_algorithm General Algorithm ! @@ -921,11 +819,11 @@ subroutine sfc_nst_post_run & ! & ' dt_cool=',dt_cool(ipr),' dt_warm=',2.0*xt(ipr)/xz(ipr), ! & ' kdt=',kdt - do i = 1, im - if (wet(i) .and. .not. icy(i)) then - tsurf_ocn(i) = tsurf_ocn(i) - (oro(i)-oro_uf(i)) * rlapse - endif - enddo +! do i = 1, im +! if (wet(i) .and. .not. icy(i)) then +! tsurf_ocn(i) = tsurf_ocn(i) - (oro(i)-oro_uf(i)) * rlapse +! endif +! enddo ! --- ... run nsst model ... --- @@ -934,12 +832,15 @@ subroutine sfc_nst_post_run & zsea1 = 0.001*real(nstf_name4) zsea2 = 0.001*real(nstf_name5) call get_dtzm_2d (xt, xz, dt_cool, & - & z_c, wet, icy, zsea1, zsea2, & + & z_c, wet, zsea1, zsea2, & & im, 1, dtzm) do i = 1, im - if ( wet(i) .and. .not. icy(i) ) then - tsfc_ocn(i) = max(271.2,tref(i) + dtzm(i)) - & - & (oro(i)-oro_uf(i))*rlapse +! if (wet(i) .and. .not.icy(i)) then +! if (wet(i) .and. (Model%frac_grid .or. .not. icy(i))) then + if (wet(i)) then + tsfc_ocn(i) = max(271.2, tref(i) + dtzm(i)) +! tsfc_ocn(i) = max(271.2, tref(i) + dtzm(i)) - & +! (oro(i)-oro_uf(i))*rlapse endif enddo endif diff --git a/physics/sfc_nst.meta b/physics/sfc_nst.meta new file mode 100644 index 000000000..d74f68c0e --- /dev/null +++ b/physics/sfc_nst.meta @@ -0,0 +1,966 @@ +[ccpp-arg-table] + name = sfc_nst_init + type = scheme + +######################################################################## +[ccpp-arg-table] + name = sfc_nst_finalize + type = scheme + +######################################################################## +[ccpp-arg-table] + name = sfc_nst_run + type = scheme +[im] + standard_name = horizontal_loop_extent + long_name = horizontal loop extent + units = count + dimensions = () + type = integer + intent = in + optional = F +[hvap] + standard_name = latent_heat_of_vaporization_of_water_at_0C + long_name = latent heat of evaporation/sublimation + units = J kg-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[cp] + standard_name = specific_heat_of_dry_air_at_constant_pressure + long_name = specific heat of dry air at constant pressure + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[hfus] + standard_name = latent_heat_of_fusion_of_water_at_0C + long_name = latent heat of fusion + units = J kg-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[jcal] + standard_name = joules_per_calorie_constant + long_name = joules per calorie constant + units = J cal-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[eps] + standard_name = ratio_of_dry_air_to_water_vapor_gas_constants + long_name = rd/rv + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[epsm1] + standard_name = ratio_of_dry_air_to_water_vapor_gas_constants_minus_one + long_name = (rd/rv) - 1 + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[rvrdm1] + standard_name = ratio_of_vapor_to_dry_air_gas_constants_minus_one + long_name = (rv/rd) - 1 (rv = ideal gas constant for water vapor) + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[rd] + standard_name = gas_constant_dry_air + long_name = ideal gas constant for dry air + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[rhw0] + standard_name = sea_water_reference_density + long_name = sea water reference density + units = kg m-3 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[sbc] + standard_name = stefan_boltzmann_constant + long_name = Stefan-Boltzmann constant + units = W m-2 K-4 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[pi] + standard_name = pi + long_name = ratio of a circle's circumference to its diameter + units = radians + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[ps] + standard_name = surface_air_pressure + long_name = surface pressure + units = Pa + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[u1] + standard_name = x_wind_at_lowest_model_layer + long_name = x component of surface layer wind + units = m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[v1] + standard_name = y_wind_at_lowest_model_layer + long_name = y component of surface layer wind + units = m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[t1] + standard_name = air_temperature_at_lowest_model_layer + long_name = surface layer mean temperature + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[q1] + standard_name = water_vapor_specific_humidity_at_lowest_model_layer + long_name = surface layer mean specific humidity + units = kg kg-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[tref] + standard_name = sea_surface_reference_temperature + long_name = reference/foundation temperature + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[cm] + standard_name = surface_drag_coefficient_for_momentum_in_air_over_ocean + long_name = surface exchange coeff for momentum over ocean + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[ch] + standard_name = surface_drag_coefficient_for_heat_and_moisture_in_air_over_ocean + long_name = surface exchange coeff heat & moisture over ocean + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[prsl1] + standard_name = air_pressure_at_lowest_model_layer + long_name = surface layer mean pressure + units = Pa + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[prslki] + standard_name = ratio_of_exner_function_between_midlayer_and_interface_at_lowest_model_layer + long_name = Exner function ratio bt midlayer and interface at 1st layer + units = ratio + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[prsik1] + standard_name = dimensionless_exner_function_at_lowest_model_interface + long_name = dimensionless Exner function at the ground surface + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[prslk1] + standard_name = dimensionless_exner_function_at_lowest_model_layer + long_name = dimensionless Exner function at the lowest model layer + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[wet] + standard_name = flag_nonzero_wet_surface_fraction + long_name = flag indicating presence of some ocean or lake surface area fraction + units = flag + dimensions = (horizontal_dimension) + type = logical + intent = in + optional = F +[xlon] + standard_name = longitude + long_name = longitude + units = radians + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[sinlat] + standard_name = sine_of_latitude + long_name = sine of latitude + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[stress] + standard_name = surface_wind_stress_over_ocean + long_name = surface wind stress over ocean + units = m2 s-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[sfcemis] + standard_name = surface_longwave_emissivity_over_ocean_interstitial + long_name = surface lw emissivity in fraction over ocean (temporary use as interstitial) + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[dlwflx] + standard_name = surface_downwelling_longwave_flux_absorbed_by_ground_over_ocean + long_name = total sky surface downward longwave flux absorbed by the ground over ocean + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[sfcnsw] + standard_name = surface_net_downwelling_shortwave_flux + long_name = total sky sfc net sw flx into ocean + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[rain] + standard_name = nonnegative_lwe_thickness_of_precipitation_amount_on_dynamics_timestep_over_ocean + long_name = total precipitation amount in each time step over ocean + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[timestep] + standard_name = time_step_for_dynamics + long_name = timestep interval + units = s + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[kdt] + standard_name = index_of_time_step + long_name = current time step index + units = index + dimensions = () + type = integer + intent = in + optional = F +[solhr] + standard_name = forecast_hour_of_the_day + long_name = time in hours after 00z at the current timestep + units = h + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[xcosz] + standard_name = instantaneous_cosine_of_zenith_angle + long_name = cosine of solar zenith angle + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[wind] + standard_name = wind_speed_at_lowest_model_layer + long_name = wind speed at lowest model level + units = m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[flag_iter] + standard_name = flag_for_iteration + long_name = flag for iteration + units = flag + dimensions = (horizontal_dimension) + type = logical + intent = in + optional = F +[flag_guess] + standard_name = flag_for_guess_run + long_name = flag for guess run + units = flag + dimensions = (horizontal_dimension) + type = logical + intent = in + optional = F +[nstf_name1] + standard_name = flag_for_nsstm_run + long_name = NSSTM flag: off/uncoupled/coupled=0/1/2 + units = flag + dimensions = () + type = integer + intent = in + optional = F +[nstf_name4] + standard_name = vertical_temperature_average_range_lower_bound + long_name = zsea1 + units = mm + dimensions = () + type = integer + intent = in + optional = F +[nstf_name5] + standard_name = vertical_temperature_average_range_upper_bound + long_name = zsea2 + units = mm + dimensions = () + type = integer + intent = in + optional = F +[lprnt] + standard_name = flag_print + long_name = flag for printing diagnostics to output + units = flag + dimensions = () + type = logical + intent = in + optional = F +[ipr] + standard_name = horizontal_index_of_printed_column + long_name = horizontal index of printed column + units = index + dimensions = () + type = integer + intent = in + optional = F +[tskin] + standard_name = surface_skin_temperature_for_nsst + long_name = ocean surface skin temperature + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[tsurf] + standard_name = surface_skin_temperature_after_iteration_over_ocean + long_name = surface skin temperature after iteration over ocean + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[xt] + standard_name = diurnal_thermocline_layer_heat_content + long_name = heat content in diurnal thermocline layer + units = K m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[xs] + standard_name = sea_water_salinity + long_name = salinity content in diurnal thermocline layer + units = ppt m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[xu] + standard_name = diurnal_thermocline_layer_x_current + long_name = u-current content in diurnal thermocline layer + units = m2 s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[xv] + standard_name = diurnal_thermocline_layer_y_current + long_name = v-current content in diurnal thermocline layer + units = m2 s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[xz] + standard_name = diurnal_thermocline_layer_thickness + long_name = diurnal thermocline layer thickness + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[zm] + standard_name = ocean_mixed_layer_thickness + long_name = mixed layer thickness + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[xtts] + standard_name = sensitivity_of_dtl_heat_content_to_surface_temperature + long_name = d(xt)/d(ts) + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[xzts] + standard_name = sensitivity_of_dtl_thickness_to_surface_temperature + long_name = d(xz)/d(ts) + units = m K-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[dt_cool] + standard_name = sub_layer_cooling_amount + long_name = sub-layer cooling amount + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[z_c] + standard_name = sub_layer_cooling_thickness + long_name = sub-layer cooling thickness + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[c_0] + standard_name = coefficient_c_0 + long_name = coefficient1 to calculate d(tz)/d(ts) + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[c_d] + standard_name = coefficient_c_d + long_name = coefficient2 to calculate d(tz)/d(ts) + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[w_0] + standard_name = coefficient_w_0 + long_name = coefficient3 to calculate d(tz)/d(ts) + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[w_d] + standard_name = coefficient_w_d + long_name = coefficient4 to calculate d(tz)/d(ts) + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[d_conv] + standard_name = free_convection_layer_thickness + long_name = thickness of free convection layer + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[ifd] + standard_name = index_of_dtlm_start + long_name = index to start dtlm run or not + units = index + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[qrain] + standard_name = sensible_heat_flux_due_to_rainfall + long_name = sensible heat flux due to rainfall + units = W + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[qsurf] + standard_name = surface_specific_humidity_over_ocean + long_name = surface air saturation specific humidity over ocean + units = kg kg-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[gflux] + standard_name = upward_heat_flux_in_soil_over_ocean + long_name = soil heat flux over ocean + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[cmm] + standard_name = surface_drag_wind_speed_for_momentum_in_air_over_ocean + long_name = momentum exchange coefficient over ocean + units = m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[chh] + standard_name = surface_drag_mass_flux_for_heat_and_moisture_in_air_over_ocean + long_name = thermal exchange coefficient over ocean + units = kg m-2 s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[evap] + standard_name = kinematic_surface_upward_latent_heat_flux_over_ocean + long_name = kinematic surface upward latent heat flux over ocean + units = kg kg-1 m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[hflx] + standard_name = kinematic_surface_upward_sensible_heat_flux_over_ocean + long_name = kinematic surface upward sensible heat flux over ocean + units = K m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[ep] + standard_name = surface_upward_potential_latent_heat_flux_over_ocean + long_name = surface upward potential latent heat flux over ocean + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F + +######################################################################## +[ccpp-arg-table] + name = sfc_nst_init + type = scheme + +######################################################################## +[ccpp-arg-table] + name = sfc_nst_finalize + type = scheme + +######################################################################## +[ccpp-arg-table] + name = sfc_nst_pre_run + type = scheme +[im] + standard_name = horizontal_loop_extent + long_name = horizontal loop extent + units = count + dimensions = () + type = integer + intent = in + optional = F +[wet] + standard_name = flag_nonzero_wet_surface_fraction + long_name = flag indicating presence of some ocean or lake surface area fraction + units = flag + dimensions = (horizontal_dimension) + type = logical + intent = in + optional = F +[tsfc_ocn] + standard_name = surface_skin_temperature_over_ocean_interstitial + long_name = surface skin temperature over ocean (temporary use as interstitial) + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[tsurf_ocn] + standard_name = surface_skin_temperature_after_iteration_over_ocean + long_name = surface skin temperature after iteration over ocean + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[tseal] + standard_name = surface_skin_temperature_for_nsst + long_name = ocean surface skin temperature + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[xt] + standard_name = diurnal_thermocline_layer_heat_content + long_name = heat content in diurnal thermocline layer + units = K m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[xz] + standard_name = diurnal_thermocline_layer_thickness + long_name = diurnal thermocline layer thickness + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[dt_cool] + standard_name = sub_layer_cooling_amount + long_name = sub-layer cooling amount + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[z_c] + standard_name = sub_layer_cooling_thickness + long_name = sub-layer cooling thickness + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[tref] + standard_name = sea_surface_reference_temperature + long_name = reference/foundation temperature + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[cplflx] + standard_name = flag_for_flux_coupling + long_name = flag controlling cplflx collection (default off) + units = flag + dimensions = () + type = logical + intent = in + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F + +######################################################################## +[ccpp-arg-table] + name = sfc_nst_post_init + type = scheme + +######################################################################## +[ccpp-arg-table] + name = sfc_nst_post_finalize + type = scheme + +######################################################################## +[ccpp-arg-table] + name = sfc_nst_post_run + type = scheme +[im] + standard_name = horizontal_loop_extent + long_name = horizontal loop extent + units = count + dimensions = () + type = integer + intent = in + optional = F +[rlapse] + standard_name = air_temperature_lapse_rate_constant + long_name = environmental air temperature lapse rate constant + units = K m-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[wet] + standard_name = flag_nonzero_wet_surface_fraction + long_name = flag indicating presence of some ocean or lake surface area fraction + units = flag + dimensions = (horizontal_dimension) + type = logical + intent = in + optional = F +[icy] + standard_name = flag_nonzero_sea_ice_surface_fraction + long_name = flag indicating presence of some sea ice surface area fraction + units = flag + dimensions = (horizontal_dimension) + type = logical + intent = in + optional = F +[oro] + standard_name = orography + long_name = orography + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[oro_uf] + standard_name = orography_unfiltered + long_name = unfiltered orography + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[nstf_name1] + standard_name = flag_for_nsstm_run + long_name = NSSTM flag: off/uncoupled/coupled=0/1/2 + units = flag + dimensions = () + type = integer + intent = in + optional = F +[nstf_name4] + standard_name = vertical_temperature_average_range_lower_bound + long_name = zsea1 + units = mm + dimensions = () + type = integer + intent = in + optional = F +[nstf_name5] + standard_name = vertical_temperature_average_range_upper_bound + long_name = zsea2 + units = mm + dimensions = () + type = integer + intent = in + optional = F +[xt] + standard_name = diurnal_thermocline_layer_heat_content + long_name = heat content in diurnal thermocline layer + units = K m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[xz] + standard_name = diurnal_thermocline_layer_thickness + long_name = diurnal thermocline layer thickness + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[dt_cool] + standard_name = sub_layer_cooling_amount + long_name = sub-layer cooling amount + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[z_c] + standard_name = sub_layer_cooling_thickness + long_name = sub-layer cooling thickness + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[tref] + standard_name = sea_surface_reference_temperature + long_name = reference/foundation temperature + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[xlon] + standard_name = longitude + long_name = longitude + units = radians + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[tsurf_ocn] + standard_name = surface_skin_temperature_after_iteration_over_ocean + long_name = surface skin temperature after iteration over ocean + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[tsfc_ocn] + standard_name = surface_skin_temperature_over_ocean_interstitial + long_name = surface skin temperature over ocean (temporary use as interstitial) + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[dtzm] + standard_name = mean_change_over_depth_in_sea_water_temperature + long_name = mean of dT(z) (zsea1 to zsea2) + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F diff --git a/physics/sfc_ocean.F b/physics/sfc_ocean.F index a0a835555..9635f30b8 100644 --- a/physics/sfc_ocean.F +++ b/physics/sfc_ocean.F @@ -17,45 +17,14 @@ end subroutine sfc_ocean_finalize #if 0 !! \section arg_table_sfc_ocean_run Argument Table -!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | -!! |----------------|------------------------------------------------------------------------------|----------------------------------------------------------------------|---------------|------|-----------|-----------|--------|----------| -!! | im | horizontal_loop_extent | horizontal loop extent | count | 0 | integer | | in | F | -!! | cp | specific_heat_of_dry_air_at_constant_pressure | specific heat of dry air at constant pressure | J kg-1 K-1 | 0 | real | kind_phys | in | F | -!! | rd | gas_constant_dry_air | ideal gas constant for dry air | J kg-1 K-1 | 0 | real | kind_phys | in | F | -!! | eps | ratio_of_dry_air_to_water_vapor_gas_constants | rd/rv | none | 0 | real | kind_phys | in | F | -!! | epsm1 | ratio_of_dry_air_to_water_vapor_gas_constants_minus_one | (rd/rv) - 1 | none | 0 | real | kind_phys | in | F | -!! | hvap | latent_heat_of_vaporization_of_water_at_0C | latent heat of evaporation/sublimation | J kg-1 | 0 | real | kind_phys | in | F | -!! | rvrdm1 | ratio_of_vapor_to_dry_air_gas_constants_minus_one | (rv/rd) - 1 (rv = ideal gas constant for water vapor) | none | 0 | real | kind_phys | in | F | -!! | ps | surface_air_pressure | surface pressure | Pa | 1 | real | kind_phys | in | F | -!! | u1 | x_wind_at_lowest_model_layer | x component of surface layer wind | m s-1 | 1 | real | kind_phys | in | F | -!! | v1 | y_wind_at_lowest_model_layer | y component of surface layer wind | m s-1 | 1 | real | kind_phys | in | F | -!! | t1 | air_temperature_at_lowest_model_layer | surface layer mean temperature | K | 1 | real | kind_phys | in | F | -!! | q1 | water_vapor_specific_humidity_at_lowest_model_layer | surface layer mean specific humidity | kg kg-1 | 1 | real | kind_phys | in | F | -!! | tskin | surface_skin_temperature_over_ocean_interstitial | surface skin temperature over ocean (temporary use as interstitial) | K | 1 | real | kind_phys | in | F | -!! | cm | surface_drag_coefficient_for_momentum_in_air_over_ocean | surface exchange coeff for momentum over ocean | none | 1 | real | kind_phys | in | F | -!! | ch | surface_drag_coefficient_for_heat_and_moisture_in_air_over_ocean | surface exchange coeff heat & moisture over ocean | none | 1 | real | kind_phys | in | F | -!! | prsl1 | air_pressure_at_lowest_model_layer | surface layer mean pressure | Pa | 1 | real | kind_phys | in | F | -!! | prslki | ratio_of_exner_function_between_midlayer_and_interface_at_lowest_model_layer | Exner function ratio bt midlayer and interface at 1st layer | ratio | 1 | real | kind_phys | in | F | -!! | wet | flag_nonzero_wet_surface_fraction | flag indicating presence of some ocean or lake surface area fraction | flag | 1 | logical | | in | F | -!! | fice | sea_ice_concentration | ice fraction over open water | frac | 1 | real | kind_phys | in | F | -!! | ddvel | surface_wind_enhancement_due_to_convection | wind enhancement due to convection | m s-1 | 1 | real | kind_phys | in | F | -!! | flag_iter | flag_for_iteration | flag for iteration | flag | 1 | logical | | in | F | -!! | qsurf | surface_specific_humidity_over_ocean | surface air saturation specific humidity over ocean | kg kg-1 | 1 | real | kind_phys | inout | F | -!! | cmm | surface_drag_wind_speed_for_momentum_in_air_over_ocean | momentum exchange coefficient over ocean | m s-1 | 1 | real | kind_phys | inout | F | -!! | chh | surface_drag_mass_flux_for_heat_and_moisture_in_air_over_ocean | thermal exchange coefficient over ocean | kg m-2 s-1 | 1 | real | kind_phys | inout | F | -!! | gflux | upward_heat_flux_in_soil_over_ocean | soil heat flux over ocean | W m-2 | 1 | real | kind_phys | inout | F | -!! | evap | kinematic_surface_upward_latent_heat_flux_over_ocean | kinematic surface upward latent heat flux over ocean | kg kg-1 m s-1 | 1 | real | kind_phys | inout | F | -!! | hflx | kinematic_surface_upward_sensible_heat_flux_over_ocean | kinematic surface upward sensible heat flux over ocean | K m s-1 | 1 | real | kind_phys | inout | F | -!! | ep | surface_upward_potential_latent_heat_flux_over_ocean | surface upward potential latent heat flux over ocean | W m-2 | 1 | real | kind_phys | inout | F | -!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | -!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | +!! \htmlinclude sfc_ocean_run.html !! #endif subroutine sfc_ocean_run & !................................... ! --- inputs: - & ( im, cp, rd, eps, epsm1, hvap, rvrdm1, ps, u1, v1, t1, q1, & - & tskin, cm, ch, prsl1, prslki, wet, fice, ddvel, & + & ( im, cp, rd, eps, epsm1, hvap, rvrdm1, ps, t1, q1, & + & tskin, cm, ch, prsl1, prslki, wet, wind, & & flag_iter, & ! --- outputs: & qsurf, cmm, chh, gflux, evap, hflx, ep, & @@ -69,8 +38,9 @@ subroutine sfc_ocean_run & ! ! ! call sfc_ocean ! ! inputs: ! -! ( im, ps, u1, v1, t1, q1, tskin, cm, ch, ! -! prsl1, prslki, wet, fice, ddvel, flag_iter, ! +! ( im, ps, t1, q1, tskin, cm, ch, ! +!! ( im, ps, u1, v1, t1, q1, tskin, cm, ch, ! +! prsl1, prslki, wet, wind, flag_iter, ! ! outputs: ! ! qsurf, cmm, chh, gflux, evap, hflx, ep ) ! ! ! @@ -93,7 +63,6 @@ subroutine sfc_ocean_run & ! inputs: size ! ! im - integer, horizontal dimension 1 ! ! ps - real, surface pressure im ! -! u1, v1 - real, u/v component of surface layer wind im ! ! t1 - real, surface layer mean temperature ( k ) im ! ! q1 - real, surface layer mean specific humidity im ! ! tskin - real, ground surface skin temperature ( k ) im ! @@ -102,8 +71,7 @@ subroutine sfc_ocean_run & ! prsl1 - real, surface layer mean pressure im ! ! prslki - real, im ! ! wet - logical, =T if any ocean/lak, =F otherwise im ! -! fice - real, ice fraction im ! -! ddvel - real, wind enhancement due to convection (m/s) im ! +! wind - real, wind speed (m/s) im ! ! flag_iter- logical, im ! ! ! ! outputs: ! @@ -127,8 +95,8 @@ subroutine sfc_ocean_run & real (kind=kind_phys), intent(in) :: cp, rd, eps, epsm1, hvap, & & rvrdm1 - real (kind=kind_phys), dimension(im), intent(in) :: ps, u1, v1, & - & t1, q1, tskin, cm, ch, prsl1, prslki, ddvel, fice + real (kind=kind_phys), dimension(im), intent(in) :: ps, & + & t1, q1, tskin, cm, ch, prsl1, prslki, wind logical, dimension(im), intent(in) :: flag_iter, wet @@ -141,7 +109,7 @@ subroutine sfc_ocean_run & ! --- locals: - real (kind=kind_phys) :: q0, qss, rch, rho, wind, tem, cpinv, & + real (kind=kind_phys) :: q0, qss, rch, rho, tem, cpinv, & & hvapi, elocp integer :: i @@ -159,17 +127,13 @@ subroutine sfc_ocean_run & ! ! --- ... flag for open water do i = 1, im - flag(i) = (wet(i) .and. fice(i)<1. .and. flag_iter(i)) + flag(i) = (wet(i) .and. flag_iter(i)) ! --- ... initialize variables. all units are supposedly m.k.s. unless specified ! ps is in pascals, wind is wind speed, ! rho is density, qss is sat. hum. at surface if ( flag(i) ) then - - wind = max(sqrt(u1(i)*u1(i) + v1(i)*v1(i)) & - & + max( 0.0, min( ddvel(i), 30.0 ) ), 1.0) - q0 = max( q1(i), 1.0e-8 ) rho = prsl1(i) / (rd*t1(i)*(1.0 + rvrdm1*q0)) @@ -183,9 +147,9 @@ subroutine sfc_ocean_run & ! --- ... rcp = rho cp ch v - rch = rho * cp * ch(i) * wind - cmm(i) = cm(i) * wind - chh(i) = rho * ch(i) * wind + rch = rho * cp * ch(i) * wind(i) + cmm(i) = cm(i) * wind(i) + chh(i) = rho * ch(i) * wind(i) ! --- ... sensible and latent heat flux over open water diff --git a/physics/sfc_ocean.meta b/physics/sfc_ocean.meta new file mode 100644 index 000000000..d60c1ce2c --- /dev/null +++ b/physics/sfc_ocean.meta @@ -0,0 +1,252 @@ +[ccpp-arg-table] + name = sfc_ocean_init + type = scheme + +######################################################################## +[ccpp-arg-table] + name = sfc_ocean_finalize + type = scheme + +######################################################################## +[ccpp-arg-table] + name = sfc_ocean_run + type = scheme +[im] + standard_name = horizontal_loop_extent + long_name = horizontal loop extent + units = count + dimensions = () + type = integer + intent = in + optional = F +[cp] + standard_name = specific_heat_of_dry_air_at_constant_pressure + long_name = specific heat of dry air at constant pressure + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[rd] + standard_name = gas_constant_dry_air + long_name = ideal gas constant for dry air + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[eps] + standard_name = ratio_of_dry_air_to_water_vapor_gas_constants + long_name = rd/rv + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[epsm1] + standard_name = ratio_of_dry_air_to_water_vapor_gas_constants_minus_one + long_name = (rd/rv) - 1 + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[hvap] + standard_name = latent_heat_of_vaporization_of_water_at_0C + long_name = latent heat of evaporation/sublimation + units = J kg-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[rvrdm1] + standard_name = ratio_of_vapor_to_dry_air_gas_constants_minus_one + long_name = (rv/rd) - 1 (rv = ideal gas constant for water vapor) + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[ps] + standard_name = surface_air_pressure + long_name = surface pressure + units = Pa + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[t1] + standard_name = air_temperature_at_lowest_model_layer + long_name = surface layer mean temperature + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[q1] + standard_name = water_vapor_specific_humidity_at_lowest_model_layer + long_name = surface layer mean specific humidity + units = kg kg-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[tskin] + standard_name = surface_skin_temperature_over_ocean_interstitial + long_name = surface skin temperature over ocean (temporary use as interstitial) + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[cm] + standard_name = surface_drag_coefficient_for_momentum_in_air_over_ocean + long_name = surface exchange coeff for momentum over ocean + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[ch] + standard_name = surface_drag_coefficient_for_heat_and_moisture_in_air_over_ocean + long_name = surface exchange coeff heat & moisture over ocean + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[prsl1] + standard_name = air_pressure_at_lowest_model_layer + long_name = surface layer mean pressure + units = Pa + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[prslki] + standard_name = ratio_of_exner_function_between_midlayer_and_interface_at_lowest_model_layer + long_name = Exner function ratio bt midlayer and interface at 1st layer + units = ratio + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[wet] + standard_name = flag_nonzero_wet_surface_fraction + long_name = flag indicating presence of some ocean or lake surface area fraction + units = flag + dimensions = (horizontal_dimension) + type = logical + intent = in + optional = F +[wind] + standard_name = wind_speed_at_lowest_model_layer + long_name = wind speed at lowest model level + units = m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[flag_iter] + standard_name = flag_for_iteration + long_name = flag for iteration + units = flag + dimensions = (horizontal_dimension) + type = logical + intent = in + optional = F +[qsurf] + standard_name = surface_specific_humidity_over_ocean + long_name = surface air saturation specific humidity over ocean + units = kg kg-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[cmm] + standard_name = surface_drag_wind_speed_for_momentum_in_air_over_ocean + long_name = momentum exchange coefficient over ocean + units = m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[chh] + standard_name = surface_drag_mass_flux_for_heat_and_moisture_in_air_over_ocean + long_name = thermal exchange coefficient over ocean + units = kg m-2 s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[gflux] + standard_name = upward_heat_flux_in_soil_over_ocean + long_name = soil heat flux over ocean + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[evap] + standard_name = kinematic_surface_upward_latent_heat_flux_over_ocean + long_name = kinematic surface upward latent heat flux over ocean + units = kg kg-1 m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[hflx] + standard_name = kinematic_surface_upward_sensible_heat_flux_over_ocean + long_name = kinematic surface upward sensible heat flux over ocean + units = K m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[ep] + standard_name = surface_upward_potential_latent_heat_flux_over_ocean + long_name = surface upward potential latent heat flux over ocean + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F diff --git a/physics/sfc_sice.f b/physics/sfc_sice.f index 19b05f789..750a6d795 100644 --- a/physics/sfc_sice.f +++ b/physics/sfc_sice.f @@ -1,151 +1,21 @@ !> \file sfc_sice.f !! This file contains the GFS three level thermodynamic sea ice model. -!> This module comtains the CCPP-compliant GFS sea ice post interstitial codes, which returns -!! updated ice thickness and concentration to global arrays -!! where there is no ice, and set temperature to surface skin temperature. - module sfc_sice_post - - contains - -!! \section arg_table_sfc_sice_post_init Argument Table -!! - subroutine sfc_sice_post_init - end subroutine sfc_sice_post_init - -!! \section arg_table_sfc_sice_post_finalize Argument Table -!! - subroutine sfc_sice_post_finalize - end subroutine sfc_sice_post_finalize - -!! \section arg_table_sfc_sice_post_run Argument Table -!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | -!! |----------------|-------------------------------------------------------|---------------------------------------------------|-------|------|-----------|-----------|--------|----------| -!! | im | horizontal_loop_extent | horizontal loop extent | count | 0 | integer | | in | F | -!! | cplflx | flag_for_flux_coupling | flag controlling cplflx collection (default off) | flag | 0 | logical | | in | F | -!! | islmsk | sea_land_ice_mask | sea/land/ice mask (=0/1/2) | flag | 1 | integer | | in | F | -!! | tice | sea_ice_temperature_interstitial | sea-ice surface temperature use as interstitial | K | 1 | real | kind_phys | in | F | -!! | tsfc | surface_skin_temperature | surface skin temperature | K | 1 | real | kind_phys | in | F | -!! | fice | sea_ice_concentration | sea-ice concentration [0,1] | frac | 1 | real | kind_phys | inout | F | -!! | hice | sea_ice_thickness | sea-ice thickness | m | 1 | real | kind_phys | inout | F | -!! | tisfc | sea_ice_temperature | sea-ice surface temperature | K | 1 | real | kind_phys | inout | F | -!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | -!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | -!! - subroutine sfc_sice_post_run(im, cplflx, islmsk, tice, tsfc, & - & fice, hice, tisfc, errmsg, errflg) - - use machine, only : kind_phys - - implicit none - -! --- input - integer, intent(in) :: im - logical, intent(in) :: cplflx - integer, dimension(im), intent(in) :: islmsk - real(kind=kind_phys), dimension(im), intent(in) :: tice, tsfc - -! --- input/output - real(kind=kind_phys), dimension(im), intent(inout) :: fice, hice, & - & tisfc - - character(len=*), intent(out) :: errmsg - integer, intent(out) :: errflg - -! --- locals - integer :: i - - ! Initialize CCPP error handling variables - errmsg = '' - errflg = 0 - -!--- return updated ice thickness & concentration to global arrays -! where there is no ice, set temperature to surface skin temperature. - if(.not. cplflx) then - do i = 1, im - if (islmsk(i) == 2) then - tisfc(i) = tice(i) - else - hice(i) = 0.0 - fice(i) = 0.0 - tisfc(i) = tsfc(i) - endif - enddo - endif - - end subroutine sfc_sice_post_run - - end module sfc_sice_post - !> This module contains the CCPP-compliant GFS sea ice scheme. module sfc_sice contains - subroutine sfc_sice_init + subroutine sfc_sice_init() end subroutine sfc_sice_init ! - subroutine sfc_sice_finalize + subroutine sfc_sice_finalize() end subroutine sfc_sice_finalize -!>\defgroup gfs_sice_main GFS sfc_sice Main +!>\defgroup gfs_sice_main GFS Three-layer Thermodynomics Sea-Ice Scheme Module !! \brief This is three-layer thermodynomics sea-ice model based on Winton (2000) \cite winton_2000. !! \section arg_table_sfc_sice_run Argument Table -!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | -!! |----------------|------------------------------------------------------------------------------|-----------------------------------------------------------------|---------------|------|-----------|-----------|--------|----------| -!! | im | horizontal_loop_extent | horizontal loop extent | count | 0 | integer | | in | F | -!! | km | soil_vertical_dimension | vertical loop extent for soil levels, start at 1 | count | 0 | integer | | in | F | -!! | sbc | steffan_boltzmann_constant | Steffan-Boltzmann constant | W m-2 K-4 | 0 | real | kind_phys | in | F | -!! | hvap | latent_heat_of_vaporization_of_water_at_0C | latent heat of evaporation/sublimation | J kg-1 | 0 | real | kind_phys | in | F | -!! | tgice | freezing_point_temperature_of_seawater | freezing point temperature of seawater | K | 0 | real | kind_phys | in | F | -!! | cp | specific_heat_of_dry_air_at_constant_pressure | specific heat of dry air at constant pressure | J kg-1 K-1 | 0 | real | kind_phys | in | F | -!! | eps | ratio_of_dry_air_to_water_vapor_gas_constants | rd/rv | none | 0 | real | kind_phys | in | F | -!! | epsm1 | ratio_of_dry_air_to_water_vapor_gas_constants_minus_one | (rd/rv) - 1 | none | 0 | real | kind_phys | in | F | -!! | rvrdm1 | ratio_of_vapor_to_dry_air_gas_constants_minus_one | (rv/rd) - 1 (rv = ideal gas constant for water vapor) | none | 0 | real | kind_phys | in | F | -!! | grav | gravitational_acceleration | gravitational acceleration | m s-2 | 0 | real | kind_phys | in | F | -!! | t0c | temperature_at_zero_celsius | temperature at 0 degrees Celsius | K | 0 | real | kind_phys | in | F | -!! | rd | gas_constant_dry_air | ideal gas constant for dry air | J kg-1 K-1 | 0 | real | kind_phys | in | F | -!! | cimin | minimum_sea_ice_concentration | minimum sea ice concentration | frac | 0 | real | kind_phys | in | F | -!! | ps | surface_air_pressure | surface pressure | Pa | 1 | real | kind_phys | in | F | -!! | u1 | x_wind_at_lowest_model_layer | u component of surface layer wind | m s-1 | 1 | real | kind_phys | in | F | -!! | v1 | y_wind_at_lowest_model_layer | v component of surface layer wind | m s-1 | 1 | real | kind_phys | in | F | -!! | t1 | air_temperature_at_lowest_model_layer | surface layer mean temperature | K | 1 | real | kind_phys | in | F | -!! | q1 | water_vapor_specific_humidity_at_lowest_model_layer | surface layer mean specific humidity | kg kg-1 | 1 | real | kind_phys | in | F | -!! | delt | time_step_for_dynamics | time step | s | 0 | real | kind_phys | in | F | -!! | sfcemis | surface_longwave_emissivity | sfc lw emissivity | frac | 1 | real | kind_phys | in | F | -!! | dlwflx | surface_downwelling_longwave_flux_absorbed_by_ground | total sky surface downward longwave flux absorbed by the ground | W m-2 | 1 | real | kind_phys | in | F | -!! | sfcnsw | surface_net_downwelling_shortwave_flux | total sky sfc netsw flx into ground | W m-2 | 1 | real | kind_phys | in | F | -!! | sfcdsw | surface_downwelling_shortwave_flux | total sky sfc downward sw flux | W m-2 | 1 | real | kind_phys | in | F | -!! | srflag | flag_for_precipitation_type | snow/rain flag for precipitation | flag | 1 | real | kind_phys | in | F | -!! | cm | surface_drag_coefficient_for_momentum_in_air_over_ice | surface exchange coeff for momentum over ice | none | 1 | real | kind_phys | in | F | -!! | ch | surface_drag_coefficient_for_heat_and_moisture_in_air_over_ice | surface exchange coeff heat & moisture over ice | none | 1 | real | kind_phys | in | F | -!! | prsl1 | air_pressure_at_lowest_model_layer | surface layer mean pressure | Pa | 1 | real | kind_phys | in | F | -!! | prslki | ratio_of_exner_function_between_midlayer_and_interface_at_lowest_model_layer | Exner function ratio bt midlayer and interface at 1st layer | ratio | 1 | real | kind_phys | in | F | -!! | islimsk | sea_land_ice_mask | sea/land/ice mask (=0/1/2) | flag | 1 | integer | | in | F | -!! | ddvel | surface_wind_enhancement_due_to_convection | wind enhancement due to convection | m s-1 | 1 | real | kind_phys | in | F | -!! | flag_iter | flag_for_iteration | flag for iteration | flag | 1 | logical | | in | F | -!! | mom4ice | flag_for_mom4_coupling | flag for Mom4 coupling | flag | 0 | logical | | in | F | -!! | lsm | flag_for_land_surface_scheme | flag for land sfc scheme =0: osu; =1: noah | flag | 0 | integer | | in | F | -!! | lprnt | flag_print | switch for printing sample column to stdout | flag | 0 | logical | | in | F | -!! | ipr | horizontal_index_of_printed_column | horizontal index of printed column | index | 0 | integer | | in | F | -!! | hice | sea_ice_thickness | sea-ice thickness | m | 1 | real | kind_phys | inout | F | -!! | fice | sea_ice_concentration | sea-ice concentration [0,1] | frac | 1 | real | kind_phys | inout | F | -!! | tice | sea_ice_temperature_interstitial | sea-ice surface temperature use as interstitial | K | 1 | real | kind_phys | inout | F | -!! | weasd | water_equivalent_accumulated_snow_depth_over_ice | water equiv of acc snow depth over ice | mm | 1 | real | kind_phys | inout | F | -!! | tskin | surface_skin_temperature_over_ice_interstitial | surface skin temperature over ice (temporary use as interstitial) | K | 1 | real | kind_phys | inout | F | -!! | tprcp | nonnegative_lwe_thickness_of_precipitation_amount_on_dynamics_timestep_over_ice | total precipitation amount in each time step over ice | m | 1 | real | kind_phys | inout | F | -!! | stc | soil_temperature | soil temp | K | 2 | real | kind_phys | inout | F | -!! | ep | surface_upward_potential_latent_heat_flux_over_ice | surface upward potential latent heat flux over ice | W m-2 | 1 | real | kind_phys | inout | F | -!! | snwdph | surface_snow_thickness_water_equivalent_over_ice | water equivalent snow depth over ice | mm | 1 | real | kind_phys | inout | F | -!! | qsurf | surface_specific_humidity_over_ice | surface air saturation specific humidity over ice | kg kg-1 | 1 | real | kind_phys | inout | F | -!! | snowmt | surface_snow_melt | snow melt during timestep | m | 1 | real | kind_phys | inout | F | -!! | gflux | upward_heat_flux_in_soil_over_ice | soil heat flux over ice | W m-2 | 1 | real | kind_phys | inout | F | -!! | cmm | surface_drag_wind_speed_for_momentum_in_air_over_ice | momentum exchange coefficient over ice | m s-1 | 1 | real | kind_phys | inout | F | -!! | chh | surface_drag_mass_flux_for_heat_and_moisture_in_air_over_ice | thermal exchange coefficient over ice | kg m-2 s-1 | 1 | real | kind_phys | inout | F | -!! | evap | kinematic_surface_upward_latent_heat_flux_over_ice | kinematic surface upward latent heat flux over ice | kg kg-1 m s-1 | 1 | real | kind_phys | inout | F | -!! | hflx | kinematic_surface_upward_sensible_heat_flux_over_ice | kinematic surface upward sensible heat flux over ice | K m s-1 | 1 | real | kind_phys | inout | F | -!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | -!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | +!! \htmlinclude sfc_sice_run.html !! !> \section general_sice_run GFS Sea Ice Driver General Algorithm !!The model has four prognostic variables: the snow layer thickness \f$h_s\f$, the ice layer thickness @@ -171,12 +41,13 @@ end subroutine sfc_sice_finalize !> @{ subroutine sfc_sice_run & & ( im, km, sbc, hvap, tgice, cp, eps, epsm1, rvrdm1, grav, & ! --- inputs: - & t0c, rd, cimin, ps, u1, v1, t1, q1, delt, & + & t0c, rd, ps, t1, q1, delt, & & sfcemis, dlwflx, sfcnsw, sfcdsw, srflag, & - & cm, ch, prsl1, prslki, islimsk, ddvel, & - & flag_iter, mom4ice, lsm, lprnt, ipr, & + & cm, ch, prsl1, prslki, prsik1, prslk1, islimsk, wind, & + & flag_iter, lprnt, ipr, cimin, & & hice, fice, tice, weasd, tskin, tprcp, stc, ep, & ! --- input/outputs: - & snwdph, qsurf, snowmt, gflux, cmm, chh, evap, hflx, & ! --- outputs: + & snwdph, qsurf, snowmt, gflux, cmm, chh, evap, hflx, & ! + & cplflx, cplchm, flag_cice, islmsk_cice, & & errmsg, errflg & ) @@ -187,10 +58,10 @@ subroutine sfc_sice_run & ! ! ! call sfc_sice ! ! inputs: ! -! ( im, km, ps, u1, v1, t1, q1, delt, ! +! ( im, km, ps, t1, q1, delt, ! ! sfcemis, dlwflx, sfcnsw, sfcdsw, srflag, ! -! cm, ch, prsl1, prslki, islimsk, ddvel, ! -! flag_iter, mom4ice, lsm, ! +! cm, ch, prsl1, prslki, prsik1, prslk1, islimsk, wind, ! +! flag_iter, ! ! input/outputs: ! ! hice, fice, tice, weasd, tskin, tprcp, stc, ep, ! ! outputs: ! @@ -203,7 +74,8 @@ subroutine sfc_sice_run & !! two-layer ice model !!- 200x -- sarah lu added flag_iter !!- oct 2006 -- h. wei added cmm and chh to output -!!- 2007 -- x. wu modified for mom4 coupling (i.e. mom4ice) +!!- 2007 -- x. wu modified for mom4 coupling (i.e. cpldice) +!! (not used anymore) !!- 2007 -- s. moorthi micellaneous changes !!- may 2009 -- y.-t. hou modified to include surface emissivity !! effect on lw radiation. replaced the confusing @@ -220,7 +92,6 @@ subroutine sfc_sice_run & ! inputs: size ! ! im, km - integer, horiz dimension and num of soil layers 1 ! ! ps - real, surface pressure im ! -! u1, v1 - real, u/v component of surface layer wind im ! ! t1 - real, surface layer mean temperature ( k ) im ! ! q1 - real, surface layer mean specific humidity im ! ! delt - real, time interval (second) 1 ! @@ -233,12 +104,11 @@ subroutine sfc_sice_run & ! ch - real, surface exchange coeff heat & moisture(m/s) im ! ! prsl1 - real, surface layer mean pressure im ! ! prslki - real, im ! +! prsik1 - real, im ! +! prslk1 - real, im ! ! islimsk - integer, sea/land/ice mask (=0/1/2) im ! -! ddvel - real, im ! +! wind - real, im ! ! flag_iter- logical, im ! -! mom4ice - logical, im ! -! lsm - integer, flag for land surface model scheme 1 ! -! =0: use osu scheme; =1: use noah scheme ! ! ! ! input/outputs: ! ! hice - real, sea-ice thickness im ! @@ -262,36 +132,39 @@ subroutine sfc_sice_run & ! ! ! ===================================================================== ! ! - use machine, only: kind_phys + use machine, only : kind_phys use funcphys, only : fpvs ! implicit none ! ! - Define constant parameters - integer, parameter :: kmi = 2 !< 2-layer of ice - real(kind=kind_phys), parameter :: himax = 8.0 !< maximum ice thickness allowed - real(kind=kind_phys), parameter :: himin = 0.1 !< minimum ice thickness required - real(kind=kind_phys), parameter :: hsmax = 2.0 !< maximum snow depth allowed - real(kind=kind_phys), parameter :: timin = 173.0 !< minimum temperature allowed for snow/ice - real(kind=kind_phys), parameter :: albfw = 0.06 !< albedo for lead - real(kind=kind_phys), parameter :: dsi = 1.0/0.33 + integer, parameter :: kmi = 2 !< 2-layer of ice + real(kind=kind_phys), parameter :: zero = 0.0d0, one = 1.0d0 + real(kind=kind_phys), parameter :: himax = 8.0d0 !< maximum ice thickness allowed + real(kind=kind_phys), parameter :: himin = 0.1d0 !< minimum ice thickness required + real(kind=kind_phys), parameter :: hsmax = 2.0d0 !< maximum snow depth allowed + real(kind=kind_phys), parameter :: timin = 173.0d0 !< minimum temperature allowed for snow/ice + real(kind=kind_phys), parameter :: albfw = 0.06d0 !< albedo for lead + real(kind=kind_phys), parameter :: dsi = one/0.33d0 ! --- inputs: - integer, intent(in) :: im, km, lsm, ipr + integer, intent(in) :: im, km, ipr logical, intent(in) :: lprnt + logical, intent(in) :: cplflx + logical, intent(in) :: cplchm real (kind=kind_phys), intent(in) :: sbc, hvap, tgice, cp, eps, & - & epsm1, grav, rvrdm1, t0c, rd, cimin + & epsm1, grav, rvrdm1, t0c, rd - real (kind=kind_phys), dimension(im), intent(in) :: ps, u1, v1, & + real (kind=kind_phys), dimension(im), intent(in) :: ps, & & t1, q1, sfcemis, dlwflx, sfcnsw, sfcdsw, srflag, cm, ch, & - & prsl1, prslki, ddvel + & prsl1, prslki, prsik1, prslk1, wind integer, dimension(im), intent(in) :: islimsk - real (kind=kind_phys), intent(in) :: delt + integer, dimension(im), intent(in) :: islmsk_cice + real (kind=kind_phys), intent(in) :: delt, cimin - logical, dimension(im), intent(in) :: flag_iter - logical, intent(in) :: mom4ice + logical, dimension(im), intent(in) :: flag_iter, flag_cice ! --- input/outputs: real (kind=kind_phys), dimension(im), intent(inout) :: hice, & @@ -310,37 +183,59 @@ subroutine sfc_sice_run & real (kind=kind_phys), dimension(im) :: ffw, evapi, evapw, & & sneti, snetw, hfd, hfi, & ! & hflxi, hflxw, sneti, snetw, qssi, qssw, hfd, hfi, hfw, & - & focn, snof, hi_save, hs_save, rch, rho, & + & focn, snof, rch, rho, & & snowd, theta1 real (kind=kind_phys) :: t12, t14, tem, stsice(im,kmi) - &, hflxi, hflxw, q0, qs1, wind, qssi, qssw + &, hflxi, hflxw, q0, qs1, qssi, qssw real (kind=kind_phys) :: cpinv, hvapi, elocp integer :: i, k + integer, dimension(im) :: islmsk_local logical :: flag(im) ! !===> ... begin here ! - cpinv = 1.0/cp - hvapi = 1.0/hvap + cpinv = one/cp + hvapi = one/hvap elocp = hvap/cp ! Initialize CCPP error handling variables errmsg = '' errflg = 0 + + + if (cplflx) then + where (flag_cice) + islmsk_local = islmsk_cice + elsewhere + islmsk_local = islimsk + endwhere + else + islmsk_local = islimsk + end if + ! !> - Set flag for sea-ice. do i = 1, im - flag(i) = (islimsk(i) == 2) .and. flag_iter(i) - if (flag_iter(i) .and. islimsk(i) < 2) then - hice(i) = 0.0 - fice(i) = 0.0 + flag(i) = (islmsk_local(i) == 2) .and. flag_iter(i) + if (flag_iter(i) .and. islmsk_local(i) < 2) then + hice(i) = zero + fice(i) = zero endif enddo + do i = 1, im + if (flag(i)) then + if (srflag(i) > zero) then + ep(i) = ep(i)*(one-srflag(i)) + weasd(i) = weasd(i) + 1.e3*tprcp(i)*srflag(i) + tprcp(i) = tprcp(i)*(one-srflag(i)) + endif + endif + enddo !> - Update/read sea ice temperature from soil temperature and initialize variables. do k = 1, kmi @@ -350,25 +245,6 @@ subroutine sfc_sice_run & endif enddo enddo -! - if (mom4ice) then - do i = 1, im - if (flag(i)) then ! sea ice - hi_save(i) = hice(i) - hs_save(i) = weasd(i) * 0.001 - endif - enddo - elseif (lsm > 0) then ! --- ... snow-rain detection - do i = 1, im - if (flag(i)) then - if (srflag(i) > 0) then - ep(i) = ep(i)*(1.-srflag(i)) - weasd(i) = weasd(i) + 1.e3*tprcp(i)*srflag(i) - tprcp(i) = tprcp(i)*(1.-srflag(i)) - endif - endif - enddo - endif ! --- ... initialize variables. all units are supposedly m.k.s. unless specifie ! psurf is in pascals, wind is wind speed, theta1 is adiabatic surface @@ -384,26 +260,26 @@ subroutine sfc_sice_run & ! dlwflx has been given a negative sign for downward longwave ! sfcnsw is the net shortwave flux (direction: dn-up) - wind = max(sqrt(u1(i)*u1(i) + v1(i)*v1(i)) & - & + max(0.0, min(ddvel(i), 30.0)), 1.0) - q0 = max(q1(i), 1.0e-8) ! tsurf(i) = tskin(i) +#ifdef GSD_SURFACE_FLUXES_BUGFIX + theta1(i) = t1(i) / prslk1(i) ! potential temperature in middle of lowest atm. layer +#else theta1(i) = t1(i) * prslki(i) - rho(i) = prsl1(i) / (rd*t1(i)*(1.0+rvrdm1*q0)) +#endif + rho(i) = prsl1(i) / (rd*t1(i)*(one+rvrdm1*q0)) qs1 = fpvs(t1(i)) qs1 = max(eps*qs1 / (prsl1(i) + epsm1*qs1), 1.e-8) q0 = min(qs1, q0) - ffw(i) = 1.0 - fice(i) if (fice(i) < cimin) then print *,'warning: ice fraction is low:', fice(i) fice(i) = cimin - ffw (i) = 1.0 - fice(i) tice(i) = tgice tskin(i)= tgice print *,'fix ice fraction: reset it to:', fice(i) endif + ffw(i) = 1.0 - fice(i) qssi = fpvs(tice(i)) qssi = eps*qssi / (ps(i) + epsm1*qssi) @@ -412,11 +288,7 @@ subroutine sfc_sice_run & !> - Convert snow depth in water equivalent from mm to m unit. - if (mom4ice) then - snowd(i) = weasd(i) * 0.001 / fice(i) - else - snowd(i) = weasd(i) * 0.001 - endif + snowd(i) = weasd(i) * 0.001d0 ! flagsnw(i) = .false. ! --- ... when snow depth is less than 1 mm, a patchy snow is assumed and @@ -426,8 +298,8 @@ subroutine sfc_sice_run & ! --- ... rcp = rho cp ch v - cmm(i) = cm(i) * wind - chh(i) = rho(i) * ch(i) * wind + cmm(i) = cm(i) * wind(i) + chh(i) = rho(i) * ch(i) * wind(i) rch(i) = chh(i) * cp !> - Calculate sensible and latent heat flux over open water & sea ice. @@ -436,10 +308,8 @@ subroutine sfc_sice_run & evapw(i) = elocp * rch(i) * (qssw - q0) ! evap(i) = fice(i)*evapi(i) + ffw(i)*evapw(i) -! if (lprnt) write(0,*)' tice=',tice(ipr) - - snetw(i) = sfcdsw(i) * (1.0 - albfw) - snetw(i) = min(3.0*sfcnsw(i)/(1.0+2.0*ffw(i)), snetw(i)) + snetw(i) = sfcdsw(i) * (one - albfw) + snetw(i) = min(3.0*sfcnsw(i)/(one+2.0d0*ffw(i)), snetw(i)) !> - Calculate net solar incoming at top \a sneti. sneti(i) = (sfcnsw(i) - ffw(i)*snetw(i)) / fice(i) @@ -448,11 +318,16 @@ subroutine sfc_sice_run & !> - Calculate net non-solar and upir heat flux @ ice surface \a hfi. +#ifdef GSD_SURFACE_FLUXES_BUGFIX + hfi(i) = -dlwflx(i) + sfcemis(i)*sbc*t14 + evapi(i) & + & + rch(i)*(tice(i)/prsik1(i) - theta1(i)) +#else hfi(i) = -dlwflx(i) + sfcemis(i)*sbc*t14 + evapi(i) & & + rch(i)*(tice(i) - theta1(i)) +#endif !> - Calculate heat flux derivative at surface \a hfd. - hfd(i) = 4.0*sfcemis(i)*sbc*tice(i)*t12 & - & + (1.0 + elocp*eps*hvap*qs1/(rd*t12)) * rch(i) + hfd(i) = 4.0d0*sfcemis(i)*sbc*tice(i)*t12 & + & + (one + elocp*eps*hvap*qs1/(rd*t12)) * rch(i) t12 = tgice * tgice t14 = t12 * t12 @@ -464,14 +339,14 @@ subroutine sfc_sice_run & !> - Assigin heat flux from ocean \a focn and snowfall rate as constants, which !! should be from ocean model and other physics. - focn(i) = 2.0 ! heat flux from ocean - should be from ocn model - snof(i) = 0.0 ! snowfall rate - snow accumulates in gbphys + focn(i) = 2.0d0 ! heat flux from ocean - should be from ocn model + snof(i) = zero ! snowfall rate - snow accumulates in gbphys !> - Initialize snow depth \a snowd. hice(i) = max( min( hice(i), himax ), himin ) snowd(i) = min( snowd(i), hsmax ) - if (snowd(i) > (2.0*hice(i))) then + if (snowd(i) > (2.0d0*hice(i))) then print *, 'warning: too much snow :',snowd(i) snowd(i) = hice(i) + hice(i) print *,'fix: decrease snow depth to:',snowd(i) @@ -480,23 +355,13 @@ subroutine sfc_sice_run & enddo !> - Call the three-layer thermodynamics sea ice model ice3lay(). -! if (lprnt) write(0,*)' tice2=',tice(ipr) call ice3lay ! --- inputs: ! & ( im, kmi, fice, flag, hfi, hfd, sneti, focn, delt, ! + & lprnt, ipr, ! --- outputs: ! & snowd, hice, stsice, tice, snof, snowmt, gflux ) ! -! if (lprnt) write(0,*)' tice3=',tice(ipr) - if (mom4ice) then - do i = 1, im - if (flag(i)) then - hice(i) = hi_save(i) - snowd(i) = hs_save(i) - endif - enddo - endif - do i = 1, im if (flag(i)) then if (tice(i) < timin) then @@ -535,8 +400,13 @@ subroutine sfc_sice_run & if (flag(i)) then ! --- ... calculate sensible heat flux (& evap over sea ice) +#ifdef GSD_SURFACE_FLUXES_BUGFIX + hflxi = rch(i) * (tice(i)/prsik1(i) - theta1(i)) + hflxw = rch(i) * (tgice / prsik1(i) - theta1(i)) +#else hflxi = rch(i) * (tice(i) - theta1(i)) hflxw = rch(i) * (tgice - theta1(i)) +#endif hflx(i) = fice(i)*hflxi + ffw(i)*hflxw evap(i) = fice(i)*evapi(i) + ffw(i)*evapw(i) ! @@ -589,6 +459,7 @@ subroutine ice3lay !................................... ! --- inputs: & ( im, kmi, fice, flag, hfi, hfd, sneti, focn, delt, & + & lprnt, ipr, ! --- input/outputs: & snowd, hice, stsice, tice, snof, & ! --- outputs: @@ -648,31 +519,32 @@ subroutine ice3lay ! ! --- constant parameters: (properties of ice, snow, and seawater) - real (kind=kind_phys), parameter :: ds = 330.0 !< snow (ov sea ice) density (kg/m^3) - real (kind=kind_phys), parameter :: dw =1000.0 !< fresh water density (kg/m^3) + real (kind=kind_phys), parameter :: ds = 330.0d0 !< snow (ov sea ice) density (kg/m^3) + real (kind=kind_phys), parameter :: dw =1000.0d0 !< fresh water density (kg/m^3) real (kind=kind_phys), parameter :: dsdw = ds/dw real (kind=kind_phys), parameter :: dwds = dw/ds - real (kind=kind_phys), parameter :: t0c =273.15 !< freezing temp of fresh ice (k) - real (kind=kind_phys), parameter :: ks = 0.31 !< conductivity of snow (w/mk) - real (kind=kind_phys), parameter :: i0 = 0.3 !< ice surface penetrating solar fraction - real (kind=kind_phys), parameter :: ki = 2.03 !< conductivity of ice (w/mk) - real (kind=kind_phys), parameter :: di = 917.0 !< density of ice (kg/m^3) + real (kind=kind_phys), parameter :: ks = 0.31d0 !< conductivity of snow (w/mk) + real (kind=kind_phys), parameter :: i0 = 0.3d0 !< ice surface penetrating solar fraction + real (kind=kind_phys), parameter :: ki = 2.03d0 !< conductivity of ice (w/mk) + real (kind=kind_phys), parameter :: di = 917.0d0 !< density of ice (kg/m^3) real (kind=kind_phys), parameter :: didw = di/dw real (kind=kind_phys), parameter :: dsdi = ds/di - real (kind=kind_phys), parameter :: ci = 2054.0 !< heat capacity of fresh ice (j/kg/k) - real (kind=kind_phys), parameter :: li = 3.34e5 !< latent heat of fusion (j/kg-ice) - real (kind=kind_phys), parameter :: si = 1.0 !< salinity of sea ice - real (kind=kind_phys), parameter :: mu = 0.054 !< relates freezing temp to salinity - real (kind=kind_phys), parameter :: tfi = -mu*si !< sea ice freezing temp = -mu*salinity - real (kind=kind_phys), parameter :: tfw = -1.8 !< tfw - seawater freezing temp (c) - real (kind=kind_phys), parameter :: tfi0 = tfi-0.0001 + real (kind=kind_phys), parameter :: ci = 2054.0d0 !< heat capacity of fresh ice (j/kg/k) + real (kind=kind_phys), parameter :: li = 3.34e5 !< latent heat of fusion (j/kg-ice) + real (kind=kind_phys), parameter :: si = 1.0d0 !< salinity of sea ice + real (kind=kind_phys), parameter :: mu = 0.054d0 !< relates freezing temp to salinity + real (kind=kind_phys), parameter :: tfi = -mu*si !< sea ice freezing temp = -mu*salinity + real (kind=kind_phys), parameter :: tfw = -1.8d0 !< tfw - seawater freezing temp (c) + real (kind=kind_phys), parameter :: tfi0 = tfi-0.0001d0 real (kind=kind_phys), parameter :: dici = di*ci real (kind=kind_phys), parameter :: dili = di*li real (kind=kind_phys), parameter :: dsli = ds*li - real (kind=kind_phys), parameter :: ki4 = ki*4.0 + real (kind=kind_phys), parameter :: ki4 = ki*4.0d0 + real (kind=kind_phys), parameter :: zero = 0.0d0, one = 1.0d0 ! --- inputs: - integer, intent(in) :: im, kmi + integer, intent(in) :: im, kmi, ipr + logical :: lprnt real (kind=kind_phys), dimension(im), intent(in) :: fice, hfi, & & hfd, sneti, focn @@ -701,10 +573,10 @@ subroutine ice3lay ! !===> ... begin here ! - dt2 = 2.0 * delt - dt4 = 4.0 * delt - dt6 = 6.0 * delt - dt2i = 1.0 / dt2 + dt2 = 2.0d0 * delt + dt4 = 4.0d0 * delt + dt6 = 6.0d0 * delt + dt2i = one / dt2 do i = 1, im if (flag(i)) then @@ -723,9 +595,9 @@ subroutine ice3lay stsice(i,2) = min(stsice(i,2)-t0c, tfi0) ! degc ip = i0 * sneti(i) ! ip +v (in winton ip=-i0*sneti as sol -v) - if (snowd(i) > 0.0) then - tsf = 0.0 - ip = 0.0 + if (snowd(i) > zero) then + tsf = zero + ip = zero else tsf = tfi ip = i0 * sneti(i) ! ip +v here (in winton ip=-i0*sneti) @@ -745,7 +617,7 @@ subroutine ice3lay !! points (see \a eq.(10) in Winton (2000) \cite winton_2000). k32 = (ki+ki) / hice(i) - wrk = 1.0 / (dt6*k32 + dici*hice(i)) + wrk = one / (dt6*k32 + dici*hice(i)) a10 = dici*hice(i)*dt2i + k32*(dt4*k32 + dici*hice(i))*wrk b10 = -di*hice(i) * (ci*stsice(i,1) + li*tfi/stsice(i,1)) & & * dt2i - ip & @@ -758,7 +630,7 @@ subroutine ice3lay !> - Calculate the new upper ice temperature following \a eq.(21) !! in Winton (2000) \cite winton_2000. - stsice(i,1) = -(sqrt(b1*b1 - 4.0*a1*c1) + b1)/(a1+a1) + stsice(i,1) = -(sqrt(b1*b1 - 4.0d0*a1*c1) + b1)/(a1+a1) tice(i) = (k12*stsice(i,1) - ai) / (k12 + bi) !> - If the surface temperature is greater than the freezing temperature @@ -771,11 +643,11 @@ subroutine ice3lay if (tice(i) > tsf) then a1 = a10 + k12 b1 = b10 - k12*tsf - stsice(i,1) = -(sqrt(b1*b1 - 4.0*a1*c1) + b1)/(a1+a1) + stsice(i,1) = -(sqrt(b1*b1 - 4.0d0*a1*c1) + b1)/(a1+a1) tice(i) = tsf tmelt = (k12*(stsice(i,1)-tsf) - (ai+bi*tsf)) * delt else - tmelt = 0.0 + tmelt =zero snowd(i) = snowd(i) + snof(i)*delt endif !> - Calculate the new lower ice temperature following \a eq.(15) @@ -791,8 +663,8 @@ subroutine ice3lay !> - Calculation of ice and snow mass changes. - h1 = 0.5 * hice(i) - h2 = 0.5 * hice(i) + h1 = 0.5d0 * hice(i) + h2 = 0.5d0 * hice(i) !> - Calculate the top layer thickness. @@ -803,14 +675,14 @@ subroutine ice3lay snowmt(i) = snowd(i) h1 = h1 - (tmelt - snowd(i)*dsli) & & / (di * (ci - li/stsice(i,1)) * (tfi - stsice(i,1))) - snowd(i) = 0.0 + snowd(i) = zero endif ! --- ... and bottom !> - When the energy for bottem melting \f$M_b\f$ is negative (i.e., freezing !! is happening),calculate the bottom layer thickness \f$h_2\f$ and the new !! lower layer temperature (see \a eqs.(24)-(26)). - if (bmelt < 0.0) then + if (bmelt < zero) then dh = -bmelt / (dili + dici*(tfi - tfw)) stsice(i,2) = (h2*stsice(i,2) + dh*tfw) / (h2 + dh) h2 = h2 + dh @@ -823,11 +695,11 @@ subroutine ice3lay hice(i) = h1 + h2 - if (hice(i) > 0.0) then - if (h1 > 0.5*hice(i)) then - f1 = 1.0 - (h2+h2) / hice(i) + if (hice(i) > zero) then + if (h1 > 0.5d0*hice(i)) then + f1 = one - (h2+h2) / hice(i) stsice(i,2) = f1 * (stsice(i,1) + li*tfi/(ci*stsice(i,1)))& - & + (1.0 - f1)*stsice(i,2) + & + (one - f1)*stsice(i,2) if (stsice(i,2) > tfi) then hice(i) = hice(i) - h2*ci*(stsice(i,2) - tfi)/ (li*delt) @@ -836,23 +708,23 @@ subroutine ice3lay else f1 = (h1+h1) / hice(i) stsice(i,1) = f1 * (stsice(i,1) + li*tfi/(ci*stsice(i,1)))& - & + (1.0 - f1)*stsice(i,2) + & + (one - f1)*stsice(i,2) stsice(i,1) = (stsice(i,1) - sqrt(stsice(i,1)*stsice(i,1) & - & - 4.0*tfi*li/ci)) * 0.5 + & - 4.0d0*tfi*li/ci)) * 0.5d0 endif k12 = ki4*ks / (ks*hice(i) + ki4*snowd(i)) gflux(i) = k12 * (stsice(i,1) - tice(i)) else snowd(i) = snowd(i) + (h1*(ci*(stsice(i,1) - tfi) & - & - li*(1.0 - tfi/stsice(i,1))) & + & - li*(one - tfi/stsice(i,1))) & & + h2*(ci*(stsice(i,2) - tfi) - li)) / li - hice(i) = max(0.0, snowd(i)*dsdi) - snowd(i) = 0.0 + hice(i) = max(zero, snowd(i)*dsdi) + snowd(i) = zero stsice(i,1) = tfw stsice(i,2) = tfw - gflux(i) = 0.0 + gflux(i) = zero endif ! end if_hice_block gflux(i) = fice(i) * gflux(i) diff --git a/physics/sfc_sice.meta b/physics/sfc_sice.meta new file mode 100644 index 000000000..c9641ffaa --- /dev/null +++ b/physics/sfc_sice.meta @@ -0,0 +1,487 @@ +[ccpp-arg-table] + name = sfc_sice_run + type = scheme +[im] + standard_name = horizontal_loop_extent + long_name = horizontal loop extent + units = count + dimensions = () + type = integer + intent = in + optional = F +[km] + standard_name = soil_vertical_dimension + long_name = vertical loop extent for soil levels, start at 1 + units = count + dimensions = () + type = integer + intent = in + optional = F +[sbc] + standard_name = stefan_boltzmann_constant + long_name = Stefan-Boltzmann constant + units = W m-2 K-4 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[hvap] + standard_name = latent_heat_of_vaporization_of_water_at_0C + long_name = latent heat of evaporation/sublimation + units = J kg-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[tgice] + standard_name = freezing_point_temperature_of_seawater + long_name = freezing point temperature of seawater + units = K + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[cp] + standard_name = specific_heat_of_dry_air_at_constant_pressure + long_name = specific heat of dry air at constant pressure + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[eps] + standard_name = ratio_of_dry_air_to_water_vapor_gas_constants + long_name = rd/rv + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[epsm1] + standard_name = ratio_of_dry_air_to_water_vapor_gas_constants_minus_one + long_name = (rd/rv) - 1 + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[rvrdm1] + standard_name = ratio_of_vapor_to_dry_air_gas_constants_minus_one + long_name = (rv/rd) - 1 (rv = ideal gas constant for water vapor) + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[grav] + standard_name = gravitational_acceleration + long_name = gravitational acceleration + units = m s-2 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[t0c] + standard_name = temperature_at_zero_celsius + long_name = temperature at 0 degrees Celsius + units = K + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[rd] + standard_name = gas_constant_dry_air + long_name = ideal gas constant for dry air + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[ps] + standard_name = surface_air_pressure + long_name = surface pressure + units = Pa + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[t1] + standard_name = air_temperature_at_lowest_model_layer + long_name = surface layer mean temperature + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[q1] + standard_name = water_vapor_specific_humidity_at_lowest_model_layer + long_name = surface layer mean specific humidity + units = kg kg-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[delt] + standard_name = time_step_for_dynamics + long_name = time step + units = s + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[sfcemis] + standard_name = surface_longwave_emissivity_over_ice_interstitial + long_name = surface lw emissivity in fraction over ice (temporary use as interstitial) + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[dlwflx] + standard_name = surface_downwelling_longwave_flux_absorbed_by_ground_over_ice + long_name = total sky surface downward longwave flux absorbed by the ground over ice + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[sfcnsw] + standard_name = surface_net_downwelling_shortwave_flux + long_name = total sky sfc netsw flx into ground + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[sfcdsw] + standard_name = surface_downwelling_shortwave_flux + long_name = total sky sfc downward sw flux + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[srflag] + standard_name = flag_for_precipitation_type + long_name = snow/rain flag for precipitation + units = flag + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[cm] + standard_name = surface_drag_coefficient_for_momentum_in_air_over_ice + long_name = surface exchange coeff for momentum over ice + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[ch] + standard_name = surface_drag_coefficient_for_heat_and_moisture_in_air_over_ice + long_name = surface exchange coeff heat & moisture over ice + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[prsl1] + standard_name = air_pressure_at_lowest_model_layer + long_name = surface layer mean pressure + units = Pa + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[prslki] + standard_name = ratio_of_exner_function_between_midlayer_and_interface_at_lowest_model_layer + long_name = Exner function ratio bt midlayer and interface at 1st layer + units = ratio + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[prsik1] + standard_name = dimensionless_exner_function_at_lowest_model_interface + long_name = dimensionless Exner function at the ground surface + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[prslk1] + standard_name = dimensionless_exner_function_at_lowest_model_layer + long_name = dimensionless Exner function at the lowest model layer + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[islimsk] + standard_name = sea_land_ice_mask + long_name = sea/land/ice mask (=0/1/2) + units = flag + dimensions = (horizontal_dimension) + type = integer + intent = in + optional = F +[wind] + standard_name = wind_speed_at_lowest_model_layer + long_name = wind speed at lowest model level + units = m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[flag_iter] + standard_name = flag_for_iteration + long_name = flag for iteration + units = flag + dimensions = (horizontal_dimension) + type = logical + intent = in + optional = F +[lprnt] + standard_name = flag_print + long_name = switch for printing sample column to stdout + units = flag + dimensions = () + type = logical + intent = in + optional = F +[ipr] + standard_name = horizontal_index_of_printed_column + long_name = horizontal index of printed column + units = index + dimensions = () + type = integer + intent = in + optional = F +[cimin] + standard_name = lake_ice_minimum + long_name = minimum lake ice value + units = ??? + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[hice] + standard_name = sea_ice_thickness + long_name = sea-ice thickness + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[fice] + standard_name = sea_ice_concentration + long_name = sea-ice concentration [0,1] + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[tice] + standard_name = sea_ice_temperature_interstitial + long_name = sea-ice surface temperature use as interstitial + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[weasd] + standard_name = water_equivalent_accumulated_snow_depth_over_ice + long_name = water equiv of acc snow depth over ice + units = mm + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[tskin] + standard_name = surface_skin_temperature_over_ice_interstitial + long_name = surface skin temperature over ice (temporary use as interstitial) + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[tprcp] + standard_name = nonnegative_lwe_thickness_of_precipitation_amount_on_dynamics_timestep_over_ice + long_name = total precipitation amount in each time step over ice + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[stc] + standard_name = soil_temperature + long_name = soil temp + units = K + dimensions = (horizontal_dimension,soil_vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[ep] + standard_name = surface_upward_potential_latent_heat_flux_over_ice + long_name = surface upward potential latent heat flux over ice + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[snwdph] + standard_name = surface_snow_thickness_water_equivalent_over_ice + long_name = water equivalent snow depth over ice + units = mm + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[qsurf] + standard_name = surface_specific_humidity_over_ice + long_name = surface air saturation specific humidity over ice + units = kg kg-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[snowmt] + standard_name = surface_snow_melt + long_name = snow melt during timestep + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[gflux] + standard_name = upward_heat_flux_in_soil_over_ice + long_name = soil heat flux over ice + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[cmm] + standard_name = surface_drag_wind_speed_for_momentum_in_air_over_ice + long_name = momentum exchange coefficient over ice + units = m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[chh] + standard_name = surface_drag_mass_flux_for_heat_and_moisture_in_air_over_ice + long_name = thermal exchange coefficient over ice + units = kg m-2 s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[evap] + standard_name = kinematic_surface_upward_latent_heat_flux_over_ice + long_name = kinematic surface upward latent heat flux over ice + units = kg kg-1 m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[hflx] + standard_name = kinematic_surface_upward_sensible_heat_flux_over_ice + long_name = kinematic surface upward sensible heat flux over ice + units = K m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[cplflx] + standard_name = flag_for_flux_coupling + long_name = flag controlling cplflx collection (default off) + units = flag + dimensions = () + type = logical + intent = in + optional = F +[cplchm] + standard_name = flag_for_chemistry_coupling + long_name = flag controlling cplchm collection (default off) + units = flag + dimensions = () + type = logical + intent = in + optional = F +[flag_cice] + standard_name = flag_for_cice + long_name = flag for cice + units = flag + dimensions = (horizontal_dimension) + type = logical + intent = in + optional = F +[islmsk_cice] + standard_name = sea_land_ice_mask_cice + long_name = sea/land/ice mask cice (=0/1/2) + units = flag + dimensions = (horizontal_dimension) + type = integer + intent = in + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F diff --git a/physics/sfcsub.F b/physics/sfcsub.F index 7c78707f5..6296e7856 100644 --- a/physics/sfcsub.F +++ b/physics/sfcsub.F @@ -2,10 +2,9 @@ !! This file contains gribcode for each parameter. -!>\defgroup mod_sfcsub_mod GFS sfcsub Module +!>\defgroup mod_sfcsub GFS sfcsub Module !!\ingroup Noah_LSM !> @{ -!>\ingroup mod_sfcsub !! This module contains grib code for each parameter-used in subroutines sfccycle() !! and setrmsk(). module sfccyc_module @@ -39,18 +38,37 @@ module sfccyc_module ! end module sfccyc_module -!>\ingroup mod_sfcsub - subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc - &, iy,im,id,ih,fh - &, rla, rlo, slmask,orog,orog_uf,use_ufo,nst_anl - &, sihfcs,sicfcs,sitfcs - &, swdfcs,slcfcs - &, vmnfcs,vmxfcs,slpfcs,absfcs - &, tsffcs,snofcs,zorfcs,albfcs,tg3fcs - &, cnpfcs,smcfcs,stcfcs,slifcs,aisfcs - &, vegfcs,vetfcs,sotfcs,alffcs - &, cvfcs,cvbfcs,cvtfcs,me,nlunit - &, sz_nml,input_nml_file +!>\ingroup mod_GFS_phys_time_vary +!! This subroutine reads or interpolates surface climatology data in analysis +!! and forecast mode. +!!\param lugb the unit number used in this subprogram +!!\param len number of points on which sfccyc operates +!!\param lsoil number of soil layers +!!\param sig1t sigma level 1 temperature for dead start. it should be on gaussian +!! grid. If not dead start, no need for dimension but set to zero as +!! in the example below. +!!\param deltsfc = fhcyc, frequcy for surface data cycling in hours +!!\param iy,im,id,ih year, month, day, and hour of initial state +!!\param fh forecast hour +!!\param rla, rlo latitude and longitudes of the len points +!!\param slmsk +!!\param orog +!!\param orog_uf +!!\param use_ufo +!!\param nst_anl +!! + + subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc & + &, iy,im,id,ih,fh & + &, rla, rlo, slmask,orog,orog_uf,use_ufo,nst_anl & + &, sihfcs,sicfcs,sitfcs & + &, swdfcs,slcfcs & + &, vmnfcs,vmxfcs,slpfcs,absfcs & + &, tsffcs,snofcs,zorfcs,albfcs,tg3fcs & + &, cnpfcs,smcfcs,stcfcs,slifcs,aisfcs & + &, vegfcs,vetfcs,sotfcs,alffcs & + &, cvfcs,cvbfcs,cvtfcs,me,nlunit & + &, sz_nml,input_nml_file & &, ialb,isot,ivegsrc,tile_num_ch,i_index,j_index) ! use machine , only : kind_io8,kind_io4 @@ -59,90 +77,90 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc character(len=*), intent(in) :: tile_num_ch integer,intent(in) :: i_index(len), j_index(len) logical use_ufo, nst_anl - real (kind=kind_io8) sllnd,slsea,aicice,aicsea,tgice,rlapse, - & orolmx,orolmn,oroomx,oroomn,orosmx, - & orosmn,oroimx,oroimn,orojmx,orojmn, - & alblmx,alblmn,albomx,albomn,albsmx, - & albsmn,albimx,albimn,albjmx,albjmn, - & wetlmx,wetlmn,wetomx,wetomn,wetsmx, - & wetsmn,wetimx,wetimn,wetjmx,wetjmn, - & snolmx,snolmn,snoomx,snoomn,snosmx, - & snosmn,snoimx,snoimn,snojmx,snojmn, - & zorlmx,zorlmn,zoromx,zoromn,zorsmx, - & zorsmn,zorimx,zorimn,zorjmx, zorjmn, - & plrlmx,plrlmn,plromx,plromn,plrsmx, - & plrsmn,plrimx,plrimn,plrjmx,plrjmn, - & tsflmx,tsflmn,tsfomx,tsfomn,tsfsmx, - & tsfsmn,tsfimx,tsfimn,tsfjmx,tsfjmn, - & tg3lmx,tg3lmn,tg3omx,tg3omn,tg3smx, - & tg3smn,tg3imx,tg3imn,tg3jmx,tg3jmn, - & stclmx,stclmn,stcomx,stcomn,stcsmx, - & stcsmn,stcimx,stcimn,stcjmx,stcjmn, - & smclmx,smclmn,smcomx,smcomn,smcsmx, - & smcsmn,smcimx,smcimn,smcjmx,smcjmn, - & scvlmx,scvlmn,scvomx,scvomn,scvsmx, - & scvsmn,scvimx,scvimn,scvjmx,scvjmn, - & veglmx,veglmn,vegomx,vegomn,vegsmx, - & vegsmn,vegimx,vegimn,vegjmx,vegjmn, - & vetlmx,vetlmn,vetomx,vetomn,vetsmx, - & vetsmn,vetimx,vetimn,vetjmx,vetjmn, - & sotlmx,sotlmn,sotomx,sotomn,sotsmx, - & sotsmn,sotimx,sotimn,sotjmx,sotjmn, - & alslmx,alslmn,alsomx,alsomn,alssmx, - & alssmn,alsimx,alsimn,alsjmx,alsjmn, - & epstsf,epsalb,epssno,epswet,epszor, - & epsplr,epsoro,epssmc,epsscv,eptsfc, - & epstg3,epsais,epsacn,epsveg,epsvet, - & epssot,epsalf,qctsfs,qcsnos,qctsfi, - & aislim,snwmin,snwmax,cplrl,cplrs, - & cvegl,czors,csnol,csnos,czorl,csots, - & csotl,cvwgs,cvetl,cvets,calfs, - & fcalfl,fcalfs,ccvt,ccnp,ccv,ccvb, - & calbl,calfl,calbs,ctsfs,grboro, - & grbmsk,ctsfl,deltf,caisl,caiss, - & fsalfl,fsalfs,flalfs,falbl,ftsfl, - & ftsfs,fzorl,fzors,fplrl,fsnos,faisl, - & faiss,fsnol,bltmsk,falbs,cvegs,percrit, - & deltsfc,critp2,critp3,blnmsk,critp1, - & fcplrl,fcplrs,fczors,fvets,fsotl,fsots, - & fvetl,fplrs,fvegl,fvegs,fcsnol,fcsnos, - & fczorl,fcalbs,fctsfl,fctsfs,fcalbl, - & falfs,falfl,fh,crit,zsca,ztsfc,tem1,tem2 - &, fsihl,fsihs,fsicl,fsics, - & csihl,csihs,csicl,csics,epssih,epssic - &, fvmnl,fvmns,fvmxl,fvmxs,fslpl,fslps, - & fabsl,fabss,cvmnl,cvmns,cvmxl,cvmxs, - & cslpl,cslps,cabsl,cabss,epsvmn,epsvmx, - & epsslp,epsabs - &, sihlmx,sihlmn,sihomx,sihomn,sihsmx, - & sihsmn,sihimx,sihimn,sihjmx,sihjmn, - & siclmx,siclmn,sicomx,sicomn,sicsmx, - & sicsmn,sicimx,sicimn,sicjmx,sicjmn - &, glacir_hice - &, vmnlmx,vmnlmn,vmnomx,vmnomn,vmnsmx, - & vmnsmn,vmnimx,vmnimn,vmnjmx,vmnjmn, - & vmxlmx,vmxlmn,vmxomx,vmxomn,vmxsmx, - & vmxsmn,vmximx,vmximn,vmxjmx,vmxjmn, - & slplmx,slplmn,slpomx,slpomn,slpsmx, - & slpsmn,slpimx,slpimn,slpjmx,slpjmn, - & abslmx,abslmn,absomx,absomn,abssmx, - & abssmn,absimx,absimn,absjmx,absjmn + real (kind=kind_io8) sllnd,slsea,aicice,aicsea,tgice,rlapse, & + & orolmx,orolmn,oroomx,oroomn,orosmx, & + & orosmn,oroimx,oroimn,orojmx,orojmn, & + & alblmx,alblmn,albomx,albomn,albsmx, & + & albsmn,albimx,albimn,albjmx,albjmn, & + & wetlmx,wetlmn,wetomx,wetomn,wetsmx, & + & wetsmn,wetimx,wetimn,wetjmx,wetjmn, & + & snolmx,snolmn,snoomx,snoomn,snosmx, & + & snosmn,snoimx,snoimn,snojmx,snojmn, & + & zorlmx,zorlmn,zoromx,zoromn,zorsmx, & + & zorsmn,zorimx,zorimn,zorjmx, zorjmn, & + & plrlmx,plrlmn,plromx,plromn,plrsmx, & + & plrsmn,plrimx,plrimn,plrjmx,plrjmn, & + & tsflmx,tsflmn,tsfomx,tsfomn,tsfsmx, & + & tsfsmn,tsfimx,tsfimn,tsfjmx,tsfjmn, & + & tg3lmx,tg3lmn,tg3omx,tg3omn,tg3smx, & + & tg3smn,tg3imx,tg3imn,tg3jmx,tg3jmn, & + & stclmx,stclmn,stcomx,stcomn,stcsmx, & + & stcsmn,stcimx,stcimn,stcjmx,stcjmn, & + & smclmx,smclmn,smcomx,smcomn,smcsmx, & + & smcsmn,smcimx,smcimn,smcjmx,smcjmn, & + & scvlmx,scvlmn,scvomx,scvomn,scvsmx, & + & scvsmn,scvimx,scvimn,scvjmx,scvjmn, & + & veglmx,veglmn,vegomx,vegomn,vegsmx, & + & vegsmn,vegimx,vegimn,vegjmx,vegjmn, & + & vetlmx,vetlmn,vetomx,vetomn,vetsmx, & + & vetsmn,vetimx,vetimn,vetjmx,vetjmn, & + & sotlmx,sotlmn,sotomx,sotomn,sotsmx, & + & sotsmn,sotimx,sotimn,sotjmx,sotjmn, & + & alslmx,alslmn,alsomx,alsomn,alssmx, & + & alssmn,alsimx,alsimn,alsjmx,alsjmn, & + & epstsf,epsalb,epssno,epswet,epszor, & + & epsplr,epsoro,epssmc,epsscv,eptsfc, & + & epstg3,epsais,epsacn,epsveg,epsvet, & + & epssot,epsalf,qctsfs,qcsnos,qctsfi, & + & aislim,snwmin,snwmax,cplrl,cplrs, & + & cvegl,czors,csnol,csnos,czorl,csots, & + & csotl,cvwgs,cvetl,cvets,calfs, & + & fcalfl,fcalfs,ccvt,ccnp,ccv,ccvb, & + & calbl,calfl,calbs,ctsfs,grboro, & + & grbmsk,ctsfl,deltf,caisl,caiss, & + & fsalfl,fsalfs,flalfs,falbl,ftsfl, & + & ftsfs,fzorl,fzors,fplrl,fsnos,faisl, & + & faiss,fsnol,bltmsk,falbs,cvegs,percrit, & + & deltsfc,critp2,critp3,blnmsk,critp1, & + & fcplrl,fcplrs,fczors,fvets,fsotl,fsots, & + & fvetl,fplrs,fvegl,fvegs,fcsnol,fcsnos, & + & fczorl,fcalbs,fctsfl,fctsfs,fcalbl, & + & falfs,falfl,fh,crit,zsca,ztsfc,tem1,tem2 & + &, fsihl,fsihs,fsicl,fsics, & + & csihl,csihs,csicl,csics,epssih,epssic & + &, fvmnl,fvmns,fvmxl,fvmxs,fslpl,fslps, & + & fabsl,fabss,cvmnl,cvmns,cvmxl,cvmxs, & + & cslpl,cslps,cabsl,cabss,epsvmn,epsvmx, & + & epsslp,epsabs & + &, sihlmx,sihlmn,sihomx,sihomn,sihsmx, & + & sihsmn,sihimx,sihimn,sihjmx,sihjmn, & + & siclmx,siclmn,sicomx,sicomn,sicsmx, & + & sicsmn,sicimx,sicimn,sicjmx,sicjmn & + &, glacir_hice & + &, vmnlmx,vmnlmn,vmnomx,vmnomn,vmnsmx, & + & vmnsmn,vmnimx,vmnimn,vmnjmx,vmnjmn, & + & vmxlmx,vmxlmn,vmxomx,vmxomn,vmxsmx, & + & vmxsmn,vmximx,vmximn,vmxjmx,vmxjmn, & + & slplmx,slplmn,slpomx,slpomn,slpsmx, & + & slpsmn,slpimx,slpimn,slpjmx,slpjmn, & + & abslmx,abslmn,absomx,absomn,abssmx, & + & abssmn,absimx,absimn,absjmx,absjmn & &, sihnew - integer imsk,jmsk,ifp,irtscv,irtacn,irtais,irtsno,irtzor, - & irtalb,irtsot,irtalf,j,irtvet,irtsmc,irtstc,irtveg, - & irtwet,k,iprnt,kk,irttsf,iret,i,igrdbg,iy,im,id, - & icalbl,icalbs,icalfl,ictsfs,lugb,len,lsoil,ih, - & ictsfl,iczors,icplrl,icplrs,iczorl,icalfs,icsnol, - & icsnos,irttg3,me,kqcm,nlunit,sz_nml,ialb + integer imsk,jmsk,ifp,irtscv,irtacn,irtais,irtsno,irtzor, & + & irtalb,irtsot,irtalf,j,irtvet,irtsmc,irtstc,irtveg, & + & irtwet,k,iprnt,kk,irttsf,iret,i,igrdbg,iy,im,id, & + & icalbl,icalbs,icalfl,ictsfs,lugb,len,lsoil,ih, & + & ictsfl,iczors,icplrl,icplrs,iczorl,icalfs,icsnol, & + & icsnos,irttg3,me,kqcm,nlunit,sz_nml,ialb & &, irtvmn, irtvmx, irtslp, irtabs, isot, ivegsrc - logical gausm, deads, qcmsk, znlst, monclm, monanl, + logical gausm, deads, qcmsk, znlst, monclm, monanl, & & monfcs, monmer, mondif, landice character(len=*), intent(in) :: input_nml_file(sz_nml) integer num_parthds ! -!> this is a limited point version of surface program. +!> This is a limited point version of surface program. !! !! this program runs in two different modes: !! @@ -159,9 +177,7 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc !! forecast hour. if surface analysis file is given, for the corresponding !! dates, the program will use it. !! -!! note: -!! -!! if the date of the analysis does not match given iy,im,id,ih, (and fh), +!!\note if the date of the analysis does not match given iy,im,id,ih, (and fh), !! the program searches an old analysis by going back 6 hours, then 12 hours, !! then one day upto nrepmx days (parameter statement in the subrotine fixrd. !! now defined as 8). this allows the user to provide non-daily analysis to @@ -178,15 +194,6 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc !! !! for a dead start, do not supply fnbgsi or set fnbgsi=' ' ! -! lugb is the unit number used in this subprogram -! len ... number of points on which sfccyc operates -! lsoil .. number of soil layers (2 as of april, 1994) -! iy,im,id,ih .. year, month, day, and hour of initial state. -! fh .. forecast hour -! rla, rlo -- latitude and longitudes of the len points -! sig1t .. sigma level 1 temperature for dead start. should be on gaussian -! grid. if not dead start, no need for dimension but set to zero -! as in the example below. ! ! variable naming conventions: ! @@ -427,7 +434,7 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc ! ! mask orography and variance on gaussian grid ! - real (kind=kind_io8) slmask(len),orog(len), orog_uf(len) + real (kind=kind_io8) slmask(len),orog(len), orog_uf(len) & &, orogd(len) real (kind=kind_io8) rla(len), rlo(len) ! @@ -440,50 +447,50 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc ! ! climatology surface fields (last character 'c' or 'clm' indicate climatology) ! - character*500 fntsfc,fnwetc,fnsnoc,fnzorc,fnalbc,fnaisc, - & fnplrc,fntg3c,fnscvc,fnsmcc,fnstcc,fnacnc, - & fnvegc,fnvetc,fnsotc + character*500 fntsfc,fnwetc,fnsnoc,fnzorc,fnalbc,fnaisc, & + & fnplrc,fntg3c,fnscvc,fnsmcc,fnstcc,fnacnc, & + & fnvegc,fnvetc,fnsotc & &, fnvmnc,fnvmxc,fnslpc,fnabsc, fnalbc2 - real (kind=kind_io8) tsfclm(len), wetclm(len), snoclm(len), - & zorclm(len), albclm(len,4), aisclm(len), - & tg3clm(len), acnclm(len), cnpclm(len), - & cvclm (len), cvbclm(len), cvtclm(len), - & scvclm(len), tsfcl2(len), vegclm(len), - & vetclm(len), sotclm(len), alfclm(len,2), sliclm(len), - & smcclm(len,lsoil), stcclm(len,lsoil) - &, sihclm(len), sicclm(len) + real (kind=kind_io8) tsfclm(len), wetclm(len), snoclm(len), & + & zorclm(len), albclm(len,4), aisclm(len), & + & tg3clm(len), acnclm(len), cnpclm(len), & + & cvclm (len), cvbclm(len), cvtclm(len), & + & scvclm(len), tsfcl2(len), vegclm(len), & + & vetclm(len), sotclm(len), alfclm(len,2), sliclm(len), & + & smcclm(len,lsoil), stcclm(len,lsoil) & + &, sihclm(len), sicclm(len) & &, vmnclm(len), vmxclm(len), slpclm(len), absclm(len) ! ! analyzed surface fields (last character 'a' or 'anl' indicate analysis) ! - character*500 fntsfa,fnweta,fnsnoa,fnzora,fnalba,fnaisa, - & fnplra,fntg3a,fnscva,fnsmca,fnstca,fnacna, - & fnvega,fnveta,fnsota + character*500 fntsfa,fnweta,fnsnoa,fnzora,fnalba,fnaisa, & + & fnplra,fntg3a,fnscva,fnsmca,fnstca,fnacna, & + & fnvega,fnveta,fnsota & &, fnvmna,fnvmxa,fnslpa,fnabsa ! - real (kind=kind_io8) tsfanl(len), wetanl(len), snoanl(len), - & zoranl(len), albanl(len,4), aisanl(len), - & tg3anl(len), acnanl(len), cnpanl(len), - & cvanl (len), cvbanl(len), cvtanl(len), - & scvanl(len), tsfan2(len), veganl(len), - & vetanl(len), sotanl(len), alfanl(len,2), slianl(len), - & smcanl(len,lsoil), stcanl(len,lsoil) - &, sihanl(len), sicanl(len) + real (kind=kind_io8) tsfanl(len), wetanl(len), snoanl(len), & + & zoranl(len), albanl(len,4), aisanl(len), & + & tg3anl(len), acnanl(len), cnpanl(len), & + & cvanl (len), cvbanl(len), cvtanl(len), & + & scvanl(len), tsfan2(len), veganl(len), & + & vetanl(len), sotanl(len), alfanl(len,2), slianl(len), & + & smcanl(len,lsoil), stcanl(len,lsoil) & + &, sihanl(len), sicanl(len) & &, vmnanl(len), vmxanl(len), slpanl(len), absanl(len) ! real (kind=kind_io8) tsfan0(len) ! sea surface temperature analysis at ft=0. ! ! predicted surface fields (last characters 'fcs' indicates forecast) ! - real (kind=kind_io8) tsffcs(len), wetfcs(len), snofcs(len), - & zorfcs(len), albfcs(len,4), aisfcs(len), - & tg3fcs(len), acnfcs(len), cnpfcs(len), - & cvfcs (len), cvbfcs(len), cvtfcs(len), - & slifcs(len), vegfcs(len), - & vetfcs(len), sotfcs(len), alffcs(len,2), - & smcfcs(len,lsoil), stcfcs(len,lsoil) - &, sihfcs(len), sicfcs(len), sitfcs(len) - &, vmnfcs(len), vmxfcs(len), slpfcs(len), absfcs(len) + real (kind=kind_io8) tsffcs(len), wetfcs(len), snofcs(len), & + & zorfcs(len), albfcs(len,4), aisfcs(len), & + & tg3fcs(len), acnfcs(len), cnpfcs(len), & + & cvfcs (len), cvbfcs(len), cvtfcs(len), & + & slifcs(len), vegfcs(len), & + & vetfcs(len), sotfcs(len), alffcs(len,2), & + & smcfcs(len,lsoil), stcfcs(len,lsoil) & + &, sihfcs(len), sicfcs(len), sitfcs(len) & + &, vmnfcs(len), vmxfcs(len), slpfcs(len), absfcs(len) & &, swdfcs(len), slcfcs(len,lsoil) ! ! ratio of sigma level 1 wind and 10m wind (diagnozed by model and not touched @@ -989,7 +996,7 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc if((fabss.gt.0.).and.(fabss.lt.99999)) cabss=exp(-deltf/fabss) !clu ---------------------------------------------------------------------- ! -! read a high resolution mask field for use in grib interpolation +!> - Call hmskrd() to read a high resolution mask field for use in grib interpolation ! call hmskrd(lugb,imsk,jmsk,fnmskh, & kpdmsk,slmskh,gausm,blnmsk,bltmsk,me) @@ -2671,7 +2678,8 @@ subroutine dayoyr(iyr,imo,idy,ldy) end !>\ingroup mod_sfcsub - subroutine hmskrd(lugb,imsk,jmsk,fnmskh, +!! reads a high resolution mask field for use in grib interpolation + subroutine hmskrd(lugb,imsk,jmsk,fnmskh, & & kpds5,slmskh,gausm,blnmsk,bltmsk,me) use machine , only : kind_io8,kind_io4 use sfccyc_module, only : mdata, xdata, ydata @@ -2706,7 +2714,7 @@ subroutine hmskrd(lugb,imsk,jmsk,fnmskh, end !>\ingroup mod_sfcsub - subroutine fixrdg(lugb,idim,jdim,fngrib, + subroutine fixrdg(lugb,idim,jdim,fngrib, & & kpds5,gdata,gaus,blno,blto,me) use machine , only : kind_io8,kind_io4 use sfccyc_module, only : mdata @@ -2824,7 +2832,7 @@ subroutine fixrdg(lugb,idim,jdim,fngrib, !>\ingroup mod_sfcsub !! This subroutine get area of the grib record. - subroutine getarea(kgds,dlat,dlon,rslat,rnlat,wlon,elon,ijordr + subroutine getarea(kgds,dlat,dlon,rslat,rnlat,wlon,elon,ijordr & &, me) use machine , only : kind_io8,kind_io4 implicit none @@ -3040,24 +3048,22 @@ subroutine subst(data,imax,jmax,dlon,dlat,ijordr) !>\ingroup mod_sfcsub !! This subroutine conducts interpolation from lat/lon to Gaussian !! grid to other lat/lon grid. - subroutine la2ga(regin,imxin,jmxin,rinlon,rinlat,rlon,rlat,inttyp, - & gauout,len,lmask,rslmsk,slmask + subroutine la2ga(regin,imxin,jmxin,rinlon,rinlat,rlon,rlat,inttyp,& + & gauout,len,lmask,rslmsk,slmask & &, outlat, outlon,me) use machine , only : kind_io8,kind_io4 implicit none - real (kind=kind_io8) wei4,wei3,wei2,sum2,sum1,sum3,wei1,sum4, - & wsum,tem,wsumiv,sums,sumn,wi2j2,x,y,wi1j1, - & wi1j2,wi2j1,rlat,rlon,aphi, + real (kind=kind_io8) wei4,wei3,wei2,sum2,sum1,sum3,wei1,sum4, & + & wsum,tem,wsumiv,sums,sumn,wi2j2,x,y,wi1j1, & + & wi1j2,wi2j1,rlat,rlon,aphi, & & rnume,alamd,denom - integer jy,ifills,ix,len,inttyp,me,i,j,jmxin,imxin,jq,jx,j1,j2, + integer jy,ifills,ix,len,inttyp,me,i,j,jmxin,imxin,jq,jx,j1,j2, & & ii,i1,i2,kmami,it integer nx,kxs,kxt integer, allocatable, save :: imxnx(:) integer, allocatable :: ifill(:) ! -! interpolation from lat/lon or gaussian grid to other lat/lon grid -! - real (kind=kind_io8) outlon(len),outlat(len),gauout(len), + real (kind=kind_io8) outlon(len),outlat(len),gauout(len), & & slmask(len) real (kind=kind_io8) regin (imxin,jmxin),rslmsk(imxin,jmxin) ! @@ -3613,54 +3619,46 @@ subroutine maxmin(f,imax,kmax) end !>\ingroup mod_sfcsub - subroutine filanl(tsfanl,tsfan2,wetanl,snoanl,zoranl,albanl, - & aisanl, - & tg3anl,cvanl ,cvbanl,cvtanl, - & cnpanl,smcanl,stcanl,slianl,scvanl,veganl, - & vetanl,sotanl,alfanl, -!cwu [+1l] add ()anl for sih, sic - & sihanl,sicanl, -!clu [+1l] add ()anl for vmn, vmx, slp, abs - & vmnanl,vmxanl,slpanl,absanl, - & tsfclm,tsfcl2,wetclm,snoclm,zorclm,albclm, - & aisclm, - & tg3clm,cvclm ,cvbclm,cvtclm, - & cnpclm,smcclm,stcclm,sliclm,scvclm,vegclm, - & vetclm,sotclm,alfclm, -!cwu [+1l] add ()clm for sih, sic - & sihclm,sicclm, -!clu [+1l] add ()clm for vmn, vmx, slp, abs - & vmnclm,vmxclm,slpclm,absclm, + subroutine filanl(tsfanl,tsfan2,wetanl,snoanl,zoranl,albanl, & + & aisanl, & + & tg3anl,cvanl ,cvbanl,cvtanl, & + & cnpanl,smcanl,stcanl,slianl,scvanl,veganl, & + & vetanl,sotanl,alfanl, & + & sihanl,sicanl, & !cwu [+1l] add ()anl for sih, sic + & vmnanl,vmxanl,slpanl,absanl, & !clu [+1l] add ()anl for vmn, vmx, slp, abs + & tsfclm,tsfcl2,wetclm,snoclm,zorclm,albclm, & + & aisclm, & + & tg3clm,cvclm ,cvbclm,cvtclm, & + & cnpclm,smcclm,stcclm,sliclm,scvclm,vegclm, & + & vetclm,sotclm,alfclm, & + & sihclm,sicclm, & !cwu [+1l] add ()clm for sih, sic + & vmnclm,vmxclm,slpclm,absclm, & !clu [+1l] add ()clm for vmn, vmx, slp, abs & len,lsoil) use machine , only : kind_io8,kind_io4 implicit none integer i,j,len,lsoil ! - real (kind=kind_io8) tsfanl(len),tsfan2(len),wetanl(len), - & snoanl(len), - & zoranl(len),albanl(len,4),aisanl(len), - & tg3anl(len), - & cvanl (len),cvbanl(len),cvtanl(len), - & cnpanl(len), - & smcanl(len,lsoil),stcanl(len,lsoil), - & slianl(len),scvanl(len),veganl(len), - & vetanl(len),sotanl(len),alfanl(len,2) -!cwu [+1l] add ()anl for sih, sic - &, sihanl(len),sicanl(len) -!clu [+1l] add ()anl for vmn, vmx, slp, abs - &, vmnanl(len),vmxanl(len),slpanl(len),absanl(len) - real (kind=kind_io8) tsfclm(len),tsfcl2(len),wetclm(len), - & snoclm(len), - & zorclm(len),albclm(len,4),aisclm(len), - & tg3clm(len), - & cvclm (len),cvbclm(len),cvtclm(len), - & cnpclm(len), - & smcclm(len,lsoil),stcclm(len,lsoil), - & sliclm(len),scvclm(len),vegclm(len), - & vetclm(len),sotclm(len),alfclm(len,2) -!cwu [+1l] add ()clm for sih, sic - &, sihclm(len),sicclm(len) -!clu [+1l] add ()clm for vmn, vmx, slp, abs + real (kind=kind_io8) tsfanl(len),tsfan2(len),wetanl(len), & + & snoanl(len), & + & zoranl(len),albanl(len,4),aisanl(len), & + & tg3anl(len), & + & cvanl (len),cvbanl(len),cvtanl(len), & + & cnpanl(len), & + & smcanl(len,lsoil),stcanl(len,lsoil), & + & slianl(len),scvanl(len),veganl(len), & + & vetanl(len),sotanl(len),alfanl(len,2) & + &, sihanl(len),sicanl(len) & + &, vmnanl(len),vmxanl(len),slpanl(len),absanl(len) + real (kind=kind_io8) tsfclm(len),tsfcl2(len),wetclm(len), & + & snoclm(len), & + & zorclm(len),albclm(len,4),aisclm(len), & + & tg3clm(len), & + & cvclm (len),cvbclm(len),cvtclm(len), & + & cnpclm(len), & + & smcclm(len,lsoil),stcclm(len,lsoil), & + & sliclm(len),scvclm(len),vegclm(len), & + & vetclm(len),sotclm(len),alfclm(len,2) & + &, sihclm(len),sicclm(len) & &, vmnclm(len),vmxclm(len),slpclm(len),absclm(len) ! do i=1,len @@ -3712,43 +3710,34 @@ subroutine filanl(tsfanl,tsfan2,wetanl,snoanl,zoranl,albanl, end !>\ingroup mod_sfcsub - subroutine analy(lugb,iy,im,id,ih,fh,len,lsoil, - & slmask,fntsfa,fnweta,fnsnoa,fnzora,fnalba,fnaisa, - & fntg3a,fnscva,fnsmca,fnstca,fnacna,fnvega, - & fnveta,fnsota, -!clu [+1l] add fn()a for vmn, vmx, slp, abs - & fnvmna,fnvmxa,fnslpa,fnabsa, - & tsfanl,wetanl,snoanl,zoranl,albanl,aisanl, - & tg3anl,cvanl ,cvbanl,cvtanl, - & smcanl,stcanl,slianl,scvanl,acnanl,veganl, - & vetanl,sotanl,alfanl,tsfan0, -!clu [+1l] add ()anl for vmn, vmx, slp, abs - & vmnanl,vmxanl,slpanl,absanl, -!cggg snow mods start & kpdtsf,kpdwet,kpdsno,kpdzor,kpdalb,kpdais, - & kpdtsf,kpdwet,kpdsno,kpdsnd,kpdzor,kpdalb,kpdais, -!cggg snow mods end - & kpdtg3,kpdscv,kpdacn,kpdsmc,kpdstc,kpdveg, - & kprvet,kpdsot,kpdalf, -!clu [+1l] add kpd() for vmn, vmx, slp, abs - & kpdvmn,kpdvmx,kpdslp,kpdabs, - & irttsf,irtwet,irtsno,irtzor,irtalb,irtais, - & irttg3,irtscv,irtacn,irtsmc,irtstc,irtveg, - & irtvet,irtsot,irtalf -!clu [+1l] add irt() for vmn, vmx, slp, abs - &, irtvmn,irtvmx,irtslp,irtabs - &, imsk, jmsk, slmskh, outlat, outlon + subroutine analy(lugb,iy,im,id,ih,fh,len,lsoil, & + & slmask,fntsfa,fnweta,fnsnoa,fnzora,fnalba,fnaisa,& + & fntg3a,fnscva,fnsmca,fnstca,fnacna,fnvega, & + & fnveta,fnsota, & + & fnvmna,fnvmxa,fnslpa,fnabsa, & !clu [+1l] add fn()a for vmn, vmx, slp, abs + & tsfanl,wetanl,snoanl,zoranl,albanl,aisanl, & + & tg3anl,cvanl ,cvbanl,cvtanl, & + & smcanl,stcanl,slianl,scvanl,acnanl,veganl, & + & vetanl,sotanl,alfanl,tsfan0, & + & vmnanl,vmxanl,slpanl,absanl, & !clu [+1l] add ()anl for vmn, vmx, slp, abs + & kpdtsf,kpdwet,kpdsno,kpdsnd,kpdzor,kpdalb,kpdais,& + & kpdtg3,kpdscv,kpdacn,kpdsmc,kpdstc,kpdveg, & + & kprvet,kpdsot,kpdalf, & + & kpdvmn,kpdvmx,kpdslp,kpdabs, & !clu [+1l] add kpd() for vmn, vmx, slp, abs + & irttsf,irtwet,irtsno,irtzor,irtalb,irtais, & + & irttg3,irtscv,irtacn,irtsmc,irtstc,irtveg, & + & irtvet,irtsot,irtalf & + &, irtvmn,irtvmx,irtslp,irtabs & !clu [+1l] add irt() for vmn, vmx, slp, abs + &, imsk, jmsk, slmskh, outlat, outlon & &, gaus, blno, blto, me, lanom) use machine , only : kind_io8,kind_io4 implicit none logical lanom - integer irtsmc,irtacn,irtstc,irtvet,irtveg,irtscv,irtzor,irtsno, - & irtalb,irttg3,irtais,iret,me,kk,kpdvet,i,irtalf,irtsot, -!cggg snow mods start & imsk,jmsk,irtwet,lsoil,len, kpdtsf,kpdsno,kpdwet,iy, - & imsk,jmsk,irtwet,lsoil,len,kpdtsf,kpdsno,kpdsnd,kpdwet,iy, -!cggg snow mods end - & lugb,im,ih,id,kpdveg,kpdstc,kprvet,irttsf,kpdsot,kpdsmc, - & kpdais,kpdzor,kpdtg3,kpdacn,kpdscv,j -!clu [+1l] add kpd() and irt() for vmn, vmx, slp, abs + integer irtsmc,irtacn,irtstc,irtvet,irtveg,irtscv,irtzor,irtsno, & + & irtalb,irttg3,irtais,iret,me,kk,kpdvet,i,irtalf,irtsot, & + & imsk,jmsk,irtwet,lsoil,len,kpdtsf,kpdsno,kpdsnd,kpdwet,iy,& + & lugb,im,ih,id,kpdveg,kpdstc,kprvet,irttsf,kpdsot,kpdsmc, & + & kpdais,kpdzor,kpdtg3,kpdacn,kpdscv,j & &, kpdvmn,kpdvmx,kpdslp,kpdabs,irtvmn,irtvmx,irtslp,irtabs real (kind=kind_io8) blto,blno,fh ! @@ -3761,21 +3750,19 @@ subroutine analy(lugb,iy,im,id,ih,fh,len,lsoil, integer lugi, lskip, lgrib, ndata !cggg snow mods end ! - character*500 fntsfa,fnweta,fnsnoa,fnzora,fnalba,fnaisa, - & fntg3a,fnscva,fnsmca,fnstca,fnacna,fnvega, + character*500 fntsfa,fnweta,fnsnoa,fnzora,fnalba,fnaisa, & + & fntg3a,fnscva,fnsmca,fnstca,fnacna,fnvega, & & fnveta,fnsota -!clu [+1l] add fn()a for vmn, vmx, slp, abs &, fnvmna,fnvmxa,fnslpa,fnabsa - real (kind=kind_io8) tsfanl(len), wetanl(len), snoanl(len), - & zoranl(len), albanl(len,4), aisanl(len), - & tg3anl(len), acnanl(len), - & cvanl (len), cvbanl(len), cvtanl(len), - & slianl(len), scvanl(len), veganl(len), - & vetanl(len), sotanl(len), alfanl(len,2), - & smcanl(len,lsoil), stcanl(len,lsoil), - & tsfan0(len) -!clu [+1l] add ()anl for vmn, vmx, slp, abs + real (kind=kind_io8) tsfanl(len), wetanl(len), snoanl(len), & + & zoranl(len), albanl(len,4), aisanl(len), & + & tg3anl(len), acnanl(len), & + & cvanl (len), cvbanl(len), cvtanl(len), & + & slianl(len), scvanl(len), veganl(len), & + & vetanl(len), sotanl(len), alfanl(len,2), & + & smcanl(len,lsoil), stcanl(len,lsoil), & + & tsfan0(len) & &, vmnanl(len),vmxanl(len),slpanl(len),absanl(len) ! logical gaus @@ -4378,53 +4365,45 @@ subroutine analy(lugb,iy,im,id,ih,fh,len,lsoil, end !>\ingroup mod_sfcsub - subroutine filfcs(tsffcs,wetfcs,snofcs,zorfcs,albfcs, - & tg3fcs,cvfcs ,cvbfcs,cvtfcs, - & cnpfcs,smcfcs,stcfcs,slifcs,aisfcs, - & vegfcs, vetfcs, sotfcs, alffcs, -!cwu [+1l] add ()fcs for sih, sic - & sihfcs,sicfcs, -!clu [+1l] add ()fcs for vmn, vmx, slp, abs - & vmnfcs,vmxfcs,slpfcs,absfcs, - & tsfanl,wetanl,snoanl,zoranl,albanl, - & tg3anl,cvanl ,cvbanl,cvtanl, - & cnpanl,smcanl,stcanl,slianl,aisanl, - & veganl, vetanl, sotanl, alfanl, -!cwu [+1l] add ()anl for sih, sic - & sihanl,sicanl, -!clu [+1l] add ()anl for vmn, vmx, slp, abs - & vmnanl,vmxanl,slpanl,absanl, + subroutine filfcs(tsffcs,wetfcs,snofcs,zorfcs,albfcs, & + & tg3fcs,cvfcs ,cvbfcs,cvtfcs, & + & cnpfcs,smcfcs,stcfcs,slifcs,aisfcs, & + & vegfcs, vetfcs, sotfcs, alffcs, & + & sihfcs,sicfcs, & !cwu [+1l] add ()fcs for sih, sic + & vmnfcs,vmxfcs,slpfcs,absfcs, & !clu [+1l] add ()fcs for vmn, vmx, slp, abs + & tsfanl,wetanl,snoanl,zoranl,albanl, & + & tg3anl,cvanl ,cvbanl,cvtanl, & + & cnpanl,smcanl,stcanl,slianl,aisanl, & + & veganl, vetanl, sotanl, alfanl, & + & sihanl,sicanl, & !cwu [+1l] add ()anl for sih, sic + & vmnanl,vmxanl,slpanl,absanl, & !clu [+1l] add ()anl for vmn, vmx, slp, abs & len,lsoil) ! use machine , only : kind_io8,kind_io4 implicit none integer i,j,len,lsoil - real (kind=kind_io8) tsffcs(len),wetfcs(len),snofcs(len), - & zorfcs(len),albfcs(len,4),aisfcs(len), - & tg3fcs(len), - & cvfcs (len),cvbfcs(len),cvtfcs(len), - & cnpfcs(len), - & smcfcs(len,lsoil),stcfcs(len,lsoil), - & slifcs(len),vegfcs(len), - & vetfcs(len),sotfcs(len),alffcs(len,2) -!cwu [+1l] add ()fcs for sih, sic - &, sihfcs(len),sicfcs(len) -!clu [+1l] add ()fcs for vmn, vmx, slp, abs - &, vmnfcs(len),vmxfcs(len),slpfcs(len),absfcs(len) - real (kind=kind_io8) tsfanl(len),wetanl(len),snoanl(len), - & zoranl(len),albanl(len,4),aisanl(len), - & tg3anl(len), - & cvanl (len),cvbanl(len),cvtanl(len), - & cnpanl(len), - & smcanl(len,lsoil),stcanl(len,lsoil), - & slianl(len),veganl(len), - & vetanl(len),sotanl(len),alfanl(len,2) -!cwu [+1l] add ()anl for sih, sic - &, sihanl(len),sicanl(len) -!clu [+1l] add ()anl for vmn, vmx, slp, abs + real (kind=kind_io8) tsffcs(len),wetfcs(len),snofcs(len), & + & zorfcs(len),albfcs(len,4),aisfcs(len), & + & tg3fcs(len), & + & cvfcs (len),cvbfcs(len),cvtfcs(len), & + & cnpfcs(len), & + & smcfcs(len,lsoil),stcfcs(len,lsoil), & + & slifcs(len),vegfcs(len), & + & vetfcs(len),sotfcs(len),alffcs(len,2) & + &, sihfcs(len),sicfcs(len) & + &, vmnfcs(len),vmxfcs(len),slpfcs(len),absfcs(len) + real (kind=kind_io8) tsfanl(len),wetanl(len),snoanl(len), & + & zoranl(len),albanl(len,4),aisanl(len), & + & tg3anl(len), & + & cvanl (len),cvbanl(len),cvtanl(len), & + & cnpanl(len), & + & smcanl(len,lsoil),stcanl(len,lsoil), & + & slianl(len),veganl(len), & + & vetanl(len),sotanl(len),alfanl(len,2) & + &, sihanl(len),sicanl(len) & &, vmnanl(len),vmxanl(len),slpanl(len),absanl(len) ! - write(6,*) ' this is a dead start run, tsfc over land is', + write(6,*) ' this is a dead start run, tsfc over land is', & & ' set as lowest sigma level temperture if given.' write(6,*) ' if not, set to climatological tsf over land is used' ! @@ -4477,7 +4456,7 @@ subroutine bktges(smcfcs,slianl,stcfcs,len,lsoil) use machine , only : kind_io8,kind_io4 implicit none integer i,j,len,lsoil,k - real (kind=kind_io8) smcfcs(len,lsoil), stcfcs(len,lsoil), + real (kind=kind_io8) smcfcs(len,lsoil), stcfcs(len,lsoil), & & slianl(len) ! ! note that smfcs comes in with the original unit (cm?) (not grib file) @@ -4565,7 +4544,10 @@ subroutine tsfcor(tsfc,orog,slmask,umask,len,rlapse) enddo return end - subroutine snodpth(scvanl,slianl,tsfanl,snoclm, + +!>\ingroup mod_sfcsub +!! This subroutine uses surface temperature to get snow depth estimate. + subroutine snodpth(scvanl,slianl,tsfanl,snoclm, & & glacir,snwmax,snwmin,landice,len,snoanl, me) use machine , only : kind_io8,kind_io4 implicit none @@ -4573,7 +4555,7 @@ subroutine snodpth(scvanl,slianl,tsfanl,snoclm, logical, intent(in) :: landice real (kind=kind_io8) sno,snwmax,snwmin ! - real (kind=kind_io8) scvanl(len), slianl(len), tsfanl(len), + real (kind=kind_io8) scvanl(len), slianl(len), tsfanl(len), & & snoclm(len), snoanl(len), glacir(len) ! if (me .eq. 0) write(6,*) 'snodpth' @@ -4621,80 +4603,81 @@ subroutine snodpth(scvanl,slianl,tsfanl,snoclm, end subroutine snodpth !>\ingroup mod_sfcsub - subroutine merge(len,lsoil,iy,im,id,ih,fh,deltsfc, - & sihfcs,sicfcs, - & vmnfcs,vmxfcs,slpfcs,absfcs, - & tsffcs,wetfcs,snofcs,zorfcs,albfcs,aisfcs, - & cvfcs ,cvbfcs,cvtfcs, - & cnpfcs,smcfcs,stcfcs,slifcs,vegfcs, - & vetfcs,sotfcs,alffcs, - & sihanl,sicanl, - & vmnanl,vmxanl,slpanl,absanl, - & tsfanl,tsfan2,wetanl,snoanl,zoranl,albanl,aisanl, - & cvanl ,cvbanl,cvtanl, - & cnpanl,smcanl,stcanl,slianl,veganl, - & vetanl,sotanl,alfanl, - & ctsfl,calbl,caisl,csnol,csmcl,czorl,cstcl,cvegl, - & ctsfs,calbs,caiss,csnos,csmcs,czors,cstcs,cvegs, - & ccv,ccvb,ccvt,ccnp,cvetl,cvets,csotl,csots, - & calfl,calfs, - & csihl,csihs,csicl,csics, - & cvmnl,cvmns,cvmxl,cvmxs,cslpl,cslps,cabsl,cabss, - & irttsf,irtwet,irtsno,irtzor,irtalb,irtais, - & irttg3,irtscv,irtacn,irtsmc,irtstc,irtveg, - & irtvmn,irtvmx,irtslp,irtabs, +!! This subroutine merges analysis and forecast. + subroutine merge(len,lsoil,iy,im,id,ih,fh,deltsfc, & + & sihfcs,sicfcs, & + & vmnfcs,vmxfcs,slpfcs,absfcs, & + & tsffcs,wetfcs,snofcs,zorfcs,albfcs,aisfcs, & + & cvfcs ,cvbfcs,cvtfcs, & + & cnpfcs,smcfcs,stcfcs,slifcs,vegfcs, & + & vetfcs,sotfcs,alffcs, & + & sihanl,sicanl, & + & vmnanl,vmxanl,slpanl,absanl, & + & tsfanl,tsfan2,wetanl,snoanl,zoranl,albanl,aisanl,& + & cvanl ,cvbanl,cvtanl, & + & cnpanl,smcanl,stcanl,slianl,veganl, & + & vetanl,sotanl,alfanl, & + & ctsfl,calbl,caisl,csnol,csmcl,czorl,cstcl,cvegl, & + & ctsfs,calbs,caiss,csnos,csmcs,czors,cstcs,cvegs, & + & ccv,ccvb,ccvt,ccnp,cvetl,cvets,csotl,csots, & + & calfl,calfs, & + & csihl,csihs,csicl,csics, & + & cvmnl,cvmns,cvmxl,cvmxs,cslpl,cslps,cabsl,cabss, & + & irttsf,irtwet,irtsno,irtzor,irtalb,irtais, & + & irttg3,irtscv,irtacn,irtsmc,irtstc,irtveg, & + & irtvmn,irtvmx,irtslp,irtabs, & & irtvet,irtsot,irtalf, landice, me) use machine , only : kind_io8,kind_io4 use sfccyc_module, only : veg_type_landice, soil_type_landice implicit none - integer k,i,im,id,iy,len,lsoil,ih,irtacn,irtsmc,irtscv,irtais, - & irttg3,irtstc,irtalf,me,irtsot,irtveg,irtvet, irtzor, - & irtalb,irtsno,irttsf,irtwet,j + integer k,i,im,id,iy,len,lsoil,ih,irtacn,irtsmc,irtscv,irtais, & + & irttg3,irtstc,irtalf,me,irtsot,irtveg,irtvet, irtzor, & + & irtalb,irtsno,irttsf,irtwet,j & &, irtvmn,irtvmx,irtslp,irtabs logical, intent(in) :: landice - real (kind=kind_io8) rvegs,rvets,rzors,raiss,rsnos,rsots,rcnp, - & rcvt,rcv,rcvb,rsnol,rzorl,raisl,ralbl, - & ralfl,rvegl,ralbs,ralfs,rtsfs,rvetl,rsotl, - & qzors,qvegs,qsnos,qalfs,qaiss,qvets,qcvt, - & qcnp,qcvb,qsots,qcv,qaisl,qsnol,qalfl, - & qtsfl,qalbl,qzorl,qtsfs,qalbs,qsotl,qvegl, - & qvetl,rtsfl,calbs,caiss,ctsfs,czorl,cvegl, - & csnos,ccvb,ccvt,ccv,czors,cvegs,caisl,csnol, - & calbl,fh,ctsfl,ccnp,csots,calfl,csotl,cvetl, - & cvets,calfs,deltsfc, - & csihl,csihs,csicl,csics, - & rsihl,rsihs,rsicl,rsics, - & qsihl,qsihs,qsicl,qsics - &, cvmnl,cvmns,cvmxl,cvmxs,cslpl,cslps - &, cabsl,cabss,rvmnl,rvmns,rvmxl,rvmxs - &, rslpl,rslps,rabsl,rabss,qvmnl,qvmns + real (kind=kind_io8) rvegs,rvets,rzors,raiss,rsnos,rsots,rcnp, & + & rcvt,rcv,rcvb,rsnol,rzorl,raisl,ralbl, & + & ralfl,rvegl,ralbs,ralfs,rtsfs,rvetl,rsotl, & + & qzors,qvegs,qsnos,qalfs,qaiss,qvets,qcvt, & + & qcnp,qcvb,qsots,qcv,qaisl,qsnol,qalfl, & + & qtsfl,qalbl,qzorl,qtsfs,qalbs,qsotl,qvegl, & + & qvetl,rtsfl,calbs,caiss,ctsfs,czorl,cvegl, & + & csnos,ccvb,ccvt,ccv,czors,cvegs,caisl,csnol, & + & calbl,fh,ctsfl,ccnp,csots,calfl,csotl,cvetl, & + & cvets,calfs,deltsfc, & + & csihl,csihs,csicl,csics, & + & rsihl,rsihs,rsicl,rsics, & + & qsihl,qsihs,qsicl,qsics & + &, cvmnl,cvmns,cvmxl,cvmxs,cslpl,cslps & + &, cabsl,cabss,rvmnl,rvmns,rvmxl,rvmxs & + &, rslpl,rslps,rabsl,rabss,qvmnl,qvmns & &, qvmxl,qvmxs,qslpl,qslps,qabsl,qabss ! - real (kind=kind_io8) tsffcs(len), wetfcs(len), snofcs(len), - & zorfcs(len), albfcs(len,4), aisfcs(len), - & cvfcs (len), cvbfcs(len), cvtfcs(len), - & cnpfcs(len), - & smcfcs(len,lsoil),stcfcs(len,lsoil), - & slifcs(len), vegfcs(len), - & vetfcs(len), sotfcs(len), alffcs(len,2) - &, sihfcs(len), sicfcs(len) + real (kind=kind_io8) tsffcs(len), wetfcs(len), snofcs(len), & + & zorfcs(len), albfcs(len,4), aisfcs(len), & + & cvfcs (len), cvbfcs(len), cvtfcs(len), & + & cnpfcs(len), & + & smcfcs(len,lsoil),stcfcs(len,lsoil), & + & slifcs(len), vegfcs(len), & + & vetfcs(len), sotfcs(len), alffcs(len,2) & + &, sihfcs(len), sicfcs(len) & &, vmnfcs(len),vmxfcs(len),slpfcs(len),absfcs(len) - real (kind=kind_io8) tsfanl(len),tsfan2(len), - & wetanl(len),snoanl(len), - & zoranl(len), albanl(len,4), aisanl(len), - & cvanl (len), cvbanl(len), cvtanl(len), - & cnpanl(len), - & smcanl(len,lsoil),stcanl(len,lsoil), - & slianl(len), veganl(len), - & vetanl(len), sotanl(len), alfanl(len,2) - &, sihanl(len),sicanl(len) + real (kind=kind_io8) tsfanl(len),tsfan2(len), & + & wetanl(len),snoanl(len), & + & zoranl(len), albanl(len,4), aisanl(len), & + & cvanl (len), cvbanl(len), cvtanl(len), & + & cnpanl(len), & + & smcanl(len,lsoil),stcanl(len,lsoil), & + & slianl(len), veganl(len), & + & vetanl(len), sotanl(len), alfanl(len,2) & + &, sihanl(len),sicanl(len) & &, vmnanl(len),vmxanl(len),slpanl(len),absanl(len) ! - real (kind=kind_io8) csmcl(lsoil), csmcs(lsoil), + real (kind=kind_io8) csmcl(lsoil), csmcs(lsoil), & & cstcl(lsoil), cstcs(lsoil) - real (kind=kind_io8) rsmcl(lsoil), rsmcs(lsoil), + real (kind=kind_io8) rsmcl(lsoil), rsmcs(lsoil), & & rstcl(lsoil), rstcs(lsoil) - real (kind=kind_io8) qsmcl(lsoil), qsmcs(lsoil), + real (kind=kind_io8) qsmcl(lsoil), qsmcs(lsoil), & & qstcl(lsoil), qstcs(lsoil) logical first integer num_threads @@ -5074,18 +5057,17 @@ subroutine merge(len,lsoil,iy,im,id,ih,fh,deltsfc, end subroutine merge !>\ingroup mod_sfcsub - subroutine newice(slianl,slifcs,tsfanl,tsffcs,len,lsoil, -!cwu [+1l] add sihnew,sicnew,sihanl,sicanl - & sihnew,sicnew,sihanl,sicanl, - & albanl,snoanl,zoranl,smcanl,stcanl, - & albsea,snosea,zorsea,smcsea,smcice, - & tsfmin,tsfice,albice,zorice,tgice, + subroutine newice(slianl,slifcs,tsfanl,tsffcs,len,lsoil, & + & sihnew,sicnew,sihanl,sicanl, & !cwu [+1l] add sihnew,sicnew,sihanl,sicanl + & albanl,snoanl,zoranl,smcanl,stcanl, & + & albsea,snosea,zorsea,smcsea,smcice, & + & tsfmin,tsfice,albice,zorice,tgice, & & rla,rlo,me) ! use machine , only : kind_io8,kind_io4 implicit none real (kind=kind_io8), parameter :: one=1.0 - real (kind=kind_io8) tgice,albice,zorice,tsfice,albsea,snosea, + real (kind=kind_io8) tgice,albice,zorice,tsfice,albsea,snosea, & & smcice,tsfmin,zorsea,smcsea !cwu [+1l] add sicnew,sihnew &, sicnew,sihnew @@ -5172,7 +5154,7 @@ subroutine newice(slianl,slifcs,tsfanl,tsffcs,len,lsoil, end !>\ingroup mod_sfcsub - subroutine qcsnow(snoanl,slmask,aisanl,glacir,len,snoval, + subroutine qcsnow(snoanl,slmask,aisanl,glacir,len,snoval, & & landice,me) use machine , only : kind_io8,kind_io4 implicit none @@ -5220,14 +5202,14 @@ subroutine qcsnow(snoanl,slmask,aisanl,glacir,len,snoval, end subroutine qcsnow !>\ingroup mod_sfcsub - subroutine qcsice(ais,glacir,amxice,aicice,aicsea,sllnd,slmask, + subroutine qcsice(ais,glacir,amxice,aicice,aicsea,sllnd,slmask, & & rla,rlo,len,me) use machine , only : kind_io8,kind_io4 implicit none integer kount1,kount,i,me,len real (kind=kind_io8) per,aicsea,aicice,sllnd ! - real (kind=kind_io8) ais(len), glacir(len), + real (kind=kind_io8) ais(len), glacir(len), & & amxice(len), slmask(len) real (kind=kind_io8) rla(len), rlo(len) ! @@ -5353,23 +5335,23 @@ subroutine scale(fld,len,scl) end !>\ingroup mod_sfcsub - subroutine qcmxmn(ttl,fld,slimsk,sno,iceflg, - & fldlmx,fldlmn,fldomx,fldomn,fldimx,fldimn, - & fldjmx,fldjmn,fldsmx,fldsmn,epsfld, + subroutine qcmxmn(ttl,fld,slimsk,sno,iceflg, & + & fldlmx,fldlmn,fldomx,fldomn,fldimx,fldimn, & + & fldjmx,fldjmn,fldsmx,fldsmn,epsfld, & & rla,rlo,len,mode,percrit,lgchek,me) ! use machine , only : kind_io8,kind_io4 implicit none - real (kind=kind_io8) permax,per,fldimx,fldimn,fldjmx,fldomn, - & fldlmx,fldlmn,fldomx,fldjmn,percrit, + real (kind=kind_io8) permax,per,fldimx,fldimn,fldjmx,fldomn, & + & fldlmx,fldlmn,fldomx,fldjmn,percrit, & & fldsmx,fldsmn,epsfld - integer kmaxi,kmini,kmaxj,kmino,kmaxl,kminl,kmaxo,mmprt,kminj, + integer kmaxi,kmini,kmaxj,kmino,kmaxl,kminl,kmaxo,mmprt,kminj, & & ij,nprt,kmaxs,kmins,i,me,len,mode parameter(mmprt=2) ! character*8 ttl logical iceflg(len) - real (kind=kind_io8) fld(len),slimsk(len),sno(len), + real (kind=kind_io8) fld(len),slimsk(len),sno(len), & & rla(len), rlo(len) integer iwk(len) logical lgchek @@ -5856,7 +5838,7 @@ subroutine getsmc(wetfld,len,lsoil,smcfld,me) end !>\ingroup mod_sfcsub - subroutine usesgt(sig1t,slianl,tg3anl,len,lsoil,tsfanl,stcanl, + subroutine usesgt(sig1t,slianl,tg3anl,len,lsoil,tsfanl,stcanl, & & tsfimx) ! use machine , only : kind_io8,kind_io4 @@ -6012,9 +5994,9 @@ subroutine qcsli(slianl,slifcs,len,me) ! end !>\ingroup mod_sfcsub - subroutine qcbyfc(tsffcs,snofcs,qctsfs,qcsnos,qctsfi, - & len,lsoil,snoanl,aisanl,slianl,tsfanl,albanl, - & zoranl,smcanl, + subroutine qcbyfc(tsffcs,snofcs,qctsfs,qcsnos,qctsfi, & + & len,lsoil,snoanl,aisanl,slianl,tsfanl,albanl, & + & zoranl,smcanl, & & smcclm,tsfsmx,albomx,zoromx, me) ! use machine , only : kind_io8,kind_io4 @@ -6110,8 +6092,8 @@ subroutine qcbyfc(tsffcs,snofcs,qctsfs,qcsnos,qctsfi, end !>\ingroup mod_sfcsub - subroutine setrmsk(kpds5,slmask,igaul,jgaul,wlon,rnlat, - & data,imax,jmax,rlnout,rltout,lmask,rslmsk + subroutine setrmsk(kpds5,slmask,igaul,jgaul,wlon,rnlat, & + & data,imax,jmax,rlnout,rltout,lmask,rslmsk & &, gaus,blno, blto, kgds1, kpds4, lbms) use machine , only : kind_io8,kind_io4 use sfccyc_module @@ -6164,17 +6146,24 @@ subroutine setrmsk(kpds5,slmask,igaul,jgaul,wlon,rnlat, ! ijmax = imax*jmax rslmsk = 0. +! TG3 MODS BEGIN + if(kpds5 == kpdtsf .and. imax == 138 .and. jmax == 116 + & .and. kpds4 == 128) then +! print*,'turn off setrmsk for tg3' + lmask = .false. + + elseif(kpds5 == kpdtsf) then +! TG3 MODS END ! ! surface temperature ! - if(kpds5.eq.kpdtsf) then -! lmask=.false. + lmask = .false. call ga2la(slmask,igaul,jgaul,rslmsk,imax,jmax,wlon,rnlat &, rlnout, rltout, gaus, blno, blto) ! &, dlon, dlat, gaus, blno, blto) - crit=0.5 + crit = 0.5 call rof01(rslmsk,ijmax,'ge',crit) - lmask=.true. + lmask = .true. ! ! bucket soil wetness ! @@ -6182,16 +6171,16 @@ subroutine setrmsk(kpds5,slmask,igaul,jgaul,wlon,rnlat, call ga2la(slmask,igaul,jgaul,rslmsk,imax,jmax,wlon,rnlat &, rlnout, rltout, gaus, blno, blto) ! &, dlon, dlat, gaus, blno, blto) - crit=0.5 + crit = 0.5 call rof01(rslmsk,ijmax,'ge',crit) - lmask=.true. + lmask = .true. ! write(6,*) 'wet rslmsk' ! znnt=1. ! call nntprt(rslmsk,ijmax,znnt) ! ! snow depth ! - elseif(kpds5.eq.kpdsnd) then + elseif(kpds5 == kpdsnd) then if(kpds4 == 192) then ! use the bitmap rslmsk = 0. do j = 1, jmax @@ -6586,25 +6575,26 @@ subroutine setrmsk(kpds5,slmask,igaul,jgaul,wlon,rnlat, end !>\ingroup mod_sfcsub - subroutine ga2la(gauin,imxin,jmxin,regout,imxout,jmxout, +!! This subroutine interpolates from lat/lon grid to other lat/lon grid. + subroutine ga2la(gauin,imxin,jmxin,regout,imxout,jmxout, & & wlon,rnlat,rlnout,rltout,gaus,blno, blto) use machine , only : kind_io8,kind_io4 implicit none - integer i1,i2,j2,ishft,i,jj,j1,jtem,jmxout,imxin,jmxin,imxout, + integer i1,i2,j2,ishft,i,jj,j1,jtem,jmxout,imxin,jmxin,imxout, & & j,iret - real (kind=kind_io8) alamd,dxin,aphi,x,sum1,sum2,y,dlati,wlon, - & rnlat,dxout,dphi,dlat,facns,tem,blno, + real (kind=kind_io8) alamd,dxin,aphi,x,sum1,sum2,y,dlati,wlon, & + & rnlat,dxout,dphi,dlat,facns,tem,blno, & & blto ! ! interpolation from lat/lon grid to other lat/lon grid ! - real (kind=kind_io8) gauin (imxin,jmxin), regout(imxout,jmxout) + real (kind=kind_io8) gauin (imxin,jmxin), regout(imxout,jmxout) & &, rlnout(imxout), rltout(jmxout) logical gaus ! real, allocatable :: gaul(:) real (kind=kind_io8) ddx(imxout),ddy(jmxout) - integer iindx1(imxout), iindx2(imxout), + integer iindx1(imxout), iindx2(imxout), & & jindx1(jmxout), jindx2(jmxout) integer jmxsav,n,kspla data jmxsav/0/ @@ -6838,8 +6828,8 @@ subroutine landtyp(vegtype,soiltype,slptype,slmask,len) use machine , only : kind_io8,kind_io4 implicit none integer i,len - real (kind=kind_io8) vegtype(len),soiltype(len),slmask(len) - +, slptype(len) + real (kind=kind_io8) vegtype(len),soiltype(len),slmask(len) & + &, slptype(len) ! ! make sure that the soil type and veg type are non-zero over land ! @@ -6852,8 +6842,9 @@ subroutine landtyp(vegtype,soiltype,slptype,slmask,len) enddo return -!>\ingroup mod_sfcsub end subroutine landtyp + +!>\ingroup mod_sfcsub subroutine gaulat(gaul,k) ! use machine , only : kind_io8,kind_io4 @@ -6886,7 +6877,7 @@ subroutine anomint(tsfan0,tsfclm,tsfcl0,tsfanl,len) use machine , only : kind_io8,kind_io4 implicit none integer i,len - real (kind=kind_io8) tsfanl(len), tsfan0(len), + real (kind=kind_io8) tsfanl(len), tsfan0(len), & & tsfclm(len), tsfcl0(len) ! ! time interpolation of anomalies @@ -6900,53 +6891,53 @@ subroutine anomint(tsfan0,tsfclm,tsfcl0,tsfanl,len) end !>\ingroup mod_sfcsub - subroutine clima(lugb,iy,im,id,ih,fh,len,lsoil, - & slmask,fntsfc,fnwetc,fnsnoc,fnzorc,fnalbc,fnaisc, - & fntg3c,fnscvc,fnsmcc,fnstcc,fnacnc,fnvegc, - & fnvetc,fnsotc, - & fnvmnc,fnvmxc,fnslpc,fnabsc, - & tsfclm,tsfcl2,wetclm,snoclm,zorclm,albclm,aisclm, - & tg3clm,cvclm ,cvbclm,cvtclm, - & cnpclm,smcclm,stcclm,sliclm,scvclm,acnclm,vegclm, - & vetclm,sotclm,alfclm, - & vmnclm,vmxclm,slpclm,absclm, - & kpdtsf,kpdwet,kpdsno,kpdzor,kpdalb,kpdais, - & kpdtg3,kpdscv,kpdacn,kpdsmc,kpdstc,kpdveg, - & kpdvet,kpdsot,kpdalf,tsfcl0, - & kpdvmn,kpdvmx,kpdslp,kpdabs, - & deltsfc, lanom - &, imsk, jmsk, slmskh, outlat, outlon - &, gaus, blno, blto, me,lprnt,iprnt, fnalbc2, ialb + subroutine clima(lugb,iy,im,id,ih,fh,len,lsoil, & + & slmask,fntsfc,fnwetc,fnsnoc,fnzorc,fnalbc,fnaisc,& + & fntg3c,fnscvc,fnsmcc,fnstcc,fnacnc,fnvegc, & + & fnvetc,fnsotc, & + & fnvmnc,fnvmxc,fnslpc,fnabsc, & + & tsfclm,tsfcl2,wetclm,snoclm,zorclm,albclm,aisclm,& + & tg3clm,cvclm ,cvbclm,cvtclm, & + & cnpclm,smcclm,stcclm,sliclm,scvclm,acnclm,vegclm,& + & vetclm,sotclm,alfclm, & + & vmnclm,vmxclm,slpclm,absclm, & + & kpdtsf,kpdwet,kpdsno,kpdzor,kpdalb,kpdais, & + & kpdtg3,kpdscv,kpdacn,kpdsmc,kpdstc,kpdveg, & + & kpdvet,kpdsot,kpdalf,tsfcl0, & + & kpdvmn,kpdvmx,kpdslp,kpdabs, & + & deltsfc, lanom & + &, imsk, jmsk, slmskh, outlat, outlon & + &, gaus, blno, blto, me,lprnt,iprnt, fnalbc2, ialb & &, tile_num_ch, i_index, j_index) ! use machine , only : kind_io8,kind_io4 implicit none character(len=*), intent(in) :: tile_num_ch integer, intent(in) :: i_index(len), j_index(len) - real (kind=kind_io8) rjday,wei1x,wei2x,rjdayh,wei2m,wei1m,wei1s, + real (kind=kind_io8) rjday,wei1x,wei2x,rjdayh,wei2m,wei1m,wei1s, & & wei2s,fh,stcmon1s,blto,blno,deltsfc,rjdayh2 real (kind=kind_io8) wei1y,wei2y - integer jdoy,jday,jh,jdow,mmm,mmp,mm,iret,monend,i,k,jm,jd,iy4, - & jy,mon1,is2,isx,kpd9,is1,l,nn,mon2,mon,is,kpdsno, - & kpdzor,kpdtsf,kpdwet,kpdscv,kpdacn,kpdais,kpdtg3,im,id, - & lugb,iy,len,lsoil,ih,kpdsmc,iprnt,me,m1,m2,k1,k2, - & kpdvet,kpdsot,kpdstc,kpdveg,jmsk,imsk,j,ialb + integer jdoy,jday,jh,jdow,mmm,mmp,mm,iret,monend,i,k,jm,jd,iy4, & + & jy,mon1,is2,isx,kpd9,is1,l,nn,mon2,mon,is,kpdsno, & + & kpdzor,kpdtsf,kpdwet,kpdscv,kpdacn,kpdais,kpdtg3,im,id, & + & lugb,iy,len,lsoil,ih,kpdsmc,iprnt,me,m1,m2,k1,k2, & + & kpdvet,kpdsot,kpdstc,kpdveg,jmsk,imsk,j,ialb & &, kpdvmn,kpdvmx,kpdslp,kpdabs,landice_cat integer kpdalb(4), kpdalf(2) ! - character*500 fntsfc,fnwetc,fnsnoc,fnzorc,fnalbc,fnaisc, - & fntg3c,fnscvc,fnsmcc,fnstcc,fnacnc,fnvegc, - & fnvetc,fnsotc,fnalbc2 + character*500 fntsfc,fnwetc,fnsnoc,fnzorc,fnalbc,fnaisc, & + & fntg3c,fnscvc,fnsmcc,fnstcc,fnacnc,fnvegc, & + & fnvetc,fnsotc,fnalbc2 & &, fnvmnc,fnvmxc,fnslpc,fnabsc - real (kind=kind_io8) tsfclm(len),tsfcl2(len), - & wetclm(len),snoclm(len), - & zorclm(len),albclm(len,4),aisclm(len), - & tg3clm(len),acnclm(len), - & cvclm (len),cvbclm(len),cvtclm(len), - & cnpclm(len), - & smcclm(len,lsoil),stcclm(len,lsoil), - & sliclm(len),scvclm(len),vegclm(len), - & vetclm(len),sotclm(len),alfclm(len,2) + real (kind=kind_io8) tsfclm(len),tsfcl2(len), & + & wetclm(len),snoclm(len), & + & zorclm(len),albclm(len,4),aisclm(len), & + & tg3clm(len),acnclm(len), & + & cvclm (len),cvbclm(len),cvtclm(len), & + & cnpclm(len), & + & smcclm(len,lsoil),stcclm(len,lsoil), & + & sliclm(len),scvclm(len),vegclm(len), & + & vetclm(len),sotclm(len),alfclm(len,2) & &, vmnclm(len),vmxclm(len),slpclm(len),absclm(len) real (kind=kind_io8) slmskh(imsk,jmsk) real (kind=kind_io8) outlat(len), outlon(len) @@ -7059,51 +7050,51 @@ subroutine clima(lugb,iy,im,id,ih,fh,len,lsoil, ! ! get tsf climatology for the begining of the forecast ! - if (fh .gt. 0.0) then + if (fh > 0.0) then !cbosu if (me == 0) print*,'bosu fh gt 0' - iy4=iy - if(iy.lt.101) iy4=1900+iy4 - fha=0 - ida=0 - jda=0 -! fha(2)=nint(fh) - ida(1)=iy - ida(2)=im - ida(3)=id - ida(5)=ih + iy4 = iy + if (iy < 101) iy4 = 1900 + iy4 + fha = 0 + ida = 0 + jda = 0 +! fha(2) = nint(fh) + ida(1) = iy + ida(2) = im + ida(3) = id + ida(5) = ih call w3kind(w3kindreal,w3kindint) if(w3kindreal == 4) then - fha4=fha + fha4 = fha call w3movdat(fha4,ida,jda) else call w3movdat(fha,ida,jda) endif - jy=jda(1) - jm=jda(2) - jd=jda(3) - jh=jda(5) - if (me .eq. 0) write(6,*) ' forecast jy,jm,jd,jh', - & jy,jm,jd,jh + jy = jda(1) + jm = jda(2) + jd = jda(3) + jh = jda(5) + if (me == 0) write(6,*) ' forecast jy,jm,jd,jh', + & jy,jm,jd,jh jdow = 0 jdoy = 0 jday = 0 call w3doxdat(jda,jdow,jdoy,jday) - rjday=jdoy+jda(5)/24. - if(rjday.lt.dayhf(1)) rjday=rjday+365. + rjday = jdoy + jda(5) / 24. + if(rjday < dayhf(1)) rjday = rjday + 365. ! - if (me .eq. 0) write(6,*) 'forecast jy,jm,jd,jh=',jy,jm,jd,jh + if (me == 0) write(6,*) 'forecast jy,jm,jd,jh=',jy,jm,jd,jh ! ! for monthly mean climatology ! monend = 12 do mm=1,monend - mmm=mm - mmp=mm+1 - if(rjday.ge.dayhf(mmm).and.rjday.lt.dayhf(mmp)) then - mon1=mmm - mon2=mmp + mmm = mm + mmp = mm + 1 + if(rjday >= dayhf(mmm) .and. rjday < dayhf(mmp)) then + mon1 = mmm + mon2 = mmp go to 10 endif enddo @@ -7111,17 +7102,18 @@ subroutine clima(lugb,iy,im,id,ih,fh,len,lsoil, call abort 10 continue wei1m = (dayhf(mon2)-rjday)/(dayhf(mon2)-dayhf(mon1)) - wei2m = (rjday-dayhf(mon1))/(dayhf(mon2)-dayhf(mon1)) - if(mon2.eq.13) mon2=1 - if (me .eq. 0) print *,'rjday,mon1,mon2,wei1m,wei2m=', - & rjday,mon1,mon2,wei1m,wei2m + wei2m = 1.0 - wei1m +! wei2m = (rjday-dayhf(mon1))/(dayhf(mon2)-dayhf(mon1)) + if (mon2 == 13) mon2 = 1 + if (me == 0) print *,'rjday,mon1,mon2,wei1m,wei2m=', + & rjday,mon1,mon2,wei1m,wei2m ! ! read monthly mean climatology of tsf ! kpd7 = -1 do nn=1,2 mon = mon1 - if (nn .eq. 2) mon = mon2 + if (nn == 2) mon = mon2 call fixrdc(lugb,fntsfc,kpdtsf,kpd7,mon,slmask, & tsf(1,nn),len,iret &, imsk, jmsk, slmskh, gaus,blno, blto @@ -7138,8 +7130,8 @@ subroutine clima(lugb,iy,im,id,ih,fh,len,lsoil, ! ! compute current jy,jm,jd,jh of forecast and the day of the year ! - iy4=iy - if(iy.lt.101) iy4=1900+iy4 + iy4 = iy + if (iy < 101) iy4=1900+iy4 fha = 0 ida = 0 jda = 0 @@ -7149,8 +7141,8 @@ subroutine clima(lugb,iy,im,id,ih,fh,len,lsoil, ida(3) = id ida(5) = ih call w3kind(w3kindreal,w3kindint) - if(w3kindreal==4) then - fha4=fha + if(w3kindreal == 4) then + fha4 = fha call w3movdat(fha4,ida,jda) else call w3movdat(fha,ida,jda) @@ -7165,44 +7157,45 @@ subroutine clima(lugb,iy,im,id,ih,fh,len,lsoil, jdoy = 0 jday = 0 call w3doxdat(jda,jdow,jdoy,jday) - rjday = jdoy+jda(5)/24. - if(rjday.lt.dayhf(1)) rjday=rjday+365. + rjday = jdoy + jda(5) / 24. + if(rjday < dayhf(1)) rjday = rjday + 365. - if (me .eq. 0) write(6,*) ' forecast jy,jm,jd,jh,rjday=', - & jy,jm,jd,jh,rjday + if (me == 0) write(6,*) ' forecast jy,jm,jd,jh,rjday=', + & jy,jm,jd,jh,rjday ! - if (me .eq. 0) write(6,*) 'forecast jy,jm,jd,jh=',jy,jm,jd,jh + if (me == 0) write(6,*) 'forecast jy,jm,jd,jh=',jy,jm,jd,jh ! ! for monthly mean climatology ! monend = 12 do mm=1,monend - mmm=mm - mmp=mm+1 - if(rjday.ge.dayhf(mmm).and.rjday.lt.dayhf(mmp)) then - mon1=mmm - mon2=mmp + mmm = mm + mmp = mm + 1 + if(rjday >= dayhf(mmm) .and. rjday < dayhf(mmp)) then + mon1 = mmm + mon2 = mmp go to 20 endif enddo print *,'wrong rjday',rjday call abort 20 continue - wei1m=(dayhf(mon2)-rjday)/(dayhf(mon2)-dayhf(mon1)) - wei2m=(rjday-dayhf(mon1))/(dayhf(mon2)-dayhf(mon1)) - if(mon2.eq.13) mon2=1 - if (me .eq. 0) print *,'rjday,mon1,mon2,wei1m,wei2m=', - & rjday,mon1,mon2,wei1m,wei2m + wei1m = (dayhf(mon2)-rjday)/(dayhf(mon2)-dayhf(mon1)) + wei2m = 1.0 - wei1m +! wei2m = (rjday-dayhf(mon1))/(dayhf(mon2)-dayhf(mon1)) + if (mon2 == 13) mon2 = 1 + if (me == 0) print *,'rjday,mon1,mon2,wei1m,wei2m=', + & rjday,mon1,mon2,wei1m,wei2m ! ! for seasonal mean climatology ! monend = 4 is = im/3 + 1 - if (is.eq.5) is = 1 + if (is == 5) is = 1 do mm=1,monend mmm = mm*3 - 2 mmp = (mm+1)*3 - 2 - if(rjday.ge.dayhf(mmm).and.rjday.lt.dayhf(mmp)) then + if(rjday >= dayhf(mmm) .and. rjday < dayhf(mmp)) then sea1 = mmm sea2 = mmp go to 30 @@ -7212,20 +7205,21 @@ subroutine clima(lugb,iy,im,id,ih,fh,len,lsoil, call abort 30 continue wei1s = (dayhf(sea2)-rjday)/(dayhf(sea2)-dayhf(sea1)) - wei2s = (rjday-dayhf(sea1))/(dayhf(sea2)-dayhf(sea1)) - if(sea2.eq.13) sea2=1 - if (me .eq. 0) print *,'rjday,sea1,sea2,wei1s,wei2s=', - & rjday,sea1,sea2,wei1s,wei2s + wei2s = 1.0 - wei1s +! wei2s = (rjday-dayhf(sea1))/(dayhf(sea2)-dayhf(sea1)) + if (sea2 == 13) sea2 = 1 + if (me == 0) print *,'rjday,sea1,sea2,wei1s,wei2s=', + & rjday,sea1,sea2,wei1s,wei2s ! ! for summer and winter values (maximum and minimum). ! monend = 2 is = im/6 + 1 - if (is.eq.3) is = 1 + if (is == 3) is = 1 do mm=1,monend mmm = mm*6 - 5 mmp = (mm+1)*6 - 5 - if(rjday.ge.dayhf(mmm).and.rjday.lt.dayhf(mmp)) then + if(rjday >= dayhf(mmm) .and. rjday < dayhf(mmp)) then hyr1 = mmm hyr2 = mmp go to 31 @@ -7235,10 +7229,11 @@ subroutine clima(lugb,iy,im,id,ih,fh,len,lsoil, call abort 31 continue wei1y = (dayhf(hyr2)-rjday)/(dayhf(hyr2)-dayhf(hyr1)) - wei2y = (rjday-dayhf(hyr1))/(dayhf(hyr2)-dayhf(hyr1)) - if(hyr2.eq.13) hyr2=1 - if (me .eq. 0) print *,'rjday,hyr1,hyr2,wei1y,wei2y=', - & rjday,hyr1,hyr2,wei1y,wei2y + wei2y = 1.0 - wei1y +! wei2y = (rjday-dayhf(hyr1))/(dayhf(hyr2)-dayhf(hyr1)) + if (hyr2 == 13) hyr2 = 1 + if (me == 0) print *,'rjday,hyr1,hyr2,wei1y,wei2y=', + & rjday,hyr1,hyr2,wei1y,wei2y ! ! start reading in climatology and interpolate to the date ! @@ -7638,7 +7633,7 @@ subroutine clima(lugb,iy,im,id,ih,fh,len,lsoil, ! mon1s = mon1 ; mon2s = mon2 ; sea1s = sea1 ; sea2s = sea2 ! - if (me .eq. 0) print *,' mon1s=',mon1s,' mon2s=',mon2s + if (me == 0) print *,' mon1s=',mon1s,' mon2s=',mon2s &,' sea1s=',sea1s,' sea2s=',sea2s ! k1 = 1 ; k2 = 2 @@ -7696,11 +7691,11 @@ subroutine clima(lugb,iy,im,id,ih,fh,len,lsoil, ! seasonal mean climatology ! isx = sea2/3 + 1 - if (isx .eq. 5) isx = 1 - if(isx.eq.1) kpd9 = 12 - if(isx.eq.2) kpd9 = 3 - if(isx.eq.3) kpd9 = 6 - if(isx.eq.4) kpd9 = 9 + if (isx == 5) isx = 1 + if (isx == 1) kpd9 = 12 + if (isx == 2) kpd9 = 3 + if (isx == 3) kpd9 = 6 + if (isx == 4) kpd9 = 9 ! ! albedo ! there are four albedo fields in this version: @@ -7736,7 +7731,7 @@ subroutine clima(lugb,iy,im,id,ih,fh,len,lsoil, if (me == 0) print*,'bosu 2nd time in clima for month ', & mon, k1,k2 if ( index(fnalbc, "tileX.nc") == 0) then ! grib file - kpd7=-1 + kpd7 = -1 do k = 1, 4 call fixrdc(lugb,fnalbc,kpdalb(k),kpd7,mon,slmask, & alb(1,k,nn),len,iret @@ -7753,7 +7748,7 @@ subroutine clima(lugb,iy,im,id,ih,fh,len,lsoil, ! ! tsf at the current time t ! - kpd7=-1 + kpd7 = -1 call fixrdc(lugb,fntsfc,kpdtsf,kpd7,mon,slmask, & tsf(1,nn),len,iret &, imsk, jmsk, slmskh, gaus,blno, blto @@ -7761,13 +7756,13 @@ subroutine clima(lugb,iy,im,id,ih,fh,len,lsoil, ! ! soil wetness ! - if(fnwetc(1:8).ne.' ') then + if (fnwetc(1:8).ne.' ') then kpd7=-1 call fixrdc(lugb,fnwetc,kpdwet,kpd7,mon,slmask, & wet(1,nn),len,iret &, imsk, jmsk, slmskh, gaus,blno, blto &, outlat, outlon, me) - elseif(fnsmcc(1:8).ne.' ') then + elseif (fnsmcc(1:8).ne.' ') then if (index(fnsmcc,'global_soilmcpc.1x1.grb') /= 0) then ! the old climo data kpd7=-1 call fixrdc(lugb,fnsmcc,kpdsmc,kpd7,mon,slmask, @@ -7809,13 +7804,13 @@ subroutine clima(lugb,iy,im,id,ih,fh,len,lsoil, ! ! sea ice ! - kpd7=-1 - if(fnacnc(1:8).ne.' ') then + kpd7 = -1 + if (fnacnc(1:8).ne.' ') then call fixrdc(lugb,fnacnc,kpdacn,kpd7,mon,slmask, & acn(1,nn),len,iret &, imsk, jmsk, slmskh, gaus,blno, blto &, outlat, outlon, me) - elseif(fnaisc(1:8).ne.' ') then + elseif (fnaisc(1:8).ne.' ') then call fixrdc(lugb,fnaisc,kpdais,kpd7,mon,slmask, & ais(1,nn),len,iret &, imsk, jmsk, slmskh, gaus,blno, blto @@ -7835,7 +7830,7 @@ subroutine clima(lugb,iy,im,id,ih,fh,len,lsoil, ! ! snow cover ! - if(fnscvc(1:8).ne.' ') then + if (fnscvc(1:8).ne.' ') then kpd7=-1 call fixrdc(lugb,fnscvc,kpdscv,kpd7,mon,slmask, & scv(1,nn),len,iret @@ -7846,7 +7841,7 @@ subroutine clima(lugb,iy,im,id,ih,fh,len,lsoil, ! ! surface roughness ! - if(fnzorc(1:3) == 'sib') then + if (fnzorc(1:3) == 'sib') then if (me == 0) then write(6,*) 'roughness length to be set from sib veg type' endif @@ -7864,7 +7859,7 @@ subroutine clima(lugb,iy,im,id,ih,fh,len,lsoil, ! ! vegetation cover ! - if(fnvegc(1:8).ne.' ') then + if (fnvegc(1:8) .ne. ' ') then if ( index(fnvegc, "tileX.nc") == 0) then ! grib file kpd7=-1 call fixrdc(lugb,fnvegc,kpdveg,kpd7,mon,slmask, @@ -7886,35 +7881,35 @@ subroutine clima(lugb,iy,im,id,ih,fh,len,lsoil, ! when chosen, set the z0 based on the vegetation type. ! for this option to work, namelist variable fnvetc must be ! set to point at the proper vegetation type file. - if(fnzorc(1:3) == 'sib') then - if(fnvetc(1:4) == ' ') then + if (fnzorc(1:3) == 'sib') then + if (fnvetc(1:4) == ' ') then if (me==0) write(6,*) "must choose sib veg type climo file" call abort endif zorclm = 0.0 do i=1,len - ivtyp=nint(vet(i)) + ivtyp = nint(vet(i)) if (ivtyp >= 1 .and. ivtyp <= 13) then zorclm(i) = z0_sib(ivtyp) endif enddo elseif(fnzorc(1:4) == 'igbp') then - if(fnvetc(1:4) == ' ') then - if (me==0) write(6,*) "must choose igbp veg type climo file" + if (fnvetc(1:4) == ' ') then + if (me == 0) write(6,*) "must choose igbp veg type climo file" call abort endif zorclm = 0.0 do i=1,len - ivtyp=nint(vet(i)) + ivtyp = nint(vet(i)) if (ivtyp >= 1 .and. ivtyp <= 20) then z0_season(1) = z0_igbp_min(ivtyp) z0_season(7) = z0_igbp_max(ivtyp) - if(outlat(i) < 0.0)then + if (outlat(i) < 0.0) then zorclm(i) = wei1y * z0_season(hyr2) + - & wei2y *z0_season(hyr1) + & wei2y * z0_season(hyr1) else zorclm(i) = wei1y * z0_season(hyr1) + - & wei2y *z0_season(hyr2) + & wei2y * z0_season(hyr2) endif endif enddo @@ -8068,8 +8063,8 @@ subroutine clima(lugb,iy,im,id,ih,fh,len,lsoil, end subroutine clima !>\ingroup mod_sfcsub - subroutine fixrdc_tile(filename_raw, tile_num_ch, - & i_index, j_index, kpds, + subroutine fixrdc_tile(filename_raw, tile_num_ch, & + & i_index, j_index, kpds, & & var, mon, npts, me) use netcdf use machine , only : kind_io8 @@ -8222,22 +8217,21 @@ subroutine netcdf_err(error) end subroutine netcdf_err !>\ingroup mod_sfcsub - subroutine fixrdc(lugb,fngrib,kpds5,kpds7,mon,slmask, - & gdata,len,iret - &, imsk, jmsk, slmskh, gaus,blno, blto +!! reads in grib climatology files and interpolate to the input +!! grid. grib files should allow all the necessary parameters +!! to be extracted from the description records. + subroutine fixrdc(lugb,fngrib,kpds5,kpds7,mon,slmask, & + & gdata,len,iret & + &, imsk, jmsk, slmskh, gaus,blno, blto & &, outlat, outlon, me) use machine , only : kind_io8,kind_io4 use sfccyc_module, only : mdata implicit none - integer imax,jmax,ijmax,i,j,n,jret,inttyp,iret,imsk, - & jmsk,len,lugb,kpds5,mon,lskip,lgrib,ndata,lugi,me,kmami + integer imax,jmax,ijmax,i,j,n,jret,inttyp,iret,imsk, & + & jmsk,len,lugb,kpds5,mon,lskip,lgrib,ndata,lugi,me,kmami & &, jj,w3kindreal,w3kindint real (kind=kind_io8) wlon,elon,rnlat,dlat,dlon,rslat,blno,blto ! -! read in grib climatology files and interpolate to the input -! grid. grib files should allow all the necessary parameters -! to be extracted from the description records. -! ! character*500 fngrib ! character*80 fngrib, asgnstr @@ -8400,18 +8394,18 @@ subroutine fixrdc(lugb,fngrib,kpds5,kpds7,mon,slmask, end subroutine fixrdc !>\ingroup mod_sfcsub - subroutine fixrda(lugb,fngrib,kpds5,slmask, - & iy,im,id,ih,fh,gdata,len,iret - &, imsk, jmsk, slmskh, gaus,blno, blto + subroutine fixrda(lugb,fngrib,kpds5,slmask, & + & iy,im,id,ih,fh,gdata,len,iret & + &, imsk, jmsk, slmskh, gaus,blno, blto & &, outlat, outlon, me) use machine , only : kind_io8,kind_io4 use sfccyc_module, only : mdata implicit none - integer nrepmx,nvalid,imo,iyr,idy,jret,ihr,nrept,lskip,lugi, - & lgrib,j,ndata,i,inttyp,jmax,imax,ijmax,ij,jday,len,iret, - & jmsk,imsk,ih,kpds5,lugb,iy,id,im,jh,jd,jdoy,jdow,jm,me, - & monend,jy,iy4,kmami,iret2,jj,w3kindreal,w3kindint - real (kind=kind_io8) rnlat,rslat,wlon,elon,dlon,dlat,fh,blno, + integer nrepmx,nvalid,imo,iyr,idy,jret,ihr,nrept,lskip,lugi, & + & lgrib,j,ndata,i,inttyp,jmax,imax,ijmax,ij,jday,len,iret, & + & jmsk,imsk,ih,kpds5,lugb,iy,id,im,jh,jd,jdoy,jdow,jm,me, & + & monend,jy,iy4,kmami,iret2,jj,w3kindreal,w3kindint + real (kind=kind_io8) rnlat,rslat,wlon,elon,dlon,dlat,fh,blno, & & rjday,blto ! ! read in grib climatology/analysis files and interpolate to the input diff --git a/physics/sflx.f b/physics/sflx.f index 926115f13..6a5914d02 100644 --- a/physics/sflx.f +++ b/physics/sflx.f @@ -57,6 +57,7 @@ !!\param[in] snoalb real, max albedo over deep snow (fraction) !!\param[in] bexpp real, perturbation of soil type "b" parameter (perturbation) !!\param[in] xlaip real, perturbation of leave area index (perturbation) +!!\param[in] lheatstrg logical, flag for canopy heat storage parameterization !!\param[in,out] tbot real, bottom soil temp (\f$K\f$) (local yearly-mean sfc air temp) !!\param[in,out] cmc real, canopy moisture content (\f$m\f$) !!\param[in,out] t1 real, ground/canopy/snowpack eff skin temp (\f$K\f$) @@ -336,7 +337,8 @@ subroutine gfssflx &! --- input & psisat, quartz, rch, refkdt, rr, rgl, rsmax, sndens, & & sncond, sbeta, sn_new, slope, snup, salp, soilwm, soilww, & & t1v, t24, t2v, th2v, topt, tsnow, zbot, z0 - + + real (kind=kind_phys) :: shdfac0 real (kind=kind_phys), dimension(nsold) :: rtdis, zsoil logical :: frzgra, snowng @@ -345,10 +347,9 @@ subroutine gfssflx &! --- input ! ! --- parameters for heat storage parametrization ! - real (kind=kind_phys) :: cpx, cpx1, cpfac, xx1, xx2, xx3 - real (kind=kind_phys), parameter :: z0min=0.2 - real (kind=kind_phys), parameter :: z0max=1.0 - + real (kind=kind_phys) :: cpx, cpx1, cpfac, xx1, xx2 + real (kind=kind_phys), parameter :: z0min=0.2_kind_phys, & + & z0max=1.0_kind_phys ! !===> ... begin here ! @@ -358,6 +359,7 @@ subroutine gfssflx &! --- input runoff2 = 0.0 runoff3 = 0.0 snomlt = 0.0 + rc = 0.0 ! --- ... define local variable ice to achieve: ! sea-ice case, ice = 1 @@ -368,6 +370,7 @@ subroutine gfssflx &! --- input ! vegetation fraction (shdfac) = 0. !> - Set ice = -1 and green vegetation fraction (shdfac) = 0 for glacial-ice land. + shdfac0 = shdfac ice = icein if(ivegsrc == 2) then @@ -420,12 +423,18 @@ subroutine gfssflx &! --- input !only igbp type has urban !urban if(vegtyp == 13)then - shdfac=0.05 - rsmin=400.0 - smcmax = 0.45 - smcref = 0.42 - smcwlt = 0.40 - smcdry = 0.40 +! shdfac=0.05 +! rsmin=400.0 +! smcmax = 0.45 +! smcref = 0.42 +! smcwlt = 0.40 +! smcdry = 0.40 + rsmin=400.0*(1-shdfac0)+40.0*shdfac0 ! gvf + shdfac=shdfac0 ! gvf + smcmax = 0.45*(1-shdfac0)+smcmax*shdfac0 + smcref = 0.42*(1-shdfac0)+smcref*shdfac0 + smcwlt = 0.40*(1-shdfac0)+smcwlt*shdfac0 + smcdry = 0.40*(1-shdfac0)+smcdry*shdfac0 endif endif @@ -440,7 +449,7 @@ subroutine gfssflx &! --- input ! --- ... bexp sfc-perts, mgehne !> - Calculate perturbated soil type "b" parameter. -!! Following Gehne et al. (2018) \cite gehne_et_al_2018, a perturbation of LAI +!! Following Gehne et al. (2019) \cite Gehne_2019 , a perturbation of LAI !! "leaf area index" (xlaip) and a perturbation of the empirical exponent parameter !! b in the soil hydraulic conductivity calculation (bexpp) are added to account for !! the uncertainties of LAI and b associated with different vegetation types and soil @@ -662,18 +671,21 @@ subroutine gfssflx &! --- input ! --- outputs: & df1 & & ) -!> - For IGBP/urban, \f$df1=3.24\f$. - if(ivegsrc == 1) then +! if(ivegsrc == 1) then !only igbp type has urban !urban - if ( vegtyp == 13 ) df1=3.24 - endif +! if ( vegtyp == 13 ) df1=3.24 +! endif !> - Add subsurface heat flux reduction effect from the !! overlying green canopy, adapted from section 2.1.2 of !! \cite peters-lidard_et_al_1997. - - df1 = df1 * exp( sbeta*shdfac ) +!wz only urban for igbp type + if(ivegsrc == 1 .and. vegtyp == 13) then + df1 = 3.24*(1.-shdfac) + shdfac*df1*exp(sbeta*shdfac) + else + df1 = df1 * exp( sbeta*shdfac ) + endif endif ! end if_ice_block @@ -802,19 +814,18 @@ subroutine gfssflx &! --- input ! ! --- enhance cp as a function of z0 to mimic heat storage ! - cpx = cp - cpx1 = cp1 - cpfac = 1. - if(lheatstrg) then - if((ivegsrc == 1 .and. vegtyp /= 13) - & .or. ivegsrc == 2) then - xx1 = (z0 - z0min) / (z0max - z0min) - xx2 = min(max(xx1, 0.), 1.) - xx3 = 1. + xx2 - cpx = cp * xx3 - cpx1 = cp1 * xx3 - cpfac = cp / cpx - endif + cpx = cp + cpx1 = cp1 + cpfac = 1.0 + if (lheatstrg) then + if ((ivegsrc == 1 .and. vegtyp /= 13) + & .or. ivegsrc == 2) then + xx1 = (z0 - z0min) / (z0max - z0min) + xx2 = 1.0 + min(max(xx1, 0.0), 1.0) + cpx = cp * xx2 + cpx1 = cp1 * xx2 + cpfac = cp / cpx + endif endif !> - Call penman() to calculate potential evaporation (\a etp), @@ -1500,18 +1511,22 @@ subroutine nopac ! --- outputs: & df1 & & ) - if(ivegsrc == 1) then +! if(ivegsrc == 1) then !urban - if ( vegtyp == 13 ) df1=3.24 - endif +! if ( vegtyp == 13 ) df1=3.24 +! endif ! --- ... vegetation greenness fraction reduction in subsurface heat ! flux via reduction factor, which is convenient to apply here ! to thermal diffusivity that is later used in hrt to compute ! sub sfc heat flux (see additional comments on veg effect ! sub-sfc heat flx in routine sflx) - - df1 = df1 * exp( sbeta*shdfac ) +!wz only urban for igbp type + if(ivegsrc == 1 .and. vegtyp == 13) then + df1 = 3.24*(1.-shdfac) + shdfac*df1*exp(sbeta*shdfac) + else + df1 = df1 * exp( sbeta*shdfac ) + endif ! --- ... compute intermediate terms passed to routine hrt (via routine ! shflx below) for use in computing subsurface heat flux in hrt @@ -2596,8 +2611,8 @@ subroutine snopac if (t12 <= tfreez) then t1 = t12 -! ssoil = df1 * (t1 - stc(1)) / dtot - ssoil = (t1 - stc (1)) * max(7.0, df1/dtot) + ssoil = df1 * (t1 - stc(1)) / dtot +!wz ssoil = (t1 - stc (1)) * max(7.0, df1/dtot) sneqv = max(0.0, sneqv-esnow2) flx3 = 0.0 ex = 0.0 @@ -2724,13 +2739,13 @@ subroutine snopac ! --- ... before call shflx in this snowpack case, set zz1 and yy arguments to ! special values that ensure that ground heat flux calculated in shflx -! matches that already computer for below the snowpack, thus the sfc +! matches that already computed for below the snowpack, thus the sfc ! heat flux to be computed in shflx will effectively be the flux at the ! snow top surface. t11 is a dummy arguement so we will not use the ! skin temp value as revised by shflx. zz1 = 1.0 - yy = stc(1) - 0.5*ssoil*zsoil(1)*zz1 / df1 + yy = stc(1) - 0.5*ssoil*zsoil(1)*zz1 / df1 t11 = t1 ! --- ... shflx will calc/update the soil temps. note: the sub-sfc heat flux @@ -3372,6 +3387,7 @@ subroutine shflx & ! --- inputs: & ( nsoil, stc, smc, smcmax, zsoil, yy, zz1, tbot, & & zbot, psisat, dt, bexp, df1, quartz, csoil,vegtyp, & + & shdfac, & ! --- input/outputs: & sh2o, & ! --- outputs: @@ -4038,6 +4054,7 @@ subroutine hrt & ! --- inputs: & ( nsoil, stc, smc, smcmax, zsoil, yy, zz1, tbot, & & zbot, psisat, dt, bexp, df1, quartz, csoil, vegtyp, & + & shdfac, & ! --- input/outputs: & sh2o, & ! --- outputs: @@ -4091,7 +4108,7 @@ subroutine hrt & real (kind=kind_phys), intent(in) :: stc(nsoil), smc(nsoil), & & smcmax, zsoil(nsoil), yy, zz1, tbot, zbot, psisat, dt, & - & bexp, df1, quartz, csoil + & bexp, df1, quartz, csoil, shdfac ! --- input/outputs: real (kind=kind_phys), intent(inout) :: sh2o(nsoil) @@ -4117,7 +4134,8 @@ subroutine hrt & if (ivegsrc == 1)then !urban if( vegtyp == 13 ) then - csoil_loc=3.0e6 +! csoil_loc=3.0e6 + csoil_loc=3.0e6*(1.-shdfac)+csoil*shdfac ! gvf endif endif @@ -4207,7 +4225,7 @@ subroutine hrt & call snksrc & ! --- inputs: & ( nsoil, 1, tavg, smc(1), smcmax, psisat, bexp, dt, & - & qtot, zsoil, & + & qtot, zsoil, shdfac, & ! --- input/outputs: & sh2o(1), & ! --- outputs: @@ -4249,9 +4267,13 @@ subroutine hrt & & df1n & & ) !urban - if (ivegsrc == 1)then - if ( vegtyp == 13 ) df1n = 3.24 - endif +! if (ivegsrc == 1)then +! if ( vegtyp == 13 ) df1n = 3.24 +! endif +!wz only urban for igbp type + if(ivegsrc == 1 .and. vegtyp == 13) then + df1n = 3.24*(1.-shdfac) + shdfac*df1n + endif ! --- ... calc the vertical soil temp gradient thru this layer @@ -4289,9 +4311,13 @@ subroutine hrt & & df1n & & ) !urban - if (ivegsrc == 1)then - if ( vegtyp == 13 ) df1n = 3.24 - endif +! if (ivegsrc == 1)then +! if ( vegtyp == 13 ) df1n = 3.24 +! endif +!wz only urban for igbp type + if(ivegsrc == 1 .and. vegtyp == 13) then + df1n = 3.24*(1.-shdfac) + shdfac*df1n + endif ! --- ... calc the vertical soil temp gradient thru bottom layer. @@ -4345,7 +4371,7 @@ subroutine hrt & call snksrc & ! --- inputs: & ( nsoil, k, tavg, smc(k), smcmax, psisat, bexp, dt, & - & qtot, zsoil, & + & qtot, zsoil, shdfac, & ! --- input/outputs: & sh2o(k), & ! --- outputs: @@ -4760,7 +4786,7 @@ end subroutine rosr12 subroutine snksrc & ! --- inputs: & ( nsoil, k, tavg, smc, smcmax, psisat, bexp, dt, & - & qtot, zsoil, & + & qtot, zsoil, shdfac, & ! --- input/outputs: & sh2o, & ! --- outputs: @@ -4805,7 +4831,7 @@ subroutine snksrc & integer, intent(in) :: nsoil, k real (kind=kind_phys), intent(in) :: tavg, smc, smcmax, psisat, & - & bexp, dt, qtot, zsoil(nsoil) + & bexp, dt, qtot, zsoil(nsoil), shdfac ! --- input/outputs: real (kind=kind_phys), intent(inout) :: sh2o @@ -4820,9 +4846,13 @@ subroutine snksrc & ! real (kind=kind_phys) :: frh2o !urban - if (ivegsrc == 1)then - if ( vegtyp == 13 ) df1=3.24 - endif +! if (ivegsrc == 1)then +! if ( vegtyp == 13 ) df1=3.24 +! endif +!wz only urban for igbp type + if(ivegsrc == 1 .and. vegtyp == 13) then + df1 = 3.24*(1.-shdfac) + shdfac*df1 + endif ! !===> ... begin here ! diff --git a/physics/shalcnv.F b/physics/shalcnv.F new file mode 100644 index 000000000..5c9e65203 --- /dev/null +++ b/physics/shalcnv.F @@ -0,0 +1,1351 @@ +!> \defgroup SASHAL Mass-Flux Shallow Convection +!! @{ +!! \brief The Mass-Flux shallow convection scheme parameterizes the effect of shallow convection on the environment much like the \ref SAS scheme with a few key modifications. Perhaps most importantly, no quasi-equilibrium assumption is necessary since the shallow cloud base mass flux is parameterized from the surface buoyancy flux. Further, there are no convective downdrafts, the entrainment rate is greater than for deep convection, and the shallow convection is limited to not extend over the level where \f$p=0.7p_{sfc}\f$. +!! +!! This scheme was designed to replace the previous eddy-diffusivity approach to shallow convection with a mass-flux based approach as it is used for deep convection. Differences between the shallow and deep SAS schemes are presented in Han and Pan (2011) \cite han_and_pan_2011 . Like the deep scheme, it uses the working concepts put forth in Arakawa and Schubert (1974) \cite arakawa_and_schubert_1974 but includes modifications and simplifications from Grell (1993) \cite grell_1993 such as only one cloud type (the deepest possible, up to \f$p=0.7p_{sfc}\f$), rather than a spectrum based on cloud top heights or assumed entrainment rates, although it assumes no convective downdrafts. It contains many modifications associated with deep scheme as discussed in Han and Pan (2011) \cite han_and_pan_2011 , including the calculation of cloud top, a greater CFL-criterion-based maximum cloud base mass flux, and the inclusion of convective overshooting. +!! +!! \section diagram Calling Hierarchy Diagram +!! \image html Shallow_SAS_Flowchart.png "Diagram depicting how the SAS shallow convection scheme is called from the GSM physics time loop" height=2cm +!! \section intraphysics Intraphysics Communication +!! This space is reserved for a description of how this scheme uses information from other scheme types and/or how information calculated in this scheme is used in other scheme types. + +!> \file shalcnv.F +!! Contains the entire SAS shallow convection scheme. + module shalcnv + + implicit none + + private + + public :: shalcnv_init, shalcnv_run, shalcnv_finalize + + contains + +!! +!! \section arg_table_shalcnv_init Argument Table +!! \htmlinclude shalcnv_init.html +!! + subroutine shalcnv_init(do_shoc,shal_cnv,imfshalcnv, & + & imfshalcnv_sas,errmsg,errflg) +! + logical, intent(in) :: do_shoc,shal_cnv + integer, intent(in) :: imfshalcnv, imfshalcnv_sas + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg +! +! initialize CCPP error handling variables + errmsg = '' + errflg = 0 +! + if (do_shoc .or. .not.shal_cnv .or. & + & imfshalcnv/=imfshalcnv_sas) then + write(errmsg,'(*(a))') 'Logic error: shalcnv incompatible with',& + & ' control flags do_shoc, shal_cnv or imfshalcnv' + errflg = 1 + return + endif +! + end subroutine shalcnv_init + +! \brief This subroutine is empty since there are no procedures that need to be done to finalize the shalcnv code. +!! +!! \section arg_table_shalcnv_finalize Argument Table +!! + subroutine shalcnv_finalize + end subroutine shalcnv_finalize + +!> \brief This subroutine contains the entirety of the SAS shallow convection scheme. +!! +!! This routine follows the \ref SAS scheme quite closely, although it can be interpreted as only having the "static" and "feedback" control portions, since the "dynamic" control is not necessary to find the cloud base mass flux. The algorithm is simplified from SAS deep convection by excluding convective downdrafts and being confined to operate below \f$p=0.7p_{sfc}\f$. Also, entrainment is both simpler and stronger in magnitude compared to the deep scheme. +!! +!! \param[in] im number of used points +!! \param[in] ix horizontal dimension +!! \param[in] km vertical layer dimension +!! \param[in] jcap number of spectral wave trancation +!! \param[in] delt physics time step in seconds +!! \param[in] delp pressure difference between level k and k+1 (Pa) +!! \param[in] prslp mean layer presure (Pa) +!! \param[in] psp surface pressure (Pa) +!! \param[in] phil layer geopotential (\f$m^2/s^2\f$) +!! \param[inout] qlc cloud water (kg/kg) +!! \param[inout] qli ice (kg/kg) +!! \param[inout] q1 updated tracers (kg/kg) +!! \param[inout] t1 updated temperature (K) +!! \param[inout] u1 updated zonal wind (\f$m s^{-1}\f$) +!! \param[inout] v1 updated meridional wind (\f$m s^{-1}\f$) +!! \param[out] rn convective rain (m) +!! \param[out] kbot index for cloud base +!! \param[out] ktop index for cloud top +!! \param[out] kcnv flag to denote deep convection (0=no, 1=yes) +!! \param[in] islimsk sea/land/ice mask (=0/1/2) +!! \param[in] dot layer mean vertical velocity (Pa/s) +!! \param[in] ncloud number of cloud species +!! \param[in] hpbl PBL height (m) +!! \param[in] heat surface sensible heat flux (K m/s) +!! \param[in] evap surface latent heat flux (kg/kg m/s) +!! \param[out] ud_mf updraft mass flux multiplied by time step (\f$kg/m^2\f$) +!! \param[out] dt_mf ud_mf at cloud top (\f$kg/m^2\f$) +!! \param[out] cnvw convective cloud water (kg/kg) +!! \param[out] cnvc convective cloud cover (unitless) +!! +!! \section general General Algorithm +!! -# Compute preliminary quantities needed for the static and feedback control portions of the algorithm. +!! -# Perform calculations related to the updraft of the entraining/detraining cloud model ("static control"). +!! -# Calculate the tendencies of the state variables (per unit cloud base mass flux) and the cloud base mass flux. +!! -# For the "feedback control", calculate updated values of the state variables by multiplying the cloud base mass flux and the tendencies calculated per unit cloud base mass flux from the static control. +!! \section detailed Detailed Algorithm +!! +!! \section arg_table_shalcnv_run Argument Table +!! \htmlinclude shalcnv_run.html +!! +!! @{ + subroutine shalcnv_run( & + & grav,cp,hvap,rv,fv,t0c,rd,cvap,cliq,eps,epsm1, & + & im,ix,km,jcap,delt,delp,prslp,psp,phil,qlc,qli, & + & q1,t1,u1,v1,rn,kbot,ktop,kcnv,islimsk, & + & dot,ncloud,hpbl,heat,evap,ud_mf,dt_mf,cnvw,cnvc, & + & clam,c0,c1,pgcon,errmsg,errflg) +! + use machine , only : kind_phys + use funcphys , only : fpvs +! use physcons, grav => con_g, cp => con_cp, hvap => con_hvap & +! &, rv => con_rv, fv => con_fvirt, t0c => con_t0c & +! &, rd => con_rd, cvap => con_cvap, cliq => con_cliq & +! &, eps => con_eps, epsm1 => con_epsm1 + implicit none +! +! Interface variables +! + real(kind=kind_phys), intent(in) :: grav, cp, hvap, rv, fv, t0c, & + & rd, cvap, cliq, eps, epsm1 + integer, intent(in) :: im, ix, km, jcap, ncloud + integer, intent(inout) :: kbot(:), ktop(:), kcnv(:) + integer, intent(in) :: islimsk(:) + real(kind=kind_phys), intent(in) :: delt, clam, c0, c1, pgcon + real(kind=kind_phys), intent(in) :: psp(:), delp(:,:), & + & prslp(:,:), dot(:,:), & + & phil(:,:), hpbl(:), & + & heat(:), evap(:) + real(kind=kind_phys), intent(inout) :: & + & qlc(:,:), qli(:,:), & + & q1(:,:), t1(:,:), & + & u1(:,:), v1(:,:), & + & cnvw(:,:), cnvc(:,:) + real(kind=kind_phys), intent(out) :: rn(:), ud_mf(:,:), dt_mf(:,:) + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg +! +! Local variables +! + integer i,j,indx, k, kk, km1 + integer kpbl(im) +! + real(kind=kind_phys) dellat, delta, + & desdt, + & dp, + & dq, dqsdp, dqsdt, dt, + & dt2, dtmax, dtmin, dv1h, + & dv1q, dv2h, dv2q, dv1u, + & dv1v, dv2u, dv2v, dv3q, + & dv3h, dv3u, dv3v, + & dz, dz1, e1, + & el2orc, elocp, aafac, + & es, etah, h1, dthk, + & evef, evfact, evfactl, fact1, + & fact2, factor, fjcap, + & g, gamma, pprime, betaw, + & qlk, qrch, qs, + & rfact, shear, tem1, + & val, val1, + & val2, w1, w1l, w1s, + & w2, w2l, w2s, w3, + & w3l, w3s, w4, w4l, + & w4s, tem, ptem, ptem1 +! + integer kb(im), kbcon(im), kbcon1(im), + & ktcon(im), ktcon1(im), + & kbm(im), kmax(im) +! + real(kind=kind_phys) aa1(im), + & delhbar(im), delq(im), delq2(im), + & delqbar(im), delqev(im), deltbar(im), + & deltv(im), edt(im), + & wstar(im), sflx(im), + & pdot(im), po(im,km), + & qcond(im), qevap(im), hmax(im), + & rntot(im), vshear(im), + & xlamud(im), xmb(im), xmbmax(im), + & delubar(im), delvbar(im), + & ps(im), del(im,km), prsl(im,km) +! + real(kind=kind_phys) cincr, cincrmax, cincrmin +! +! physical parameters +! parameter(g=grav) +! parameter(elocp=hvap/cp, +! & el2orc=hvap*hvap/(rv*cp)) +! parameter(c0=.002,c1=5.e-4,delta=fv) +! parameter(delta=fv) +! parameter(fact1=(cvap-cliq)/rv,fact2=hvap/rv-fact1*t0c) + parameter(cincrmax=180.,cincrmin=120.,dthk=25.) + parameter(h1=0.33333333) +! local variables and arrays + real(kind=kind_phys) pfld(im,km), to(im,km), qo(im,km), + & uo(im,km), vo(im,km), qeso(im,km) +! cloud water +! real(kind=kind_phys) qlko_ktcon(im), dellal(im,km), tvo(im,km), + real(kind=kind_phys) qlko_ktcon(im), dellal(im,km), + & dbyo(im,km), zo(im,km), xlamue(im,km), + & heo(im,km), heso(im,km), + & dellah(im,km), dellaq(im,km), + & dellau(im,km), dellav(im,km), hcko(im,km), + & ucko(im,km), vcko(im,km), qcko(im,km), + & qrcko(im,km), eta(im,km), + & zi(im,km), pwo(im,km), + & tx1(im), cnvwt(im,km) +! + logical totflg, cnvflg(im), flg(im) +! + real(kind=kind_phys) tf, tcr, tcrf + parameter (tf=233.16, tcr=263.16, tcrf=1.0/(tcr-tf)) +! +!----------------------------------------------------------------------- +! +!************************************************************************ +! replace (derived) constants above with regular variables + g = grav + elocp = hvap/cp + el2orc = hvap*hvap/(rv*cp) + delta = fv + fact1 = (cvap-cliq)/rv + fact2 = hvap/rv-fact1*t0c +!************************************************************************ +! initialize CCPP error handling variables + errmsg = '' + errflg = 0 +!************************************************************************ +! convert input pa terms to cb terms -- moorthi +!> ## Compute preliminary quantities needed for the static and feedback control portions of the algorithm. +!> - Convert input pressure terms to centibar units. + ps = psp * 0.001 + prsl = prslp * 0.001 + del = delp * 0.001 +!************************************************************************ +! + km1 = km - 1 +! +! compute surface buoyancy flux +! +!> - Compute the surface buoyancy flux according to +!! \f[ +!! \overline{w'\theta_v'}=\overline{w'\theta'}+\left(\frac{R_v}{R_d}-1\right)T_0\overline{w'q'} +!! \f] +!! where \f$\overline{w'\theta'}\f$ is the surface sensible heat flux, \f$\overline{w'q'}\f$ is the surface latent heat flux, \f$R_v\f$ is the gas constant for water vapor, \f$R_d\f$ is the gas constant for dry air, and \f$T_0\f$ is a reference temperature. + do i=1,im + sflx(i) = heat(i)+fv*t1(i,1)*evap(i) + enddo +! +! initialize arrays +! +!> - Initialize column-integrated and other single-value-per-column variable arrays. + do i=1,im + cnvflg(i) = .true. + if(kcnv(i).eq.1) cnvflg(i) = .false. + if(sflx(i).le.0.) cnvflg(i) = .false. + if(cnvflg(i)) then + kbot(i)=km+1 + ktop(i)=0 + endif + rn(i)=0. + kbcon(i)=km + ktcon(i)=1 + kb(i)=km + pdot(i) = 0. + qlko_ktcon(i) = 0. + edt(i) = 0. + aa1(i) = 0. + vshear(i) = 0. + enddo +!> - Initialize updraft and detrainment mass fluxes to zero. +! hchuang code change + do k = 1, km + do i = 1, im + ud_mf(i,k) = 0. + dt_mf(i,k) = 0. + enddo + enddo +!! +!> - Return to the calling routine if deep convection is present or the surface buoyancy flux is negative. + totflg = .true. + do i=1,im + totflg = totflg .and. (.not. cnvflg(i)) + enddo + if(totflg) return +!! +! +!> - Define tunable parameters. + dt2 = delt + val = 1200. + dtmin = max(dt2, val ) + val = 3600. + dtmax = max(dt2, val ) +! model tunable parameters are all here +! clam = .3 + aafac = .1 + betaw = .03 +! evef = 0.07 + evfact = 0.3 + evfactl = 0.3 +! +! pgcon = 0.7 ! gregory et al. (1997, qjrms) +! pgcon = 0.55 ! zhang & wu (2003,jas) + fjcap = (float(jcap) / 126.) ** 2 + val = 1. + fjcap = max(fjcap,val) + w1l = -8.e-3 + w2l = -4.e-2 + w3l = -5.e-3 + w4l = -5.e-4 + w1s = -2.e-4 + w2s = -2.e-3 + w3s = -1.e-3 + w4s = -2.e-5 +! +! define top layer for search of the downdraft originating layer +! and the maximum thetae for updraft +! +!> - Determine maximum indices for the parcel starting point (kbm) and cloud top (kmax). + do i=1,im + kbm(i) = km + kmax(i) = km + tx1(i) = 1.0 / ps(i) + enddo +! + do k = 1, km + do i=1,im + if (prsl(i,k)*tx1(i) .gt. 0.70) kbm(i) = k + 1 + if (prsl(i,k)*tx1(i) .gt. 0.60) kmax(i) = k + 1 + enddo + enddo + do i=1,im + kbm(i) = min(kbm(i),kmax(i)) + enddo +! +! hydrostatic height assume zero terr and compute +! updraft entrainment rate as an inverse function of height +! +!> - Calculate hydrostatic height at layer centers assuming a flat surface (no terrain) from the geopotential. + do k = 1, km + do i=1,im + zo(i,k) = phil(i,k) / g + enddo + enddo +!> - Calculate interface height and the entrainment rate as an inverse function of height. + do k = 1, km1 + do i=1,im + zi(i,k) = 0.5*(zo(i,k)+zo(i,k+1)) + xlamue(i,k) = clam / zi(i,k) + enddo + enddo + do i=1,im + xlamue(i,km) = xlamue(i,km1) + enddo +! +! pbl height +! +!> - Find the index for the PBL top using the PBL height; enforce that it is lower than the maximum parcel starting level. + do i=1,im + flg(i) = cnvflg(i) + kpbl(i)= 1 + enddo + do k = 2, km1 + do i=1,im + if (flg(i).and.zo(i,k).le.hpbl(i)) then + kpbl(i) = k + else + flg(i) = .false. + endif + enddo + enddo + do i=1,im + kpbl(i)= min(kpbl(i),kbm(i)) + enddo +! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! convert surface pressure to mb from cb +! +!> - Convert prsl from centibar to millibar, set normalized mass flux to 1, cloud properties to 0, and save model state variables (after advection/turbulence). + do k = 1, km + do i = 1, im + if (cnvflg(i) .and. k .le. kmax(i)) then + pfld(i,k) = prsl(i,k) * 10.0 + eta(i,k) = 1. + hcko(i,k) = 0. + qcko(i,k) = 0. + qrcko(i,k)= 0. + ucko(i,k) = 0. + vcko(i,k) = 0. + dbyo(i,k) = 0. + pwo(i,k) = 0. + dellal(i,k) = 0. + to(i,k) = t1(i,k) + qo(i,k) = q1(i,k) + uo(i,k) = u1(i,k) + vo(i,k) = v1(i,k) +! uo(i,k) = u1(i,k) * rcs(i) +! vo(i,k) = v1(i,k) * rcs(i) + cnvwt(i,k) = 0. + endif + enddo + enddo +! +! column variables +! p is pressure of the layer (mb) +! t is temperature at t-dt (k)..tn +! q is mixing ratio at t-dt (kg/kg)..qn +! to is temperature at t+dt (k)... this is after advection and turbulan +! qo is mixing ratio at t+dt (kg/kg)..q1 +! +!> - Calculate saturation mixing ratio and enforce minimum moisture values. + do k = 1, km + do i=1,im + if (cnvflg(i) .and. k .le. kmax(i)) then + qeso(i,k) = 0.01 * fpvs(to(i,k)) ! fpvs is in pa + qeso(i,k) = eps * qeso(i,k) / (pfld(i,k) + epsm1*qeso(i,k)) + val1 = 1.e-8 + qeso(i,k) = max(qeso(i,k), val1) + val2 = 1.e-10 + qo(i,k) = max(qo(i,k), val2 ) +! qo(i,k) = min(qo(i,k),qeso(i,k)) +! tvo(i,k) = to(i,k) + delta * to(i,k) * qo(i,k) + endif + enddo + enddo +! +! compute moist static energy +! +!> - Calculate moist static energy (heo) and saturation moist static energy (heso). + do k = 1, km + do i=1,im + if (cnvflg(i) .and. k .le. kmax(i)) then +! tem = g * zo(i,k) + cp * to(i,k) + tem = phil(i,k) + cp * to(i,k) + heo(i,k) = tem + hvap * qo(i,k) + heso(i,k) = tem + hvap * qeso(i,k) +! heo(i,k) = min(heo(i,k),heso(i,k)) + endif + enddo + enddo +! +! determine level with largest moist static energy within pbl +! this is the level where updraft starts +! +!> ## Perform calculations related to the updraft of the entraining/detraining cloud model ("static control"). +!> - Search in the PBL for the level of maximum moist static energy to start the ascending parcel. + do i=1,im + if (cnvflg(i)) then + hmax(i) = heo(i,1) + kb(i) = 1 + endif + enddo + do k = 2, km + do i=1,im + if (cnvflg(i).and.k.le.kpbl(i)) then + if(heo(i,k).gt.hmax(i)) then + kb(i) = k + hmax(i) = heo(i,k) + endif + endif + enddo + enddo +! +!> - Calculate the temperature, water vapor mixing ratio, and pressure at interface levels. + do k = 1, km1 + do i=1,im + if (cnvflg(i) .and. k .le. kmax(i)-1) then + dz = .5 * (zo(i,k+1) - zo(i,k)) + dp = .5 * (pfld(i,k+1) - pfld(i,k)) + es = 0.01 * fpvs(to(i,k+1)) ! fpvs is in pa + pprime = pfld(i,k+1) + epsm1 * es + qs = eps * es / pprime + dqsdp = - qs / pprime + desdt = es * (fact1 / to(i,k+1) + fact2 / (to(i,k+1)**2)) + dqsdt = qs * pfld(i,k+1) * desdt / (es * pprime) + gamma = el2orc * qeso(i,k+1) / (to(i,k+1)**2) + dt = (g * dz + hvap * dqsdp * dp) / (cp * (1. + gamma)) + dq = dqsdt * dt + dqsdp * dp + to(i,k) = to(i,k+1) + dt + qo(i,k) = qo(i,k+1) + dq + po(i,k) = .5 * (pfld(i,k) + pfld(i,k+1)) + endif + enddo + enddo +! +!> - Recalculate saturation mixing ratio, moist static energy, saturation moist static energy, and horizontal momentum on interface levels. Enforce minimum mixing ratios. + do k = 1, km1 + do i=1,im + if (cnvflg(i) .and. k .le. kmax(i)-1) then + qeso(i,k) = 0.01 * fpvs(to(i,k)) ! fpvs is in pa + qeso(i,k) = eps * qeso(i,k) / (po(i,k) + epsm1*qeso(i,k)) + val1 = 1.e-8 + qeso(i,k) = max(qeso(i,k), val1) + val2 = 1.e-10 + qo(i,k) = max(qo(i,k), val2 ) +! qo(i,k) = min(qo(i,k),qeso(i,k)) + heo(i,k) = .5 * g * (zo(i,k) + zo(i,k+1)) + + & cp * to(i,k) + hvap * qo(i,k) + heso(i,k) = .5 * g * (zo(i,k) + zo(i,k+1)) + + & cp * to(i,k) + hvap * qeso(i,k) + uo(i,k) = .5 * (uo(i,k) + uo(i,k+1)) + vo(i,k) = .5 * (vo(i,k) + vo(i,k+1)) + endif + enddo + enddo +! +! look for the level of free convection as cloud base +!!> - Search below the index "kbm" for the level of free convection (LFC) where the condition \f$h_b > h^*\f$ is first met, where \f$h_b, h^*\f$ are the state moist static energy at the parcel's starting level and saturation moist static energy, respectively. Set "kbcon" to the index of the LFC. + do i=1,im + flg(i) = cnvflg(i) + if(flg(i)) kbcon(i) = kmax(i) + enddo + do k = 2, km1 + do i=1,im + if (flg(i).and.k.lt.kbm(i)) then + if(k.gt.kb(i).and.heo(i,kb(i)).gt.heso(i,k)) then + kbcon(i) = k + flg(i) = .false. + endif + endif + enddo + enddo +! +!> - If no LFC, return to the calling routine without modifying state variables. + do i=1,im + if(cnvflg(i)) then + if(kbcon(i).eq.kmax(i)) cnvflg(i) = .false. + endif + enddo +!! + totflg = .true. + do i=1,im + totflg = totflg .and. (.not. cnvflg(i)) + enddo + if(totflg) return +!! +! +! determine critical convective inhibition +! as a function of vertical velocity at cloud base. +! +!> - Determine the vertical pressure velocity at the LFC. After Han and Pan (2011) \cite han_and_pan_2011 , determine the maximum pressure thickness between a parcel's starting level and the LFC. If a parcel doesn't reach the LFC within the critical thickness, then the convective inhibition is deemed too great for convection to be triggered, and the subroutine returns to the calling routine without modifying the state variables. + do i=1,im + if(cnvflg(i)) then +! pdot(i) = 10.* dot(i,kbcon(i)) + pdot(i) = 0.01 * dot(i,kbcon(i)) ! now dot is in pa/s + endif + enddo + do i=1,im + if(cnvflg(i)) then + if(islimsk(i) == 1) then + w1 = w1l + w2 = w2l + w3 = w3l + w4 = w4l + else + w1 = w1s + w2 = w2s + w3 = w3s + w4 = w4s + endif + if(pdot(i).le.w4) then + ptem = (pdot(i) - w4) / (w3 - w4) + elseif(pdot(i).ge.-w4) then + ptem = - (pdot(i) + w4) / (w4 - w3) + else + ptem = 0. + endif + val1 = -1. + ptem = max(ptem,val1) + val2 = 1. + ptem = min(ptem,val2) + ptem = 1. - ptem + ptem1= .5*(cincrmax-cincrmin) + cincr = cincrmax - ptem * ptem1 + tem1 = pfld(i,kb(i)) - pfld(i,kbcon(i)) + if(tem1.gt.cincr) then + cnvflg(i) = .false. + endif + endif + enddo +!! + totflg = .true. + do i=1,im + totflg = totflg .and. (.not. cnvflg(i)) + enddo + if(totflg) return +!! +! +! assume the detrainment rate for the updrafts to be same as +! the entrainment rate at cloud base +! +!> - The updraft detrainment rate is set constant and equal to the entrainment rate at cloud base. + do i = 1, im + if(cnvflg(i)) then + xlamud(i) = xlamue(i,kbcon(i)) + endif + enddo +! +! determine updraft mass flux for the subcloud layers +! +!> - Calculate the normalized mass flux for subcloud and in-cloud layers according to Pan and Wu (1995) \cite pan_and_wu_1995 equation 1: +!! \f[ +!! \frac{1}{\eta}\frac{\partial \eta}{\partial z} = \lambda_e - \lambda_d +!! \f] +!! where \f$\eta\f$ is the normalized mass flux, \f$\lambda_e\f$ is the entrainment rate and \f$\lambda_d\f$ is the detrainment rate. The normalized mass flux increases upward below the cloud base and decreases upward above. + do k = km1, 1, -1 + do i = 1, im + if (cnvflg(i)) then + if(k.lt.kbcon(i).and.k.ge.kb(i)) then + dz = zi(i,k+1) - zi(i,k) + ptem = 0.5*(xlamue(i,k)+xlamue(i,k+1))-xlamud(i) + eta(i,k) = eta(i,k+1) / (1. + ptem * dz) + endif + endif + enddo + enddo +! +! compute mass flux above cloud base +! + do k = 2, km1 + do i = 1, im + if(cnvflg(i))then + if(k.gt.kbcon(i).and.k.lt.kmax(i)) then + dz = zi(i,k) - zi(i,k-1) + ptem = 0.5*(xlamue(i,k)+xlamue(i,k-1))-xlamud(i) + eta(i,k) = eta(i,k-1) * (1 + ptem * dz) + endif + endif + enddo + enddo +! +! compute updraft cloud property +! +!> - Set initial cloud properties equal to the state variables at cloud base. + do i = 1, im + if(cnvflg(i)) then + indx = kb(i) + hcko(i,indx) = heo(i,indx) + ucko(i,indx) = uo(i,indx) + vcko(i,indx) = vo(i,indx) + endif + enddo +! +!> - Calculate the cloud properties as a parcel ascends, modified by entrainment and detrainment. Discretization follows Appendix B of Grell (1993) \cite grell_1993 . Following Han and Pan (2006) \cite han_and_pan_2006, the convective momentum transport is reduced by the convection-induced pressure gradient force by the constant "pgcon", currently set to 0.55 after Zhang and Wu (2003) \cite zhang_and_wu_2003 . + do k = 2, km1 + do i = 1, im + if (cnvflg(i)) then + if(k.gt.kb(i).and.k.lt.kmax(i)) then + dz = zi(i,k) - zi(i,k-1) + tem = 0.5 * (xlamue(i,k)+xlamue(i,k-1)) * dz + tem1 = 0.5 * xlamud(i) * dz + factor = 1. + tem - tem1 + ptem = 0.5 * tem + pgcon + ptem1= 0.5 * tem - pgcon + hcko(i,k) = ((1.-tem1)*hcko(i,k-1)+tem*0.5* + & (heo(i,k)+heo(i,k-1)))/factor + ucko(i,k) = ((1.-tem1)*ucko(i,k-1)+ptem*uo(i,k) + & +ptem1*uo(i,k-1))/factor + vcko(i,k) = ((1.-tem1)*vcko(i,k-1)+ptem*vo(i,k) + & +ptem1*vo(i,k-1))/factor + dbyo(i,k) = hcko(i,k) - heso(i,k) + endif + endif + enddo + enddo +! +! taking account into convection inhibition due to existence of +! dry layers below cloud base +! +!> - With entrainment, recalculate the LFC as the first level where buoyancy is positive. The difference in pressure levels between LFCs calculated with/without entrainment must be less than a threshold (currently 25 hPa). Otherwise, convection is inhibited and the scheme returns to the calling routine without modifying the state variables. This is the subcloud dryness trigger modification discussed in Han and Pan (2011) \cite han_and_pan_2011. + do i=1,im + flg(i) = cnvflg(i) + kbcon1(i) = kmax(i) + enddo + do k = 2, km1 + do i=1,im + if (flg(i).and.k.lt.kbm(i)) then + if(k.ge.kbcon(i).and.dbyo(i,k).gt.0.) then + kbcon1(i) = k + flg(i) = .false. + endif + endif + enddo + enddo + do i=1,im + if(cnvflg(i)) then + if(kbcon1(i).eq.kmax(i)) cnvflg(i) = .false. + endif + enddo + do i=1,im + if(cnvflg(i)) then + tem = pfld(i,kbcon(i)) - pfld(i,kbcon1(i)) + if(tem.gt.dthk) then + cnvflg(i) = .false. + endif + endif + enddo +!! + totflg = .true. + do i = 1, im + totflg = totflg .and. (.not. cnvflg(i)) + enddo + if(totflg) return +!! +! +! determine first guess cloud top as the level of zero buoyancy +! limited to the level of sigma=0.7 +! +!> - Calculate the cloud top as the first level where parcel buoyancy becomes negative; the maximum possible value is at \f$p=0.7p_{sfc}\f$. + do i = 1, im + flg(i) = cnvflg(i) + if(flg(i)) ktcon(i) = kbm(i) + enddo + do k = 2, km1 + do i=1,im + if (flg(i).and.k .lt. kbm(i)) then + if(k.gt.kbcon1(i).and.dbyo(i,k).lt.0.) then + ktcon(i) = k + flg(i) = .false. + endif + endif + enddo + enddo +! +! turn off shallow convection if cloud top is less than pbl top +! +! do i=1,im +! if(cnvflg(i)) then +! kk = kpbl(i)+1 +! if(ktcon(i).le.kk) cnvflg(i) = .false. +! endif +! enddo +!! +! totflg = .true. +! do i = 1, im +! totflg = totflg .and. (.not. cnvflg(i)) +! enddo +! if(totflg) return +!! +! +! specify upper limit of mass flux at cloud base +! +!> - Calculate the maximum value of the cloud base mass flux using the CFL-criterion-based formula of Han and Pan (2011) \cite han_and_pan_2011, equation 7. + do i = 1, im + if(cnvflg(i)) then +! xmbmax(i) = .1 +! + k = kbcon(i) + dp = 1000. * del(i,k) + xmbmax(i) = dp / (g * dt2) +! +! tem = dp / (g * dt2) +! xmbmax(i) = min(tem, xmbmax(i)) + endif + enddo +! +! compute cloud moisture property and precipitation +! +!> - Initialize the cloud moisture at cloud base and set the cloud work function to zero. + do i = 1, im + if (cnvflg(i)) then + aa1(i) = 0. + qcko(i,kb(i)) = qo(i,kb(i)) + qrcko(i,kb(i)) = qo(i,kb(i)) + endif + enddo +!> - Calculate the moisture content of the entraining/detraining parcel (qcko) and the value it would have if just saturated (qrch), according to equation A.14 in Grell (1993) \cite grell_1993 . Their difference is the amount of convective cloud water (qlk = rain + condensate). Determine the portion of convective cloud water that remains suspended and the portion that is converted into convective precipitation (pwo). Calculate and save the negative cloud work function (aa1) due to water loading. Above the level of minimum moist static energy, some of the cloud water is detrained into the grid-scale cloud water from every cloud layer with a rate of 0.0005 \f$m^{-1}\f$ (dellal). + do k = 2, km1 + do i = 1, im + if (cnvflg(i)) then + if(k.gt.kb(i).and.k.lt.ktcon(i)) then + dz = zi(i,k) - zi(i,k-1) + gamma = el2orc * qeso(i,k) / (to(i,k)**2) + qrch = qeso(i,k) + & + gamma * dbyo(i,k) / (hvap * (1. + gamma)) +!j + tem = 0.5 * (xlamue(i,k)+xlamue(i,k-1)) * dz + tem1 = 0.5 * xlamud(i) * dz + factor = 1. + tem - tem1 + qcko(i,k) = ((1.-tem1)*qcko(i,k-1)+tem*0.5* + & (qo(i,k)+qo(i,k-1)))/factor + qrcko(i,k) = qcko(i,k) +!j + dq = eta(i,k) * (qcko(i,k) - qrch) +! +! rhbar(i) = rhbar(i) + qo(i,k) / qeso(i,k) +! +! below lfc check if there is excess moisture to release latent heat +! + if(k.ge.kbcon(i).and.dq.gt.0.) then + etah = .5 * (eta(i,k) + eta(i,k-1)) + if(ncloud.gt.0.) then + dp = 1000. * del(i,k) + qlk = dq / (eta(i,k) + etah * (c0 + c1) * dz) + dellal(i,k) = etah * c1 * dz * qlk * g / dp + else + qlk = dq / (eta(i,k) + etah * c0 * dz) + endif + aa1(i) = aa1(i) - dz * g * qlk + qcko(i,k)= qlk + qrch + pwo(i,k) = etah * c0 * dz * qlk + cnvwt(i,k) = etah * qlk * g / dp + endif + endif + endif + enddo + enddo +! +! calculate cloud work function +! +!> - Calculate the cloud work function according to Pan and Wu (1995) \cite pan_and_wu_1995 equation 4: +!! \f[ +!! A_u=\int_{z_0}^{z_t}\frac{g}{c_pT(z)}\frac{\eta}{1 + \gamma}[h(z)-h^*(z)]dz +!! \f] +!! (discretized according to Grell (1993) \cite grell_1993 equation B.10 using B.2 and B.3 of Arakawa and Schubert (1974) \cite arakawa_and_schubert_1974 and assuming \f$\eta=1\f$) where \f$A_u\f$ is the updraft cloud work function, \f$z_0\f$ and \f$z_t\f$ are cloud base and cloud top, respectively, \f$\gamma = \frac{L}{c_p}\left(\frac{\partial \overline{q_s}}{\partial T}\right)_p\f$ and other quantities are previously defined. + do k = 2, km1 + do i = 1, im + if (cnvflg(i)) then + if(k.ge.kbcon(i).and.k.lt.ktcon(i)) then + dz1 = zo(i,k+1) - zo(i,k) + gamma = el2orc * qeso(i,k) / (to(i,k)**2) + rfact = 1. + delta * cp * gamma + & * to(i,k) / hvap + aa1(i) = aa1(i) + + & dz1 * (g / (cp * to(i,k))) + & * dbyo(i,k) / (1. + gamma) + & * rfact + val = 0. + aa1(i)=aa1(i)+ + & dz1 * g * delta * + & max(val,(qeso(i,k) - qo(i,k))) + endif + endif + enddo + enddo +!> - If the updraft cloud work function is negative, convection does not occur, and the scheme returns to the calling routine. + do i = 1, im + if(cnvflg(i).and.aa1(i).le.0.) cnvflg(i) = .false. + enddo +!! + totflg = .true. + do i=1,im + totflg = totflg .and. (.not. cnvflg(i)) + enddo + if(totflg) return +!! +! +! estimate the onvective overshooting as the level +! where the [aafac * cloud work function] becomes zero, +! which is the final cloud top +! limited to the level of sigma=0.7 +! +!> - Continue calculating the cloud work function past the point of neutral buoyancy to represent overshooting according to Han and Pan (2011) \cite han_and_pan_2011 . Convective overshooting stops when \f$ cA_u < 0\f$ where \f$c\f$ is currently 10%, or when 10% of the updraft cloud work function has been consumed by the stable buoyancy force. Overshooting is also limited to the level where \f$p=0.7p_{sfc}\f$. + do i = 1, im + if (cnvflg(i)) then + aa1(i) = aafac * aa1(i) + endif + enddo +! + do i = 1, im + flg(i) = cnvflg(i) + ktcon1(i) = kbm(i) + enddo + do k = 2, km1 + do i = 1, im + if (flg(i)) then + if(k.ge.ktcon(i).and.k.lt.kbm(i)) then + dz1 = zo(i,k+1) - zo(i,k) + gamma = el2orc * qeso(i,k) / (to(i,k)**2) + rfact = 1. + delta * cp * gamma + & * to(i,k) / hvap + aa1(i) = aa1(i) + + & dz1 * (g / (cp * to(i,k))) + & * dbyo(i,k) / (1. + gamma) + & * rfact + if(aa1(i).lt.0.) then + ktcon1(i) = k + flg(i) = .false. + endif + endif + endif + enddo + enddo +! +! compute cloud moisture property, detraining cloud water +! and precipitation in overshooting layers +! +!> - For the overshooting convection, calculate the moisture content of the entraining/detraining parcel as before. Partition convective cloud water and precipitation and detrain convective cloud water in the overshooting layers. + do k = 2, km1 + do i = 1, im + if (cnvflg(i)) then + if(k.ge.ktcon(i).and.k.lt.ktcon1(i)) then + dz = zi(i,k) - zi(i,k-1) + gamma = el2orc * qeso(i,k) / (to(i,k)**2) + qrch = qeso(i,k) + & + gamma * dbyo(i,k) / (hvap * (1. + gamma)) +!j + tem = 0.5 * (xlamue(i,k)+xlamue(i,k-1)) * dz + tem1 = 0.5 * xlamud(i) * dz + factor = 1. + tem - tem1 + qcko(i,k) = ((1.-tem1)*qcko(i,k-1)+tem*0.5* + & (qo(i,k)+qo(i,k-1)))/factor + qrcko(i,k) = qcko(i,k) +!j + dq = eta(i,k) * (qcko(i,k) - qrch) +! +! check if there is excess moisture to release latent heat +! + if(dq.gt.0.) then + etah = .5 * (eta(i,k) + eta(i,k-1)) + if(ncloud.gt.0.) then + dp = 1000. * del(i,k) + qlk = dq / (eta(i,k) + etah * (c0 + c1) * dz) + dellal(i,k) = etah * c1 * dz * qlk * g / dp + else + qlk = dq / (eta(i,k) + etah * c0 * dz) + endif + qcko(i,k) = qlk + qrch + pwo(i,k) = etah * c0 * dz * qlk + cnvwt(i,k) = etah * qlk * g / dp + endif + endif + endif + enddo + enddo +! +! exchange ktcon with ktcon1 +! + do i = 1, im + if(cnvflg(i)) then + kk = ktcon(i) + ktcon(i) = ktcon1(i) + ktcon1(i) = kk + endif + enddo +! +! this section is ready for cloud water +! + if(ncloud.gt.0) then +! +! compute liquid and vapor separation at cloud top +! +!> - => Separate the total updraft cloud water at cloud top into vapor and condensate. + do i = 1, im + if(cnvflg(i)) then + k = ktcon(i) - 1 + gamma = el2orc * qeso(i,k) / (to(i,k)**2) + qrch = qeso(i,k) + & + gamma * dbyo(i,k) / (hvap * (1. + gamma)) + dq = qcko(i,k) - qrch +! +! check if there is excess moisture to release latent heat +! + if(dq.gt.0.) then + qlko_ktcon(i) = dq + qcko(i,k) = qrch + endif + endif + enddo + endif +! +!--- compute precipitation efficiency in terms of windshear +! +!! - Calculate the wind shear and precipitation efficiency according to equation 58 in Fritsch and Chappell (1980) \cite fritsch_and_chappell_1980 : +!! \f[ +!! E = 1.591 - 0.639\frac{\Delta V}{\Delta z} + 0.0953\left(\frac{\Delta V}{\Delta z}\right)^2 - 0.00496\left(\frac{\Delta V}{\Delta z}\right)^3 +!! \f] +!! where \f$\Delta V\f$ is the integrated horizontal shear over the cloud depth, \f$\Delta z\f$, (the ratio is converted to units of \f$10^{-3} s^{-1}\f$). The variable "edt" is \f$1-E\f$ and is constrained to the range \f$[0,0.9]\f$. + do i = 1, im + if(cnvflg(i)) then + vshear(i) = 0. + endif + enddo + do k = 2, km + do i = 1, im + if (cnvflg(i)) then + if(k.gt.kb(i).and.k.le.ktcon(i)) then + shear= sqrt((uo(i,k)-uo(i,k-1)) ** 2 + & + (vo(i,k)-vo(i,k-1)) ** 2) + vshear(i) = vshear(i) + shear + endif + endif + enddo + enddo + do i = 1, im + if(cnvflg(i)) then + vshear(i) = 1.e3 * vshear(i) / (zi(i,ktcon(i))-zi(i,kb(i))) + e1=1.591-.639*vshear(i) + & +.0953*(vshear(i)**2)-.00496*(vshear(i)**3) + edt(i)=1.-e1 + val = .9 + edt(i) = min(edt(i),val) + val = .0 + edt(i) = max(edt(i),val) + endif + enddo +! +!--- what would the change be, that a cloud with unit mass +!--- will do to the environment? +! +!> ## Calculate the tendencies of the state variables (per unit cloud base mass flux) and the cloud base mass flux. +!> - Calculate the change in moist static energy, moisture mixing ratio, and horizontal winds per unit cloud base mass flux for all layers below cloud top from equations B.14 and B.15 from Grell (1993) \cite grell_1993, and for the cloud top from B.16 and B.17. + do k = 1, km + do i = 1, im + if(cnvflg(i) .and. k .le. kmax(i)) then + dellah(i,k) = 0. + dellaq(i,k) = 0. + dellau(i,k) = 0. + dellav(i,k) = 0. + endif + enddo + enddo +! +!--- changed due to subsidence and entrainment +! + do k = 2, km1 + do i = 1, im + if (cnvflg(i)) then + if(k.gt.kb(i).and.k.lt.ktcon(i)) then + dp = 1000. * del(i,k) + dz = zi(i,k) - zi(i,k-1) +! + dv1h = heo(i,k) + dv2h = .5 * (heo(i,k) + heo(i,k-1)) + dv3h = heo(i,k-1) + dv1q = qo(i,k) + dv2q = .5 * (qo(i,k) + qo(i,k-1)) + dv3q = qo(i,k-1) + dv1u = uo(i,k) + dv2u = .5 * (uo(i,k) + uo(i,k-1)) + dv3u = uo(i,k-1) + dv1v = vo(i,k) + dv2v = .5 * (vo(i,k) + vo(i,k-1)) + dv3v = vo(i,k-1) +! + tem = 0.5 * (xlamue(i,k)+xlamue(i,k-1)) + tem1 = xlamud(i) +!j + dellah(i,k) = dellah(i,k) + + & ( eta(i,k)*dv1h - eta(i,k-1)*dv3h + & - tem*eta(i,k-1)*dv2h*dz + & + tem1*eta(i,k-1)*.5*(hcko(i,k)+hcko(i,k-1))*dz + & ) *g/dp +!j + dellaq(i,k) = dellaq(i,k) + + & ( eta(i,k)*dv1q - eta(i,k-1)*dv3q + & - tem*eta(i,k-1)*dv2q*dz + & + tem1*eta(i,k-1)*.5*(qrcko(i,k)+qcko(i,k-1))*dz + & ) *g/dp +!j + dellau(i,k) = dellau(i,k) + + & ( eta(i,k)*dv1u - eta(i,k-1)*dv3u + & - tem*eta(i,k-1)*dv2u*dz + & + tem1*eta(i,k-1)*.5*(ucko(i,k)+ucko(i,k-1))*dz + & - pgcon*eta(i,k-1)*(dv1u-dv3u) + & ) *g/dp +!j + dellav(i,k) = dellav(i,k) + + & ( eta(i,k)*dv1v - eta(i,k-1)*dv3v + & - tem*eta(i,k-1)*dv2v*dz + & + tem1*eta(i,k-1)*.5*(vcko(i,k)+vcko(i,k-1))*dz + & - pgcon*eta(i,k-1)*(dv1v-dv3v) + & ) *g/dp +!j + endif + endif + enddo + enddo +! +!------- cloud top +! + do i = 1, im + if(cnvflg(i)) then + indx = ktcon(i) + dp = 1000. * del(i,indx) + dv1h = heo(i,indx-1) + dellah(i,indx) = eta(i,indx-1) * + & (hcko(i,indx-1) - dv1h) * g / dp + dv1q = qo(i,indx-1) + dellaq(i,indx) = eta(i,indx-1) * + & (qcko(i,indx-1) - dv1q) * g / dp + dv1u = uo(i,indx-1) + dellau(i,indx) = eta(i,indx-1) * + & (ucko(i,indx-1) - dv1u) * g / dp + dv1v = vo(i,indx-1) + dellav(i,indx) = eta(i,indx-1) * + & (vcko(i,indx-1) - dv1v) * g / dp +! +! cloud water +! + dellal(i,indx) = eta(i,indx-1) * + & qlko_ktcon(i) * g / dp + endif + enddo +! +! mass flux at cloud base for shallow convection +! (grant, 2001) +! +!> - Calculate the cloud base mass flux according to equation 6 in Grant (2001) \cite grant_2001, based on the subcloud layer convective velocity scale, \f$w_*\f$. +!! \f[ +!! M_c = 0.03\rho w_* +!! \f] +!! where \f$M_c\f$ is the cloud base mass flux, \f$\rho\f$ is the air density, and \f$w_*=\left(\frac{g}{T_0}\overline{w'\theta_v'}h\right)^{1/3}\f$ with \f$h\f$ the PBL height and other quantities have been defined previously. + do i= 1, im + if(cnvflg(i)) then + k = kbcon(i) +! ptem = g*sflx(i)*zi(i,k)/t1(i,1) + ptem = g*sflx(i)*hpbl(i)/t1(i,1) + wstar(i) = ptem**h1 + tem = po(i,k)*100. / (rd*t1(i,k)) + xmb(i) = betaw*tem*wstar(i) + xmb(i) = min(xmb(i),xmbmax(i)) + endif + enddo +!> ## For the "feedback control", calculate updated values of the state variables by multiplying the cloud base mass flux and the tendencies calculated per unit cloud base mass flux from the static control. +!! - Recalculate saturation specific humidity. +! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! + do k = 1, km + do i = 1, im + if (cnvflg(i) .and. k .le. kmax(i)) then + qeso(i,k) = 0.01 * fpvs(t1(i,k)) ! fpvs is in pa + qeso(i,k) = eps * qeso(i,k) / (pfld(i,k) + epsm1*qeso(i,k)) + val = 1.e-8 + qeso(i,k) = max(qeso(i,k), val ) + endif + enddo + enddo +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! +!> - Calculate the temperature tendency from the moist static energy and specific humidity tendencies. +!> - Update the temperature, specific humidity, and horiztonal wind state variables by multiplying the cloud base mass flux-normalized tendencies by the cloud base mass flux. +!> - Accumulate column-integrated tendencies. + do i = 1, im + delhbar(i) = 0. + delqbar(i) = 0. + deltbar(i) = 0. + delubar(i) = 0. + delvbar(i) = 0. + qcond(i) = 0. + enddo + do k = 1, km + do i = 1, im + if (cnvflg(i)) then + if(k.gt.kb(i).and.k.le.ktcon(i)) then + dellat = (dellah(i,k) - hvap * dellaq(i,k)) / cp + t1(i,k) = t1(i,k) + dellat * xmb(i) * dt2 + q1(i,k) = q1(i,k) + dellaq(i,k) * xmb(i) * dt2 +! tem = 1./rcs(i) +! u1(i,k) = u1(i,k) + dellau(i,k) * xmb(i) * dt2 * tem +! v1(i,k) = v1(i,k) + dellav(i,k) * xmb(i) * dt2 * tem + u1(i,k) = u1(i,k) + dellau(i,k) * xmb(i) * dt2 + v1(i,k) = v1(i,k) + dellav(i,k) * xmb(i) * dt2 + dp = 1000. * del(i,k) + delhbar(i) = delhbar(i) + dellah(i,k)*xmb(i)*dp/g + delqbar(i) = delqbar(i) + dellaq(i,k)*xmb(i)*dp/g + deltbar(i) = deltbar(i) + dellat*xmb(i)*dp/g + delubar(i) = delubar(i) + dellau(i,k)*xmb(i)*dp/g + delvbar(i) = delvbar(i) + dellav(i,k)*xmb(i)*dp/g + endif + endif + enddo + enddo +!> - Recalculate saturation specific humidity using the updated temperature. + do k = 1, km + do i = 1, im + if (cnvflg(i)) then + if(k.gt.kb(i).and.k.le.ktcon(i)) then + qeso(i,k) = 0.01 * fpvs(t1(i,k)) ! fpvs is in pa + qeso(i,k) = eps * qeso(i,k)/(pfld(i,k) + epsm1*qeso(i,k)) + val = 1.e-8 + qeso(i,k) = max(qeso(i,k), val ) + endif + endif + enddo + enddo +! +!> - Add up column-integrated convective precipitation by multiplying the normalized value by the cloud base mass flux. + do i = 1, im + rntot(i) = 0. + delqev(i) = 0. + delq2(i) = 0. + flg(i) = cnvflg(i) + enddo + do k = km, 1, -1 + do i = 1, im + if (cnvflg(i)) then + if(k.lt.ktcon(i).and.k.gt.kb(i)) then + rntot(i) = rntot(i) + pwo(i,k) * xmb(i) * .001 * dt2 + endif + endif + enddo + enddo +! +! evaporating rain +! +!> - Determine the evaporation of the convective precipitation and update the integrated convective precipitation. +!> - Update state temperature and moisture to account for evaporation of convective precipitation. +!> - Update column-integrated tendencies to account for evaporation of convective precipitation. + do k = km, 1, -1 + do i = 1, im + if (k .le. kmax(i)) then + deltv(i) = 0. + delq(i) = 0. + qevap(i) = 0. + if(cnvflg(i)) then + if(k.lt.ktcon(i).and.k.gt.kb(i)) then + rn(i) = rn(i) + pwo(i,k) * xmb(i) * .001 * dt2 + endif + endif + if(flg(i).and.k.lt.ktcon(i)) then + evef = edt(i) * evfact + if(islimsk(i) == 1) evef=edt(i) * evfactl +! if(islimsk(i) == 1) evef=.07 +! if(islimsk(i) == 1) evef = 0. + qcond(i) = evef * (q1(i,k) - qeso(i,k)) + & / (1. + el2orc * qeso(i,k) / t1(i,k)**2) + dp = 1000. * del(i,k) + if(rn(i).gt.0..and.qcond(i).lt.0.) then + qevap(i) = -qcond(i) * (1.-exp(-.32*sqrt(dt2*rn(i)))) + qevap(i) = min(qevap(i), rn(i)*1000.*g/dp) + delq2(i) = delqev(i) + .001 * qevap(i) * dp / g + endif + if(rn(i).gt.0..and.qcond(i).lt.0..and. + & delq2(i).gt.rntot(i)) then + qevap(i) = 1000.* g * (rntot(i) - delqev(i)) / dp + flg(i) = .false. + endif + if(rn(i).gt.0..and.qevap(i).gt.0.) then + tem = .001 * dp / g + tem1 = qevap(i) * tem + if(tem1.gt.rn(i)) then + qevap(i) = rn(i) / tem + rn(i) = 0. + else + rn(i) = rn(i) - tem1 + endif + q1(i,k) = q1(i,k) + qevap(i) + t1(i,k) = t1(i,k) - elocp * qevap(i) + deltv(i) = - elocp*qevap(i)/dt2 + delq(i) = + qevap(i)/dt2 + delqev(i) = delqev(i) + .001*dp*qevap(i)/g + endif + dellaq(i,k) = dellaq(i,k) + delq(i) / xmb(i) + delqbar(i) = delqbar(i) + delq(i)*dp/g + deltbar(i) = deltbar(i) + deltv(i)*dp/g + endif + endif + enddo + enddo +!j +! do i = 1, im +! if(me.eq.31.and.cnvflg(i)) then +! if(cnvflg(i)) then +! print *, ' shallow delhbar, delqbar, deltbar = ', +! & delhbar(i),hvap*delqbar(i),cp*deltbar(i) +! print *, ' shallow delubar, delvbar = ',delubar(i),delvbar(i) +! print *, ' precip =', hvap*rn(i)*1000./dt2 +! print*,'pdif= ',pfld(i,kbcon(i))-pfld(i,ktcon(i)) +! endif +! enddo +!j + do i = 1, im + if(cnvflg(i)) then + if(rn(i).lt.0..or..not.flg(i)) rn(i) = 0. + ktop(i) = ktcon(i) + kbot(i) = kbcon(i) + kcnv(i) = 0 + endif + enddo +! +! convective cloud water +! +!> - Calculate shallow convective cloud water. + do k = 1, km + do i = 1, im + if (cnvflg(i) .and. rn(i).gt.0.) then + if (k.ge.kbcon(i).and.k.lt.ktcon(i)) then + cnvw(i,k) = cnvwt(i,k) * xmb(i) * dt2 + endif + endif + enddo + enddo + +! +! convective cloud cover +! +!> - Calculate shallow convective cloud cover. + do k = 1, km + do i = 1, im + if (cnvflg(i) .and. rn(i).gt.0.) then + if (k.ge.kbcon(i).and.k.lt.ktcon(i)) then + cnvc(i,k) = 0.04 * log(1. + 675. * eta(i,k) * xmb(i)) + cnvc(i,k) = min(cnvc(i,k), 0.2) + cnvc(i,k) = max(cnvc(i,k), 0.0) + endif + endif + enddo + enddo + +! +! cloud water +! +!> - Separate detrained cloud water into liquid and ice species as a function of temperature only. + if (ncloud.gt.0) then +! + do k = 1, km1 + do i = 1, im + if (cnvflg(i)) then + if (k.gt.kb(i).and.k.le.ktcon(i)) then + tem = dellal(i,k) * xmb(i) * dt2 + tem1 = max(0.0, min(1.0, (tcr-t1(i,k))*tcrf)) + if (qlc(i,k) .gt. -999.0) then + qli(i,k) = qli(i,k) + tem * tem1 ! ice + qlc(i,k) = qlc(i,k) + tem *(1.0-tem1) ! water + else + qli(i,k) = qli(i,k) + tem + endif + endif + endif + enddo + enddo +! + endif +! +! hchuang code change +! +!> - Calculate the updraft shallow convective mass flux. + do k = 1, km + do i = 1, im + if(cnvflg(i)) then + if(k.ge.kb(i) .and. k.lt.ktop(i)) then + ud_mf(i,k) = eta(i,k) * xmb(i) * dt2 + endif + endif + enddo + enddo +!> - Calculate the detrainment mass flux at shallow cloud top. + do i = 1, im + if(cnvflg(i)) then + k = ktop(i)-1 + dt_mf(i,k) = ud_mf(i,k) + endif + enddo +!! + return + + end subroutine shalcnv_run + + end module shalcnv +!> @} +!! @} diff --git a/physics/shalcnv.meta b/physics/shalcnv.meta new file mode 100644 index 000000000..533b9cd0e --- /dev/null +++ b/physics/shalcnv.meta @@ -0,0 +1,466 @@ +[ccpp-arg-table] + name = shalcnv_init + type = scheme +[do_shoc] + standard_name = flag_for_shoc + long_name = flag for SHOC + units = flag + dimensions = () + type = logical + intent = in + optional = F +[shal_cnv] + standard_name = flag_for_shallow_convection + long_name = flag for calling shallow convection + units = flag + dimensions = () + type = logical + intent = in + optional = F +[imfshalcnv] + standard_name = flag_for_mass_flux_shallow_convection_scheme + long_name = flag for mass-flux shallow convection scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F +[imfshalcnv_sas] + standard_name = flag_for_sas_shallow_convection_scheme + long_name = flag for SAS shallow convection scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F + +######################################################################## +[ccpp-arg-table] + name = shalcnv_finalize + type = scheme + +######################################################################## +[ccpp-arg-table] + name = shalcnv_run + type = scheme +[grav] + standard_name = gravitational_acceleration + long_name = gravitational acceleration + units = m s-2 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[cp] + standard_name = specific_heat_of_dry_air_at_constant_pressure + long_name = specific heat of dry air at constant pressure + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[hvap] + standard_name = latent_heat_of_vaporization_of_water_at_0C + long_name = latent heat of evaporation/sublimation + units = J kg-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[rv] + standard_name = gas_constant_water_vapor + long_name = ideal gas constant for water vapor + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[fv] + standard_name = ratio_of_vapor_to_dry_air_gas_constants_minus_one + long_name = (rv/rd) - 1 (rv = ideal gas constant for water vapor) + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[t0c] + standard_name = temperature_at_zero_celsius + long_name = temperature at 0 degrees Celsius + units = K + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[rd] + standard_name = gas_constant_dry_air + long_name = ideal gas constant for dry air + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[cvap] + standard_name = specific_heat_of_water_vapor_at_constant_pressure + long_name = specific heat of water vapor at constant pressure + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[cliq] + standard_name = specific_heat_of_liquid_water_at_constant_pressure + long_name = specific heat of liquid water at constant pressure + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[eps] + standard_name = ratio_of_dry_air_to_water_vapor_gas_constants + long_name = rd/rv + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[epsm1] + standard_name = ratio_of_dry_air_to_water_vapor_gas_constants_minus_one + long_name = (rd/rv) - 1 + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[im] + standard_name = horizontal_loop_extent + long_name = horizontal loop extent + units = count + dimensions = () + type = integer + intent = in + optional = F +[ix] + standard_name = horizontal_dimension + long_name = horizontal_dimension + units = count + dimensions = () + type = integer + intent = in + optional = F +[km] + standard_name = vertical_dimension + long_name = number of vertical levels + units = count + dimensions = () + type = integer + intent = in + optional = F +[jcap] + standard_name = number_of_spectral_wave_trancation_for_sas + long_name = number of spectral wave trancation used only by sascnv and shalcnv + units = count + dimensions = () + type = integer + intent = in + optional = F +[delt] + standard_name = time_step_for_physics + long_name = physics timestep + units = s + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[delp] + standard_name = air_pressure_difference_between_midlayers + long_name = air pressure difference between midlayers + units = Pa + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[prslp] + standard_name = air_pressure + long_name = mean layer pressure + units = Pa + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[psp] + standard_name = surface_air_pressure + long_name = surface pressure + units = Pa + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[phil] + standard_name = geopotential + long_name = geopotential at model layer centers + units = m2 s-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[qlc] + standard_name = cloud_condensed_water_mixing_ratio_convective_transport_tracer + long_name = ratio of mass of cloud water to mass of dry air plus vapor (without condensates) in the convectively transported tracer array + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[qli] + standard_name = ice_water_mixing_ratio_convective_transport_tracer + long_name = ratio of mass of ice water to mass of dry air plus vapor (without condensates) in the convectively transported tracer array + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[q1] + standard_name = water_vapor_specific_humidity_updated_by_physics + long_name = water vapor specific humidity updated by physics + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[t1] + standard_name = air_temperature_updated_by_physics + long_name = temperature updated by physics + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[u1] + standard_name = x_wind_updated_by_physics + long_name = zonal wind updated by physics + units = m s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[v1] + standard_name = y_wind_updated_by_physics + long_name = meridional wind updated by physics + units = m s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[rn] + standard_name = lwe_thickness_of_shallow_convective_precipitation_amount + long_name = shallow convective rainfall amount on physics timestep + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[kbot] + standard_name = vertical_index_at_cloud_base + long_name = index for cloud base + units = index + dimensions = (horizontal_dimension) + type = integer + intent = inout + optional = F +[ktop] + standard_name = vertical_index_at_cloud_top + long_name = index for cloud top + units = index + dimensions = (horizontal_dimension) + type = integer + intent = inout + optional = F +[kcnv] + standard_name = flag_deep_convection + long_name = deep convection: 0=no, 1=yes + units = flag + dimensions = (horizontal_dimension) + type = integer + intent = inout + optional = F +[islimsk] + standard_name = sea_land_ice_mask + long_name = landmask: sea/land/ice=0/1/2 + units = flag + dimensions = (horizontal_dimension) + type = integer + intent = in + optional = F +[dot] + standard_name = omega + long_name = layer mean vertical velocity + units = Pa s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[ncloud] + standard_name = number_of_hydrometeors + long_name = number of hydrometeors + units = count + dimensions = () + type = integer + intent = in + optional = F +[hpbl] + standard_name = atmosphere_boundary_layer_thickness + long_name = pbl height + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[heat] + standard_name = kinematic_surface_upward_sensible_heat_flux + long_name = kinematic surface upward sensible heat flux + units = K m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[evap] + standard_name = kinematic_surface_upward_latent_heat_flux + long_name = kinematic surface upward latent heat flux + units = kg kg-1 m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[ud_mf] + standard_name = instantaneous_atmosphere_updraft_convective_mass_flux + long_name = (updraft mass flux) * delt + units = kg m-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[dt_mf] + standard_name = instantaneous_atmosphere_detrainment_convective_mass_flux + long_name = (detrainment mass flux) * delt + units = kg m-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[cnvw] + standard_name = convective_cloud_water_mixing_ratio + long_name = moist convective cloud water mixing ratio + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[cnvc] + standard_name = convective_cloud_cover + long_name = convective cloud cover + units = frac + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[clam] + standard_name = entrainment_rate_coefficient_shallow_convection + long_name = entrainment rate coefficient for shallow convection + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[c0] + standard_name = rain_conversion_parameter_shallow_convection + long_name = convective rain conversion parameter for shallow convection + units = m-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[c1] + standard_name = detrainment_conversion_parameter_shallow_convection + long_name = convective detrainment conversion parameter for shallow convection + units = m-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[pgcon] + standard_name = momentum_transport_reduction_factor_pgf_shallow_convection + long_name = reduction factor in momentum transport due to shallow convection induced pressure gradient force + units = frac + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F diff --git a/physics/shinhongvdif.F90 b/physics/shinhongvdif.F90 index c5011218b..8053934ac 100644 --- a/physics/shinhongvdif.F90 +++ b/physics/shinhongvdif.F90 @@ -22,57 +22,7 @@ end subroutine shinhongvdif_finalize !! scale-aware Shinhong scheme. !! !> \section arg_table_shinhongvdif_run Argument Table -!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | -!! |----------------|-----------------------------------------------------------------------------|-------------------------------------------------------|---------------|------|-----------|-----------|--------|----------| -!! | ix | horizontal_dimension | horizontal dimension | count | 0 | integer | | in | F | -!! | im | horizontal_loop_extent | horizontal loop extent | count | 0 | integer | | in | F | -!! | km | vertical_dimension | vertical layer dimension | count | 0 | integer | | in | F | -!! | ux | x_wind | x component of layer wind | m s-1 | 2 | real | kind_phys | in | F | -!! | vx | y_wind | y component of layer wind | m s-1 | 2 | real | kind_phys | in | F | -!! | tx | air_temperature | layer mean air temperature | K | 2 | real | kind_phys | in | F | -!! | qx | tracer_concentration | model layer mean tracer concentration | kg kg-1 | 3 | real | kind_phys | in | F | -!! | p2d | air_pressure | mean layer pressure | Pa | 2 | real | kind_phys | in | F | -!! | p2di | air_pressure_at_interface | air pressure at model layer interfaces | Pa | 2 | real | kind_phys | in | F | -!! | pi2d | dimensionless_exner_function_at_model_layers | Exner function at layers | none | 2 | real | kind_phys | in | F | -!! | vtnp | tendency_of_y_wind_due_to_model_physics | updated tendency of the y wind | m s-2 | 2 | real | kind_phys | inout | F | -!! | utnp | tendency_of_x_wind_due_to_model_physics | updated tendency of the x wind | m s-2 | 2 | real | kind_phys | inout | F | -!! | ttnp | tendency_of_air_temperature_due_to_model_physics | updated tendency of the temperature | K s-1 | 2 | real | kind_phys | inout | F | -!! | qtnp | tendency_of_tracers_due_to_model_physics | updated tendency of the tracers due to model physics | kg kg-1 s-1 | 3 | real | kind_phys | inout | F | -!! | ntrac | number_of_tracers | number of tracers | count | 0 | integer | | in | F | -!! | ndiff | number_of_vertical_diffusion_tracers | number of tracers to diffuse vertically | count | 0 | integer | | in | F | -!! | ntcw | index_for_liquid_cloud_condensate | tracer index for cloud condensate (or liquid water) | index | 0 | integer | | in | F | -!! | ntiw | index_for_ice_cloud_condensate | tracer index for ice water | index | 0 | integer | | in | F | -!! | phii | geopotential_at_interface | geopotential at model layer interfaces | m2 s-2 | 2 | real | kind_phys | in | F | -!! | phil | geopotential | geopotential at model layer centers | m2 s-2 | 2 | real | kind_phys | in | F | -!! | psfcpa | surface_air_pressure | surface pressure | Pa | 1 | real | kind_phys | in | F | -!! | zorl | surface_roughness_length | surface roughness length in cm | cm | 1 | real | kind_phys | in | F | -!! | stress | surface_wind_stress | surface wind stress | m2 s-2 | 1 | real | kind_phys | in | F | -!! | hpbl | atmosphere_boundary_layer_thickness | PBL thickness | m | 1 | real | kind_phys | out | F | -!! | psim | Monin-Obukhov_similarity_function_for_momentum | Monin-Obukhov similarity function for momentum | none | 1 | real | kind_phys | in | F | -!! | psih | Monin-Obukhov_similarity_function_for_heat | Monin-Obukhov similarity function for heat | none | 1 | real | kind_phys | in | F | -!! | landmask | sea_land_ice_mask | landmask: sea/land/ice=0/1/2 | flag | 1 | integer | | in | F | -!! | heat | kinematic_surface_upward_sensible_heat_flux | kinematic surface upward sensible heat flux | K m s-1 | 1 | real | kind_phys | in | F | -!! | evap | kinematic_surface_upward_latent_heat_flux | kinematic surface upward latent heat flux | kg kg-1 m s-1 | 1 | real | kind_phys | in | F | -!! | wspd | wind_speed_at_lowest_model_layer | wind speed at lowest model level | m s-1 | 1 | real | kind_phys | in | F | -!! | br | bulk_richardson_number_at_lowest_model_level | bulk Richardson number at the surface | none | 1 | real | kind_phys | in | F | -!! | g | gravitational_acceleration | gravitational acceleration | m s-2 | 0 | real | kind_phys | in | F | -!! | rd | gas_constant_dry_air | ideal gas constant for dry air | J kg-1 K-1 | 0 | real | kind_phys | in | F | -!! | cp | specific_heat_of_dry_air_at_constant_pressure | specific heat of dry air at constant pressure | J kg-1 K-1 | 0 | real | kind_phys | in | F | -!! | rv | gas_constant_water_vapor | ideal gas constant for water vapor | J kg-1 K-1 | 0 | real | kind_phys | in | F | -!! | ep1 | ratio_of_vapor_to_dry_air_gas_constants_minus_one | rv/rd - 1 (rv = ideal gas constant for water vapor) | none | 0 | real | kind_phys | in | F | -!! | ep2 | ratio_of_dry_air_to_water_vapor_gas_constants | rd/rv | none | 0 | real | kind_phys | in | F | -!! | xlv | latent_heat_of_vaporization_of_water_at_0C | latent heat of evaporation/sublimation | J kg-1 | 0 | real | kind_phys | in | F | -!! | dusfc | instantaneous_surface_x_momentum_flux | x momentum flux | Pa | 1 | real | kind_phys | out | F | -!! | dvsfc | instantaneous_surface_y_momentum_flux | y momentum flux | Pa | 1 | real | kind_phys | out | F | -!! | dtsfc | instantaneous_surface_upward_sensible_heat_flux | surface upward sensible heat flux | W m-2 | 1 | real | kind_phys | out | F | -!! | dqsfc | instantaneous_surface_upward_latent_heat_flux | surface upward latent heat flux | W m-2 | 1 | real | kind_phys | out | F | -!! | dt | time_step_for_physics | time step for physics | s | 0 | real | kind_phys | in | F | -!! | kpbl1d | vertical_index_at_top_of_atmosphere_boundary_layer | PBL top model level index | index | 1 | integer | | out | F | -!! | u10 | x_wind_at_10m | x component of wind at 10 m | m s-1 | 1 | real | kind_phys | in | F | -!! | v10 | y_wind_at_10m | y component of wind at 10 m | m s-1 | 1 | real | kind_phys | in | F | -!! | dx | cell_size | size of the grid cell | m | 1 | real | kind_phys | in | F | -!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | -!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | +!! \htmlinclude shinhongvdif_run.html !! !------------------------------------------------------------------------------- subroutine shinhongvdif_run(ix,im,km,ux,vx,tx,qx,p2d,p2di,pi2d, & diff --git a/physics/shinhongvdif.meta b/physics/shinhongvdif.meta new file mode 100644 index 000000000..e859fca4d --- /dev/null +++ b/physics/shinhongvdif.meta @@ -0,0 +1,434 @@ +[ccpp-arg-table] + name = shinhongvdif_run + type = scheme +[ix] + standard_name = horizontal_dimension + long_name = horizontal dimension + units = count + dimensions = () + type = integer + intent = in + optional = F +[im] + standard_name = horizontal_loop_extent + long_name = horizontal loop extent + units = count + dimensions = () + type = integer + intent = in + optional = F +[km] + standard_name = vertical_dimension + long_name = vertical layer dimension + units = count + dimensions = () + type = integer + intent = in + optional = F +[ux] + standard_name = x_wind + long_name = x component of layer wind + units = m s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[vx] + standard_name = y_wind + long_name = y component of layer wind + units = m s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[tx] + standard_name = air_temperature + long_name = layer mean air temperature + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[qx] + standard_name = tracer_concentration + long_name = model layer mean tracer concentration + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension,number_of_tracers) + type = real + kind = kind_phys + intent = in + optional = F +[p2d] + standard_name = air_pressure + long_name = mean layer pressure + units = Pa + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[p2di] + standard_name = air_pressure_at_interface + long_name = air pressure at model layer interfaces + units = Pa + dimensions = (horizontal_dimension,vertical_dimension_plus_one) + type = real + kind = kind_phys + intent = in + optional = F +[pi2d] + standard_name = dimensionless_exner_function_at_model_layers + long_name = Exner function at layers + units = none + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[vtnp] + standard_name = tendency_of_y_wind_due_to_model_physics + long_name = updated tendency of the y wind + units = m s-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[utnp] + standard_name = tendency_of_x_wind_due_to_model_physics + long_name = updated tendency of the x wind + units = m s-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[ttnp] + standard_name = tendency_of_air_temperature_due_to_model_physics + long_name = updated tendency of the temperature + units = K s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[qtnp] + standard_name = tendency_of_tracers_due_to_model_physics + long_name = updated tendency of the tracers due to model physics + units = kg kg-1 s-1 + dimensions = (horizontal_dimension,vertical_dimension,number_of_tracers) + type = real + kind = kind_phys + intent = inout + optional = F +[ntrac] + standard_name = number_of_tracers + long_name = number of tracers + units = count + dimensions = () + type = integer + intent = in + optional = F +[ndiff] + standard_name = number_of_vertical_diffusion_tracers + long_name = number of tracers to diffuse vertically + units = count + dimensions = () + type = integer + intent = in + optional = F +[ntcw] + standard_name = index_for_liquid_cloud_condensate + long_name = tracer index for cloud condensate (or liquid water) + units = index + dimensions = () + type = integer + intent = in + optional = F +[ntiw] + standard_name = index_for_ice_cloud_condensate + long_name = tracer index for ice water + units = index + dimensions = () + type = integer + intent = in + optional = F +[phii] + standard_name = geopotential_at_interface + long_name = geopotential at model layer interfaces + units = m2 s-2 + dimensions = (horizontal_dimension,vertical_dimension_plus_one) + type = real + kind = kind_phys + intent = in + optional = F +[phil] + standard_name = geopotential + long_name = geopotential at model layer centers + units = m2 s-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[psfcpa] + standard_name = surface_air_pressure + long_name = surface pressure + units = Pa + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[zorl] + standard_name = surface_roughness_length + long_name = surface roughness length in cm + units = cm + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[stress] + standard_name = surface_wind_stress + long_name = surface wind stress + units = m2 s-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[hpbl] + standard_name = atmosphere_boundary_layer_thickness + long_name = PBL thickness + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[psim] + standard_name = Monin_Obukhov_similarity_function_for_momentum + long_name = Monin-Obukhov similarity function for momentum + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[psih] + standard_name = Monin_Obukhov_similarity_function_for_heat + long_name = Monin-Obukhov similarity function for heat + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[landmask] + standard_name = sea_land_ice_mask + long_name = landmask: sea/land/ice=0/1/2 + units = flag + dimensions = (horizontal_dimension) + type = integer + intent = in + optional = F +[heat] + standard_name = kinematic_surface_upward_sensible_heat_flux + long_name = kinematic surface upward sensible heat flux + units = K m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[evap] + standard_name = kinematic_surface_upward_latent_heat_flux + long_name = kinematic surface upward latent heat flux + units = kg kg-1 m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[wspd] + standard_name = wind_speed_at_lowest_model_layer + long_name = wind speed at lowest model level + units = m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[br] + standard_name = bulk_richardson_number_at_lowest_model_level + long_name = bulk Richardson number at the surface + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[g] + standard_name = gravitational_acceleration + long_name = gravitational acceleration + units = m s-2 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[rd] + standard_name = gas_constant_dry_air + long_name = ideal gas constant for dry air + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[cp] + standard_name = specific_heat_of_dry_air_at_constant_pressure + long_name = specific heat of dry air at constant pressure + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[rv] + standard_name = gas_constant_water_vapor + long_name = ideal gas constant for water vapor + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[ep1] + standard_name = ratio_of_vapor_to_dry_air_gas_constants_minus_one + long_name = rv/rd - 1 (rv = ideal gas constant for water vapor) + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[ep2] + standard_name = ratio_of_dry_air_to_water_vapor_gas_constants + long_name = rd/rv + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[xlv] + standard_name = latent_heat_of_vaporization_of_water_at_0C + long_name = latent heat of evaporation/sublimation + units = J kg-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[dusfc] + standard_name = instantaneous_surface_x_momentum_flux + long_name = x momentum flux + units = Pa + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[dvsfc] + standard_name = instantaneous_surface_y_momentum_flux + long_name = y momentum flux + units = Pa + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[dtsfc] + standard_name = instantaneous_surface_upward_sensible_heat_flux + long_name = surface upward sensible heat flux + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[dqsfc] + standard_name = instantaneous_surface_upward_latent_heat_flux + long_name = surface upward latent heat flux + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[dt] + standard_name = time_step_for_physics + long_name = time step for physics + units = s + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[kpbl1d] + standard_name = vertical_index_at_top_of_atmosphere_boundary_layer + long_name = PBL top model level index + units = index + dimensions = (horizontal_dimension) + type = integer + intent = out + optional = F +[u10] + standard_name = x_wind_at_10m + long_name = x component of wind at 10 m + units = m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[v10] + standard_name = y_wind_at_10m + long_name = y component of wind at 10 m + units = m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[dx] + standard_name = cell_size + long_name = size of the grid cell + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F diff --git a/physics/tridi.f b/physics/tridi.f index 5ffcc4686..bd44bcc86 100644 --- a/physics/tridi.f +++ b/physics/tridi.f @@ -38,8 +38,11 @@ subroutine tridi1(l,n,cl,cm,cu,r1,au,a1) enddo ! return - end + end subroutine tridi1 + +c----------------------------------------------------------------------- !>\ingroup satmedmf +!>\ingroup satmedmfvdifq !> This subroutine .. subroutine tridi2(l,n,cl,cm,cu,r1,r2,au,a1,a2) cc @@ -78,10 +81,11 @@ subroutine tridi2(l,n,cl,cm,cu,r1,r2,au,a1,a2) enddo c----------------------------------------------------------------------- return - end + end subroutine tridi2 c----------------------------------------------------------------------- !>\ingroup satmedmf +!>\ingroup satmedmfvdifq !> Routine to solve the tridiagonal system to calculate u- and !! v-momentum at \f$ t + \Delta t \f$; part of two-part process to !! calculate time tendencies due to vertical diffusion. @@ -148,4 +152,67 @@ subroutine tridin(l,n,nt,cl,cm,cu,r1,r2,au,a1,a2) enddo c----------------------------------------------------------------------- return - end + end subroutine tridin + +c----------------------------------------------------------------------- +!>\ingroup satmedmf +!>\ingroup satmedmfvdifq +!! This subroutine solves tridiagonal problem for TKE. + subroutine tridit(l,n,nt,cl,cm,cu,rt,au,at) +!----------------------------------------------------------------------- +!! + use machine , only : kind_phys + implicit none + integer is,k,kk,n,nt,l,i + real(kind=kind_phys) fk(l) +!! + real(kind=kind_phys) cl(l,2:n), cm(l,n), cu(l,n-1), & + & rt(l,n*nt), & + & au(l,n-1), at(l,n*nt), & + & fkk(l,2:n-1) +!----------------------------------------------------------------------- + do i=1,l + fk(i) = 1./cm(i,1) + au(i,1) = fk(i)*cu(i,1) + enddo + do k = 1, nt + is = (k-1) * n + do i = 1, l + at(i,1+is) = fk(i) * rt(i,1+is) + enddo + enddo + do k=2,n-1 + do i=1,l + fkk(i,k) = 1./(cm(i,k)-cl(i,k)*au(i,k-1)) + au(i,k) = fkk(i,k)*cu(i,k) + enddo + enddo + do kk = 1, nt + is = (kk-1) * n + do k=2,n-1 + do i=1,l + at(i,k+is) = fkk(i,k)*(rt(i,k+is)-cl(i,k)*at(i,k+is-1)) + enddo + enddo + enddo + do i=1,l + fk(i) = 1./(cm(i,n)-cl(i,n)*au(i,n-1)) + enddo + do k = 1, nt + is = (k-1) * n + do i = 1, l + at(i,n+is) = fk(i)*(rt(i,n+is)-cl(i,n)*at(i,n+is-1)) + enddo + enddo + do kk = 1, nt + is = (kk-1) * n + do k=n-1,1,-1 + do i=1,l + at(i,k+is) = at(i,k+is) - au(i,k)*at(i,k+is+1) + enddo + enddo + enddo +!----------------------------------------------------------------------- + return + end subroutine tridit +!> @} diff --git a/physics/ugwp_driver_v0.F b/physics/ugwp_driver_v0.F new file mode 100644 index 000000000..4edd84a7a --- /dev/null +++ b/physics/ugwp_driver_v0.F @@ -0,0 +1,2094 @@ +!!23456 + module sso_coorde +! +! specific to COORDE-2019 project OGW switches/sensitivity +! to diagnose SSO effects pgwd=1 (OGW is on) =0 (off) +! pgd4=4 (4 timse taub, control pgwd=1) +! + use machine, only: kind_phys + real(kind=kind_phys),parameter :: pgwd = 1._kind_phys + real(kind=kind_phys),parameter :: pgwd4 = 1._kind_phys + end module sso_coorde +! +! +! Routine cires_ugwp_driver_v0 is replaced with cires_ugwp.F90/cires_ugwp_run in CCPP +#if 0 + subroutine cires_ugwp_driver_v0(me, master, + & im, levs, nmtvr, dtp, kdt, imx, do_ugwp, do_tofd, + & cdmbgwd, xlat, xlatd, sinlat, coslat, spgrid, + & ugrs, vgrs, tgrs, qgrs, prsi, prsl, prslk, + & phii, phil, del, hprime, oc, oa4, clx, theta, + & gamm, sigma, elvmax, sgh30, kpbl, + & dusfcg, dvsfcg, gw_dudt, gw_dvdt, gw_dtdt, gw_kdis, + & tau_tofd, tau_mtb, tau_ogw, tau_ngw, + & zmtb, zlwb, zogw, du3dt_mtb,du3dt_ogw, du3dt_tms,rdxzb, + & rain, ntke, tke, lprnt, ipr) +!----------------------------------------------------------- +! Part 1 "old-revised" gfs-gwdps_v0 or "old" gwdps (if do_ugwp=.false.) +! Part 2 non-stationary multi-wave GWs FV3GFS-v0 +! Part 3 Dissipative version of UGWP-tendency application +! (similar to WAM-2017) +!----------------------------------------------------------- + use machine, only : kind_phys + use physcons, only : con_cp, con_g, con_rd, con_rv + + use ugwp_wmsdis_init, only : tamp_mpa, ilaunch + use sso_coorde, only : pgwd, pgwd4 + implicit none +!input + + integer, intent(in) :: me, master + integer, intent(in) :: im, levs, kdt, imx, nmtvr, ntke, ipr + + real(kind=kind_phys), intent(in) :: dtp, cdmbgwd(4) + logical :: do_ugwp, do_tofd, lprnt + integer, intent(in) :: kpbl(im) + real(kind=kind_phys), intent(in), dimension(im) :: xlat, xlatd + &, sgh30, sinlat, coslat, spgrid ! spgrid = tile-area + &, rain + + real(kind=kind_phys), intent(in), dimension(im,levs) :: + &, ugrs, vgrs, tgrs, qgrs, prsl, prslk, phil, del + real(kind=kind_phys), intent(in), dimension(im,levs+1) :: + & phii, prsi + +! real(kind=kind_phys), intent(in) :: oro_stat(im,nmtvr) + real(kind=kind_phys), intent(in), dimension(im) :: hprime, oc + &, theta, gamm, sigma, elvmax + real(kind=kind_phys), intent(in), dimension(im,4) :: oa4, clx + real(kind=kind_phys), intent(in) :: tke(im,levs) +!out + real(kind=kind_phys), dimension(im,levs) :: gw_dudt, gw_dvdt + &, gw_dTdt, gw_kdis + +!-----locals + diagnostics output + + real(kind=kind_phys), dimension(im,levs) :: Pdvdt, Pdudt + &, Pdtdt, Pkdis, ed_dudt, ed_dvdt, ed_dTdt + + real(kind=kind_phys), dimension(im) :: dusfcg, dvsfcg + + real(kind=kind_phys), dimension(im) :: rdxzb, zmtb, + & zlwb, zogw, tau_mtb, tau_ogw, tau_tofd, tau_ngw, turb_fac + real(kind=kind_phys), dimension(im,levs) :: du3dt_mtb, du3dt_ogw + &, du3dt_tms + real(kind=kind_phys), dimension(im) :: tem + +! locals + real(kind=kind_phys) :: rfac, tx1 + integer :: i, j, k, ix +! +! define hprime, oc, oa4, clx, theta, sigma, gamm, elvmax +! +! real(kind=kind_phys), dimension(im) :: hprime, +! & oc, theta, sigma, gamm, elvmax +! real(kind=kind_phys), dimension(im, 4) :: clx, oa4 +! +! switches that activate impact of OGWs and NGWs along with eddy diffusion +! + real(kind=kind_phys), parameter :: pogw=1.0, pngw=1.0, pked=1.0 + &, ompked=1.0-pked +! +! switches for GW-effects: pogw=1 (OGWs) pngw=1 (NGWs) pked=1 (eddy mixing) +! + if (me == master .and. kdt < 2) then + print * + write(6,*) 'FV3GFS execute ugwp_driver_v0 ' +! write(6,*) 'FV3GFS execute ugwp_driver_v0 nmtvr=', nmtvr + write(6,*) ' COORDE EXPER pogw = ' , pogw + write(6,*) ' COORDE EXPER pgwd = ' , pgwd + write(6,*) ' COORDE EXPER pgwd4 = ', pgwd4 + print * + endif + + do i=1,im + zlwb(i) = 0. + enddo +! +! 1) ORO stationary GWs +! ------------------ + + if (do_ugwp .and. nmtvr == 14) then ! calling revised old GFS gravity wave drag + CALL GWDPS_V0(IM, levs, imx, do_tofd, + & Pdvdt, Pdudt, Pdtdt, Pkdis, + & ugrs , vgrs, tgrs, qgrs,KPBL, prsi,del,prsl, + & prslk, phii, phil, DTP,KDT, + & sgh30, HPRIME, OC, OA4, CLX, THETA, + & SIGMA, GAMM, ELVMAX, + & DUSFCg, DVSFCg, xlatd, sinlat, coslat, spgrid, + & cdmbgwd(1:2), me, master, rdxzb, + & zmtb, zogw, tau_mtb, tau_ogw, tau_tofd, + & du3dt_mtb, du3dt_ogw, du3dt_tms) +! + if (me == master .and. kdt < 2) then + print * + write(6,*) 'FV3GFS finished gwdps_v0 in ugwp_driver_v0 ' + print * + endif + else ! calling old GFS gravity wave drag as is + do k=1,levs + do i=1,im + pdvdt(i,k) = 0.0 + pdudt(i,k) = 0.0 + pdtdt(i,k) = 0.0 + pkdis(i,k) = 0.0 + enddo + enddo + if (cdmbgwd(1) > 0.0 .or. cdmbgwd(2) > 0.0) then + call gwdps(im, im, im, levs, Pdvdt, Pdudt, Pdtdt & + &, ugrs, vgrs, tgrs, qgrs & + &, kpbl, prsi, del, prsl, prslk, phii, phil, dtp, kdt& + &, hprime, oc, oa4, clx, theta, sigma, gamm & + &, elvmax, dusfcg, dvsfcg & + &, con_g, con_cp, con_rd, con_rv, imx & + &, nmtvr, cdmbgwd(1:2), me, lprnt, ipr, rdxzb) + endif + + tau_mtb = 0.0 ; tau_ogw = 0.0 ; tau_tofd = 0.0 + du3dt_mtb = 0.0 ; du3dt_ogw = 0.0 ; du3dt_tms= 0.0 + endif +! + if (cdmbgwd(3) > 0.0) then +! 2) non-stationary GWs with GEOS-5/MERRA GW-forcing +! ---------------------------------------------- +!-------- +! GMAO GEOS-5/MERRA GW-forcing lat-dep +!-------- + call slat_geos5_tamp(im, tamp_mpa, xlatd, tau_ngw) + +! call slat_geos5(im, xlatd, tau_ngw) +! + if (abs(1.0-cdmbgwd(3)) > 1.0e-6) then + if (cdmbgwd(4) > 0.0) then + do i=1,im + turb_fac(i) = 0.0 + tem(i) = 0.0 + enddo + if (ntke > 0) then + do k=1,(levs+levs)/3 + do i=1,im + turb_fac(i) = turb_fac(i) + del(i,k) * tke(i,k) + tem(i) = tem(i) + del(i,k) + enddo + enddo + do i=1,im + turb_fac(i) = turb_fac(i) / tem(i) + enddo + endif + rfac = 86400000 / dtp + do i=1,im + tx1 = cdmbgwd(4)*min(10.0, max(turb_fac(i),rain(i)*rfac)) + tau_ngw(i) = tau_ngw(i) * max(0.1, min(5.0, tx1)) + enddo + endif + do i=1,im + tau_ngw(i) = tau_ngw(i) * cdmbgwd(3) + enddo + endif +! + call fv3_ugwp_solv2_v0(im, levs, dtp, + & tgrs, ugrs, vgrs, qgrs, prsl, prsi, + & phil, xlatd, sinlat, coslat, + & gw_dudt, gw_dvdt, gw_dTdt, gw_kdis, + & tau_ngw, me, master, kdt) + + if (me == master .and. kdt < 2) then + print * + write(6,*)'FV3GFS finished fv3_ugwp_v0 in ugwp_driver_v0 ' + write(6,*) ' non-stationary GWs with GMAO/MERRA GW-forcing ' + print * + endif + do k=1,levs + do i=1,im + gw_dtdt(i,k) = pngw*gw_dtdt(i,k) + pogw*Pdtdt(i,k) + gw_dudt(i,k) = pngw*gw_dudt(i,k) + pogw*Pdudt(i,k) + gw_dvdt(i,k) = pngw*gw_dvdt(i,k) + pogw*Pdvdt(i,k) + gw_kdis(i,k) = pngw*gw_kdis(i,k) + pogw*Pkdis(i,k) + enddo + enddo + else + do k=1,levs + do i=1,im + gw_dtdt(i,k) = Pdtdt(i,k) + gw_dudt(i,k) = Pdudt(i,k) + gw_dvdt(i,k) = Pdvdt(i,k) + gw_kdis(i,k) = Pkdis(i,k) + enddo + enddo + endif + + if (pogw == 0.0) then +! zmtb = 0.; zogw =0. + tau_mtb = 0.0 ; tau_ogw = 0.0 ; tau_tofd = 0.0 + du3dt_mtb = 0.0 ; du3dt_ogw = 0.0 ; du3dt_tms= 0.0 + endif + + return + +!============================================================================= +! make "ugwp eddy-diffusion" update for gw_dtdt/gw_dudt/gw_dvdt by solving +! vert diffusion equations & update "Statein%tgrs, Statein%ugrs, Statein%vgrs" +!============================================================================= +! +! 3) application of "eddy"-diffusion to "smooth" UGWP-related tendencies +!------------------------------------------------------------------------------ + do k=1,levs + do i=1,im + ed_dudt(i,k) = 0.0 ; ed_dvdt(i,k) = 0.0 ; ed_dtdt(i,k) = 0.0 + enddo + enddo + + call edmix_ugwp_v0(im, levs, dtp, + & tgrs, ugrs, vgrs, qgrs, del, + & prsl, prsi, phil, prslk, + & gw_dudt, gw_dvdt, gw_dTdt, gw_kdis, + & ed_dudt, ed_dvdt, ed_dTdt, + & me, master, kdt ) + + do k=1,levs + do i=1,im + gw_dtdt(i,k) = gw_dtdt(i,k)*ompked + ed_dtdt(i,k)*pked + gw_dvdt(i,k) = gw_dvdt(i,k)*ompked + ed_dvdt(i,k)*pked + gw_dudt(i,k) = gw_dudt(i,k)*ompked + ed_dudt(i,k)*pked + enddo + enddo + + end subroutine cires_ugwp_driver_v0 +#endif +! +!===================================================================== +! +!ugwp-v0 subroutines: GWDPS_V0 and fv3_ugwp_solv2_v0 +! +!===================================================================== +!>\ingroup cires_ugwp_run +!> @{ +!!Note for the sub-grid scale orography scheme in UGWP-v0: Due to degraded forecast scores of simulations with revised schemes for subgrid-scale orography effects in FV3GFS, EMC reinstalled the original gwdps-code with updated efficiency factors for the mountain blocking and OGW drag. The GFS OGW is described in the separate section (\ref GFS_GWDPS) and its “call” moved into UGWP-driver subroutine. This combination of NGW and OGW schemes was tested in the FV3GFS-L127 medium-range forecasts (15-30 days) for C96, C192, C384 and C768 resolutions and work in progress to introduce the optimal choice for the scale-aware representations of the efficiency factors that will reflect the better simulations of GW activity by FV3 dynamical core at higher horizontal resolutions. With the MERRA-2 VMF function for NGWs (\ref slat_geos5_tamp) and operational OGW drag scheme (\ref GFS_GWDPS), FV3GFS simulations can successfully forecast the recent major mid-winter sudden stratospheric warming (SSW) events of 2018-02-12 and 2018-12-31 (10-14 days before the SSW onset; Yudin et al. 2019 \cite yudin_et_al_2019). The first multi-year (2015-2018) FV3GFS simulations with UGWP-v0 also produce the equatorial QBO-like oscillations in the zonal wind and temperature anomalies. +!! + SUBROUTINE GWDPS_V0(IM, km, imx, do_tofd, + & Pdvdt, Pdudt, Pdtdt, Pkdis, U1,V1,T1,Q1,KPBL, + & PRSI,DEL,PRSL,PRSLK,PHII, PHIL,DTP,KDT, + & sgh30, HPRIME,OC,OA4,CLX4,THETA,vSIGMA,vGAMMA,ELVMAXD, + & DUSFC, DVSFC, xlatd, sinlat, coslat, sparea, + $ cdmbgwd, me, master, rdxzb, + & zmtb, zogw, tau_mtb, tau_ogw, tau_tofd, + & dudt_mtb, dudt_ogw, dudt_tms) +!---------------------------------------- +! ugwp_v0 +! +! modified/revised version of gwdps.f (with bug fixes, tofd, appropriate +! computation of kref for OGW + COORDE diagnostics +! all constants/parameters inside cires_ugwp_initialize.F90 +!---------------------------------------- + + USE MACHINE , ONLY : kind_phys + use ugwp_common , only : rgrav, grav, cpd, rd, rv, rcpd, rcpd2 + &, pi, rad_to_deg, deg_to_rad, pi2 + &, rdi, gor, grcp, gocp, fv, gr2 + &, bnv2min, dw2min, velmin, arad + + use ugwp_oro_init, only : rimin, ric, efmin, efmax + &, hpmax, hpmin, sigfaci => sigfac + &, dpmin, minwnd, hminmt, hncrit + &, RLOLEV, GMAX, VELEPS, FACTOP + &, FRC, CE, CEOFRC, frmax, CG + &, FDIR, MDIR, NWDIR + &, cdmb, cleff, fcrit_gfs, fcrit_mtb + &, n_tofd, ze_tofd, ztop_tofd + + use cires_ugwp_module, only : kxw, max_kdis, max_axyz + use sso_coorde, only : pgwd, pgwd4 +!---------------------------------------- + implicit none + character(len=8) :: strsolver='PSS-1986' ! current operational solver or 'WAM-2017' + integer, intent(in) :: im, km, imx, kdt + integer, intent(in) :: me, master + logical, intent(in) :: do_tofd + real(kind=kind_phys), parameter :: sigfac = 3, sigfacS = 0.5 + real(kind=kind_phys) :: ztopH,zlowH,ph_blk, dz_blk + integer, intent(in) :: KPBL(IM) ! Index for the PBL top layer! + real(kind=kind_phys), intent(in) :: dtp ! time step + real(kind=kind_phys), intent(in) :: cdmbgwd(2) + + real(kind=kind_phys), intent(in), dimension(im,km) :: + & u1, v1, t1, q1, + & del, prsl, prslk, phil + real(kind=kind_phys), intent(in),dimension(im,km+1):: prsi, phii + real(kind=kind_phys), intent(in) :: xlatd(im),sinlat(im), + & coslat(im) + real(kind=kind_phys), intent(in) :: sparea(im) + + real(kind=kind_phys), intent(in) :: OC(IM), OA4(im,4), CLX4(im,4) + real(kind=kind_phys), intent(in) :: HPRIME(IM), sgh30(IM) + real(kind=kind_phys), intent(in) :: ELVMAXD(IM), THETA(IM) + real(kind=kind_phys), intent(in) :: vSIGMA(IM), vGAMMA(IM) + real(kind=kind_phys) :: SIGMA(IM), GAMMA(IM) + +!output -phys-tend + real(kind=kind_phys),dimension(im,km),intent(out) :: + & Pdvdt, Pdudt, Pkdis, Pdtdt +! output - diag-coorde + &, dudt_mtb, dudt_ogw, dudt_tms +! + real(kind=kind_phys),dimension(im) :: RDXZB, zmtb, zogw + &, tau_ogw, tau_mtb, tau_tofd + &, dusfc, dvsfc +! +!--------------------------------------------------------------------- +! # of permissible sub-grid orography hills for "any" resolution < 25 +! correction for "elliptical" hills based on shilmin-area =sgrid/25 +! 4.*gamma*b_ell*b_ell >= shilmin +! give us limits on [b_ell & gamma *b_ell] > 5 km =sso_min +! gamma_min = 1/4*shilmin/sso_min/sso_min +!23.01.2019: cdmb = 4.*192/768_c192=1 x 0.5 +! 192: cdmbgwd = 0.5, 2.5 +! cleff = 2.5*0.5e-5 * sqrt(192./768.) => Lh_eff = 1004. km +! 6*dx = 240 km 8*dx = 320. ~ 3-5 more effective +!--------------------------------------------------------------------- + real(kind=kind_phys) :: gammin = 0.00999999 + real(kind=kind_phys), parameter :: nhilmax = 25. + real(kind=kind_phys), parameter :: sso_min = 3000. + logical, parameter :: do_adjoro = .true. +! + real(kind=kind_phys) :: shilmin, sgrmax, sgrmin + real(kind=kind_phys) :: belpmin, dsmin, dsmax +! real(kind=kind_phys) :: arhills(im) ! not used why do we need? + real(kind=kind_phys) :: xlingfs + +! +! locals +! mean flow + real(kind=kind_phys), dimension(im,km) :: RI_N, BNV2, RO + &, VTK, VTJ, VELCO +!mtb + real(kind=kind_phys), dimension(im) :: OA, CLX , elvmax, wk + &, PE, EK, UP + + real(kind=kind_phys), dimension(im,km) :: DB, ANG, UDS + + real(kind=kind_phys) :: ZLEN, DBTMP, R, PHIANG, DBIM, ZR + real(kind=kind_phys) :: ENG0, ENG1, COSANG2, SINANG2 + real(kind=kind_phys) :: bgam, cgam, gam2, rnom, rdem +! +! TOFD +! Some constants now in "use ugwp_oro_init" + "use ugwp_common" +! +!================== + real(kind=kind_phys) :: unew, vnew, zpbl, sigflt, zsurf + real(kind=kind_phys), dimension(km) :: utofd1, vtofd1 + &, epstofd1, krf_tofd1 + &, up1, vp1, zpm + real(kind=kind_phys),dimension(im, km) :: axtms, aytms +! +! OGW +! + LOGICAL ICRILV(IM) +! + real(kind=kind_phys), dimension(im) :: XN, YN, UBAR, VBAR, ULOW, + & ROLL, bnv2bar, SCOR, DTFAC, XLINV, DELKS, DELKS1 +! + real(kind=kind_phys) :: TAUP(IM,km+1), TAUD(IM,km) + real(kind=kind_phys) :: taub(im), taulin(im), heff, hsat, hdis + + integer, dimension(im) :: kref, idxzb, ipt, kreflm, + & iwklm, iwk, izlow +! +!check what we need +! + real(kind=kind_phys) :: bnv, fr, ri_gw + &, brvf, tem, tem1, tem2, temc, temv + &, ti, rdz, dw2, shr2, bvf2 + &, rdelks, efact, coefm, gfobnv + &, scork, rscor, hd, fro, sira + &, dtaux, dtauy, pkp1log, pklog + &, grav2, rcpdt, windik, wdir + &, sigmin, dxres,sigres,hdxres + &, cdmb4, mtbridge + &, kxridge, inv_b2eff, zw1, zw2 + &, belps, aelps, nhills, selps + + integer :: kmm1, kmm2, lcap, lcapp1 + &, npt, kbps, kbpsp1,kbpsm1 + &, kmps, idir, nwd, klcap, kp1, kmpbl, kmll + &, k_mtb, k_zlow, ktrial, klevm1, i, j, k +! + rcpdt = 1.0 / (cpd*dtp) + grav2 = grav + grav +! +! mtb-blocking sigma_min and dxres => cires_initialize +! + sgrmax = maxval(sparea) ; sgrmin = minval(sparea) + dsmax = sqrt(sgrmax) ; dsmin = sqrt(sgrmin) + + dxres = pi2*arad/float(IMX) + hdxres = 0.5*dxres +! shilmin = sgrmin/nhilmax ! not used - Moorthi + +! gammin = min(sso_min/dsmax, 1.) ! Moorthi - with this results are not reproducible + gammin = min(sso_min/dxres, 1.) ! Moorthi + +! sigmin = 2.*hpmin/dsmax !dxres ! Moorthi - this will not reproduce + sigmin = 2.*hpmin/dxres !dxres + +! if (kdt == 1) then +! print *, sgrmax, sgrmin , ' min-max sparea ' +! print *, 'sigmin-hpmin-dsmax', sigmin, hpmin, dsmax +! print *, 'dxres/dsmax ', dxres, dsmax +! print *, ' shilmin gammin ', shilmin, gammin +! endif + + kxridge = float(IMX)/arad * cdmbgwd(2) + + if (me == master .and. kdt == 1) then + print *, ' gwdps_v0 kxridge ', kxridge + print *, ' gwdps_v0 scale2 ', cdmbgwd(2) + print *, ' gwdps_v0 IMX ', imx + print *, ' gwdps_v0 GAM_MIN ', gammin + print *, ' gwdps_v0 SSO_MIN ', sso_min + endif + + do i=1,im + idxzb(i) = 0 + zmtb(i) = 0.0 + zogw(i) = 0.0 + rdxzb(i) = 0.0 + tau_ogw(i) = 0.0 + tau_mtb(i) = 0.0 + dusfc(i) = 0.0 + dvsfc(i) = 0.0 + tau_tofd(i) = 0.0 +! + ipt(i) = 0 + sigma(i) = max(vsigma(i), sigmin) + gamma(i) = max(vgamma(i), gammin) + enddo + + do k=1,km + do i=1,im + pdvdt(i,k) = 0.0 + pdudt(i,k) = 0.0 + pdtdt(i,k) = 0.0 + pkdis(i,k) = 0.0 + dudt_mtb(i,k) = 0.0 + dudt_ogw(i,k) = 0.0 + dudt_tms(i,k) = 0.0 + enddo + enddo + +! ---- for lm and gwd calculation points + + npt = 0 + do i = 1,im + if ( elvmaxd(i) >= hminmt .and. hprime(i) >= hpmin ) then + + npt = npt + 1 + ipt(npt) = i +! arhills(i) = 1.0 +! + sigres = max(sigmin, sigma(i)) +! if (sigma(i) < sigmin) sigma(i)= sigmin + dxres = sqrt(sparea(i)) + if (2.*hprime(i)/sigres > dxres) sigres=2.*hprime(i)/dxres + aelps = min(2.*hprime(i)/sigres, 0.5*dxres) + if (gamma(i) > 0.0 ) belps = min(aelps/gamma(i),.5*dxres) +! +! small-scale "turbulent" oro-scales < sso_min +! + if( aelps < sso_min .and. do_adjoro) then + +! a, b > sso_min upscale ellipse a/b > 0.1 a>sso_min & h/b=>new_sigm +! + aelps = sso_min + if (belps < sso_min ) then + gamma(i) = 1.0 + belps = aelps*gamma(i) + else + gamma(i) = min(aelps/belps, 1.0) + endif + sigma(i) = 2.*hprime(i)/aelps + gamma(i) = min(aelps/belps, 1.0) + endif + + selps = belps*belps*gamma(i)*4. ! ellipse area of the el-c hill + nhills = min(nhilmax, sparea(i)/selps) +! arhills(i) = max(nhills, 1.0) + +!333 format( ' nhil: ', I6, 4(2x, F9.3), 2(2x, E9.3)) +! if (kdt==1 ) +! & write(6,333) nint(nhills)+1,xlatd(i), hprime(i),aelps*1.e-3, +! & belps*1.e-3, sigma(i),gamma(i) + + endif + enddo + + IF (npt == 0) then +! print *, 'oro-npt = 0 elvmax ', maxval(elvmaxd), hminmt +! print *, 'oro-npt = 0 hprime ', maxval(hprime), hpmin + RETURN ! No gwd/mb calculation done + endif + + + do i=1,npt + iwklm(i) = 2 + IDXZB(i) = 0 + kreflm(i) = 0 + enddo + + do k=1,km + do i=1,im + db(i,k) = 0.0 + ang(i,k) = 0.0 + uds(i,k) = 0.0 + enddo + enddo + + KMM1 = km - 1 ; KMM2 = km - 2 ; KMLL = kmm1 + LCAP = km ; LCAPP1 = LCAP + 1 + + DO I = 1, npt + j = ipt(i) + ELVMAX(J) = min (ELVMAXd(J)*0. + sigfac * hprime(j), hncrit) + izlow(i) = 1 ! surface-level + ENDDO +! + DO K = 1, kmm1 + DO I = 1, npt + j = ipt(i) + ztopH = sigfac * hprime(j) + zlowH = sigfacs* hprime(j) + pkp1log = phil(j,k+1) * rgrav + pklog = phil(j,k) * rgrav +! if (( ELVMAX(j) <= pkp1log) .and. (ELVMAX(j).ge.pklog) ) +! & iwklm(I) = MAX(iwklm(I), k+1 ) + if (( ztopH <= pkp1log) .and. (zTOPH >= pklog) ) + & iwklm(I) = MAX(iwklm(I), k+1 ) +! + if (zlowH <= pkp1log .and. zlowH >= pklog) + & izlow(I) = MAX(izlow(I),k) + ENDDO + ENDDO +! + DO K = 1,km + DO I =1,npt + J = ipt(i) + VTJ(I,K) = T1(J,K) * (1.+FV*Q1(J,K)) + VTK(I,K) = VTJ(I,K) / PRSLK(J,K) + RO(I,K) = RDI * PRSL(J,K) / VTJ(I,K) ! DENSITY mid-levels + TAUP(I,K) = 0.0 + ENDDO + ENDDO +! +! check RI_N or RI_MF computation +! + DO K = 1,kmm1 + DO I =1,npt + J = ipt(i) + RDZ = grav / (phil(j,k+1) - phil(j,k)) + TEM1 = U1(J,K) - U1(J,K+1) + TEM2 = V1(J,K) - V1(J,K+1) + DW2 = TEM1*TEM1 + TEM2*TEM2 + SHR2 = MAX(DW2,DW2MIN) * RDZ * RDZ +! TI = 2.0 / (T1(J,K)+T1(J,K+1)) +! BVF2 = Grav*(GOCP+RDZ*(VTJ(I,K+1)-VTJ(I,K)))* TI +! RI_N(I,K) = MAX(BVF2/SHR2,RIMIN) ! Richardson number +! + BVF2 = grav2 * RDZ * (VTK(I,K+1)-VTK(I,K)) + & / (VTK(I,K+1)+VTK(I,K)) + bnv2(i,k+1) = max( BVF2, bnv2min ) + RI_N(I,K+1) = Bnv2(i,k)/SHR2 ! Richardson number consistent with BNV2 +! +! add here computation for Ktur and OGW-dissipation fro VE-GFS +! + ENDDO + ENDDO + K = 1 + DO I = 1, npt + bnv2(i,k) = bnv2(i,k+1) + ENDDO +! +! level iwklm =>phil(j,k)/g < sigfac * hprime(j) < phil(j,k+1)/g +! + DO I = 1, npt + J = ipt(i) + k_zlow = izlow(I) + if (k_zlow == iwklm(i)) k_zlow = 1 + DELKS(I) = 1.0 / (PRSI(J,k_zlow) - PRSI(J,iwklm(i))) +! DELKS1(I) = 1.0 /(PRSL(J,k_zlow) - PRSL(J,iwklm(i))) + UBAR (I) = 0.0 + VBAR (I) = 0.0 + ROLL (I) = 0.0 + PE (I) = 0.0 + EK (I) = 0.0 + BNV2bar(I) = 0.0 + ENDDO +! + DO I = 1, npt + k_zlow = izlow(I) + if (k_zlow == iwklm(i)) k_zlow = 1 + DO K = k_zlow, iwklm(I)-1 ! Kreflm(I)= iwklm(I)-1 + J = ipt(i) ! laye-aver Rho, U, V + RDELKS = DEL(J,K) * DELKS(I) + UBAR(I) = UBAR(I) + RDELKS * U1(J,K) ! trial Mean U below + VBAR(I) = VBAR(I) + RDELKS * V1(J,K) ! trial Mean V below + ROLL(I) = ROLL(I) + RDELKS * RO(I,K) ! trial Mean RO below +! + BNV2bar(I) = BNV2bar(I) + .5*(BNV2(I,K)+BNV2(I,K+1))* RDELKS + ENDDO + ENDDO +! + DO I = 1, npt + J = ipt(i) +! +! integrate from Ztoph = sigfac*hprime down to Zblk if exists +! find ph_blk, dz_blk like in LM-97 and IFS +! + ph_blk =0. + DO K = iwklm(I), 1, -1 + PHIANG = atan2(V1(J,K),U1(J,K))*RAD_TO_DEG + ANG(I,K) = ( THETA(J) - PHIANG ) + if ( ANG(I,K) > 90. ) ANG(I,K) = ANG(I,K) - 180. + if ( ANG(I,K) < -90. ) ANG(I,K) = ANG(I,K) + 180. + ANG(I,K) = ANG(I,K) * DEG_TO_RAD + UDS(I,K) = + & MAX(SQRT(U1(J,K)*U1(J,K) + V1(J,K)*V1(J,K)), velmin) +! + IF (IDXZB(I) == 0 ) then + dz_blk = ( PHII(J,K+1) - PHII(J,K) ) *rgrav + PE(I) = PE(I) + BNV2(I,K) * + & ( ELVMAX(J) - phil(J,K)*rgrav ) * dz_blk + + UP(I) = max(UDS(I,K) * cos(ANG(I,K)), velmin) + EK(I) = 0.5 * UP(I) * UP(I) + + ph_blk = ph_blk + dz_blk*sqrt(BNV2(I,K))/UP(I) + +! --- Dividing Stream lime is found when PE =exceeds EK. oper-l GFS +! IF ( PE(I) >= EK(I) ) THEN + IF ( ph_blk >= fcrit_gfs ) THEN + IDXZB(I) = K + zmtb (J) = PHIL(J, K)*rgrav + RDXZB(J) = real(k, kind=kind_phys) + ENDIF + + ENDIF + ENDDO +! +! Alternative expression: ZMTB = max(Heff*(1. -Fcrit_gfs/Fr), 0) +! fcrit_gfs/fr +! + goto 788 + + BNV = SQRT( BNV2bar(I) ) + heff = 2.*min(HPRIME(J),hpmax) + zw2 = UBAR(I)*UBAR(I)+VBAR(I)*VBAR(I) + Ulow(i) = sqrt(max(zw2,dw2min)) + Fr = heff*bnv/Ulow(i) + ZW1 = max(Heff*(1. -fcrit_gfs/fr), 0.0) + zw2 = phil(j,2)*rgrav + if (Fr > fcrit_gfs .and. zw1 > zw2 ) then + do k=2, kmm1 + pkp1log = phil(j,k+1) * rgrav + pklog = phil(j,k) * rgrav + if (zw1 <= pkp1log .and. zw1 >= pklog) exit + enddo + IDXZB(I) = K + zmtb (J) = PHIL(J, K)*rgrav + else + zmtb (J) = 0. + IDXZB(I) = 0 + endif +788 continue + ENDDO + +! +! --- The drag for mtn blocked flow +! + cdmb4 = 0.25*cdmb + DO I = 1, npt + J = ipt(i) +! + IF ( IDXZB(I) > 0 ) then +! (4.16)-IFS + gam2 = gamma(j)*gamma(j) + BGAM = 1.0 - 0.18*gamma(j) - 0.04*gam2 + CGAM = 0.48*gamma(j) + 0.30*gam2 + DO K = IDXZB(I)-1, 1, -1 + + ZLEN = SQRT( ( PHIL(J,IDXZB(I)) - PHIL(J,K) ) / + & ( PHIL(J,K ) + Grav * hprime(J) ) ) + + tem = cos(ANG(I,K)) + COSANG2 = tem * tem + SINANG2 = 1.0 - COSANG2 +! +! cos =1 sin =0 => 1/R= gam ZR = 2.-gam +! cos =0 sin =1 => 1/R= 1/gam ZR = 2.- 1/gam +! + rdem = COSANG2 + GAM2 * SINANG2 + rnom = COSANG2*GAM2 + SINANG2 +! +! metOffice Dec 2010 +! correction of H. Wells & A. Zadra for the +! aspect ratio of the hill seen by MF +! (1/R , R-inverse below: 2-R) + + rdem = max(rdem, 1.e-6) + R = sqrt(rnom/rdem) + ZR = MAX( 2. - R, 0. ) + + sigres = max(sigmin, sigma(J)) + if (hprime(J)/sigres > dxres) sigres = hprime(J)/dxres + mtbridge = ZR * sigres*ZLEN / hprime(J) +! (4.15)-IFS +! DBTMP = CDmb4 * mtbridge * +! & MAX(cos(ANG(I,K)), gamma(J)*sin(ANG(I,K))) +! (4.16)-IFS + DBTMP = CDmb4*mtbridge*(bgam* COSANG2 +cgam* SINANG2) + DB(I,K)= DBTMP * UDS(I,K) + ENDDO +! + endif + ENDDO +! +!............................. +!............................. +! end mtn blocking section +!............................. +!............................. +! +!--- Orographic Gravity Wave Drag Section +! +! Scale cleff between IM=384*2 and 192*2 for T126/T170 and T62 +! inside "cires_ugwp_initialize.F90" now +! + KMPBL = km / 2 + iwk(1:npt) = 2 +! +! METO-scheme: +! k_mtb = max(k_zmtb, k_n*hprime/2] to reduce diurnal variations taub_ogw +! + DO K=3,KMPBL + DO I=1,npt + j = ipt(i) + tem = (prsi(j,1) - prsi(j,k)) + if (tem < dpmin) iwk(i) = k ! dpmin=50 mb + +!=============================================================== +! lev=111 t=311.749 hkm=0.430522 Ps-P(iwk)=52.8958 +! below "Hprime" - source of OGWs and below Zblk !!! +! 27 2 kpbl ~ 1-2 km < Hprime +!=============================================================== + enddo + enddo +! +! iwk - adhoc GFS-parameter to select OGW-launch level between +! LEVEL ~0.4-0.5 KM from surface or/and PBL-top +! in UGWP-V1: options to modify as Htop ~ (2-3)*Hprime > Zmtb +! in UGWP-V0 we ensured that : Zogw > Zmtb +! + + KBPS = 1 + KMPS = km + K_mtb = 1 + DO I=1,npt + J = ipt(i) + K_mtb = max(1, idxzb(i)) + + kref(I) = MAX(IWK(I), KPBL(J)+1 ) ! reference level PBL or smt-else ???? + kref(I) = MAX(kref(i), iwklm(i) ) ! iwklm => sigfac*hprime + + if (kref(i) <= idxzb(i)) kref(i) = idxzb(i) + 1 ! layer above zmtb + KBPS = MAX(KBPS, kref(I)) + KMPS = MIN(KMPS, kref(I)) +! + DELKS(I) = 1.0 / (PRSI(J,k_mtb) - PRSI(J,kref(I))) + UBAR (I) = 0.0 + VBAR (I) = 0.0 + ROLL (I) = 0.0 + BNV2bar(I)= 0.0 + ENDDO +! + KBPSP1 = KBPS + 1 + KBPSM1 = KBPS - 1 + K_mtb = 1 +! + DO I = 1,npt + K_mtb = max(1, idxzb(i)) + DO K = k_mtb,KBPS !KBPS = MAX(kref) ;KMPS= MIN(kref) + IF (K < kref(I)) THEN + J = ipt(i) + RDELKS = DEL(J,K) * DELKS(I) + UBAR(I) = UBAR(I) + RDELKS * U1(J,K) ! Mean U below kref + VBAR(I) = VBAR(I) + RDELKS * V1(J,K) ! Mean V below kref + ROLL(I) = ROLL(I) + RDELKS * RO(I,K) ! Mean RO below kref + BNV2bar(I) = BNV2bar(I) + .5*(BNV2(I,K)+BNV2(I,K+1))* RDELKS + ENDIF + ENDDO + ENDDO +! +! orographic asymmetry parameter (OA), and (CLX) + DO I = 1,npt + J = ipt(i) + wdir = atan2(UBAR(I),VBAR(I)) + pi + idir = mod(nint(fdir*wdir),mdir) + 1 + nwd = nwdir(idir) + OA(I) = (1-2*INT( (NWD-1)/4 )) * OA4(J,MOD(NWD-1,4)+1) + CLX(I) = CLX4(J,MOD(NWD-1,4)+1) + ENDDO +! + DO I = 1,npt + DTFAC(I) = 1.0 + ICRILV(I) = .FALSE. ! INITIALIZE CRITICAL LEVEL CONTROL VECTOR + ULOW(I) = MAX(SQRT(UBAR(I)*UBAR(I)+VBAR(I)*VBAR(I)),velmin) + XN(I) = UBAR(I) / ULOW(I) + YN(I) = VBAR(I) / ULOW(I) + ENDDO +! + DO K = 1, kmm1 + DO I = 1,npt + J = ipt(i) + VELCO(I,K) = 0.5 * ((U1(J,K)+U1(J,K+1))*XN(I) + & + (V1(J,K)+V1(J,K+1))*YN(I)) + ENDDO + ENDDO +! +!------------------ +! v0: incorporates latest modifications for kxridge and heff/hsat +! and taulin for Fr <=fcrit_gfs +! and concept of "clipped" hill if zmtb > 0. to make +! the integrated "tau_sso = tau_ogw +tau_mtb" close to reanalysis data +! it is still used the "single-OGWave"-approach along ULOW-upwind +! +! in contrast to the 2-orthogonal wave (2OTW) schemes of IFS/METO/E-CANADA +! 2OTW scheme requires "aver angle" and wind projections on 2 axes of ellipse a-b +! with 2-stresses: taub_a & taub_b from AS of Phillips et al. (1984) +!------------------ + taub(:) = 0. ; taulin(:)= 0. + DO I = 1,npt + J = ipt(i) + BNV = SQRT( BNV2bar(I) ) + heff = min(HPRIME(J),hpmax) + + if( zmtb(j) > 0.) heff = max(sigfac*heff-zmtb(j), 0.)/sigfac + if (heff <= 0) cycle + + hsat = fcrit_gfs*ULOW(I)/bnv + heff = min(heff, hsat) + + FR = min(BNV * heff /ULOW(I), FRMAX) +! + EFACT = (OA(I) + 2.) ** (CEOFRC*FR) + EFACT = MIN( MAX(EFACT,EFMIN), EFMAX ) +! + COEFM = (1. + CLX(I)) ** (OA(I)+1.) +! + XLINV(I) = COEFM * CLEFF ! effective kxw for Lin-wave + XLINGFS = COEFM * CLEFF +! + TEM = FR * FR * OC(J) + GFOBNV = GMAX * TEM / ((TEM + CG)*BNV) +! +!new specification of XLINV(I) & taulin(i) + + sigres = max(sigmin, sigma(J)) + if (heff/sigres > hdxres) sigres = heff/hdxres + inv_b2eff = 0.5*sigres/heff + kxridge = 1.0 / sqrt(sparea(J)) + XLINV(I) = XLINGFS !or max(kxridge, inv_b2eff) ! 6.28/Lx ..0.5*sigma(j)/heff = 1./Lridge + taulin(i) = 0.5*ROLL(I)*XLINV(I)*BNV*ULOW(I)* + & heff*heff*pgwd4 + + if ( FR > fcrit_gfs ) then + TAUB(I) = XLINV(I) * ROLL(I) * ULOW(I) * ULOW(I) + & * ULOW(I) * GFOBNV * EFACT *pgwd4 ! nonlinear FLUX Tau0...XLINV(I) +! + else +! + TAUB(I) = XLINV(I) * ROLL(I) * ULOW(I) * ULOW(I) + & * ULOW(I) * GFOBNV * EFACT *pgwd4 +! +! TAUB(I) = taulin(i) ! linear flux for FR <= fcrit_gfs +! + endif +! +! + K = MAX(1, kref(I)-1) + TEM = MAX(VELCO(I,K)*VELCO(I,K), dw2min) + SCOR(I) = BNV2(I,K) / TEM ! Scorer parameter below ref level +! +! diagnostics for zogw > zmtb +! + zogw(J) = PHII(j, kref(I)) *rgrav + ENDDO +! +!----SET UP BOTTOM VALUES OF STRESS +! + DO K = 1, KBPS + DO I = 1,npt + IF (K <= kref(I)) TAUP(I,K) = TAUB(I) + ENDDO + ENDDO + + if (strsolver == 'PSS-1986') then + +!====================================================== +! V0-GFS OROGW-solver of Palmer et al 1986 -"PSS-1986" +! in V1-OROGW LINSATDIS of "WAM-2017" +! with LLWB-mechanism for +! rotational/non-hydrostat OGWs important for +! HighRES-FV3GFS with dx < 10 km +!====================================================== + + DO K = KMPS, KMM1 ! Vertical Level Loop + KP1 = K + 1 + DO I = 1, npt +! + IF (K >= kref(I)) THEN + ICRILV(I) = ICRILV(I) .OR. ( RI_N(I,K) < RIC) + & .OR. (VELCO(I,K) <= 0.0) + ENDIF + ENDDO +! + DO I = 1,npt + IF (K >= kref(I)) THEN + IF (.NOT.ICRILV(I) .AND. TAUP(I,K) > 0.0 ) THEN + TEMV = 1.0 / max(VELCO(I,K), velmin) +! + IF (OA(I) > 0. .AND. kp1 < kref(i)) THEN + SCORK = BNV2(I,K) * TEMV * TEMV + RSCOR = MIN(1.0, SCORK / SCOR(I)) + SCOR(I) = SCORK + ELSE + RSCOR = 1. + ENDIF +! + BRVF = SQRT(BNV2(I,K)) ! Brent-Vaisala Frequency interface +! TEM1 = XLINV(I)*(RO(I,KP1)+RO(I,K))*BRVF*VELCO(I,K)*0.5 + + TEM1 = XLINV(I)*(RO(I,KP1)+RO(I,K))*BRVF*0.5 + & * max(VELCO(I,K), velmin) + HD = SQRT(TAUP(I,K) / TEM1) + FRO = BRVF * HD * TEMV +! +! RIM is the "WAVE"-RICHARDSON NUMBER BY PALMER,Shutts, Swinbank 1986 +! + + TEM2 = SQRT(ri_n(I,K)) + TEM = 1. + TEM2 * FRO + RI_GW = ri_n(I,K) * (1.0-FRO) / (TEM * TEM) +! +! CHECK STABILITY TO EMPLOY THE 'dynamical SATURATION HYPOTHESIS' +! OF PALMER,Shutts, Swinbank 1986 +! ---------------------- + IF (RI_GW <= RIC .AND. + & (OA(I) <= 0. .OR. kp1 >= kref(i) )) THEN + TEMC = 2.0 + 1.0 / TEM2 + HD = VELCO(I,K) * (2.*SQRT(TEMC)-TEMC) / BRVF + TAUP(I,KP1) = TEM1 * HD * HD + ELSE + TAUP(I,KP1) = TAUP(I,K) * RSCOR + ENDIF + taup(i,kp1) = min(taup(i,kp1), taup(i,k)) + ENDIF + ENDIF + ENDDO + ENDDO +! +! zero momentum deposition at the top model layer +! + taup(1:npt,km+1) = taup(1:npt,km) +! +! Calculate wave acc-n: - (grav)*d(tau)/d(p) = taud +! + DO K = 1,KM + DO I = 1,npt + TAUD(I,K) = GRAV*(TAUP(I,K+1) - TAUP(I,K))/DEL(ipt(I),K) + ENDDO + ENDDO +! +!------scale MOMENTUM DEPOSITION AT TOP TO 1/2 VALUE +! it is zero now +! DO I = 1,npt +! TAUD(I, km) = TAUD(I,km) * FACTOP +! ENDDO + +!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +!------IF THE GRAVITY WAVE DRAG WOULD FORCE A CRITICAL LINE IN THE +!------LAYERS BELOW SIGMA=RLOLEV DURING THE NEXT DELTIM TIMESTEP, +!------THEN ONLY APPLY DRAG UNTIL THAT CRITICAL LINE IS REACHED. +! Empirical implementation of the LLWB-mechanism: Lower Level Wave Breaking +! by limiting "Ax = Dtfac*Ax" due to possible LLWB around Kref and 500 mb +! critical line [V - Ax*dtp = 0.] is smt like "LLWB" for stationary OGWs +!2019: this option limits sensitivity of taux/tauy to increase/decreaseof TAUB +!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + DO K = 1,KMM1 + DO I = 1,npt + IF (K >= kref(I) .and. PRSI(ipt(i),K) >= RLOLEV) THEN + + IF(TAUD(I,K) /= 0.) THEN + TEM = DTP * TAUD(I,K) + DTFAC(I) = MIN(DTFAC(I),ABS(VELCO(I,K)/TEM)) +! DTFAC(I) = 1.0 + ENDIF + ENDIF + ENDDO + ENDDO +! +!--------------------------- OROGW-solver of GFS PSS-1986 +! + else +! +!--------------------------- OROGW-solver of WAM2017 +! +! sigres = max(sigmin, sigma(J)) +! if (heff/sigres.gt.dxres) sigres=heff/dxres +! inv_b2eff = 0.5*sigres/heff +! XLINV(I) = max(kxridge, inv_b2eff) ! 0.5*sigma(j)/heff = 1./Lridge + dtfac(:) = 1.0 + + call oro_wam_2017(im, km, npt, ipt, kref, kdt, me, master, + & dtp, dxres, taub, u1, v1, t1, xn, yn, bnv2, ro, prsi,prsL, + & del, sigma, hprime, gamma, theta, + & sinlat, xlatd, taup, taud, pkdis) + + endif ! oro_wam_2017 - LINSATDIS-solver of WAM-2017 +! +!--------------------------- OROGW-solver of WAM2017 +! +! TOFD as in BELJAARS-2004 +! +! --------------------------- + IF( do_tofd ) then + axtms(:,:) = 0.0 ; aytms(:,:) = 0.0 + if ( kdt == 1 .and. me == 0) then + print *, 'VAY do_tofd from surface to ', ztop_tofd + endif + DO I = 1,npt + J = ipt(i) + zpbl =rgrav*phil( j, kpbl(j) ) + + sigflt = min(sgh30(j), 0.3*hprime(j)) ! cannot exceed 30% of LS-SSO + + zsurf = phii(j,1)*rgrav + do k=1,km + zpm(k) = phiL(j,k)*rgrav + up1(k) = u1(j,k) + vp1(k) = v1(j,k) + enddo + + call ugwp_tofd1d(km, sigflt, elvmaxd(j), zsurf, zpbl, + & up1, vp1, zpm, utofd1, vtofd1, epstofd1, krf_tofd1) + + do k=1,km + axtms(j,k) = utofd1(k) + aytms(j,k) = vtofd1(k) +! +! add TOFD to GW-tendencies +! + pdvdt(J,k) = pdvdt(J,k) + aytms(j,k) + pdudt(J,k) = pdudt(J,k) + axtms(j,k) + enddo +!2018-diag + tau_tofd(J) = sum( utofd1(1:km)* del(j,1:km)) + enddo + ENDIF ! do_tofd + +!--------------------------- +! combine oro-drag effects +!--------------------------- +! + diag-3d + + dudt_tms = axtms + tau_ogw = 0. + tau_mtb = 0. + + DO K = 1,KM + DO I = 1,npt + J = ipt(i) +! + ENG0 = 0.5*(U1(j,K)*U1(j,K)+V1(J,K)*V1(J,K)) +! + if ( K < IDXZB(I) .AND. IDXZB(I) /= 0 ) then +! +! if blocking layers -- no OGWs +! + DBIM = DB(I,K) / (1.+DB(I,K)*DTP) + Pdvdt(j,k) = - DBIM * V1(J,K) +Pdvdt(j,k) + Pdudt(j,k) = - DBIM * U1(J,K) +Pdudt(j,k) + ENG1 = ENG0*(1.0-DBIM*DTP)*(1.-DBIM*DTP) + + DUSFC(J) = DUSFC(J) - DBIM * U1(J,K) * DEL(J,K) + DVSFC(J) = DVSFC(J) - DBIM * V1(J,K) * DEL(J,K) +!2018-diag + dudt_mtb(j,k) = -DBIM * U1(J,K) + tau_mtb(j) = tau_mtb(j) + dudt_mtb(j,k)* DEL(J,K) + + else +! +! OGW-s above blocking height +! + TAUD(I,K) = TAUD(I,K) * DTFAC(I) + DTAUX = TAUD(I,K) * XN(I) * pgwd + DTAUY = TAUD(I,K) * YN(I) * pgwd + + Pdvdt(j,k) = DTAUY +Pdvdt(j,k) + Pdudt(j,k) = DTAUX +Pdudt(j,k) + + unew = U1(J,K) + DTAUX*dtp ! Pdudt(J,K)*DTP + vnew = V1(J,K) + DTAUY*dtp ! Pdvdt(J,K)*DTP + ENG1 = 0.5*(unew*unew + vnew*vnew) +! + DUSFC(J) = DUSFC(J) + DTAUX * DEL(J,K) + DVSFC(J) = DVSFC(J) + DTAUY * DEL(J,K) +!2018-diag + dudt_ogw(j,k) = DTAUX + tau_ogw(j) = tau_ogw(j) +DTAUX*DEL(j,k) + endif +! +! local energy deposition SSO-heat +! + Pdtdt(j,k) = max(ENG0-ENG1,0.)*rcpdt + ENDDO + ENDDO +! dusfc w/o tofd sign as in the ERA-I, MERRA and CFSR + DO I = 1,npt + J = ipt(i) + DUSFC(J) = -rgrav * DUSFC(J) + DVSFC(J) = -rgrav * DVSFC(J) + tau_mtb(j) = -rgrav * tau_mtb(j) + tau_ogw(j) = -rgrav * tau_ogw(j) + tau_tofd(J) = -rgrav * tau_tofd(j) + ENDDO + + RETURN + + +!============ debug ------------------------------------------------ + if (kdt <= 2 .and. me == 0) then + print *, 'vgw-oro done gwdps_v0 in ugwp-v0 step-proc ', kdt, me +! + print *, maxval(pdudt)*86400., minval(pdudt)*86400, 'vgw_axoro' + print *, maxval(pdvdt)*86400., minval(pdvdt)*86400, 'vgw_ayoro' +! print *, maxval(kdis), minval(kdis), 'vgw_kdispro m2/sec' + print *, maxval(pdTdt)*86400., minval(pdTdt)*86400,'vgw_epsoro' + print *, maxval(zmtb), ' z_mtb ', maxval(tau_mtb), ' tau_mtb ' + print *, maxval(zogw), ' z_ogw ', maxval(tau_ogw), ' tau_ogw ' +! print *, maxval(tau_tofd), ' tau_tofd ' +! print *, maxval(axtms)*86400., minval(axtms)*86400, 'vgw_axtms' +! print *,maxval(dudt_mtb)*86400.,minval(dudt_mtb)*86400,'vgw_axmtb' + if (maxval(abs(pdudt))*86400. > 100.) then + + print *, maxval(u1), minval(u1), ' u1 gwdps-v0 ' + print *, maxval(v1), minval(v1), ' v1 gwdps-v0 ' + print *, maxval(t1), minval(t1), ' t1 gwdps-v0 ' + print *, maxval(q1), minval(q1), ' q1 gwdps-v0 ' + print *, maxval(del), minval(del), ' del gwdps-v0 ' + print *, maxval(phil)*rgrav,minval(phil)*rgrav, 'zmet' + print *, maxval(phii)*rgrav,minval(phii)*rgrav, 'zmeti' + print *, maxval(prsi), minval(prsi), ' prsi ' + print *, maxval(prsL), minval(prsL), ' prsL ' + print *, maxval(RO), minval(RO), ' RO-dens ' + print *, maxval(bnv2(1:npt,:)), minval(bnv2(1:npt,:)),' BNV2 ' + print *, maxval(kpbl), minval(kpbl), ' kpbl ' + print *, maxval(sgh30), maxval(hprime), maxval(elvmax),'oro-d' + print * + do i =1, npt + j= ipt(i) + print *,zogw(J)/hprime(j), zmtb(j)/hprime(j), + & phil(j,1)/9.81, nint(hprime(j)/sigma(j)) +! +!.................................................................... +! +! zogw/hp=5.9 zblk/hp=10.7 zm=11.1m ridge/2=2,489m/9,000m +! from 5 to 20 km , we need to count for "ridges" > dx/4 ~ 15 km +! we must exclude blocking by small ridges +! VAY-kref < iblk zogw-lev 15 block-level: 39 +! +! velmin => 1.0, 0.01, 0.1 etc.....unification of wind limiters +! MAX(SQRT(U1(J,K)*U1(J,K) + V1(J,K)*V1(J,K)), minwnd) +! MAX(DW2,DW2MIN) * RDZ * RDZ +! ULOW(I) = MAX(SQRT(UBAR(I)*UBAR(I) + VBAR(I)*VBAR(I)), 1.0) +! TEM = MAX(VELCO(I,K)*VELCO(I,K), 0.1) +! TEMV = 1.0 / max(VELCO(I,K), 0.01) +! & * max(VELCO(I,K),0.01) +!.................................................................... + enddo + print * + stop + endif + endif + +! + RETURN +!--------------------------------------------------------------- +! review of OLD-GFS code 2017/18 most substantial changes +! a) kref > idxzb if idxzb > KPBL "OK" clipped-hill for OGW +! b) tofd -sgh30 "OK" +! +! c) FR < Frc linear theory for taub-specification +! +! d) solver of Palmer et al. (1987) => Linsat of McFarlane +! +!--------------------------------------------------------------- + end subroutine gwdps_v0 + + + +!=============================================================================== +! use fv3gfs-v0 +! first beta version of ugwp for fv3gfs-128 +! cires/swpc - jan 2018 +! non-tested wam ugwp-solvers in fv3gfs: "lsatdis", "dspdis", "ado99dis" +! they reqiure extra-work to put them in with intializtion and namelists +! next will be lsatdis for both fv3wam & fv3gfs-128l implementations +! with (a) stochastic-deterministic propagation solvers for wave packets/spectra +! (b) gw-sources: oro/convection/dyn-instability (fronts/jets/pv-anomalies) +! (c) guidance from high-res runs for GW sources and res-aware tune-ups +!23456 +! +! call gwdrag_wam(1, im, ix, km, ksrc, dtp, +! & xlat, gw_dudt, gw_dvdt, taux, tauy) +! call fv3_ugwp_wms17(kid1, im, ix, km, ksrc_ifs, dtp, +! & adt,adu,adv,prsl,prsi,phil,xlat, gw_dudt, gw_dvdt, gw_dtdt, gw_ked, +! & taux,tauy,grav, amol_i, me, lstep_first ) +! +! +!23456============================================================================== + +!>\ingroup cires_ugwp_run +!> @{ +!! + subroutine fv3_ugwp_solv2_v0(klon, klev, dtime, + & tm1 , um1, vm1, qm1, + & prsl, prsi, philg, xlatd, sinlat, coslat, + & pdudt, pdvdt, pdtdt, dked, tau_ngw, + & mpi_id, master, kdt) +! + + +!======================================================= +! +! nov 2015 alternative gw-solver for nggps-wam +! nov 2017 nh/rotational gw-modes for nh-fv3gfs +! --------------------------------------------------------------------------------- +! + + use ugwp_common , only : rgrav, grav, cpd, rd, rv + &, omega2, rcpd2, pi, pi2, fv + &, rad_to_deg, deg_to_rad + &, rdi, gor, grcp, gocp + &, bnv2min, dw2min, velmin, gr2 +! + use ugwp_wmsdis_init, only : hpscale, rhp2, bv2min, gssec + &, v_kxw, v_kxw2, tamp_mpa, zfluxglob + &, maxdudt, gw_eff, dked_min + &, nslope, ilaunch, zmsi + &, zci, zdci, zci4, zci3, zci2 + &, zaz_fct, zcosang, zsinang + &, nwav, nazd, zcimin, zcimax +! + implicit none +!23456 + + integer, intent(in) :: klev ! vertical level + integer, intent(in) :: klon ! horiz tiles + + real, intent(in) :: dtime ! model time step + real, intent(in) :: vm1(klon,klev) ! meridional wind + real, intent(in) :: um1(klon,klev) ! zonal wind + real, intent(in) :: qm1(klon,klev) ! spec. humidity + real, intent(in) :: tm1(klon,klev) ! kin temperature + + real, intent(in) :: prsl(klon,klev) ! mid-layer pressure + real, intent(in) :: philg(klon,klev) ! m2/s2-phil => meters !!!!! phil =philg/grav + real, intent(in) :: prsi(klon,klev+1)! prsi interface pressure + real, intent(in) :: xlatd(klon) ! lat was in radians, now with xlat_d in degrees + real, intent(in) :: sinlat(klon) + real, intent(in) :: coslat(klon) + real, intent(in) :: tau_ngw(klon) + + integer, intent(in) :: mpi_id, master, kdt +! +! +! out-gw effects +! + real, intent(out) :: pdudt(klon,klev) ! zonal momentum tendency + real, intent(out) :: pdvdt(klon,klev) ! meridional momentum tendency + real, intent(out) :: pdtdt(klon,klev) ! gw-heating (u*ax+v*ay)/cp + real, intent(out) :: dked(klon,klev) ! gw-eddy diffusion + real, parameter :: minvel = 0.5 ! + real, parameter :: epsln = 1.0d-12 ! + +!vay-2018 + + real :: taux(klon,klev+1) ! EW component of vertical momentum flux (pa) + real :: tauy(klon,klev+1) ! NS component of vertical momentum flux (pa) + real :: phil(klon,klev) ! gphil/grav +! +! local =============================================================================================== +! + +! real :: zthm1(klon,klev) ! temperature interface levels + real :: zthm1 ! 1.0 / temperature interface levels + real :: zbvfhm1(klon,ilaunch:klev) ! interface BV-frequency + real :: zbn2(klon,ilaunch:klev) ! interface BV-frequency + real :: zrhohm1(klon,ilaunch:klev) ! interface density + real :: zuhm1(klon,ilaunch:klev) ! interface zonal wind + real :: zvhm1(klon,ilaunch:klev) ! meridional wind + real :: v_zmet(klon,ilaunch:klev) + real :: vueff(klon,ilaunch:klev) + real :: zbvfl(klon) ! BV at launch level + real :: c2f2(klon) + +!23456 + real :: zul(klon,nazd) ! velocity in azimuthal direction at launch level + real :: zci_min(klon,nazd) +! real :: zcrt(klon,klev,nazd) ! not used - do we need it? Moorthi + real :: zact(klon, nwav, nazd) ! if =1 then critical level encountered => c-u +! real :: zacc(klon, nwav, nazd) ! not used! +! + real :: zpu(klon,klev, nazd) ! momentum flux +! real :: zdfl(klon,klev, nazd) + real :: zfct(klon,klev) + real :: zfnorm(klon) ! normalisation factor + + real :: zfluxlaun(klon) + real :: zui(klon, klev,nazd) +! + real :: zdfdz_v(klon,klev, nazd) ! axj = -df*rho/dz directional momentum depositiom + real :: zflux(klon, nwav, nazd) ! momentum flux at each level stored as ( ix, mode, iazdim) + + real :: zflux_z (klon, nwav,klev) !momentum flux at each azimuth stored as ( ix, mode, klev) +! + real :: vm_zflx_mode, vc_zflx_mode + real :: kzw2, kzw3, kdsat, cdf2, cdf1, wdop2 + +! real :: zang, znorm, zang1, ztx + real :: zu, zcin, zcpeak, zcin4, zbvfl4 + real :: zcin2, zbvfl2, zcin3, zbvfl3, zcinc + real :: zatmp, zfluxs, zdep, zfluxsq, zulm, zdft, ze1, ze2 + +! + real :: zdelp,zrgpts + real :: zthstd,zrhostd,zbvfstd + real :: tvc1, tvm1, tem1, tem2, tem3 + real :: zhook_handle + real :: delpi(klon,ilaunch:klev) + + +! real :: rcpd, grav2cpd + real, parameter :: rcpdl = cpd/grav ! 1/[g/cp] == cp/g + &, grav2cpd = grav/rcpdl ! g*(g/cp)= g^2/cp + &, cpdi = 1.0d0/cpd + + real :: expdis, fdis +! real :: fmode, expdis, fdis + real :: v_kzi, v_kzw, v_cdp, v_wdp, sc, tx1 + + integer :: j, k, inc, jk, jl, iazi +! +!-------------------------------------------------------------------------- +! + do k=1,klev + do j=1,klon + pdvdt(j,k) = 0.0 + pdudt(j,k) = 0.0 + pdtdt(j,k) = 0.0 + dked(j,k) = 0.0 + phil(j,k) = philg(j,k) * rgrav + enddo + enddo +!----------------------------------------------------------- +! also other options to alter tropical values +! tamp = 100.e-3*1.e3 = 100 mpa +! vay-2017 zfluxglob=> lat-dep here from geos-5/merra-2 +!----------------------------------------------------------- +! call slat_geos5_tamp(klon, tamp_mpa, xlatd, tau_ngw) + + +! phil = philg*rgrav + +! rcpd = 1.0/(grav/cpd) ! 1/[g/cp] +! grav2cpd = grav*grav/cpd ! g*(g/cp)= g^2/cp + + if (kdt ==1 .and. mpi_id == master) then + print *, maxval(tm1), minval(tm1), 'vgw: temp-res ' + print *, 'ugwp-v0: zcimin=' , zcimin + print *, 'ugwp-v0: zcimax=' , zcimax + print * + endif +! +!================================================= + do iazi=1, nazd + do jk=1,klev + do jl=1,klon + zpu(jl,jk,iazi) = 0.0 +! zcrt(jl,jk,iazi) = 0.0 +! zdfl(jl,jk,iazi) = 0.0 + enddo + enddo + enddo + +! +! set initial min Cxi for critical level absorption + do iazi=1,nazd + do jl=1,klon + zci_min(jl,iazi) = zcimin + enddo + enddo +! define half model level winds and temperature +! --------------------------------------------- + do jk=max(ilaunch,2),klev + do jl=1,klon + tvc1 = tm1(jl,jk) * (1. +fv*qm1(jl,jk)) + tvm1 = tm1(jl,jk-1) * (1. +fv*qm1(jl,jk-1)) +! zthm1(jl,jk) = 0.5 *(tvc1+tvm1) + zthm1 = 2.0 / (tvc1+tvm1) + zuhm1(jl,jk) = 0.5 *(um1(jl,jk-1)+um1(jl,jk)) + zvhm1(jl,jk) = 0.5 *(vm1(jl,jk-1)+vm1(jl,jk)) +! zrhohm1(jl,jk) = prsi(jl,jk)*rdi/zthm1(jl,jk) ! rho = p/(RTv) + zrhohm1(jl,jk) = prsi(jl,jk)*rdi*zthm1 ! rho = p/(RTv) + zdelp = phil(jl,jk)-phil(jl,jk-1) !>0 ...... dz-meters + v_zmet(jl,jk) = zdelp + zdelp + delpi(jl,jk) = grav / (prsi(jl,jk-1) - prsi(jl,jk)) + vueff(jl,jk) = + & 2.e-5*exp( (phil(jl,jk)+phil(jl,jk-1))*rhp2)+dked_min +! +! zbn2(jl,jk) = grav2cpd/zthm1(jl,jk) + zbn2(jl,jk) = grav2cpd*zthm1 + & * (1.0+rcpdl*(tm1(jl,jk)-tm1(jl,jk-1))/zdelp) + zbn2(jl,jk) = max(min(zbn2(jl,jk), gssec), bv2min) + zbvfhm1(jl,jk) = sqrt(zbn2(jl,jk)) ! bn = sqrt(bn2) + enddo + enddo + + if (ilaunch == 1) then + jk = 1 + do jl=1,klon +! zthm1(jl,jk) = tm1(jl,jk) * (1. +fv*qm1(jl,jk)) ! not used + zuhm1(jl,jk) = um1(jl,jk) + zvhm1(jl,jk) = vm1(jl,jk) + ZBVFHM1(JL,1) = ZBVFHM1(JL,2) + V_ZMET(JL,1) = V_ZMET(JL,2) + VUEFF(JL,1) = DKED_MIN + ZBN2(JL,1) = ZBN2(JL,2) + enddo + endif + do jl=1,klon + tx1 = OMEGA2 * SINLAT(JL) / V_KXW + C2F2(JL) = tx1 * tx1 + zbvfl(jl) = zbvfhm1(jl,ilaunch) + enddo +! +! define intrinsic velocity (relative to launch level velocity) u(z)-u(zo), and coefficinets +! ------------------------------------------------------------------------------------------ + do iazi=1, nazd + do jl=1,klon + zul(jl,iazi) = zcosang(iazi) * zuhm1(jl,ilaunch) + & + zsinang(iazi) * zvhm1(jl,ilaunch) + enddo + enddo +! + do jk=ilaunch, klev-1 ! from z-launch up model level from which gw spectrum is launched + do iazi=1, nazd + do jl=1,klon + zu = zcosang(iazi)*zuhm1(jl,jk) + & + zsinang(iazi)*zvhm1(jl,jk) + zui(jl,jk,iazi) = zu - zul(jl,iazi) + enddo + enddo + + enddo +! define rho(zo)/n(zo) +! ------------------- + do jk=ilaunch, klev-1 + do jl=1,klon + zfct(jl,jk) = zrhohm1(jl,jk) / zbvfhm1(jl,jk) + enddo + enddo + +! ----------------------------------------- +! set launch momentum flux spectral density +! ----------------------------------------- + + if(nslope == 1) then ! s=1 case + ! -------- + do inc=1,nwav + zcin = zci(inc) + zcin4 = zci4(inc) + do jl=1,klon +!n4 + zbvfl4 = zbvfl(jl) * zbvfl(jl) + zbvfl4 = zbvfl4 * zbvfl4 + zflux(jl,inc,1) = zfct(jl,ilaunch)*zbvfl4*zcin + & / (zbvfl4+zcin4) + enddo + enddo + elseif(nslope == 2) then ! s=2 case + ! -------- + do inc=1, nwav + zcin = zci(inc) + zcin4 = zci4(inc) + do jl=1,klon + zbvfl4 = zbvfl(jl) * zbvfl(jl) + zbvfl4 = zbvfl4 * zbvfl4 + zcpeak = zbvfl(jl) * zmsi + zflux(jl,inc,1) = zfct(jl,ilaunch)* + & zbvfl4*zcin*zcpeak/(zbvfl4*zcpeak+zcin4*zcin) + enddo + enddo + elseif(nslope == -1) then ! s=-1 case + ! -------- + do inc=1,nwav + zcin = zci(inc) + zcin2 = zci2(inc) + do jl=1,klon + zbvfl2 = zbvfl(jl)*zbvfl(jl) + zflux(jl,inc,1) = zfct(jl,ilaunch)*zbvfl2*zcin + & / (zbvfl2+zcin2) + enddo + enddo + elseif(nslope == 0) then ! s=0 case + ! -------- + + do inc=1, nwav + zcin = zci(inc) + zcin3 = zci3(inc) + do jl=1,klon + zbvfl3 = zbvfl(jl)**3 + zflux(jl,inc,1) = zfct(jl,ilaunch)*zbvfl3*zcin + & / (zbvfl3+zcin3) + enddo + enddo + + endif ! for slopes +! +! normalize momentum flux at the src-level +! ------------------------------ +! integrate (zflux x dx) + do inc=1, nwav + zcinc = zdci(inc) + do jl=1,klon + zpu(jl,ilaunch,1) = zpu(jl,ilaunch,1) + zflux(jl,inc,1)*zcinc + enddo + enddo +! +! normalize and include lat-dep (precip or merra-2) +! ----------------------------------------------------------- +! also other options to alter tropical values +! + do jl=1,klon + zfluxlaun(jl) = tau_ngw(jl) !*(.5+.75*coslat(JL)) !zfluxglob/2 on poles + zfnorm(jl) = zfluxlaun(jl) / zpu(jl,ilaunch,1) + enddo +! + do iazi=1,nazd + do jl=1,klon + zpu(jl,ilaunch,iazi) = zfluxlaun(jl) + enddo + enddo + +! adjust constant zfct + + do jk=ilaunch, klev-1 + do jl=1,klon + zfct(jl,jk) = zfnorm(jl)*zfct(jl,jk) + enddo + enddo +! renormalize each spectral mode + + do inc=1, nwav + do jl=1,klon + zflux(jl,inc,1) = zfnorm(jl)*zflux(jl,inc,1) + enddo + enddo + +! copy zflux into all other azimuths +! -------------------------------- +! zact(:,:,:) = 1.0 ; zacc(:,:,:) = 1.0 + zact(:,:,:) = 1.0 + do iazi=2, nazd + do inc=1,nwav + do jl=1,klon + zflux(jl,inc,iazi) = zflux(jl,inc,1) + enddo + enddo + enddo + +! ------------------------------------------------------------- +! azimuth do-loop +! -------------------- + do iazi=1, nazd + +! write(0,*)' iazi=',iazi,' ilaunch=',ilaunch +! vertical do-loop +! ---------------- + do jk=ilaunch, klev-1 +! first check for critical levels +! ------------------------ + do jl=1,klon + zci_min(jl,iazi) = max(zci_min(jl,iazi),zui(jl,jk,iazi)) + enddo +! set zact to zero if critical level encountered +! ---------------------------------------------- + do inc=1, nwav +! zcin = zci(inc) + do jl=1,klon +! zatmp = minvel + sign(minvel,zcin-zci_min(jl,iazi)) +! zacc(jl,inc,iazi) = zact(jl,inc,iazi)-zatmp +! zact(jl,inc,iazi) = zatmp + zact(jl,inc,iazi) = minvel + & + sign(minvel,zci(inc)-zci_min(jl,iazi)) + enddo + enddo +! +! zdfl not used! - do we need it? Moorthi +! integrate to get critical-level contribution to mom deposition +! --------------------------------------------------------------- +! do inc=1, nwav +! zcinc = zdci(inc) +! do jl=1,klon +! zdfl(jl,jk,iazi) = zdfl(jl,jk,iazi) + +! & zacc(jl,inc,iazi)*zflux(jl,inc,iazi)*zcinc +! enddo +! enddo +! -------------------------------------------- +! get weighted average of phase speed in layer zcrt is not used - do we need it? Moorthi +! -------------------------------------------- +! do jl=1,klon +! write(0,*)' jk=',jk,' jl=',jl,' iazi=',iazi, zdfl(jl,jk,iazi) +! if(zdfl(jl,jk,iazi) > epsln ) then +! zatmp = zcrt(jl,jk,iazi) +! do inc=1, nwav +! zatmp = zatmp + zci(inc) * +! & zacc(jl,inc,iazi)*zflux(jl,inc,iazi)*zdci(inc) +! enddo +! +! zcrt(jl,jk,iazi) = zatmp / zdfl(jl,jk,iazi) +! else +! zcrt(jl,jk,iazi) = zcrt(jl,jk-1,iazi) +! endif +! enddo + +! + do inc=1, nwav + zcin = zci(inc) + if (abs(zcin) > epsln) then + zcinc = 1.0 / zcin + else + zcinc = 1.0 + endif + do jl=1,klon +!======================================================================= +! saturated limit wfit = kzw*kzw*kt; wfdt = wfit/(kxw*cx)*betat +! & dissipative kzi = 2.*kzw*(wfdm+wfdt)*dzpi(k) +! define kxw = +!======================================================================= + v_cdp = abs(zcin-zui(jL,jk,iazi)) + v_wdp = v_kxw*v_cdp + wdop2 = v_wdp* v_wdp + cdf2 = v_cdp*v_cdp - c2f2(jL) + if (cdf2 > 0) then + kzw2 = (zBn2(jL,jk)-wdop2)/Cdf2 - v_kxw2 + else + kzw2 = 0.0 + endif + if ( kzw2 > 0 ) then + v_kzw = sqrt(kzw2) +! +!linsatdis: kzw2, kzw3, kdsat, c2f2, cdf2, cdf1 +! +!kzw2 = (zBn2(k)-wdop2)/Cdf2 - rhp4 - v_kx2w ! full lin DS-NiGW (N2-wd2)*k2=(m2+k2+[1/2H]^2)*(wd2-f2) +! Kds = kxw*Cdf1*rhp2/kzw3 +! + v_cdp = sqrt( cdf2 ) + v_wdp = v_kxw * v_cdp + v_kzi = abs(v_kzw*v_kzw*vueff(jl,jk)/v_wdp*v_kzw) + expdis = exp(-v_kzi*v_zmet(jl,jk)) + else + v_kzi = 0. + expdis = 1.0 + v_kzw = 0. + v_cdp = 0. ! no effects of reflected waves + endif + +! fmode = zflux(jl,inc,iazi) +! fdis = fmode*expdis + fdis = expdis * zflux(jl,inc,iazi) +! +! saturated flux + wave dissipation - Keddy_gwsat in UGWP-V1 +! linsatdis = 1.0 , here: u'^2 ~ linsatdis* [v_cdp*v_cdp] +! + zfluxs = zfct(jl,jk)*v_cdp*v_cdp*zcinc +! +! zfluxs= zfct(jl,jk)*(zcin-zui(jl,jk,iazi))**2/zcin +! flux_tot - sat.flux +! + zdep = zact(jl,inc,iazi)* (fdis-zfluxs) + if(zdep > 0.0 ) then +! subs on sat-limit + zflux(jl,inc,iazi) = zfluxs + zflux_z(jl,inc,jk) = zfluxs + else +! assign dis-ve flux + zflux(jl,inc,iazi) = fdis + zflux_z(jl,inc,jk) = fdis + endif + enddo + enddo +! +! integrate over spectral modes zpu(y, z, azimuth) zact(jl,inc,iazi)*zflux(jl,inc,iazi)*[d("zcinc")] +! + zdfdz_v(:,jk,iazi) = 0.0 + + do inc=1, nwav + zcinc = zdci(inc) ! dc-integration + do jl=1,klon + vc_zflx_mode = zact(jl,inc,iazi)*zflux(jl,inc,iazi) + zpu(jl,jk,iazi) = zpu(jl,jk,iazi) + vc_zflx_mode*zcinc + +!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +! check monotonic decrease +! (heat deposition integration over spectral mode for each azimuth +! later sum over selected azimuths as "non-negative" scalars) +!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + if (jk > ilaunch)then +! zdelp = grav/(prsi(jl,jk-1)-prsi(jl,jk))* +! & abs(zcin-zui(jl,jk,iazi)) *zcinc + zdelp = delpi(jl,jk) * abs(zcin-zui(jl,jk,iazi)) *zcinc + vm_zflx_mode = zact(jl,inc,iazi)* zflux_z(jl,inc,jk-1) + + if (vc_zflx_mode > vm_zflx_mode) + & vc_zflx_mode = vm_zflx_mode ! no-flux increase + zdfdz_v( jl,jk,iazi) = zdfdz_v( jl,jk,iazi) + + & (vm_zflx_mode-vc_zflx_mode)*zdelp ! heating >0 +! +! + endif + enddo !jl=1,klon + enddo !waves inc=1,nwav + +! -------------- + enddo ! end jk do-loop vertical loop +! --------------- + enddo ! end nazd do-loop +! ---------------------------------------------------------------------------- +! sum contribution for total zonal and meridional flux + +! energy dissipation +! --------------------------------------------------- +! + do jk=1,klev+1 + do jl=1,klon + taux(jl,jk) = 0.0 + tauy(jl,jk) = 0.0 + enddo + enddo + + tem3 = zaz_fct*cpdi + do iazi=1,nazd + tem1 = zaz_fct*zcosang(iazi) + tem2 = zaz_fct*zsinang(iazi) + do jk=ilaunch, klev-1 + do jl=1,klon + taux(jl,jk) = taux(jl,jk) + tem1 * zpu(jl,jk,iazi) ! zaz_fct - "azimuth"-norm-n + tauy(jl,jk) = tauy(jl,jk) + tem2 * zpu(jl,jk,iazi) + pdtdt(jl,jk) = pdtdt(jl,jk) + tem3 * zdfdz_v(jl,jk,iazi) ! eps_dis =sum( +d(flux_e)/dz) > 0. + enddo + enddo + + enddo +! +! update du/dt and dv/dt tendencies ..... no contribution to heating => keddy/tracer-mom-heat +! ---------------------------- +! + + do jk=ilaunch,klev + do jl=1, klon +! zdelp = grav / (prsi(jl,jk-1)-prsi(jl,jk)) + zdelp = delpi(jl,jk) + ze1 = (taux(jl,jk)-taux(jl,jk-1))*zdelp + ze2 = (tauy(jl,jk)-tauy(jl,jk-1))*zdelp + if (abs(ze1) >= maxdudt ) then + ze1 = sign(maxdudt, ze1) + endif + if (abs(ze2) >= maxdudt ) then + ze2 = sign(maxdudt, ze2) + endif + pdudt(jl,jk) = -ze1 + pdvdt(jl,jk) = -ze2 +! +! Cx =0 based Cx=/= 0. above +! + pdtdt(jl,jk) = (ze1*um1(jl,jk) + ze2*vm1(jl,jk)) * cpdi +! + dked(jl,jk) = max(dked_min, pdtdt(jl,jk)/zbn2(jl,jk)) +! if (dked(jl,jk) < 0) dked(jl,jk) = dked_min + enddo + enddo +! +! add limiters/efficiency for "unbalanced ics" if it is needed +! + do jk=ilaunch,klev + do jl=1, klon + pdudt(jl,jk) = gw_eff * pdudt(jl,jk) + pdvdt(jl,jk) = gw_eff * pdvdt(jl,jk) + pdtdt(jl,jk) = gw_eff * pdtdt(jl,jk) + dked(jl,jk) = gw_eff * dked(jl,jk) + enddo + enddo +! +!--------------------------------------------------------------------------- +! + if (kdt == 1 .and. mpi_id == master) then + print *, 'vgw done ' +! + print *, maxval(pdudt)*86400., minval(pdudt)*86400, 'vgw ax' + print *, maxval(pdvdt)*86400., minval(pdvdt)*86400, 'vgw ay' + print *, maxval(dked)*1., minval(dked)*1, 'vgw keddy m2/sec' + print *, maxval(pdtdt)*86400., minval(pdtdt)*86400,'vgw eps' +! +! print *, ' ugwp -heating rates ' + endif + + return + end subroutine fv3_ugwp_solv2_v0 +!------------------------------------------------------------------------------- +! +! Part-3 of UGWP-V01 Dissipative (eddy) effects of UGWP it will be activated +! after tests of OGW (new revision) and NGW with MERRA-2 forcing. +! +!------------------------------------------------------------------------------- + subroutine edmix_ugwp_v0(im, levs, dtp, + & t1, u1, v1, q1, del, + & prsl, prsi, phil, prslk, + & pdudt, pdvdt, pdTdt, pkdis, + & ed_dudt, ed_dvdt, ed_dTdt, + & me, master, kdt ) +! + use machine, only : kind_phys + use ugwp_common , only : rgrav, grav, cpd, rd, rdi, fv +! &, pi, rad_to_deg, deg_to_rad, pi2 + &, bnv2min, velmin, arad + + implicit none + + integer, intent(in) :: me, master, kdt + integer, intent(in) :: im, levs + real(kind=kind_phys), intent(in) :: dtp + real(kind=kind_phys), intent(in), dimension(im,levs) :: + & u1, v1, t1, q1, del, prsl, prslk, phil +! + real(kind=kind_phys), intent(in),dimension(im,levs+1):: prsi + real(kind=kind_phys),dimension(im,levs) :: pdudt, pdvdt, pdTdt + real(kind=kind_phys),dimension(im,levs) :: pkdis +! +! out +! + real(kind=kind_phys),dimension(im,levs) :: ed_dudt, ed_dvdt + real(kind=kind_phys),dimension(im,levs) :: ed_dTdt +! +! locals +! + integer :: i, j, k +!------------------------------------------------------------------------ +! solving 1D-vertical eddy diffusion to "smooth" +! GW-related tendencies: du/dt, dv/dt, d(PT)/dt +! we need to use sum of molecular + eddy terms including turb-part +! of PBL extended to the model top, because "phys-tend" dx/dt +! should be smoothed as "entire" fields therefore one should +! first estimate and collect "effective" diffusion and applied +! it to each part of tendency or "sum of tendencies + Xdyn" +! this "diffusive-way" is tested with UGWP-tendencies +! forced by various wave sources. X' =dx/dt *dt +! d(X + X')/dt = K*diff(X + X') => +! +! wave1 dX'/dt = Kw * diff(X')... eddy part "Kwave" on wave-part +! turb2 dX/dt = Kturb * diff(X) ... resolved scale mixing "Kturb" like PBL +! we may assume "zero-GW"-tendency at the top lid and "zero" flux +! or "vertical gradient" near the surface +! +! 1-st trial w/o PBL interactions: add dU, dV dT tendencies +! compute BV, SHR2, Ri => Kturb, Kturb + Kwave => Apply it to "X_Tend +X " +! ed_X = X_ed - X => final eddy tendencies +!--------------------------------------------------------------------------- +! rzs=30m dk = rzs*rzs*sqrt(shr2(i,k)) +! Ktemp = dk/(1+5.*ri)**2 Kmom = Pr*Ktemp +! + real(kind=kind_phys) :: Sw(levs), Sw1(levs), Fw(levs), Fw1(levs) + real(kind=kind_phys) :: Km(levs), Kpt(levs), Pt(levs), Ptmap(levs) + real(kind=kind_phys) :: rho(levs), rdp(levs), rdpm(levs-1) + real(kind=kind_phys),dimension(levs) :: ktur, vumol, up, vp, tp + real(kind=kind_phys),dimension(levs) :: bn2, shr2, ksum + real(kind=kind_phys) :: eps_shr, eps_bn2, eps_dis + real(kind=kind_phys) :: rdz , uz, vz, ptz +! ------------------------------------------------------------------------- +! Prw*Lsat2 =1, for GW-eddy diffusion Pr_wave = Kv/Kt +! Pr_wave ~1/Lsat2 = 1/Frcit2 = 2. => Lsat2 = 1./2 (Frc ~0.7) +! m*u'/N = u'/{c-U) = h'N/(c-U) = Lsat = Fcrit +! > PBL: 0.25 < prnum = 1.0 + 2.1*ri < 4 +! monin-edmf parameter(rlam=30.0,vk=0.4,vk2=vk*vk) rlamun=150.0 +! + real(kind=kind_phys), parameter :: iPr_pt = 0.5, dw2min = 1.e-4 + real(kind=kind_phys), parameter :: lturb = 30., sc2 = lturb*lturb + real(kind=kind_phys), parameter :: ulturb=150.,sc2u=ulturb* ulturb + real(kind=kind_phys), parameter :: ric =0.25 + real(kind=kind_phys), parameter :: rimin = -10., prmin = 0.25 + real(kind=kind_phys), parameter :: prmax = 4.0 + real(kind=kind_phys), parameter :: hps = 7000., h4 = 0.25/hps + real(kind=kind_phys), parameter :: kedmin = 0.01, kedmax = 250. + + + real(kind=kind_phys) :: rdtp, rineg, kamp, zmet, zgrow + real(kind=kind_phys) :: stab, stab_dt, dtstab, ritur + integer :: nstab + real(kind=kind_phys) :: w1, w2, w3 + rdtp = 1./dtp + nstab = 1 + stab_dt = 0.9999 + + do i =1, im + + rdp(1:levs) = grav/del(i, 1:levs) + + up(1:levs) = u1(i,1:levs) +pdudt(i,1:levs)*dtp + vp(1:levs) = v1(i,1:levs) +pdvdt(i,1:levs)*dtp + tp(1:levs) = t1(i,1:levs) +pdTdt(i,1:levs)*dtp + Ptmap(1:levs) = (1.+fv*q1(i,1:levs))/prslk(i,1:levs) + rho(1:levs) = rdi*prsl(i, 1:levs)/tp(1:levs) + Pt(1:levs) = tp(1:levs)*Ptmap(1:levs) + + do k=1, levs-1 + rdpm(k) = grav/(prsl(i,k)-prsl(i,k+1)) + rdz = .5*rdpm(k)*(rho(k)+rho(k+1)) + uz = up(k+1)-up(k) + vz = vp(k+1)-vp(k) + ptz =2.*(pt(k+1)-pt(k))/(pt(k+1)+pt(k)) + shr2(k) = rdz*rdz*(max(uz*uz+vz*vz, dw2min)) + bn2(k) = grav*rdz*ptz + zmet = phil(j,k)*rgrav + zgrow = exp(zmet*h4) + if ( bn2(k) < 0. ) then +! +! adjust PT-profile to bn2(k) = bnv2min -- neutral atmosphere +! adapt "pdtdt = (Ptadj-Ptdyn)/Ptmap" +! + print *,' UGWP-V0 unstab PT(z) via gwdTdt ', bn2(k), k + + rineg = bn2(k)/shr2(k) + bn2(k) = max(bn2(k), bnv2min) + kamp = sqrt(shr2(k))*sc2u *zgrow + ktur(k) =kamp* (1+8.*(-rineg)/(1+1.746*sqrt(-rineg))) + endif + ritur = max(bn2(k)/shr2(k), rimin) + if (ritur > 0. ) then + kamp = sqrt(shr2(k))*sc2 *zgrow + w1 = 1./(1. + 5*ritur) + ktur(k)= kamp * w1 * w1 + endif + vumol(k) = 2.e-5 *exp(zmet/hps) + ksum(k) =ktur(k)+Pkdis(i,k)+vumol(k) + ksum(k) = max(ksum(k), kedmin) + ksum(k) = min(ksum(k), kedmax) + stab = 2.*ksum(k)*rdz*rdz*dtp + if ( stab >= 1.0 ) then + stab_dt = max(stab_dt, stab) + endif + enddo + nstab = max(1, nint(stab_dt)+1) + dtstab = dtp / float(nstab) + ksum(levs) = ksum(levs-1) + Fw(1:levs) = pdudt(i, 1:levs) + Fw1(1:levs) = pdvdt(i, 1:levs) + Km(1:levs) = ksum(1:levs) * rho(1:levs)* rho(1:levs) + + do j=1, nstab + call diff_1d_wtend(levs, dtstab, Fw, Fw1, Km, + & rdp, rdpm, Sw, Sw1) + Fw = Sw + Fw1 = Sw1 + enddo + + ed_dudt(i,:) = Sw + ed_dvdt(i,:) = Sw1 + + Pt(1:levs) = t1(i,1:levs)*Ptmap(1:levs) + Kpt = Km*iPr_pt + Fw(1:levs) = pdTdt(i, 1:levs)*Ptmap(1:levs) + do j=1, nstab + call diff_1d_ptend(levs, dtstab, Fw, Kpt, rdp, rdpm, Sw) + Fw = Sw + enddo + ed_dtdt(i,1:levs) = Sw(1:levs)/Ptmap(1:levs) + + enddo + + end subroutine edmix_ugwp_v0 + + subroutine diff_1d_wtend(levs, dt, F, F1, Km, rdp, rdpm, S, S1) + use machine, only: kind_phys + implicit none + integer :: levs + real(kind=kind_phys) :: dt + real(kind=kind_phys) :: S(levs), S1(levs), F(levs), F1(levs) + real(kind=kind_phys) :: Km(levs), rdp(levs), rdpm(levs-1) + integer :: i, k + real(kind=kind_phys) :: Kp1, ad, cd, bd +! real(kind=kind_phys) :: km1, Kp1, ad, cd, bd +! S(:) = 0.0 ; S1(:) = 0.0 +! +! explicit diffusion solver +! + k = 1 +! km1 = 0. ; ad =0. + ad =0. + kp1 = .5*(Km(k)+Km(k+1)) + cd = rdp(1)*rdpm(1)*kp1*dt + bd = 1. - cd - ad +! S(k) = cd*F(k+1) + ad *F(k-1) + bd *F(k) + S(K) = F(k) + S1(K) = F1(k) + do k=2, levs-1 + ad = cd + kp1 = .5*(Km(k)+Km(k+1)) + cd = rdp(k)*rdpm(k)*kp1*dt + bd = 1.-(ad +cd) + S(k) = cd*F(k+1) + ad *F(k-1) + bd *F(k) + S1(k) = cd*F1(k+1) + ad *F1(k-1) + bd *F1(k) + enddo + k = levs + S(k) = F(k) + S1(k) = F1(k) + end subroutine diff_1d_wtend + + subroutine diff_1d_ptend(levs, dt, F, Km, rdp, rdpm, S) + use machine, only: kind_phys + implicit none + integer :: levs + real(kind=kind_phys) :: dt + real(kind=kind_phys) :: S(levs), S1(levs), F(levs), F1(levs) + real(kind=kind_phys) :: Km(levs), rdp(levs), rdpm(levs-1) + integer :: i, k + real(kind=kind_phys) :: Kp1, ad, cd, bd +! real(kind=kind_phys) :: km1, Kp1, ad, cd, bd +! +! explicit "eddy" smoother for tendencies +! + + k = 1 +! km1 = 0. ; ad =0. + ad =0. + kp1 = .5*(Km(k)+Km(k+1)) + cd = rdp(1)*rdpm(1)*kp1*dt + bd = 1. -(cd +ad) +! S(k) = cd*F(k+1) + ad *F(k-1) + bd *F(k) + S(K) = F(k) + do k=2, levs-1 + ad = cd + kp1 = .5*(Km(k)+Km(k+1)) + cd = rdp(k)*rdpm(k)*kp1*dt + bd = 1.-(ad +cd) + S(k) = cd*F(k+1) + ad *F(k-1) + bd *F(k) + enddo + k = levs + S(k) = F(k) + end subroutine diff_1d_ptend diff --git a/physics/ysuvdif.F90 b/physics/ysuvdif.F90 index e76f2120b..fff945774 100644 --- a/physics/ysuvdif.F90 +++ b/physics/ysuvdif.F90 @@ -22,62 +22,10 @@ end subroutine ysuvdif_finalize !! YSU scheme. !! !> \section arg_table_ysuvdif_run Argument Table -!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | -!! |----------------|-----------------------------------------------------------------------------|-------------------------------------------------------|---------------|------|-----------|-----------|--------|----------| -!! | ix | horizontal_dimension | horizontal dimension | count | 0 | integer | | in | F | -!! | im | horizontal_loop_extent | horizontal loop extent | count | 0 | integer | | in | F | -!! | km | vertical_dimension | vertical layer dimension | count | 0 | integer | | in | F | -!! | ux | x_wind | x component of layer wind | m s-1 | 2 | real | kind_phys | in | F | -!! | vx | y_wind | y component of layer wind | m s-1 | 2 | real | kind_phys | in | F | -!! | tx | air_temperature | layer mean air temperature | K | 2 | real | kind_phys | in | F | -!! | qx | tracer_concentration | model layer mean tracer concentration | kg kg-1 | 3 | real | kind_phys | in | F | -!! | p2d | air_pressure | mean layer pressure | Pa | 2 | real | kind_phys | in | F | -!! | p2di | air_pressure_at_interface | air pressure at model layer interfaces | Pa | 2 | real | kind_phys | in | F | -!! | pi2d | dimensionless_exner_function_at_model_layers | Exner function at layers | none | 2 | real | kind_phys | in | F | -!! | vtnp | tendency_of_y_wind_due_to_model_physics | updated tendency of the y wind | m s-2 | 2 | real | kind_phys | inout | F | -!! | utnp | tendency_of_x_wind_due_to_model_physics | updated tendency of the x wind | m s-2 | 2 | real | kind_phys | inout | F | -!! | ttnp | tendency_of_air_temperature_due_to_model_physics | updated tendency of the temperature | K s-1 | 2 | real | kind_phys | inout | F | -!! | qtnp | tendency_of_tracers_due_to_model_physics | updated tendency of the tracers due to model physics | kg kg-1 s-1 | 3 | real | kind_phys | inout | F | -!! | swh | tendency_of_air_temperature_due_to_shortwave_heating_on_radiation_time_step | total sky shortwave heating rate | K s-1 | 2 | real | kind_phys | in | F | -!! | hlw | tendency_of_air_temperature_due_to_longwave_heating_on_radiation_time_step | total sky longwave heating rate | K s-1 | 2 | real | kind_phys | in | F | -!! | xmu | zenith_angle_temporal_adjustment_factor_for_shortwave_fluxes | zenith angle temporal adjustment factor for shortwave | none | 1 | real | kind_phys | in | F | -!! | ntrac | number_of_tracers | number of tracers | count | 0 | integer | | in | F | -!! | ndiff | number_of_vertical_diffusion_tracers | number of tracers to diffuse vertically | count | 0 | integer | | in | F | -!! | ntcw | index_for_liquid_cloud_condensate | tracer index for cloud condensate (or liquid water) | index | 0 | integer | | in | F | -!! | ntiw | index_for_ice_cloud_condensate | tracer index for ice water | index | 0 | integer | | in | F | -!! | phii | geopotential_at_interface | geopotential at model layer interfaces | m2 s-2 | 2 | real | kind_phys | in | F | -!! | phil | geopotential | geopotential at model layer centers | m2 s-2 | 2 | real | kind_phys | in | F | -!! | psfcpa | surface_air_pressure | surface pressure | Pa | 1 | real | kind_phys | in | F | -!! | zorl | surface_roughness_length | surface roughness length in cm | cm | 1 | real | kind_phys | in | F | -!! | stress | surface_wind_stress | surface wind stress | m2 s-2 | 1 | real | kind_phys | in | F | -!! | hpbl | atmosphere_boundary_layer_thickness | PBL thickness | m | 1 | real | kind_phys | out | F | -!! | psim | Monin-Obukhov_similarity_function_for_momentum | Monin-Obukhov similarity function for momentum | none | 1 | real | kind_phys | in | F | -!! | psih | Monin-Obukhov_similarity_function_for_heat | Monin-Obukhov similarity function for heat | none | 1 | real | kind_phys | in | F | -!! | landmask | sea_land_ice_mask | landmask: sea/land/ice=0/1/2 | flag | 1 | integer | | in | F | -!! | heat | kinematic_surface_upward_sensible_heat_flux | kinematic surface upward sensible heat flux | K m s-1 | 1 | real | kind_phys | in | F | -!! | evap | kinematic_surface_upward_latent_heat_flux | kinematic surface upward latent heat flux | kg kg-1 m s-1 | 1 | real | kind_phys | in | F | -!! | wspd | wind_speed_at_lowest_model_layer | wind speed at lowest model level | m s-1 | 1 | real | kind_phys | in | F | -!! | br | bulk_richardson_number_at_lowest_model_level | bulk Richardson number at the surface | none | 1 | real | kind_phys | in | F | -!! | g | gravitational_acceleration | gravitational acceleration | m s-2 | 0 | real | kind_phys | in | F | -!! | rd | gas_constant_dry_air | ideal gas constant for dry air | J kg-1 K-1 | 0 | real | kind_phys | in | F | -!! | cp | specific_heat_of_dry_air_at_constant_pressure | specific heat of dry air at constant pressure | J kg-1 K-1 | 0 | real | kind_phys | in | F | -!! | rv | gas_constant_water_vapor | ideal gas constant for water vapor | J kg-1 K-1 | 0 | real | kind_phys | in | F | -!! | ep1 | ratio_of_vapor_to_dry_air_gas_constants_minus_one | rv/rd - 1 (rv = ideal gas constant for water vapor) | none | 0 | real | kind_phys | in | F | -!! | ep2 | ratio_of_dry_air_to_water_vapor_gas_constants | rd/rv | none | 0 | real | kind_phys | in | F | -!! | xlv | latent_heat_of_vaporization_of_water_at_0C | latent heat of evaporation/sublimation | J kg-1 | 0 | real | kind_phys | in | F | -!! | dusfc | instantaneous_surface_x_momentum_flux | x momentum flux | Pa | 1 | real | kind_phys | out | F | -!! | dvsfc | instantaneous_surface_y_momentum_flux | y momentum flux | Pa | 1 | real | kind_phys | out | F | -!! | dtsfc | instantaneous_surface_upward_sensible_heat_flux | surface upward sensible heat flux | W m-2 | 1 | real | kind_phys | out | F | -!! | dqsfc | instantaneous_surface_upward_latent_heat_flux | surface upward latent heat flux | W m-2 | 1 | real | kind_phys | out | F | -!! | dt | time_step_for_physics | time step for physics | s | 0 | real | kind_phys | in | F | -!! | kpbl1d | vertical_index_at_top_of_atmosphere_boundary_layer | PBL top model level index | index | 1 | integer | | out | F | -!! | u10 | x_wind_at_10m | x component of wind at 10 m | m s-1 | 1 | real | kind_phys | in | F | -!! | v10 | y_wind_at_10m | y component of wind at 10 m | m s-1 | 1 | real | kind_phys | in | F | -!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | -!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | +!! \htmlinclude ysuvdif_run.html !! !------------------------------------------------------------------------------- - subroutine ysuvdif_run(ix,im,km,ux,vx,tx,qx,p2d,p2di,pi2d, & + subroutine ysuvdif_run(ix,im,km,ux,vx,tx,qx,p2d,p2di,pi2d, & utnp,vtnp,ttnp,qtnp, & swh,hlw,xmu,ntrac,ndiff,ntcw,ntiw, & phii,phil,psfcpa, & diff --git a/physics/ysuvdif.meta b/physics/ysuvdif.meta new file mode 100644 index 000000000..da01b0a41 --- /dev/null +++ b/physics/ysuvdif.meta @@ -0,0 +1,452 @@ +[ccpp-arg-table] + name = ysuvdif_run + type = scheme +[ix] + standard_name = horizontal_dimension + long_name = horizontal dimension + units = count + dimensions = () + type = integer + intent = in + optional = F +[im] + standard_name = horizontal_loop_extent + long_name = horizontal loop extent + units = count + dimensions = () + type = integer + intent = in + optional = F +[km] + standard_name = vertical_dimension + long_name = vertical layer dimension + units = count + dimensions = () + type = integer + intent = in + optional = F +[ux] + standard_name = x_wind + long_name = x component of layer wind + units = m s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[vx] + standard_name = y_wind + long_name = y component of layer wind + units = m s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[tx] + standard_name = air_temperature + long_name = layer mean air temperature + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[qx] + standard_name = tracer_concentration + long_name = model layer mean tracer concentration + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension,number_of_tracers) + type = real + kind = kind_phys + intent = in + optional = F +[p2d] + standard_name = air_pressure + long_name = mean layer pressure + units = Pa + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[p2di] + standard_name = air_pressure_at_interface + long_name = air pressure at model layer interfaces + units = Pa + dimensions = (horizontal_dimension,vertical_dimension_plus_one) + type = real + kind = kind_phys + intent = in + optional = F +[pi2d] + standard_name = dimensionless_exner_function_at_model_layers + long_name = Exner function at layers + units = none + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[vtnp] + standard_name = tendency_of_y_wind_due_to_model_physics + long_name = updated tendency of the y wind + units = m s-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[utnp] + standard_name = tendency_of_x_wind_due_to_model_physics + long_name = updated tendency of the x wind + units = m s-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[ttnp] + standard_name = tendency_of_air_temperature_due_to_model_physics + long_name = updated tendency of the temperature + units = K s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[qtnp] + standard_name = tendency_of_tracers_due_to_model_physics + long_name = updated tendency of the tracers due to model physics + units = kg kg-1 s-1 + dimensions = (horizontal_dimension,vertical_dimension,number_of_tracers) + type = real + kind = kind_phys + intent = inout + optional = F +[swh] + standard_name = tendency_of_air_temperature_due_to_shortwave_heating_on_radiation_timestep + long_name = total sky shortwave heating rate + units = K s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[hlw] + standard_name = tendency_of_air_temperature_due_to_longwave_heating_on_radiation_timestep + long_name = total sky longwave heating rate + units = K s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[xmu] + standard_name = zenith_angle_temporal_adjustment_factor_for_shortwave_fluxes + long_name = zenith angle temporal adjustment factor for shortwave + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[ntrac] + standard_name = number_of_tracers + long_name = number of tracers + units = count + dimensions = () + type = integer + intent = in + optional = F +[ndiff] + standard_name = number_of_vertical_diffusion_tracers + long_name = number of tracers to diffuse vertically + units = count + dimensions = () + type = integer + intent = in + optional = F +[ntcw] + standard_name = index_for_liquid_cloud_condensate + long_name = tracer index for cloud condensate (or liquid water) + units = index + dimensions = () + type = integer + intent = in + optional = F +[ntiw] + standard_name = index_for_ice_cloud_condensate + long_name = tracer index for ice water + units = index + dimensions = () + type = integer + intent = in + optional = F +[phii] + standard_name = geopotential_at_interface + long_name = geopotential at model layer interfaces + units = m2 s-2 + dimensions = (horizontal_dimension,vertical_dimension_plus_one) + type = real + kind = kind_phys + intent = in + optional = F +[phil] + standard_name = geopotential + long_name = geopotential at model layer centers + units = m2 s-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[psfcpa] + standard_name = surface_air_pressure + long_name = surface pressure + units = Pa + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[zorl] + standard_name = surface_roughness_length + long_name = surface roughness length in cm + units = cm + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[stress] + standard_name = surface_wind_stress + long_name = surface wind stress + units = m2 s-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[hpbl] + standard_name = atmosphere_boundary_layer_thickness + long_name = PBL thickness + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[psim] + standard_name = Monin_Obukhov_similarity_function_for_momentum + long_name = Monin-Obukhov similarity function for momentum + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[psih] + standard_name = Monin_Obukhov_similarity_function_for_heat + long_name = Monin-Obukhov similarity function for heat + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[landmask] + standard_name = sea_land_ice_mask + long_name = landmask: sea/land/ice=0/1/2 + units = flag + dimensions = (horizontal_dimension) + type = integer + intent = in + optional = F +[heat] + standard_name = kinematic_surface_upward_sensible_heat_flux + long_name = kinematic surface upward sensible heat flux + units = K m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[evap] + standard_name = kinematic_surface_upward_latent_heat_flux + long_name = kinematic surface upward latent heat flux + units = kg kg-1 m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[wspd] + standard_name = wind_speed_at_lowest_model_layer + long_name = wind speed at lowest model level + units = m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[br] + standard_name = bulk_richardson_number_at_lowest_model_level + long_name = bulk Richardson number at the surface + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[g] + standard_name = gravitational_acceleration + long_name = gravitational acceleration + units = m s-2 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[rd] + standard_name = gas_constant_dry_air + long_name = ideal gas constant for dry air + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[cp] + standard_name = specific_heat_of_dry_air_at_constant_pressure + long_name = specific heat of dry air at constant pressure + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[rv] + standard_name = gas_constant_water_vapor + long_name = ideal gas constant for water vapor + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[ep1] + standard_name = ratio_of_vapor_to_dry_air_gas_constants_minus_one + long_name = rv/rd - 1 (rv = ideal gas constant for water vapor) + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[ep2] + standard_name = ratio_of_dry_air_to_water_vapor_gas_constants + long_name = rd/rv + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[xlv] + standard_name = latent_heat_of_vaporization_of_water_at_0C + long_name = latent heat of evaporation/sublimation + units = J kg-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[dusfc] + standard_name = instantaneous_surface_x_momentum_flux + long_name = x momentum flux + units = Pa + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[dvsfc] + standard_name = instantaneous_surface_y_momentum_flux + long_name = y momentum flux + units = Pa + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[dtsfc] + standard_name = instantaneous_surface_upward_sensible_heat_flux + long_name = surface upward sensible heat flux + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[dqsfc] + standard_name = instantaneous_surface_upward_latent_heat_flux + long_name = surface upward latent heat flux + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[dt] + standard_name = time_step_for_physics + long_name = time step for physics + units = s + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[kpbl1d] + standard_name = vertical_index_at_top_of_atmosphere_boundary_layer + long_name = PBL top model level index + units = index + dimensions = (horizontal_dimension) + type = integer + intent = out + optional = F +[u10] + standard_name = x_wind_at_10m + long_name = x component of wind at 10 m + units = m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[v10] + standard_name = y_wind_at_10m + long_name = y component of wind at 10 m + units = m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F diff --git a/stochastic_physics/compns_stochy.F90 b/stochastic_physics/compns_stochy.F90 deleted file mode 100644 index 7015d937f..000000000 --- a/stochastic_physics/compns_stochy.F90 +++ /dev/null @@ -1,214 +0,0 @@ -!>\file compns_stochy.F90 -!! This file includes ... - -!>\ingroup gfs_stoch -!! This module -module compns_stochy_mod - - implicit none - - contains - -!----------------------------------------------------------------------- - subroutine compns_stochy (me,sz_nml,input_nml_file,fn_nml,nlunit,deltim,iret) -!$$$ Subprogram Documentation Block -! -! Subprogram: compns Check and compute namelist frequencies -! Prgmmr: Iredell Org: NP23 Date: 1999-01-26 -! -! Abstract: This subprogram checks global spectral model namelist -! frequencies in hour units for validity. If they are valid, -! then the frequencies are computed in timestep units. -! The following rules are applied: -! 1. the timestep must be positive; -! -! Program History Log: -! 2016-10-11 Phil Pegion make the stochastic physics stand alone -! -! Usage: call compns_stochy (me,deltim,nlunit, stochy_namelist,iret) -! Input Arguments: -! deltim - real timestep in seconds -! Output Arguments: -! iret - integer return code (0 if successful or -! between 1 and 8 for which rule above was broken) -! stochy_namelist -! -! Attributes: -! Language: Fortran 90 -! -!$$$ - - - use stochy_namelist_def - - implicit none - - - integer, intent(out) :: iret - integer, intent(in) :: nlunit,me,sz_nml - character(len=*), intent(in) :: input_nml_file(sz_nml) - character(len=64), intent(in) :: fn_nml - real, intent(in) :: deltim - real tol - integer k,ios - -! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -! - namelist /nam_stochy/ntrunc,lon_s,lat_s,sppt,sppt_tau,sppt_lscale,sppt_logit, & - iseed_shum,iseed_sppt,shum,shum_tau,& - shum_lscale,fhstoch,stochini,skeb_varspect_opt,sppt_sfclimit, & - skeb,skeb_tau,skeb_vdof,skeb_lscale,iseed_skeb,skeb_vfilt,skeb_diss_smooth, & - skeb_sigtop1,skeb_sigtop2,skebnorm,sppt_sigtop1,sppt_sigtop2,& - shum_sigefold,skebint,skeb_npass,use_zmtnblck - namelist /nam_sfcperts/nsfcpert,pertz0,pertshc,pertzt,pertlai, & ! mg, sfcperts - pertvegf,pertalb,iseed_sfc,sfc_tau,sfc_lscale,sppt_land - - tol=0.01 ! tolerance for calculations -! spectral resolution defintion - ntrunc=-999 - lon_s=-999 - lat_s=-999 - ! can specify up to 5 values for the stochastic physics parameters - ! (each is an array of length 5) - sppt = -999. !< stochastic physics tendency amplitude - shum = -999. !< stochastic boundary layer spf hum amp - skeb = -999. !< stochastic KE backscatter amplitude - ! mg, sfcperts - pertz0 = -999. !< momentum roughness length amplitude - pertshc = -999. !< soil hydraulic conductivity amp - pertzt = -999. !< mom/heat roughness length amplitude - pertlai = -999. !< leaf area index amplitude - pertvegf = -999. !< vegetation fraction amplitude - pertalb = -999. !< albedo perturbations amplitude -! logicals - do_sppt = .false. - use_zmtnblck = .false. - do_shum = .false. - do_skeb = .false. - ! mg, sfcperts - do_sfcperts = .false. - sppt_land = .false. - nsfcpert = 0 -! for sfcperts random patterns - sfc_lscale = -999. !< length scales - sfc_tau = -999. ! time scales - iseed_sfc = 0 ! random seeds (if 0 use system clock) -! for SKEB random patterns. - skeb_vfilt = 0 - skebint = 0 - skeb_npass = 11 ! number of passes of smoother for dissipation estiamte - sppt_tau = -999. ! time scales - shum_tau = -999. - skeb_tau = -999. - skeb_vdof = 5 ! proxy for vertical correlation, 5 is close to 40 passes of the 1-2-1 filter in the GFS - skebnorm = 0 ! 0 - random pattern is stream function, 1- pattern is kenorm, 2- pattern is vorticity - sppt_lscale = -999. ! length scales - shum_lscale = -999. - skeb_lscale = -999. - iseed_sppt = 0 ! random seeds (if 0 use system clock) - iseed_shum = 0 - iseed_skeb = 0 -! parameters to control vertical tapering of stochastic physics with -! height - sppt_sigtop1 = 0.1 - sppt_sigtop2 = 0.025 - skeb_sigtop1 = 0.1 - skeb_sigtop2 = 0.025 - shum_sigefold = 0.2 -! reduce amplitude of sppt near surface (lowest 2 levels) - sppt_sfclimit = .false. -! gaussian or power law variance spectrum for skeb (0: gaussian, 1: -! power law). If power law, skeb_lscale interpreted as a power not a -! length scale. - skeb_varspect_opt = 0 - sppt_logit = .false. ! logit transform for sppt to bounded interval [-1,+1] - fhstoch = -999.0 ! forecast hour to dump random patterns - stochini = .false. ! true= read in pattern, false=initialize from seed - -#ifdef INTERNAL_FILE_NML - read(input_nml_file, nml=nam_stochy) -#else - rewind (nlunit) - open (unit=nlunit, file=fn_nml, READONLY, status='OLD', iostat=ios) - read(nlunit,nam_stochy) -#endif -#ifdef INTERNAL_FILE_NML - read(input_nml_file, nml=nam_sfcperts) -#else - rewind (nlunit) - open (unit=nlunit, file=fn_nml, READONLY, status='OLD', iostat=ios) - read(nlunit,nam_sfcperts) -#endif - - if (me == 0) then - print *,' in compns_stochy' - print*,'skeb=',skeb - endif - -! PJP stochastic physics additions - IF (sppt(1) > 0 ) THEN - do_sppt=.true. - ENDIF - IF (shum(1) > 0 ) THEN - do_shum=.true. -! shum parameter has units of 1/hour, to remove time step -! dependence. -! change shum parameter units from per hour to per timestep - DO k=1,5 - IF (shum(k) .gt. 0.0) shum(k)=shum(k)*deltim/3600.0 - ENDDO - ENDIF - IF (skeb(1) > 0 ) THEN - do_skeb=.true. - if (skebnorm==0) then ! stream function norm - skeb=skeb*1.111e3*sqrt(deltim) - !skeb=skeb*5.0e5/sqrt(deltim) - endif - if (skebnorm==1) then ! stream function norm - skeb=skeb*0.00222*sqrt(deltim) - !skeb=skeb*1/sqrt(deltim) - endif - if (skebnorm==2) then ! vorticty function norm - skeb=skeb*1.111e-9*sqrt(deltim) - !skeb=skeb*5.0e-7/sqrt(deltim) - endif -! adjust skeb values for resolution. -! scaling is such that a value of 1.0 at T574 with a 900 second -! timestep produces well-calibrated values of forecast spread. -! DO k=1,5 -! IF (skeb(k) .gt. 0.0) THEN -! skeb(k)=skeb(k)*deltim/(ntrunc*(ntrunc+1))*365765.0 ! 365765 is a scale factor so the base SKEB value in the namelist is 1.0 -! skeb(k)=skeb(k)*deltim/(ntrunc*(ntrunc+1))*2000.0 ! 2000 is new scale factor so the base SKEB value in the namelist is 1.0 -! ENDIF -! ENDDO - ENDIF -! compute frequencty to estimate dissipation timescale - IF (skebint == 0.) skebint=deltim - nsskeb=nint(skebint/deltim) ! skebint in seconds - IF(nsskeb<=0 .or. abs(nsskeb-skebint/deltim)>tol) THEN - WRITE(0,*) "SKEB interval is invalid",skebint - iret=9 - return - ENDIF -! mg, sfcperts - IF (pertz0(1) > 0 .OR. pertshc(1) > 0 .OR. pertzt(1) > 0 .OR. & - pertlai(1) > 0 .OR. pertvegf(1) > 0 .OR. pertalb(1) > 0) THEN - do_sfcperts=.true. - ENDIF -! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -! -! All checks are successful. -! - if (me == 0) then - print *, 'stochastic physics' - print *, ' do_sppt : ', do_sppt - print *, ' do_shum : ', do_shum - print *, ' do_skeb : ', do_skeb - print *, ' do_sfcperts : ', do_sfcperts - endif - iret = 0 -! - return - end subroutine compns_stochy - -end module compns_stochy_mod diff --git a/stochastic_physics/dezouv_stochy.f b/stochastic_physics/dezouv_stochy.f deleted file mode 100644 index 32f4e7dba..000000000 --- a/stochastic_physics/dezouv_stochy.f +++ /dev/null @@ -1,269 +0,0 @@ - module dezouv_stochy_mod - - implicit none - - contains - - subroutine dezouv_stochy(dev,zod,uev,vod,epsedn,epsodn, - & snnp1ev,snnp1od,ls_node) -cc - -cc - use stochy_resol_def - use spectral_layout_mod - use machine - implicit none -cc - real(kind_dbl_prec) dev(len_trie_ls,2) - real(kind_dbl_prec) zod(len_trio_ls,2) - real(kind_dbl_prec) uev(len_trie_ls,2) - real(kind_dbl_prec) vod(len_trio_ls,2) -cc - real(kind_dbl_prec) epsedn(len_trie_ls) - real(kind_dbl_prec) epsodn(len_trio_ls) -cc - real(kind_dbl_prec) snnp1ev(len_trie_ls) - real(kind_dbl_prec) snnp1od(len_trio_ls) -cc - integer ls_node(ls_dim,3) -cc -!cmr ls_node(1,1) ... ls_node(ls_max_node,1) : values of L -!cmr ls_node(1,2) ... ls_node(ls_max_node,2) : values of jbasev -!cmr ls_node(1,3) ... ls_node(ls_max_node,3) : values of jbasod -cc - integer l,locl,n -cc - integer indev,indev1,indev2 - integer indod,indod1,indod2 - integer inddif -cc - real(kind_dbl_prec) rl -cc - real(kind_dbl_prec) cons0 !constant -cc - integer indlsev,jbasev - integer indlsod,jbasod - real(kind_evod) rerth -cc - include 'function2' -cc -cc -cc...................................................................... -cc -cc - cons0 = 0.d0 !constant - rerth =6.3712e+6 ! radius of earth (m) -cc -cc - do locl=1,ls_max_node - l=ls_node(locl,1) - jbasev=ls_node(locl,2) -cc - uev(indlsev(l,l),1) = cons0 !constant - uev(indlsev(l,l),2) = cons0 !constant -cc -cc - enddo -cc -cc...................................................................... -cc - do locl=1,ls_max_node - l=ls_node(locl,1) - jbasev=ls_node(locl,2) - jbasod=ls_node(locl,3) - indev1 = indlsev(L,L) + 1 - if (mod(L,2).eq.mod(jcap+1,2)) then - indev2 = indlsev(jcap+1,L) - else - indev2 = indlsev(jcap ,L) - endif - indod1 = indlsod(l+1,l) - inddif = indev1 - indod1 -cc - do indev = indev1 , indev2 -cc - uev(indev,1) = -epsedn(indev) - x * zod(indev-inddif,1) -cc - uev(indev,2) = -epsedn(indev) - x * zod(indev-inddif,2) -cc - enddo -cc - enddo -cc -cc...................................................................... -cc - do locl=1,ls_max_node - l=ls_node(locl,1) - jbasev=ls_node(locl,2) - jbasod=ls_node(locl,3) - indev1 = indlsev(L,L) - if (mod(L,2).eq.mod(jcap+1,2)) then - indev2 = indlsev(jcap-1,L) - else - indev2 = indlsev(jcap ,L) - endif - indod1 = indlsod(l+1,l) - inddif = indev1 - indod1 -cc - do indev = indev1 , indev2 -cc - vod(indev-inddif,1) = epsodn(indev-inddif) - x * dev(indev,1) -cc - vod(indev-inddif,2) = epsodn(indev-inddif) - x * dev(indev,2) -cc - enddo -cc - enddo -cc -cc...................................................................... -cc - do locl=1,ls_max_node - l=ls_node(locl,1) - jbasev=ls_node(locl,2) - indev1 = indlsev(L,L) - if (mod(L,2).eq.mod(jcap+1,2)) then - indev2 = indlsev(jcap-1,L) - else - indev2 = indlsev(jcap ,L) - endif - if ( l .ge. 1 ) then - rl = l - do indev = indev1 , indev2 -cc u(l,n)=-i*l*d(l,n)/(n*(n+1)) -cc - uev(indev,1) = uev(indev,1) - 1 + rl * dev(indev,2) - 2 / snnp1ev(indev) -cc - uev(indev,2) = uev(indev,2) - 1 - rl * dev(indev,1) - 2 / snnp1ev(indev) -cc - enddo - endif -cc - enddo -cc -cc...................................................................... -cc - do locl=1,ls_max_node - l=ls_node(locl,1) - jbasod=ls_node(locl,3) - indod1 = indlsod(L+1,L) - if (mod(L,2).eq.mod(jcap+1,2)) then - indod2 = indlsod(jcap ,L) - else - indod2 = indlsod(jcap+1,L) - 1 - endif - if ( l .ge. 1 ) then - rl = l - do indod = indod1 , indod2 -cc u(l,n)=-i*l*d(l,n)/(n*(n+1)) -cc - vod(indod,1) = vod(indod,1) - 1 + rl * zod(indod,2) - 2 / snnp1od(indod) -cc - vod(indod,2) = vod(indod,2) - 1 - rl * zod(indod,1) - 2 / snnp1od(indod) -cc - enddo - endif -cc - enddo -cc -cc...................................................................... -cc - do locl=1,ls_max_node - l=ls_node(locl,1) - jbasev=ls_node(locl,2) - jbasod=ls_node(locl,3) - indev1 = indlsev(L,L) - if (mod(L,2).eq.mod(jcap+1,2)) then - indev2 = indlsev(jcap+1,L) - 1 - else - indev2 = indlsev(jcap ,L) - 1 - endif - indod1 = indlsod(l+1,l) - inddif = indev1 - indod1 -cc - do indev = indev1 , indev2 -cc - uev(indev,1) = uev(indev ,1) - 1 + epsodn(indev-inddif) * zod(indev-inddif,1) -cc - uev(indev,2) = uev(indev ,2) - 1 + epsodn(indev-inddif) * zod(indev-inddif,2) -cc - enddo -cc - enddo -cc -cc...................................................................... -cc - do locl=1,ls_max_node - l=ls_node(locl,1) - jbasev=ls_node(locl,2) - jbasod=ls_node(locl,3) - indev1 = indlsev(L,L) + 1 - if (mod(L,2).eq.mod(jcap+1,2)) then - indev2 = indlsev(jcap-1,L) - else - indev2 = indlsev(jcap ,L) - endif - indod1 = indlsod(l+1,l) - inddif = indev1 - indod1 -cc - do indev = indev1 , indev2 -cc - vod(indev-inddif,1) = vod(indev-inddif,1) - 1 - epsedn(indev) * dev(indev ,1) -cc - vod(indev-inddif,2) = vod(indev-inddif,2) - 1 - epsedn(indev) * dev(indev ,2) -cc - enddo -cc - enddo -cc -cc...................................................................... -cc -cc - do locl=1,ls_max_node - l=ls_node(locl,1) - jbasev=ls_node(locl,2) - jbasod=ls_node(locl,3) - indev1 = indlsev(L,L) - indod1 = indlsod(L+1,L) - if (mod(L,2).eq.mod(jcap+1,2)) then - indev2 = indlsev(jcap+1,L) - indod2 = indlsod(jcap ,L) - else - indev2 = indlsev(jcap ,L) - indod2 = indlsod(jcap+1,L) - endif - do indev = indev1 , indev2 -cc - uev(indev,1) = uev(indev,1) * rerth - uev(indev,2) = uev(indev,2) * rerth -cc - enddo -cc - do indod = indod1 , indod2 -cc - vod(indod,1) = vod(indod,1) * rerth - vod(indod,2) = vod(indod,2) * rerth -cc - enddo -cc - enddo -cc - return - end - - end module dezouv_stochy_mod diff --git a/stochastic_physics/dozeuv_stochy.f b/stochastic_physics/dozeuv_stochy.f deleted file mode 100644 index 4ff5ad8f2..000000000 --- a/stochastic_physics/dozeuv_stochy.f +++ /dev/null @@ -1,267 +0,0 @@ - module dozeuv_stochy_mod - - implicit none - - contains - - subroutine dozeuv_stochy(dod,zev,uod,vev,epsedn,epsodn, - & snnp1ev,snnp1od,ls_node) -cc - use stochy_resol_def - use spectral_layout_mod - use machine - implicit none -cc - real(kind_dbl_prec) dod(len_trio_ls,2) - real(kind_dbl_prec) zev(len_trie_ls,2) - real(kind_dbl_prec) uod(len_trio_ls,2) - real(kind_dbl_prec) vev(len_trie_ls,2) -cc - real(kind_dbl_prec) epsedn(len_trie_ls) - real(kind_dbl_prec) epsodn(len_trio_ls) -cc - real(kind_dbl_prec) snnp1ev(len_trie_ls) - real(kind_dbl_prec) snnp1od(len_trio_ls) -cc - integer ls_node(ls_dim,3) -cc -!cmr ls_node(1,1) ... ls_node(ls_max_node,1) : values of L -!cmr ls_node(1,2) ... ls_node(ls_max_node,2) : values of jbasev -!cmr ls_node(1,3) ... ls_node(ls_max_node,3) : values of jbasod -cc - integer l,locl,n -cc - integer indev,indev1,indev2 - integer indod,indod1,indod2 - integer inddif -cc - real(kind_dbl_prec) rl -cc - real(kind_dbl_prec) cons0 !constant -cc - integer indlsev,jbasev - integer indlsod,jbasod - real(kind_evod) rerth -cc - include 'function2' -cc -cc -cc...................................................................... -cc -cc - cons0 = 0.d0 !constant - rerth =6.3712e+6 ! radius of earth (m) -cc -cc - do locl=1,ls_max_node - l=ls_node(locl,1) - jbasev=ls_node(locl,2) -cc - vev(indlsev(l,l),1) = cons0 !constant - vev(indlsev(l,l),2) = cons0 !constant -cc -cc - enddo -cc -cc...................................................................... -cc - do locl=1,ls_max_node - l=ls_node(locl,1) - jbasev=ls_node(locl,2) - jbasod=ls_node(locl,3) - indev1 = indlsev(L,L) - if (mod(L,2).eq.mod(jcap+1,2)) then - indev2 = indlsev(jcap-1,L) - else - indev2 = indlsev(jcap ,L) - endif - indod1 = indlsod(l+1,l) - inddif = indev1 - indod1 -cc - do indev = indev1 , indev2 -cc - uod(indev-inddif,1) = -epsodn(indev-inddif) - x * zev(indev,1) -cc - uod(indev-inddif,2) = -epsodn(indev-inddif) - x * zev(indev,2) -cc - enddo -cc - enddo -cc -cc...................................................................... -cc - do locl=1,ls_max_node - l=ls_node(locl,1) - jbasev=ls_node(locl,2) - jbasod=ls_node(locl,3) - indev1 = indlsev(L,L) + 1 - if (mod(L,2).eq.mod(jcap+1,2)) then - indev2 = indlsev(jcap+1,L) - else - indev2 = indlsev(jcap ,L) - endif - indod1 = indlsod(l+1,l) - inddif = indev1 - indod1 -cc - do indev = indev1 , indev2 -cc - vev(indev,1) = epsedn(indev) - x * dod(indev-inddif,1) -cc - vev(indev,2) = epsedn(indev) - x * dod(indev-inddif,2) -cc - enddo -cc - enddo -cc -cc...................................................................... -cc - do locl=1,ls_max_node - l=ls_node(locl,1) - jbasod=ls_node(locl,3) - indod1 = indlsod(L+1,L) - if (mod(L,2).eq.mod(jcap+1,2)) then - indod2 = indlsod(jcap ,L) - else - indod2 = indlsod(jcap+1,L) - 1 - endif - if ( l .ge. 1 ) then - rl = l - do indod = indod1 , indod2 -cc u(l,n)=-i*l*d(l,n)/(n*(n+1)) -cc - uod(indod,1) = uod(indod,1) - 1 + rl * dod(indod,2) - 2 / snnp1od(indod) -cc - uod(indod,2) = uod(indod,2) - 1 - rl * dod(indod,1) - 2 / snnp1od(indod) -cc - enddo - endif -cc - enddo -cc -cc...................................................................... -cc - do locl=1,ls_max_node - l=ls_node(locl,1) - jbasev=ls_node(locl,2) - indev1 = indlsev(L,L) - if (mod(L,2).eq.mod(jcap+1,2)) then - indev2 = indlsev(jcap-1,L) - else - indev2 = indlsev(jcap ,L) - endif - if ( l .ge. 1 ) then - rl = l - do indev = indev1 , indev2 -cc u(l,n)=-i*l*d(l,n)/(n*(n+1)) -cc - vev(indev,1) = vev(indev,1) - 1 + rl * zev(indev,2) - 2 / snnp1ev(indev) -cc - vev(indev,2) = vev(indev,2) - 1 - rl * zev(indev,1) - 2 / snnp1ev(indev) -cc - enddo - endif -cc - enddo -cc -cc...................................................................... -cc - do locl=1,ls_max_node - l=ls_node(locl,1) - jbasev=ls_node(locl,2) - jbasod=ls_node(locl,3) - indev1 = indlsev(L,L) + 1 - if (mod(L,2).eq.mod(jcap+1,2)) then - indev2 = indlsev(jcap-1,L) - else - indev2 = indlsev(jcap ,L) - endif - indod1 = indlsod(l+1,l) - inddif = indev1 - indod1 -cc - do indev = indev1 , indev2 -cc - uod(indev-inddif,1) = uod(indev-inddif,1) - 1 + epsedn(indev) * zev(indev ,1) -cc - uod(indev-inddif,2) = uod(indev-inddif,2) - 1 + epsedn(indev) * zev(indev ,2) -cc - enddo -cc - enddo -cc -cc...................................................................... -cc - do locl=1,ls_max_node - l=ls_node(locl,1) - jbasev=ls_node(locl,2) - jbasod=ls_node(locl,3) - indev1 = indlsev(L,L) - if (mod(L,2).eq.mod(jcap+1,2)) then - indev2 = indlsev(jcap+1,L) - 1 - else - indev2 = indlsev(jcap ,L) - 1 - endif - indod1 = indlsod(l+1,l) - inddif = indev1 - indod1 -cc - do indev = indev1 , indev2 -cc - vev(indev,1) = vev(indev ,1) - 1 - epsodn(indev-inddif) * dod(indev-inddif,1) -cc - vev(indev,2) = vev(indev ,2) - 1 - epsodn(indev-inddif) * dod(indev-inddif,2) -cc - enddo -cc - enddo -cc -cc...................................................................... -cc -cc - do locl=1,ls_max_node - l=ls_node(locl,1) - jbasev=ls_node(locl,2) - jbasod=ls_node(locl,3) - indev1 = indlsev(L,L) - indod1 = indlsod(L+1,L) - if (mod(L,2).eq.mod(jcap+1,2)) then - indev2 = indlsev(jcap+1,L) - indod2 = indlsod(jcap ,L) - else - indev2 = indlsev(jcap ,L) - indod2 = indlsod(jcap+1,L) - endif - do indod = indod1 , indod2 -cc - uod(indod,1) = uod(indod,1) * rerth - uod(indod,2) = uod(indod,2) * rerth -cc - enddo -cc - do indev = indev1 , indev2 -cc - vev(indev,1) = vev(indev,1) * rerth - vev(indev,2) = vev(indev,2) * rerth -cc - enddo -cc - enddo -cc - return - end - - end module dozeuv_stochy_mod diff --git a/stochastic_physics/epslon_stochy.f b/stochastic_physics/epslon_stochy.f deleted file mode 100644 index c7aace515..000000000 --- a/stochastic_physics/epslon_stochy.f +++ /dev/null @@ -1,93 +0,0 @@ - module epslon_stochy_mod - - implicit none - - contains - - subroutine epslon_stochy(epse,epso,epsedn,epsodn, - & ls_node) -cc - use stochy_resol_def - use spectral_layout_mod - use machine - implicit none -cc - real(kind_dbl_prec) epse(len_trie_ls) - real(kind_dbl_prec) epso(len_trio_ls) -cc - real(kind_dbl_prec) epsedn(len_trie_ls) - real(kind_dbl_prec) epsodn(len_trio_ls) -cc - integer ls_node(ls_dim,3) -cc -!cmr ls_node(1,1) ... ls_node(ls_max_node,1) : values of L -!cmr ls_node(1,2) ... ls_node(ls_max_node,2) : values of jbasev -!cmr ls_node(1,3) ... ls_node(ls_max_node,3) : values of jbasod -cc - integer l,locl,n -cc - integer indev - integer indod -cc - real(kind_dbl_prec) f1,f2,rn,val -cc - real(kind_dbl_prec) cons0 !constant -cc - integer indlsev,jbasev - integer indlsod,jbasod -cc - include 'function2' -cc -cc - cons0=0.0d0 !constant -cc -cc -cc...................................................................... -cc -cc - do locl=1,ls_max_node - l=ls_node(locl,1) - jbasev=ls_node(locl,2) - indev=indlsev(l,l) - epse (indev)=cons0 !constant - epsedn(indev)=cons0 !constant - indev=indev+1 -cc - - do n=l+2,jcap+1,2 - rn=n - f1=n*n-l*l - f2=4*n*n-1 - val=sqrt(f1/f2) - epse (indev)=val - epsedn(indev)=val/rn - indev=indev+1 - enddo -cc - enddo -cc -cc -cc...................................................................... -cc -cc - do locl=1,ls_max_node - l=ls_node(locl,1) - jbasod=ls_node(locl,3) - indod=indlsod(l+1,l) -cc - do n=l+1,jcap+1,2 - rn=n - f1=n*n-l*l - f2=4*n*n-1 - val=sqrt(f1/f2) - epso (indod)=val - epsodn(indod)=val/rn - indod=indod+1 - enddo -cc - enddo -cc - return - end - - end module epslon_stochy_mod diff --git a/stochastic_physics/four_to_grid_stochy.F b/stochastic_physics/four_to_grid_stochy.F deleted file mode 100644 index 5f26a0a7e..000000000 --- a/stochastic_physics/four_to_grid_stochy.F +++ /dev/null @@ -1,271 +0,0 @@ - module four_to_grid_mod - - use stochy_ccpp, only: num_parthds_stochy => ompthreads - - implicit none - - contains - - subroutine four_to_grid(syn_gr_a_1,syn_gr_a_2, - & lon_dim_coef,lon_dim_grid,lons_lat,lot) -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - use machine - implicit none -!! - real(kind=kind_dbl_prec) syn_gr_a_1(lon_dim_coef,lot) - real(kind=kind_dbl_prec) syn_gr_a_2(lon_dim_grid,lot) - integer lon_dim_coef - integer lon_dim_grid - integer lons_lat - integer lot -!________________________________________________________ -#ifdef MKL - integer*8 plan -#else - real(kind=kind_dbl_prec) aux1crs(42002) - real(kind=kind_dbl_prec) scale_ibm - integer ibmsign - integer init -#endif - integer lot_thread - integer num_threads - integer nvar_thread_max - integer nvar_1 - integer nvar_2 - integer thread -#ifdef MKL - include "fftw/fftw3.f" - integer NULL -#else - external dcrft - external scrft -#endif -!________________________________________________________ - num_threads = min(num_parthds_stochy,lot) - - nvar_thread_max = (lot+num_threads-1)/num_threads - - if ( kind_dbl_prec == 8 ) then !------------------------------------ -#ifdef MKL -!$omp parallel do shared(syn_gr_a_1,syn_gr_a_2,lons_lat) -!$omp+shared(lon_dim_coef,lon_dim_grid) -!$omp+shared(lot,num_threads,nvar_thread_max) -!$omp+private(thread,nvar_1,nvar_2,lot_thread,plan) -#else -!$omp parallel do shared(syn_gr_a_1,syn_gr_a_2,lons_lat) -!$omp+shared(lon_dim_coef,lon_dim_grid) -!$omp+shared(lot,num_threads,nvar_thread_max) -!$omp+shared(ibmsign,scale_ibm) -!$omp+private(thread,nvar_1,nvar_2,lot_thread,init,aux1crs) -#endif - do thread=1,num_threads ! start of thread loop .............. - nvar_1=(thread-1)*nvar_thread_max + 1 - nvar_2=min(nvar_1+nvar_thread_max-1,lot) - - lot_thread=nvar_2 - nvar_1 + 1 - - if (nvar_2 >= nvar_1) then -#ifdef MKL - !call dfftw_plan_many_dft_c2r( - ! plan, 1, N, m, & - ! X, NULL, 1, dimx, & - ! Y, NULL, 1, dimy, & - ! fftw_flag) - call dfftw_plan_many_dft_c2r( & - & plan, 1, lons_lat, lot_thread, & - & syn_gr_a_1, NULL, 1, size(syn_gr_a_1,dim=1), & - & syn_gr_a_2, NULL, 1, size(syn_gr_a_2,dim=1), & - & FFTW_ESTIMATE) - call dfftw_execute(plan) - call dfftw_destroy_plan(plan) -#else - init = 1 - ibmsign = -1 - scale_ibm = 1.0d0 - - call dcrft(init, - & syn_gr_a_1(1,nvar_1) ,lon_dim_coef/2, - & syn_gr_a_2(1,nvar_1) ,lon_dim_grid, - & lons_lat,lot_thread,ibmsign,scale_ibm, - & aux1crs,22000, - & aux1crs(22001),20000) - - init = 0 - call dcrft(init, - & syn_gr_a_1(1,nvar_1) ,lon_dim_coef/2, - & syn_gr_a_2(1,nvar_1) ,lon_dim_grid, - & lons_lat,lot_thread,ibmsign,scale_ibm, - & aux1crs,22000, - & aux1crs(22001),20000) -#endif - endif - - enddo ! fin thread loop ...................................... - else !------------------------------------------------------------ -#ifdef MKL -!$omp parallel do shared(syn_gr_a_1,syn_gr_a_2,lons_lat) -!$omp+shared(lon_dim_coef,lon_dim_grid) -!$omp+shared(lot,num_threads,nvar_thread_max) -!$omp+private(thread,nvar_1,nvar_2,lot_thread,plan) -#else -!$omp parallel do shared(syn_gr_a_1,syn_gr_a_2,lons_lat) -!$omp+shared(lon_dim_coef,lon_dim_grid) -!$omp+shared(lot,num_threads,nvar_thread_max) -!$omp+shared(ibmsign,scale_ibm) -!$omp+private(thread,nvar_1,nvar_2,lot_thread,init,aux1crs) -#endif - do thread=1,num_threads ! start of thread loop .............. - nvar_1 = (thread-1)*nvar_thread_max + 1 - nvar_2 = min(nvar_1+nvar_thread_max-1,lot) - - lot_thread = nvar_2 - nvar_1 + 1 - - if (nvar_2 >= nvar_1) then -#ifdef MKL - !call sfftw_plan_many_dft_c2r( - ! plan, 1, N, m, & - ! X, NULL, 1, dimx, & - ! Y, NULL, 1, dimy, & - ! fftw_flag) - call sfftw_plan_many_dft_c2r( & - & plan, 1, lons_lat, lot_thread, & - & syn_gr_a_1, NULL, 1, size(syn_gr_a_1,dim=1), & - & syn_gr_a_2, NULL, 1, size(syn_gr_a_2,dim=1), & - & FFTW_ESTIMATE) - call sfftw_execute(plan) - call sfftw_destroy_plan(plan) -#else - init = 1 - ibmsign = -1 - scale_ibm = 1.0d0 - call scrft(init, - & syn_gr_a_1(1,nvar_1) ,lon_dim_coef/2, - & syn_gr_a_2(1,nvar_1) ,lon_dim_grid, - & lons_lat,lot_thread,ibmsign,scale_ibm, - & aux1crs,22000, - & aux1crs(22001),20000, - & aux1crs(22001),0) - init = 0 - call scrft(init, - & syn_gr_a_1(1,nvar_1) ,lon_dim_coef/2, - & syn_gr_a_2(1,nvar_1) ,lon_dim_grid, - & lons_lat,lot_thread,ibmsign,scale_ibm, - & aux1crs,22000, - & aux1crs(22001),20000, - & aux1crs(22001),0) -#endif - endif - enddo ! fin thread loop ...................................... - endif !----------------------------------------------------------- -!! - return - end - subroutine grid_to_four(anl_gr_a_2,anl_gr_a_1, - & lon_dim_grid,lon_dim_coef,lons_lat,lot) -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - use machine - implicit none -!! - real(kind=kind_dbl_prec) anl_gr_a_2(lon_dim_grid,lot) - real(kind=kind_dbl_prec) anl_gr_a_1(lon_dim_coef,lot) - integer lon_dim_grid - integer lon_dim_coef - integer lons_lat - integer lot -!________________________________________________________ - real(kind=kind_dbl_prec) aux1crs(42002) - real(kind=kind_dbl_prec) scale_ibm,rone - integer ibmsign - integer init - integer lot_thread - integer num_threads - integer nvar_thread_max - integer nvar_1,nvar_2 - integer thread -!________________________________________________________ -#ifdef MKL - write(0,*) "ERROR in grid_to_four: srcft and drcft ", - & " must be replaced with MKL's FFTW calls. ABORT." - call sleep(5) - stop -#endif - num_threads=min(num_parthds_stochy,lot) - - nvar_thread_max=(lot+num_threads-1)/num_threads - - if ( kind_dbl_prec == 8 ) then !------------------------------------ -!$omp parallel do shared(anl_gr_a_1,anl_gr_a_2,lons_lat) -!$omp+shared(lon_dim_coef,lon_dim_grid) -!$omp+shared(lot,num_threads,nvar_thread_max) -!$omp+shared(ibmsign,scale_ibm,rone) -!$omp+private(thread,nvar_1,nvar_2,lot_thread,init,aux1crs) - - do thread=1,num_threads ! start of thread loop .............. - nvar_1 = (thread-1)*nvar_thread_max + 1 - nvar_2 = min(nvar_1+nvar_thread_max-1,lot) - - if (nvar_2 >= nvar_1) then - lot_thread = nvar_2 - nvar_1 + 1 - - init = 1 - ibmsign = 1 - rone = 1.0d0 - scale_ibm = rone/lons_lat - call drcft(init, - & anl_gr_a_2(1,nvar_1), lon_dim_grid, - & anl_gr_a_1(1,nvar_1), lon_dim_coef/2, - & lons_lat,lot_thread,ibmsign,scale_ibm, - & aux1crs,22000, - & aux1crs(22001),20000) - init = 0 - call drcft(init, - & anl_gr_a_2(1,nvar_1), lon_dim_grid, - & anl_gr_a_1(1,nvar_1), lon_dim_coef/2, - & lons_lat,lot_thread,ibmsign,scale_ibm, - & aux1crs,22000, - & aux1crs(22001),20000) - - endif - enddo ! fin thread loop ...................................... - else !------------------------------------------------------------ -!$omp parallel do shared(anl_gr_a_1,anl_gr_a_2,lons_lat) -!$omp+shared(lon_dim_coef,lon_dim_grid) -!$omp+shared(lot,num_threads,nvar_thread_max) -!$omp+shared(ibmsign,scale_ibm,rone) -!$omp+private(thread,nvar_1,nvar_2,lot_thread,init,aux1crs) - - do thread=1,num_threads ! start of thread loop .............. - nvar_1 = (thread-1)*nvar_thread_max + 1 - nvar_2 = min(nvar_1+nvar_thread_max-1,lot) - - if (nvar_2 >= nvar_1) then - lot_thread=nvar_2 - nvar_1 + 1 - - init = 1 - ibmsign = 1 - rone = 1.0d0 - scale_ibm = rone/lons_lat - call srcft(init, - & anl_gr_a_2(1,nvar_1), lon_dim_grid, - & anl_gr_a_1(1,nvar_1), lon_dim_coef/2, - & lons_lat,lot_thread,ibmsign,scale_ibm, - & aux1crs,22000, - & aux1crs(22001),20000, - & aux1crs(22001),0) - init = 0 - call srcft(init, - & anl_gr_a_2(1,nvar_1), lon_dim_grid, - & anl_gr_a_1(1,nvar_1), lon_dim_coef/2, - & lons_lat,lot_thread,ibmsign,scale_ibm, - & aux1crs,22000, - & aux1crs(22001),20000, - & aux1crs(22001),0) - - endif - enddo ! fin thread loop ...................................... - endif !----------------------------------------------------------- -!! - return - end - - end module four_to_grid_mod diff --git a/stochastic_physics/function2 b/stochastic_physics/function2 deleted file mode 100644 index f3328235b..000000000 --- a/stochastic_physics/function2 +++ /dev/null @@ -1,5 +0,0 @@ -!cc - indlsev(n,l) = jbasev + (n-l)/2 + 1 -!cc - indlsod(n,l) = jbasod + (n-l)/2 + 1 -!cc diff --git a/stochastic_physics/function_indlsev b/stochastic_physics/function_indlsev deleted file mode 100644 index 94e605cfb..000000000 --- a/stochastic_physics/function_indlsev +++ /dev/null @@ -1,3 +0,0 @@ -!cc - indlsev(n,l) = jbasev + (n-l)/2 + 1 -!cc diff --git a/stochastic_physics/function_indlsod b/stochastic_physics/function_indlsod deleted file mode 100644 index 16c4e7996..000000000 --- a/stochastic_physics/function_indlsod +++ /dev/null @@ -1,3 +0,0 @@ -!cc - indlsod(n,l) = jbasod + (n-l)/2 + 1 -!cc diff --git a/stochastic_physics/get_lats_node_a_stochy.f b/stochastic_physics/get_lats_node_a_stochy.f deleted file mode 100644 index 62bc7b293..000000000 --- a/stochastic_physics/get_lats_node_a_stochy.f +++ /dev/null @@ -1,92 +0,0 @@ - module get_lats_node_a_stochy_mod - - implicit none - - contains - - subroutine get_lats_node_a_stochy(me_fake,global_lats_a, - & lats_nodes_a_fake,gl_lats_index, - & global_time_sort_index,iprint) -cc - use stochy_resol_def - use spectral_layout_mod - implicit none -cc - integer gl_lats_index,gl_start - integer me_fake - integer global_lats_a(latg) - integer lats_nodes_a_fake - integer iprint -cc - integer ijk - integer jptlats - integer lat - integer node,nodesio - integer global_time_sort_index(latg) - integer nodes_tmp -cc -c -!jw if (liope) then -!jw if (icolor.eq.2) then -!jw nodesio=1 -!jw else - nodesio=nodes -!jw endif -!jw else -!jw nodesio=nodes -!jw endif -!! -cc - lat = 1 - nodes_tmp = nodes -!jw if (liope .and. icolor .eq. 2) nodes_tmp = nodes -1 - - gl_start = gl_lats_index -cc............................................. - do ijk=1,latg -cc - do node=1,nodes_tmp - if (node.eq.me_fake+1) then - gl_lats_index=gl_lats_index+1 - global_lats_a(gl_lats_index) = global_time_sort_index(lat) - endif - lat = lat + 1 - if (lat .gt. latg) go to 200 - enddo -cc - do node=nodes_tmp,1,-1 - if (node.eq.me_fake+1) then - gl_lats_index=gl_lats_index+1 - global_lats_a(gl_lats_index) = global_time_sort_index(lat) - endif - lat = lat + 1 - if (lat .gt. latg) go to 200 - enddo -cc - enddo -cc............................................. -cc - 200 continue -cc -cc............................................. -cc -!jw if (liope .and. icolor .eq. 2) gl_start = 0 - do node=1,nodes_tmp - if (node.eq.me_fake+1) then - lats_nodes_a_fake=gl_lats_index-gl_start -c$$$ print*,' setting lats_nodes_a_fake = ', -c$$$ . lats_nodes_a_fake - endif - enddo - - if(iprint.eq.1) print 220 - 220 format ('completed loop 200 in get_lats_a ') -c - if(iprint.eq.1) - & print*,'completed get_lats_node, lats_nodes_a_fake=', - & lats_nodes_a_fake -cc - return - end - - end module get_lats_node_a_stochy_mod diff --git a/stochastic_physics/get_ls_node_stochy.f b/stochastic_physics/get_ls_node_stochy.f deleted file mode 100644 index 51d9f85c3..000000000 --- a/stochastic_physics/get_ls_node_stochy.f +++ /dev/null @@ -1,81 +0,0 @@ - module get_ls_node_stochy_mod - - implicit none - - contains - - subroutine get_ls_node_stochy(me_fake,ls_node,ls_max_node_fake, - c iprint) -! - use stochy_resol_def - use spectral_layout_mod - implicit none -! - integer me_fake, ls_max_node_fake, iprint - integer ls_node(ls_dim) - - integer ijk, jptls, l, node, nodesio -! -!jw if (liope) then -!jw if (icolor.eq.2) then -!jw nodesio=1 -!jw else - - nodesio = nodes - -!jw endif -!jw else -!jw nodesio=nodes -!jw endif -!! - ls_node = -1 -! - jptls = 0 - l = 0 -!............................................. - do ijk=1,jcap1 -! - do node=1,nodesio - if (node == me_fake+1) then - jptls = jptls + 1 - ls_node(jptls) = l - endif - l = l + 1 - if (l > jcap) go to 200 - enddo -! - do node=nodesio,1,-1 - if (node == me_fake+1) then - jptls = jptls + 1 - ls_node(jptls) = l - endif - l = l + 1 - if (l > jcap) go to 200 - enddo -! - enddo -!............................................. -! - 200 continue -! -!............................................. -! - if(iprint == 1) print *, 'completed loop 200 in get_ls_node' - ls_max_node_fake = 0 - do ijk=1,ls_dim - if(ls_node(ijk) >= 0) then - ls_max_node_fake = ijk - if(iprint == 1) - & print 230, me_fake, ijk, ls_node(ijk) - endif - 230 format ('me_fake=',i5,' get_ls_node ls_node(', i5, ')=',i5) - enddo -! - if(iprint == 1) - & print*,'completed get_ls_node, ls_max_node_fake=', - & ls_max_node_fake -! - return - end - - end module get_ls_node_stochy_mod diff --git a/stochastic_physics/get_stochy_pattern.F90 b/stochastic_physics/get_stochy_pattern.F90 deleted file mode 100644 index 0ccaf7f2e..000000000 --- a/stochastic_physics/get_stochy_pattern.F90 +++ /dev/null @@ -1,527 +0,0 @@ -!>\file get_stochy_pattern.F90 -!! This file includes random pattern generators for FV3GFS stochastic physics. - -!>\ingroup gfs_stoch -!! This module contains random pattern generators for FV3GFS stochastic physics. -module get_stochy_pattern_mod - use machine, only : kind_dbl_prec, kind_evod - use stochy_ccpp, only : nodes => mpisize, stochy_la2ga - use stochy_resol_def, only : latg, latg2, levs, lonf, skeblevs - use spectral_layout_mod, only : ipt_lats_node_a, lat1s_a, lats_dim_a, & - lats_node_a, lon_dim_a, len_trie_ls, & - len_trio_ls, ls_dim - use stochy_namelist_def, only : nsfcpert, ntrunc, stochini - use stochy_data_mod, only : gg_lats, gg_lons, inttyp, nskeb, nshum, nsppt, & - rad2deg, rnlat, rpattern_sfc, rpattern_skeb, & - rpattern_shum, rpattern_sppt, skebu_save, & - skebv_save, skeb_vwts, skeb_vpts, wlon - use stochy_gg_def, only : coslat_a - use stochy_patterngenerator_mod, only: random_pattern, ndimspec, & - patterngenerator_advance - use stochy_internal_state_mod, only: stochy_internal_state - use stochy_ccpp, only : is_master, mp_reduce_sum, mpicomm - use GFS_typedefs, only: GFS_control_type, GFS_grid_type - use mersenne_twister, only: random_seed - use dezouv_stochy_mod, only: dezouv_stochy - use dozeuv_stochy_mod, only: dozeuv_stochy - use four_to_grid_mod, only: four_to_grid - use sumfln_stochy_mod, only: sumfln_stochy - implicit none - private - - public get_random_pattern_fv3,get_random_pattern_fv3_vect - public get_random_pattern_sfc_fv3 - public dump_patterns - logical :: first_call=.true. - contains - -!> This subroutine generates a random pattern for stochastic physics. -subroutine get_random_pattern_fv3(rpattern,npatterns,& - gis_stochy,Model,Grid,nblks,maxlen,pattern_2d) - -! generate a random pattern for stochastic physics - implicit none - type(random_pattern), intent(inout) :: rpattern(npatterns) - type(stochy_internal_state) :: gis_stochy - type(GFS_control_type), intent(in) :: Model - type(GFS_grid_type), intent(in) :: Grid(nblks) - integer,intent(in):: npatterns,nblks,maxlen - - integer i,j,l,lat,ierr,n,nn,k,nt - real(kind=kind_dbl_prec), dimension(lonf,gis_stochy%lats_node_a,1):: wrk2d - - integer :: num2d -! logical lprint - - real(kind=kind_dbl_prec), allocatable, dimension(:,:) :: workg - real (kind=kind_dbl_prec) glolal(lonf,gis_stochy%lats_node_a) - integer kmsk0(lonf,gis_stochy%lats_node_a),len - real(kind=kind_dbl_prec) :: globalvar,globalvar0 - real(kind=kind_dbl_prec) :: pattern_2d(nblks,maxlen) - real(kind=kind_dbl_prec) :: pattern_1d(maxlen) - real(kind=kind_dbl_prec), allocatable, dimension(:,:) :: rslmsk - integer :: blk - - kmsk0 = 0 - glolal = 0. - do n=1,npatterns - call patterngenerator_advance(rpattern(n),1,.false.) - call scalarspect_to_gaugrid( & - rpattern(n)%spec_e,rpattern(n)%spec_o,wrk2d,& - gis_stochy%ls_node,gis_stochy%ls_nodes,gis_stochy%max_ls_nodes,& - gis_stochy%lats_nodes_a,gis_stochy%global_lats_a,gis_stochy%lonsperlat,& - gis_stochy%plnev_a,gis_stochy%plnod_a,1) - glolal = glolal + wrk2d(:,:,1) - enddo - - allocate(workg(lonf,latg)) - workg = 0. - do j=1,gis_stochy%lats_node_a - lat=gis_stochy%global_lats_a(ipt_lats_node_a-1+j) - do i=1,lonf - workg(i,lat) = glolal(i,j) - enddo - enddo - - call mp_reduce_sum(workg,lonf,latg) - -! interpolate to cube grid - - allocate(rslmsk(lonf,latg)) - do blk=1,nblks - len=size(Grid(blk)%xlat,1) - pattern_1d = 0 - associate( tlats=>Grid(blk)%xlat*rad2deg,& - tlons=>Grid(blk)%xlon*rad2deg ) - call stochy_la2ga(workg,lonf,latg,gg_lons,gg_lats,wlon,rnlat,& - pattern_1d(1:len),len,rslmsk,tlats,tlons) - pattern_2d(blk,:)=pattern_1d(:) - end associate - enddo - deallocate(rslmsk) - deallocate(workg) - -end subroutine get_random_pattern_fv3 - -!> This subroutine generates a random pattern for surface perturbations of -!! stochastic physics. -subroutine get_random_pattern_sfc_fv3(rpattern,npatterns,& - gis_stochy,Model,Grid,nblks,maxlen,pattern_3d) - -! generate a random pattern for stochastic physics - implicit none - type(random_pattern), intent(inout) :: rpattern(npatterns) - type(stochy_internal_state), target :: gis_stochy - type(GFS_control_type), intent(in) :: Model - type(GFS_grid_type), intent(in) :: Grid(nblks) - integer,intent(in):: npatterns,nblks,maxlen - - integer i,j,l,lat,ierr,n,nn,k,nt - real(kind=kind_dbl_prec), dimension(lonf,gis_stochy%lats_node_a,1):: wrk2d - - integer :: num2d -! logical lprint - - real(kind=kind_dbl_prec), allocatable, dimension(:,:) :: workg - real (kind=kind_dbl_prec) glolal(lonf,gis_stochy%lats_node_a) - integer kmsk0(lonf,gis_stochy%lats_node_a),len - real(kind=kind_dbl_prec) :: globalvar,globalvar0 - real(kind=kind_dbl_prec) :: pattern_3d(nblks,maxlen,nsfcpert) - real(kind=kind_dbl_prec) :: pattern_1d(maxlen) - real(kind=kind_dbl_prec), allocatable, dimension(:,:) :: rslmsk - integer :: blk - - do k=1,nsfcpert - kmsk0 = 0 - glolal = 0. - do n=1,npatterns - if (is_master()) print *, 'Random pattern for SFC-PERTS in get_random_pattern_sfc_fv3: k, min, max ',k,minval(rpattern_sfc(n)%spec_o(:,:,k)), maxval(rpattern_sfc(n)%spec_o(:,:,k)) - call scalarspect_to_gaugrid( & - rpattern(n)%spec_e(:,:,k),rpattern(n)%spec_o(:,:,k),wrk2d,& - gis_stochy%ls_node,gis_stochy%ls_nodes,gis_stochy%max_ls_nodes,& - gis_stochy%lats_nodes_a,gis_stochy%global_lats_a,gis_stochy%lonsperlat,& - gis_stochy%plnev_a,gis_stochy%plnod_a,1) - glolal = glolal + wrk2d(:,:,1) - enddo - - allocate(workg(lonf,latg)) - workg = 0. - do j=1,gis_stochy%lats_node_a - lat=gis_stochy%global_lats_a(ipt_lats_node_a-1+j) - do i=1,lonf - workg(i,lat) = glolal(i,j) - enddo - enddo - - call mp_reduce_sum(workg,lonf,latg) - if (is_master()) print *, 'workg after mp_reduce_sum for SFC-PERTS in get_random_pattern_sfc_fv3: k, min, max ',k,minval(workg), maxval(workg) - -! interpolate to cube grid - - allocate(rslmsk(lonf,latg)) - do blk=1,nblks - len=size(Grid(blk)%xlat,1) - pattern_1d = 0 - associate( tlats=>Grid(blk)%xlat*rad2deg,& - tlons=>Grid(blk)%xlon*rad2deg ) - call stochy_la2ga(workg,lonf,latg,gg_lons,gg_lats,wlon,rnlat,& - pattern_1d(1:len),len,rslmsk,tlats,tlons) - pattern_3d(blk,:,k)=pattern_1d(:) - end associate - enddo - if (is_master()) print *, '3D pattern for SFC-PERTS in get_random_pattern_sfc_fv3: k, min, max ',k,minval(pattern_3d(:,:,k)), maxval(pattern_3d(:,:,k)) - deallocate(rslmsk) - deallocate(workg) - - enddo ! loop over k, nsfcpert - -end subroutine get_random_pattern_sfc_fv3 - -!> This subroutine generates a random pattern for FV3GFS stochastic physics in SKEB application. -subroutine get_random_pattern_fv3_vect(rpattern,npatterns,& - gis_stochy,Model,Grid,nblks,maxlen,upattern_3d,vpattern_3d) - -! generate a random pattern for stochastic physics - implicit none - type(GFS_control_type), intent(in) :: Model - type(GFS_grid_type), intent(in) :: Grid(nblks) - type(stochy_internal_state), target :: gis_stochy - type(random_pattern), intent(inout) :: rpattern(npatterns) - - real(kind=kind_evod), dimension(len_trie_ls,2,1) :: vrtspec_e,divspec_e - real(kind=kind_evod), dimension(len_trio_ls,2,1) :: vrtspec_o,divspec_o - integer:: npatterns,nblks,blk,len,maxlen - - real(kind=kind_dbl_prec) :: upattern_3d(nblks,maxlen,levs) - real(kind=kind_dbl_prec) :: vpattern_3d(nblks,maxlen,levs) - real(kind=kind_dbl_prec) :: pattern_1d(maxlen) - real(kind=kind_dbl_prec), allocatable, dimension(:,:) :: rslmsk - integer i,j,l,lat,ierr,n,nn,k,nt - real(kind_dbl_prec), dimension(lonf,gis_stochy%lats_node_a,1):: wrk2du,wrk2dv - - integer :: num2d -! logical lprint - - real, allocatable, dimension(:,:) :: workgu,workgv - integer kmsk0(lonf,gis_stochy%lats_node_a),i1,i2,j1 - real(kind=kind_dbl_prec) :: globalvar,globalvar0 - kmsk0 = 0 - allocate(workgu(lonf,latg)) - allocate(workgv(lonf,latg)) - allocate(rslmsk(lonf,latg)) - if (first_call) then - allocate(skebu_save(nblks,maxlen,skeblevs)) - allocate(skebv_save(nblks,maxlen,skeblevs)) - do k=2,skeblevs - workgu = 0. - workgv = 0. - do n=1,npatterns - if (.not. stochini) call patterngenerator_advance(rpattern(n),k,first_call) - ! ke norm (convert streamfunction forcing to vorticity forcing) - divspec_e = 0; divspec_o = 0. - do nn=1,2 - vrtspec_e(:,nn,1) = gis_stochy%kenorm_e*rpattern(n)%spec_e(:,nn,k) - vrtspec_o(:,nn,1) = gis_stochy%kenorm_o*rpattern(n)%spec_o(:,nn,k) - enddo - ! convert to winds - call vrtdivspect_to_uvgrid(& - divspec_e,divspec_o,vrtspec_e,vrtspec_o,& - wrk2du,wrk2dv,& - gis_stochy%ls_node,gis_stochy%ls_nodes,gis_stochy%max_ls_nodes,& - gis_stochy%lats_nodes_a,gis_stochy%global_lats_a,gis_stochy%lonsperlat,& - gis_stochy%epsedn,gis_stochy%epsodn,gis_stochy%snnp1ev,gis_stochy%snnp1od,& - gis_stochy%plnev_a,gis_stochy%plnod_a,1) - do i=1,lonf - do j=1,gis_stochy%lats_node_a - lat=gis_stochy%global_lats_a(ipt_lats_node_a-1+j) - workgu(i,lat) = workgu(i,lat) + wrk2du(i,j,1) - workgv(i,lat) = workgv(i,lat) + wrk2dv(i,j,1) - enddo - enddo - enddo - call mp_reduce_sum(workgu,lonf,latg) - call mp_reduce_sum(workgv,lonf,latg) -! interpolate to cube grid - do blk=1,nblks - len=size(Grid(blk)%xlat,1) - pattern_1d = 0 - associate( tlats=>Grid(blk)%xlat*rad2deg,& - tlons=>Grid(blk)%xlon*rad2deg ) - call stochy_la2ga(workgu,lonf,latg,gg_lons,gg_lats,wlon,rnlat,& - pattern_1d(1:len),len,rslmsk,tlats,tlons) - skebu_save(blk,:,k)=pattern_1d(:) - call stochy_la2ga(workgv,lonf,latg,gg_lons,gg_lats,wlon,rnlat,& - pattern_1d(1:len),len,rslmsk,tlats,tlons) - skebv_save(blk,:,k)=-1*pattern_1d(:) - end associate - enddo - enddo - endif - do k=1,skeblevs-1 - skebu_save(:,:,k)=skebu_save(:,:,k+1) - skebv_save(:,:,k)=skebv_save(:,:,k+1) - do n=1,npatterns - rpattern(n)%spec_e(:,:,k)=rpattern(n)%spec_e(:,:,k+1) - rpattern(n)%spec_o(:,:,k)=rpattern(n)%spec_o(:,:,k+1) - enddo - enddo - -! get pattern for last level - workgu = 0. - workgv = 0. - do n=1,npatterns -! if (stochini.AND. first_call) then -! print*,'skipping advance' -! else - call patterngenerator_advance(rpattern(n),skeblevs,first_call) -! endif -! ke norm (convert streamfunction forcing to vorticity forcing) - divspec_e = 0; divspec_o = 0. - do nn=1,2 - vrtspec_e(:,nn,1) = gis_stochy%kenorm_e*rpattern(n)%spec_e(:,nn,skeblevs) - vrtspec_o(:,nn,1) = gis_stochy%kenorm_o*rpattern(n)%spec_o(:,nn,skeblevs) - enddo - ! convert to winds - call vrtdivspect_to_uvgrid(& - divspec_e,divspec_o,vrtspec_e,vrtspec_o,& - wrk2du,wrk2dv,& - gis_stochy%ls_node,gis_stochy%ls_nodes,gis_stochy%max_ls_nodes,& - gis_stochy%lats_nodes_a,gis_stochy%global_lats_a,gis_stochy%lonsperlat,& - gis_stochy%epsedn,gis_stochy%epsodn,gis_stochy%snnp1ev,gis_stochy%snnp1od,& - gis_stochy%plnev_a,gis_stochy%plnod_a,1) - do i=1,lonf - do j=1,gis_stochy%lats_node_a - lat=gis_stochy%global_lats_a(ipt_lats_node_a-1+j) - workgu(i,lat) = workgu(i,lat) + wrk2du(i,j,1) - workgv(i,lat) = workgv(i,lat) + wrk2dv(i,j,1) - enddo - enddo - enddo - call mp_reduce_sum(workgu,lonf,latg) - call mp_reduce_sum(workgv,lonf,latg) -! interpolate to cube grid - do blk=1,nblks - len=size(Grid(blk)%xlat,1) - pattern_1d = 0 - associate( tlats=>Grid(blk)%xlat*rad2deg,& - tlons=>Grid(blk)%xlon*rad2deg ) - call stochy_la2ga(workgu,lonf,latg,gg_lons,gg_lats,wlon,rnlat,& - pattern_1d(1:len),len,rslmsk,tlats,tlons) - skebu_save(blk,:,skeblevs)=pattern_1d(:) - call stochy_la2ga(workgv,lonf,latg,gg_lons,gg_lats,wlon,rnlat,& - pattern_1d(1:len),len,rslmsk,tlats,tlons) - skebv_save(blk,:,skeblevs)=-1*pattern_1d(:) - end associate - enddo - deallocate(rslmsk) - deallocate(workgu) - deallocate(workgv) -! interpolate in the vertical ! consider moving to cubed sphere side, more memory, but less interpolations - do k=1,Model%levs - do blk=1,nblks - upattern_3d(blk,:,k) = skeb_vwts(k,1)*skebu_save(blk,:,skeb_vpts(k,1))+skeb_vwts(k,2)*skebu_save(blk,:,skeb_vpts(k,2)) - vpattern_3d(blk,:,k) = skeb_vwts(k,1)*skebv_save(blk,:,skeb_vpts(k,1))+skeb_vwts(k,2)*skebv_save(blk,:,skeb_vpts(k,2)) - enddo - enddo - first_call=.false. - -end subroutine get_random_pattern_fv3_vect - -subroutine scalarspect_to_gaugrid(& - trie_ls,trio_ls,datag,& - ls_node,ls_nodes,max_ls_nodes,& - lats_nodes_a,global_lats_a,lonsperlat,& - plnev_a,plnod_a,nlevs) - - - implicit none - real(kind=kind_dbl_prec), intent(in) :: trie_ls(len_trie_ls,2,nlevs) - real(kind=kind_dbl_prec), intent(in) :: trio_ls(len_trio_ls,2,nlevs) - real(kind=kind_dbl_prec), intent(out) :: datag(lonf,lats_node_a,nlevs) - integer, intent(in) :: ls_node(ls_dim,3),ls_nodes(ls_dim,nodes),& - nlevs,max_ls_nodes(nodes),lats_nodes_a(nodes),global_lats_a(latg),lonsperlat(latg) - real(kind=kind_dbl_prec),intent(in) :: plnev_a(len_trie_ls,latg2),plnod_a(len_trio_ls,latg2) -! local vars - real(kind=kind_dbl_prec) for_gr_a_1(lon_dim_a,nlevs,lats_dim_a) - real(kind=kind_dbl_prec) for_gr_a_2(lonf,nlevs,lats_dim_a) - integer i,j,k - integer l,lan,lat - integer lons_lat - - call sumfln_stochy(trie_ls,& - trio_ls,& - lat1s_a,& - plnev_a,plnod_a,& - nlevs,ls_node,latg2,& - lats_dim_a,nlevs,for_gr_a_1,& - ls_nodes,max_ls_nodes,& - lats_nodes_a,global_lats_a,& - lats_node_a,ipt_lats_node_a,& - lonsperlat,lon_dim_a,latg,0) - - do lan=1,lats_node_a - lat = global_lats_a(ipt_lats_node_a-1+lan) - lons_lat = lonsperlat(lat) - CALL FOUR_TO_GRID(for_gr_a_1(1,1,lan),for_gr_a_2(1,1,lan),& - lon_dim_a,lonf,lons_lat,nlevs) - enddo - - datag = 0. - do lan=1,lats_node_a - lat = global_lats_a(ipt_lats_node_a-1+lan) - lons_lat = lonsperlat(lat) - do k=1,nlevs - do i=1,lons_lat - datag(i,lan,k) = for_gr_a_2(i,k,lan) - enddo - enddo - enddo - - return - end subroutine scalarspect_to_gaugrid - -subroutine dump_patterns(sfile) - implicit none - character*120 :: sfile - integer :: stochlun,k,n - stochlun=99 - if (is_master()) then - if (nsppt > 0 .OR. nshum > 0 .OR. nskeb > 0) then - OPEN(stochlun,file=sfile,form='unformatted') - print*,'open ',sfile,' for output' - endif - endif - if (nsppt > 0) then - do n=1,nsppt - call write_pattern(rpattern_sppt(n),1,stochlun) - enddo - endif - if (nshum > 0) then - do n=1,nshum - call write_pattern(rpattern_shum(n),1,stochlun) - enddo - endif - if (nskeb > 0) then - do n=1,nskeb - do k=1,skeblevs - call write_pattern(rpattern_skeb(n),k,stochlun) - enddo - enddo - endif - close(stochlun) - end subroutine dump_patterns - subroutine write_pattern(rpattern,lev,lunptn) - implicit none - type(random_pattern), intent(inout) :: rpattern - integer, intent(in) :: lunptn,lev - real(kind_dbl_prec), allocatable :: pattern2d(:) - integer nm,nn,ierr,arrlen,isize - integer,allocatable :: isave(:) - arrlen=2*ndimspec - - allocate(pattern2d(arrlen)) - pattern2d=0.0 - ! fill in apprpriate pieces of array - !print*,'before collection...',me,maxval(rpattern%spec_e),maxval(rpattern%spec_o) & - ! ,minval(rpattern%spec_e),minval(rpattern%spec_o) - do nn=1,len_trie_ls - nm = rpattern%idx_e(nn) - if (nm == 0) cycle - pattern2d(nm) = rpattern%spec_e(nn,1,lev) - pattern2d(ndimspec+nm) = rpattern%spec_e(nn,2,lev) - enddo - do nn=1,len_trio_ls - nm = rpattern%idx_o(nn) - if (nm == 0) cycle - pattern2d(nm) = rpattern%spec_o(nn,1,lev) - pattern2d(ndimspec+nm) = rpattern%spec_o(nn,2,lev) - enddo - call mp_reduce_sum(pattern2d,arrlen) - ! write only on root process - if (is_master()) then - print*,'writing out random pattern (min/max/size)',& - minval(pattern2d),maxval(pattern2d),size(pattern2d) - !print*,'max/min pattern=',maxval(pattern2d),minval(pattern2d) - write(lunptn) ntrunc - call random_seed(size=isize) ! get seed size - allocate(isave(isize)) ! get seed - call random_seed(get=isave,stat=rpattern%rstate) ! write seed - write(lunptn) isave - write(lunptn) pattern2d - endif - deallocate(pattern2d) - end subroutine write_pattern - - - subroutine vrtdivspect_to_uvgrid(& - trie_di,trio_di,trie_ze,trio_ze,& - uug,vvg,& - ls_node,ls_nodes,max_ls_nodes,& - lats_nodes_a,global_lats_a,lonsperlar,& - epsedn,epsodn,snnp1ev,snnp1od,plnev_a,plnod_a,nlevs) - - implicit none - real(kind=kind_dbl_prec), intent(in) :: trie_di(len_trie_ls,2,nlevs) - real(kind=kind_dbl_prec), intent(in) :: trio_di(len_trio_ls,2,nlevs) - real(kind=kind_dbl_prec), intent(in) :: trie_ze(len_trie_ls,2,nlevs) - real(kind=kind_dbl_prec), intent(in) :: trio_ze(len_trio_ls,2,nlevs) - real(kind=kind_dbl_prec), intent(out) :: uug(lonf,lats_node_a,nlevs) - real(kind=kind_dbl_prec), intent(out) :: vvg(lonf,lats_node_a,nlevs) - integer, intent(in) :: ls_node(ls_dim,3),ls_nodes(ls_dim,nodes),& - nlevs,max_ls_nodes(nodes),lats_nodes_a(nodes),global_lats_a(latg),lonsperlar(latg) - real(kind=kind_dbl_prec),intent(in) :: epsedn(len_trie_ls),& - epsodn(len_trio_ls),snnp1ev(len_trie_ls),snnp1od(len_trio_ls),& - plnev_a(len_trie_ls,latg2),plnod_a(len_trio_ls,latg2) -! local vars - real(kind=kind_dbl_prec) trie_ls(len_trie_ls,2,2*nlevs) - real(kind=kind_dbl_prec) trio_ls(len_trio_ls,2,2*nlevs) - real(kind=kind_dbl_prec) for_gr_a_1(lon_dim_a,2*nlevs,lats_dim_a) - real(kind=kind_dbl_prec) for_gr_a_2(lonf,2*nlevs,lats_dim_a) - integer i,j,k - integer l,lan,lat - integer lons_lat - real (kind=kind_dbl_prec) tx1 - - do k=1,nlevs - call dezouv_stochy(trie_di(1,1,k), trio_ze(1,1,k),& - trie_ls(1,1,k), trio_ls(1,1,nlevs+k),& - epsedn,epsodn,snnp1ev,snnp1od,ls_node) - call dozeuv_stochy(trio_di(1,1,k), trie_ze(1,1,k),& - trio_ls(1,1,k), trie_ls(1,1,nlevs+k),& - epsedn,epsodn,snnp1ev,snnp1od,ls_node) - enddo - - call sumfln_stochy(trie_ls,& - trio_ls,& - lat1s_a,& - plnev_a,plnod_a,& - 2*nlevs,ls_node,latg2,& - lats_dim_a,2*nlevs,for_gr_a_1,& - ls_nodes,max_ls_nodes,& - lats_nodes_a,global_lats_a,& - lats_node_a,ipt_lats_node_a,& - lonsperlar,lon_dim_a,latg,0) - - do lan=1,lats_node_a - lat = global_lats_a(ipt_lats_node_a-1+lan) - lons_lat = lonsperlar(lat) - CALL FOUR_TO_GRID(for_gr_a_1(1,1,lan),for_gr_a_2(1,1,lan),& - lon_dim_a,lonf,lons_lat,2*nlevs) - enddo - - uug = 0.; vvg = 0. - do lan=1,lats_node_a - lat = global_lats_a(ipt_lats_node_a-1+lan) - lons_lat = lonsperlar(lat) - tx1 = 1. / coslat_a(lat) - do k=1,nlevs - do i=1,lons_lat - uug(i,lan,k) = for_gr_a_2(i,k,lan) * tx1 - vvg(i,lan,k) = for_gr_a_2(i,nlevs+k,lan) * tx1 - enddo - enddo - enddo - - return - end subroutine vrtdivspect_to_uvgrid -end module get_stochy_pattern_mod diff --git a/stochastic_physics/getcon_lag_stochy.f b/stochastic_physics/getcon_lag_stochy.f deleted file mode 100644 index e90f51279..000000000 --- a/stochastic_physics/getcon_lag_stochy.f +++ /dev/null @@ -1,89 +0,0 @@ - module getcon_lag_stochy_mod - - implicit none - - contains - - subroutine getcon_lag_stochy(lats_nodes_a,global_lats_a, - & lats_nodes_h,global_lats_h_sn, - & lonsperlat,xhalo,yhalo) - use stochy_resol_def, only : jcap,latg,latg2,lonf - use spectral_layout_mod, only : me,nodes - - use stochy_gg_def, only : colrad_a,sinlat_a - use stochy_layout_lag, only : - & ipt_lats_node_h,lat1s_h,lats_dim_h, - & lats_node_h,lats_node_h_max,lon_dim_h - use setlats_lag_stochy_mod, only: setlats_lag_stochy - implicit none -! - integer yhalo,xhalo -! - integer, dimension(nodes) :: lats_nodes_a, lats_nodes_h - integer, dimension(latg) :: lonsperlat, global_lats_a - - integer, dimension(latg+2*yhalo*nodes) :: global_lats_h_sn -! - integer i,j,l,n,lat,i1,i2,node,nodesio - integer, dimension(latg+2*yhalo*nodes) :: global_lats_h_ns -! - if (me == 0) print 100, jcap, me -100 format ('getcon_h jcap= ',i4,2x,'me=',i3) - - do lat = 1, latg2 - lonsperlat(latg+1-lat) = lonsperlat(lat) - end do - nodesio = nodes - -! print*,'con_h me,nodes,nodesio = ',me,nodes,nodesio - - call setlats_lag_stochy(lats_nodes_a,global_lats_a, - & lats_nodes_h,global_lats_h_ns,yhalo) - -! reverse order for use in set_halos - - i1 = 1 - i2 = 0 - do n=1,nodes - j = 0 - i2 = i2 + lats_nodes_h(n) - do i=i1,i2 - j = j + 1 - global_lats_h_sn(i) = global_lats_h_ns(i2+1-j) - enddo - i1 = i2 + 1 - enddo - - 830 format(10(i4,1x)) - lats_dim_h = 0 - do node=1,nodes - lats_dim_h = max(lats_dim_h, lats_nodes_h(node)) - enddo - lats_node_h = lats_nodes_h(me+1) - lats_node_h_max = 0 - do i=1,nodes - lats_node_h_max = max(lats_node_h_max, lats_nodes_h(i)) - enddo - ipt_lats_node_h = 1 - if ( me > 0 ) then - do node=1,me - ipt_lats_node_h = ipt_lats_node_h + lats_nodes_h(node) - enddo - endif - do j=1,latg2 - sinlat_a(j) = cos(colrad_a(j)) - enddo - do l=0,jcap - do lat = 1, latg2 - if ( l <= min(jcap,lonsperlat(lat)/2) ) then - lat1s_h(l) = lat - go to 200 - endif - end do - 200 continue - end do - lon_dim_h = lonf + 1 + xhalo + xhalo !even/odd - return - end - - end module getcon_lag_stochy_mod diff --git a/stochastic_physics/getcon_spectral.F90 b/stochastic_physics/getcon_spectral.F90 deleted file mode 100644 index 7eaa48ae8..000000000 --- a/stochastic_physics/getcon_spectral.F90 +++ /dev/null @@ -1,277 +0,0 @@ -module getcon_spectral_mod - - implicit none - - contains - - subroutine getcon_spectral ( ls_node,ls_nodes,max_ls_nodes, & - lats_nodes_a,global_lats_a, & - lonsperlat,latsmax, & - lats_nodes_ext,global_lats_ext, & - epse,epso,epsedn,epsodn, & - snnp1ev,snnp1od, & - plnev_a,plnod_a,pddev_a,pddod_a, & - plnew_a,plnow_a,colat1) - -! program log: -! 20110220 henry juang update code to fit mass_dp and ndslfv -! - use epslon_stochy_mod, only: epslon_stochy - use get_lats_node_a_stochy_mod, only: get_lats_node_a_stochy - use get_ls_node_stochy_mod, only: get_ls_node_stochy - use glats_stochy_mod, only: glats_stochy - use gozrineo_a_stochy_mod, only: gozrineo_a_stochy - use pln2eo_a_stochy_mod, only: pln2eo_a_stochy - use setlats_a_stochy_mod, only: setlats_a_stochy - use stochy_resol_def - use spectral_layout_mod - use stochy_gg_def - use stochy_internal_state_mod - - implicit none -! - integer i,j,k,l,lat,lan,lons_lat,n - integer ls_node(ls_dim,3),ierr -! -! ls_node(1,1) ... ls_node(ls_max_node,1) : values of L -! ls_node(1,2) ... ls_node(ls_max_node,2) : values of jbasev -! ls_node(1,3) ... ls_node(ls_max_node,3) : values of jbasod -! - integer ls_nodes(ls_dim,nodes) - integer, dimension(nodes) :: max_ls_nodes, lats_nodes_a - integer, dimension(latg) :: global_lats_a, lonsperlat -! - integer lats_nodes_ext(nodes) - integer global_lats_ext(latg+2*jintmx+2*nypt*(nodes-1)) -! - real(kind=kind_dbl_prec), dimension(len_trie_ls) :: epse, epsedn, snnp1ev - real(kind=kind_dbl_prec), dimension(len_trio_ls) :: epso, epsodn, snnp1od -! - real(kind=kind_dbl_prec), dimension(len_trie_ls,latg2) :: plnev_a, pddev_a, plnew_a - real(kind=kind_dbl_prec), dimension(len_trio_ls,latg2) :: plnod_a, pddod_a, plnow_a -! - real(kind=kind_dbl_prec), allocatable:: colrad_dp(:), wgt_dp(:),& - wgtcs_dp(:), rcs2_dp(:), epse_dp(:), epso_dp(:),& - epsedn_dp(:), epsodn_dp(:),plnev_dp(:), plnod_dp(:),& - pddev_dp(:), pddod_dp(:),plnew_dp(:), plnow_dp(:) -! - integer iprint,locl,node,& - len_trie_ls_nod, len_trio_ls_nod,& - indev, indod, indlsev,jbasev,indlsod,jbasod -! - integer gl_lats_index, latsmax - integer global_time_sort_index_a(latg) -! - real fd2 -!! - include 'function2' -! - real(kind=kind_dbl_prec) global_time_a(latg) -! - real(kind=kind_dbl_prec), parameter :: cons0 = 0.d0, cons0p5 = 0.5d0,& - cons1 = 1.d0, cons0p92 = 0.92d0 - real(kind=kind_dbl_prec) colat1 -! - gl_lats_index = 0 - global_lats_a = -1 - do lat = 1,latg !my intialize global_time_a to lonsperlat - global_time_a(lat) = lonsperlat(lat) - enddo - - do lat = 1, latg2 - lonsperlat(latg+1-lat) = lonsperlat(lat) - end do - do node=1,nodes - call get_lats_node_a_stochy( node-1, global_lats_a,lats_nodes_a(node),& - gl_lats_index,global_time_sort_index_a, iprint) - enddo - call setlats_a_stochy(lats_nodes_a,global_lats_a,iprint, lonsperlat) - - iprint = 0 - do node=1,nodes - call get_ls_node_stochy( node-1, ls_nodes(1,node),max_ls_nodes(node), iprint ) - enddo -! - len_trie_ls_max = 0 - len_trio_ls_max = 0 - do node=1,nodes -! - len_trie_ls_nod = 0 - len_trio_ls_nod = 0 - do locl=1,max_ls_nodes(node) - l=ls_nodes(locl,node) - len_trie_ls_nod = len_trie_ls_nod+(jcap+3-l)/2 - len_trio_ls_nod = len_trio_ls_nod+(jcap+2-l)/2 - enddo - len_trie_ls_max = max(len_trie_ls_max,len_trie_ls_nod) - len_trio_ls_max = max(len_trio_ls_max,len_trio_ls_nod) -! - enddo -! - iprint = 0 -! - lats_dim_a = 0 - do node=1,nodes - lats_dim_a = max(lats_dim_a,lats_nodes_a(node)) - enddo - lats_node_a = lats_nodes_a(me+1) - - lats_node_a_max = 0 - do i=1,nodes - lats_node_a_max = max(lats_node_a_max, lats_nodes_a(i)) - enddo - latsmax = lats_node_a_max - -! - ipt_lats_node_ext = 1 -! - ipt_lats_node_a = 1 - if ( me > 0 ) then - do node=1,me - ipt_lats_node_a = ipt_lats_node_a + lats_nodes_a(node) - enddo - endif - -! - iprint = 0 -! - if ( kind_dbl_prec == 8 ) then !------------------------------------ - call glats_stochy(latg2,colrad_a,wgt_a,wgtcs_a,rcs2_a,iprint) - call epslon_stochy(epse,epso,epsedn,epsodn,ls_node) - call pln2eo_a_stochy(plnev_a,plnod_a,epse,epso,colrad_a,ls_node,latg2) - call gozrineo_a_stochy(plnev_a,plnod_a,pddev_a,pddod_a, & - plnew_a,plnow_a,epse,epso,rcs2_a,wgt_a,ls_node,latg2) -! - else !------------------------------------------------------------ - allocate ( colrad_dp(latg2) ) - allocate ( wgt_dp(latg2) ) - allocate ( wgtcs_dp(latg2) ) - allocate ( rcs2_dp(latg2) ) -! - allocate ( epse_dp(len_trie_ls) ) - allocate ( epso_dp(len_trio_ls) ) - allocate ( epsedn_dp(len_trie_ls) ) - allocate ( epsodn_dp(len_trio_ls) ) -! - allocate ( plnev_dp(len_trie_ls) ) - allocate ( plnod_dp(len_trio_ls) ) - allocate ( pddev_dp(len_trie_ls) ) - allocate ( pddod_dp(len_trio_ls) ) - allocate ( plnew_dp(len_trie_ls) ) - allocate ( plnow_dp(len_trio_ls) ) - - call glats_stochy(latg2,colrad_dp,wgt_dp,wgtcs_dp,rcs2_dp,iprint) -! - do i=1,latg2 - colrad_a(i) = colrad_dp(i) - wgt_a(i) = wgt_dp(i) - wgtcs_a(i) = wgtcs_dp(i) - rcs2_a(i) = rcs2_dp(i) - enddo -! - call epslon_stochy(epse_dp,epso_dp,epsedn_dp,epsodn_dp,ls_node) -! - do i=1,len_trie_ls - epse(i) = epse_dp(i) - epsedn(i) = epsedn_dp(i) - enddo -! - do i=1,len_trio_ls - epso(i) = epso_dp(i) - epsodn(i) = epsodn_dp(i) - enddo -! - do lat=1,latg2 -! - call pln2eo_a_stochy(plnev_dp,plnod_dp,epse_dp,epso_dp,colrad_dp(lat),ls_node,1) -! - call gozrineo_a_stochy(plnev_dp,plnod_dp,pddev_dp,pddod_dp, plnew_dp,plnow_dp,& - epse_dp,epso_dp,rcs2_dp(lat),wgt_dp(lat),ls_node,1) -! - do i=1,len_trie_ls - plnev_a(i,lat) = plnev_dp(i) - pddev_a(i,lat) = pddev_dp(i) - plnew_a(i,lat) = plnew_dp(i) - enddo - do i=1,len_trio_ls - plnod_a(i,lat) = plnod_dp(i) - pddod_a(i,lat) = pddod_dp(i) - plnow_a(i,lat) = plnow_dp(i) - enddo - enddo -! - deallocate ( colrad_dp, wgt_dp, wgtcs_dp, rcs2_dp , & - epse_dp, epso_dp, epsedn_dp, epsodn_dp, & - plnev_dp, plnod_dp, pddev_dp, pddod_dp , & - plnew_dp, plnow_dp ) - endif !----------------------------------------------------------- -! -! - do locl=1,ls_max_node - l = ls_node(locl,1) - jbasev = ls_node(locl,2) - indev = indlsev(l,l) - do n = l, jcap, 2 - snnp1ev(indev) = n*(n+1) - indev = indev+1 - end do - end do -! -! - do locl=1,ls_max_node - l = ls_node(locl,1) - jbasod = ls_node(locl,3) - if ( l <= jcap-1 ) then - indod = indlsod(l+1,l) - do n = l+1, jcap, 2 - snnp1od(indod) = n*(n+1) - indod = indod+1 - end do - end if - end do -! -! - do locl=1,ls_max_node - l = ls_node(locl,1) - jbasev = ls_node(locl,2) - jbasod = ls_node(locl,3) - if (mod(L,2) == mod(jcap+1,2)) then ! set even (n-l) terms of top row to zero - snnp1ev(indlsev(jcap+1,l)) = cons0 - else ! set odd (n-l) terms of top row to zero - snnp1od(indlsod(jcap+1,l)) = cons0 - endif - enddo -! - do j=1,latg - if( j <= latg2 ) then - sinlat_a(j) = cos(colrad_a(j)) - else - sinlat_a(j) = -cos(colrad_a(latg+1-j)) - endif - coslat_a(j) = sqrt(1.-sinlat_a(j)*sinlat_a(j)) - enddo -! - do L=0,jcap - do lat = 1, latg2 - if ( L <= min(jcap,lonsperlat(lat)/2) ) then - lat1s_a(L) = lat - go to 200 - endif - end do - 200 continue - end do -! - - do j=1,lats_node_a - lat = global_lats_a(ipt_lats_node_a-1+j) - if ( lonsperlat(lat) == lonf ) then - lon_dims_a(j) = lonfx - else - lon_dims_a(j) = lonsperlat(lat) + 2 - endif - enddo -! - return - end - -end module getcon_spectral_mod diff --git a/stochastic_physics/glats_stochy.f b/stochastic_physics/glats_stochy.f deleted file mode 100644 index 4ed9d38f4..000000000 --- a/stochastic_physics/glats_stochy.f +++ /dev/null @@ -1,109 +0,0 @@ - module glats_stochy_mod - - implicit none - - contains - - subroutine glats_stochy(lgghaf,colrad,wgt,wgtcs,rcs2,iprint) -! -! Jan 2013 Henry Juang increase precision by kind_qdt_prec=16 -! to help wgt (Gaussian weighting) - use machine - implicit none - integer iter,k,k1,l2,lgghaf,iprint -! -! increase precision for more significant digit to help wgt - real(kind=kind_qdt_prec) drad,dradz,p1,p2,phi,pi,rad,rc -! real(kind=kind_qdt_prec) drad,dradz,eps,p1,p2,phi,pi,rad,rc - real(kind=kind_qdt_prec) rl2,scale,si,sn,w,x -! - real(kind=kind_dbl_prec), dimension(lgghaf) :: colrad, wgt, - & wgtcs, rcs2 -! - real(kind=kind_dbl_prec), parameter :: cons0 = 0.d0, cons1 = 1.d0, - & cons2 = 2.d0, cons4 = 4.d0, - & cons180 = 180.d0, - & cons360 = 360.d0, - & cons0p25 = 0.25d0 - real(kind=kind_qdt_prec), parameter :: eps = 1.d-20 -! -! for better accuracy to select smaller number -! eps = 1.d-12 -! eps = 1.d-20 -! - if(iprint == 1) print 101 - 101 format (' i colat colrad wgt', 12x, 'wgtcs', - & 10x, 'iter res') - si = cons1 - l2 = 2*lgghaf - rl2 = l2 - scale = cons2/(rl2*rl2) - k1 = l2-1 - pi = atan(si)*cons4 -! dradz = pi / cons360 / 10.0 -! for better accuracy to start iteration - dradz = pi / float(lgghaf) / 200.0 - rad = cons0 - do k=1,lgghaf - iter = 0 - drad = dradz -1 call poly(l2,rad,p2) -2 p1 = p2 - iter = iter + 1 - rad = rad + drad - call poly(l2,rad,p2) - if(sign(si,p1) == sign(si,p2)) go to 2 - if(drad < eps)go to 3 - rad = rad-drad - drad = drad * cons0p25 - go to 1 -3 continue - colrad(k) = rad - phi = rad * cons180 / pi - call poly(k1,rad,p1) - x = cos(rad) - w = scale * (cons1 - x*x)/ (p1*p1) - wgt(k) = w - sn = sin(rad) - w = w/(sn*sn) - wgtcs(k) = w - rc = cons1/(sn*sn) - rcs2(k) = rc - call poly(l2,rad,p1) - if(iprint == 1) - & print 102,k,phi,colrad(k),wgt(k),wgtcs(k),iter,p1 - 102 format(1x,i3,2x,f6.2,2x,f10.7,2x,e14.7,2x,e14.7,2x,i4,2x,e14.7) - enddo - if(iprint == 1) print 100,lgghaf -100 format(1h ,'shalom from 0.0e0 glats for ',i3) -! - return - end - - subroutine poly(n,rad,p) - use machine -! - implicit none -! - integer i,n -! -! increase precision for more significant digit to help wgt - real(kind=kind_qdt_prec) floati,g,p,rad,x,y1,y2,y3 -! - real(kind=kind_dbl_prec), parameter :: cons1 = 1.d0 -! - x = cos(rad) - y1 = cons1 - y2 = x - do i=2,n - g = x*y2 - floati = i - y3 = g - y1 + g - (g-y1)/floati - y1 = y2 - y2 = y3 - enddo - p = y3 - return - end - - end module glats_stochy_mod diff --git a/stochastic_physics/gozrineo_stochy.f b/stochastic_physics/gozrineo_stochy.f deleted file mode 100644 index 01210ff92..000000000 --- a/stochastic_physics/gozrineo_stochy.f +++ /dev/null @@ -1,180 +0,0 @@ - module gozrineo_a_stochy_mod - - implicit none - - contains - - subroutine gozrineo_a_stochy(plnev_a,plnod_a, - & pddev_a,pddod_a, - & plnew_a,plnow_a, - & epse,epso,rcs2_a,wgt_a,ls_node,num_lat) -cc - use stochy_resol_def - use spectral_layout_mod - use machine - implicit none -cc - real(kind=kind_dbl_prec) plnev_a(len_trie_ls,latg2) - real(kind=kind_dbl_prec) plnod_a(len_trio_ls,latg2) - real(kind=kind_dbl_prec) pddev_a(len_trie_ls,latg2) - real(kind=kind_dbl_prec) pddod_a(len_trio_ls,latg2) - real(kind=kind_dbl_prec) plnew_a(len_trie_ls,latg2) - real(kind=kind_dbl_prec) plnow_a(len_trio_ls,latg2) -cc - real(kind=kind_dbl_prec) epse(len_trie_ls) - real(kind=kind_dbl_prec) epso(len_trio_ls) -cc - real(kind=kind_dbl_prec) rcs2_a(latg2) - real(kind=kind_dbl_prec) wgt_a(latg2) -cc - integer ls_node(ls_dim,3) -cc - integer num_lat -cc -!cmr ls_node(1,1) ... ls_node(ls_max_node,1) : values of L -!cmr ls_node(1,2) ... ls_node(ls_max_node,2) : values of jbasev -!cmr ls_node(1,3) ... ls_node(ls_max_node,3) : values of jbasod -cc - integer l,lat,locl,n -cc - integer indev,indev1,indev2 - integer indod,indod1,indod2 - integer inddif -cc - real(kind=kind_dbl_prec) rn,rnp1,wcsa -cc - real(kind=kind_dbl_prec) cons0 !constant - real(kind=kind_dbl_prec) cons2 !constant - real rerth -cc - integer indlsev,jbasev - integer indlsod,jbasod -cc - include 'function2' -cc -cc - cons0 = 0.d0 !constant - cons2 = 2.d0 !constant - rerth =6.3712e+6 ! radius of earth (m) -cc -cc - do lat=1,num_lat -cc - do locl=1,ls_max_node - l=ls_node(locl,1) - jbasev=ls_node(locl,2) - jbasod=ls_node(locl,3) -cc - rn=l -cc -cc - pddev_a(indlsev(l,l),lat) = -epso(indlsod(l+1,l)) - & * plnod_a(indlsod(l+1,l),lat) * rn - indev1 = indlsev(L,L) + 1 - if (mod(L,2).eq.mod(jcap+1,2)) then - indev2 = indlsev(jcap-1,L) - else - indev2 = indlsev(jcap ,L) - endif - indod1 = indlsod(l+1,l) - inddif = indev1 - indod1 -cc - rn =l+2 - rnp1=l+2+1 - do indev = indev1 , indev2 -cc - pddev_a(indev,lat) = epse(indev) - & * plnod_a(indev-inddif ,lat) * rnp1 - & - epso(indev-inddif+1) - & * plnod_a(indev-inddif+1,lat) * rn -cc - rn = rn + cons2 !constant - rnp1 = rnp1 + cons2 !constant - enddo -cc -cc...................................................................... - indev1 = indlsev(L,L) - if (mod(L,2).eq.mod(jcap+1,2)) then - indev2 = indlsev(jcap+1,L) - 1 - else - indev2 = indlsev(jcap ,L) - 1 - endif - indod1 = indlsod(l+1,l) - inddif = indev1 - indod1 -cc - rn =l+1 - rnp1=l+1+1 - do indev = indev1 , indev2 -cc - pddod_a(indev-inddif,lat) = epso(indev-inddif) - & * plnev_a(indev ,lat) * rnp1 - & - epse(indev+1) - & * plnev_a(indev+1,lat) * rn -cc - rn = rn + cons2 !constant - rnp1 = rnp1 + cons2 !constant - enddo -cc - enddo -cc -cc...................................................................... -cc - do locl=1,ls_max_node - l=ls_node(locl,1) - jbasev=ls_node(locl,2) - jbasod=ls_node(locl,3) -cc - if (mod(L,2).eq.mod(jcap+1,2)) then -cc -cc set the even (n-l) terms of the top row to zero - pddev_a(indlsev(jcap+1,l),lat) = cons0 !constant -cc - else -cc -cc set the odd (n-l) terms of the top row to zero - pddod_a(indlsod(jcap+1,l),lat) = cons0 !constant -cc - endif -cc - enddo -cc -cc...................................................................... -cc - wcsa=rcs2_a(lat)/rerth -cc -cc - do locl=1,ls_max_node - l=ls_node(locl,1) - jbasev=ls_node(locl,2) - jbasod=ls_node(locl,3) - indev1 = indlsev(L,L) - indod1 = indlsod(L+1,L) - if (mod(L,2).eq.mod(jcap+1,2)) then - indev2 = indlsev(jcap+1,L) - indod2 = indlsod(jcap ,L) - else - indev2 = indlsev(jcap ,L) - indod2 = indlsod(jcap+1,L) - endif - do indev = indev1 , indev2 -cc - pddev_a(indev,lat) = pddev_a(indev,lat) * wcsa - plnew_a(indev,lat) = plnev_a(indev,lat) * wgt_a(lat) -cc - enddo -cc - do indod = indod1 , indod2 -cc - pddod_a(indod,lat) = pddod_a(indod,lat) * wcsa - plnow_a(indod,lat) = plnod_a(indod,lat) * wgt_a(lat) -cc - enddo -cc - enddo -cc - enddo -cc - return - end - - end module gozrineo_a_stochy_mod diff --git a/stochastic_physics/initialize_spectral_mod.F90 b/stochastic_physics/initialize_spectral_mod.F90 deleted file mode 100644 index 13d1dd2f0..000000000 --- a/stochastic_physics/initialize_spectral_mod.F90 +++ /dev/null @@ -1,268 +0,0 @@ -! !module: stochy_initialize_spectral -! --- initialize module of the -! gridded component of the stochastic physics patteern -! generator, which is in spectral space -! -! !description: gfs dynamics gridded component initialize module. -! -! !revision history: -! -! oct 11 2016 P.Pegion copy of gsm/dynamics to create stand alone version -! -! !interface: -! - module initialize_spectral_mod -! -!!uses: -! - use machine - use spectral_layout_mod, only : ipt_lats_node_a, lats_node_a_max,lon_dim_a,len_trie_ls,len_trio_ls & - ,nodes,ls_max_node,lats_dim_a,ls_dim,nodes_comp,lat1s_a - use stochy_layout_lag, only : lat1s_h - use stochy_internal_state_mod - use spectral_layout_mod,only:lon_dims_a - use stochy_resol_def - use stochy_namelist_def - use stochy_ccpp, only : is_master, num_parthds_stochy => ompthreads - use stochy_gg_def, only : wgt_a,sinlat_a,coslat_a,colrad_a,wgtcs_a,rcs2_a,lats_nodes_h,global_lats_h - use getcon_spectral_mod, only: getcon_spectral - use get_ls_node_stochy_mod, only: get_ls_node_stochy - use getcon_lag_stochy_mod, only: getcon_lag_stochy -#ifndef IBM - USE omp_lib -#endif - - implicit none - - contains - - subroutine initialize_spectral(gis_stochy, rc) - -! this subroutine set up the internal state variables, -! allocate internal state arrays for initializing the gfs system. -!---------------------------------------------------------------- -! - implicit none -! -! type(stochy_internal_state), pointer, intent(inout) :: gis_stochy - type(stochy_internal_state), intent(inout) :: gis_stochy - integer, intent(out) :: rc - integer :: ierr, npe_single_member, iret,latghf - integer :: i, j, k, l, n, locl - logical :: file_exists=.false. - integer, parameter :: iunit=101 - -!------------------------------------------------------------------- - -! set up gfs internal state dimension and values for dynamics etc -!------------------------------------------------------------------- -! print*,'before allocate lonsperlat,',& -! allocated(gis_stochy%lonsperlat),'latg=',latg -! -! gis_stochy%nodes=mpp_npes() -! print*,'mpp_npes=',mpp_npes() - nodes = gis_stochy%nodes - npe_single_member = gis_stochy%npe_single_member - - lon_dim_a = lon_s + 2 - jcap=ntrunc - jcap1 = jcap+1 - jcap2 = jcap+2 - latg = lat_s - latg2 = latg/2 - lonf = lon_s - lnt = jcap2*jcap1/2 - lnuv = jcap2*jcap1 - lnt2 = lnt + lnt - lnt22 = lnt2 + 1 - lnte = (jcap2/2)*((jcap2/2)+1)-1 - lnto = (jcap2/2)*((jcap2/2)+1)-(jcap2/2) - lnted = lnte - lntod = lnto - - gis_stochy%lnt2 = lnt2 - - allocate(lat1s_a(0:jcap)) - allocate(lon_dims_a(latg)) - - allocate(wgt_a(latg2)) - allocate(wgtcs_a(latg2)) - allocate(rcs2_a(latg2)) - -!! create io communicator and comp communicator -!! - nodes_comp=nodes -! -! if (is_master()) then -! print*,'number of threads is',num_parthds_stochy -! print*,'number of mpi procs is',nodes -! endif -! - ls_dim = (jcap1-1)/nodes+1 -! print*,'allocating lonsperlat',latg - allocate(gis_stochy%lonsperlat(latg)) -! print*,'size=',size(gis_stochy%lonsperlat) - - - inquire (file="lonsperlat.dat", exist=file_exists) - if ( .not. file_exists ) then - !call mpp_error(FATAL,'Requested lonsperlat.dat data file does not exist') - gis_stochy%lonsperlat(:)=lonf - else - open (iunit,file='lonsperlat.dat',status='old',form='formatted', & - action='read',iostat=iret) - if (iret /= 0) then - write(0,*) 'error while reading lonsperlat.dat' - rc = 1 - return - end if - rewind iunit - read (iunit,*,iostat=iret) latghf,(gis_stochy%lonsperlat(i),i=1,latghf) - if (latghf+latghf /= latg) then - write(0,*)' latghf=',latghf,' not equal to latg/2=',latg/2 - if (iret /= 0) then - write(0,*) 'lonsperlat file has wrong size' - rc = 1 - return - end if - endif - do i=1,latghf - gis_stochy%lonsperlat(latg-i+1) = gis_stochy%lonsperlat(i) - enddo - close(iunit) - endif -!! -!cxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx -! -! write(0,*)'before allocate ls_nodes,',allocated(gis_stochy%ls_nodes),& -! 'ls_dim=', ls_dim,'nodes=',nodes - allocate ( gis_stochy%ls_node (ls_dim*3) ) - allocate ( gis_stochy%ls_nodes(ls_dim,nodes) ) - allocate ( gis_stochy%max_ls_nodes(nodes) ) -! - allocate ( gis_stochy%lats_nodes_a_fix(nodes)) ! added for mGrid -! - allocate ( gis_stochy%lats_nodes_a(nodes) ) - allocate ( gis_stochy%global_lats_a(latg) ) -! - allocate ( gis_stochy%lats_nodes_ext(nodes) ) - allocate ( gis_stochy%global_lats_ext(latg+2*jintmx+2*nypt*(nodes-1)) ) - -! internal parallel structure. Weiyu. -!--------------------------------------------------- - ALLOCATE(gis_stochy%TRIE_LS_SIZE (npe_single_member)) - ALLOCATE(gis_stochy%TRIO_LS_SIZE (npe_single_member)) - ALLOCATE(gis_stochy%TRIEO_LS_SIZE (npe_single_member)) - ALLOCATE(gis_stochy%LS_MAX_NODE_GLOBAL(npe_single_member)) - ALLOCATE(gis_stochy%LS_NODE_GLOBAL (LS_DIM*3, npe_single_member)) - - gis_stochy%LS_NODE_GLOBAL = 0 - gis_stochy%LS_MAX_NODE_GLOBAL = 0 - gis_stochy%TRIEO_TOTAL_SIZE = 0 - - DO i = 1, npe_single_member - CALL GET_LS_NODE_STOCHY(i-1, gis_stochy%LS_NODE_GLOBAL(1, i), & - gis_stochy%LS_MAX_NODE_GLOBAL(i), gis_stochy%IPRINT) - gis_stochy%TRIE_LS_SIZE(i) = 0 - gis_stochy%TRIO_LS_SIZE(i) = 0 - DO LOCL = 1, gis_stochy%LS_MAX_NODE_GLOBAL(i) - gis_stochy%LS_NODE_GLOBAL(LOCL+ LS_DIM, i) = gis_stochy%TRIE_LS_SIZE(i) - gis_stochy%LS_NODE_GLOBAL(LOCL+ 2*LS_DIM, i) = gis_stochy%TRIO_LS_SIZE(i) - - L = gis_stochy%LS_NODE_GLOBAL(LOCL, i) - - gis_stochy%TRIE_LS_SIZE(i) = gis_stochy%TRIE_LS_SIZE(i) + (JCAP+3-L)/2 - gis_stochy%TRIO_LS_SIZE(i) = gis_stochy%TRIO_LS_SIZE(i) + (JCAP+2-L)/2 - END DO - gis_stochy%TRIEO_LS_SIZE(i) = gis_stochy%TRIE_LS_SIZE(i) + gis_stochy%TRIO_LS_SIZE(i) + 3 - gis_stochy%TRIEO_TOTAL_SIZE = gis_stochy%TRIEO_TOTAL_SIZE + gis_stochy%TRIEO_LS_SIZE(i) - END DO - - -!--------------------------------------------------- -! - gis_stochy%iprint = 0 - call get_ls_node_stochy( gis_stochy%me, gis_stochy%ls_node, ls_max_node, gis_stochy%iprint ) -! -! - len_trie_ls = 0 - len_trio_ls = 0 - do locl=1,ls_max_node - gis_stochy%ls_node(locl+ ls_dim) = len_trie_ls - gis_stochy%ls_node(locl+2*ls_dim) = len_trio_ls - l = gis_stochy%ls_node(locl) - len_trie_ls = len_trie_ls+(jcap+3-l)/2 - len_trio_ls = len_trio_ls+(jcap+2-l)/2 - enddo -! if (gis_stochy%me == 0) print *,'ls_node=',gis_stochy%ls_node(1:ls_dim),'2dim=', & -! gis_stochy%ls_node(ls_dim+1:2*ls_dim),'3dim=', & -! gis_stochy%ls_node(2*ls_dim+1:3*ls_dim) -! -! - allocate ( gis_stochy%epse (len_trie_ls) ) - allocate ( gis_stochy%epso (len_trio_ls) ) - allocate ( gis_stochy%epsedn(len_trie_ls) ) - allocate ( gis_stochy%epsodn(len_trio_ls) ) - allocate ( gis_stochy%kenorm_e(len_trie_ls) ) - allocate ( gis_stochy%kenorm_o(len_trio_ls) ) -! - allocate ( gis_stochy%snnp1ev(len_trie_ls) ) - allocate ( gis_stochy%snnp1od(len_trio_ls) ) -! - allocate ( gis_stochy%plnev_a(len_trie_ls,latg2) ) - allocate ( gis_stochy%plnod_a(len_trio_ls,latg2) ) - allocate ( gis_stochy%pddev_a(len_trie_ls,latg2) ) - allocate ( gis_stochy%pddod_a(len_trio_ls,latg2) ) - allocate ( gis_stochy%plnew_a(len_trie_ls,latg2) ) - allocate ( gis_stochy%plnow_a(len_trio_ls,latg2) ) - - allocate(colrad_a(latg2)) - allocate(sinlat_a(latg)) - allocate(coslat_a(latg)) - allocate(lat1s_h(0:jcap)) -! - if(gis_stochy%iret/=0) then - write(0,*) 'incompatible namelist - aborted in stochy' - rc = 1 - return - end if -!! - gis_stochy%lats_nodes_ext = 0 - call getcon_spectral(gis_stochy%ls_node, gis_stochy%ls_nodes, & - gis_stochy%max_ls_nodes, gis_stochy%lats_nodes_a, & - gis_stochy%global_lats_a, gis_stochy%lonsperlat, & - gis_stochy%lats_node_a_max, gis_stochy%lats_nodes_ext, & - gis_stochy%global_lats_ext, gis_stochy%epse, & - gis_stochy%epso, gis_stochy%epsedn, & - gis_stochy%epsodn, gis_stochy%snnp1ev, & - gis_stochy%snnp1od, gis_stochy%plnev_a, & - gis_stochy%plnod_a, gis_stochy%pddev_a, & - gis_stochy%pddod_a, gis_stochy%plnew_a, & - gis_stochy%plnow_a, gis_stochy%colat1) -! - gis_stochy%lats_node_a = gis_stochy%lats_nodes_a(gis_stochy%me+1) - gis_stochy%ipt_lats_node_a = ipt_lats_node_a - -! if (gis_stochy%me == 0) & -! write(0,*)'after getcon_spectral lats_node_a=',gis_stochy%lats_node_a & -! ,'ipt_lats_node_a=',gis_stochy%ipt_lats_node_a -! - if (.not. allocated(lats_nodes_h)) allocate (lats_nodes_h(nodes)) - if (.not. allocated(global_lats_h)) allocate (global_lats_h(latg+2*gis_stochy%yhalo*nodes)) - call getcon_lag_stochy(gis_stochy%lats_nodes_a,gis_stochy%global_lats_a, & - lats_nodes_h, global_lats_h, & - gis_stochy%lonsperlat,gis_stochy%xhalo,gis_stochy%yhalo) - -! -! - allocate ( gis_stochy%trie_ls (len_trie_ls,2,lotls) ) - allocate ( gis_stochy%trio_ls (len_trio_ls,2,lotls) ) - -! if (gis_stochy%me == 0) then -! print*, ' lats_dim_a=', lats_dim_a, ' lats_node_a=', gis_stochy%lats_node_a -! endif - rc=0 - - end subroutine initialize_spectral - - end module initialize_spectral_mod diff --git a/stochastic_physics/pln2eo_stochy.f b/stochastic_physics/pln2eo_stochy.f deleted file mode 100644 index 4c6576ba6..000000000 --- a/stochastic_physics/pln2eo_stochy.f +++ /dev/null @@ -1,287 +0,0 @@ - module pln2eo_a_stochy_mod - - implicit none - - contains - - subroutine pln2eo_a_stochy(plnev_a,plnod_a,epse,epso,colrad_a, - & ls_node,num_lat) -! -! use x-number method to archieve accuracy due to recursive to avoid -! underflow and overflow if necessary by henry juang 2012 july -! - use stochy_resol_def - use spectral_layout_mod - use machine - implicit none -! -! define x number constant for real8 start - integer, parameter :: in_f = 960 , in_h = in_f/2 - real(kind=kind_dbl_prec), parameter :: bb_f = 2.d0 ** ( in_f ) - real(kind=kind_dbl_prec), parameter :: bs_f = 2.d0 ** (-in_f ) - real(kind=kind_dbl_prec), parameter :: bb_h = 2.d0 ** ( in_h ) - real(kind=kind_dbl_prec), parameter :: bs_h = 2.d0 ** (-in_h ) -! define x number constant end - -cc - real(kind=kind_dbl_prec) plnev_a(len_trie_ls,latg2) - real(kind=kind_dbl_prec) plnod_a(len_trio_ls,latg2) -cc - real(kind=kind_dbl_prec) epse(len_trie_ls) - real(kind=kind_dbl_prec) epso(len_trio_ls) -cc - real(kind=kind_dbl_prec) colrad_a(latg2) -cc - integer ls_node(ls_dim,3) -cc - integer num_lat -cc -!cmr ls_node(1,1) ... ls_node(ls_max_node,1) : values of L -!cmr ls_node(1,2) ... ls_node(ls_max_node,2) : values of jbasev -!cmr ls_node(1,3) ... ls_node(ls_max_node,3) : values of jbasod -cc - integer l,lat,locl,max_l,n -cc - integer indev - integer indod -cc -! need index for alp to be x-number - integer id, ialp1, ialp2, ialp3, iprod - integer ialp10(0:jcap) - real(kind=kind_dbl_prec) aa, bb, w - - real(kind=kind_dbl_prec) a,alp1,alp2,alp3,b - real(kind=kind_dbl_prec) cos2,fl,prod,sinlat,coslat -cc - real(kind=kind_dbl_prec) alp10(0:jcap) -cc - real(kind=kind_dbl_prec) cons0,cons0p5,cons1,cons2,cons3 !constant -cc -cc - integer indlsev,jbasev - integer indlsod,jbasod -cc - include 'function2' -cc -cc - cons0=0.0d0 !constant - cons0p5=0.5d0 !constant - cons1=1.0d0 !constant - cons2=2.0d0 !constant - cons3=3.0d0 !constant -cc -cc - max_l=-1 - do locl=1,ls_max_node - max_l = max ( max_l, ls_node(locl,1) ) - enddo -cc -cc - do lat=1,num_lat -cc - sinlat = cos(colrad_a(lat)) - cos2=cons1-sinlat*sinlat !constant - coslat = sqrt(cos2) - -! use x number for alp10 - alp10(0) = sqrt(0.5) - ialp10(0) = 0 - - do l=1,max_l - fl = l - prod=coslat*sqrt(cons1+cons1/(cons2*fl)) - iprod=0 - w = abs(prod) - if( w.ge.bb_h ) then - prod = prod * bs_f - iprod = iprod + 1 - elseif( w.lt.bs_h ) then - prod = prod * bb_f - iprod = iprod - 1 - endif - alp10(l)=alp10(l-1)*prod - ialp10(l)=ialp10(l-1)+iprod - w = abs(alp10(l)) - if( w.ge.bb_h ) then - alp10(l) = alp10(l) * bs_f - ialp10(l) = ialp10(l) + 1 - elseif( w.lt.bs_h ) then - alp10(l) = alp10(l) * bb_f - ialp10(l) = ialp10(l) - 1 - endif - enddo -cc - do locl=1,ls_max_node - l=ls_node(locl,1) - jbasev=ls_node(locl,2) - jbasod=ls_node(locl,3) - n=l - fl=l -! get m=normalized x number for alp1 start - alp1=alp10(l) - ialp1=ialp10(l) - - indev=indlsev(n ,l) - indod=indlsod(n+1,l) -! x2f plnev_a(indev ,lat)=alp1 -! x2f start - if( ialp1.eq.0 ) then - plnev_a(indev ,lat)=alp1 - elseif( ialp1.eq.-1 ) then - plnev_a(indev ,lat)=alp1 * bs_f - elseif( ialp1.lt.-1 ) then - plnev_a(indev ,lat)=0.0 -!! plnev_a(indev ,lat)=alp1 * bs_f * bs_f - else - plnev_a(indev ,lat)=alp1 * bb_f - endif -! x2f end - -! xltime alp2=sqrt(cons2*fl+cons3)*sinlat*alp1 !constant -! xltime start - prod=sqrt(cons2*fl+cons3)*sinlat - iprod=0 - w = abs(prod) - if( w.ge.bb_h ) then - prod = prod * bs_f - iprod = iprod + 1 - elseif( w.lt.bs_h ) then - prod = prod * bb_f - iprod = iprod - 1 - endif - alp2=alp1*prod - ialp2 = ialp1 + iprod -! xltime end -! norm alp2 start - w = abs(alp2) - if( w.ge.bb_h ) then - alp2 = alp2*bs_f - ialp2 = ialp2 + 1 - elseif( w.lt.bs_h ) then - alp2 = alp2*bb_f - ialp2 = ialp2 - 1 - endif -! norm alp2 end - -! x2f plnod_a(indod ,lat)=alp2 -! x2f start - if( ialp2.eq.0 ) then - plnod_a(indod ,lat)=alp2 - elseif( ialp2.eq.-1 ) then - plnod_a(indod ,lat)=alp2 * bs_f - elseif( ialp2.lt.-1 ) then - plnod_a(indod ,lat)=0.0 -!! plnod_a(indod ,lat)=alp2 * bs_f * bs_f - else - plnod_a(indod ,lat)=alp2 * bb_f - endif -! x2f end -cc - do n=l+2,jcap+1 - if(mod(n+l,2).eq.0) then - indev=indev+1 -! xlsum2 start - aa = sinlat / epse(indev) - bb = epso(indod) / epse(indev) - id = ialp2 - ialp1 - if( id.eq.0 ) then - alp3 = aa*alp2 - bb*alp1 - ialp3 = ialp1 - elseif( id.eq.1 ) then - alp3 = aa*alp2 - bb*alp1*bs_f - ialp3 = ialp2 - elseif( id.eq.-1 ) then - alp3 = aa*alp2*bs_f - bb*alp1 - ialp3 = ialp1 - elseif( id.gt.1 ) then - alp3 = aa*alp2 - ialp3 = ialp2 - else - alp3 = - bb*alp1 - ialp3 = ialp1 - endif -! xlsum2 end -! xnorm alp3 start - w = abs(alp3) - if( w.ge.bb_h ) then - alp3 = alp3*bs_f - ialp3 = ialp3 + 1 - elseif( w.lt.bs_h ) then - alp3 = alp3*bb_f - ialp3 = ialp3 - 1 - endif -! xnorm alp3 end - -! x2f alp3 start - if( ialp3.eq.0 ) then - plnev_a(indev,lat)=alp3 - elseif( ialp3.eq.-1 ) then - plnev_a(indev,lat)=alp3 * bs_f - elseif( ialp3.lt.-1 ) then - plnev_a(indev,lat)=0.0 - else - plnev_a(indev,lat)=alp3 * bb_f - endif -! x2f alp3 end - - else - indod=indod+1 - -! xlsum2 start - aa = sinlat / epso(indod) - bb = epse(indev) / epso(indod) - id = ialp2 - ialp1 - if( id.eq.0 ) then - alp3 = aa*alp2 - bb*alp1 - ialp3 = ialp1 - elseif( id.eq.1 ) then - alp3 = aa*alp2 - bb*alp1*bs_f - ialp3 = ialp2 - elseif( id.eq.-1 ) then - alp3 = aa*alp2*bs_f - bb*alp1 - ialp3 = ialp1 - elseif( id.gt.1 ) then - alp3 = aa*alp2 - ialp3 = ialp2 - else - alp3 = - bb*alp1 - ialp3 = ialp1 - endif -! xlsum2 end -! xnorm alp3 start - w = abs(alp3) - if( w.ge.bb_h ) then - alp3 = alp3*bs_f - ialp3 = ialp3 + 1 - elseif( w.lt.bs_h ) then - alp3 = alp3*bb_f - ialp3 = ialp3 - 1 - endif -! xnorm alp3 end - -! x2f alp3 start - if( ialp3.eq.0 ) then - plnod_a(indod,lat)=alp3 - elseif( ialp3.eq.-1 ) then - plnod_a(indod,lat)=alp3 * bs_f - elseif( ialp3.lt.-1 ) then - plnod_a(indod,lat)=0.0 - else - plnod_a(indod,lat)=alp3 * bb_f - endif -! x2f alp3 end - endif - alp1=alp2 - alp2=alp3 - ialp1 = ialp2 - ialp2 = ialp3 - enddo -cc - enddo -cc - enddo -cc - return - end - - end module pln2eo_a_stochy_mod diff --git a/stochastic_physics/setlats_a_stochy.f b/stochastic_physics/setlats_a_stochy.f deleted file mode 100644 index 4eb4b876f..000000000 --- a/stochastic_physics/setlats_a_stochy.f +++ /dev/null @@ -1,195 +0,0 @@ - module setlats_a_stochy_mod - - implicit none - - contains - - subroutine setlats_a_stochy(lats_nodes_a,global_lats_a, - & iprint,lonsperlat) -! - use stochy_resol_def , only : latg,lonf - use spectral_layout_mod , only : nodes,me -! - implicit none -! - integer, dimension(latg) :: global_lats_a, lonsperlat - integer lats_nodes_a(nodes) - - integer iprint,opt,ifin,nodesio - &, jcount,jpt,lat,lats_sum,node,i,ii - &, ngrptg,ngrptl,ipe,irest,idp - &, ngrptgh,nodesioh -! &, ilatpe,ngrptg,ngrptl,ipe,irest,idp -! - integer,allocatable :: lats_hold(:,:) -! - allocate ( lats_hold(latg,nodes) ) -! -! iprint = 1 - iprint = 0 - opt = 1 ! reduced grid - if (opt == 2) lonsperlat = lonf ! full grid - lats_nodes_a = 0 -! if (liope .and. icolor == 2) then -! nodesio = 1 -! else - nodesio = nodes -! endif -! - ngrptg = 0 - do lat=1,latg - do i=1,lonsperlat(lat) - ngrptg = ngrptg + 1 - enddo - enddo - -! -! ngrptg contains total number of grid points. -! -! distribution of the grid - nodesioh = nodesio / 2 - - if (nodesioh*2 /= nodesio) then -! ilatpe = ngrptg / nodesio - ngrptl = 0 - ipe = 0 - irest = 0 - idp = 1 - - do lat=1,latg - ifin = lonsperlat(lat) - ngrptl = ngrptl + ifin - -! if (me == 0) -! &write(2000+me,*)'in setlats lat=',lat,' latg=',latg,' ifin=',ifin -! &,' ngrptl=',ngrptl,' nodesio=',nodesio,' ngrptg=',ngrptg -! &,' irest=',irest - - if (ngrptl*nodesio <= ngrptg+irest) then - lats_nodes_a(ipe+1) = lats_nodes_a(ipe+1) + 1 - lats_hold(idp,ipe+1) = lat - idp = idp + 1 -! if (me == 0) -! & write(2000+me,*)' nodesio1=',nodesio,' idp=',idp,' ipe=',ipe - else - ipe = ipe + 1 - if (ipe <= nodesio) lats_hold(1,ipe+1) = lat - idp = 2 - irest = irest + ngrptg - (ngrptl-ifin)*nodesio - ngrptl = ifin - lats_nodes_a(ipe+1) = lats_nodes_a(ipe+1) + 1 -! if (me == 0) -! & write(2000+me,*)' nodesio1=',nodesio,' idp=',idp,' ipe=',ipe - endif -! if (me == 0) -! & write(2000+me,*)' lat=',lat,' lats_nodes_a=',lats_nodes_a(ipe+1) -! &,' ipe+1=',ipe+1 - enddo - else - nodesioh = nodesio/2 - ngrptgh = ngrptg/2 - ngrptl = 0 - ipe = 0 - irest = 0 - idp = 1 - - do lat=1,latg/2 - ifin = lonsperlat(lat) - ngrptl = ngrptl + ifin - -! if (me == 0) -! &write(0,*)'in setlats lat=',lat,' latg=',latg,' ifin=',ifin -! &,' ngrptl=',ngrptl,' nodesio=',nodesio,' ngrptg=',ngrptg -! &,' irest=',irest,' ngrptgh=',ngrptgh,' nodesioh=',nodesioh - - if (ngrptl*nodesioh <= ngrptgh+irest .or. lat == latg/2) then - lats_nodes_a(ipe+1) = lats_nodes_a(ipe+1) + 1 - lats_hold(idp,ipe+1) = lat -! lats_nodes_a(nodesio-ipe) = lats_nodes_a(nodesio-ipe) + 1 -! lats_hold(idp,nodesio-ipe) = latg+1-lat - idp = idp + 1 -! if (me == 0) -! & write(0,*)' nodesio1=',nodesioh,' idp=',idp,' ipe=',ipe - else - ipe = ipe + 1 - if (ipe <= nodesioh) then - lats_hold(1,ipe+1) = lat -! lats_hold(1,nodesio-ipe) = latg+1-lat - endif - idp = 2 - irest = irest + ngrptgh - (ngrptl-ifin)*nodesioh - ngrptl = ifin - lats_nodes_a(ipe+1) = lats_nodes_a(ipe+1) + 1 -! lats_nodes_a(nodesio-ipe) = lats_nodes_a(nodesio-ipe) + 1 -! if (me == 0) -! & write(0,*)' nodesio1h=',nodesioh,'idp=',idp,' ipe=',ipe - endif -! if (me == 0) -! & write(0,*)' lat=',lat,' lats_nodes_a=',lats_nodes_a(ipe+1) -! &,' ipe+1=',ipe+1 - enddo - do node=1, nodesioh - ii = nodesio-node+1 - jpt = lats_nodes_a(node) - lats_nodes_a(ii) = jpt - do i=1,jpt - lats_hold(jpt+1-i,ii) = latg+1-lats_hold(i,node) - enddo - enddo - - - endif -!! -!!........................................................ -!! - jpt = 0 - do node=1,nodesio -! write(2000+me,*)'node=',node,' lats_nodes_a=',lats_nodes_a(node) -! &, ' jpt=',jpt,' nodesio=',nodesio - if ( lats_nodes_a(node) > 0 ) then - do jcount=1,lats_nodes_a(node) - global_lats_a(jpt+jcount) = lats_hold(jcount,node) -! write(2000+me,*)' jpt+jcount=',jpt+jcount -! &, 'global_lats_a=',global_lats_a(jpt+jcount) - enddo - endif - jpt = jpt + lats_nodes_a(node) - enddo -!! - deallocate (lats_hold) - if ( iprint /= 1 ) return -!! - if (me == 0) then - jpt=0 - do node=1,nodesio - if ( lats_nodes_a(node) > 0 ) then - print 600 - lats_sum=0 - do jcount=1,lats_nodes_a(node) - lats_sum=lats_sum + lonsperlat(global_lats_a(jpt+jcount)) - print 700, node-1, - x node, lats_nodes_a(node), - x jpt+jcount, global_lats_a(jpt+jcount), - x lonsperlat(global_lats_a(jpt+jcount)), - x lats_sum - enddo - endif - jpt=jpt+lats_nodes_a(node) - enddo -! - print 600 -! - 600 format ( ' ' ) -! - 700 format ( 'setlats me=', i4, - x ' lats_nodes_a(', i4, ' )=', i4, - x ' global_lats_a(', i4, ' )=', i4, - x ' lonsperlat=', i5, - x ' lats_sum=', i6 ) -! - endif - - return - end - - end module setlats_a_stochy_mod diff --git a/stochastic_physics/setlats_lag_stochy.f b/stochastic_physics/setlats_lag_stochy.f deleted file mode 100644 index ff4e4f0a6..000000000 --- a/stochastic_physics/setlats_lag_stochy.f +++ /dev/null @@ -1,127 +0,0 @@ - module setlats_lag_stochy_mod - - implicit none - - contains - - subroutine setlats_lag_stochy(lats_nodes_a, global_lats_a, - & lats_nodes_h, global_lats_h, yhalo) -! - use stochy_resol_def, only : latg - use spectral_layout_mod, only : me,nodes - implicit none -! - integer yhalo -! - integer lats_nodes_a(nodes), lats_nodes_h(nodes) - &, global_lats_a(latg) - &, global_lats_h(latg+2*yhalo*nodes) -! - integer jj,jpt_a,jpt_h,lat_val,nn,nodes_lats - &, j1, j2, iprint -! - lats_nodes_h = 0 -! - nodes_lats = 0 - do nn=1,nodes - if (lats_nodes_a(nn) > 0) then - lats_nodes_h(nn) = lats_nodes_a(nn) + yhalo + yhalo - nodes_lats = nodes_lats + 1 - endif - enddo -! - global_lats_h = 0 -! -! set non-yhalo latitudes -! - jpt_a = 0 - jpt_h = yhalo - do nn=1,nodes - if (lats_nodes_a(nn) > 0) then - do jj=1,lats_nodes_a(nn) - jpt_a = jpt_a + 1 - jpt_h = jpt_h + 1 - global_lats_h(jpt_h) = global_lats_a(jpt_a) - enddo - jpt_h = jpt_h + yhalo + yhalo - endif - enddo -! - j1 = latg + (yhalo+yhalo) * nodes_lats - do jj=1,yhalo - j2 = yhalo - jj - global_lats_h(jj) = global_lats_a(1) + j2 ! set north pole yhalo - global_lats_h(j1-j2) = global_lats_a(latg) + 1 - jj ! set south pole yhalo - enddo -! - if (lats_nodes_a(1) /= latg) then -! -! set non-polar south yhalos - jpt_h = 0 - do nn=1,nodes-1 - jpt_h = jpt_h + lats_nodes_h(nn) - lat_val = global_lats_h(jpt_h-yhalo) - do jj=1,yhalo - global_lats_h(jpt_h-yhalo+jj) = min(lat_val+jj,latg) - enddo - enddo -! -! set non-polar north yhalos - jpt_h = 0 - do nn=1,nodes-1 - jpt_h = jpt_h + lats_nodes_h(nn) - lat_val = global_lats_h(jpt_h+yhalo+1) - do jj=1,yhalo - global_lats_h(jpt_h+yhalo-(jj-1)) = max(lat_val-jj,1) - enddo - enddo -! - endif -! - - iprint = 0 -! iprint = 1 - if (iprint == 1 .and. me == 0) then -! - write(me+6000,'("setlats_h yhalo=",i3," nodes=",i3/)') - & yhalo,nodes -! - do nn=1,nodes - write(me+6000,'("lats_nodes_a(",i4,")=",i4," ", - & " lats_nodes_h(",i4,")=",i4)') - & nn, lats_nodes_a(nn), - & nn, lats_nodes_h(nn) - enddo -! - jpt_a = 0 - do nn=1,nodes - if (lats_nodes_a(nn) > 0) then - write(me+6000,'(" ")') - do jj=1,lats_nodes_a(nn) - jpt_a=jpt_a+1 - write(me+6000,'(2i4," global_lats_a(",i4,")=",i4)') - & nn, jj, jpt_a, global_lats_a(jpt_a) - enddo - endif - enddo -! - jpt_h=0 - do nn=1,nodes - if (lats_nodes_h(nn).gt.0) then - write(me+6000,'(" ")') - do jj=1,lats_nodes_h(nn) - jpt_h=jpt_h+1 - write(me+6000,'(2i4," global_lats_h(",i4,")=",i4)') - & nn, jj, jpt_h, global_lats_h(jpt_h) - enddo - endif - enddo -! - close(6000+me) - endif -! close(6000+me) -! - return - end - - end module setlats_lag_stochy_mod diff --git a/stochastic_physics/spectral_layout.f b/stochastic_physics/spectral_layout.f deleted file mode 100644 index 687e2da82..000000000 --- a/stochastic_physics/spectral_layout.f +++ /dev/null @@ -1,31 +0,0 @@ - module spectral_layout_mod - - implicit none -! -! program log: -! 20161011 philip pegion : make stochastic pattern generator standalone -! -! 20180731 dom heinzeller : todo: cleanup nodes, me, ... (defined multiple times in confusing ways in several files) -! - - integer nodes, nodes_comp,nodes_io, - & me,lon_dim_a, - & ls_dim, - & ls_max_node, - & lats_dim_a, - & lats_node_a, - & lats_node_a_max, - & ipt_lats_node_a, - & len_trie_ls, - & len_trio_ls, - & len_trie_ls_max, - & len_trio_ls_max, - & me_l_0, - - & lats_dim_ext, - & lats_node_ext, - & ipt_lats_node_ext -! - INTEGER ,ALLOCATABLE :: lat1s_a(:), lon_dims_a(:),lon_dims_ext(:) - - end module spectral_layout_mod diff --git a/stochastic_physics/stochastic_physics.F90 b/stochastic_physics/stochastic_physics.F90 deleted file mode 100644 index 51a173173..000000000 --- a/stochastic_physics/stochastic_physics.F90 +++ /dev/null @@ -1,420 +0,0 @@ -!>\file stochastic_physics.F90 -!! This file includes - -!>\ingroup gfs_stoch -!! This module -module stochastic_physics - -use stochy_ccpp, only : is_initialized, & - is_master, & - mpicomm, & - mpirank, & - mpiroot, & - mpisize, & - ompthreads - -implicit none - -private - -public :: stochastic_physics_init, stochastic_physics_run, stochastic_physics_finalize - -contains - -!> This subroutine -!> \section arg_table_stochastic_physics_init Argument Table -!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | -!! |----------------|--------------------------------------------------------|-------------------------------------------------------------------------|----------|------|-----------------------|-----------|--------|----------| -!! | Model | GFS_control_type_instance | Fortran DDT containing FV3-GFS model control parameters | DDT | 0 | GFS_control_type | | inout | F | -!! | nthreads | omp_threads | number of OpenMP threads available for physics schemes | count | 0 | integer | | in | F | -!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | -!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | -!! -subroutine stochastic_physics_init(Model, nthreads, errmsg, errflg) -use stochy_internal_state_mod -use stochy_data_mod, only : nshum,rpattern_shum,init_stochdata,rpattern_sppt,nsppt,rpattern_skeb,nskeb,gg_lats,gg_lons,& - rad2deg,INTTYP,wlon,rnlat,gis_stochy,vfact_skeb,vfact_sppt,vfact_shum,skeb_vpts,skeb_vwts,sl -use stochy_resol_def, only : latg,lonf,skeblevs -use stochy_gg_def, only : colrad_a -use stochy_namelist_def -use physcons, only: con_pi -use spectral_layout_mod, only:me -use GFS_typedefs, only: GFS_control_type - -implicit none -type(GFS_control_type), intent(inout) :: Model -integer, intent(in) :: nthreads -character(len=*), intent(out) :: errmsg -integer, intent(out) :: errflg - -integer :: nblks -integer :: iret -real*8 :: PRSI(Model%levs),PRSL(Model%levs),dx -real, allocatable :: skeb_vloc(:) -integer :: k,kflip,latghf,nodes,blk,k2 -character*2::proc - -! Initialize CCPP error handling variables -errmsg = '' -errflg = 0 - -! Set/update shared variables in stochy_ccpp -mpicomm = Model%communicator -mpirank = Model%me -mpiroot = Model%master -mpisize = Model%ntasks -ompthreads = nthreads -is_initialized = .true. - -! ------------------------------------------ - -nblks = size(Model%blksz) - -! replace -rad2deg=180.0/con_pi -INTTYP=0 ! bilinear interpolation -me=Model%me -nodes=Model%ntasks -gis_stochy%me=me -gis_stochy%nodes=nodes -call init_stochdata(Model%levs,Model%dtp,Model%input_nml_file,Model%fn_nml,Model%nlunit,iret) -! check to see decomposition -!if(Model%isppt_deep == .true.)then -!do_sppt = .true. -!endif -! check namelist entries for consistency -if (Model%do_sppt.neqv.do_sppt) then - write(errmsg,'(*(a))') 'Logic error in stochastic_physics_init: incompatible', & - & ' namelist settings do_sppt and sppt' - errflg = 1 -else if (Model%do_shum.neqv.do_shum) then - write(errmsg,'(*(a))') 'Logic error in stochastic_physics_init: incompatible', & - & ' namelist settings do_shum and shum' - errflg = 1 -else if (Model%do_skeb.neqv.do_skeb) then - write(errmsg,'(*(a))') 'Logic error in stochastic_physics_init: incompatible', & - & ' namelist settings do_skeb and skeb' - errflg = 1 -else if (Model%do_sfcperts.neqv.do_sfcperts) then ! mg, sfc-perts - write(errmsg,'(*(a))') 'Logic error in stochastic_physics_init: incompatible', & - & ' namelist settings do_sfcperts and pertz0 / pertshc / pertzt / pertlai / pertvegf / pertalb' - errflg = 1 -end if -! update remaining model configuration parameters from namelist -Model%use_zmtnblck=use_zmtnblck -Model%skeb_npass=skeb_npass -Model%nsfcpert=nsfcpert ! mg, sfc-perts -Model%pertz0=pertz0 ! mg, sfc-perts -Model%pertzt=pertzt ! mg, sfc-perts -Model%pertshc=pertshc ! mg, sfc-perts -Model%pertlai=pertlai ! mg, sfc-perts -Model%pertalb=pertalb ! mg, sfc-perts -Model%pertvegf=pertvegf ! mg, sfc-perts -if ( (.NOT. do_sppt) .AND. (.NOT. do_shum) .AND. (.NOT. do_skeb) .AND. (.NOT. do_sfcperts) ) return -allocate(sl(Model%levs)) -do k=1,Model%levs - sl(k)= 0.5*(Model%ak(k)/101300.+Model%bk(k)+Model%ak(k+1)/101300.0+Model%bk(k+1)) ! si are now sigmas -! if(is_master())print*,'sl(k)',k,sl(k),Model%ak(k),Model%bk(k) -enddo -if (do_sppt) then - allocate(vfact_sppt(Model%levs)) - do k=1,Model%levs - if (sl(k) .lt. sppt_sigtop1 .and. sl(k) .gt. sppt_sigtop2) then - vfact_sppt(k) = (sl(k)-sppt_sigtop2)/(sppt_sigtop1-sppt_sigtop2) - else if (sl(k) .lt. sppt_sigtop2) then - vfact_sppt(k) = 0.0 - else - vfact_sppt(k) = 1.0 - endif - enddo - if (sppt_sfclimit) then - vfact_sppt(2)=vfact_sppt(3)*0.5 - vfact_sppt(1)=0.0 - endif - if (is_master()) then - do k=1,MOdel%levs - print *,'sppt vert profile',k,sl(k),vfact_sppt(k) - enddo - endif -endif -if (do_skeb) then - !print*,'allocating skeb stuff',skeblevs - allocate(vfact_skeb(Model%levs)) - allocate(skeb_vloc(skeblevs)) ! local - allocate(skeb_vwts(Model%levs,2)) ! save for later - allocate(skeb_vpts(Model%levs,2)) ! save for later - do k=1,Model%levs - if (sl(k) .lt. skeb_sigtop1 .and. sl(k) .gt. skeb_sigtop2) then - vfact_skeb(k) = (sl(k)-skeb_sigtop2)/(skeb_sigtop1-skeb_sigtop2) - else if (sl(k) .lt. skeb_sigtop2) then - vfact_skeb(k) = 0.0 - else - vfact_skeb(k) = 1.0 - endif - if (is_master()) print *,'skeb vert profile',k,sl(k),vfact_skeb(k) - enddo -! calculate vertical interpolation weights - do k=1,skeblevs - skeb_vloc(k)=sl(1)-real(k-1)/real(skeblevs-1.0)*(sl(1)-sl(Model%levs)) - enddo -! surface -skeb_vwts(1,2)=0 -skeb_vpts(1,1)=1 -! top -skeb_vwts(Model%levs,2)=1 -skeb_vpts(Model%levs,1)=skeblevs-2 -! internal -DO k=2,Model%levs-1 - DO k2=1,skeblevs-1 - IF (sl(k) .LE. skeb_vloc(k2) .AND. sl(k) .GT. skeb_vloc(k2+1)) THEN - skeb_vpts(k,1)=k2 - skeb_vwts(k,2)=(skeb_vloc(k2)-sl(k))/(skeb_vloc(k2)-skeb_vloc(k2+1)) - ENDIF - ENDDO -ENDDO -deallocate(skeb_vloc) -if (is_master()) then -DO k=1,Model%levs - print*,'skeb vpts ',skeb_vpts(k,1),skeb_vwts(k,2) -ENDDO -endif -skeb_vwts(:,1)=1.0-skeb_vwts(:,2) -skeb_vpts(:,2)=skeb_vpts(:,1)+1.0 -endif - -if (do_shum) then - allocate(vfact_shum(Model%levs)) - do k=1,Model%levs - vfact_shum(k) = exp((sl(k)-1.)/shum_sigefold) - if (sl(k).LT. 2*shum_sigefold) then - vfact_shum(k)=0.0 - endif - if (is_master()) print *,'shum vert profile',k,sl(k),vfact_shum(k) - enddo -endif -! get interpolation weights -! define gaussian grid lats and lons -latghf=latg/2 -!print *,'define interp weights',latghf,lonf -!print *,allocated(gg_lats),allocated(gg_lons) -allocate(gg_lats(latg)) -!print *,'aloocated lats' -allocate(gg_lons(lonf)) -!print *,'aloocated lons' -do k=1,latghf - gg_lats(k)=-1.0*colrad_a(latghf-k+1)*rad2deg - gg_lats(latg-k+1)=-1*gg_lats(k) -enddo -dx=360.0/lonf -!print*,'dx=',dx -do k=1,lonf - gg_lons(k)=dx*(k-1) -enddo -WLON=gg_lons(1)-(gg_lons(2)-gg_lons(1)) -RNLAT=gg_lats(1)*2-gg_lats(2) - -!print *,'done with init_stochastic_physics' - -if(Model%me == Model%master) print*,'do_skeb=',Model%do_skeb - -end subroutine stochastic_physics_init - - -!> \section arg_table_stochastic_physics_run Argument Table -!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | -!! |----------------|--------------------------------------------------------|-------------------------------------------------------------------------|----------|------|-----------------------|-----------|--------|----------| -!! | Model | GFS_control_type_instance | Fortran DDT containing FV3-GFS model control parameters | DDT | 0 | GFS_control_type | | in | F | -!! | Data | GFS_data_type_instance_all_blocks | Fortran DDT containing FV3-GFS data | DDT | 1 | GFS_data_type | | inout | F | -!! | nthreads | omp_threads | number of OpenMP threads available for physics schemes | count | 0 | integer | | in | F | -!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | -!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | -!! -subroutine stochastic_physics_run(Model, Data, nthreads, errmsg, errflg) -use stochy_internal_state_mod -use stochy_data_mod, only : nshum,rpattern_shum,rpattern_sppt,nsppt,rpattern_skeb,nskeb,& - rad2deg,INTTYP,wlon,rnlat,gis_stochy,vfact_sppt,vfact_shum,vfact_skeb -use get_stochy_pattern_mod,only : get_random_pattern_fv3,get_random_pattern_fv3_vect,dump_patterns -use stochy_resol_def , only : latg,lonf -use stochy_namelist_def -use spectral_layout_mod,only:me -use GFS_typedefs, only: GFS_control_type, GFS_data_type -implicit none -type(GFS_control_type), intent(in) :: Model -type(GFS_data_type), intent(inout) :: Data(:) -integer, intent(in) :: nthreads -character(len=*), intent(out) :: errmsg -integer, intent(out) :: errflg - -real,allocatable :: tmp_wts(:,:),tmpu_wts(:,:,:),tmpv_wts(:,:,:) -!D-grid -integer :: k -integer j,ierr,i -integer :: nblks, blk, len, maxlen -character*120 :: sfile -character*6 :: STRFH - -! Initialize CCPP error handling variables -errmsg = '' -errflg = 0 - -if ( (.NOT. do_sppt) .AND. (.NOT. do_shum) .AND. (.NOT. do_skeb) .AND. (.NOT. do_sfcperts) ) return - -! Update number of threads in shared variables in stochy_ccpp and set block-related variables -ompthreads = nthreads -nblks = size(Model%blksz) -maxlen = maxval(Model%blksz(:)) - -! check to see if it is time to write out random patterns -if (Model%phour .EQ. fhstoch) then - write(STRFH,FMT='(I6.6)') nint(Model%phour) - sfile='stoch_out.F'//trim(STRFH) - call dump_patterns(sfile) -endif -allocate(tmp_wts(nblks,maxlen)) -allocate(tmpu_wts(nblks,maxlen,Model%levs)) -allocate(tmpv_wts(nblks,maxlen,Model%levs)) -if (do_sppt) then - call get_random_pattern_fv3(rpattern_sppt,nsppt,gis_stochy,Model,Data(:)%Grid,nblks,maxlen,tmp_wts) - DO blk=1,nblks - len=size(Data(blk)%Grid%xlat,1) - DO k=1,Model%levs - Data(blk)%Coupling%sppt_wts(:,k)=tmp_wts(blk,1:len)*vfact_sppt(k) - ENDDO - if (sppt_logit) Data(blk)%Coupling%sppt_wts(:,:) = (2./(1.+exp(Data(blk)%Coupling%sppt_wts(:,:))))-1. - Data(blk)%Coupling%sppt_wts(:,:)= Data(blk)%Coupling%sppt_wts(:,:)+1.0 - ENDDO -endif -if (do_shum) then - call get_random_pattern_fv3(rpattern_shum,nshum,gis_stochy,Model,Data(:)%Grid,nblks,maxlen,tmp_wts) - DO blk=1,nblks - len=size(Data(blk)%Grid%xlat,1) - DO k=1,Model%levs - Data(blk)%Coupling%shum_wts(:,k)=tmp_wts(blk,1:len)*vfact_shum(k) - ENDDO - ENDDO -endif -if (do_skeb) then - call get_random_pattern_fv3_vect(rpattern_skeb,nskeb,gis_stochy,Model,Data(:)%Grid,nblks,maxlen,tmpu_wts,tmpv_wts) - DO blk=1,nblks - len=size(Data(blk)%Grid%xlat,1) - DO k=1,Model%levs - Data(blk)%Coupling%skebu_wts(:,k)=tmpu_wts(blk,1:len,k)*vfact_skeb(k) - Data(blk)%Coupling%skebv_wts(:,k)=tmpv_wts(blk,1:len,k)*vfact_skeb(k) - ENDDO - ENDDO -endif -deallocate(tmp_wts) -deallocate(tmpu_wts) -deallocate(tmpv_wts) - -end subroutine stochastic_physics_run - -!> \section arg_table_stochastic_physics_finalize Argument Table -!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | -!! |----------------|--------------------------------------------------------|-------------------------------------------------------------------------|----------|------|-----------------------|-----------|--------|----------| -!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | -!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | -!! -subroutine stochastic_physics_finalize(errmsg, errflg) - - character(len=*), intent(out) :: errmsg - integer, intent(out) :: errflg - - ! Initialize CCPP error handling variables - errmsg = '' - errflg = 0 - - if (.not.is_initialized) return - - is_initialized = .false. - -end subroutine stochastic_physics_finalize - -end module stochastic_physics - -!>\ingroup gfs_stoch -!! This module -module stochastic_physics_sfc - -use stochy_ccpp, only : is_initialized, is_master - -implicit none - -private -public :: stochastic_physics_sfc_init, stochastic_physics_sfc_run, stochastic_physics_sfc_finalize - -contains - -!> \section arg_table_stochastic_physics_sfc_init Argument Table -!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | -!! |----------------|--------------------------------------------------------|-------------------------------------------------------------------------|----------|------|-----------------------|-----------|--------|----------| -!! | Model | GFS_control_type_instance | Fortran DDT containing FV3-GFS model control parameters | DDT | 0 | GFS_control_type | | in | F | -!! | Data | GFS_data_type_instance_all_blocks | Fortran DDT containing FV3-GFS data | DDT | 1 | GFS_data_type | | inout | F | -!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | -!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | -!! -subroutine stochastic_physics_sfc_init(Model, Data, errmsg, errflg) -use stochy_internal_state_mod -use stochy_data_mod, only : rad2deg,INTTYP,wlon,rnlat,gis_stochy, rpattern_sfc,npsfc ! mg, sfc-perts -use get_stochy_pattern_mod,only : get_random_pattern_sfc_fv3 ! mg, sfc-perts -use stochy_resol_def , only : latg,lonf -use stochy_namelist_def -use GFS_typedefs, only: GFS_control_type, GFS_data_type -implicit none -type(GFS_control_type), intent(in) :: Model -type(GFS_data_type), intent(inout) :: Data(:) -character(len=*), intent(out) :: errmsg -integer, intent(out) :: errflg - -real,allocatable :: tmpsfc_wts(:,:,:) -!D-grid -integer :: k -integer j,ierr,i -integer :: nblks, blk, len, maxlen -character*120 :: sfile -character*6 :: STRFH - -! Initialize CCPP error handling variables -errmsg = '' -errflg = 0 - -if (.NOT. do_sfcperts) return - -! stochastic_physics_sfc_init depends on stochastic_physics_init being run first; -! in general, stochastic_physics_sfc can only be run with/after stochastic_physics -! check initialization status in stochy_ccpp to make sure this is true -if (.not.is_initialized) then - write(errmsg,'(*(a))') 'Logic error: stochastic_physics_init must be called before stochastic_physics_sfc_init' - errflg = 1 - return -end if - -! Set block-related variables -nblks = size(Model%blksz) -maxlen = maxval(Model%blksz(:)) - -allocate(tmpsfc_wts(nblks,maxlen,Model%nsfcpert)) ! mg, sfc-perts -if (is_master()) then - print*,'In stochastic_physics_sfc_init: do_sfcperts ',do_sfcperts -endif -call get_random_pattern_sfc_fv3(rpattern_sfc,npsfc,gis_stochy,Model,Data(:)%Grid,nblks,maxlen,tmpsfc_wts) -DO blk=1,nblks - len=size(Data(blk)%Grid%xlat,1) - DO k=1,Model%nsfcpert - Data(blk)%Coupling%sfc_wts(:,k)=tmpsfc_wts(blk,1:len,k) - ENDDO -ENDDO -if (is_master()) then - print*,'tmpsfc_wts(blk,1,:) =',tmpsfc_wts(1,1,1),tmpsfc_wts(1,1,2),tmpsfc_wts(1,1,3),tmpsfc_wts(1,1,4),tmpsfc_wts(1,1,5) - print*,'min(tmpsfc_wts(:,:,:)) =',minval(tmpsfc_wts(:,:,:)) -endif -deallocate(tmpsfc_wts) -end subroutine stochastic_physics_sfc_init - -subroutine stochastic_physics_sfc_run() -end subroutine stochastic_physics_sfc_run - -subroutine stochastic_physics_sfc_finalize() -end subroutine stochastic_physics_sfc_finalize - -end module stochastic_physics_sfc diff --git a/stochastic_physics/stochy_ccpp.F90 b/stochastic_physics/stochy_ccpp.F90 deleted file mode 100644 index f7c7ce60a..000000000 --- a/stochastic_physics/stochy_ccpp.F90 +++ /dev/null @@ -1,437 +0,0 @@ -module stochy_ccpp - -#ifdef MPI - use mpi -#endif - - implicit none - - private - - public is_initialized - public is_master - public stochy_la2ga - public mp_bcst - public mp_reduce_sum - public mpicomm - public mpirank - public mpiroot - public mpisize - public mpp_alltoall - public ompthreads - - logical :: is_initialized = .false. - - interface mpp_alltoall - !module procedure mpp_alltoall_int4 - !module procedure mpp_alltoall_int8 - !module procedure mpp_alltoall_real4 - !module procedure mpp_alltoall_real8 - !module procedure mpp_alltoall_int4_v - !module procedure mpp_alltoall_int8_v - module procedure mpp_alltoall_real4_v - !module procedure mpp_alltoall_real8_v - end interface - - !> The interface 'mp_bcast contains routines that call SPMD broadcast - !! (one-to-many communication). - interface mp_bcst - module procedure mp_bcst_i - !module procedure mp_bcst_r4 - !module procedure mp_bcst_r8 - !module procedure mp_bcst_1d_r4 - module procedure mp_bcst_1d_r8 - !module procedure mp_bcst_2d_r4 - !module procedure mp_bcst_2d_r8 - !module procedure mp_bcst_3d_r4 - !module procedure mp_bcst_3d_r8 - !module procedure mp_bcst_4d_r4 - !module procedure mp_bcst_4d_r8 - module procedure mp_bcst_1d_i - !module procedure mp_bcst_2d_i - !module procedure mp_bcst_3d_i - !module procedure mp_bcst_4d_i - end interface - - !> The interface 'mp_reduce_sum' contains routines that call SPMD_REDUCE. - !! The routines compute the sums of values and place the net sum in a result. - interface mp_reduce_sum - !module procedure mp_reduce_sum_r4 - !module procedure mp_reduce_sum_r4_1d - !module procedure mp_reduce_sum_r4_1darr - !module procedure mp_reduce_sum_r4_2darr - !module procedure mp_reduce_sum_r8 - !module procedure mp_reduce_sum_r8_1d - module procedure mp_reduce_sum_r8_1darr - module procedure mp_reduce_sum_r8_2darr - end interface - -#ifdef MPI - integer, save, target :: mpicomm = MPI_COMM_WORLD -#else - integer, save, target :: mpicomm = 0 -#endif - integer, save, target :: mpirank = 0 - integer, save, target :: mpiroot = 0 - integer, save, target :: mpisize = 1 - - integer, save, target :: ompthreads = 1 - -contains - - - function is_master() result(match) - - logical :: match - - match = (mpirank==mpiroot) - - end function is_master - - - subroutine mpp_alltoall_real4_v(sbuf, ssize, sdispl, rbuf, rsize, rdispl) - - real(kind=4), intent(in) :: sbuf(:) - real(kind=4), intent(inout) :: rbuf(:) - - integer :: ierr - - integer, intent(in) :: ssize(:), rsize(:) - integer, intent(in) :: sdispl(:), rdispl(:) - -#ifdef MPI - call MPI_Alltoallv( sbuf, ssize, sdispl, MPI_REAL, & - rbuf, rsize, rdispl, MPI_REAL, & - mpicomm, ierr ) -#else - rbuf = sbuf -#endif - - end subroutine mpp_alltoall_real4_v - - - subroutine mp_bcst_i(q) - integer, intent(inout) :: q - integer :: ierr - -#ifdef MPI - call MPI_BCAST(q, 1, MPI_INTEGER, mpiroot, mpicomm, ierr) -#endif - - end subroutine mp_bcst_i - - - subroutine mp_bcst_1d_i(q, idim) - - integer, intent(in) :: idim - integer, intent(inout) :: q(idim) - - integer :: ierr - -#ifdef MPI - call MPI_BCAST(q, idim, MPI_INTEGER, mpiroot, mpicomm, ierr) -#endif - - end subroutine mp_bcst_1d_i - - - subroutine mp_bcst_1d_r8(q, idim) - - integer, intent(in) :: idim - real(kind=8), intent(inout) :: q(idim) - - integer :: ierr - -#ifdef MPI - call MPI_BCAST(q, idim, MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) -#endif - - end subroutine mp_bcst_1d_r8 - - - subroutine mp_reduce_sum_r8_1darr(mysum, npts) - - integer, intent(in) :: npts - real(kind=8), intent(inout) :: mysum(npts) - - real(kind=8) :: gsum(npts) - integer :: ierr - -#ifdef MPI - gsum = 0.0 - - call MPI_ALLREDUCE( mysum, gsum, npts, & - MPI_DOUBLE_PRECISION, MPI_SUM, & - mpicomm, ierr ) - - mysum = gsum -#endif - - end subroutine mp_reduce_sum_r8_1darr - - - subroutine mp_reduce_sum_r8_2darr(mysum,npts1,npts2) - - integer, intent(in) :: npts1,npts2 - real(kind=8), intent(inout) :: mysum(npts1,npts2) - - real(kind=8) :: gsum(npts1,npts2) - integer :: ierr - -#ifdef MPI - gsum = 0.0 - - call MPI_ALLREDUCE( mysum, gsum, npts1*npts2, & - MPI_DOUBLE_PRECISION, MPI_SUM, & - mpicomm, ierr ) - - mysum = gsum -#endif - - end subroutine mp_reduce_sum_r8_2darr - - - ! - ! interpolation from lat/lon or gaussian grid to other lat/lon grid - ! - subroutine stochy_la2ga(regin,imxin,jmxin,rinlon,rinlat,rlon,rlat, & - gauout,len,rslmsk, outlat, outlon) - use machine , only : kind_io8, kind_io4 - implicit none - ! interface variables - real (kind=kind_io8), intent(in) :: regin(imxin,jmxin) - integer, intent(in) :: imxin - integer, intent(in) :: jmxin - real (kind=kind_io8), intent(in) :: rinlon(imxin) - real (kind=kind_io8), intent(in) :: rinlat(jmxin) - real (kind=kind_io8), intent(in) :: rlon - real (kind=kind_io8), intent(in) :: rlat - real (kind=kind_io8), intent(out) :: gauout(len) - integer, intent(in) :: len - real (kind=kind_io8), intent(in) :: rslmsk(imxin,jmxin) - real (kind=kind_io8), intent(in) :: outlat(len) - real (kind=kind_io8), intent(in) :: outlon(len) - ! local variables - real (kind=kind_io8) :: wei4,wei3,wei2,sum2,sum1,sum3,wei1,sum4 - real (kind=kind_io8) :: wsum,wsumiv,sums,sumn,wi2j2,x,y,wi1j1 - real (kind=kind_io8) :: wi1j2,wi2j1,aphi,rnume,alamd,denom - integer :: jy,ix,i,j,jq,jx - integer :: j1,j2,ii,i1,i2,kmami,it - integer :: nx,kxs,kxt - integer :: iindx1(len) - integer :: iindx2(len) - integer :: jindx1(len) - integer :: jindx2(len) - real(kind=kind_io8) :: ddx(len) - real(kind=kind_io8) :: ddy(len) - real(kind=kind_io8) :: wrk(len) - integer :: len_thread_m - integer :: len_thread - integer :: i1_t - integer :: i2_t -! - len_thread_m = (len+ompthreads-1) / ompthreads -! - !$omp parallel do num_threads(ompthreads) default(none) & - !$omp private(i1_t,i2_t,len_thread,it,i,ii,i1,i2) & - !$omp private(j,j1,j2,jq,ix,jy,nx,kxs,kxt,kmami) & - !$omp private(alamd,denom,rnume,aphi,x,y,wsum,wsumiv,sum1,sum2) & - !$omp private(sum3,sum4,wi1j1,wi2j1,wi1j2,wi2j2,wei1,wei2,wei3,wei4) & - !$omp private(sumn,sums) & - !$omp shared(imxin,jmxin) & - !$omp shared(outlon,outlat,wrk,iindx1,rinlon,jindx1,rinlat,ddx,ddy) & - !$omp shared(rlon,rlat,regin,gauout) & - !$omp shared(ompthreads,len_thread_m,len,iindx2,jindx2,rslmsk) - do it=1,ompthreads ! start of threaded loop - i1_t = (it-1)*len_thread_m+1 - i2_t = min(i1_t+len_thread_m-1,len) - len_thread = i2_t-i1_t+1 -! -! find i-index for interpolation -! - do i=i1_t, i2_t - alamd = outlon(i) - if (alamd .lt. rlon) alamd = alamd + 360.0 - if (alamd .gt. 360.0+rlon) alamd = alamd - 360.0 - wrk(i) = alamd - iindx1(i) = imxin - enddo - do i=i1_t,i2_t - do ii=1,imxin - if(wrk(i) .ge. rinlon(ii)) iindx1(i) = ii - enddo - enddo - do i=i1_t,i2_t - i1 = iindx1(i) - if (i1 .lt. 1) i1 = imxin - i2 = i1 + 1 - if (i2 .gt. imxin) i2 = 1 - iindx1(i) = i1 - iindx2(i) = i2 - denom = rinlon(i2) - rinlon(i1) - if(denom.lt.0.) denom = denom + 360. - rnume = wrk(i) - rinlon(i1) - if(rnume.lt.0.) rnume = rnume + 360. - ddx(i) = rnume / denom - enddo -! -! find j-index for interplation -! - if(rlat.gt.0.) then - do j=i1_t,i2_t - jindx1(j)=0 - enddo - do jx=1,jmxin - do j=i1_t,i2_t - if(outlat(j).le.rinlat(jx)) jindx1(j) = jx - enddo - enddo - do j=i1_t,i2_t - jq = jindx1(j) - aphi=outlat(j) - if(jq.ge.1 .and. jq .lt. jmxin) then - j2=jq+1 - j1=jq - ddy(j)=(aphi-rinlat(j1))/(rinlat(j2)-rinlat(j1)) - elseif (jq .eq. 0) then - j2=1 - j1=1 - if(abs(90.-rinlat(j1)).gt.0.001) then - ddy(j)=(aphi-rinlat(j1))/(90.-rinlat(j1)) - else - ddy(j)=0.0 - endif - else - j2=jmxin - j1=jmxin - if(abs(-90.-rinlat(j1)).gt.0.001) then - ddy(j)=(aphi-rinlat(j1))/(-90.-rinlat(j1)) - else - ddy(j)=0.0 - endif - endif - jindx1(j)=j1 - jindx2(j)=j2 - enddo - else - do j=i1_t,i2_t - jindx1(j) = jmxin+1 - enddo - do jx=jmxin,1,-1 - do j=i1_t,i2_t - if(outlat(j).le.rinlat(jx)) jindx1(j) = jx - enddo - enddo - do j=i1_t,i2_t - jq = jindx1(j) - aphi=outlat(j) - if(jq.gt.1 .and. jq .le. jmxin) then - j2=jq - j1=jq-1 - ddy(j)=(aphi-rinlat(j1))/(rinlat(j2)-rinlat(j1)) - elseif (jq .eq. 1) then - j2=1 - j1=1 - if(abs(-90.-rinlat(j1)).gt.0.001) then - ddy(j)=(aphi-rinlat(j1))/(-90.-rinlat(j1)) - else - ddy(j)=0.0 - endif - else - j2=jmxin - j1=jmxin - if(abs(90.-rinlat(j1)).gt.0.001) then - ddy(j)=(aphi-rinlat(j1))/(90.-rinlat(j1)) - else - ddy(j)=0.0 - endif - endif - jindx1(j)=j1 - jindx2(j)=j2 - enddo - endif -! - sum1 = 0. - sum2 = 0. - sum3 = 0. - sum4 = 0. - do i=1,imxin - sum1 = sum1 + regin(i,1) - sum2 = sum2 + regin(i,jmxin) - enddo - sum1 = sum1 / imxin - sum2 = sum2 / imxin - sum3 = sum1 - sum4 = sum2 -! -! quasi-bilinear interpolation -! - do i=i1_t,i2_t - y = ddy(i) - j1 = jindx1(i) - j2 = jindx2(i) - x = ddx(i) - i1 = iindx1(i) - i2 = iindx2(i) -! - wi1j1 = (1.-x) * (1.-y) - wi2j1 = x *( 1.-y) - wi1j2 = (1.-x) * y - wi2j2 = x * y -! - wsum = wi1j1 + wi2j1 + wi1j2 + wi2j2 - wrk(i) = wsum - if(wsum.ne.0.) then - wsumiv = 1./wsum - if(j1.ne.j2) then - gauout(i) = (wi1j1*regin(i1,j1) + wi2j1*regin(i2,j1) + & - wi1j2*regin(i1,j2) + wi2j2*regin(i2,j2)) & - *wsumiv - else - if (rlat .gt. 0.0) then - sumn = sum3 - sums = sum4 - if( j1 .eq. 1) then - gauout(i) = (wi1j1*sumn +wi2j1*sumn + & - wi1j2*regin(i1,j2)+wi2j2*regin(i2,j2)) & - * wsumiv - elseif (j1 .eq. jmxin) then - gauout(i) = (wi1j1*regin(i1,j1)+wi2j1*regin(i2,j1)+ & - wi1j2*sums +wi2j2*sums ) & - * wsumiv - endif - else - sums = sum3 - sumn = sum4 - if( j1 .eq. 1) then - gauout(i) = (wi1j1*regin(i1,j1)+wi2j1*regin(i2,j1)+ & - wi1j2*sums +wi2j2*sums ) & - * wsumiv - elseif (j1 .eq. jmxin) then - gauout(i) = (wi1j1*sumn +wi2j1*sumn + & - wi1j2*regin(i1,j2)+wi2j2*regin(i2,j2)) & - * wsumiv - endif - endif - endif ! if j1 .ne. j2 - endif - enddo - do i=i1_t,i2_t - j1 = jindx1(i) - j2 = jindx2(i) - i1 = iindx1(i) - i2 = iindx2(i) - if(wrk(i) .eq. 0.0) then - write(6,*) ' la2ga: bad rslmsk given' - call sleep(2) - stop - endif - enddo - enddo ! end of threaded loop -!$omp end parallel do -! - return -! - end subroutine stochy_la2ga - -end module stochy_ccpp diff --git a/stochastic_physics/stochy_data_mod.F90 b/stochastic_physics/stochy_data_mod.F90 deleted file mode 100644 index ff3916d3a..000000000 --- a/stochastic_physics/stochy_data_mod.F90 +++ /dev/null @@ -1,397 +0,0 @@ -!>\file stochy_data_mod.F90 -!!This file includes module to set up and initializes stochastic random patterns. - -!> This module set up and initializes stochastic random patterns -module stochy_data_mod - - - use spectral_layout_mod, only: len_trie_ls,len_trio_ls,ls_dim,ls_max_node - use stochy_resol_def, only : skeblevs,levs,jcap,lonf,latg - use stochy_namelist_def - use physcons, only : radius => con_rerth - use stochy_ccpp, only: is_master, & - mp_bcst, & - me => mpirank, & - nodes => mpisize - use stochy_patterngenerator_mod, only: random_pattern, patterngenerator_init,& - getnoise, patterngenerator_advance,ndimspec,chgres_pattern,computevarspec_r - use initialize_spectral_mod, only: initialize_spectral - use stochy_internal_state_mod -! use mersenne_twister_stochy, only : random_seed - use mersenne_twister, only : random_seed - use compns_stochy_mod, only : compns_stochy - - implicit none - private - public :: init_stochdata - - type(random_pattern), public, save, allocatable, dimension(:) :: & - rpattern_sppt,rpattern_shum,rpattern_skeb, rpattern_sfc - integer, public :: nsppt=0 - integer, public :: nshum=0 - integer, public :: nskeb=0 - integer, public :: npsfc=0 - real*8, public,allocatable :: sl(:) - - real(kind=kind_dbl_prec),public, allocatable :: vfact_sppt(:),vfact_shum(:),vfact_skeb(:) - real(kind=kind_dbl_prec),public, allocatable :: skeb_vwts(:,:),skeb_vpts(:,:) - real(kind=kind_dbl_prec),public, allocatable :: gg_lats(:),gg_lons(:) - real(kind=kind_dbl_prec),public :: wlon,rnlat,rad2deg - real(kind=kind_dbl_prec),public, allocatable :: skebu_save(:,:,:),skebv_save(:,:,:) - integer,public :: INTTYP - type(stochy_internal_state),public :: gis_stochy - - contains - -!> This subroutine initializes random patterns. A spinup period of spinup_efolds times -!! the temporal time scale is run for each pattern. - subroutine init_stochdata(nlevs,delt,input_nml_file,fn_nml,nlunit,iret) - - integer, intent(in) :: nlunit,nlevs - character(len=*), intent(in) :: input_nml_file(:) - character(len=64), intent(in) :: fn_nml - real, intent(in) :: delt - integer, intent(out) :: iret - real :: pertsfc(1) - - real :: rnn1 - integer :: nn,nspinup,k,nm,spinup_efolds,stochlun,ierr,n - integer :: locl,indev,indod,indlsod,indlsev - integer :: l,jbasev,jbasod - real(kind_dbl_prec),allocatable :: noise_e(:,:),noise_o(:,:) - include 'function_indlsod' - include 'function_indlsev' - stochlun=99 - levs=nlevs - - iret=0 - if(is_master()) print*,'in init stochdata' - call compns_stochy (me,size(input_nml_file,1),input_nml_file(:),fn_nml,nlunit,delt,iret) - if ( (.NOT. do_sppt) .AND. (.NOT. do_shum) .AND. (.NOT. do_skeb) .AND. (.NOT. do_sfcperts) ) return - if (nodes.GE.lat_s/2) then - lat_s=(int(nodes/12)+1)*24 - lon_s=lat_s*2 - ntrunc=lat_s-2 - if (is_master()) print*,'WARNING: spectral resolution is too low for number of mpi_tasks, resetting lon_s,lat_s,and ntrunc to',lon_s,lat_s,ntrunc - endif - call initialize_spectral(gis_stochy, iret) - if (iret/=0) return - allocate(noise_e(len_trie_ls,2),noise_o(len_trio_ls,2)) -! determine number of random patterns to be used for each scheme. - do n=1,size(sppt) - if (sppt(n) > 0) then - nsppt=nsppt+1 - else - exit - endif - enddo - if (is_master()) print *,'nsppt = ',nsppt - do n=1,size(shum) - if (shum(n) > 0) then - nshum=nshum+1 - else - exit - endif - enddo - if (is_master()) print *,'nshum = ',nshum - do n=1,size(skeb) - if (skeb(n) > 0) then - nskeb=nskeb+1 - else - exit - endif - enddo - if (is_master()) print *,'nskeb = ',nskeb - ! mg, sfc-perts - do n=1,size(pertz0) - if (pertz0(n) > 0 .or. pertzt(n)>0 .or. pertshc(n)>0 .or. & - pertvegf(n)>0 .or. pertlai(n)>0 .or. pertalb(n)>0) then - npsfc=npsfc+1 - else - exit - endif - enddo - if (is_master()) then - if (npsfc > 0) then - print *,' npsfc = ', npsfc - print *,' pertz0 = ', pertz0 - print *,' pertzt = ', pertzt - print *,' pertshc = ', pertshc - print *,' pertlai = ', pertlai - print *,' pertalb = ', pertalb - print *,' pertvegf = ', pertvegf - endif - endif - - if (nsppt > 0) allocate(rpattern_sppt(nsppt)) - if (nshum > 0) allocate(rpattern_shum(nshum)) - if (nskeb > 0) allocate(rpattern_skeb(nskeb)) - ! mg, sfc perts - if (npsfc > 0) allocate(rpattern_sfc(npsfc)) - -! if stochini is true, then read in pattern from a file - if (is_master()) then - if (stochini) then - print*,'opening stoch_ini' - OPEN(stochlun,file='stoch_ini',form='unformatted',iostat=ierr,status='old') - if (ierr .NE. 0) then - write(0,*) 'error opening stoch_ini' - iret = ierr - return - end if - endif - endif - ! no spinup needed if initial patterns are defined correctly. - spinup_efolds = 0 - if (nsppt > 0) then - if (is_master()) print *, 'Initialize random pattern for SPPT' - call patterngenerator_init(sppt_lscale,delt,sppt_tau,sppt,iseed_sppt,rpattern_sppt, & - lonf,latg,jcap,gis_stochy%ls_node,nsppt,1,0) - do n=1,nsppt - nspinup = spinup_efolds*sppt_tau(n)/delt - if (stochini) then - call read_pattern(rpattern_sppt(n),1,stochlun) - else - call getnoise(rpattern_sppt(n),noise_e,noise_o) - do nn=1,len_trie_ls - rpattern_sppt(n)%spec_e(nn,1,1)=noise_e(nn,1) - rpattern_sppt(n)%spec_e(nn,2,1)=noise_e(nn,2) - nm = rpattern_sppt(n)%idx_e(nn) - if (nm .eq. 0) cycle - rpattern_sppt(n)%spec_e(nn,1,1) = rpattern_sppt(n)%stdev*rpattern_sppt(n)%spec_e(nn,1,1)*rpattern_sppt(n)%varspectrum(nm) - rpattern_sppt(n)%spec_e(nn,2,1) = rpattern_sppt(n)%stdev*rpattern_sppt(n)%spec_e(nn,2,1)*rpattern_sppt(n)%varspectrum(nm) - enddo - do nn=1,len_trio_ls - rpattern_sppt(n)%spec_o(nn,1,1)=noise_o(nn,1) - rpattern_sppt(n)%spec_o(nn,2,1)=noise_o(nn,2) - nm = rpattern_sppt(n)%idx_o(nn) - if (nm .eq. 0) cycle - rpattern_sppt(n)%spec_o(nn,1,1) = rpattern_sppt(n)%stdev*rpattern_sppt(n)%spec_o(nn,1,1)*rpattern_sppt(n)%varspectrum(nm) - rpattern_sppt(n)%spec_o(nn,2,1) = rpattern_sppt(n)%stdev*rpattern_sppt(n)%spec_o(nn,2,1)*rpattern_sppt(n)%varspectrum(nm) - enddo - do nn=1,nspinup - call patterngenerator_advance(rpattern_sppt(n),1,.false.) - enddo - endif - enddo - endif - if (nshum > 0) then - if (is_master()) print *, 'Initialize random pattern for SHUM' - call patterngenerator_init(shum_lscale,delt,shum_tau,shum,iseed_shum,rpattern_shum, & - lonf,latg,jcap,gis_stochy%ls_node,nshum,1,0) - do n=1,nshum - nspinup = spinup_efolds*shum_tau(n)/delt - if (stochini) then - call read_pattern(rpattern_shum(n),1,stochlun) - else - call getnoise(rpattern_shum(n),noise_e,noise_o) - do nn=1,len_trie_ls - rpattern_shum(n)%spec_e(nn,1,1)=noise_e(nn,1) - rpattern_shum(n)%spec_e(nn,2,1)=noise_e(nn,2) - nm = rpattern_shum(n)%idx_e(nn) - if (nm .eq. 0) cycle - rpattern_shum(n)%spec_e(nn,1,1) = rpattern_shum(n)%stdev*rpattern_shum(n)%spec_e(nn,1,1)*rpattern_shum(n)%varspectrum(nm) - rpattern_shum(n)%spec_e(nn,2,1) = rpattern_shum(n)%stdev*rpattern_shum(n)%spec_e(nn,2,1)*rpattern_shum(n)%varspectrum(nm) - enddo - do nn=1,len_trio_ls - rpattern_shum(n)%spec_o(nn,1,1)=noise_o(nn,1) - rpattern_shum(n)%spec_o(nn,2,1)=noise_o(nn,2) - nm = rpattern_shum(n)%idx_o(nn) - if (nm .eq. 0) cycle - rpattern_shum(n)%spec_o(nn,1,1) = rpattern_shum(n)%stdev*rpattern_shum(n)%spec_o(nn,1,1)*rpattern_shum(n)%varspectrum(nm) - rpattern_shum(n)%spec_o(nn,2,1) = rpattern_shum(n)%stdev*rpattern_shum(n)%spec_o(nn,2,1)*rpattern_shum(n)%varspectrum(nm) - enddo - do nn=1,nspinup - call patterngenerator_advance(rpattern_shum(n),1,.false.) - enddo - endif - enddo - endif - - if (nskeb > 0) then - ! determine number of skeb levels to deal with temperoal/vertical correlations - skeblevs=nint(skeb_tau(1)/delt*skeb_vdof) -! backscatter noise. - if (is_master()) print *, 'Initialize random pattern for SKEB',skeblevs - call patterngenerator_init(skeb_lscale,delt,skeb_tau,skeb,iseed_skeb,rpattern_skeb, & - lonf,latg,jcap,gis_stochy%ls_node,nskeb,skeblevs,skeb_varspect_opt) - do n=1,nskeb - do k=1,skeblevs - nspinup = spinup_efolds*skeb_tau(n)/delt - if (stochini) then - call read_pattern(rpattern_skeb(n),k,stochlun) - if (is_master()) print *, 'skeb read',k,rpattern_skeb(n)%spec_o(5,1,k) - else - call getnoise(rpattern_skeb(n),noise_e,noise_o) - do nn=1,len_trie_ls - rpattern_skeb(n)%spec_e(nn,1,k)=noise_e(nn,1) - rpattern_skeb(n)%spec_e(nn,2,k)=noise_e(nn,2) - nm = rpattern_skeb(n)%idx_e(nn) - if (nm .eq. 0) cycle - rpattern_skeb(n)%spec_e(nn,1,k) = rpattern_skeb(n)%stdev*rpattern_skeb(n)%spec_e(nn,1,k)*rpattern_skeb(n)%varspectrum(nm) - rpattern_skeb(n)%spec_e(nn,2,k) = rpattern_skeb(n)%stdev*rpattern_skeb(n)%spec_e(nn,2,k)*rpattern_skeb(n)%varspectrum(nm) - enddo - do nn=1,len_trio_ls - rpattern_skeb(n)%spec_o(nn,1,k)=noise_o(nn,1) - rpattern_skeb(n)%spec_o(nn,2,k)=noise_o(nn,2) - nm = rpattern_skeb(n)%idx_o(nn) - if (nm .eq. 0) cycle - rpattern_skeb(n)%spec_o(nn,1,k) = rpattern_skeb(n)%stdev*rpattern_skeb(n)%spec_o(nn,1,k)*rpattern_skeb(n)%varspectrum(nm) - rpattern_skeb(n)%spec_o(nn,2,k) = rpattern_skeb(n)%stdev*rpattern_skeb(n)%spec_o(nn,2,k)*rpattern_skeb(n)%varspectrum(nm) - enddo - endif - enddo - do nn=1,nspinup - call patterngenerator_advance(rpattern_skeb(n),skeblevs,.false.) - enddo - enddo - - gis_stochy%kenorm_e=1. - gis_stochy%kenorm_o=1. ! used to convert forcing pattern to wind field. -if (skebnorm==0) then - do locl=1,ls_max_node - l = gis_stochy%ls_node(locl) - jbasev = gis_stochy%ls_node(locl+ls_dim) - indev = indlsev(l,l) - jbasod = gis_stochy%ls_node(locl+2*ls_dim) - indod = indlsod(l+1,l) - do n=l,jcap,2 - rnn1 = n*(n+1.) - gis_stochy%kenorm_e(indev) = rnn1/radius**2 - indev = indev + 1 - enddo - do n=l+1,jcap,2 - rnn1 = n*(n+1.) - gis_stochy%kenorm_o(indod) = rnn1/radius**2 - indod = indod + 1 - enddo - enddo - if (is_master()) print*,'using streamfunction ',maxval(gis_stochy%kenorm_e(:)),minval(gis_stochy%kenorm_e(:)) -endif -if (skebnorm==1) then - do locl=1,ls_max_node - l = gis_stochy%ls_node(locl) - jbasev = gis_stochy%ls_node(locl+ls_dim) - indev = indlsev(l,l) - jbasod = gis_stochy%ls_node(locl+2*ls_dim) - indod = indlsod(l+1,l) - do n=l,jcap,2 - rnn1 = n*(n+1.) - gis_stochy%kenorm_e(indev) = sqrt(rnn1)/radius - indev = indev + 1 - enddo - do n=l+1,jcap,2 - rnn1 = n*(n+1.) - gis_stochy%kenorm_o(indod) = sqrt(rnn1)/radius - indod = indod + 1 - enddo - enddo - if (is_master()) print*,'using kenorm ',maxval(gis_stochy%kenorm_e(:)),minval(gis_stochy%kenorm_e(:)) -endif - ! set the even and odd (n-l) terms of the top row to zero -do locl=1,ls_max_node - l = gis_stochy%ls_node(locl) - jbasev = gis_stochy%ls_node(locl+ls_dim) - jbasod = gis_stochy%ls_node(locl+2*ls_dim) - if (mod(l,2) .eq. mod(jcap+1,2)) then - gis_stochy%kenorm_e(indlsev(jcap+1,l)) = 0. - endif - if (mod(l,2) .ne. mod(jcap+1,2)) then - gis_stochy%kenorm_o(indlsod(jcap+1,l)) = 0. - endif -enddo - - endif ! skeb > 0 -! mg, sfc-perts -if (npsfc > 0) then - pertsfc(1) = 1. - call patterngenerator_init(sfc_lscale,delt,sfc_tau,pertsfc,iseed_sfc,rpattern_sfc, & - lonf,latg,jcap,gis_stochy%ls_node,npsfc,nsfcpert,0) - do n=1,npsfc - if (is_master()) print *, 'Initialize random pattern for SFC-PERTS',n - do k=1,nsfcpert - nspinup = spinup_efolds*sfc_tau(n)/delt - call getnoise(rpattern_sfc(n),noise_e,noise_o) - do nn=1,len_trie_ls - rpattern_sfc(n)%spec_e(nn,1,k)=noise_e(nn,1) - rpattern_sfc(n)%spec_e(nn,2,k)=noise_e(nn,2) - nm = rpattern_sfc(n)%idx_e(nn) - if (nm .eq. 0) cycle - rpattern_sfc(n)%spec_e(nn,1,k) = rpattern_sfc(n)%stdev*rpattern_sfc(n)%spec_e(nn,1,k)*rpattern_sfc(n)%varspectrum(nm) - rpattern_sfc(n)%spec_e(nn,2,k) = rpattern_sfc(n)%stdev*rpattern_sfc(n)%spec_e(nn,2,k)*rpattern_sfc(n)%varspectrum(nm) - enddo - do nn=1,len_trio_ls - rpattern_sfc(n)%spec_o(nn,1,k)=noise_o(nn,1) - rpattern_sfc(n)%spec_o(nn,2,k)=noise_o(nn,2) - nm = rpattern_sfc(n)%idx_o(nn) - if (nm .eq. 0) cycle - rpattern_sfc(n)%spec_o(nn,1,k) = rpattern_sfc(n)%stdev*rpattern_sfc(n)%spec_o(nn,1,k)*rpattern_sfc(n)%varspectrum(nm) - rpattern_sfc(n)%spec_o(nn,2,k) = rpattern_sfc(n)%stdev*rpattern_sfc(n)%spec_o(nn,2,k)*rpattern_sfc(n)%varspectrum(nm) - enddo - do nn=1,nspinup - call patterngenerator_advance(rpattern_sfc(n),k,.false.) - enddo - if (is_master()) print *, 'Random pattern for SFC-PERTS: k, min, max ',k, minval(rpattern_sfc(1)%spec_o(:,:,k)), maxval(rpattern_sfc(1)%spec_o(:,:,k)) - enddo ! k, nsfcpert - enddo ! n, npsfc - endif ! npsfc > 0 - if (is_master() .and. stochini) CLOSE(stochlun) - deallocate(noise_e,noise_o) - end subroutine init_stochdata - -subroutine read_pattern(rpattern,k,lunptn) - type(random_pattern), intent(inout) :: rpattern - integer, intent(in) :: lunptn - real(kind_dbl_prec),allocatable :: pattern2d(:),pattern2din(:) - real(kind_dbl_prec) :: stdevin,varin - integer nm,nn,ierr,jcap,isize,k - integer, allocatable :: isave(:) - - allocate(pattern2d(2*ndimspec)) - pattern2d=0. - call random_seed(size=isize,stat=rpattern%rstate) ! get size of generator state seed array - allocate(isave(isize)) - ! read only on root process, and send to all tasks - if (is_master()) then - read(lunptn) jcap - read(lunptn) isave - allocate(pattern2din((jcap+1)*(jcap+2))) - print*,'reading in random pattern at ',jcap,ndimspec,size(pattern2din) - read(lunptn) pattern2din - print*,'reading in random pattern (min/max/size/seed)',& - minval(pattern2din),maxval(pattern2din),size(pattern2din),isave(1:4) - if (jcap .eq. ntrunc) then - pattern2d=pattern2din - else - call chgres_pattern(pattern2din,pattern2d,jcap,ntrunc) ! chgres of spectral files - ! change the standard deviation of the patterns for a resolution change - ! needed for SKEB & SHUM - call computevarspec_r(rpattern,pattern2d,varin) - print*,'stddev in and out..',sqrt(varin),rpattern%stdev - stdevin=rpattern%stdev/sqrt(varin) - pattern2d(:)=pattern2d(:)*stdevin - endif - deallocate(pattern2din) - endif - call mp_bcst(isave,isize) ! blast out seed - call mp_bcst(pattern2d,2*ndimspec) - call random_seed(put=isave,stat=rpattern%rstate) - ! subset - do nn=1,len_trie_ls - nm = rpattern%idx_e(nn) - if (nm == 0) cycle - rpattern%spec_e(nn,1,k) = pattern2d(nm) - rpattern%spec_e(nn,2,k) = pattern2d(ndimspec+nm) - enddo - do nn=1,len_trio_ls - nm = rpattern%idx_o(nn) - if (nm == 0) cycle - rpattern%spec_o(nn,1,k) = pattern2d(nm) - rpattern%spec_o(nn,2,k) = pattern2d(ndimspec+nm) - enddo - !print*,'after scatter...',me,maxval(pattern2d_e),maxval(pattern2d_o) & - ! ,minval(pattern2d_e),minval(pattern2d_o) - deallocate(pattern2d,isave) - end subroutine read_pattern - -end module stochy_data_mod diff --git a/stochastic_physics/stochy_gg_def.f b/stochastic_physics/stochy_gg_def.f deleted file mode 100644 index 9470c436e..000000000 --- a/stochastic_physics/stochy_gg_def.f +++ /dev/null @@ -1,9 +0,0 @@ - module stochy_gg_def - use machine - implicit none - - real(kind=kind_dbl_prec), allocatable, dimension(:) :: colrad_a, - & wgt_a, wgtcs_a, rcs2_a, sinlat_a, coslat_a -! - integer ,allocatable, dimension(:) :: lats_nodes_h,global_lats_h - end module stochy_gg_def diff --git a/stochastic_physics/stochy_internal_state_mod.F90 b/stochastic_physics/stochy_internal_state_mod.F90 deleted file mode 100644 index e62645bd1..000000000 --- a/stochastic_physics/stochy_internal_state_mod.F90 +++ /dev/null @@ -1,136 +0,0 @@ - -! -! !module: stochy_internal_state_mod -! --- internal state definition of the -! gridded component of the spectral random patterns -! -! !description: define the spectral internal state used to -! create the internal state. -!--------------------------------------------------------------------------- -! !revision history: -! -! Oct 11 2016 P Pegion port of gfs_dynamics_interal_state -! -! !interface: -! - - module stochy_internal_state_mod - -!!uses: -!------ - use spectral_layout_mod - use stochy_gg_def - use stochy_resol_def - - - implicit none - private - -! ----------------------------------------------- - type,public::stochy_internal_state ! start type define -! ----------------------------------------------- - - integer :: me, nodes - integer :: lnt2_s, llgg_s - integer :: lnt2 - integer :: grib_inp - -! - integer nxpt,nypt,jintmx - integer lonf,latg,lats_node_a_max - - integer npe_single_member - - character(16) :: cfhour1 -!jws - integer :: num_file - character(32) ,allocatable :: filename_base(:) - integer :: ipt_lats_node_a - integer :: lats_node_a -!jwe - - integer :: nblck,kdt -! real :: deltim - - integer ,allocatable :: lonsperlat (:) - integer ,allocatable :: ls_node (:) - integer ,allocatable :: ls_nodes (:, :) - integer ,allocatable :: max_ls_nodes (:) - - integer ,allocatable :: lats_nodes_a (:) - integer ,allocatable :: global_lats_a (:) - integer ,allocatable :: lats_nodes_ext (:) - integer ,allocatable :: global_lats_ext(:) - integer ,allocatable :: global_lats_h (:) - integer :: xhalo,yhalo - - integer ,allocatable :: lats_nodes_a_fix (:) - - real(kind=kind_dbl_prec) ,allocatable :: epse (:) - real(kind=kind_dbl_prec) ,allocatable :: epso (:) - real(kind=kind_dbl_prec) ,allocatable :: epsedn(:) - real(kind=kind_dbl_prec) ,allocatable :: epsodn(:) - real(kind=kind_dbl_prec) ,allocatable :: kenorm_e(:) - real(kind=kind_dbl_prec) ,allocatable :: kenorm_o(:) - - real(kind=kind_dbl_prec) ,allocatable :: snnp1ev(:) - real(kind=kind_dbl_prec) ,allocatable :: snnp1od(:) - - real(kind=kind_dbl_prec) ,allocatable :: plnev_a(:,:) - real(kind=kind_dbl_prec) ,allocatable :: plnod_a(:,:) - real(kind=kind_dbl_prec) ,allocatable :: pddev_a(:,:) - real(kind=kind_dbl_prec) ,allocatable :: pddod_a(:,:) - real(kind=kind_dbl_prec) ,allocatable :: plnew_a(:,:) - real(kind=kind_dbl_prec) ,allocatable :: plnow_a(:,:) - - - real(kind=kind_dbl_prec) ,allocatable :: trie_ls(:,:,:) - real(kind=kind_dbl_prec) ,allocatable :: trio_ls(:,:,:) - - INTEGER :: TRIEO_TOTAL_SIZE - INTEGER, ALLOCATABLE, DIMENSION(:) :: TRIE_LS_SIZE - INTEGER, ALLOCATABLE, DIMENSION(:) :: TRIO_LS_SIZE - INTEGER, ALLOCATABLE, DIMENSION(:) :: TRIEO_LS_SIZE - INTEGER, ALLOCATABLE, DIMENSION(:) :: LS_MAX_NODE_GLOBAL - INTEGER, ALLOCATABLE, DIMENSION(:, :) :: LS_NODE_GLOBAL - - -! - -!! - integer init,jcount,jpt,node,ibmsign,lon_dim,ilat - - real(kind=kind_dbl_prec) colat1, rone, rlons_lat, scale_ibm - - integer lotls,lotgr,lots,lots_slg,lotd,lota,lotp - - integer ibrad,ifges,ihour,ini,j,jdt,ksout,maxstp - integer mdt,idt,timetot,timer,time0 - integer mods,n1,n2,ndgf,ndgi,nfiles,nflps - integer n1hyb, n2hyb,nlunit - integer nges,ngpken,niter,nnmod,nradf,nradr - integer nsfcf,nsfci,nsfcs,nsigi,nsigs,nstep - integer nznlf,nznli,nznls,id,iret,nsout,ndfi - - integer ierr,iprint,k,l,locl,n - integer lan,lat - integer spectral_loop - - - integer ikey,nrank_all,kcolor - - real(kind=kind_dbl_prec) cons0p5,cons1200,cons3600,cons0 - -! -! ----------------------------------------------------- - end type stochy_internal_state ! end type define -! ----------------------------------------------------- - -! this state is supported by c pointer not f90 pointer, thus -! need this wrap. -!----------------------------------------------------------- - type stochy_wrap ! begin type define - type (stochy_internal_state), pointer :: int_state - end type stochy_wrap ! end type define - - end module stochy_internal_state_mod diff --git a/stochastic_physics/stochy_layout_lag.f b/stochastic_physics/stochy_layout_lag.f deleted file mode 100644 index b2ee13bab..000000000 --- a/stochastic_physics/stochy_layout_lag.f +++ /dev/null @@ -1,13 +0,0 @@ - module stochy_layout_lag - use machine - implicit none - save -cc - integer lats_dim_h, - x lats_node_h, - x lats_node_h_max, - x ipt_lats_node_h, - x lon_dim_h -cc - INTEGER ,ALLOCATABLE :: lat1s_h(:) - end module stochy_layout_lag diff --git a/stochastic_physics/stochy_namelist_def.F90 b/stochastic_physics/stochy_namelist_def.F90 deleted file mode 100644 index 06fac4f48..000000000 --- a/stochastic_physics/stochy_namelist_def.F90 +++ /dev/null @@ -1,37 +0,0 @@ - module stochy_namelist_def -! -! program log -! 11 Oct 2016: Philip Pegion create standalone stochastic physics -! - use machine - implicit none - - public - integer nsskeb,lon_s,lat_s,ntrunc - -! pjp stochastic phyics - integer skeb_varspect_opt,skeb_npass - logical sppt_sfclimit - - real(kind=kind_dbl_prec) :: skeb_sigtop1,skeb_sigtop2, & - sppt_sigtop1,sppt_sigtop2,shum_sigefold, & - skeb_vdof - real(kind=kind_dbl_prec) fhstoch,skeb_diss_smooth,skebint,skebnorm - real(kind=kind_dbl_prec), dimension(5) :: skeb,skeb_lscale,skeb_tau - real(kind=kind_dbl_prec), dimension(5) :: sppt,sppt_lscale,sppt_tau - real(kind=kind_dbl_prec), dimension(5) :: shum,shum_lscale,shum_tau - integer,dimension(5) ::skeb_vfilt - integer(8),dimension(5) ::iseed_sppt,iseed_shum,iseed_skeb - logical stochini,sppt_logit - logical do_shum,do_sppt,do_skeb,use_zmtnblck - -! mg surface perturbations - real(kind=kind_dbl_prec), dimension(5) :: sfc_lscale,sfc_tau - real(kind=kind_dbl_prec), dimension(5) :: pertz0,pertshc,pertzt - real(kind=kind_dbl_prec), dimension(5) :: pertlai,pertvegf,pertalb - integer nsfcpert - integer(8),dimension(5) ::iseed_sfc - logical sppt_land - logical do_sfcperts - - end module stochy_namelist_def diff --git a/stochastic_physics/stochy_patterngenerator.F90 b/stochastic_physics/stochy_patterngenerator.F90 deleted file mode 100644 index 9cb477cfc..000000000 --- a/stochastic_physics/stochy_patterngenerator.F90 +++ /dev/null @@ -1,362 +0,0 @@ -module stochy_patterngenerator_mod - - ! generate random patterns with specified temporal and spatial auto-correlation - ! in spherical harmonic space. - use machine - use spectral_layout_mod, only: len_trie_ls, len_trio_ls, ls_dim, ls_max_node -! use mersenne_twister_stochy, only: random_setseed,random_gauss,random_stat - use mersenne_twister, only: random_setseed,random_gauss,random_stat - use stochy_ccpp, only: is_master, mp_bcst - implicit none - private - - public :: computevarspec, setvarspect,& - patterngenerator_init, patterngenerator_destroy, getnoise, & - patterngenerator_advance, random_pattern, ndimspec,& - chgres_pattern,computevarspec_r - - type random_pattern - real(kind_dbl_prec), public :: lengthscale - real(kind_dbl_prec), public :: tau - real(kind_dbl_prec), public :: dt - real(kind_dbl_prec), public :: phi - real(kind_dbl_prec), public :: stdev - real(kind_evod), allocatable, dimension(:), public :: varspectrum, varspectrum1d, lap - integer, allocatable, dimension(:), public ::& - degree,order,idx_e,idx_o - integer, allocatable, dimension(:,:), public :: idx - integer, public :: seed - real(kind_dbl_prec), allocatable, dimension(:,:,:), public :: spec_e,spec_o - type(random_stat), public :: rstate - end type random_pattern - - integer :: nlons,nlats,ntrunc,ndimspec - - contains - - subroutine patterngenerator_init(lscale, delt, tscale, stdev, iseed, rpattern,& - nlon, nlat, jcap, ls_node, npatterns,& - nlevs, varspect_opt) - real(kind_dbl_prec), intent(in),dimension(npatterns) :: lscale,tscale,stdev - real, intent(in) :: delt - integer, intent(in) :: nlon,nlat,jcap,npatterns,varspect_opt - integer, intent(in) :: ls_node(ls_dim,3),nlevs - type(random_pattern), intent(out), dimension(npatterns) :: rpattern - integer(8), intent(inout) :: iseed(npatterns) - integer m,j,l,n,nm,nn,np,indev1,indev2,indod1,indod2 - integer(8) count, count_rate, count_max, count_trunc - integer(8) :: iscale = 10000000000 - integer count4, ierr -! integer member_id - integer indlsod,indlsev,jbasev,jbasod - include 'function_indlsod' - include 'function_indlsev' - nlons = nlon - nlats = nlat - ntrunc = jcap - ndimspec = (ntrunc+1)*(ntrunc+2)/2 -! propagate seed supplied from namelist to all patterns... - if (iseed(1) .NE. 0) then - do np=2,npatterns - if (iseed(np).EQ.0) then - iseed(np)=iseed(1)+np*100000000 - endif - enddo - endif - - do np=1,npatterns - allocate(rpattern(np)%idx(0:ntrunc,0:ntrunc)) - allocate(rpattern(np)%idx_e(len_trie_ls)) - allocate(rpattern(np)%idx_o(len_trio_ls)) - allocate(rpattern(np)%spec_e(len_trie_ls,2,nlevs)) - allocate(rpattern(np)%spec_o(len_trio_ls,2,nlevs)) - rpattern(np)%idx_e = 0; rpattern(np)%idx_o = 0; rpattern(np)%idx = 0 - rpattern(np)%spec_e(:,:,:)=0. - rpattern(np)%spec_o(:,:,:)=0. - nm = 0 - do m=0,ntrunc - do n=m,ntrunc - nm = nm + 1 - rpattern(np)%idx(m,n) = nm - enddo - enddo - do j = 1, ls_max_node - l=ls_node(j,1) ! zonal wavenumber - jbasev=ls_node(j,2) - jbasod=ls_node(j,3) - indev1 = indlsev(l,l) - indod1 = indlsod(l+1,l) - if (mod(l,2) .eq. mod(ntrunc+1,2)) then - indev2 = indlsev(ntrunc+1,l) - indod2 = indlsod(ntrunc ,l) - else - indev2 = indlsev(ntrunc ,l) - indod2 = indlsod(ntrunc+1,l) - endif - n = l ! degree - do nn=indev1,indev2 - if (n <= ntrunc .and. l <= ntrunc) then - nm = rpattern(np)%idx(l,n) - rpattern(np)%idx_e(nn) = nm - endif - n = n + 2 - enddo - n = l+1 - do nn=indod1,indod2 - if (n <= ntrunc .and. l <= ntrunc) then - nm = rpattern(np)%idx(l,n) - rpattern(np)%idx_o(nn) = nm - endif - n = n + 2 - enddo - enddo - allocate(rpattern(np)%degree(ndimspec),rpattern(np)%order(ndimspec),rpattern(np)%lap(ndimspec)) -#ifdef __GFORTRAN__ - j = 0 - do m=0,ntrunc - do n=m,ntrunc - j = j + 1 - rpattern(np)%degree(j) = n - rpattern(np)%order(j) = m - end do - end do -#else - rpattern(np)%degree = (/((n,n=m,ntrunc),m=0,ntrunc)/) - rpattern(np)%order = (/((m,n=m,ntrunc),m=0,ntrunc)/) -#endif - rpattern(np)%lap = -rpattern(np)%degree*(rpattern(np)%degree+1.0) - rpattern(np)%tau = tscale(np) - rpattern(np)%lengthscale = lscale(np) - rpattern(np)%dt = delt - rpattern(np)%phi = exp(-delt/tscale(np)) - rpattern(np)%stdev = stdev(np) - allocate(rpattern(np)%varspectrum(ndimspec)) - allocate(rpattern(np)%varspectrum1d(0:ntrunc)) - ! seed computed on root, then bcast to all tasks and set. - if (is_master()) then -! read(ens_nam(2:3),'(i2)') member_id -! print *,'ens_nam,member_id',trim(ens_nam),member_id - if (iseed(np) == 0) then - ! generate a random seed from system clock and ens member number - call system_clock(count, count_rate, count_max) - ! iseed is elapsed time since unix epoch began (secs) - ! truncate to 4 byte integer - count_trunc = iscale*(count/iscale) - count4 = count - count_trunc !+ member_id - print *,'using seed',count4 - else - !count4 = iseed(np) + member_id - ! don't rely on compiler to truncate integer(8) to integer(4) on - ! overflow, do wrap around explicitly. - !count4 = mod(iseed(np) + member_id + 2147483648, 4294967296) - 2147483648 - count4 = mod(iseed(np) + 2147483648, 4294967296) - 2147483648 - print *,'using seed',count4,iseed(np)!,member_id - endif - endif - ! broadcast seed to all tasks. - call mp_bcst(count4) - rpattern(np)%seed = count4 - ! set seed (to be the same) on all tasks. Save random state. - call random_setseed(rpattern(np)%seed,rpattern(np)%rstate) - if (varspect_opt .ne. 0 .and. varspect_opt .ne. 1) then - if (is_master()) then - print *,'WARNING: illegal value for varspect_opt (should be 0 or 1), using 0 (gaussian spectrum)...' - endif - call setvarspect(rpattern(np),0) - else - call setvarspect(rpattern(np),varspect_opt) - endif - enddo ! n=1,npatterns - end subroutine patterngenerator_init - - - - subroutine patterngenerator_destroy(rpattern,npatterns) - type(random_pattern), intent(inout) :: rpattern(npatterns) - integer, intent(in) :: npatterns - integer n - do n=1,npatterns - deallocate(rpattern(n)%varspectrum,rpattern(n)%varspectrum1d) - deallocate(rpattern(n)%degree,rpattern(n)%order,rpattern(n)%lap) - deallocate(rpattern(n)%idx,rpattern(n)%idx_e,rpattern(n)%idx_o) - enddo - end subroutine patterngenerator_destroy - - subroutine computevarspec(rpattern,dataspec,var) - ! compute globally integrated variance from spectral coefficients - complex(kind_evod), intent(in) :: dataspec(ndimspec) - real(kind_evod), intent(out) :: var - type(random_pattern), intent(in) :: rpattern - integer n - var = 0. - do n=1,ndimspec - if (rpattern%order(n) .ne. 0) then - var = var + dataspec(n)*conjg(dataspec(n)) - else - var = var + 0.5*dataspec(n)*conjg(dataspec(n)) - endif - enddo - end subroutine computevarspec - - subroutine computevarspec_r(rpattern,dataspec,var) - ! compute globally integrated variance from spectral coefficients - real(kind_dbl_prec), intent(in) :: dataspec(2*ndimspec) - real(kind_dbl_prec), intent(out) :: var - type(random_pattern), intent(in) :: rpattern - integer n - var = 0. - do n=1,ndimspec - if (rpattern%order(n) .ne. 0) then - var = var + dataspec(n)**2+dataspec(n+ndimspec)**2 - else - var = var + 0.5*(dataspec(n)**2+dataspec(n+ndimspec)**2) - endif - enddo - end subroutine computevarspec_r - - subroutine getnoise(rpattern,noise_e,noise_o) - real(kind_dbl_prec), intent(out) :: noise_e(len_trie_ls,2) - real(kind_dbl_prec), intent(out) :: noise_o(len_trio_ls,2) - ! generate white noise with unit variance in spectral space - type(random_pattern), intent(inout) :: rpattern - real :: noise(2*ndimspec) - integer nm,nn - call random_gauss(noise,rpattern%rstate) - noise(1) = 0.; noise(ndimspec+1) = 0. - noise = noise*sqrt(1./ntrunc) - noise_e = 0.; noise_o = 0. - ! subset - do nn=1,len_trie_ls - nm = rpattern%idx_e(nn) - if (nm == 0) cycle - noise_e(nn,1) = noise(nm)/sqrt(2.*rpattern%degree(nm)+1) - noise_e(nn,2) = noise(ndimspec+nm)/sqrt(2.*rpattern%degree(nm)+1) - if (rpattern%order(nm) .eq. 0) then - noise_e(nn,1) = sqrt(2.)*noise_e(nn,1) - noise_e(nn,2) = 0. - endif - enddo - do nn=1,len_trio_ls - nm = rpattern%idx_o(nn) - if (nm == 0) cycle - noise_o(nn,1) = noise(nm)/sqrt(2.*rpattern%degree(nm)+1) - noise_o(nn,2) = noise(ndimspec+nm)/sqrt(2.*rpattern%degree(nm)+1) - if (rpattern%order(nm) .eq. 0) then - noise_o(nn,1) = sqrt(2.)*noise_o(nn,1) - noise_o(nn,2) = 0. - endif - enddo - end subroutine getnoise - - subroutine patterngenerator_advance(rpattern,k,skeb_first_call) - -#ifdef TRANSITION -!DIR$ OPTIMIZE:1 -#endif - - ! advance 1st-order autoregressive process with - ! specified autocorrelation (phi) and variance spectrum (spectrum) - real(kind_dbl_prec) :: noise_e(len_trie_ls,2) - real(kind_dbl_prec) :: noise_o(len_trio_ls,2) - type(random_pattern), intent(inout) :: rpattern - logical, intent(in) :: skeb_first_call - integer j,l,n,nn,nm,k,k2 - call getnoise(rpattern,noise_e,noise_o) - if (k.GT.1.AND.skeb_first_call) then - k2=k-1 - else - k2=k - endif - do nn=1,len_trie_ls - nm = rpattern%idx_e(nn) - if (nm == 0) cycle - rpattern%spec_e(nn,1,k) = rpattern%phi*rpattern%spec_e(nn,1,k2) + & - rpattern%stdev*sqrt(1.-rpattern%phi**2)*rpattern%varspectrum(nm)*noise_e(nn,1) - rpattern%spec_e(nn,2,k) = rpattern%phi*rpattern%spec_e(nn,2,k2) + & - rpattern%stdev*sqrt(1.-rpattern%phi**2)*rpattern%varspectrum(nm)*noise_e(nn,2) - enddo - do nn=1,len_trio_ls - nm = rpattern%idx_o(nn) - if (nm == 0) cycle - rpattern%spec_o(nn,1,k) = rpattern%phi*rpattern%spec_o(nn,1,k2) + & - rpattern%stdev*sqrt(1.-rpattern%phi**2)*rpattern%varspectrum(nm)*noise_o(nn,1) - rpattern%spec_o(nn,2,k) = rpattern%phi*rpattern%spec_o(nn,2,k2) + & - rpattern%stdev*sqrt(1.-rpattern%phi**2)*rpattern%varspectrum(nm)*noise_o(nn,2) - enddo - end subroutine patterngenerator_advance - - subroutine setvarspect(rpattern,varspect_opt) - ! define variance spectrum (isotropic covariance) - ! normalized to unit global variance - type(random_pattern), intent(inout) :: rpattern - integer, intent(in) :: varspect_opt - integer :: n - complex(kind_evod) noise(ndimspec) - real(kind_evod) var,rerth - rerth =6.3712e+6 ! radius of earth (m) - ! 1d variance spectrum (as a function of total wavenumber) - if (varspect_opt == 0) then ! gaussian - ! rpattern%lengthscale is interpreted as an efolding length - ! scale, in meters. - do n=0,ntrunc - rpattern%varspectrum1d(n) = exp(-rpattern%lengthscale**2*(float(n)*(float(n)+1.))/(4.*rerth**2)) - enddo - ! scaling factors for spectral coeffs of white noise pattern with unit variance - rpattern%varspectrum = sqrt(ntrunc*exp(rpattern%lengthscale**2*rpattern%lap/(4.*rerth**2))) - else if (varspect_opt == 1) then ! power law - ! rpattern%lengthscale is interpreted as a power, not a length. - do n=0,ntrunc - rpattern%varspectrum1d(n) = float(n)**(rpattern%lengthscale) - enddo - ! scaling factors for spectral coeffs of white noise pattern with unit variance - rpattern%varspectrum = sqrt(ntrunc*(rpattern%degree**(rpattern%lengthscale))) - endif - noise = 0. - do n=1,ndimspec - if (rpattern%order(n) .ne. 0.) then - noise(n) = cmplx(1.,1.)/sqrt(2.*rpattern%degree(n)+1) - else - noise(n) = sqrt(2.)/sqrt(2.*rpattern%degree(n)+1.) - endif - enddo - noise(1) = 0 ! no global mean. - ! make sure global mean variance is 1. - noise = noise*sqrt(1./ntrunc) - noise = rpattern%varspectrum*noise - call computevarspec(rpattern,noise,var) - rpattern%varspectrum = rpattern%varspectrum/sqrt(var) - rpattern%varspectrum1d = rpattern%varspectrum1d/var - - end subroutine setvarspect - - subroutine chgres_pattern(pattern2din,pattern2dout,ntruncin,ntruncout) - real(kind_dbl_prec), intent(in) :: pattern2din((ntruncin+1)*(ntruncin+2)) - real(kind_dbl_prec), intent(out) :: pattern2dout((ntruncout+1)*(ntruncout+2)) - integer, intent(in) :: ntruncin,ntruncout - integer :: m,n,nm,ndimsspecin,ndimsspecout - integer,allocatable, dimension(:,:):: idxin - allocate(idxin(0:ntruncin,0:ntruncin)) - ndimsspecin=(ntruncin+1)*(ntruncin+2)/2 - ndimsspecout=(ntruncout+1)*(ntruncout+2)/2 - nm = 0 - do m=0,ntruncin - do n=m,ntruncin - nm = nm + 1 - idxin(m,n) = nm - enddo - enddo - ! chgres - nm = 0 - do m=0,ntruncout - do n=m,ntruncout - nm = nm + 1 - if (m .le. ntruncin .and. n .le. ntruncin) then - pattern2dout(nm) = pattern2din(idxin(m,n)) - pattern2dout(ndimsspecout+nm) = pattern2din(ndimsspecin+idxin(m,n)) - endif - enddo - enddo - deallocate(idxin) -end subroutine chgres_pattern - -end module stochy_patterngenerator_mod diff --git a/stochastic_physics/stochy_resol_def.f b/stochastic_physics/stochy_resol_def.f deleted file mode 100644 index 708e31c84..000000000 --- a/stochastic_physics/stochy_resol_def.f +++ /dev/null @@ -1,44 +0,0 @@ - module stochy_resol_def - -! program log: -! 20110220: Henry Juang update index for MASS_DP and NDSLFV -! 20130202: Henry Juang revise reduced grid and add x number -! - implicit none - - integer jcap,jcap1,jcap2,latg,latg2 - integer levh,levm1,levp1,skeblevs,levs,lnt,lnt2,lnt22,levr - integer lnte,lnted,lnto,lntod,lnuv - integer lonf,lonfx,num_p2d,num_p3d - integer nxpt,nypt,jintmx,latgd - integer ntoz,ntcw,ncld,ntke,ixgr,ntiw,ntlnc,ntinc,nto,nto2 - integer ivsupa, ivsinp - integer nlunit, kdt_start - integer,target :: ntrac - integer,target :: ngrids_gg - integer,target :: thermodyn_id, sfcpress_id ! hmhj - logical,target :: adiabatic -! - INTEGER p_gz,p_lapgz,p_zslam,p_zsphi,p_dlam,p_dphi,p_uln,p_vln - INTEGER p_zem,p_dim,p_tem,p_rm,p_dpm,p_qm - INTEGER p_ze ,p_di ,p_te ,p_rq,p_dp ,p_q - INTEGER p_w ,p_x ,p_y ,p_rt,p_dpn,p_zq - INTEGER p_zz ,p_dpphi,p_dplam,p_zzphi,p_zzlam - INTEGER g_uum,g_vvm,g_ttm,g_rm ,g_dpm,g_qm,g_gz,g_zz - INTEGER g_uu ,g_vv ,g_tt ,g_rq ,g_dp ,g_q - INTEGER g_uup,g_vvp,g_ttp,g_rqp,g_dpp,g_zqp,g_rqtk - INTEGER g_u ,g_v ,g_t ,g_rt ,g_dpn,g_zq, g_p, g_dpdt - INTEGER lots,lots_slg,lotd,lota,lotp,lotls,lotgr,lotgr6 - - integer ksz, ksd, kst, ksr, ksdp, ksq, ksplam, kspphi - integer ksu, ksv, kzslam, kzsphi -! - integer kau, kav, kat, kar, kadp, kaps, kazs, kap2 -! - integer kdpphi, kzzphi, kdplam, kzzlam -! - integer kdtphi, kdrphi, kdtlam, kdrlam - integer kdulam, kdvlam, kduphi, kdvphi - - - end module stochy_resol_def diff --git a/stochastic_physics/sumfln_stochy.f b/stochastic_physics/sumfln_stochy.f deleted file mode 100644 index 973828e1b..000000000 --- a/stochastic_physics/sumfln_stochy.f +++ /dev/null @@ -1,294 +0,0 @@ - module sumfln_stochy_mod - - implicit none - - contains - - subroutine sumfln_stochy(flnev,flnod,lat1s,plnev,plnod, - & nvars,ls_node,latl2, - & workdim,nvarsdim,four_gr, - & ls_nodes,max_ls_nodes, - & lats_nodes,global_lats, - & lats_node,ipt_lats_node, - & lons_lat,londi,latl,nvars_0) -! - use stochy_resol_def , only : jcap,latgd - use spectral_layout_mod , only : len_trie_ls,len_trio_ls, - & ls_dim,ls_max_node,me,nodes - use machine - use stochy_ccpp, only : mpp_alltoall, - & num_parthds_stochy => ompthreads - - implicit none -! - external esmf_dgemm -! - integer lat1s(0:jcap),latl2 -! - integer nvars,nvars_0 - real(kind=kind_dbl_prec) flnev(len_trie_ls,2*nvars) - real(kind=kind_dbl_prec) flnod(len_trio_ls,2*nvars) -! - real(kind=kind_dbl_prec) plnev(len_trie_ls,latl2) - real(kind=kind_dbl_prec) plnod(len_trio_ls,latl2) -! - integer ls_node(ls_dim,3) -! -!cmr ls_node(1,1) ... ls_node(ls_max_node,1) : values of L -!cmr ls_node(1,2) ... ls_node(ls_max_node,2) : values of jbasev -!cmr ls_node(1,3) ... ls_node(ls_max_node,3) : values of jbasod -! -! local scalars -! ------------- -! - integer j, k, l, lat, lat1, n, kn, n2,indev,indod -! -! local arrays -! ------------ -! - real(kind=kind_dbl_prec), dimension(nvars*2,latl2) :: apev, apod - integer num_threads, nvar_thread_max, nvar_1, nvar_2 - &, thread -! xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx -! - integer nvarsdim, latl, workdim, londi - &, lats_node, ipt_lats_node -! - real(kind=kind_dbl_prec) four_gr(londi,nvarsdim,workdim) -! - integer ls_nodes(ls_dim,nodes) - integer, dimension(nodes) :: max_ls_nodes, lats_nodes - integer, dimension(latl) :: global_lats, lons_lat - -!jfe integer global_lats(latg+2*jintmx+2*nypt*(nodes-1)) -! - real(kind=4),target,dimension(2,nvars,ls_dim*workdim,nodes):: - & workr,works -! real(kind=4),dimension(2*nvars*ls_dim*workdim*nodes):: -! & work1dr,work1ds - real(kind=4),pointer:: work1dr(:),work1ds(:) - integer, dimension(jcap+1) :: kpts, kptr, sendcounts, recvcounts, - & sdispls -! - integer ierr,ilat,ipt_ls, lmax,lval,i,jj,lonl,nv - integer node,nvar,arrsz - integer ilat_list(nodes) ! for OMP buffer copy -! -! statement functions -! ------------------- -! - integer indlsev, jbasev, indlsod, jbasod -! - include 'function_indlsev' - include 'function_indlsod' -! - real(kind=kind_dbl_prec), parameter :: cons0=0.0d0, cons1=1.0d0 -! -! xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx -! - arrsz=2*nvars*ls_dim*workdim*nodes - num_threads = min(num_parthds_stochy,nvars) - nvar_thread_max = (nvars+num_threads-1)/num_threads - kpts = 0 -! write(0,*)' londi=',londi,'nvarsdim=',nvarsdim,'workdim=',workdim -! - do j = 1, ls_max_node ! start of do j loop ##################### -! - l = ls_node(j,1) - jbasev = ls_node(j,2) - jbasod = ls_node(j,3) - - indev = indlsev(l,l) - indod = indlsod(l+1,l) -! - lat1 = lat1s(l) - if ( kind_dbl_prec == 8 ) then !------------------------------------ - -!$omp parallel do private(thread,nvar_1,nvar_2,n2) - do thread=1,num_threads ! start of thread loop .............. - nvar_1 = (thread-1)*nvar_thread_max + 1 - nvar_2 = min(nvar_1+nvar_thread_max-1,nvars) - - if (nvar_2 >= nvar_1) then - n2 = 2*(nvar_2-nvar_1+1) - -! compute the even and odd components of the fourier coefficients -! -! compute the sum of the even real terms for each level -! compute the sum of the even imaginary terms for each level -! -! call dgemm('t','n',latl2-lat1+1, 2*(nvar_2-nvar_1+1), -! & (jcap+2-l)/2,cons1, !constant -! & plnev(indev,lat1), len_trio_ls, -! & flnev(indev,2*nvar_1-1),len_trio_ls,cons0, -! & apev(2*nvar_1-1,lat1),latl2) - call esmf_dgemm( - & 't', - & 'n', - & n2, - & latl2-lat1+1, - & (jcap+3-l)/2, - & cons1, - & flnev(indev,2*nvar_1-1), - & len_trie_ls, - & plnev(indev,lat1), - & len_trie_ls, - & cons0, - & apev(2*nvar_1-1,lat1), - & 2*nvars - & ) -! -! compute the sum of the odd real terms for each level -! compute the sum of the odd imaginary terms for each level -! -! call dgemm('t','n',latl2-lat1+1, 2*(nvar_2-nvar_1+1), -! & (jcap+2-l)/2,cons1, !constant -! & plnod(indod,lat1), len_trio_ls, -! & flnod(indod,2*nvar_1-1),len_trio_ls,cons0, -! & apod(2*nvar_1-1,lat1), latl2) - call esmf_dgemm( - & 't', - & 'n', - & n2, - & latl2-lat1+1, - & (jcap+2-l)/2, - & cons1, - & flnod(indod,2*nvar_1-1), - & len_trio_ls, - & plnod(indod,lat1), - & len_trio_ls, - & cons0, - & apod(2*nvar_1-1,lat1), - & 2*nvars - & ) -! - endif - enddo ! end of thread loop .................................. - else !------------------------------------------------------------ -!$omp parallel do private(thread,nvar_1,nvar_2) - do thread=1,num_threads ! start of thread loop .............. - nvar_1 = (thread-1)*nvar_thread_max + 1 - nvar_2 = min(nvar_1+nvar_thread_max-1,nvars) - enddo ! end of thread loop .................................. - endif !----------------------------------------------------------- -! -ccxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx -! -! compute the fourier coefficients for each level -! ----------------------------------------------- -! - ilat_list(1) = 0 - do node = 1, nodes - 1 - ilat_list(node+1) = ilat_list(node) + lats_nodes(node) - end do - -!$omp parallel do private(node,jj,ilat,lat,ipt_ls,nvar,kn,n2) - do node=1,nodes - do jj=1,lats_nodes(node) - ilat = ilat_list(node) + jj - lat = global_lats(ilat) - ipt_ls = min(lat,latl-lat+1) - if ( ipt_ls >= lat1s(ls_nodes(j,me+1)) ) then - kpts(node) = kpts(node) + 1 - kn = kpts(node) -! - if ( lat <= latl2 ) then -! northern hemisphere - do nvar=1,nvars - n2 = nvar + nvar - works(1,nvar,kn,node) = apev(n2-1,ipt_ls) - & + apod(n2-1,ipt_ls) - works(2,nvar,kn,node) = apev(n2, ipt_ls) - & + apod(n2, ipt_ls) - enddo - else -! southern hemisphere - do nvar=1,nvars - n2 = nvar + nvar - works(1,nvar,kn,node) = apev(n2-1,ipt_ls) - & - apod(n2-1,ipt_ls) - works(2,nvar,kn,node) = apev(n2, ipt_ls) - & - apod(n2, ipt_ls) - enddo - endif - endif - enddo - enddo -! - enddo ! end of do j loop ####################################### -! - kptr = 0 - do node=1,nodes - do l=1,max_ls_nodes(node) - lval = ls_nodes(l,node)+1 - do j=1,lats_node - lat = global_lats(ipt_lats_node-1+j) - if ( min(lat,latl-lat+1) >= lat1s(lval-1) ) then - kptr(node) = kptr(node) + 1 - endif - enddo - enddo - enddo -! -! - n2 = nvars + nvars -!$omp parallel do private(node) - do node=1,nodes - sendcounts(node) = kpts(node) * n2 - recvcounts(node) = kptr(node) * n2 - sdispls(node) = (node-1) * n2 * ls_dim * workdim - end do - work1dr(1:arrsz)=>workr - work1ds(1:arrsz)=>works - call mpp_alltoall(work1ds, sendcounts, sdispls, - & work1dr, recvcounts, sdispls) - nullify(work1dr) - nullify(work1ds) -!$omp parallel do private(j,lat,lmax,nvar,lval,n2,lonl,nv) - do j=1,lats_node - lat = global_lats(ipt_lats_node-1+j) - lonl = lons_lat(lat) - lmax = min(jcap,lonl/2) - n2 = lmax + lmax + 3 -! write(0,*)' j=',j,' lat=',lat,' lmax=',lmax,' n2=',n2 -! &,' nvars=',nvars,' lonl=',lonl - if ( n2 <= lonl+2 ) then - do nvar=1,nvars - nv = nvars_0 + nvar - do lval = n2, lonl+2 -! write(0,*)' lval=',lval,' nvar=',nvar,nvars_0 -! &,' n2=',n2,' lonl=',lonl,' nv=',nv,' j=',j -! &,'size=',size(four_gr,1),size(four_gr,2),size(four_gr,3) - four_gr(lval,nv,j) = cons0 - enddo - enddo - endif - enddo -! - kptr = 0 -! write(0,*)' kptr=',kptr(1) -!! -!$omp parallel do private(node,l,lval,j,lat,nvar,kn,n2) - do node=1,nodes - do l=1,max_ls_nodes(node) - lval = ls_nodes(l,node)+1 - n2 = lval + lval - do j=1,lats_node - lat = global_lats(ipt_lats_node-1+j) - if ( min(lat,latl-lat+1) >= lat1s(lval-1) ) then - kptr(node) = kptr(node) + 1 - kn = kptr(node) - - do nvar=1,nvars - four_gr(n2-1,nvars_0+nvar,j) = workr(1,nvar,kn,node) - four_gr(n2, nvars_0+nvar,j) = workr(2,nvar,kn,node) - enddo - endif - enddo - enddo - enddo -! - return - end - - end module sumfln_stochy_mod