diff --git a/.gitmodules b/.gitmodules index 8758980ec..b2d51bdfe 100644 --- a/.gitmodules +++ b/.gitmodules @@ -1,4 +1,4 @@ -[submodule "physics/rte-rrtmgp"] - path = physics/rte-rrtmgp +[submodule "physics/Radiation/RRTMGP/rte-rrtmgp"] + path = physics/Radiation/RRTMGP/rte-rrtmgp url = https://github.com/earth-system-radiation/rte-rrtmgp branch = main diff --git a/CMakeLists.txt b/CMakeLists.txt index 97591a2ee..715af8afe 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -1,4 +1,4 @@ -cmake_minimum_required(VERSION 3.3) +cmake_minimum_required(VERSION 3.10) project(ccpp_physics VERSION 5.0.0 @@ -8,6 +8,13 @@ project(ccpp_physics set(PACKAGE "ccpp-physics") set(AUTHORS "Grant Firl" "Dustin Swales" "Man Zhang" "Mike Kavulich" ) +#------------------------------------------------------------------------------ +# Set MPI flags for Fortran with MPI F08 interface +find_package(MPI REQUIRED Fortran) +if(NOT MPI_Fortran_HAVE_F08_MODULE) + message(FATAL_ERROR "MPI implementation does not support the Fortran 2008 mpi_f08 interface") +endif() + #------------------------------------------------------------------------------ # Set OpenMP flags for C/C++/Fortran if (OPENMP) @@ -79,37 +86,37 @@ get_filename_component(LOCAL_CURRENT_SOURCE_DIR ${FULL_PATH_TO_CMAKELISTS} DIREC #------------------------------------------------------------------------------ # List of files that need to be compiled without OpenMP -set(SCHEMES_OPENMP_OFF ${LOCAL_CURRENT_SOURCE_DIR}/physics/rte-rrtmgp/rrtmgp/mo_gas_optics.F90 - ${LOCAL_CURRENT_SOURCE_DIR}/physics/rte-rrtmgp/rrtmgp/mo_rrtmgp_constants.F90 - ${LOCAL_CURRENT_SOURCE_DIR}/physics/rte-rrtmgp/rrtmgp/mo_gas_concentrations.F90 - ${LOCAL_CURRENT_SOURCE_DIR}/physics/rte-rrtmgp/rrtmgp/mo_rrtmgp_util_string.F90 - ${LOCAL_CURRENT_SOURCE_DIR}/physics/rte-rrtmgp/rrtmgp/kernels/mo_gas_optics_kernels.F90 - ${LOCAL_CURRENT_SOURCE_DIR}/physics/rte-rrtmgp/rrtmgp/mo_gas_optics_rrtmgp.F90 - ${LOCAL_CURRENT_SOURCE_DIR}/physics/rte-rrtmgp/extensions/mo_rrtmgp_clr_all_sky.F90 - ${LOCAL_CURRENT_SOURCE_DIR}/physics/rte-rrtmgp/extensions/mo_fluxes_byband.F90 - ${LOCAL_CURRENT_SOURCE_DIR}/physics/rte-rrtmgp/extensions/solar_variability/mo_solar_variability.F90 - ${LOCAL_CURRENT_SOURCE_DIR}/physics/rte-rrtmgp/extensions/mo_heating_rates.F90 - ${LOCAL_CURRENT_SOURCE_DIR}/physics/rte-rrtmgp/extensions/mo_fluxes_bygpoint.F90 - ${LOCAL_CURRENT_SOURCE_DIR}/physics/rte-rrtmgp/extensions/mo_compute_bc.F90 - ${LOCAL_CURRENT_SOURCE_DIR}/physics/rte-rrtmgp/extensions/cloud_optics/mo_cloud_sampling.F90 - ${LOCAL_CURRENT_SOURCE_DIR}/physics/rte-rrtmgp/extensions/cloud_optics/mo_cloud_optics.F90 - ${LOCAL_CURRENT_SOURCE_DIR}/physics/rte-rrtmgp/rte/mo_rte_config.F90 - ${LOCAL_CURRENT_SOURCE_DIR}/physics/rte-rrtmgp/rte/mo_source_functions.F90 - ${LOCAL_CURRENT_SOURCE_DIR}/physics/rte-rrtmgp/rte/mo_rte_sw.F90 - ${LOCAL_CURRENT_SOURCE_DIR}/physics/rte-rrtmgp/rte/mo_fluxes.F90 - ${LOCAL_CURRENT_SOURCE_DIR}/physics/rte-rrtmgp/rte/mo_rte_lw.F90 - ${LOCAL_CURRENT_SOURCE_DIR}/physics/rte-rrtmgp/rte/mo_rte_util_array.F90 - ${LOCAL_CURRENT_SOURCE_DIR}/physics/rte-rrtmgp/rte/kernels/mo_rte_solver_kernels.F90 - ${LOCAL_CURRENT_SOURCE_DIR}/physics/rte-rrtmgp/rte/kernels/mo_optical_props_kernels.F90 - ${LOCAL_CURRENT_SOURCE_DIR}/physics/rte-rrtmgp/rte/kernels/mo_fluxes_broadband_kernels.F90 - ${LOCAL_CURRENT_SOURCE_DIR}/physics/rte-rrtmgp/rte/mo_rte_kind.F90 - ${LOCAL_CURRENT_SOURCE_DIR}/physics/rte-rrtmgp/rte/mo_optical_props.F90) +set(SCHEMES_OPENMP_OFF ${LOCAL_CURRENT_SOURCE_DIR}/physics/Radiation/RRTMGP/rte-rrtmgp/rrtmgp/mo_gas_optics.F90 + ${LOCAL_CURRENT_SOURCE_DIR}/physics/Radiation/RRTMGP/rte-rrtmgp/rrtmgp/mo_rrtmgp_constants.F90 + ${LOCAL_CURRENT_SOURCE_DIR}/physics/Radiation/RRTMGP/rte-rrtmgp/rrtmgp/mo_gas_concentrations.F90 + ${LOCAL_CURRENT_SOURCE_DIR}/physics/Radiation/RRTMGP/rte-rrtmgp/rrtmgp/mo_rrtmgp_util_string.F90 + ${LOCAL_CURRENT_SOURCE_DIR}/physics/Radiation/RRTMGP/rte-rrtmgp/rrtmgp/kernels/mo_gas_optics_kernels.F90 + ${LOCAL_CURRENT_SOURCE_DIR}/physics/Radiation/RRTMGP/rte-rrtmgp/rrtmgp/mo_gas_optics_rrtmgp.F90 + ${LOCAL_CURRENT_SOURCE_DIR}/physics/Radiation/RRTMGP/rte-rrtmgp/extensions/mo_rrtmgp_clr_all_sky.F90 + ${LOCAL_CURRENT_SOURCE_DIR}/physics/Radiation/RRTMGP/rte-rrtmgp/extensions/mo_fluxes_byband.F90 + ${LOCAL_CURRENT_SOURCE_DIR}/physics/Radiation/RRTMGP/rte-rrtmgp/extensions/solar_variability/mo_solar_variability.F90 + ${LOCAL_CURRENT_SOURCE_DIR}/physics/Radiation/RRTMGP/rte-rrtmgp/extensions/mo_heating_rates.F90 + ${LOCAL_CURRENT_SOURCE_DIR}/physics/Radiation/RRTMGP/rte-rrtmgp/extensions/mo_fluxes_bygpoint.F90 + ${LOCAL_CURRENT_SOURCE_DIR}/physics/Radiation/RRTMGP/rte-rrtmgp/extensions/mo_compute_bc.F90 + ${LOCAL_CURRENT_SOURCE_DIR}/physics/Radiation/RRTMGP/rte-rrtmgp/extensions/cloud_optics/mo_cloud_sampling.F90 + ${LOCAL_CURRENT_SOURCE_DIR}/physics/Radiation/RRTMGP/rte-rrtmgp/extensions/cloud_optics/mo_cloud_optics.F90 + ${LOCAL_CURRENT_SOURCE_DIR}/physics/Radiation/RRTMGP/rte-rrtmgp/rte/mo_rte_config.F90 + ${LOCAL_CURRENT_SOURCE_DIR}/physics/Radiation/RRTMGP/rte-rrtmgp/rte/mo_source_functions.F90 + ${LOCAL_CURRENT_SOURCE_DIR}/physics/Radiation/RRTMGP/rte-rrtmgp/rte/mo_rte_sw.F90 + ${LOCAL_CURRENT_SOURCE_DIR}/physics/Radiation/RRTMGP/rte-rrtmgp/rte/mo_fluxes.F90 + ${LOCAL_CURRENT_SOURCE_DIR}/physics/Radiation/RRTMGP/rte-rrtmgp/rte/mo_rte_lw.F90 + ${LOCAL_CURRENT_SOURCE_DIR}/physics/Radiation/RRTMGP/rte-rrtmgp/rte/mo_rte_util_array.F90 + ${LOCAL_CURRENT_SOURCE_DIR}/physics/Radiation/RRTMGP/rte-rrtmgp/rte/kernels/mo_rte_solver_kernels.F90 + ${LOCAL_CURRENT_SOURCE_DIR}/physics/Radiation/RRTMGP/rte-rrtmgp/rte/kernels/mo_optical_props_kernels.F90 + ${LOCAL_CURRENT_SOURCE_DIR}/physics/Radiation/RRTMGP/rte-rrtmgp/rte/kernels/mo_fluxes_broadband_kernels.F90 + ${LOCAL_CURRENT_SOURCE_DIR}/physics/Radiation/RRTMGP/rte-rrtmgp/rte/mo_rte_kind.F90 + ${LOCAL_CURRENT_SOURCE_DIR}/physics/Radiation/RRTMGP/rte-rrtmgp/rte/mo_optical_props.F90) # List of files that need to be compiled with different precision set(SCHEMES_DYNAMICS) -if(${LOCAL_CURRENT_SOURCE_DIR}/physics/fv_sat_adj.F90 IN_LIST SCHEMES) - list(APPEND SCHEMES_DYNAMICS ${LOCAL_CURRENT_SOURCE_DIR}/physics/fv_sat_adj.F90) +if(${LOCAL_CURRENT_SOURCE_DIR}/physics/MP/GFDL/fv_sat_adj.F90 IN_LIST SCHEMES) + list(APPEND SCHEMES_DYNAMICS ${LOCAL_CURRENT_SOURCE_DIR}/physics/MP/GFDL/fv_sat_adj.F90) endif() # Remove files that need to be compiled with different precision @@ -135,7 +142,9 @@ SET_PROPERTY(SOURCE ${SCHEMES} ${CAPS} # Lower optimization for certain schemes when compiling with Intel in Release mode if(CMAKE_BUILD_TYPE STREQUAL "Release" AND ${CMAKE_Fortran_COMPILER_ID} STREQUAL "Intel") # Define a list of schemes that need lower optimization with Intel in Release mode - set(SCHEME_NAMES_LOWER_OPTIMIZATION module_sf_mynn.F90) + set(SCHEME_NAMES_LOWER_OPTIMIZATION module_sf_mynn.F90 + mynnedmf_wrapper.F90 + gcycle.F90) foreach(SCHEME_NAME IN LISTS SCHEME_NAMES_LOWER_OPTIMIZATION) set(SCHEMES_TMP ${SCHEMES}) # Need to determine the name of the scheme with its path diff --git a/CODEOWNERS b/CODEOWNERS index 8f53a50bc..99d6697f2 100644 --- a/CODEOWNERS +++ b/CODEOWNERS @@ -11,190 +11,187 @@ # https://docs.google.com/spreadsheets/d/14y0Th_sSpCqlssEMNfSZ_Ni9wrpPqfpPY0kRG7jCZB8/edit#gid=0 # (Internal NOAA document.) -smoke_dust/* @haiqinli @grantfirl @Qingfu-Liu @dustinswales -physics/aer_cloud.F @AnningCheng-NOAA @andrewgettelman @grantfirl @Qingfu-Liu @dustinswales -physics/aerclm_def.F @AnningCheng-NOAA @andrewgettelman @grantfirl @Qingfu-Liu @dustinswales -physics/aerinterp.F90 @AnningCheng-NOAA @andrewgettelman @grantfirl @Qingfu-Liu @dustinswales -physics/bl_mynn_common.f90 @joeolson42 @grantfirl @Qingfu-Liu @dustinswales -physics/calpreciptype.f90 @grantfirl @Qingfu-Liu @dustinswales -physics/cires_orowam2017.f @mdtoyNOAA @grantfirl @Qingfu-Liu @dustinswales -physics/cires_tauamf_data.F90 @mdtoyNOAA @grantfirl @Qingfu-Liu @dustinswales -physics/cires_ugwp* @mdtoyNOAA @grantfirl @Qingfu-Liu @dustinswales -physics/cldmacro.F @AnningCheng-NOAA @andrewgettelman @grantfirl @Qingfu-Liu @dustinswales -physics/cldwat2m_micro.F @AnningCheng-NOAA @andrewgettelman @grantfirl @Qingfu-Liu @dustinswales -physics/clm_lake.* @tanyasmirnova @SamuelTrahanNOAA @grantfirl @Qingfu-Liu @dustinswales -physics/cnvc90.* @grantfirl @Qingfu-Liu @dustinswales -physics/cs_conv_aw_adj.* @AnningCheng-NOAA @grantfirl @Qingfu-Liu @dustinswales -physics/cs_conv.* @AnningCheng-NOAA @grantfirl @Qingfu-Liu @dustinswales -physics/cu_gf* @haiqinli @grantfirl @Qingfu-Liu @dustinswales -physics/cu_ntiedtke* @JongilHan66 @Qingfu-Liu @grantfirl @Qingfu-Liu @dustinswales -physics/cu_c3* @lisa-bengtsson @haiqinli @grantfirl @Qingfu-Liu @dustinswales -physics/date_def.f @XuLi-NOAA @grantfirl @Qingfu-Liu @dustinswales -physics/dcyc2t3.* @Qingfu-Liu @dustinswales @grantfirl @Qingfu-Liu @dustinswales -physics/drag_suite.* @mdtoyNOAA @grantfirl @Qingfu-Liu @dustinswales -physics/flake* @barlage @grantfirl @Qingfu-Liu @dustinswales -physics/funcphys.f90 @grantfirl @Qingfu-Liu @dustinswales -physics/fv_sat_adj.* @RuiyuSun @grantfirl @Qingfu-Liu @dustinswales -physics/gcycle.F90 @grantfirl @Qingfu-Liu @dustinswales -physics/get_phi_fv3.* @grantfirl @Qingfu-Liu @dustinswales -physics/get_prs_fv3.* @grantfirl @Qingfu-Liu @dustinswales -physics/gfdl_cloud_microphys.* @RuiyuSun @grantfirl @Qingfu-Liu @dustinswales -physics/GFDL_parse_tracers.F90 @grantfirl @Qingfu-Liu @dustinswales -physics/gfdl_sfc_layer.* @ZhanZhang-NOAA @grantfirl @Qingfu-Liu @dustinswales -physics/GFS_cloud_diagnostics.* @dustinswales @Qingfu-Liu @grantfirl @Qingfu-Liu @dustinswales -physics/GFS_DCNV_generic_post.* @grantfirl @Qingfu-Liu @dustinswales -physics/GFS_DCNV_generic_pre.* @grantfirl @Qingfu-Liu @dustinswales -physics/GFS_debug.* @grantfirl @Qingfu-Liu @dustinswales -physics/GFS_GWD_generic_post.* @grantfirl @Qingfu-Liu @dustinswales -physics/GFS_GWD_generic_pre.* @grantfirl @Qingfu-Liu @dustinswales -physics/GFS_MP_generic_post.* @grantfirl @Qingfu-Liu @dustinswales -physics/GFS_MP_generic_pre.* @grantfirl @Qingfu-Liu @dustinswales -physics/GFS_PBL_generic_common.F90 @grantfirl @Qingfu-Liu @dustinswales -physics/GFS_PBL_generic_post.* @grantfirl @Qingfu-Liu @dustinswales -physics/GFS_PBL_generic_pre.* @grantfirl @Qingfu-Liu @dustinswales -physics/GFS_phys_time_vary.fv3.* @grantfirl @Qingfu-Liu @dustinswales -physics/GFS_phys_time_vary.scm.* @grantfirl @Qingfu-Liu @dustinswales -physics/gfs_phy_tracer_config.F @grantfirl @Qingfu-Liu @dustinswales -physics/GFS_radiation_surface.* @grantfirl @Qingfu-Liu @dustinswales -physics/GFS_rad_time_vary.fv3.* @grantfirl @Qingfu-Liu @dustinswales -physics/GFS_rad_time_vary.scm.* @grantfirl @Qingfu-Liu @dustinswales -physics/GFS_rrtmgp_cloud_mp.* @dustinswales @Qingfu-Liu @grantfirl @Qingfu-Liu @dustinswales -physics/GFS_rrtmgp_cloud_overlap.* @dustinswales @Qingfu-Liu @grantfirl @Qingfu-Liu @dustinswales -physics/GFS_rrtmg_post.* @Qingfu-Liu @dustinswales @grantfirl @Qingfu-Liu @dustinswales -physics/GFS_rrtmgp_pre.* @dustinswales @Qingfu-Liu @grantfirl @Qingfu-Liu @dustinswales -physics/GFS_rrtmg_pre.* @Qingfu-Liu @dustinswales @grantfirl @Qingfu-Liu @dustinswales -physics/GFS_rrtmgp_setup.* @dustinswales @Qingfu-Liu @grantfirl @Qingfu-Liu @dustinswales -physics/GFS_rrtmgp_post.* @dustinswales @Qingfu-Liu @grantfirl @Qingfu-Liu @dustinswales -physics/GFS_rrtmg_setup.* @Qingfu-Liu @dustinswales @grantfirl @Qingfu-Liu @dustinswales -physics/GFS_SCNV_generic_post.* @grantfirl @Qingfu-Liu @dustinswales -physics/GFS_SCNV_generic_pre.* @grantfirl @Qingfu-Liu @dustinswales -physics/GFS_stochastics.* @pjpegion @lisa-bengtsson @grantfirl @Qingfu-Liu @dustinswales -physics/GFS_suite_interstitial_1.* @grantfirl @Qingfu-Liu @dustinswales -physics/GFS_suite_interstitial_2.* @grantfirl @Qingfu-Liu @dustinswales -physics/GFS_suite_interstitial_3.* @grantfirl @Qingfu-Liu @dustinswales -physics/GFS_suite_interstitial_4.* @grantfirl @Qingfu-Liu @dustinswales -physics/GFS_suite_interstitial_5.* @grantfirl @Qingfu-Liu @dustinswales -physics/GFS_suite_interstitial_phys_reset.* @grantfirl @Qingfu-Liu @dustinswales -physics/GFS_suite_interstitial_rad_reset.* @grantfirl @Qingfu-Liu @dustinswales -physics/GFS_suite_stateout_reset.* @grantfirl @Qingfu-Liu @dustinswales -physics/GFS_suite_stateout_update.* @grantfirl @Qingfu-Liu @dustinswales -physics/GFS_surface_composites_inter.* @grantfirl @Qingfu-Liu @dustinswales -physics/GFS_surface_composites_post.* @grantfirl @Qingfu-Liu @dustinswales -physics/GFS_surface_composites_pre.* @grantfirl @Qingfu-Liu @dustinswales -physics/GFS_surface_generic_post.* @grantfirl @Qingfu-Liu @dustinswales -physics/GFS_surface_generic_pre.* @grantfirl @Qingfu-Liu @dustinswales -physics/GFS_surface_loop_control_part1.* @grantfirl @Qingfu-Liu @dustinswales -physics/GFS_surface_loop_control_part2.* @grantfirl @Qingfu-Liu @dustinswales -physics/GFS_time_vary_pre.fv3.* @grantfirl @Qingfu-Liu @dustinswales -physics/GFS_time_vary_pre.scm.* @grantfirl @Qingfu-Liu @dustinswales -physics/gocart_tracer_config_stub.f @grantfirl @Qingfu-Liu @dustinswales -physics/gwdc.* @Songyou184 @grantfirl @Qingfu-Liu @dustinswales -physics/gwdps.* @Songyou184 @grantfirl @Qingfu-Liu @dustinswales -physics/h2o_def.* @grantfirl @Qingfu-Liu @dustinswales -physics/h2ointerp.f90 @grantfirl @Qingfu-Liu @dustinswales -physics/h2ophys.* @Qingfu-Liu @grantfirl @Qingfu-Liu @dustinswales -physics/hedmf.* @JongilHan66 @WeiguoWang-NOAA @grantfirl @Qingfu-Liu @dustinswales -physics/iccn_def.F @grantfirl @Qingfu-Liu @dustinswales -physics/iccninterp.F90 @grantfirl @Qingfu-Liu @dustinswales -physics/iounitdef.f @grantfirl @Qingfu-Liu @dustinswales -physics/lsm_noah.* @HelinWei-NOAA @grantfirl @Qingfu-Liu @dustinswales -physics/lsm_ruc.* @tanyasmirnova @grantfirl @Qingfu-Liu @dustinswales -physics/machine.* @grantfirl @Qingfu-Liu @dustinswales -physics/maximum_hourly_diagnostics.* @grantfirl @Qingfu-Liu @dustinswales -physics/mersenne_twister.f @grantfirl @Qingfu-Liu @dustinswales -physics/mfpbl.f @JongilHan66 @grantfirl @Qingfu-Liu @dustinswales -physics/mfpblt.f @JongilHan66 @grantfirl @Qingfu-Liu @dustinswales -physics/mfpbltq.f @JongilHan66 @grantfirl @Qingfu-Liu @dustinswales -physics/mfscu.f @JongilHan66 @grantfirl @Qingfu-Liu @dustinswales -physics/mfscuq.f @JongilHan66 @grantfirl @Qingfu-Liu @dustinswales -physics/micro_mg* @AnningCheng-NOAA @andrewgettelman @grantfirl @Qingfu-Liu @dustinswales -physics/m_micro* @AnningCheng-NOAA @andrewgettelman @grantfirl @Qingfu-Liu @dustinswales -physics/module_bfmicrophysics.f @grantfirl @Qingfu-Liu @dustinswales -physics/module_BL_MYJPBL.* @Qingfu-Liu @grantfirl @Qingfu-Liu @dustinswales -physics/module_bl_mynn.* @joeolson42 @grantfirl @Qingfu-Liu @dustinswales -physics/module_gfdl_cloud_microphys.* @RuiyuSun @grantfirl @Qingfu-Liu @dustinswales -physics/module_MP_FER_HIRES.* @ericaligo-NOAA @grantfirl @Qingfu-Liu @dustinswales -physics/module_mp_nssl_2mom.F90 @MicroTed @grantfirl @Qingfu-Liu @dustinswales -physics/module_mp_radar.* @gthompsnWRF @RuiyuSun @grantfirl @Qingfu-Liu @dustinswales -physics/module_mp_thompson* @gthompsnWRF @RuiyuSun @AndersJensen-NOAA @grantfirl @Qingfu-Liu @dustinswales -physics/module_nst* @XuLi-NOAA @grantfirl @Qingfu-Liu @dustinswales -physics/module_sf_exchcoef.f90 @ZhanZhang-NOAA @grantfirl @Qingfu-Liu @dustinswales -physics/module_SF_JSFC.F90 @Qingfu-Liu @grantfirl @Qingfu-Liu @dustinswales -physics/module_sf_mynn.F90 @joeolson42 @grantfirl @Qingfu-Liu @dustinswales -physics/module_sf_ruclsm.* @tanyasmirnova @grantfirl @Qingfu-Liu @dustinswales -physics/module_soil_pre.* @tanyasmirnova @grantfirl @Qingfu-Liu @dustinswales -physics/moninshoc.* @grantfirl @Qingfu-Liu @dustinswales -physics/mp_fer_hires.* @ericaligo-NOAA @grantfirl @Qingfu-Liu @dustinswales -physics/mp_nssl.* @MicroTed @grantfirl @Qingfu-Liu @dustinswales -physics/mp_thompson* @gthompsnWRF @RuiyuSun @AndersJensen-NOAA @grantfirl @Qingfu-Liu @dustinswales -physics/multi_gases.F90 @RuiyuSun @grantfirl @Qingfu-Liu @dustinswales -physics/myjpbl_wrapper.* @Qingfu-Liu @grantfirl @Qingfu-Liu @dustinswales -physics/myjsfc_wrapper.* @Qingfu-Liu @grantfirl @Qingfu-Liu @dustinswales -physics/mynnedmf_wrapper.* @joeolson42 @grantfirl @Qingfu-Liu @dustinswales -physics/mynnsfc_wrapper.* @joeolson42 @grantfirl @Qingfu-Liu @dustinswales -physics/namelist_soilveg.* @HelinWei-NOAA @barlage @cenlinhe @grantfirl @Qingfu-Liu @dustinswales -physics/namelist_soilveg_ruc.* @tanyasmirnova @grantfirl @Qingfu-Liu @dustinswales -physics/*noahmp* @barlage @cenlinhe @grantfirl @Qingfu-Liu @dustinswales -physics/ozinterp.f90 @grantfirl @Qingfu-Liu @dustinswales -physics/ozne_def.* @grantfirl @Qingfu-Liu @dustinswales -physics/ozphys* @Qingfu-Liu @dustinswales @grantfirl @Qingfu-Liu @dustinswales -physics/physcons.F90 @grantfirl @Qingfu-Liu @dustinswales -physics/phys_tend.* @grantfirl @Qingfu-Liu @dustinswales -physics/progsigma_calc.f90 @lisa-bengtsson @grantfirl @Qingfu-Liu @dustinswales -physics/radcons.f90 @Qingfu-Liu @dustinswales @grantfirl @Qingfu-Liu @dustinswales -physics/radiation_aerosols.f @Qingfu-Liu @dustinswales @grantfirl @Qingfu-Liu @dustinswales -physics/radiation_astronomy.f @Qingfu-Liu @dustinswales @grantfirl @Qingfu-Liu @dustinswales -physics/radiation_cloud_overlap.F90 @Qingfu-Liu @dustinswales @grantfirl @Qingfu-Liu @dustinswales -physics/radiation_clouds.f @Qingfu-Liu @dustinswales @grantfirl @Qingfu-Liu @dustinswales -physics/radiation_gases.f @Qingfu-Liu @dustinswales @grantfirl @Qingfu-Liu @dustinswales -physics/radiation_surface.* @Qingfu-Liu @dustinswales @grantfirl @Qingfu-Liu @dustinswales -physics/radiation_tools.F90 @Qingfu-Liu @dustinswales @grantfirl @Qingfu-Liu @dustinswales -physics/radlw_* @mjiacono @Qingfu-Liu @grantfirl @Qingfu-Liu @dustinswales -physics/radsw_* @mjiacono @Qingfu-Liu @grantfirl @Qingfu-Liu @dustinswales -physics/rascnv.* @haiqinli @JongilHan66 @grantfirl @Qingfu-Liu @dustinswales -physics/rayleigh_damp.* @yangfanglin @grantfirl @Qingfu-Liu @dustinswales -physics/rrtmg_lw_cloud_optics.F90 @Qingfu-Liu @dustinswales @grantfirl @Qingfu-Liu @dustinswales -physics/rrtmg_lw_post.* @Qingfu-Liu @dustinswales @grantfirl @Qingfu-Liu @dustinswales -physics/rrtmg_lw_pre.* @Qingfu-Liu @dustinswales @grantfirl @Qingfu-Liu @dustinswales -physics/rrtmgp_aerosol_optics.* @dustinswales @Qingfu-Liu @grantfirl @Qingfu-Liu @dustinswales -physics/rrtmgp_lw_* @dustinswales @Qingfu-Liu @grantfirl @Qingfu-Liu @dustinswales -physics/rrtmgp_sw_* @dustinswales @Qingfu-Liu @grantfirl @Qingfu-Liu @dustinswales -physics/rrtmg_sw_cloud_optics.F90 @dustinswales @Qingfu-Liu @grantfirl @Qingfu-Liu @dustinswales -physics/rrtmg_sw_post.* @Qingfu-Liu @dustinswales @grantfirl @Qingfu-Liu @dustinswales -physics/rte-rrtmgp @dustinswales @Qingfu-Liu @grantfirl @Qingfu-Liu @dustinswales -physics/samfdeepcnv.* @JongilHan66 @lisa-bengtsson @grantfirl @Qingfu-Liu @dustinswales -physics/samfshalcnv.* @JongilHan66 @lisa-bengtsson @grantfirl @Qingfu-Liu @dustinswales -physics/samfaerosols.* @JongilHan66 @lisa-bengtsson @grantfirl @Qingfu-Liu @dustinswales -physics/sascnvn.* @JongilHan66 @grantfirl @Qingfu-Liu @dustinswales -physics/satmedmfvdif.* @JongilHan66 @grantfirl @Qingfu-Liu @dustinswales -physics/satmedmfvdifq.* @JongilHan66 @grantfirl @Qingfu-Liu @dustinswales -physics/scm_sfc_flux_spec.* @grantfirl @grantfirl @Qingfu-Liu @dustinswales -physics/set_soilveg.* @HelinWei-NOAA @barlage @cenlinhe @grantfirl @Qingfu-Liu @dustinswales -physics/set_soilveg_ruc.* @tanyasmirnova @grantfirl @Qingfu-Liu @dustinswales -physics/sfc_cice.* @wd20xw @grantfirl @Qingfu-Liu @dustinswales -physics/sfc_diag.* @grantfirl @Qingfu-Liu @dustinswales -physics/sfc_diag_post.* @grantfirl @Qingfu-Liu @dustinswales -physics/sfc_diff.* @JongilHan66 @grantfirl @Qingfu-Liu @dustinswales -physics/sfc_nst* @XuLi-NOAA @grantfirl @Qingfu-Liu @dustinswales -physics/sfc_ocean.* @HelinWei-NOAA @grantfirl @Qingfu-Liu @dustinswales -physics/sfc_sice.* @wd20xw @grantfirl @Qingfu-Liu @dustinswales -physics/sfcsub.F @grantfirl @Qingfu-Liu @dustinswales -physics/sflx.f @HelinWei-NOAA @grantfirl @Qingfu-Liu @dustinswales -physics/sgscloud_radpost.* @grantfirl @Qingfu-Liu @dustinswales -physics/sgscloud_radpre.* @grantfirl @Qingfu-Liu @dustinswales -physics/shalcnv.* @JongilHan66 @grantfirl @Qingfu-Liu @dustinswales -physics/shinhongvdif.* @Qingfu-Liu @WeiguoWang-NOAA @grantfirl @Qingfu-Liu @dustinswales -physics/shoc.* @grantfirl @Qingfu-Liu @dustinswales -physics/surface_perturbation.* @HelinWei-NOAA @grantfirl @Qingfu-Liu @dustinswales -physics/tridi.f @JongilHan66 @WeiguoWang-NOAA @grantfirl @Qingfu-Liu @dustinswales -physics/ugwp_driver_v0.F @mdtoyNOAA @grantfirl @Qingfu-Liu @dustinswales -physics/ugwpv1_gsldrag.* @mdtoyNOAA @grantfirl @Qingfu-Liu @dustinswales -physics/ugwpv1_gsldrag_post.* @mdtoyNOAA @grantfirl @Qingfu-Liu @dustinswales -physics/unified_ugwp* @mdtoyNOAA @grantfirl @Qingfu-Liu @dustinswales -physics/wv_saturation.F @AnningCheng-NOAA @andrewgettelman @grantfirl @Qingfu-Liu @dustinswales -physics/ysuvdif.* @Qingfu-Liu @WeiguoWang-NOAA @grantfirl @Qingfu-Liu @dustinswales -physics/zhaocarr_gscond.* @RuiyuSun @grantfirl @Qingfu-Liu @dustinswales -physics/zhaocarr_precpd.* @RuiyuSun @grantfirl @Qingfu-Liu @dustinswales +physics/CONV/C3/cu_c3* @lisa-bengtsson @haiqinli @grantfirl @Qingfu-Liu @dustinswales +physics/CONV/Chikira_Sugiyama/cs_conv_aw_adj.* @AnningCheng-NOAA @grantfirl @Qingfu-Liu @dustinswales +physics/CONV/Chikira_Sugiyama/cs_conv.* @AnningCheng-NOAA @grantfirl @Qingfu-Liu @dustinswales +physics/CONV/Grell_Freitas/cu_gf* @haiqinli @grantfirl @Qingfu-Liu @dustinswales +physics/CONV/RAS/rascnv.* @haiqinli @JongilHan66 @grantfirl @Qingfu-Liu @dustinswales +physics/CONV/SAMF/samfdeepcnv.* @JongilHan66 @lisa-bengtsson @grantfirl @Qingfu-Liu @dustinswales +physics/CONV/SAMF/samfshalcnv.* @JongilHan66 @lisa-bengtsson @grantfirl @Qingfu-Liu @dustinswales +physics/CONV/SAMF/samfaerosols.* @JongilHan66 @lisa-bengtsson @grantfirl @Qingfu-Liu @dustinswales +physics/CONV/SAS/sascnvn.* @JongilHan66 @grantfirl @Qingfu-Liu @dustinswales +physics/CONV/SAS/shalcnv.* @JongilHan66 @grantfirl @Qingfu-Liu @dustinswales +physics/CONV/nTiedtke/cu_ntiedtke* @JongilHan66 @Qingfu-Liu @grantfirl @Qingfu-Liu @dustinswales +physics/CONV/progsigma_calc.f90 @lisa-bengtsson @grantfirl @Qingfu-Liu @dustinswales +physics/GWD/cires_orowam2017.f @mdtoyNOAA @grantfirl @Qingfu-Liu @dustinswales +physics/GWD/cires_tauamf_data.F90 @mdtoyNOAA @grantfirl @Qingfu-Liu @dustinswales +physics/GWD/cires_ugwp* @mdtoyNOAA @grantfirl @Qingfu-Liu @dustinswales +physics/GWD/drag_suite.* @mdtoyNOAA @grantfirl @Qingfu-Liu @dustinswales +physics/GWD/gwdc.* @Songyou184 @grantfirl @Qingfu-Liu @dustinswales +physics/GWD/gwdps.* @Songyou184 @grantfirl @Qingfu-Liu @dustinswales +physics/GWD/rayleigh_damp.* @yangfanglin @grantfirl @Qingfu-Liu @dustinswales +physics/GWD/ugwp_driver_v0.F @mdtoyNOAA @grantfirl @Qingfu-Liu @dustinswales +physics/GWD/ugwpv1_gsldrag.* @mdtoyNOAA @BoYang-NOAA @grantfirl @Qingfu-Liu @dustinswales +physics/GWD/ugwpv1_gsldrag_post.* @mdtoyNOAA @BoYang-NOAA @grantfirl @Qingfu-Liu @dustinswales +physics/GWD/unified_ugwp* @mdtoyNOAA @grantfirl @Qingfu-Liu @dustinswales +physics/MP/Ferrier_Aligo/module_MP_FER_HIRES.* @ericaligo-NOAA @grantfirl @Qingfu-Liu @dustinswales +physics/MP/Ferrier_Aligo/mp_fer_hires.* @ericaligo-NOAA @grantfirl @Qingfu-Liu @dustinswales +physics/MP/GFDL/GFDL_parse_tracers.F90 @grantfirl @Qingfu-Liu @dustinswales +physics/MP/GFDL/gfdl_cloud_microphys.* @RuiyuSun @grantfirl @Qingfu-Liu @dustinswales +physics/MP/GFDL/module_gfdl_cloud_microphys.* @RuiyuSun @grantfirl @Qingfu-Liu @dustinswales +physics/MP/GFDL/fv_sat_adj.* @RuiyuSun @grantfirl @Qingfu-Liu @dustinswales +physics/MP/GFDL/multi_gases.F90 @RuiyuSun @grantfirl @Qingfu-Liu @dustinswales +physics/MP/Morrison_Gettelman/aer_cloud.F @AnningCheng-NOAA @andrewgettelman @grantfirl @Qingfu-Liu @dustinswales +physics/MP/Morrison_Gettelman/aerclm_def.F @AnningCheng-NOAA @andrewgettelman @grantfirl @Qingfu-Liu @dustinswales +physics/MP/Morrison_Gettelman/aerinterp.F90 @AnningCheng-NOAA @andrewgettelman @grantfirl @Qingfu-Liu @dustinswales +physics/MP/Morrison_Gettelman/cldmacro.F @AnningCheng-NOAA @andrewgettelman @grantfirl @Qingfu-Liu @dustinswales +physics/MP/Morrison_Gettelman/cldwat2m_micro.F @AnningCheng-NOAA @andrewgettelman @grantfirl @Qingfu-Liu @dustinswales +physics/MP/Morrison_Gettelman/micro_mg* @AnningCheng-NOAA @andrewgettelman @grantfirl @Qingfu-Liu @dustinswales +physics/MP/Morrison_Gettelman/m_micro* @AnningCheng-NOAA @andrewgettelman @grantfirl @Qingfu-Liu @dustinswales +physics/MP/Morrison_Gettelman/wv_saturation.F @AnningCheng-NOAA @andrewgettelman @grantfirl @Qingfu-Liu @dustinswales +physics/MP/NSSL/module_mp_nssl_2mom.F90 @MicroTed @grantfirl @Qingfu-Liu @dustinswales +physics/MP/NSSL/mp_nssl.* @MicroTed @grantfirl @Qingfu-Liu @dustinswales +physics/MP/Thompson/module_mp_thompson* @gthompsnWRF @RuiyuSun @AndersJensen-NOAA @grantfirl @Qingfu-Liu @dustinswales +physics/MP/Thompson/mp_thompson* @gthompsnWRF @RuiyuSun @AndersJensen-NOAA @grantfirl @Qingfu-Liu @dustinswales +physics/MP/Zhao_Carr/zhaocarr_gscond.* @RuiyuSun @grantfirl @Qingfu-Liu @dustinswales +physics/MP/Zhao_Carr/zhaocarr_precpd.* @RuiyuSun @grantfirl @Qingfu-Liu @dustinswales +physics/MP/calpreciptype.f90 @grantfirl @Qingfu-Liu @dustinswales +physics/MP/module_mp_radar.* @gthompsnWRF @RuiyuSun @grantfirl @Qingfu-Liu @dustinswales +physics/PBL/HEDMF/hedmf.* @JongilHan66 @WeiguoWang-NOAA @grantfirl @Qingfu-Liu @dustinswales +physics/PBL/MYJ/module_BL_MYJPBL.* @Qingfu-Liu @grantfirl @Qingfu-Liu @dustinswales +physics/PBL/MYJ/myjpbl_wrapper.* @Qingfu-Liu @grantfirl @Qingfu-Liu @dustinswales +physics/PBL/MYNN_EDMF/bl_mynn_common.f90 @joeolson42 @grantfirl @Qingfu-Liu @dustinswales +physics/PBL/MYNN_EDMF/module_bl_mynn.* @joeolson42 @grantfirl @Qingfu-Liu @dustinswales +physics/PBL/MYNN_EDMF/mynnedmf_wrapper.* @joeolson42 @grantfirl @Qingfu-Liu @dustinswales +physics/PBL/SATMEDMF/satmedmfvdif.* @JongilHan66 @grantfirl @Qingfu-Liu @dustinswales +physics/PBL/SATMEDMF/satmedmfvdifq.* @JongilHan66 @grantfirl @Qingfu-Liu @dustinswales +physics/PBL/SATMEDMF/mfscu.f @JongilHan66 @grantfirl @Qingfu-Liu @dustinswales +physics/PBL/SATMEDMF/mfscuq.f @JongilHan66 @grantfirl @Qingfu-Liu @dustinswales +physics/PBL/SHOC/moninshoc.* @grantfirl @Qingfu-Liu @dustinswales +physics/PBL/SHOC/shoc.* @grantfirl @Qingfu-Liu @dustinswales +physics/PBL/YSU/ysuvdif.* @Qingfu-Liu @WeiguoWang-NOAA @grantfirl @Qingfu-Liu @dustinswales +physics/PBL/saYSU/shinhongvdif.* @Qingfu-Liu @WeiguoWang-NOAA @grantfirl @Qingfu-Liu @dustinswales +physics/PBL/mfpbl.f @JongilHan66 @grantfirl @Qingfu-Liu @dustinswales +physics/PBL/mfpblt.f @JongilHan66 @grantfirl @Qingfu-Liu @dustinswales +physics/PBL/mfpbltq.f @JongilHan66 @grantfirl @Qingfu-Liu @dustinswales +physics/PBL/tridi.f @JongilHan66 @WeiguoWang-NOAA @grantfirl @Qingfu-Liu @dustinswales +physics/Radiation/RRTMG/iounitdef.f @grantfirl @Qingfu-Liu @dustinswales +physics/Radiation/RRTMG/module_bfmicrophysics.f @grantfirl @Qingfu-Liu @dustinswales +physics/Radiation/RRTMG/rad_sw_pre* @mjiacono @Qingfu-Liu @grantfirl @Qingfu-Liu @dustinswales +physics/Radiation/RRTMG/radcons.f90 @Qingfu-Liu @dustinswales @grantfirl @Qingfu-Liu @dustinswales +physics/Radiation/RRTMG/radlw_* @mjiacono @Qingfu-Liu @grantfirl @Qingfu-Liu @dustinswales +physics/Radiation/RRTMG/radsw_* @mjiacono @Qingfu-Liu @grantfirl @Qingfu-Liu @dustinswales +physics/Radiation/RRTMG/rrtmg_lw_cloud_optics.F90 @Qingfu-Liu @dustinswales @grantfirl @Qingfu-Liu @dustinswales +physics/Radiation/RRTMG/rrtmg_lw_post.* @Qingfu-Liu @dustinswales @grantfirl @Qingfu-Liu @dustinswales +physics/Radiation/RRTMG/rrtmg_sw_cloud_optics.F90 @dustinswales @Qingfu-Liu @grantfirl @Qingfu-Liu @dustinswales +physics/Radiation/RRTMG/rrtmg_sw_post.* @Qingfu-Liu @dustinswales @grantfirl @Qingfu-Liu @dustinswales +physics/Radiation/RRTMGP/rte-rrtmgp @dustinswales @Qingfu-Liu @grantfirl @Qingfu-Liu @dustinswales +physics/Radiation/RRTMGP/rrtmgp_aerosol_optics.* @dustinswales @Qingfu-Liu @grantfirl @Qingfu-Liu @dustinswales +physics/Radiation/RRTMGP/rrtmgp_lw_* @dustinswales @Qingfu-Liu @grantfirl @Qingfu-Liu @dustinswales +physics/Radiation/RRTMGP/rrtmgp_sw_* @dustinswales @Qingfu-Liu @grantfirl @Qingfu-Liu @dustinswales +physics/Radiation/mersenne_twister.f @grantfirl @Qingfu-Liu @dustinswales +physics/Radiation/radiation_aerosols.f @Qingfu-Liu @dustinswales @grantfirl @Qingfu-Liu @dustinswales +physics/Radiation/radiation_astronomy.f @Qingfu-Liu @dustinswales @grantfirl @Qingfu-Liu @dustinswales +physics/Radiation/radiation_cloud_overlap.F90 @Qingfu-Liu @dustinswales @grantfirl @Qingfu-Liu @dustinswales +physics/Radiation/radiation_clouds.f @Qingfu-Liu @dustinswales @grantfirl @Qingfu-Liu @dustinswales +physics/Radiation/radiation_gases.f @Qingfu-Liu @dustinswales @grantfirl @Qingfu-Liu @dustinswales +physics/Radiation/radiation_surface.f @Qingfu-Liu @dustinswales @grantfirl @Qingfu-Liu @dustinswales +physics/Radiation/radiation_tools.F90 @Qingfu-Liu @dustinswales @grantfirl @Qingfu-Liu @dustinswales +physics/SFC_Layer/GFDL/gfdl_sfc_layer.* @ZhanZhang-NOAA @grantfirl @Qingfu-Liu @dustinswales +physics/SFC_Layer/GFDL/module_sf_exchcoef.f90 @ZhanZhang-NOAA @grantfirl @Qingfu-Liu @dustinswales +physics/SFC_Layer/MYJ/myjsfc_wrapper.* @Qingfu-Liu @grantfirl @Qingfu-Liu @dustinswales +physics/SFC_Layer/MYJ/module_SF_JSFC.F90 @Qingfu-Liu @grantfirl @Qingfu-Liu @dustinswales +physics/SFC_Layer/MYNN/mynnsfc_wrapper.* @joeolson42 @grantfirl @Qingfu-Liu @dustinswales +physics/SFC_Layer/MYNN/module_sf_mynn.F90 @joeolson42 @grantfirl @Qingfu-Liu @dustinswales +physics/SFC_Layer/UFS/date_def.f @XuLi-NOAA @grantfirl @Qingfu-Liu @dustinswales +physics/SFC_Layer/UFS/module_nst* @XuLi-NOAA @grantfirl @Qingfu-Liu @dustinswales +physics/SFC_Layer/UFS/sfc_diag.* @grantfirl @Qingfu-Liu @dustinswales +physics/SFC_Layer/UFS/sfc_diag_post.* @grantfirl @Qingfu-Liu @dustinswales +physics/SFC_Layer/UFS/sfc_diff.* @JongilHan66 @grantfirl @Qingfu-Liu @dustinswales +physics/SFC_Layer/UFS/sfc_nst* @XuLi-NOAA @grantfirl @Qingfu-Liu @dustinswales +physics/SFC_Models/Lake/CLM/clm_lake.* @tanyasmirnova @SamuelTrahanNOAA @grantfirl @Qingfu-Liu @dustinswales +physics/SFC_Models/Lake/Flake/flake* @barlage @grantfirl @Qingfu-Liu @dustinswales +physics/SFC_Models/Land/Noah/lsm_noah.* @HelinWei-NOAA @grantfirl @Qingfu-Liu @dustinswales +physics/SFC_Models/Land/Noah/namelist_soilveg.* @HelinWei-NOAA @barlage @cenlinhe @grantfirl @Qingfu-Liu @dustinswales +physics/SFC_Models/Land/Noah/set_soilveg.* @HelinWei-NOAA @barlage @cenlinhe @grantfirl @Qingfu-Liu @dustinswales +physics/SFC_Models/Land/Noah/sflx.f @HelinWei-NOAA @grantfirl @Qingfu-Liu @dustinswales +physics/SFC_Models/Land/Noah/surface_perturbation.* @HelinWei-NOAA @grantfirl @Qingfu-Liu @dustinswales +physics/SFC_Models/Land/Noahmp/*noahmp* @barlage @cenlinhe @grantfirl @Qingfu-Liu @dustinswales +physics/SFC_Models/Land/RUC/lsm_ruc.* @tanyasmirnova @grantfirl @Qingfu-Liu @dustinswales +physics/SFC_Models/Land/RUC/module_sf_ruclsm.* @tanyasmirnova @grantfirl @Qingfu-Liu @dustinswales +physics/SFC_Models/Land/RUC/module_soil_pre.* @tanyasmirnova @grantfirl @Qingfu-Liu @dustinswales +physics/SFC_Models/Land/RUC/namelist_soilveg_ruc.* @tanyasmirnova @grantfirl @Qingfu-Liu @dustinswales +physics/SFC_Models/Land/RUC/set_soilveg_ruc.* @tanyasmirnova @grantfirl @Qingfu-Liu @dustinswales +physics/SFC_Models/Land/sfc_land.* @grantfirl @Qingfu-Liu @dustinswales +physics/SFC_Models/Ocean/UFS/sfc_ocean.* @HelinWei-NOAA @grantfirl @Qingfu-Liu @dustinswales +physics/SFC_Models/SeaIce/CICE/sfc_cice.* @wd20xw @grantfirl @Qingfu-Liu @dustinswales +physics/SFC_Models/SeaIce/CICE/sfc_sice.* @wd20xw @grantfirl @Qingfu-Liu @dustinswales +physics/hooks/machine.* @grantfirl @Qingfu-Liu @dustinswales +physics/hooks/physcons.F90 @grantfirl @Qingfu-Liu @dustinswales +physics/photochem/h2o_def.* @grantfirl @Qingfu-Liu @dustinswales +physics/photochem/h2ointerp.f90 @grantfirl @Qingfu-Liu @dustinswales +physics/photochem/h2ophys.* @Qingfu-Liu @grantfirl @Qingfu-Liu @dustinswales +physics/photochem/module_ozphys.* @dustinswales @grantfirl @Qingfu-Liu @dustinswales +physics/smoke_dust/* @haiqinli @grantfirl @Qingfu-Liu @dustinswales +physics/tools/funcphys.f90 @grantfirl @Qingfu-Liu @dustinswales +physics/tools/get_phi_fv3.* @grantfirl @Qingfu-Liu @dustinswales +physics/tools/get_prs_fv3.* @grantfirl @Qingfu-Liu @dustinswales +physics/Interstitials/UFS_SCM_NEPTUNE/GFS_cloud_diagnostics.* @dustinswales @Qingfu-Liu @grantfirl @Qingfu-Liu @dustinswales +physics/Interstitials/UFS_SCM_NEPTUNE/GFS_DCNV_generic_post.* @grantfirl @Qingfu-Liu @dustinswales +physics/Interstitials/UFS_SCM_NEPTUNE/GFS_DCNV_generic_pre.* @grantfirl @Qingfu-Liu @dustinswales +physics/Interstitials/UFS_SCM_NEPTUNE/GFS_debug.* @grantfirl @Qingfu-Liu @dustinswales +physics/Interstitials/UFS_SCM_NEPTUNE/GFS_GWD_generic_post.* @grantfirl @Qingfu-Liu @dustinswales +physics/Interstitials/UFS_SCM_NEPTUNE/GFS_GWD_generic_pre.* @grantfirl @Qingfu-Liu @dustinswales +physics/Interstitials/UFS_SCM_NEPTUNE/GFS_MP_generic_post.* @grantfirl @Qingfu-Liu @dustinswales +physics/Interstitials/UFS_SCM_NEPTUNE/GFS_MP_generic_pre.* @grantfirl @Qingfu-Liu @dustinswales +physics/Interstitials/UFS_SCM_NEPTUNE/GFS_PBL_generic_common.F90 @grantfirl @Qingfu-Liu @dustinswales +physics/Interstitials/UFS_SCM_NEPTUNE/GFS_PBL_generic_post.* @grantfirl @Qingfu-Liu @dustinswales +physics/Interstitials/UFS_SCM_NEPTUNE/GFS_PBL_generic_pre.* @grantfirl @Qingfu-Liu @dustinswales +physics/Interstitials/UFS_SCM_NEPTUNE/GFS_phys_time_vary.fv3.* @grantfirl @Qingfu-Liu @dustinswales +physics/Interstitials/UFS_SCM_NEPTUNE/GFS_phys_time_vary.scm.* @grantfirl @Qingfu-Liu @dustinswales +physics/Interstitials/UFS_SCM_NEPTUNE/GFS_physics_post.* @grantfirl @Qingfu-Liu @dustinswales +physics/Interstitials/UFS_SCM_NEPTUNE/GFS_radiation_surface.* @grantfirl @Qingfu-Liu @dustinswales +physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rad_time_vary.fv3.* @grantfirl @Qingfu-Liu @dustinswales +physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rad_time_vary.scm.* @grantfirl @Qingfu-Liu @dustinswales +physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_cloud_mp.* @dustinswales @Qingfu-Liu @grantfirl @Qingfu-Liu @dustinswales +physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_cloud_overlap.* @dustinswales @Qingfu-Liu @grantfirl @Qingfu-Liu @dustinswales +physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmg_post.* @Qingfu-Liu @dustinswales @grantfirl @Qingfu-Liu @dustinswales +physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_pre.* @dustinswales @Qingfu-Liu @grantfirl @Qingfu-Liu @dustinswales +physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmg_pre.* @Qingfu-Liu @dustinswales @grantfirl @Qingfu-Liu @dustinswales +physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_setup.* @dustinswales @Qingfu-Liu @grantfirl @Qingfu-Liu @dustinswales +physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_post.* @dustinswales @Qingfu-Liu @grantfirl @Qingfu-Liu @dustinswales +physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmg_setup.* @Qingfu-Liu @dustinswales @grantfirl @Qingfu-Liu @dustinswales +physics/Interstitials/UFS_SCM_NEPTUNE/GFS_SCNV_generic_post.* @grantfirl @Qingfu-Liu @dustinswales +physics/Interstitials/UFS_SCM_NEPTUNE/GFS_SCNV_generic_pre.* @grantfirl @Qingfu-Liu @dustinswales +physics/Interstitials/UFS_SCM_NEPTUNE/GFS_stochastics.* @pjpegion @lisa-bengtsson @grantfirl @Qingfu-Liu @dustinswales +physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_interstitial_1.* @grantfirl @Qingfu-Liu @dustinswales +physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_interstitial_2.* @grantfirl @Qingfu-Liu @dustinswales +physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_interstitial_3.* @grantfirl @Qingfu-Liu @dustinswales +physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_interstitial_4.* @grantfirl @Qingfu-Liu @dustinswales +physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_interstitial_5.* @grantfirl @Qingfu-Liu @dustinswales +physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_interstitial_phys_reset.* @grantfirl @Qingfu-Liu @dustinswales +physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_interstitial_rad_reset.* @grantfirl @Qingfu-Liu @dustinswales +physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_stateout_reset.* @grantfirl @Qingfu-Liu @dustinswales +physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_stateout_update.* @grantfirl @Qingfu-Liu @dustinswales +physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_composites_inter.* @grantfirl @Qingfu-Liu @dustinswales +physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_composites_post.* @grantfirl @Qingfu-Liu @dustinswales +physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_composites_pre.* @grantfirl @Qingfu-Liu @dustinswales +physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_generic_post.* @grantfirl @Qingfu-Liu @dustinswales +physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_generic_pre.* @grantfirl @Qingfu-Liu @dustinswales +physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_loop_control_part1.* @grantfirl @Qingfu-Liu @dustinswales +physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_loop_control_part2.* @grantfirl @Qingfu-Liu @dustinswales +physics/Interstitials/UFS_SCM_NEPTUNE/GFS_time_vary_pre.fv3.* @grantfirl @Qingfu-Liu @dustinswales +physics/Interstitials/UFS_SCM_NEPTUNE/GFS_time_vary_pre.scm.* @grantfirl @Qingfu-Liu @dustinswales +physics/Interstitials/UFS_SCM_NEPTUNE/cnvc90.* @grantfirl @Qingfu-Liu @dustinswales +physics/Interstitials/UFS_SCM_NEPTUNE/dcyc2t3.* @Qingfu-Liu @dustinswales @grantfirl @Qingfu-Liu @dustinswales +physics/Interstitials/UFS_SCM_NEPTUNE/gcycle.F90 @grantfirl @Qingfu-Liu @dustinswales +physics/Interstitials/UFS_SCM_NEPTUNE/iccn_def.F @grantfirl @Qingfu-Liu @dustinswales +physics/Interstitials/UFS_SCM_NEPTUNE/iccninterp.F90 @grantfirl @Qingfu-Liu @dustinswales +physics/Interstitials/UFS_SCM_NEPTUNE/maximum_hourly_diagnostics.* @grantfirl @Qingfu-Liu @dustinswales +physics/Interstitials/UFS_SCM_NEPTUNE/scm_sfc_flux_spec.* @grantfirl @grantfirl @Qingfu-Liu @dustinswales +physics/Interstitials/UFS_SCM_NEPTUNE/sfcsub.F @grantfirl @Qingfu-Liu @dustinswales +physics/Interstitials/UFS_SCM_NEPTUNE/sgscloud_radpost.* @grantfirl @Qingfu-Liu @dustinswales +physics/Interstitials/UFS_SCM_NEPTUNE/sgscloud_radpre.* @grantfirl @Qingfu-Liu @dustinswales ######################################################################## diff --git a/physics/cu_c3_deep.F90 b/physics/CONV/C3/cu_c3_deep.F90 similarity index 94% rename from physics/cu_c3_deep.F90 rename to physics/CONV/C3/cu_c3_deep.F90 index c3a4b2c4e..9bcbe5910 100644 --- a/physics/cu_c3_deep.F90 +++ b/physics/CONV/C3/cu_c3_deep.F90 @@ -97,6 +97,9 @@ subroutine cu_c3_deep_run( & ,tmf & ! instantanious tendency from turbulence ,qmicro & ! instantanious tendency from microphysics ,forceqv_spechum & !instantanious tendency from dynamics + ,betascu & ! Tuning parameter for shallow clouds + ,betamcu & ! Tuning parameter for mid-level clouds + ,betadcu & ! Tuning parameter for deep clouds ,sigmain & ! input area fraction after advection ,sigmaout & ! updated prognostic area fraction ,z1 & ! terrain @@ -159,12 +162,12 @@ subroutine cu_c3_deep_run( & nranflag,itf,ktf,its,ite, kts,kte,ipr,imid integer, intent (in ) :: & ichoice - real(kind=kind_phys), dimension (its:ite,4) & + real(kind=kind_phys), dimension (its:,:) & ,intent (in ) :: rand_clos - real(kind=kind_phys), dimension (its:ite) & + real(kind=kind_phys), dimension (its:) & ,intent (in ) :: rand_mom,rand_vmas !$acc declare copyin(rand_clos,rand_mom,rand_vmas) - real(kind=kind_phys), intent(in), dimension (its:ite) :: ca_deep(:) + real(kind=kind_phys), intent(in), dimension (its:), optional :: ca_deep(:) integer, intent(in) :: do_capsuppress real(kind=kind_phys), intent(in), dimension(:) :: cap_suppress_j !$acc declare create(cap_suppress_j) @@ -177,28 +180,31 @@ subroutine cu_c3_deep_run( & ! outq = output q tendency (per s) ! outqc = output qc tendency (per s) ! pre = output precip - real(kind=kind_phys), dimension (its:ite,kts:kte) & + real(kind=kind_phys), dimension (its:,kts:) & ,intent (inout ) :: & cnvwt,outu,outv,outt,outq,outqc,cupclw - real(kind=kind_phys), dimension (its:ite) & + real(kind=kind_phys), dimension (its:) & ,intent (out ) :: & frh_out,rainevap - real(kind=kind_phys), dimension (its:ite,kts:kte) & + real(kind=kind_phys), dimension (its:,kts:) & ,intent (in ) :: & - tmf, qmicro, sigmain, forceqv_spechum - real(kind=kind_phys), dimension (its:ite) & + tmf + real(kind=kind_phys), dimension (its:,kts:) & + ,intent (in ), optional :: & + qmicro, sigmain, forceqv_spechum + real(kind=kind_phys), dimension (its:) & ,intent (inout ) :: & pre,xmb_out !$acc declare copy(cnvwt,outu,outv,outt,outq,outqc,cupclw,frh_out,pre,xmb_out) - real(kind=kind_phys), dimension (its:ite) & + real(kind=kind_phys), dimension (its:) & ,intent (in ) :: & hfx,qfx,xmbm_in,xmbs_in !$acc declare copyin(hfx,qfx,xmbm_in,xmbs_in) - integer, dimension (its:ite) & + integer, dimension (its:) & ,intent (inout ) :: & kbcon,ktop !$acc declare copy(kbcon,ktop) - integer, dimension (its:ite) & + integer, dimension (its:) & ,intent (in ) :: & kpbl,tropics !$acc declare copyin(kpbl,tropics) @@ -207,34 +213,34 @@ subroutine cu_c3_deep_run( & ! omega (omeg), windspeed (us,vs), and a flag (ierr) to turn off ! convection for this call only and at that particular gridpoint ! - real(kind=kind_phys), dimension (its:ite,kts:kte) & + real(kind=kind_phys), dimension (its:,kts:) & ,intent (in ) :: & dhdt,rho,t,po,us,vs,tn,delp !$acc declare copyin(dhdt,rho,t,po,us,vs,tn) - real(kind=kind_phys), dimension (its:ite,kts:kte) & + real(kind=kind_phys), dimension (its:,kts:) & ,intent (inout ) :: & omeg !$acc declare copy(omeg) - real(kind=kind_phys), dimension (its:ite,kts:kte) & + real(kind=kind_phys), dimension (its:,kts:) & ,intent (inout) :: & q,qo,zuo,zdo,zdm !$acc declare sigmaout - real(kind=kind_phys), dimension (its:ite,kts:kte) & - ,intent (out) :: & + real(kind=kind_phys), dimension (its:,kts:) & + ,intent (out), optional :: & sigmaout - real(kind=kind_phys), dimension (its:ite) & + real(kind=kind_phys), dimension (its:) & ,intent (in ) :: & dx,z1,psur,xland !$acc declare copyin(dx,z1,psur,xland) - real(kind=kind_phys), dimension (its:ite) & + real(kind=kind_phys), dimension (its:) & ,intent (inout ) :: & mconv,ccn !$acc declare copy(mconv,ccn) real(kind=kind_phys) & - ,intent (in ) :: & - dtime,ccnclean,fv,r_d + ,intent (in ) :: & + dtime,ccnclean,fv,r_d,betascu,betamcu,betadcu ! @@ -372,8 +378,8 @@ subroutine cu_c3_deep_run( & !$acc kzdown,kdet,k22,jmin,kstabi,kstabm,k22x,xland1, & !$acc ktopdby,kbconx,ierr2,ierr3,kbmax) - integer, dimension (its:ite), intent(inout) :: ierr - integer, dimension (its:ite), intent(in) :: csum + integer, dimension (its:), intent(inout) :: ierr + integer, dimension (its:), intent(in), optional :: csum logical, intent(in) :: do_ca, progsigma logical, intent(in) :: flag_init, flag_restart !$acc declare copy(ierr) copyin(csum) @@ -386,13 +392,16 @@ subroutine cu_c3_deep_run( & real(kind=kind_phys), dimension (its:ite) :: pefc real(kind=kind_phys) entdo,dp,subin,detdo,entup, & detup,subdown,entdoj,entupk,detupk,totmas + real(kind=kind_phys) :: & + sigmind,sigminm,sigmins + parameter(sigmind=0.005,sigmins=0.03,sigminm=0.01) real(kind=kind_phys), dimension (its:ite) :: lambau,flux_tun,zws,ztexec,zqexec !$acc declare create(lambau,flux_tun,zws,ztexec,zqexec) integer :: jprnt,jmini,start_k22 logical :: keep_going,flg(its:ite),cnvflg(its:ite) - logical :: flag_shallow + logical :: flag_shallow,flag_mid !$acc declare create(flg) @@ -421,7 +430,7 @@ subroutine cu_c3_deep_run( & !$acc tn_bl, qo_bl, qeso_bl, heo_bl, heso_bl, & !$acc qeso_cup_bl,qo_cup_bl, heo_cup_bl,heso_cup_bl, & !$acc gammao_cup_bl,tn_cup_bl,hco_bl,dbyo_bl,xf_dicycle) - real(kind=kind_phys), intent(inout), dimension(its:ite,10) :: forcing + real(kind=kind_phys), intent(inout), dimension(its:,:) :: forcing !$acc declare copy(forcing) integer :: turn,pmin_lev(its:ite),start_level(its:ite),ktopkeep(its:ite) real(kind=kind_phys), dimension (its:ite,kts:kte) :: dtempdz @@ -1988,7 +1997,11 @@ subroutine cu_c3_deep_run( & ! equation 8, call progsigma_calc() to compute updraft area fraction based on a moisture budget if(progsigma)then + flag_mid = .false. flag_shallow = .false. + if(imid.eq.1)then + flag_mid = .true. + endif do k=kts,ktf do i=its,itf del(i,k) = delp(i,k)*0.001 @@ -2003,9 +2016,9 @@ subroutine cu_c3_deep_run( & endif enddo call progsigma_calc(itf,ktf,flag_init,flag_restart,flag_shallow, & - del,tmf,qmicro,dbyo1,zdqca,omega_u,zeta,xlv,dtime, & - forceqv_spechum,kbcon,ktop,cnvflg, & - sigmain,sigmaout,sigmab) + flag_mid,del,tmf,qmicro,dbyo1,zdqca,omega_u,zeta,xlv,dtime, & + forceqv_spechum,kbcon,ktop,cnvflg,betascu,betamcu,betadcu, & + sigmind,sigminm,sigmins,sigmain,sigmaout,sigmab) endif !$acc end kernels @@ -2078,10 +2091,6 @@ subroutine cu_c3_deep_run( & !> - Call rain_evap_below_cloudbase() to calculate evaporation 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 !$acc kernels do i=its,itf @@ -2137,7 +2146,7 @@ subroutine cu_c3_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.400.)then + if(k.gt.jmin(i))then if(flg(i))then q1=qo(i,k)+(outq(i,k))*dtime t1=tn(i,k)+(outt(i,k))*dtime @@ -2162,7 +2171,7 @@ subroutine cu_c3_deep_run( & pre(i)=max(pre(i),0.) delqev(i) = delqev(i) + .001*dp*qevap(i)/g endif - !endif ! 400mb + endif endif enddo ! pre(i)=1000.*rn(i)/dtime @@ -2418,16 +2427,16 @@ subroutine rain_evap_below_cloudbase(itf,ktf, its,ite, kts,kte,ierr, & 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 + integer, dimension(its:) ,intent(in) :: ierr,kbcon + real(kind=kind_phys), dimension(its:) ,intent(in) ::psur,xland,pwavo,edto,pwevo,xmb + real(kind=kind_phys), dimension(its:,kts:),intent(in) :: po_cup,qo_cup,qes_cup + real(kind=kind_phys), dimension(its:) ,intent(inout) :: pre + real(kind=kind_phys), dimension(its:,kts:),intent(inout) :: outt,outq !,outbuoy !$acc declare copyin(ierr,kbcon,psur,xland,pwavo,edto,pwevo,xmb,po_cup,qo_cup,qes_cup) !$acc declare copy(pre,outt,outq) - !real, dimension(its:ite) ,intent(out) :: tot_evap_bcb - !real, dimension(its:ite,kts:kte),intent(out) :: evap_bcb,net_prec_bcb + !real, dimension(its:) ,intent(out) :: tot_evap_bcb + !real, dimension(its:,kts:),intent(out) :: evap_bcb,net_prec_bcb !-- locals integer :: i,k @@ -2511,30 +2520,30 @@ subroutine cup_dd_edt(ierr,us,vs,z,ktop,kbcon,edt,p,pwav, & ! ! ierr error value, maybe modified in this routine ! - real(kind=kind_phys), dimension (its:ite,kts:kte) & + real(kind=kind_phys), dimension (its:,kts:) & ,intent (in ) :: & rho,us,vs,z,p,pw - real(kind=kind_phys), dimension (its:ite,1) & + real(kind=kind_phys), dimension (its:,: ) & ,intent (out ) :: & edtc - real(kind=kind_phys), dimension (its:ite) & + real(kind=kind_phys), dimension (its:) & ,intent (out ) :: & pefc - real(kind=kind_phys), dimension (its:ite) & + real(kind=kind_phys), dimension (its:) & ,intent (out ) :: & edt - real(kind=kind_phys), dimension (its:ite) & + real(kind=kind_phys), dimension (its:) & ,intent (in ) :: & pwav,pwev,psum2,psumh,edtmax,edtmin - integer, dimension (its:ite) & + integer, dimension (its:) & ,intent (in ) :: & ktop,kbcon,xland1 real(kind=kind_phys), intent (in ) :: & !HCB ccnclean - real(kind=kind_phys), dimension (its:ite) & + real(kind=kind_phys), dimension (its:) & ,intent (inout ) :: & ccn - integer, dimension (its:ite) & + integer, dimension (its:) & ,intent (inout) :: & ierr !$acc declare copyin(rho,us,vs,z,p,pw,pwav,pwev,psum2,psumh,edtmax,edtmin,ktop,kbcon) @@ -2671,7 +2680,7 @@ subroutine cup_dd_moisture(ierrc,zd,hcd,hes_cup,qcd,qes_cup, & ! pwev = total normalized integrated evaoprate (i2) ! entr= entrainment rate ! - real(kind=kind_phys), dimension (its:ite,kts:kte) & + real(kind=kind_phys), dimension (its:,kts:) & ,intent (in ) :: & zd,hes_cup,hcd,qes_cup,q_cup,z_cup, & dd_massentr,dd_massdetr,gamma_cup,q,he,p_cup @@ -2679,18 +2688,18 @@ subroutine cup_dd_moisture(ierrc,zd,hcd,hes_cup,qcd,qes_cup, & integer & ,intent (in ) :: & iloop - integer, dimension (its:ite) & + integer, dimension (its:) & ,intent (in ) :: & jmin !$acc declare copyin(jmin) - integer, dimension (its:ite) & + integer, dimension (its:) & ,intent (inout) :: & ierr !$acc declare copy(ierr) - real(kind=kind_phys), dimension (its:ite,kts:kte)& + real(kind=kind_phys), dimension (its:,kts:)& ,intent (out ) :: & qcd,qrcd,pwd - real(kind=kind_phys), dimension (its:ite)& + real(kind=kind_phys), dimension (its:)& ,intent (out ) :: & pwev,bu !$acc declare copyout(qcd,qrcd,pwd,pwev,bu) @@ -2812,23 +2821,23 @@ subroutine cup_env(z,qes,he,hes,t,q,p,z1, & its,ite, kts,kte ! ! - real(kind=kind_phys), dimension (its:ite,kts:kte) & + real(kind=kind_phys), dimension (its:,kts:) & ,intent (in ) :: & p,t,q !$acc declare copyin(p,t,q) - real(kind=kind_phys), dimension (its:ite,kts:kte) & + real(kind=kind_phys), dimension (its:,kts:) & ,intent (out ) :: & hes,qes !$acc declare copyout(hes,qes) - real(kind=kind_phys), dimension (its:ite,kts:kte) & + real(kind=kind_phys), dimension (its:,kts:) & ,intent (inout) :: & he,z !$acc declare copy(he,z) - real(kind=kind_phys), dimension (its:ite) & + real(kind=kind_phys), dimension (its:) & ,intent (in ) :: & psur,z1 !$acc declare copyin(psur,z1) - integer, dimension (its:ite) & + integer, dimension (its:) & ,intent (inout) :: & ierr !$acc declare copy(ierr) @@ -2966,19 +2975,19 @@ subroutine cup_env_clev(t,qes,q,he,hes,z,p,qes_cup,q_cup, & itf,ktf, & its,ite, kts,kte ! - real(kind=kind_phys), dimension (its:ite,kts:kte) & + real(kind=kind_phys), dimension (its:,kts:) & ,intent (in ) :: & qes,q,he,hes,z,p,t !$acc declare copyin(qes,q,he,hes,z,p,t) - real(kind=kind_phys), dimension (its:ite,kts:kte) & + real(kind=kind_phys), dimension (its:,kts:) & ,intent (out ) :: & qes_cup,q_cup,he_cup,hes_cup,z_cup,p_cup,gamma_cup,t_cup !$acc declare copyout(qes_cup,q_cup,he_cup,hes_cup,z_cup,p_cup,gamma_cup,t_cup) - real(kind=kind_phys), dimension (its:ite) & + real(kind=kind_phys), dimension (its:) & ,intent (in ) :: & psur,z1 !$acc declare copyin(psur,z1) - integer, dimension (its:ite) & + integer, dimension (its:) & ,intent (inout) :: & ierr !$acc declare copy(ierr) @@ -3077,33 +3086,33 @@ subroutine cup_forcing_ens_3d(closure_n,xland,aa0,aa1,xaa0,mbdt,dtime,ierr,ierr2 ! k22 = updraft originating level ! ichoice = flag if only want one closure (usually set to zero!) ! - real(kind=kind_phys), dimension (its:ite,1:maxens3) & + real(kind=kind_phys), dimension (its:,1:) & ,intent (inout) :: & pr_ens - real(kind=kind_phys), dimension (its:ite,1:maxens3) & + real(kind=kind_phys), dimension (its:,1:) & ,intent (inout ) :: & xf_ens !$acc declare copy(pr_ens,xf_ens) - real(kind=kind_phys), dimension (its:ite,kts:kte) & + real(kind=kind_phys), dimension (its:,kts:) & ,intent (in ) :: & zd,zu,p_cup,zdm - real(kind=kind_phys), dimension (its:ite,kts:kte) & + real(kind=kind_phys), dimension (its:,kts:) & ,intent (in ) :: & omeg - real(kind=kind_phys), dimension (its:ite,1) & + real(kind=kind_phys), dimension (its:,:) & ,intent (in ) :: & xaa0 - real(kind=kind_phys), dimension (its:ite,4) & + real(kind=kind_phys), dimension (its:,:) & ,intent (in ) :: & rand_clos - real(kind=kind_phys), dimension (its:ite) & + real(kind=kind_phys), dimension (its:) & ,intent (in ) :: & aa1,edt,edtm,omegac,sigmab - real(kind=kind_phys), dimension (its:ite) & + real(kind=kind_phys), dimension (its:) & ,intent (in ) :: & mconv,axx !$acc declare copyin(zd,zu,p_cup,zdm,omeg,xaa0,rand_clos,aa1,edt,edtm,mconv,axx) - real(kind=kind_phys), dimension (its:ite) & + real(kind=kind_phys), dimension (its:) & ,intent (inout) :: & aa0,closure_n !$acc declare copy(aa0,closure_n) @@ -3113,13 +3122,13 @@ subroutine cup_forcing_ens_3d(closure_n,xland,aa0,aa1,xaa0,mbdt,dtime,ierr,ierr2 real(kind=kind_phys) & ,intent (in ) :: & dtime - integer, dimension (its:ite) & + integer, dimension (its:) & ,intent (inout ) :: & k22,kbcon,ktop - integer, dimension (its:ite) & + integer, dimension (its:) & ,intent (in ) :: & xland - integer, dimension (its:ite) & + integer, dimension (its:) & ,intent (inout) :: & ierr,ierr2,ierr3 !$acc declare copy(k22,kbcon,ktop,ierr,ierr2,ierr3) copyin(xland) @@ -3129,10 +3138,10 @@ subroutine cup_forcing_ens_3d(closure_n,xland,aa0,aa1,xaa0,mbdt,dtime,ierr,ierr2 integer, intent(in) :: dicycle logical, intent (in) :: progsigma - real(kind=kind_phys), intent(in) , dimension (its:ite) :: aa1_bl,tau_ecmwf - real(kind=kind_phys), intent(inout), dimension (its:ite) :: xf_dicycle - real(kind=kind_phys), intent(out), dimension (its:ite) :: xf_progsigma - real(kind=kind_phys), intent(inout), dimension (its:ite,10) :: forcing + real(kind=kind_phys), intent(in) , dimension (its:) :: aa1_bl,tau_ecmwf + real(kind=kind_phys), intent(inout), dimension (its:) :: xf_dicycle + real(kind=kind_phys), intent(out), dimension (its:) :: xf_progsigma + real(kind=kind_phys), intent(inout), dimension (its:,:) :: forcing !$acc declare copyin(aa1_bl,tau_ecmwf) copy(xf_dicycle,forcing) !- local var real(kind=kind_phys) :: xff_dicycle @@ -3151,7 +3160,7 @@ subroutine cup_forcing_ens_3d(closure_n,xland,aa0,aa1,xaa0,mbdt,dtime,ierr,ierr2 ! pcrit,acrit,acritt integer, dimension (its:ite) :: kloc real(kind=kind_phys) :: & - a1,a_ave,xff0,xomg,gravinv!,aclim1,aclim2,aclim3,aclim4 + a1,a_ave,xff0,xomg,gravinv real(kind=kind_phys), dimension (its:ite) :: ens_adj !$acc declare create(kloc,ens_adj) @@ -3487,31 +3496,31 @@ subroutine cup_kbcon(ierrc,cap_inc,iloop_in,k22,kbcon,he_cup,hes_cup, & ! ! ierr error value, maybe modified in this routine ! - real(kind=kind_phys), dimension (its:ite,kts:kte) & + real(kind=kind_phys), dimension (its:,kts:) & ,intent (in ) :: & he_cup,hes_cup,p_cup !$acc declare copyin(he_cup,hes_cup,p_cup) - real(kind=kind_phys), dimension (its:ite) & + real(kind=kind_phys), dimension (its:) & ,intent (in ) :: & entr_rate,ztexec,zqexec,cap_inc,cap_max !$acc declare copyin(entr_rate,ztexec,zqexec,cap_inc,cap_max) - real(kind=kind_phys), dimension (its:ite) & + real(kind=kind_phys), dimension (its:) & ,intent (inout ) :: & hkb !,cap_max !$acc declare copy(hkb) - integer, dimension (its:ite) & + integer, dimension (its:) & ,intent (in ) :: & kbmax !$acc declare copyin(kbmax) - integer, dimension (its:ite) & + integer, dimension (its:) & ,intent (inout) :: & kbcon,k22,ierr !$acc declare copy(kbcon,k22,ierr) integer & ,intent (in ) :: & iloop_in - character*50 :: ierrc(its:ite) - real(kind=kind_phys), dimension (its:ite,kts:kte),intent (in) :: z_cup,heo + character*50 :: ierrc(its:) + real(kind=kind_phys), dimension (its:,kts:),intent (in) :: z_cup,heo !$acc declare copyin(z_cup,heo) integer, dimension (its:ite) :: iloop,start_level !$acc declare create(iloop,start_level) @@ -3645,18 +3654,18 @@ subroutine cup_maximi(array,ks,ke,maxx,ierr, & ! x output array with return values ! kt output array of levels ! ks,kend check-range - real(kind=kind_phys), dimension (its:ite,kts:kte) & + real(kind=kind_phys), dimension (its:,kts:) & ,intent (in ) :: & array !$acc declare copyin(array) - integer, dimension (its:ite) & + integer, dimension (its:) & ,intent (in ) :: & ierr,ke !$acc declare copyin(ierr,ke) integer & ,intent (in ) :: & ks - integer, dimension (its:ite) & + integer, dimension (its:) & ,intent (out ) :: & maxx !$acc declare copyout(maxx) @@ -3708,15 +3717,15 @@ subroutine cup_minimi(array,ks,kend,kt,ierr, & ! x output array with return values ! kt output array of levels ! ks,kend check-range - real(kind=kind_phys), dimension (its:ite,kts:kte) & + real(kind=kind_phys), dimension (its:,kts:) & ,intent (in ) :: & array !$acc declare copyin(array) - integer, dimension (its:ite) & + integer, dimension (its:) & ,intent (in ) :: & ierr,ks,kend !$acc declare copyin(ierr,ks,kend) - integer, dimension (its:ite) & + integer, dimension (its:) & ,intent (out ) :: & kt !$acc declare copyout(kt) @@ -3771,10 +3780,10 @@ subroutine cup_up_aa0(aa0,z,zu,dby,gamma_cup,t_cup, & ! z = heights of model levels ! ierr error value, maybe modified in this routine ! - real(kind=kind_phys), dimension (its:ite,kts:kte) & + real(kind=kind_phys), dimension (its:,kts:) & ,intent (in ) :: & z,zu,gamma_cup,t_cup,dby - integer, dimension (its:ite) & + integer, dimension (its:) & ,intent (in ) :: & kbcon,ktop !$acc declare copyin(z,zu,gamma_cup,t_cup,dby,kbcon,ktop) @@ -3783,11 +3792,11 @@ subroutine cup_up_aa0(aa0,z,zu,dby,gamma_cup,t_cup, & ! - integer, dimension (its:ite) & + integer, dimension (its:) & ,intent (inout) :: & ierr !$acc declare copy(ierr) - real(kind=kind_phys), dimension (its:ite) & + real(kind=kind_phys), dimension (its:) & ,intent (out ) :: & aa0 !$acc declare copyout(aa0) @@ -3830,15 +3839,15 @@ subroutine neg_check(name,j,dt,q,outq,outt,outu,outv, & outqc,pret,its,ite,kts,kte,itf,ktf,ktop) integer, intent(in ) :: j,its,ite,kts,kte,itf,ktf - integer, dimension (its:ite ), intent(in ) :: ktop + integer, dimension (its: ), intent(in ) :: ktop - real(kind=kind_phys), dimension (its:ite,kts:kte ) , & + real(kind=kind_phys), dimension (its:,kts: ) , & intent(inout ) :: & outq,outt,outqc,outu,outv - real(kind=kind_phys), dimension (its:ite,kts:kte ) , & + real(kind=kind_phys), dimension (its:,kts: ) , & intent(inout ) :: & q - real(kind=kind_phys), dimension (its:ite ) , & + real(kind=kind_phys), dimension (its: ) , & intent(inout ) :: & pret !$acc declare copy(outq,outt,outqc,outu,outv,q,pret) @@ -3979,38 +3988,38 @@ subroutine cup_output_ens_3d(xff_mid,xf_ens,ierr,dellat,dellaq,dellaqc, & ! pw = pw -epsilon*pd (ensemble dependent) ! ierr error value, maybe modified in this routine ! - real(kind=kind_phys), dimension (its:ite,1:maxens3) & + real(kind=kind_phys), dimension (its:,:) & ,intent (inout) :: & xf_ens,pr_ens - real(kind=kind_phys), dimension (its:ite,kts:kte) & + real(kind=kind_phys), dimension (its:,kts:) & ,intent (inout ) :: & outtem,outq,outqc - real(kind=kind_phys), dimension (its:ite,kts:kte) & + real(kind=kind_phys), dimension (its:,kts:) & ,intent (in ) :: & zu,pwd,p_cup - real(kind=kind_phys), dimension (its:ite) & + real(kind=kind_phys), dimension (its:) & ,intent (in ) :: & sig,xmbm_in,xmbs_in,edt,sigmab,dx - real(kind=kind_phys), dimension (its:ite,2) & + real(kind=kind_phys), dimension (its:,:) & ,intent (in ) :: & xff_mid - real(kind=kind_phys), dimension (its:ite) & + real(kind=kind_phys), dimension (its:) & ,intent (inout ) :: & pre,xmb - real(kind=kind_phys), dimension (its:ite) & + real(kind=kind_phys), dimension (its:) & ,intent (inout ) :: & closure_n - real(kind=kind_phys), dimension (its:ite,kts:kte,1) & + real(kind=kind_phys), dimension (its:,kts:,:) & ,intent (in ) :: & dellat,dellaqc,dellaq,pw - integer, dimension (its:ite) & + integer, dimension (its:) & ,intent (in ) :: & ktop,xland1 - integer, dimension (its:ite) & + integer, dimension (its:) & ,intent (inout) :: & ierr,ierr2,ierr3 integer, intent(in) :: dicycle - real(kind=kind_phys), intent(in), dimension (its:ite) :: xf_dicycle, xf_progsigma + real(kind=kind_phys), intent(in), dimension (its:) :: xf_dicycle, xf_progsigma !$acc declare copyin(zu,pwd,p_cup,sig,xmbm_in,xmbs_in,edt,xff_mid,dellat,dellaqc,dellaq,pw,ktop,xland1,xf_dicycle) !$acc declare copy(xf_ens,pr_ens,outtem,outq,outqc,pre,xmb,closure_n,ierr,ierr2,ierr3) ! @@ -4248,15 +4257,15 @@ subroutine cup_up_moisture(name,ierr,z_cup,qc,qrc,pw,pwav, & ! zu = normalized updraft mass flux ! gamma_cup = gamma on model cloud levels ! - real(kind=kind_phys), dimension (its:ite,kts:kte) & + real(kind=kind_phys), dimension (its:,kts:) & ,intent (in ) :: & p_cup,rho,q,zu,gamma_cup,qe_cup, & up_massentr,up_massdetr,dby,qes_cup,z_cup - real(kind=kind_phys), dimension (its:ite) & + real(kind=kind_phys), dimension (its:) & ,intent (in ) :: & zqexec,c0 ! entr= entrainment rate - integer, dimension (its:ite) & + integer, dimension (its:) & ,intent (in ) :: & kbcon,ktop,k22,xland1 !$acc declare copyin(p_cup,rho,q,zu,gamma_cup,qe_cup,up_massentr,up_massdetr,dby,qes_cup,z_cup,zqexec,c0,kbcon,ktop,k22,xland1) @@ -4268,7 +4277,7 @@ subroutine cup_up_moisture(name,ierr,z_cup,qc,qrc,pw,pwav, & ! ierr error value, maybe modified in this routine - integer, dimension (its:ite) & + integer, dimension (its:) & ,intent (inout) :: & ierr !$acc declare copy(ierr) @@ -4281,11 +4290,11 @@ subroutine cup_up_moisture(name,ierr,z_cup,qc,qrc,pw,pwav, & ! pwav = totan normalized integrated condensate (i1) ! c0 = conversion rate (cloud to rain) - real(kind=kind_phys), dimension (its:ite,kts:kte) & + real(kind=kind_phys), dimension (its:,kts:) & ,intent (out ) :: & qc,qrc,pw,clw_all !$acc declare copy(qc,qrc,pw,clw_all) - real(kind=kind_phys), dimension (its:ite,kts:kte) & + real(kind=kind_phys), dimension (its:,kts:) & ,intent (inout) :: & c1d !$acc declare copy(c1d) @@ -4295,11 +4304,11 @@ subroutine cup_up_moisture(name,ierr,z_cup,qc,qrc,pw,pwav, & real(kind=kind_phys), dimension (its:ite) :: & pwavh !$acc declare create(pwavh) - real(kind=kind_phys), dimension (its:ite) & + real(kind=kind_phys), dimension (its:) & ,intent (out ) :: & pwav,psum,psumh !$acc declare copyout(pwav,psum,psumh) - real(kind=kind_phys), dimension (its:ite) & + real(kind=kind_phys), dimension (its:) & ,intent (in ) :: & ccn !$acc declare copyin(ccn) @@ -4329,7 +4338,7 @@ subroutine cup_up_moisture(name,ierr,z_cup,qc,qrc,pw,pwav, & is_deep = (name == 'deep') !$acc kernels - prop_b(kts:kte)=0 + prop_b(kts:)=0 !$acc end kernels iall=0 clwdet=0.1 !0.02 @@ -4429,7 +4438,7 @@ subroutine cup_up_moisture(name,ierr,z_cup,qc,qrc,pw,pwav, & ! !now do the rest ! - kklev(i)=maxloc(zu(i,:),1) + kklev(i)=maxloc(zu(i,2:ktop(i)),1) !$acc loop seq do k=kbcon(i)+1,ktop(i) if(t(i,k) > 273.16) then @@ -4489,6 +4498,8 @@ subroutine cup_up_moisture(name,ierr,z_cup,qc,qrc,pw,pwav, & endif if(k.gt.kbcon(i)+1)c1d(i,k)=clwdet*up_massdetr(i,k-1) if(k.gt.kbcon(i)+1)c1d_b(i,k)=clwdet*up_massdetr(i,k-1) + c1d(i,k)=0.005 + c1d_b(i,k)=0.005 if(autoconv.eq.2) then ! @@ -4646,11 +4657,11 @@ subroutine rates_up_pdf(rand_vmas,ipr,name,ktop,ierr,p_cup,entr_rate_2d,hkbo,heo implicit none character *(*), intent (in) :: name integer, intent(in) :: ipr,its,ite,itf,kts,kte,ktf - real(kind=kind_phys), dimension (its:ite,kts:kte),intent (inout) :: entr_rate_2d,zuo - real(kind=kind_phys), dimension (its:ite,kts:kte),intent (in) ::p_cup, heo,heso_cup,z_cup - real(kind=kind_phys), dimension (its:ite),intent (in) :: hkbo,rand_vmas - integer, dimension (its:ite),intent (in) :: kstabi,k22,kpbl,csum,xland,pmin_lev - integer, dimension (its:ite),intent (inout) :: kbcon,ierr,ktop,ktopdby + real(kind=kind_phys), dimension (its:,kts:),intent (inout) :: entr_rate_2d,zuo + real(kind=kind_phys), dimension (its:,kts:),intent (in) ::p_cup, heo,heso_cup,z_cup + real(kind=kind_phys), dimension (its:),intent (in) :: hkbo,rand_vmas + integer, dimension (its:),intent (in) :: kstabi,k22,kpbl,csum,xland,pmin_lev + integer, dimension (its:),intent (inout) :: kbcon,ierr,ktop,ktopdby !$acc declare copy(entr_rate_2d,zuo,kbcon,ierr,ktop,ktopdby) & !$acc copyin(p_cup, heo,heso_cup,z_cup,hkbo,rand_vmas,kstabi,k22,kpbl,csum,xland,pmin_lev) @@ -4737,7 +4748,7 @@ subroutine rates_up_pdf(rand_vmas,ipr,name,ktop,ierr,p_cup,entr_rate_2d,hkbo,heo ktop(i)= 0 else call get_zu_zd_pdf_fim(kklev,p_cup(i,:),rand_vmas(i),zubeg,ipr,xland(i),zuh2,1,ierr(i),k22(i), & - kfinalzu+1,zuo(i,kts:kte),kts,kte,ktf,beta_u,kbcon(i),csum(i),pmin_lev(i)) + kfinalzu+1,zuo(i,kts:),kts,kte,ktf,beta_u,kbcon(i),csum(i),pmin_lev(i)) endif endif ! end deep if ( is_mid ) then @@ -4748,7 +4759,7 @@ subroutine rates_up_pdf(rand_vmas,ipr,name,ktop,ierr,p_cup,entr_rate_2d,hkbo,heo kfinalzu=ktop(i) ktopdby(i)=ktop(i)+1 call get_zu_zd_pdf_fim(kklev,p_cup(i,:),rand_vmas(i),zubeg,ipr,xland(i),zuh2,3, & - ierr(i),k22(i),ktopdby(i)+1,zuo(i,kts:kte),kts,kte,ktf,beta_u,kbcon(i),csum(i),pmin_lev(i)) + ierr(i),k22(i),ktopdby(i)+1,zuo(i,kts:),kts,kte,ktf,beta_u,kbcon(i),csum(i),pmin_lev(i)) endif endif ! mid if ( is_shallow ) then @@ -4759,7 +4770,7 @@ subroutine rates_up_pdf(rand_vmas,ipr,name,ktop,ierr,p_cup,entr_rate_2d,hkbo,heo kfinalzu=ktop(i) ktopdby(i)=ktop(i)+1 call get_zu_zd_pdf_fim(kbcon(i),p_cup(i,:),rand_vmas(i),zubeg,ipr,xland(i),zuh2,2,ierr(i),k22(i), & - ktopdby(i)+1,zuo(i,kts:kte),kts,kte,ktf,beta_u,kbcon(i),csum(i),pmin_lev(i)) + ktopdby(i)+1,zuo(i,kts:),kts,kte,ktf,beta_u,kbcon(i),csum(i),pmin_lev(i)) endif endif ! shal @@ -4782,8 +4793,8 @@ subroutine get_zu_zd_pdf_fim(kklev,p,rand_vmas,zubeg,ipr,xland,zuh2,draft,ierr,k real(kind=kind_phys), parameter :: beta_dd=4.0,g_beta_dd=6. integer, intent(in) ::ipr,xland,kb,kklev,kt,kts,kte,ktf,kpbli,csum,pmin_lev real(kind=kind_phys), intent(in) ::max_mass,zubeg - real(kind=kind_phys), intent(inout) :: zu(kts:kte) - real(kind=kind_phys), intent(in) :: p(kts:kte) + real(kind=kind_phys), intent(inout) :: zu(kts:) + real(kind=kind_phys), intent(in) :: p(kts:) real(kind=kind_phys) :: trash,beta_deep,zuh(kts:kte),zuh2(1:40) integer, intent(inout) :: ierr integer, intent(in) ::draft @@ -5057,20 +5068,20 @@ subroutine cup_up_aa1bl(aa0,t,tn,q,qo,dtime, & ! z = heights of model levels ! ierr error value, maybe modified in this routine ! - real(kind=kind_phys), dimension (its:ite,kts:kte) & + real(kind=kind_phys), dimension (its:,kts:) & ,intent (in ) :: & z_cup,zu,gamma_cup,t_cup,dby,t,tn,q,qo - integer, dimension (its:ite) & + integer, dimension (its:) & ,intent (in ) :: & kbcon,ktop real(kind=kind_phys), intent(in) :: dtime ! ! input and output ! - integer, dimension (its:ite) & + integer, dimension (its:) & ,intent (inout) :: & ierr - real(kind=kind_phys), dimension (its:ite) & + real(kind=kind_phys), dimension (its:) & ,intent (out ) :: & aa0 ! @@ -5107,14 +5118,14 @@ subroutine get_inversion_layers(ierr,p_cup,t_cup,z_cup,qo_cup,qeso_cup,k_inv_lay implicit none integer ,intent (in ) :: itf,ktf,its,ite,kts,kte - integer, dimension (its:ite) ,intent (in ) :: ierr,kstart,kend + integer, dimension (its:) ,intent (in ) :: ierr,kstart,kend !$acc declare copyin(ierr,kstart,kend) integer, dimension (its:ite) :: kend_p3 !$acc declare create(kend_p3) - real(kind=kind_phys), dimension (its:ite,kts:kte), intent (in ) :: p_cup,t_cup,z_cup,qo_cup,qeso_cup - real(kind=kind_phys), dimension (its:ite,kts:kte), intent (out) :: dtempdz - integer, dimension (its:ite,kts:kte), intent (out) :: k_inv_layers + real(kind=kind_phys), dimension (its:,kts:), intent (in ) :: p_cup,t_cup,z_cup,qo_cup,qeso_cup + real(kind=kind_phys), dimension (its:,kts:), intent (out) :: dtempdz + integer, dimension (its:,kts:), intent (out) :: k_inv_layers !$acc declare copyin(p_cup,t_cup,z_cup,qo_cup,qeso_cup) !$acc declare copyout(dtempdz,k_inv_layers) !-local vars @@ -5308,15 +5319,15 @@ subroutine get_lateral_massflux(itf,ktf, its,ite, kts,kte implicit none integer, intent (in) :: draft integer, intent(in):: itf,ktf, its,ite, kts,kte - integer, intent(in) , dimension(its:ite) :: ierr,ktop,kbcon,k22 + integer, intent(in) , dimension(its:) :: ierr,ktop,kbcon,k22 !$acc declare copyin(ierr,ktop,kbcon,k22) - !real(kind=kind_phys), intent(in), optional , dimension(its:ite):: lambau - real(kind=kind_phys), intent(inout), optional , dimension(its:ite):: lambau - real(kind=kind_phys), intent(in) , dimension(its:ite,kts:kte) :: zo_cup,zuo - real(kind=kind_phys), intent(inout), dimension(its:ite,kts:kte) :: cd,entr_rate_2d - real(kind=kind_phys), intent( out), dimension(its:ite,kts:kte) :: up_massentro, up_massdetro & + !real(kind=kind_phys), intent(in), optional , dimension(its:):: lambau + real(kind=kind_phys), intent(inout), optional , dimension(its:):: lambau + real(kind=kind_phys), intent(in) , dimension(its:,kts:) :: zo_cup,zuo + real(kind=kind_phys), intent(inout), dimension(its:,kts:) :: cd,entr_rate_2d + real(kind=kind_phys), intent( out), dimension(its:,kts:) :: up_massentro, up_massdetro & ,up_massentr, up_massdetr - real(kind=kind_phys), intent( out), dimension(its:ite,kts:kte), optional :: & + real(kind=kind_phys), intent( out), dimension(its:,kts:), optional :: & up_massentru,up_massdetru !$acc declare copy(lambau,cd,entr_rate_2d) copyin(zo_cup,zuo) copyout(up_massentro, up_massdetro,up_massentr, up_massdetr) !$acc declare copyout(up_massentro, up_massdetro,up_massentr, up_massdetr, up_massentru,up_massdetru) @@ -5437,10 +5448,10 @@ subroutine get_partition_liq_ice(ierr,tn,po_cup, p_liq_ice,melting_layer implicit none character *(*), intent (in) :: cumulus integer ,intent (in ) :: itf,ktf, its,ite, kts,kte - real(kind=kind_phys), intent (in ), dimension(its:ite,kts:kte) :: tn,po_cup - real(kind=kind_phys), intent (inout), dimension(its:ite,kts:kte) :: p_liq_ice,melting_layer + real(kind=kind_phys), intent (in ), dimension(its:,kts:) :: tn,po_cup + real(kind=kind_phys), intent (inout), dimension(its:,kts:) :: p_liq_ice,melting_layer !$acc declare copyin(tn,po_cup) copy(p_liq_ice,melting_layer) - integer , intent (in ), dimension(its:ite) :: ierr + integer , intent (in ), dimension(its:) :: ierr !$acc declare copyin(ierr) integer :: i,k real(kind=kind_phys) :: dp @@ -5539,11 +5550,11 @@ subroutine get_melting_profile(ierr,tn_cup,po_cup, p_liq_ice,melting_layer,qrco implicit none character *(*), intent (in) :: cumulus integer ,intent (in ) :: itf,ktf, its,ite, kts,kte - integer ,intent (in ), dimension(its:ite) :: ierr - real(kind=kind_phys) ,intent (in ), dimension(its:ite) :: edto - real(kind=kind_phys) ,intent (in ), dimension(its:ite,kts:kte) :: tn_cup,po_cup,qrco,pwo & + integer ,intent (in ), dimension(its:) :: ierr + real(kind=kind_phys) ,intent (in ), dimension(its:) :: edto + real(kind=kind_phys) ,intent (in ), dimension(its:,kts:) :: tn_cup,po_cup,qrco,pwo & ,pwdo,p_liq_ice,melting_layer - real(kind=kind_phys) ,intent (inout), dimension(its:ite,kts:kte) :: melting + real(kind=kind_phys) ,intent (inout), dimension(its:,kts:) :: melting !$acc declare copyin(ierr,edto,tn_cup,po_cup,qrco,pwo,pwdo,p_liq_ice,melting_layer,melting) integer :: i,k real(kind=kind_phys) :: dp @@ -5615,13 +5626,13 @@ subroutine get_cloud_top(name,ktop,ierr,p_cup,entr_rate_2d,hkbo,heo,heso_cup,z_c kstabi,k22,kbcon,its,ite,itf,kts,kte,ktf,zuo,kpbl,klcl,hcot) implicit none integer, intent(in) :: its,ite,itf,kts,kte,ktf - real(kind=kind_phys), dimension (its:ite,kts:kte),intent (inout) :: entr_rate_2d,zuo - real(kind=kind_phys), dimension (its:ite,kts:kte),intent (in) ::p_cup, heo,heso_cup,z_cup - real(kind=kind_phys), dimension (its:ite),intent (in) :: hkbo - integer, dimension (its:ite),intent (in) :: kstabi,k22,kbcon,kpbl,klcl - integer, dimension (its:ite),intent (inout) :: ierr,ktop + real(kind=kind_phys), dimension (its:,kts:),intent (inout) :: entr_rate_2d,zuo + real(kind=kind_phys), dimension (its:,kts:),intent (in) ::p_cup, heo,heso_cup,z_cup + real(kind=kind_phys), dimension (its:),intent (in) :: hkbo + integer, dimension (its:),intent (in) :: kstabi,k22,kbcon,kpbl,klcl + integer, dimension (its:),intent (inout) :: ierr,ktop !$acc declare copy(entr_rate_2d,zuo,ierr,ktop) copyin(p_cup, heo,heso_cup,z_cup,hkbo,kstabi,k22,kbcon,kpbl,klcl) - real(kind=kind_phys), dimension (its:ite,kts:kte) :: hcot + real(kind=kind_phys), dimension (its:,kts:) :: hcot !$acc declare create(hcot) character *(*), intent (in) :: name real(kind=kind_phys) :: dz,dh, dbythresh @@ -5644,7 +5655,7 @@ subroutine get_cloud_top(name,ktop,ierr,p_cup,entr_rate_2d,hkbo,heo,heso_cup,z_c kfinalzu=ktf-2 ktop(i)=kfinalzu if(ierr(i).eq.0)then - dby (kts:kte)=0.0 + dby (kts:)=0.0 start_level(i)=kbcon(i) !-- hcot below kbcon @@ -5704,16 +5715,16 @@ subroutine calculate_updraft_velocity(its,itf,ktf,ite,kts,kte,ierr,progsigma, implicit none logical, intent(in) :: progsigma integer, intent(in) :: itf,its,ktf,ite,kts,kte - integer, dimension (its:ite), intent(inout) :: ierr - real(kind=kind_phys), dimension (its:ite,kts:kte),intent (in) :: zo,entr_rate_2d, & + integer, dimension (its:), intent(inout) :: ierr + real(kind=kind_phys), dimension (its:,kts:),intent (in) :: zo,entr_rate_2d, & cd,po,qeso,to,qo,dbyo,clw_all,qlk,delp,zu - integer, dimension (its:ite),intent(in) :: k22,kbcon,ktcon + integer, dimension (its:),intent(in) :: k22,kbcon,ktcon real(kind=kind_phys), dimension (its:ite) :: sumx real(kind=kind_phys) ,intent (in) :: fv,rd,el2orc real(kind=kind_phys), dimension (its:ite,kts:kte) :: drag, buo, zi, del - real(kind=kind_phys), dimension (its:ite,kts:kte),intent (out) :: wu2,omega_u, & + real(kind=kind_phys), dimension (its:,kts:),intent (out) :: wu2,omega_u, & zeta,zdqca - real(kind=kind_phys), dimension (its:ite),intent(out) :: wc,omegac + real(kind=kind_phys), dimension (its:),intent(out) :: wc,omegac real(kind=kind_phys) :: rho,bb1,bb2,dz,dp,ptem,tem1,ptem1,tem,rfact,gamma,val integer :: i,k diff --git a/physics/cu_c3_driver.F90 b/physics/CONV/C3/cu_c3_driver.F90 similarity index 91% rename from physics/cu_c3_driver.F90 rename to physics/CONV/C3/cu_c3_driver.F90 index fd4d37b0b..a08d47463 100644 --- a/physics/cu_c3_driver.F90 +++ b/physics/CONV/C3/cu_c3_driver.F90 @@ -30,7 +30,8 @@ module cu_c3_driver !! \htmlinclude cu_c3_driver_init.html !! subroutine cu_c3_driver_init(imfshalcnv, imfshalcnv_c3, imfdeepcnv, & - imfdeepcnv_c3,mpirank, mpiroot, errmsg, errflg) + imfdeepcnv_c3,progsigma, cnx, mpirank, mpiroot, & + errmsg, errflg) implicit none @@ -38,6 +39,8 @@ subroutine cu_c3_driver_init(imfshalcnv, imfshalcnv_c3, imfdeepcnv, & integer, intent(in) :: imfdeepcnv, imfdeepcnv_c3 integer, intent(in) :: mpirank integer, intent(in) :: mpiroot + integer, intent(in) :: cnx + logical, intent(inout) :: progsigma character(len=*), intent( out) :: errmsg integer, intent( out) :: errflg @@ -45,6 +48,13 @@ subroutine cu_c3_driver_init(imfshalcnv, imfshalcnv_c3, imfdeepcnv, & errmsg = '' errflg = 0 + if(progsigma)then + if(cnx < 384)then + progsigma=.false. + write(*,*)'Forcing prognostic closure to .false. due to coarse resolution' + endif + endif + end subroutine cu_c3_driver_init ! @@ -60,7 +70,8 @@ end subroutine cu_c3_driver_init subroutine cu_c3_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart,& do_ca,progsigma,cactiv,cactiv_m,g,cp,fv,r_d,xlv,r_v,forcet, & forceqv_spechum,phil,delp,raincv,tmf,qmicro,sigmain, & - qv_spechum,t,cld1d,us,vs,t2di,w,qv2di_spechum,p2di,psuri, & + betascu,betamcu,betadcu,qv_spechum,t,cld1d,us,vs,t2di,w, & + qv2di_spechum,p2di,psuri, & hbot,htop,kcnv,xland,hfx2,qfx2,aod_gf,cliw,clcw,ca_deep,rainevap,& pbl,ud_mf,dd_mf,dt_mf,cnvw_moist,cnvc,imfshalcnv, & flag_for_scnv_generic_tend,flag_for_dcnv_generic_tend, & @@ -96,22 +107,23 @@ subroutine cu_c3_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart,& integer, intent(in ) :: ichoice_in,ichoicem_in,ichoice_s_in logical, intent(in ) :: flag_init, flag_restart, do_mynnedmf logical, intent(in ) :: flag_for_scnv_generic_tend,flag_for_dcnv_generic_tend, & - do_ca,progsigma - real (kind=kind_phys), intent(in) :: g,cp,fv,r_d,xlv,r_v + do_ca + real (kind=kind_phys), intent(in) :: g,cp,fv,r_d,xlv,r_v,betascu,betamcu,betadcu logical, intent(in ) :: ldiag3d - - real(kind=kind_phys), intent(inout) :: dtend(:,:,:) + logical, intent(in ) :: progsigma + real(kind=kind_phys), intent(inout), optional :: dtend(:,:,:) !$acc declare copy(dtend) integer, intent(in) :: dtidx(:,:), & index_of_x_wind, index_of_y_wind, index_of_temperature, & index_of_process_scnv, index_of_process_dcnv, ntqv, ntcw, ntiw !$acc declare copyin(dtidx) - real(kind=kind_phys), dimension( : , : ), intent(in ) :: forcet,forceqv_spechum,w,phil,delp - real(kind=kind_phys), dimension ( : , : ), intent(in ) :: sigmain,qmicro + real(kind=kind_phys), dimension( : , : ), intent(in ), optional :: forcet,forceqv_spechum + real(kind=kind_phys), dimension( : , : ), intent(in ) :: w,phil,delp + real(kind=kind_phys), dimension ( : , : ), intent(in ), optional :: sigmain,qmicro real(kind=kind_phys), dimension( : , : ), intent(inout ) :: t,us,vs - real(kind=kind_phys), dimension( : , : ), intent(inout ) :: qci_conv + real(kind=kind_phys), dimension( : , : ), intent(inout ), optional :: qci_conv real(kind=kind_phys), dimension( : , : ), intent(out ) :: cnvw_moist,cnvc - real(kind=kind_phys), dimension ( : , : ), intent(out ) :: sigmaout + real(kind=kind_phys), dimension ( : , : ), intent(out ), optional :: sigmaout real(kind=kind_phys), dimension( : , : ), intent(inout ) :: cliw, clcw real(kind=kind_phys), dimension ( : , : , :), intent(in ) :: tmf !$acc declare copyin(forcet,forceqv_spechum,w,phil) @@ -123,27 +135,31 @@ subroutine cu_c3_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart,& integer, intent(in) :: dfi_radar_max_intervals real(kind=kind_phys), intent(in) :: fhour, fh_dfi_radar(:) integer, intent(in) :: num_dfi_radar, ix_dfi_radar(:) - real(kind=kind_phys), intent(in) :: cap_suppress(:,:) + real(kind=kind_phys), intent(in), optional :: cap_suppress(:,:) !$acc declare copyin(fh_dfi_radar,ix_dfi_radar,cap_suppress) integer, dimension (:), intent(out) :: hbot,htop,kcnv integer, dimension (:), intent(in) :: xland - real(kind=kind_phys), dimension (:), intent(in) :: pbl,maxMF + real(kind=kind_phys), dimension (:), intent(in) :: pbl + real(kind=kind_phys), dimension (:), intent(in), optional :: maxMF !$acc declare copyout(hbot,htop,kcnv) !$acc declare copyin(xland,pbl) integer, dimension (im) :: tropics !$acc declare create(tropics) ! ruc variable - real(kind=kind_phys), dimension (:), intent(in) :: hfx2,qfx2,psuri,ca_deep - real(kind=kind_phys), dimension (:,:), intent(out) :: ud_mf,dd_mf,dt_mf - real(kind=kind_phys), dimension (:), intent(out) :: raincv,cld1d,maxupmf,rainevap + real(kind=kind_phys), dimension (:), intent(in) :: hfx2,qfx2,psuri + real(kind=kind_phys), dimension (:), intent(in), optional :: ca_deep + real(kind=kind_phys), dimension (:,:), intent(out), optional :: ud_mf + real(kind=kind_phys), dimension (:,:), intent(out) :: dd_mf,dt_mf + real(kind=kind_phys), dimension (:), intent(out) :: raincv,cld1d,rainevap + real(kind=kind_phys), dimension (:), intent(out), optional :: maxupmf real(kind=kind_phys), dimension (:,:), intent(in) :: t2di,p2di !$acc declare copyin(hfx2,qfx2,psuri,t2di,p2di) !$acc declare copyout(ud_mf,dd_mf,dt_mf,raincv,cld1d) ! Specific humidity from FV3 real(kind=kind_phys), dimension (:,:), intent(in) :: qv2di_spechum real(kind=kind_phys), dimension (:,:), intent(inout) :: qv_spechum - real(kind=kind_phys), dimension (:), intent(inout) :: aod_gf + real(kind=kind_phys), dimension (:), intent(inout), optional :: aod_gf !$acc declare copyin(qv2di_spechum) copy(qv_spechum,aod_gf) ! Local water vapor mixing ratios and cloud water mixing ratios real(kind=kind_phys), dimension (im,km) :: qv2di, qv, forceqv, cnvw @@ -154,7 +170,7 @@ subroutine cu_c3_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart,& real(kind=kind_phys), intent(in ) :: dt integer, intent(in ) :: imfshalcnv - integer, dimension(:), intent(inout) :: cactiv,cactiv_m + integer, dimension(:), intent(inout), optional :: cactiv,cactiv_m !$acc declare copy(cactiv,cactiv_m) character(len=*), intent(out) :: errmsg @@ -340,8 +356,8 @@ subroutine cu_c3_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart,& ! !> - Set tuning constants for radiation coupling ! - tun_rad_shall(:)=.01 - tun_rad_mid(:)=.3 !.02 + tun_rad_shall(:)=.012 + tun_rad_mid(:)=.15 !.02 tun_rad_deep(:)=.3 !.065 edt(:)=0. edtm(:)=0. @@ -587,7 +603,7 @@ subroutine cu_c3_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart,& hfx(i)=hfx2(i)*cp*rhoi(i,1) qfx(i)=qfx2(i)*xlv*rhoi(i,1) dx(i) = sqrt(garea(i)) - enddo + enddo do i=its,itf do k=kts,kpbli(i) @@ -644,7 +660,6 @@ subroutine cu_c3_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart,& enddo !$acc end kernels if (dx(its)<6500.) then - ichoice=10 imid_gf=0 endif ! @@ -670,7 +685,8 @@ subroutine cu_c3_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart,& zus,xmbs,kbcons,ktops,k22s,ierrs,ierrcs, & ! Prog closure flag_init, flag_restart,fv,r_d,delp,tmfq,qmicro, & - forceqv_spechum,sigmain,sigmaout,progsigma,dx, & + forceqv_spechum,betascu,betamcu,betadcu,sigmain, & + sigmaout,progsigma,dx, & ! output tendencies outts,outqs,outqcs,outus,outvs,cnvwt,prets,cupclws, & ! dimesnional variables @@ -680,10 +696,6 @@ subroutine cu_c3_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart,& do i=its,itf if(xmbs(i).gt.0.)then cutens(i)=1. - if (dx(i)<6500.) then - ierrm(i)=555 - ierr (i)=555 - endif endif enddo !$acc end kernels @@ -719,6 +731,9 @@ subroutine cu_c3_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart,& ,tmfq & ,qmicro & ,forceqv_spechum & + ,betascu & + ,betamcu & + ,betadcu & ,sigmain & ,sigmaout & ,ter11 & @@ -810,6 +825,9 @@ subroutine cu_c3_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart,& ,tmfq & ,qmicro & ,forceqv_spechum & + ,betascu & + ,betamcu & + ,betadcu & ,sigmain & ,sigmaout & ,ter11 & @@ -828,30 +846,29 @@ subroutine cu_c3_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart,& ,ca_deep & ,mconv & ,omeg & - - ,cactiv & - ,cnvwt & - ,zu & - ,zd & - ,zdm & ! hli - ,edt & - ,edtm & ! hli - ,xmb & - ,xmbm & - ,xmbs & - ,pret & - ,outu & - ,outv & - ,outt & - ,outq & - ,outqc & - ,kbcon & - ,ktop & - ,cupclw & - ,frhd & - ,rainevap & - ,ierr & - ,ierrc & + ,cactiv & + ,cnvwt & + ,zu & + ,zd & + ,zdm & ! hli + ,edt & + ,edtm & ! hli + ,xmb & + ,xmbm & + ,xmbs & + ,pret & + ,outu & + ,outv & + ,outt & + ,outq & + ,outqc & + ,kbcon & + ,ktop & + ,cupclw & + ,frhd & + ,rainevap & + ,ierr & + ,ierrc & ! the following should be set to zero if not available ,rand_mom & ! for stochastics mom, if temporal and spatial patterns exist ,rand_vmas & ! for stochastics vertmass, if temporal and spatial patterns exist @@ -954,38 +971,6 @@ subroutine cu_c3_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart,& !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) -! -!> - Calculate subsidence effect on clw -! -! 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)) @@ -1041,8 +1026,8 @@ subroutine cu_c3_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart,& gdc(i,16,10)=pret(i)*3600. maxupmf(i)=0. - if(forcing(i,6).gt.0.)then - maxupmf(i)=maxval(xmb(i)*zu(i,kts:ktf)/forcing(i,6)) + if(forcing2(i,6).gt.0.)then + maxupmf(i)=maxval(xmb(i)*zu(i,kts:ktf)/forcing2(i,6)) endif if(ktop(i).gt.2 .and.pret(i).gt.0.)dt_mf(i,ktop(i)-1)=ud_mf(i,ktop(i)) diff --git a/physics/cu_c3_driver.meta b/physics/CONV/C3/cu_c3_driver.meta similarity index 93% rename from physics/cu_c3_driver.meta rename to physics/CONV/C3/cu_c3_driver.meta index 999b5c2bc..af411cb6b 100644 --- a/physics/cu_c3_driver.meta +++ b/physics/CONV/C3/cu_c3_driver.meta @@ -1,7 +1,8 @@ [ccpp-table-properties] name = cu_c3_driver type = scheme - dependencies = cu_c3_deep.F90,cu_c3_sh.F90,machine.F,physcons.F90,progsigma_calc.f90 + dependencies = ../../hooks/machine.F + dependencies = cu_c3_deep.F90,cu_c3_sh.F90,../progsigma_calc.f90 ######################################################################## [ccpp-arg-table] @@ -49,6 +50,20 @@ dimensions = () type = integer intent = in +[progsigma] + standard_name = do_prognostic_updraft_area_fraction + long_name = flag for prognostic sigma in cumuls scheme + units = flag + dimensions = () + type = logical + intent = inout +[cnx] + standard_name = number_of_x_points_for_current_cubed_sphere_tile + long_name = number of points in x direction for this cubed sphere face + units = count + dimensions = () + type = integer + intent = in [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP @@ -141,6 +156,7 @@ dimensions = (horizontal_loop_extent) type = integer intent = inout + optional = True [cactiv_m] standard_name = counter_for_grell_freitas_mid_level_convection long_name = mid-level cloud convective activity memory @@ -148,6 +164,7 @@ dimensions = (horizontal_loop_extent) type = integer intent = inout + optional = True [g] standard_name = gravitational_acceleration long_name = gravitational acceleration @@ -204,6 +221,7 @@ type = real kind = kind_phys intent = in + optional = True [forceqv_spechum] standard_name = tendendy_of_specific_humidity_due_to_nonphysics long_name = moisture tendency due to dynamics only @@ -212,6 +230,7 @@ type = real kind = kind_phys intent = in + optional = True [tmf] standard_name = tendency_of_vertically_diffused_tracer_concentration long_name = updated tendency of the tracers due to vertical diffusion in PBL scheme @@ -228,6 +247,7 @@ type = real kind = kind_phys intent = in + optional = True [sigmain] standard_name = prognostic_updraft_area_fraction_in_convection long_name = convective updraft area fraction @@ -236,6 +256,7 @@ type = real kind = kind_phys intent = in + optional = True [sigmaout] standard_name = updraft_area_fraction_updated_by_physics long_name = convective updraft area fraction updated by physics @@ -244,6 +265,30 @@ type = real kind = kind_phys intent = out + optional = True +[betascu] + standard_name = tuning_param_for_shallow_cu + long_name = tuning param for shallow cu in case prognostic closure is used + units = none + dimensions = () + type = real + kind = kind_phys + intent = in +[betamcu] + standard_name = tuning_param_for_midlevel_cu + long_name = tuning param for midlevel cu in case prognostic closure is used + units = none + dimensions = () + type = real + kind = kind_phys + intent = in +[betadcu] + standard_name = tuning_param_for_deep_cu + long_name = tuning param for deep cu in case prognostic closure is used + units = none + dimensions = () + type = real + intent = in [phil] standard_name = geopotential long_name = layer geopotential @@ -400,6 +445,7 @@ type = real kind = kind_phys intent = inout + optional = True [cliw] standard_name = ice_water_mixing_ratio_convective_transport_tracer long_name = ratio of mass of ice water to mass of dry air plus vapor (without condensates) in the convectively transported tracer array @@ -432,6 +478,7 @@ type = real kind = kind_phys intent = out + optional = True [dd_mf] standard_name = instantaneous_atmosphere_downdraft_convective_mass_flux long_name = (downdraft mass flux) * delt @@ -493,6 +540,7 @@ type = real kind = kind_phys intent = inout + optional = True [dtidx] standard_name = cumulative_change_of_state_variables_outer_index long_name = index of state-variable and process in last dimension of diagnostic tendencies array AKA cumulative_change_index @@ -578,6 +626,7 @@ type = real kind = kind_phys intent = inout + optional = True [fhour] standard_name = forecast_time long_name = current forecast time @@ -623,6 +672,7 @@ type = real kind = kind_phys intent = in + optional = True [ca_deep] standard_name = cellular_automata_area_fraction_for_deep_convection_from_coupled_process long_name = fraction of cellular automata for deep convection @@ -631,6 +681,7 @@ type = real kind = kind_phys intent = in + optional = True [rainevap] standard_name = physics_field_for_coupling long_name = physics_field_for_coupling @@ -647,6 +698,7 @@ type = real kind = kind_phys intent = out + optional = True [maxMF] standard_name = maximum_mass_flux long_name = maximum mass flux within a column @@ -655,6 +707,7 @@ type = real kind = kind_phys intent = in + optional = True [do_mynnedmf] standard_name = flag_for_mellor_yamada_nakanishi_niino_pbl_scheme long_name = flag to activate MYNN-EDMF diff --git a/physics/cu_c3_driver_post.F90 b/physics/CONV/C3/cu_c3_driver_post.F90 similarity index 75% rename from physics/cu_c3_driver_post.F90 rename to physics/CONV/C3/cu_c3_driver_post.F90 index 74957a6b2..28ddbf62b 100644 --- a/physics/cu_c3_driver_post.F90 +++ b/physics/CONV/C3/cu_c3_driver_post.F90 @@ -26,15 +26,16 @@ subroutine cu_c3_driver_post_run (im, km, t, q, prevst, prevsq, cactiv, cactiv_m real(kind_phys), intent(in) :: t(:,:) real(kind_phys), intent(in) :: q(:,:) real(kind_phys), dimension(:),intent(in) :: garea - real(kind_phys), intent(out) :: prevst(:,:) - real(kind_phys), intent(out) :: prevsq(:,:) - integer, intent(in) :: cactiv(:) - integer, intent(in) :: cactiv_m(:) - real(kind_phys), intent(out) :: conv_act(:) - real(kind_phys), intent(out) :: conv_act_m(:) + real(kind_phys), intent(out), optional :: prevst(:,:) + real(kind_phys), intent(out), optional :: prevsq(:,:) + integer, intent(in), optional :: cactiv(:) + integer, intent(in), optional :: cactiv_m(:) + real(kind_phys), intent(out), optional :: conv_act(:) + real(kind_phys), intent(out), optional :: conv_act_m(:) ! for Radar reflectivity real(kind_phys), intent(in) :: dt - real(kind_phys), intent(in) :: raincv(:), maxupmf(:) + real(kind_phys), intent(in) :: raincv(:) + real(kind_phys), intent(in), optional :: maxupmf(:) real(kind_phys), intent(inout) :: refl_10cm(:,:) character(len=*), intent(out) :: errmsg !$acc declare copyin(t,q,cactiv,cactiv_m) copyout(prevst,prevsq,conv_act,conv_act_m) @@ -66,20 +67,19 @@ subroutine cu_c3_driver_post_run (im, km, t, q, prevst, prevsq, cactiv, cactiv_m conv_act_m(i)=0.0 endif ! reflectivity parameterization for parameterized convection (reference:Unipost MDLFLD.f) - if(sqrt(garea(i)).lt.6500.)then ze = 0.0 ze_conv = 0.0 dbz_sum = 0.0 - cuprate = raincv(i) * 3600.0 / dt ! cu precip rate (mm/h) - ze_conv = 300.0 * cuprate**1.4 - if (maxupmf(i).gt.0.05) then + cuprate = 1.e3*raincv(i) * 3600.0 / dt ! cu precip rate (mm/h) + if(cuprate .lt. 0.05) cuprate=0. + ze_conv = 300.0 * cuprate**1.5 + if (maxupmf(i).gt.0.1 .and. cuprate.gt.0.) then do k = 1, km ze = 10._kind_phys ** (0.1 * refl_10cm(i,k)) dbz_sum = max(dbzmin, 10.0 * log10(ze + ze_conv)) refl_10cm(i,k) = dbz_sum enddo endif - endif enddo !$acc end kernels diff --git a/physics/cu_c3_driver_post.meta b/physics/CONV/C3/cu_c3_driver_post.meta similarity index 95% rename from physics/cu_c3_driver_post.meta rename to physics/CONV/C3/cu_c3_driver_post.meta index c53972f09..4e4122b69 100644 --- a/physics/cu_c3_driver_post.meta +++ b/physics/CONV/C3/cu_c3_driver_post.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = cu_c3_driver_post type = scheme - dependencies = machine.F + dependencies = ../../hooks/machine.F ######################################################################## [ccpp-arg-table] @@ -45,6 +45,7 @@ type = real kind = kind_phys intent = out + optional = True [prevsq] standard_name = specific_humidity_on_previous_timestep long_name = moisture from previous time step @@ -53,6 +54,7 @@ type = real kind = kind_phys intent = out + optional = True [cactiv] standard_name = counter_for_grell_freitas_convection long_name = convective activity memory @@ -60,6 +62,7 @@ dimensions = (horizontal_loop_extent) type = integer intent = in + optional = True [cactiv_m] standard_name = counter_for_grell_freitas_mid_level_convection long_name = midlevel convective activity memory @@ -67,6 +70,7 @@ dimensions = (horizontal_loop_extent) type = integer intent = in + optional = True [conv_act] standard_name = consecutive_calls_for_grell_freitas_convection long_name = Memory counter for GF @@ -75,6 +79,7 @@ type = real kind = kind_phys intent = out + optional = True [conv_act_m] standard_name = consecutive_calls_for_grell_freitas_mid_level_convection long_name = Memory counter for GF midlevel @@ -83,6 +88,7 @@ type = real kind = kind_phys intent = out + optional = True [dt] standard_name = timestep_for_physics long_name = physics time step @@ -115,6 +121,7 @@ type = real kind = kind_phys intent = in + optional = True [refl_10cm] standard_name = radar_reflectivity_10cm long_name = instantaneous refl_10cm diff --git a/physics/cu_c3_driver_pre.F90 b/physics/CONV/C3/cu_c3_driver_pre.F90 similarity index 81% rename from physics/cu_c3_driver_pre.F90 rename to physics/CONV/C3/cu_c3_driver_pre.F90 index c6e79059b..368687116 100644 --- a/physics/cu_c3_driver_pre.F90 +++ b/physics/CONV/C3/cu_c3_driver_pre.F90 @@ -30,16 +30,16 @@ subroutine cu_c3_driver_pre_run (flag_init, flag_restart, kdt, fhour, dtp, t, q, real(kind_phys), intent(in) :: dtp real(kind_phys), intent(in) :: t(:,:) real(kind_phys), intent(in) :: q(:,:) - real(kind_phys), intent(in) :: prevst(:,:) - real(kind_phys), intent(in) :: prevsq(:,:) + real(kind_phys), intent(in), optional :: prevst(:,:) + real(kind_phys), intent(in), optional :: prevsq(:,:) !$acc declare copyin(t,q,prevst,prevsq) - real(kind_phys), intent(out) :: forcet(:,:) - real(kind_phys), intent(out) :: forceq(:,:) - integer, intent(out) :: cactiv(:) - integer, intent(out) :: cactiv_m(:) + real(kind_phys), intent(out), optional :: forcet(:,:) + real(kind_phys), intent(out), optional :: forceq(:,:) + integer, intent(out), optional :: cactiv(:) + integer, intent(out), optional :: cactiv_m(:) !$acc declare copyout(forcet,forceq,cactiv,cactiv_m) - real(kind_phys), intent(in) :: conv_act(:) - real(kind_phys), intent(in) :: conv_act_m(:) + real(kind_phys), intent(in), optional :: conv_act(:) + real(kind_phys), intent(in), optional :: conv_act_m(:) !$acc declare copyin(conv_act,conv_act_m) character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg diff --git a/physics/cu_c3_driver_pre.meta b/physics/CONV/C3/cu_c3_driver_pre.meta similarity index 95% rename from physics/cu_c3_driver_pre.meta rename to physics/CONV/C3/cu_c3_driver_pre.meta index c018bee9f..6e0b30045 100644 --- a/physics/cu_c3_driver_pre.meta +++ b/physics/CONV/C3/cu_c3_driver_pre.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = cu_c3_driver_pre type = scheme - dependencies = machine.F + dependencies = ../../hooks/machine.F ######################################################################## [ccpp-arg-table] @@ -68,6 +68,7 @@ type = real kind = kind_phys intent = in + optional = True [prevsq] standard_name = specific_humidity_on_previous_timestep long_name = moisture from previous time step @@ -76,6 +77,7 @@ type = real kind = kind_phys intent = in + optional = True [forcet] standard_name = tendency_of_air_temperature_due_to_nonphysics long_name = temperature tendency due to dynamics only @@ -84,6 +86,7 @@ type = real kind = kind_phys intent = out + optional = True [forceq] standard_name = tendendy_of_specific_humidity_due_to_nonphysics long_name = moisture tendency due to dynamics only @@ -92,6 +95,7 @@ type = real kind = kind_phys intent = out + optional = True [cactiv] standard_name = counter_for_grell_freitas_convection long_name = convective activity memory @@ -99,6 +103,7 @@ dimensions = (horizontal_loop_extent) type = integer intent = out + optional = True [cactiv_m] standard_name = counter_for_grell_freitas_mid_level_convection long_name = midlevel convective activity memory @@ -106,6 +111,7 @@ dimensions = (horizontal_loop_extent) type = integer intent = out + optional = True [conv_act] standard_name = consecutive_calls_for_grell_freitas_convection long_name = Memory counter for GF @@ -114,6 +120,7 @@ type = real kind = kind_phys intent = in + optional = True [conv_act_m] standard_name = consecutive_calls_for_grell_freitas_mid_level_convection long_name = Memory counter for GF midlevel @@ -122,6 +129,7 @@ type = real kind = kind_phys intent = in + optional = True [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/cu_c3_sh.F90 b/physics/CONV/C3/cu_c3_sh.F90 similarity index 94% rename from physics/cu_c3_sh.F90 rename to physics/CONV/C3/cu_c3_sh.F90 index 0ea0f28ae..0625b2949 100644 --- a/physics/cu_c3_sh.F90 +++ b/physics/CONV/C3/cu_c3_sh.F90 @@ -6,12 +6,12 @@ module cu_c3_sh use progsigma, only : progsigma_calc !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) :: c0_shal=.004 + real(kind=kind_phys) :: c1_shal=0. !0.005! .0005 real(kind=kind_phys), parameter:: fluxtune=1.5 contains @@ -68,7 +68,8 @@ subroutine cu_c3_sh_run ( & hfx,qfx,xland,ichoice,tcrit,dtime, & zuo,xmb_out,kbcon,ktop,k22,ierr,ierrc, & flag_init, flag_restart,fv,r_d,delp,tmf,qmicro, & - forceqv_spechum,sigmain,sigmaout,progsigma,dx, & + forceqv_spechum,betascu,betamcu,betadcu,sigmain,& + sigmaout,progsigma,dx, & outt,outq,outqc,outu,outv,cnvwt,pre,cupclw, & ! output tendencies itf,ktf,its,ite, kts,kte,ipr,tropics) ! dimesnional variables ! @@ -95,23 +96,27 @@ subroutine cu_c3_sh_run ( & ! outq = output q tendency (per s) ! outqc = output qc tendency (per s) ! pre = output precip - real(kind=kind_phys), dimension (its:ite,kts:kte) & + real(kind=kind_phys), dimension (its:,kts:) & ,intent (inout ) :: & cnvwt,outt,outq,outqc,cupclw,zuo,outu,outv !$acc declare copy(cnvwt,outt,outq,outqc,cupclw,zuo,outu,outv) - real(kind=kind_phys), dimension (its:ite,kts:kte) & + real(kind=kind_phys), dimension (its:,kts:) & ,intent (in ) :: & - tmf, qmicro, sigmain, forceqv_spechum - real(kind=kind_phys), dimension (its:ite) & + tmf + real(kind=kind_phys), dimension (its:,kts:) & + ,intent (in ), optional :: & + qmicro, sigmain, forceqv_spechum + + real(kind=kind_phys), dimension (its:) & ,intent (out ) :: & xmb_out - integer, dimension (its:ite) & + integer, dimension (its:) & ,intent (inout ) :: & ierr - integer, dimension (its:ite) & + integer, dimension (its:) & ,intent (out ) :: & kbcon,ktop,k22 - integer, dimension (its:ite) & + integer, dimension (its:) & ,intent (in ) :: & kpbl,tropics !$acc declare copyout(xmb_out,kbcon,ktop,k22) copyin(kpbl,tropics) copy(ierr) @@ -119,22 +124,22 @@ subroutine cu_c3_sh_run ( & ! basic environmental input includes a flag (ierr) to turn off ! convection for this call only and at that particular gridpoint ! - real(kind=kind_phys), dimension (its:ite,kts:kte) & + real(kind=kind_phys), dimension (its:,kts:) & ,intent (in ) :: & t,po,tn,dhdt,rho,us,vs,delp - real(kind=kind_phys), dimension (its:ite,kts:kte) & + real(kind=kind_phys), dimension (its:,kts:) & ,intent (inout) :: & q,qo - real(kind=kind_phys), dimension (its:ite) & + real(kind=kind_phys), dimension (its:) & ,intent (in ) :: & xland,z1,psur,hfx,qfx,dx real(kind=kind_phys) & ,intent (in ) :: & - dtime,tcrit,fv,r_d -!$acc declare sigmaout - real(kind=kind_phys), dimension (its:ite,kts:kte) & - ,intent (out) :: & + dtime,tcrit,fv,r_d,betascu,betamcu,betadcu +!$acc declare sigmaout + real(kind=kind_phys), dimension (its:,kts:) & + ,intent (out), optional :: & sigmaout @@ -234,18 +239,21 @@ subroutine cu_c3_sh_run ( & !$acc cap_max_increment,lambau, & !$acc kstabi,xland1,kbmax,ktopx) - logical :: flag_shallow + logical :: flag_shallow,flag_mid logical, dimension(its:ite) :: cnvflg integer :: & kstart,i,k,ki - real(kind=kind_phys) :: & + real(kind=kind_phys) :: & dz,mbdt,zkbmax, & cap_maxs,trash,trash2,frh,el2orc,gravinv - real(kind=kind_phys) buo_flux,pgeoh,dp,entup,detup,totmas + real(kind=kind_phys) buo_flux,pgeoh,dp,entup,detup,totmas + real(kind=kind_phys) :: & + sigmind,sigminm,sigmins + parameter(sigmind=0.005,sigmins=0.03,sigminm=0.01) real(kind=kind_phys) xff_shal(3),blqe,xkshal - character*50 :: ierrc(its:ite) + character*50 :: ierrc(its:) real(kind=kind_phys), dimension (its:ite,kts:kte) :: & up_massentr,up_massdetr,up_massentro,up_massdetro,up_massentru,up_massdetru !$acc declare create(up_massentr,up_massdetr,up_massentro,up_massdetro,up_massentru,up_massdetru) @@ -274,6 +282,8 @@ subroutine cu_c3_sh_run ( & ktopx(i)=0 if(xland(i).gt.1.5 .or. xland(i).lt.0.5)then xland1(i)=0 + c0_shal=.001 + c1_shal=.001 ! ierr(i)=100 endif pre(i)=0. @@ -669,14 +679,14 @@ subroutine cu_c3_sh_run ( & if(qco(i,k)>=trash ) then dz=z_cup(i,k)-z_cup(i,k-1) ! cloud liquid water - c1d(i,k)=.02*up_massdetr(i,k-1) + c1d(i,k)=c1_shal! 0. !.02*up_massdetr(i,k-1) + clw_all(i,k)=max(0._kind_phys,qco(i,k)-trash) qrco(i,k)= (qco(i,k)-trash)/(1.+(c0_shal+c1d(i,k))*dz) if(qrco(i,k).lt.0.)then ! hli new test 02/12/19 qrco(i,k)=0. - c1d(i,k)=0. + !c1d(i,k)=0. endif pwo(i,k)=c0_shal*dz*qrco(i,k)*zuo(i,k) - clw_all(i,k)=qco(i,k)-trash !LB total cloud before rain and detrain ! cloud water vapor qco (i,k)= trash+qrco(i,k) @@ -958,6 +968,7 @@ subroutine cu_c3_sh_run ( & ! equation 8, call progsigma_calc() to compute updraft area fraction based on a moisture budget if(progsigma)then flag_shallow = .true. + flag_mid = .false. do k=kts,ktf do i=its,itf del(i,k) = delp(i,k)*0.001 @@ -972,9 +983,9 @@ subroutine cu_c3_sh_run ( & endif enddo call progsigma_calc(itf,ktf,flag_init,flag_restart,flag_shallow, & - del,tmf,qmicro,dbyo,zdqca,omega_u,zeta,xlv,dtime, & - forceqv_spechum,kbcon,ktop,cnvflg, & - sigmain,sigmaout,sigmab) + flag_mid,del,tmf,qmicro,dbyo,zdqca,omega_u,zeta,xlv,dtime, & + forceqv_spechum,kbcon,ktop,cnvflg,betascu,betamcu,betadcu, & + sigmind,sigminm,sigmins,sigmain,sigmaout,sigmab) endif diff --git a/physics/cs_conv.F90 b/physics/CONV/Chikira_Sugiyama/cs_conv.F90 similarity index 79% rename from physics/cs_conv.F90 rename to physics/CONV/Chikira_Sugiyama/cs_conv.F90 index ab7388df8..02c834ffa 100644 --- a/physics/cs_conv.F90 +++ b/physics/CONV/Chikira_Sugiyama/cs_conv.F90 @@ -60,6 +60,7 @@ module cs_conv !DD and precipitation. Decrease for more precip real(kind_phys), public :: precz0, preczh, clmd, clmp, clmdpa + real(kind_phys), public, parameter :: c0t=0.002, d0t=0.002 ! ! Private data ! @@ -194,18 +195,19 @@ subroutine cs_conv_run( IJSDIM , KMAX , ntracp1 , NN, & ! ! modified arguments ! - real(kind_phys), intent(inout) :: CBMFX(:,:) ! cloud base mass flux (kg/m2/s) + real(kind_phys), intent(inout), optional :: CBMFX(:,:) ! cloud base mass flux (kg/m2/s) ! ! output arguments ! ! updraft, downdraft, and detrainment mass flux (kg/m2/s) - real(kind_phys), intent(inout), dimension(:,:) :: ud_mf, dd_mf, dt_mf + real(kind_phys), intent(inout), dimension(:,:), optional :: ud_mf + real(kind_phys), intent(inout), dimension(:,:) :: dd_mf, dt_mf real(kind_phys), intent(out) :: rain1(:) ! lwe thickness of deep convective precipitation amount (m) ! GJF* These variables are conditionally allocated depending on whether the ! Morrison-Gettelman microphysics is used, so they must be declared ! using assumed shape. - real(kind_phys), intent(out), dimension(:,:) :: qlcn, qicn, w_upi,cnv_mfd, & + real(kind_phys), intent(out), dimension(:,:), optional :: qlcn, qicn, w_upi,cnv_mfd, & cnv_dqldt, clcn, cnv_fice, & cnv_ndrop, cnv_nice, cf_upi ! *GJF @@ -225,15 +227,17 @@ subroutine cs_conv_run( IJSDIM , KMAX , ntracp1 , NN, & ! ! output arguments of CS_CUMLUS ! - real(kind_phys), dimension(IJSDIM,KMAX,nctp) :: vverti + real(kind_phys), dimension(IJSDIM,KMAX+1,nctp) :: vverti, sigmai real(kind_phys) GTT(IJSDIM,KMAX) !< temperature tendency [K/s] real(kind_phys) GTQ(IJSDIM,KMAX,NTR) !< tracer tendency [kg/kg/s] real(kind_phys) GTU(IJSDIM,KMAX) !< zonal velocity tendency [m/s2] real(kind_phys) GTV(IJSDIM,KMAX) !< meridional velocity tendency [m/s2] - real(kind_phys) GTPRP(IJSDIM,KMAX) !< precipitation (including snowfall) flux at interfaces [kg/m2/s] - real(kind_phys) GSNWP(IJSDIM,KMAX) !< snowfall flux at interfaces [kg/m2/s] - + real(kind_phys) CMDET(IJSDIM,KMAX) !< detrainment mass flux [kg/m2/s] + real(kind_phys) GTPRP(IJSDIM,KMAX+1) !< precipitation (including snowfall) flux at interfaces [kg/m2/s] + real(kind_phys) GSNWP(IJSDIM,KMAX+1) !< snowfall flux at interfaces [kg/m2/s] + real(kind_phys) GMFX0(IJSDIM,KMAX+1) !< updraft mass flux [kg/m2/s] + real(kind_phys) GMFX1(IJSDIM,KMAX+1) !< downdraft mass flux [kg/m2/s] integer KT(IJSDIM,nctp) !< cloud top index for each cloud type real(kind_phys) :: cape(IJSDIM) !< convective available potential energy (J/kg) @@ -377,13 +381,14 @@ subroutine cs_conv_run( IJSDIM , KMAX , ntracp1 , NN, & !> -# Initialize the sigma diagnostics do n=1,nctp - do k=1,kmax + do k=1,kmax+1 do i=ists,iens vverti(i,k,n) = zero + sigmai(i,k,n) = zero enddo enddo enddo - do k=1,kmax + do k=1,kmax+1 do i=ists,iens sigma(i,k) = zero enddo @@ -394,9 +399,9 @@ subroutine cs_conv_run( IJSDIM , KMAX , ntracp1 , NN, & otspt(1:ntr,1), otspt(1:ntr,2), & lprnt , ipr , & GTT , GTQ , GTU , GTV , & ! output - dt_mf , & ! output - GTPRP , GSNWP , ud_mf , & ! output - dd_mf , cape , KT , & ! output + CMDET , & ! output + GTPRP , GSNWP , GMFX0 , & ! output + GMFX1 , cape , KT , & ! output CBMFX , & ! modified GDT , GDQ , GDU , GDV , & ! input GDTM , & ! input @@ -404,7 +409,7 @@ subroutine cs_conv_run( IJSDIM , KMAX , ntracp1 , NN, & delp , delpi , & DELTA , DELTI , ISTS , IENS, mype,& ! input fscav, fswtr, wcbmaxm, nctp, & - sigma, vverti, & ! input/output !DDsigma + sigmai, sigma, vverti, & ! input/output !DDsigma do_aw, do_awdd, flx_form) ! ! @@ -432,6 +437,10 @@ subroutine cs_conv_run( IJSDIM , KMAX , ntracp1 , NN, & t(i,k) = GDT(i,k) + GTT(i,k) * delta u(i,k) = GDU(i,k) + GTU(i,k) * delta v(i,k) = GDV(i,k) + GTV(i,k) * delta +! Set the mass fluxes. + ud_mf (i,k) = GMFX0(i,k) + dd_mf (i,k) = GMFX1(i,k) + dt_mf (i,k) = CMDET(i,k) enddo enddo @@ -458,8 +467,8 @@ subroutine cs_conv_run( IJSDIM , KMAX , ntracp1 , NN, & ! CNV_PRC3(i,k) = 0.0 CNV_NDROP(i,k) = 0.0 CNV_NICE(i,k) = 0.0 - cf_upi(i,k) = max(0.0, min(1.0, 0.5*(sigma(i,k)+sigma(i,kp1)))) - CLCN(i,k) = cf_upi(i,k) !downdraft is below updraft + cf_upi(i,k) = max(0.0,min(0.01*log(1.0+500*ud_mf(i,k)),0.1)) +! CLCN(i,k) = cf_upi(i,k) !downdraft is below updraft !! clcn(i,k) = max(0.0,min(0.01*log(1.0+500*ud_mf(i,k)/delta),0.25)) w_upi(i,k) = 0.0 @@ -492,9 +501,9 @@ subroutine cs_conv_run( IJSDIM , KMAX , ntracp1 , NN, & ! CNV_PRC3(i,k) = 0.0 CNV_NDROP(i,k) = 0.0 CNV_NICE(i,k) = 0.0 - cf_upi(i,k) = max(0.0,min(0.01*log(1.0+500*ud_mf(i,k)),0.25)) + cf_upi(i,k) = max(0.0,min(0.01*log(1.0+500*ud_mf(i,k)),0.1)) ! & 500*ud_mf(i,k)),0.60)) - CLCN(i,k) = cf_upi(i,k) !downdraft is below updraft +! CLCN(i,k) = cf_upi(i,k) !downdraft is below updraft w_upi(i,k) = ud_mf(i,k)*(t(i,k)+epsvt*gdq(i,k,1)) * rair & / (max(cf_upi(i,k),1.e-12)*gdp(i,k)) @@ -586,11 +595,11 @@ SUBROUTINE CS_CUMLUS (im , IJSDIM, KMAX , NTR , & !DD dimensions GDT , GDQ , GDU , GDV , & ! input GDTM , & ! input GDP , GDPM , GDZ , GDZM , & ! input - delp , delpi , & + delp , delpinv , & DELTA , DELTI , ISTS , IENS, mype,& ! input fscav, fswtr, wcbmaxm, nctp, & ! - sigma, vverti, & ! input/output !DDsigma - do_aw, do_awdd, flx_form ) + sigmai, sigma, vverti, & ! input/output !DDsigma + do_aw, do_awdd, flx_form) ! IMPLICIT NONE @@ -598,6 +607,8 @@ SUBROUTINE CS_CUMLUS (im , IJSDIM, KMAX , NTR , & !DD dimensions INTEGER, INTENT(IN) :: im, IJSDIM, KMAX, NTR, mype, nctp, ipr !! DD, for GFS, pass in logical, intent(in) :: do_aw, do_awdd, flx_form ! switch to apply Arakawa-Wu to the tendencies logical, intent(in) :: otspt1(ntr), otspt2(ntr), lprnt + REAL(kind_phys),intent(in) :: DELP (IJSDIM, KMAX) + REAL(kind_phys),intent(in) :: DELPINV (IJSDIM, KMAX) ! ! [OUTPUT] REAL(kind_phys), INTENT(OUT) :: GTT (IJSDIM, KMAX ) ! heating rate @@ -605,35 +616,35 @@ SUBROUTINE CS_CUMLUS (im , IJSDIM, KMAX , NTR , & !DD dimensions REAL(kind_phys), INTENT(OUT) :: GTU (IJSDIM, KMAX ) ! tendency of u REAL(kind_phys), INTENT(OUT) :: GTV (IJSDIM, KMAX ) ! tendency of v REAL(kind_phys), INTENT(OUT) :: CMDET (IJSDIM, KMAX ) ! detrainment mass flux - + REAL(kind_phys) :: GTLDET( IJSDIM, KMAX ) ! cloud liquid tendency by detrainment + REAL(kind_phys) :: GTIDET( IJSDIM, KMAX ) ! cloud ice tendency by detrainment ! assuming there is no flux at the top of the atmospherea - Moorthi - REAL(kind_phys), INTENT(OUT) :: GTPRP (IJSDIM, KMAX ) ! rain+snow flux - REAL(kind_phys), INTENT(OUT) :: GSNWP (IJSDIM, KMAX ) ! snowfall flux - REAL(kind_phys), INTENT(OUT) :: GMFX0 (IJSDIM, KMAX ) ! updraft mass flux - REAL(kind_phys), INTENT(OUT) :: GMFX1 (IJSDIM, KMAX ) ! downdraft mass flux + REAL(kind_phys), INTENT(OUT) :: GTPRP (IJSDIM, KMAX+1 ) ! rain+snow flux + REAL(kind_phys), INTENT(OUT) :: GSNWP (IJSDIM, KMAX+1 ) ! snowfall flux + REAL(kind_phys), INTENT(OUT) :: GMFX0 (IJSDIM, KMAX+1 ) ! updraft mass flux + REAL(kind_phys), INTENT(OUT) :: GMFX1 (IJSDIM, KMAX+1 ) ! downdraft mass flux REAL(kind_phys), INTENT(OUT) :: CAPE (IJSDIM ) INTEGER , INTENT(OUT) :: KT (IJSDIM, NCTP ) ! cloud top ! ! [MODIFIED] - REAL(kind_phys), INTENT(INOUT) :: CBMFX (IM, NCTP) ! cloud base mass flux - -!DDsigma - output added for AW sigma diagnostics -! sigma and vert. velocity as a function of cloud type (1==sfc) - real(kind_phys), intent(out), dimension(IM,KMAX) :: sigma !sigma totaled over cloud type - on interfaces (1=sfc) - real(kind_phys), intent(out), dimension(IM,KMAX,nctp) :: vverti + REAL(kind_phys), INTENT(INOUT) :: CBMFX ( IM, NCTP ) !! cloud base mass flux + !DDsigma - output added for AW sigma diagnostics + real(kind_phys), intent(out) :: sigmai(IM,KMAX+1,nctp) !DDsigma sigma by cloud type - on interfaces (1=sfc) + real(kind_phys), intent(out) :: vverti(IM,KMAX+1,nctp) !DDsigma vert. vel. by cloud type - on interfaces (1=sfc) + real(kind_phys), intent(out) :: sigma(IM,KMAX+1) !DDsigma sigma totaled over cloud type - on interfaces (1=sfc) + ! for computing AW flux form of tendencies -! The tendencies are summed over all cloud types -! real(kind_phys), intent(out), dimension(IM,KMAX) :: & !DDsigmadiag - real(kind_phys), allocatable, dimension(:,:) :: sfluxterm, qvfluxterm,& ! tendencies of DSE and water vapor due to eddy mass flux - qlfluxterm, qifluxterm,& ! tendencies of cloud water and cloud ice due to eddy mass flux +! real(kind_phys), dimension(IM,KMAX) :: & !DDsigmadiag +! sfluxterm, qvfluxterm +! real(kind_phys), dimension(IM,KMAX) :: & !DDsigmadiag +! qlfluxterm, qifluxterm +! real(kind_phys), dimension(ijsdim,kmax,ntrq:ntr) :: trfluxterm ! tendencies of tracers due to eddy mass flux + real(kind_phys), dimension(IM,KMAX) :: & !DDsigmadiag + condtermt, condtermq, frzterm, prectermq, prectermfrz + !DDsigma -! The fluxes are for an individual cloud type and reused. -! condtermt, condtermq are eddy flux of temperature and water vapor - condtermt, condtermq, frzterm, & - prectermq, prectermfrz - real(kind_phys), allocatable, dimension(:,:,:) :: trfluxterm ! tendencies of tracers due to eddy mass flux ! ! [INPUT] REAL(kind_phys), INTENT(IN) :: GDT (IJSDIM, KMAX ) ! temperature T @@ -653,137 +664,144 @@ SUBROUTINE CS_CUMLUS (im , IJSDIM, KMAX , NTR , & !DD dimensions ! ! [INTERNAL WORK] REAL(kind_phys), allocatable :: GPRCC (:, :) ! rainfall -! REAL(kind_phys) GPRCC (IJSDIM, NTR) ! rainfall -! REAL(kind_phys) GSNWC (IJSDIM) ! snowfall -! REAL(kind_phys) CUMCLW(IJSDIM, KMAX) ! cloud water in cumulus -! REAL(kind_phys) CUMFRC(IJSDIM) ! cumulus cloud fraction -! -! REAL(kind_phys) GTCFRC(IJSDIM, KMAX) ! change in cloud fraction -! REAL(kind_phys) FLIQC (IJSDIM, KMAX) ! liquid ratio in cumulus -! -! REAL(kind_phys) GDCFRC(IJSDIM, KMAX) ! cloud fraction -! - REAL(kind_phys) GDW (IJSDIM, KMAX) ! total water - REAL(kind_phys) DELP (IJSDIM, KMAX) - REAL(kind_phys) DELPI (IJSDIM, KMAX) - REAL(kind_phys) GDQS (IJSDIM, KMAX) ! saturate moisture - REAL(kind_phys) FDQS (IJSDIM, KMAX) - REAL(kind_phys) GAM (IJSDIM, KMAX) - REAL(kind_phys) GDS (IJSDIM, KMAX) ! dry static energy - REAL(kind_phys) GDH (IJSDIM, KMAX) ! moist static energy - REAL(kind_phys) GDHS (IJSDIM, KMAX) ! saturate MSE -! - REAL(kind_phys) GCYM (IJSDIM, KMAX, NCTP)! norm. mass flux (half lev) - REAL(kind_phys) GCHB (IJSDIM) ! cloud base MSE-Li*Qi - REAL(kind_phys) GCWB (IJSDIM) ! cloud base total water - REAL(kind_phys) GCUB (IJSDIM) ! cloud base U - REAL(kind_phys) GCVB (IJSDIM) ! cloud base V - REAL(kind_phys) GCIB (IJSDIM) ! cloud base ice - REAL(kind_phys) GCtrB (IJSDIM,ntrq:ntr) ! cloud base tracer - REAL(kind_phys) GCYT (IJSDIM, NCTP) ! norm. mass flux @top - REAL(kind_phys) GCHT (IJSDIM, NCTP) ! cloud top MSE - REAL(kind_phys) GCQT (IJSDIM, NCTP) ! cloud top q - REAL(kind_phys) GCwT (IJSDIM) ! cloud top total water - REAL(kind_phys) GCUT (IJSDIM, NCTP) ! cloud top U - REAL(kind_phys) GCVT (IJSDIM, NCTP) ! cloud top V - REAL(kind_phys) GCLT (IJSDIM, NCTP) ! cloud top cloud water - REAL(kind_phys) GCIT (IJSDIM, NCTP) ! cloud top cloud ice + REAL(kind_phys) GSNWC ( IJSDIM ) ! snowfall + REAL(kind_phys) CUMCLW( IJSDIM, KMAX ) ! cloud water in cumulus + REAL(kind_phys) CUMFRC( IJSDIM ) ! cumulus cloud fraction +!COSP + REAL(kind_phys) QLIQC ( IJSDIM, KMAX ) ! cumulus cloud liquid water [kg/kg] + REAL(kind_phys) QICEC ( IJSDIM, KMAX ) ! cumulus cloud ice [kg/kg] + REAL(kind_phys) GPRCPF( IJSDIM, KMAX ) ! rainfall flux at full level + REAL(kind_phys) GSNWPF( IJSDIM, KMAX ) ! snowfall flux at full level +! + REAL(kind_phys) GTCFRC( IJSDIM, KMAX ) ! change in cloud fraction + REAL(kind_phys) FLIQC ( IJSDIM, KMAX ) ! liquid ratio in cumulus +! +!#ifdef OPT_CHASER +! REAL(kind_phys) RFXC ( IJSDIM, KMAX+1 ) ! precipi. flx [kg/m2/s] +! REAL(kind_phys) SFXC ( IJSDIM, KMAX+1 ) ! ice/snow flx [kg/m2/s] +! INTEGER LEVCUM( IJSDIM, KMAX ) ! flag for cum. cloud top +! REAL(kind_phys) LNFRC ( IJSDIM, KMAX ) ! areal rates of clouds +! REAL(kind_phys) REVC ( IJSDIM, KMAX ) ! evaporation rates +!#endif +! + REAL(kind_phys) GDCFRC( IJSDIM, KMAX ) ! cloud fraction +! +! REAL(kind_phys) GTQL ( IJSDIM, KMAX ) ! tendency of cloud liquid +! + REAL(kind_phys) GDW ( IJSDIM, KMAX ) ! total water + REAL(kind_phys) GDQS ( IJSDIM, KMAX ) ! saturate moisture + REAL(kind_phys) FDQS ( IJSDIM, KMAX ) + REAL(kind_phys) GAM ( IJSDIM, KMAX ) + REAL(kind_phys) GDS ( IJSDIM, KMAX ) ! dry static energy + REAL(kind_phys) GDH ( IJSDIM, KMAX ) ! moist static energy + REAL(kind_phys) GDHS ( IJSDIM, KMAX ) ! saturate MSE +! + REAL(kind_phys) GCYM ( IJSDIM, KMAX, NCTP ) ! norm. mass flux (half lev) + REAL(kind_phys) GCHB ( IJSDIM ) ! cloud base MSE-Li*Qi + REAL(kind_phys) GCWB ( IJSDIM ) ! cloud base total water + REAL(kind_phys) GCtrB ( IJSDIM, ntrq:ntr ) ! cloud base water vapor tracer + REAL(kind_phys) GCUB ( IJSDIM ) ! cloud base U + REAL(kind_phys) GCVB ( IJSDIM ) ! cloud base V + REAL(kind_phys) GCIB ( IJSDIM ) ! cloud base ice + REAL(kind_phys) ELAM ( IJSDIM, KMAX, NCTP ) ! entrainment (rate*massflux) + REAL(kind_phys) GCYT ( IJSDIM, NCTP ) ! norm. mass flux @top + REAL(kind_phys) GCHT ( IJSDIM, NCTP ) ! cloud top MSE + REAL(kind_phys) GCQT ( IJSDIM, NCTP ) ! cloud top q + REAL(kind_phys) GCwT ( IJSDIM ) ! cloud top total water + REAL(kind_phys) GCUT ( IJSDIM, NCTP ) ! cloud top U + REAL(kind_phys) GCVT ( IJSDIM, NCTP ) ! cloud top V + REAL(kind_phys) GCLT ( IJSDIM, NCTP ) ! cloud top cloud water + REAL(kind_phys) GCIT ( IJSDIM, NCTP ) ! cloud top cloud ice REAL(kind_phys) GCtrT (IJSDIM, ntrq:ntr, NCTP) ! cloud top tracer - REAL(kind_phys) GTPRT (IJSDIM, NCTP) ! precipitation/M - REAL(kind_phys) GCLZ (IJSDIM, KMAX) ! cloud liquid for each CTP - REAL(kind_phys) GCIZ (IJSDIM, KMAX) ! cloud ice for each CTP - -! REAL(kind_phys) ACWF (IJSDIM, NCTP) ! cloud work function - REAL(kind_phys) ACWF (IJSDIM ) ! cloud work function - REAL(kind_phys) GPRCIZ(IJSDIM, KMAX) ! precipitation - REAL(kind_phys) GSNWIZ(IJSDIM, KMAX) ! snowfall - REAL(kind_phys) GTPRC0(IJSDIM) ! precip. before evap. - - REAL(kind_phys) GMFLX (IJSDIM, KMAX) ! mass flux (updraft+downdraft) - REAL(kind_phys) QLIQ (IJSDIM, KMAX) ! total cloud liquid - REAL(kind_phys) QICE (IJSDIM, KMAX) ! total cloud ice - REAL(kind_phys) GPRCI (IJSDIM, KMAX) ! rainfall generation - REAL(kind_phys) GSNWI (IJSDIM, KMAX) ! snowfall generation - - REAL(kind_phys) GPRCP (IJSDIM, KMAX) ! rainfall flux -! - REAL(kind_phys) GTEVP (IJSDIM, KMAX) ! evaporation+sublimation - REAL(kind_phys) GMDD (IJSDIM, KMAX) ! downdraft mass flux - -! REAL(kind_phys) CUMHGT(IJSDIM, NCTP) ! cloud top height -! REAL(kind_phys) CTOPP (IJSDIM) ! cloud top pressure - - REAL(kind_phys) GDZTR (IJSDIM) ! tropopause height -! REAL(kind_phys) FLIQOU(IJSDIM, KMAX) ! liquid ratio in cumulus - INTEGER KB (IJSDIM) - INTEGER KSTRT (IJSDIM) ! tropopause level - REAL(kind_phys) GAMX - REAL(kind_phys) CIN (IJSDIM) - INTEGER JBUOY (IJSDIM) - REAL(kind_phys) DELZ, BUOY, DELWC, DELER - REAL(kind_phys) WCBX (IJSDIM) -! REAL(kind_phys) ERMR (NCTP) ! entrainment rate (ASMODE) -! SAVE ERMR - INTEGER KTMX (NCTP) ! max of cloud top - INTEGER KTMXT ! max of cloud top -! REAL(kind_phys) TIMED - REAL(kind_phys) GDCLDX, GDMU2X, GDMU3X -! -! REAL(kind_phys) HBGT (IJSDIM) ! imbalance in column heat -! REAL(kind_phys) WBGT (IJSDIM) ! imbalance in column water + REAL(kind_phys) GTPRT ( IJSDIM, NCTP ) ! precipitation/M + REAL(kind_phys) GCLZ ( IJSDIM, KMAX ) ! cloud liquid for each CTP + REAL(kind_phys) GCIZ ( IJSDIM, KMAX ) ! cloud ice for each CTP + + REAL(kind_phys) ACWF ( IJSDIM ) ! cloud work function + REAL(kind_phys) GPRCIZ( IJSDIM, KMAX+1, NCTP ) ! precipitation + REAL(kind_phys) GSNWIZ( IJSDIM, KMAX+1, NCTP ) ! snowfall + REAL(kind_phys) GTPRC0( IJSDIM ) ! precip. before evap. + + REAL(kind_phys) GMFLX ( IJSDIM, KMAX+1 ) ! mass flux (updraft+downdraft) + REAL(kind_phys) QLIQ ( IJSDIM, KMAX ) ! total cloud liquid + REAL(kind_phys) QICE ( IJSDIM, KMAX ) ! total cloud ice + REAL(kind_phys) GPRCI ( IJSDIM, KMAX ) ! rainfall generation + REAL(kind_phys) GSNWI ( IJSDIM, KMAX ) ! snowfall generation + + REAL(kind_phys) GPRCP ( IJSDIM, KMAX+1 ) ! rainfall flux +! + REAL(kind_phys) GTEVP ( IJSDIM, KMAX ) ! evaporation+sublimation + REAL(kind_phys) GMDD ( IJSDIM, KMAX+1 ) ! downdraft mass flux + + REAL(kind_phys) CUMHGT( IJSDIM, NCTP ) ! cloud top height + REAL(kind_phys) CTOPP ( IJSDIM ) ! cloud top pressure + + REAL(kind_phys) GDZTR ( IJSDIM ) ! tropopause height + REAL(kind_phys) FLIQOU( IJSDIM, KMAX ) ! liquid ratio in cumulus +!#ifdef OPT_CHASER +! REAL(kind_phys) TOPFLX( IJSDIM, NCTP ) !! flux at each cloud top +!#endif + INTEGER KB ( IJSDIM ) + INTEGER KSTRT ( IJSDIM ) ! tropopause level + REAL(kind_phys) GAMX + REAL(kind_phys) CIN ( IJSDIM ) + INTEGER JBUOY ( IJSDIM ) + REAL(kind_phys) DELZ, BUOY, DELWC, DELER +!M REAL(kind_phys) WCB ( NCTP ) ! updraft velocity**2 @base +!M SAVE WCB + REAL(kind_phys) WCBX (IJSDIM) +! REAL(kind_phys) ERMR ( NCTP ) ! entrainment rate (ASMODE) +! SAVE ERMR + INTEGER KTMX ( NCTP ) ! max of cloud top + INTEGER KTMXT ! max of cloud top + REAL(kind_phys) TIMED + REAL(kind_phys) GDCLDX, GDMU2X, GDMU3X +! + LOGICAL OOUT1, OOUT2 + INTEGER KBMX, I, K, CTP, ierr, n, kp1, l, l1, kk, kbi, kmi, km1 + real(kind_phys) tem1, tem2, tem3, cbmfl, mflx_e, teme, tems + + REAL(kind_phys) HBGT ( IJSDIM ) ! imbalance in column heat + REAL(kind_phys) WBGT ( IJSDIM ) ! imbalance in column water -!DDsigma begin local work variables - all on model interfaces (sfc=1) - REAL(kind_phys) lamdai ! lamda for cloud type ctp - REAL(kind_phys) gdqm, gdlm, gdim ! water vapor + !DDsigma begin local work variables - all on model interfaces (sfc=1) + REAL(kind_phys) lamdai( IJSDIM, KMAX+1, nctp ) ! lamda for cloud type ctp + REAL(kind_phys) lamdaprod( IJSDIM, KMAX+1 ) ! product of (1+lamda) through cloud type ctp + REAL(kind_phys) gdrhom ! density + REAL(kind_phys) gdtvm ! virtual temperature + REAL(kind_phys) gdqm, gdwm,gdlm, gdim ! water vaper REAL(kind_phys) gdtrm(ntrq:ntr) ! tracer - -! the following are new arguments to cumup to get them out for AW - REAL(kind_phys) wcv (IJSDIM, KMAX) ! in-cloud vertical velocity - REAL(kind_phys) GCTM (IJSDIM, KMAX) ! cloud T (half lev) !DDsigmadiag make output - REAL(kind_phys) GCQM (IJSDIM, KMAX) ! cloud q (half lev) !DDsigmadiag make output - REAL(kind_phys) GCwM (IJSDIM, KMAX) ! cloud q (half lev) !DDsigmadiag make output - REAL(kind_phys) GCiM (IJSDIM, KMAX) ! cloud q (half lev) !DDsigmadiag make output - REAL(kind_phys) GClM (IJSDIM, KMAX) ! cloud q (half lev) !DDsigmadiag make output - REAL(kind_phys) GChM (IJSDIM, KMAX) ! cloud q (half lev) !DDsigmadiag make output + character(len=4) :: cproc !DDsigmadiag + + ! the following are new arguments to cumup to get them out + REAL(kind_phys) wcv( IJSDIM, KMAX+1, nctp) ! in-cloud vertical velocity + REAL(kind_phys) GCTM ( IJSDIM, KMAX+1 ) ! cloud T (half lev) !DDsigmadiag make output + REAL(kind_phys) GCQM ( IJSDIM, KMAX+1, nctp ) ! cloud q (half lev) !DDsigmadiag make output + REAL(kind_phys) GCwM ( IJSDIM, KMAX+1, nctp ) ! cloud q (half lev) !DDsigmadiag make output + REAL(kind_phys) GCiM ( IJSDIM, KMAX+1 ) ! cloud q (half lev) !DDsigmadiag make output + REAL(kind_phys) GClM ( IJSDIM, KMAX+1 ) ! cloud q (half lev) !DDsigmadiag make output + REAL(kind_phys) GChM ( IJSDIM, KMAX+1, nctp ) ! cloud q (half lev) !DDsigmadiag make output REAL(kind_phys) GCtrM (IJSDIM, KMAX, ntrq:ntr) ! cloud tracer (half lev) !DDsigmadiag make output - -! eddy flux profiles for dse, water vapor, cloud water, cloud ice - REAL(kind_phys), dimension(Kmax+1) :: sfluxtem, qvfluxtem, qlfluxtem, qifluxtem - REAL(kind_phys), dimension(Kmax+1,ntrq:ntr) :: trfluxtem ! tracer - -! tendency profiles - condensation heating, condensation moistening, heating due to -! freezing, total precip production, frozen precip production - REAL(kind_phys), dimension(ijsdim,Kmax) :: dtcondtem, dqcondtem, dtfrztem, dqprectem,& ! Moorthi - dfrzprectem, lamdaprod !< product of (1+lamda) through cloud type ctp - REAL(kind_phys), dimension(ijsdim,Kmax) :: dtevap, dqevap, dtmelt, dtsubl - -! factor to modify precip rate to force conservation of water. With bug fixes it's -! not doing anything now. - REAL(kind_phys), dimension(ijsdim) :: moistening_aw - real(kind_phys), dimension(ijsdim,kmax) :: gctbl, gcqbl,gcwbl, gcqlbl, gcqibl, & !DDsigmadiag updraft profiles below cloud Base - sigmad ! downdraft area fraction + +! these are the fluxes at the interfaces - AW will operate on them + REAL(kind_phys), dimension(ijsdim,Kmax+1,nctp) :: sfluxtem, qvfluxtem, qlfluxtem, qifluxtem + REAL(kind_phys), dimension(ijsdim,Kmax+1,ntrq:ntr,nctp) :: trfluxtem ! tracer + + REAL(kind_phys), dimension(ijsdim,Kmax+1) :: dtcondtem, dqcondtem, dtfrztem, dqprectem,dfrzprectem + REAL(kind_phys), dimension(ijsdim,Kmax) :: dtevap, dqevap, dtmelt, dtsubl + REAL(kind_phys), dimension(ijsdim) :: moistening_aw + real(kind_phys) rhs_q, rhs_h, sftem, qftem, qlftem, qiftem + real(kind_phys), dimension(ijsdim,kmax+1) :: gctbl, gcqbl,gcwbl, gcqlbl, gcqibl !DDsigmadiag updraft profiles below cloud Base real(kind_phys), dimension(ijsdim,kmax,ntrq:ntr) :: gctrbl !DDsigmadiag tracer updraft profiles below cloud Base -! rhs_q, rhs_h are residuals of condensed water, MSE budgets to compute condensation, -! and heating due to freezing - real(kind_phys) :: rhs_q, rhs_h, fsigma, sigmai, delpinv -! real(kind_phys) :: rhs_q, rhs_h, sftem, qftem, qlftem, qiftem, & -! fsigma ! factor to reduce mass flux terms (1-sigma**2) for AW -!DDsigma end local work variables -! -! profiles of heating due to precip evaporation, melting and sublimation, and the -! evap, melting and sublimation rates. - - REAL(kind_phys), allocatable, dimension(:,:) :: dtdwn, & ! t tendency downdraft detrainment - dqvdwn, & ! qv tendency downdraft detrainment - dqldwn, & ! ql tendency downdraft detrainment - dqidwn ! qi tendency downdraft detrainment - REAL(kind_phys), allocatable, dimension(:,:,:) :: dtrdwn ! tracer tendency downdraft detrainment - + real(kind_phys), dimension(ijsdim,kmax+1) :: sigmad + real(kind_phys) :: fsigma( IJSDIM, KMAX+1 ) ! factor to reduce mass flux terms (1-sigma**2) for AW + real(kind_phys) :: lamdamax ! for sorting lamda values + integer loclamdamax + real(kind_phys) :: pr_tot, pr_ice, pr_liq !DDsigma end local work variables ! ! [INTERNAL PARM] - REAL(kind_phys), parameter :: WCBMIN = zero ! min. of updraft velocity at cloud base - + REAL(kind_phys) :: WCBMIN = 0._kind_phys ! min. of updraft velocity at cloud base !M REAL(kind_phys) :: WCBMAX = 1.4_kind_phys ! max. of updraft velocity at cloud base !M wcbas commented by Moorthi since it is not used !M REAL(kind_phys) :: WCBAS = 2._kind_phys ! updraft velocity**2 at cloud base (ASMODE) @@ -791,22 +809,35 @@ SUBROUTINE CS_CUMLUS (im , IJSDIM, KMAX , NTR , & !DD dimensions ! used only in OPT_ASMODE !M REAL(kind_phys) :: ERAMAX = 2.e-3_kind_phys ! max. of entrainment rate ! used only in OPT_ASMODE - LOGICAL :: OINICB = .false. ! set 0.d0 to CBMFX when .true. +! downdraft mass flux terms now slot nctp+1 in the *fluxterm arrays + REAL(kind_phys) dtdwn ( IJSDIM, KMAX ) ! t tendency downdraft detrainment + REAL(kind_phys) dqvdwn ( IJSDIM, KMAX ) ! qv tendency downdraft detrainment + REAL(kind_phys) dqldwn ( IJSDIM, KMAX ) ! ql tendency downdraft detrainment + REAL(kind_phys) dqidwn ( IJSDIM, KMAX ) ! qi tendency downdraft detrainment + REAL(kind_phys), dimension(ijsdim,kmax,ntrq:ntr) :: dtrdwn ! tracer tendency downdraft detrainment + + LOGICAL :: OINICB = .false. ! set 0.d0 to CBMFX -! REAL(kind_phys) :: VARMIN = 1.e-13_kind_phys ! minimum of PDF variance -! REAL(kind_phys) :: VARMAX = 5.e-7_kind_phys ! maximum of PDF variance -! REAL(kind_phys) :: SKWMAX = 0.566_kind_phys ! maximum of PDF skewness + REAL(kind_phys) :: VARMIN = 1.e-13_kind_phys ! minimum of PDF variance + REAL(kind_phys) :: VARMAX = 5.e-7_kind_phys ! maximum of PDF variance + REAL(kind_phys) :: SKWMAX = 0.566_kind_phys ! maximum of PDF skewness - REAL(kind_phys) :: PSTRMX = 400.e2_kind_phys ! max P of tropopause - REAL(kind_phys) :: PSTRMN = 50.e2_kind_phys ! min P of tropopause - REAL(kind_phys) :: GCRSTR = 1.e-4_kind_phys ! crit. dT/dz tropopause + REAL(kind_phys) :: PSTRMX = 400.e2_kind_phys ! max P of tropopause + REAL(kind_phys) :: PSTRMN = 50.e2_kind_phys ! min P of tropopause + REAL(kind_phys) :: GCRSTR = 1.e-4_kind_phys ! crit. dT/dz tropopause - real(kind=kind_phys) :: tem, esat, mflx_e, cbmfl, tem1, tem2, tem3 - INTEGER :: KBMX, I, K, CTP, ierr, n, kp1, km1, kk, kbi, l, l1 + ! 0: mass fixer is not applied + ! tracers which may become negative values + ! e.g. subgrid-PDFs + ! 1: mass fixer is applied, total mass may change through cumulus scheme + ! e.g. moisture, liquid cloud, ice cloud, aerosols + ! 2: mass fixer is applied, total mass never change through cumulus scheme + ! e.g. CO2 + real(kind=kind_phys), parameter :: zero=0.0, one=1.0 + real(kind=kind_phys) :: tem, esat ! - LOGICAL, SAVE :: OFIRST = .TRUE. ! called first time? + LOGICAL, SAVE :: OFIRST = .TRUE. ! called first time? ! - IF (OFIRST) THEN OFIRST = .FALSE. IF (OINICB) THEN @@ -814,6 +845,8 @@ SUBROUTINE CS_CUMLUS (im , IJSDIM, KMAX , NTR , & !DD dimensions ENDIF ENDIF ! + + kp1 = kmax + 1 do n=1,ntr do k=1,kmax do i=1,ijsdim @@ -821,65 +854,82 @@ SUBROUTINE CS_CUMLUS (im , IJSDIM, KMAX , NTR , & !DD dimensions enddo enddo enddo - + do k=1,kmax+1 + do i=1,ijsdim + gmflx(i,k) = zero + gmfx0(i,k) = zero + enddo + enddo do k=1,kmax do i=1,ijsdim - gtt(i,k) = zero - gtu(i,k) = zero - gtv(i,k) = zero - gmflx(i,k) = zero - gmfx0(i,k) = zero - gprci(i,k) = zero - gsnwi(i,k) = zero - qliq(i,k) = zero - qice(i,k) = zero -! gtcfrc(i,k) = zero -! cumclw(i,k) = zero -! fliqc(i,k) = zero - sigma(i,k) = zero + gtt(i,k) = zero + gtu(i,k) = zero + gtv(i,k) = zero + gprci(i,k) = zero + gsnwi(i,k) = zero + qliq(i,k) = zero + qice(i,k) = zero +! gtcfrc(i,k) = zero +! cumclw(i,k) = zero +! fliqc(i,k) = zero + fliqou(i,k) = zero + gprcpf(i,k) = zero + gsnwpf(i,k) = zero + cmdet(i,k) = zero enddo enddo if (flx_form) then - allocate(sfluxterm(ijsdim,kmax), qvfluxterm(ijsdim,kmax), qlfluxterm(ijsdim,kmax), & - qifluxterm(ijsdim,kmax), condtermt(ijsdim,kmax), condtermq(ijsdim,kmax), & - frzterm(ijsdim,kmax), prectermq(ijsdim,kmax), prectermfrz(ijsdim,kmax), & - dtdwn(ijsdim,kmax), dqvdwn(ijsdim,kmax), dqldwn(ijsdim,kmax), & - dqidwn(ijsdim,kmax), trfluxterm(ijsdim,kmax,ntrq:ntr), & - dtrdwn(ijsdim,kmax,ntrq:ntr)) - do k=1,kmax - do i=1,ijsdim - sfluxterm(i,k) = zero - qvfluxterm(i,k) = zero - qlfluxterm(i,k) = zero - qifluxterm(i,k) = zero - condtermt(i,k) = zero - condtermq(i,k) = zero - frzterm(i,k) = zero - prectermq(i,k) = zero - prectermfrz(i,k) = zero - dtdwn(i,k) = zero - dqvdwn(i,k) = zero - dqldwn(i,k) = zero - dqidwn(i,k) = zero - cmdet(i,k) = zero + do ctp = 1,nctp + do k=1,kp1 + do i=1,ijsdim + sfluxtem(i,k,ctp) = zero + qvfluxtem(i,k,ctp) = zero + qlfluxtem(i,k,ctp) = zero + qifluxtem(i,k,ctp) = zero + enddo + enddo + do n = ntrq,ntr + do k=1,kp1 + do i=1,ijsdim + trfluxtem(i,k,n,ctp) = zero + enddo + enddo enddo enddo - do n = ntrq,ntr do k=1,kmax do i=1,ijsdim - trfluxterm(i,k,n) = zero - dtrdwn(i,k,n) = zero + condtermt(i,k) = zero + condtermq(i,k) = zero + frzterm(i,k) = zero + prectermq(i,k) = zero + prectermfrz(i,k) = zero enddo enddo - enddo + do k=1,kmax + do i=1,ijsdim + dtdwn(i,k) = zero + dqvdwn(i,k) = zero + dqldwn(i,k) = zero + dqidwn(i,k) = zero + enddo + enddo + do n = ntrq,ntr + do k=1,kmax + do i=1,ijsdim + dtrdwn(i,k,n) = zero + enddo + enddo + enddo endif do i=1,ijsdim -! gprcc(i,:) = zero - gtprc0(i) = zero -! hbgt(i) = zero -! wbgt(i) = zero - gdztr(i) = zero - kstrt(i) = kmax +! gprcc(i,:) = zero +! gmflx(i,kp1) = zero + gmfx0(i,kp1) = zero + gtprc0(i) = zero +! hbgt(i) = zero +! wbgt(i) = zero + gdztr(i) = zero + kstrt(i) = kmax enddo do k=1,kmax @@ -907,9 +957,8 @@ SUBROUTINE CS_CUMLUS (im , IJSDIM, KMAX , NTR , & !DD dimensions ! !> -# Compute tropopause height (GDZTR) DO K=1,KMAX - kp1 = k + 1 DO I=ISTS,IENS - GAMX = (GDTM(I,KP1)-GDTM(I,K)) / (GDZM(I,KP1)-GDZM(I,K)) + GAMX = (GDTM(I,K+1)-GDTM(I,K)) / (GDZM(I,K+1)-GDZM(I,K)) IF ((GDP(I,K) < PSTRMX .AND. GAMX > GCRSTR) .OR. GDP(I,K) < PSTRMN) THEN KSTRT(I) = MIN(K, KSTRT(I)) ENDIF @@ -925,12 +974,12 @@ SUBROUTINE CS_CUMLUS (im , IJSDIM, KMAX , NTR , & !DD dimensions !> -# Call cumbas() to compute cloud base properties CALL CUMBAS(IJSDIM, KMAX , & !DD dimensions - KB , GCYM(1,1,1) , KBMX , & ! output + KB , GCYM(:,:,1) , KBMX , & ! output ntr , ntrq , & GCHB , GCWB , GCUB , GCVB , & ! output GCIB , gctrb, & ! output GDH , GDW , GDHS , GDQS , & ! input - GDQ(1,1,iti) , GDU , GDV , GDZM , & ! input + GDQ(:,:,iti) , GDU , GDV , GDZM , & ! input GDPM , FDQS , GAM , & ! input lprnt, ipr, & ISTS , IENS , & !) ! input @@ -955,7 +1004,7 @@ SUBROUTINE CS_CUMLUS (im , IJSDIM, KMAX , NTR , & !DD dimensions CAPE(I) = CAPE(I) + BUOY * GRAV * (GDZM(I,K+1) - GDZM(I,K)) JBUOY(I) = 2 ELSEIF (BUOY < zero .AND. JBUOY(I) /= 2) THEN - CIN(I) = CIN(I) - BUOY * GRAV * (GDZM(I,K+1) - GDZM(I,K)) + CIN(I) = CIN(I) + BUOY * GRAV * (GDZM(I,K+1) - GDZM(I,K)) JBUOY(I) = -1 ENDIF endif @@ -968,12 +1017,25 @@ SUBROUTINE CS_CUMLUS (im , IJSDIM, KMAX , NTR , & !DD dimensions !DDsigma some initialization before summing over cloud type !> -# Initialize variables before summing over cloud types - do k=1,kmax ! Moorthi + if(flx_form) then + do k=1,kp1 ! Moorthi do i=1,ijsdim lamdaprod(i,k) = one + sigma(i,k) = 0.0 enddo enddo + do ctp=1,nctp + do k=1,kp1 + do i=1,ijsdim + lamdai(i,k,ctp) = zero + sigmai(i,k,ctp) = zero + vverti(i,k,ctp) = zero + enddo + enddo + enddo + endif + do ctp=2,nctp do k=1,kmax do i=1,ijsdim @@ -990,15 +1052,6 @@ SUBROUTINE CS_CUMLUS (im , IJSDIM, KMAX , NTR , & !DD dimensions WCBX(I) = DELWC * DELWC enddo - do k=1,kmax ! Moorthi - do i=1,ijsdim - dqcondtem(i,k) = zero - dqprectem(i,k) = zero - dfrzprectem(i,k) = zero - dtfrztem(i,k) = zero - dtcondtem(i,k) = zero - enddo - enddo ! getting more incloud profiles of variables to compute eddy flux tendencies ! and condensation rates @@ -1010,51 +1063,48 @@ SUBROUTINE CS_CUMLUS (im , IJSDIM, KMAX , NTR , & !DD dimensions !> -# Call cumup() to compute in-cloud properties CALL CUMUP(IJSDIM, KMAX, NTR, ntrq, & !DD dimensions ACWF , & ! output - GCLZ , GCIZ , GPRCIZ , GSNWIZ, & ! output - GCYT(1,CTP) , GCHT(1,CTP) , GCQT (1,CTP), & ! output - GCLT(1,CTP) , GCIT(1,CTP) , GTPRT(1,CTP), & ! output - GCUT(1,CTP) , GCVT(1,CTP) , gctrt(1,ntrq:ntr,ctp), & ! output - KT (1,CTP) , KTMX(CTP) , & ! output - GCYM(1,1,CTP) , & ! modified - wcv , & ! !DD-sigma new output + GCLZ , GCIZ , GPRCIZ(:,:,CTP), GSNWIZ(:,:,CTP), & ! output + GCYT(:,CTP) , GCHT(:,CTP) , GCQT (:,CTP), & ! output + GCLT(:,CTP) , GCIT(:,CTP) , GTPRT(:,CTP), & ! output + GCUT(:,CTP) , GCVT(:,CTP) , gctrt(:,ntrq:ntr,ctp), & ! output + KT (:,CTP) , KTMX(CTP) , & ! output + GCYM(:,:,CTP) , & ! modified + wcv(:,:,CTP) , & ! !DD-sigma new output GCHB , GCWB , GCUB , GCVB , & ! input !DDsigmadiag GCIB , gctrb , & ! input GDU , GDV , GDH , GDW , & ! input GDHS , GDQS , GDT , GDTM , & ! input - GDQ , GDQ(1,1,iti) , GDZ , GDZM , & ! input + GDQ , GDQ(:,:,iti) , GDZ , GDZM , & ! input GDPM , FDQS , GAM , GDZTR , & ! input CPRES , WCBX , & ! input KB , CTP , ISTS , IENS , & ! input - gctm , gcqm, gcwm, gchm, gcwt, gclm, gcim, gctrm, & ! additional incloud profiles and cloud top total water + gctm , gcqm(:,:,CTP), gcwm(:,:,CTP), gchm(:,:,CTP),& + gcwt, gclm, gcim, gctrm, & ! additional incloud profiles and cloud top total water lprnt , ipr ) ! !> -# Call cumbmx() to compute cloud base mass flux CALL CUMBMX(IJSDIM, KMAX, & !DD dimensions - CBMFX(1,CTP), & ! modified - ACWF , GCYT(1,CTP), GDZM , & ! input + CBMFX(:,CTP), & ! modified + ACWF , GCYT(:,CTP), GDZM , & ! input GDW , GDQS , DELP , & ! input - KT (1,CTP), KTMX(CTP) , KB , & ! input + KT (:,CTP), KTMX(CTP) , KB , & ! input DELTI , ISTS , IENS ) !DDsigma - begin sigma computation ! At this point cbmfx is updated and we have everything we need to compute sigma - do i=ISTS,IENS - if (flx_form) then -!> -# Initialize eddy fluxes for cloud types - do k=1,kmax+1 - sfluxtem(k) = zero - qvfluxtem(k) = zero - qlfluxtem(k) = zero - qifluxtem(k) = zero - enddo - do n=ntrq,ntr ! tracers - do k=1,kmax+1 - trfluxtem(k,n) = zero - enddo + if (flx_form) then + do k=1,kmax + 1 ! Moorthi + do i=1,ijsdim + dqcondtem(i,k) = zero + dqprectem(i,k) = zero + dfrzprectem(i,k) = zero + dtfrztem(i,k) = zero + dtcondtem(i,k) = zero enddo - endif + enddo + do i=ISTS,IENS cbmfl = cbmfx(i,ctp) kk = kt(i,ctp) ! cloud top index @@ -1062,56 +1112,54 @@ SUBROUTINE CS_CUMLUS (im , IJSDIM, KMAX , NTR , & !DD dimensions kbi = kb(i) ! cloud base index do k=kbi,kk ! loop from cloud base to cloud top km1 = k - 1 - rhs_h = zero - rhs_q = zero -!> -# Interpolate environment variables to layer interface +! get environment variables interpolated to layer interface GDQM = half * (GDQ(I,K,1) + GDQ(I,KM1,1)) ! as computed in cumup ! GDwM = half * (GDw(I,K) + GDw(I,KM1 )) - GDlM = half * (GDQ(I,K,3) + GDQ(I,KM1,3)) - GDiM = half * (GDQ(I,K,2) + GDQ(I,KM1,2)) + GDlM = half * (GDQ(I,K,itl) + GDQ(I,KM1,itl)) + GDiM = half * (GDQ(I,K,iti) + GDQ(I,KM1,iti)) do n = ntrq,NTR GDtrM(n) = half * (GDQ(I,K,n) + GDQ(I,KM1,n)) ! as computed in cumup enddo mflx_e = gcym(i,k,ctp) * cbmfl ! mass flux at level k for cloud ctp - if (do_aw) then !> -# Compute lamda for a cloud type and then updraft area fraction !! (sigmai) following Equations 23 and 12 of !! Arakawa and Wu (2013) \cite arakawa_and_wu_2013 , respectively - lamdai = mflx_e * rair * gdtm(i,k)*(one+epsvt*gdqm) & - / (gdpm(i,k)*wcv(i,k)) - lamdaprod(i,k) = lamdaprod(i,k) * (one+lamdai) - -! vverti(i,k,ctp) = wcv(i,k) -! sigmai(i,k,ctp) = lamdai / lamdaprod(i,k) -! sigma(i,k) = max(zero, min(one, sigma(i,k) + sigmai(i,k,ctp))) - - sigmai = lamdai / lamdaprod(i,k) - sigma(i,k) = max(zero, min(one, sigma(i,k) + sigmai)) - vverti(i,k,ctp) = sigmai * wcv(i,k) - else - sigma(i,k) = 0.0 - endif + lamdai(i,k,ctp) = mflx_e * rair * gdtm(i,k)*(one+epsvt*gdqm) & + / (gdpm(i,k)*wcv(i,k,ctp)) + +! just compute lamdai here, we will compute sigma, sigmai, and vverti outside +! the cloud type loop after we can sort lamdai +! lamdaprod(i,k) = lamdaprod(i,k) * (one+lamdai(i,k,ctp)) +! +!! vverti(i,k,ctp) = wcv(i,k) +!! sigmai(i,k,ctp) = lamdai / lamdaprod(i,k) +!! sigma(i,k) = max(zero, min(one, sigma(i,k) + sigmai(i,k,ctp))) +! +! sigmai(i,k,ctp) = lamdai(i,k,ctp) / lamdaprod(i,k) +! sigma(i,k) = max(zero, min(one, sigma(i,k) + sigmai(i,k,ctp))) +! vverti(i,k,ctp) = sigmai(i,k,ctp) * wcv(i,k,ctp) - if (flx_form) then +! sigma effect won't be applied until later, when lamda is sorted ! fsigma = 1.0 ! no aw effect, comment following lines to undo AW - fsigma = one - sigma(i,k) +! fsigma = one - sigma(i,k) !> -# Compute tendencies based on mass flux and condensation ! fsigma is the AW reduction of flux tendencies if(k == kbi) then do l=2,kbi ! compute eddy fluxes below cloud base - tem = - fsigma * gcym(i,l,ctp) * cbmfl +! tem = - fsigma * gcym(i,l,ctp) * cbmfl + tem = - gcym(i,l,ctp) * cbmfl ! first get environment variables at layer interface l1 = l - 1 GDQM = half * (GDQ(I,l,1) + GDQ(I,l1,1)) - GDlM = half * (GDQ(I,l,3) + GDQ(I,l1,3)) - GDiM = half * (GDQ(I,l,2) + GDQ(I,l1,2)) + GDlM = half * (GDQ(I,l,itl) + GDQ(I,l1,itl)) + GDiM = half * (GDQ(I,l,iti) + GDQ(I,l1,iti)) !! GDwM = half * (GDw(I,l) + GDw(I,l1)) do n = ntrq,NTR GDtrM(n) = half * (GDQ(I,l,n) + GDQ(I,l1,n)) ! as computed in cumup @@ -1119,12 +1167,12 @@ SUBROUTINE CS_CUMLUS (im , IJSDIM, KMAX , NTR , & !DD dimensions ! flux = mass flux * (updraft variable minus environment variable) !centered differences - sfluxtem(l) = tem * (gdtm(i,l)-gctbl(i,l)) - qvfluxtem(l) = tem * (gdqm-gcqbl(i,l)) - qlfluxtem(l) = tem * (gdlm-gcqlbl(i,l)) - qifluxtem(l) = tem * (gdim-gcqibl(i,l)) + sfluxtem(i,l,ctp) = tem * (gdtm(i,l)-gctbl(i,l)) + qvfluxtem(i,l,ctp) = tem * (gdqm-gcqbl(i,l)) + qlfluxtem(i,l,ctp) = tem * (gdlm-gcqlbl(i,l)) + qifluxtem(i,l,ctp) = tem * (gdim-gcqibl(i,l)) do n = ntrq,NTR - trfluxtem(l,n) = tem * (gdtrm(n)-gctrbl(i,l,n)) + trfluxtem(i,l,n,ctp) = tem * (gdtrm(n)-gctrbl(i,l,n)) enddo ! if(lprnt .and. i == ipr) write(0,*)' l=',l,' kbi=',kbi,' tem =', tem,' trfluxtem=',trfluxtem(l,ntr),& ! ' gdtrm=',gdtrm(ntr),' gctrbl=',gctrbl(i,l,ntr),' gq=',GDQ(I,l,ntr),GDQ(I,l1,ntr),' l1=',l1,' ctp=',ctp,& @@ -1146,14 +1194,15 @@ SUBROUTINE CS_CUMLUS (im , IJSDIM, KMAX , NTR , & !DD dimensions else ! flux = mass flux * (updraft variable minus environment variable) - tem = - fsigma * mflx_e +! tem = - fsigma * mflx_e + tem = - mflx_e !centered - sfluxtem(k) = tem * (gdtm(i,k)+gocp*gdzm(i,k)-gctm(i,k)) - qvfluxtem(k) = tem * (gdqm-gcqm(i,k)) - qlfluxtem(k) = tem * (gdlm-gclm(i,k)) - qifluxtem(k) = tem * (gdim-gcim(i,k)) + sfluxtem(i,k,ctp) = tem * (gdtm(i,k)+gocp*gdzm(i,k)-gctm(i,k)) + qvfluxtem(i,k,ctp) = tem * (gdqm-gcqm(i,k,ctp)) + qlfluxtem(i,k,ctp) = tem * (gdlm-gclm(i,k)) + qifluxtem(i,k,ctp) = tem * (gdim-gcim(i,k)) do n = ntrq,NTR - trfluxtem(k,n) = tem * (gdtrm(n)-gctrm(i,k,n)) + trfluxtem(i,k,n,ctp) = tem * (gdtrm(n)-gctrm(i,k,n)) enddo !upstream - This better matches what the original CS tendencies do @@ -1185,117 +1234,57 @@ SUBROUTINE CS_CUMLUS (im , IJSDIM, KMAX , NTR , & !DD dimensions ! ' fsigma=',fsigma,' mflx_e=',mflx_e,' trfluxtemk=',trfluxtem(k,ntr),' sigma=',sigma(i,k) -! the condensation terms - these come from the MSE and condensed water budgets for -! an entraining updraft -! if(k > kb(i)) then ! comment for test -! if(k <= kk) then ! Moorthi -! if(k < kt(i,ctp)) then -! rhs_h = cbmfl*(gcym(i,k)*gchm(i,k) - (gcym(i,km1)*gchm(i,km1) & -! + GDH(I,Km1 )*(gcym(i,k)-gcym(i,km1))) ) -! rhs_q = cbmfl*(gcym(i,k)*(gcwm(i,k)-gcqm(i,k)) & -! - (gcym(i,km1)*(gcwm(i,km1)-gcqm(i,km1)) & -! + (GDw( I,Km1 )-gdq(i,km1,1))*(gcym(i,k)-gcym(i,km1))) ) -! tem = cbmfl * (one - sigma(i,k)) - tem = cbmfl * (one - 0.5*(sigma(i,k)+sigma(i,km1))) - tem1 = gcym(i,k,ctp) * (one - sigma(i,k)) - tem2 = gcym(i,km1,ctp) * (one - sigma(i,km1)) - rhs_h = cbmfl * (tem1*gchm(i,k) - (tem2*gchm(i,km1) & - + GDH(I,Km1)*(tem1-tem2)) ) - rhs_q = cbmfl * (tem1*(gcwm(i,k)-gcqm(i,k)) & - - (tem2*(gcwm(i,km1)-gcqm(i,km1)) & - + (GDw(I,Km1)-gdq(i,km1,1))*(tem1-tem2)) ) - -! ELSE -! rhs_h = cbmfl*(gcht(i,ctp) - (gcym(i,k-1)*gchm(i,k-1) + GDH( I,K-1 )*(gcyt(i,ctp)-gcym(i,k-1))) ) -! rhs_q = cbmfl*((gcwt(i)-gcqt(i,ctp)) - (gcym(i,k-1)*(gcwm(i,k-1)-gcqm(i,k-1)) + (GDw( I,K-1 )-gdq(i,k-1,1))*(gcyt(i,ctp)-gcym(i,k-1))) ) -! endif - -!> -# Compute condensation, total precipitation production, frozen precipitation production, -!! heating due to freezing, and total temperature tendency due to in-cloud microphysics - dqcondtem(i,km1) = -rhs_q ! condensation -! dqprectem(i,km1) = cbmfl * (GPRCIZ(i,k) + GSNWIZ(i,k)) - dqprectem(i,km1) = tem * (GPRCIZ(i,k) + GSNWIZ(i,k)) ! total precip production -! dfrzprectem(i,km1) = cbmfl * GSNWIZ(i,k) - dfrzprectem(i,km1) = tem * GSNWIZ(i,k) ! production of frozen precip - dtfrztem(i,km1) = rhs_h*oneocp ! heating due to freezing - dtcondtem(i,km1) = - elocp * dqcondtem(i,km1) + dtfrztem(i,km1) - endif ! if(k > kbi) then - endif ! if (flx_form) enddo ! end of k=kbi,kk loop endif ! end of if(cbmfl > zero) -! get tendencies by difference of fluxes, sum over cloud type - - if (flx_form) then - do k = 1,kk - delpinv = delpi(i,k) -!> -# Sum single cloud microphysical tendencies over all cloud types - condtermt(i,k) = condtermt(i,k) + dtcondtem(i,k) * delpinv - condtermq(i,k) = condtermq(i,k) + dqcondtem(i,k) * delpinv - prectermq(i,k) = prectermq(i,k) + dqprectem(i,k) * delpinv - prectermfrz(i,k) = prectermfrz(i,k) + dfrzprectem(i,k) * delpinv - frzterm(i,k) = frzterm(i,k) + dtfrztem(i,k) * delpinv - -!> -# Compute flux tendencies and vertical flux divergence - sfluxterm(i,k) = sfluxterm(i,k) - (sfluxtem(k+1) - sfluxtem(k)) * delpinv - qvfluxterm(i,k) = qvfluxterm(i,k) - (qvfluxtem(k+1) - qvfluxtem(k)) * delpinv - qlfluxterm(i,k) = qlfluxterm(i,k) - (qlfluxtem(k+1) - qlfluxtem(k)) * delpinv - qifluxterm(i,k) = qifluxterm(i,k) - (qifluxtem(k+1) - qifluxtem(k)) * delpinv - do n = ntrq,ntr - trfluxterm(i,k,n) = trfluxterm(i,k,n) - (trfluxtem(k+1,n) - trfluxtem(k,n)) * delpinv - enddo -! if (lprnt .and. i == ipr) write(0,*)' k=',k,' trfluxtem=',trfluxtem(k+1,ntr),trfluxtem(k,ntr),& -! ' ctp=',ctp,' trfluxterm=',trfluxterm(i,k,ntr) - enddo - endif ! if (flx_form) enddo ! end of i loop -! - do i=ists,iens - if (cbmfx(i,ctp) > zero) then - tem = one - sigma(i,kt(i,ctp)) - gcyt(i,ctp) = tem * gcyt(i,ctp) - gtprt(i,ctp) = tem * gtprt(i,ctp) - gclt(i,ctp) = tem * gclt(i,ctp) - gcht(i,ctp) = tem * gcht(i,ctp) - gcqt(i,ctp) = tem * gcqt(i,ctp) - gcit(i,ctp) = tem * gcit(i,ctp) - if (.not. flx_form) then - do n = ntrq,ntr - gctrt(i,n,ctp) = tem * gctrt(i,n,ctp) - enddo - end if - gcut(i,ctp) = tem * gcut(i,ctp) - gcvt(i,ctp) = tem * gcvt(i,ctp) - do k=1,kmax - kk = kb(i) - if (k < kk) then - tem = one - sigma(i,kk) - tem1 = tem - else - tem = one - sigma(i,k) - tem1 = one - 0.5*(sigma(i,k)+sigma(i,k-1)) - endif - gcym(i,k,ctp) = tem * gcym(i,k,ctp) - gprciz(i,k) = tem1 * gprciz(i,k) - gsnwiz(i,k) = tem1 * gsnwiz(i,k) - gclz(i,k) = tem1 * gclz(i,k) - gciz(i,k) = tem1 * gciz(i,k) - enddo - endif - enddo + endif ! if (flx_form) +! +! we don't reduce these values in AW, just the tendencies due to fluxes +! do i=ists,iens +! if (cbmfx(i,ctp) > zero) then +! tem = one - sigma(i,kt(i,ctp)) +! gcyt(i,ctp) = tem * gcyt(i,ctp) +! gtprt(i,ctp) = tem * gtprt(i,ctp) +! gclt(i,ctp) = tem * gclt(i,ctp) +! gcht(i,ctp) = tem * gcht(i,ctp) +! gcqt(i,ctp) = tem * gcqt(i,ctp) +! gcit(i,ctp) = tem * gcit(i,ctp) +! do n = ntrq,ntr +! gctrt(i,n,ctp) = tem * gctrt(i,n,ctp) +! enddo +! gcut(i,ctp) = tem * gcut(i,ctp) +! gcvt(i,ctp) = tem * gcvt(i,ctp) +! do k=1,kmax +! kk = kb(i) +! if (k < kk) then +! tem = one - sigma(i,kk) +! tem1 = tem +! else +! tem = one - sigma(i,k) +! tem1 = one - 0.5*(sigma(i,k)+sigma(i,k-1)) +! endif +! gcym(i,k,ctp) = tem * gcym(i,k,ctp) +! gprciz(i,k) = tem1 * gprciz(i,k) +! gsnwiz(i,k) = tem1 * gsnwiz(i,k) +! gclz(i,k) = tem1 * gclz(i,k) +! gciz(i,k) = tem1 * gciz(i,k) +! enddo +! endif +! enddo ! !> -# Call cumflx() to compute cloud mass flux and precipitation CALL CUMFLX(IM , IJSDIM, KMAX , & !DD dimensions GMFX0 , GPRCI , GSNWI , CMDET, & ! output QLIQ , QICE , GTPRC0, & ! output - CBMFX(1,CTP) , GCYM(1,1,ctp), GPRCIZ , GSNWIZ , & ! input - GTPRT(1,CTP) , GCLZ , GCIZ , GCYT(1,ctp),& ! input - KB , KT(1,CTP) , KTMX(CTP) , & ! input + CBMFX(:,CTP) , GCYM(:,:,ctp), GPRCIZ(:,:,CTP), GSNWIZ(:,:,CTP) , & ! input + GTPRT(:,CTP) , GCLZ , GCIZ , GCYT(:,ctp),& ! input + KB , KT(:,CTP) , KTMX(CTP) , & ! input ISTS , IENS ) ! input ENDDO ! end of cloud type ctp loop @@ -1333,46 +1322,127 @@ SUBROUTINE CS_CUMLUS (im , IJSDIM, KMAX , NTR , & !DD dimensions GDH , GDQ , GDU , GDV , & ! input ! GTT , GTQ , GTCFRC, GTU , GTV , & ! modified ! GDH , GDQ , GDCFRC, GDU , GDV , & ! input - CBMFX , GCYT , DELPI , GCHT , GCQT , & ! input - GCLT , GCIT , GCUT , GCVT , GDQ(1,1,iti),& ! input + CBMFX , GCYT , DELPInv , GCHT , GCQT , & ! input + GCLT , GCIT , GCUT , GCVT , GDQ(:,:,iti),& ! input gctrt , & KT , ISTS , IENS, nctp ) ! input endif !for now area fraction of the downdraft is zero, it will be computed -! within cumdwn and applied there -! Get AW downdraft eddy flux and microphysical tendencies out of downdraft code. +! within cumdwn and applied there. So we will get the total sigma now before calling it, +! and apply to the diabatic terms from the updrafts. - do k=1,kmax - do i=ists,iens - sigmad(i,k) = zero - enddo - enddo +! if (do_aw.and.flx_form) then + if (flx_form) then + do k=1,kp1 + do i=ists,iens + lamdamax = maxval(lamdai(i,k,:)) + do while (lamdamax > zero) + loclamdamax = maxloc(lamdai(i,k,:),dim=1) + lamdaprod(i,k) = lamdaprod(i,k) * (one+lamdai(i,k,loclamdamax)) + sigmai(i,k,loclamdamax) = lamdai(i,k,loclamdamax) / lamdaprod(i,k) + sigma(i,k) = max(zero, min(one, sigma(i,k) + sigmai(i,k,loclamdamax))) + vverti(i,k,loclamdamax) = sigmai(i,k,loclamdamax) * wcv(i,k,loclamdamax) + + ! make this lamdai negative so it won't be counted again + lamdai(i,k,loclamdamax) = -lamdai(i,k,loclamdamax) + ! get new lamdamax + lamdamax = maxval(lamdai(i,k,:)) + enddo + ! restore original values of lamdai + lamdai(i,k,:) = abs(lamdai(i,k,:)) +! write(6,'(i2,14f7.4)') k,sigmai(i,k,:) + enddo + enddo + endif + +! the condensation terms - these come from the MSE and condensed water budgets for +! an entraining updraft + if(flx_form) then + DO CTP=1,NCTP ! loop over cloud types + dtcondtem(:,:) = zero + dqcondtem(:,:) = zero + dqprectem(:,:) = zero + dfrzprectem(:,:) = zero + dtfrztem(:,:) = zero + do i=ISTS,IENS + cbmfl = cbmfx(i,ctp) + kk = kt(i,ctp) ! cloud top index + if(cbmfl > zero) then ! this should avoid zero wcv in the denominator + kbi = kb(i) ! cloud base index + do k=kbi,kk ! loop from cloud base to cloud top + km1 = k - 1 + rhs_h = zero + rhs_q = zero + if(k > kbi) then +! tem = cbmfl * (one - sigma(i,k)) + tem = cbmfl * (one - 0.5*(sigma(i,k)+sigma(i,km1))) + tem1 = gcym(i,k,ctp) * (one - sigma(i,k)) + tem2 = gcym(i,km1,ctp) * (one - sigma(i,km1)) + rhs_h = cbmfl * (tem1*gchm(i,k,ctp) - (tem2*gchm(i,km1,ctp) & + + GDH(I,Km1)*(tem1-tem2)) ) + rhs_q = cbmfl * (tem1*(gcwm(i,k,ctp)-gcqm(i,k,ctp)) & + - (tem2*(gcwm(i,km1,ctp)-gcqm(i,km1,ctp)) & + + (GDw(I,Km1)-gdq(i,km1,1))*(tem1-tem2)) ) +! + dqcondtem(i,km1) = -rhs_q ! condensation + dqprectem(i,km1) = tem * (GPRCIZ(i,k,ctp) + GSNWIZ(i,k,ctp)) ! total precip production + dfrzprectem(i,km1) = tem * GSNWIZ(i,k,ctp) ! production of frozen precip + dtfrztem(i,km1) = rhs_h*oneocp ! heating due to freezing +! total temperature tendency due to in cloud microphysics + dtcondtem(i,km1) = - elocp * dqcondtem(i,km1) + dtfrztem(i,km1) + + endif ! if(k > kbi) then + enddo ! end of k=kbi,kk loop + + endif ! end of if(cbmfl > zero) + + +! get tendencies by difference of fluxes, sum over cloud type + + do k = 1,kk +! sum single cloud microphysical tendencies over all cloud types + condtermt(i,k) = condtermt(i,k) + dtcondtem(i,k) * delpinv(i,k) + condtermq(i,k) = condtermq(i,k) + dqcondtem(i,k) * delpinv(i,k) + prectermq(i,k) = prectermq(i,k) + dqprectem(i,k) * delpinv(i,k) + prectermfrz(i,k) = prectermfrz(i,k) + dfrzprectem(i,k) * delpinv(i,k) + frzterm(i,k) = frzterm(i,k) + dtfrztem(i,k) * delpinv(i,k) + +! if (lprnt .and. i == ipr) write(0,*)' k=',k,' trfluxtem=',trfluxtem(k+1,ntr),trfluxtem(k,ntr),& +! ' ctp=',ctp,' trfluxterm=',trfluxterm(i,k,ntr) + enddo + + enddo ! end of i loop + enddo ! end of nctp loop + endif +!downdraft sigma and mass-flux tendency terms are now put into +! the nctp+1 slot of the cloud-type dimensiond variables + + do k=1,kmax + do i=ists,iens + sigmad(i,k) = zero + enddo + enddo !> -# Call cumdwn() to compute cumulus downdraft and assocated melt, freeze !! and evaporation - CALL CUMDWN(IM , IJSDIM, KMAX , NTR , ntrq , & ! DD dimensions + CALL CUMDWN(IM, IJSDIM, KMAX, NTR, ntrq, nctp, & ! DD dimensions GTT , GTQ , GTU , GTV , & ! modified GMFLX , & ! modified updraft+downdraft flux GPRCP , GSNWP , GTEVP , GMDD , & ! output GPRCI , GSNWI , & ! input - GDH , GDW , GDQ , GDQ(1,1,iti) , & ! input + GDH , GDW , GDQ , GDQ(:,:,iti) , & ! input GDQS , GDS , GDHS , GDT , & ! input GDU , GDV , GDZ , & ! input - GDZM , FDQS , DELP , DELPI , & ! input + GDZM , FDQS , DELP , DELPInv , & ! input sigmad, do_aw , do_awdd, flx_form, & ! DDsigma input dtmelt, dtevap, dtsubl, & ! DDsigma input dtdwn , dqvdwn, dqldwn, dqidwn, & ! DDsigma input dtrdwn, & KB , KTMXT , ISTS , IENS ) ! input -! here we substitute the AW tendencies into tendencies to be passed out -! if (do_aw) then -! do k=1,kmax -! do i=ists,iens -! sigma(i,k) = sigma(i,k) + sigmad(i,k) -! enddo -! enddo + +! sigma = sigma + sigmad !> -# Call cumsbw() to compute cloud subsidence heating if (.not. flx_form) then @@ -1381,20 +1451,20 @@ SUBROUTINE CS_CUMLUS (im , IJSDIM, KMAX , NTR , & !DD dimensions CALL CUMSBH(IM , IJSDIM, KMAX , NTR , ntrq , & !DD dimensions GTT , GTQ , & ! modified GTU , GTV , & ! modified - GDH , GDQ , GDQ(1,1,iti) , & ! input + GDH , GDQ , GDQ(:,:,iti) , & ! input GDU , GDV , & ! input - DELPI , GMFLX , GMFX0 , & ! input + DELPINV , GMFLX , GMFX0 , & ! input KTMXT , CPRES , kb, ISTS , IENS ) ! input else CALL CUMSBW(IM , IJSDIM, KMAX , & !DD dimensions GTU , GTV , & ! modified GDU , GDV , & ! input - DELPI , GMFLX , GMFX0 , & ! input + DELPINV , GMFLX , GMFX0 , & ! input KTMXT , CPRES , kb, ISTS , IENS ) ! input endif ! -! for now the following routines appear to be of no consequence to AW - DD +! for now the following routines appear to be of no consequence - DD ! if (.not. flx_form) then ! Tracer Updraft properties @@ -1411,20 +1481,20 @@ SUBROUTINE CS_CUMLUS (im , IJSDIM, KMAX , NTR , & !DD dimensions GCYM , GCYT , GCQT , GCLT , GCIT , & ! input GTPRT , GTEVP , GTPRC0, & ! input KB , KBMX , KT , KTMX , KTMXT , & ! input - DELPI , OTSPT1, ISTS , IENS, & ! input + DELPInv , OTSPT1, ISTS , IENS, & ! input fscav , fswtr, nctp) ! ! Tracer Change due to Downdraft ! --------------- CALL CUMDNR(im ,IJSDIM , KMAX , NTR , & !DD dimensions GTQ , & ! modified - GDQ , GMDD , DELPI , & ! input + GDQ , GMDD , DELPInv , & ! input KTMXT , OTSPT1, ISTS , IENS ) ! input !! !! Tracer change due to Subsidence !! --------------- !! This will be done by cumsbh, now DD 20170907 -! CALL CUMSBR(im , IJSDIM, KMAX , NTR , & !DD dimensions +! CALL CUMSBR(im , IJSDIM, KMAX , NTR ,NCTP, & !DD dimensions ! GTQ , & ! modified ! GDQ , DELPI , & ! input ! GMFLX , KTMXT , OTSPT2, & ! input @@ -1447,6 +1517,60 @@ SUBROUTINE CS_CUMLUS (im , IJSDIM, KMAX , NTR , & !DD dimensions !> -# Compute AW tendencies of T, ql and qi if(flx_form) then ! compute AW tendencies ! AW lump all heating together, compute qv term + +! sigma interpolated to the layer for condensation, etc. terms, precipitation + if(do_aw) then + do k=1,kmax + kp1 = k+1 + do i=1,ijsdim + fsigma(i,k) = one - half*(sigma(i,k)+sigma(i,kp1)) + enddo + enddo + else + do k=1,kmax+1 + do i=1,ijsdim + fsigma(i,k) = one + enddo + enddo + endif + +! AW adjustment of precip fluxes from downdraft model + if(do_aw) then + kp1 = kmax+1 + DO I=ISTS,IENS + GSNWP( I,kp1 ) = zero + GPRCP( I,kp1 ) = zero + ENDDO + tem1 = cpoemelt/grav + tem2 = cpoel/grav + tem3 = cpoesub/grav + DO K=KMAX,1,-1 + kp1 = k+1 + DO I=ISTS,IENS + tem = -dtmelt(i,k) * delp(i,k) * tem1 + teme = -dtevap(i,k) * delp(i,k) * tem2 + tems = -dtsubl(i,k) * delp(i,k) * tem3 + GSNWP(I,k) = GSNWP(I,kp1) + fsigma(i,k) * (GSNWI(i,k) - tem - tems) + GPRCP(I,k) = GPRCP(I,kp1) + fsigma(i,k) * (GPRCI(i,k) + tem - teme) + ENDDO + ENDDO + endif + + +! some of the above routines have set the tendencies and they need to be +! reinitialized, gtt not needed, but gtq needed Anning 5/25/2020 + do n=1,ntr + do k=1,kmax + do i=1,ijsdim + gtq(i,k,n) = zero + enddo + enddo + enddo +! do k=1,kmax +! do i=1,ijsdim +! gtt(i,k) = zero +! enddo +! enddo do k=1,kmax do i=ists,iens dqevap(i,k) = - dtevap(i,k)*cpoel - dtsubl(i,k)*cpoesub @@ -1454,25 +1578,70 @@ SUBROUTINE CS_CUMLUS (im , IJSDIM, KMAX , NTR , & !DD dimensions dtsubl(i,k) = zero enddo enddo - do i=1,ijsdim - moistening_aw(i) = zero - enddo - tem2 = one / delta + + +! diabatic terms from updraft and downdraft models DO K=1,KMAX DO I=ISTS,IENS tem = frzterm(i,k)*cpoEMELT - prectermfrz(i,k) - gtt(i,k) = dtdwn(i,k) + sfluxterm(i,k) + condtermt(i,k) & - + dtmelt(i,k) + dtevap(i,k) - gtq(i,k,1) = dqvdwn(i,k) + qvfluxterm(i,k) + condtermq(i,k) & - + dqevap(i,k) - gtq(i,k,itl) = dqldwn(i,k) + qlfluxterm(i,k) - condtermq(i,k) & +! gtt(i,k) = gtt(i,k) + fsigma(i,k)*(dtmelt(i,k) + dtevap(i,k)) + condtermt(i,k) +! gtq(i,k,1) = gtq(i,k,1) + fsigma(i,k)*dqevap(i,k) + condtermq(i,k) +! gtq(i,k,itl) = gtq(i,k,itl) - (condtermq(i,k) + prectermq(i,k) + tem) +! gtq(i,k,iti) = gtq(i,k,iti) + tem + gtt(i,k) = dtdwn(i,k) + condtermt(i,k) & + + fsigma(i,k)*(dtmelt(i,k) + dtevap(i,k)) + gtq(i,k,1) = dqvdwn(i,k) + condtermq(i,k) & + + fsigma(i,k) * dqevap(i,k) + gtq(i,k,itl) = dqldwn(i,k) - condtermq(i,k) & - prectermq(i,k) - tem - gtq(i,k,iti) = dqidwn(i,k) + qifluxterm(i,k) + tem + gtq(i,k,iti) = dqidwn(i,k) + tem + ! detrainment terms get zeroed ! gtldet(i,k) = zero ! gtidet(i,k) = zero + ENDDO + ENDDO +!! flux tendencies - compute the vertical flux divergence + DO ctp =1,nctp + DO I=ISTS,IENS + cbmfl = cbmfx(i,ctp) + kk = kt(i,ctp) ! cloud top index + if(cbmfl > zero) then ! this should avoid zero wcv in the denominator + DO K=1,kk + kp1 = k+1 + gtt(i,k) = gtt(i,k) - (fsigma(i,kp1)*sfluxtem(i,kp1,ctp) & + - fsigma(i,k)*sfluxtem(i,k,ctp)) * delpinv(i,k) + gtq(i,k,1) = gtq(i,k,1) - (fsigma(i,kp1)*qvfluxtem(i,kp1,ctp) & + - fsigma(i,k)*qvfluxtem(i,k,ctp)) * delpinv(i,k) + gtq(i,k,itl) = gtq(i,k,itl) - (fsigma(i,kp1)*qlfluxtem(i,kp1,ctp) & + - fsigma(i,k)*qlfluxtem(i,k,ctp)) * delpinv(i,k) + gtq(i,k,iti) = gtq(i,k,iti) - (fsigma(i,kp1)*qifluxtem(i,kp1,ctp) & + - fsigma(i,k)*qifluxtem(i,k,ctp)) * delpinv(i,k) + ENDDO +! replace tracer tendency only if to be advected. + DO n = ntrq,NTR + if (OTSPT2(n)) then + DO K=1,kk + kp1 = k+1 + gtq(i,k,n) = - (fsigma(i,kp1)*trfluxtem(i,kp1,n,ctp) & + - fsigma(i,k)*trfluxtem(i,k,n,ctp)) * delpinv(i,k) + ENDDO + endif + ENDDO + end if + ENDDO + ENDDO +! if(kdt>4) stop 1000 + DO I=ISTS,IENS + moistening_aw(i) = zero + enddo + +! adjust tendencies that will lead to negative water mixing ratios + tem2 = one / delta + DO K=1,KMAX + DO I=ISTS,IENS tem1 = - gdq(i,k,itl)*tem2 if (gtq(i,k,itl) < tem1) then tem3 = gtq(i,k,itl) - tem1 @@ -1504,7 +1673,7 @@ SUBROUTINE CS_CUMLUS (im , IJSDIM, KMAX , NTR , & !DD dimensions if (OTSPT2(n)) then DO K=1,KMAX DO I=ISTS,IENS - gtq(i,k,n) = dtrdwn(i,k,n) + trfluxterm(i,k,n) + gtq(i,k,n) = gtq(i,k,n) + dtrdwn(i,k,n) ENDDO ENDDO endif @@ -1597,46 +1766,74 @@ SUBROUTINE CS_CUMLUS (im , IJSDIM, KMAX , NTR , & !DD dimensions !> -# Ensures conservation of water. !In fact, no adjustment of the precip ! is occuring now which is a good sign! DD - if(flx_form .and. adjustp) then + if(flx_form) then DO I = ISTS, IENS if(gprcp(i,1)+gsnwp(i,1) > 1.e-12_kind_phys) then - moistening_aw(i) = - moistening_aw(i) / (gprcp(i,1)+gsnwp(i,1)) - else - moistening_aw(i) = 1.0 + moistening_aw(i) = -moistening_aw(i) / (gprcp(i,1)+gsnwp(i,1)) +! print*,'moistening_aw',moistening_aw(i) + gprcp(i,:) = gprcp(i,:) * moistening_aw(i) + gsnwp(i,:) = gsnwp(i,:) * moistening_aw(i) endif - ENDDO - do k=1,kmax - DO I = ISTS, IENS - gprcp(i,k) = max(0.0, gprcp(i,k) * moistening_aw(i)) - gsnwp(i,k) = max(0.0, gsnwp(i,k) * moistening_aw(i)) - ENDDO - enddo - + END DO endif + +! second method of determining sfc precip only +! if(flx_form) then +! DO I = ISTS, IENS +! pr_tot = zero +! pr_liq = zero +! pr_ice = zero +! do k = 1,kmax +! pr_tot = pr_tot - (gtq(i,k,1)+gtq(i,k,itl)+gtq(i,k,iti)) * delp(i,k) * gravi +! pr_ice = pr_ice + ( cp*gtt(i,k) + el*gtq(i,k,1) - emelt*gtq(i,k,iti) ) & +! * delp(i,k)*gravi +! enddo + !pr_ice = max( min(pr_tot, pr_ice / (emelt)),zero) +! pr_ice = pr_ice / emelt +! pr_liq = pr_tot - pr_ice +! END DO +! print *,'precip1',pr_tot*86400.,gprcp(1,1)*86400.,gsnwp(1,1)*86400. +! print *,'precip2',pr_tot*86400.,pr_liq*86400.,pr_ice*86400. +! endif + + DO K = 1, KMAX + DO I = ISTS, IENS + GPRCPF( I,K ) = 0.5*( GPRCP( I,K )+GPRCP( I,K+1 ) ) + GSNWPF( I,K ) = 0.5*( GSNWP( I,K )+GSNWP( I,K+1 ) ) + END DO + END DO + ! -! do i=ISTS,IENS -! GPRCC(I,1) = GPRCP(I,1) -! GSNWC(I ) = GSNWP(I,1) -! enddo - do k=1,kmax +! do i=ISTS,IENS +! GPRCC( I,1 ) = GPRCP( I,1 ) +! GSNWC( I ) = GSNWP( I,1 ) +! enddo + +! adjust sfc precip consistently with vertically integrated +! temperature and moisture tendencies + + do k=1,kmax+1 do i=ISTS,IENS GTPRP(I,k) = GPRCP(I,k) + GSNWP(I,k) enddo enddo ! !DD provide GFS with a separate downdraft mass flux - DO K=1,KMAX - DO I=ISTS,IENS - GMFX1(I,K) = GMFX0(I,K) - GMFLX(I,K) - ENDDO - ENDDO -! - if (flx_form) then - deallocate(sfluxterm, qvfluxterm, qlfluxterm, qifluxterm,& - condtermt, condtermq, frzterm, prectermq, & - prectermfrz, dtdwn, dqvdwn, dqldwn, & - dqidwn, trfluxterm, dtrdwn) - endif + if(do_aw) then + DO K = 1, KMAX+1 + DO I = ISTS, IENS + fsigma(i,k) = one - sigma(i,k) + GMFX0( I,K ) = GMFX0( I,K ) * fsigma(i,k) + GMFLX( I,K ) = GMFLX( I,K ) * fsigma(i,k) + END DO + END DO + endif + DO K = 1, KMAX+1 + DO I = ISTS, IENS + GMFX1( I,K ) = GMFX0( I,K ) - GMFLX( I,K ) + END DO + END DO + if (allocated(gprcc)) deallocate(gprcc) ! @@ -1748,28 +1945,6 @@ SUBROUTINE CUMBAS & ! cloud base ENDIF ENDDO ENDDO - DO K=KLCLB+1,KBMAX-1 - DO I=ISTS,IENS - spbl(i) = one - gdpm(i,k) * tx1(i) - IF (kb(i) > k .and. spbl(i) > spblmax) THEN - KB(I) = K - ENDIF - ENDDO - ENDDO -! DO K=KBMAX-1,KLCLB+1,-1 -! DO I=ISTS,IENS -! GAMX = FDQS(I,K) / (one+GAM(I,K)) * oneocp -! QSL(i) = GDQS(I,K) + GAMX * (GDH(I,KLCLB)-GDHS(I,K)) -! spbl(i) = one - gdpm(i,k) * tx1(i) -! IF (GDW(I,KLCLB) >= QSL(i) .and. spbl(i) >= spblcrit & -! .and. spbl(i) < spblcrit*6.0) THEN -! .and. spbl(i) < spblcrit*8.0) THEN -! KB(I) = K + KBOFS -! ENDIF -! ENDDO -! if(lprnt) write(0,*)' k=',k,' gdh1=',gdh(ipr,klclb),' gdhs=',gdhs(ipr,k),' kb=',kb(ipr) & -! ,' GDQS=',GDQS(ipr,k),' GDW=',GDW(ipr,KLCLB),' gdpm=',gdpm(ipr,k),' spbl=',spbl(ipr),' qsl=',qsl(ipr) -! ENDDO ENDIF ! do i=ists,iens @@ -1910,8 +2085,8 @@ SUBROUTINE CUMUP & !! in-cloud properties REAL(kind_phys) ACWF (IJSDIM) !< cloud work function REAL(kind_phys) GCLZ (IJSDIM, KMAX) !< cloud liquid water*eta REAL(kind_phys) GCIZ (IJSDIM, KMAX) !< cloud ice*eta - REAL(kind_phys) GPRCIZ(IJSDIM, KMAX) !< rain generation*eta - REAL(kind_phys) GSNWIZ(IJSDIM, KMAX) !< snow generation*eta + REAL(kind_phys) GPRCIZ(IJSDIM, KMAX+1) !< rain generation*eta + REAL(kind_phys) GSNWIZ(IJSDIM, KMAX+1) !< snow generation*eta REAL(kind_phys) GCYT (IJSDIM) !< norm. mass flux @top REAL(kind_phys) GCHT (IJSDIM) !< cloud top MSE*eta REAL(kind_phys) GCQT (IJSDIM) !< cloud top moisture*eta @@ -1924,7 +2099,7 @@ SUBROUTINE CUMUP & !! in-cloud properties REAL(kind_phys) GCwT (IJSDIM) !< cloud top v*eta INTEGER KT (IJSDIM) !< cloud top INTEGER KTMX !< max of cloud top - REAL(kind_phys) WCV (IJSDIM, KMAX) !< updraft velocity (half lev) !DD sigma make output + REAL(kind_phys) WCV (IJSDIM, KMAX+1) !< updraft velocity (half lev) !DD sigma make output ! ! [MODIFIED] REAL(kind_phys) GCYM (IJSDIM, KMAX) !< norm. mass flux @@ -1980,12 +2155,12 @@ SUBROUTINE CUMUP & !! in-cloud properties ! REAL(kind_phys) ELAR (IJSDIM, KMAX) !< entrainment rate REAL(kind_phys) ELAR !< entrainment rate at mid layer ! - REAL(kind_phys) GCHM (IJSDIM, KMAX) !< cloud MSE (half lev) - REAL(kind_phys) GCWM (IJSDIM, KMAX) !< cloud Qt (half lev) !DDsigmadiag - REAL(kind_phys) GCTM (IJSDIM, KMAX) !< cloud T (half lev) !DDsigmadiag make output - REAL(kind_phys) GCQM (IJSDIM, KMAX) !< cloud q (half lev) !DDsigmadiag make output - REAL(kind_phys) GCLM (IJSDIM, KMAX) !< cloud liquid ( half lev) - REAL(kind_phys) GCIM (IJSDIM, KMAX) !< cloud ice (half lev) + REAL(kind_phys) GCHM (IJSDIM, KMAX+1) !< cloud MSE (half lev) + REAL(kind_phys) GCWM (IJSDIM, KMAX+1) !< cloud Qt (half lev) !DDsigmadiag + REAL(kind_phys) GCTM (IJSDIM, KMAX+1) !< cloud T (half lev) !DDsigmadiag make output + REAL(kind_phys) GCQM (IJSDIM, KMAX+1) !< cloud q (half lev) !DDsigmadiag make output + REAL(kind_phys) GCLM (IJSDIM, KMAX+1) !< cloud liquid ( half lev) + REAL(kind_phys) GCIM (IJSDIM, KMAX+1) !< cloud ice (half lev) REAL(kind_phys) GCUM (IJSDIM, KMAX) !< cloud U (half lev) REAL(kind_phys) GCVM (IJSDIM, KMAX) !< cloud V (half lev) REAL(kind_phys) GCtrM (IJSDIM, KMAX,ntrq:ntr) !< cloud tracer (half lev) @@ -2021,8 +2196,9 @@ SUBROUTINE CUMUP & !! in-cloud properties ! REAL(kind_phys) :: WCCRT = zero !m REAL(kind_phys) :: WCCRT = 0.01 REAL(kind_phys) :: WCCRT = 1.0e-6_kind_phys, wvcrt=1.0e-3_kind_phys - REAL(kind_phys) :: TSICE = 268.15_kind_phys ! compatible with macrop_driver - REAL(kind_phys) :: TWICE = 238.15_kind_phys ! compatible with macrop_driver + REAL(kind_phys) :: TSICE = 273.15_kind_phys ! compatible with macrop_driver + REAL(kind_phys) :: TWICE = 233.15_kind_phys ! compatible with macrop_driver + REAL(kind_phys) :: c1t ! REAL(kind_phys) :: wfn_neg = 0.1 REAL(kind_phys) :: wfn_neg = 0.15 @@ -2033,10 +2209,15 @@ SUBROUTINE CUMUP & !! in-cloud properties REAL(kind_phys) :: esat, tem ! REAL(kind_phys) :: esat, tem, rhs_h, rhs_q ! +! [INTERNAL FUNC] + REAL(kind_phys) FPREC ! precipitation ratio in condensate + REAL(kind_phys) FRICE ! ice ratio in cloud water REAL(kind_phys) Z ! altitude REAL(kind_phys) ZH ! scale height REAL(kind_phys) T ! temperature ! + FPREC(Z,ZH) = MIN(MAX(one-EXP(-(Z-PRECZ0)/ZH), zero), one) + FRICE(T) = MIN(MAX((TSICE-T)/(TSICE-TWICE), zero), one) ! ! Note: iteration is not made to diagnose cloud ice for simplicity ! @@ -2052,14 +2233,25 @@ SUBROUTINE CUMUP & !! in-cloud properties GCVT (I) = zero GCwT (I) = zero enddo + do k=1,kmax+1 + do i=ists,iens + GPRCIZ(I,k) = zero + GSNWIZ(I,k) = zero + enddo + enddo + do k=1,kmax + do i=ists,iens + WCV (I,k) = unset_kind_phys + GCLM (I,k) = unset_kind_phys + GCIM (I,k) = unset_kind_phys + enddo + enddo do k=1,kmax do i=ists,iens ACWFK (I,k) = unset_kind_phys ACWFN (I,k) = unset_kind_phys GCLZ (I,k) = zero GCIZ (I,k) = zero - GPRCIZ(I,k) = zero - GSNWIZ(I,k) = zero ! GCHMZ (I,k) = zero GCWMZ (I,k) = zero @@ -2070,15 +2262,12 @@ SUBROUTINE CUMUP & !! in-cloud properties ! BUOY (I,k) = unset_kind_phys BUOYM (I,k) = unset_kind_phys - WCV (I,k) = unset_kind_phys GCY (I,k) = unset_kind_phys ! GCHM (I,k) = unset_kind_phys GCWM (I,k) = unset_kind_phys GCTM (I,k) = unset_kind_phys GCQM (I,k) = unset_kind_phys - GCLM (I,k) = unset_kind_phys - GCIM (I,k) = unset_kind_phys GCUM (I,k) = unset_kind_phys GCVM (I,k) = unset_kind_phys enddo @@ -2199,13 +2388,24 @@ SUBROUTINE CUMUP & !! in-cloud properties FDQSM = GDQSM * tem * (fact1 + fact2*tem) ! calculate d(qs)/dT CPGMI = one / (CP + EL*FDQSM) - PRCZH = PRECZH * MIN(GDZTR(I)*ZTREFI, one) - PRECR = FPREC(GDZM(I,K)-GDZMKB(I), PRCZH ) ! wrk = one / GCYM(I,K) DCTM = (GCHMZ(I,K)*wrk - GDHSM) * CPGMI GCQMZ(i) = min((GDQSM+FDQSM*DCTM)*GCYM(I,K), GCWMZ(I,K)) - GTPRMZ(I,K) = PRECR * (GCWMZ(I,K)-GCQMZ(i)) + if(PRECZH > zero) then + PRCZH = PRECZH * MIN(GDZTR(I)*ZTREFI, one) + PRECR = FPREC(GDZM(I,K)-GDZMKB(I), PRCZH ) + GTPRMZ(I,K) = PRECR * (GCWMZ(I,K)-GCQMZ(i)) + else + DELC=GDZ(I,K)-GDZ(I,KM1) + if(gdtm(i,k)>TSICE) then + c1t=c0t*delc + else + c1t=c0t*exp(d0t*(gdtm(i,k)-TSICE))*delc + end if + c1t=min(c1t, one) + GTPRMZ(I,K) = c1t * (GCWMZ(I,K)-GCQMZ(i)) + end if GTPRMZ(I,K) = MAX(GTPRMZ(I,K), GTPRMZ(I,KM1)) GCCMZ = GCWMZ(I,K) - GCQMZ(i) - GTPRMZ(I,K ) DELC = MIN(GCCMZ, zero) @@ -2274,7 +2474,11 @@ SUBROUTINE CUMUP & !! in-cloud properties wrk = one / GCYM(I,K) DCTM = (GCHMZ(I,K)*wrk - GDHSM) * CPGMI GCQMZ(i) = min((GDQSM+FDQSM*DCTM)*GCYM(I,K), GCWMZ(I,K)) - GTPRMZ(I,K) = PRECR * (GCWMZ(I,K)-GCQMZ(i)) + if(PRECZH > zero) then + GTPRMZ(I,K) = PRECR * (GCWMZ(I,K)-GCQMZ(i)) + else + GTPRMZ(I,K) = c1t * (GCWMZ(I,K)-GCQMZ(i)) + end if GTPRMZ(I,K) = MAX(GTPRMZ(I,K), GTPRMZ(I,KM1)) GCCMZ = GCWMZ(I,K) - GCQMZ(i) - GTPRMZ(I,K) DELC = MIN(GCCMZ, zero) @@ -2399,8 +2603,19 @@ SUBROUTINE CUMUP & !! in-cloud properties wrk = one / gcyt(i) DCT = (GCHT(I)*wrk - GDHS(I,K)) / (CP*(one + GAM(I,K))) GCQT(I) = min((GDQS(I,K) + FDQS(I,K)*DCT) * GCYT(I), GCWT(i)) - PRCZH = PRECZH * MIN(GDZTR(I)*ZTREFI, one) - GTPRT(I) = FPREC(GDZ(I,K)-GDZMKB(I), PRCZH) * (GCWT(i)-GCQT(I)) + if(PRECZH > zero) then + PRCZH = PRECZH * MIN(GDZTR(I)*ZTREFI, one) + GTPRT(I) = FPREC(GDZ(I,K)-GDZMKB(I), PRCZH) * (GCWT(i)-GCQT(I)) + else + DELC=GDZ(I,K)-GDZ(I,K-1) + if(gdtm(i,k)>TSICE) then + c1t=c0t*delc + else + c1t=c0t*exp(d0t*(gdtm(i,k)-TSICE))*delc + end if + c1t=min(c1t, one) + GTPRT(I) = c1t * (GCWT(i)-GCQT(I)) + end if GTPRT(I) = MAX(GTPRT(I), GTPRMZ(I,K)) GCCT = GCWT(i) - GCQT(I) - GTPRT(I) DELC = MIN(GCCT, zero) @@ -2503,24 +2718,6 @@ SUBROUTINE CUMUP & !! in-cloud properties ! ! WRITE( CTNUM, '(I2.2)' ) CTP ! - -contains - - pure function FPREC(Z,ZH) - implicit none - real(kind_phys), intent(in) :: Z - real(kind_phys), intent(in) :: ZH - real(kind_phys) :: FPREC - FPREC = MIN(MAX(one-EXP(-(Z-PRECZ0)/ZH), zero), one) - end function FPREC - - pure function FRICE(T) - implicit none - real(kind_phys), intent(in) :: T - real(kind_phys) :: FRICE - FRICE = MIN(MAX((TSICE-T)/(TSICE-TWICE), zero), one) - end function FRICE - END SUBROUTINE CUMUP !*********************************************************************** !>\ingroup cs_scheme @@ -2562,8 +2759,8 @@ SUBROUTINE CUMBMX & !! cloud base mass flux ! [INTERNAL PARAM] REAL(kind_phys) :: FMAX = 1.5e-2_kind_phys ! maximum flux ! REAL(kind_phys) :: RHMCRT = zero ! critical val. of cloud mean RH -! REAL(kind_phys) :: RHMCRT = 0.25_kind_phys ! critical val. of cloud mean RH - REAL(kind_phys) :: RHMCRT = 0.50_kind_phys ! critical val. of cloud mean RH + REAL(kind_phys) :: RHMCRT = 0.25_kind_phys ! critical val. of cloud mean RH +! REAL(kind_phys) :: RHMCRT = 0.50_kind_phys ! critical val. of cloud mean RH REAL(kind_phys) :: ALP1 = zero REAL(kind_phys) :: TAUD = 1.e3_kind_phys ! REAL(kind_phys) :: TAUD = 6.e2_kind_phys @@ -2624,7 +2821,7 @@ SUBROUTINE CUMFLX & !! cloud mass flux INTEGER, INTENT(IN) :: IJSDIM, KMAX, IM !! DD, for GFS, pass in ! ! [OUTPUT] - REAL(kind_phys) GMFLX (IJSDIM, KMAX) !< mass flux + REAL(kind_phys) GMFLX (IJSDIM, KMAX+1) !< mass flux REAL(kind_phys) CMDET (IJSDIM, KMAX) !< detrainment mass flux REAL(kind_phys) GPRCI (IJSDIM, KMAX) !< rainfall generation REAL(kind_phys) GSNWI (IJSDIM, KMAX) !< snowfall generation @@ -2636,8 +2833,8 @@ SUBROUTINE CUMFLX & !! cloud mass flux REAL(kind_phys) CBMFX (IJSDIM) !< cloud base mass flux REAL(kind_phys) GCYM (IJSDIM, KMAX) !< normalized mass flux REAL(kind_phys) GCYT (IJSDIM) !< detraining mass flux - REAL(kind_phys) GPRCIZ(IJSDIM, KMAX) !< precipitation/M - REAL(kind_phys) GSNWIZ(IJSDIM, KMAX) !< snowfall/M + REAL(kind_phys) GPRCIZ(IJSDIM, KMAX+1) !< precipitation/M + REAL(kind_phys) GSNWIZ(IJSDIM, KMAX+1) !< snowfall/M REAL(kind_phys) GTPRT (IJSDIM) !< rain+snow @top REAL(kind_phys) GCLZ (IJSDIM, KMAX) !< cloud liquid/M REAL(kind_phys) GCIZ (IJSDIM, KMAX) !< cloud ice/M @@ -2773,8 +2970,8 @@ SUBROUTINE CUMSBH & !! adiabat. descent REAL(kind_phys) GDU (IJSDIM, KMAX) REAL(kind_phys) GDV (IJSDIM, KMAX) REAL(kind_phys) DELPI (IJSDIM, KMAX) - REAL(kind_phys) GMFLX (IJSDIM, KMAX) !< mass flux (updraft+downdraft) - REAL(kind_phys) GMFX0 (IJSDIM, KMAX) !< mass flux (updraft only) + REAL(kind_phys) GMFLX (IJSDIM, KMAX+1) !< mass flux (updraft+downdraft) + REAL(kind_phys) GMFX0 (IJSDIM, KMAX+1) !< mass flux (updraft only) INTEGER KB(IJSDIM) !< cloud base index - negative means no convection INTEGER KTMX REAL(kind_phys) CPRES !< pressure factor for cumulus friction @@ -2890,8 +3087,8 @@ SUBROUTINE CUMSBW & !! adiabat. descent REAL(kind_phys) GDU (IJSDIM, KMAX) REAL(kind_phys) GDV (IJSDIM, KMAX) REAL(kind_phys) DELPI (IJSDIM, KMAX) - REAL(kind_phys) GMFLX (IJSDIM, KMAX) !< mass flux (updraft+downdraft) - REAL(kind_phys) GMFX0 (IJSDIM, KMAX) !< mass flux (updraft only) + REAL(kind_phys) GMFLX (IJSDIM, KMAX+1) !< mass flux (updraft+downdraft) + REAL(kind_phys) GMFX0 (IJSDIM, KMAX+1) !< mass flux (updraft only) INTEGER KB(IJSDIM) !< cloud base index - negative means no convection INTEGER KTMX, ISTS, IENS REAL(kind_phys) CPRES !< pressure factor for cumulus friction @@ -2942,7 +3139,7 @@ END SUBROUTINE CUMSBW !>\ingroup cs_scheme !! This subroution calculates freeze, melt and evaporation in cumulus downdraft. SUBROUTINE CUMDWN & ! Freeze & Melt & Evaporation - ( IM , IJSDIM, KMAX , NTR , ntrq, & !DD dimensions + ( IM , IJSDIM, KMAX , NTR,ntrq,nctp, & !DD dimensions GTT , GTQ , GTU , GTV , & ! modified GMFLX , & ! modified GPRCP , GSNWP , GTEVP , GMDD , & ! output @@ -2962,7 +3159,7 @@ SUBROUTINE CUMDWN & ! Freeze & Melt & Evaporation ! IMPLICIT NONE - INTEGER, INTENT(IN) :: IM, IJSDIM, KMAX, NTR, ntrq ! DD, for GFS, pass in + INTEGER, INTENT(IN) :: IM, IJSDIM, KMAX, NTR , ntrq, nctp !! DD, for GFS, pass in logical, intent(in) :: do_aw, do_awdd, flx_form ! ! [MODIFY] @@ -2970,13 +3167,13 @@ SUBROUTINE CUMDWN & ! Freeze & Melt & Evaporation REAL(kind_phys) GTQ (IJSDIM, KMAX, NTR) !< Moisture etc tendency REAL(kind_phys) GTU (IJSDIM, KMAX) !< u tendency REAL(kind_phys) GTV (IJSDIM, KMAX) !< v tendency - REAL(kind_phys) GMFLX (IJSDIM, KMAX) !< mass flux + REAL(kind_phys) GMFLX (IJSDIM, KMAX+1) !< mass flux ! ! [OUTPUT] - REAL(kind_phys) GPRCP (IJSDIM, KMAX) !< rainfall flux - REAL(kind_phys) GSNWP (IJSDIM, KMAX) !< snowfall flux + REAL(kind_phys) GPRCP (IJSDIM, KMAX+1) !< rainfall flux + REAL(kind_phys) GSNWP (IJSDIM, KMAX+1) !< snowfall flux REAL(kind_phys) GTEVP (IJSDIM, KMAX) !< evaporation+sublimation - REAL(kind_phys) GMDD (IJSDIM, KMAX) !< downdraft mass flux + REAL(kind_phys) GMDD (IJSDIM, KMAX+1) !< downdraft mass flux !AW microphysical tendencies REAL(kind_phys) gtmelt (IJSDIM, KMAX) !< t tendency ice-liq @@ -2988,8 +3185,6 @@ SUBROUTINE CUMDWN & ! Freeze & Melt & Evaporation REAL(kind_phys) dqldwn (IJSDIM, KMAX) !< ql tendency downdraft detrainment REAL(kind_phys) dqidwn (IJSDIM, KMAX) !< qi tendency downdraft detrainment REAL(kind_phys) dtrdwn (IJSDIM, KMAX, ntrq:ntr) !< tracer tendency downdraft detrainment -! AW downdraft area fraction (assumed zero for now) - REAL(kind_phys) sigmad (IJSDIM,KMAX) !< DDsigma cloud downdraft area fraction ! [INPUT] REAL(kind_phys) GPRCI (IJSDIM, KMAX) !< rainfall generation @@ -3011,6 +3206,8 @@ SUBROUTINE CUMDWN & ! Freeze & Melt & Evaporation REAL(kind_phys) DELPI (IJSDIM, KMAX) INTEGER KB (IJSDIM) INTEGER KTMX, ISTS, IENS + REAL(kind_phys) sigmad (IM,KMAX+1) !< DDsigma cloud downdraft area fraction + ! ! [INTERNAL WORK] ! Note: Some variables have 3-dimensions for the purpose of budget check. @@ -3031,27 +3228,33 @@ SUBROUTINE CUMDWN & ! Freeze & Melt & Evaporation ! profiles of downdraft variables for AW flux tendencies REAL(kind_phys) GCdseD(ISTS:IENS, KMAX) !< downdraft dse REAL(kind_phys) GCqvD (ISTS:IENS, KMAX) !< downdraft qv -! REAL(kind_phys) GCqlD (ISTS:IENS, KMAX) !< downdraft ql -! REAL(kind_phys) GCqiD (ISTS:IENS, KMAX) !< downdraft qi + REAL(kind_phys) GCqlD (ISTS:IENS, KMAX) !< downdraft ql + REAL(kind_phys) GCqiD (ISTS:IENS, KMAX) !< downdraft qi REAL(kind_phys) GCtrD (ISTS:IENS, ntrq:ntr) !< downdraft tracer REAL(kind_phys) GCUD (ISTS:IENS) !< downdraft u REAL(kind_phys) GCVD (ISTS:IENS) !< downdraft v REAL(kind_phys) FSNOW (ISTS:IENS) REAL(kind_phys) GMDDD (ISTS:IENS) - - REAL(kind_phys) GDTW, GCHX, GCTX, GCQSX, GTPRP, EVSU, GTEVE, LVIC, & - DQW, DTW, GDQW, DZ, GCSD, FDET, GDHI, GMDDX, & - GMDDMX, GCHDX, GCWDX, GCUDD, GCVDD, GTHCI, GTQVCI, & - wrk, wrk1, wrk2, wrk3, wrk4, tx1, & - WMX, HMX, DDWMX, DDHMX, dp_above, dp_below, fsigma, & - fmelt, fevp, wrkn, gctrdd(ntrq:ntr) - + INTEGER I, K + REAL(kind_phys) GDTW + REAL(kind_phys) GCHX, GCTX, GCQSX, GTPRP, EVSU, GTEVE, LVIC + REAL(kind_phys) DQW, DTW, GDQW, DZ, GCSD, FDET, GDHI + REAL(kind_phys) GMDDX, GMDDMX + REAL(kind_phys) GCHDX, GCWDX + REAL(kind_phys) GCUDD, GCVDD + REAL(kind_phys) GTHCI, GTQVCI, GTQLCI, GTQICI !M REAL(kind_phys) GTHCI, GTQVCI, GTQLCI, GTQICI, GTUCI, GTVCI + real(kind_phys) wrk, fmelt, fevp, gctrdd(ntrq:ntr) !DD#ifdef OPT_CUMBGT -! Water, energy, downdraft water and downdraft energy budgets -! REAL(kind_phys), dimension(ISTS:IENS) :: WBGT, HBGT, DDWBGT, DDHBGT - integer ij, i, k, kp1, n + REAL(kind_phys) WBGT ( ISTS:IENS ) !! water budget + REAL(kind_phys) HBGT ( ISTS:IENS ) !! energy budget + REAL(kind_phys) DDWBGT( ISTS:IENS ) !! downdraft water budget + REAL(kind_phys) DDHBGT( ISTS:IENS ) !! downdraft energy budget + REAL(kind_phys) WMX, HMX, DDWMX, DDHMX, tx1, wrk1, wrk2, wrk3, wrk4, wrkn + REAL(kind_phys) dp_above, dp_below + real(kind_phys) fsigma + integer ij, n, kp1 !DD#endif ! ! [INTERNAL PARM] @@ -3109,46 +3312,23 @@ SUBROUTINE CUMDWN & ! Freeze & Melt & Evaporation gtsubl(I,k) = zero enddo enddo -! testing on oct 17 2016 - if (flx_form) then - if (.not. do_awdd) then - do k=1,kmax - do i=ists,iens - if (kb(i) > 0) then - dtdwn (i,k) = gtt(i,k) - dqvdwn(i,k) = gtq(i,k,1) - dqldwn(i,k) = gtq(i,k,itl) - dqidwn(i,k) = gtq(i,k,iti) - endif - enddo - enddo - do n=ntrq,ntr - do k=1,kmax - do i=ists,iens - if (kb(i) > 0) then - dtrdwn(i,k,n) = gtq(i,k,n) - endif - enddo - enddo - enddo - else - do k=1,kmax - do i=ists,iens - dtdwn (I,k) = zero - dqvdwn(I,k) = zero - dqldwn(I,k) = zero - dqidwn(I,k) = zero - enddo - enddo - do n=ntrq,ntr - do k=1,kmax - do i=ists,iens - dtrdwn(i,k,n) = zero - enddo - enddo - enddo - endif - endif + +! These are zeroed by the calling routine, cs_cumlus +! do k=1,kmax +! do i=ists,iens +! dtdwn (I,k) = zero +! dqvdwn(I,k) = zero +! dqldwn(I,k) = zero +! dqidwn(I,k) = zero +! enddo +! enddo +! do n=ntrq,ntr +! do k=1,kmax +! do i=ists,iens +! dtrdwn(i,k,n) = zero +! enddo +! enddo +! enddo ! do i=ists,iens GCHD(I) = zero @@ -3178,20 +3358,19 @@ SUBROUTINE CUMDWN & ! Freeze & Melt & Evaporation LVIC = ELocp + EMELTocp*FSNOW(I) GDTW = GDT(I,K) - LVIC*(GDQS(I,K) - GDQ(I,K,1)) & / (one + LVIC*FDQS(I,K)) + + DZ = GDZM(I,KP1) - GDZM(I,K) + FMELT = (one + FTMLT*(GDTW - TWSNOW)) & + * (one - TANH(GMFLX(I,KP1)/GMFLXC)) & + * (one - TANH(VTERMS*MELTAU/DZ)) IF (GDTW < TWSNOW) THEN - GSNWP(I,K) = GSNWP(I,KP1) + GPRCI(I,K) + GSNWI(I,K) - GTTEV(I,K) = EMELToCP * GPRCI(I,K) * DELPI(I,K) - SNMLT(I,K) = -GPRCI(I,K) + SNMLT(I,K) = GPRCP(I,KP1)*min(max(FMELT, one), zero) ELSE - DZ = GDZM(I,KP1) - GDZM(I,K) - FMELT = (one + FTMLT*(GDTW - TWSNOW)) & - * (one - TANH(GMFLX(I,KP1)/GMFLXC)) & - * (one - TANH(VTERMS*MELTAU/DZ)) SNMLT(I,K) = GSNWP(I,KP1)*max(min(FMELT, one), zero) - GSNWP(I,K) = GSNWP(I,KP1)+GSNWI(I,K) - SNMLT(I,K) - GPRCP(I,K) = GPRCP(I,KP1)+GPRCI(I,K) + SNMLT(I,K) - GTTEV(I,K) = -EMELToCP * SNMLT(I,K) * DELPI(I,K) ENDIF + GSNWP(I,K) = GSNWP(I,KP1)+GSNWI(I,K) - SNMLT(I,K) + GPRCP(I,K) = GPRCP(I,KP1)+GPRCI(I,K) + SNMLT(I,K) + GTTEV(I,K) = -EMELToCP * SNMLT(I,K) * DELPI(I,K) !DD heating rate due to precip melting for AW gtmelt(i,k) = gtmelt(i,k) + GTTEV(I,K) endif @@ -3350,8 +3529,15 @@ SUBROUTINE CUMDWN & ! Freeze & Melt & Evaporation GTQ(I,K,1) = GTQ(I,K,1) + GTQEV(I,K) ! GMFLX(I,K) = GMFLX(I,K) - GMDD(I,K) + endif + ENDDO ! end of i loop + ENDDO ! end of k loop ! AW tendencies due to vertical divergence of eddy fluxes + DO K=2,KTMX + kp1 = min(k+1,kmax) + DO I=ISTS,IENS + if (kb(i) > 0) then if (k > 1 .and. flx_form) then fsigma = one - sigmad(i,kp1) dp_below = wrk * (one - sigmad(i,k)) @@ -3381,28 +3567,6 @@ SUBROUTINE CUMDWN & ! Freeze & Melt & Evaporation endif ENDDO ! end of i loop ENDDO ! end of k loop -! - if (.not. do_awdd .and. flx_form) then - do k=1,kmax - do i=ists,iens - if (kb(i) > 0) then - dtdwn(i,k) = gtt(i,k) - dtdwn(i,k) - dqvdwn(i,k) = gtq(i,k,1) - dqvdwn(i,k) - dqldwn(i,k) = gtq(i,k,itl) - dqldwn(i,k) - dqidwn(i,k) = gtq(i,k,iti) - dqidwn(i,k) - endif - enddo - enddo - do n=ntrq,ntr - do k=1,kmax - do i=ists,iens - if (kb(i) > 0) then - dtrdwn(i,k,n) = gtq(i,k,n) - dtrdwn(i,k,n) - endif - enddo - enddo - enddo - endif ! END SUBROUTINE CUMDWN !*********************************************************************** @@ -3428,22 +3592,28 @@ SUBROUTINE CUMCLD & !! cloudiness REAL(kind_phys) FLIQC (IJSDIM, KMAX) !< liquid ratio in cumulus ! ! [INPUT] - REAL(kind_phys) GMFLX (IJSDIM, KMAX) ! cumulus mass flux + REAL(kind_phys) GMFLX (IJSDIM, KMAX+1) ! cumulus mass flux INTEGER KTMX INTEGER ISTS, IENS ! ! [WORK] INTEGER I, K REAL(kind_phys) CUMF, QC, wrk + LOGICAL, SAVE :: OFIRST = .TRUE. ! ! [INTERNAL PARAM] - REAL(kind_phys), parameter :: CMFMIN = 2.e-3_kind_phys, &!< Mc->cloudiness - CMFMAX = 3.e-1_kind_phys, &!< Mc->cloudiness - CLMIN = 1.e-3_kind_phys, &!< cloudiness Min. - CLMAX = 0.1_kind_phys, &!< cloudiness Max. - FACLW = 0.1_kind_phys, &!< Mc->CLW - FACLF = (CLMAX-CLMIN)/LOG(CMFMAX/CMFMIN) -! + REAL(kind_phys) :: FACLW = 0.1_kind_phys !> Mc->CLW + REAL(kind_phys) :: CMFMIN = 2.e-3_kind_phys !> Mc->cloudiness + REAL(kind_phys) :: CMFMAX = 3.e-1_kind_phys !> Mc->cloudiness + REAL(kind_phys) :: CLMIN = 1.e-3_kind_phys !> cloudiness Min. + REAL(kind_phys) :: CLMAX = 0.1_kind_phys !> cloudiness Max. + REAL(kind_phys), SAVE :: FACLF +! + IF ( OFIRST ) THEN + FACLF = (CLMAX-CLMIN)/LOG(CMFMAX/CMFMIN) + OFIRST = .FALSE. + END IF + CUMFRC(ISTS:IENS) = zero DO K=1,KTMX DO I=ISTS,IENS @@ -3668,26 +3838,28 @@ END SUBROUTINE CUMDNR !*********************************************************************** !>\ingroup cs_scheme SUBROUTINE CUMSBR & !! Tracer Subsidence - ( IM , IJSDIM, KMAX , NTR , & !DD dimensions + ( IM , IJSDIM, KMAX, NTR, NCTP, & !DD dimensions GTR , & ! modified - GDR , DELPI , & ! input + GDR , DELP , & ! input GMFLX , KTMX , OTSPT , & ! input + sigmai , sigma , & !DDsigma input ISTS, IENS ) ! input ! IMPLICIT NONE - INTEGER, INTENT(IN) :: IM, IJSDIM, KMAX, NTR !! DD, for GFS, pass in + INTEGER, INTENT(IN) :: IM, IJSDIM, KMAX, NTR, nctp !! DD, for GFS, pass in ! ! [MODIFY] REAL(kind_phys) GTR (IJSDIM, KMAX, NTR) !! tracer tendency ! ! [INPUT] REAL(kind_phys) GDR (IJSDIM, KMAX, NTR) !! tracer - REAL(kind_phys) DELPI (IJSDIM, KMAX) - REAL(kind_phys) GMFLX (IJSDIM, KMAX) !! mass flux + REAL(kind_phys) DELP (IJSDIM, KMAX) + REAL(kind_phys) GMFLX (IJSDIM, KMAX+1) !! mass flux INTEGER KTMX LOGICAL OTSPT (NTR) !! tracer transport on/off INTEGER ISTS, IENS + REAL(kind_phys) sigmai (IM,KMAX+1,NCTP), sigma(IM,KMAX+1) !!DDsigma cloud updraft fraction ! ! [INTERNAL WORK] INTEGER I, K, KM, KP, LT @@ -3703,14 +3875,14 @@ SUBROUTINE CUMSBR & !! Tracer Subsidence KM = MAX(K-1, 1) KP = MIN(K+1, KMAX) DO I=ISTS,IENS - SBR0 = GMFLX(I,KP) * (GDR(I,KP,LT) - GDR(I,K,LT)) - SBR1 = GMFLX(I,K) * (GDR(I,K,LT) - GDR(I,KM,LT)) - IF (GMFLX(I,K) > GMFLX(I,KP)) THEN + SBR0 = GMFLX(I,K+1) * (GDR(I,KP,LT) - GDR(I,K,LT)) + SBR1 = GMFLX(I,K) * (GDR(I,K,LT) - GDR(I,KM,LT)) + IF (GMFLX(I,K) > GMFLX(I,K+1)) THEN FX1 = half ELSE FX1 = zero END IF - GTR(I,K,LT) = GTR(I,K,LT) + DELPI(I,K) & + GTR(I,K,LT) = GTR(I,K,LT) + GRAV/DELP(I,K) & * ((one-FX(I))*SBR0 + FX1*SBR1) FX(I) = FX1 ENDDO @@ -3815,14 +3987,14 @@ END SUBROUTINE CUMFXR !********************************************************************* !>\ingroup cs_scheme SUBROUTINE CUMFXR1 & ! Tracer mass fixer - ( IM , IJSDIM, KMAX , & !DD dimensions + ( IM , IJSDIM, KMAX ,nctp, & !DD dimensions GTR , & ! modified GDR , DELP , DELTA , KTMX , IMFXR , & ! input ISTS , IENS ) ! input ! IMPLICIT NONE - INTEGER, INTENT(IN) :: IM, IJSDIM, KMAX ! DD, for GFS, pass in + INTEGER, INTENT(IN) :: IM, IJSDIM, KMAX, nctp !! DD, for GFS, pass in ! ! [MODIFY] REAL(kind_phys) GTR (IJSDIM, KMAX) ! tracer tendency diff --git a/physics/cs_conv.meta b/physics/CONV/Chikira_Sugiyama/cs_conv.meta similarity index 96% rename from physics/cs_conv.meta rename to physics/CONV/Chikira_Sugiyama/cs_conv.meta index fae1c91fe..ee8e1de55 100644 --- a/physics/cs_conv.meta +++ b/physics/CONV/Chikira_Sugiyama/cs_conv.meta @@ -2,7 +2,7 @@ [ccpp-table-properties] name = cs_conv type = scheme - dependencies = funcphys.f90,machine.F,physcons.F90 + dependencies = ../../tools/funcphys.f90,../../hooks/machine.F,../../hooks/physcons.F90 ######################################################################## [ccpp-arg-table] @@ -159,6 +159,7 @@ type = real kind = kind_phys intent = inout + optional = True [dd_mf] standard_name = instantaneous_atmosphere_downdraft_convective_mass_flux long_name = (downdraft mass flux) * delt @@ -215,6 +216,7 @@ type = real kind = kind_phys intent = inout + optional = True [mype] standard_name = mpi_rank long_name = current MPI rank @@ -258,7 +260,7 @@ standard_name = convective_updraft_area_fraction_at_model_interfaces long_name = convective updraft area fraction at model interfaces units = frac - dimensions = (horizontal_loop_extent,vertical_layer_dimension) + dimensions = (horizontal_loop_extent,vertical_interface_dimension) type = real kind = kind_phys intent = out @@ -312,6 +314,7 @@ type = real kind = kind_phys intent = out + optional = True [qicn] standard_name = mass_fraction_of_convective_cloud_ice long_name = mass fraction of convective cloud ice water @@ -320,6 +323,7 @@ type = real kind = kind_phys intent = out + optional = True [w_upi] standard_name = vertical_velocity_for_updraft long_name = vertical velocity for updraft @@ -328,6 +332,7 @@ type = real kind = kind_phys intent = out + optional = True [cf_upi] standard_name = convective_cloud_fraction_for_microphysics long_name = convective cloud fraction for microphysics @@ -336,6 +341,7 @@ type = real kind = kind_phys intent = out + optional = True [cnv_mfd] standard_name = detrained_mass_flux long_name = detrained mass flux @@ -344,6 +350,7 @@ type = real kind = kind_phys intent = out + optional = True [cnv_dqldt] standard_name = tendency_of_cloud_water_due_to_convective_microphysics long_name = tendency of cloud water due to convective microphysics @@ -352,6 +359,7 @@ type = real kind = kind_phys intent = out + optional = True [clcn] standard_name = convective_cloud_volume_fraction long_name = convective cloud volume fraction @@ -360,6 +368,7 @@ type = real kind = kind_phys intent = out + optional = True [cnv_fice] standard_name = ice_fraction_in_convective_tower long_name = ice fraction in convective tower @@ -368,6 +377,7 @@ type = real kind = kind_phys intent = out + optional = True [cnv_ndrop] standard_name = number_concentration_of_cloud_liquid_water_particles_for_detrainment long_name = droplet number concentration in convective detrainment @@ -376,6 +386,7 @@ type = real kind = kind_phys intent = out + optional = True [cnv_nice] standard_name = number_concentration_of_ice_crystals_for_detrainment long_name = crystal number concentration in convective detrainment @@ -384,6 +395,7 @@ type = real kind = kind_phys intent = out + optional = True [mp_phys] standard_name = control_for_microphysics_scheme long_name = flag for microphysics scheme diff --git a/physics/cs_conv_aw_adj.F90 b/physics/CONV/Chikira_Sugiyama/cs_conv_aw_adj.F90 similarity index 96% rename from physics/cs_conv_aw_adj.F90 rename to physics/CONV/Chikira_Sugiyama/cs_conv_aw_adj.F90 index bd0444bab..2d74779d1 100644 --- a/physics/cs_conv_aw_adj.F90 +++ b/physics/CONV/Chikira_Sugiyama/cs_conv_aw_adj.F90 @@ -40,8 +40,8 @@ subroutine cs_conv_aw_adj_run(im, levs, do_cscnv, do_aw, do_shoc, & real(kind_phys), dimension(:,:), intent(in) :: save_t real(kind_phys), dimension(:,:,:), intent(in) :: save_q real(kind_phys), dimension(:,:), intent(in) :: prsi - real(kind_phys), dimension(:,:), intent(inout) :: cldfrac - real(kind_phys), dimension(:,:), intent(inout) :: subcldfrac + real(kind_phys), dimension(:,:), intent(inout), optional :: cldfrac + real(kind_phys), dimension(:,:), intent(inout), optional :: subcldfrac real(kind_phys), dimension(:), intent(inout) :: prcp integer, intent(in ) :: imp_physics, imp_physics_mg character(len=*), intent( out) :: errmsg diff --git a/physics/cs_conv_aw_adj.meta b/physics/CONV/Chikira_Sugiyama/cs_conv_aw_adj.meta similarity index 98% rename from physics/cs_conv_aw_adj.meta rename to physics/CONV/Chikira_Sugiyama/cs_conv_aw_adj.meta index 0dada0fd5..88c3d27c7 100644 --- a/physics/cs_conv_aw_adj.meta +++ b/physics/CONV/Chikira_Sugiyama/cs_conv_aw_adj.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = cs_conv_aw_adj type = scheme - dependencies = machine.F + dependencies = ../../hooks/machine.F ######################################################################## [ccpp-arg-table] @@ -134,6 +134,7 @@ type = real kind = kind_phys intent = inout + optional = True [subcldfrac] standard_name = subgrid_scale_cloud_fraction_from_shoc long_name = subgrid-scale cloud fraction from the SHOC scheme @@ -142,6 +143,7 @@ type = real kind = kind_phys intent = inout + optional = True [prcp] standard_name = lwe_thickness_of_explicit_precipitation_amount long_name = explicit precipitation (rain, ice, snow, graupel, ...) on physics timestep diff --git a/physics/cs_conv_post.F90 b/physics/CONV/Chikira_Sugiyama/cs_conv_post.F90 similarity index 100% rename from physics/cs_conv_post.F90 rename to physics/CONV/Chikira_Sugiyama/cs_conv_post.F90 diff --git a/physics/cs_conv_post.meta b/physics/CONV/Chikira_Sugiyama/cs_conv_post.meta similarity index 93% rename from physics/cs_conv_post.meta rename to physics/CONV/Chikira_Sugiyama/cs_conv_post.meta index 116ffbef4..5877c051b 100644 --- a/physics/cs_conv_post.meta +++ b/physics/CONV/Chikira_Sugiyama/cs_conv_post.meta @@ -2,7 +2,7 @@ [ccpp-table-properties] name = cs_conv_post type = scheme - dependencies = machine.F + dependencies = ../../hooks/machine.F ######################################################################## [ccpp-arg-table] @@ -33,7 +33,7 @@ standard_name = convective_updraft_area_fraction_at_model_interfaces long_name = convective updraft area fraction at model interfaces units = frac - dimensions = (horizontal_loop_extent,vertical_layer_dimension) + dimensions = (horizontal_loop_extent,vertical_interface_dimension) type = real kind = kind_phys intent = in diff --git a/physics/cs_conv_pre.F90 b/physics/CONV/Chikira_Sugiyama/cs_conv_pre.F90 similarity index 100% rename from physics/cs_conv_pre.F90 rename to physics/CONV/Chikira_Sugiyama/cs_conv_pre.F90 diff --git a/physics/cs_conv_pre.meta b/physics/CONV/Chikira_Sugiyama/cs_conv_pre.meta similarity index 99% rename from physics/cs_conv_pre.meta rename to physics/CONV/Chikira_Sugiyama/cs_conv_pre.meta index 2decd5f8b..7ce80496b 100644 --- a/physics/cs_conv_pre.meta +++ b/physics/CONV/Chikira_Sugiyama/cs_conv_pre.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = cs_conv_pre type = scheme - dependencies = machine.F + dependencies = ../../hooks/machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/cu_gf_deep.F90 b/physics/CONV/Grell_Freitas/cu_gf_deep.F90 similarity index 95% rename from physics/cu_gf_deep.F90 rename to physics/CONV/Grell_Freitas/cu_gf_deep.F90 index 67dd9bd3f..0f324244a 100644 --- a/physics/cu_gf_deep.F90 +++ b/physics/CONV/Grell_Freitas/cu_gf_deep.F90 @@ -3,6 +3,7 @@ module cu_gf_deep use machine , only : kind_phys + use physcons, only : qamin real(kind=kind_phys), parameter::g=9.81 real(kind=kind_phys), parameter:: cp=1004. real(kind=kind_phys), parameter:: xlv=2.5e6 @@ -28,6 +29,7 @@ module cu_gf_deep integer, parameter :: autoconv=1 !2 integer, parameter :: aeroevap=1 !3 real(kind=kind_phys), parameter :: scav_factor = 0.5 + real(kind=kind_phys), parameter :: dx_thresh = 6500. !> still 16 ensembles for clousres integer, parameter:: maxens3=16 @@ -123,6 +125,11 @@ subroutine cu_gf_deep_run( & ,frh_out & ! fractional coverage ,ierr & ! ierr flags are error flags, used for debugging ,ierrc & ! the following should be set to zero if not available + ,nchem & + ,fscav & + ,chem3d & + ,wetdpc_deep & + ,do_smoke_transport & ,rand_mom & ! for stochastics mom, if temporal and spatial patterns exist ,rand_vmas & ! for stochastics vertmass, if temporal and spatial patterns exist ,rand_clos & ! for stochastics closures, if temporal and spatial patterns exist @@ -135,15 +142,15 @@ subroutine cu_gf_deep_run( & !! betwee -1 and +1 ,do_capsuppress,cap_suppress_j & ! ,k22 & ! - ,jmin,tropics) ! + ,jmin,kdt,tropics) ! implicit none integer & ,intent (in ) :: & - nranflag,itf,ktf,its,ite, kts,kte,ipr,imid + nranflag,itf,ktf,its,ite, kts,kte,ipr,imid,kdt integer, intent (in ) :: & - ichoice + ichoice,nchem real(kind=kind_phys), dimension (its:ite,4) & ,intent (in ) :: rand_clos real(kind=kind_phys), dimension (its:ite) & @@ -151,7 +158,7 @@ subroutine cu_gf_deep_run( & !$acc declare copyin(rand_clos,rand_mom,rand_vmas) integer, intent(in) :: do_capsuppress - real(kind=kind_phys), intent(in), dimension(:) :: cap_suppress_j + real(kind=kind_phys), intent(in), dimension(:), optional :: cap_suppress_j !$acc declare create(cap_suppress_j) ! ! @@ -162,17 +169,17 @@ subroutine cu_gf_deep_run( & ! outq = output q tendency (per s) ! outqc = output qc tendency (per s) ! pre = output precip - real(kind=kind_phys), dimension (its:ite,kts:kte) & + real(kind=kind_phys), dimension (its:ite,kts:kte) & ,intent (inout ) :: & cnvwt,outu,outv,outt,outq,outqc,cupclw - real(kind=kind_phys), dimension (its:ite) & + real(kind=kind_phys), dimension (its:ite) & ,intent (out ) :: & frh_out - real(kind=kind_phys), dimension (its:ite) & + real(kind=kind_phys), dimension (its:ite) & ,intent (inout ) :: & pre,xmb_out !$acc declare copy(cnvwt,outu,outv,outt,outq,outqc,cupclw,frh_out,pre,xmb_out) - real(kind=kind_phys), dimension (its:ite) & + real(kind=kind_phys), dimension (its:ite) & ,intent (in ) :: & hfx,qfx,xmbm_in,xmbs_in !$acc declare copyin(hfx,qfx,xmbm_in,xmbs_in) @@ -189,29 +196,36 @@ subroutine cu_gf_deep_run( & ! omega (omeg), windspeed (us,vs), and a flag (ierr) to turn off ! convection for this call only and at that particular gridpoint ! - real(kind=kind_phys), dimension (its:ite,kts:kte) & + real(kind=kind_phys), dimension (its:ite,kts:kte) & ,intent (in ) :: & dhdt,rho,t,po,us,vs,tn !$acc declare copyin(dhdt,rho,t,po,us,vs,tn) - real(kind=kind_phys), dimension (its:ite,kts:kte) & + real(kind=kind_phys), dimension (its:ite,kts:kte) & ,intent (inout ) :: & omeg !$acc declare copy(omeg) - real(kind=kind_phys), dimension (its:ite,kts:kte) & + real(kind=kind_phys), dimension (its:ite,kts:kte) & ,intent (inout) :: & q,qo,zuo,zdo,zdm !$acc declare copy(q,qo,zuo,zdo,zdm) - real(kind=kind_phys), dimension (its:ite) & + real(kind=kind_phys), dimension (its:ite) & ,intent (in ) :: & dx,z1,psur,xland !$acc declare copyin(dx,z1,psur,xland) - real(kind=kind_phys), dimension (its:ite) & + real(kind=kind_phys), dimension (its:ite) & ,intent (inout ) :: & mconv,ccn !$acc declare copy(mconv,ccn) - - - real(kind=kind_phys) & + real(kind=kind_phys), dimension (:,:,:) & + ,intent (inout), optional :: & + chem3d + logical, intent (in) :: do_smoke_transport + real(kind=kind_phys), dimension (:,:) & + , intent (out), optional :: wetdpc_deep + real(kind=kind_phys), intent (in) :: fscav(:) +!$acc declare copy(chem3d) copyout(wetdpc_deep) copyin(fscav) + + real(kind=kind_phys) & ,intent (in ) :: & dtime,ccnclean @@ -219,11 +233,11 @@ subroutine cu_gf_deep_run( & ! ! local ensemble dependent variables in this routine ! - real(kind=kind_phys), dimension (its:ite,1) :: & + real(kind=kind_phys), dimension (its:ite,1) :: & xaa0_ens - real(kind=kind_phys), dimension (its:ite,1) :: & + real(kind=kind_phys), dimension (its:ite,1) :: & edtc - real(kind=kind_phys), dimension (its:ite,kts:kte,1) :: & + real(kind=kind_phys), dimension (its:ite,kts:kte,1) :: & dellat_ens,dellaqc_ens,dellaq_ens,pwo_ens !$acc declare create(xaa0_ens,edtc,dellat_ens,dellaqc_ens,dellaq_ens,pwo_ens) ! @@ -291,8 +305,20 @@ subroutine cu_gf_deep_run( & ! xmb = total base mass flux ! hc = cloud moist static energy ! hkb = moist static energy at originating level - - real(kind=kind_phys), dimension (its:ite,kts:kte) :: & + real(kind=kind_phys), dimension (its:ite,kts:kte,nchem) :: & + chem + real(kind=kind_phys), dimension (its:ite,kts:kte,nchem) :: & + chem_cup,chem_up,chem_down,dellac,dellac2,chem_c,chem_pw,chem_pwd + real(kind=kind_phys), dimension (its:ite,nchem) :: & + chem_pwav,chem_psum + real(kind=kind_phys):: dtime_max,sum1,sum2 + real(kind=kind_phys), dimension (kts:kte) :: trac,trcflx_in,trcflx_out,trc,trco + real(kind=kind_phys), dimension (its:ite,kts:kte) :: pwdper, massflx + integer :: nv +!$acc declare create(chem,chem_cup,chem_up,chem_down,dellac,dellac2,chem_c,chem_pw,chem_pwd, & +!$acc chem_pwav,chem_psum,pwdper,massflx) + + real(kind=kind_phys), dimension (its:ite,kts:kte) :: & entr_rate_2d,mentrd_rate_2d,he,hes,qes,z, heo,heso,qeso,zo, & xhe,xhes,xqes,xz,xt,xq,qes_cup,q_cup,he_cup,hes_cup,z_cup, & p_cup,gamma_cup,t_cup, qeso_cup,qo_cup,heo_cup,heso_cup, & @@ -329,13 +355,13 @@ subroutine cu_gf_deep_run( & ! xaa0 = cloud work function with cloud effects (ensemble dependent) ! edt = epsilon - real(kind=kind_phys), dimension (its:ite) :: & - edt,edto,edtm,aa1,aa0,xaa0,hkb, & + real(kind=kind_phys), dimension (its:ite) :: & + edt,edto,edtm,aa1,aa0,xaa0,hkb, & hkbo,xhkb, & xmb,pwavo,ccnloss, & pwevo,bu,bud,cap_max, & cap_max_increment,closure_n,psum,psumh,sig,sigd - real(kind=kind_phys), dimension (its:ite) :: & + real(kind=kind_phys), dimension (its:ite) :: & axx,edtmax,edtmin,entr_rate integer, dimension (its:ite) :: & kzdown,kdet,k22,jmin,kstabi,kstabm,k22x,xland1, & @@ -350,7 +376,7 @@ subroutine cu_gf_deep_run( & !$acc ktopdby,kbconx,ierr2,ierr3,kbmax) integer, dimension (its:ite), intent(inout) :: ierr - integer, dimension (its:ite), intent(in) :: csum + integer, dimension (its:ite), intent(in), optional :: csum !$acc declare copy(ierr) copyin(csum) integer :: & iloop,nens3,ki,kk,i,k @@ -371,10 +397,10 @@ subroutine cu_gf_deep_run( & character*50 :: ierrc(its:ite) character*4 :: cumulus - real(kind=kind_phys), dimension (its:ite,kts:kte) :: & + real(kind=kind_phys), dimension (its:ite,kts:kte) :: & up_massentr,up_massdetr,c1d & ,up_massentro,up_massdetro,dd_massentro,dd_massdetro - real(kind=kind_phys), dimension (its:ite,kts:kte) :: & + real(kind=kind_phys), dimension (its:ite,kts:kte) :: & up_massentru,up_massdetru,dd_massentru,dd_massdetru !$acc declare create(up_massentr,up_massdetr,c1d,up_massentro,up_massdetro,dd_massentro,dd_massdetro, & !$acc up_massentru,up_massdetru,dd_massentru,dd_massdetru) @@ -400,7 +426,8 @@ subroutine cu_gf_deep_run( & real(kind=kind_phys), dimension (its:ite,kts:kte) :: dtempdz integer, dimension (its:ite,kts:kte) :: k_inv_layers real(kind=kind_phys), dimension (its:ite) :: c0 ! HCB -!$acc declare create(pmin_lev,start_level,ktopkeep,dtempdz,k_inv_layers,c0) + real(kind=kind_phys), dimension (its:ite,kts:kte) :: c0t3d ! hli for smoke/dust wet scavenging +!$acc declare create(pmin_lev,start_level,ktopkeep,dtempdz,k_inv_layers,c0,c0t3d) ! rainevap from sas real(kind=kind_phys) zuh2(40) @@ -564,6 +591,7 @@ subroutine cu_gf_deep_run( & sig(i)=(1.-frh)**2 !frh_out(i) = frh if(forcing(i,7).eq.0.)sig(i)=1. + if(kdt.le.(3600./dtime))sig(i)=1. frh_out(i) = frh*sig(i) enddo !$acc end kernels @@ -1057,14 +1085,14 @@ subroutine cu_gf_deep_run( & if(imid.eq.1)then call cup_up_moisture('mid',ierr,zo_cup,qco,qrco,pwo,pwavo, & p_cup,kbcon,ktop,dbyo,clw_all,xland1, & - qo,gammao_cup,zuo,qeso_cup,k22,qo_cup,c0, & + qo,gammao_cup,zuo,qeso_cup,k22,qo_cup,c0,c0t3d, & zqexec,ccn,ccnclean,rho,c1d,tn_cup,autoconv,up_massentr,up_massdetr,psum,psumh, & 1,itf,ktf, & its,ite, kts,kte) else call cup_up_moisture('deep',ierr,zo_cup,qco,qrco,pwo,pwavo, & p_cup,kbcon,ktop,dbyo,clw_all,xland1, & - qo,gammao_cup,zuo,qeso_cup,k22,qo_cup,c0, & + qo,gammao_cup,zuo,qeso_cup,k22,qo_cup,c0,c0t3d, & zqexec,ccn,ccnclean,rho,c1d,tn_cup,autoconv,up_massentr,up_massdetr,psum,psumh, & 1,itf,ktf, & its,ite, kts,kte) @@ -2012,6 +2040,186 @@ subroutine cu_gf_deep_run( & kts,kte,ierr,kbcon,xmb,psur,xland,qo_cup, & po_cup,qes_cup,pwavo,edto,pwevo,pre,outt,outq) !,outbuoy) +! +! +!>- atmospheric composition tracers +! +!> ## Determine whether to perform aerosol transport + if (do_smoke_transport .and. nchem > 0) then +! +! initialize tracers if they exist +! + chem (:,:,:) = 0. +!$acc kernels + do nv = 1,nchem + do k = 1, ktf + do i = 1, itf + chem(i,k,nv) = max(qamin, chem3d(i,k,nv)) + enddo + enddo + enddo + + wetdpc_deep = 0. + + chem_pwav(:,:) = 0. + chem_psum(:,:) = 0. + chem_pw (:,:,:) = 0. + chem_pwd (:,:,:) = 0. + pwdper (:,:) = 0. + chem_down(:,:,:) = 0. + chem_up (:,:,:) = 0. + chem_c (:,:,:) = 0. + chem_cup (:,:,:) = 0. + + do i=its,itf + if(ierr(i).eq.0)then + do k=kts,jmin(i) + if(pwavo(i).ne.0.) pwdper(i,k)=-edtc(i,1)*pwdo(i,k)/pwavo(i) + enddo + pwdper(i,:)=0. + do nv=1,nchem + do k=kts+1,ktf + chem_cup(i,k,nv)=.5*(chem(i,k-1,nv)+chem(i,k,nv)) + enddo + chem_cup(i,kts,nv)=chem(i,kts,nv) +! +! in updraft +! + do k=1,k22(i) + chem_up(i,k,nv)=chem_cup(i,k,nv) + enddo + do k=k22(i)+1,ktop(i) + chem_up(i,k,nv)=(chem_up(i,k-1,nv)*zuo(i,k-1) & + -.5*up_massdetr(i,k-1)*chem_up(i,k-1,nv)+ & + up_massentr(i,k-1)*chem(i,k-1,nv)) / & + (zuo(i,k-1)-.5*up_massdetr(i,k-1)+up_massentr(i,k-1)) + chem_c(i,k,nv)=fscav(nv)*chem_up(i,k,nv) + dz=zo_cup(i,K)-zo_cup(i,K-1) + trash2=chem_up(i,k,nv)-chem_c(i,k,nv) + trash=chem_c(i,k,nv)/(1.+c0t3d(i,k)*dz) + chem_pw=c0t3d(i,k)*dz*trash*zuo(i,k) + chem_up(i,k,nv)=trash2+trash + chem_pwav(i,nv)=chem_pwav(i,nv)+chem_pw(i,k,nv)! *g/dp + enddo + do k=ktop(i)+1,ktf + chem_up(i,k,nv)=chem_cup(i,k,nv) + enddo +! +! in downdraft +! + chem_down(i,jmin(i)+1,nv)=chem_cup(i,jmin(i)+1,nv) + chem_psum(i,nv)=0. + do ki=jmin(i),2,-1 + dp=100.*(po_cup(i,ki)-po_cup(i,ki+1)) + chem_down(i,ki,nv)=(chem_down(i,ki+1,nv)*zdo(i,ki+1) & + -.5_kind_phys*dd_massdetro(i,ki)*chem_down(i,ki+1,nv)+ & + dd_massentro(i,ki)*chem(i,ki,nv)) / & + (zdo(i,ki+1)-.5_kind_phys*dd_massdetro(i,ki)+dd_massentro(i,ki)) + chem_down(i,ki,nv)=chem_down(i,ki,nv)+pwdper(i,ki)*chem_pwav(i,nv) + chem_pwd(i,ki,nv)=max(0._kind_phys,pwdper(i,ki)*chem_pwav(i,nv)) + enddo +! total wet deposition + do k=1,ktf-1 + dp=100.*(po_cup(i,k)-po_cup(i,k+1)) + chem_psum(i,nv)=chem_psum(i,nv)+chem_pw(i,k,nv)*g !/dp + enddo + chem_psum(i,nv)=chem_psum(i,nv)*xmb(i)*dtime +! + enddo ! nchem + endif ! ierr=0 + enddo ! i + + dellac(:,:,:)=0. + + do nv=1,nchem + do i=its,itf + if(ierr(i).eq.0)then + dp=100.*(po_cup(i,1)-po_cup(i,2)) + dellac(i,1,nv)=dellac(i,1,nv)+(edto(i)*zdo(i,2)*chem_down(i,2,nv))*g/dp*xmb(i) + if(k22(i).eq.2)then + entupk=zuo(i,2) + dellac(i,1,nv)=dellac(i,1,nv)-entupk*chem_cup(i,2,nv)*g/dp*xmb(i) + endif + do k=kts+1,ktop(i)-1 + detup=0. + detdo=0. + entup=0. + entdo=0. + entdoj=0. + dp=100.*(po_cup(i,k)-po_cup(i,k+1)) + ! entrainment/detrainment for updraft + entdo=edto(i)*dd_massentro(i,k)*chem(i,k,nv) + detdo=edto(i)*dd_massdetro(i,k)*.5*(chem_down(i,k+1,nv)+chem_down(i,k,nv)) + entup=up_massentro(i,k)*chem(i,k,nv) + detup=up_massdetro(i,k)*.5*(chem_up(i,k+1,nv)+chem_up(i,k,nv)) + ! special levels + if(k == k22(i)-1) then + entup=zuo(i,k+1)*chem_cup(i,k+1,nv) + detup=0. + endif + if(k.eq.jmin(i))entdoj=edto(i)*zdo(i,k)*chem_cup(i,k,nv) +! mass budget + dellac(i,k,nv) =dellac(i,k,nv) + (detup+detdo-entdo-entup-entdoj)*g/dp*xmb(i) + enddo + dellac(i,ktop(i),nv)=zuo(i,ktop(i))*chem_up(i,ktop(i),nv)*g/dp*xmb(i) + endif ! ierr + enddo ! i + enddo ! nchem loop + +! fct for subsidence + dellac2(:,:,:)=0. + massflx(:,:)=0. + do nv=1,nchem +!$acc loop private(trcflx_in) + do i=its,itf + if(ierr(i).eq.0)then + trcflx_in(:)=0. + dtime_max=dtime + +! initialize fct routine + do k=kts,ktop(i) + dp=100._kind_phys*(po_cup(i,k)-po_cup(i,k+1)) + dtime_max=min(dtime_max,.5_kind_phys*dp) + massflx(i,k)=-xmb(i)*(zuo(i,k)-edto(i)*zdo(i,k)) + trcflx_in(k)=massflx(i,k)*chem_cup(i,k,nv) + enddo + trcflx_in(1)=0. + massflx(i,1)=0. + call fct1d3(ktop(i),kte,dtime_max,po_cup(i,:),chem(i,:,nv),massflx(i,:), & + trcflx_in,dellac2(i,:,nv),g) + do k=kts,ktop(i) + trash=chem (i,k,nv) + chem (i,k,nv)=chem (i,k,nv) + (dellac(i,k,nv)+dellac2(i,k,nv))*dtime + if(chem(i,k,nv).lt.qamin)then + dp=100.*(po_cup(i,k)-po_cup(i,k+1)) + wetdpc_deep(i,nv)=wetdpc_deep(i,nv)+(qamin-chem(i,k,nv))*dp/g/dtime + chem(i,k,nv)=qamin + endif + enddo + endif + + enddo ! i + enddo ! nchem loop + +!> - Store aerosol concentrations if present + do nv = 1, nchem + do i = 1, itf + do k = 1, ktf + if(ierr(i).eq.0) then + if (k <= ktop(i)) then + dp=100.*(po_cup(i,k)-po_cup(i,k+1)) + wetdpc_deep(i,nv)=wetdpc_deep(i,nv) + ((chem3d(i,k,nv)-chem(i,k,nv))*dp/(g*dtime)) + chem3d(i,k,nv) = chem(i,k,nv) + endif + endif + enddo + wetdpc_deep(i,nv)=max(wetdpc_deep(i,nv),qamin) + enddo + enddo +!$acc end kernels + + endif ! nchem > 0 + k=1 !$acc kernels do i=its,itf @@ -4100,7 +4308,7 @@ end subroutine cup_output_ens_3d !> Calculates moisture properties of the updraft. subroutine cup_up_moisture(name,ierr,z_cup,qc,qrc,pw,pwav, & p_cup,kbcon,ktop,dby,clw_all,xland1, & - q,gamma_cup,zu,qes_cup,k22,qe_cup,c0, & + q,gamma_cup,zu,qes_cup,k22,qe_cup,c0,c0t3d, & zqexec,ccn,ccnclean,rho,c1d,t,autoconv, & up_massentr,up_massdetr,psum,psumh, & itest,itf,ktf, & @@ -4136,11 +4344,13 @@ subroutine cup_up_moisture(name,ierr,z_cup,qc,qrc,pw,pwav, & real(kind=kind_phys), dimension (its:ite) & ,intent (in ) :: & zqexec,c0 + real(kind=kind_phys), dimension (its:ite,kts:kte), intent (out) :: c0t3d ! entr= entrainment rate integer, dimension (its:ite) & ,intent (in ) :: & kbcon,ktop,k22,xland1 !$acc declare copyin(p_cup,rho,q,zu,gamma_cup,qe_cup,up_massentr,up_massdetr,dby,qes_cup,z_cup,zqexec,c0,kbcon,ktop,k22,xland1) +!$acc declare copy(c0t3d) real(kind=kind_phys), intent (in ) :: & ! HCB ccnclean ! @@ -4217,6 +4427,9 @@ subroutine cup_up_moisture(name,ierr,z_cup,qc,qrc,pw,pwav, & c0_iceconv=0.01 c1d_b=c1d bdsp(:)=bdispm +!$acc kernels + c0t3d = 0. +!$acc end kernels ! !--- no precip for small clouds @@ -4287,6 +4500,7 @@ subroutine cup_up_moisture(name,ierr,z_cup,qc,qrc,pw,pwav, & else c0t = c0(i) * exp(c0_iceconv * (t(i,k) - 273.16)) endif + c0t3d(i,k)=c0t qc(i,k)= (qc(i,k-1)*zu(i,k-1)-.5*up_massdetr(i,k-1)* qc(i,k-1)+ & up_massentr(i,k-1)*q(i,k-1)) / & (zu(i,k-1)-.5*up_massdetr(i,k-1)+up_massentr(i,k-1)) @@ -4319,6 +4533,7 @@ subroutine cup_up_moisture(name,ierr,z_cup,qc,qrc,pw,pwav, & c0t = c0(i) * exp(c0_iceconv * (t(i,k) - 273.16)) endif if(is_mid)c0t=0.004 + c0t3d(i,k)=c0t if(autoconv .gt.1) c0t=c0(i) denom=zu(i,k-1)-.5*up_massdetr(i,k-1)+up_massentr(i,k-1) @@ -4707,11 +4922,10 @@ subroutine get_zu_zd_pdf_fim(kklev,p,rand_vmas,zubeg,ipr,xland,zuh2,draft,ierr,k if(draft == 1) then lev_start=min(.9,.1+csum*.013) kb_adj=max(kb,2) - tunning=max(p(kklev+1),.5*(p(kpbli)+p(kt))) - tunning=p(kklev) -! tunning=p(kklev+1) !p(kpbli+1) !p(kklev) !p(kt)+(p(kpbli)-p(kt))*lev_start -! tunning=.5*(p(kb_adj)+p(kt)) !p(kpbli+1) !p(kklev) !p(kt)+(p(kpbli)-p(kt))*lev_start +! trash is the depth of the cloud trash=-p(kt)+p(kb_adj) + tunning=p(kklev) + if(rand_vmas.ne.0.) tunning=p(kklev-1)+.1*rand_vmas*trash beta_deep=1.3 +(1.-trash/1200.) tunning =min(0.95, (tunning-p(kb_adj))/(p(kt)-p(kb_adj))) !=.6 tunning =max(0.02, tunning) diff --git a/physics/cu_gf_driver.F90 b/physics/CONV/Grell_Freitas/cu_gf_driver.F90 similarity index 91% rename from physics/cu_gf_driver.F90 rename to physics/CONV/Grell_Freitas/cu_gf_driver.F90 index f82569b99..df5a196b1 100644 --- a/physics/cu_gf_driver.F90 +++ b/physics/CONV/Grell_Freitas/cu_gf_driver.F90 @@ -67,7 +67,8 @@ subroutine cu_gf_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart,& fhour,fh_dfi_radar,ix_dfi_radar,num_dfi_radar,cap_suppress, & dfi_radar_max_intervals,ldiag3d,qci_conv,do_cap_suppress, & maxupmf,maxMF,do_mynnedmf,ichoice_in,ichoicem_in,ichoice_s_in, & - errmsg,errflg) + spp_cu_deep,spp_wts_cu_deep,nchem,chem3d,fscav,wetdpc_deep, & + do_smoke_transport,kdt,errmsg,errflg) !------------------------------------------------------------- implicit none integer, parameter :: maxiens=1 @@ -80,8 +81,12 @@ subroutine cu_gf_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart,& integer :: ichoice=0 ! 0 2 5 13 8 integer :: ichoicem=13 ! 0 2 5 13 integer :: ichoice_s=3 ! 0 1 2 3 + integer, intent(in) :: spp_cu_deep ! flag for using SPP perturbations + real(kind_phys), dimension(:,:), intent(in),optional :: & + & spp_wts_cu_deep + real(kind=kind_phys) :: spp_wts_cu_deep_tmp - logical, intent(in) :: do_cap_suppress + logical, intent(in) :: do_cap_suppress, do_smoke_transport real(kind=kind_phys), parameter :: aodc0=0.14 real(kind=kind_phys), parameter :: aodreturn=30. real(kind=kind_phys) :: dts,fpi,fp @@ -90,22 +95,23 @@ subroutine cu_gf_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart,& integer :: ishallow_g3 ! depend on imfshalcnv !------------------------------------------------------------- integer :: its,ite, jts,jte, kts,kte - integer, intent(in ) :: im,km,ntracer + integer, intent(in ) :: im,km,ntracer,nchem,kdt integer, intent(in ) :: ichoice_in,ichoicem_in,ichoice_s_in logical, intent(in ) :: flag_init, flag_restart, do_mynnedmf logical, intent(in ) :: flag_for_scnv_generic_tend,flag_for_dcnv_generic_tend real (kind=kind_phys), intent(in) :: g,cp,xlv,r_v logical, intent(in ) :: ldiag3d - real(kind=kind_phys), intent(inout) :: dtend(:,:,:) + real(kind=kind_phys), intent(inout), optional :: dtend(:,:,:) !$acc declare copy(dtend) integer, intent(in) :: dtidx(:,:), & index_of_x_wind, index_of_y_wind, index_of_temperature, & index_of_process_scnv, index_of_process_dcnv, ntqv, ntcw, ntiw !$acc declare copyin(dtidx) - real(kind=kind_phys), dimension( : , : ), intent(in ) :: forcet,forceqv_spechum,w,phil + real(kind=kind_phys), dimension( : , : ), intent(in ), optional :: forcet,forceqv_spechum + real(kind=kind_phys), dimension( : , : ), intent(in ) :: w,phil real(kind=kind_phys), dimension( : , : ), intent(inout ) :: t,us,vs - real(kind=kind_phys), dimension( : , : ), intent(inout ) :: qci_conv + real(kind=kind_phys), dimension( : , : ), intent(inout ), optional :: qci_conv real(kind=kind_phys), dimension( : , : ), intent(out ) :: cnvw_moist,cnvc real(kind=kind_phys), dimension( : , : ), intent(inout ) :: cliw, clcw !$acc declare copyin(forcet,forceqv_spechum,w,phil) @@ -117,27 +123,30 @@ subroutine cu_gf_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart,& integer, intent(in) :: dfi_radar_max_intervals real(kind=kind_phys), intent(in) :: fhour, fh_dfi_radar(:) integer, intent(in) :: num_dfi_radar, ix_dfi_radar(:) - real(kind=kind_phys), intent(in) :: cap_suppress(:,:) + real(kind=kind_phys), intent(in), optional :: cap_suppress(:,:) !$acc declare copyin(fh_dfi_radar,ix_dfi_radar,cap_suppress) integer, dimension (:), intent(out) :: hbot,htop,kcnv integer, dimension (:), intent(in) :: xland - real(kind=kind_phys), dimension (:), intent(in) :: pbl,maxMF + real(kind=kind_phys), dimension (:), intent(in) :: pbl + real(kind=kind_phys), dimension (:), intent(in), optional :: maxMF !$acc declare copyout(hbot,htop,kcnv) !$acc declare copyin(xland,pbl) integer, dimension (im) :: tropics !$acc declare create(tropics) ! ruc variable real(kind=kind_phys), dimension (:), intent(in) :: hfx2,qfx2,psuri - real(kind=kind_phys), dimension (:,:), intent(out) :: ud_mf,dd_mf,dt_mf - real(kind=kind_phys), dimension (:), intent(out) :: raincv,cld1d,maxupmf + real(kind=kind_phys), dimension (:,:), intent(out) :: dd_mf,dt_mf + real(kind=kind_phys), dimension (:,:), intent(out), optional :: ud_mf + real(kind=kind_phys), dimension (:), intent(out) :: raincv,cld1d + real(kind=kind_phys), dimension (:), intent(out), optional :: maxupmf real(kind=kind_phys), dimension (:,:), intent(in) :: t2di,p2di !$acc declare copyin(hfx2,qfx2,psuri,t2di,p2di) !$acc declare copyout(ud_mf,dd_mf,dt_mf,raincv,cld1d) ! Specific humidity from FV3 real(kind=kind_phys), dimension (:,:), intent(in) :: qv2di_spechum real(kind=kind_phys), dimension (:,:), intent(inout) :: qv_spechum - real(kind=kind_phys), dimension (:), intent(inout) :: aod_gf + real(kind=kind_phys), dimension (:), intent(inout), optional :: aod_gf !$acc declare copyin(qv2di_spechum) copy(qv_spechum,aod_gf) ! Local water vapor mixing ratios and cloud water mixing ratios real(kind=kind_phys), dimension (im,km) :: qv2di, qv, forceqv, cnvw @@ -148,8 +157,12 @@ subroutine cu_gf_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart,& real(kind=kind_phys), intent(in ) :: dt integer, intent(in ) :: imfshalcnv - integer, dimension(:), intent(inout) :: cactiv,cactiv_m -!$acc declare copy(cactiv,cactiv_m) + integer, dimension(:), intent(inout), optional :: cactiv,cactiv_m + real(kind_phys), dimension(:), intent(in) :: fscav +!$acc declare copyin(fscav) + real(kind_phys), dimension(:,:,:), intent(inout), optional :: chem3d + real(kind_phys), dimension(:,:), intent(inout), optional :: wetdpc_deep +!$acc declare copy(cactiv,cactiv_m,chem3d,wetdpc_deep) character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -174,19 +187,20 @@ subroutine cu_gf_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart,& 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 + real(kind=kind_phys), dimension (im,nchem) :: wetdpc_mid integer, dimension (im) :: kbcon, ktop,ierr,ierrs,ierrm,kpbli integer, dimension (im) :: k22s,kbcons,ktops,k22,jmin,jminm integer, dimension (im) :: kbconm,ktopm,k22m !$acc declare create(k22_shallow,kbcon_shallow,ktop_shallow,rand_mom,rand_vmas, & -!$acc rand_clos,gdc,gdc2,ht,ccn_gf,ccn_m,dx,frhm,frhd, & +!$acc rand_clos,gdc,gdc2,ht,ccn_gf,ccn_m,dx,frhm,frhd,wetdpc_mid, & !$acc outt,outq,outqc,phh,subm,cupclw,cupclws, & !$acc dhdt,zu,zus,zd,phf,zum,zdm,outum,outvm, & !$acc outts,outqs,outqcs,outu,outv,outus,outvs, & !$acc outtm,outqm,outqcm,submm,cupclwm, & !$acc cnvwt,cnvwts,cnvwtm,hco,hcdo,zdo,zdd,hcom,hcdom,zdom, & !$acc tau_ecmwf,edt,edtm,edtd,ter11,aa0,xlandi, & -!$acc pret,prets,pretm,hexec,forcing,forcing2, & +!$acc pret,prets,pretm,hexec,forcing,forcing2,wetdpc_mid, & !$acc kbcon, ktop,ierr,ierrs,ierrm,kpbli, & !$acc k22s,kbcons,ktops,k22,jmin,jminm,kbconm,ktopm,k22m) @@ -313,9 +327,18 @@ subroutine cu_gf_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart,& ! these should be coming in from outside ! ! cactiv(:) = 0 - rand_mom(:) = 0. - rand_vmas(:) = 0. - rand_clos(:,:) = 0. + if (spp_cu_deep == 0) then + rand_mom(:) = 0. + rand_vmas(:) = 0. + rand_clos(:,:) = 0. + else + do i=1,im + spp_wts_cu_deep_tmp=min(max(-1.0_kind_phys, spp_wts_cu_deep(i,1)),1.0_kind_phys) + rand_mom(i) = spp_wts_cu_deep_tmp + rand_vmas(i) = spp_wts_cu_deep_tmp + rand_clos(i,:) = spp_wts_cu_deep_tmp + end do + end if !$acc end kernels ! its=1 @@ -630,7 +653,6 @@ subroutine cu_gf_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart,& enddo !$acc end kernels if (dx(its)<6500.) then - ichoice=10 imid_gf=0 endif ! @@ -730,11 +752,16 @@ subroutine cu_gf_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart,& ,frhm & ,ierrm & ,ierrcm & + ,nchem & + ,fscav & + ,chem3d & + ,wetdpc_mid & + ,do_smoke_transport & ! the following should be set to zero if not available ,rand_mom & ! for stochastics mom, if temporal and spatial patterns exist ,rand_vmas & ! for stochastics vertmass, if temporal and spatial patterns exist ,rand_clos & ! for stochastics closures, if temporal and spatial patterns exist - ,0 & ! flag to what you want perturbed + ,spp_cu_deep & ! flag to what you want perturbed ! 1 = momentum transport ! 2 = normalized vertical mass flux profile ! 3 = closures @@ -743,7 +770,7 @@ subroutine cu_gf_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart,& ! betwee -1 and +1 ,do_cap_suppress_here,cap_suppress_j & ,k22m & - ,jminm,tropics) + ,jminm,kdt,tropics) !$acc kernels do i=its,itf do k=kts,ktf @@ -789,34 +816,38 @@ subroutine cu_gf_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart,& ,dx & ,mconv & ,omeg & - - ,cactiv & - ,cnvwt & - ,zu & - ,zd & - ,zdm & ! hli - ,edt & - ,edtm & ! hli - ,xmb & - ,xmbm & - ,xmbs & - ,pret & - ,outu & - ,outv & - ,outt & - ,outq & - ,outqc & - ,kbcon & - ,ktop & - ,cupclw & - ,frhd & - ,ierr & - ,ierrc & + ,cactiv & + ,cnvwt & + ,zu & + ,zd & + ,zdm & ! hli + ,edt & + ,edtm & ! hli + ,xmb & + ,xmbm & + ,xmbs & + ,pret & + ,outu & + ,outv & + ,outt & + ,outq & + ,outqc & + ,kbcon & + ,ktop & + ,cupclw & + ,frhd & + ,ierr & + ,ierrc & + ,nchem & + ,fscav & + ,chem3d & + ,wetdpc_deep & + ,do_smoke_transport & ! the following should be set to zero if not available ,rand_mom & ! for stochastics mom, if temporal and spatial patterns exist ,rand_vmas & ! for stochastics vertmass, if temporal and spatial patterns exist ,rand_clos & ! for stochastics closures, if temporal and spatial patterns exist - ,0 & ! flag to what you want perturbed + ,spp_cu_deep & ! flag to what you want perturbed ! 1 = momentum transport ! 2 = normalized vertical mass flux profile ! 3 = closures @@ -825,7 +856,7 @@ subroutine cu_gf_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart,& ! betwee -1 and +1 ,do_cap_suppress_here,cap_suppress_j & ,k22 & - ,jmin,tropics) + ,jmin,kdt,tropics) jpr=0 ipr=0 !$acc kernels @@ -914,38 +945,6 @@ subroutine cu_gf_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart,& !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) -! -!> - Calculate subsidence effect on clw -! -! 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)) @@ -1001,8 +1000,8 @@ subroutine cu_gf_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart,& gdc(i,16,10)=pret(i)*3600. maxupmf(i)=0. - if(forcing(i,6).gt.0.)then - maxupmf(i)=maxval(xmb(i)*zu(i,kts:ktf)/forcing(i,6)) + if(forcing2(i,6).gt.0.)then + maxupmf(i)=maxval(xmb(i)*zu(i,kts:ktf)/forcing2(i,6)) endif if(ktop(i).gt.2 .and.pret(i).gt.0.)dt_mf(i,ktop(i)-1)=ud_mf(i,ktop(i)) diff --git a/physics/cu_gf_driver.meta b/physics/CONV/Grell_Freitas/cu_gf_driver.meta similarity index 89% rename from physics/cu_gf_driver.meta rename to physics/CONV/Grell_Freitas/cu_gf_driver.meta index 8b1a46e2d..f76d0c30c 100644 --- a/physics/cu_gf_driver.meta +++ b/physics/CONV/Grell_Freitas/cu_gf_driver.meta @@ -1,7 +1,8 @@ [ccpp-table-properties] name = cu_gf_driver type = scheme - dependencies = cu_gf_deep.F90,cu_gf_sh.F90,machine.F,physcons.F90 + dependencies = ../../hooks/machine.F + dependencies = cu_gf_deep.F90,cu_gf_sh.F90 ######################################################################## [ccpp-arg-table] @@ -127,6 +128,7 @@ dimensions = (horizontal_loop_extent) type = integer intent = inout + optional = True [cactiv_m] standard_name = counter_for_grell_freitas_mid_level_convection long_name = mid-level cloud convective activity memory @@ -134,6 +136,7 @@ dimensions = (horizontal_loop_extent) type = integer intent = inout + optional = True [g] standard_name = gravitational_acceleration long_name = gravitational acceleration @@ -174,6 +177,7 @@ type = real kind = kind_phys intent = in + optional = True [forceqv_spechum] standard_name = tendendy_of_specific_humidity_due_to_nonphysics long_name = moisture tendency due to dynamics only @@ -182,6 +186,7 @@ type = real kind = kind_phys intent = in + optional = True [phil] standard_name = geopotential long_name = layer geopotential @@ -330,6 +335,7 @@ type = real kind = kind_phys intent = inout + optional = True [cliw] standard_name = ice_water_mixing_ratio_convective_transport_tracer long_name = ratio of mass of ice water to mass of dry air plus vapor (without condensates) in the convectively transported tracer array @@ -362,6 +368,7 @@ type = real kind = kind_phys intent = out + optional = True [dd_mf] standard_name = instantaneous_atmosphere_downdraft_convective_mass_flux long_name = (downdraft mass flux) * delt @@ -423,6 +430,7 @@ type = real kind = kind_phys intent = inout + optional = True [dtidx] standard_name = cumulative_change_of_state_variables_outer_index long_name = index of state-variable and process in last dimension of diagnostic tendencies array AKA cumulative_change_index @@ -508,6 +516,7 @@ type = real kind = kind_phys intent = inout + optional = True [fhour] standard_name = forecast_time long_name = current forecast time @@ -553,6 +562,7 @@ type = real kind = kind_phys intent = in + optional = True [maxupmf] standard_name = maximum_convective_updraft_mass_flux long_name = maximum convective updraft mass flux within a column @@ -561,6 +571,7 @@ type = real kind = kind_phys intent = out + optional = True [maxMF] standard_name = maximum_mass_flux long_name = maximum mass flux within a column @@ -569,6 +580,7 @@ type = real kind = kind_phys intent = in + optional = True [do_mynnedmf] standard_name = flag_for_mellor_yamada_nakanishi_niino_pbl_scheme long_name = flag to activate MYNN-EDMF @@ -597,6 +609,69 @@ dimensions = () type = integer intent = in +[spp_wts_cu_deep] + standard_name = spp_weights_for_cu_deep_scheme + long_name = spp weights for cu deep scheme + units = 1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = in + optional = True +[spp_cu_deep] + standard_name = control_for_deep_convection_spp_perturbations + long_name = control for deep convection spp perturbations + units = count + dimensions = () + type = integer + intent = in +[nchem] + standard_name = number_of_chemical_species_vertically_mixed + long_name = number of chemical species vertically mixed + units = count + dimensions = () + type = integer + intent = in +[chem3d] + standard_name = chem3d_mynn_pbl_transport + long_name = mynn pbl transport of smoke and dust + units = various + dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_chemical_species_vertically_mixed) + type = real + kind = kind_phys + intent = inout + optional = True +[fscav] + standard_name = smoke_dust_conv_wet_coef + long_name = smoke dust convetive wet scavanging coefficents + units = none + dimensions = (3) + type = real + kind = kind_phys + intent = in +[do_smoke_transport] + standard_name = do_smoke_conv_transport + long_name = flag for rrfs smoke convective transport + units = flag + dimensions = () + type = logical + intent = in +[wetdpc_deep] + standard_name = conv_wet_deposition_smoke_dust + long_name = convective wet removal of smoke and dust + units = kg kg-1 + dimensions = (horizontal_loop_extent,number_of_chemical_species_vertically_mixed) + type = real + kind = kind_phys + intent = inout + optional = True +[kdt] + standard_name = index_of_timestep + long_name = current forecast iteration + units = index + dimensions = () + type = integer + intent = in [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/cu_gf_driver_post.F90 b/physics/CONV/Grell_Freitas/cu_gf_driver_post.F90 similarity index 50% rename from physics/cu_gf_driver_post.F90 rename to physics/CONV/Grell_Freitas/cu_gf_driver_post.F90 index 56da0feba..02bb3cb84 100644 --- a/physics/cu_gf_driver_post.F90 +++ b/physics/CONV/Grell_Freitas/cu_gf_driver_post.F90 @@ -15,7 +15,7 @@ module cu_gf_driver_post !> \section arg_table_cu_gf_driver_post_run Argument Table !! \htmlinclude cu_gf_driver_post_run.html !! - subroutine cu_gf_driver_post_run (im, km, t, q, prevst, prevsq, cactiv, cactiv_m, conv_act, conv_act_m,dt, garea, raincv, maxupmf, refl_10cm, errmsg, errflg) + subroutine cu_gf_driver_post_run (im, km, t, q, prevst, prevsq, cactiv, cactiv_m, conv_act, conv_act_m, rrfs_sd, ntsmoke, ntdust, ntcoarsepm, chem3d, gq0, errmsg, errflg) use machine, only: kind_phys @@ -25,25 +25,21 @@ subroutine cu_gf_driver_post_run (im, km, t, q, prevst, prevsq, cactiv, cactiv_m integer, intent(in) :: im, km real(kind_phys), intent(in) :: t(:,:) real(kind_phys), intent(in) :: q(:,:) - real(kind_phys), dimension(:),intent(in) :: garea - real(kind_phys), intent(out) :: prevst(:,:) - real(kind_phys), intent(out) :: prevsq(:,:) - integer, intent(in) :: cactiv(:) - integer, intent(in) :: cactiv_m(:) - real(kind_phys), intent(out) :: conv_act(:) - real(kind_phys), intent(out) :: conv_act_m(:) - ! for Radar reflectivity - real(kind_phys), intent(in) :: dt - real(kind_phys), intent(in) :: raincv(:), maxupmf(:) - real(kind_phys), intent(inout) :: refl_10cm(:,:) + real(kind_phys), intent(out), optional :: prevst(:,:) + real(kind_phys), intent(out), optional :: prevsq(:,:) + integer, intent(in), optional :: cactiv(:) + integer, intent(in), optional :: cactiv_m(:) + real(kind_phys), intent(out), optional :: conv_act(:) + real(kind_phys), intent(out), optional :: conv_act_m(:) + logical, intent(in) :: rrfs_sd + integer, intent(in) :: ntsmoke, ntdust, ntcoarsepm + real(kind_phys), intent(inout), optional :: chem3d(:,:,:) + real(kind_phys), intent(inout) :: gq0(:,:,:) character(len=*), intent(out) :: errmsg -!$acc declare copyin(t,q,cactiv,cactiv_m) copyout(prevst,prevsq,conv_act,conv_act_m) +!$acc declare copyin(t,q,cactiv,cactiv_m) copyout(prevst,prevsq,conv_act,conv_act_m,chem3d,gq0) integer, intent(out) :: errflg ! Local variables - real(kind_phys), parameter :: dbzmin=-10.0 - real(kind_phys) :: cuprate - real(kind_phys) :: ze, ze_conv, dbz_sum integer :: i, k ! Initialize CCPP error handling variables @@ -65,22 +61,13 @@ subroutine cu_gf_driver_post_run (im, km, t, q, prevst, prevsq, cactiv, cactiv_m else conv_act_m(i)=0.0 endif - ! reflectivity parameterization for parameterized convection (reference:Unipost MDLFLD.f) - if(sqrt(garea(i)).lt.6500.)then - ze = 0.0 - ze_conv = 0.0 - dbz_sum = 0.0 - cuprate = raincv(i) * 3600.0 / dt ! cu precip rate (mm/h) - ze_conv = 300.0 * cuprate**1.4 - if (maxupmf(i).gt.0.05) then - do k = 1, km - ze = 10._kind_phys ** (0.1 * refl_10cm(i,k)) - dbz_sum = max(dbzmin, 10.0 * log10(ze + ze_conv)) - refl_10cm(i,k) = dbz_sum - enddo - endif - endif enddo + + if (rrfs_sd) then + gq0(:,:,ntsmoke ) = chem3d(:,:,1) + gq0(:,:,ntdust ) = chem3d(:,:,2) + gq0(:,:,ntcoarsepm) = chem3d(:,:,3) + endif !$acc end kernels end subroutine cu_gf_driver_post_run diff --git a/physics/cu_gf_driver_post.meta b/physics/CONV/Grell_Freitas/cu_gf_driver_post.meta similarity index 68% rename from physics/cu_gf_driver_post.meta rename to physics/CONV/Grell_Freitas/cu_gf_driver_post.meta index 48e762cb4..302fec1d7 100644 --- a/physics/cu_gf_driver_post.meta +++ b/physics/CONV/Grell_Freitas/cu_gf_driver_post.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = cu_gf_driver_post type = scheme - dependencies = machine.F + dependencies = ../../hooks/machine.F ######################################################################## [ccpp-arg-table] @@ -45,6 +45,7 @@ type = real kind = kind_phys intent = out + optional = True [prevsq] standard_name = specific_humidity_on_previous_timestep long_name = moisture from previous time step @@ -53,6 +54,7 @@ type = real kind = kind_phys intent = out + optional = True [cactiv] standard_name = counter_for_grell_freitas_convection long_name = convective activity memory @@ -60,6 +62,7 @@ dimensions = (horizontal_loop_extent) type = integer intent = in + optional = True [cactiv_m] standard_name = counter_for_grell_freitas_mid_level_convection long_name = midlevel convective activity memory @@ -67,6 +70,7 @@ dimensions = (horizontal_loop_extent) type = integer intent = in + optional = True [conv_act] standard_name = consecutive_calls_for_grell_freitas_convection long_name = Memory counter for GF @@ -75,6 +79,7 @@ type = real kind = kind_phys intent = out + optional = True [conv_act_m] standard_name = consecutive_calls_for_grell_freitas_mid_level_convection long_name = Memory counter for GF midlevel @@ -83,46 +88,35 @@ type = real kind = kind_phys intent = out -[dt] - standard_name = timestep_for_physics - long_name = physics time step - units = s + optional = True +[rrfs_sd] + standard_name = do_smoke_coupling + long_name = flag controlling rrfs_sd collection + units = flag dimensions = () - type = real - kind = kind_phys + type = logical intent = in -[garea] - standard_name = cell_area - long_name = grid cell area - units = m2 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys +[ntsmoke] + standard_name = index_for_smoke_in_tracer_concentration_array + long_name = tracer index for smoke + units = index + dimensions = () + type = integer intent = in -[raincv] - standard_name = lwe_thickness_of_deep_convective_precipitation_amount - long_name = deep convective rainfall amount on physics timestep - units = m - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys +[ntdust] + standard_name = index_for_dust_in_tracer_concentration_array + long_name = tracer index for dust + units = index + dimensions = () + type = integer intent = in -[maxupmf] - standard_name = maximum_convective_updraft_mass_flux - long_name = maximum convective updraft mass flux within a column - units = m s-1 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys +[ntcoarsepm] + standard_name = index_for_coarse_particulate_matter_in_tracer_concentration_array + long_name = tracer index for coarse particulate matter + units = index + dimensions = () + type = integer intent = in -[refl_10cm] - standard_name = radar_reflectivity_10cm - long_name = instantaneous refl_10cm - units = dBZ - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = inout [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP @@ -131,6 +125,23 @@ type = character kind = len=* intent = out +[chem3d] + standard_name = chem3d_mynn_pbl_transport + long_name = mynn pbl transport of smoke and dust + units = various + dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_chemical_species_vertically_mixed) + type = real + kind = kind_phys + intent = inout + optional = True +[gq0] + standard_name = tracer_concentration_of_new_state + long_name = tracer concentration updated by physics + units = kg kg-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_tracers) + type = real + kind = kind_phys + intent = inout [errflg] standard_name = ccpp_error_code long_name = error code for error handling in CCPP diff --git a/physics/cu_gf_driver_pre.F90 b/physics/CONV/Grell_Freitas/cu_gf_driver_pre.F90 similarity index 66% rename from physics/cu_gf_driver_pre.F90 rename to physics/CONV/Grell_Freitas/cu_gf_driver_pre.F90 index 98cc76b95..1bc9aed34 100644 --- a/physics/cu_gf_driver_pre.F90 +++ b/physics/CONV/Grell_Freitas/cu_gf_driver_pre.F90 @@ -17,6 +17,7 @@ module cu_gf_driver_pre !! subroutine cu_gf_driver_pre_run (flag_init, flag_restart, kdt, fhour, dtp, t, q, prevst, prevsq, & forcet, forceq, cactiv, cactiv_m, conv_act, conv_act_m, & + rrfs_sd, ntsmoke, ntdust, ntcoarsepm, chem3d, gq0, & errmsg, errflg) use machine, only: kind_phys @@ -25,22 +26,26 @@ subroutine cu_gf_driver_pre_run (flag_init, flag_restart, kdt, fhour, dtp, t, q, logical, intent(in) :: flag_init logical, intent(in) :: flag_restart + logical, intent(in) :: rrfs_sd integer, intent(in) :: kdt real(kind_phys), intent(in) :: fhour real(kind_phys), intent(in) :: dtp real(kind_phys), intent(in) :: t(:,:) real(kind_phys), intent(in) :: q(:,:) - real(kind_phys), intent(in) :: prevst(:,:) - real(kind_phys), intent(in) :: prevsq(:,:) + real(kind_phys), intent(in), optional :: prevst(:,:) + real(kind_phys), intent(in), optional :: prevsq(:,:) !$acc declare copyin(t,q,prevst,prevsq) - real(kind_phys), intent(out) :: forcet(:,:) - real(kind_phys), intent(out) :: forceq(:,:) - integer, intent(out) :: cactiv(:) - integer, intent(out) :: cactiv_m(:) + real(kind_phys), intent(out), optional :: forcet(:,:) + real(kind_phys), intent(out), optional :: forceq(:,:) + integer, intent(out), optional :: cactiv(:) + integer, intent(out), optional :: cactiv_m(:) + integer, intent(in) :: ntsmoke, ntdust, ntcoarsepm !$acc declare copyout(forcet,forceq,cactiv,cactiv_m) - real(kind_phys), intent(in) :: conv_act(:) - real(kind_phys), intent(in) :: conv_act_m(:) -!$acc declare copyin(conv_act,conv_act_m) + real(kind_phys), intent(in), optional :: conv_act(:) + real(kind_phys), intent(in), optional :: conv_act_m(:) + real(kind_phys), intent(inout), optional :: chem3d(:,:,:) + real(kind_phys), intent(inout) :: gq0(:,:,:) +!$acc declare copyin(conv_act,conv_act_m) copy(chem3d,gq0) character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -77,6 +82,12 @@ subroutine cu_gf_driver_pre_run (flag_init, flag_restart, kdt, fhour, dtp, t, q, !$acc kernels cactiv(:)=nint(conv_act(:)) cactiv_m(:)=nint(conv_act_m(:)) + + if (rrfs_sd) then + chem3d(:,:,1) = gq0(:,:,ntsmoke) + chem3d(:,:,2) = gq0(:,:,ntdust) + chem3d(:,:,3) = gq0(:,:,ntcoarsepm) + endif !$acc end kernels end subroutine cu_gf_driver_pre_run diff --git a/physics/cu_gf_driver_pre.meta b/physics/CONV/Grell_Freitas/cu_gf_driver_pre.meta similarity index 71% rename from physics/cu_gf_driver_pre.meta rename to physics/CONV/Grell_Freitas/cu_gf_driver_pre.meta index 7fd66d19b..105461758 100644 --- a/physics/cu_gf_driver_pre.meta +++ b/physics/CONV/Grell_Freitas/cu_gf_driver_pre.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = cu_gf_driver_pre type = scheme - dependencies = machine.F + dependencies = ../../hooks/machine.F ######################################################################## [ccpp-arg-table] @@ -68,6 +68,7 @@ type = real kind = kind_phys intent = in + optional = True [prevsq] standard_name = specific_humidity_on_previous_timestep long_name = moisture from previous time step @@ -76,6 +77,7 @@ type = real kind = kind_phys intent = in + optional = True [forcet] standard_name = tendency_of_air_temperature_due_to_nonphysics long_name = temperature tendency due to dynamics only @@ -84,6 +86,7 @@ type = real kind = kind_phys intent = out + optional = True [forceq] standard_name = tendendy_of_specific_humidity_due_to_nonphysics long_name = moisture tendency due to dynamics only @@ -92,6 +95,7 @@ type = real kind = kind_phys intent = out + optional = True [cactiv] standard_name = counter_for_grell_freitas_convection long_name = convective activity memory @@ -99,6 +103,7 @@ dimensions = (horizontal_loop_extent) type = integer intent = out + optional = True [cactiv_m] standard_name = counter_for_grell_freitas_mid_level_convection long_name = midlevel convective activity memory @@ -106,6 +111,7 @@ dimensions = (horizontal_loop_extent) type = integer intent = out + optional = True [conv_act] standard_name = consecutive_calls_for_grell_freitas_convection long_name = Memory counter for GF @@ -114,6 +120,7 @@ type = real kind = kind_phys intent = in + optional = True [conv_act_m] standard_name = consecutive_calls_for_grell_freitas_mid_level_convection long_name = Memory counter for GF midlevel @@ -122,6 +129,52 @@ type = real kind = kind_phys intent = in + optional = True +[rrfs_sd] + standard_name = do_smoke_coupling + long_name = flag controlling rrfs_sd collection + units = flag + dimensions = () + type = logical + intent = in +[ntsmoke] + standard_name = index_for_smoke_in_tracer_concentration_array + long_name = tracer index for smoke + units = index + dimensions = () + type = integer + intent = in +[ntdust] + standard_name = index_for_dust_in_tracer_concentration_array + long_name = tracer index for dust + units = index + dimensions = () + type = integer + intent = in +[ntcoarsepm] + standard_name = index_for_coarse_particulate_matter_in_tracer_concentration_array + long_name = tracer index for coarse particulate matter + units = index + dimensions = () + type = integer + intent = in +[chem3d] + standard_name = chem3d_mynn_pbl_transport + long_name = mynn pbl transport of smoke and dust + units = various + dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_chemical_species_vertically_mixed) + type = real + kind = kind_phys + intent = inout + optional = True +[gq0] + standard_name = tracer_concentration_of_new_state + long_name = tracer concentration updated by physics + units = kg kg-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_tracers) + type = real + kind = kind_phys + intent = inout [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/cu_gf_sh.F90 b/physics/CONV/Grell_Freitas/cu_gf_sh.F90 similarity index 100% rename from physics/cu_gf_sh.F90 rename to physics/CONV/Grell_Freitas/cu_gf_sh.F90 diff --git a/physics/rascnv.F90 b/physics/CONV/RAS/rascnv.F90 similarity index 99% rename from physics/rascnv.F90 rename to physics/CONV/RAS/rascnv.F90 index 0b57de1fe..a6f21ea30 100644 --- a/physics/rascnv.F90 +++ b/physics/CONV/RAS/rascnv.F90 @@ -331,14 +331,16 @@ subroutine rascnv_run(IM, k, itc, ntc, ntr, dt, dtf & real(kind=kind_phys), dimension(:,:), intent(inout) :: tin, qin, uin, vin real(kind=kind_phys), dimension(:,:), intent(in) :: prsl, prslk, phil & &, rhc - real(kind=kind_phys), dimension(:,:), intent(out) :: ud_mf, dd_mf, dt_mf - real(kind=kind_phys), dimension(:,:), intent(inout) :: qlcn, qicn, w_upi & + real(kind=kind_phys), dimension(:,:), intent(out), optional :: ud_mf + real(kind=kind_phys), dimension(:,:), intent(out) :: dd_mf, dt_mf + real(kind=kind_phys), dimension(:,:), intent(inout), optional :: qlcn, qicn, w_upi & &, cnv_mfd & &, cnv_dqldt, clcn & &, cnv_fice, cnv_ndrop & &, cnv_nice, cf_upi real(kind=kind_phys), dimension(:) , intent(in) :: area, cdrag - real(kind=kind_phys), dimension(:) , intent(out) :: rainc, ddvel + real(kind=kind_phys), dimension(:) , intent(out) :: rainc + real(kind=kind_phys), dimension(:) , intent(out), optional :: ddvel real(kind=kind_phys), dimension(:,:), intent(in) :: rannum real(kind=kind_phys), intent(inout) :: ccin(:,:,:) real(kind=kind_phys), intent(in) :: dt, dtf diff --git a/physics/rascnv.meta b/physics/CONV/RAS/rascnv.meta similarity index 98% rename from physics/rascnv.meta rename to physics/CONV/RAS/rascnv.meta index 5285c830f..8e23ae8b8 100644 --- a/physics/rascnv.meta +++ b/physics/CONV/RAS/rascnv.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = rascnv type = scheme - dependencies = funcphys.f90,machine.F + dependencies = ../../tools/funcphys.f90,../../hooks/machine.F ######################################################################## [ccpp-arg-table] @@ -482,6 +482,7 @@ type = real kind = kind_phys intent = out + optional = True [ud_mf] standard_name = instantaneous_atmosphere_updraft_convective_mass_flux long_name = (updraft mass flux) * dt @@ -490,6 +491,7 @@ type = real kind = kind_phys intent = out + optional = True [dd_mf] standard_name = instantaneous_atmosphere_downdraft_convective_mass_flux long_name = (downdraft mass flux) * dt @@ -514,6 +516,7 @@ type = real kind = kind_phys intent = inout + optional = True [qicn] standard_name = mass_fraction_of_convective_cloud_ice long_name = mass fraction of convective cloud ice water @@ -522,6 +525,7 @@ type = real kind = kind_phys intent = inout + optional = True [w_upi] standard_name = vertical_velocity_for_updraft long_name = vertical velocity for updraft @@ -530,6 +534,7 @@ type = real kind = kind_phys intent = inout + optional = True [cf_upi] standard_name = convective_cloud_fraction_for_microphysics long_name = convective cloud fraction for microphysics @@ -538,6 +543,7 @@ type = real kind = kind_phys intent = inout + optional = True [cnv_mfd] standard_name = detrained_mass_flux long_name = detrained mass flux @@ -546,6 +552,7 @@ type = real kind = kind_phys intent = inout + optional = True [cnv_dqldt] standard_name = tendency_of_cloud_water_due_to_convective_microphysics long_name = tendency of cloud water due to convective microphysics @@ -554,6 +561,7 @@ type = real kind = kind_phys intent = inout + optional = True [clcn] standard_name = convective_cloud_volume_fraction long_name = convective cloud volume fraction @@ -562,6 +570,7 @@ type = real kind = kind_phys intent = inout + optional = True [cnv_fice] standard_name = ice_fraction_in_convective_tower long_name = ice fraction in convective tower @@ -570,6 +579,7 @@ type = real kind = kind_phys intent = inout + optional = True [cnv_ndrop] standard_name = number_concentration_of_cloud_liquid_water_particles_for_detrainment long_name = droplet number concentration in convective detrainment @@ -578,6 +588,7 @@ type = real kind = kind_phys intent = inout + optional = True [cnv_nice] standard_name = number_concentration_of_ice_crystals_for_detrainment long_name = crystal number concentration in convective detrainment @@ -586,6 +597,7 @@ type = real kind = kind_phys intent = inout + optional = True [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/samfaerosols.F b/physics/CONV/SAMF/samfaerosols.F similarity index 100% rename from physics/samfaerosols.F rename to physics/CONV/SAMF/samfaerosols.F diff --git a/physics/samfdeepcnv.f b/physics/CONV/SAMF/samfdeepcnv.f similarity index 98% rename from physics/samfdeepcnv.f rename to physics/CONV/SAMF/samfdeepcnv.f index 8a36fe34c..3ad067657 100644 --- a/physics/samfdeepcnv.f +++ b/physics/CONV/SAMF/samfdeepcnv.f @@ -83,7 +83,8 @@ subroutine samfdeepcnv_run (im,km,first_time_step,restart, & & CNV_DQLDT,CLCN,CNV_FICE,CNV_NDROP,CNV_NICE,mp_phys,mp_phys_mg,& & clam,c0s,c1,betal,betas,evef,pgcon,asolfac, & & do_ca, ca_closure, ca_entr, ca_trigger, nthresh,ca_deep, & - & rainevap,sigmain, sigmaout, errmsg,errflg) + & rainevap,sigmain,sigmaout,betadcu,betamcu,betascu, & + & maxMF, do_mynnedmf,errmsg,errflg) ! use machine , only : kind_phys use funcphys , only : fpvs @@ -99,15 +100,17 @@ subroutine samfdeepcnv_run (im,km,first_time_step,restart, & & prslp(:,:), garea(:), hpbl(:), dot(:,:), phil(:,:) real(kind=kind_phys), dimension(:), intent(in) :: fscav logical, intent(in) :: first_time_step,restart,hwrf_samfdeep, & - & progsigma - real(kind=kind_phys), intent(in) :: nthresh - real(kind=kind_phys), intent(in) :: ca_deep(:) - real(kind=kind_phys), intent(in) :: sigmain(:,:),qmicro(:,:), & - & tmf(:,:,:),q(:,:), prevsq(:,:) + & progsigma,do_mynnedmf + real(kind=kind_phys), intent(in) :: nthresh,betadcu,betamcu, & + & betascu + real(kind=kind_phys), intent(in), optional :: ca_deep(:) + real(kind=kind_phys), intent(in), optional :: sigmain(:,:), & + & qmicro(:,:), prevsq(:,:) + real(kind=kind_phys), intent(in) :: tmf(:,:,:),q(:,:) + real(kind=kind_phys), dimension (:), intent(in), optional :: maxMF real(kind=kind_phys), intent(out) :: rainevap(:) - real(kind=kind_phys), intent(out) :: sigmaout(:,:) + real(kind=kind_phys), intent(out), optional :: sigmaout(:,:) logical, intent(in) :: do_ca,ca_closure,ca_entr,ca_trigger - integer, intent(inout) :: kcnv(:) ! DH* TODO - check dimensions of qtr, ntr+2 correct? *DH real(kind=kind_phys), intent(inout) :: qtr(:,:,:), & @@ -117,12 +120,12 @@ subroutine samfdeepcnv_run (im,km,first_time_step,restart, & integer, intent(out) :: kbot(:), ktop(:) real(kind=kind_phys), intent(out) :: cldwrk(:), & & rn(:), & - & ud_mf(:,:),dd_mf(:,:), dt_mf(:,:) - + & dd_mf(:,:), dt_mf(:,:) + real(kind=kind_phys), intent(out), optional :: ud_mf(:,:) ! GJF* These variables are conditionally allocated depending on whether the ! Morrison-Gettelman microphysics is used, so they must be declared ! using assumed shape. - real(kind=kind_phys), dimension(:,:), intent(inout) :: & + real(kind=kind_phys), dimension(:,:), intent(inout), optional :: & & qlcn, qicn, w_upi, cnv_mfd, cnv_dqldt, clcn & &, cnv_fice, cnv_ndrop, cnv_nice, cf_upi ! *GJF @@ -212,9 +215,11 @@ subroutine samfdeepcnv_run (im,km,first_time_step,restart, & ! ! parameters for prognostic sigma closure real(kind=kind_phys) omega_u(im,km),zdqca(im,km),tmfq(im,km), - & omegac(im),zeta(im,km),dbyo1(im,km),sigmab(im),qadv(im,km) - real(kind=kind_phys) gravinv,invdelt - logical flag_shallow + & omegac(im),zeta(im,km),dbyo1(im,km),sigmab(im),qadv(im,km), + & sigmaoutx(im) + real(kind=kind_phys) gravinv,invdelt,sigmind,sigminm,sigmins + parameter(sigmind=0.01,sigmins=0.03,sigminm=0.01) + logical flag_shallow, flag_mid c physical parameters ! parameter(grav=grav,asolfac=0.958) ! parameter(elocp=hvap/cp,el2orc=hvap*hvap/(rv*cp)) @@ -347,6 +352,9 @@ subroutine samfdeepcnv_run (im,km,first_time_step,restart, & ! do i=1,im cnvflg(i) = .true. + if(do_mynnedmf) then + if(maxMF(i).gt.0.)cnvflg(i)=.false. + endif sfcpbl(i) = sfclfac * hpbl(i) rn(i)=0. mbdt(i)=10. @@ -2930,10 +2938,11 @@ subroutine samfdeepcnv_run (im,km,first_time_step,restart, & enddo flag_shallow = .false. + flag_mid = .false. call progsigma_calc(im,km,first_time_step,restart,flag_shallow, - & del,tmfq,qmicro,dbyo1,zdqca,omega_u,zeta,hvap,delt, - & qadv,kbcon1,ktcon,cnvflg, - & sigmain,sigmaout,sigmab) + & flag_mid,del,tmfq,qmicro,dbyo1,zdqca,omega_u,zeta,hvap, + & delt,qadv,kbcon1,ktcon,cnvflg,betascu,betamcu,betadcu, + & sigmind,sigminm,sigmins,sigmain,sigmaout,sigmab) endif !> - From Han et al.'s (2017) \cite han_et_al_2017 equation 6, calculate cloud base mass flux as a function of the mean updraft velcoity for the grid sizes where the quasi-equilibrium assumption of Arakawa-Schubert is not valid any longer. @@ -3415,17 +3424,28 @@ subroutine samfdeepcnv_run (im,km,first_time_step,restart, & endif enddo c -c convective cloud water +! + if(progsigma)then + do i = 1, im + sigmaoutx(i)=max(sigmaout(i,1),0.0) + sigmaoutx(i)=min(sigmaoutx(i),1.0) + enddo + endif c !> - Calculate convective cloud water. do k = 1, km - do i = 1, im - if (cnvflg(i) .and. rn(i) > 0.) then - if (k >= kbcon(i) .and. k < ktcon(i)) then - cnvw(i,k) = cnvwt(i,k) * xmb(i) * dt2 + do i = 1, im + if (cnvflg(i) .and. rn(i) > 0.) then + if (k >= kbcon(i) .and. k < ktcon(i)) then + cnvw(i,k) = cnvwt(i,k) * xmb(i) * dt2 + if(progsigma)then + cnvw(i,k) = cnvw(i,k) * sigmaoutx(i) + else + cnvw(i,k) = cnvw(i,k) * sigmagfm(i) + endif + endif endif - endif - enddo + enddo enddo c c convective cloud cover diff --git a/physics/samfdeepcnv.meta b/physics/CONV/SAMF/samfdeepcnv.meta similarity index 93% rename from physics/samfdeepcnv.meta rename to physics/CONV/SAMF/samfdeepcnv.meta index bed4d655d..3652a0d27 100644 --- a/physics/samfdeepcnv.meta +++ b/physics/CONV/SAMF/samfdeepcnv.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = samfdeepcnv type = scheme - dependencies = funcphys.f90,machine.F,samfaerosols.F,progsigma_calc.f90 + dependencies = ../../tools/funcphys.f90,../../hooks/machine.F,samfaerosols.F,../progsigma_calc.f90 ######################################################################## [ccpp-arg-table] @@ -85,6 +85,7 @@ type = real kind = kind_phys intent = in + optional = True [itc] standard_name = index_of_first_chemical_tracer_for_convection long_name = index of first chemical tracer transported/scavenged by convection @@ -257,6 +258,7 @@ type = real kind = kind_phys intent = in + optional = True [q] standard_name = specific_humidity long_name = water vapor specific humidity @@ -402,6 +404,7 @@ type = real kind = kind_phys intent = out + optional = True [dd_mf] standard_name = instantaneous_atmosphere_downdraft_convective_mass_flux long_name = (downdraft mass flux) * delt @@ -442,6 +445,7 @@ type = real kind = kind_phys intent = in + optional = True [sigmaout] standard_name = updraft_area_fraction_updated_by_physics long_name = convective updraft area fraction updated by physics @@ -450,6 +454,46 @@ type = real kind = kind_phys intent = out + optional = True +[betascu] + standard_name = tuning_param_for_shallow_cu + long_name = tuning param for shallow cu in case prognostic closure is used + units = none + dimensions = () + type = real + kind = kind_phys + intent = in +[betamcu] + standard_name = tuning_param_for_midlevel_cu + long_name = tuning param for midlevel cu in case prognostic closure is used + units = none + dimensions = () + type = real + kind = kind_phys + intent = in +[betadcu] + standard_name = tuning_param_for_deep_cu + long_name = tuning param for deep cu in case prognostic closure is used + units = none + dimensions = () + type = real + intent = in +[maxMF] + standard_name = maximum_mass_flux + long_name = maximum mass flux within a column + units = m s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = True +[do_mynnedmf] + standard_name = flag_for_mellor_yamada_nakanishi_niino_pbl_scheme + long_name = flag to activate MYNN-EDMF + units = flag + dimensions = () + type = logical + intent = in [qlcn] standard_name = mass_fraction_of_convective_cloud_liquid_water long_name = mass fraction of convective cloud liquid water @@ -458,6 +502,7 @@ type = real kind = kind_phys intent = inout + optional = True [qicn] standard_name = mass_fraction_of_convective_cloud_ice long_name = mass fraction of convective cloud ice water @@ -466,6 +511,7 @@ type = real kind = kind_phys intent = inout + optional = True [w_upi] standard_name = vertical_velocity_for_updraft long_name = vertical velocity for updraft @@ -474,6 +520,7 @@ type = real kind = kind_phys intent = inout + optional = True [cf_upi] standard_name = convective_cloud_fraction_for_microphysics long_name = convective cloud fraction for microphysics @@ -482,6 +529,7 @@ type = real kind = kind_phys intent = inout + optional = True [cnv_mfd] standard_name = detrained_mass_flux long_name = detrained mass flux @@ -490,6 +538,7 @@ type = real kind = kind_phys intent = inout + optional = True [cnv_dqldt] standard_name = tendency_of_cloud_water_due_to_convective_microphysics long_name = tendency of cloud water due to convective microphysics @@ -498,6 +547,7 @@ type = real kind = kind_phys intent = inout + optional = True [clcn] standard_name = convective_cloud_volume_fraction long_name = convective cloud volume fraction @@ -506,6 +556,7 @@ type = real kind = kind_phys intent = inout + optional = True [cnv_fice] standard_name = ice_fraction_in_convective_tower long_name = ice fraction in convective tower @@ -514,6 +565,7 @@ type = real kind = kind_phys intent = inout + optional = True [cnv_ndrop] standard_name = number_concentration_of_cloud_liquid_water_particles_for_detrainment long_name = droplet number concentration in convective detrainment @@ -522,6 +574,7 @@ type = real kind = kind_phys intent = inout + optional = True [cnv_nice] standard_name = number_concentration_of_ice_crystals_for_detrainment long_name = crystal number concentration in convective detrainment @@ -530,6 +583,7 @@ type = real kind = kind_phys intent = inout + optional = True [mp_phys] standard_name = control_for_microphysics_scheme long_name = choice of microphysics scheme @@ -652,6 +706,7 @@ type = real kind = kind_phys intent = in + optional = True [rainevap] standard_name = physics_field_for_coupling long_name = physics_field_for_coupling diff --git a/physics/samfshalcnv.f b/physics/CONV/SAMF/samfshalcnv.f similarity index 98% rename from physics/samfshalcnv.f rename to physics/CONV/SAMF/samfshalcnv.f index a7682342f..ce783ea15 100644 --- a/physics/samfshalcnv.f +++ b/physics/CONV/SAMF/samfshalcnv.f @@ -57,7 +57,7 @@ subroutine samfshalcnv_run(im,km,itc,ntc,cliq,cp,cvap, & & rn,kbot,ktop,kcnv,islimsk,garea, & & dot,ncloud,hpbl,ud_mf,dt_mf,cnvw,cnvc, & & clam,c0s,c1,evef,pgcon,asolfac,hwrf_samfshal, & - & sigmain,sigmaout,errmsg,errflg) + & sigmain,sigmaout,betadcu,betamcu,betascu,errmsg,errflg) ! use machine , only : kind_phys use funcphys , only : fpvs @@ -67,13 +67,15 @@ subroutine samfshalcnv_run(im,km,itc,ntc,cliq,cp,cvap, & integer, intent(in) :: im, km, itc, ntc, ntk, ntr, ncloud integer, intent(in) :: islimsk(:) real(kind=kind_phys), intent(in) :: cliq, cp, cvap, & - & eps, epsm1, fv, grav, hvap, rd, rv, t0c + & eps, epsm1, fv, grav, hvap, rd, rv, t0c, betascu, betadcu, & + & betamcu real(kind=kind_phys), intent(in) :: delt real(kind=kind_phys), intent(in) :: psp(:), delp(:,:), & & prslp(:,:), garea(:), hpbl(:), dot(:,:), phil(:,:), & - & qmicro(:,:),tmf(:,:,:),prevsq(:,:),q(:,:) - - real(kind=kind_phys), intent(in) :: sigmain(:,:) + & tmf(:,:,:), q(:,:) + real(kind=kind_phys), intent(in), optional :: qmicro(:,:), & + & prevsq(:,:) + real(kind=kind_phys), intent(in), optional :: sigmain(:,:) ! real(kind=kind_phys), dimension(:), intent(in) :: fscav integer, intent(inout) :: kcnv(:) @@ -83,8 +85,10 @@ subroutine samfshalcnv_run(im,km,itc,ntc,cliq,cp,cvap, & ! integer, intent(out) :: kbot(:), ktop(:) real(kind=kind_phys), intent(out) :: rn(:), & - & cnvw(:,:), cnvc(:,:), ud_mf(:,:), dt_mf(:,:), sigmaout(:,:) + & cnvw(:,:), cnvc(:,:), dt_mf(:,:) ! + real(kind=kind_phys), intent(out), optional :: ud_mf(:,:), & + & sigmaout(:,:) real(kind=kind_phys), intent(in) :: clam, c0s, c1, & & asolfac, evef, pgcon logical, intent(in) :: hwrf_samfshal,first_time_step, & @@ -158,9 +162,10 @@ subroutine samfshalcnv_run(im,km,itc,ntc,cliq,cp,cvap, & ! parameters for prognostic sigma closure real(kind=kind_phys) omega_u(im,km),zdqca(im,km),tmfq(im,km), & omegac(im),zeta(im,km),dbyo1(im,km), - & sigmab(im),qadv(im,km) - real(kind=kind_phys) gravinv,dxcrtas,invdelt - logical flag_shallow + & sigmab(im),qadv(im,km),sigmaoutx(im) + real(kind=kind_phys) gravinv,dxcrtas,invdelt,sigmind,sigmins, + & sigminm + logical flag_shallow,flag_mid c physical parameters ! parameter(g=grav,asolfac=0.89) ! parameter(g=grav) @@ -189,12 +194,12 @@ subroutine samfshalcnv_run(im,km,itc,ntc,cliq,cp,cvap, & parameter(cinacrmx=-120.,shevf=2.0) parameter(dtmax=10800.,dtmin=600.) parameter(bb1=4.0,bb2=0.8,csmf=0.2) - parameter(tkcrt=2.,cmxfac=15.) + parameter(tkcrt=2.,cmxfac=10.) ! parameter(bet1=1.875,cd1=.506,f1=2.0,gam1=.5) parameter(betaw=.03,dxcrtc0=9.e3) parameter(h1=0.33333333) ! progsigma - parameter(dxcrtas=30.e3) + parameter(dxcrtas=30.e3,sigmind=0.01,sigmins=0.03,sigminm=0.01) c local variables and arrays real(kind=kind_phys) pfld(im,km), to(im,km), qo(im,km), & uo(im,km), vo(im,km), qeso(im,km), @@ -1974,10 +1979,11 @@ subroutine samfshalcnv_run(im,km,itc,ntc,cliq,cp,cvap, & enddo flag_shallow = .true. + flag_mid = .false. call progsigma_calc(im,km,first_time_step,restart,flag_shallow, - & del,tmfq,qmicro,dbyo1,zdqca,omega_u,zeta,hvap,delt, - & qadv,kbcon1,ktcon,cnvflg, - & sigmain,sigmaout,sigmab) + & flag_mid,del,tmfq,qmicro,dbyo1,zdqca,omega_u,zeta,hvap, + & delt,qadv,kbcon1,ktcon,cnvflg,betascu,betamcu,betadcu, + & sigmind,sigminm,sigmins,sigmain,sigmaout,sigmab) endif !> - From Han et al.'s (2017) \cite han_et_al_2017 equation 6, calculate cloud base mass flux as a function of the mean updraft velcoity. @@ -2391,20 +2397,29 @@ subroutine samfshalcnv_run(im,km,itc,ntc,cliq,cp,cvap, & endif enddo c -c convective cloud water -c -!> - Calculate shallow convective cloud water. + if(progsigma)then + do i = 1, im + sigmaoutx(i)=max(sigmaout(i,1),0.0) + sigmaoutx(i)=min(sigmaoutx(i),1.0) + enddo + endif + +c convective cloud water do k = 1, km - do i = 1, im - if (cnvflg(i)) then - if (k >= kbcon(i) .and. k < ktcon(i)) then - cnvw(i,k) = cnvwt(i,k) * xmb(i) * dt2 + do i = 1, im + if (cnvflg(i)) then + if (k >= kbcon(i) .and. k < ktcon(i)) then + cnvw(i,k) = cnvwt(i,k) * xmb(i) * dt2 + if (progsigma) then + cnvw(i,k) = cnvw(i,k) * sigmaoutx(i) + else + cnvw(i,k) = cnvw(i,k) * sigmagfm(i) + endif + endif endif - endif - enddo + enddo enddo - -c +c c convective cloud cover c !> - Calculate convective cloud cover, which is used when pdf-based cloud fraction is used (i.e., pdfcld=.true.). diff --git a/physics/samfshalcnv.meta b/physics/CONV/SAMF/samfshalcnv.meta similarity index 94% rename from physics/samfshalcnv.meta rename to physics/CONV/SAMF/samfshalcnv.meta index c1fffef58..4dfa8ac20 100644 --- a/physics/samfshalcnv.meta +++ b/physics/CONV/SAMF/samfshalcnv.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = samfshalcnv type = scheme - dependencies = funcphys.f90,machine.F,samfaerosols.F,progsigma_calc.f90 + dependencies = ../../tools/funcphys.f90,../../hooks/machine.F,samfaerosols.F,../progsigma_calc.f90 ######################################################################## [ccpp-arg-table] @@ -85,6 +85,7 @@ type = real kind = kind_phys intent = in + optional = True [itc] standard_name = index_of_first_chemical_tracer_for_convection long_name = index of first chemical tracer transported/scavenged by convection @@ -257,6 +258,7 @@ type = real kind = kind_phys intent = in + optional = True [q] standard_name = specific_humidity long_name = water vapor specific humidity @@ -380,6 +382,7 @@ type = real kind = kind_phys intent = out + optional = True [dt_mf] standard_name = instantaneous_atmosphere_detrainment_convective_mass_flux long_name = (detrainment mass flux) * delt @@ -474,6 +477,7 @@ type = real kind = kind_phys intent = in + optional = True [sigmaout] standard_name = updraft_area_fraction_updated_by_physics long_name = convective updraft area fraction updated by physics @@ -482,6 +486,30 @@ type = real kind = kind_phys intent = out + optional = True +[betascu] + standard_name = tuning_param_for_shallow_cu + long_name = tuning param for shallow cu in case prognostic closure is used + units = none + dimensions = () + type = real + kind = kind_phys + intent = in +[betamcu] + standard_name = tuning_param_for_midlevel_cu + long_name = tuning param for midlevel cu in case prognostic closure is used + units = none + dimensions = () + type = real + kind = kind_phys + intent = in +[betadcu] + standard_name = tuning_param_for_deep_cu + long_name = tuning param for deep cu in case prognostic closure is used + units = none + dimensions = () + type = real + intent = in [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/sascnvn.F b/physics/CONV/SAS/sascnvn.F similarity index 99% rename from physics/sascnvn.F rename to physics/CONV/SAS/sascnvn.F index 673231e05..709e4dd5b 100644 --- a/physics/sascnvn.F +++ b/physics/CONV/SAS/sascnvn.F @@ -126,9 +126,9 @@ subroutine sascnvn_run( & u1(:,:), v1(:,:), & & cnvw(:,:), cnvc(:,:) real(kind=kind_phys), intent(out) :: cldwrk(:), rn(:), & - & ud_mf(:,:), dd_mf(:,:), & - & dt_mf(:,:) - real(kind=kind_phys), intent(inout) :: & + & dt_mf(:,:), dd_mf(:,:) + real(kind=kind_phys), intent(out), optional :: ud_mf(:,:) + real(kind=kind_phys), intent(inout), optional :: & & qlcn(:,:), qicn(:,:), & & w_upi(:,:), cnv_mfd(:,:), & & cnv_dqldt(:,:), clcn(:,:), & diff --git a/physics/sascnvn.meta b/physics/CONV/SAS/sascnvn.meta similarity index 98% rename from physics/sascnvn.meta rename to physics/CONV/SAS/sascnvn.meta index 66e5161ad..10b0f9aff 100644 --- a/physics/sascnvn.meta +++ b/physics/CONV/SAS/sascnvn.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = sascnvn type = scheme - dependencies = funcphys.f90,machine.F + dependencies = ../../tools/funcphys.f90,../../hooks/machine.F ######################################################################## [ccpp-arg-table] @@ -305,6 +305,7 @@ type = real kind = kind_phys intent = out + optional = True [dd_mf] standard_name = instantaneous_atmosphere_downdraft_convective_mass_flux long_name = (downdraft mass flux) * delt @@ -345,6 +346,7 @@ type = real kind = kind_phys intent = inout + optional = True [qicn] standard_name = mass_fraction_of_convective_cloud_ice long_name = mass fraction of convective cloud ice water @@ -353,6 +355,7 @@ type = real kind = kind_phys intent = inout + optional = True [w_upi] standard_name = vertical_velocity_for_updraft long_name = vertical velocity for updraft @@ -361,6 +364,7 @@ type = real kind = kind_phys intent = inout + optional = True [cf_upi] standard_name = convective_cloud_fraction_for_microphysics long_name = convective cloud fraction for microphysics @@ -369,6 +373,7 @@ type = real kind = kind_phys intent = inout + optional = True [cnv_mfd] standard_name = detrained_mass_flux long_name = detrained mass flux @@ -377,6 +382,7 @@ type = real kind = kind_phys intent = inout + optional = True [cnv_dqldt] standard_name = tendency_of_cloud_water_due_to_convective_microphysics long_name = tendency of cloud water due to convective microphysics @@ -385,6 +391,7 @@ type = real kind = kind_phys intent = inout + optional = True [clcn] standard_name = convective_cloud_volume_fraction long_name = convective cloud volume fraction @@ -393,6 +400,7 @@ type = real kind = kind_phys intent = inout + optional = True [cnv_fice] standard_name = ice_fraction_in_convective_tower long_name = ice fraction in convective tower @@ -401,6 +409,7 @@ type = real kind = kind_phys intent = inout + optional = True [cnv_ndrop] standard_name = number_concentration_of_cloud_liquid_water_particles_for_detrainment long_name = droplet number concentration in convective detrainment @@ -409,6 +418,7 @@ type = real kind = kind_phys intent = inout + optional = True [cnv_nice] standard_name = number_concentration_of_ice_crystals_for_detrainment long_name = crystal number concentration in convective detrainment @@ -417,6 +427,7 @@ type = real kind = kind_phys intent = inout + optional = True [mp_phys] standard_name = control_for_microphysics_scheme long_name = choice of microphysics scheme diff --git a/physics/shalcnv.F b/physics/CONV/SAS/shalcnv.F similarity index 99% rename from physics/shalcnv.F rename to physics/CONV/SAS/shalcnv.F index 3b8d706cd..3224ed125 100644 --- a/physics/shalcnv.F +++ b/physics/CONV/SAS/shalcnv.F @@ -123,7 +123,8 @@ subroutine shalcnv_run( & & q1(:,:), t1(:,:), & & u1(:,:), v1(:,:), & & cnvw(:,:), cnvc(:,:) - real(kind=kind_phys), intent(out) :: rn(:), ud_mf(:,:), dt_mf(:,:) + real(kind=kind_phys), intent(out) :: rn(:), dt_mf(:,:) + real(kind=kind_phys), intent(out), optional :: ud_mf(:,:) character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg ! diff --git a/physics/shalcnv.meta b/physics/CONV/SAS/shalcnv.meta similarity index 99% rename from physics/shalcnv.meta rename to physics/CONV/SAS/shalcnv.meta index f554201c5..8a06e7b06 100644 --- a/physics/shalcnv.meta +++ b/physics/CONV/SAS/shalcnv.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = shalcnv type = scheme - dependencies = funcphys.f90,machine.F + dependencies = ../../tools/funcphys.f90,../../hooks/machine.F ######################################################################## [ccpp-arg-table] @@ -335,6 +335,7 @@ type = real kind = kind_phys intent = out + optional = True [dt_mf] standard_name = instantaneous_atmosphere_detrainment_convective_mass_flux long_name = (detrainment mass flux) * delt diff --git a/physics/cu_ntiedtke.F90 b/physics/CONV/nTiedtke/cu_ntiedtke.F90 similarity index 99% rename from physics/cu_ntiedtke.F90 rename to physics/CONV/nTiedtke/cu_ntiedtke.F90 index 0be7df95a..ada38c6f5 100644 --- a/physics/cu_ntiedtke.F90 +++ b/physics/CONV/nTiedtke/cu_ntiedtke.F90 @@ -171,13 +171,15 @@ subroutine cu_ntiedtke_run(pu,pv,pt,pqv,tdi,qvdi,pqvf,ptf,clw,poz,pzz,prsl,prsi, integer, dimension( : ), intent(in) :: lmask real(kind=kind_phys), dimension( : ), intent(in ) :: evap, hfx, dx real(kind=kind_phys), dimension( :, : ), intent(inout) :: pu, pv, pt, pqv - real(kind=kind_phys), dimension( :, :), intent(in ) :: tdi, qvdi, poz, prsl, pomg, pqvf, ptf + real(kind=kind_phys), dimension( :, :), intent(in ) :: tdi, qvdi, poz, prsl, pomg + real(kind=kind_phys), dimension( :, :), intent(in ), optional :: pqvf, ptf real(kind=kind_phys), dimension( :, : ), intent(in ) :: pzz, prsi real(kind=kind_phys), dimension( :, :, : ), intent(inout ) :: clw integer, dimension( : ), intent(out) :: kbot, ktop, kcnv real(kind=kind_phys), dimension( : ), intent(out) :: zprecc - real(kind=kind_phys), dimension (:, :), intent(out) :: ud_mf, dd_mf, dt_mf, cnvw, cnvc + real(kind=kind_phys), dimension (:, :), intent(out), optional :: ud_mf + real(kind=kind_phys), dimension (:, :), intent(out) :: dd_mf, dt_mf, cnvw, cnvc ! error messages character(len=*), intent(out) :: errmsg diff --git a/physics/cu_ntiedtke.meta b/physics/CONV/nTiedtke/cu_ntiedtke.meta similarity index 98% rename from physics/cu_ntiedtke.meta rename to physics/CONV/nTiedtke/cu_ntiedtke.meta index dded8fb20..3e1755a5a 100644 --- a/physics/cu_ntiedtke.meta +++ b/physics/CONV/nTiedtke/cu_ntiedtke.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = cu_ntiedtke type = scheme - dependencies = machine.F,physcons.F90 + dependencies = ../../hooks/machine.F,../../hooks/physcons.F90 ######################################################################## [ccpp-arg-table] @@ -125,6 +125,7 @@ type = real kind = kind_phys intent = in + optional = True [ptf] standard_name = tendency_of_air_temperature_due_to_nonphysics long_name = temperature tendency due to dynamics only @@ -133,6 +134,7 @@ type = real kind = kind_phys intent = in + optional = True [clw] standard_name = convective_transportable_tracers long_name = array to contain cloud water and other tracers @@ -278,6 +280,7 @@ type = real kind = kind_phys intent = out + optional = True [dd_mf] standard_name = instantaneous_atmosphere_downdraft_convective_mass_flux long_name = (downdraft mass flux) * delt diff --git a/physics/cu_ntiedtke_post.F90 b/physics/CONV/nTiedtke/cu_ntiedtke_post.F90 similarity index 87% rename from physics/cu_ntiedtke_post.F90 rename to physics/CONV/nTiedtke/cu_ntiedtke_post.F90 index 8b3c99681..583dfd57d 100644 --- a/physics/cu_ntiedtke_post.F90 +++ b/physics/CONV/nTiedtke/cu_ntiedtke_post.F90 @@ -23,8 +23,8 @@ subroutine cu_ntiedtke_post_run (t, q, prevst, prevsq, errmsg, errflg) ! Interface variables real(kind_phys), intent(in) :: t(:,:) real(kind_phys), intent(in) :: q(:,:) - real(kind_phys), intent(out) :: prevst(:,:) - real(kind_phys), intent(out) :: prevsq(:,:) + real(kind_phys), intent(out), optional :: prevst(:,:) + real(kind_phys), intent(out), optional :: prevsq(:,:) character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg diff --git a/physics/cu_ntiedtke_post.meta b/physics/CONV/nTiedtke/cu_ntiedtke_post.meta similarity index 95% rename from physics/cu_ntiedtke_post.meta rename to physics/CONV/nTiedtke/cu_ntiedtke_post.meta index 703d32b90..db51223d3 100644 --- a/physics/cu_ntiedtke_post.meta +++ b/physics/CONV/nTiedtke/cu_ntiedtke_post.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = cu_ntiedtke_post type = scheme - dependencies = machine.F + dependencies = ../../hooks/machine.F ######################################################################## [ccpp-arg-table] @@ -31,6 +31,7 @@ type = real kind = kind_phys intent = out + optional = True [prevsq] standard_name = specific_humidity_on_previous_timestep long_name = moisture from previous time step @@ -39,6 +40,7 @@ type = real kind = kind_phys intent = out + optional = True [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/cu_ntiedtke_pre.F90 b/physics/CONV/nTiedtke/cu_ntiedtke_pre.F90 similarity index 87% rename from physics/cu_ntiedtke_pre.F90 rename to physics/CONV/nTiedtke/cu_ntiedtke_pre.F90 index abdffcb49..81a55176d 100644 --- a/physics/cu_ntiedtke_pre.F90 +++ b/physics/CONV/nTiedtke/cu_ntiedtke_pre.F90 @@ -28,10 +28,10 @@ subroutine cu_ntiedtke_pre_run (flag_init, flag_restart, kdt, fhour, dtp, t, q, real(kind_phys), intent(in) :: dtp real(kind_phys), intent(in) :: t(:,:) real(kind_phys), intent(in) :: q(:,:) - real(kind_phys), intent(in) :: prevst(:,:) - real(kind_phys), intent(in) :: prevsq(:,:) - real(kind_phys), intent(out) :: forcet(:,:) - real(kind_phys), intent(out) :: forceq(:,:) + real(kind_phys), intent(in), optional :: prevst(:,:) + real(kind_phys), intent(in), optional :: prevsq(:,:) + real(kind_phys), intent(out), optional :: forcet(:,:) + real(kind_phys), intent(out), optional :: forceq(:,:) character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg diff --git a/physics/cu_ntiedtke_pre.meta b/physics/CONV/nTiedtke/cu_ntiedtke_pre.meta similarity index 96% rename from physics/cu_ntiedtke_pre.meta rename to physics/CONV/nTiedtke/cu_ntiedtke_pre.meta index ccb9b7f48..1938ee711 100644 --- a/physics/cu_ntiedtke_pre.meta +++ b/physics/CONV/nTiedtke/cu_ntiedtke_pre.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = cu_ntiedtke_pre type = scheme - dependencies = machine.F + dependencies = ../../hooks/machine.F ######################################################################## [ccpp-arg-table] @@ -68,6 +68,7 @@ type = real kind = kind_phys intent = in + optional = True [prevsq] standard_name = specific_humidity_on_previous_timestep long_name = moisture from previous time step @@ -76,6 +77,7 @@ type = real kind = kind_phys intent = in + optional = True [forcet] standard_name = tendency_of_air_temperature_due_to_nonphysics long_name = temperature tendency due to dynamics only @@ -84,6 +86,7 @@ type = real kind = kind_phys intent = out + optional = True [forceq] standard_name = tendendy_of_specific_humidity_due_to_nonphysics long_name = moisture tendency due to dynamics only @@ -92,6 +95,7 @@ type = real kind = kind_phys intent = out + optional = True [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/progsigma_calc.f90 b/physics/CONV/progsigma_calc.f90 similarity index 88% rename from physics/progsigma_calc.f90 rename to physics/CONV/progsigma_calc.f90 index c87308602..469df49f6 100644 --- a/physics/progsigma_calc.f90 +++ b/physics/CONV/progsigma_calc.f90 @@ -19,10 +19,10 @@ module progsigma !! This subroutine computes a prognostic updraft area fracftion !! used in the closure computations in the samfshalcnv. scheme !!\section gen_progsigma progsigma_calc General Algorithm - subroutine progsigma_calc (im,km,flag_init,flag_restart, & - flag_shallow,del,tmf,qmicro,dbyo1,zdqca,omega_u,zeta,hvap, & - delt,qadv,kbcon1,ktcon,cnvflg,sigmain,sigmaout, & - sigmab) + subroutine progsigma_calc (im,km,flag_init,flag_restart,flag_shallow,& + flag_mid,del,tmf,qmicro,dbyo1,zdqca,omega_u,zeta,hvap, & + delt,qadv,kbcon1,ktcon,cnvflg,betascu,betamcu,betadcu, & + sigmind,sigminm,sigmins,sigmain,sigmaout,sigmab) ! ! use machine, only : kind_phys @@ -32,11 +32,12 @@ subroutine progsigma_calc (im,km,flag_init,flag_restart, & ! intent in integer, intent(in) :: im,km,kbcon1(im),ktcon(im) - real(kind=kind_phys), intent(in) :: hvap,delt + real(kind=kind_phys), intent(in) :: hvap,delt,betascu,betamcu,betadcu, & + sigmind,sigminm,sigmins real(kind=kind_phys), intent(in) :: qadv(im,km),del(im,km), & qmicro(im,km),tmf(im,km),dbyo1(im,km),zdqca(im,km), & omega_u(im,km),zeta(im,km) - logical, intent(in) :: flag_init,flag_restart,cnvflg(im),flag_shallow + logical, intent(in) :: flag_init,flag_restart,cnvflg(im),flag_shallow,flag_mid real(kind=kind_phys), intent(in) :: sigmain(im,km) ! intent out @@ -53,15 +54,13 @@ subroutine progsigma_calc (im,km,flag_init,flag_restart, & real(kind=kind_phys) :: gcvalmx,epsilon,ZZ,cvg,mcon,buy2, & fdqb,dtdyn,dxlim,rmulacvg,tem, & - DEN,betascu,betadcu,dp1,invdelt + DEN,dp1,invdelt !Parameters gcvalmx = 0.1 rmulacvg=10. epsilon=1.E-11 km1=km-1 - betadcu = 2.0 - betascu = 8.0 invdelt = 1./delt !Initialization 2D @@ -206,17 +205,27 @@ subroutine progsigma_calc (im,km,flag_init,flag_restart, & do i= 1, im if(cnvflg(i)) then sigmab(i)=sigmab(i)/betascu - sigmab(i)=MAX(0.03,sigmab(i)) + sigmab(i)=MAX(sigmins,sigmab(i)) + endif + enddo + elseif(flag_mid)then + do i= 1, im + if(cnvflg(i)) then + sigmab(i)=sigmab(i)/betamcu + sigmab(i)=MAX(sigminm,sigmab(i)) endif enddo else do i= 1, im if(cnvflg(i)) then sigmab(i)=sigmab(i)/betadcu - sigmab(i)=MAX(0.01,sigmab(i)) + sigmab(i)=MAX(sigmind,sigmab(i)) endif enddo endif + do i= 1, im + sigmab(i) = MIN(0.95,sigmab(i)) + enddo end subroutine progsigma_calc diff --git a/physics/GFS_suite_stateout_update.F90 b/physics/GFS_suite_stateout_update.F90 deleted file mode 100644 index 2771c3e82..000000000 --- a/physics/GFS_suite_stateout_update.F90 +++ /dev/null @@ -1,63 +0,0 @@ -!> \file GFS_suite_stateout_update.f90 -!! Contains code to update the state variables due to process-split physics from accumulated tendencies during that phase. -!! Also, set bounds on the mass-weighted rime factor when using Ferrier-Aligo microphysics. - - module GFS_suite_stateout_update - - contains - -!> \section arg_table_GFS_suite_stateout_update_run Argument Table -!! \htmlinclude GFS_suite_stateout_update_run.html -!! - subroutine GFS_suite_stateout_update_run (im, levs, ntrac, dtp, & - tgrs, ugrs, vgrs, qgrs, dudt, dvdt, dtdt, dqdt, & - gt0, gu0, gv0, gq0, ntiw, nqrimef, imp_physics, & - imp_physics_fer_hires, epsq, errmsg, errflg) - - use machine, only: kind_phys - - implicit none - - ! Interface variables - integer, intent(in ) :: im - integer, intent(in ) :: levs - integer, intent(in ) :: ntrac - integer, intent(in ) :: imp_physics,imp_physics_fer_hires - integer, intent(in ) :: ntiw, nqrimef - real(kind=kind_phys), intent(in ) :: dtp, epsq - - real(kind=kind_phys), intent(in ), dimension(:,:) :: tgrs, ugrs, vgrs - real(kind=kind_phys), intent(in ), dimension(:,:,:) :: qgrs - real(kind=kind_phys), intent(in ), dimension(:,:) :: dudt, dvdt, dtdt - real(kind=kind_phys), intent(in ), dimension(:,:,:) :: dqdt - real(kind=kind_phys), intent(out), dimension(:,:) :: gt0, gu0, gv0 - real(kind=kind_phys), intent(out), dimension(:,:,:) :: gq0 - - character(len=*), intent(out) :: errmsg - integer, intent(out) :: errflg - - integer :: i, k - ! Initialize CCPP error handling variables - errmsg = '' - errflg = 0 - - gt0(:,:) = tgrs(:,:) + dtdt(:,:) * dtp - gu0(:,:) = ugrs(:,:) + dudt(:,:) * dtp - gv0(:,:) = vgrs(:,:) + dvdt(:,:) * dtp - gq0(:,:,:) = qgrs(:,:,:) + dqdt(:,:,:) * dtp - - if (imp_physics == imp_physics_fer_hires) then - do k=1,levs - do i=1,im - if(gq0(i,k,ntiw) > epsq) then - gq0(i,k,nqrimef) = max(1., gq0(i,k,nqrimef)/gq0(i,k,ntiw)) - else - gq0(i,k,nqrimef) = 1. - end if - end do - end do - end if - - end subroutine GFS_suite_stateout_update_run - - end module GFS_suite_stateout_update \ No newline at end of file diff --git a/physics/cires_orowam2017.f b/physics/GWD/cires_orowam2017.f similarity index 100% rename from physics/cires_orowam2017.f rename to physics/GWD/cires_orowam2017.f diff --git a/physics/cires_tauamf_data.F90 b/physics/GWD/cires_tauamf_data.F90 similarity index 96% rename from physics/cires_tauamf_data.F90 rename to physics/GWD/cires_tauamf_data.F90 index 77c74b1a9..4f12b2ec1 100644 --- a/physics/cires_tauamf_data.F90 +++ b/physics/GWD/cires_tauamf_data.F90 @@ -180,7 +180,6 @@ subroutine gfs_idate_calendar(idate, fhour, ddd, fddd) integer :: jdow, jdoy, jday real(8) :: rinc(5) real(4) :: rinc4(5) - integer :: w3kindreal, w3kindint integer :: iw3jdn integer :: jd1, jddd @@ -196,13 +195,7 @@ subroutine gfs_idate_calendar(idate, fhour, ddd, fddd) rinc(1:5) = 0. rinc(2) = fhour ! - call w3kind(w3kindreal,w3kindint) - if(w3kindreal==4) then - rinc4 = rinc - call w3movdat(rinc4, idat,jdat) - else - call w3movdat(rinc, idat,jdat) - endif + call w3movdat(rinc, idat,jdat) ! jdate(8)- date and time (yr, mo, day, [tz], hr, min, sec) jdow = 0 jdoy = 0 diff --git a/physics/cires_ugwp.F90 b/physics/GWD/cires_ugwp.F90 similarity index 97% rename from physics/cires_ugwp.F90 rename to physics/GWD/cires_ugwp.F90 index c648d9647..cab602252 100644 --- a/physics/cires_ugwp.F90 +++ b/physics/GWD/cires_ugwp.F90 @@ -229,13 +229,14 @@ subroutine cires_ugwp_run(do_ugwp, me, master, im, levs, ntrac, dtp, kdt, lonr real(kind=kind_phys), intent(out), dimension(:) :: zmtb, zlwb, zogw, rdxzb real(kind=kind_phys), intent(out), dimension(:) :: tau_mtb, tau_ogw, tau_tofd, tau_ngw real(kind=kind_phys), intent(out), dimension(:, :):: gw_dudt, gw_dvdt, gw_dtdt, gw_kdis - real(kind=kind_phys), intent(out), dimension(:, :):: dudt_mtb, dudt_ogw, dudt_tms - real(kind=kind_phys), intent(out), dimension(:) :: dusfc_ms, dvsfc_ms, dusfc_bl, dvsfc_bl - real(kind=kind_phys), intent(out), dimension(:, :) :: dtauy2d_ms - real(kind=kind_phys), intent(out), dimension(:, :) :: dtaux2d_bl, dtauy2d_bl + real(kind=kind_phys), intent(out), dimension(:, :):: dudt_mtb, dudt_tms + real(kind=kind_phys), intent(out), dimension(:, :), optional :: dudt_ogw + real(kind=kind_phys), intent(out), dimension(:), optional :: dusfc_ms, dvsfc_ms, dusfc_bl, dvsfc_bl + real(kind=kind_phys), intent(out), dimension(:, :), optional :: dtauy2d_ms + real(kind=kind_phys), intent(out), dimension(:, :), optional :: dtaux2d_bl, dtauy2d_bl ! dtend is only allocated if ldiag=.true. - real(kind=kind_phys), optional, intent(inout) :: dtend(:,:,:) + real(kind=kind_phys), optional, intent(inout) :: dtend(:,:,:) integer, intent(in) :: dtidx(:,:), & index_of_x_wind, index_of_y_wind, index_of_temperature, & index_of_process_orographic_gwd, index_of_process_nonorographic_gwd @@ -243,7 +244,7 @@ subroutine cires_ugwp_run(do_ugwp, me, master, im, levs, ntrac, dtp, kdt, lonr logical, intent(in) :: ldiag3d, lssav ! These arrays only allocated if ldiag_ugwp = .true. - real(kind=kind_phys), intent(inout), dimension(:,:) :: du3dt_mtb, du3dt_ogw, du3dt_tms + real(kind=kind_phys), intent(inout), dimension(:,:), optional :: du3dt_mtb, du3dt_ogw, du3dt_tms real(kind=kind_phys), intent(inout), dimension(:, :):: dudt, dvdt, dtdt diff --git a/physics/cires_ugwp.meta b/physics/GWD/cires_ugwp.meta similarity index 99% rename from physics/cires_ugwp.meta rename to physics/GWD/cires_ugwp.meta index d944a635e..b0b1a8615 100644 --- a/physics/cires_ugwp.meta +++ b/physics/GWD/cires_ugwp.meta @@ -3,7 +3,7 @@ type = scheme # DH* 20200804 - this is a result of the nasty hack to call gwdps from within ugwp-v0! dependencies=cires_ugwp_triggers.F90,cires_ugwp_initialize.F90 - dependencies=cires_orowam2017.f,cires_ugwp_module.F90,gwdps.f,machine.F,ugwp_driver_v0.F + dependencies=cires_orowam2017.f,cires_ugwp_module.F90,gwdps.f,../hooks/machine.F,ugwp_driver_v0.F ######################################################################## [ccpp-arg-table] @@ -604,6 +604,7 @@ type = real kind = kind_phys intent = out + optional = True [dvsfc_ms] standard_name = vertically_integrated_y_momentum_flux_due_to_mesoscale_orographic_gravity_wave_drag long_name = integrated y momentum flux from mesoscale gwd @@ -612,6 +613,7 @@ type = real kind = kind_phys intent = out + optional = True [dusfc_bl] standard_name = vertically_integrated_x_momentum_flux_due_to_blocking_drag long_name = integrated x momentum flux from blocking drag @@ -620,6 +622,7 @@ type = real kind = kind_phys intent = out + optional = True [dvsfc_bl] standard_name = vertically_integrated_y_momentum_flux_due_to_blocking_drag long_name = integrated y momentum flux from blocking drag @@ -628,6 +631,7 @@ type = real kind = kind_phys intent = out + optional = True [dudt_ogw] standard_name = tendency_of_x_wind_due_to_mesoscale_orographic_gravity_wave_drag long_name = instantaneous change in x wind due to orographic gw drag @@ -636,6 +640,7 @@ type = real kind = kind_phys intent = out + optional = True [dtauy2d_ms] standard_name = tendency_of_y_wind_due_to_mesoscale_orographic_gravity_wave_drag long_name = instantaneous change in y wind due to orographic gw drag @@ -644,6 +649,7 @@ type = real kind = kind_phys intent = out + optional = True [dtaux2d_bl] standard_name = tendency_of_x_wind_due_to_blocking_drag long_name = x wind tendency from blocking drag @@ -652,6 +658,7 @@ type = real kind = kind_phys intent = out + optional = True [dtauy2d_bl] standard_name = tendency_of_y_wind_due_to_blocking_drag long_name = y wind tendency from blocking drag @@ -660,6 +667,7 @@ type = real kind = kind_phys intent = out + optional = True [dudt_mtb] standard_name = instantaneous_change_in_x_wind_due_to_mountain_blocking_drag long_name = instantaneous change in x wind due to mountain blocking drag @@ -684,6 +692,7 @@ type = real kind = kind_phys intent = inout + optional = True [du3dt_ogw] standard_name = time_integral_of_change_in_x_wind_due_to_orographic_gravity_wave_drag long_name = time integral of change in x wind due to orographic gw drag @@ -692,6 +701,7 @@ type = real kind = kind_phys intent = inout + optional = True [du3dt_tms] standard_name = time_integral_of_change_in_x_wind_due_to_turbulent_orographic_form_drag long_name = time integral of change in x wind due to TOFD @@ -700,6 +710,7 @@ type = real kind = kind_phys intent = inout + optional = True [dudt] standard_name = process_split_cumulative_tendency_of_x_wind long_name = zonal wind tendency due to model physics @@ -840,8 +851,8 @@ dimensions = (horizontal_loop_extent,vertical_layer_dimension,cumulative_change_of_state_variables_outer_index_max) type = real kind = kind_phys - active = (flag_for_diagnostics_3D) intent = inout + optional = True [dtidx] standard_name = cumulative_change_of_state_variables_outer_index long_name = index of state-variable and process in last dimension of diagnostic tendencies array AKA cumulative_change_index diff --git a/physics/cires_ugwp_initialize.F90 b/physics/GWD/cires_ugwp_initialize.F90 similarity index 100% rename from physics/cires_ugwp_initialize.F90 rename to physics/GWD/cires_ugwp_initialize.F90 diff --git a/physics/cires_ugwp_module.F90 b/physics/GWD/cires_ugwp_module.F90 similarity index 100% rename from physics/cires_ugwp_module.F90 rename to physics/GWD/cires_ugwp_module.F90 diff --git a/physics/cires_ugwp_post.F90 b/physics/GWD/cires_ugwp_post.F90 similarity index 91% rename from physics/cires_ugwp_post.F90 rename to physics/GWD/cires_ugwp_post.F90 index f12237e2f..3efb2b7e8 100644 --- a/physics/cires_ugwp_post.F90 +++ b/physics/GWD/cires_ugwp_post.F90 @@ -33,8 +33,9 @@ subroutine cires_ugwp_post_run (ldiag_ugwp, dtf, im, levs, & real(kind=kind_phys), intent(in), dimension(:) :: tau_mtb, tau_ogw, tau_tofd, tau_ngw real(kind=kind_phys), intent(inout), dimension(:) :: tot_mtb, tot_ogw, tot_tofd, tot_ngw real(kind=kind_phys), intent(inout), dimension(:) :: tot_zmtb, tot_zlwb, tot_zogw - real(kind=kind_phys), intent(in), dimension(:,:) :: gw_dtdt, gw_dudt, gw_dvdt, dudt_mtb, dudt_ogw, dudt_tms - real(kind=kind_phys), intent(inout), dimension(:,:) :: du3dt_mtb, du3dt_ogw, du3dt_tms, du3dt_ngw, dv3dt_ngw + real(kind=kind_phys), intent(in), dimension(:,:) :: gw_dtdt, gw_dudt, gw_dvdt, dudt_mtb, dudt_tms + real(kind=kind_phys), intent(in), dimension(:,:), optional :: dudt_ogw + real(kind=kind_phys), intent(inout), dimension(:,:), optional :: du3dt_mtb, du3dt_ogw, du3dt_tms, du3dt_ngw, dv3dt_ngw real(kind=kind_phys), intent(inout), dimension(:,:) :: dtdt, dudt, dvdt character(len=*), intent(out) :: errmsg diff --git a/physics/cires_ugwp_post.meta b/physics/GWD/cires_ugwp_post.meta similarity index 98% rename from physics/cires_ugwp_post.meta rename to physics/GWD/cires_ugwp_post.meta index 5add9d43f..209209e25 100644 --- a/physics/cires_ugwp_post.meta +++ b/physics/GWD/cires_ugwp_post.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = cires_ugwp_post type = scheme - dependencies = machine.F + dependencies = ../hooks/machine.F ######################################################################## [ccpp-arg-table] @@ -132,6 +132,7 @@ type = real kind = kind_phys intent = in + optional = True [dudt_tms] standard_name = tendency_of_x_wind_due_to_turbulent_orographic_form_drag long_name = instantaneous change in x wind due to TOFD @@ -204,6 +205,7 @@ type = real kind = kind_phys intent = inout + optional = True [du3dt_ogw] standard_name = time_integral_of_change_in_x_wind_due_to_orographic_gravity_wave_drag long_name = time integral of change in x wind due to orographic gw drag @@ -212,6 +214,7 @@ type = real kind = kind_phys intent = inout + optional = True [du3dt_tms] standard_name = time_integral_of_change_in_x_wind_due_to_turbulent_orographic_form_drag long_name = time integral of change in x wind due to TOFD @@ -220,6 +223,7 @@ type = real kind = kind_phys intent = inout + optional = True [du3dt_ngw] standard_name = time_integral_of_change_in_x_wind_due_to_nonstationary_gravity_wave long_name = time integral of change in x wind due to NGW @@ -228,6 +232,7 @@ type = real kind = kind_phys intent = inout + optional = True [dv3dt_ngw] standard_name = time_integral_of_change_in_y_wind_due_to_nonstationary_gravity_wave long_name = time integral of change in y wind due to NGW @@ -236,6 +241,7 @@ type = real kind = kind_phys intent = inout + optional = True [dtdt] standard_name = process_split_cumulative_tendency_of_air_temperature long_name = air temperature tendency due to model physics diff --git a/physics/cires_ugwp_triggers.F90 b/physics/GWD/cires_ugwp_triggers.F90 similarity index 100% rename from physics/cires_ugwp_triggers.F90 rename to physics/GWD/cires_ugwp_triggers.F90 diff --git a/physics/cires_ugwpv1_initialize.F90 b/physics/GWD/cires_ugwpv1_initialize.F90 similarity index 100% rename from physics/cires_ugwpv1_initialize.F90 rename to physics/GWD/cires_ugwpv1_initialize.F90 diff --git a/physics/cires_ugwpv1_module.F90 b/physics/GWD/cires_ugwpv1_module.F90 similarity index 100% rename from physics/cires_ugwpv1_module.F90 rename to physics/GWD/cires_ugwpv1_module.F90 diff --git a/physics/cires_ugwpv1_oro.F90 b/physics/GWD/cires_ugwpv1_oro.F90 similarity index 100% rename from physics/cires_ugwpv1_oro.F90 rename to physics/GWD/cires_ugwpv1_oro.F90 diff --git a/physics/cires_ugwpv1_solv2.F90 b/physics/GWD/cires_ugwpv1_solv2.F90 similarity index 100% rename from physics/cires_ugwpv1_solv2.F90 rename to physics/GWD/cires_ugwpv1_solv2.F90 diff --git a/physics/cires_ugwpv1_sporo.F90 b/physics/GWD/cires_ugwpv1_sporo.F90 similarity index 100% rename from physics/cires_ugwpv1_sporo.F90 rename to physics/GWD/cires_ugwpv1_sporo.F90 diff --git a/physics/cires_ugwpv1_triggers.F90 b/physics/GWD/cires_ugwpv1_triggers.F90 similarity index 100% rename from physics/cires_ugwpv1_triggers.F90 rename to physics/GWD/cires_ugwpv1_triggers.F90 diff --git a/physics/drag_suite.F90 b/physics/GWD/drag_suite.F90 similarity index 52% rename from physics/drag_suite.F90 rename to physics/GWD/drag_suite.F90 index 22f122e71..5c2bf6c2c 100644 --- a/physics/drag_suite.F90 +++ b/physics/GWD/drag_suite.F90 @@ -219,8 +219,8 @@ subroutine drag_suite_run( & & dusfc_ms,dvsfc_ms,dusfc_bl,dvsfc_bl, & & dusfc_ss,dvsfc_ss,dusfc_fd,dvsfc_fd, & & slmsk,br1,hpbl, & - & g, cp, rd, rv, fv, pi, imx, cdmbgwd, me, master, & - & lprnt, ipr, rdxzb, dx, gwd_opt, & + & g, cp, rd, rv, fv, pi, imx, cdmbgwd, alpha_fd, & + & me, master, lprnt, ipr, rdxzb, dx, gwd_opt, & & do_gsl_drag_ls_bl, do_gsl_drag_ss, do_gsl_drag_tofd, & & dtend, dtidx, index_of_process_orographic_gwd, & & index_of_temperature, index_of_x_wind, & @@ -327,8 +327,9 @@ subroutine drag_suite_run( & integer, intent(in) :: gwd_opt logical, intent(in) :: lprnt integer, intent(in) :: KPBL(:) - real(kind=kind_phys), intent(in) :: deltim, G, CP, RD, RV, cdmbgwd(:) - real(kind=kind_phys), intent(inout) :: dtend(:,:,:) + real(kind=kind_phys), intent(in) :: deltim, G, CP, RD, RV, & + & cdmbgwd(:), alpha_fd + real(kind=kind_phys), intent(inout), optional :: dtend(:,:,:) logical, intent(in) :: ldiag3d integer, intent(in) :: dtidx(:,:), index_of_temperature, & & index_of_process_orographic_gwd, index_of_x_wind, index_of_y_wind @@ -337,7 +338,7 @@ subroutine drag_suite_run( & integer, parameter :: ims=1, kms=1, its=1, kts=1 real(kind=kind_phys), intent(in) :: fv, pi real(kind=kind_phys) :: rcl, cdmb - real(kind=kind_phys) :: g_inv + real(kind=kind_phys) :: g_inv, rd_inv real(kind=kind_phys), intent(inout) :: & & dudt(:,:),dvdt(:,:), & @@ -353,7 +354,7 @@ subroutine drag_suite_run( & real(kind=kind_phys), intent(in) :: var(:),oc1(:), & & oa4(:,:),ol4(:,:), & & dx(:) - real(kind=kind_phys), intent(in) :: varss(:),oc1ss(:), & + real(kind=kind_phys), intent(in), optional :: varss(:),oc1ss(:), & & oa4ss(:,:),ol4ss(:,:) real(kind=kind_phys), intent(in) :: THETA(:),SIGMA(:), & & GAMMA(:),ELVMAX(:) @@ -374,7 +375,7 @@ subroutine drag_suite_run( & !SPP real(kind=kind_phys), dimension(im) :: var_stoch, varss_stoch, & varmax_fd_stoch - real(kind=kind_phys), intent(in) :: spp_wts_gwd(:,:) + real(kind=kind_phys), intent(in), optional :: spp_wts_gwd(:,:) integer, intent(in) :: spp_gwd real(kind=kind_phys), dimension(im) :: rstoch @@ -383,12 +384,12 @@ subroutine drag_suite_run( & real(kind=kind_phys), intent(inout) :: & & dusfc(:), dvsfc(:) !Output (optional): - real(kind=kind_phys), intent(inout) :: & + real(kind=kind_phys), intent(inout), optional :: & & dusfc_ms(:),dvsfc_ms(:), & & dusfc_bl(:),dvsfc_bl(:), & & dusfc_ss(:),dvsfc_ss(:), & & dusfc_fd(:),dvsfc_fd(:) - real(kind=kind_phys), intent(inout) :: & + real(kind=kind_phys), intent(inout), optional :: & & dtaux2d_ms(:,:),dtauy2d_ms(:,:), & & dtaux2d_bl(:,:),dtauy2d_bl(:,:), & & dtaux2d_ss(:,:),dtauy2d_ss(:,:), & @@ -443,6 +444,7 @@ subroutine drag_suite_run( & real(kind=kind_phys), dimension(im,km) :: utendform,vtendform real(kind=kind_phys) :: a1,a2,wsp real(kind=kind_phys) :: H_efold + real(kind=kind_phys), parameter :: coeff_fd = 6.325e-3 ! critical richardson number for wave breaking : ! larger drag with larger value real(kind=kind_phys), parameter :: ric = 0.25 @@ -460,6 +462,8 @@ subroutine drag_suite_run( & real(kind=kind_phys), parameter :: ce = 0.8 real(kind=kind_phys), parameter :: cg = 0.5 real(kind=kind_phys), parameter :: sgmalolev = 0.5 ! max sigma lvl for dtfac + real(kind=kind_phys), parameter :: plolevmeso = 70.0 ! pres lvl for mesosphere OGWD reduction (Pa) + real(kind=kind_phys), parameter :: facmeso = 0.5 ! fractional velocity reduction for OGWD integer,parameter :: kpblmin = 2 ! @@ -472,7 +476,7 @@ subroutine drag_suite_run( & 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 + dtauxb,dtauyb,eng0,eng1,ksmax,dtfac_meso ! logical :: ldrag(im),icrilv(im), & flag(im),kloop1(im) @@ -509,7 +513,6 @@ subroutine drag_suite_run( & real(kind=kind_phys),parameter :: olmin = 1.0e-5 real(kind=kind_phys),parameter :: odmin = 0.1 real(kind=kind_phys),parameter :: odmax = 10. - real(kind=kind_phys),parameter :: erad = 6371.315e+3 integer :: komax(im) integer :: kblk real(kind=kind_phys) :: cd @@ -705,11 +708,12 @@ subroutine drag_suite_run( & taufb(1:im,1:km+1) = 0.0 komax(1:im) = 0 ! + rd_inv = 1./rd do k = kts,km do i = its,im vtj(i,k) = t1(i,k) * (1.+fv*q1(i,k)) vtk(i,k) = vtj(i,k) / prslk(i,k) - ro(i,k) = 1./rd * prsl(i,k) / vtj(i,k) ! density kg/m**3 + ro(i,k) = rd_inv * prsl(i,k) / vtj(i,k) ! density kg/m**3 enddo enddo ! @@ -887,6 +891,14 @@ subroutine drag_suite_run( & ldrag(i) = ldrag(i) .or. bnv2(i,1).le.0.0 ldrag(i) = ldrag(i) .or. ulow(i).eq.1.0 ldrag(i) = ldrag(i) .or. var_stoch(i) .le. 0.0 +! Check if mesoscale gravity waves will propagate vertically or be evanescent +! and not impart a drag force -- consider the maximum sub-grid horizontal +! topographic wavelength to be one-half the horizontal grid spacing -- calculate +! ksmax accordingly + ksmax = 4.0*pi/dx(i) ! based on wavelength = 0.5*dx(i) + if ( bnv2(i,1).gt.0.0 ) then + ldrag(i) = ldrag(i) .or. sqrt(bnv2(i,1))*rulow(i).lt.ksmax + endif ! ! set all ri low level values to the low level value ! @@ -1106,7 +1118,19 @@ subroutine drag_suite_run( & enddo ! do k = kts,km - taud_ms(i,k) = taud_ms(i,k)*dtfac(i)* ls_taper(i) *(1.-rstoch(i)) + + ! Check if well into mesosphere -- if so, perform similar reduction of + ! velocity tendency due to mesoscale GWD to prevent sudden reversal of + ! wind direction (similar to above) + dtfac_meso = 1.0 + if (prsl(i,k).le.plolevmeso) then + if (taud_ms(i,k).ne.0.) & + dtfac_meso = min(dtfac_meso,facmeso*abs(velco(i,k) & + /(deltim*rcs*taud_ms(i,k)))) + end if + + taud_ms(i,k) = taud_ms(i,k)*dtfac(i)*dtfac_meso* & + ls_taper(i) *(1.-rstoch(i)) taud_bl(i,k) = taud_bl(i,k)*dtfac(i)* ls_taper(i) *(1.-rstoch(i)) dtaux = taud_ms(i,k) * xn(i) @@ -1340,8 +1364,10 @@ subroutine drag_suite_run( & H_efold = 1500. DO k=kts,km wsp=SQRT(uwnd1(i,k)**2 + vwnd1(i,k)**2) - ! alpha*beta*Cmd*Ccorr*2.109 = 12.*1.*0.005*0.6*2.109 = 0.0759 - var_temp = 0.0759*EXP(-(zl(i,k)/H_efold)**1.5)*a2* & + ! Note: In Beljaars et al. (2004): + ! alpha_fd*beta*Cmd*Ccorr*2.109 = 12.*1.*0.005*0.6*2.109 = 0.0759 + ! lump beta*Cmd*Ccorr*2.109 into 1.*0.005*0.6*2.109 = coeff_fd ~ 6.325e-3_kind_phys + var_temp = alpha_fd*coeff_fd*EXP(-(zl(i,k)/H_efold)**1.5)*a2* & zl(i,k)**(-1.2)*ss_taper(i) ! this is greater than zero ! Note: This is a semi-implicit treatment of the time differencing ! per Beljaars et al. (2004, QJRMS) @@ -1391,6 +1417,1228 @@ subroutine drag_suite_run( & return end subroutine drag_suite_run !------------------------------------------------------------------- + + subroutine drag_suite_psl( & + & IM,KM,dvdt,dudt,dtdt,U1,V1,T1,Q1,KPBL, & + & PRSI,DEL,PRSL,PRSLK,PHII,PHIL,DELTIM,KDT, & + & var,oc1,oa4,ol4, & + & varss,oc1ss,oa4ss,ol4ss, & + & THETA,SIGMA,GAMMA,ELVMAX, & + & dtaux2d_ls,dtauy2d_ls,dtaux2d_bl,dtauy2d_bl, & + & dtaux2d_ss,dtauy2d_ss,dtaux2d_fd,dtauy2d_fd, & + & dusfc,dvsfc, & + & dusfc_ls,dvsfc_ls,dusfc_bl,dvsfc_bl, & + & dusfc_ss,dvsfc_ss,dusfc_fd,dvsfc_fd, & + & slmsk,br1,hpbl,vtype, & + & g, cp, rd, rv, fv, pi, imx, cdmbgwd, alpha_fd, & + & me, master, lprnt, ipr, rdxzb, dx, gwd_opt, & + & do_gsl_drag_ls_bl, do_gsl_drag_ss, do_gsl_drag_tofd, & + & psl_gwd_dx_factor, & + & dtend, dtidx, index_of_process_orographic_gwd, & + & index_of_temperature, index_of_x_wind, & + & index_of_y_wind, ldiag3d, ldiag_ugwp, ugwp_seq_update, & + & spp_wts_gwd, spp_gwd, errmsg, errflg) + +! ******************************************************************** +! -----> I M P L E M E N T A T I O N V E R S I O N <---------- +! +! ----- This code ----- +!begin WRF code + +! this code handles the time tendencies of u v due to the effect of mountain +! induced gravity wave drag from sub-grid scale orography. this routine +! not only treats the traditional upper-level wave breaking due to mountain +! variance (alpert 1988), but also the enhanced lower-tropospheric wave +! breaking due to mountain convexity and asymmetry (kim and arakawa 1995). +! thus, in addition to the terrain height data in a model grid box, +! additional 10-2d topographic statistics files are needed, including +! orographic standard deviation (var), convexity (oc1), asymmetry (oa4) +! and ol (ol4). these data sets are prepared based on the 30 sec usgs orography +! hong (1999). the current scheme was implmented as in hong et al.(2008) +! +! Originally coded by song-you hong and young-joon kim and implemented by song-you hong +! +! program history log: +! 2014-10-01 Hyun-Joo Choi (from KIAPS) flow-blocking drag of kim and doyle +! with blocked height by dividing streamline theory +! 2017-04-06 Joseph Olson (from Gert-Jan Steeneveld) added small-scale +! orographic grabity wave drag: +! 2017-09-15 Joseph Olson, with some bug fixes from Michael Toy: added the +! topographic form drag of Beljaars et al. (2004, QJRMS) +! Activation of each component is done by specifying the integer-parameters +! (defined below) to 0: inactive or 1: active +! gwd_opt_ls = 0 or 1: large-scale +! gwd_opt_bl = 0 or 1: blocking drag +! gwd_opt_ss = 0 or 1: small-scale gravity wave drag +! gwd_opt_fd = 0 or 1: topographic form drag +! 2017-09-25 Michael Toy (from NCEP GFS model) added dissipation heating +! gsd_diss_ht_opt = 0: dissipation heating off +! gsd_diss_ht_opt = 1: dissipation heating on +! 2020-08-25 Michael Toy changed logic control for drag component selection +! for CCPP. +! Namelist options: +! do_gsl_drag_ls_bl - logical flag for large-scale GWD + blocking +! do_gsl_drag_ss - logical flag for small-scale GWD +! do_gsl_drag_tofd - logical flag for turbulent form drag +! Compile-time options (same as before): +! gwd_opt_ls = 0 or 1: large-scale GWD +! gwd_opt_bl = 0 or 1: blocking drag +! +! References: +! Choi and Hong (2015) J. Geophys. Res. +! Hong et al. (2008), wea. and forecasting +! Kim and Doyle (2005), Q. J. R. Meteor. Soc. +! Kim and Arakawa (1995), j. atmos. sci. +! Alpert et al. (1988), NWP conference. +! Hong (1999), NCEP office note 424. +! Steeneveld et al (2008), JAMC +! Tsiringakis et al. (2017), Q. J. R. Meteor. Soc. +! Beljaars et al. (2004), Q. J. R. Meteor. Soc. +! +! notice : comparible or lower resolution orography files than model resolution +! are desirable in preprocess (wps) to prevent weakening of the drag +!------------------------------------------------------------------------------- +! +! input +! dudt (im,km) non-lin tendency for u wind component +! dvdt (im,km) non-lin tendency for v wind component +! u1(im,km) zonal wind / sqrt(rcl) m/sec at t0-dt +! v1(im,km) meridional wind / sqrt(rcl) m/sec at t0-dt +! t1(im,km) temperature deg k at t0-dt +! q1(im,km) specific humidity at t0-dt +! deltim time step secs +! del(km) positive increment of pressure across layer (pa) +! KPBL(IM) is the index of the top layer of the PBL +! ipr & lprnt for diagnostics +! +! output +! dudt, dvdt wind tendency due to gwdo +! dTdt +! +!------------------------------------------------------------------------------- + +!end wrf code +!----------------------------------------------------------------------C +! USE +! ROUTINE IS CALLED FROM CCPP (AFTER CALLING PBL SCHEMES) +! +! PURPOSE +! USING THE GWD PARAMETERIZATIONS OF PS-GLAS AND PH- +! GFDL TECHNIQUE. THE TIME TENDENCIES OF U V +! ARE ALTERED TO INCLUDE THE EFFECT OF MOUNTAIN INDUCED +! GRAVITY WAVE DRAG FROM SUB-GRID SCALE OROGRAPHY INCLUDING +! CONVECTIVE BREAKING, SHEAR BREAKING AND THE PRESENCE OF +! CRITICAL LEVELS +! +! +! ******************************************************************** + USE MACHINE , ONLY : kind_phys + implicit none + + ! Interface variables + integer, intent(in) :: im, km, imx, kdt, ipr, me, master + integer, intent(in) :: gwd_opt + logical, intent(in) :: lprnt + integer, intent(in) :: KPBL(:) + real(kind=kind_phys), intent(in) :: deltim, G, CP, RD, RV, & + & cdmbgwd(:), alpha_fd + real(kind=kind_phys), intent(inout), optional :: dtend(:,:,:) + logical, intent(in) :: ldiag3d + integer, intent(in) :: dtidx(:,:), index_of_temperature, & + & index_of_process_orographic_gwd, index_of_x_wind, index_of_y_wind + + integer :: kpblmax + integer, parameter :: ims=1, kms=1, its=1, kts=1 + real(kind=kind_phys), intent(in) :: fv, pi + real(kind=kind_phys) :: rcl, cdmb + real(kind=kind_phys) :: g_inv, g_cp, rd_inv + + real(kind=kind_phys), intent(inout) :: & + & dudt(:,:),dvdt(:,:), & + & dtdt(:,:) + real(kind=kind_phys), intent(out) :: rdxzb(:) + real(kind=kind_phys), intent(in) :: & + & u1(:,:),v1(:,:), & + & t1(:,:),q1(:,:), & + & PHII(:,:),prsl(:,:), & + & prslk(:,:),PHIL(:,:) + real(kind=kind_phys), intent(in) :: prsi(:,:), & + & del(:,:) + real(kind=kind_phys), intent(in) :: var(:),oc1(:), & + & oa4(:,:),ol4(:,:), & + & dx(:) + real(kind=kind_phys), intent(in), optional :: varss(:),oc1ss(:), & + & oa4ss(:,:),ol4ss(:,:) + real(kind=kind_phys), intent(in) :: THETA(:),SIGMA(:), & + & GAMMA(:),ELVMAX(:) + +! added for small-scale orographic wave drag + real(kind=kind_phys), dimension(im,km) :: utendwave,vtendwave,thx,thvx + integer, intent(in) :: vtype(:) + real(kind=kind_phys), intent(in) :: br1(:), & + & hpbl(:), & + & slmsk(:) + real(kind=kind_phys), dimension(im) :: govrth,xland + !real(kind=kind_phys), dimension(im,km) :: dz2 + real(kind=kind_phys) :: tauwavex0,tauwavey0, & + & XNBV,density,tvcon,hpbl2 + integer :: kpbl2,kvar + !real(kind=kind_phys), dimension(im,km+1) :: zq ! = PHII/g + real(kind=kind_phys), dimension(im,km) :: zl ! = PHIL/g + +!SPP + real(kind=kind_phys), dimension(im) :: var_stoch, varss_stoch, & + varmax_ss_stoch, varmax_fd_stoch + real(kind=kind_phys), intent(in), optional :: spp_wts_gwd(:,:) + integer, intent(in) :: spp_gwd + + real(kind=kind_phys), dimension(im) :: rstoch + +!Output: + real(kind=kind_phys), intent(out) :: & + & dusfc(:), dvsfc(:) +!Output (optional): + real(kind=kind_phys), intent(out), optional :: & + & dusfc_ls(:),dvsfc_ls(:), & + & dusfc_bl(:),dvsfc_bl(:), & + & dusfc_ss(:),dvsfc_ss(:), & + & dusfc_fd(:),dvsfc_fd(:) + real(kind=kind_phys), intent(out), optional :: & + & dtaux2d_ls(:,:),dtauy2d_ls(:,:), & + & dtaux2d_bl(:,:),dtauy2d_bl(:,:), & + & dtaux2d_ss(:,:),dtauy2d_ss(:,:), & + & dtaux2d_fd(:,:),dtauy2d_fd(:,:) + +!Misc arrays + real(kind=kind_phys), dimension(im,km) :: dtaux2d, dtauy2d + +!------------------------------------------------------------------------- +! Flags to regulate the activation of specific components of drag suite: +! Each component is tapered off automatically as a function of dx, so best to +! keep them activated (.true.). + logical, intent(in) :: & + do_gsl_drag_ls_bl, & ! large-scale gravity wave drag and blocking + do_gsl_drag_ss, & ! small-scale gravity wave drag (Steeneveld et al. 2008) + do_gsl_drag_tofd ! form drag (Beljaars et al. 2004, QJRMS) +! Flag for diagnostic outputs + logical, intent(in) :: ldiag_ugwp + +! Flag for sequential update of u and v between +! LSGWD + BLOCKING and SSGWD + TOFD calculations + logical, intent(in) :: ugwp_seq_update +! +! Additional flags + integer, parameter :: & + gwd_opt_ls = 1, & ! large-scale gravity wave drag + gwd_opt_bl = 1, & ! blocking drag + gsd_diss_ht_opt = 0 + +! Parameters for bounding the scale-adaptive variability: +! Small-scale GWD + turbulent form drag + real(kind=kind_phys), parameter :: dxmin_ss = 1000., & + & dxmax_ss = 12000. ! min,max range of tapering (m) +! Large-scale GWD + blocking + real(kind=kind_phys), parameter :: dxmin_ls = 3000., & + & dxmax_ls = 13000. ! min,max range of tapering (m) + real(kind=kind_phys), dimension(im) :: ss_taper, ls_taper ! small- and large-scale tapering factors (-) +! +! Variables for limiting topographic standard deviation (var) + real(kind=kind_phys), parameter :: varmax_ss = 50., & + varmax_fd = 150., & + beta_ss = 0.1, & + beta_fd = 0.2 + real(kind=kind_phys) :: var_temp, var_temp2 + +! added Beljaars orographic form drag + real(kind=kind_phys), dimension(im,km) :: utendform,vtendform + real(kind=kind_phys) :: a1,a2,wsp + real(kind=kind_phys) :: H_efold + real(kind=kind_phys), parameter :: coeff_fd = 6.325e-3 + +! multification factor of standard deviation : ! larger drag with larger value +!!! real(kind=kind_phys), parameter :: psl_gwd_dx_factor = 6.0 + real(kind=kind_phys), intent(in) :: psl_gwd_dx_factor + +! critical richardson number for wave breaking : ! larger drag with larger value + real(kind=kind_phys), parameter :: ric = 0.25 + real(kind=kind_phys), parameter :: dw2min = 1. + real(kind=kind_phys), parameter :: rimin = -100. + real(kind=kind_phys), parameter :: bnv2min = 1.0e-5 + real(kind=kind_phys), parameter :: efmin = 0.0 + real(kind=kind_phys), parameter :: efmax = 10.0 + real(kind=kind_phys), parameter :: xl = 4.0e4 + real(kind=kind_phys), parameter :: critac = 1.0e-5 + real(kind=kind_phys), parameter :: gmax = 1. + real(kind=kind_phys), parameter :: veleps = 1.0 + real(kind=kind_phys), parameter :: factop = 0.5 + real(kind=kind_phys), parameter :: frc = 1.0 + real(kind=kind_phys), parameter :: ce = 0.8 + real(kind=kind_phys), parameter :: cg = 1.0 +! real(kind=kind_phys), parameter :: var_min = 100.0 + real(kind=kind_phys), parameter :: var_min = 10.0 + real(kind=kind_phys), parameter :: hmt_min = 50. + real(kind=kind_phys), parameter :: oc_min = 1.0 + real(kind=kind_phys), parameter :: oc_max = 10.0 +! 7.5 mb -- 33 km ... 0.01 kgm-3 reduce gwd drag above cutoff level + real(kind=kind_phys), parameter :: pcutoff = 7.5e2 +! 0.76 mb -- 50 km ...0.001 kgm-3 --- 0.1 mb 65 km 0.0001 kgm-3 + real(kind=kind_phys), parameter :: pcutoff_den = 0.01 ! + + integer,parameter :: kpblmin = 2 + +! +! local variables +! + integer :: i,j,k,lcap,lcapp1,nwd,idir, & + klcap,kp1 +! + real(kind=kind_phys) :: rcs,csg,fdir,cs, & + rcsks,wdir,ti,rdz,tem2,dw2,shr2, & + bvf2,rdelks,wtkbj,tem,gfobnv,hd,fro, & + rim,temc,tem1,efact,temv,dtaux,dtauy, & + dtauxb,dtauyb,eng0,eng1 + real(kind=kind_phys) :: denfac +! + logical :: ldrag(im),icrilv(im), & + flag(im) +! + real(kind=kind_phys) :: invgrcs +! + real(kind=kind_phys) :: taub(im),taup(im,km+1), & + xn(im),yn(im), & + ubar(im),vbar(im), & + fr(im),ulow(im), & + rulow(im),bnv(im), & + oa(im),ol(im),oc(im), & + oass(im),olss(im), & + roll(im),dtfac(im,km), & + brvf(im),xlinv(im), & + delks(im),delks1(im), & + bnv2(im,km),usqj(im,km), & + taud_ls(im,km),taud_bl(im,km), & + ro(im,km), & + vtk(im,km),vtj(im,km), & + zlowtop(im),velco(im,km-1), & + coefm(im),coefm_ss(im) + real(kind=kind_phys) :: cleff(im),cleff_ss(im) +! + integer :: kbl(im),klowtop(im) + integer,parameter :: mdir=8 + !integer :: nwdir(mdir) + !data nwdir/6,7,5,8,2,3,1,4/ + integer, parameter :: nwdir(8) = (/6,7,5,8,2,3,1,4/) +! +! variables for flow-blocking drag +! + real(kind=kind_phys),parameter :: frmax = 10. + real(kind=kind_phys),parameter :: olmin = 1.e-5 + real(kind=kind_phys),parameter :: odmin = 0.1 + real(kind=kind_phys),parameter :: odmax = 10. + real(kind=kind_phys),parameter :: cdmin = 0.0 + integer :: komax(im),kbmax(im),kblk(im) + real(kind=kind_phys) :: hmax(im) + real(kind=kind_phys) :: cd + real(kind=kind_phys) :: zblk,tautem + real(kind=kind_phys) :: pe,ke + real(kind=kind_phys) :: delx,dely + real(kind=kind_phys) :: dxy4(im,4),dxy4p(im,4) + real(kind=kind_phys) :: dxy(im),dxyp(im) + real(kind=kind_phys) :: ol4p(4),olp(im),od(im) + real(kind=kind_phys) :: taufb(im,km+1) + + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + integer :: udtend, vdtend, Tdtend + + ! Calculate inverse of gravitational acceleration + g_inv = 1./G + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + ! Initialize local variables + var_temp2 = 0. + udtend = -1 + vdtend = -1 + Tdtend = -1 + + if(ldiag3d) then + udtend = dtidx(index_of_x_wind,index_of_process_orographic_gwd) + vdtend = dtidx(index_of_y_wind,index_of_process_orographic_gwd) + Tdtend = dtidx(index_of_temperature,index_of_process_orographic_gwd) + endif +! +!---- constants +! + rcl = 1. + rcs = sqrt(rcl) + cs = 1. / sqrt(rcl) + csg = cs * g + lcap = km + lcapp1 = lcap + 1 + fdir = mdir / (2.0*pi) + invgrcs = 1._kind_phys/g*rcs + kpblmax = km / 2 ! maximum pbl height : # of vertical levels / 2 + denfac = 1.0 + + do i=1,im + if (slmsk(i)==1. .or. slmsk(i)==2.) then !sea/land/ice mask (=0/1/2) in FV3 + xland(i)=1.0 !but land/water = (1/2) in this module + else + xland(i)=2.0 + endif + RDXZB(i) = 0.0 + enddo + +!--- calculate scale-aware tapering factors + do i=1,im + if ( dx(i) .ge. dxmax_ls ) then + ls_taper(i) = 1. + else + if ( dx(i) .le. dxmin_ls) then + ls_taper(i) = 0. + else + ls_taper(i) = 0.5 * ( SIN(pi*(dx(i)-0.5*(dxmax_ls+dxmin_ls))/ & + (dxmax_ls-dxmin_ls)) + 1. ) + endif + endif + enddo + + ! Remove ss_tapering + ss_taper(:) = 1. + + ! SPP, if spp_gwd is 0, no perturbations are applied. + if ( spp_gwd==1 ) then + do i = its,im + var_stoch(i) = var(i) + var(i)*0.75*spp_wts_gwd(i,1) + varss_stoch(i) = varss(i) + varss(i)*0.75*spp_wts_gwd(i,1) + varmax_ss_stoch(i) = varmax_ss + varmax_ss*0.75*spp_wts_gwd(i,1) + varmax_fd_stoch(i) = varmax_fd + varmax_fd*0.75*spp_wts_gwd(i,1) + enddo + else + do i = its,im + var_stoch(i) = var(i) + varss_stoch(i) = varss(i) + varmax_ss_stoch(i) = varmax_ss + varmax_fd_stoch(i) = varmax_fd + enddo + endif + + !--- calculate length of grid for flow-blocking drag + ! + do i=1,im + delx = dx(i) + dely = dx(i) + dxy4(i,1) = delx + dxy4(i,2) = dely + dxy4(i,3) = sqrt(delx*delx + dely*dely) + dxy4(i,4) = dxy4(i,3) + dxy4p(i,1) = dxy4(i,2) + dxy4p(i,2) = dxy4(i,1) + dxy4p(i,3) = dxy4(i,4) + dxy4p(i,4) = dxy4(i,3) + cleff(i) = psl_gwd_dx_factor*(delx+dely)*0.5 + cleff_ss(i) = 0.1 * max(dxmax_ss,dxy4(i,3)) + ! cleff_ss(i) = cleff(i) ! consider ..... + enddo +! +!-----initialize arrays +! + dtaux = 0.0 + dtauy = 0.0 + do i = its,im + klowtop(i) = 0 + kbl(i) = 0 + enddo +! + do i = its,im + xn(i) = 0.0 + yn(i) = 0.0 + ubar (i) = 0.0 + vbar (i) = 0.0 + roll (i) = 0.0 + taub (i) = 0.0 + oa(i) = 0.0 + ol(i) = 0.0 + oc(i) = 0.0 + oass(i) = 0.0 + olss(i) = 0.0 + ulow (i) = 0.0 + rstoch(i) = 0.0 + ldrag(i) = .false. + icrilv(i) = .false. + enddo + + do k = kts,km + do i = its,im + usqj(i,k) = 0.0 + bnv2(i,k) = 0.0 + vtj(i,k) = 0.0 + vtk(i,k) = 0.0 + taup(i,k) = 0.0 + taud_ls(i,k) = 0.0 + taud_bl(i,k) = 0.0 + dtaux2d(i,k) = 0.0 + dtauy2d(i,k) = 0.0 + dtfac(i,k) = 1.0 + enddo + enddo +! + if ( ldiag_ugwp ) then + do i = its,im + dusfc_ls(i) = 0.0 + dvsfc_ls(i) = 0.0 + dusfc_bl(i) = 0.0 + dvsfc_bl(i) = 0.0 + dusfc_ss(i) = 0.0 + dvsfc_ss(i) = 0.0 + dusfc_fd(i) = 0.0 + dvsfc_fd(i) = 0.0 + enddo + do k = kts,km + do i = its,im + dtaux2d_ls(i,k)= 0.0 + dtauy2d_ls(i,k)= 0.0 + dtaux2d_bl(i,k)= 0.0 + dtauy2d_bl(i,k)= 0.0 + dtaux2d_ss(i,k)= 0.0 + dtauy2d_ss(i,k)= 0.0 + dtaux2d_fd(i,k)= 0.0 + dtauy2d_fd(i,k)= 0.0 + enddo + enddo + endif + + do i = its,im + taup(i,km+1) = 0.0 + xlinv(i) = 1.0/xl + dusfc(i) = 0.0 + dvsfc(i) = 0.0 + enddo +! +! initialize array for flow-blocking drag +! + taufb(1:im,1:km+1) = 0.0 + hmax(1:im) = 0.0 + komax(1:im) = 0 + kbmax(1:im) = 0 + kblk(1:im) = 0 +! + rd_inv = 1./rd + do k = kts,km + do i = its,im + vtj(i,k) = t1(i,k) * (1.+fv*q1(i,k)) + vtk(i,k) = vtj(i,k) / prslk(i,k) + ro(i,k) = rd_inv * prsl(i,k) / vtj(i,k) ! density kg/m**3 + enddo + enddo +! +! calculate mid-layer height (zl), interface height (zq), and layer depth (dz2). +! + !zq=0. + do k = kts,km + do i = its,im + !zq(i,k+1) = PHII(i,k+1)*g_inv + !dz2(i,k) = (PHII(i,k+1)-PHII(i,k))*g_inv + zl(i,k) = PHIL(i,k)*g_inv + enddo + enddo +! +! determine reference level: maximum of 2*var and pbl heights +! + do i = its,im + if(vtype(i)==15) then + zlowtop(i) = 1.0 * var_stoch(i) !!! reduce drag over land ice + else + zlowtop(i) = 2.0 * var_stoch(i) + endif + enddo +! + do i = its,im + flag(i) = .true. + enddo +! + do k = kts+1,km + do i = its,im + if(flag(i).and.zl(i,k).ge.zlowtop(i)) then + klowtop(i) = k+1 + flag(i) = .false. + endif + enddo + enddo +! +! determine the maximum height level +! note taht elvmax and zl are the heights from the model surface whereas +! oro (mean orography) is the height from the sea level +! + do i = its,im + flag(i) = .true. + enddo +! + do k = kts+1,km + do i = its,im + if(flag(i).and.zl(i,k).ge.elvmax(i)) then + komax(i) = k+1 + flag(i) = .false. + endif + enddo + enddo +! +! determine the launching level in determining blocking layer +! + do i = its,im + flag(i) = .true. + enddo +! + do k = kts+1,km + do i = its,im + if(flag(i).and.zl(i,k).ge.elvmax(i)+zlowtop(i)) then + kbmax(i) = k+1 + flag(i) = .false. + endif + enddo + enddo +! +! determing the reference level for gwd and blockding... +! + do i = its,im + hmax(i) = max(elvmax(i),zlowtop(i)) + enddo +! + do i = its,im +!!! kbl(i) = max(kpbl(i), klowtop(i)) ! do not use pbl height for the time being... + kbl(i) = max(komax(i), klowtop(i)) + kbl(i) = max(min(kbl(i),kpblmax),kpblmin) + enddo +! +! compute low level averages below reference level +! + do i = its,im + delks(i) = 1.0 / (prsi(i,1) - prsi(i,kbl(i))) + delks1(i) = 1.0 / (prsl(i,1) - prsl(i,kbl(i))) + enddo + do k = kts,kpblmax + do i = its,im + if (k.lt.kbl(i)) then + rcsks = rcs * del(i,k) * delks(i) + rdelks = del(i,k) * delks(i) + ubar(i) = ubar(i) + rcsks * u1(i,k) ! pbl u mean + vbar(i) = vbar(i) + rcsks * v1(i,k) ! pbl v mean + roll(i) = roll(i) + rdelks * ro(i,k) ! ro mean + endif + enddo + enddo +! +! figure out low-level horizontal wind direction +! +! nwd 1 2 3 4 5 6 7 8 +! wd w s sw nw e n ne se +! + do i = its,im + wdir = atan2(ubar(i),vbar(i)) + pi + idir = mod(nint(fdir*wdir),mdir) + 1 + nwd = nwdir(idir) + oa(i) = (1-2*int( (nwd-1)/4 )) * oa4(i,mod(nwd-1,4)+1) + ol(i) = max(ol4(i,mod(nwd-1,4)+1),olmin) + oc(i) = min(max(oc1(i),oc_min),oc_max) +! if (var(i).le.var_min) then +! oc(i) = max(oc(i)*var(i)/var_min,oc_min) +! endif + ! Repeat for small-scale gwd + oass(i) = (1-2*int( (nwd-1)/4 )) * oa4ss(i,mod(nwd-1,4)+1) + olss(i) = ol4ss(i,mod(nwd-1,4)+1) + +! +!----- compute orographic width along (ol) and perpendicular (olp) +!----- the direction of wind +! + ol4p(1) = ol4(i,2) + ol4p(2) = ol4(i,1) + ol4p(3) = ol4(i,4) + ol4p(4) = ol4(i,3) + olp(i) = max(ol4p(mod(nwd-1,4)+1),olmin) +! +!----- compute orographic direction (horizontal orographic aspect ratio) +! + od(i) = olp(i)/ol(i) + od(i) = min(od(i),odmax) + od(i) = max(od(i),odmin) +! +!----- compute length of grid in the along(dxy) and cross(dxyp) wind directions +! + dxy(i) = dxy4(i,MOD(nwd-1,4)+1) + dxyp(i) = dxy4p(i,MOD(nwd-1,4)+1) + enddo +! +! END INITIALIZATION; BEGIN GWD CALCULATIONS: +! +IF ( (do_gsl_drag_ls_bl).and. & + ((gwd_opt_ls .EQ. 1).or.(gwd_opt_bl .EQ. 1)) ) then + + g_cp = g/cp + do i=its,im + + if ( ls_taper(i).GT.1.E-02 ) then + +! +!--- saving richardson number in usqj for migwdi +! + do k = kts,km-1 + ti = 2.0 / (t1(i,k)+t1(i,k+1)) + rdz = 1./(zl(i,k+1) - zl(i,k)) + tem1 = u1(i,k) - u1(i,k+1) + tem2 = v1(i,k) - v1(i,k+1) + dw2 = rcl*(tem1*tem1 + tem2*tem2) + shr2 = max(dw2,dw2min) * rdz * rdz + bvf2 = g*(g_cp+rdz*(vtj(i,k+1)-vtj(i,k))) * ti + usqj(i,k) = max(bvf2/shr2,rimin) + bnv2(i,k) = 2.0*g*rdz*(vtk(i,k+1)-vtk(i,k))/(vtk(i,k+1)+vtk(i,k)) + bnv2(i,k) = max( bnv2(i,k), bnv2min ) + enddo +! +!----compute the "low level" or 1/3 wind magnitude (m/s) +! + ulow(i) = max(sqrt(ubar(i)*ubar(i) + vbar(i)*vbar(i)), 1.0) + rulow(i) = 1./ulow(i) +! + do k = kts,km-1 + velco(i,k) = (0.5*rcs) * ((u1(i,k)+u1(i,k+1)) * ubar(i) & + + (v1(i,k)+v1(i,k+1)) * vbar(i)) + velco(i,k) = velco(i,k) * rulow(i) + if ((velco(i,k).lt.veleps) .and. (velco(i,k).gt.0.)) then + velco(i,k) = veleps + endif + enddo +! +! no drag when sub-oro is too small.. +! + ldrag(i) = hmax(i).le.hmt_min +! +! no drag when critical level in the base layer +! + ldrag(i) = ldrag(i).or. velco(i,1).le.0. +! +! no drag when velco.lt.0 +! + do k = kpblmin,kpblmax + if (k .lt. kbl(i)) ldrag(i) = ldrag(i).or. velco(i,k).le.0. + enddo +! +! no drag when bnv2.lt.0 +! + do k = kts,kpblmax + if (k .lt. kbl(i)) ldrag(i) = ldrag(i).or. bnv2(i,k).lt.0. + enddo +! +!-----the low level weighted average ri is stored in usqj(1,1; im) +!-----the low level weighted average n**2 is stored in bnv2(1,1; im) +!---- this is called bnvl2 in phys_gwd_alpert_sub not bnv2 +!---- rdelks (del(k)/delks) vert ave factor so we can * instead of / +! + wtkbj = (prsl(i,1)-prsl(i,2)) * delks1(i) + bnv2(i,1) = wtkbj * bnv2(i,1) + usqj(i,1) = wtkbj * usqj(i,1) +! + do k = kpblmin,kpblmax + if (k .lt. kbl(i)) then + rdelks = (prsl(i,k)-prsl(i,k+1)) * delks1(i) + bnv2(i,1) = bnv2(i,1) + bnv2(i,k) * rdelks + usqj(i,1) = usqj(i,1) + usqj(i,k) * rdelks + endif + enddo +! + ldrag(i) = ldrag(i) .or. bnv2(i,1).le.0.0 + ldrag(i) = ldrag(i) .or. ulow(i).eq.1.0 + ldrag(i) = ldrag(i) .or. var_stoch(i) .le. 0.0 + ldrag(i) = ldrag(i) .or. xland(i) .gt. 1.5 +! +! set all ri low level values to the low level value +! + do k = kpblmin,kpblmax + if (k .lt. kbl(i)) usqj(i,k) = usqj(i,1) + enddo +! + if (.not.ldrag(i)) then + bnv(i) = sqrt( bnv2(i,1) ) + fr(i) = bnv(i) * rulow(i) * 2. * var_stoch(i) * od(i) + fr(i) = min(fr(i),frmax) + xn(i) = ubar(i) * rulow(i) + yn(i) = vbar(i) * rulow(i) + endif +! +! compute the base level stress and store it in taub +! calculate enhancement factor, number of mountains & aspect +! ratio const. use simplified relationship between standard +! deviation & critical hgt + + if (.not. ldrag(i)) then + efact = (oa(i) + 2.) ** (ce*fr(i)/frc) + efact = min( max(efact,efmin), efmax ) + coefm(i) = (1. + ol(i)) ** (oa(i)+1.) + xlinv(i) = coefm(i) / cleff(i) + tem = fr(i) * fr(i) * oc(i) + gfobnv = gmax * tem / ((tem + cg)*bnv(i)) + if ( gwd_opt_ls .NE. 0 ) then + taub(i) = xlinv(i) * roll(i) * ulow(i) * ulow(i) & + * ulow(i) * gfobnv * efact + else ! We've gotten what we need for the blocking scheme + taub(i) = 0.0 + end if + else + taub(i) = 0.0 + xn(i) = 0.0 + yn(i) = 0.0 + endif + + endif ! (ls_taper(i).GT.1.E-02) + + enddo ! do i=its,im + +ENDIF ! (do_gsl_drag_ls_bl).and.((gwd_opt_ls .EQ. 1).or.(gwd_opt_bl .EQ. 1)) + +!========================================================= +! add small-scale wavedrag for stable boundary layer +!========================================================= + XNBV=0. + tauwavex0=0. + tauwavey0=0. + density=1.2 + utendwave=0. + vtendwave=0. +! +IF ( do_gsl_drag_ss ) THEN + + do i=its,im + + if ( ss_taper(i).GT.1.E-02 ) then + ! + ! calculating potential temperature + ! + do k = kts,km + thx(i,k) = t1(i,k)/prslk(i,k) + enddo + ! + do k = kts,km + tvcon = (1.+fv*q1(i,k)) + thvx(i,k) = thx(i,k)*tvcon + enddo + + hpbl2 = hpbl(i)+10. + kpbl2 = kpbl(i) + !kvar = MIN(kpbl, k-level of var) + kvar = 1 + do k=kts+1,MAX(kpbl(i),kts+1) +! IF (zl(i,k)>2.*var(i) .or. zl(i,k)>2*varmax) then + IF (zl(i,k)>300.) then + kpbl2 = k + IF (k == kpbl(i)) then + hpbl2 = hpbl(i)+10. + ELSE + hpbl2 = zl(i,k)+10. + ENDIF + exit + ENDIF + enddo + if((xland(i)-1.5).le.0. .and. 2.*varss_stoch(i).le.hpbl(i))then + if(br1(i).gt.0. .and. thvx(i,kpbl2)-thvx(i,kts) > 0.)then + coefm_ss(i) = (1. + olss(i)) ** (oass(i)+1.) + xlinv(i) = coefm_ss(i) / cleff_ss(i) + !govrth(i)=g/(0.5*(thvx(i,kpbl(i))+thvx(i,kts))) + govrth(i)=g/(0.5*(thvx(i,kpbl2)+thvx(i,kts))) + !XNBV=sqrt(govrth(i)*(thvx(i,kpbl(i))-thvx(i,kts))/hpbl(i)) + XNBV=sqrt(govrth(i)*(thvx(i,kpbl2)-thvx(i,kts))/hpbl2) +! + !if(abs(XNBV/u1(i,kpbl(i))).gt.xlinv(i))then + if(abs(XNBV/u1(i,kpbl2)).gt.xlinv(i))then + !tauwavex0=0.5*XNBV*xlinv(i)*(2*MIN(varss(i),75.))**2*ro(i,kts)*u1(i,kpbl(i)) + !tauwavex0=0.5*XNBV*xlinv(i)*(2.*MIN(varss(i),40.))**2*ro(i,kts)*u1(i,kpbl2) + !tauwavex0=0.5*XNBV*xlinv(i)*(2.*MIN(varss(i),40.))**2*ro(i,kts)*u1(i,3) + ! Remove limit on varss_stoch + var_temp = varss_stoch(i) + ! Note: This is a semi-implicit treatment of the time differencing + var_temp2 = 0.5*XNBV*xlinv(i)*(2.*var_temp)**2*ro(i,kvar) ! this is greater than zero + tauwavex0=var_temp2*u1(i,kvar)/(1.+var_temp2*deltim) + tauwavex0=tauwavex0*ss_taper(i) + else + tauwavex0=0. + endif +! + !if(abs(XNBV/v1(i,kpbl(i))).gt.xlinv(i))then + if(abs(XNBV/v1(i,kpbl2)).gt.xlinv(i))then + !tauwavey0=0.5*XNBV*xlinv(i)*(2*MIN(varss(i),75.))**2*ro(i,kts)*v1(i,kpbl(i)) + !tauwavey0=0.5*XNBV*xlinv(i)*(2.*MIN(varss(i),40.))**2*ro(i,kts)*v1(i,kpbl2) + !tauwavey0=0.5*XNBV*xlinv(i)*(2.*MIN(varss(i),40.))**2*ro(i,kts)*v1(i,3) + ! Remove limit on varss_stoch + var_temp = varss_stoch(i) + ! Note: This is a semi-implicit treatment of the time differencing + var_temp2 = 0.5*XNBV*xlinv(i)*(2.*var_temp)**2*ro(i,kvar) ! this is greater than zero + tauwavey0=var_temp2*v1(i,kvar)/(1.+var_temp2*deltim) + tauwavey0=tauwavey0*ss_taper(i) + else + tauwavey0=0. + endif + + do k=kts,kpbl(i) !MIN(kpbl2+1,km-1) +!original + !utendwave(i,k)=-1.*tauwavex0*2.*max((1.-zl(i,k)/hpbl(i)),0.)/hpbl(i) + !vtendwave(i,k)=-1.*tauwavey0*2.*max((1.-zl(i,k)/hpbl(i)),0.)/hpbl(i) +!new + utendwave(i,k)=-1.*tauwavex0*2.*max((1.-zl(i,k)/hpbl2),0.)/hpbl2 + vtendwave(i,k)=-1.*tauwavey0*2.*max((1.-zl(i,k)/hpbl2),0.)/hpbl2 +!mod-to be used in HRRRv3/RAPv4 + !utendwave(i,k)=-1.*tauwavex0 * max((1.-zl(i,k)/hpbl2),0.)**2 + !vtendwave(i,k)=-1.*tauwavey0 * max((1.-zl(i,k)/hpbl2),0.)**2 + enddo + endif + endif + + do k = kts,km + dudt(i,k) = dudt(i,k) + utendwave(i,k) + dvdt(i,k) = dvdt(i,k) + vtendwave(i,k) + dusfc(i) = dusfc(i) + utendwave(i,k) * del(i,k) + dvsfc(i) = dvsfc(i) + vtendwave(i,k) * del(i,k) + enddo + if(udtend>0) then + dtend(i,kts:km,udtend) = dtend(i,kts:km,udtend) + utendwave(i,kts:km)*deltim + endif + if(vdtend>0) then + dtend(i,kts:km,vdtend) = dtend(i,kts:km,vdtend) + vtendwave(i,kts:km)*deltim + endif + if ( ldiag_ugwp ) then + do k = kts,km + dusfc_ss(i) = dusfc_ss(i) + utendwave(i,k) * del(i,k) + dvsfc_ss(i) = dvsfc_ss(i) + vtendwave(i,k) * del(i,k) + dtaux2d_ss(i,k) = utendwave(i,k) + dtauy2d_ss(i,k) = vtendwave(i,k) + enddo + endif + + endif ! if (ss_taper(i).GT.1.E-02) + + enddo ! i=its,im + +ENDIF ! if (do_gsl_drag_ss) + +!================================================================ +! Topographic Form Drag from Beljaars et al. (2004, QJRMS, equ. 16): +!================================================================ +IF ( do_gsl_drag_tofd ) THEN + + do i=its,im + + if ( ss_taper(i).GT.1.E-02 ) then + + utendform=0. + vtendform=0. + + IF ((xland(i)-1.5) .le. 0.) then + !(IH*kflt**n1)**-1 = (0.00102*0.00035**-1.9)**-1 = 0.00026615161 + ! Remove limit on varss_stoch + var_temp = varss_stoch(i) + !var_temp = MIN(var_temp, 250.) + a1=0.00026615161*var_temp**2 +! a1=0.00026615161*MIN(varss(i),varmax)**2 +! a1=0.00026615161*(0.5*varss(i))**2 + ! k1**(n1-n2) = 0.003**(-1.9 - -2.8) = 0.003**0.9 = 0.005363 + a2=a1*0.005363 + ! Beljaars H_efold + H_efold = 1500. + DO k=kts,km + wsp=SQRT(u1(i,k)**2 + v1(i,k)**2) + ! Note: In Beljaars et al. (2004): + ! alpha_fd*beta*Cmd*Ccorr*2.109 = 12.*1.*0.005*0.6*2.109 = 0.0759 + ! lump beta*Cmd*Ccorr*2.109 into 1.*0.005*0.6*2.109 = coeff_fd ~ 6.325e-3_kind_phys + var_temp = alpha_fd*coeff_fd*EXP(-(zl(i,k)/H_efold)**1.5)*a2* & + zl(i,k)**(-1.2)*ss_taper(i) ! this is greater than zero + ! Note: This is a semi-implicit treatment of the time differencing + ! per Beljaars et al. (2004, QJRMS) + utendform(i,k) = - var_temp*wsp*u1(i,k)/(1. + var_temp*deltim*wsp) + vtendform(i,k) = - var_temp*wsp*v1(i,k)/(1. + var_temp*deltim*wsp) + !IF(zl(i,k) > 4000.) exit + ENDDO + ENDIF + + do k = kts,km + dudt(i,k) = dudt(i,k) + utendform(i,k) + dvdt(i,k) = dvdt(i,k) + vtendform(i,k) + dusfc(i) = dusfc(i) + utendform(i,k) * del(i,k) + dvsfc(i) = dvsfc(i) + vtendform(i,k) * del(i,k) + enddo + if(udtend>0) then + dtend(i,kts:km,udtend) = dtend(i,kts:km,udtend) + utendform(i,kts:km)*deltim + endif + if(vdtend>0) then + dtend(i,kts:km,vdtend) = dtend(i,kts:km,vdtend) + vtendform(i,kts:km)*deltim + endif + if ( ldiag_ugwp ) then + do k = kts,km + dtaux2d_fd(i,k) = utendform(i,k) + dtauy2d_fd(i,k) = vtendform(i,k) + dusfc_fd(i) = dusfc_fd(i) + utendform(i,k) * del(i,k) + dvsfc_fd(i) = dvsfc_fd(i) + vtendform(i,k) * del(i,k) + enddo + endif + + endif ! if (ss_taper(i).GT.1.E-02) + + enddo ! i=its,im + +ENDIF ! if (do_gsl_drag_tofd) +!======================================================= +! More for the large-scale gwd component +IF ( (do_gsl_drag_ls_bl).and.(gwd_opt_ls .EQ. 1) ) THEN + + do i=its,im + + if ( ls_taper(i).GT.1.E-02 ) then + +! +! now compute vertical structure of the stress. + do k = kts,kpblmax + if (k .le. kbl(i)) taup(i,k) = taub(i) + enddo +! + do k = kpblmin, km-1 ! vertical level k loop! + kp1 = k + 1 +! +! unstablelayer if ri < ric +! unstable layer if upper air vel comp along surf vel <=0 (crit lay) +! at (u-c)=0. crit layer exists and bit vector should be set (.le.) +! + if (k .ge. kbl(i)) then + icrilv(i) = icrilv(i) .or. ( usqj(i,k) .lt. ric) & + .or. (velco(i,k) .le. 0.0) + brvf(i) = max(bnv2(i,k),bnv2min) ! brunt-vaisala frequency squared + brvf(i) = sqrt(brvf(i)) ! brunt-vaisala frequency + endif +! + if (k .ge. kbl(i) .and. (.not. ldrag(i))) then + if (.not.icrilv(i) .and. taup(i,k) .gt. 0.0 ) then + temv = 1.0 / velco(i,k) + tem1 = coefm(i)/dxy(i)*(ro(i,kp1)+ro(i,k))*brvf(i)* & + velco(i,k)*0.5 + hd = sqrt(taup(i,k) / tem1) + fro = brvf(i) * hd * temv +! +! rim is the minimum-richardson number by shutts (1985) + tem2 = sqrt(usqj(i,k)) + tem = 1. + tem2 * fro + rim = usqj(i,k) * (1.-fro) / (tem * tem) +! +! check stability to employ the 'saturation hypothesis' +! of lindzen (1981) except at tropospheric downstream regions +! + if (rim .le. ric) then ! saturation hypothesis! + temc = 2.0 + 1.0 / tem2 + hd = velco(i,k) * (2.*sqrt(temc)-temc) / brvf(i) + taup(i,kp1) = tem1 * hd * hd + else ! no wavebreaking! + taup(i,kp1) = taup(i,k) + endif + endif + endif + enddo +! + if(lcap.lt.km) then + do klcap = lcapp1,km + taup(i,klcap) = prsi(i,klcap) / prsi(i,lcap) * taup(i,lcap) + enddo + endif + + endif ! if ( ls_taper(i).GT.1.E-02 ) + + enddo ! do i=its,im + +ENDIF ! (do_gsl_drag_ls_bl).and.(gwd_opt_ls .EQ. 1) +!=============================================================== +!COMPUTE BLOCKING COMPONENT +!=============================================================== +IF ( (do_gsl_drag_ls_bl) .and. (gwd_opt_bl .EQ. 1) ) THEN + do i = its,im + flag(i) = .true. + enddo + + do i=its,im + + if ( ls_taper(i).GT.1.E-02 ) then + + if (.not.ldrag(i)) then +! +!------- determine the height of flow-blocking layer +! + pe = 0.0 + ke = 0.0 + do k = km, kpblmin, -1 + if(flag(i).and. k.le.kbmax(i)) then + pe = pe + bnv2(i,k)*(zl(i,kbmax(i))-zl(i,k))* & + del(i,k)*g_inv/ro(i,k) + ke = 0.5*((rcs*u1(i,k))**2.+(rcs*v1(i,k))**2.) +! +!---------- apply flow-blocking drag when pe >= ke +! + if(pe.ge.ke.and.zl(i,k).le.hmax(i)) then + kblk(i)= k + zblk = zl(i,k) + RDXZB(i) = real(k,kind=kind_phys) + flag(i) = .false. + endif + endif + enddo + if(.not.flag(i)) then +! +!--------- compute flow-blocking stress +! + cd = max(2.0-1.0/od(i),cdmin) + taufb(i,kts) = 0.5 * roll(i) * coefm(i) / & + max(dxmax_ls,dxy(i))**2 * cd * dxyp(i) * & + olp(i) * zblk * ulow(i)**2 + tautem = taufb(i,kts)/float(kblk(i)-kts) + do k = kts+1, kpblmax + if (k .le. kblk(i)) taufb(i,k) = taufb(i,k-1) - tautem + enddo +! +! reset gwd stress below blocking layer +! + do k = kts,kpblmax + if (k .le. kblk(i)) taup(i,k) = taup(i,kblk(i)) + enddo +! if(kblk(i).gt.5) print *,' gwd kbl komax kbmax kblk ',kbl(i),komax(i),kbmax(i),kblk(i) +! if(kblk(i).gt.5) print *,' gwd elvmax zlowtop zblk ',elvmax(i),zlowtop(i),zl(i,kblk(i)) + endif + + endif ! if (.not.ldrag(i)) + + endif ! if ( ls_taper(i).GT.1.E-02 ) + + enddo ! do i=its,im + +ENDIF ! IF ( (do_gsl_drag_ls_bl) .and. (gwd_opt_bl .EQ. 1) ) +!=========================================================== +IF ( (do_gsl_drag_ls_bl) .and. & + (gwd_opt_ls .EQ. 1 .OR. gwd_opt_bl .EQ. 1) ) THEN + + do i=its,im + + if ( ls_taper(i) .GT. 1.E-02 ) then + +! +! calculate - (g)*d(tau)/d(pressure) and deceleration terms dtaux, dtauy +! + do k = kts,km + taud_ls(i,k) = 1. * (taup(i,k+1) - taup(i,k)) * csg / del(i,k) + taud_bl(i,k) = 1. * (taufb(i,k+1) - taufb(i,k)) * csg / del(i,k) + enddo +! +! limit de-acceleration (momentum deposition ) at top to 1/2 value +! the idea is some stuff must go out the 'top' + do klcap = lcap,km + taud_ls(i,klcap) = taud_ls(i,klcap) * factop + taud_bl(i,klcap) = taud_bl(i,klcap) * factop + enddo +! +! if the gravity wave drag would force a critical line +! in the lower ksmm1 layers during the next deltim timestep, +! then only apply drag until that critical line is reached. +! + do k = kts,kpblmax-1 + if ((taud_ls(i,k)+taud_bl(i,k)).ne.0.) then + dtfac(i,k) = min(dtfac(i,k),abs(velco(i,k) & + /(deltim*rcs*(taud_ls(i,k)+taud_bl(i,k))))) + endif + enddo +! apply limiter to mesosphere drag, reduce the drag by density factor 10-3 +! prevent wind reversal... +! + do k = kpblmax,km-1 + if ((taud_ls(i,k)+taud_bl(i,k)).ne.0..and.prsl(i,k).le.pcutoff) then + denfac = min(ro(i,k)/pcutoff_den,1.) + dtfac(i,k) = min(dtfac(i,k),denfac*abs(velco(i,k) & + /(deltim*rcs*(taud_ls(i,k)+taud_bl(i,k))))) + endif + enddo +! + do k = kts,km + taud_ls(i,k) = taud_ls(i,k)*dtfac(i,k)* ls_taper(i) *(1.-rstoch(i)) + taud_bl(i,k) = taud_bl(i,k)*dtfac(i,k)* ls_taper(i) *(1.-rstoch(i)) + dtaux = taud_ls(i,k) * xn(i) + dtauy = taud_ls(i,k) * yn(i) + dtauxb = taud_bl(i,k) * xn(i) + dtauyb = taud_bl(i,k) * yn(i) + + !add blocking and large-scale contributions to tendencies + dudt(i,k) = dtaux + dtauxb + dudt(i,k) + dvdt(i,k) = dtauy + dtauyb + dvdt(i,k) + + if ( gsd_diss_ht_opt .EQ. 1 ) then + ! Calculate dissipation heating + ! Initial kinetic energy (at t0-dt) + eng0 = 0.5*( (rcs*u1(i,k))**2. + (rcs*v1(i,k))**2. ) + ! Kinetic energy after wave-breaking/flow-blocking + eng1 = 0.5*( (rcs*(u1(i,k)+(dtaux+dtauxb)*deltim))**2 + & + (rcs*(v1(i,k)+(dtauy+dtauyb)*deltim))**2 ) + ! Modify theta tendency + dtdt(i,k) = dtdt(i,k) + max((eng0-eng1),0.0)/cp/deltim + if ( Tdtend>0 ) then + dtend(i,k,Tdtend) = dtend(i,k,Tdtend) + max((eng0-eng1),0.0)/cp + endif + endif + + dusfc(i) = dusfc(i) + taud_ls(i,k)*xn(i)*del(i,k) + & + taud_bl(i,k)*xn(i)*del(i,k) + dvsfc(i) = dvsfc(i) + taud_ls(i,k)*yn(i)*del(i,k) + & + taud_bl(i,k)*yn(i)*del(i,k) + if(udtend>0) then + dtend(i,k,udtend) = dtend(i,k,udtend) + (taud_ls(i,k) * & + xn(i) + taud_bl(i,k) * xn(i)) * deltim + endif + if(vdtend>0) then + dtend(i,k,vdtend) = dtend(i,k,vdtend) + (taud_ls(i,k) * & + yn(i) + taud_bl(i,k) * yn(i)) * deltim + endif + + enddo + + ! Finalize dusfc and dvsfc diagnostics + dusfc(i) = -(invgrcs) * dusfc(i) + dvsfc(i) = -(invgrcs) * dvsfc(i) + + if ( ldiag_ugwp ) then + do k = kts,km + dtaux2d_ls(i,k) = taud_ls(i,k) * xn(i) + dtauy2d_ls(i,k) = taud_ls(i,k) * yn(i) + dtaux2d_bl(i,k) = taud_bl(i,k) * xn(i) + dtauy2d_bl(i,k) = taud_bl(i,k) * yn(i) + dusfc_ls(i) = dusfc_ls(i) + dtaux2d_ls(i,k) * del(i,k) + dvsfc_ls(i) = dvsfc_ls(i) + dtauy2d_ls(i,k) * del(i,k) + dusfc_bl(i) = dusfc_bl(i) + dtaux2d_bl(i,k) * del(i,k) + dvsfc_bl(i) = dvsfc_bl(i) + dtauy2d_bl(i,k) * del(i,k) + enddo + endif + + endif ! if ( ls_taper(i) .GT. 1.E-02 ) + + enddo ! do i=its,im + +ENDIF ! (do_gsl_drag_ls_bl).and.(gwd_opt_ls.EQ.1 .OR. gwd_opt_bl.EQ.1) + +if ( ldiag_ugwp ) then + ! Finalize dusfc and dvsfc diagnostics + do i = its,im + dusfc_ls(i) = -(invgrcs) * dusfc_ls(i) + dvsfc_ls(i) = -(invgrcs) * dvsfc_ls(i) + dusfc_bl(i) = -(invgrcs) * dusfc_bl(i) + dvsfc_bl(i) = -(invgrcs) * dvsfc_bl(i) + dusfc_ss(i) = -(invgrcs) * dusfc_ss(i) + dvsfc_ss(i) = -(invgrcs) * dvsfc_ss(i) + dusfc_fd(i) = -(invgrcs) * dusfc_fd(i) + dvsfc_fd(i) = -(invgrcs) * dvsfc_fd(i) + enddo +endif +! + return + end subroutine drag_suite_psl ! !> @} diff --git a/physics/drag_suite.meta b/physics/GWD/drag_suite.meta similarity index 96% rename from physics/drag_suite.meta rename to physics/GWD/drag_suite.meta index 66f320b98..5413a5482 100644 --- a/physics/drag_suite.meta +++ b/physics/GWD/drag_suite.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = drag_suite type = scheme - dependencies = + dependencies = ../hooks/machine.F ######################################################################## [ccpp-arg-table] @@ -214,6 +214,7 @@ type = real kind = kind_phys intent = in + optional = True [oc1ss] standard_name = convexity_of_subgrid_orography_small_scale long_name = convexity of subgrid height_above_mean_sea_level small scale @@ -222,6 +223,7 @@ type = real kind = kind_phys intent = in + optional = True [oa4ss] standard_name = asymmetry_of_subgrid_orography_small_scale long_name = asymmetry of subgrid height_above_mean_sea_level small scale @@ -230,6 +232,7 @@ type = real kind = kind_phys intent = in + optional = True [ol4ss] standard_name = fraction_of_grid_box_with_subgrid_orography_higher_than_critical_height_small_scale long_name = horizontal fraction of grid box covered by subgrid height_above_mean_sea_level higher than critical height small scale @@ -238,6 +241,7 @@ type = real kind = kind_phys intent = in + optional = True [theta] standard_name = angle_from_east_of_maximum_subgrid_orographic_variations long_name = angle with respect to east of maximum subgrid orographic variations @@ -278,6 +282,7 @@ type = real kind = kind_phys intent = inout + optional = True [dtauy2d_ms] standard_name = tendency_of_y_wind_due_to_mesoscale_orographic_gravity_wave_drag long_name = y wind tendency from mesoscale gwd @@ -286,6 +291,7 @@ type = real kind = kind_phys intent = inout + optional = True [dtaux2d_bl] standard_name = tendency_of_x_wind_due_to_blocking_drag long_name = x wind tendency from blocking drag @@ -294,6 +300,7 @@ type = real kind = kind_phys intent = inout + optional = True [dtauy2d_bl] standard_name = tendency_of_y_wind_due_to_blocking_drag long_name = y wind tendency from blocking drag @@ -302,6 +309,7 @@ type = real kind = kind_phys intent = inout + optional = True [dtaux2d_ss] standard_name = tendency_of_x_wind_due_to_small_scale_gravity_wave_drag long_name = x wind tendency from small scale gwd @@ -310,6 +318,7 @@ type = real kind = kind_phys intent = inout + optional = True [dtauy2d_ss] standard_name = tendency_of_y_wind_due_to_small_scale_gravity_wave_drag long_name = y wind tendency from small scale gwd @@ -318,6 +327,7 @@ type = real kind = kind_phys intent = inout + optional = True [dtaux2d_fd] standard_name = tendency_of_x_wind_due_to_form_drag long_name = x wind tendency from form drag @@ -326,6 +336,7 @@ type = real kind = kind_phys intent = inout + optional = True [dtauy2d_fd] standard_name = tendency_of_y_wind_due_to_form_drag long_name = y wind tendency from form drag @@ -334,6 +345,7 @@ type = real kind = kind_phys intent = inout + optional = True [dusfc] standard_name = instantaneous_x_stress_due_to_gravity_wave_drag long_name = zonal surface stress due to orographic gravity wave drag @@ -358,6 +370,7 @@ type = real kind = kind_phys intent = inout + optional = True [dvsfc_ms] standard_name = vertically_integrated_y_momentum_flux_due_to_mesoscale_orographic_gravity_wave_drag long_name = integrated y momentum flux from mesoscale gwd @@ -366,6 +379,7 @@ type = real kind = kind_phys intent = inout + optional = True [dusfc_bl] standard_name = vertically_integrated_x_momentum_flux_due_to_blocking_drag long_name = integrated x momentum flux from blocking drag @@ -374,6 +388,7 @@ type = real kind = kind_phys intent = inout + optional = True [dvsfc_bl] standard_name = vertically_integrated_y_momentum_flux_due_to_blocking_drag long_name = integrated y momentum flux from blocking drag @@ -382,6 +397,7 @@ type = real kind = kind_phys intent = inout + optional = True [dusfc_ss] standard_name = vertically_integrated_x_momentum_flux_due_to_small_scale_gravity_wave_drag long_name = integrated x momentum flux from small scale gwd @@ -390,6 +406,7 @@ type = real kind = kind_phys intent = inout + optional = True [dvsfc_ss] standard_name = vertically_integrated_y_momentum_flux_due_to_small_scale_gravity_wave_drag long_name = integrated y momentum flux from small scale gwd @@ -398,6 +415,7 @@ type = real kind = kind_phys intent = inout + optional = True [dusfc_fd] standard_name = vertically_integrated_x_momentum_flux_due_to_form_drag long_name = integrated x momentum flux from form drag @@ -406,6 +424,7 @@ type = real kind = kind_phys intent = inout + optional = True [dvsfc_fd] standard_name = vertically_integrated_y_momentum_flux_due_to_form_drag long_name = integrated y momentum flux from form drag @@ -414,6 +433,7 @@ type = real kind = kind_phys intent = inout + optional = True [slmsk] standard_name = area_type long_name = landmask: sea/land/ice=0/1/2 @@ -501,6 +521,14 @@ type = real kind = kind_phys intent = in +[alpha_fd] + standard_name = alpha_coefficient_for_turbulent_orographic_form_drag + long_name = alpha coefficient for Beljaars et al turbulent orographic form drag + units = 1 + dimensions = () + type = real + kind = kind_phys + intent = in [me] standard_name = mpi_rank long_name = rank of the current MPI task @@ -580,8 +608,8 @@ dimensions = (horizontal_loop_extent,vertical_layer_dimension,cumulative_change_of_state_variables_outer_index_max) type = real kind = kind_phys - active = (flag_for_diagnostics_3D) intent = inout + optional = True [dtidx] standard_name = cumulative_change_of_state_variables_outer_index long_name = index of state-variable and process in last dimension of diagnostic tendencies array AKA cumulative_change_index @@ -646,6 +674,7 @@ type = real kind = kind_phys intent = in + optional = True [spp_gwd] standard_name = control_for_gravity_wave_drag_spp_perturbations long_name = control for gravity wave drag spp perturbations diff --git a/physics/gwdc.f b/physics/GWD/gwdc.f similarity index 100% rename from physics/gwdc.f rename to physics/GWD/gwdc.f diff --git a/physics/gwdc.meta b/physics/GWD/gwdc.meta similarity index 99% rename from physics/gwdc.meta rename to physics/GWD/gwdc.meta index 341879b0b..9884d8a62 100644 --- a/physics/gwdc.meta +++ b/physics/GWD/gwdc.meta @@ -2,7 +2,7 @@ [ccpp-table-properties] name = gwdc type = scheme - dependencies = machine.F + dependencies = ../hooks/machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/gwdc_post.f b/physics/GWD/gwdc_post.f similarity index 99% rename from physics/gwdc_post.f rename to physics/GWD/gwdc_post.f index 62891ffd4..ab2043fec 100644 --- a/physics/gwdc_post.f +++ b/physics/GWD/gwdc_post.f @@ -79,4 +79,4 @@ subroutine gwdc_post_run( & end subroutine gwdc_post_run - end module gwdc_post \ No newline at end of file + end module gwdc_post diff --git a/physics/gwdc_post.meta b/physics/GWD/gwdc_post.meta similarity index 98% rename from physics/gwdc_post.meta rename to physics/GWD/gwdc_post.meta index 25415b888..6b3a160d0 100644 --- a/physics/gwdc_post.meta +++ b/physics/GWD/gwdc_post.meta @@ -2,7 +2,7 @@ [ccpp-table-properties] name = gwdc_post type = scheme - dependencies = machine.F + dependencies = ../hooks/machine.F ######################################################################## [ccpp-arg-table] @@ -115,8 +115,8 @@ dimensions = (horizontal_loop_extent,vertical_layer_dimension,cumulative_change_of_state_variables_outer_index_max) type = real kind = kind_phys - active = (flag_for_diagnostics_3D) intent = inout + optional = True [dtidx] standard_name = cumulative_change_of_state_variables_outer_index long_name = index of state-variable and process in last dimension of diagnostic tendencies array AKA cumulative_change_index diff --git a/physics/gwdc_pre.f b/physics/GWD/gwdc_pre.f similarity index 100% rename from physics/gwdc_pre.f rename to physics/GWD/gwdc_pre.f diff --git a/physics/gwdc_pre.meta b/physics/GWD/gwdc_pre.meta similarity index 99% rename from physics/gwdc_pre.meta rename to physics/GWD/gwdc_pre.meta index 63df59cfa..55b0054bd 100644 --- a/physics/gwdc_pre.meta +++ b/physics/GWD/gwdc_pre.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = gwdc_pre type = scheme - dependencies = machine.F + dependencies = ../hooks/machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/gwdps.f b/physics/GWD/gwdps.f similarity index 99% rename from physics/gwdps.f rename to physics/GWD/gwdps.f index 273c2d5dc..ca2efeef4 100644 --- a/physics/gwdps.f +++ b/physics/GWD/gwdps.f @@ -315,11 +315,11 @@ subroutine gwdps_run( & & THETA(:), SIGMA(:), GAMMA(:) real(kind=kind_phys), intent(inout) :: DUSFC(:), DVSFC(:), & & RDXZB(:) - real(kind=kind_phys), intent(inout) :: dtaux2d_ms(:,:), & + real(kind=kind_phys), intent(inout), optional :: dtaux2d_ms(:,:), & & dtauy2d_ms(:,:), dtaux2d_bl(:,:), & & dtauy2d_bl(:,:) - real(kind=kind_phys), intent(inout) :: dusfc_ms(:), dvsfc_ms(:), & - & dusfc_bl(:), dvsfc_bl(:) + real(kind=kind_phys), intent(inout), optional :: dusfc_ms(:), & + & dvsfc_ms(:), dusfc_bl(:), dvsfc_bl(:) integer, intent(in) :: nmtvr logical, intent(in) :: lprnt logical, intent(in) :: ldiag_ugwp diff --git a/physics/gwdps.meta b/physics/GWD/gwdps.meta similarity index 98% rename from physics/gwdps.meta rename to physics/GWD/gwdps.meta index af60886ab..58c18d367 100644 --- a/physics/gwdps.meta +++ b/physics/GWD/gwdps.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = gwdps type = scheme - dependencies = + dependencies = ../hooks/machine.F ######################################################################## [ccpp-arg-table] @@ -235,6 +235,7 @@ type = real kind = kind_phys intent = inout + optional = True [dtauy2d_ms] standard_name = tendency_of_y_wind_due_to_mesoscale_orographic_gravity_wave_drag long_name = instantaneous change in y wind due to orographic gw drag @@ -243,6 +244,7 @@ type = real kind = kind_phys intent = inout + optional = True [dtaux2d_bl] standard_name = tendency_of_x_wind_due_to_blocking_drag long_name = x wind tendency from blocking drag @@ -251,6 +253,7 @@ type = real kind = kind_phys intent = inout + optional = True [dtauy2d_bl] standard_name = tendency_of_y_wind_due_to_blocking_drag long_name = y wind tendency from blocking drag @@ -259,6 +262,7 @@ type = real kind = kind_phys intent = inout + optional = True [dusfc_ms] standard_name = vertically_integrated_x_momentum_flux_due_to_mesoscale_orographic_gravity_wave_drag long_name = integrated x momentum flux from mesoscale gwd @@ -267,6 +271,7 @@ type = real kind = kind_phys intent = inout + optional = True [dvsfc_ms] standard_name = vertically_integrated_y_momentum_flux_due_to_mesoscale_orographic_gravity_wave_drag long_name = integrated y momentum flux from mesoscale gwd @@ -275,6 +280,7 @@ type = real kind = kind_phys intent = inout + optional = True [dusfc_bl] standard_name = vertically_integrated_x_momentum_flux_due_to_blocking_drag long_name = integrated x momentum flux from blocking drag @@ -283,6 +289,7 @@ type = real kind = kind_phys intent = inout + optional = True [dvsfc_bl] standard_name = vertically_integrated_y_momentum_flux_due_to_blocking_drag long_name = integrated y momentum flux from blocking drag @@ -291,6 +298,7 @@ type = real kind = kind_phys intent = inout + optional = True [g] standard_name = gravitational_acceleration long_name = gravitational acceleration @@ -373,7 +381,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - intent = out + intent = inout [ldiag_ugwp] standard_name = flag_for_unified_gravity_wave_physics_diagnostics long_name = flag for CIRES UGWP Diagnostics diff --git a/physics/rayleigh_damp.f b/physics/GWD/rayleigh_damp.f similarity index 97% rename from physics/rayleigh_damp.f rename to physics/GWD/rayleigh_damp.f index abbac041c..f8b4ac6a6 100644 --- a/physics/rayleigh_damp.f +++ b/physics/GWD/rayleigh_damp.f @@ -70,7 +70,8 @@ subroutine rayleigh_damp_run ( & real(kind=kind_phys),intent(in) :: U1(:,:), V1(:,:) real(kind=kind_phys),intent(inout) :: A(:,:), B(:,:), C(:,:) real(kind=kind_phys),optional, intent(inout) :: dtend(:,:,:) - integer, intent(in) :: dtidx(:,:), & + integer, intent(in) :: dtidx(:,:) + integer, intent(in) :: & & index_of_process_rayleigh_damping, index_of_temperature, & & index_of_x_wind, index_of_y_wind character(len=*), intent(out) :: errmsg diff --git a/physics/rayleigh_damp.meta b/physics/GWD/rayleigh_damp.meta similarity index 98% rename from physics/rayleigh_damp.meta rename to physics/GWD/rayleigh_damp.meta index 63025bcff..857c66e8b 100644 --- a/physics/rayleigh_damp.meta +++ b/physics/GWD/rayleigh_damp.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = rayleigh_damp type = scheme - dependencies = + dependencies = ../hooks/machine.F ######################################################################## [ccpp-arg-table] @@ -137,8 +137,8 @@ dimensions = (horizontal_loop_extent,vertical_layer_dimension,cumulative_change_of_state_variables_outer_index_max) type = real kind = kind_phys - active = (flag_for_diagnostics_3D) intent = inout + optional = True [dtidx] standard_name = cumulative_change_of_state_variables_outer_index long_name = index of state-variable and process in last dimension of diagnostic tendencies array AKA cumulative_change_index diff --git a/physics/ugwp_driver_v0.F b/physics/GWD/ugwp_driver_v0.F similarity index 100% rename from physics/ugwp_driver_v0.F rename to physics/GWD/ugwp_driver_v0.F diff --git a/physics/ugwpv1_gsldrag.F90 b/physics/GWD/ugwpv1_gsldrag.F90 similarity index 91% rename from physics/ugwpv1_gsldrag.F90 rename to physics/GWD/ugwpv1_gsldrag.F90 index 9303e0221..fc90955bd 100644 --- a/physics/ugwpv1_gsldrag.F90 +++ b/physics/GWD/ugwpv1_gsldrag.F90 @@ -44,7 +44,7 @@ module ugwpv1_gsldrag use cires_ugwpv1_solv2, only: cires_ugwpv1_ngw_solv2 use cires_ugwpv1_oro, only: orogw_v1 - use drag_suite, only: drag_suite_run + use drag_suite, only: drag_suite_run, drag_suite_psl implicit none @@ -305,11 +305,13 @@ end subroutine ugwpv1_gsldrag_finalize !! @{ subroutine ugwpv1_gsldrag_run(me, master, im, levs, ak, bk, ntrac, lonr, dtp, & fhzero, kdt, ldiag3d, lssav, flag_for_gwd_generic_tend, do_gsl_drag_ls_bl, & - do_gsl_drag_ss, do_gsl_drag_tofd, do_ugwp_v1, do_ugwp_v1_orog_only, & + do_gsl_drag_ss, do_gsl_drag_tofd, & + do_gwd_opt_psl, psl_gwd_dx_factor, & + do_ugwp_v1, do_ugwp_v1_orog_only, & do_ugwp_v1_w_gsldrag, gwd_opt, do_tofd, ldiag_ugwp, ugwp_seq_update, & - cdmbgwd, jdat, nmtvr, hprime, oc, theta, sigma, gamma, & + cdmbgwd, alpha_fd, jdat, nmtvr, hprime, oc, theta, sigma, gamma, & elvmax, clx, oa4, varss,oc1ss,oa4ss,ol4ss, dx, xlat, xlat_d, sinlat, coslat, & - area, rain, br1, hpbl, kpbl, slmsk, & + area, rain, br1, hpbl,vtype, kpbl, slmsk, & ugrs, vgrs, tgrs, q1, prsi, prsl, prslk, phii, phil, del, tau_amf, & dudt_ogw, dvdt_ogw, du_ogwcol, dv_ogwcol, & dudt_obl, dvdt_obl, du_oblcol, dv_oblcol, & @@ -367,19 +369,22 @@ subroutine ugwpv1_gsldrag_run(me, master, im, levs, ak, bk, ntrac, lonr, dtp, real(kind=kind_phys), intent(in) :: dtp, fhzero real(kind=kind_phys), intent(in) :: ak(:), bk(:) integer, intent(in) :: kdt, jdat(:) - +! option for psl gwd + logical, intent(in) :: do_gwd_opt_psl ! option for psl gravity wave drag + real(kind=kind_phys), intent(in) :: psl_gwd_dx_factor ! ! SSO parameters and variables integer, intent(in) :: gwd_opt !gwd_opt and nmtvr are "redundant" controls integer, intent(in) :: nmtvr - real(kind=kind_phys), intent(in) :: cdmbgwd(:) ! for gsl_drag + real(kind=kind_phys), intent(in) :: cdmbgwd(:), alpha_fd ! for gsl_drag real(kind=kind_phys), intent(in), dimension(:) :: hprime, oc, theta, sigma, gamma real(kind=kind_phys), intent(in), dimension(:) :: elvmax real(kind=kind_phys), intent(in), dimension(:,:) :: clx, oa4 - real(kind=kind_phys), intent(in), dimension(:) :: varss,oc1ss,dx - real(kind=kind_phys), intent(in), dimension(:,:) :: oa4ss,ol4ss + real(kind=kind_phys), intent(in), dimension(:) :: dx + real(kind=kind_phys), intent(in), dimension(:), optional :: varss,oc1ss + real(kind=kind_phys), intent(in), dimension(:,:), optional :: oa4ss,ol4ss !===== !ccpp-style passing constants, I prefer to take them out from the "call-subr" list @@ -396,6 +401,7 @@ subroutine ugwpv1_gsldrag_run(me, master, im, levs, ak, bk, ntrac, lonr, dtp, real(kind=kind_phys), intent(in), dimension(:,:) :: prsi, phii real(kind=kind_phys), intent(in), dimension(:,:) :: q1 integer, intent(in), dimension(:) :: kpbl + integer, intent(in), dimension(:) :: vtype real(kind=kind_phys), intent(in), dimension(:) :: rain real(kind=kind_phys), intent(in), dimension(:) :: br1, hpbl, slmsk @@ -407,7 +413,7 @@ subroutine ugwpv1_gsldrag_run(me, master, im, levs, ak, bk, ntrac, lonr, dtp, !Output (optional): - real(kind=kind_phys), intent(out), dimension(:) :: & + real(kind=kind_phys), intent(out), dimension(:), optional :: & du_ogwcol, dv_ogwcol, du_oblcol, dv_oblcol, & du_osscol, dv_osscol, du_ofdcol, dv_ofdcol ! @@ -417,28 +423,27 @@ subroutine ugwpv1_gsldrag_run(me, master, im, levs, ak, bk, ntrac, lonr, dtp, real(kind=kind_phys), intent(out), dimension(:) :: dusfcg, dvsfcg real(kind=kind_phys), intent(out), dimension(:) :: tau_ogw, tau_ngw, tau_oss - real(kind=kind_phys), intent(out) , dimension(:,:) :: & + real(kind=kind_phys), intent(out) , dimension(:,:), optional :: & dudt_ogw, dvdt_ogw, dudt_obl, dvdt_obl, & dudt_oss, dvdt_oss, dudt_ofd, dvdt_ofd - real(kind=kind_phys), intent(out) , dimension(:,:) :: dudt_ngw, dvdt_ngw, kdis_ngw - real(kind=kind_phys), intent(out) , dimension(:,:) :: dudt_gw, dvdt_gw, kdis_gw - - real(kind=kind_phys), intent(out) , dimension(:,:) :: dtdt_ngw, dtdt_gw + real(kind=kind_phys), intent(out) , dimension(:,:), optional :: dudt_ngw, dvdt_ngw, kdis_ngw, dtdt_ngw + real(kind=kind_phys), intent(out) , dimension(:,:) :: dudt_gw, dvdt_gw, dtdt_gw, kdis_gw real(kind=kind_phys), intent(out) , dimension(:) :: zogw, zlwb, zobl, zngw ! ! real(kind=kind_phys), intent(inout), dimension(:,:) :: dudt, dvdt, dtdt - real(kind=kind_phys), intent(inout) :: dtend(:,:,:) - integer, intent(in) :: dtidx(:,:), & + real(kind=kind_phys), intent(inout), optional :: dtend(:,:,:) + integer, intent(in) :: dtidx(:,:) + integer, intent(in) :: & index_of_x_wind, index_of_y_wind, index_of_temperature, & index_of_process_orographic_gwd, index_of_process_nonorographic_gwd real(kind=kind_phys), intent(out), dimension(:) :: rdxzb ! for stoch phys. mtb-level - real(kind=kind_phys), intent(in) :: spp_wts_gwd(:,:) + real(kind=kind_phys), intent(in), optional :: spp_wts_gwd(:,:) integer, intent(in) :: spp_gwd character(len=*), intent(out) :: errmsg @@ -544,6 +549,28 @@ subroutine ugwpv1_gsldrag_run(me, master, im, levs, ak, bk, ntrac, lonr, dtp, ! dusfcg, dvsfcg ! ! + if (do_gwd_opt_psl) then + call drag_suite_psl(im, levs, Pdvdt, Pdudt, Pdtdt, & + ugrs,vgrs,tgrs,q1, & + kpbl,prsi,del,prsl,prslk,phii,phil,dtp, & + kdt,hprime,oc,oa4,clx,varss,oc1ss,oa4ss, & + ol4ss,theta,sigma,gamma,elvmax, & + dudt_ogw, dvdt_ogw, dudt_obl, dvdt_obl, & + dudt_oss, dvdt_oss, dudt_ofd, dvdt_ofd, & + dusfcg, dvsfcg, & + du_ogwcol, dv_ogwcol, du_oblcol, dv_oblcol, & + du_osscol, dv_osscol, du_ofdcol, dv_ofdcol, & + slmsk,br1,hpbl,vtype,con_g,con_cp,con_rd,con_rv, & + con_fv, con_pi, lonr, & + cdmbgwd(1:2),alpha_fd,me,master, & + lprnt,ipr,rdxzb,dx,gwd_opt, & + do_gsl_drag_ls_bl,do_gsl_drag_ss,do_gsl_drag_tofd, & + psl_gwd_dx_factor, & + dtend, dtidx, index_of_process_orographic_gwd, & + index_of_temperature, index_of_x_wind, & + index_of_y_wind, ldiag3d, ldiag_ugwp, & + ugwp_seq_update, spp_wts_gwd, spp_gwd, errmsg, errflg) + else call drag_suite_run(im, levs, Pdvdt, Pdudt, Pdtdt, & ugrs,vgrs,tgrs,q1, & kpbl,prsi,del,prsl,prslk,phii,phil,dtp, & @@ -554,14 +581,16 @@ subroutine ugwpv1_gsldrag_run(me, master, im, levs, ak, bk, ntrac, lonr, dtp, dusfcg, dvsfcg, & du_ogwcol, dv_ogwcol, du_oblcol, dv_oblcol, & du_osscol, dv_osscol, du_ofdcol, dv_ofdcol, & - slmsk,br1,hpbl, con_g,con_cp,con_rd,con_rv, & + slmsk,br1,hpbl,con_g,con_cp,con_rd,con_rv, & con_fv, con_pi, lonr, & - cdmbgwd(1:2),me,master,lprnt,ipr,rdxzb,dx,gwd_opt, & + cdmbgwd(1:2),alpha_fd,me,master, & + lprnt,ipr,rdxzb,dx,gwd_opt, & do_gsl_drag_ls_bl,do_gsl_drag_ss,do_gsl_drag_tofd, & dtend, dtidx, index_of_process_orographic_gwd, & index_of_temperature, index_of_x_wind, & index_of_y_wind, ldiag3d, ldiag_ugwp, & ugwp_seq_update, spp_wts_gwd, spp_gwd, errmsg, errflg) + endif ! ! dusfcg = du_ogwcol + du_oblcol + du_osscol + du_ofdcol ! diff --git a/physics/ugwpv1_gsldrag.meta b/physics/GWD/ugwpv1_gsldrag.meta similarity index 95% rename from physics/ugwpv1_gsldrag.meta rename to physics/GWD/ugwpv1_gsldrag.meta index 82caa8832..6d9f5426b 100644 --- a/physics/ugwpv1_gsldrag.meta +++ b/physics/GWD/ugwpv1_gsldrag.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = ugwpv1_gsldrag type = scheme - dependencies = machine.F,drag_suite.F90 + dependencies = ../hooks/machine.F,drag_suite.F90 dependencies = cires_ugwpv1_module.F90,cires_ugwpv1_triggers.F90,cires_ugwpv1_initialize.F90,cires_ugwpv1_solv2.F90 dependencies = cires_ugwpv1_sporo.F90,cires_ugwpv1_oro.F90 ######################################################################## @@ -402,6 +402,21 @@ dimensions = () type = logical intent = in +[do_gwd_opt_psl] + standard_name = do_gsl_drag_suite_with_psl_gwd_option + long_name = flag to activate PSL drag suite - mesoscale GWD and blocking + units = flag + dimensions = () + type = logical + intent = in +[psl_gwd_dx_factor] + standard_name = effective_grid_spacing_of_psl_gwd_suite + long_name = multiplication of grid spacing + units = 1 + dimensions = () + type = real + kind = kind_phys + intent = in [do_ugwp_v1] standard_name = flag_for_ugwp_version_1 long_name = flag to activate ver 1 CIRES UGWP @@ -459,6 +474,14 @@ type = real kind = kind_phys intent = in +[alpha_fd] + standard_name = alpha_coefficient_for_turbulent_orographic_form_drag + long_name = alpha coefficient for Beljaars et al turbulent orographic form drag + units = 1 + dimensions = () + type = real + kind = kind_phys + intent = in [jdat] standard_name = date_and_time_of_forecast_in_united_states_order long_name = current forecast date and time @@ -545,6 +568,7 @@ type = real kind = kind_phys intent = in + optional = True [oc1ss] standard_name = convexity_of_subgrid_orography_small_scale long_name = convexity of subgrid height_above_mean_sea_level small scale @@ -553,6 +577,7 @@ type = real kind = kind_phys intent = in + optional = True [oa4ss] standard_name = asymmetry_of_subgrid_orography_small_scale long_name = asymmetry of subgrid height_above_mean_sea_level small scale @@ -561,6 +586,7 @@ type = real kind = kind_phys intent = in + optional = True [ol4ss] standard_name = fraction_of_grid_box_with_subgrid_orography_higher_than_critical_height_small_scale long_name = horizontal fraction of grid box covered by sso higher than critical height small scale @@ -569,6 +595,7 @@ type = real kind = kind_phys intent = in + optional = True [dx] standard_name = characteristic_grid_lengthscale long_name = size of the grid cell @@ -641,6 +668,13 @@ type = real kind = kind_phys intent = in +[vtype] + standard_name = vegetation_type_classification + long_name = vegetation type for lsm + units = index + dimensions = (horizontal_loop_extent) + type = integer + intent = in [kpbl] standard_name = vertical_index_at_top_of_atmosphere_boundary_layer long_name = vertical index at top atmospheric boundary layer @@ -752,6 +786,7 @@ type = real kind = kind_phys intent = out + optional = True [dvdt_ogw] standard_name = tendency_of_y_wind_due_to_mesoscale_orographic_gravity_wave_drag long_name = y wind tendency from meso scale ogw @@ -760,6 +795,7 @@ type = real kind = kind_phys intent = out + optional = True [du_ogwcol] standard_name = vertically_integrated_x_momentum_flux_due_to_mesoscale_orographic_gravity_wave_drag long_name = integrated x momentum flux from meso scale ogw @@ -768,6 +804,7 @@ type = real kind = kind_phys intent = out + optional = True [dv_ogwcol] standard_name = vertically_integrated_y_momentum_flux_due_to_mesoscale_orographic_gravity_wave_drag long_name = integrated y momentum flux from meso scale ogw @@ -776,6 +813,7 @@ type = real kind = kind_phys intent = out + optional = True [dudt_obl] standard_name = tendency_of_x_wind_due_to_blocking_drag long_name = x wind tendency from blocking drag @@ -784,6 +822,7 @@ type = real kind = kind_phys intent = out + optional = True [dvdt_obl] standard_name = tendency_of_y_wind_due_to_blocking_drag long_name = y wind tendency from blocking drag @@ -792,6 +831,7 @@ type = real kind = kind_phys intent = out + optional = True [du_oblcol] standard_name = vertically_integrated_x_momentum_flux_due_to_blocking_drag long_name = integrated x momentum flux from blocking drag @@ -800,6 +840,7 @@ type = real kind = kind_phys intent = out + optional = True [dv_oblcol] standard_name = vertically_integrated_y_momentum_flux_due_to_blocking_drag long_name = integrated y momentum flux from blocking drag @@ -808,6 +849,7 @@ type = real kind = kind_phys intent = out + optional = True [dudt_oss] standard_name = tendency_of_x_wind_due_to_small_scale_gravity_wave_drag long_name = x wind tendency from small scale gwd @@ -816,6 +858,7 @@ type = real kind = kind_phys intent = out + optional = True [dvdt_oss] standard_name = tendency_of_y_wind_due_to_small_scale_gravity_wave_drag long_name = y wind tendency from small scale gwd @@ -824,6 +867,7 @@ type = real kind = kind_phys intent = out + optional = True [du_osscol] standard_name = vertically_integrated_x_momentum_flux_due_to_small_scale_gravity_wave_drag long_name = integrated x momentum flux from small scale gwd @@ -832,6 +876,7 @@ type = real kind = kind_phys intent = out + optional = True [dv_osscol] standard_name = vertically_integrated_y_momentum_flux_due_to_small_scale_gravity_wave_drag long_name = integrated y momentum flux from small scale gwd @@ -840,6 +885,7 @@ type = real kind = kind_phys intent = out + optional = True [dudt_ofd] standard_name = tendency_of_x_wind_due_to_form_drag long_name = x wind tendency from form drag @@ -848,6 +894,7 @@ type = real kind = kind_phys intent = out + optional = True [dvdt_ofd] standard_name = tendency_of_y_wind_due_to_form_drag long_name = y wind tendency from form drag @@ -856,6 +903,7 @@ type = real kind = kind_phys intent = out + optional = True [du_ofdcol] standard_name = vertically_integrated_x_momentum_flux_due_to_form_drag long_name = integrated x momentum flux from form drag @@ -864,6 +912,7 @@ type = real kind = kind_phys intent = out + optional = True [dv_ofdcol] standard_name = vertically_integrated_y_momentum_flux_due_to_form_drag long_name = integrated y momentum flux from form drag @@ -872,6 +921,7 @@ type = real kind = kind_phys intent = out + optional = True [dudt_ngw] standard_name = tendency_of_x_wind_due_to_nonorographic_gravity_wave_drag long_name = zonal wind tendency due to non-stationary GWs @@ -880,6 +930,7 @@ type = real kind = kind_phys intent = out + optional = True [dvdt_ngw] standard_name = tendency_of_y_wind_due_to_nonorographic_gravity_wave_drag long_name = meridional wind tendency due to non-stationary GWs @@ -888,6 +939,7 @@ type = real kind = kind_phys intent = out + optional = True [dtdt_ngw] standard_name = tendency_of_air_temperature_due_to_nonorographic_gravity_wave_drag long_name = air temperature tendency due to non-stationary GWs @@ -896,6 +948,7 @@ type = real kind = kind_phys intent = out + optional = True [kdis_ngw] standard_name = atmosphere_momentum_diffusivity_due_to_nonorographic_gravity_wave_drag long_name = eddy mixing due to non-stationary GWs @@ -904,6 +957,7 @@ type = real kind = kind_phys intent = out + optional = True [dudt_gw] standard_name = tendency_of_x_wind_due_to_gravity_wave_drag long_name = zonal wind tendency due to all GWs @@ -1049,6 +1103,7 @@ type = real kind = kind_phys intent = inout + optional = True [dtidx] standard_name = cumulative_change_of_state_variables_outer_index long_name = index of state-variable and process in last dimension of diagnostic tendencies array AKA cumulative_change_index @@ -1113,6 +1168,7 @@ type = real kind = kind_phys intent = in + optional = True [spp_gwd] standard_name = control_for_gravity_wave_drag_spp_perturbations long_name = control for gravity wave drag spp perturbations diff --git a/physics/ugwpv1_gsldrag_post.F90 b/physics/GWD/ugwpv1_gsldrag_post.F90 similarity index 71% rename from physics/ugwpv1_gsldrag_post.F90 rename to physics/GWD/ugwpv1_gsldrag_post.F90 index 8c6704dc5..2b1d3e018 100644 --- a/physics/ugwpv1_gsldrag_post.F90 +++ b/physics/GWD/ugwpv1_gsldrag_post.F90 @@ -35,30 +35,31 @@ subroutine ugwpv1_gsldrag_post_run ( im, levs, ldiag_ugwp, & logical, intent(in) :: ldiag_ugwp !< flag for CIRES UGWP Diagnostics real(kind=kind_phys), intent(in), dimension(:) :: zobl, zlwb, zogw - real(kind=kind_phys), intent(in), dimension(:) :: du_ofdcol, tau_ogw, du_oblcol, tau_ngw + real(kind=kind_phys), intent(in), dimension(:) :: tau_ogw, tau_ngw + real(kind=kind_phys), intent(in), dimension(:),optional :: du_ofdcol, du_oblcol real(kind=kind_phys), intent(inout), dimension(:) :: tot_mtb, tot_ogw, tot_tofd, tot_ngw real(kind=kind_phys), intent(inout), dimension(:) :: tot_zmtb, tot_zlwb, tot_zogw real(kind=kind_phys), intent(in), dimension(:,:) :: dtdt_gw, dudt_gw, dvdt_gw - real(kind=kind_phys), intent(in), dimension(:,:) :: dudt_obl, dvdt_obl, dudt_ogw - real(kind=kind_phys), intent(in), dimension(:,:) :: dvdt_ogw, dudt_ofd, dvdt_ofd - real(kind=kind_phys), intent(in), dimension(:,:) :: dudt_oss, dvdt_oss - real(kind=kind_phys), intent(inout), dimension(:,:) :: du3dt_mtb, du3dt_ogw, du3dt_tms - real(kind=kind_phys), intent(inout), dimension(:,:) :: du3dt_ngw, dv3dt_ngw - real(kind=kind_phys), intent(in), dimension(:,:) :: dudt_ngw, dvdt_ngw, dtdt_ngw - real(kind=kind_phys), intent(inout), dimension(:,:) :: ldu3dt_ngw, ldv3dt_ngw, ldt3dt_ngw - real(kind=kind_phys), intent(inout), dimension(:,:) :: dws3dt_ogw, dws3dt_obl - real(kind=kind_phys), intent(inout), dimension(:,:) :: dws3dt_oss, dws3dt_ofd - real(kind=kind_phys), intent(inout), dimension(:,:) :: ldu3dt_ogw, ldu3dt_obl - real(kind=kind_phys), intent(inout), dimension(:,:) :: ldu3dt_oss, ldu3dt_ofd - real(kind=kind_phys), intent(in), dimension(:) :: du_ogwcol, dv_ogwcol - real(kind=kind_phys), intent(in), dimension(:) :: dv_oblcol - real(kind=kind_phys), intent(in), dimension(:) :: du_osscol, dv_osscol - real(kind=kind_phys), intent(in), dimension(:) :: dv_ofdcol - real(kind=kind_phys), intent(inout), dimension(:) :: du3_ogwcol, dv3_ogwcol - real(kind=kind_phys), intent(inout), dimension(:) :: du3_oblcol, dv3_oblcol - real(kind=kind_phys), intent(inout), dimension(:) :: du3_osscol, dv3_osscol - real(kind=kind_phys), intent(inout), dimension(:) :: du3_ofdcol, dv3_ofdcol + real(kind=kind_phys), intent(in), dimension(:,:), optional :: dudt_obl, dvdt_obl, dudt_ogw + real(kind=kind_phys), intent(in), dimension(:,:), optional :: dvdt_ogw, dudt_ofd, dvdt_ofd + real(kind=kind_phys), intent(in), dimension(:,:), optional :: dudt_oss, dvdt_oss + real(kind=kind_phys), intent(inout), dimension(:,:), optional :: du3dt_mtb, du3dt_ogw, du3dt_tms + real(kind=kind_phys), intent(inout), dimension(:,:), optional :: du3dt_ngw, dv3dt_ngw + real(kind=kind_phys), intent(in), dimension(:,:), optional :: dudt_ngw, dvdt_ngw, dtdt_ngw + real(kind=kind_phys), intent(inout), dimension(:,:), optional :: ldu3dt_ngw, ldv3dt_ngw, ldt3dt_ngw + real(kind=kind_phys), intent(inout), dimension(:,:), optional :: dws3dt_ogw, dws3dt_obl + real(kind=kind_phys), intent(inout), dimension(:,:), optional :: dws3dt_oss, dws3dt_ofd + real(kind=kind_phys), intent(inout), dimension(:,:), optional :: ldu3dt_ogw, ldu3dt_obl + real(kind=kind_phys), intent(inout), dimension(:,:), optional :: ldu3dt_oss, ldu3dt_ofd + real(kind=kind_phys), intent(in), dimension(:), optional :: du_ogwcol, dv_ogwcol + real(kind=kind_phys), intent(in), dimension(:), optional :: dv_oblcol + real(kind=kind_phys), intent(in), dimension(:), optional :: du_osscol, dv_osscol + real(kind=kind_phys), intent(in), dimension(:), optional :: dv_ofdcol + real(kind=kind_phys), intent(inout), dimension(:), optional :: du3_ogwcol, dv3_ogwcol + real(kind=kind_phys), intent(inout), dimension(:), optional :: du3_oblcol, dv3_oblcol + real(kind=kind_phys), intent(inout), dimension(:), optional :: du3_osscol, dv3_osscol + real(kind=kind_phys), intent(inout), dimension(:), optional :: du3_ofdcol, dv3_ofdcol real(kind=kind_phys), intent(inout), dimension(:,:) :: dtdt, dudt, dvdt diff --git a/physics/ugwpv1_gsldrag_post.meta b/physics/GWD/ugwpv1_gsldrag_post.meta similarity index 95% rename from physics/ugwpv1_gsldrag_post.meta rename to physics/GWD/ugwpv1_gsldrag_post.meta index f8766060c..b97db21c0 100644 --- a/physics/ugwpv1_gsldrag_post.meta +++ b/physics/GWD/ugwpv1_gsldrag_post.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = ugwpv1_gsldrag_post type = scheme - dependencies = machine.F + dependencies = ../hooks/machine.F ######################################################################## [ccpp-arg-table] @@ -108,6 +108,7 @@ type = real kind = kind_phys intent = in + optional = True [dvdt_obl] standard_name = tendency_of_y_wind_due_to_blocking_drag long_name = y wind tendency from blocking drag @@ -116,6 +117,7 @@ type = real kind = kind_phys intent = in + optional = True [dudt_ofd] standard_name = tendency_of_x_wind_due_to_form_drag long_name = x wind tendency from form drag @@ -124,6 +126,7 @@ type = real kind = kind_phys intent = in + optional = True [dvdt_ofd] standard_name = tendency_of_y_wind_due_to_form_drag long_name = y wind tendency from form drag @@ -132,6 +135,7 @@ type = real kind = kind_phys intent = in + optional = True [dudt_ogw] standard_name = tendency_of_x_wind_due_to_mesoscale_orographic_gravity_wave_drag long_name = x wind tendency from meso scale ogw @@ -140,6 +144,7 @@ type = real kind = kind_phys intent = in + optional = True [dvdt_ogw] standard_name = tendency_of_y_wind_due_to_mesoscale_orographic_gravity_wave_drag long_name = y wind tendency from meso scale ogw @@ -148,6 +153,7 @@ type = real kind = kind_phys intent = in + optional = True [dudt_oss] standard_name = tendency_of_x_wind_due_to_small_scale_gravity_wave_drag long_name = x wind tendency from small scale gwd @@ -156,6 +162,7 @@ type = real kind = kind_phys intent = in + optional = True [dvdt_oss] standard_name = tendency_of_y_wind_due_to_small_scale_gravity_wave_drag long_name = y wind tendency from small scale gwd @@ -164,6 +171,7 @@ type = real kind = kind_phys intent = in + optional = True [tot_zmtb] standard_name = time_integral_of_height_of_mountain_blocking long_name = time integral of height of mountain blocking drag @@ -228,6 +236,7 @@ type = real kind = kind_phys intent = inout + optional = True [du3dt_ogw] standard_name = time_integral_of_change_in_x_wind_due_to_orographic_gravity_wave_drag long_name = time integral of change in x wind due to orographic gw drag @@ -236,6 +245,7 @@ type = real kind = kind_phys intent = inout + optional = True [du3dt_tms] standard_name = time_integral_of_change_in_x_wind_due_to_turbulent_orographic_form_drag long_name = time integral of change in x wind due to TOFD @@ -244,6 +254,7 @@ type = real kind = kind_phys intent = inout + optional = True [du3dt_ngw] standard_name = time_integral_of_change_in_x_wind_due_to_nonstationary_gravity_wave long_name = time integral of change in x wind due to NGW @@ -252,6 +263,7 @@ type = real kind = kind_phys intent = inout + optional = True [dv3dt_ngw] standard_name = time_integral_of_change_in_y_wind_due_to_nonstationary_gravity_wave long_name = time integral of change in y wind due to NGW @@ -260,6 +272,7 @@ type = real kind = kind_phys intent = inout + optional = True [dudt_ngw] standard_name = tendency_of_x_wind_due_to_nonorographic_gravity_wave_drag long_name = zonal wind tendency due to non-stationary GWs @@ -268,6 +281,7 @@ type = real kind = kind_phys intent = in + optional = True [dvdt_ngw] standard_name = tendency_of_y_wind_due_to_nonorographic_gravity_wave_drag long_name = meridional wind tendency due to non-stationary GWs @@ -276,6 +290,7 @@ type = real kind = kind_phys intent = in + optional = True [dtdt_ngw] standard_name = tendency_of_air_temperature_due_to_nonorographic_gravity_wave_drag long_name = air temperature tendency due to non-stationary GWs @@ -284,6 +299,7 @@ type = real kind = kind_phys intent = in + optional = True [ldu3dt_ngw] standard_name = cumulative_change_in_x_wind_due_to_convective_gravity_wave_drag long_name = cumulative change in x wind due to convective gravity wave drag @@ -292,6 +308,7 @@ type = real kind = kind_phys intent = inout + optional = True [ldv3dt_ngw] standard_name = cumulative_change_in_y_wind_due_to_convective_gravity_wave_drag long_name = cumulative change in y wind due to convective gravity wave drag @@ -300,6 +317,7 @@ type = real kind = kind_phys intent = inout + optional = True [ldt3dt_ngw] standard_name = cumulative_change_in_temperature_due_to_convective_gravity_wave_drag long_name = cumulative change in temperature due to convective gravity wave drag @@ -308,6 +326,7 @@ type = real kind = kind_phys intent = inout + optional = True [dws3dt_ogw] standard_name = cumulative_change_in_wind_speed_due_to_mesoscale_orographic_gravity_wave_drag long_name = cumulative change in wind speed due to mesoscale orographic gravity wave drag @@ -316,6 +335,7 @@ type = real kind = kind_phys intent = inout + optional = True [dws3dt_obl] standard_name = cumulative_change_in_wind_speed_due_to_blocking_drag long_name = cumulative change in wind speed due to blocking drag @@ -324,6 +344,7 @@ type = real kind = kind_phys intent = inout + optional = True [dws3dt_oss] standard_name = cumulative_change_in_wind_speed_due_to_small_scale_orographic_gravity_wave_drag long_name = cumulative change in wind speed due to small scale orographic gravity wave drag @@ -332,6 +353,7 @@ type = real kind = kind_phys intent = inout + optional = True [dws3dt_ofd] standard_name = cumulative_change_in_wind_speed_due_to_turbulent_orographic_form_drag long_name = cumulative change in wind speed due to turbulent orographic form drag @@ -340,6 +362,7 @@ type = real kind = kind_phys intent = inout + optional = True [ldu3dt_ogw] standard_name = cumulative_change_in_x_wind_due_to_mesoscale_orographic_gravity_wave_drag long_name = cumulative change in x wind due to mesoscale orographic gravity wave drag @@ -348,6 +371,7 @@ type = real kind = kind_phys intent = inout + optional = True [ldu3dt_obl] standard_name = cumulative_change_in_x_wind_due_to_blocking_drag long_name = cumulative change in x wind due to blocking drag @@ -356,6 +380,7 @@ type = real kind = kind_phys intent = inout + optional = True [ldu3dt_oss] standard_name = cumulative_change_in_x_wind_due_to_small_scale_gravity_wave_drag long_name = cumulative change in x wind due to small scale gravity wave drag @@ -364,6 +389,7 @@ type = real kind = kind_phys intent = inout + optional = True [ldu3dt_ofd] standard_name = cumulative_change_in_x_wind_due_to_form_drag long_name = cumulative change in x wind due to form drag @@ -372,6 +398,7 @@ type = real kind = kind_phys intent = inout + optional = True [du_ogwcol] standard_name = vertically_integrated_x_momentum_flux_due_to_mesoscale_orographic_gravity_wave_drag long_name = integrated x momentum flux from meso scale ogw @@ -380,6 +407,7 @@ type = real kind = kind_phys intent = in + optional = True [dv_ogwcol] standard_name = vertically_integrated_y_momentum_flux_due_to_mesoscale_orographic_gravity_wave_drag long_name = integrated y momentum flux from meso scale ogw @@ -388,6 +416,7 @@ type = real kind = kind_phys intent = in + optional = True [du_oblcol] standard_name = vertically_integrated_x_momentum_flux_due_to_blocking_drag long_name = integrated x momentum flux from blocking drag @@ -396,6 +425,7 @@ type = real kind = kind_phys intent = in + optional = True [dv_oblcol] standard_name = vertically_integrated_y_momentum_flux_due_to_blocking_drag long_name = integrated y momentum flux from blocking drag @@ -404,6 +434,7 @@ type = real kind = kind_phys intent = in + optional = True [du_osscol] standard_name = vertically_integrated_x_momentum_flux_due_to_small_scale_gravity_wave_drag long_name = integrated x momentum flux from small scale gwd @@ -412,6 +443,7 @@ type = real kind = kind_phys intent = in + optional = True [dv_osscol] standard_name = vertically_integrated_y_momentum_flux_due_to_small_scale_gravity_wave_drag long_name = integrated y momentum flux from small scale gwd @@ -420,6 +452,7 @@ type = real kind = kind_phys intent = in + optional = True [du_ofdcol] standard_name = vertically_integrated_x_momentum_flux_due_to_form_drag long_name = integrated x momentum flux from form drag @@ -428,6 +461,7 @@ type = real kind = kind_phys intent = in + optional = True [dv_ofdcol] standard_name = vertically_integrated_y_momentum_flux_due_to_form_drag long_name = integrated y momentum flux from form drag @@ -436,6 +470,7 @@ type = real kind = kind_phys intent = in + optional = True [du3_ogwcol] standard_name = cumulative_vertically_integrated_x_momentum_flux_due_to_mesoscale_orographic_gravity_wave_drag long_name = cumulative integrated x momentum flux from mesoscale orographic gravity wave drag @@ -444,6 +479,7 @@ type = real kind = kind_phys intent = inout + optional = True [dv3_ogwcol] standard_name = cumulative_vertically_integrated_y_momentum_flux_due_to_mesoscale_orographic_gravity_wave_drag long_name = cumulative integrated y momentum flux from mesoscale orographic gravity wave drag @@ -452,6 +488,7 @@ type = real kind = kind_phys intent = inout + optional = True [du3_oblcol] standard_name = cumulative_vertically_integrated_x_momentum_flux_due_to_blocking_drag long_name = cumulative integrated x momentum flux from blocking drag @@ -460,6 +497,7 @@ type = real kind = kind_phys intent = inout + optional = True [dv3_oblcol] standard_name = cumulative_vertically_integrated_y_momentum_flux_due_to_blocking_drag long_name = cumulative integrated y momentum flux from blocking drag @@ -468,6 +506,7 @@ type = real kind = kind_phys intent = inout + optional = True [du3_osscol] standard_name = cumulative_vertically_integrated_x_momentum_flux_due_to_small_scale_gravity_wave_drag long_name = cumulative integrated x momentum flux from small scale gravity wave drag @@ -476,6 +515,7 @@ type = real kind = kind_phys intent = inout + optional = True [dv3_osscol] standard_name = cumulative_vertically_integrated_y_momentum_flux_due_small_scale_gravity_wave_drag long_name = cumulative integrated y momentum flux from small scale gravity wave drag @@ -484,6 +524,7 @@ type = real kind = kind_phys intent = inout + optional = True [du3_ofdcol] standard_name = cumulative_vertically_integrated_x_momentum_flux_due_to_form_drag long_name = cumulative integrated x momentum flux from form drag @@ -492,6 +533,7 @@ type = real kind = kind_phys intent = inout + optional = True [dv3_ofdcol] standard_name = cumulative_vertically_integrated_y_momentum_flux_due_to_form_drag long_name = cumulative integrated y momentum flux from form drag @@ -500,6 +542,7 @@ type = real kind = kind_phys intent = inout + optional = True [dtdt] standard_name = process_split_cumulative_tendency_of_air_temperature long_name = air temperature tendency due to model physics diff --git a/physics/unified_ugwp.F90 b/physics/GWD/unified_ugwp.F90 similarity index 89% rename from physics/unified_ugwp.F90 rename to physics/GWD/unified_ugwp.F90 index 0bcbc4f62..adedeeb15 100644 --- a/physics/unified_ugwp.F90 +++ b/physics/GWD/unified_ugwp.F90 @@ -40,7 +40,7 @@ module unified_ugwp use gwdps, only: gwdps_run use cires_ugwp_triggers use ugwp_driver_v0 - use drag_suite, only: drag_suite_run + use drag_suite, only: drag_suite_run, drag_suite_psl implicit none @@ -249,11 +249,11 @@ subroutine unified_ugwp_run(me, master, im, levs, ak,bk, ntrac, dtp, fhzero, kdt varss,oc1ss,oa4ss,ol4ss,dx,dusfc_ms,dvsfc_ms,dusfc_bl,dvsfc_bl,dusfc_ss, & dvsfc_ss,dusfc_fd,dvsfc_fd,dtaux2d_ms,dtauy2d_ms,dtaux2d_bl,dtauy2d_bl, & dtaux2d_ss,dtauy2d_ss,dtaux2d_fd,dtauy2d_fd,dudt_ngw,dvdt_ngw,dtdt_ngw, & - br1,hpbl,slmsk, do_tofd, ldiag_ugwp, ugwp_seq_update, & - cdmbgwd, jdat, xlat, xlat_d, sinlat, coslat, area, & + br1,hpbl,vtype,slmsk, do_tofd, ldiag_ugwp, ugwp_seq_update, & + cdmbgwd, alpha_fd, jdat, xlat, xlat_d, sinlat, coslat, area, & ugrs, vgrs, tgrs, q1, prsi, prsl, prslk, phii, phil, & del, kpbl, dusfcg, dvsfcg, gw_dudt, gw_dvdt, gw_dtdt, gw_kdis, & - tau_tofd, tau_mtb, tau_ogw, tau_ngw, zmtb, zlwb, zogw, & + tau_tofd, tau_mtb, tau_ogw, tau_ngw, & dudt_mtb, dudt_tms, du3dt_mtb, du3dt_ogw, du3dt_tms, & dudt, dvdt, dtdt, rdxzb, con_g, con_omega, con_pi, con_cp, con_rd, con_rv, & con_rerth, con_fvirt, rain, ntke, q_tke, dqdt_tke, lprnt, ipr, & @@ -262,6 +262,7 @@ subroutine unified_ugwp_run(me, master, im, levs, ak,bk, ntrac, dtp, fhzero, kdt index_of_process_nonorographic_gwd, & lssav, flag_for_gwd_generic_tend, do_ugwp_v0, do_ugwp_v0_orog_only, & do_ugwp_v0_nst_only, do_gsl_drag_ls_bl, do_gsl_drag_ss, do_gsl_drag_tofd, & + do_gwd_opt_psl, psl_gwd_dx_factor, & gwd_opt, spp_wts_gwd, spp_gwd, errmsg, errflg) implicit none @@ -270,12 +271,14 @@ subroutine unified_ugwp_run(me, master, im, levs, ak,bk, ntrac, dtp, fhzero, kdt integer, intent(in) :: me, master, im, levs, ntrac, kdt, lonr, nmtvr integer, intent(in) :: gwd_opt integer, intent(in), dimension(:) :: kpbl + integer, intent(in), dimension(:) :: vtype real(kind=kind_phys), intent(in), dimension(:) :: ak, bk real(kind=kind_phys), intent(in), dimension(:) :: oro, oro_uf, hprime, oc, theta, sigma, gamma - real(kind=kind_phys), intent(in), dimension(:) :: varss,oc1ss, dx + real(kind=kind_phys), intent(in), dimension(:), optional :: varss,oc1ss + real(kind=kind_phys), intent(in), dimension(:) :: dx !vay-nov 2020 - real(kind=kind_phys), intent(in), dimension(:,:) :: oa4ss,ol4ss + real(kind=kind_phys), intent(in), dimension(:,:), optional :: oa4ss,ol4ss logical, intent(in) :: flag_for_gwd_generic_tend @@ -287,41 +290,41 @@ subroutine unified_ugwp_run(me, master, im, levs, ak,bk, ntrac, dtp, fhzero, kdt real(kind=kind_phys), intent(in), dimension(:,:) :: del, ugrs, vgrs, tgrs, prsl, prslk, phil real(kind=kind_phys), intent(in), dimension(:,:) :: prsi, phii real(kind=kind_phys), intent(in), dimension(:,:) :: q1 - real(kind=kind_phys), intent(in) :: dtp, fhzero, cdmbgwd(:) + real(kind=kind_phys), intent(in) :: dtp, fhzero, cdmbgwd(:), alpha_fd integer, intent(in) :: jdat(:) logical, intent(in) :: do_tofd, ldiag_ugwp, ugwp_seq_update !Output (optional): - real(kind=kind_phys), intent(out) :: & + real(kind=kind_phys), intent(out), optional :: & & dusfc_ms(:),dvsfc_ms(:), & & dusfc_bl(:),dvsfc_bl(:), & & dusfc_ss(:),dvsfc_ss(:), & & dusfc_fd(:),dvsfc_fd(:) - real(kind=kind_phys), intent(out) :: & + real(kind=kind_phys), intent(out), optional :: & & dtaux2d_ms(:,:),dtauy2d_ms(:,:), & & dtaux2d_bl(:,:),dtauy2d_bl(:,:), & & dtaux2d_ss(:,:),dtauy2d_ss(:,:), & & dtaux2d_fd(:,:),dtauy2d_fd(:,:), & & dudt_ngw(:,:),dvdt_ngw(:,:),dtdt_ngw(:,:) - - real(kind=kind_phys), intent(in) :: br1(:), & - & hpbl(:), & + real(kind=kind_phys), intent(in) :: hpbl(:), & + & br1(:), & & slmsk(:) real(kind=kind_phys), intent(out), dimension(:) :: dusfcg, dvsfcg - real(kind=kind_phys), intent(out), dimension(:) :: zmtb, zlwb, zogw, rdxzb + real(kind=kind_phys), intent(out), dimension(:) :: rdxzb real(kind=kind_phys), intent(out), dimension(:) :: tau_mtb, tau_ogw, tau_tofd, tau_ngw real(kind=kind_phys), intent(out), dimension(:,:) :: gw_dudt, gw_dvdt, gw_dtdt, gw_kdis real(kind=kind_phys), intent(out), dimension(:,:) :: dudt_mtb, dudt_tms - real(kind=kind_phys), intent(inout) :: dtend(:,:,:) - integer, intent(in) :: dtidx(:,:), index_of_temperature, index_of_x_wind, & + real(kind=kind_phys), intent(inout), optional :: dtend(:,:,:) + integer, intent(in) :: dtidx(:,:) + integer, intent(in) :: index_of_temperature, index_of_x_wind, & index_of_y_wind, index_of_process_nonorographic_gwd, & index_of_process_orographic_gwd logical, intent(in) :: ldiag3d, lssav ! These arrays only allocated if ldiag_ugwp = .true. - real(kind=kind_phys), intent(inout), dimension(:,:) :: du3dt_mtb, du3dt_ogw, du3dt_tms + real(kind=kind_phys), intent(inout), dimension(:,:), optional :: du3dt_mtb, du3dt_ogw, du3dt_tms real(kind=kind_phys), intent(inout), dimension(:,:) :: dudt, dvdt, dtdt @@ -342,9 +345,13 @@ subroutine unified_ugwp_run(me, master, im, levs, ak,bk, ntrac, dtp, fhzero, kdt do_gsl_drag_ls_bl, do_gsl_drag_ss, & do_gsl_drag_tofd - real(kind=kind_phys), intent(in) :: spp_wts_gwd(:,:) + real(kind=kind_phys), intent(in), optional :: spp_wts_gwd(:,:) integer, intent(in) :: spp_gwd + ! option for psl gwd + logical, intent(in) :: do_gwd_opt_psl ! option for psl gravity wave drag + real(kind=kind_phys), intent(in) :: psl_gwd_dx_factor ! + character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -378,6 +385,18 @@ subroutine unified_ugwp_run(me, master, im, levs, ak,bk, ntrac, dtp, fhzero, kdt errflg = 0 + ! Initialize intent(out) variables in case they are not set below + dusfcg(:) = 0.0 + dvsfcg(:) = 0.0 + rdxzb(:) = 0.0 + tau_ngw(:) = 0.0 + gw_dudt(:,:) = 0.0 + gw_dvdt(:,:) = 0.0 + gw_dtdt(:,:) = 0.0 + gw_kdis(:,:) = 0.0 + dudt_mtb(:,:) = 0.0 + dudt_tms(:,:) = 0.0 + ! 1) ORO stationary GWs ! ------------------ @@ -487,7 +506,27 @@ subroutine unified_ugwp_run(me, master, im, levs, ak,bk, ntrac, dtp, fhzero, kdt ! Note: In case of GSL drag_suite, this includes ss and tofd if ( do_gsl_drag_ls_bl.or.do_gsl_drag_ss.or.do_gsl_drag_tofd ) then - +! + if (do_gwd_opt_psl) then + call drag_suite_psl(im,levs,dvdt,dudt,dtdt,uwnd1,vwnd1, & + tgrs,q1,kpbl,prsi,del,prsl,prslk,phii,phil,dtp, & + kdt,hprime,oc,oa4,clx,varss,oc1ss,oa4ss, & + ol4ss,theta,sigma,gamma,elvmax,dtaux2d_ms, & + dtauy2d_ms,dtaux2d_bl,dtauy2d_bl,dtaux2d_ss, & + dtauy2d_ss,dtaux2d_fd,dtauy2d_fd,dusfcg, & + dvsfcg,dusfc_ms,dvsfc_ms,dusfc_bl,dvsfc_bl, & + dusfc_ss,dvsfc_ss,dusfc_fd,dvsfc_fd, & + slmsk,br1,hpbl,vtype,con_g,con_cp,con_rd,con_rv, & + con_fvirt,con_pi,lonr, & + cdmbgwd,alpha_fd,me,master, & + lprnt,ipr,rdxzb,dx,gwd_opt, & + do_gsl_drag_ls_bl,do_gsl_drag_ss,do_gsl_drag_tofd, & + psl_gwd_dx_factor, & + dtend, dtidx, index_of_process_orographic_gwd, & + index_of_temperature, index_of_x_wind, & + index_of_y_wind, ldiag3d, ldiag_ugwp, & + ugwp_seq_update, spp_wts_gwd, spp_gwd, errmsg, errflg) + else call drag_suite_run(im,levs,dvdt,dudt,dtdt,uwnd1,vwnd1, & tgrs,q1,kpbl,prsi,del,prsl,prslk,phii,phil,dtp, & kdt,hprime,oc,oa4,clx,varss,oc1ss,oa4ss, & @@ -498,12 +537,14 @@ subroutine unified_ugwp_run(me, master, im, levs, ak,bk, ntrac, dtp, fhzero, kdt dusfc_ss,dvsfc_ss,dusfc_fd,dvsfc_fd, & slmsk,br1,hpbl,con_g,con_cp,con_rd,con_rv, & con_fvirt,con_pi,lonr, & - cdmbgwd,me,master,lprnt,ipr,rdxzb,dx,gwd_opt, & + cdmbgwd,alpha_fd,me,master, & + lprnt,ipr,rdxzb,dx,gwd_opt, & do_gsl_drag_ls_bl,do_gsl_drag_ss,do_gsl_drag_tofd, & dtend, dtidx, index_of_process_orographic_gwd, & index_of_temperature, index_of_x_wind, & index_of_y_wind, ldiag3d, ldiag_ugwp, & ugwp_seq_update, spp_wts_gwd, spp_gwd, errmsg, errflg) + endif ! ! put zeros due to xy GSL-drag style: dtaux2d_bl,dtauy2d_bl,dtaux2d_ss.......dusfc_ms,dvsfc_ms ! diff --git a/physics/unified_ugwp.meta b/physics/GWD/unified_ugwp.meta similarity index 95% rename from physics/unified_ugwp.meta rename to physics/GWD/unified_ugwp.meta index 8af99957a..91f63f03e 100644 --- a/physics/unified_ugwp.meta +++ b/physics/GWD/unified_ugwp.meta @@ -1,10 +1,10 @@ [ccpp-table-properties] name = unified_ugwp type = scheme - - dependencies=cires_ugwp_triggers.F90,cires_ugwp_initialize.F90 - dependencies=cires_orowam2017.f, cires_ugwp_module.F90,gwdps.f,machine.F,ugwp_driver_v0.F - dependencies=drag_suite.F90 + dependencies = ../hooks/machine.F + dependencies = cires_ugwp_triggers.F90,cires_ugwp_initialize.F90 + dependencies = cires_orowam2017.f,cires_ugwp_module.F90,gwdps.f,ugwp_driver_v0.F + dependencies = drag_suite.F90 ######################################################################## [ccpp-arg-table] @@ -448,6 +448,7 @@ type = real kind = kind_phys intent = in + optional = True [oc1ss] standard_name = convexity_of_subgrid_orography_small_scale long_name = convexity of subgrid height_above_mean_sea_level small scale @@ -456,6 +457,7 @@ type = real kind = kind_phys intent = in + optional = True [oa4ss] standard_name = asymmetry_of_subgrid_orography_small_scale long_name = asymmetry of subgrid height_above_mean_sea_level small scale @@ -464,6 +466,7 @@ type = real kind = kind_phys intent = in + optional = True [ol4ss] standard_name = fraction_of_grid_box_with_subgrid_orography_higher_than_critical_height_small_scale long_name = horizontal fraction of grid box covered by subgrid height_above_mean_sea_level higher than critical height small scale @@ -472,6 +475,7 @@ type = real kind = kind_phys intent = in + optional = True [dx] standard_name = characteristic_grid_lengthscale long_name = size of the grid cell @@ -488,6 +492,7 @@ type = real kind = kind_phys intent = out + optional = True [dvsfc_ms] standard_name = vertically_integrated_y_momentum_flux_due_to_mesoscale_orographic_gravity_wave_drag long_name = integrated y momentum flux from mesoscale gwd @@ -496,6 +501,7 @@ type = real kind = kind_phys intent = out + optional = True [dusfc_bl] standard_name = vertically_integrated_x_momentum_flux_due_to_blocking_drag long_name = integrated x momentum flux from blocking drag @@ -504,6 +510,7 @@ type = real kind = kind_phys intent = out + optional = True [dvsfc_bl] standard_name = vertically_integrated_y_momentum_flux_due_to_blocking_drag long_name = integrated y momentum flux from blocking drag @@ -512,6 +519,7 @@ type = real kind = kind_phys intent = out + optional = True [dusfc_ss] standard_name = vertically_integrated_x_momentum_flux_due_to_small_scale_gravity_wave_drag long_name = integrated x momentum flux from small scale gwd @@ -520,6 +528,7 @@ type = real kind = kind_phys intent = out + optional = True [dvsfc_ss] standard_name = vertically_integrated_y_momentum_flux_due_to_small_scale_gravity_wave_drag long_name = integrated y momentum flux from small scale gwd @@ -528,6 +537,7 @@ type = real kind = kind_phys intent = out + optional = True [dusfc_fd] standard_name = vertically_integrated_x_momentum_flux_due_to_form_drag long_name = integrated x momentum flux from form drag @@ -536,6 +546,7 @@ type = real kind = kind_phys intent = out + optional = True [dvsfc_fd] standard_name = vertically_integrated_y_momentum_flux_due_to_form_drag long_name = integrated y momentum flux from form drag @@ -544,6 +555,7 @@ type = real kind = kind_phys intent = out + optional = True [dtaux2d_ms] standard_name = tendency_of_x_wind_due_to_mesoscale_orographic_gravity_wave_drag long_name = instantaneous change in x wind due to orographic gw drag @@ -552,6 +564,7 @@ type = real kind = kind_phys intent = out + optional = True [dtauy2d_ms] standard_name = tendency_of_y_wind_due_to_mesoscale_orographic_gravity_wave_drag long_name = instantaneous change in y wind due to orographic gw drag @@ -560,6 +573,7 @@ type = real kind = kind_phys intent = out + optional = True [dtaux2d_bl] standard_name = tendency_of_x_wind_due_to_blocking_drag long_name = x wind tendency from blocking drag @@ -568,6 +582,7 @@ type = real kind = kind_phys intent = out + optional = True [dtauy2d_bl] standard_name = tendency_of_y_wind_due_to_blocking_drag long_name = y wind tendency from blocking drag @@ -576,6 +591,7 @@ type = real kind = kind_phys intent = out + optional = True [dtaux2d_ss] standard_name = tendency_of_x_wind_due_to_small_scale_gravity_wave_drag long_name = x wind tendency from small scale gwd @@ -584,6 +600,7 @@ type = real kind = kind_phys intent = out + optional = True [dtauy2d_ss] standard_name = tendency_of_y_wind_due_to_small_scale_gravity_wave_drag long_name = y wind tendency from small scale gwd @@ -592,6 +609,7 @@ type = real kind = kind_phys intent = out + optional = True [dtaux2d_fd] standard_name = tendency_of_x_wind_due_to_form_drag long_name = x wind tendency from form drag @@ -600,6 +618,7 @@ type = real kind = kind_phys intent = out + optional = True [dtauy2d_fd] standard_name = tendency_of_y_wind_due_to_form_drag long_name = y wind tendency from form drag @@ -608,6 +627,7 @@ type = real kind = kind_phys intent = out + optional = True [dudt_ngw] standard_name = tendency_of_x_wind_due_to_nonorographic_gravity_wave_drag long_name = zonal wind tendency due to non-stationary GWs @@ -616,6 +636,7 @@ type = real kind = kind_phys intent = out + optional = True [dvdt_ngw] standard_name = tendency_of_y_wind_due_to_nonorographic_gravity_wave_drag long_name = meridional wind tendency due to non-stationary GWs @@ -624,6 +645,7 @@ type = real kind = kind_phys intent = out + optional = True [dtdt_ngw] standard_name = tendency_of_air_temperature_due_to_nonorographic_gravity_wave_drag long_name = air temperature tendency due to non-stationary GWs @@ -632,6 +654,7 @@ type = real kind = kind_phys intent = out + optional = True [br1] standard_name = bulk_richardson_number_at_lowest_model_level long_name = bulk Richardson number at the surface @@ -648,6 +671,13 @@ type = real kind = kind_phys intent = in +[vtype] + standard_name = vegetation_type_classification + long_name = vegetation type for lsm + units = index + dimensions = (horizontal_loop_extent) + type = integer + intent = in [slmsk] standard_name = area_type long_name = landmask: sea/land/ice=0/1/2 @@ -685,6 +715,14 @@ type = real kind = kind_phys intent = in +[alpha_fd] + standard_name = alpha_coefficient_for_turbulent_orographic_form_drag + long_name = alpha coefficient for Beljaars et al turbulent orographic form drag + units = 1 + dimensions = () + type = real + kind = kind_phys + intent = in [jdat] standard_name = date_and_time_of_forecast_in_united_states_order long_name = current forecast date and time @@ -900,30 +938,6 @@ type = real kind = kind_phys intent = out -[zmtb] - standard_name = height_of_mountain_blocking - long_name = height of mountain blocking drag - units = m - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = out -[zlwb] - standard_name = height_of_low_level_wave_breaking - long_name = height of low level wave breaking - units = m - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = out -[zogw] - standard_name = height_of_launch_level_of_orographic_gravity_wave - long_name = height of launch level of orographic gravity wave - units = m - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = out [dudt_mtb] standard_name = instantaneous_change_in_x_wind_due_to_mountain_blocking_drag long_name = instantaneous change in x wind due to mountain blocking drag @@ -948,6 +962,7 @@ type = real kind = kind_phys intent = inout + optional = True [du3dt_ogw] standard_name = time_integral_of_change_in_x_wind_due_to_orographic_gravity_wave_drag long_name = time integral of change in x wind due to orographic gw drag @@ -956,6 +971,7 @@ type = real kind = kind_phys intent = inout + optional = True [du3dt_tms] standard_name = time_integral_of_change_in_x_wind_due_to_turbulent_orographic_form_drag long_name = time integral of change in x wind due to TOFD @@ -964,6 +980,7 @@ type = real kind = kind_phys intent = inout + optional = True [dudt] standard_name = process_split_cumulative_tendency_of_x_wind long_name = zonal wind tendency due to model physics @@ -1120,6 +1137,7 @@ type = real kind = kind_phys intent = inout + optional = True [dtidx] standard_name = cumulative_change_of_state_variables_outer_index long_name = index of state-variable and process in last dimension of diagnostic tendencies array AKA cumulative_change_index @@ -1218,6 +1236,21 @@ dimensions = () type = logical intent = in +[do_gwd_opt_psl] + standard_name = do_gsl_drag_suite_with_psl_gwd_option + long_name = flag to activate PSL drag suite - mesoscale GWD and blocking + units = flag + dimensions = () + type = logical + intent = in +[psl_gwd_dx_factor] + standard_name = effective_grid_spacing_of_psl_gwd_suite + long_name = multiplication of grid spacing + units = 1 + dimensions = () + type = real + kind = kind_phys + intent = in [gwd_opt] standard_name = control_for_drag_suite_gravity_wave_drag long_name = flag to choose gwd scheme @@ -1233,6 +1266,7 @@ type = real kind = kind_phys intent = in + optional = True [spp_gwd] standard_name = control_for_gravity_wave_drag_spp_perturbations long_name = control for gravity wave drag spp perturbations diff --git a/physics/unified_ugwp_post.F90 b/physics/GWD/unified_ugwp_post.F90 similarity index 72% rename from physics/unified_ugwp_post.F90 rename to physics/GWD/unified_ugwp_post.F90 index 9c3717546..47ad40ba9 100644 --- a/physics/unified_ugwp_post.F90 +++ b/physics/GWD/unified_ugwp_post.F90 @@ -42,23 +42,24 @@ subroutine unified_ugwp_post_run (ldiag3d, ldiag_ugwp, & real(kind=kind_phys), intent(inout), dimension(:) :: tot_mtb, tot_ogw, tot_tofd, tot_ngw real(kind=kind_phys), intent(inout), dimension(:) :: tot_zmtb, tot_zlwb, tot_zogw real(kind=kind_phys), intent(in), dimension(:,:) :: gw_dtdt, gw_dudt, gw_dvdt, dudt_mtb - real(kind=kind_phys), intent(in), dimension(:,:) :: dudt_ogw, dvdt_ogw, dudt_tms - real(kind=kind_phys), intent(inout), dimension(:,:) :: du3dt_mtb, du3dt_ogw, du3dt_tms, du3dt_ngw, dv3dt_ngw - real(kind=kind_phys), intent(inout), dimension(:,:) :: ldu3dt_ogw, ldu3dt_obl, ldu3dt_oss, ldu3dt_ofd - real(kind=kind_phys), intent(in), dimension(:,:) :: dudt_ngw, dvdt_ngw, dtdt_ngw - real(kind=kind_phys), intent(inout), dimension(:,:) :: ldu3dt_ngw, ldv3dt_ngw, ldt3dt_ngw - real(kind=kind_phys), intent(in), dimension(:,:) :: dudt_obl, dvdt_obl - real(kind=kind_phys), intent(in), dimension(:,:) :: dudt_oss, dvdt_oss, dudt_ofd, dvdt_ofd - real(kind=kind_phys), intent(inout), dimension(:,:) :: dws3dt_obl, dws3dt_ogw - real(kind=kind_phys), intent(inout), dimension(:,:) :: dws3dt_oss, dws3dt_ofd - real(kind=kind_phys), intent(in), dimension(:) :: du_ogwcol, dv_ogwcol - real(kind=kind_phys), intent(in), dimension(:) :: du_oblcol, dv_oblcol - real(kind=kind_phys), intent(in), dimension(:) :: du_osscol, dv_osscol - real(kind=kind_phys), intent(in), dimension(:) :: du_ofdcol, dv_ofdcol - real(kind=kind_phys), intent(inout), dimension(:) :: du3_ogwcol, dv3_ogwcol - real(kind=kind_phys), intent(inout), dimension(:) :: du3_oblcol, dv3_oblcol - real(kind=kind_phys), intent(inout), dimension(:) :: du3_osscol, dv3_osscol - real(kind=kind_phys), intent(inout), dimension(:) :: du3_ofdcol, dv3_ofdcol + real(kind=kind_phys), intent(in), dimension(:,:), optional :: dudt_ogw, dvdt_ogw + real(kind=kind_phys), intent(in), dimension(:,:) :: dudt_tms + real(kind=kind_phys), intent(inout), dimension(:,:), optional :: du3dt_mtb, du3dt_ogw, du3dt_tms, du3dt_ngw, dv3dt_ngw + real(kind=kind_phys), intent(inout), dimension(:,:), optional :: ldu3dt_ogw, ldu3dt_obl, ldu3dt_oss, ldu3dt_ofd + real(kind=kind_phys), intent(in), dimension(:,:), optional :: dudt_ngw, dvdt_ngw, dtdt_ngw + real(kind=kind_phys), intent(inout), dimension(:,:), optional :: ldu3dt_ngw, ldv3dt_ngw, ldt3dt_ngw + real(kind=kind_phys), intent(in), dimension(:,:), optional :: dudt_obl, dvdt_obl + real(kind=kind_phys), intent(in), dimension(:,:), optional :: dudt_oss, dvdt_oss, dudt_ofd, dvdt_ofd + real(kind=kind_phys), intent(inout), dimension(:,:), optional :: dws3dt_obl, dws3dt_ogw + real(kind=kind_phys), intent(inout), dimension(:,:), optional :: dws3dt_oss, dws3dt_ofd + real(kind=kind_phys), intent(in), dimension(:), optional :: du_ogwcol, dv_ogwcol + real(kind=kind_phys), intent(in), dimension(:), optional :: du_oblcol, dv_oblcol + real(kind=kind_phys), intent(in), dimension(:), optional :: du_osscol, dv_osscol + real(kind=kind_phys), intent(in), dimension(:), optional :: du_ofdcol, dv_ofdcol + real(kind=kind_phys), intent(inout), dimension(:), optional :: du3_ogwcol, dv3_ogwcol + real(kind=kind_phys), intent(inout), dimension(:), optional :: du3_oblcol, dv3_oblcol + real(kind=kind_phys), intent(inout), dimension(:), optional :: du3_osscol, dv3_osscol + real(kind=kind_phys), intent(inout), dimension(:), optional :: du3_ofdcol, dv3_ofdcol real(kind=kind_phys), intent(inout), dimension(:,:) :: dtdt, dudt, dvdt character(len=*), intent(out) :: errmsg diff --git a/physics/unified_ugwp_post.meta b/physics/GWD/unified_ugwp_post.meta similarity index 95% rename from physics/unified_ugwp_post.meta rename to physics/GWD/unified_ugwp_post.meta index 6da6342df..d129b046f 100644 --- a/physics/unified_ugwp_post.meta +++ b/physics/GWD/unified_ugwp_post.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = unified_ugwp_post type = scheme - dependencies = machine.F + dependencies = ../hooks/machine.F ######################################################################## [ccpp-arg-table] @@ -139,6 +139,7 @@ type = real kind = kind_phys intent = in + optional = True [dvdt_ogw] standard_name = tendency_of_y_wind_due_to_mesoscale_orographic_gravity_wave_drag long_name = y momentum tendency from meso scale ogw @@ -147,6 +148,7 @@ type = real kind = kind_phys intent = in + optional = True [dudt_tms] standard_name = tendency_of_x_wind_due_to_turbulent_orographic_form_drag long_name = instantaneous change in x wind due to TOFD @@ -219,6 +221,7 @@ type = real kind = kind_phys intent = inout + optional = True [du3dt_ogw] standard_name = time_integral_of_change_in_x_wind_due_to_orographic_gravity_wave_drag long_name = time integral of change in x wind due to orographic gw drag @@ -227,6 +230,7 @@ type = real kind = kind_phys intent = inout + optional = True [du3dt_tms] standard_name = time_integral_of_change_in_x_wind_due_to_turbulent_orographic_form_drag long_name = time integral of change in x wind due to TOFD @@ -235,6 +239,7 @@ type = real kind = kind_phys intent = inout + optional = True [du3dt_ngw] standard_name = time_integral_of_change_in_x_wind_due_to_nonstationary_gravity_wave long_name = time integral of change in x wind due to NGW @@ -243,6 +248,7 @@ type = real kind = kind_phys intent = inout + optional = True [dv3dt_ngw] standard_name = time_integral_of_change_in_y_wind_due_to_nonstationary_gravity_wave long_name = time integral of change in y wind due to NGW @@ -251,6 +257,7 @@ type = real kind = kind_phys intent = inout + optional = True [ldu3dt_ogw] standard_name = cumulative_change_in_x_wind_due_to_mesoscale_orographic_gravity_wave_drag long_name = cumulative change in x wind due to mesoscale orographic gravity wave drag @@ -259,6 +266,7 @@ type = real kind = kind_phys intent = inout + optional = True [ldu3dt_obl] standard_name = cumulative_change_in_x_wind_due_to_blocking_drag long_name = cumulative change in x wind due to blocking drag @@ -267,6 +275,7 @@ type = real kind = kind_phys intent = inout + optional = True [ldu3dt_oss] standard_name = cumulative_change_in_x_wind_due_to_small_scale_gravity_wave_drag long_name = cumulative change in x wind due to small scale gravity wave drag @@ -275,6 +284,7 @@ type = real kind = kind_phys intent = inout + optional = True [ldu3dt_ofd] standard_name = cumulative_change_in_x_wind_due_to_form_drag long_name = cumulative change in x wind due to form drag @@ -283,6 +293,7 @@ type = real kind = kind_phys intent = inout + optional = True [dudt_ngw] standard_name = tendency_of_x_wind_due_to_nonorographic_gravity_wave_drag long_name = zonal wind tendency due to non-stationary GWs @@ -291,6 +302,7 @@ type = real kind = kind_phys intent = in + optional = True [dvdt_ngw] standard_name = tendency_of_y_wind_due_to_nonorographic_gravity_wave_drag long_name = meridional wind tendency due to non-stationary GWs @@ -299,6 +311,7 @@ type = real kind = kind_phys intent = in + optional = True [dtdt_ngw] standard_name = tendency_of_air_temperature_due_to_nonorographic_gravity_wave_drag long_name = air temperature tendency due to non-stationary GWs @@ -307,6 +320,7 @@ type = real kind = kind_phys intent = in + optional = True [ldu3dt_ngw] standard_name = cumulative_change_in_x_wind_due_to_convective_gravity_wave_drag long_name = cumulative change in x wind due to convective gravity wave drag @@ -315,6 +329,7 @@ type = real kind = kind_phys intent = inout + optional = True [ldv3dt_ngw] standard_name = cumulative_change_in_y_wind_due_to_convective_gravity_wave_drag long_name = cumulative change in y wind due to convective gravity wave drag @@ -323,6 +338,7 @@ type = real kind = kind_phys intent = inout + optional = True [ldt3dt_ngw] standard_name = cumulative_change_in_temperature_due_to_convective_gravity_wave_drag long_name = cumulative change in temperature due to convective gravity wave drag @@ -331,6 +347,7 @@ type = real kind = kind_phys intent = inout + optional = True [dudt_obl] standard_name = tendency_of_x_wind_due_to_blocking_drag long_name = x wind tendency from blocking drag @@ -339,6 +356,7 @@ type = real kind = kind_phys intent = in + optional = True [dvdt_obl] standard_name = tendency_of_y_wind_due_to_blocking_drag long_name = y wind tendency from blocking drag @@ -347,6 +365,7 @@ type = real kind = kind_phys intent = in + optional = True [dudt_oss] standard_name = tendency_of_x_wind_due_to_small_scale_gravity_wave_drag long_name = x wind tendency from small scale gwd @@ -355,6 +374,7 @@ type = real kind = kind_phys intent = in + optional = True [dvdt_oss] standard_name = tendency_of_y_wind_due_to_small_scale_gravity_wave_drag long_name = y wind tendency from small scale gwd @@ -363,6 +383,7 @@ type = real kind = kind_phys intent = in + optional = True [dudt_ofd] standard_name = tendency_of_x_wind_due_to_form_drag long_name = x wind tendency from form drag @@ -371,6 +392,7 @@ type = real kind = kind_phys intent = in + optional = True [dvdt_ofd] standard_name = tendency_of_y_wind_due_to_form_drag long_name = y wind tendency from form drag @@ -379,6 +401,7 @@ type = real kind = kind_phys intent = in + optional = True [dws3dt_ogw] standard_name = cumulative_change_in_wind_speed_due_to_mesoscale_orographic_gravity_wave_drag long_name = cumulative change in wind speed due to mesoscale orographic gravity wave drag @@ -387,6 +410,7 @@ type = real kind = kind_phys intent = inout + optional = True [dws3dt_obl] standard_name = cumulative_change_in_wind_speed_due_to_blocking_drag long_name = cumulative change in wind speed due to blocking drag @@ -395,6 +419,7 @@ type = real kind = kind_phys intent = inout + optional = True [dws3dt_oss] standard_name = cumulative_change_in_wind_speed_due_to_small_scale_orographic_gravity_wave_drag long_name = cumulative change in wind speed due to small scale orographic gravity wave drag @@ -403,6 +428,7 @@ type = real kind = kind_phys intent = inout + optional = True [dws3dt_ofd] standard_name = cumulative_change_in_wind_speed_due_to_turbulent_orographic_form_drag long_name = cumulative change in wind speed due to turbulent orographic form drag @@ -411,6 +437,7 @@ type = real kind = kind_phys intent = inout + optional = True [du_ogwcol] standard_name = vertically_integrated_x_momentum_flux_due_to_mesoscale_orographic_gravity_wave_drag long_name = integrated x momentum flux from meso scale ogw @@ -419,6 +446,7 @@ type = real kind = kind_phys intent = in + optional = True [dv_ogwcol] standard_name = vertically_integrated_y_momentum_flux_due_to_mesoscale_orographic_gravity_wave_drag long_name = integrated y momentum flux from meso scale ogw @@ -427,6 +455,7 @@ type = real kind = kind_phys intent = in + optional = True [du_oblcol] standard_name = vertically_integrated_x_momentum_flux_due_to_blocking_drag long_name = integrated x momentum flux from blocking drag @@ -435,6 +464,7 @@ type = real kind = kind_phys intent = in + optional = True [dv_oblcol] standard_name = vertically_integrated_y_momentum_flux_due_to_blocking_drag long_name = integrated y momentum flux from blocking drag @@ -443,6 +473,7 @@ type = real kind = kind_phys intent = in + optional = True [du_osscol] standard_name = vertically_integrated_x_momentum_flux_due_to_small_scale_gravity_wave_drag long_name = integrated x momentum flux from small scale gwd @@ -451,6 +482,7 @@ type = real kind = kind_phys intent = in + optional = True [dv_osscol] standard_name = vertically_integrated_y_momentum_flux_due_to_small_scale_gravity_wave_drag long_name = integrated y momentum flux from small scale gwd @@ -459,6 +491,7 @@ type = real kind = kind_phys intent = in + optional = True [du_ofdcol] standard_name = vertically_integrated_x_momentum_flux_due_to_form_drag long_name = integrated x momentum flux from form drag @@ -467,6 +500,7 @@ type = real kind = kind_phys intent = in + optional = True [dv_ofdcol] standard_name = vertically_integrated_y_momentum_flux_due_to_form_drag long_name = integrated y momentum flux from form drag @@ -475,6 +509,7 @@ type = real kind = kind_phys intent = in + optional = True [du3_ogwcol] standard_name = cumulative_vertically_integrated_x_momentum_flux_due_to_mesoscale_orographic_gravity_wave_drag long_name = cumulative integrated x momentum flux from mesoscale orographic gravity wave drag @@ -483,6 +518,7 @@ type = real kind = kind_phys intent = inout + optional = True [dv3_ogwcol] standard_name = cumulative_vertically_integrated_y_momentum_flux_due_to_mesoscale_orographic_gravity_wave_drag long_name = cumulative integrated y momentum flux from mesoscale orographic gravity wave drag @@ -491,6 +527,7 @@ type = real kind = kind_phys intent = inout + optional = True [du3_oblcol] standard_name = cumulative_vertically_integrated_x_momentum_flux_due_to_blocking_drag long_name = cumulative integrated x momentum flux from blocking drag @@ -499,6 +536,7 @@ type = real kind = kind_phys intent = inout + optional = True [dv3_oblcol] standard_name = cumulative_vertically_integrated_y_momentum_flux_due_to_blocking_drag long_name = cumulative integrated y momentum flux from blocking drag @@ -507,6 +545,7 @@ type = real kind = kind_phys intent = inout + optional = True [du3_osscol] standard_name = cumulative_vertically_integrated_x_momentum_flux_due_to_small_scale_gravity_wave_drag long_name = cumulative integrated x momentum flux from small scale gravity wave drag @@ -515,6 +554,7 @@ type = real kind = kind_phys intent = inout + optional = True [dv3_osscol] standard_name = cumulative_vertically_integrated_y_momentum_flux_due_small_scale_gravity_wave_drag long_name = cumulative integrated y momentum flux from small scale gravity wave drag @@ -523,6 +563,7 @@ type = real kind = kind_phys intent = inout + optional = True [du3_ofdcol] standard_name = cumulative_vertically_integrated_x_momentum_flux_due_to_form_drag long_name = cumulative integrated x momentum flux from form drag @@ -531,6 +572,7 @@ type = real kind = kind_phys intent = inout + optional = True [dv3_ofdcol] standard_name = cumulative_vertically_integrated_y_momentum_flux_due_to_form_drag long_name = cumulative integrated y momentum flux from form drag @@ -539,6 +581,7 @@ type = real kind = kind_phys intent = inout + optional = True [dtdt] standard_name = process_split_cumulative_tendency_of_air_temperature long_name = air temperature tendency due to model physics diff --git a/physics/GFS_DCNV_generic_post.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_DCNV_generic_post.F90 similarity index 88% rename from physics/GFS_DCNV_generic_post.F90 rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_DCNV_generic_post.F90 index 51a228122..da255adc8 100644 --- a/physics/GFS_DCNV_generic_post.F90 +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_DCNV_generic_post.F90 @@ -15,7 +15,7 @@ subroutine GFS_DCNV_generic_post_run (im, levs, lssav, ldiag3d, qdiag3d, ras, & index_of_temperature, index_of_x_wind, index_of_y_wind, ntqv, gq0, save_q, & cnvw, cnvc, cnvw_phy_f3d, cnvc_phy_f3d, flag_for_dcnv_generic_tend, & ntcw,ntiw,ntclamt,ntrw,ntsw,ntrnc,ntsnc,ntgl, & - ntgnc, nthl, nthnc, nthv, ntgv, ntsigma, ntrac,clw, & + ntgnc, nthl, nthnc, nthv, ntgv, ntrz, ntgz, nthz, ntsigma, ntrac,clw, & satmedmf, trans_trac, errmsg, errflg) @@ -32,24 +32,26 @@ subroutine GFS_DCNV_generic_post_run (im, levs, lssav, ldiag3d, qdiag3d, ras, & real(kind=kind_phys), dimension(:,:), intent(in) :: save_u, save_v, save_t real(kind=kind_phys), dimension(:,:), intent(in) :: gu0, gv0, gt0 real(kind=kind_phys), dimension(:,:,:), intent(in) :: gq0, save_q - real(kind=kind_phys), dimension(:,:), intent(in) :: ud_mf, dd_mf, dt_mf + real(kind=kind_phys), dimension(:,:), intent(in) :: dd_mf, dt_mf + real(kind=kind_phys), dimension(:,:), intent(in), optional :: ud_mf real(kind=kind_phys), intent(in) :: con_g integer, intent(in) :: npdf3d, num_p3d, ncnvcld3d logical, intent(in) :: satmedmf, trans_trac real(kind=kind_phys), dimension(:), intent(inout) :: rainc, cldwrk - real(kind=kind_phys), dimension(:,:), intent(inout) :: upd_mf, dwn_mf, det_mf + real(kind=kind_phys), dimension(:,:), intent(inout), optional :: upd_mf, dwn_mf, det_mf real(kind=kind_phys), dimension(:,:), intent(inout) :: cnvw, cnvc - real(kind=kind_phys), dimension(:,:,:), intent(inout) :: dtend + real(kind=kind_phys), dimension(:,:,:), intent(inout), optional :: dtend integer, intent(in) :: dtidx(:,:), index_of_process_dcnv, index_of_temperature, & index_of_x_wind, index_of_y_wind, ntqv - integer, intent(in) :: ntcw,ntiw,ntclamt,ntrw,ntsw,ntrnc,ntsnc,ntgl, & - ntgnc, nthl, nthnc, nthv, ntgv, ntsigma, ntrac + integer, intent(in) :: ntcw,ntiw,ntclamt,ntrw,ntsw,ntrnc,ntsnc,ntgl, & + ntgnc, nthl, nthnc, nthv, ntgv, ntrz, ntgz, nthz, & + ntsigma, ntrac real(kind=kind_phys), dimension(:,:,:), intent(in) :: clw - real(kind=kind_phys), dimension(:,:), intent(inout) :: cnvw_phy_f3d, cnvc_phy_f3d + real(kind=kind_phys), dimension(:,:), intent(inout), optional :: cnvw_phy_f3d, cnvc_phy_f3d character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -112,6 +114,7 @@ subroutine GFS_DCNV_generic_post_run (im, levs, lssav, ldiag3d, qdiag3d, ras, & n /= ntrw .and. n /= ntsw .and. n /= ntrnc .and. & n /= ntsnc .and. n /= ntgl .and. n /= ntgnc .and. & n /= nthl .and. n /= nthnc .and. n /= nthv .and. & + n /= ntrz .and. n /= ntgz .and. n /= nthz .and. & n /= ntgv .and. n /= ntsigma) then tracers = tracers + 1 idtend = dtidx(100+n,index_of_process_dcnv) diff --git a/physics/GFS_DCNV_generic_post.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_DCNV_generic_post.meta similarity index 94% rename from physics/GFS_DCNV_generic_post.meta rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_DCNV_generic_post.meta index 8428752ce..30bc93ccd 100644 --- a/physics/GFS_DCNV_generic_post.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_DCNV_generic_post.meta @@ -2,7 +2,7 @@ [ccpp-table-properties] name = GFS_DCNV_generic_post type = scheme - dependencies = machine.F + dependencies = ../../hooks/machine.F ######################################################################## [ccpp-arg-table] @@ -138,6 +138,7 @@ type = real kind = kind_phys intent = in + optional = True [dd_mf] standard_name = instantaneous_atmosphere_downdraft_convective_mass_flux long_name = (downdraft mass flux) * delt @@ -162,6 +163,7 @@ type = real kind = kind_phys intent = inout + optional = True [dtidx] standard_name = cumulative_change_of_state_variables_outer_index long_name = index of state-variable and process in last dimension of diagnostic tendencies array AKA cumulative_change_index @@ -280,6 +282,7 @@ type = real kind = kind_phys intent = inout + optional = True [dwn_mf] standard_name = cumulative_atmosphere_downdraft_convective_mass_flux long_name = cumulative downdraft mass flux @@ -288,6 +291,7 @@ type = real kind = kind_phys intent = inout + optional = True [det_mf] standard_name = cumulative_atmosphere_detrainment_convective_mass_flux long_name = cumulative detrainment mass flux @@ -296,6 +300,7 @@ type = real kind = kind_phys intent = inout + optional = True [cnvw] standard_name = convective_cloud_water_mixing_ratio long_name = moist convective cloud water mixing ratio @@ -320,6 +325,7 @@ type = real kind = kind_phys intent = inout + optional = True [cnvc_phy_f3d] standard_name = convective_cloud_area_fraction long_name = convective cloud cover in the phy_f3d array @@ -328,6 +334,7 @@ type = real kind = kind_phys intent = inout + optional = True [flag_for_dcnv_generic_tend] standard_name = flag_for_generic_tendency_due_to_deep_convection long_name = true if GFS_DCNV_generic should calculate tendencies @@ -454,6 +461,27 @@ dimensions = () type = integer intent = in +[ntrz] + standard_name = index_of_reflectivity_of_rain_in_tracer_concentration_array + long_name = tracer index for rain reflectivity + units = index + dimensions = () + type = integer + intent = in +[ntgz] + standard_name = index_of_reflectivity_of_graupel_in_tracer_concentration_array + long_name = tracer index for graupel reflectivity + units = index + dimensions = () + type = integer + intent = in +[nthz] + standard_name = index_of_reflectivity_of_hail_in_tracer_concentration_array + long_name = tracer index for hail reflectivity + units = index + dimensions = () + type = integer + intent = in [clw] standard_name = convective_transportable_tracers long_name = array to contain cloud water and other convective trans. tracers diff --git a/physics/GFS_DCNV_generic_pre.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_DCNV_generic_pre.F90 similarity index 93% rename from physics/GFS_DCNV_generic_pre.F90 rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_DCNV_generic_pre.F90 index b31daf5d6..1dd3aafc7 100644 --- a/physics/GFS_DCNV_generic_pre.F90 +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_DCNV_generic_pre.F90 @@ -13,7 +13,8 @@ subroutine GFS_DCNV_generic_pre_run (im, levs, ldiag3d, qdiag3d, do_cnvgwd, cplc gu0, gv0, gt0, gq0, nsamftrac, ntqv, & save_u, save_v, save_t, save_q, clw, & ntcw,ntiw,ntclamt,ntrw,ntsw,ntrnc,ntsnc,ntgl, & - ntgnc, nthl, nthnc, nthv, ntgv,ntsigma, & + ntgnc, nthl, nthnc, nthv, ntgv, & + ntrz, ntgz, nthz, ntsigma, & cscnv, satmedmf, trans_trac, ras, ntrac, & dtidx, index_of_process_dcnv, errmsg, errflg) @@ -22,7 +23,8 @@ subroutine GFS_DCNV_generic_pre_run (im, levs, ldiag3d, qdiag3d, do_cnvgwd, cplc implicit none integer, intent(in) :: im, levs, nsamftrac, ntqv, index_of_process_dcnv, dtidx(:,:), & - ntcw,ntiw,ntclamt,ntrw,ntsw,ntrnc,ntsnc,ntgl,ntrac,ntgnc,nthl,nthnc,nthv,ntgv,ntsigma + ntcw,ntiw,ntclamt,ntrw,ntsw,ntrnc,ntsnc,ntgl,ntrac,ntgnc,nthl,nthnc,nthv,ntgv, & + ntrz, ntgz, nthz, ntsigma logical, intent(in) :: ldiag3d, qdiag3d, do_cnvgwd, cplchm real(kind=kind_phys), dimension(:,:), intent(in) :: gu0 real(kind=kind_phys), dimension(:,:), intent(in) :: gv0 @@ -68,6 +70,7 @@ subroutine GFS_DCNV_generic_pre_run (im, levs, ldiag3d, qdiag3d, do_cnvgwd, cplc n /= ntrw .and. n /= ntsw .and. n /= ntrnc .and. & n /= ntsnc .and. n /= ntgl .and. n /= ntgnc .and. & n /= nthl .and. n /= nthnc .and. n /= nthv .and. & + n /= ntrz .and. n /= ntgz .and. n /= nthz .and. & n /= ntgv .and. n/= ntsigma) then tracers = tracers + 1 if(dtidx(100+n,index_of_process_dcnv)>0) then diff --git a/physics/GFS_DCNV_generic_pre.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_DCNV_generic_pre.meta similarity index 92% rename from physics/GFS_DCNV_generic_pre.meta rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_DCNV_generic_pre.meta index ee2050926..b8be36596 100644 --- a/physics/GFS_DCNV_generic_pre.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_DCNV_generic_pre.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = GFS_DCNV_generic_pre type = scheme - dependencies = machine.F + dependencies = ../../hooks/machine.F ######################################################################## [ccpp-arg-table] @@ -126,7 +126,7 @@ dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_tracers) type = real kind = kind_phys - intent = in + intent = inout [dtidx] standard_name = cumulative_change_of_state_variables_outer_index long_name = index of state-variable and process in last dimension of diagnostic tendencies array AKA cumulative_change_index @@ -267,6 +267,27 @@ dimensions = () type = integer intent = in +[ntrz] + standard_name = index_of_reflectivity_of_rain_in_tracer_concentration_array + long_name = tracer index for rain reflectivity + units = index + dimensions = () + type = integer + intent = in +[ntgz] + standard_name = index_of_reflectivity_of_graupel_in_tracer_concentration_array + long_name = tracer index for graupel reflectivity + units = index + dimensions = () + type = integer + intent = in +[nthz] + standard_name = index_of_reflectivity_of_hail_in_tracer_concentration_array + long_name = tracer index for hail reflectivity + units = index + dimensions = () + type = integer + intent = in [clw] standard_name = convective_transportable_tracers long_name = array to contain cloud water and other convective trans. tracers diff --git a/physics/GFS_GWD_generic_post.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_GWD_generic_post.F90 similarity index 97% rename from physics/GFS_GWD_generic_post.F90 rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_GWD_generic_post.F90 index 58f18567d..579d32fac 100644 --- a/physics/GFS_GWD_generic_post.F90 +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_GWD_generic_post.F90 @@ -27,7 +27,7 @@ subroutine GFS_GWD_generic_post_run(lssav, ldiag3d, dtf, dusfcg, dvsfcg, dudt, d real(kind=kind_phys), intent(inout) :: dugwd(:), dvgwd(:) ! dtend only allocated only if ldiag3d is .true. - real(kind=kind_phys), intent(inout) :: dtend(:,:,:) + real(kind=kind_phys), intent(inout), optional :: dtend(:,:,:) integer, intent(in) :: dtidx(:,:), index_of_temperature, & & index_of_x_wind, index_of_y_wind, index_of_process_orographic_gwd diff --git a/physics/GFS_GWD_generic_post.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_GWD_generic_post.meta similarity index 98% rename from physics/GFS_GWD_generic_post.meta rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_GWD_generic_post.meta index 204c16c84..a11b8641d 100644 --- a/physics/GFS_GWD_generic_post.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_GWD_generic_post.meta @@ -2,7 +2,7 @@ [ccpp-table-properties] name = GFS_GWD_generic_post type = scheme - dependencies = machine.F + dependencies = ../../hooks/machine.F ######################################################################## [ccpp-arg-table] @@ -94,6 +94,7 @@ type = real kind = kind_phys intent = inout + optional = True [dtidx] standard_name = cumulative_change_of_state_variables_outer_index long_name = index of state-variable and process in last dimension of diagnostic tendencies array AKA cumulative_change_index diff --git a/physics/GFS_GWD_generic_pre.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_GWD_generic_pre.F90 similarity index 96% rename from physics/GFS_GWD_generic_pre.F90 rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_GWD_generic_pre.F90 index 51a76c989..53dce2b4c 100644 --- a/physics/GFS_GWD_generic_pre.F90 +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_GWD_generic_pre.F90 @@ -28,13 +28,13 @@ subroutine GFS_GWD_generic_pre_run( & real(kind=kind_phys), intent(out) :: & & oc(:), oa4(:,:), clx(:,:), & - & varss(:), ocss(:), oa4ss(:,:), clxss(:,:), & & theta(:), sigma(:), gamma(:), elvmax(:) - + real(kind=kind_phys), intent(out), optional :: & + & varss(:), ocss(:), oa4ss(:,:), clxss(:,:) logical, intent(in) :: lssav, ldiag3d, flag_for_gwd_generic_tend real(kind=kind_phys), intent(in) :: dtdt(:,:), dudt(:,:), dvdt(:,:) ! dtend only allocated only if ldiag3d is .true. - real(kind=kind_phys), intent(inout) :: dtend(:,:,:) + real(kind=kind_phys), intent(inout), optional :: dtend(:,:,:) integer, intent(in) :: dtidx(:,:), index_of_temperature, & & index_of_x_wind, index_of_y_wind, index_of_process_orographic_gwd real(kind=kind_phys), intent(in) :: dtf diff --git a/physics/GFS_GWD_generic_pre.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_GWD_generic_pre.meta similarity index 98% rename from physics/GFS_GWD_generic_pre.meta rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_GWD_generic_pre.meta index 9bcc03300..8321c7d32 100644 --- a/physics/GFS_GWD_generic_pre.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_GWD_generic_pre.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = GFS_GWD_generic_pre type = scheme - dependencies = machine.F + dependencies = ../../hooks/machine.F ######################################################################## [ccpp-arg-table] @@ -76,6 +76,7 @@ type = real kind = kind_phys intent = out + optional = True [ocss] standard_name = convexity_of_subgrid_orography_small_scale long_name = convexity of subgrid height_above_mean_sea_level small scale @@ -84,6 +85,7 @@ type = real kind = kind_phys intent = out + optional = True [oa4ss] standard_name = asymmetry_of_subgrid_orography_small_scale long_name = asymmetry of subgrid height_above_mean_sea_level small scale @@ -92,6 +94,7 @@ type = real kind = kind_phys intent = out + optional = True [clxss] standard_name = fraction_of_grid_box_with_subgrid_orography_higher_than_critical_height_small_scale long_name = horizontal fraction of grid box covered by subgrid height_above_mean_sea_level higher than critical height small scale @@ -100,6 +103,7 @@ type = real kind = kind_phys intent = out + optional = True [sigma] standard_name = slope_of_subgrid_orography long_name = slope of subgrid height_above_mean_sea_level @@ -170,6 +174,7 @@ type = real kind = kind_phys intent = inout + optional = True [dtidx] standard_name = cumulative_change_of_state_variables_outer_index long_name = index of state-variable and process in last dimension of diagnostic tendencies array AKA cumulative_change_index diff --git a/physics/GFS_MP_generic_post.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_MP_generic_post.F90 similarity index 83% rename from physics/GFS_MP_generic_post.F90 rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_MP_generic_post.F90 index 201c0e817..108005dc1 100644 --- a/physics/GFS_MP_generic_post.F90 +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_MP_generic_post.F90 @@ -21,12 +21,13 @@ module GFS_MP_generic_post subroutine GFS_MP_generic_post_run( & im, levs, kdt, nrcm, nncl, ntcw, ntrac, imp_physics, imp_physics_gfdl, imp_physics_thompson, imp_physics_nssl, & imp_physics_mg, imp_physics_fer_hires, cal_pre, cplflx, cplchm, cpllnd, progsigma, con_g, rhowater, rainmin, dtf, & - frain, rainc, rain1, rann, xlat, xlon, gt0, gq0, prsl, prsi, phii, tsfc, ice, snow, graupel, save_t, save_q, & + frain, rainc, rain1, rann, xlat, xlon, gt0, gq0, prsl, prsi, phii, tsfc, ice, phil, htop, refl_10cm, & + imfshalcnv,imfshalcnv_gf,imfdeepcnv,imfdeepcnv_gf,imfdeepcnv_samf, con_t0c, snow, graupel, save_t, save_q, & rain0, ice0, snow0, graupel0, del, rain, domr_diag, domzr_diag, domip_diag, doms_diag, tprcp, srflag, sr, cnvprcp,& totprcp, totice, totsnw, totgrp, cnvprcpb, totprcpb, toticeb, totsnwb, totgrpb, rain_cpl, rainc_cpl, snow_cpl, & pwat, frzr, frzrb, frozr, frozrb, tsnowp, tsnowpb, rhonewsn1, exticeden, & drain_cpl, dsnow_cpl, lsm, lsm_ruc, lsm_noahmp, raincprv, rainncprv, iceprv, snowprv, & - graupelprv, draincprv, drainncprv, diceprv, dsnowprv, dgraupelprv, dtp, dfi_radar_max_intervals, & + graupelprv, draincprv, drainncprv, diceprv, dsnowprv, dgraupelprv, dtp, & dtend, dtidx, index_of_temperature, index_of_process_mp,ldiag3d, qdiag3d,dqdt_qmicro, lssav, num_dfi_radar, & fh_dfi_radar,index_of_process_dfi_radar, ix_dfi_radar, dfi_radar_tten, radar_tten_limits, fhour, prevsq, & iopt_lake, iopt_lake_clm, lkm, use_lake_model, errmsg, errflg) @@ -40,48 +41,48 @@ subroutine GFS_MP_generic_post_run( integer, intent(in) :: imp_physics_nssl, iopt_lake_clm, iopt_lake, lkm logical, intent(in) :: cal_pre, lssav, ldiag3d, qdiag3d, cplflx, cplchm, cpllnd, progsigma, exticeden integer, intent(in) :: index_of_temperature,index_of_process_mp,use_lake_model(:) - - integer :: dfi_radar_max_intervals - real(kind=kind_phys), intent(in) :: fh_dfi_radar(:), fhour + integer, intent(in) :: imfshalcnv,imfshalcnv_gf,imfdeepcnv,imfdeepcnv_gf,imfdeepcnv_samf + integer, dimension (:), intent(in) :: htop + real(kind=kind_phys), intent(in) :: fh_dfi_radar(:), fhour, con_t0c real(kind=kind_phys), intent(in) :: radar_tten_limits(:) - integer :: ix_dfi_radar(:) - real(kind=kind_phys), dimension(:,:), intent(inout) :: gt0 + integer, intent(in) :: ix_dfi_radar(:) + real(kind=kind_phys), dimension(:,:), intent(inout) :: gt0,refl_10cm real(kind=kind_phys), intent(in) :: dtf, frain, con_g, rainmin, rhowater real(kind=kind_phys), dimension(:), intent(in) :: rain1, xlat, xlon, tsfc real(kind=kind_phys), dimension(:), intent(inout) :: ice, snow, graupel, rainc - real(kind=kind_phys), dimension(:), intent(in) :: rain0, ice0, snow0, graupel0 + real(kind=kind_phys), dimension(:), intent(in), optional :: rain0, ice0, snow0, graupel0 real(kind=kind_phys), dimension(:,:), intent(in) :: rann real(kind=kind_phys), dimension(:,:), intent(in) :: prsl, save_t, del - real(kind=kind_phys), dimension(:,:), intent(in) :: prsi, phii + real(kind=kind_phys), dimension(:,:), intent(in) :: prsi, phii,phil real(kind=kind_phys), dimension(:,:,:), intent(in) :: gq0, save_q - real(kind=kind_phys), dimension(:,:,:), intent(in) :: dfi_radar_tten + real(kind=kind_phys), dimension(:,:,:), intent(in), optional :: dfi_radar_tten real(kind=kind_phys), dimension(:), intent(in ) :: sr real(kind=kind_phys), dimension(:), intent(inout) :: rain, domr_diag, domzr_diag, domip_diag, doms_diag, tprcp, & srflag, cnvprcp, totprcp, totice, totsnw, totgrp, cnvprcpb, & totprcpb, toticeb, totsnwb, totgrpb, pwat - real(kind=kind_phys), dimension(:), intent(inout) :: rain_cpl, rainc_cpl, snow_cpl + real(kind=kind_phys), dimension(:), intent(inout), optional :: rain_cpl, rainc_cpl, snow_cpl - real(kind=kind_phys), dimension(:,:,:), intent(inout) :: dtend + real(kind=kind_phys), dimension(:,:,:), intent(inout), optional :: dtend integer, dimension(:,:), intent(in) :: dtidx ! Stochastic physics / surface perturbations - real(kind=kind_phys), dimension(:), intent(inout) :: drain_cpl, dsnow_cpl + real(kind=kind_phys), dimension(:), intent(inout), optional :: drain_cpl, dsnow_cpl ! Rainfall variables previous time step integer, intent(in) :: lsm, lsm_ruc, lsm_noahmp - real(kind=kind_phys), dimension(:), intent(inout) :: raincprv - real(kind=kind_phys), dimension(:), intent(inout) :: rainncprv - real(kind=kind_phys), dimension(:), intent(inout) :: iceprv - real(kind=kind_phys), dimension(:), intent(inout) :: snowprv - real(kind=kind_phys), dimension(:), intent(inout) :: graupelprv - real(kind=kind_phys), dimension(:), intent(inout) :: draincprv - real(kind=kind_phys), dimension(:), intent(inout) :: drainncprv - real(kind=kind_phys), dimension(:), intent(inout) :: diceprv - real(kind=kind_phys), dimension(:), intent(inout) :: dsnowprv - real(kind=kind_phys), dimension(:), intent(inout) :: dgraupelprv + real(kind=kind_phys), dimension(:), intent(inout), optional :: raincprv + real(kind=kind_phys), dimension(:), intent(inout), optional :: rainncprv + real(kind=kind_phys), dimension(:), intent(inout), optional :: iceprv + real(kind=kind_phys), dimension(:), intent(inout), optional :: snowprv + real(kind=kind_phys), dimension(:), intent(inout), optional :: graupelprv + real(kind=kind_phys), dimension(:), intent(inout), optional :: draincprv + real(kind=kind_phys), dimension(:), intent(inout), optional :: drainncprv + real(kind=kind_phys), dimension(:), intent(inout), optional :: diceprv + real(kind=kind_phys), dimension(:), intent(inout), optional :: dsnowprv + real(kind=kind_phys), dimension(:), intent(inout), optional :: dgraupelprv real(kind=kind_phys), dimension(:), intent(inout) :: frzr real(kind=kind_phys), dimension(:), intent(inout) :: frzrb real(kind=kind_phys), dimension(:), intent(inout) :: frozr @@ -89,8 +90,8 @@ subroutine GFS_MP_generic_post_run( real(kind=kind_phys), dimension(:), intent(inout) :: tsnowp real(kind=kind_phys), dimension(:), intent(inout) :: tsnowpb real(kind=kind_phys), dimension(:), intent(inout) :: rhonewsn1 - real(kind=kind_phys), dimension(:,:), intent(inout) :: dqdt_qmicro - real(kind=kind_phys), dimension(:,:), intent(inout) :: prevsq + real(kind=kind_phys), dimension(:,:), intent(inout), optional :: dqdt_qmicro + real(kind=kind_phys), dimension(:,:), intent(inout), optional :: prevsq real(kind=kind_phys), intent(in) :: dtp ! CCPP error handling @@ -112,6 +113,17 @@ subroutine GFS_MP_generic_post_run( real :: snowrat,grauprat,icerat,curat,prcpncfr,prcpcufr real :: rhonewsnow,rhoprcpice,rhonewgr,rhonewice + real(kind_phys), parameter :: dbzmin=-20.0 + real(kind_phys) :: cuprate + real(kind_phys) :: ze, ze_conv, dbz_sum + + real(kind_phys), dimension(1:im,1:levs) :: zo + real(kind_phys), dimension(1:im) :: zfrz + real(kind_phys), dimension(1:im) :: factor + real(kind_phys) ze_mp, fctz, delz + logical :: lfrz + + ! Initialize CCPP error handling variables errmsg = '' errflg = 0 @@ -121,6 +133,52 @@ subroutine GFS_MP_generic_post_run( do i = 1, im rain(i) = rainc(i) + frain * rain1(i) ! time-step convective plus explicit enddo +! +! Combine convective reflectivity with MP reflectivity for selected +! parameterizations. + if ( (imp_physics==imp_physics_thompson .or. imp_physics==imp_physics_nssl) .and. & + (imfdeepcnv==imfdeepcnv_samf .or. imfdeepcnv==imfdeepcnv_gf .or. imfshalcnv==imfshalcnv_gf) ) then + do i=1,im + factor(i) = 0.0 + lfrz = .true. + zfrz(i) = phil(i,1)*onebg + do k = levs, 1, -1 + zo(i,k) = phil(i,k)*onebg + if (gt0(i,k) >= con_t0c .and. lfrz) then + zfrz(i) = zo(i,k) + lfrz = .false. + endif + enddo + enddo +! + do i=1,im + if(rainc (i) > 0.0 .and. htop(i) > 0) then + factor(i) = -2./max(1000., zo(i,htop(i)) - zfrz(i)) + endif + enddo + +! combine the reflectivity from both Thompson MP and samfdeep convection + + do k=1,levs + do i=1,im + if(rainc(i) > 0. .and. k <= htop(i)) then + fctz = 0.0 + delz = zo(i,k) - zfrz(i) + if(delz <0.0) then + fctz = 1. ! wrong + else + fctz = 10.**(factor(i)*delz) + endif + cuprate = rainc(i) * 3.6e6 / dtp ! cu precip rate (mm/h) + ze_conv = 300.0 * cuprate**1.4 + ze_conv = fctz * ze_conv + ze_mp = 10._kind_phys ** (0.1 * refl_10cm(i,k)) + dbz_sum = max(DBZmin, 10.*log10(ze_mp + ze_conv)) + refl_10cm(i,k) = dbz_sum + endif + enddo + enddo + endif ! compute surface snowfall, graupel/sleet, freezing rain and precip ice density if (imp_physics == imp_physics_gfdl .or. imp_physics == imp_physics_thompson .or. imp_physics == imp_physics_nssl ) then diff --git a/physics/GFS_MP_generic_post.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_MP_generic_post.meta similarity index 91% rename from physics/GFS_MP_generic_post.meta rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_MP_generic_post.meta index 7cd2ca4b5..c188cc555 100644 --- a/physics/GFS_MP_generic_post.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_MP_generic_post.meta @@ -2,7 +2,7 @@ [ccpp-table-properties] name = GFS_MP_generic_post type = scheme - dependencies = calpreciptype.f90,machine.F + dependencies = ../../MP/calpreciptype.f90,../../hooks/machine.F ######################################################################## [ccpp-arg-table] @@ -254,6 +254,72 @@ type = real kind = kind_phys intent = in +[phil] + standard_name = geopotential + long_name = layer geopotential + units = m2 s-2 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = in +[htop] + standard_name = vertical_index_at_cloud_top + long_name = index for cloud top + units = index + dimensions = (horizontal_loop_extent) + type = integer + intent = in +[refl_10cm] + standard_name = radar_reflectivity_10cm + long_name = instantaneous refl_10cm + units = dBZ + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout +[imfshalcnv] + standard_name = control_for_shallow_convection_scheme + long_name = flag for mass-flux shallow convection scheme + units = flag + dimensions = () + type = integer + intent = in +[imfshalcnv_gf] + standard_name = identifier_for_grell_freitas_shallow_convection + long_name = flag for Grell-Freitas shallow convection scheme + units = flag + dimensions = () + type = integer + intent = in +[imfdeepcnv] + standard_name = control_for_deep_convection_scheme + long_name = flag for mass-flux deep convection scheme + units = flag + dimensions = () + type = integer + intent = in +[imfdeepcnv_gf] + standard_name = identifier_for_grell_freitas_deep_convection + long_name = flag for Grell-Freitas deep convection scheme + units = flag + dimensions = () + type = integer + intent = in +[imfdeepcnv_samf] + standard_name = identifer_for_scale_aware_mass_flux_deep_convection + long_name = flag for SAMF deep convection scheme + units = flag + dimensions = () + type = integer + intent = in +[con_t0c] + standard_name = temperature_at_zero_celsius + long_name = temperature at 0 degree Celsius + units = K + dimensions = () + type = real + kind = kind_phys + intent = in [tsfc] standard_name = surface_skin_temperature long_name = surface skin temperature @@ -364,7 +430,7 @@ dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_tracers) type = real kind = kind_phys - intent = inout + intent = in [rain0] standard_name = lwe_thickness_of_explicit_rain_amount long_name = explicit rain on physics timestep @@ -373,6 +439,7 @@ type = real kind = kind_phys intent = in + optional = True [ice0] standard_name = lwe_thickness_of_ice_amount long_name = ice fall on physics timestep @@ -381,6 +448,7 @@ type = real kind = kind_phys intent = in + optional = True [snow0] standard_name = lwe_thickness_of_snow_amount long_name = snow fall on physics timestep @@ -389,6 +457,7 @@ type = real kind = kind_phys intent = in + optional = True [graupel0] standard_name = lwe_thickness_of_graupel_amount long_name = graupel fall on physics timestep @@ -397,6 +466,7 @@ type = real kind = kind_phys intent = in + optional = True [del] standard_name = air_pressure_difference_between_midlayers long_name = air pressure difference between midlayers @@ -557,6 +627,7 @@ type = real kind = kind_phys intent = inout + optional = True [rainc_cpl] standard_name = cumulative_lwe_thickness_of_convective_precipitation_amount_for_coupling long_name = total convective precipitation @@ -565,6 +636,7 @@ type = real kind = kind_phys intent = inout + optional = True [snow_cpl] standard_name = cumulative_lwe_thickness_of_snow_amount_for_coupling long_name = total snow precipitation @@ -573,6 +645,7 @@ type = real kind = kind_phys intent = inout + optional = True [pwat] standard_name = column_precipitable_water long_name = precipitable water @@ -589,6 +662,7 @@ type = real kind = kind_phys intent = inout + optional = True [dsnow_cpl] standard_name = tendency_of_lwe_thickness_of_snowfall_amount_on_dynamics_timestep_for_coupling long_name = change in show_cpl (coupling_type) @@ -597,6 +671,7 @@ type = real kind = kind_phys intent = inout + optional = True [lsm] standard_name = control_for_land_surface_scheme long_name = flag for land surface model @@ -626,6 +701,7 @@ type = real kind = kind_phys intent = inout + optional = True [rainncprv] standard_name = lwe_thickness_of_explicit_precipitation_amount_on_previous_timestep long_name = explicit rainfall from previous timestep @@ -634,6 +710,7 @@ type = real kind = kind_phys intent = inout + optional = True [iceprv] standard_name = lwe_thickness_of_ice_precipitation_amount_on_previous_timestep long_name = ice amount from previous timestep @@ -642,6 +719,7 @@ type = real kind = kind_phys intent = inout + optional = True [snowprv] standard_name = snow_mass_on_previous_timestep long_name = snow amount from previous timestep @@ -650,6 +728,7 @@ type = real kind = kind_phys intent = inout + optional = True [graupelprv] standard_name = lwe_thickness_of_graupel_amount_on_previous_timestep long_name = graupel amount from previous timestep @@ -658,6 +737,7 @@ type = real kind = kind_phys intent = inout + optional = True [draincprv] standard_name = convective_precipitation_rate_on_previous_timestep long_name = convective precipitation rate from previous timestep @@ -666,6 +746,7 @@ type = real kind = kind_phys intent = inout + optional = True [drainncprv] standard_name = explicit_precipitation_rate_on_previous_timestep long_name = explicit rainfall rate previous timestep @@ -674,6 +755,7 @@ type = real kind = kind_phys intent = inout + optional = True [diceprv] standard_name = ice_precipitation_rate_on_previous_timestep long_name = ice precipitation rate from previous timestep @@ -682,6 +764,7 @@ type = real kind = kind_phys intent = inout + optional = True [dsnowprv] standard_name = snowfall_rate_on_previous_timestep long_name = snow precipitation rate from previous timestep @@ -690,6 +773,7 @@ type = real kind = kind_phys intent = inout + optional = True [dgraupelprv] standard_name = graupel_precipitation_rate_on_previous_timestep long_name = graupel precipitation rate from previous timestep @@ -698,6 +782,7 @@ type = real kind = kind_phys intent = inout + optional = True [dtp] standard_name = timestep_for_physics long_name = physics timestep @@ -706,13 +791,6 @@ type = real kind = kind_phys intent = in -[dfi_radar_max_intervals] - standard_name = maximum_number_of_radar_derived_temperature_or_convection_suppression_intervals - long_name = maximum allowed number of time ranges with radar-derived microphysics temperature tendencies or radar-derived convection suppression - units = count - dimensions = () - type = integer - intent = in [num_dfi_radar] standard_name = number_of_radar_derived_temperature_or_convection_suppression_intervals long_name = number of time ranges with radar-derived microphysics temperature tendencies or radar-derived convection suppression @@ -743,6 +821,7 @@ type = real kind = kind_phys intent = in + optional = True [fhour] standard_name = forecast_time long_name = current forecast time @@ -774,6 +853,7 @@ type = real kind = kind_phys intent = inout + optional = True [dtidx] standard_name = cumulative_change_of_state_variables_outer_index long_name = index of state-variable and process in last dimension of diagnostic tendencies array AKA cumulative_change_index @@ -817,6 +897,7 @@ type = real kind = kind_phys intent = inout + optional = True [prevsq] standard_name = specific_humidity_on_previous_timestep long_name = specific_humidity_on_previous_timestep @@ -825,6 +906,7 @@ type = real kind = kind_phys intent = inout + optional = True [lssav] standard_name = flag_for_diagnostics long_name = logical flag for storing diagnostics diff --git a/physics/GFS_MP_generic_pre.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_MP_generic_pre.F90 similarity index 100% rename from physics/GFS_MP_generic_pre.F90 rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_MP_generic_pre.F90 diff --git a/physics/GFS_MP_generic_pre.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_MP_generic_pre.meta similarity index 98% rename from physics/GFS_MP_generic_pre.meta rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_MP_generic_pre.meta index a2a4947ef..6d5fd1538 100644 --- a/physics/GFS_MP_generic_pre.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_MP_generic_pre.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = GFS_MP_generic_pre type = scheme - dependencies = machine.F + dependencies = ../../hooks/machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/GFS_PBL_generic_common.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_PBL_generic_common.F90 similarity index 100% rename from physics/GFS_PBL_generic_common.F90 rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_PBL_generic_common.F90 diff --git a/physics/GFS_PBL_generic_post.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_PBL_generic_post.F90 similarity index 92% rename from physics/GFS_PBL_generic_post.F90 rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_PBL_generic_post.F90 index 0d13dc5d8..ccf83f7bb 100644 --- a/physics/GFS_PBL_generic_post.F90 +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_PBL_generic_post.F90 @@ -10,9 +10,9 @@ module GFS_PBL_generic_post !! subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac, & ntqv, ntcw, ntiw, ntrw, ntsw, ntlnc, ntinc, ntrnc, ntsnc, ntgnc, ntwa, ntia, ntgl, ntoz, ntke, ntkev,nqrimef, & - trans_aero, ntchs, ntchm, ntccn, nthl, nthnc, ntgv, nthv, & + trans_aero, ntchs, ntchm, ntccn, nthl, nthnc, ntgv, nthv, ntrz, ntgz, nthz, & imp_physics, imp_physics_gfdl, imp_physics_thompson, imp_physics_wsm6, imp_physics_zhao_carr, imp_physics_mg, & - imp_physics_fer_hires, imp_physics_nssl, nssl_ccn_on, ltaerosol, mraerosol, nssl_hail_on, & + imp_physics_fer_hires, imp_physics_nssl, nssl_ccn_on, ltaerosol, mraerosol, nssl_hail_on, nssl_3moment, & cplflx, cplaqm, cplchm, lssav, flag_for_pbl_generic_tend, 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, dtend, dtidx, index_of_temperature, index_of_x_wind, index_of_y_wind, & @@ -30,12 +30,12 @@ subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac, integer, parameter :: kp = kind_phys integer, intent(in) :: im, levs, nvdiff, ntrac, ntchs, ntchm, kdt integer, intent(in) :: ntqv, ntcw, ntiw, ntrw, ntsw, ntlnc, ntinc, ntrnc, ntsnc, ntgnc, ntwa, ntia, ntgl, ntoz, ntke, ntkev, nqrimef - integer, intent(in) :: ntccn, nthl, nthnc, ntgv, nthv + integer, intent(in) :: ntccn, nthl, nthnc, ntgv, nthv, ntrz, ntgz, nthz 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, imp_physics_mg, imp_physics_fer_hires integer, intent(in) :: imp_physics_nssl - logical, intent(in) :: nssl_ccn_on, nssl_hail_on + logical, intent(in) :: nssl_ccn_on, nssl_hail_on, nssl_3moment logical, intent(in) :: ltaerosol, cplflx, cplaqm, cplchm, lssav, ldiag3d, lsidea, use_med_flux, mraerosol logical, intent(in) :: hybedmf, do_shoc, satmedmf, shinhong, do_ysu @@ -47,8 +47,9 @@ subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac, real(kind=kind_phys), intent(in) :: rd, cp, fvirt, hvap, huge real(kind=kind_phys), dimension(:), intent(in) :: t1, q1, hflx, oceanfrac real(kind=kind_phys), dimension(:,:), intent(in) :: prsl - real(kind=kind_phys), dimension(:), intent(in) :: dusfc_cice, dvsfc_cice, dtsfc_cice, dqsfc_cice, & - dtsfc_med, dqsfc_med, dusfc_med, dvsfc_med, wind, stress_wat, hflx_wat, evap_wat, ugrs1, vgrs1 + real(kind=kind_phys), dimension(:), intent(in), optional :: dusfc_cice, dvsfc_cice, dtsfc_cice, dqsfc_cice, & + dtsfc_med, dqsfc_med, dusfc_med, dvsfc_med + real(kind=kind_phys), dimension(:), intent(in) :: wind, stress_wat, hflx_wat, evap_wat, ugrs1, vgrs1 real(kind=kind_phys), dimension(:,:, :), intent(in) :: qgrs real(kind=kind_phys), dimension(:,:), intent(in) :: ugrs, vgrs, tgrs @@ -63,14 +64,16 @@ subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac, ! Since Intel 15 crashes when passing unallocated arrays to arrays defined with explicit shape, ! use assumed-shape arrays. Note that Intel 18 and GNU 6.2.0-8.1.0 tolerate explicit-shape arrays ! as long as these do not get used when not allocated. - real(kind=kind_phys), dimension(:), intent(inout) :: dusfc_cpl, dvsfc_cpl, dtsfc_cpl, dqsfc_cpl, dusfci_cpl, dvsfci_cpl, & - dtsfci_cpl, dqsfci_cpl, dusfc_diag, dvsfc_diag, dtsfc_diag, dqsfc_diag, dusfci_diag, dvsfci_diag, dtsfci_diag, dqsfci_diag + real(kind=kind_phys), dimension(:), intent(inout), optional :: dusfc_cpl, dvsfc_cpl, & + dtsfc_cpl, dqsfc_cpl, dusfci_cpl, dvsfci_cpl, dtsfci_cpl, dqsfci_cpl + real(kind=kind_phys), dimension(:), intent(inout) :: dusfc_diag, dvsfc_diag, & + dtsfc_diag, dqsfc_diag, dusfci_diag, dvsfci_diag, dtsfci_diag, dqsfci_diag real(kind=kind_phys), intent(inout), optional :: dtend(:,:,:) integer, intent(in) :: dtidx(:,:) integer, intent(in) :: index_of_temperature, index_of_x_wind, index_of_y_wind, index_of_process_pbl logical, dimension(:),intent(in) :: wet, dry, icy - real(kind=kind_phys), dimension(:), intent(out) :: ushfsfci + real(kind=kind_phys), dimension(:), intent(out), optional :: ushfsfci ! From canopy heat storage - reduction factors in latent/sensible heat flux due to surface roughness real(kind=kind_phys), dimension(:), intent(in) :: hffac @@ -270,8 +273,16 @@ subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac, dqdt(i,k,ntgv) = dvdftra(i,k,14) dqdt(i,k,nthv) = dvdftra(i,k,15) dqdt(i,k,ntoz) = dvdftra(i,k,16) + n = 16 IF ( nssl_ccn_on ) THEN - dqdt(i,k,ntccn) = dvdftra(i,k,17) + dqdt(i,k,ntccn) = dvdftra(i,k,n+1) + n = n+1 + ENDIF + IF ( nssl_3moment ) THEN + dqdt(i,k,ntrz) = dvdftra(i,k,n+1) + dqdt(i,k,ntgz) = dvdftra(i,k,n+2) + dqdt(i,k,nthz) = dvdftra(i,k,n+3) + n = n+3 ENDIF enddo enddo @@ -292,9 +303,16 @@ subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac, dqdt(i,k,ntsnc) = dvdftra(i,k,10) dqdt(i,k,ntgnc) = dvdftra(i,k,11) dqdt(i,k,ntgv) = dvdftra(i,k,12) - dqdt(i,k,ntoz) = dvdftra(i,k,13) + dqdt(i,k,ntoz) = dvdftra(i,k,13) + n = 13 IF ( nssl_ccn_on ) THEN - dqdt(i,k,ntccn) = dvdftra(i,k,14) + dqdt(i,k,ntccn) = dvdftra(i,k,n+1) + n = n+1 + ENDIF + IF ( nssl_3moment ) THEN + dqdt(i,k,ntrz) = dvdftra(i,k,n+1) + dqdt(i,k,ntgz) = dvdftra(i,k,n+2) + n = n+2 ENDIF enddo enddo diff --git a/physics/GFS_PBL_generic_post.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_PBL_generic_post.meta similarity index 96% rename from physics/GFS_PBL_generic_post.meta rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_PBL_generic_post.meta index b20142991..057d061a4 100644 --- a/physics/GFS_PBL_generic_post.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_PBL_generic_post.meta @@ -2,7 +2,7 @@ [ccpp-table-properties] name = GFS_PBL_generic_post type = scheme - dependencies = GFS_PBL_generic_common.F90,machine.F + dependencies = GFS_PBL_generic_common.F90,../../hooks/machine.F ######################################################################## [ccpp-arg-table] @@ -211,6 +211,27 @@ dimensions = () type = integer intent = in +[ntrz] + standard_name = index_of_reflectivity_of_rain_in_tracer_concentration_array + long_name = tracer index for rain reflectivity + units = index + dimensions = () + type = integer + intent = in +[ntgz] + standard_name = index_of_reflectivity_of_graupel_in_tracer_concentration_array + long_name = tracer index for graupel reflectivity + units = index + dimensions = () + type = integer + intent = in +[nthz] + standard_name = index_of_reflectivity_of_hail_in_tracer_concentration_array + long_name = tracer index for hail reflectivity + units = index + dimensions = () + type = integer + intent = in [imp_physics] standard_name = control_for_microphysics_scheme long_name = choice of microphysics scheme @@ -295,6 +316,13 @@ dimensions = () type = logical intent = in +[nssl_3moment] + standard_name = nssl_3moment + long_name = 3-moment activation flag in NSSL microphysics scheme + units = flag + dimensions = () + type = logical + intent = in [cplflx] standard_name = flag_for_surface_flux_coupling long_name = flag controlling cplflx collection (default off) @@ -419,6 +447,7 @@ type = real kind = kind_phys intent = inout + optional = True [dtidx] standard_name = cumulative_change_of_state_variables_outer_index long_name = index of state-variable and process in last dimension of diagnostic tendencies array AKA cumulative_change_index @@ -534,6 +563,7 @@ type = real kind = kind_phys intent = inout + optional = True [dvsfc_cpl] standard_name = cumulative_surface_y_momentum_flux_for_coupling_multiplied_by_timestep long_name = cumulative sfc v momentum flux multiplied by timestep @@ -542,6 +572,7 @@ type = real kind = kind_phys intent = inout + optional = True [dtsfc_cpl] standard_name = cumulative_surface_upward_sensible_heat_flux_for_coupling_multiplied_by_timestep long_name = cumulative sfc sensible heat flux multiplied by timestep @@ -550,6 +581,7 @@ type = real kind = kind_phys intent = inout + optional = True [dqsfc_cpl] standard_name = cumulative_surface_upward_latent_heat_flux_for_coupling_multiplied_by_timestep long_name = cumulative sfc latent heat flux multiplied by timestep @@ -558,6 +590,7 @@ type = real kind = kind_phys intent = inout + optional = True [dusfci_cpl] standard_name = surface_x_momentum_flux_for_coupling long_name = instantaneous sfc u momentum flux @@ -566,6 +599,7 @@ type = real kind = kind_phys intent = inout + optional = True [dvsfci_cpl] standard_name = surface_y_momentum_flux_for_coupling long_name = instantaneous sfc v momentum flux @@ -574,6 +608,7 @@ type = real kind = kind_phys intent = inout + optional = True [dtsfci_cpl] standard_name = surface_upward_sensible_heat_flux_for_coupling long_name = instantaneous sfc sensible heat flux @@ -582,6 +617,7 @@ type = real kind = kind_phys intent = inout + optional = True [dqsfci_cpl] standard_name = surface_upward_latent_heat_flux_for_coupling long_name = instantaneous sfc latent heat flux @@ -590,6 +626,7 @@ type = real kind = kind_phys intent = inout + optional = True [dusfc_diag] standard_name = cumulative_surface_x_momentum_flux_for_diag_multiplied_by_timestep long_name = cumulative sfc x momentum flux multiplied by timestep @@ -726,6 +763,7 @@ type = real kind = kind_phys intent = out + optional = True [oceanfrac] standard_name = sea_area_fraction long_name = fraction of horizontal grid area occupied by ocean @@ -749,6 +787,7 @@ type = real kind = kind_phys intent = in + optional = True [dvsfc_cice] standard_name = surface_y_momentum_flux_from_coupled_process long_name = sfc y momentum flux for coupling @@ -757,6 +796,7 @@ type = real kind = kind_phys intent = in + optional = True [dtsfc_cice] standard_name = surface_upward_sensible_heat_flux_from_coupled_process long_name = sfc sensible heat flux for coupling @@ -765,6 +805,7 @@ type = real kind = kind_phys intent = in + optional = True [dqsfc_cice] standard_name = surface_upward_latent_heat_flux_from_coupled_process long_name = sfc latent heat flux for coupling @@ -773,6 +814,7 @@ type = real kind = kind_phys intent = in + optional = True [use_med_flux] standard_name = do_mediator_atmosphere_ocean_fluxes long_name = flag for using atmosphere-ocean fluxes from mediator @@ -788,6 +830,7 @@ type = real kind = kind_phys intent = in + optional = True [dtsfc_med] standard_name = surface_upward_sensible_heat_flux_over_ocean_from_mediator long_name = sfc sensible heat flux input over ocean for coupling @@ -796,6 +839,7 @@ type = real kind = kind_phys intent = in + optional = True [dusfc_med] standard_name = surface_x_momentum_flux_over_ocean_from_mediator long_name = sfc x momentum flux over ocean for coupling @@ -804,6 +848,7 @@ type = real kind = kind_phys intent = in + optional = True [dvsfc_med] standard_name = surface_y_momentum_flux_over_ocean_from_mediator long_name = sfc y momentum flux over ocean for coupling @@ -812,6 +857,7 @@ type = real kind = kind_phys intent = in + optional = True [wet] standard_name = flag_nonzero_wet_surface_fraction long_name = flag indicating presence of some ocean or lake surface area fraction diff --git a/physics/GFS_PBL_generic_pre.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_PBL_generic_pre.F90 similarity index 88% rename from physics/GFS_PBL_generic_pre.F90 rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_PBL_generic_pre.F90 index b9f7bb880..d8ed0f8fc 100644 --- a/physics/GFS_PBL_generic_pre.F90 +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_PBL_generic_pre.F90 @@ -12,10 +12,10 @@ module GFS_PBL_generic_pre subroutine GFS_PBL_generic_pre_run (im, levs, nvdiff, ntrac, rtg_ozone_index, & ntqv, ntcw, ntiw, ntrw, ntsw, ntlnc, ntinc, ntrnc, ntsnc, ntgnc, & ntwa, ntia, ntgl, ntoz, ntke, ntkev, nqrimef, trans_aero, ntchs, ntchm, & - ntccn, nthl, nthnc, ntgv, nthv, & + ntccn, nthl, nthnc, ntgv, nthv, ntrz, ntgz, nthz, & imp_physics, imp_physics_gfdl, imp_physics_thompson, imp_physics_wsm6, & imp_physics_zhao_carr, imp_physics_mg, imp_physics_fer_hires, imp_physics_nssl, & - ltaerosol, mraerosol, nssl_ccn_on, nssl_hail_on, & + ltaerosol, mraerosol, nssl_ccn_on, nssl_hail_on, nssl_3moment, & hybedmf, do_shoc, satmedmf, qgrs, vdftra, save_u, save_v, save_t, save_q, & flag_for_pbl_generic_tend, ldiag3d, qdiag3d, lssav, ugrs, vgrs, tgrs, errmsg, errflg) @@ -29,13 +29,13 @@ subroutine GFS_PBL_generic_pre_run (im, levs, nvdiff, ntrac, rtg_ozone_index, integer, intent(in) :: im, levs, nvdiff, ntrac 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 - integer, intent(in) :: ntccn, nthl, nthnc, ntgv, nthv + integer, intent(in) :: ntccn, nthl, nthnc, ntgv, nthv, ntrz, ntgz, nthz logical, intent(in) :: trans_aero, ldiag3d, qdiag3d, lssav integer, intent(in) :: imp_physics, imp_physics_gfdl, imp_physics_thompson, imp_physics_wsm6 integer, intent(in) :: imp_physics_zhao_carr, imp_physics_mg, imp_physics_fer_hires logical, intent(in) :: ltaerosol, hybedmf, do_shoc, satmedmf, flag_for_pbl_generic_tend, mraerosol integer, intent(in) :: imp_physics_nssl - logical, intent(in) :: nssl_hail_on, nssl_ccn_on + logical, intent(in) :: nssl_hail_on, nssl_ccn_on, nssl_3moment real(kind=kind_phys), dimension(:,:,:), intent(in) :: qgrs real(kind=kind_phys), dimension(:,:), intent(in) :: ugrs, vgrs, tgrs @@ -215,15 +215,23 @@ subroutine GFS_PBL_generic_pre_run (im, levs, nvdiff, ntrac, rtg_ozone_index, vdftra(i,k,7) = qgrs(i,k,nthl) vdftra(i,k,8) = qgrs(i,k,ntlnc) vdftra(i,k,9) = qgrs(i,k,ntinc) - vdftra(i,k,10) = qgrs(i,k,ntrnc) - vdftra(i,k,11) = qgrs(i,k,ntsnc) - vdftra(i,k,12) = qgrs(i,k,ntgnc) - vdftra(i,k,13) = qgrs(i,k,nthnc) - vdftra(i,k,14) = qgrs(i,k,ntgv) - vdftra(i,k,15) = qgrs(i,k,nthv) - vdftra(i,k,16) = qgrs(i,k,ntoz) + vdftra(i,k,10) = qgrs(i,k,ntrnc) + vdftra(i,k,11) = qgrs(i,k,ntsnc) + vdftra(i,k,12) = qgrs(i,k,ntgnc) + vdftra(i,k,13) = qgrs(i,k,nthnc) + vdftra(i,k,14) = qgrs(i,k,ntgv) + vdftra(i,k,15) = qgrs(i,k,nthv) + vdftra(i,k,16) = qgrs(i,k,ntoz) + n = 16 IF ( nssl_ccn_on ) THEN - vdftra(i,k,17) = qgrs(i,k,ntccn) + vdftra(i,k,n+1) = qgrs(i,k,ntccn) + n = n+1 + ENDIF + IF ( nssl_3moment ) THEN + vdftra(i,k,n+1) = qgrs(i,k,ntrz) + vdftra(i,k,n+2) = qgrs(i,k,ntgz) + vdftra(i,k,n+3) = qgrs(i,k,nthz) + n = n+3 ENDIF enddo enddo @@ -241,12 +249,19 @@ subroutine GFS_PBL_generic_pre_run (im, levs, nvdiff, ntrac, rtg_ozone_index, 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,ntgv) - vdftra(i,k,13) = qgrs(i,k,ntoz) + vdftra(i,k,10) = qgrs(i,k,ntsnc) + vdftra(i,k,11) = qgrs(i,k,ntgnc) + vdftra(i,k,12) = qgrs(i,k,ntgv) + vdftra(i,k,13) = qgrs(i,k,ntoz) + n = 13 IF ( nssl_ccn_on ) THEN - vdftra(i,k,14) = qgrs(i,k,ntccn) + vdftra(i,k,n+1) = qgrs(i,k,ntccn) + n = n+1 + ENDIF + IF ( nssl_3moment ) THEN + vdftra(i,k,n+1) = qgrs(i,k,ntrz) + vdftra(i,k,n+2) = qgrs(i,k,ntgz) + n = n+2 ENDIF enddo enddo diff --git a/physics/GFS_PBL_generic_pre.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_PBL_generic_pre.meta similarity index 93% rename from physics/GFS_PBL_generic_pre.meta rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_PBL_generic_pre.meta index a09b34b48..7a8e72bba 100644 --- a/physics/GFS_PBL_generic_pre.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_PBL_generic_pre.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = GFS_PBL_generic_pre type = scheme - dependencies = GFS_PBL_generic_common.F90,machine.F + dependencies = GFS_PBL_generic_common.F90,../../hooks/machine.F ######################################################################## [ccpp-arg-table] @@ -217,6 +217,27 @@ dimensions = () type = integer intent = in +[ntrz] + standard_name = index_of_reflectivity_of_rain_in_tracer_concentration_array + long_name = tracer index for rain reflectivity + units = index + dimensions = () + type = integer + intent = in +[ntgz] + standard_name = index_of_reflectivity_of_graupel_in_tracer_concentration_array + long_name = tracer index for graupel reflectivity + units = index + dimensions = () + type = integer + intent = in +[nthz] + standard_name = index_of_reflectivity_of_hail_in_tracer_concentration_array + long_name = tracer index for hail reflectivity + units = index + dimensions = () + type = integer + intent = in [imp_physics] standard_name = control_for_microphysics_scheme long_name = choice of microphysics scheme @@ -301,6 +322,13 @@ dimensions = () type = logical intent = in +[nssl_3moment] + standard_name = nssl_3moment + long_name = 3-moment activation flag in NSSL microphysics scheme + units = flag + dimensions = () + type = logical + intent = in [hybedmf] standard_name = flag_for_hybrid_edmf_pbl_scheme long_name = flag for hybrid edmf pbl scheme (moninedmf) diff --git a/physics/GFS_SCNV_generic_post.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_SCNV_generic_post.F90 similarity index 97% rename from physics/GFS_SCNV_generic_post.F90 rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_SCNV_generic_post.F90 index 0b38ff081..8102d70eb 100644 --- a/physics/GFS_SCNV_generic_post.F90 +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_SCNV_generic_post.F90 @@ -31,7 +31,7 @@ subroutine GFS_SCNV_generic_post_run (im, levs, nn, lssav, ldiag3d, qdiag3d, & real(kind=kind_phys), dimension(:,:,:), intent(in) :: save_q, gq0 ! dtend only allocated if ldiag3d == .true. - real(kind=kind_phys), intent(inout) :: dtend(:,:,:) + real(kind=kind_phys), intent(inout), optional :: dtend(:,:,:) integer, intent(in) :: dtidx(:,:) integer, intent(in) :: index_of_temperature, index_of_x_wind, index_of_y_wind, index_of_process_scnv real(kind=kind_phys), dimension(:,:,:), intent(in) :: clw @@ -46,7 +46,7 @@ subroutine GFS_SCNV_generic_post_run (im, levs, nn, lssav, ldiag3d, qdiag3d, & ! Since Intel 15 crashes when passing unallocated arrays to arrays defined with explicit shape, ! use assumed-shape arrays. Note that Intel 18 and GNU 6.2.0-8.1.0 tolerate explicit-shape arrays ! as long as these do not get used when not allocated. - real(kind=kind_phys), dimension(:,:), intent(inout) :: cnvw_phy_f3d, cnvc_phy_f3d + real(kind=kind_phys), dimension(:,:), intent(inout), optional :: cnvw_phy_f3d, cnvc_phy_f3d integer, intent(in) :: imfshalcnv, imfshalcnv_sas, imfshalcnv_samf logical, intent(in) :: cscnv, satmedmf, trans_trac, ras diff --git a/physics/GFS_SCNV_generic_post.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_SCNV_generic_post.meta similarity index 99% rename from physics/GFS_SCNV_generic_post.meta rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_SCNV_generic_post.meta index bf6ba394f..f90fccf01 100644 --- a/physics/GFS_SCNV_generic_post.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_SCNV_generic_post.meta @@ -2,7 +2,7 @@ [ccpp-table-properties] name = GFS_SCNV_generic_post type = scheme - dependencies = machine.F + dependencies = ../../hooks/machine.F ######################################################################## [ccpp-arg-table] @@ -130,6 +130,7 @@ type = real kind = kind_phys intent = inout + optional = True [dtidx] standard_name = cumulative_change_of_state_variables_outer_index long_name = index of state-variable and process in last dimension of diagnostic tendencies array AKA cumulative_change_index @@ -271,6 +272,7 @@ type = real kind = kind_phys intent = inout + optional = True [cnvc_phy_f3d] standard_name = convective_cloud_area_fraction long_name = convective cloud cover in the phy_f3d array @@ -279,6 +281,7 @@ type = real kind = kind_phys intent = inout + optional = True [flag_for_scnv_generic_tend] standard_name = flag_for_generic_tendency_due_to_shallow_convection long_name = true if GFS_SCNV_generic should calculate tendencies diff --git a/physics/GFS_SCNV_generic_pre.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_SCNV_generic_pre.F90 similarity index 100% rename from physics/GFS_SCNV_generic_pre.F90 rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_SCNV_generic_pre.F90 diff --git a/physics/GFS_SCNV_generic_pre.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_SCNV_generic_pre.meta similarity index 99% rename from physics/GFS_SCNV_generic_pre.meta rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_SCNV_generic_pre.meta index eccd547a1..fbd9e47d8 100644 --- a/physics/GFS_SCNV_generic_pre.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_SCNV_generic_pre.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = GFS_SCNV_generic_pre type = scheme - dependencies = machine.F + dependencies = ../../hooks/machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/GFS_cloud_diagnostics.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_cloud_diagnostics.F90 similarity index 95% rename from physics/GFS_cloud_diagnostics.F90 rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_cloud_diagnostics.F90 index 86dc2b518..2fd553c8e 100644 --- a/physics/GFS_cloud_diagnostics.F90 +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_cloud_diagnostics.F90 @@ -59,12 +59,13 @@ subroutine GFS_cloud_diagnostics_run(nCol, nLev, iovr, iovr_rand, iovr_maxrand, lat, & ! Latitude de_lgth, & ! Decorrelation length si ! Vertical sigma coordinate + real(kind_phys), dimension(:,:), intent(in), optional :: & + p_lay ! Pressure at model-layer real(kind_phys), dimension(:,:), intent(in) :: & - p_lay, & ! Pressure at model-layer cld_frac ! Total cloud fraction - real(kind_phys), dimension(:,:), intent(in) :: & + real(kind_phys), dimension(:,:), intent(in), optional :: & p_lev ! Pressure at model interfaces - real(kind_phys), dimension(:,:), intent(in) :: & + real(kind_phys), dimension(:,:), intent(in), optional :: & deltaZ, & ! Layer thickness (m) cloud_overlap_param, & ! Cloud-overlap parameter precip_overlap_param ! Precipitation overlap parameter diff --git a/physics/GFS_cloud_diagnostics.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_cloud_diagnostics.meta similarity index 96% rename from physics/GFS_cloud_diagnostics.meta rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_cloud_diagnostics.meta index 53d1552e6..daf1bddee 100644 --- a/physics/GFS_cloud_diagnostics.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_cloud_diagnostics.meta @@ -1,7 +1,8 @@ [ccpp-table-properties] name = GFS_cloud_diagnostics type = scheme - dependencies = machine.F,radiation_clouds.f + relative_path = ../../ + dependencies = hooks/machine.F,Radiation/radiation_clouds.f ######################################################################## [ccpp-arg-table] @@ -108,6 +109,7 @@ type = real kind = kind_phys intent = in + optional = True [cld_frac] standard_name = total_cloud_fraction long_name = layer total cloud fraction @@ -124,6 +126,7 @@ type = real kind = kind_phys intent = in + optional = True [deltaZ] standard_name = layer_thickness long_name = layer_thickness @@ -132,6 +135,7 @@ type = real kind = kind_phys intent = in + optional = True [cloud_overlap_param] standard_name = cloud_overlap_param long_name = cloud overlap parameter @@ -140,6 +144,7 @@ type = real kind = kind_phys intent = in + optional = True [precip_overlap_param] standard_name = precip_overlap_param long_name = precipitation overlap parameter @@ -148,6 +153,7 @@ type = real kind = kind_phys intent = in + optional = True [con_pi] standard_name = pi long_name = ratio of a circle's circumference to its diameter diff --git a/physics/GFS_debug.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_debug.F90 similarity index 95% rename from physics/GFS_debug.F90 rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_debug.F90 index fe63c1cea..cdd3d8e2b 100644 --- a/physics/GFS_debug.F90 +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_debug.F90 @@ -303,6 +303,16 @@ module GFS_diagtoscreen use print_var_chksum, only: print_var + use machine, only: kind_phys + + use GFS_typedefs, only: GFS_control_type, GFS_statein_type, & + GFS_stateout_type, GFS_sfcprop_type, & + GFS_coupling_type, GFS_grid_type, & + GFS_tbd_type, GFS_cldprop_type, & + GFS_radtend_type, GFS_diag_type + + use CCPP_typedefs, only: GFS_interstitial_type + implicit none private @@ -314,66 +324,70 @@ module GFS_diagtoscreen !> \section arg_table_GFS_diagtoscreen_init Argument Table !! \htmlinclude GFS_diagtoscreen_init.html !! - subroutine GFS_diagtoscreen_init (Model, Data, Interstitial, errmsg, errflg) - - use GFS_typedefs, only: GFS_control_type, GFS_data_type - use CCPP_typedefs, only: GFS_interstitial_type + subroutine GFS_diagtoscreen_init (Model, Statein, Stateout, Sfcprop, Coupling, & + Grid, Tbd, Cldprop, Radtend, Diag, Interstitial, & + errmsg, errflg) implicit none !--- interface variables type(GFS_control_type), intent(in) :: Model - type(GFS_data_type), intent(in) :: Data(:) + type(GFS_statein_type), intent(in) :: Statein + type(GFS_stateout_type), intent(in) :: Stateout + type(GFS_sfcprop_type), intent(in) :: Sfcprop + type(GFS_coupling_type), intent(in) :: Coupling + type(GFS_grid_type), intent(in) :: Grid + type(GFS_tbd_type), intent(in) :: Tbd + type(GFS_cldprop_type), intent(in) :: Cldprop + type(GFS_radtend_type), intent(in) :: Radtend + type(GFS_diag_type), intent(in) :: Diag type(GFS_interstitial_type), intent(in) :: Interstitial(:) character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg - !--- local variables - integer :: i - ! Initialize CCPP error handling variables errmsg = '' errflg = 0 - do i=1,size(Data) - call GFS_diagtoscreen_run (Model, Data(i)%Statein, Data(i)%Stateout, Data(i)%Sfcprop, & - Data(i)%Coupling, Data(i)%Grid, Data(i)%Tbd, Data(i)%Cldprop, & - Data(i)%Radtend, Data(i)%Intdiag, Interstitial(1), & - size(Interstitial), i, errmsg, errflg) - end do + call GFS_diagtoscreen_run (Model, Statein, Stateout, Sfcprop, & + Coupling, Grid, Tbd, Cldprop, & + Radtend, Diag, Interstitial(1), & + size(Interstitial), -999, errmsg, errflg) end subroutine GFS_diagtoscreen_init !> \section arg_table_GFS_diagtoscreen_timestep_init Argument Table !! \htmlinclude GFS_diagtoscreen_timestep_init.html !! - subroutine GFS_diagtoscreen_timestep_init (Model, Data, Interstitial, errmsg, errflg) - - use GFS_typedefs, only: GFS_control_type, GFS_data_type - use CCPP_typedefs, only: GFS_interstitial_type + subroutine GFS_diagtoscreen_timestep_init (Model, Statein, Stateout, Sfcprop, Coupling, & + Grid, Tbd, Cldprop, Radtend, Diag, Interstitial, & + errmsg, errflg) implicit none !--- interface variables type(GFS_control_type), intent(in) :: Model - type(GFS_data_type), intent(in) :: Data(:) + type(GFS_statein_type), intent(in) :: Statein + type(GFS_stateout_type), intent(in) :: Stateout + type(GFS_sfcprop_type), intent(in) :: Sfcprop + type(GFS_coupling_type), intent(in) :: Coupling + type(GFS_grid_type), intent(in) :: Grid + type(GFS_tbd_type), intent(in) :: Tbd + type(GFS_cldprop_type), intent(in) :: Cldprop + type(GFS_radtend_type), intent(in) :: Radtend + type(GFS_diag_type), intent(in) :: Diag type(GFS_interstitial_type), intent(in) :: Interstitial(:) character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg - !--- local variables - integer :: i - ! Initialize CCPP error handling variables errmsg = '' errflg = 0 - do i=1,size(Data) - call GFS_diagtoscreen_run (Model, Data(i)%Statein, Data(i)%Stateout, Data(i)%Sfcprop, & - Data(i)%Coupling, Data(i)%Grid, Data(i)%Tbd, Data(i)%Cldprop, & - Data(i)%Radtend, Data(i)%Intdiag, Interstitial(1), & - size(Interstitial), i, errmsg, errflg) - end do + call GFS_diagtoscreen_run (Model, Statein, Stateout, Sfcprop, & + Coupling, Grid, Tbd, Cldprop, & + Radtend, Diag, Interstitial(1), & + size(Interstitial), -999, errmsg, errflg) end subroutine GFS_diagtoscreen_timestep_init @@ -385,17 +399,11 @@ subroutine GFS_diagtoscreen_run (Model, Statein, Stateout, Sfcprop, Coupling, nthreads, blkno, errmsg, errflg) #ifdef MPI - use mpi + use mpi_f08 #endif #ifdef _OPENMP use omp_lib #endif - use GFS_typedefs, only: GFS_control_type, GFS_statein_type, & - GFS_stateout_type, GFS_sfcprop_type, & - GFS_coupling_type, GFS_grid_type, & - GFS_tbd_type, GFS_cldprop_type, & - GFS_radtend_type, GFS_diag_type - use CCPP_typedefs, only: GFS_interstitial_type implicit none @@ -418,7 +426,7 @@ subroutine GFS_diagtoscreen_run (Model, Statein, Stateout, Sfcprop, Coupling, !--- local variables integer :: impi, iomp, ierr, n, idtend, iprocess, itracer - integer :: mpirank, mpisize, mpicomm + integer :: mpirank, mpisize integer :: omprank, ompsize ! Initialize CCPP error handling variables @@ -426,13 +434,11 @@ subroutine GFS_diagtoscreen_run (Model, Statein, Stateout, Sfcprop, Coupling, errflg = 0 #ifdef MPI - mpicomm = Model%communicator mpirank = Model%me mpisize = Model%ntasks #else mpirank = 0 mpisize = 1 - mpicomm = 0 #endif #ifdef _OPENMP omprank = OMP_GET_THREAD_NUM() @@ -446,7 +452,7 @@ subroutine GFS_diagtoscreen_run (Model, Statein, Stateout, Sfcprop, Coupling, !$OMP BARRIER #endif #ifdef MPI -! call MPI_BARRIER(mpicomm,ierr) +! call MPI_BARRIER(Model%communicator,ierr) #endif do impi=0,mpisize-1 @@ -619,7 +625,7 @@ subroutine GFS_diagtoscreen_run (Model, Statein, Stateout, Sfcprop, Coupling, call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Tbd%in_nm' , Tbd%in_nm) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Tbd%ccn_nm' , Tbd%ccn_nm) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Tbd%aer_nm' , Tbd%aer_nm) - if (Model%imfdeepcnv == Model%imfdeepcnv_gf .or. Model%imfdeepcnv == Model%imfdeepcnv_unified) then + if (Model%imfdeepcnv == Model%imfdeepcnv_gf) then call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Tbd%cactiv' , Tbd%cactiv) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Tbd%cactiv_m' , Tbd%cactiv_m) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Tbd%aod_gf' , Tbd%aod_gf) @@ -747,9 +753,9 @@ subroutine GFS_diagtoscreen_run (Model, Statein, Stateout, Sfcprop, Coupling, call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%det_thl ', Diag%det_thl) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%det_sqv ', Diag%det_sqv) end if - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%nupdraft ', Diag%nupdraft) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%maxwidth ', Diag%maxwidth) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%maxMF ', Diag%maxMF) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%ktop_plume ', Diag%ktop_plume) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%ztop_plume ', Diag%ztop_plume) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%exch_h ', Diag%exch_h) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%exch_m ', Diag%exch_m) end if @@ -877,13 +883,6 @@ subroutine GFS_diagtoscreen_run (Model, Statein, Stateout, Sfcprop, Coupling, call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Coupling%v10mi_cpl ', Coupling%v10mi_cpl ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Coupling%tsfci_cpl ', Coupling%tsfci_cpl ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Coupling%psurfi_cpl ', Coupling%psurfi_cpl ) - if (Model%use_med_flux) then - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Coupling%dusfcino_cpl ', Coupling%dusfcino_cpl ) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Coupling%dvsfcino_cpl ', Coupling%dvsfcino_cpl ) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Coupling%dtsfcino_cpl ', Coupling%dtsfcino_cpl ) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Coupling%dqsfcino_cpl ', Coupling%dqsfcino_cpl ) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Coupling%ulwsfcino_cpl', Coupling%ulwsfcino_cpl ) - end if end if if (Model%cplchm) then call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Coupling%rainc_cpl', Coupling%rainc_cpl) @@ -951,7 +950,7 @@ subroutine GFS_diagtoscreen_run (Model, Statein, Stateout, Sfcprop, Coupling, #endif end do #ifdef MPI -! call MPI_BARRIER(mpicomm,ierr) +! call MPI_BARRIER(Model%communicator,ierr) #endif end do @@ -959,7 +958,7 @@ subroutine GFS_diagtoscreen_run (Model, Statein, Stateout, Sfcprop, Coupling, !$OMP BARRIER #endif #ifdef MPI -! call MPI_BARRIER(mpicomm,ierr) +! call MPI_BARRIER(Model%communicator,ierr) #endif end subroutine GFS_diagtoscreen_run @@ -971,6 +970,17 @@ module GFS_interstitialtoscreen use print_var_chksum, only: print_var + use machine, only: kind_phys + + use GFS_typedefs, only: GFS_control_type, GFS_statein_type, & + GFS_stateout_type, GFS_sfcprop_type, & + GFS_coupling_type, GFS_grid_type, & + GFS_tbd_type, GFS_cldprop_type, & + GFS_radtend_type, GFS_diag_type + + use CCPP_typedefs, only: GFS_interstitial_type + + implicit none private @@ -982,16 +992,23 @@ module GFS_interstitialtoscreen !> \section arg_table_GFS_interstitialtoscreen_init Argument Table !! \htmlinclude GFS_interstitialtoscreen_init.html !! - subroutine GFS_interstitialtoscreen_init (Model, Data, Interstitial, errmsg, errflg) - - use GFS_typedefs, only: GFS_control_type, GFS_data_type - use CCPP_typedefs, only: GFS_interstitial_type + subroutine GFS_interstitialtoscreen_init (Model, Statein, Stateout, Sfcprop, Coupling, & + Grid, Tbd, Cldprop, Radtend, Diag, Interstitial, & + errmsg, errflg) implicit none !--- interface variables type(GFS_control_type), intent(in) :: Model - type(GFS_data_type), intent(in) :: Data(:) + type(GFS_statein_type), intent(in) :: Statein + type(GFS_stateout_type), intent(in) :: Stateout + type(GFS_sfcprop_type), intent(in) :: Sfcprop + type(GFS_coupling_type), intent(in) :: Coupling + type(GFS_grid_type), intent(in) :: Grid + type(GFS_tbd_type), intent(in) :: Tbd + type(GFS_cldprop_type), intent(in) :: Cldprop + type(GFS_radtend_type), intent(in) :: Radtend + type(GFS_diag_type), intent(in) :: Diag type(GFS_interstitial_type), intent(in) :: Interstitial(:) character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -1003,11 +1020,9 @@ subroutine GFS_interstitialtoscreen_init (Model, Data, Interstitial, errmsg, err errmsg = '' errflg = 0 - do i=1,size(Interstitial) - call GFS_interstitialtoscreen_run (Model, Data(1)%Statein, Data(1)%Stateout, Data(1)%Sfcprop, & - Data(1)%Coupling, Data(1)%Grid, Data(1)%Tbd, Data(1)%Cldprop, & - Data(1)%Radtend, Data(1)%Intdiag, Interstitial(i), & + call GFS_interstitialtoscreen_run (Model, Statein, Stateout, Sfcprop, Coupling, & + Grid, Tbd, Cldprop, Radtend, Diag, Interstitial(i), & size(Interstitial), -999, errmsg, errflg) end do @@ -1016,16 +1031,23 @@ end subroutine GFS_interstitialtoscreen_init !> \section arg_table_GFS_interstitialtoscreen_timestep_init Argument Table !! \htmlinclude GFS_interstitialtoscreen_timestep_init.html !! - subroutine GFS_interstitialtoscreen_timestep_init (Model, Data, Interstitial, errmsg, errflg) - - use GFS_typedefs, only: GFS_control_type, GFS_data_type - use CCPP_typedefs, only: GFS_interstitial_type + subroutine GFS_interstitialtoscreen_timestep_init (Model, Statein, Stateout, Sfcprop, Coupling, & + Grid, Tbd, Cldprop, Radtend, Diag, Interstitial, & + errmsg, errflg) implicit none !--- interface variables type(GFS_control_type), intent(in) :: Model - type(GFS_data_type), intent(in) :: Data(:) + type(GFS_statein_type), intent(in) :: Statein + type(GFS_stateout_type), intent(in) :: Stateout + type(GFS_sfcprop_type), intent(in) :: Sfcprop + type(GFS_coupling_type), intent(in) :: Coupling + type(GFS_grid_type), intent(in) :: Grid + type(GFS_tbd_type), intent(in) :: Tbd + type(GFS_cldprop_type), intent(in) :: Cldprop + type(GFS_radtend_type), intent(in) :: Radtend + type(GFS_diag_type), intent(in) :: Diag type(GFS_interstitial_type), intent(in) :: Interstitial(:) character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -1039,9 +1061,8 @@ subroutine GFS_interstitialtoscreen_timestep_init (Model, Data, Interstitial, er do i=1,size(Interstitial) - call GFS_interstitialtoscreen_run (Model, Data(1)%Statein, Data(1)%Stateout, Data(1)%Sfcprop, & - Data(1)%Coupling, Data(1)%Grid, Data(1)%Tbd, Data(1)%Cldprop, & - Data(1)%Radtend, Data(1)%Intdiag, Interstitial(i), & + call GFS_interstitialtoscreen_run (Model, Statein, Stateout, Sfcprop, Coupling, & + Grid, Tbd, Cldprop, Radtend, Diag, Interstitial(i), & size(Interstitial), -999, errmsg, errflg) end do @@ -1055,19 +1076,11 @@ subroutine GFS_interstitialtoscreen_run (Model, Statein, Stateout, Sfcprop, Coup nthreads, blkno, errmsg, errflg) #ifdef MPI - use mpi + use mpi_f08 #endif #ifdef _OPENMP use omp_lib #endif - use machine, only: kind_phys - use GFS_typedefs, only: GFS_control_type, GFS_statein_type, & - GFS_stateout_type, GFS_sfcprop_type, & - GFS_coupling_type, GFS_grid_type, & - GFS_tbd_type, GFS_cldprop_type, & - GFS_radtend_type, GFS_diag_type - use CCPP_typedefs, only: GFS_interstitial_type - implicit none !--- interface variables @@ -1089,7 +1102,7 @@ subroutine GFS_interstitialtoscreen_run (Model, Statein, Stateout, Sfcprop, Coup !--- local variables integer :: impi, iomp, ierr - integer :: mpirank, mpisize, mpicomm + integer :: mpirank, mpisize integer :: omprank, ompsize integer :: istart, iend, kstart, kend @@ -1098,13 +1111,11 @@ subroutine GFS_interstitialtoscreen_run (Model, Statein, Stateout, Sfcprop, Coup errflg = 0 #ifdef MPI - mpicomm = Model%communicator mpirank = Model%me - call MPI_COMM_SIZE(mpicomm, mpisize, ierr) + call MPI_COMM_SIZE(Model%communicator, mpisize, ierr) #else mpirank = 0 mpisize = 1 - mpicomm = 0 #endif #ifdef _OPENMP omprank = OMP_GET_THREAD_NUM() @@ -1118,7 +1129,7 @@ subroutine GFS_interstitialtoscreen_run (Model, Statein, Stateout, Sfcprop, Coup !$OMP BARRIER #endif #ifdef MPI -! call MPI_BARRIER(mpicomm,ierr) +! call MPI_BARRIER(Model%communicator,ierr) #endif do impi=0,mpisize-1 @@ -1293,7 +1304,6 @@ subroutine GFS_interstitialtoscreen_run (Model, Statein, Stateout, Sfcprop, Coup call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%qss_ice ', Interstitial%qss_ice ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%qss_land ', Interstitial%qss_land ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%qss_water ', Interstitial%qss_water ) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%radar_reset ', Interstitial%radar_reset ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%raddt ', Interstitial%raddt ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%raincd ', Interstitial%raincd ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%raincs ', Interstitial%raincs ) @@ -1322,8 +1332,6 @@ subroutine GFS_interstitialtoscreen_run (Model, Statein, Stateout, Sfcprop, Coup call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%sigmafrac ', Interstitial%sigmafrac ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%sigmatot ', Interstitial%sigmatot ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%snowc ', Interstitial%snowc ) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%snowd_ice ', Interstitial%snowd_ice ) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%snowd_land ', Interstitial%snowd_land ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%snohf ', Interstitial%snohf ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%snowmt ', Interstitial%snowmt ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%stress ', Interstitial%stress ) @@ -1470,7 +1478,7 @@ subroutine GFS_interstitialtoscreen_run (Model, Statein, Stateout, Sfcprop, Coup #endif end do #ifdef MPI -! call MPI_BARRIER(mpicomm,ierr) +! call MPI_BARRIER(Model%communicator,ierr) #endif end do @@ -1478,7 +1486,7 @@ subroutine GFS_interstitialtoscreen_run (Model, Statein, Stateout, Sfcprop, Coup !$OMP BARRIER #endif #ifdef MPI -! call MPI_BARRIER(mpicomm,ierr) +! call MPI_BARRIER(Model%communicator,ierr) #endif end subroutine GFS_interstitialtoscreen_run @@ -1535,7 +1543,7 @@ module GFS_checkland !! \htmlinclude GFS_checkland_run.html !! subroutine GFS_checkland_run (me, master, blkno, im, kdt, iter, flag_iter, flag_guess, & - flag_init, flag_restart, frac_grid, isot, ivegsrc, stype,scolor, vtype, slope, & + flag_init, flag_restart, frac_grid, isot, ivegsrc, stype,scolor, vtype, slope, & dry, icy, wet, lake, ocean, oceanfrac, landfrac, lakefrac, slmsk, islmsk, & zorl, zorlw, zorll, zorli, fice, errmsg, errflg ) diff --git a/physics/GFS_debug.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_debug.meta similarity index 77% rename from physics/GFS_debug.meta rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_debug.meta index 1ad24e1d6..0d12b2bbb 100644 --- a/physics/GFS_debug.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_debug.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = GFS_diagtoscreen type = scheme - dependencies = machine.F + dependencies = ../../hooks/machine.F ######################################################################## [ccpp-arg-table] @@ -9,17 +9,73 @@ type = scheme [Model] standard_name = GFS_control_type_instance - long_name = instance of derived type GFS_control_type in FV3 + long_name = instance of derived type GFS_control_type units = DDT dimensions = () type = GFS_control_type intent = in -[Data] - standard_name = GFS_data_type_instance_all_blocks - long_name = instance of derived type GFS_data_type +[Statein] + standard_name = GFS_statein_type_instance + long_name = prognostic state data in from dycore + units = DDT + dimensions = () + type = GFS_statein_type + intent = in +[Stateout] + standard_name = GFS_stateout_type_instance + long_name = prognostic state or tendencies return to dycore + units = DDT + dimensions = () + type = GFS_stateout_type + intent = in +[Sfcprop] + standard_name = GFS_sfcprop_type_instance + long_name = instance of derived type GFS_sfcprop_type + units = DDT + dimensions = () + type = GFS_sfcprop_type + intent = in +[Coupling] + standard_name = GFS_coupling_type_instance + long_name = instance of derived type GFS_coupling_type + units = DDT + dimensions = () + type = GFS_coupling_type + intent = in +[Grid] + standard_name = GFS_grid_type_instance + long_name = instance of derived type GFS_grid_type + units = DDT + dimensions = () + type = GFS_grid_type + intent = in +[Tbd] + standard_name = GFS_tbd_type_instance + long_name = instance of derived type GFS_tbd_type + units = DDT + dimensions = () + type = GFS_tbd_type + intent = in +[Cldprop] + standard_name = GFS_cldprop_type_instance + long_name = instance of derived type GFS_cldprop_type + units = DDT + dimensions = () + type = GFS_cldprop_type + intent = in +[Radtend] + standard_name = GFS_radtend_type_instance + long_name = instance of derived type GFS_radtend_type units = DDT - dimensions = (ccpp_block_count) - type = GFS_data_type + dimensions = () + type = GFS_radtend_type + intent = in +[Diag] + standard_name = GFS_diag_type_instance + long_name = instance of derived type GFS_diag_type + units = DDT + dimensions = () + type = GFS_diag_type intent = in [Interstitial] standard_name = GFS_interstitial_type_instance_all_threads @@ -55,12 +111,68 @@ dimensions = () type = GFS_control_type intent = in -[Data] - standard_name = GFS_data_type_instance_all_blocks - long_name = instance of derived type GFS_data_type +[Statein] + standard_name = GFS_statein_type_instance + long_name = prognostic state data in from dycore + units = DDT + dimensions = () + type = GFS_statein_type + intent = in +[Stateout] + standard_name = GFS_stateout_type_instance + long_name = prognostic state or tendencies return to dycore + units = DDT + dimensions = () + type = GFS_stateout_type + intent = in +[Sfcprop] + standard_name = GFS_sfcprop_type_instance + long_name = instance of derived type GFS_sfcprop_type + units = DDT + dimensions = () + type = GFS_sfcprop_type + intent = in +[Coupling] + standard_name = GFS_coupling_type_instance + long_name = instance of derived type GFS_coupling_type + units = DDT + dimensions = () + type = GFS_coupling_type + intent = in +[Grid] + standard_name = GFS_grid_type_instance + long_name = instance of derived type GFS_grid_type units = DDT - dimensions = (ccpp_block_count) - type = GFS_data_type + dimensions = () + type = GFS_grid_type + intent = in +[Tbd] + standard_name = GFS_tbd_type_instance + long_name = instance of derived type GFS_tbd_type + units = DDT + dimensions = () + type = GFS_tbd_type + intent = in +[Cldprop] + standard_name = GFS_cldprop_type_instance + long_name = instance of derived type GFS_cldprop_type + units = DDT + dimensions = () + type = GFS_cldprop_type + intent = in +[Radtend] + standard_name = GFS_radtend_type_instance + long_name = instance of derived type GFS_radtend_type + units = DDT + dimensions = () + type = GFS_radtend_type + intent = in +[Diag] + standard_name = GFS_diag_type_instance + long_name = instance of derived type GFS_diag_type + units = DDT + dimensions = () + type = GFS_diag_type intent = in [Interstitial] standard_name = GFS_interstitial_type_instance_all_threads @@ -200,7 +312,7 @@ [ccpp-table-properties] name = GFS_interstitialtoscreen type = scheme - dependencies = machine.F + dependencies = ../../hooks/machine.F ######################################################################## [ccpp-arg-table] @@ -213,12 +325,68 @@ dimensions = () type = GFS_control_type intent = in -[Data] - standard_name = GFS_data_type_instance_all_blocks - long_name = instance of derived type GFS_data_type +[Statein] + standard_name = GFS_statein_type_instance + long_name = prognostic state data in from dycore + units = DDT + dimensions = () + type = GFS_statein_type + intent = in +[Stateout] + standard_name = GFS_stateout_type_instance + long_name = prognostic state or tendencies return to dycore + units = DDT + dimensions = () + type = GFS_stateout_type + intent = in +[Sfcprop] + standard_name = GFS_sfcprop_type_instance + long_name = instance of derived type GFS_sfcprop_type + units = DDT + dimensions = () + type = GFS_sfcprop_type + intent = in +[Coupling] + standard_name = GFS_coupling_type_instance + long_name = instance of derived type GFS_coupling_type + units = DDT + dimensions = () + type = GFS_coupling_type + intent = in +[Grid] + standard_name = GFS_grid_type_instance + long_name = instance of derived type GFS_grid_type + units = DDT + dimensions = () + type = GFS_grid_type + intent = in +[Tbd] + standard_name = GFS_tbd_type_instance + long_name = instance of derived type GFS_tbd_type + units = DDT + dimensions = () + type = GFS_tbd_type + intent = in +[Cldprop] + standard_name = GFS_cldprop_type_instance + long_name = instance of derived type GFS_cldprop_type + units = DDT + dimensions = () + type = GFS_cldprop_type + intent = in +[Radtend] + standard_name = GFS_radtend_type_instance + long_name = instance of derived type GFS_radtend_type units = DDT - dimensions = (ccpp_block_count) - type = GFS_data_type + dimensions = () + type = GFS_radtend_type + intent = in +[Diag] + standard_name = GFS_diag_type_instance + long_name = instance of derived type GFS_diag_type + units = DDT + dimensions = () + type = GFS_diag_type intent = in [Interstitial] standard_name = GFS_interstitial_type_instance_all_threads @@ -254,12 +422,68 @@ dimensions = () type = GFS_control_type intent = in -[Data] - standard_name = GFS_data_type_instance_all_blocks - long_name = instance of derived type GFS_data_type +[Statein] + standard_name = GFS_statein_type_instance + long_name = prognostic state data in from dycore + units = DDT + dimensions = () + type = GFS_statein_type + intent = in +[Stateout] + standard_name = GFS_stateout_type_instance + long_name = prognostic state or tendencies return to dycore + units = DDT + dimensions = () + type = GFS_stateout_type + intent = in +[Sfcprop] + standard_name = GFS_sfcprop_type_instance + long_name = instance of derived type GFS_sfcprop_type units = DDT - dimensions = (ccpp_block_count) - type = GFS_data_type + dimensions = () + type = GFS_sfcprop_type + intent = in +[Coupling] + standard_name = GFS_coupling_type_instance + long_name = instance of derived type GFS_coupling_type + units = DDT + dimensions = () + type = GFS_coupling_type + intent = in +[Grid] + standard_name = GFS_grid_type_instance + long_name = instance of derived type GFS_grid_type + units = DDT + dimensions = () + type = GFS_grid_type + intent = in +[Tbd] + standard_name = GFS_tbd_type_instance + long_name = instance of derived type GFS_tbd_type + units = DDT + dimensions = () + type = GFS_tbd_type + intent = in +[Cldprop] + standard_name = GFS_cldprop_type_instance + long_name = instance of derived type GFS_cldprop_type + units = DDT + dimensions = () + type = GFS_cldprop_type + intent = in +[Radtend] + standard_name = GFS_radtend_type_instance + long_name = instance of derived type GFS_radtend_type + units = DDT + dimensions = () + type = GFS_radtend_type + intent = in +[Diag] + standard_name = GFS_diag_type_instance + long_name = instance of derived type GFS_diag_type + units = DDT + dimensions = () + type = GFS_diag_type intent = in [Interstitial] standard_name = GFS_interstitial_type_instance_all_threads @@ -399,7 +623,7 @@ [ccpp-table-properties] name = GFS_abort type = scheme - dependencies = machine.F + dependencies = ../../hooks/machine.F ######################################################################## [ccpp-arg-table] @@ -439,7 +663,7 @@ [ccpp-table-properties] name = GFS_checkland type = scheme - dependencies = machine.F + dependencies = ../../hooks/machine.F ######################################################################## [ccpp-arg-table] @@ -698,7 +922,7 @@ [ccpp-table-properties] name = GFS_checktracers type = scheme - dependencies = machine.F + dependencies = ../../hooks/machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/GFS_phys_time_vary.fv3.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_phys_time_vary.fv3.F90 similarity index 80% rename from physics/GFS_phys_time_vary.fv3.F90 rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_phys_time_vary.fv3.F90 index 223ec94da..f06c0b24b 100644 --- a/physics/GFS_phys_time_vary.fv3.F90 +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_phys_time_vary.fv3.F90 @@ -2,7 +2,7 @@ !! 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, stratospheric water vapor, +!! This module contains GFS physics time vary subroutines including stratospheric water vapor, !! aerosol, IN&CCN and surface properties updates. module GFS_phys_time_vary @@ -10,12 +10,11 @@ module GFS_phys_time_vary use omp_lib #endif - use machine, only : kind_phys + use machine, only : kind_phys, kind_dbl_prec, kind_sngl_prec use mersenne_twister, only: random_setseed, random_number - use ozne_def, only : levozp, oz_coeff, oz_lat, oz_pres, oz_time, ozplin - use ozinterp, only : read_o3data, setindxoz, ozinterpol + use module_ozphys, only: ty_ozphys use h2o_def, only : levh2o, h2o_coeff, h2o_lat, h2o_pres, h2o_time, h2oplin use h2ointerp, only : read_h2odata, setindxh2o, h2ointerpol @@ -61,6 +60,22 @@ module GFS_phys_time_vary contains + subroutine copy_error(myerrmsg, myerrflg, errmsg, errflg) + implicit none + character(*), intent(in) :: myerrmsg + integer, intent(in) :: myerrflg + character(*), intent(out) :: errmsg + integer, intent(inout) :: errflg + if(myerrflg /= 0 .and. errflg == 0) then + !$OMP CRITICAL + if(errflg == 0) then + errmsg = myerrmsg + errflg = myerrflg + endif + !$OMP END CRITICAL + endif + end subroutine copy_error + !> \section arg_table_GFS_phys_time_vary_init Argument Table !! \htmlinclude GFS_phys_time_vary_init.html !! @@ -69,7 +84,7 @@ module GFS_phys_time_vary subroutine GFS_phys_time_vary_init ( & me, master, ntoz, h2o_phys, iaerclm, iccn, iaermdl, iflip, im, levs, & nx, ny, idate, xlat_d, xlon_d, & - jindx1_o3, jindx2_o3, ddy_o3, ozpl, jindx1_h, jindx2_h, ddy_h, h2opl,fhour, & + jindx1_o3, jindx2_o3, ddy_o3, jindx1_h, jindx2_h, ddy_h, h2opl,fhour, & jindx1_aer, jindx2_aer, ddy_aer, iindx1_aer, iindx2_aer, ddx_aer, aer_nm, & jindx1_ci, jindx2_ci, ddy_ci, iindx1_ci, iindx2_ci, ddx_ci, imap, jmap, & do_ugwp_v1, jindx1_tau, jindx2_tau, ddy_j1tau, ddy_j2tau, & @@ -82,7 +97,7 @@ subroutine GFS_phys_time_vary_init ( smcwtdxy, deeprechxy, rechxy, snowxy, snicexy, snliqxy, tsnoxy , smoiseq, zsnsoxy, & sh2o,smois,tslb,tsfcl, snowd, canopy, tg3, stype, con_t0c, lsm_cold_start, nthrds, & lkm, use_lake_model, lakefrac, lakedepth, iopt_lake, iopt_lake_clm, iopt_lake_flake, & - lakefrac_threshold, lakedepth_threshold, errmsg, errflg) + lakefrac_threshold, lakedepth_threshold, ozphys, errmsg, errflg) implicit none @@ -97,18 +112,19 @@ subroutine GFS_phys_time_vary_init ( integer, intent(inout) :: use_lake_model(:) real(kind=kind_phys), intent(in ) :: lakefrac(:), lakedepth(:) - integer, intent(inout) :: jindx1_o3(:), jindx2_o3(:), jindx1_h(:), jindx2_h(:) - real(kind_phys), intent(inout) :: ddy_o3(:), ddy_h(:) - real(kind_phys), intent(in) :: ozpl(:,:,:), h2opl(:,:,:) - integer, intent(inout) :: jindx1_aer(:), jindx2_aer(:), iindx1_aer(:), iindx2_aer(:) - real(kind_phys), intent(inout) :: ddy_aer(:), ddx_aer(:) + integer, intent(inout), optional :: jindx1_o3(:), jindx2_o3(:), jindx1_h(:), jindx2_h(:) + real(kind_phys), intent(inout), optional :: ddy_o3(:), ddy_h(:) + real(kind_phys), intent(in) :: h2opl(:,:,:) + + integer, intent(inout), optional :: jindx1_aer(:), jindx2_aer(:), iindx1_aer(:), iindx2_aer(:) + real(kind_phys), intent(inout), optional :: ddy_aer(:), ddx_aer(:) real(kind_phys), intent(out) :: aer_nm(:,:,:) - integer, intent(inout) :: jindx1_ci(:), jindx2_ci(:), iindx1_ci(:), iindx2_ci(:) - real(kind_phys), intent(inout) :: ddy_ci(:), ddx_ci(:) + integer, intent(inout), optional :: jindx1_ci(:), jindx2_ci(:), iindx1_ci(:), iindx2_ci(:) + real(kind_phys), intent(inout), optional :: ddy_ci(:), ddx_ci(:) integer, intent(inout) :: imap(:), jmap(:) logical, intent(in) :: do_ugwp_v1 - real(kind_phys), intent(inout) :: ddy_j1tau(:), ddy_j2tau(:) - integer, intent(inout) :: jindx1_tau(:), jindx2_tau(:) + real(kind_phys), intent(inout), optional :: ddy_j1tau(:), ddy_j2tau(:) + integer, intent(inout), optional :: jindx1_tau(:), jindx2_tau(:) integer, intent(in) :: isot, ivegsrc, nlunit real(kind_phys), intent(inout) :: sncovr(:), sncovr_ice(:) @@ -116,55 +132,56 @@ subroutine GFS_phys_time_vary_init ( real(kind_phys), intent(in) :: min_seaice, fice(:) real(kind_phys), intent(in) :: landfrac(:) real(kind_phys), intent(inout) :: weasd(:) + type(ty_ozphys), intent(in) :: ozphys ! NoahMP - only allocated when NoahMP is used integer, intent(in) :: lsoil_lsm, lsnow_lsm_lbound, lsnow_lsm_ubound real(kind_phys), intent(in) :: zs(:) real(kind_phys), intent(in) :: dzs(:) - real(kind_phys), intent(inout) :: tvxy(:) - real(kind_phys), intent(inout) :: tgxy(:) - real(kind_phys), intent(inout) :: tahxy(:) - real(kind_phys), intent(inout) :: canicexy(:) - real(kind_phys), intent(inout) :: canliqxy(:) - real(kind_phys), intent(inout) :: eahxy(:) - real(kind_phys), intent(inout) :: cmxy(:) - real(kind_phys), intent(inout) :: chxy(:) - real(kind_phys), intent(inout) :: fwetxy(:) - real(kind_phys), intent(inout) :: sneqvoxy(:) - real(kind_phys), intent(inout) :: alboldxy(:) - real(kind_phys), intent(inout) :: qsnowxy(:) - real(kind_phys), intent(inout) :: wslakexy(:) + real(kind_phys), intent(inout), optional :: tvxy(:) + real(kind_phys), intent(inout), optional :: tgxy(:) + real(kind_phys), intent(inout), optional :: tahxy(:) + real(kind_phys), intent(inout), optional :: canicexy(:) + real(kind_phys), intent(inout), optional :: canliqxy(:) + real(kind_phys), intent(inout), optional :: eahxy(:) + real(kind_phys), intent(inout), optional :: cmxy(:) + real(kind_phys), intent(inout), optional :: chxy(:) + real(kind_phys), intent(inout), optional :: fwetxy(:) + real(kind_phys), intent(inout), optional :: sneqvoxy(:) + real(kind_phys), intent(inout), optional :: alboldxy(:) + real(kind_phys), intent(inout), optional :: qsnowxy(:) + real(kind_phys), intent(inout), optional :: wslakexy(:) real(kind_phys), intent(inout) :: albdvis_lnd(:) real(kind_phys), intent(inout) :: albdnir_lnd(:) real(kind_phys), intent(inout) :: albivis_lnd(:) real(kind_phys), intent(inout) :: albinir_lnd(:) - real(kind_phys), intent(inout) :: albdvis_ice(:) - real(kind_phys), intent(inout) :: albdnir_ice(:) - real(kind_phys), intent(inout) :: albivis_ice(:) - real(kind_phys), intent(inout) :: albinir_ice(:) + real(kind_phys), intent(inout), optional :: albdvis_ice(:) + real(kind_phys), intent(inout), optional :: albdnir_ice(:) + real(kind_phys), intent(inout), optional :: albivis_ice(:) + real(kind_phys), intent(inout), optional :: albinir_ice(:) real(kind_phys), intent(inout) :: emiss_lnd(:) real(kind_phys), intent(inout) :: emiss_ice(:) - real(kind_phys), intent(inout) :: taussxy(:) - real(kind_phys), intent(inout) :: waxy(:) - real(kind_phys), intent(inout) :: wtxy(:) - real(kind_phys), intent(inout) :: zwtxy(:) - real(kind_phys), intent(inout) :: xlaixy(:) - real(kind_phys), intent(inout) :: xsaixy(:) - real(kind_phys), intent(inout) :: lfmassxy(:) - real(kind_phys), intent(inout) :: stmassxy(:) - real(kind_phys), intent(inout) :: rtmassxy(:) - real(kind_phys), intent(inout) :: woodxy(:) - real(kind_phys), intent(inout) :: stblcpxy(:) - real(kind_phys), intent(inout) :: fastcpxy(:) - real(kind_phys), intent(inout) :: smcwtdxy(:) - real(kind_phys), intent(inout) :: deeprechxy(:) - real(kind_phys), intent(inout) :: rechxy(:) - real(kind_phys), intent(inout) :: snowxy(:) - real(kind_phys), intent(inout) :: snicexy(:,lsnow_lsm_lbound:) - real(kind_phys), intent(inout) :: snliqxy(:,lsnow_lsm_lbound:) - real(kind_phys), intent(inout) :: tsnoxy (:,lsnow_lsm_lbound:) - real(kind_phys), intent(inout) :: smoiseq(:,:) - real(kind_phys), intent(inout) :: zsnsoxy(:,lsnow_lsm_lbound:) + real(kind_phys), intent(inout), optional :: taussxy(:) + real(kind_phys), intent(inout), optional :: waxy(:) + real(kind_phys), intent(inout), optional :: wtxy(:) + real(kind_phys), intent(inout), optional :: zwtxy(:) + real(kind_phys), intent(inout), optional :: xlaixy(:) + real(kind_phys), intent(inout), optional :: xsaixy(:) + real(kind_phys), intent(inout), optional :: lfmassxy(:) + real(kind_phys), intent(inout), optional :: stmassxy(:) + real(kind_phys), intent(inout), optional :: rtmassxy(:) + real(kind_phys), intent(inout), optional :: woodxy(:) + real(kind_phys), intent(inout), optional :: stblcpxy(:) + real(kind_phys), intent(inout), optional :: fastcpxy(:) + real(kind_phys), intent(inout), optional :: smcwtdxy(:) + real(kind_phys), intent(inout), optional :: deeprechxy(:) + real(kind_phys), intent(inout), optional :: rechxy(:) + real(kind_phys), intent(inout), optional :: snowxy(:) + real(kind_phys), intent(inout), optional :: snicexy(:,lsnow_lsm_lbound:) + real(kind_phys), intent(inout), optional :: snliqxy(:,lsnow_lsm_lbound:) + real(kind_phys), intent(inout), optional :: tsnoxy (:,lsnow_lsm_lbound:) + real(kind_phys), intent(inout), optional :: smoiseq(:,:) + real(kind_phys), intent(inout), optional :: zsnsoxy(:,lsnow_lsm_lbound:) real(kind_phys), intent(inout) :: sh2o(:,:) real(kind_phys), intent(inout) :: smois(:,:) real(kind_phys), intent(inout) :: tslb(:,:) @@ -192,6 +209,9 @@ subroutine GFS_phys_time_vary_init ( real(kind=kind_phys), dimension(:), allocatable :: dzsno real(kind=kind_phys), dimension(:), allocatable :: dzsnso + integer :: myerrflg + character(len=255) :: myerrmsg + ! Initialize CCPP error handling variables errmsg = '' errflg = 0 @@ -202,69 +222,37 @@ subroutine GFS_phys_time_vary_init ( jamin=999 jamax=-999 -!$OMP parallel num_threads(nthrds) default(none) & -!$OMP shared (me,master,ntoz,h2o_phys,im,nx,ny,levs,idate) & -!$OMP shared (xlat_d,xlon_d,imap,jmap,errmsg,errflg) & -!$OMP shared (levozp,oz_coeff,oz_pres,ozpl) & -!$OMP shared (levh2o,h2o_coeff,h2o_pres,h2opl) & -!$OMP shared (iamin, iamax, jamin, jamax) & -!$OMP shared (iaerclm,iaermdl,ntrcaer,aer_nm,iflip,iccn) & -!$OMP shared (jindx1_o3,jindx2_o3,ddy_o3,jindx1_h,jindx2_h,ddy_h) & -!$OMP shared (jindx1_aer,jindx2_aer,ddy_aer,iindx1_aer,iindx2_aer,ddx_aer) & -!$OMP shared (jindx1_ci,jindx2_ci,ddy_ci,iindx1_ci,iindx2_ci,ddx_ci) & -!$OMP shared (do_ugwp_v1,jindx1_tau,jindx2_tau,ddy_j1tau,ddy_j2tau) & -!$OMP shared (isot,ivegsrc,nlunit,sncovr,sncovr_ice,lsm,lsm_ruc) & -!$OMP shared (min_seaice,fice,landfrac,vtype,weasd,snupx,salp_data) & -!$OMP private (ix,i,j,rsnow,vegtyp) - -!$OMP sections - -!$OMP section -!> - Call read_o3data() to read ozone data - call read_o3data (ntoz, me, master) - - ! Consistency check that the hardcoded values for levozp and - ! oz_coeff in GFS_typedefs.F90 match what is set by read_o3data - ! in GFS_typedefs.F90: allocate (Tbd%ozpl (IM,levozp,oz_coeff)) - if (size(ozpl, dim=2).ne.levozp) then - write(errmsg,'(2a,i0,a,i0)') "Value error in GFS_phys_time_vary_init: ", & - "levozp from read_o3data does not match value in GFS_typedefs.F90: ", & - levozp, " /= ", size(ozpl, dim=2) - errflg = 1 - end if - if (size(ozpl, dim=3).ne.oz_coeff) then - write(errmsg,'(2a,i0,a,i0)') "Value error in GFS_phys_time_vary_init: ", & - "oz_coeff from read_o3data does not match value in GFS_typedefs.F90: ", & - oz_coeff, " /= ", size(ozpl, dim=3) - errflg = 1 - end if - -!$OMP section !> - Call read_h2odata() to read stratospheric water vapor data + need_h2odata: if(h2o_phys) then call read_h2odata (h2o_phys, me, master) ! Consistency check that the hardcoded values for levh2o and - ! h2o_coeff in GFS_typedefs.F90 match what is set by read_o3data + ! h2o_coeff in GFS_typedefs.F90 match what is set by read_h2odata ! in GFS_typedefs.F90: allocate (Tbd%h2opl (IM,levh2o,h2o_coeff)) if (size(h2opl, dim=2).ne.levh2o) then - write(errmsg,'(2a,i0,a,i0)') "Value error in GFS_phys_time_vary_init: ", & + write(myerrmsg,'(2a,i0,a,i0)') "Value error in GFS_phys_time_vary_init: ", & "levh2o from read_h2odata does not match value in GFS_typedefs.F90: ", & levh2o, " /= ", size(h2opl, dim=2) - errflg = 1 + myerrflg = 1 + call copy_error(myerrmsg, myerrflg, errmsg, errflg) end if if (size(h2opl, dim=3).ne.h2o_coeff) then - write(errmsg,'(2a,i0,a,i0)') "Value error in GFS_phys_time_vary_init: ", & + write(myerrmsg,'(2a,i0,a,i0)') "Value error in GFS_phys_time_vary_init: ", & "h2o_coeff from read_h2odata does not match value in GFS_typedefs.F90: ", & h2o_coeff, " /= ", size(h2opl, dim=3) - errflg = 1 + myerrflg = 1 + call copy_error(myerrmsg, myerrflg, errmsg, errflg) end if + endif need_h2odata -!$OMP section !> - Call read_aerdata() to read aerosol climatology, Anning added coupled !> added coupled gocart and radiation option to initializing aer_nm if (iaerclm) then ntrcaer = ntrcaerm - call read_aerdata (me,master,iflip,idate,errmsg,errflg) + myerrflg = 0 + myerrmsg = 'read_aerdata failed without a message' + call read_aerdata (me,master,iflip,idate,myerrmsg,myerrflg) + call copy_error(myerrmsg, myerrflg, errmsg, errflg) else if(iaermdl ==2 ) then do ix=1,ntrcaerm do j=1,levs @@ -278,7 +266,6 @@ subroutine GFS_phys_time_vary_init ( ntrcaer = 1 endif -!$OMP section !> - Call read_cidata() to read IN and CCN data if (iccn == 1) then call read_cidata (me,master) @@ -286,39 +273,41 @@ subroutine GFS_phys_time_vary_init ( ! hardcoded in module iccn_def.F and GFS_typedefs.F90 endif -!$OMP section !> - Call tau_amf dats for ugwp_v1 if (do_ugwp_v1) then - call read_tau_amf(me, master, errmsg, errflg) + myerrflg = 0 + myerrmsg = 'read_tau_amf failed without a message' + call read_tau_amf(me, master, myerrmsg, myerrflg) + call copy_error(myerrmsg, myerrflg, errmsg, errflg) endif -!$OMP section !> - Initialize soil vegetation (needed for sncovr calculation further down) - call set_soilveg(me, isot, ivegsrc, nlunit, errmsg, errflg) + myerrflg = 0 + myerrmsg = 'set_soilveg failed without a message' + call set_soilveg(me, isot, ivegsrc, nlunit, myerrmsg, myerrflg) + call copy_error(myerrmsg, myerrflg, errmsg, errflg) -!$OMP section !> - read in NoahMP table (needed for NoahMP init) - call read_mp_table_parameters(errmsg, errflg) + if(lsm == lsm_noahmp) then + myerrflg = 0 + myerrmsg = 'read_mp_table_parameters failed without a message' + call read_mp_table_parameters(myerrmsg, myerrflg) + call copy_error(myerrmsg, myerrflg, errmsg, errflg) + endif -!$OMP end sections ! Need an OpenMP barrier here (implicit in "end sections") -!$OMP sections - -!$OMP section -!> - Call setindxoz() to initialize ozone data +!> - Setup spatial interpolation indices for ozone physics. if (ntoz > 0) then - call setindxoz (im, xlat_d, jindx1_o3, jindx2_o3, ddy_o3) + call ozphys%setup_o3prog(xlat_d, jindx1_o3, jindx2_o3, ddy_o3) endif -!$OMP section !> - Call setindxh2o() to initialize stratospheric water vapor data if (h2o_phys) then call setindxh2o (im, xlat_d, jindx1_h, jindx2_h, ddy_h) endif -!$OMP section !> - Call setindxaer() to initialize aerosols data if (iaerclm) then call setindxaer (im, xlat_d, jindx1_aer, & @@ -331,7 +320,6 @@ subroutine GFS_phys_time_vary_init ( jamax = max(maxval(jindx2_aer), jamax) endif -!$OMP section !> - Call setindxci() to initialize IN and CCN data if (iccn == 1) then call setindxci (im, xlat_d, jindx1_ci, & @@ -339,14 +327,12 @@ subroutine GFS_phys_time_vary_init ( iindx1_ci, iindx2_ci, ddx_ci) endif -!$OMP section !> - Call cires_indx_ugwp to read monthly-mean GW-tau diagnosed from FV3GFS-runs that can resolve GWs if (do_ugwp_v1) then call cires_indx_ugwp (im, me, master, xlat_d, jindx1_tau, jindx2_tau, & ddy_j1tau, ddy_j2tau) endif -!$OMP section !--- initial calculation of maps local ix -> global i and j ix = 0 do j = 1,ny @@ -357,7 +343,6 @@ subroutine GFS_phys_time_vary_init ( enddo enddo -!$OMP section !--- if sncovr does not exist in the restart, need to create it if (all(sncovr < zero)) then if (me == master ) write(*,'(a)') 'GFS_phys_time_vary_init: compute sncovr from weasd and soil vegetation parameters' @@ -386,14 +371,12 @@ subroutine GFS_phys_time_vary_init ( endif endif -!$OMP end sections - -!$OMP end parallel - if (errflg/=0) return if (iaerclm) then + ! This call is outside the OpenMP section, so it should access errmsg & errflg directly. call read_aerdataf (me, master, iflip, idate, fhour, errmsg, errflg) + ! If it is moved to an OpenMP section, it must use myerrmsg, myerrflg, and copy_error. if (errflg/=0) return end if @@ -479,7 +462,8 @@ subroutine GFS_phys_time_vary_init ( !$omp shared(dwsat_table,dksat_table,psisat_table,smoiseq) & !$OMP shared(smcwtdxy,deeprechxy,rechxy,errmsg,errflg) & !$OMP private(vegtyp,masslai,masssai,snd,dzsno,dzsnso,isnow) & -!$OMP private(soiltyp,bexp,smcmax,smcwlt,dwsat,dksat,psisat,ddz) +!$OMP private(soiltyp,bexp,smcmax,smcwlt,dwsat,dksat,psisat) & +!$OMP private(myerrmsg,myerrflg,ddz) do ix=1,im if (landfrac(ix) >= drythresh) then tvxy(ix) = tsfcl(ix) @@ -594,8 +578,9 @@ subroutine GFS_phys_time_vary_init ( dzsno(-1) = 0.20_kind_phys dzsno(0) = snd - 0.05_kind_phys - 0.20_kind_phys else - errmsg = 'Error in GFS_phys_time_vary.fv3.F90: Problem with the logic assigning snow layers in Noah MP initialization' - errflg = 1 + myerrmsg = 'Error in GFS_phys_time_vary.fv3.F90: Problem with the logic assigning snow layers in Noah MP initialization' + myerrflg = 1 + call copy_error(myerrmsg, myerrflg, errmsg, errflg) endif ! Now we have the snowxy field @@ -608,8 +593,10 @@ subroutine GFS_phys_time_vary_init ( isnow = nint(snowxy(ix))+1 ! snowxy <=0.0, dzsno >= 0.0 +! using stc and tgxy to linearly interpolate the snow temp for each layer + do is = isnow,0 - tsnoxy(ix,is) = tgxy(ix) + tsnoxy(ix,is) = tgxy(ix) + (( sum(dzsno(isnow:is)) -0.5*dzsno(is) )/snd)*(stc(ix,1)-tgxy(ix)) snliqxy(ix,is) = zero snicexy(ix,is) = one * dzsno(is) * weasd(ix)/snd enddo @@ -749,7 +736,7 @@ subroutine GFS_phys_time_vary_timestep_init ( lakefrac, min_seaice, min_lakeice, smc, slc, stc, smois, sh2o, tslb, tiice, tg3, tref, & tsfc, tsfco, tisfc, hice, fice, facsf, facwf, alvsf, alvwf, alnsf, alnwf, zorli, zorll, & zorlo, weasd, slope, snoalb, canopy, vfrac, vtype, stype,scolor, shdmin, shdmax, snowd, & - cv, cvb, cvt, oro, oro_uf, xlat_d, xlon_d, slmsk, landfrac, & + cv, cvb, cvt, oro, oro_uf, xlat_d, xlon_d, slmsk, landfrac, ozphys, & do_ugwp_v1, jindx1_tau, jindx2_tau, ddy_j1tau, ddy_j2tau, tau_amf, errmsg, errflg) implicit none @@ -761,14 +748,14 @@ subroutine GFS_phys_time_vary_timestep_init ( real(kind_phys), intent(in) :: fhswr, fhour logical, intent(in) :: lsswr, cal_pre, random_clds, h2o_phys, iaerclm real(kind_phys), intent(out) :: clstp - integer, intent(in) :: jindx1_o3(:), jindx2_o3(:), jindx1_h(:), jindx2_h(:) - real(kind_phys), intent(in) :: ddy_o3(:), ddy_h(:) + integer, intent(in), optional :: jindx1_o3(:), jindx2_o3(:), jindx1_h(:), jindx2_h(:) + real(kind_phys), intent(in), optional :: ddy_o3(:), ddy_h(:) real(kind_phys), intent(inout) :: ozpl(:,:,:), h2opl(:,:,:) - integer, intent(in) :: jindx1_aer(:), jindx2_aer(:), iindx1_aer(:), iindx2_aer(:) - real(kind_phys), intent(in) :: ddy_aer(:), ddx_aer(:) + integer, intent(in), optional :: jindx1_aer(:), jindx2_aer(:), iindx1_aer(:), iindx2_aer(:) + real(kind_phys), intent(in), optional :: ddy_aer(:), ddx_aer(:) real(kind_phys), intent(inout) :: aer_nm(:,:,:) - integer, intent(in) :: jindx1_ci(:), jindx2_ci(:), iindx1_ci(:), iindx2_ci(:) - real(kind_phys), intent(in) :: ddy_ci(:), ddx_ci(:) + integer, intent(in), optional :: jindx1_ci(:), jindx2_ci(:), iindx1_ci(:), iindx2_ci(:) + real(kind_phys), intent(in), optional :: ddy_ci(:), ddx_ci(:) real(kind_phys), intent(inout) :: in_nm(:,:), ccn_nm(:,:) integer, intent(in) :: imap(:), jmap(:) real(kind_phys), intent(in) :: prsl(:,:) @@ -776,9 +763,10 @@ subroutine GFS_phys_time_vary_timestep_init ( real(kind_phys), intent(inout) :: rann(:,:) logical, intent(in) :: do_ugwp_v1 - integer, intent(in) :: jindx1_tau(:), jindx2_tau(:) - real(kind_phys), intent(in) :: ddy_j1tau(:), ddy_j2tau(:) + integer, intent(in), optional :: jindx1_tau(:), jindx2_tau(:) + real(kind_phys), intent(in), optional :: ddy_j1tau(:), ddy_j2tau(:) real(kind_phys), intent(inout) :: tau_amf(:) + type(ty_ozphys), intent(in) :: ozphys ! For gcycle only integer, intent(in) :: nthrds, nx, ny, nsst, tile_num, nlunit, lsoil @@ -788,23 +776,25 @@ subroutine GFS_phys_time_vary_timestep_init ( logical, intent(in) :: use_ufo, nst_anl, frac_grid real(kind_phys), intent(in) :: fhcyc, phour, lakefrac(:), min_seaice, min_lakeice, & xlat_d(:), xlon_d(:), landfrac(:) - real(kind_phys), intent(inout) :: smc(:,:), slc(:,:), stc(:,:), smois(:,:), sh2o(:,:), & - tslb(:,:), tiice(:,:), tg3(:), tref(:), & + real(kind_phys), intent(inout) :: smc(:,:), slc(:,:), stc(:,:), tiice(:,:), tg3(:), & tsfc(:), tsfco(:), tisfc(:), hice(:), fice(:), & facsf(:), facwf(:), alvsf(:), alvwf(:), alnsf(:), alnwf(:), & zorli(:), zorll(:), zorlo(:), weasd(:), snoalb(:), & canopy(:), vfrac(:), shdmin(:), shdmax(:), & snowd(:), cv(:), cvb(:), cvt(:), oro(:), oro_uf(:), slmsk(:) + real(kind_phys), intent(inout), optional :: smois(:,:), sh2o(:,:), tslb(:,:), tref(:) integer, intent(inout) :: vtype(:), stype(:),scolor(:), slope(:) character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg ! Local variables - integer :: i, j, k, iseed, iskip, ix - real(kind=kind_phys) :: wrk(1) - real(kind=kind_phys) :: rannie(cny) - real(kind=kind_phys) :: rndval(cnx*cny*nrcm) + integer :: i, j, k, iseed, iskip, ix, idat(8), jdat(8), iday, j1, j2, nc, n1, n2, jdow, & + jdoy, jday, w3kindreal, w3kindint + real(kind_phys) :: wrk(1), tem, tx1, tx2, rjday + real(kind_phys) :: rannie(cny) + real(kind_phys) :: rndval(cnx*cny*nrcm) + real(kind_dbl_prec) :: rinc(5) ! Initialize CCPP error handling variables errmsg = '' @@ -824,7 +814,8 @@ subroutine GFS_phys_time_vary_timestep_init ( !$OMP shared(ozpl,ddy_o3,h2o_phys,jindx1_h,jindx2_h,h2opl,ddy_h,iaerclm,master) & !$OMP shared(levs,prsl,iccn,jindx1_ci,jindx2_ci,ddy_ci,iindx1_ci,iindx2_ci) & !$OMP shared(ddx_ci,in_nm,ccn_nm,do_ugwp_v1,jindx1_tau,jindx2_tau,ddy_j1tau) & -!$OMP shared(ddy_j2tau,tau_amf,iflip) & +!$OMP shared(ddy_j2tau,tau_amf,iflip,ozphys,rjday,n1,n2,idat,jdat,rinc) & +!$OMP shared(w3kindreal,w3kindint,jdow,jdoy,jday) & !$OMP private(iseed,iskip,i,j,k) !$OMP sections @@ -875,11 +866,35 @@ subroutine GFS_phys_time_vary_timestep_init ( endif ! imfdeepcnv, cal_re, random_clds !$OMP section -!> - Call ozinterpol() to make ozone interpolation + !> - Compute temporal interpolation indices for updating gas concentrations. + idat=0 + idat(1)=idate(4) + idat(2)=idate(2) + idat(3)=idate(3) + idat(5)=idate(1) + rinc=0. + rinc(2)=fhour + CALL w3movdat(rinc,idat,jdat) + jdow = 0 + jdoy = 0 + jday = 0 + call w3doxdat(jdat,jdow,jdoy,jday) + rjday = jdoy + jdat(5) / 24. + if (rjday < ozphys%time(1)) rjday = rjday + 365. + + n2 = ozphys%ntime + 1 + do j=2,ozphys%ntime + if (rjday < ozphys%time(j)) then + n2 = j + exit + endif + enddo + n1 = n2 - 1 + if (n2 > ozphys%ntime) n2 = n2 - ozphys%ntime + +!> - Update ozone concentration. if (ntoz > 0) then - call ozinterpol (me, im, idate, fhour, & - jindx1_o3, jindx2_o3, & - ozpl, ddy_o3) + call ozphys%update_o3prog(jindx1_o3, jindx2_o3, ddy_o3, rjday, n1, n2, ozpl) endif !$OMP section @@ -979,12 +994,6 @@ subroutine GFS_phys_time_vary_finalize(errmsg, errflg) if (.not.is_initialized) return - ! Deallocate ozone arrays - if (allocated(oz_lat) ) deallocate(oz_lat) - if (allocated(oz_pres) ) deallocate(oz_pres) - if (allocated(oz_time) ) deallocate(oz_time) - if (allocated(ozplin) ) deallocate(ozplin) - ! Deallocate h2o arrays if (allocated(h2o_lat) ) deallocate(h2o_lat) if (allocated(h2o_pres)) deallocate(h2o_pres) diff --git a/physics/GFS_phys_time_vary.fv3.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_phys_time_vary.fv3.meta similarity index 95% rename from physics/GFS_phys_time_vary.fv3.meta rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_phys_time_vary.fv3.meta index 9bd8a21cb..8437d7fb1 100644 --- a/physics/GFS_phys_time_vary.fv3.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_phys_time_vary.fv3.meta @@ -1,8 +1,16 @@ [ccpp-table-properties] name = GFS_phys_time_vary type = scheme - dependencies = aerclm_def.F,aerinterp.F90,gcycle.F90,h2o_def.f,h2ointerp.f90,iccn_def.F,iccninterp.F90,machine.F,mersenne_twister.f - dependencies = namelist_soilveg.f,set_soilveg.f,ozinterp.f90,ozne_def.f,sfcsub.F,cires_tauamf_data.F90,noahmp_tables.f90 + relative_path = ../../ + dependencies = hooks/machine.F + dependencies = Interstitials/UFS_SCM_NEPTUNE/gcycle.F90,Interstitials/UFS_SCM_NEPTUNE/iccn_def.F + dependencies = Interstitials/UFS_SCM_NEPTUNE/iccninterp.F90,Interstitials/UFS_SCM_NEPTUNE/sfcsub.F + dependencies = Radiation/mersenne_twister.f + dependencies = MP/Morrison_Gettelman/aerclm_def.F,MP/Morrison_Gettelman/aerinterp.F90 + dependencies = SFC_Models/Land/Noah/namelist_soilveg.f,SFC_Models/Land/Noah/set_soilveg.f,SFC_Models/Land/Noahmp/noahmp_tables.f90 + dependencies = photochem/module_ozphys.F90 + dependencies = photochem/h2o_def.f,photochem/h2ointerp.f90 + dependencies = GWD/cires_tauamf_data.F90 ######################################################################## [ccpp-arg-table] @@ -123,6 +131,7 @@ dimensions = (horizontal_dimension) type = integer intent = inout + optional = True [jindx2_o3] standard_name = upper_latitude_index_of_ozone_forcing_for_interpolation long_name = interpolation high index for ozone @@ -130,6 +139,7 @@ dimensions = (horizontal_dimension) type = integer intent = inout + optional = True [ddy_o3] standard_name = latitude_interpolation_weight_for_ozone_forcing long_name = interpolation high index for ozone @@ -138,14 +148,7 @@ type = real kind = kind_phys intent = inout -[ozpl] - standard_name = ozone_forcing - long_name = ozone forcing data - units = mixed - dimensions = (horizontal_dimension,vertical_dimension_of_ozone_forcing_data,number_of_coefficients_in_ozone_forcing_data) - type = real - kind = kind_phys - intent = in + optional = True [jindx1_h] standard_name = lower_latitude_index_of_stratospheric_water_vapor_forcing_for_interpolation long_name = interpolation low index for stratospheric water vapor @@ -153,6 +156,7 @@ dimensions = (horizontal_dimension) type = integer intent = inout + optional = True [jindx2_h] standard_name = upper_latitude_index_of_stratospheric_water_vapor_forcing_for_interpolation long_name = interpolation high index for stratospheric water vapor @@ -160,6 +164,7 @@ dimensions = (horizontal_dimension) type = integer intent = inout + optional = True [ddy_h] standard_name = latitude_interpolation_weight_for_stratospheric_water_vapor_forcing long_name = interpolation high index for stratospheric water vapor @@ -168,6 +173,7 @@ type = real kind = kind_phys intent = inout + optional = True [h2opl] standard_name = stratospheric_water_vapor_forcing long_name = water forcing data @@ -191,6 +197,7 @@ dimensions = (horizontal_dimension) type = integer intent = inout + optional = True [jindx2_aer] standard_name = upper_latitude_index_of_aerosol_forcing_for_interpolation long_name = interpolation high index for prescribed aerosols in the y direction @@ -198,6 +205,7 @@ dimensions = (horizontal_dimension) type = integer intent = inout + optional = True [ddy_aer] standard_name = latitude_interpolation_weight_for_aerosol_forcing long_name = interpolation high index for prescribed aerosols in the y direction @@ -206,6 +214,7 @@ type = real kind = kind_phys intent = inout + optional = True [iindx1_aer] standard_name = lower_longitude_index_of_aerosol_forcing_for_interpolation long_name = interpolation low index for prescribed aerosols in the x direction @@ -213,6 +222,7 @@ dimensions = (horizontal_dimension) type = integer intent = inout + optional = True [iindx2_aer] standard_name = upper_longitude_index_of_aerosol_forcing_for_interpolation long_name = interpolation high index for prescribed aerosols in the x direction @@ -220,6 +230,7 @@ dimensions = (horizontal_dimension) type = integer intent = inout + optional = True [ddx_aer] standard_name = longitude_interpolation_weight_for_aerosol_forcing long_name = interpolation high index for prescribed aerosols in the x direction @@ -228,6 +239,7 @@ type = real kind = kind_phys intent = inout + optional = True [aer_nm] standard_name = mass_mixing_ratio_of_aerosol_from_gocart_or_merra2 long_name = mass mixing ratio of aerosol from gocart or merra2 @@ -243,6 +255,7 @@ dimensions = (horizontal_dimension) type = integer intent = inout + optional = True [jindx2_ci] standard_name = upper_latitude_index_of_cloud_nuclei_forcing_for_interpolation long_name = interpolation high index for ice and cloud condensation nuclei in the y direction @@ -250,6 +263,7 @@ dimensions = (horizontal_dimension) type = integer intent = inout + optional = True [ddy_ci] standard_name = latitude_interpolation_weight_for_cloud_nuclei_forcing long_name = interpolation high index for ice and cloud condensation nuclei in the y direction @@ -258,6 +272,7 @@ type = real kind = kind_phys intent = inout + optional = True [iindx1_ci] standard_name = lower_longitude_index_of_cloud_nuclei_forcing_for_interpolation long_name = interpolation low index for ice and cloud condensation nuclei in the x direction @@ -265,6 +280,7 @@ dimensions = (horizontal_dimension) type = integer intent = inout + optional = True [iindx2_ci] standard_name = upper_longitude_index_of_cloud_nuclei_forcing_for_interpolation long_name = interpolation high index for ice and cloud condensation nuclei in the x direction @@ -272,6 +288,7 @@ dimensions = (horizontal_dimension) type = integer intent = inout + optional = True [ddx_ci] standard_name = longitude_interpolation_weight_for_cloud_nuclei_forcing long_name = interpolation high index for ice and cloud condensation nuclei in the x direction @@ -280,6 +297,7 @@ type = real kind = kind_phys intent = inout + optional = True [imap] standard_name = map_of_block_column_number_to_global_i_index long_name = map of local index ix to global index i for this block @@ -308,6 +326,7 @@ dimensions = (horizontal_dimension) type = integer intent = inout + optional = True [jindx2_tau] standard_name = upper_latitude_index_of_absolute_momentum_flux_due_to_nonorographic_gravity_wave_drag_for_interpolation long_name = index2 for weight2 for tau NGWs @@ -315,6 +334,7 @@ dimensions = (horizontal_dimension) type = integer intent = inout + optional = True [ddy_j1tau] standard_name = latitude_interpolation_weight_complement_for_absolute_momentum_flux_due_to_nonorographic_gravity_wave_drag long_name = interpolation weight1 for tau NGWs @@ -323,6 +343,7 @@ type = real intent = inout kind = kind_phys + optional = True [ddy_j2tau] standard_name = latitude_interpolation_weight_for_absolute_momentum_flux_due_to_nonorographic_gravity_wave_drag long_name = interpolation weight2 for tau NGWs @@ -331,6 +352,7 @@ type = real intent = inout kind = kind_phys + optional = True [isot] standard_name = control_for_soil_type_dataset long_name = soil type dataset choice @@ -473,6 +495,7 @@ type = real kind = kind_phys intent = inout + optional = True [tgxy] standard_name = ground_temperature long_name = ground temperature for noahmp @@ -481,6 +504,7 @@ type = real kind = kind_phys intent = inout + optional = True [tahxy] standard_name = air_temperature_in_canopy long_name = canopy air temperature @@ -489,6 +513,7 @@ type = real kind = kind_phys intent = inout + optional = True [canicexy] standard_name = canopy_intercepted_ice_mass long_name = canopy intercepted ice mass @@ -497,6 +522,7 @@ type = real kind = kind_phys intent = inout + optional = True [canliqxy] standard_name = canopy_intercepted_liquid_water long_name = canopy intercepted liquid water @@ -505,6 +531,7 @@ type = real kind = kind_phys intent = inout + optional = True [eahxy] standard_name = air_vapor_pressure_in_canopy long_name = canopy air vapor pressure @@ -513,6 +540,7 @@ type = real kind = kind_phys intent = inout + optional = True [cmxy] standard_name = surface_drag_coefficient_for_momentum_for_noahmp long_name = surface drag coefficient for momentum for noahmp @@ -521,6 +549,7 @@ type = real kind = kind_phys intent = inout + optional = True [chxy] standard_name = surface_drag_coefficient_for_heat_and_moisture_for_noahmp long_name = surface exchange coeff heat & moisture for noahmp @@ -529,6 +558,7 @@ type = real kind = kind_phys intent = inout + optional = True [fwetxy] standard_name = wet_canopy_area_fraction long_name = area fraction of canopy that is wetted/snowed @@ -537,6 +567,7 @@ type = real kind = kind_phys intent = inout + optional = True [sneqvoxy] standard_name = lwe_thickness_of_snowfall_amount_on_previous_timestep long_name = snow mass at previous time step @@ -545,6 +576,7 @@ type = real kind = kind_phys intent = inout + optional = True [alboldxy] standard_name = surface_albedo_assuming_deep_snow_on_previous_timestep long_name = snow albedo at previous time step @@ -553,6 +585,7 @@ type = real kind = kind_phys intent = inout + optional = True [qsnowxy] standard_name = lwe_snowfall_rate long_name = snow precipitation rate at surface @@ -561,6 +594,7 @@ type = real kind = kind_phys intent = inout + optional = True [wslakexy] standard_name = water_storage_in_lake long_name = lake water storage @@ -569,6 +603,7 @@ type = real kind = kind_phys intent = inout + optional = True [taussxy] standard_name = dimensionless_age_of_surface_snow long_name = non-dimensional snow age @@ -577,6 +612,7 @@ type = real kind = kind_phys intent = inout + optional = True [waxy] standard_name = water_storage_in_aquifer long_name = water storage in aquifer @@ -585,6 +621,7 @@ type = real kind = kind_phys intent = inout + optional = True [wtxy] standard_name = water_storage_in_aquifer_and_saturated_soil long_name = water storage in aquifer and saturated soil @@ -593,6 +630,7 @@ type = real kind = kind_phys intent = inout + optional = True [zwtxy] standard_name = water_table_depth long_name = water table depth @@ -601,6 +639,7 @@ type = real kind = kind_phys intent = inout + optional = True [xlaixy] standard_name = leaf_area_index long_name = leaf area index @@ -609,6 +648,7 @@ type = real kind = kind_phys intent = inout + optional = True [xsaixy] standard_name = stem_area_index long_name = stem area index @@ -617,6 +657,7 @@ type = real kind = kind_phys intent = inout + optional = True [lfmassxy] standard_name = leaf_mass_content long_name = leaf mass @@ -625,6 +666,7 @@ type = real kind = kind_phys intent = inout + optional = True [stmassxy] standard_name = stem_mass_content long_name = stem mass @@ -633,6 +675,7 @@ type = real kind = kind_phys intent = inout + optional = True [rtmassxy] standard_name = fine_root_mass_content long_name = fine root mass @@ -641,6 +684,7 @@ type = real kind = kind_phys intent = inout + optional = True [woodxy] standard_name = wood_mass_content long_name = wood mass including woody roots @@ -649,6 +693,7 @@ type = real kind = kind_phys intent = inout + optional = True [stblcpxy] standard_name = slow_soil_pool_mass_content_of_carbon long_name = stable carbon in deep soil @@ -657,6 +702,7 @@ type = real kind = kind_phys intent = inout + optional = True [fastcpxy] standard_name = fast_soil_pool_mass_content_of_carbon long_name = short-lived carbon in shallow soil @@ -665,6 +711,7 @@ type = real kind = kind_phys intent = inout + optional = True [smcwtdxy] standard_name = volumetric_soil_moisture_between_soil_bottom_and_water_table long_name = soil water content between the bottom of the soil and the water table @@ -673,6 +720,7 @@ type = real kind = kind_phys intent = inout + optional = True [deeprechxy] standard_name = water_table_recharge_assuming_deep long_name = recharge to or from the water table when deep @@ -681,6 +729,7 @@ type = real kind = kind_phys intent = inout + optional = True [rechxy] standard_name = water_table_recharge_assuming_shallow long_name = recharge to or from the water table when shallow @@ -689,6 +738,7 @@ type = real kind = kind_phys intent = inout + optional = True [albdvis_lnd] standard_name = surface_albedo_direct_visible_over_land long_name = direct surface albedo visible band over land @@ -729,6 +779,7 @@ type = real kind = kind_phys intent = inout + optional = True [albdnir_ice] standard_name = surface_albedo_direct_NIR_over_ice long_name = direct surface albedo NIR band over ice @@ -737,6 +788,7 @@ type = real kind = kind_phys intent = inout + optional = True [albivis_ice] standard_name = surface_albedo_diffuse_visible_over_ice long_name = diffuse surface albedo visible band over ice @@ -745,6 +797,7 @@ type = real kind = kind_phys intent = inout + optional = True [albinir_ice] standard_name = surface_albedo_diffuse_NIR_over_ice long_name = diffuse surface albedo NIR band over ice @@ -753,6 +806,7 @@ type = real kind = kind_phys intent = inout + optional = True [emiss_lnd] standard_name = surface_longwave_emissivity_over_land long_name = surface lw emissivity in fraction over land @@ -777,6 +831,7 @@ type = real kind = kind_phys intent = inout + optional = True [snicexy] standard_name = lwe_thickness_of_ice_in_surface_snow long_name = snow layer ice @@ -785,6 +840,7 @@ type = real kind = kind_phys intent = inout + optional = True [snliqxy] standard_name = lwe_thickness_of_liquid_water_in_surface_snow long_name = snow layer liquid water @@ -793,6 +849,7 @@ type = real kind = kind_phys intent = inout + optional = True [tsnoxy] standard_name = temperature_in_surface_snow long_name = temperature_in_surface_snow @@ -801,6 +858,7 @@ type = real kind = kind_phys intent = inout + optional = True [smoiseq] standard_name = volumetric_equilibrium_soil_moisture long_name = equilibrium soil water content @@ -809,6 +867,7 @@ type = real kind = kind_phys intent = inout + optional = True [zsnsoxy] standard_name = depth_from_snow_surface_at_bottom_interface long_name = depth from the top of the snow surface at the bottom of the layer @@ -817,9 +876,10 @@ type = real kind = kind_phys intent = inout -[sh2o] - standard_name = volume_fraction_of_unfrozen_soil_moisture_for_land_surface_model - long_name = volume fraction of unfrozen soil moisture for lsm + optional = True +[slc] + standard_name = volume_fraction_of_unfrozen_water_in_soil + long_name = liquid soil moisture units = frac dimensions = (horizontal_dimension,vertical_dimension_of_soil_internal_to_land_surface_scheme) type = real @@ -969,6 +1029,13 @@ type = real kind = kind_phys intent = in +[ozphys] + standard_name = dataset_for_ozone_physics + long_name = dataset for NRL ozone physics + units = mixed + dimensions = () + type = ty_ozphys + intent = in [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP @@ -1187,6 +1254,7 @@ dimensions = (horizontal_dimension) type = integer intent = in + optional = True [jindx2_o3] standard_name = upper_latitude_index_of_ozone_forcing_for_interpolation long_name = interpolation high index for ozone @@ -1194,6 +1262,7 @@ dimensions = (horizontal_dimension) type = integer intent = in + optional = True [ddy_o3] standard_name = latitude_interpolation_weight_for_ozone_forcing long_name = interpolation high index for ozone @@ -1202,11 +1271,12 @@ type = real kind = kind_phys intent = in + optional = True [ozpl] standard_name = ozone_forcing long_name = ozone forcing data units = mixed - dimensions = (horizontal_dimension,vertical_dimension_of_ozone_forcing_data,number_of_coefficients_in_ozone_forcing_data) + dimensions = (horizontal_dimension,vertical_dimension_of_ozone_forcing_data,number_of_coefficients_in_ozone_data) type = real kind = kind_phys intent = inout @@ -1217,6 +1287,7 @@ dimensions = (horizontal_dimension) type = integer intent = in + optional = True [jindx2_h] standard_name = upper_latitude_index_of_stratospheric_water_vapor_forcing_for_interpolation long_name = interpolation high index for stratospheric water vapor @@ -1224,6 +1295,7 @@ dimensions = (horizontal_dimension) type = integer intent = in + optional = True [ddy_h] standard_name = latitude_interpolation_weight_for_stratospheric_water_vapor_forcing long_name = interpolation high index for stratospheric water vapor @@ -1232,6 +1304,7 @@ type = real kind = kind_phys intent = in + optional = True [h2opl] standard_name = stratospheric_water_vapor_forcing long_name = water forcing data @@ -1254,6 +1327,7 @@ dimensions = (horizontal_dimension) type = integer intent = in + optional = True [jindx2_aer] standard_name = upper_latitude_index_of_aerosol_forcing_for_interpolation long_name = interpolation high index for prescribed aerosols in the y direction @@ -1261,6 +1335,7 @@ dimensions = (horizontal_dimension) type = integer intent = in + optional = True [ddy_aer] standard_name = latitude_interpolation_weight_for_aerosol_forcing long_name = interpolation high index for prescribed aerosols in the y direction @@ -1269,6 +1344,7 @@ type = real kind = kind_phys intent = in + optional = True [iindx1_aer] standard_name = lower_longitude_index_of_aerosol_forcing_for_interpolation long_name = interpolation low index for prescribed aerosols in the x direction @@ -1276,6 +1352,7 @@ dimensions = (horizontal_dimension) type = integer intent = in + optional = True [iindx2_aer] standard_name = upper_longitude_index_of_aerosol_forcing_for_interpolation long_name = interpolation high index for prescribed aerosols in the x direction @@ -1283,6 +1360,7 @@ dimensions = (horizontal_dimension) type = integer intent = in + optional = True [ddx_aer] standard_name = longitude_interpolation_weight_for_aerosol_forcing long_name = interpolation high index for prescribed aerosols in the x direction @@ -1291,6 +1369,7 @@ type = real kind = kind_phys intent = in + optional = True [aer_nm] standard_name = mass_mixing_ratio_of_aerosol_from_gocart_or_merra2 long_name = mass mixing ratio of aerosol from gocart or merra2 @@ -1306,6 +1385,7 @@ dimensions = (horizontal_dimension) type = integer intent = in + optional = True [jindx2_ci] standard_name = upper_latitude_index_of_cloud_nuclei_forcing_for_interpolation long_name = interpolation high index for ice and cloud condensation nuclei in the y direction @@ -1313,6 +1393,7 @@ dimensions = (horizontal_dimension) type = integer intent = in + optional = True [ddy_ci] standard_name = latitude_interpolation_weight_for_cloud_nuclei_forcing long_name = interpolation high index for ice and cloud condensation nuclei in the y direction @@ -1321,6 +1402,7 @@ type = real kind = kind_phys intent = in + optional = True [iindx1_ci] standard_name = lower_longitude_index_of_cloud_nuclei_forcing_for_interpolation long_name = interpolation low index for ice and cloud condensation nuclei in the x direction @@ -1328,6 +1410,7 @@ dimensions = (horizontal_dimension) type = integer intent = in + optional = True [iindx2_ci] standard_name = upper_longitude_index_of_cloud_nuclei_forcing_for_interpolation long_name = interpolation high index for ice and cloud condensation nuclei in the x direction @@ -1335,6 +1418,7 @@ dimensions = (horizontal_dimension) type = integer intent = in + optional = True [ddx_ci] standard_name = longitude_interpolation_weight_for_cloud_nuclei_forcing long_name = interpolation high index for ice and cloud condensation nuclei in the x direction @@ -1343,6 +1427,7 @@ type = real kind = kind_phys intent = in + optional = True [in_nm] standard_name = ice_nucleation_number_from_climatology long_name = ice nucleation number in MG MP @@ -1589,6 +1674,7 @@ type = real kind = kind_phys intent = inout + optional = True [sh2o] standard_name = volume_fraction_of_unfrozen_soil_moisture_for_land_surface_model long_name = volume fraction of unfrozen soil moisture for lsm @@ -1597,6 +1683,7 @@ type = real kind = kind_phys intent = inout + optional = True [tslb] standard_name = soil_temperature_for_land_surface_model long_name = soil temperature for land surface model @@ -1605,6 +1692,7 @@ type = real kind = kind_phys intent = inout + optional = True [tiice] standard_name = temperature_in_ice_layer long_name = sea ice internal temperature @@ -1629,6 +1717,7 @@ type = real kind = kind_phys intent = inout + optional = True [tsfc] standard_name = surface_skin_temperature long_name = surface skin temperature @@ -1911,6 +2000,7 @@ dimensions = (horizontal_dimension) type = integer intent = in + optional = True [jindx2_tau] standard_name = upper_latitude_index_of_absolute_momentum_flux_due_to_nonorographic_gravity_wave_drag_for_interpolation long_name = index2 for weight2 for tau NGWs @@ -1918,6 +2008,7 @@ dimensions = (horizontal_dimension) type = integer intent = in + optional = True [ddy_j1tau] standard_name = latitude_interpolation_weight_complement_for_absolute_momentum_flux_due_to_nonorographic_gravity_wave_drag long_name = interpolation weight1 for tau NGWs @@ -1926,6 +2017,7 @@ type = real intent = in kind = kind_phys + optional = True [ddy_j2tau] standard_name = latitude_interpolation_weight_for_absolute_momentum_flux_due_to_nonorographic_gravity_wave_drag long_name = interpolation weight2 for tau NGWs @@ -1934,6 +2026,7 @@ type = real intent = in kind = kind_phys + optional = True [tau_amf] standard_name = absolute_momentum_flux_due_to_nonorographic_gravity_wave_drag long_name = ngw_absolute_momentum_flux @@ -1942,6 +2035,13 @@ type = real kind = kind_phys intent = inout +[ozphys] + standard_name = dataset_for_ozone_physics + long_name = dataset for NRL ozone physics + units = mixed + dimensions = () + type = ty_ozphys + intent = in [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/GFS_phys_time_vary.scm.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_phys_time_vary.scm.F90 similarity index 83% rename from physics/GFS_phys_time_vary.scm.F90 rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_phys_time_vary.scm.F90 index 74b34e974..59b59e76a 100644 --- a/physics/GFS_phys_time_vary.scm.F90 +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_phys_time_vary.scm.F90 @@ -2,17 +2,16 @@ !! 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, stratospheric water vapor, +!! This module contains GFS physics time vary subroutines including stratospheric water vapor, !! aerosol, IN&CCN and surface properties updates. !> @{ module GFS_phys_time_vary - use machine, only : kind_phys + use machine, only : kind_phys, kind_dbl_prec, kind_sngl_prec use mersenne_twister, only: random_setseed, random_number - use ozne_def, only : levozp, oz_coeff, oz_lat, oz_pres, oz_time, ozplin - use ozinterp, only : read_o3data, setindxoz, ozinterpol + use module_ozphys, only: ty_ozphys use h2o_def, only : levh2o, h2o_coeff, h2o_lat, h2o_pres, h2o_time, h2oplin use h2ointerp, only : read_h2odata, setindxh2o, h2ointerpol @@ -62,7 +61,7 @@ module GFS_phys_time_vary !! @{ subroutine GFS_phys_time_vary_init ( & me, master, ntoz, h2o_phys, iaerclm, iccn, iflip, im, nx, ny, idate, xlat_d, xlon_d, & - jindx1_o3, jindx2_o3, ddy_o3, ozpl, jindx1_h, jindx2_h, ddy_h, h2opl,fhour, & + jindx1_o3, jindx2_o3, ddy_o3, ozphys, jindx1_h, jindx2_h, ddy_h, h2opl,fhour, & jindx1_aer, jindx2_aer, ddy_aer, iindx1_aer, iindx2_aer, ddx_aer, aer_nm, & jindx1_ci, jindx2_ci, ddy_ci, iindx1_ci, iindx2_ci, ddx_ci, imap, jmap, & do_ugwp_v1, jindx1_tau, jindx2_tau, ddy_j1tau, ddy_j2tau, & @@ -85,18 +84,18 @@ subroutine GFS_phys_time_vary_init ( real(kind_phys), intent(in) :: fhour real(kind_phys), intent(in) :: xlat_d(:), xlon_d(:) - integer, intent(inout) :: jindx1_o3(:), jindx2_o3(:), jindx1_h(:), jindx2_h(:) - real(kind_phys), intent(inout) :: ddy_o3(:), ddy_h(:) - real(kind_phys), intent(in) :: ozpl(:,:,:), h2opl(:,:,:) - integer, intent(inout) :: jindx1_aer(:), jindx2_aer(:), iindx1_aer(:), iindx2_aer(:) - real(kind_phys), intent(inout) :: ddy_aer(:), ddx_aer(:) + integer, intent(inout), optional :: jindx1_o3(:), jindx2_o3(:), jindx1_h(:), jindx2_h(:) + real(kind_phys), intent(inout), optional :: ddy_o3(:), ddy_h(:) + real(kind_phys), intent(in) :: h2opl(:,:,:) + integer, intent(inout), optional :: jindx1_aer(:), jindx2_aer(:), iindx1_aer(:), iindx2_aer(:) + real(kind_phys), intent(inout), optional :: ddy_aer(:), ddx_aer(:) real(kind_phys), intent(in) :: aer_nm(:,:,:) - integer, intent(inout) :: jindx1_ci(:), jindx2_ci(:), iindx1_ci(:), iindx2_ci(:) - real(kind_phys), intent(inout) :: ddy_ci(:), ddx_ci(:) + integer, intent(inout), optional :: jindx1_ci(:), jindx2_ci(:), iindx1_ci(:), iindx2_ci(:) + real(kind_phys), intent(inout), optional :: ddy_ci(:), ddx_ci(:) integer, intent(inout) :: imap(:), jmap(:) logical, intent(in) :: do_ugwp_v1 - real(kind_phys), intent(inout) :: ddy_j1tau(:), ddy_j2tau(:) - integer, intent(inout) :: jindx1_tau(:), jindx2_tau(:) + real(kind_phys), intent(inout), optional :: ddy_j1tau(:), ddy_j2tau(:) + integer, intent(inout), optional :: jindx1_tau(:), jindx2_tau(:) integer, intent(in) :: isot, ivegsrc, nlunit real(kind_phys), intent(inout) :: sncovr(:), sncovr_ice(:) @@ -104,55 +103,56 @@ subroutine GFS_phys_time_vary_init ( real(kind_phys), intent(in) :: min_seaice, fice(:) real(kind_phys), intent(in) :: landfrac(:) real(kind_phys), intent(inout) :: weasd(:) + type(ty_ozphys), intent(in) :: ozphys ! NoahMP - only allocated when NoahMP is used integer, intent(in) :: lsoil, lsnow_lsm_lbound, lsnow_lsm_ubound real(kind_phys), intent(in) :: zs(:) real(kind_phys), intent(in) :: dzs(:) - real(kind_phys), intent(inout) :: tvxy(:) - real(kind_phys), intent(inout) :: tgxy(:) - real(kind_phys), intent(inout) :: tahxy(:) - real(kind_phys), intent(inout) :: canicexy(:) - real(kind_phys), intent(inout) :: canliqxy(:) - real(kind_phys), intent(inout) :: eahxy(:) - real(kind_phys), intent(inout) :: cmxy(:) - real(kind_phys), intent(inout) :: chxy(:) - real(kind_phys), intent(inout) :: fwetxy(:) - real(kind_phys), intent(inout) :: sneqvoxy(:) - real(kind_phys), intent(inout) :: alboldxy(:) - real(kind_phys), intent(inout) :: qsnowxy(:) - real(kind_phys), intent(inout) :: wslakexy(:) + real(kind_phys), intent(inout), optional :: tvxy(:) + real(kind_phys), intent(inout), optional :: tgxy(:) + real(kind_phys), intent(inout), optional :: tahxy(:) + real(kind_phys), intent(inout), optional :: canicexy(:) + real(kind_phys), intent(inout), optional :: canliqxy(:) + real(kind_phys), intent(inout), optional :: eahxy(:) + real(kind_phys), intent(inout), optional :: cmxy(:) + real(kind_phys), intent(inout), optional :: chxy(:) + real(kind_phys), intent(inout), optional :: fwetxy(:) + real(kind_phys), intent(inout), optional :: sneqvoxy(:) + real(kind_phys), intent(inout), optional :: alboldxy(:) + real(kind_phys), intent(inout), optional :: qsnowxy(:) + real(kind_phys), intent(inout), optional :: wslakexy(:) real(kind_phys), intent(inout) :: albdvis_lnd(:) real(kind_phys), intent(inout) :: albdnir_lnd(:) real(kind_phys), intent(inout) :: albivis_lnd(:) real(kind_phys), intent(inout) :: albinir_lnd(:) - real(kind_phys), intent(inout) :: albdvis_ice(:) - real(kind_phys), intent(inout) :: albdnir_ice(:) - real(kind_phys), intent(inout) :: albivis_ice(:) - real(kind_phys), intent(inout) :: albinir_ice(:) + real(kind_phys), intent(inout), optional :: albdvis_ice(:) + real(kind_phys), intent(inout), optional :: albdnir_ice(:) + real(kind_phys), intent(inout), optional :: albivis_ice(:) + real(kind_phys), intent(inout), optional :: albinir_ice(:) real(kind_phys), intent(inout) :: emiss_lnd(:) real(kind_phys), intent(inout) :: emiss_ice(:) - real(kind_phys), intent(inout) :: taussxy(:) - real(kind_phys), intent(inout) :: waxy(:) - real(kind_phys), intent(inout) :: wtxy(:) - real(kind_phys), intent(inout) :: zwtxy(:) - real(kind_phys), intent(inout) :: xlaixy(:) - real(kind_phys), intent(inout) :: xsaixy(:) - real(kind_phys), intent(inout) :: lfmassxy(:) - real(kind_phys), intent(inout) :: stmassxy(:) - real(kind_phys), intent(inout) :: rtmassxy(:) - real(kind_phys), intent(inout) :: woodxy(:) - real(kind_phys), intent(inout) :: stblcpxy(:) - real(kind_phys), intent(inout) :: fastcpxy(:) - real(kind_phys), intent(inout) :: smcwtdxy(:) - real(kind_phys), intent(inout) :: deeprechxy(:) - real(kind_phys), intent(inout) :: rechxy(:) - real(kind_phys), intent(inout) :: snowxy(:) - real(kind_phys), intent(inout) :: snicexy(:,lsnow_lsm_lbound:) - real(kind_phys), intent(inout) :: snliqxy(:,lsnow_lsm_lbound:) - real(kind_phys), intent(inout) :: tsnoxy (:,lsnow_lsm_lbound:) - real(kind_phys), intent(inout) :: smoiseq(:,:) - real(kind_phys), intent(inout) :: zsnsoxy(:,lsnow_lsm_lbound:) + real(kind_phys), intent(inout), optional :: taussxy(:) + real(kind_phys), intent(inout), optional :: waxy(:) + real(kind_phys), intent(inout), optional :: wtxy(:) + real(kind_phys), intent(inout), optional :: zwtxy(:) + real(kind_phys), intent(inout), optional :: xlaixy(:) + real(kind_phys), intent(inout), optional :: xsaixy(:) + real(kind_phys), intent(inout), optional :: lfmassxy(:) + real(kind_phys), intent(inout), optional :: stmassxy(:) + real(kind_phys), intent(inout), optional :: rtmassxy(:) + real(kind_phys), intent(inout), optional :: woodxy(:) + real(kind_phys), intent(inout), optional :: stblcpxy(:) + real(kind_phys), intent(inout), optional :: fastcpxy(:) + real(kind_phys), intent(inout), optional :: smcwtdxy(:) + real(kind_phys), intent(inout), optional :: deeprechxy(:) + real(kind_phys), intent(inout), optional :: rechxy(:) + real(kind_phys), intent(inout), optional :: snowxy(:) + real(kind_phys), intent(inout), optional :: snicexy(:,lsnow_lsm_lbound:) + real(kind_phys), intent(inout), optional :: snliqxy(:,lsnow_lsm_lbound:) + real(kind_phys), intent(inout), optional :: tsnoxy (:,lsnow_lsm_lbound:) + real(kind_phys), intent(inout), optional :: smoiseq(:,:) + real(kind_phys), intent(inout), optional :: zsnsoxy(:,lsnow_lsm_lbound:) real(kind_phys), intent(inout) :: slc(:,:) real(kind_phys), intent(inout) :: smc(:,:) real(kind_phys), intent(inout) :: stc(:,:) @@ -189,30 +189,11 @@ subroutine GFS_phys_time_vary_init ( jamin=999 jamax=-999 -!> - Call read_o3data() to read ozone data - call read_o3data (ntoz, me, master) - - ! Consistency check that the hardcoded values for levozp and - ! oz_coeff in GFS_typedefs.F90 match what is set by read_o3data - ! in GFS_typedefs.F90: allocate (Tbd%ozpl (IM,levozp,oz_coeff)) - if (size(ozpl, dim=2).ne.levozp) then - write(errmsg,'(2a,i0,a,i0)') "Value error in GFS_phys_time_vary_init: ", & - "levozp from read_o3data does not match value in GFS_typedefs.F90: ", & - levozp, " /= ", size(ozpl, dim=2) - errflg = 1 - end if - if (size(ozpl, dim=3).ne.oz_coeff) then - write(errmsg,'(2a,i0,a,i0)') "Value error in GFS_phys_time_vary_init: ", & - "oz_coeff from read_o3data does not match value in GFS_typedefs.F90: ", & - oz_coeff, " /= ", size(ozpl, dim=3) - errflg = 1 - end if - !> - Call read_h2odata() to read stratospheric water vapor data call read_h2odata (h2o_phys, me, master) ! Consistency check that the hardcoded values for levh2o and - ! h2o_coeff in GFS_typedefs.F90 match what is set by read_o3data + ! h2o_coeff in GFS_typedefs.F90 match what is set by read_h2odata ! in GFS_typedefs.F90: allocate (Tbd%h2opl (IM,levh2o,h2o_coeff)) if (size(h2opl, dim=2).ne.levh2o) then write(errmsg,'(2a,i0,a,i0)') "Value error in GFS_phys_time_vary_init: ", & @@ -266,9 +247,9 @@ subroutine GFS_phys_time_vary_init ( !> - Initialize soil vegetation (needed for sncovr calculation further down) call set_soilveg(me, isot, ivegsrc, nlunit, errmsg, errflg) -!> - Call setindxoz() to initialize ozone data +!> - Setup spatial interpolation indices for ozone physics. if (ntoz > 0) then - call setindxoz (im, xlat_d, jindx1_o3, jindx2_o3, ddy_o3) + call ozphys%setup_o3prog(xlat_d, jindx1_o3, jindx2_o3, ddy_o3) endif !> - Call setindxh2o() to initialize stratospheric water vapor data @@ -652,7 +633,7 @@ end subroutine GFS_phys_time_vary_init !! @{ subroutine GFS_phys_time_vary_timestep_init ( & me, master, cnx, cny, isc, jsc, nrcm, im, levs, kdt, idate, nsswr, fhswr, lsswr, fhour, & - imfdeepcnv, cal_pre, random_clds, ntoz, h2o_phys, iaerclm, iccn, clstp, & + imfdeepcnv, cal_pre, random_clds, ozphys, ntoz, h2o_phys, iaerclm, iccn, clstp, & jindx1_o3, jindx2_o3, ddy_o3, ozpl, jindx1_h, jindx2_h, ddy_h, h2opl, iflip, & jindx1_aer, jindx2_aer, ddy_aer, iindx1_aer, iindx2_aer, ddx_aer, aer_nm, & jindx1_ci, jindx2_ci, ddy_ci, iindx1_ci, iindx2_ci, ddx_ci, in_nm, ccn_nm, & @@ -668,14 +649,14 @@ subroutine GFS_phys_time_vary_timestep_init ( real(kind_phys), intent(in) :: fhswr, fhour logical, intent(in) :: lsswr, cal_pre, random_clds, h2o_phys, iaerclm real(kind_phys), intent(out) :: clstp - integer, intent(in) :: jindx1_o3(:), jindx2_o3(:), jindx1_h(:), jindx2_h(:) - real(kind_phys), intent(in) :: ddy_o3(:), ddy_h(:) + integer, intent(in), optional :: jindx1_o3(:), jindx2_o3(:), jindx1_h(:), jindx2_h(:) + real(kind_phys), intent(in), optional :: ddy_o3(:), ddy_h(:) real(kind_phys), intent(inout) :: ozpl(:,:,:), h2opl(:,:,:) - integer, intent(in) :: jindx1_aer(:), jindx2_aer(:), iindx1_aer(:), iindx2_aer(:) - real(kind_phys), intent(in) :: ddy_aer(:), ddx_aer(:) + integer, intent(in), optional :: jindx1_aer(:), jindx2_aer(:), iindx1_aer(:), iindx2_aer(:) + real(kind_phys), intent(in), optional :: ddy_aer(:), ddx_aer(:) real(kind_phys), intent(inout) :: aer_nm(:,:,:) - integer, intent(in) :: jindx1_ci(:), jindx2_ci(:), iindx1_ci(:), iindx2_ci(:) - real(kind_phys), intent(in) :: ddy_ci(:), ddx_ci(:) + integer, intent(in), optional :: jindx1_ci(:), jindx2_ci(:), iindx1_ci(:), iindx2_ci(:) + real(kind_phys), intent(in), optional :: ddy_ci(:), ddx_ci(:) real(kind_phys), intent(inout) :: in_nm(:,:), ccn_nm(:,:) integer, intent(in) :: imap(:), jmap(:) real(kind_phys), intent(in) :: prsl(:,:) @@ -683,18 +664,22 @@ subroutine GFS_phys_time_vary_timestep_init ( real(kind_phys), intent(inout) :: rann(:,:) logical, intent(in) :: do_ugwp_v1 - integer, intent(in) :: jindx1_tau(:), jindx2_tau(:) - real(kind_phys), intent(in) :: ddy_j1tau(:), ddy_j2tau(:) + integer, intent(in), optional :: jindx1_tau(:), jindx2_tau(:) + real(kind_phys), intent(in), optional :: ddy_j1tau(:), ddy_j2tau(:) real(kind_phys), intent(inout) :: tau_amf(:) + type(ty_ozphys), intent(in) :: ozphys integer, intent(in) :: nthrds character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg ! Local variables - integer :: i, j, k, iseed, iskip, ix - real(kind=kind_phys) :: wrk(1) - real(kind=kind_phys) :: rannie(cny) - real(kind=kind_phys) :: rndval(cnx*cny*nrcm) + integer :: i, j, k, iseed, iskip, ix, idat(8), jdat(8), iday, j1, j2, nc, n1, n2, jdow, & + jdoy, jday, w3kindreal, w3kindint + real(kind_phys) :: wrk(1), tem, tx1, tx2, rjday + real(kind_phys) :: rannie(cny) + real(kind_phys) :: rndval(cnx*cny*nrcm) + real(kind_dbl_prec) :: rinc(5) + real(kind_sngl_prec) :: rinc4(5) ! Initialize CCPP error handling variables errmsg = '' @@ -748,11 +733,41 @@ subroutine GFS_phys_time_vary_timestep_init ( endif ! imfdeepcnv, cal_re, random_clds -!> - Call ozinterpol() to make ozone interpolation + !> - Compute temporal interpolation indices for updating gas concentrations. + idat=0 + idat(1)=idate(4) + idat(2)=idate(2) + idat(3)=idate(3) + idat(5)=idate(1) + rinc=0. + rinc(2)=fhour + call w3kind(w3kindreal,w3kindint) + if(w3kindreal==4) then + rinc4=rinc + CALL w3movdat(rinc4,idat,jdat) + else + CALL w3movdat(rinc,idat,jdat) + endif + jdow = 0 + jdoy = 0 + jday = 0 + call w3doxdat(jdat,jdow,jdoy,jday) + rjday = jdoy + jdat(5) / 24. + if (rjday < ozphys%time(1)) rjday = rjday + 365. + + n2 = ozphys%ntime + 1 + do j=2,ozphys%ntime + if (rjday < ozphys%time(j)) then + n2 = j + exit + endif + enddo + n1 = n2 - 1 + if (n2 > ozphys%ntime) n2 = n2 - ozphys%ntime + +!> - Update ozone concentration. if (ntoz > 0) then - call ozinterpol (me, im, idate, fhour, & - jindx1_o3, jindx2_o3, & - ozpl, ddy_o3) + call ozphys%update_o3prog(jindx1_o3, jindx2_o3, ddy_o3, rjday, n1, n2, ozpl) endif !> - Call h2ointerpol() to make stratospheric water vapor data interpolation @@ -844,12 +859,6 @@ subroutine GFS_phys_time_vary_finalize(errmsg, errflg) if (.not.is_initialized) return - ! Deallocate ozone arrays - if (allocated(oz_lat) ) deallocate(oz_lat) - if (allocated(oz_pres) ) deallocate(oz_pres) - if (allocated(oz_time) ) deallocate(oz_time) - if (allocated(ozplin) ) deallocate(ozplin) - ! Deallocate h2o arrays if (allocated(h2o_lat) ) deallocate(h2o_lat) if (allocated(h2o_pres)) deallocate(h2o_pres) diff --git a/physics/GFS_phys_time_vary.scm.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_phys_time_vary.scm.meta similarity index 94% rename from physics/GFS_phys_time_vary.scm.meta rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_phys_time_vary.scm.meta index 8b59e4bed..43397f854 100644 --- a/physics/GFS_phys_time_vary.scm.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_phys_time_vary.scm.meta @@ -1,8 +1,15 @@ [ccpp-table-properties] name = GFS_phys_time_vary type = scheme - dependencies = aerclm_def.F,aerinterp.F90,h2o_def.f,h2ointerp.f90,iccn_def.F,iccninterp.F90,machine.F,mersenne_twister.f - dependencies = namelist_soilveg.f,set_soilveg.f,ozinterp.f90,ozne_def.f,cires_tauamf_data.F90,noahmp_tables.f90 + relative_path = ../../ + dependencies = hooks/machine.F + dependencies = Interstitials/UFS_SCM_NEPTUNE/iccn_def.F,Interstitials/UFS_SCM_NEPTUNE/iccninterp.F90 + dependencies = Interstitials/UFS_SCM_NEPTUNE/sfcsub.F,Radiation/mersenne_twister.f + dependencies = MP/Morrison_Gettelman/aerclm_def.F,MP/Morrison_Gettelman/aerinterp.F90 + dependencies = SFC_Models/Land/Noah/namelist_soilveg.f,SFC_Models/Land/Noah/set_soilveg.f,SFC_Models/Land/Noahmp/noahmp_tables.f90 + dependencies = photochem/module_ozphys.F90 + dependencies = photochem/h2o_def.f,photochem/h2ointerp.f90 + dependencies = GWD/cires_tauamf_data.F90 ######################################################################## [ccpp-arg-table] @@ -109,6 +116,7 @@ dimensions = (horizontal_dimension) type = integer intent = inout + optional = True [jindx2_o3] standard_name = upper_latitude_index_of_ozone_forcing_for_interpolation long_name = interpolation high index for ozone @@ -116,6 +124,7 @@ dimensions = (horizontal_dimension) type = integer intent = inout + optional = True [ddy_o3] standard_name = latitude_interpolation_weight_for_ozone_forcing long_name = interpolation high index for ozone @@ -124,14 +133,7 @@ type = real kind = kind_phys intent = inout -[ozpl] - standard_name = ozone_forcing - long_name = ozone forcing data - units = mixed - dimensions = (horizontal_dimension,vertical_dimension_of_ozone_forcing_data,number_of_coefficients_in_ozone_forcing_data) - type = real - kind = kind_phys - intent = in + optional = True [jindx1_h] standard_name = lower_latitude_index_of_stratospheric_water_vapor_forcing_for_interpolation long_name = interpolation low index for stratospheric water vapor @@ -139,6 +141,7 @@ dimensions = (horizontal_dimension) type = integer intent = inout + optional = True [jindx2_h] standard_name = upper_latitude_index_of_stratospheric_water_vapor_forcing_for_interpolation long_name = interpolation high index for stratospheric water vapor @@ -146,6 +149,7 @@ dimensions = (horizontal_dimension) type = integer intent = inout + optional = True [ddy_h] standard_name = latitude_interpolation_weight_for_stratospheric_water_vapor_forcing long_name = interpolation high index for stratospheric water vapor @@ -154,6 +158,7 @@ type = real kind = kind_phys intent = inout + optional = True [h2opl] standard_name = stratospheric_water_vapor_forcing long_name = water forcing data @@ -177,6 +182,7 @@ dimensions = (horizontal_dimension) type = integer intent = inout + optional = True [jindx2_aer] standard_name = upper_latitude_index_of_aerosol_forcing_for_interpolation long_name = interpolation high index for prescribed aerosols in the y direction @@ -184,6 +190,7 @@ dimensions = (horizontal_dimension) type = integer intent = inout + optional = True [ddy_aer] standard_name = latitude_interpolation_weight_for_aerosol_forcing long_name = interpolation high index for prescribed aerosols in the y direction @@ -192,6 +199,7 @@ type = real kind = kind_phys intent = inout + optional = True [iindx1_aer] standard_name = lower_longitude_index_of_aerosol_forcing_for_interpolation long_name = interpolation low index for prescribed aerosols in the x direction @@ -199,6 +207,7 @@ dimensions = (horizontal_dimension) type = integer intent = inout + optional = True [iindx2_aer] standard_name = upper_longitude_index_of_aerosol_forcing_for_interpolation long_name = interpolation high index for prescribed aerosols in the x direction @@ -206,6 +215,7 @@ dimensions = (horizontal_dimension) type = integer intent = inout + optional = True [ddx_aer] standard_name = longitude_interpolation_weight_for_aerosol_forcing long_name = interpolation high index for prescribed aerosols in the x direction @@ -214,6 +224,7 @@ type = real kind = kind_phys intent = inout + optional = True [aer_nm] standard_name = mass_mixing_ratio_of_aerosol_from_gocart_or_merra2 long_name = mass mixing ratio of aerosol from gocart or merra2 @@ -229,6 +240,7 @@ dimensions = (horizontal_dimension) type = integer intent = inout + optional = True [jindx2_ci] standard_name = upper_latitude_index_of_cloud_nuclei_forcing_for_interpolation long_name = interpolation high index for ice and cloud condensation nuclei in the y direction @@ -236,6 +248,7 @@ dimensions = (horizontal_dimension) type = integer intent = inout + optional = True [ddy_ci] standard_name = latitude_interpolation_weight_for_cloud_nuclei_forcing long_name = interpolation high index for ice and cloud condensation nuclei in the y direction @@ -244,6 +257,7 @@ type = real kind = kind_phys intent = inout + optional = True [iindx1_ci] standard_name = lower_longitude_index_of_cloud_nuclei_forcing_for_interpolation long_name = interpolation low index for ice and cloud condensation nuclei in the x direction @@ -251,6 +265,7 @@ dimensions = (horizontal_dimension) type = integer intent = inout + optional = True [iindx2_ci] standard_name = upper_longitude_index_of_cloud_nuclei_forcing_for_interpolation long_name = interpolation high index for ice and cloud condensation nuclei in the x direction @@ -258,6 +273,7 @@ dimensions = (horizontal_dimension) type = integer intent = inout + optional = True [ddx_ci] standard_name = longitude_interpolation_weight_for_cloud_nuclei_forcing long_name = interpolation high index for ice and cloud condensation nuclei in the x direction @@ -266,6 +282,7 @@ type = real kind = kind_phys intent = inout + optional = True [imap] standard_name = map_of_block_column_number_to_global_i_index long_name = map of local index ix to global index i for this block @@ -294,6 +311,7 @@ dimensions = (horizontal_dimension) type = integer intent = inout + optional = True [jindx2_tau] standard_name = upper_latitude_index_of_absolute_momentum_flux_due_to_nonorographic_gravity_wave_drag_for_interpolation long_name = index2 for weight2 for tau NGWs @@ -301,6 +319,7 @@ dimensions = (horizontal_dimension) type = integer intent = inout + optional = True [ddy_j1tau] standard_name = latitude_interpolation_weight_complement_for_absolute_momentum_flux_due_to_nonorographic_gravity_wave_drag long_name = interpolation weight1 for tau NGWs @@ -309,6 +328,7 @@ type = real intent = inout kind = kind_phys + optional = True [ddy_j2tau] standard_name = latitude_interpolation_weight_for_absolute_momentum_flux_due_to_nonorographic_gravity_wave_drag long_name = interpolation weight2 for tau NGWs @@ -317,6 +337,7 @@ type = real intent = inout kind = kind_phys + optional = True [isot] standard_name = control_for_soil_type_dataset long_name = soil type dataset choice @@ -459,6 +480,7 @@ type = real kind = kind_phys intent = inout + optional = True [tgxy] standard_name = ground_temperature long_name = ground temperature for noahmp @@ -467,6 +489,7 @@ type = real kind = kind_phys intent = inout + optional = True [tahxy] standard_name = air_temperature_in_canopy long_name = canopy air temperature @@ -475,6 +498,7 @@ type = real kind = kind_phys intent = inout + optional = True [canicexy] standard_name = canopy_intercepted_ice_mass long_name = canopy intercepted ice mass @@ -483,6 +507,7 @@ type = real kind = kind_phys intent = inout + optional = True [canliqxy] standard_name = canopy_intercepted_liquid_water long_name = canopy intercepted liquid water @@ -491,6 +516,7 @@ type = real kind = kind_phys intent = inout + optional = True [eahxy] standard_name = air_vapor_pressure_in_canopy long_name = canopy air vapor pressure @@ -499,6 +525,7 @@ type = real kind = kind_phys intent = inout + optional = True [cmxy] standard_name = surface_drag_coefficient_for_momentum_for_noahmp long_name = surface drag coefficient for momentum for noahmp @@ -507,6 +534,7 @@ type = real kind = kind_phys intent = inout + optional = True [chxy] standard_name = surface_drag_coefficient_for_heat_and_moisture_for_noahmp long_name = surface exchange coeff heat & moisture for noahmp @@ -515,6 +543,7 @@ type = real kind = kind_phys intent = inout + optional = True [fwetxy] standard_name = wet_canopy_area_fraction long_name = area fraction of canopy that is wetted/snowed @@ -523,6 +552,7 @@ type = real kind = kind_phys intent = inout + optional = True [sneqvoxy] standard_name = lwe_thickness_of_snowfall_amount_on_previous_timestep long_name = snow mass at previous time step @@ -531,6 +561,7 @@ type = real kind = kind_phys intent = inout + optional = True [alboldxy] standard_name = surface_albedo_assuming_deep_snow_on_previous_timestep long_name = snow albedo at previous time step @@ -539,6 +570,7 @@ type = real kind = kind_phys intent = inout + optional = True [qsnowxy] standard_name = lwe_snowfall_rate long_name = snow precipitation rate at surface @@ -547,6 +579,7 @@ type = real kind = kind_phys intent = inout + optional = True [wslakexy] standard_name = water_storage_in_lake long_name = lake water storage @@ -555,6 +588,7 @@ type = real kind = kind_phys intent = inout + optional = True [taussxy] standard_name = dimensionless_age_of_surface_snow long_name = non-dimensional snow age @@ -563,6 +597,7 @@ type = real kind = kind_phys intent = inout + optional = True [waxy] standard_name = water_storage_in_aquifer long_name = water storage in aquifer @@ -571,6 +606,7 @@ type = real kind = kind_phys intent = inout + optional = True [wtxy] standard_name = water_storage_in_aquifer_and_saturated_soil long_name = water storage in aquifer and saturated soil @@ -579,6 +615,7 @@ type = real kind = kind_phys intent = inout + optional = True [zwtxy] standard_name = water_table_depth long_name = water table depth @@ -587,6 +624,7 @@ type = real kind = kind_phys intent = inout + optional = True [xlaixy] standard_name = leaf_area_index long_name = leaf area index @@ -595,6 +633,7 @@ type = real kind = kind_phys intent = inout + optional = True [xsaixy] standard_name = stem_area_index long_name = stem area index @@ -603,6 +642,7 @@ type = real kind = kind_phys intent = inout + optional = True [lfmassxy] standard_name = leaf_mass_content long_name = leaf mass @@ -611,6 +651,7 @@ type = real kind = kind_phys intent = inout + optional = True [stmassxy] standard_name = stem_mass_content long_name = stem mass @@ -619,6 +660,7 @@ type = real kind = kind_phys intent = inout + optional = True [rtmassxy] standard_name = fine_root_mass_content long_name = fine root mass @@ -627,6 +669,7 @@ type = real kind = kind_phys intent = inout + optional = True [woodxy] standard_name = wood_mass_content long_name = wood mass including woody roots @@ -635,6 +678,7 @@ type = real kind = kind_phys intent = inout + optional = True [stblcpxy] standard_name = slow_soil_pool_mass_content_of_carbon long_name = stable carbon in deep soil @@ -643,6 +687,7 @@ type = real kind = kind_phys intent = inout + optional = True [fastcpxy] standard_name = fast_soil_pool_mass_content_of_carbon long_name = short-lived carbon in shallow soil @@ -651,6 +696,7 @@ type = real kind = kind_phys intent = inout + optional = True [smcwtdxy] standard_name = volumetric_soil_moisture_between_soil_bottom_and_water_table long_name = soil water content between the bottom of the soil and the water table @@ -659,6 +705,7 @@ type = real kind = kind_phys intent = inout + optional = True [deeprechxy] standard_name = water_table_recharge_assuming_deep long_name = recharge to or from the water table when deep @@ -667,6 +714,7 @@ type = real kind = kind_phys intent = inout + optional = True [rechxy] standard_name = water_table_recharge_assuming_shallow long_name = recharge to or from the water table when shallow @@ -675,6 +723,7 @@ type = real kind = kind_phys intent = inout + optional = True [albdvis_lnd] standard_name = surface_albedo_direct_visible_over_land long_name = direct surface albedo visible band over land @@ -715,6 +764,7 @@ type = real kind = kind_phys intent = inout + optional = True [albdnir_ice] standard_name = surface_albedo_direct_NIR_over_ice long_name = direct surface albedo NIR band over ice @@ -723,6 +773,7 @@ type = real kind = kind_phys intent = inout + optional = True [albivis_ice] standard_name = surface_albedo_diffuse_visible_over_ice long_name = diffuse surface albedo visible band over ice @@ -731,6 +782,7 @@ type = real kind = kind_phys intent = inout + optional = True [albinir_ice] standard_name = surface_albedo_diffuse_NIR_over_ice long_name = diffuse surface albedo NIR band over ice @@ -739,6 +791,7 @@ type = real kind = kind_phys intent = inout + optional = True [emiss_lnd] standard_name = surface_longwave_emissivity_over_land long_name = surface lw emissivity in fraction over land @@ -763,6 +816,7 @@ type = real kind = kind_phys intent = inout + optional = True [snicexy] standard_name = lwe_thickness_of_ice_in_surface_snow long_name = snow layer ice @@ -771,6 +825,7 @@ type = real kind = kind_phys intent = inout + optional = True [snliqxy] standard_name = lwe_thickness_of_liquid_water_in_surface_snow long_name = snow layer liquid water @@ -779,6 +834,7 @@ type = real kind = kind_phys intent = inout + optional = True [tsnoxy] standard_name = temperature_in_surface_snow long_name = temperature_in_surface_snow @@ -787,6 +843,7 @@ type = real kind = kind_phys intent = inout + optional = True [smoiseq] standard_name = volumetric_equilibrium_soil_moisture long_name = equilibrium soil water content @@ -795,6 +852,7 @@ type = real kind = kind_phys intent = inout + optional = True [zsnsoxy] standard_name = depth_from_snow_surface_at_bottom_interface long_name = depth from the top of the snow surface at the bottom of the layer @@ -803,6 +861,7 @@ type = real kind = kind_phys intent = inout + optional = True [slc] standard_name = volume_fraction_of_unfrozen_water_in_soil long_name = liquid soil moisture @@ -1099,6 +1158,7 @@ dimensions = (horizontal_dimension) type = integer intent = in + optional = True [jindx2_o3] standard_name = upper_latitude_index_of_ozone_forcing_for_interpolation long_name = interpolation high index for ozone @@ -1106,6 +1166,7 @@ dimensions = (horizontal_dimension) type = integer intent = in + optional = True [ddy_o3] standard_name = latitude_interpolation_weight_for_ozone_forcing long_name = interpolation high index for ozone @@ -1114,11 +1175,12 @@ type = real kind = kind_phys intent = in + optional = True [ozpl] standard_name = ozone_forcing long_name = ozone forcing data units = mixed - dimensions = (horizontal_dimension,vertical_dimension_of_ozone_forcing_data,number_of_coefficients_in_ozone_forcing_data) + dimensions = (horizontal_dimension,vertical_dimension_of_ozone_forcing_data,number_of_coefficients_in_ozone_data) type = real kind = kind_phys intent = inout @@ -1129,6 +1191,7 @@ dimensions = (horizontal_dimension) type = integer intent = in + optional = True [jindx2_h] standard_name = upper_latitude_index_of_stratospheric_water_vapor_forcing_for_interpolation long_name = interpolation high index for stratospheric water vapor @@ -1136,6 +1199,7 @@ dimensions = (horizontal_dimension) type = integer intent = in + optional = True [ddy_h] standard_name = latitude_interpolation_weight_for_stratospheric_water_vapor_forcing long_name = interpolation high index for stratospheric water vapor @@ -1144,6 +1208,7 @@ type = real kind = kind_phys intent = in + optional = True [h2opl] standard_name = stratospheric_water_vapor_forcing long_name = water forcing data @@ -1166,6 +1231,7 @@ dimensions = (horizontal_dimension) type = integer intent = in + optional = True [jindx2_aer] standard_name = upper_latitude_index_of_aerosol_forcing_for_interpolation long_name = interpolation high index for prescribed aerosols in the y direction @@ -1173,6 +1239,7 @@ dimensions = (horizontal_dimension) type = integer intent = in + optional = True [ddy_aer] standard_name = latitude_interpolation_weight_for_aerosol_forcing long_name = interpolation high index for prescribed aerosols in the y direction @@ -1181,6 +1248,7 @@ type = real kind = kind_phys intent = in + optional = True [iindx1_aer] standard_name = lower_longitude_index_of_aerosol_forcing_for_interpolation long_name = interpolation low index for prescribed aerosols in the x direction @@ -1188,6 +1256,7 @@ dimensions = (horizontal_dimension) type = integer intent = in + optional = True [iindx2_aer] standard_name = upper_longitude_index_of_aerosol_forcing_for_interpolation long_name = interpolation high index for prescribed aerosols in the x direction @@ -1195,6 +1264,7 @@ dimensions = (horizontal_dimension) type = integer intent = in + optional = True [ddx_aer] standard_name = longitude_interpolation_weight_for_aerosol_forcing long_name = interpolation high index for prescribed aerosols in the x direction @@ -1203,6 +1273,7 @@ type = real kind = kind_phys intent = in + optional = True [aer_nm] standard_name = mass_mixing_ratio_of_aerosol_from_gocart_or_merra2 long_name = mass mixing ratio of aerosol from gocart or merra2 @@ -1218,6 +1289,7 @@ dimensions = (horizontal_dimension) type = integer intent = in + optional = True [jindx2_ci] standard_name = upper_latitude_index_of_cloud_nuclei_forcing_for_interpolation long_name = interpolation high index for ice and cloud condensation nuclei in the y direction @@ -1225,6 +1297,7 @@ dimensions = (horizontal_dimension) type = integer intent = in + optional = True [ddy_ci] standard_name = latitude_interpolation_weight_for_cloud_nuclei_forcing long_name = interpolation high index for ice and cloud condensation nuclei in the y direction @@ -1233,6 +1306,7 @@ type = real kind = kind_phys intent = in + optional = True [iindx1_ci] standard_name = lower_longitude_index_of_cloud_nuclei_forcing_for_interpolation long_name = interpolation low index for ice and cloud condensation nuclei in the x direction @@ -1240,6 +1314,7 @@ dimensions = (horizontal_dimension) type = integer intent = in + optional = True [iindx2_ci] standard_name = upper_longitude_index_of_cloud_nuclei_forcing_for_interpolation long_name = interpolation high index for ice and cloud condensation nuclei in the x direction @@ -1247,6 +1322,7 @@ dimensions = (horizontal_dimension) type = integer intent = in + optional = True [ddx_ci] standard_name = longitude_interpolation_weight_for_cloud_nuclei_forcing long_name = interpolation high index for ice and cloud condensation nuclei in the x direction @@ -1255,6 +1331,7 @@ type = real kind = kind_phys intent = in + optional = True [in_nm] standard_name = ice_nucleation_number_from_climatology long_name = ice nucleation number in MG MP @@ -1322,6 +1399,7 @@ dimensions = (horizontal_dimension) type = integer intent = in + optional = True [jindx2_tau] standard_name = upper_latitude_index_of_absolute_momentum_flux_due_to_nonorographic_gravity_wave_drag_for_interpolation long_name = index2 for weight2 for tau NGWs @@ -1329,6 +1407,7 @@ dimensions = (horizontal_dimension) type = integer intent = in + optional = True [ddy_j1tau] standard_name = latitude_interpolation_weight_complement_for_absolute_momentum_flux_due_to_nonorographic_gravity_wave_drag long_name = interpolation weight1 for tau NGWs @@ -1337,6 +1416,7 @@ type = real intent = in kind = kind_phys + optional = True [ddy_j2tau] standard_name = latitude_interpolation_weight_for_absolute_momentum_flux_due_to_nonorographic_gravity_wave_drag long_name = interpolation weight2 for tau NGWs @@ -1345,6 +1425,7 @@ type = real intent = in kind = kind_phys + optional = True [tau_amf] standard_name = absolute_momentum_flux_due_to_nonorographic_gravity_wave_drag long_name = ngw_absolute_momentum_flux @@ -1353,6 +1434,13 @@ type = real kind = kind_phys intent = inout +[ozphys] + standard_name = dataset_for_ozone_physics + long_name = dataset for NRL ozone physics + units = mixed + dimensions = () + type = ty_ozphys + intent = in [nthrds] standard_name = number_of_openmp_threads long_name = number of OpenMP threads available for physics schemes diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_physics_post.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_physics_post.F90 new file mode 100644 index 000000000..ec041623c --- /dev/null +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_physics_post.F90 @@ -0,0 +1,158 @@ +! ########################################################################################### +!> \file GFS_physics_post.F90 +!! +!! This module contains GFS specific calculations (e.g. diagnostics) and suite specific +!! code (e.g Saving fields for subsequent physics timesteps). For interoperability across a +!! wide range of hosts, CCPP compliant schemes should avoid including such calculations. This +!! module/scheme is intended for such "host-specific" computations. +!! +! ########################################################################################### +module GFS_physics_post + use machine, only : kind_phys, kind_dbl_prec, kind_sngl_prec + implicit none + public GFS_physics_post_run +contains + +! ########################################################################################### +! SUBROUTINE GFS_physics_post_run +! ########################################################################################### +!! \section arg_table_GFS_physics_post_run Argument Table +!! \htmlinclude GFS_physics_post_run.html +!! + subroutine GFS_physics_post_run(nCol, nLev, ntoz, ntracp100, nprocess, nprocess_summed, & + dtidx, is_photochem, ldiag3d, ip_physics, ip_photochem, ip_prod_loss, ip_ozmix, & + ip_temp, ip_overhead_ozone, do3_dt_prd, do3_dt_ozmx, do3_dt_temp, do3_dt_ohoz, & + dtend, errmsg, errflg) + + ! Inputs + integer, intent(in) :: & + nCol, & ! Horizontal dimension + nLev, & ! Number of vertical layers + ntoz, & ! Index for ozone mixing ratio + ntracp100, & ! Number of tracers plus 100 + nprocess, & ! Number of processes that cause changes in state variables + nprocess_summed,& ! Number of causes in dtidx per tracer summed for total physics tendency + ip_physics, & ! Index for process in diagnostic tendency output + ip_photochem, & ! Index for process in diagnostic tendency output + ip_prod_loss, & ! Index for process in diagnostic tendency output + ip_ozmix, & ! Index for process in diagnostic tendency output + ip_temp, & ! Index for process in diagnostic tendency output + ip_overhead_ozone ! Index for process in diagnostic tendency output + integer, intent(in), dimension(:,:) :: & + dtidx ! Bookkeeping indices for GFS diagnostic tendencies + logical, intent(in) :: & + ldiag3d ! Flag for 3d diagnostic fields + logical, intent(in), dimension(:) :: & + is_photochem ! Flags for photochemistry processes to sum + + ! Inputs (optional) + real(kind=kind_phys), intent(in), dimension(:,:), pointer, optional :: & + do3_dt_prd, & ! Physics tendency: production and loss effect + do3_dt_ozmx, & ! Physics tendency: ozone mixing ratio effect + do3_dt_temp, & ! Physics tendency: temperature effect + do3_dt_ohoz ! Physics tendency: overhead ozone effect + + ! Outputs + real(kind=kind_phys), intent(inout), dimension(:,:,:), optional :: & + dtend ! Diagnostic tendencies for state variables + character(len=*), intent(out) :: & + errmsg ! CCPP error message + integer, intent(out) :: & + errflg ! CCPP error flag + + ! Locals + integer :: idtend, ichem, iphys, itrac + logical :: all_true(nprocess) + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + if(.not.ldiag3d) then + return + endif + + ! ####################################################################################### + ! + ! Ozone physics diagnostics + ! + ! ####################################################################################### + idtend = dtidx(100+ntoz,ip_prod_loss) + if (idtend >= 1 .and. associated(do3_dt_prd)) then + dtend(:,:,idtend) = dtend(:,:,idtend) + do3_dt_prd + endif + ! + idtend = dtidx(100+ntoz,ip_ozmix) + if (idtend >= 1 .and. associated(do3_dt_ozmx)) then + dtend(:,:,idtend) = dtend(:,:,idtend) + do3_dt_ozmx + endif + ! + idtend = dtidx(100+ntoz,ip_temp) + if (idtend >= 1 .and. associated(do3_dt_temp)) then + dtend(:,:,idtend) = dtend(:,:,idtend) + do3_dt_temp + endif + ! + idtend = dtidx(100+ntoz,ip_overhead_ozone) + if (idtend >= 1 .and. associated(do3_dt_ohoz)) then + dtend(:,:,idtend) = dtend(:,:,idtend) + do3_dt_ohoz + endif + + ! ####################################################################################### + ! + ! Total (photochemical) tendencies. + ! + ! ####################################################################################### + itrac = ntoz+100 + ichem = dtidx(itrac, ip_photochem) + if(ichem >= 1) then + call sum_it(ichem, itrac, is_photochem) + endif + + ! ####################################################################################### + ! + ! Total (physics) tendencies + ! + ! ####################################################################################### + all_true = .true. + do itrac = 2,ntracp100 + iphys = dtidx(itrac,ip_physics) + if(iphys >= 1) then + call sum_it(iphys, itrac, all_true) + endif + enddo + + contains + + subroutine sum_it(isum,itrac,sum_me) + integer, intent(in) :: isum ! third index of dtend of summary process + integer, intent(in) :: itrac ! tracer or state variable being summed + logical, intent(in) :: sum_me(nprocess) ! false = skip this process + logical :: first + integer :: idtend, iprocess + + first=.true. + do iprocess=1,nprocess + if(iprocess>nprocess_summed) then + exit ! Don't sum up the sums. + else if(.not.sum_me(iprocess)) then + cycle ! We were asked to skip this one. + endif + idtend = dtidx(itrac,iprocess) + if(idtend>=1) then + ! This tendency was calculated for this tracer, so + ! accumulate it into the total tendency. + if(first) then + dtend(:,:,isum) = dtend(:,:,idtend) + first=.false. + else + dtend(:,:,isum) = dtend(:,:,isum) + dtend(:,:,idtend) + endif + endif + enddo + if(first) then + ! No tendencies were calculated, so sum is 0: + dtend(:,:,isum) = 0 + endif + end subroutine sum_it + end subroutine GFS_physics_post_run +end module GFS_physics_post diff --git a/physics/ozphys_2015.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_physics_post.meta similarity index 59% rename from physics/ozphys_2015.meta rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_physics_post.meta index 8bce7defe..c42da0166 100644 --- a/physics/ozphys_2015.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_physics_post.meta @@ -1,130 +1,26 @@ [ccpp-table-properties] - name = ozphys_2015 + name = GFS_physics_post type = scheme - dependencies = machine.F + dependencies = ../../hooks/machine.F ######################################################################## [ccpp-arg-table] - name = ozphys_2015_init + name = GFS_physics_post_run type = scheme -[oz_phys_2015] - standard_name = flag_for_nrl_2015_ozone_scheme - long_name = flag for new (2015) ozone physics - units = flag - dimensions = () - type = logical - intent = in -[errmsg] - standard_name = ccpp_error_message - long_name = error message for error handling in CCPP - units = none - dimensions = () - type = character - kind = len=* - intent = out -[errflg] - standard_name = ccpp_error_code - long_name = error code for error handling in CCPP - units = 1 - dimensions = () - type = integer - intent = out - -######################################################################## -[ccpp-arg-table] - name = ozphys_2015_run - type = scheme -[im] +[nCol] standard_name = horizontal_loop_extent long_name = horizontal loop extent units = count dimensions = () type = integer intent = in -[levs] +[nLev] standard_name = vertical_layer_dimension long_name = number of vertical layers units = count dimensions = () type = integer intent = in -[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 -[dt] - standard_name = timestep_for_physics - long_name = physics time step - units = s - dimensions = () - type = real - kind = kind_phys - intent = in -[oz] - standard_name = ozone_concentration_of_new_state - long_name = ozone concentration updated by physics - units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = inout -[tin] - standard_name = air_temperature_of_new_state - long_name = updated air temperature - units = K - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = in -[po3] - standard_name = natural_log_of_ozone_forcing_data_pressure_levels - long_name = natural log of ozone forcing data pressure levels - units = 1 - dimensions = (vertical_dimension_of_ozone_forcing_data) - type = real - kind = kind_phys - intent = in -[prsl] - standard_name = air_pressure - long_name = mid-layer pressure - units = Pa - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = in -[prdout] - standard_name = ozone_forcing - long_name = ozone forcing data - units = mixed - dimensions = (horizontal_loop_extent,vertical_dimension_of_ozone_forcing_data,number_of_coefficients_in_ozone_forcing_data) - type = real - kind = kind_phys - intent = in -[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 -[delp] - standard_name = air_pressure_difference_between_midlayers - long_name = difference between mid-layer pressures - units = Pa - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = in -[ldiag3d] - standard_name = flag_for_diagnostics_3D - long_name = flag for calculating 3-D diagnostic fields - units = flag - dimensions = () - type = logical - intent = in [dtend] standard_name = cumulative_change_of_state_variables long_name = diagnostic tendencies for state variables @@ -133,6 +29,7 @@ type = real kind = kind_phys intent = inout + optional = True [dtidx] standard_name = cumulative_change_of_state_variables_outer_index long_name = index of state-variable and process in last dimension of diagnostic tendencies array AKA cumulative_change_index @@ -147,49 +44,119 @@ dimensions = () type = integer intent = in -[index_of_process_prod_loss] +[ntracp100] + standard_name = number_of_tracers_plus_one_hundred + long_name = number of tracers plus one hundred + units = count + dimensions = () + type = integer + intent = in +[nprocess] + standard_name = number_of_cumulative_change_processes + long_name = number of processes that cause changes in state variables + units = count + dimensions = () + type = integer + intent = in +[nprocess_summed] + standard_name = number_of_physics_causes_of_tracer_changes + long_name = number of causes in dtidx per tracer summed for total physics tendency + units = count + dimensions = () + type = integer + intent = in +[ip_physics] + standard_name = index_of_all_physics_process_in_cumulative_change_index + long_name = index of all physics transport process in second dimension of array cumulative change index + units = index + dimensions = () + type = integer + intent = in +[ip_photochem] + standard_name = index_of_photochemistry_process_in_cumulative_change_index + long_name = index of photochemistry process in second dimension of array cumulative change index + units = index + dimensions = () + type = integer + intent = in +[is_photochem] + standard_name = flags_for_photochemistry_processes_to_sum + long_name = flags for photochemistry processes to sum as the total photochemistry process cumulative change + units = flag + dimensions = (number_of_cumulative_change_processes) + type = logical + intent = in +[ldiag3d] + standard_name = flag_for_diagnostics_3D + long_name = flag for 3d diagnostic fields + units = flag + dimensions = () + type = logical + intent = in +[ip_prod_loss] standard_name = index_of_production_and_loss_process_in_cumulative_change_index long_name = index of production and loss effect in photochemistry process in second dimension of array cumulative change index units = index dimensions = () type = integer intent = in -[index_of_process_ozmix] +[ip_ozmix] standard_name = index_of_ozone_mixing_ratio_process_in_cumulative_change_index long_name = index of ozone mixing ratio effect in photochemistry process in second dimension of array cumulative change index units = index dimensions = () type = integer intent = in -[index_of_process_temp] +[ip_temp] standard_name = index_of_temperature_process_in_cumulative_change_index long_name = index of temperature effect in photochemistry process in second dimension of array cumulative change index units = index dimensions = () type = integer intent = in -[index_of_process_overhead_ozone] +[ip_overhead_ozone] standard_name = index_of_overhead_process_in_cumulative_change_index long_name = index of overhead ozone effect in photochemistry process in second dimension of array cumulative change index units = index dimensions = () type = integer intent = in -[con_g] - standard_name = gravitational_acceleration - long_name = gravitational acceleration - units = m s-2 - dimensions = () +[do3_dt_prd] + standard_name = ozone_tendency_due_to_production_and_loss_rate + long_name = ozone tendency due to production and loss rate + units = kg kg-1 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys intent = in -[me] - standard_name = mpi_rank - long_name = rank of the current MPI task - units = index - dimensions = () - type = integer + optional = True +[do3_dt_ozmx] + standard_name = ozone_tendency_due_to_ozone_mixing_ratio + long_name = ozone tendency due to ozone mixing ratio + units = kg kg-1 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys intent = in + optional = True +[do3_dt_temp] + standard_name = ozone_tendency_due_to_temperature + long_name = ozone tendency due to temperature + units = kg kg-1 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = in + optional = True +[do3_dt_ohoz] + standard_name = ozone_tendency_due_to_overhead_ozone_column + long_name = ozone tendency due to overhead ozone column + units = kg kg-1 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = in + optional = True [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP @@ -204,4 +171,4 @@ units = 1 dimensions = () type = integer - intent = out + intent = out \ No newline at end of file diff --git a/physics/GFS_rad_time_vary.fv3.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rad_time_vary.fv3.F90 similarity index 85% rename from physics/GFS_rad_time_vary.fv3.F90 rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rad_time_vary.fv3.F90 index 978dc177f..d55fac983 100644 --- a/physics/GFS_rad_time_vary.fv3.F90 +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rad_time_vary.fv3.F90 @@ -30,19 +30,19 @@ subroutine GFS_rad_time_vary_timestep_init (lrseeds, rseeds, ! Interface variables logical, intent(in) :: lrseeds - integer, intent(in) :: rseeds(:,:) + integer, intent(in), optional :: rseeds(:,:) integer, intent(in) :: isubc_lw, isubc_sw, cnx, cny, isc, jsc, kdt integer, intent(in) :: imp_physics, imp_physics_zhao_carr, ipsd0, ipsdlim logical, intent(in) :: lslwr, lsswr - integer, intent(inout) :: icsdsw(:), icsdlw(:) + integer, intent(inout), optional :: icsdsw(:), icsdlw(:) integer, intent(in) :: imap(:), jmap(:) real(kind_phys), intent(in) :: sec - real(kind_phys), intent(inout) :: ps_2delt(:) - real(kind_phys), intent(inout) :: ps_1delt(:) - real(kind_phys), intent(inout) :: t_2delt(:,:) - real(kind_phys), intent(inout) :: t_1delt(:,:) - real(kind_phys), intent(inout) :: qv_2delt(:,:) - real(kind_phys), intent(inout) :: qv_1delt(:,:) + real(kind_phys), intent(inout), optional :: ps_2delt(:) + real(kind_phys), intent(inout), optional :: ps_1delt(:) + real(kind_phys), intent(inout), optional :: t_2delt(:,:) + real(kind_phys), intent(inout), optional :: t_1delt(:,:) + real(kind_phys), intent(inout), optional :: qv_2delt(:,:) + real(kind_phys), intent(inout), optional:: qv_1delt(:,:) real(kind_phys), intent(in) :: t(:,:), qv(:,:), ps(:) character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg diff --git a/physics/GFS_rad_time_vary.fv3.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rad_time_vary.fv3.meta similarity index 95% rename from physics/GFS_rad_time_vary.fv3.meta rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rad_time_vary.fv3.meta index 19eb41dc2..488f547b6 100644 --- a/physics/GFS_rad_time_vary.fv3.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rad_time_vary.fv3.meta @@ -1,7 +1,8 @@ [ccpp-table-properties] name = GFS_rad_time_vary type = scheme - dependencies = machine.F,mersenne_twister.f,radcons.f90 + relative_path = ../../ + dependencies = hooks/machine.F,Radiation/mersenne_twister.f,Radiation/RRTMG/radcons.f90 ######################################################################## [ccpp-arg-table] @@ -21,6 +22,7 @@ dimensions = (horizontal_dimension, number_of_host_provided_random_number_streams) type = integer intent = in + optional = True [lslwr] standard_name = flag_for_calling_longwave_radiation long_name = logical flags for lw radiation calls @@ -56,6 +58,7 @@ dimensions = (horizontal_dimension) type = integer intent = inout + optional = True [icsdlw] standard_name = random_number_seed_for_mcica_longwave long_name = random seeds for sub-column cloud generators lw @@ -63,6 +66,7 @@ dimensions = (horizontal_dimension) type = integer intent = inout + optional = True [cnx] standard_name = number_of_x_points_for_current_cubed_sphere_tile long_name = number of points in x direction for this cubed sphere face @@ -156,6 +160,7 @@ type = real kind = kind_phys intent = inout + optional = True [ps_1delt] standard_name = surface_air_pressure_on_previous_timestep long_name = surface air pressure at previous timestep @@ -164,6 +169,7 @@ type = real kind = kind_phys intent = inout + optional = True [t_2delt] standard_name = air_temperature_two_timesteps_back long_name = air temperature two timesteps back @@ -172,6 +178,7 @@ type = real kind = kind_phys intent = inout + optional = True [t_1delt] standard_name = air_temperature_on_previous_timestep_in_xyz_dimensioned_restart_array long_name = air temperature at previous timestep @@ -180,6 +187,7 @@ type = real kind = kind_phys intent = inout + optional = True [qv_2delt] standard_name = specific_humidity_two_timesteps_back long_name = water vapor specific humidity two timesteps back @@ -188,6 +196,7 @@ type = real kind = kind_phys intent = inout + optional = True [qv_1delt] standard_name = specific_humidity_on_previous_timestep_in_xyz_dimensioned_restart_array long_name = water vapor specific humidity at previous timestep @@ -196,6 +205,7 @@ type = real kind = kind_phys intent = inout + optional = True [t] standard_name = air_temperature long_name = model layer mean temperature diff --git a/physics/GFS_rad_time_vary.scm.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rad_time_vary.scm.F90 similarity index 100% rename from physics/GFS_rad_time_vary.scm.F90 rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rad_time_vary.scm.F90 diff --git a/physics/GFS_rad_time_vary.scm.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rad_time_vary.scm.meta similarity index 95% rename from physics/GFS_rad_time_vary.scm.meta rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rad_time_vary.scm.meta index 19eb41dc2..488f547b6 100644 --- a/physics/GFS_rad_time_vary.scm.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rad_time_vary.scm.meta @@ -1,7 +1,8 @@ [ccpp-table-properties] name = GFS_rad_time_vary type = scheme - dependencies = machine.F,mersenne_twister.f,radcons.f90 + relative_path = ../../ + dependencies = hooks/machine.F,Radiation/mersenne_twister.f,Radiation/RRTMG/radcons.f90 ######################################################################## [ccpp-arg-table] @@ -21,6 +22,7 @@ dimensions = (horizontal_dimension, number_of_host_provided_random_number_streams) type = integer intent = in + optional = True [lslwr] standard_name = flag_for_calling_longwave_radiation long_name = logical flags for lw radiation calls @@ -56,6 +58,7 @@ dimensions = (horizontal_dimension) type = integer intent = inout + optional = True [icsdlw] standard_name = random_number_seed_for_mcica_longwave long_name = random seeds for sub-column cloud generators lw @@ -63,6 +66,7 @@ dimensions = (horizontal_dimension) type = integer intent = inout + optional = True [cnx] standard_name = number_of_x_points_for_current_cubed_sphere_tile long_name = number of points in x direction for this cubed sphere face @@ -156,6 +160,7 @@ type = real kind = kind_phys intent = inout + optional = True [ps_1delt] standard_name = surface_air_pressure_on_previous_timestep long_name = surface air pressure at previous timestep @@ -164,6 +169,7 @@ type = real kind = kind_phys intent = inout + optional = True [t_2delt] standard_name = air_temperature_two_timesteps_back long_name = air temperature two timesteps back @@ -172,6 +178,7 @@ type = real kind = kind_phys intent = inout + optional = True [t_1delt] standard_name = air_temperature_on_previous_timestep_in_xyz_dimensioned_restart_array long_name = air temperature at previous timestep @@ -180,6 +187,7 @@ type = real kind = kind_phys intent = inout + optional = True [qv_2delt] standard_name = specific_humidity_two_timesteps_back long_name = water vapor specific humidity two timesteps back @@ -188,6 +196,7 @@ type = real kind = kind_phys intent = inout + optional = True [qv_1delt] standard_name = specific_humidity_on_previous_timestep_in_xyz_dimensioned_restart_array long_name = water vapor specific humidity at previous timestep @@ -196,6 +205,7 @@ type = real kind = kind_phys intent = inout + optional = True [t] standard_name = air_temperature long_name = model layer mean temperature diff --git a/physics/GFS_radiation_surface.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_radiation_surface.F90 similarity index 95% rename from physics/GFS_radiation_surface.F90 rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_radiation_surface.F90 index f6067a86c..6f05c93db 100644 --- a/physics/GFS_radiation_surface.F90 +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_radiation_surface.F90 @@ -72,16 +72,17 @@ subroutine GFS_radiation_surface_run ( & integer, dimension(:), intent(in) :: use_lake_model real(kind=kind_phys), dimension(:), intent(in) :: xlat, xlon, slmsk, & - sfc_alb_pert, lndp_prt_list, & + sfc_alb_pert, & landfrac, lakefrac, & snodl, snodi, sncovr, & sncovr_ice, fice, zorl, & hprime, tsfg, tsfa, tisfc, & coszen, alvsf, alnsf, alvwf, & alnwf, facsf, facwf, snoalb - character(len=3) , dimension(:), intent(in) :: lndp_var_list - real(kind=kind_phys), dimension(:), intent(in) :: albdvis_ice, albdnir_ice, & - albivis_ice, albinir_ice + real(kind=kind_phys), dimension(:), intent(in), optional :: lndp_prt_list + character(len=3) , dimension(:), intent(in), optional :: lndp_var_list + real(kind=kind_phys), dimension(:), intent(in), optional :: albdvis_ice, albdnir_ice, & + albivis_ice, albinir_ice real(kind=kind_phys), dimension(:), intent(inout) :: albdvis_lnd, albdnir_lnd, & albivis_lnd, albinir_lnd, & @@ -178,7 +179,6 @@ subroutine GFS_radiation_surface_run ( & call setalb (slmsk, lsm, lsm_noahmp, lsm_ruc, use_cice_alb, snodi, sncovr, sncovr_ice, & snoalb, zorl, coszen, tsfg, tsfa, hprime, frac_grid, lakefrac, & -! snoalb, zorl, coszen, tsfg, tsfa, hprime, frac_grid, min_seaice, & alvsf, alnsf, alvwf, alnwf, facsf, facwf, fice, tisfc, & albdvis_lnd, albdnir_lnd, albivis_lnd, albinir_lnd, & albdvis_ice, albdnir_ice, albivis_ice, albinir_ice, & diff --git a/physics/GFS_radiation_surface.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_radiation_surface.meta similarity index 97% rename from physics/GFS_radiation_surface.meta rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_radiation_surface.meta index 9d5734706..94043898d 100644 --- a/physics/GFS_radiation_surface.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_radiation_surface.meta @@ -1,7 +1,10 @@ [ccpp-table-properties] name = GFS_radiation_surface type = scheme - dependencies = iounitdef.f,machine.F,radiation_surface.f,set_soilveg_ruc.F90,namelist_soilveg_ruc.F90 + relative_path = ../../ + dependencies = Radiation/radiation_surface.f + dependencies = SFC_Models/Land/RUC/set_soilveg_ruc.F90,SFC_Models/Land/RUC/namelist_soilveg_ruc.F90 + dependencies = hooks/machine.F ######################################################################## [ccpp-arg-table] @@ -181,6 +184,7 @@ type = character kind = len=3 intent = in + optional = True [lndp_prt_list] standard_name = land_surface_perturbation_magnitudes long_name = magnitude of perturbations for landperts @@ -189,6 +193,7 @@ type = real kind = kind_phys intent = in + optional = True [landfrac] standard_name = land_area_fraction long_name = fraction of horizontal grid area occupied by land @@ -458,6 +463,7 @@ type = real kind = kind_phys intent = in + optional = True [albdnir_ice] standard_name = surface_albedo_direct_NIR_over_ice long_name = direct surface albedo NIR band over ice @@ -466,6 +472,7 @@ type = real kind = kind_phys intent = in + optional = True [albivis_ice] standard_name = surface_albedo_diffuse_visible_over_ice long_name = diffuse surface albedo visible band over ice @@ -474,6 +481,7 @@ type = real kind = kind_phys intent = in + optional = True [albinir_ice] standard_name = surface_albedo_diffuse_NIR_over_ice long_name = diffuse surface albedo NIR band over ice @@ -482,6 +490,7 @@ type = real kind = kind_phys intent = in + optional = True [semisbase] standard_name = baseline_surface_longwave_emissivity long_name = baseline surface lw emissivity in fraction diff --git a/physics/GFS_rrtmg_post.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmg_post.F90 similarity index 100% rename from physics/GFS_rrtmg_post.F90 rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmg_post.F90 diff --git a/physics/GFS_rrtmg_post.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmg_post.meta similarity index 97% rename from physics/GFS_rrtmg_post.meta rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmg_post.meta index 5fa6328a7..b387c3e33 100644 --- a/physics/GFS_rrtmg_post.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmg_post.meta @@ -1,7 +1,9 @@ [ccpp-table-properties] name = GFS_rrtmg_post type = scheme - dependencies = iounitdef.f,machine.F,radiation_aerosols.f,radlw_param.f,radsw_param.f + relative_path = ../../ + dependencies = hooks/machine.F + dependencies = Radiation/radiation_aerosols.f,Radiation/RRTMG/radlw_param.f,Radiation/RRTMG/radsw_param.f ######################################################################## [ccpp-arg-table] diff --git a/physics/GFS_rrtmg_pre.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmg_pre.F90 similarity index 97% rename from physics/GFS_rrtmg_pre.F90 rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmg_pre.F90 index 4f4de181a..eadc041fd 100644 --- a/physics/GFS_rrtmg_pre.F90 +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmg_pre.F90 @@ -19,7 +19,7 @@ module GFS_rrtmg_pre !>\section rrtmg_pre_gen General Algorithm subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, lextop,& ltp, imfdeepcnv, imfdeepcnv_gf, imfdeepcnv_c3, me, ncnd, ntrac, & - num_p3d, npdf3d, & + num_p3d, npdf3d, xr_cnvcld, & ncnvcld3d,ntqv, ntcw,ntiw, ntlnc, ntinc, ntrnc, ntsnc, ntccn, top_at_1,& ntrw, ntsw, ntgl, nthl, ntwa, ntoz, ntsmoke, ntdust, ntcoarsepm, & ntclamt, nleffr, nieffr, nseffr, lndp_type, kdt, & @@ -45,7 +45,8 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, lextop,& gasvmr_ccl4, gasvmr_cfc113, aerodp,ext550, clouds6, clouds7, clouds8, & clouds9, cldsa, cldfra, cldfra2d, lwp_ex,iwp_ex, lwp_fc,iwp_fc, & faersw1, faersw2, faersw3, faerlw1, faerlw2, faerlw3, alpha, rrfs_sd, & - aero_dir_fdb, fdb_coef, spp_wts_rad, spp_rad, ico2, errmsg, errflg) + aero_dir_fdb, fdb_coef, spp_wts_rad, spp_rad, ico2, ozphys, & + errmsg, errflg) use machine, only: kind_phys @@ -53,7 +54,7 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, lextop,& use funcphys, only: fpvs use module_radiation_astronomy,only: coszmn ! sol_init, sol_update - use module_radiation_gases, only: NF_VGAS, getgases, getozn ! gas_init, gas_update, + use module_radiation_gases, only: NF_VGAS, getgases ! gas_init, gas_update, use module_radiation_aerosols, only: NF_AESW, NF_AELW, setaer, & ! aer_init, aer_update, & NSPC1 use module_radiation_clouds, only: NF_CLDS, & ! cld_init @@ -80,6 +81,8 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, lextop,& make_IceNumber, & make_DropletNumber, & make_RainNumber + ! For NRL Ozone + use module_ozphys, only: ty_ozphys implicit none integer, intent(in) :: im, levs, lm, lmk, lmp, ltp, & @@ -120,17 +123,17 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, lextop,& integer, intent(in) :: ntdu1, ntdu2, ntdu3, ntdu4, ntdu5, ntss1, ntss2, ntss3, & ntss4, ntss5, ntsu, ntbcb, ntbcl, ntocb, ntocl, ntchm - character(len=3), dimension(:), intent(in) :: lndp_var_list + character(len=3), dimension(:), intent(in), optional :: lndp_var_list logical, intent(in) :: lsswr, lslwr, ltaerosol, lgfdlmprad, & uni_cld, effr_in, do_mynnedmf, & lmfshal, lmfdeep2, pert_clds, lcrick,& lcnorm, top_at_1, lextop, mraerosol - logical, intent(in) :: rrfs_sd, aero_dir_fdb + logical, intent(in) :: rrfs_sd, aero_dir_fdb, xr_cnvcld logical, intent(in) :: nssl_ccn_on, nssl_invertccn integer, intent(in) :: spp_rad - real(kind_phys), intent(in) :: spp_wts_rad(:,:) + real(kind_phys), intent(in), optional :: spp_wts_rad(:,:) real(kind=kind_phys), intent(in) :: fhswr, fhlwr, solhr, sup, julian, sppt_amp, dcorr_con real(kind=kind_phys), intent(in) :: con_eps, epsm1, fvirt, rog, rocp, con_rd, con_pi, con_g, con_ttp, con_thgni @@ -140,23 +143,24 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, lextop,& slmsk, dx, si real(kind=kind_phys), dimension(:,:), intent(in) :: prsi, prsl, prslk, & - tgrs, sfc_wts, & + tgrs + real(kind=kind_phys), dimension(:,:), intent(in), optional :: & mg_cld, effrr_in, & cnvw_in, cnvc_in, & - sppt_wts + sppt_wts, sfc_wts real(kind=kind_phys), dimension(:,:,:), intent(in) :: qgrs real(kind=kind_phys), dimension(:,:,:), intent(inout) :: aer_nm real(kind=kind_phys), dimension(:), intent(inout) :: coszen, coszdg - real(kind=kind_phys), dimension(:,:), intent(inout) :: effrl_inout, & + real(kind=kind_phys), dimension(:,:), intent(inout), optional :: effrl_inout, & effri_inout, & effrs_inout real(kind=kind_phys), dimension(:,:), intent(inout) :: clouds1, & clouds2, clouds3, & clouds4, clouds5 - real(kind=kind_phys), dimension(:,:), intent(in) :: qci_conv + real(kind=kind_phys), dimension(:,:), intent(in), optional :: qci_conv real(kind=kind_phys), dimension(:), intent(in) :: fdb_coef real(kind=kind_phys), dimension(:), intent(out) :: lwp_ex,iwp_ex, & lwp_fc,iwp_fc @@ -250,6 +254,9 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, lextop,& integer :: iflag integer :: islmsk + ! For NRL Ozone + type(ty_ozphys),intent(in) :: ozphys + integer :: ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte @@ -420,7 +427,6 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, lextop,& !> - Get layer ozone mass mixing ratio (if use ozone climatology data, -!! call getozn()). if (ntoz > 0) then ! interactive ozone generation do k=1,lmk @@ -429,8 +435,7 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, lextop,& enddo enddo else ! climatological ozone - call getozn (prslk1, xlat, im, lmk, top_at_1, & ! --- inputs - olyr) ! --- outputs + call ozphys%run_o3clim(xlat, prslk1, con_pi, olyr) endif ! end_if_ntoz !> - Call coszmn(), to compute cosine of zenith angle (only when SW is called) @@ -976,8 +981,8 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, lextop,& & imp_physics_mg, iovr, iovr_rand, iovr_maxrand, iovr_max, & & iovr_dcorr, iovr_exp, iovr_exprand, idcor, idcor_con, & & idcor_hogan, idcor_oreopoulos, lcrick, lcnorm, & - & imfdeepcnv, imfdeepcnv_gf, imfdeepcnv_gf, do_mynnedmf, & - & lgfdlmprad, & + & imfdeepcnv, imfdeepcnv_gf, imfdeepcnv_c3, do_mynnedmf, & + & lgfdlmprad, xr_cnvcld, & & uni_cld, lmfshal, lmfdeep2, cldcov, clouds1, & & effrl, effri, effrr, effrs, effr_in, & & effrl_inout, effri_inout, effrs_inout, & diff --git a/physics/GFS_rrtmg_pre.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmg_pre.meta similarity index 97% rename from physics/GFS_rrtmg_pre.meta rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmg_pre.meta index a8aecdbe0..a7df9be2a 100644 --- a/physics/GFS_rrtmg_pre.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmg_pre.meta @@ -1,9 +1,14 @@ [ccpp-table-properties] name = GFS_rrtmg_pre type = scheme - dependencies = funcphys.f90,iounitdef.f,machine.F,module_bfmicrophysics.f,module_mp_radar.F90,module_mp_thompson.F90 - dependencies = module_mp_thompson_make_number_concentrations.F90,radcons.f90,radiation_aerosols.f - dependencies = radiation_astronomy.f,radiation_clouds.f,radiation_gases.f,radlw_param.f,radsw_param.f,surface_perturbation.F90,radiation_cloud_overlap.F90 + relative_path = ../../ + dependencies = tools/funcphys.f90,hooks/machine.F + dependencies = MP/Thompson/module_mp_thompson.F90,MP/Thompson/module_mp_thompson_make_number_concentrations.F90 + dependencies = Radiation/RRTMG/radcons.f90,Radiation/radiation_aerosols.f + dependencies = Radiation/radiation_astronomy.f,Radiation/radiation_clouds.f,Radiation/radiation_gases.f + dependencies = Radiation/RRTMG/radlw_param.f,Radiation/RRTMG/radsw_param.f,Radiation/radiation_cloud_overlap.F90 + dependencies = SFC_Models/Land/Noah/surface_perturbation.F90 + dependencies = photochem/module_ozphys.F90 ######################################################################## [ccpp-arg-table] @@ -51,6 +56,13 @@ dimensions = () type = logical intent = in +[xr_cnvcld] + standard_name = flag_for_suspended_convective_clouds_in_Xu_Randall + long_name = flag for using suspended convective clouds in Xu Randall + units = flag + dimensions = () + type = logical + intent = in [ltp] standard_name = extra_top_layer long_name = extra top layer for radiation @@ -247,6 +259,13 @@ dimensions = () type = integer intent = in +[ozphys] + standard_name = dataset_for_ozone_physics + long_name = dataset for NRL ozone physics + units = mixed + dimensions = () + type = ty_ozphys + intent = in [iaermdl] standard_name = control_for_aerosol_radiation_scheme long_name = control of aerosol scheme in radiation @@ -599,6 +618,7 @@ type = character kind = len=3 intent = in + optional = True [lsswr] standard_name = flag_for_calling_shortwave_radiation long_name = logical flags for sw radiation calls @@ -891,6 +911,7 @@ type = real kind = kind_phys intent = in + optional = True [mg_cld] standard_name = cloud_fraction_for_MG long_name = cloud fraction used by Morrison-Gettelman MP @@ -899,6 +920,7 @@ type = real kind = kind_phys intent = in + optional = True [effrr_in] standard_name = effective_radius_of_stratiform_cloud_rain_particle long_name = effective radius of cloud rain particle in micrometers @@ -907,6 +929,7 @@ type = real kind = kind_phys intent = in + optional = True [pert_clds] standard_name = flag_for_stochastic_cloud_fraction_perturbations long_name = flag for stochastic cloud fraction physics perturbations @@ -922,6 +945,7 @@ type = real kind = kind_phys intent = in + optional = True [sppt_amp] standard_name = total_amplitude_of_sppt_perturbation long_name = total ampltidue of stochastic sppt perturbation @@ -938,6 +962,7 @@ type = real kind = kind_phys intent = in + optional = True [cnvc_in] standard_name = convective_cloud_area_fraction long_name = convective cloud cover in the phy_f3d array @@ -946,6 +971,7 @@ type = real kind = kind_phys intent = in + optional = True [qgrs] standard_name = tracer_concentration long_name = model layer mean tracer concentration @@ -1001,6 +1027,7 @@ type = real kind = kind_phys intent = inout + optional = True [effri_inout] standard_name = effective_radius_of_stratiform_cloud_ice_particle long_name = eff. radius of cloud ice water particle in micrometer @@ -1009,6 +1036,7 @@ type = real kind = kind_phys intent = inout + optional = True [effrs_inout] standard_name = effective_radius_of_stratiform_cloud_snow_particle long_name = effective radius of cloud snow particle in micrometers @@ -1017,6 +1045,7 @@ type = real kind = kind_phys intent = inout + optional = True [clouds1] standard_name = total_cloud_fraction long_name = layer total cloud fraction @@ -1065,6 +1094,7 @@ type = real kind = kind_phys intent = in + optional = True [kd] standard_name = vertical_index_difference_between_inout_and_local long_name = vertical index difference between in/out and local @@ -1496,6 +1526,7 @@ type = real kind = kind_phys intent = in + optional = True [spp_rad] standard_name = control_for_radiation_spp_perturbations long_name = control for radiation spp perturbations diff --git a/physics/GFS_rrtmg_setup.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmg_setup.F90 similarity index 97% rename from physics/GFS_rrtmg_setup.F90 rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmg_setup.F90 index 384d5252d..e48a60ac8 100644 --- a/physics/GFS_rrtmg_setup.F90 +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmg_setup.F90 @@ -7,7 +7,7 @@ module GFS_rrtmg_setup use machine, only: kind_phys - + use module_ozphys, only: ty_ozphys implicit none public GFS_rrtmg_setup_init, GFS_rrtmg_setup_timestep_init, GFS_rrtmg_setup_finalize @@ -218,8 +218,7 @@ subroutine GFS_rrtmg_setup_init ( si, levr, ictm, isol, solar_file, ico2, & con_pi ) call aer_init ( levr, me, iaermdl, iaerflg, lalw1bd, aeros_file, & con_pi, con_t0c, con_c, con_boltz, con_plnk, errflg, errmsg) - call gas_init ( me, co2usr_file, co2cyc_file, ico2, ictm, ntoz, & - con_pi, errflg, errmsg) + call gas_init ( me, co2usr_file, co2cyc_file, ico2, ictm, con_pi, errflg, errmsg ) call cld_init ( si, levr, imp_physics, me, con_g, con_rd, errflg, errmsg) call rlwinit ( me, rad_hr_units, inc_minor_gas, icliq_lw, isubcsw, & iovr, iovr_rand, iovr_maxrand, iovr_max, iovr_dcorr, & @@ -245,7 +244,8 @@ end subroutine GFS_rrtmg_setup_init !! subroutine GFS_rrtmg_setup_timestep_init (idate, jdate, deltsw, deltim, & lsswr, me, iaermdl, iaerflg, isol, aeros_file, slag, sdec, cdec, & - solcon, con_pi, co2dat_file, co2gbl_file, ictm, ico2, ntoz, errmsg, errflg) + solcon, con_pi, co2dat_file, co2gbl_file, ictm, ico2, ntoz, ozphys,& + errmsg, errflg) implicit none @@ -258,6 +258,7 @@ subroutine GFS_rrtmg_setup_timestep_init (idate, jdate, deltsw, deltim, & logical, intent(in) :: lsswr integer, intent(in) :: me integer, intent(in) :: iaermdl, iaerflg, isol, ictm, ico2, ntoz + type(ty_ozphys), intent(inout) :: ozphys character(len=26), intent(in) :: aeros_file, co2dat_file, co2gbl_file real(kind=kind_phys), intent(out) :: slag real(kind=kind_phys), intent(out) :: sdec @@ -278,7 +279,7 @@ subroutine GFS_rrtmg_setup_timestep_init (idate, jdate, deltsw, deltim, & errflg = 0 call radupdate(idate,jdate,deltsw,deltim,lsswr,me,iaermdl, iaerflg,isol,aeros_file,& - slag,sdec,cdec,solcon,con_pi,co2dat_file,co2gbl_file,ictm,ico2,ntoz,errflg,errmsg) + slag,sdec,cdec,solcon,con_pi,co2dat_file,co2gbl_file,ictm,ico2,ntoz,ozphys,errflg,errmsg) end subroutine GFS_rrtmg_setup_timestep_init @@ -326,7 +327,7 @@ end subroutine GFS_rrtmg_setup_finalize !----------------------------------- subroutine radupdate( idate,jdate,deltsw,deltim,lsswr,me, iaermdl,& iaerflg, isol, aeros_file, slag,sdec,cdec,solcon, con_pi, & - co2dat_file,co2gbl_file, ictm, ico2, ntoz, errflg, errmsg) + co2dat_file,co2gbl_file, ictm, ico2, ntoz, ozphys, errflg, errmsg) !................................... ! ================= subprogram documentation block ================ ! @@ -370,6 +371,7 @@ subroutine radupdate( idate,jdate,deltsw,deltim,lsswr,me, iaermdl,& ! --- inputs: integer, intent(in) :: idate(:), jdate(:), me, iaermdl, iaerflg, isol, ictm, ntoz, ico2 + type(ty_ozphys),intent(inout) :: ozphys logical, intent(in) :: lsswr character(len=26),intent(in) :: aeros_file,co2dat_file,co2gbl_file @@ -462,8 +464,11 @@ subroutine radupdate( idate,jdate,deltsw,deltim,lsswr,me, iaermdl,& lco2_chg = .false. endif - call gas_update ( kyear,kmon,kday,khour,loz1st,lco2_chg, me, co2dat_file, & - co2gbl_file, ictm, ico2, ntoz, errflg, errmsg ) + call gas_update ( kyear,kmon,kday,khour,lco2_chg, me, co2dat_file, & + co2gbl_file, ictm, ico2, errflg, errmsg ) + if (ntoz == 0) then + call ozphys%update_o3clim(kmon, kday, khour, loz1st) + endif if ( loz1st ) loz1st = .false. diff --git a/physics/GFS_rrtmg_setup.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmg_setup.meta similarity index 96% rename from physics/GFS_rrtmg_setup.meta rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmg_setup.meta index adf6d8750..7f7ad7532 100644 --- a/physics/GFS_rrtmg_setup.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmg_setup.meta @@ -1,8 +1,12 @@ [ccpp-table-properties] name = GFS_rrtmg_setup type = scheme - dependencies = iounitdef.f,module_bfmicrophysics.f,radcons.f90,radiation_aerosols.f,radiation_astronomy.f,radiation_clouds.f - dependencies = module_mp_thompson.F90,radiation_gases.f,radlw_main.F90,radlw_param.f,radsw_main.F90,radsw_param.f,machine.F + relative_path = ../../ + dependencies = hooks/machine.F + dependencies = Radiation/radiation_aerosols.f + dependencies = Radiation/radiation_astronomy.f,Radiation/radiation_clouds.f,Radiation/radiation_gases.f + dependencies = Radiation/RRTMG/radlw_main.F90,Radiation/RRTMG/radlw_param.f,Radiation/RRTMG/radsw_main.F90,Radiation/RRTMG/radsw_param.f + dependencies = MP/Thompson/module_mp_thompson.F90,photochem/module_ozphys.F90 ######################################################################## [ccpp-arg-table] @@ -509,6 +513,13 @@ dimensions = () type = integer intent = in +[ozphys] + standard_name = dataset_for_ozone_physics + long_name = dataset for NRL ozone physics + units = mixed + dimensions = () + type = ty_ozphys + intent = inout [con_pi] standard_name = pi long_name = ratio of a circle's circumference to its diameter diff --git a/physics/GFS_rrtmgp_cloud_mp.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_cloud_mp.F90 similarity index 98% rename from physics/GFS_rrtmgp_cloud_mp.F90 rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_cloud_mp.F90 index 32104b7f8..f61ea76c6 100644 --- a/physics/GFS_rrtmgp_cloud_mp.F90 +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_cloud_mp.F90 @@ -105,28 +105,31 @@ subroutine GFS_rrtmgp_cloud_mp_run(nCol, nLev, nTracers, ncnd, i_cldliq, i_cldic xlon, & ! Longitude xlat, & ! Latitude dx ! Characteristic grid lengthscale (m) - real(kind_phys), dimension(:,:), intent(in) :: & + real(kind_phys), dimension(:,:), intent(in), optional :: & tv_lay, & ! Virtual temperature (K) t_lay, & ! Temperature (K) qs_lay, & ! Saturation vapor pressure (Pa) q_lay, & ! water-vapor mixing ratio (kg/kg) relhum, & ! Relative humidity - p_lay, & ! Pressure at model-layers (Pa) - cnv_mixratio, & ! Convective cloud mixing-ratio (kg/kg) + p_lay ! Pressure at model-layers (Pa) + real(kind_phys), dimension(:,:), intent(in) :: & + cnv_mixratio ! Convective cloud mixing-ratio (kg/kg) + real(kind_phys), dimension(:,:), intent(in), optional :: & qci_conv, & ! Convective cloud condesate after rainout (kg/kg) deltaZ, & ! Layer-thickness (m) deltaZc, & ! Layer-thickness, from layer centers (m) deltaP, & ! Layer-thickness (Pa) qc_mynn, & ! - qi_mynn, & ! + qi_mynn ! + real(kind_phys), dimension(:,:), intent(in), optional :: & cld_pbl_frac ! - real(kind_phys), dimension(:,:), intent(inout) :: & + real(kind_phys), dimension(:,:), intent(inout), optional :: & effrin_cldliq, & ! Effective radius for stratiform liquid cloud-particles (microns) effrin_cldice, & ! Effective radius for stratiform ice cloud-particles (microns) effrin_cldsnow ! Effective radius for stratiform snow cloud-particles (microns) - real(kind_phys), dimension(:,:), intent(in) :: & + real(kind_phys), dimension(:,:), intent(in), optional :: & effrin_cldrain ! Effective radius for stratiform rain cloud-particles (microns) - real(kind_phys), dimension(:,:), intent(in) :: & + real(kind_phys), dimension(:,:), intent(in), optional :: & p_lev ! Pressure at model-level interfaces (Pa) real(kind_phys), dimension(:,:,:),intent(in) :: & tracer ! Cloud condensate amount in layer by type () @@ -148,7 +151,8 @@ subroutine GFS_rrtmgp_cloud_mp_run(nCol, nLev, nTracers, ncnd, i_cldliq, i_cldic cld_swp, & ! Water path for snow hydrometeors cld_resnow, & ! Effective radius for snow hydrometeors cld_rwp, & ! Water path for rain hydrometeors - cld_rerain, & ! Effective radius for rain hydrometeors + cld_rerain ! Effective radius for rain hydrometeors + real(kind_phys), dimension(:,:),intent(inout), optional :: & precip_frac, & ! Precipitation fraction cld_cnv_frac, & ! Cloud-fraction for convective clouds cld_cnv_lwp, & ! Water path for convective liquid cloud-particles @@ -569,7 +573,7 @@ subroutine cloud_mp_uni(nCol, nLev, nTracers, ncnd, i_cldliq, i_cldice, i_cldrai effrin_cldliq, & ! Effective radius for liquid cloud-particles (microns) effrin_cldice, & ! Effective radius for ice cloud-particles (microns) effrin_cldsnow ! Effective radius for snow cloud-particles (microns) - real(kind_phys), dimension(:,:), intent(in) ,optional :: & + real(kind_phys), dimension(:,:), intent(in), optional :: & effrin_cldrain ! Effective radius for rain cloud-particles (microns) real(kind_phys), dimension(:,:), intent(in) :: & p_lev ! Pressure at model-level interfaces (Pa) @@ -875,17 +879,12 @@ subroutine cmp_reff_Thompson(nLev, nCol, i_cldliq, i_cldice, i_cldsnow, i_cldice qi_mp(iCol,iLay) = tracer(iCol,iLay,i_cldice) / (1.-q_lay(iCol,iLay)) qs_mp(iCol,iLay) = tracer(iCol,iLay,i_cldsnow) / (1.-q_lay(iCol,iLay)) ni_mp(iCol,iLay) = tracer(iCol,iLay,i_cldice_nc) / (1.-q_lay(iCol,iLay)) - if (ltaerosol) then + if (ltaerosol .or. mraerosol) then nc_mp(iCol,iLay) = tracer(iCol,iLay,i_cldliq_nc) / (1.-q_lay(iCol,iLay)) nwfa(iCol,iLay) = tracer(iCol,iLay,i_twa) if (qc_mp(iCol,iLay) > 1.e-12 .and. nc_mp(iCol,iLay) < 100.) then nc_mp(iCol,iLay) = make_DropletNumber(qc_mp(iCol,iLay)*rho, nwfa(iCol,iLay)*rho) * orho endif - elseif (mraerosol) then - nc_mp(iCol,iLay) = tracer(iCol,iLay,i_cldliq_nc) / (1.-q_lay(iCol,iLay)) - if (qc_mp(iCol,iLay) > 1.e-12 .and. nc_mp(iCol,iLay) < 100.) then - nc_mp(iCol,iLay) = make_DropletNumber(qc_mp(iCol,iLay)*rho, nwfa(iCol,iLay)*rho) * orho - endif else if (nint(lsmask(iCol)) == 1) then !land nc_mp(iCol,iLay) = nt_c_l*orho diff --git a/physics/GFS_rrtmgp_cloud_mp.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_cloud_mp.meta similarity index 96% rename from physics/GFS_rrtmgp_cloud_mp.meta rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_cloud_mp.meta index b782e73b4..a0fb78333 100644 --- a/physics/GFS_rrtmgp_cloud_mp.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_cloud_mp.meta @@ -1,7 +1,10 @@ [ccpp-table-properties] name = GFS_rrtmgp_cloud_mp type = scheme - dependencies = radiation_tools.F90, radiation_clouds.f, module_mp_thompson_make_number_concentrations.F90, module_mp_thompson.F90, rrtmgp_lw_cloud_optics.F90 + relative_path = ../../ + dependencies = hooks/machine.F + dependencies = Radiation/radiation_tools.F90,Radiation/radiation_clouds.f,Radiation/RRTMGP/rrtmgp_lw_cloud_optics.F90 + dependencies = MP/Thompson/module_mp_thompson_make_number_concentrations.F90,MP/Thompson/module_mp_thompson.F90 ######################################################################## [ccpp-arg-table] @@ -264,6 +267,7 @@ type = real kind = kind_phys intent = in + optional = True [p_lay] standard_name = air_pressure_at_layer_for_RRTMGP long_name = air pressure at vertical layer for radiation calculation @@ -272,6 +276,7 @@ type = real kind = kind_phys intent = in + optional = True [tv_lay] standard_name = virtual_temperature long_name = layer virtual temperature @@ -280,6 +285,7 @@ type = real kind = kind_phys intent = in + optional = True [t_lay] standard_name = air_temperature_at_layer_for_RRTMGP long_name = air temperature at vertical layer for radiation calculation @@ -288,6 +294,7 @@ type = real kind = kind_phys intent = in + optional = True [qs_lay] standard_name = saturation_vapor_pressure long_name = saturation vapor pressure @@ -296,6 +303,7 @@ type = real kind = kind_phys intent = in + optional = True [q_lay] standard_name = water_vapor_mixing_ratio long_name = water vaport mixing ratio @@ -304,6 +312,7 @@ type = real kind = kind_phys intent = in + optional = True [relhum] standard_name = relative_humidity long_name = layer relative humidity @@ -312,6 +321,7 @@ type = real kind = kind_phys intent = in + optional = True [effrin_cldliq] standard_name = effective_radius_of_stratiform_cloud_liquid_water_particle long_name = eff. radius of cloud liquid water particle in micrometer @@ -320,6 +330,7 @@ type = real kind = kind_phys intent = inout + optional = True [effrin_cldice] standard_name = effective_radius_of_stratiform_cloud_ice_particle long_name = eff. radius of cloud ice water particle in micrometer @@ -328,6 +339,7 @@ type = real kind = kind_phys intent = inout + optional = True [effrin_cldrain] standard_name = effective_radius_of_stratiform_cloud_rain_particle long_name = effective radius of cloud rain particle in micrometers @@ -336,6 +348,7 @@ type = real kind = kind_phys intent = in + optional = True [effrin_cldsnow] standard_name = effective_radius_of_stratiform_cloud_snow_particle long_name = effective radius of cloud snow particle in micrometers @@ -344,6 +357,7 @@ type = real kind = kind_phys intent = inout + optional = True [tracer] standard_name = tracer_concentration long_name = model layer mean tracer concentration @@ -368,6 +382,7 @@ type = real kind = kind_phys intent = inout + optional = True [qci_conv] standard_name = convective_cloud_condesate_after_rainout long_name = convective cloud condesate after rainout @@ -376,6 +391,7 @@ type = real kind = kind_phys intent = in + optional = True [deltaZ] standard_name = layer_thickness long_name = layer_thickness @@ -384,6 +400,7 @@ type = real kind = kind_phys intent = in + optional = True [deltaZc] standard_name = layer_thickness_from_layer_center long_name = layer_thickness @@ -392,6 +409,7 @@ type = real kind = kind_phys intent = in + optional = True [deltaP] standard_name = layer_thickness_in_Pa long_name = layer_thickness_in_Pa @@ -400,6 +418,7 @@ type = real kind = kind_phys intent = in + optional = True [qc_mynn] standard_name = subgrid_scale_cloud_liquid_water_mixing_ratio long_name = subgrid cloud water mixing ratio from PBL scheme @@ -408,6 +427,7 @@ type = real kind = kind_phys intent = in + optional = True [qi_mynn] standard_name = subgrid_scale_cloud_ice_mixing_ratio long_name = subgrid cloud ice mixing ratio from PBL scheme @@ -416,6 +436,7 @@ type = real kind = kind_phys intent = in + optional = True [con_g] standard_name = gravitational_acceleration long_name = gravitational acceleration @@ -549,6 +570,7 @@ type = real kind = kind_phys intent = inout + optional = True [cld_cnv_lwp] standard_name = convective_cloud_liquid_water_path long_name = layer convective cloud liquid water path @@ -557,6 +579,7 @@ type = real kind = kind_phys intent = inout + optional = True [cld_cnv_iwp] standard_name = convective_cloud_ice_water_path long_name = layer convective cloud ice water path @@ -565,6 +588,7 @@ type = real kind = kind_phys intent = inout + optional = True [cld_cnv_reliq] standard_name = mean_effective_radius_for_liquid_convective_cloud long_name = mean effective radius for liquid convective cloud @@ -573,6 +597,7 @@ type = real kind = kind_phys intent = inout + optional = True [cld_cnv_reice] standard_name = mean_effective_radius_for_ice_convective_cloud long_name = mean effective radius for ice convective cloud @@ -581,6 +606,7 @@ type = real kind = kind_phys intent = inout + optional = True [cld_pbl_frac] standard_name = subgrid_scale_cloud_area_fraction_in_atmosphere_layer long_name = subgrid cloud fraction from PBL scheme @@ -589,6 +615,7 @@ type = real kind = kind_phys intent = in + optional = True [cld_pbl_lwp] standard_name = MYNN_SGS_cloud_liquid_water_path long_name = layer convective cloud liquid water path @@ -597,6 +624,7 @@ type = real kind = kind_phys intent = inout + optional = True [cld_pbl_iwp] standard_name = MYNN_SGS_cloud_ice_water_path long_name = layer convective cloud ice water path @@ -605,6 +633,7 @@ type = real kind = kind_phys intent = inout + optional = True [cld_pbl_reliq] standard_name = mean_effective_radius_for_liquid_MYNN_SGS_cloud long_name = mean effective radius for liquid MYNN_SGS cloud @@ -613,6 +642,7 @@ type = real kind = kind_phys intent = inout + optional = True [cld_pbl_reice] standard_name = mean_effective_radius_for_ice_MYNN_SGS_cloud long_name = mean effective radius for ice MYNN_SGS cloud @@ -621,6 +651,7 @@ type = real kind = kind_phys intent = inout + optional = True [lwp_ex] standard_name = liq_water_path_from_microphysics long_name = total liquid water path from explicit microphysics diff --git a/physics/GFS_rrtmgp_cloud_overlap.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_cloud_overlap.F90 similarity index 91% rename from physics/GFS_rrtmgp_cloud_overlap.F90 rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_cloud_overlap.F90 index 0094f8165..db660148e 100644 --- a/physics/GFS_rrtmgp_cloud_overlap.F90 +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_cloud_overlap.F90 @@ -30,7 +30,7 @@ module GFS_rrtmgp_cloud_overlap !! !! \section GFS_rrtmgp_cloud_overlap_run subroutine GFS_rrtmgp_cloud_overlap_run(nCol, nLev, yearlen, doSWrad, doLWrad, & - julian, lat, p_lev, p_lay, tv_lay, deltaZc, con_pi, con_g, con_rd, con_epsq, & + julian, lat, deltaZc, con_pi, con_g, con_rd, con_epsq, & dcorr_con, idcor, iovr, iovr_dcorr, iovr_exp, iovr_exprand, idcor_con, & idcor_hogan, idcor_oreopoulos, cld_frac, cld_cnv_frac, iovr_convcld, top_at_1, & imfdeepcnv, imfdeepcnv_gf, imfdeepcnv_samf, de_lgth, cloud_overlap_param, & @@ -67,19 +67,17 @@ subroutine GFS_rrtmgp_cloud_overlap_run(nCol, nLev, yearlen, doSWrad, doLWrad, dcorr_con ! Decorrelation-length (used if idcor = idcor_con) real(kind_phys), dimension(:), intent(in) :: & lat ! Latitude - real(kind_phys), dimension(:,:), intent(in) :: & - tv_lay, & ! Virtual temperature (K) - p_lay, & ! Pressure at model-layers (Pa) - cld_frac, & ! Total cloud fraction + real(kind_phys), dimension(:,:), intent(in) :: & + cld_frac ! Total cloud fraction + real(kind_phys), dimension(:,:), intent(in), optional :: & cld_cnv_frac ! Convective cloud-fraction - real(kind_phys), dimension(:,:), intent(in) :: & - p_lev, & ! Pressure at model-level interfaces (Pa) + real(kind_phys), dimension(:,:), intent(in), optional :: & deltaZc ! Layer thickness (from layer-centers)(m) ! Outputs real(kind_phys), dimension(:),intent(out) :: & de_lgth ! Decorrelation length - real(kind_phys), dimension(:,:),intent(out) :: & + real(kind_phys), dimension(:,:),intent(out), optional :: & cloud_overlap_param, & ! Cloud-overlap parameter cnv_cloud_overlap_param,& ! Convective cloud-overlap parameter precip_overlap_param ! Precipitation overlap parameter diff --git a/physics/GFS_rrtmgp_cloud_overlap.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_cloud_overlap.meta similarity index 89% rename from physics/GFS_rrtmgp_cloud_overlap.meta rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_cloud_overlap.meta index cf6a05217..3455087b5 100644 --- a/physics/GFS_rrtmgp_cloud_overlap.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_cloud_overlap.meta @@ -1,7 +1,9 @@ [ccpp-table-properties] name = GFS_rrtmgp_cloud_overlap type = scheme - dependencies = radiation_tools.F90, radiation_cloud_overlap.F90 + relative_path = ../../ + dependencies = hooks/machine.F + dependencies = Radiation/radiation_tools.F90,Radiation/radiation_cloud_overlap.F90 ######################################################################## [ccpp-arg-table] @@ -58,30 +60,6 @@ type = real intent = in kind = kind_phys -[p_lev] - standard_name = air_pressure_at_interface_for_RRTMGP - long_name = air pressure at vertical interface for radiation calculation - units = Pa - dimensions = (horizontal_loop_extent,vertical_interface_dimension) - type = real - kind = kind_phys - intent = in -[p_lay] - standard_name = air_pressure_at_layer_for_RRTMGP - long_name = air pressure at vertical layer for radiation calculation - units = Pa - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = in -[tv_lay] - standard_name = virtual_temperature - long_name = layer virtual temperature - units = K - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = in [deltaZc] standard_name = layer_thickness_from_layer_center long_name = layer_thickness @@ -90,6 +68,7 @@ type = real kind = kind_phys intent = in + optional = True [con_pi] standard_name = pi long_name = ratio of a circle's circumference to its diameter @@ -209,6 +188,7 @@ type = real kind = kind_phys intent = in + optional = True [top_at_1] standard_name = flag_for_vertical_ordering_in_radiation long_name = flag for vertical ordering in radiation @@ -253,6 +233,7 @@ type = real kind = kind_phys intent = out + optional = True [precip_overlap_param] standard_name = precip_overlap_param long_name = precipitation overlap parameter @@ -261,6 +242,7 @@ type = real kind = kind_phys intent = out + optional = True [cnv_cloud_overlap_param] standard_name = convective_cloud_overlap_param long_name = convective cloud overlap parameter @@ -269,6 +251,7 @@ type = real kind = kind_phys intent = out + optional = True [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/GFS_rrtmgp_post.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_post.F90 similarity index 99% rename from physics/GFS_rrtmgp_post.F90 rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_post.F90 index 22fe2fc21..34dc7de86 100644 --- a/physics/GFS_rrtmgp_post.F90 +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_post.F90 @@ -71,7 +71,7 @@ subroutine GFS_rrtmgp_post_run (nCol, nLev, nDay, iSFC, iTOA, idxday, doLWrad, d sfc_alb_nir_dif, & ! Surface albedo (diffuse) sfc_alb_uvvis_dir, & ! Surface albedo (direct) sfc_alb_uvvis_dif ! Surface albedo (diffuse) - real(kind_phys), dimension(:,:), intent(in) :: & + real(kind_phys), dimension(:,:), intent(in), optional :: & p_lev, & ! Pressure @ model layer-interfaces (Pa) fluxlwUP_allsky, & ! RRTMGP longwave all-sky flux (W/m2) fluxlwDOWN_allsky, & ! RRTMGP longwave all-sky flux (W/m2) @@ -118,7 +118,8 @@ subroutine GFS_rrtmgp_post_run (nCol, nLev, nDay, iSFC, iTOA, idxday, doLWrad, d sfcdsw ! SW sfc all-sky downward flux (W/m2) real(kind_phys), dimension(:,:), intent(inout) :: & htrlw, & ! LW all-sky heating rate (K/s) - htrsw, & ! SW all-sky heating rate (K/s) + htrsw ! SW all-sky heating rate (K/s) + real(kind_phys), dimension(:,:), intent(inout), optional :: & htrlwu ! LW all-sky heating-rate updated in-between radiation calls. type(sfcflw_type), dimension(:), intent(inout) :: & sfcflw ! LW radiation fluxes at sfc diff --git a/physics/GFS_rrtmgp_post.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_post.meta similarity index 97% rename from physics/GFS_rrtmgp_post.meta rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_post.meta index e4bc3e5dc..5d67afcd8 100644 --- a/physics/GFS_rrtmgp_post.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_post.meta @@ -1,7 +1,9 @@ [ccpp-table-properties] name = GFS_rrtmgp_post type = scheme - dependencies = iounitdef.f,machine.F,radiation_aerosols.f,radlw_param.f,radiation_tools.F90,rte-rrtmgp/extensions/mo_heating_rates.F90 + relative_path = ../../ + dependencies = hooks/machine.F,Radiation/radiation_aerosols.f + dependencies = Radiation/RRTMG/radlw_param.f,Radiation/radiation_tools.F90,Radiation/RRTMGP/rte-rrtmgp/extensions/mo_heating_rates.F90 ######################################################################## [ccpp-arg-table] @@ -164,6 +166,7 @@ type = real kind = kind_phys intent = in + optional = True [fluxlwUP_allsky] standard_name = RRTMGP_lw_flux_profile_upward_allsky long_name = RRTMGP upward longwave all-sky flux profile @@ -172,6 +175,7 @@ type = real kind = kind_phys intent = in + optional = True [fluxlwDOWN_allsky] standard_name = RRTMGP_lw_flux_profile_downward_allsky long_name = RRTMGP downward longwave all-sky flux profile @@ -180,6 +184,7 @@ type = real kind = kind_phys intent = in + optional = True [fluxlwUP_clrsky] standard_name = RRTMGP_lw_flux_profile_upward_clrsky long_name = RRTMGP upward longwave clr-sky flux profile @@ -188,6 +193,7 @@ type = real kind = kind_phys intent = in + optional = True [fluxlwDOWN_clrsky] standard_name = RRTMGP_lw_flux_profile_downward_clrsky long_name = RRTMGP downward longwave clr-sky flux profile @@ -196,6 +202,7 @@ type = real kind = kind_phys intent = in + optional = True [fluxswUP_allsky] standard_name = RRTMGP_sw_flux_profile_upward_allsky long_name = RRTMGP upward shortwave all-sky flux profile @@ -204,6 +211,7 @@ type = real kind = kind_phys intent = in + optional = True [fluxswDOWN_allsky] standard_name = RRTMGP_sw_flux_profile_downward_allsky long_name = RRTMGP downward shortwave all-sky flux profile @@ -212,6 +220,7 @@ type = real kind = kind_phys intent = in + optional = True [fluxswUP_clrsky] standard_name = RRTMGP_sw_flux_profile_upward_clrsky long_name = RRTMGP upward shortwave clr-sky flux profile @@ -220,6 +229,7 @@ type = real kind = kind_phys intent = in + optional = True [fluxswDOWN_clrsky] standard_name = RRTMGP_sw_flux_profile_downward_clrsky long_name = RRTMGP downward shortwave clr-sky flux profile @@ -228,6 +238,7 @@ type = real kind = kind_phys intent = in + optional = True [raddt] standard_name = time_step_for_radiation long_name = radiation time step @@ -352,6 +363,7 @@ type = real kind = kind_phys intent = inout + optional = True [topflw] standard_name = lw_fluxes_top_atmosphere long_name = lw radiation fluxes at top diff --git a/physics/GFS_rrtmgp_pre.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_pre.F90 similarity index 97% rename from physics/GFS_rrtmgp_pre.F90 rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_pre.F90 index 009eb8c38..ba5e2ad58 100644 --- a/physics/GFS_rrtmgp_pre.F90 +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_pre.F90 @@ -8,7 +8,8 @@ module GFS_rrtmgp_pre use machine, only: kind_phys use funcphys, only: fpvs use module_radiation_astronomy, only: coszmn - use module_radiation_gases, only: NF_VGAS, getgases, getozn + use module_radiation_gases, only: NF_VGAS, getgases + use module_ozphys, only: ty_ozphys use mo_gas_concentrations, only: ty_gas_concs use radiation_tools, only: check_error_msg,cmp_tlev use rrtmgp_lw_gas_optics, only: lw_gas_props @@ -47,7 +48,7 @@ subroutine GFS_rrtmgp_pre_init(nGases, active_gases, active_gases_array, errmsg, nGases ! Number of active gases in RRTMGP character(len=*), intent(in) :: & active_gases ! List of active gases from namelist - character(len=*), dimension(:), intent(out) :: & + character(len=*), dimension(:), intent(out), optional :: & active_gases_array ! List of active gases from namelist as array ! Outputs @@ -117,15 +118,17 @@ subroutine GFS_rrtmgp_pre_run(me, nCol, nLev, i_o3, doSWrad, doLWrad, fhswr, fhl vmr_n2o, vmr_co2, tsfg, tsfa, qs_lay, q_lay, tv_lay, & relhum, deltaZ, deltaZc, deltaP, active_gases_array, & tsfc_radtime, coszen, coszdg, top_at_1, iSFC, iTOA, nDay, idxday, semis, & - sfc_emiss_byband, ico2, con_pi, errmsg, errflg) + sfc_emiss_byband, ico2, ozphys, con_pi, errmsg, errflg) - ! Inputs + ! Inputs integer, intent(in) :: & me, & ! MPI rank nCol, & ! Number of horizontal grid points nLev, & ! Number of vertical layers ico2, & ! Flag for co2 radiation scheme i_o3 ! Index into tracer array for ozone + type(ty_ozphys),intent(in) :: & + ozphys logical, intent(in) :: & doSWrad, & ! Call SW radiation? doLWrad ! Call LW radiation @@ -155,7 +158,7 @@ subroutine GFS_rrtmgp_pre_run(me, nCol, nLev, i_o3, doSWrad, doLWrad, fhswr, fhl prsi ! Pressure at model-interfaces (Pa) real(kind_phys), dimension(:,:,:), intent(in) :: & qgrs ! Tracer concentrations (kg/kg) - character(len=*), dimension(:), intent(in) :: & + character(len=*), dimension(:), intent(in), optional :: & active_gases_array ! List of active gases from namelist as array ! Outputs @@ -179,7 +182,7 @@ subroutine GFS_rrtmgp_pre_run(me, nCol, nLev, i_o3, doSWrad, doLWrad, fhswr, fhl coszdg ! Cosine of SZA, daytime integer, dimension(:), intent(inout) :: & idxday ! Indices for daylit points - real(kind_phys), dimension(:,:), intent(inout) :: & + real(kind_phys), dimension(:,:), intent(inout), optional :: & p_lay, & ! Pressure at model-layer t_lay, & ! Temperature at model layer q_lay, & ! Water-vapor mixing ratio (kg/kg) @@ -349,8 +352,8 @@ subroutine GFS_rrtmgp_pre_run(me, nCol, nLev, i_o3, doSWrad, doLWrad, fhswr, fhl enddo enddo ! OR Use climatological ozone data - else - call getozn (prslk(1:NCOL,:), xlat, nCol, nLev, top_at_1, o3_lay) + else + call ozphys%run_o3clim(xlat, prslk, con_pi, o3_lay) endif ! ####################################################################################### diff --git a/physics/GFS_rrtmgp_pre.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_pre.meta similarity index 94% rename from physics/GFS_rrtmgp_pre.meta rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_pre.meta index abb07b825..7af8e04d5 100644 --- a/physics/GFS_rrtmgp_pre.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_pre.meta @@ -1,8 +1,9 @@ [ccpp-table-properties] name = GFS_rrtmgp_pre type = scheme - dependencies = funcphys.f90,iounitdef.f,machine.F,module_bfmicrophysics.f,physcons.F90,radcons.f90,radiation_aerosols.f - dependencies = radiation_astronomy.f,radiation_gases.f,radiation_tools.F90,rrtmg_lw_cloud_optics.F90 + relative_path = ../../ + dependencies = tools/funcphys.f90,hooks/machine.F,Radiation/radiation_aerosols.f,photochem/module_ozphys.F90 + dependencies = Radiation/radiation_astronomy.f,Radiation/radiation_gases.f,Radiation/radiation_tools.F90 ######################################################################## [ccpp-arg-table] @@ -31,6 +32,7 @@ type = character kind = len=128 intent = out + optional = True [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP @@ -276,6 +278,7 @@ type = real kind = kind_phys intent = inout + optional = True [p_lev] standard_name = air_pressure_at_interface_for_RRTMGP long_name = air pressure at vertical interface for radiation calculation @@ -284,6 +287,7 @@ type = real kind = kind_phys intent = inout + optional = True [t_lay] standard_name = air_temperature_at_layer_for_RRTMGP long_name = air temperature at vertical layer for radiation calculation @@ -292,6 +296,7 @@ type = real kind = kind_phys intent = inout + optional = True [t_lev] standard_name = air_temperature_at_interface_for_RRTMGP long_name = air temperature at vertical interface for radiation calculation @@ -300,6 +305,7 @@ type = real kind = kind_phys intent = inout + optional = True [deltaZ] standard_name = layer_thickness long_name = layer_thickness @@ -308,6 +314,7 @@ type = real kind = kind_phys intent = inout + optional = True [deltaZc] standard_name = layer_thickness_from_layer_center long_name = layer_thickness @@ -316,6 +323,7 @@ type = real kind = kind_phys intent = inout + optional = True [deltaP] standard_name = layer_thickness_in_Pa long_name = layer_thickness_in_Pa @@ -324,6 +332,7 @@ type = real kind = kind_phys intent = inout + optional = True [top_at_1] standard_name = flag_for_vertical_ordering_in_radiation long_name = flag for vertical ordering in radiation @@ -353,6 +362,7 @@ type = real kind = kind_phys intent = inout + optional = True [tsfg] standard_name = surface_ground_temperature_for_radiation long_name = surface ground temperature for radiation @@ -377,6 +387,7 @@ type = real kind = kind_phys intent = inout + optional = True [relhum] standard_name = relative_humidity long_name = layer relative humidity @@ -385,6 +396,7 @@ type = real kind = kind_phys intent = inout + optional = True [qs_lay] standard_name = saturation_vapor_pressure long_name = saturation vapor pressure @@ -393,6 +405,7 @@ type = real kind = kind_phys intent = inout + optional = True [q_lay] standard_name = water_vapor_mixing_ratio long_name = water vaport mixing ratio @@ -401,6 +414,7 @@ type = real kind = kind_phys intent = inout + optional = True [vmr_o2] standard_name = volume_mixing_ratio_for_o2 long_name = molar mixing ratio of o2 in with respect to dry air @@ -409,6 +423,7 @@ type = real kind = kind_phys intent = inout + optional = True [vmr_h2o] standard_name = volume_mixing_ratio_for_h2o long_name = molar mixing ratio of h2o in with respect to dry air @@ -417,6 +432,7 @@ type = real kind = kind_phys intent = inout + optional = True [vmr_o3] standard_name = volume_mixing_ratio_for_o3 long_name = molar mixing ratio of o3 in with respect to dry air @@ -425,6 +441,7 @@ type = real kind = kind_phys intent = inout + optional = True [vmr_ch4] standard_name = volume_mixing_ratio_for_ch4 long_name = molar mixing ratio of ch4 in with respect to dry air @@ -433,6 +450,7 @@ type = real kind = kind_phys intent = inout + optional = True [vmr_n2o] standard_name = volume_mixing_ratio_for_n2o long_name = molar mixing ratio of n2o in with respect to dry air @@ -441,6 +459,7 @@ type = real kind = kind_phys intent = inout + optional = True [vmr_co2] standard_name = volume_mixing_ratio_for_co2 long_name = molar mixing ratio of co2 in with respect to dry air @@ -449,6 +468,7 @@ type = real kind = kind_phys intent = inout + optional = True [active_gases_array] standard_name = list_of_active_gases_used_by_RRTMGP long_name = list of active gases used by RRTMGP @@ -457,6 +477,7 @@ type = character kind = len=* intent = in + optional = True [coszdg] standard_name = cosine_of_solar_zenith_angle_on_radiation_timestep long_name = daytime mean cosz over rad call period @@ -489,6 +510,7 @@ type = real kind = kind_phys intent = inout + optional = True [nday] standard_name = daytime_points_dimension long_name = daytime points dimension @@ -503,6 +525,13 @@ dimensions = (horizontal_loop_extent) type = integer intent = inout +[ozphys] + standard_name = dataset_for_ozone_physics + long_name = dataset for NRL ozone physics + units = mixed + dimensions = () + type = ty_ozphys + intent = in [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/GFS_rrtmgp_setup.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_setup.F90 similarity index 91% rename from physics/GFS_rrtmgp_setup.F90 rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_setup.F90 index 76db14279..9f2b2a9f9 100644 --- a/physics/GFS_rrtmgp_setup.F90 +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_setup.F90 @@ -6,6 +6,7 @@ module GFS_rrtmgp_setup use module_radiation_astronomy, only : sol_init, sol_update use module_radiation_aerosols, only : aer_init, aer_update use module_radiation_gases, only : gas_init, gas_update + use module_ozphys, only : ty_ozphys implicit none public GFS_rrtmgp_setup_init, GFS_rrtmgp_setup_timestep_init, GFS_rrtmgp_setup_finalize @@ -37,9 +38,10 @@ module GFS_rrtmgp_setup subroutine GFS_rrtmgp_setup_init(do_RRTMGP, imp_physics, imp_physics_fer_hires, & imp_physics_gfdl, imp_physics_thompson, imp_physics_wsm6, imp_physics_zhao_carr, & imp_physics_zhao_carr_pdf, imp_physics_mg, si, levr, ictm, isol, ico2, iaer, & - ntcw, ntoz, iovr, isubc_sw, isubc_lw, lalw1bd, idate, me, aeros_file, & - iaermdl, iaerflg, con_pi, con_t0c, con_c, con_boltz, con_plnk, solar_file, & - con_solr_2008, con_solr_2002, co2usr_file, co2cyc_file, ipsd0, errmsg, errflg) + ntcw, ntoz, iovr, isubc_sw, isubc_lw, lalw1bd, idate, & + me, aeros_file, iaermdl, iaerflg, con_pi, con_t0c, con_c, con_boltz, con_plnk, & + solar_file, con_solr_2008, con_solr_2002, co2usr_file, co2cyc_file, ipsd0, & + errmsg, errflg) ! Inputs logical, intent(in) :: do_RRTMGP @@ -56,9 +58,7 @@ subroutine GFS_rrtmgp_setup_init(do_RRTMGP, imp_physics, imp_physics_fer_hires, con_pi, con_t0c, con_c, con_boltz, con_plnk, con_solr_2008, con_solr_2002 real(kind_phys), dimension(:), intent(in) :: & si - integer, intent(in) :: levr, ictm, isol, ico2, iaer, & - ntcw, ntoz, iovr, isubc_sw, isubc_lw, & - me + integer, intent(in) :: levr, ictm, isol, ico2, iaer, ntcw, ntoz, iovr, isubc_sw, isubc_lw, me logical, intent(in) :: & lalw1bd integer, intent(in), dimension(:) :: & @@ -129,7 +129,7 @@ subroutine GFS_rrtmgp_setup_init(do_RRTMGP, imp_physics, imp_physics_fer_hires, call sol_init ( me, isol, solar_file, con_solr_2008, con_solr_2002, con_pi ) call aer_init ( levr, me, iaermdl, iaerflg, lalw1bd, aeros_file, con_pi, con_t0c, & con_c, con_boltz, con_plnk, errflg, errmsg) - call gas_init ( me, co2usr_file, co2cyc_file, ico2, ictm, ntoz, con_pi, errflg, errmsg ) + call gas_init ( me, co2usr_file, co2cyc_file, ico2, ictm, con_pi, errflg, errmsg ) if ( me == 0 ) then print *,' return from rad_initialize (GFS_rrtmgp_setup_init) - after calling radinit' @@ -148,7 +148,7 @@ end subroutine GFS_rrtmgp_setup_init !! subroutine GFS_rrtmgp_setup_timestep_init (idate, jdate, deltsw, deltim, doSWrad, me, & iaermdl, aeros_file, isol, slag, sdec, cdec, solcon, con_pi, co2dat_file, & - co2gbl_file, ictm, ico2, ntoz, errmsg, errflg) + co2gbl_file, ictm, ico2, ntoz, ozphys, errmsg, errflg) ! Inputs integer, intent(in) :: idate(:) @@ -160,7 +160,7 @@ subroutine GFS_rrtmgp_setup_timestep_init (idate, jdate, deltsw, deltim, doSWrad integer, intent(in) :: me integer, intent(in) :: iaermdl,isol,ictm,ico2,ntoz character(len=26), intent(in) :: aeros_file,co2dat_file,co2gbl_file - + type(ty_ozphys),intent(inout) :: ozphys ! Outputs real(kind_phys), intent(out) :: slag real(kind_phys), intent(out) :: sdec @@ -240,8 +240,11 @@ subroutine GFS_rrtmgp_setup_timestep_init (idate, jdate, deltsw, deltim, doSWrad else lco2_chg = .false. endif - call gas_update (kyear, kmon, kday, khour, loz1st, lco2_chg, me, co2dat_file, & - co2gbl_file, ictm, ico2, ntoz, errflg, errmsg ) + call gas_update (kyear, kmon, kday, khour, lco2_chg, me, co2dat_file, co2gbl_file, ictm,& + ico2, errflg, errmsg ) + if (ntoz == 0) then + call ozphys%update_o3clim(kmon, kday, khour, loz1st) + endif if ( loz1st ) loz1st = .false. diff --git a/physics/GFS_rrtmgp_setup.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_setup.meta similarity index 96% rename from physics/GFS_rrtmgp_setup.meta rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_setup.meta index c4f7cfaa5..fecb716ed 100644 --- a/physics/GFS_rrtmgp_setup.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_setup.meta @@ -1,8 +1,10 @@ [ccpp-table-properties] name = GFS_rrtmgp_setup type = scheme - dependencies = iounitdef.f,machine.F,module_bfmicrophysics.f,radiation_aerosols.f,radiation_astronomy.f - dependencies = module_mp_thompson.F90,radiation_gases.f + relative_path = ../../ + dependencies = hooks/machine.F,MP/Thompson/module_mp_thompson.F90 + dependencies = Radiation/radiation_aerosols.f,photochem/module_ozphys.F90 + dependencies = Radiation/radiation_gases.f,Radiation/radiation_astronomy.f ######################################################################## [ccpp-arg-table] @@ -389,6 +391,13 @@ dimensions = () type = integer intent = in +[ozphys] + standard_name = dataset_for_ozone_physics + long_name = dataset for NRL ozone physics + units = mixed + dimensions = () + type = ty_ozphys + intent = inout [iaermdl] standard_name = control_for_aerosol_radiation_scheme long_name = control of aerosol scheme in radiation diff --git a/physics/GFS_stochastics.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_stochastics.F90 similarity index 95% rename from physics/GFS_stochastics.F90 rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_stochastics.F90 index 36ed2815a..2fb1b185d 100644 --- a/physics/GFS_stochastics.F90 +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_stochastics.F90 @@ -89,12 +89,12 @@ subroutine GFS_stochastics_run (im, km, kdt, delt, do_sppt, pert_mp, use_zmtnblc logical, intent(in) :: do_skeb real(kind_phys), dimension(:), intent(in) :: zmtnblck ! sppt_wts only allocated if do_sppt == .true. - real(kind_phys), dimension(:,:), intent(inout) :: sppt_wts + real(kind_phys), dimension(:,:), intent(inout), optional :: sppt_wts ! skebu_wts, skebv_wts only allocated if do_skeb == .true. - real(kind_phys), dimension(:,:), intent(in) :: skebu_wts - real(kind_phys), dimension(:,:), intent(in) :: skebv_wts + real(kind_phys), dimension(:,:), intent(in), optional :: skebu_wts + real(kind_phys), dimension(:,:), intent(in), optional :: skebv_wts ! shum_wts only allocated if do_shum == .true. - real(kind_phys), dimension(:,:), intent(in) :: shum_wts + real(kind_phys), dimension(:,:), intent(in), optional :: shum_wts real(kind_phys), dimension(:,:), intent(in) :: diss_est real(kind_phys), dimension(:,:), intent(in) :: ugrs real(kind_phys), dimension(:,:), intent(in) :: vgrs @@ -119,7 +119,7 @@ subroutine GFS_stochastics_run (im, km, kdt, delt, do_sppt, pert_mp, use_zmtnblc integer, intent(in) :: ntsw integer, intent(in) :: ntiw integer, intent(in) :: ntgl - real(kind_phys), dimension(:,:), intent(inout) :: dtdtnp + real(kind_phys), dimension(:,:), intent(inout), optional :: dtdtnp real(kind_phys), dimension(:), intent(in) :: rain real(kind_phys), dimension(:), intent(in) :: rainc real(kind_phys), dimension(:), intent(inout) :: tprcp @@ -130,14 +130,14 @@ subroutine GFS_stochastics_run (im, km, kdt, delt, do_sppt, pert_mp, use_zmtnblc logical, intent(in) :: cplflx logical, intent(in) :: cpllnd ! rain_cpl only allocated if cplflx == .true. or cplchm == .true. or cpllnd == .true. - real(kind_phys), dimension(:), intent(inout) :: rain_cpl + real(kind_phys), dimension(:), intent(inout), optional :: rain_cpl ! snow_cpl only allocated if cplflx == .true. or cplchm == .true. - real(kind_phys), dimension(:), intent(inout) :: snow_cpl + real(kind_phys), dimension(:), intent(inout), optional :: snow_cpl ! drain_cpl, dsnow_cpl only allocated if cplflx == .true. or cplchm == .true. - real(kind_phys), dimension(:), intent(in) :: drain_cpl - real(kind_phys), dimension(:), intent(in) :: dsnow_cpl + real(kind_phys), dimension(:), intent(in), optional :: drain_cpl + real(kind_phys), dimension(:), intent(in), optional :: dsnow_cpl real(kind_phys), dimension(:), intent(in) :: vfact_ca - real(kind_phys), dimension(:), intent(in) :: ca1 + real(kind_phys), dimension(:), intent(in), optional :: ca1 character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg diff --git a/physics/GFS_stochastics.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_stochastics.meta similarity index 98% rename from physics/GFS_stochastics.meta rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_stochastics.meta index 796f4ddf7..904030522 100644 --- a/physics/GFS_stochastics.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_stochastics.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = GFS_stochastics type = scheme - dependencies = machine.F + dependencies = ../../hooks/machine.F [ccpp-arg-table] name = GFS_stochastics_init @@ -148,6 +148,7 @@ type = real kind = kind_phys intent = in + optional = True [vfact_ca] standard_name = cellular_automata_vertical_weight long_name = vertical weight for ca @@ -172,6 +173,7 @@ type = real kind = kind_phys intent = inout + optional = True [skebu_wts] standard_name = skeb_x_wind_weights_from_coupled_process long_name = weights for stochastic skeb perturbation of x wind @@ -180,6 +182,7 @@ type = real kind = kind_phys intent = in + optional = True [skebv_wts] standard_name = skeb_y_wind_weights_from_coupled_process long_name = weights for stochastic skeb perturbation of y wind @@ -188,6 +191,7 @@ type = real kind = kind_phys intent = in + optional = True [shum_wts] standard_name = shum_weights_from_coupled_process long_name = weights for stochastic shum perturbation @@ -196,6 +200,7 @@ type = real kind = kind_phys intent = in + optional = True [diss_est] standard_name = dissipation_estimate_of_air_temperature_at_model_layers long_name = dissipation estimate model layer mean temperature @@ -316,6 +321,7 @@ type = real kind = kind_phys intent = inout + optional = True [gq0_cw] standard_name = cloud_liquid_water_mixing_ratio_of_new_state long_name = cloud condensed water mixing ratio updated by physics @@ -434,6 +440,7 @@ type = real kind = kind_phys intent = inout + optional = True [snow_cpl] standard_name = cumulative_lwe_thickness_of_snow_amount_for_coupling long_name = total snow precipitation @@ -442,6 +449,7 @@ type = real kind = kind_phys intent = inout + optional = True [drain_cpl] standard_name = tendency_of_lwe_thickness_of_rain_amount_on_dynamics_timestep_for_coupling long_name = change in rain_cpl (coupling_type) @@ -450,6 +458,7 @@ type = real kind = kind_phys intent = in + optional = True [dsnow_cpl] standard_name = tendency_of_lwe_thickness_of_snowfall_amount_on_dynamics_timestep_for_coupling long_name = change in show_cpl (coupling_type) @@ -458,6 +467,7 @@ type = real kind = kind_phys intent = in + optional = True [ntcw] standard_name = index_of_cloud_liquid_water_mixing_ratio_in_tracer_concentration_array long_name = tracer index for cloud condensate (or liquid water) diff --git a/physics/GFS_suite_interstitial_1.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_interstitial_1.F90 similarity index 100% rename from physics/GFS_suite_interstitial_1.F90 rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_interstitial_1.F90 diff --git a/physics/GFS_suite_interstitial_1.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_interstitial_1.meta similarity index 99% rename from physics/GFS_suite_interstitial_1.meta rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_interstitial_1.meta index a465ed320..295ffdf2e 100644 --- a/physics/GFS_suite_interstitial_1.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_interstitial_1.meta @@ -2,7 +2,7 @@ [ccpp-table-properties] name = GFS_suite_interstitial_1 type = scheme - dependencies = machine.F + dependencies = ../../hooks/machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/GFS_suite_interstitial_2.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_interstitial_2.F90 similarity index 97% rename from physics/GFS_suite_interstitial_2.F90 rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_interstitial_2.F90 index c72e5c7b2..923cee897 100644 --- a/physics/GFS_suite_interstitial_2.F90 +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_interstitial_2.F90 @@ -30,9 +30,10 @@ subroutine GFS_suite_interstitial_2_run (im, levs, lssav, ldiag3d, lsidea, flag_ logical, intent(in ), dimension(:) :: flag_cice real(kind=kind_phys), intent(in ), dimension(:) :: ctei_rm real(kind=kind_phys), intent(in ), dimension(:) :: xcosz, adjsfcdsw, adjsfcdlw, pgr, xmu, work1, work2 - real(kind=kind_phys), intent(in ), dimension(:) :: ulwsfc_cice + real(kind=kind_phys), intent(in ), dimension(:), optional :: ulwsfc_cice real(kind=kind_phys), intent(in ), dimension(:) :: cice - real(kind=kind_phys), intent(in ), dimension(:,:) :: htrsw, htrlw, htrlwu, tgrs, prsl, qgrs_water_vapor, qgrs_cloud_water, prslk + real(kind=kind_phys), intent(in ), dimension(:,:) :: htrsw, htrlw, tgrs, prsl, qgrs_water_vapor, qgrs_cloud_water, prslk + real(kind=kind_phys), intent(in ), dimension(:,:), optional :: htrlwu real(kind=kind_phys), intent(in ), dimension(:,:) :: prsi real(kind=kind_phys), intent(in ), dimension(:,:,:) :: lwhd integer, intent(inout), dimension(:) :: kinver diff --git a/physics/GFS_suite_interstitial_2.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_interstitial_2.meta similarity index 99% rename from physics/GFS_suite_interstitial_2.meta rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_interstitial_2.meta index 1f4300574..a1f1660ad 100644 --- a/physics/GFS_suite_interstitial_2.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_interstitial_2.meta @@ -2,7 +2,7 @@ [ccpp-table-properties] name = GFS_suite_interstitial_2 type = scheme - dependencies = machine.F + dependencies = ../../hooks/machine.F ######################################################################## [ccpp-arg-table] @@ -148,6 +148,7 @@ type = real kind = kind_phys intent = in + optional = True [lwhd] standard_name = tendency_of_air_temperature_due_to_integrated_dynamics_through_earths_atmosphere long_name = idea sky lw heating rates @@ -291,6 +292,7 @@ type = real kind = kind_phys intent = in + optional = True [adjsfculw] standard_name = surface_upwelling_longwave_flux long_name = surface upwelling longwave flux at current time @@ -355,6 +357,7 @@ type = real kind = kind_phys intent = inout + optional = True [dtidx] standard_name = cumulative_change_of_state_variables_outer_index long_name = index of state-variable and process in last dimension of diagnostic tendencies array AKA cumulative_change_index diff --git a/physics/GFS_suite_interstitial_3.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_interstitial_3.F90 similarity index 98% rename from physics/GFS_suite_interstitial_3.F90 rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_interstitial_3.F90 index 5ca20ffc1..bc99e7fff 100644 --- a/physics/GFS_suite_interstitial_3.F90 +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_interstitial_3.F90 @@ -54,8 +54,8 @@ subroutine GFS_suite_interstitial_3_run (otsptflag, & real(kind=kind_phys), intent(in ), dimension(:,:) :: gt0 real(kind=kind_phys), intent(in ), dimension(:,:,:) :: gq0 - real(kind=kind_phys), intent(inout ), dimension(:,:) :: sigmain - real(kind=kind_phys), intent(inout ), dimension(:,:) :: sigmaout,qmicro + real(kind=kind_phys), intent(inout ), dimension(:,:), optional :: sigmain + real(kind=kind_phys), intent(inout ), dimension(:,:), optional :: sigmaout, qmicro real(kind=kind_phys), intent(inout), dimension(:,:) :: rhc, save_qc ! save_qi is not allocated for Zhao-Carr MP real(kind=kind_phys), intent(inout), dimension(:,:) :: save_qi diff --git a/physics/GFS_suite_interstitial_3.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_interstitial_3.meta similarity index 99% rename from physics/GFS_suite_interstitial_3.meta rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_interstitial_3.meta index e8f9fe889..d1e9d4d50 100644 --- a/physics/GFS_suite_interstitial_3.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_interstitial_3.meta @@ -2,7 +2,7 @@ [ccpp-table-properties] name = GFS_suite_interstitial_3 type = scheme - dependencies = machine.F + dependencies = ../../hooks/machine.F ######################################################################## [ccpp-arg-table] @@ -244,6 +244,7 @@ type = real kind = kind_phys intent = inout + optional = True [sigmaout] standard_name = updraft_area_fraction_updated_by_physics long_name = convective updraft area fraction updated by physics @@ -252,6 +253,7 @@ type = real kind = kind_phys intent = inout + optional = True [qmicro] standard_name = instantaneous_tendency_of_specific_humidity_due_to_microphysics long_name = moisture tendency due to microphysics @@ -260,6 +262,7 @@ type = real kind = kind_phys intent = out + optional = True [imp_physics] standard_name = control_for_microphysics_scheme long_name = choice of microphysics scheme diff --git a/physics/GFS_suite_interstitial_4.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_interstitial_4.F90 similarity index 98% rename from physics/GFS_suite_interstitial_4.F90 rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_interstitial_4.F90 index cbabb991b..d1aadb731 100644 --- a/physics/GFS_suite_interstitial_4.F90 +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_interstitial_4.F90 @@ -37,7 +37,7 @@ subroutine GFS_suite_interstitial_4_run (im, levs, ltaerosol, tracers_total, ntr ! dtend and dtidx are only allocated if ldiag3d logical, intent(in) :: ldiag3d, qdiag3d - real(kind=kind_phys), dimension(:,:,:), intent(inout) :: dtend + real(kind=kind_phys), dimension(:,:,:), intent(inout), optional :: dtend integer, dimension(:,:), intent(in) :: dtidx integer, intent(in) :: index_of_process_conv_trans,ntk,ntke @@ -45,7 +45,8 @@ subroutine GFS_suite_interstitial_4_run (im, levs, ltaerosol, tracers_total, ntr real(kind=kind_phys), dimension(:,:,:), intent(inout) :: clw real(kind=kind_phys), dimension(:,:), intent(in) :: prsl real(kind=kind_phys), intent(in) :: con_rd, con_eps, nssl_cccn - real(kind=kind_phys), dimension(:,:), intent(in) :: nwfa, save_tcp + real(kind=kind_phys), dimension(:,:), intent(in), optional :: nwfa + real(kind=kind_phys), dimension(:,:), intent(in) :: save_tcp real(kind=kind_phys), dimension(:,:), intent(in) :: spechum character(len=*), intent( out) :: errmsg @@ -290,4 +291,4 @@ subroutine GFS_suite_interstitial_4_run (im, levs, ltaerosol, tracers_total, ntr end subroutine GFS_suite_interstitial_4_run - end module GFS_suite_interstitial_4 \ No newline at end of file + end module GFS_suite_interstitial_4 diff --git a/physics/GFS_suite_interstitial_4.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_interstitial_4.meta similarity index 98% rename from physics/GFS_suite_interstitial_4.meta rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_interstitial_4.meta index 92870d95f..c6a330ccb 100644 --- a/physics/GFS_suite_interstitial_4.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_interstitial_4.meta @@ -2,7 +2,9 @@ [ccpp-table-properties] name = GFS_suite_interstitial_4 type = scheme - dependencies = machine.F,module_mp_thompson_make_number_concentrations.F90 + relative_path = ../../ + dependencies = hooks/machine.F + dependencies = MP/Thompson/module_mp_thompson_make_number_concentrations.F90 ######################################################################## [ccpp-arg-table] @@ -309,6 +311,7 @@ type = real kind = kind_phys intent = in + optional = True [spechum] standard_name = specific_humidity long_name = water vapor specific humidity @@ -332,6 +335,7 @@ type = real kind = kind_phys intent = inout + optional = True [ntk] standard_name = index_for_turbulent_kinetic_energy_convective_transport_tracer long_name = index for turbulent kinetic energy in the convectively transported tracer array diff --git a/physics/GFS_suite_interstitial_5.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_interstitial_5.F90 similarity index 100% rename from physics/GFS_suite_interstitial_5.F90 rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_interstitial_5.F90 diff --git a/physics/GFS_suite_interstitial_5.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_interstitial_5.meta similarity index 98% rename from physics/GFS_suite_interstitial_5.meta rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_interstitial_5.meta index 9d32160a1..511137901 100644 --- a/physics/GFS_suite_interstitial_5.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_interstitial_5.meta @@ -2,7 +2,7 @@ [ccpp-table-properties] name = GFS_suite_interstitial_5 type = scheme - dependencies = machine.F + dependencies = ../../hooks/machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/GFS_suite_interstitial_phys_reset.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_interstitial_phys_reset.F90 similarity index 100% rename from physics/GFS_suite_interstitial_phys_reset.F90 rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_interstitial_phys_reset.F90 diff --git a/physics/GFS_suite_interstitial_phys_reset.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_interstitial_phys_reset.meta similarity index 96% rename from physics/GFS_suite_interstitial_phys_reset.meta rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_interstitial_phys_reset.meta index adebbc833..947a1950f 100644 --- a/physics/GFS_suite_interstitial_phys_reset.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_interstitial_phys_reset.meta @@ -2,7 +2,7 @@ [ccpp-table-properties] name = GFS_suite_interstitial_phys_reset type = scheme - dependencies = machine.F + dependencies = ../../hooks/machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/GFS_suite_interstitial_rad_reset.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_interstitial_rad_reset.F90 similarity index 100% rename from physics/GFS_suite_interstitial_rad_reset.F90 rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_interstitial_rad_reset.F90 diff --git a/physics/GFS_suite_interstitial_rad_reset.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_interstitial_rad_reset.meta similarity index 96% rename from physics/GFS_suite_interstitial_rad_reset.meta rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_interstitial_rad_reset.meta index 91fd8cba7..aaaff02f5 100644 --- a/physics/GFS_suite_interstitial_rad_reset.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_interstitial_rad_reset.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = GFS_suite_interstitial_rad_reset type = scheme - dependencies = machine.F + dependencies = ../../hooks/machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/GFS_suite_stateout_reset.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_stateout_reset.F90 similarity index 100% rename from physics/GFS_suite_stateout_reset.F90 rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_stateout_reset.F90 diff --git a/physics/GFS_suite_stateout_reset.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_stateout_reset.meta similarity index 98% rename from physics/GFS_suite_stateout_reset.meta rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_stateout_reset.meta index fa4111e6b..b84d10691 100644 --- a/physics/GFS_suite_stateout_reset.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_stateout_reset.meta @@ -2,7 +2,7 @@ [ccpp-table-properties] name = GFS_suite_stateout_reset type = scheme - dependencies = machine.F + dependencies = ../../hooks/machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_stateout_update.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_stateout_update.F90 new file mode 100644 index 000000000..c2f5266fd --- /dev/null +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_stateout_update.F90 @@ -0,0 +1,92 @@ +! ######################################################################################### +!> \file GFS_suite_stateout_update.f90 +!! Update the state variables due to process-split physics from accumulated tendencies +!! during that phase. +!! Update gas concentrations, if using prognostic photolysis schemes. +!! Also, set bounds on the mass-weighted rime factor when using Ferrier-Aligo microphysics. +! ######################################################################################### +module GFS_suite_stateout_update + use machine, only: kind_phys + use module_ozphys, only: ty_ozphys + implicit none +contains +! ######################################################################################### +!> \section arg_table_GFS_suite_stateout_update_run Argument Table +!! \htmlinclude GFS_suite_stateout_update_run.html +!! +! ######################################################################################### + subroutine GFS_suite_stateout_update_run (im, levs, ntrac, dtp, tgrs, ugrs, vgrs, qgrs, & + dudt, dvdt, dtdt, dqdt, gt0, gu0, gv0, gq0, oz0, ntiw, nqrimef, imp_physics, & + imp_physics_fer_hires, epsq, ozphys, oz_phys_2015, oz_phys_2006, con_1ovg, prsl, & + dp, ozpl, qdiag3d, do3_dt_prd, do3_dt_ozmx, do3_dt_temp, do3_dt_ohoz, errmsg, errflg) + + ! Inputs + integer, intent(in ) :: im + integer, intent(in ) :: levs + integer, intent(in ) :: ntrac + integer, intent(in ) :: imp_physics,imp_physics_fer_hires + integer, intent(in ) :: ntiw, nqrimef + real(kind=kind_phys), intent(in ) :: dtp, epsq, con_1ovg + real(kind=kind_phys), intent(in ), dimension(:,:) :: tgrs, ugrs, vgrs, prsl, dp + real(kind=kind_phys), intent(in ), dimension(:,:,:) :: qgrs, ozpl + real(kind=kind_phys), intent(in ), dimension(:,:) :: dudt, dvdt, dtdt + real(kind=kind_phys), intent(in ), dimension(:,:,:) :: dqdt + logical, intent(in) :: qdiag3d + logical, intent(in) :: oz_phys_2015 + logical, intent(in) :: oz_phys_2006 + type(ty_ozphys), intent(in) :: ozphys + + ! Outputs (optional) + real(kind=kind_phys), intent(inout), dimension(:,:), optional :: & + do3_dt_prd, & ! Physics tendency: production and loss effect + do3_dt_ozmx, & ! Physics tendency: ozone mixing ratio effect + do3_dt_temp, & ! Physics tendency: temperature effect + do3_dt_ohoz ! Physics tendency: overhead ozone effect + + ! Outputs + real(kind=kind_phys), intent(out), dimension(:,:) :: gt0, gu0, gv0, oz0 + real(kind=kind_phys), intent(out), dimension(:,:,:) :: gq0 + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! Locals + integer :: i, k + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + ! Update prognostic state varaibles using accumulated tendencies from "process-split" + ! section of GFS suite. + gt0(:,:) = tgrs(:,:) + dtdt(:,:) * dtp + gu0(:,:) = ugrs(:,:) + dudt(:,:) * dtp + gv0(:,:) = vgrs(:,:) + dvdt(:,:) * dtp + gq0(:,:,:) = qgrs(:,:,:) + dqdt(:,:,:) * dtp + + ! If using photolysis physics schemes, update (prognostic) gas concentrations using + ! updated state. + if (oz_phys_2015) then + call ozphys%run_o3prog_2015(con_1ovg, dtp, prsl, gt0, dp, ozpl, oz0, qdiag3d, & + do3_dt_prd, do3_dt_ozmx, do3_dt_temp, do3_dt_ohoz) + endif + if (oz_phys_2006) then + call ozphys%run_o3prog_2006(con_1ovg, dtp, prsl, gt0, dp, ozpl, oz0, qdiag3d, & + do3_dt_prd, do3_dt_ozmx, do3_dt_temp, do3_dt_ohoz) + endif + + ! If using Ferrier-Aligo microphysics, set bounds on the mass-weighted rime factor. + if (imp_physics == imp_physics_fer_hires) then + do k=1,levs + do i=1,im + if(gq0(i,k,ntiw) > epsq) then + gq0(i,k,nqrimef) = max(1., gq0(i,k,nqrimef)/gq0(i,k,ntiw)) + else + gq0(i,k,nqrimef) = 1. + end if + end do + end do + end if + + end subroutine GFS_suite_stateout_update_run + +end module GFS_suite_stateout_update diff --git a/physics/GFS_suite_stateout_update.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_stateout_update.meta similarity index 62% rename from physics/GFS_suite_stateout_update.meta rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_stateout_update.meta index 580482b71..f2f5d2281 100644 --- a/physics/GFS_suite_stateout_update.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_stateout_update.meta @@ -2,7 +2,7 @@ [ccpp-table-properties] name = GFS_suite_stateout_update type = scheme - dependencies = machine.F + dependencies = ../../hooks/machine.F,../../photochem/module_ozphys.F90 ######################################################################## [ccpp-arg-table] @@ -37,6 +37,34 @@ type = real kind = kind_phys intent = in +[ozphys] + standard_name = dataset_for_ozone_physics + long_name = dataset for NRL ozone physics + units = mixed + dimensions = () + type = ty_ozphys + intent = in +[qdiag3d] + standard_name = flag_for_tracer_diagnostics_3D + long_name = flag for 3d tracer diagnostic fields + units = flag + dimensions = () + type = logical + intent = in +[oz_phys_2015] + standard_name = flag_for_nrl_2015_ozone_scheme + long_name = flag for new (2015) ozone physics + units = flag + dimensions = () + type = logical + intent = in +[oz_phys_2006] + standard_name = flag_for_nrl_2006_ozone_scheme + long_name = flag for new (2006) ozone physics + units = flag + dimensions = () + type = logical + intent = in [tgrs] standard_name = air_temperature long_name = model layer mean temperature @@ -133,6 +161,14 @@ type = real kind = kind_phys intent = out +[oz0] + standard_name = ozone_concentration_of_new_state + long_name = ozone concentration updated by physics + units = kg kg-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout [ntiw] standard_name = index_of_cloud_ice_mixing_ratio_in_tracer_concentration_array long_name = tracer index for ice water @@ -169,6 +205,74 @@ type = real kind = kind_phys intent = in +[con_1ovg] + standard_name = one_divided_by_the_gravitational_acceleration + long_name = inverse of gravitational acceleration + units = s2 m-1 + dimensions = () + type = real + kind = kind_phys + intent = in +[prsl] + standard_name = air_pressure + long_name = mid-layer pressure + units = Pa + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = in +[ozpl] + standard_name = ozone_forcing + long_name = ozone forcing data + units = mixed + dimensions = (horizontal_loop_extent,vertical_dimension_of_ozone_forcing_data,number_of_coefficients_in_ozone_data) + type = real + kind = kind_phys + intent = in +[dp] + standard_name = air_pressure_difference_between_midlayers + long_name = difference between mid-layer pressures + units = Pa + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = in +[do3_dt_prd] + standard_name = ozone_tendency_due_to_production_and_loss_rate + long_name = ozone tendency due to production and loss rate + units = kg kg-1 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout + optional = True +[do3_dt_ozmx] + standard_name = ozone_tendency_due_to_ozone_mixing_ratio + long_name = ozone tendency due to ozone mixing ratio + units = kg kg-1 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout + optional = True +[do3_dt_temp] + standard_name = ozone_tendency_due_to_temperature + long_name = ozone tendency due to temperature + units = kg kg-1 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout + optional = True +[do3_dt_ohoz] + standard_name = ozone_tendency_due_to_overhead_ozone_column + long_name = ozone tendency due to overhead ozone column + units = kg kg-1 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout + optional = True [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/GFS_surface_composites_inter.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_composites_inter.F90 similarity index 100% rename from physics/GFS_surface_composites_inter.F90 rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_composites_inter.F90 diff --git a/physics/GFS_surface_composites_inter.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_composites_inter.meta similarity index 99% rename from physics/GFS_surface_composites_inter.meta rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_composites_inter.meta index 36af0ef5a..ef3005583 100644 --- a/physics/GFS_surface_composites_inter.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_composites_inter.meta @@ -2,7 +2,7 @@ [ccpp-table-properties] name = GFS_surface_composites_inter type = scheme - dependencies = machine.F + dependencies = ../../hooks/machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/GFS_surface_composites_post.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_composites_post.F90 similarity index 99% rename from physics/GFS_surface_composites_post.F90 rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_composites_post.F90 index ab7528a62..01617aa1b 100644 --- a/physics/GFS_surface_composites_post.F90 +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_composites_post.F90 @@ -41,7 +41,7 @@ subroutine GFS_surface_composites_post_run ( logical, intent(in) :: cplflx, frac_grid, cplwav2atm, frac_ice logical, intent(in) :: lheatstrg logical, dimension(:), intent(in) :: flag_cice, dry, icy - logical, dimension(:), intent(inout) :: wet + logical, dimension(:), intent(in) :: wet integer, dimension(:), intent(in) :: islmsk, use_lake_model real(kind=kind_phys), dimension(:), intent(in) :: wind, t1, q1, prsl1, landfrac, lakefrac, oceanfrac, & cd_wat, cd_lnd, cd_ice, cdq_wat, cdq_lnd, cdq_ice, rb_wat, rb_lnd, rb_ice, stress_wat, & diff --git a/physics/GFS_surface_composites_post.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_composites_post.meta similarity index 99% rename from physics/GFS_surface_composites_post.meta rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_composites_post.meta index a78610cc7..7224d7221 100644 --- a/physics/GFS_surface_composites_post.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_composites_post.meta @@ -2,7 +2,8 @@ [ccpp-table-properties] name = GFS_surface_composites_post type = scheme - dependencies = machine.F,sfc_diff.f + relative_path = ../../ + dependencies = hooks/machine.F,SFC_Layer/UFS/sfc_diff.f ######################################################################## [ccpp-arg-table] diff --git a/physics/GFS_surface_composites_pre.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_composites_pre.F90 similarity index 96% rename from physics/GFS_surface_composites_pre.F90 rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_composites_pre.F90 index 98b9fecd2..d36a86721 100644 --- a/physics/GFS_surface_composites_pre.F90 +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_composites_pre.F90 @@ -42,9 +42,9 @@ subroutine GFS_surface_composites_pre_run (im, lkm, frac_grid, iopt_lake, iopt_l real(kind=kind_phys), dimension(:), intent(in ) :: landfrac, lakefrac, lakedepth, oceanfrac real(kind=kind_phys), dimension(:), intent(inout) :: cice, hice real(kind=kind_phys), dimension(:), intent( out) :: frland - real(kind=kind_phys), dimension(:), intent(in ) :: snowd, tprcp, uustar, weasd, qss + real(kind=kind_phys), dimension(:), intent(in ) :: snowd, tprcp, uustar, weasd, qss, tisfc - real(kind=kind_phys), dimension(:), intent(inout) :: tsfc, tsfco, tsfcl, tisfc + real(kind=kind_phys), dimension(:), intent(inout) :: tsfc, tsfco, tsfcl real(kind=kind_phys), dimension(:), intent(inout) :: snowd_lnd, snowd_ice, tprcp_wat, & tprcp_lnd, tprcp_ice, tsfc_wat, tsurf_wat,tsurf_lnd, tsurf_ice, & uustar_wat, uustar_lnd, uustar_ice, weasd_lnd, weasd_ice, & @@ -86,7 +86,6 @@ subroutine GFS_surface_composites_pre_run (im, lkm, frac_grid, iopt_lake, iopt_l if (oceanfrac(i) > zero) then if (cice(i) >= min_seaice) then icy(i) = .true. - tisfc(i) = max(timin, min(tisfc(i), tgice)) if (cplflx) then islmsk_cice(i) = 4 flag_cice(i) = .true. @@ -111,7 +110,6 @@ subroutine GFS_surface_composites_pre_run (im, lkm, frac_grid, iopt_lake, iopt_l if (cice(i) >= min_lakeice) then icy(i) = .true. islmsk(i) = 2 - tisfc(i) = max(timin, min(tisfc(i), tgice)) else cice(i) = zero hice(i) = zero @@ -151,7 +149,6 @@ subroutine GFS_surface_composites_pre_run (im, lkm, frac_grid, iopt_lake, iopt_l if (oceanfrac(i) > zero) then if (cice(i) >= min_seaice) then icy(i) = .true. - tisfc(i) = max(timin, min(tisfc(i), tgice)) ! This cplice namelist option was added to deal with the ! situation of the FV3ATM-HYCOM coupling without an active sea ! ice (e.g., CICE6) component. By default, the cplice is true @@ -187,9 +184,6 @@ subroutine GFS_surface_composites_pre_run (im, lkm, frac_grid, iopt_lake, iopt_l is_clm = lkm>0 .and. iopt_lake==iopt_lake_clm .and. use_lake_model(i)>0 if (cice(i) >= min_lakeice) then icy(i) = .true. - if(.not.is_clm) then - tisfc(i) = max(timin, min(tisfc(i), tgice)) - endif islmsk(i) = 2 else cice(i) = zero @@ -241,8 +235,10 @@ subroutine GFS_surface_composites_pre_run (im, lkm, frac_grid, iopt_lake, iopt_l !mjz tsfcl(i) = huge endif + if (icy(i) .or. wet(i)) then ! init uustar_ice for all water/ice grids + uustar_ice(i) = uustar(i) + endif if (icy(i)) then ! Ice - uustar_ice(i) = uustar(i) is_clm = lkm>0 .and. iopt_lake==iopt_lake_clm .and. use_lake_model(i)>0 if(lsm /= lsm_ruc .and. .not.is_clm) then weasd_ice(i) = weasd(i) diff --git a/physics/GFS_surface_composites_pre.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_composites_pre.meta similarity index 99% rename from physics/GFS_surface_composites_pre.meta rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_composites_pre.meta index d6b9003fe..4d1021118 100644 --- a/physics/GFS_surface_composites_pre.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_composites_pre.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = GFS_surface_composites_pre type = scheme - dependencies = machine.F + dependencies = ../../hooks/machine.F ######################################################################## [ccpp-arg-table] @@ -358,7 +358,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - intent = inout + intent = in [tsurf_wat] standard_name = surface_skin_temperature_after_iteration_over_water long_name = surface skin temperature after iteration over water diff --git a/physics/GFS_surface_generic_post.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_generic_post.F90 similarity index 96% rename from physics/GFS_surface_generic_post.F90 rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_generic_post.F90 index 9faebc8cf..8e3e0fdbf 100644 --- a/physics/GFS_surface_generic_post.F90 +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_generic_post.F90 @@ -66,14 +66,16 @@ subroutine GFS_surface_generic_post_run (im, cplflx, cplaqm, cplchm, cplwav, cpl real(kind=kind_phys), dimension(:), intent(in) :: ep1d, gflx, tgrs_1, qgrs_1, ugrs_1, vgrs_1, adjsfcdlw, adjsfcdsw, & adjnirbmd, adjnirdfd, adjvisbmd, adjvisdfd, adjsfculw, adjsfculw_wat, adjnirbmu, adjnirdfu, adjvisbmu, adjvisdfu, & - t2m, q2m, u10m, v10m, tsfc, tsfc_wat, pgr, xcosz, evbs, evcw, trans, sbsno, snowc, snohf, pah, ecan, etran, edir, & + t2m, q2m, u10m, v10m, tsfc, tsfc_wat, pgr, xcosz, evbs, evcw, trans, sbsno, snowc, snohf, pah, ecan, etran, edir + real(kind=kind_phys), dimension(:), intent(in), optional :: & waxy - real(kind=kind_phys), dimension(:), intent(inout) :: epi, gfluxi, t1, q1, u1, v1, dlwsfci_cpl, dswsfci_cpl, dlwsfc_cpl, & + real(kind=kind_phys), dimension(:), intent(inout) :: epi, gfluxi, t1, q1, u1, v1,gflux, evbsa, & + evcwa, transa, sbsnoa, snowca, snohfa, ep, tecan, tetran, tedir + real(kind=kind_phys), dimension(:), intent(inout), optional :: pahi, dlwsfci_cpl, dswsfci_cpl, dlwsfc_cpl, & dswsfc_cpl, dnirbmi_cpl, dnirdfi_cpl, dvisbmi_cpl, dvisdfi_cpl, dnirbm_cpl, dnirdf_cpl, dvisbm_cpl, dvisdf_cpl, & nlwsfci_cpl, nlwsfc_cpl, t2mi_cpl, q2mi_cpl, u10mi_cpl, v10mi_cpl, tsfci_cpl, psurfi_cpl, nnirbmi_cpl, nnirdfi_cpl, & - nvisbmi_cpl, nvisdfi_cpl, nswsfci_cpl, nswsfc_cpl, nnirbm_cpl, nnirdf_cpl, nvisbm_cpl, nvisdf_cpl, gflux, evbsa, & - evcwa, transa, sbsnoa, snowca, snohfa, ep, paha, tecan, tetran, tedir, twa, pahi + nvisbmi_cpl, nvisdfi_cpl, nswsfci_cpl, nswsfc_cpl, nnirbm_cpl, nnirdf_cpl, nvisbm_cpl, nvisdf_cpl, paha, twa real(kind=kind_phys), dimension(:), intent(inout) :: runoff, srunoff real(kind=kind_phys), dimension(:), intent(in) :: drain, runof @@ -130,6 +132,8 @@ subroutine GFS_surface_generic_post_run (im, cplflx, cplaqm, cplchm, cplwav, cpl if (cplflx .or. cpllnd) then do i=1,im + dlwsfci_cpl (i) = adjsfcdlw(i) + dswsfci_cpl (i) = adjsfcdsw(i) dlwsfc_cpl (i) = dlwsfc_cpl(i) + adjsfcdlw(i)*dtf dswsfc_cpl (i) = dswsfc_cpl(i) + adjsfcdsw(i)*dtf psurfi_cpl (i) = pgr(i) @@ -138,8 +142,6 @@ subroutine GFS_surface_generic_post_run (im, cplflx, cplaqm, cplchm, cplwav, cpl if (cplflx) then do i=1,im - dlwsfci_cpl (i) = adjsfcdlw(i) - dswsfci_cpl (i) = adjsfcdsw(i) dnirbmi_cpl (i) = adjnirbmd(i) dnirdfi_cpl (i) = adjnirdfd(i) dvisbmi_cpl (i) = adjvisbmd(i) @@ -242,7 +244,7 @@ subroutine GFS_surface_generic_post_run (im, cplflx, cplaqm, cplchm, cplwav, cpl tedir(i) = tedir(i) + edir(i) * dtf if (lsm == lsm_noahmp) then paha(i) = paha(i) + pah(i) * dtf - twa(i) = waxy(i) + twa(i) = waxy(i) endif enddo endif @@ -252,7 +254,7 @@ subroutine GFS_surface_generic_post_run (im, cplflx, cplaqm, cplchm, cplwav, cpl ! heat torage parameterization the kinematic sensible heat flux ! (hflx) as surface boundary forcing to the pbl scheme is ! reduced in a factor of hffac given as a function of surface roughness & -! green vegetation fraction (zvfun) +! green vegetation fraction (zvfun) ! do i=1,im hflxq(i) = hflx(i) diff --git a/physics/GFS_surface_generic_post.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_generic_post.meta similarity index 97% rename from physics/GFS_surface_generic_post.meta rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_generic_post.meta index 9658be7d8..2c8ae74c0 100644 --- a/physics/GFS_surface_generic_post.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_generic_post.meta @@ -2,7 +2,7 @@ [ccpp-table-properties] name = GFS_surface_generic_post type = scheme - dependencies = machine.F + dependencies = ../../hooks/machine.F ######################################################################## [ccpp-arg-table] @@ -448,6 +448,7 @@ type = real kind = kind_phys intent = in + optional = True [epi] standard_name = instantaneous_surface_potential_evaporation long_name = instantaneous sfc potential evaporation @@ -504,6 +505,7 @@ type = real kind = kind_phys intent = inout + optional = True [dswsfci_cpl] standard_name = surface_downwelling_shortwave_flux_for_coupling long_name = instantaneous sfc downward sw flux @@ -512,6 +514,7 @@ type = real kind = kind_phys intent = inout + optional = True [dlwsfc_cpl] standard_name = cumulative_surface_downwelling_longwave_flux_for_coupling_multiplied_by_timestep long_name = cumulative sfc downward lw flux mulitplied by timestep @@ -520,6 +523,7 @@ type = real kind = kind_phys intent = inout + optional = True [dswsfc_cpl] standard_name = cumulative_surface_downwelling_shortwave_flux_for_coupling_multiplied_by_timestep long_name = cumulative sfc downward sw flux multiplied by timestep @@ -528,6 +532,7 @@ type = real kind = kind_phys intent = inout + optional = True [dnirbmi_cpl] standard_name = surface_downwelling_direct_nir_shortwave_flux_for_coupling long_name = instantaneous sfc nir beam downward sw flux @@ -536,6 +541,7 @@ type = real kind = kind_phys intent = inout + optional = True [dnirdfi_cpl] standard_name = surface_downwelling_diffuse_nir_shortwave_flux_for_coupling long_name = instantaneous sfc nir diff downward sw flux @@ -544,6 +550,7 @@ type = real kind = kind_phys intent = inout + optional = True [dvisbmi_cpl] standard_name = surface_downwelling_direct_uv_and_vis_shortwave_flux_for_coupling long_name = instantaneous sfc uv+vis beam downward sw flux @@ -552,6 +559,7 @@ type = real kind = kind_phys intent = inout + optional = True [dvisdfi_cpl] standard_name = surface_downwelling_diffuse_uv_and_vis_shortwave_flux_for_coupling long_name = instantaneous sfc uv+vis diff downward sw flux @@ -560,6 +568,7 @@ type = real kind = kind_phys intent = inout + optional = True [dnirbm_cpl] standard_name = cumulative_surface_downwelling_direct_nir_shortwave_flux_for_coupling_multiplied_by_timestep long_name = cumulative sfc nir beam downward sw flux multiplied by timestep @@ -568,6 +577,7 @@ type = real kind = kind_phys intent = inout + optional = True [dnirdf_cpl] standard_name = cumulative_surface_downwelling_diffuse_nir_shortwave_flux_for_coupling_multiplied_by_timestep long_name = cumulative sfc nir diff downward sw flux multiplied by timestep @@ -576,6 +586,7 @@ type = real kind = kind_phys intent = inout + optional = True [dvisbm_cpl] standard_name = cumulative_surface_downwelling_direct_uv_and_vis_shortwave_flux_for_coupling_multiplied_by_timestep long_name = cumulative sfc uv+vis beam dnwd sw flux multiplied by timestep @@ -584,6 +595,7 @@ type = real kind = kind_phys intent = inout + optional = True [dvisdf_cpl] standard_name = cumulative_surface_downwelling_diffuse_uv_and_vis_shortwave_flux_for_coupling_multiplied_by_timestep long_name = cumulative sfc uv+vis diff dnwd sw flux multiplied by timestep @@ -592,6 +604,7 @@ type = real kind = kind_phys intent = inout + optional = True [nlwsfci_cpl] standard_name = surface_net_downwelling_longwave_flux_for_coupling long_name = instantaneous net sfc downward lw flux @@ -600,6 +613,7 @@ type = real kind = kind_phys intent = inout + optional = True [nlwsfc_cpl] standard_name = cumulative_surface_net_downwelling_longwave_flux_for_coupling_multiplied_by_timestep long_name = cumulative net downward lw flux multiplied by timestep @@ -608,6 +622,7 @@ type = real kind = kind_phys intent = inout + optional = True [t2mi_cpl] standard_name = temperature_at_2m_for_coupling long_name = instantaneous T2m @@ -616,6 +631,7 @@ type = real kind = kind_phys intent = inout + optional = True [q2mi_cpl] standard_name = specific_humidity_at_2m_for_coupling long_name = instantaneous Q2m @@ -624,6 +640,7 @@ type = real kind = kind_phys intent = inout + optional = True [u10mi_cpl] standard_name = x_wind_at_10m_for_coupling long_name = instantaneous U10m @@ -632,6 +649,7 @@ type = real kind = kind_phys intent = inout + optional = True [v10mi_cpl] standard_name = y_wind_at_10m_for_coupling long_name = instantaneous V10m @@ -640,6 +658,7 @@ type = real kind = kind_phys intent = inout + optional = True [tsfci_cpl] standard_name = surface_skin_temperature_for_coupling long_name = instantaneous sfc temperature @@ -648,6 +667,7 @@ type = real kind = kind_phys intent = inout + optional = True [psurfi_cpl] standard_name = surface_air_pressure_for_coupling long_name = instantaneous sfc pressure @@ -656,6 +676,7 @@ type = real kind = kind_phys intent = inout + optional = True [nnirbmi_cpl] standard_name = surface_net_downwelling_direct_nir_shortwave_flux_for_coupling long_name = instantaneous net nir beam sfc downward sw flux @@ -664,6 +685,7 @@ type = real kind = kind_phys intent = inout + optional = True [nnirdfi_cpl] standard_name = surface_net_downwelling_diffuse_nir_shortwave_flux_for_coupling long_name = instantaneous net nir diff sfc downward sw flux @@ -672,6 +694,7 @@ type = real kind = kind_phys intent = inout + optional = True [nvisbmi_cpl] standard_name = surface_net_downwelling_direct_uv_and_vis_shortwave_flux_for_coupling long_name = instantaneous net uv+vis beam downward sw flux @@ -680,6 +703,7 @@ type = real kind = kind_phys intent = inout + optional = True [nvisdfi_cpl] standard_name = surface_net_downwelling_diffuse_uv_and_vis_shortwave_flux_for_coupling long_name = instantaneous net uv+vis diff downward sw flux @@ -688,6 +712,7 @@ type = real kind = kind_phys intent = inout + optional = True [nswsfci_cpl] standard_name = surface_net_downwelling_shortwave_flux_for_coupling long_name = instantaneous net sfc downward sw flux @@ -696,6 +721,7 @@ type = real kind = kind_phys intent = inout + optional = True [nswsfc_cpl] standard_name = cumulative_surface_net_downwelling_shortwave_flux_for_coupling_multiplied_by_timestep long_name = cumulative net downward sw flux multiplied by timestep @@ -704,6 +730,7 @@ type = real kind = kind_phys intent = inout + optional = True [nnirbm_cpl] standard_name = cumulative_surface_net_downwelling_direct_nir_shortwave_flux_for_coupling_multiplied_by_timestep long_name = cumulative net nir beam downward sw flux multiplied by timestep @@ -712,6 +739,7 @@ type = real kind = kind_phys intent = inout + optional = True [nnirdf_cpl] standard_name = cumulative_surface_net_downwellling_diffuse_nir_shortwave_flux_for_coupling_multiplied_by_timestep long_name = cumulative net nir diff downward sw flux multiplied by timestep @@ -720,6 +748,7 @@ type = real kind = kind_phys intent = inout + optional = True [nvisbm_cpl] standard_name = cumulative_surface_net_downwelling_direct_uv_and_vis_shortwave_flux_for_coupling_multiplied_by_timestep long_name = cumulative net uv+vis beam downward sw rad flux multiplied by timestep @@ -728,6 +757,7 @@ type = real kind = kind_phys intent = inout + optional = True [nvisdf_cpl] standard_name = cumulative_surface_net_downwelling_diffuse_uv_and_vis_shortwave_flux_for_coupling_multiplied_by_timestep long_name = cumulative net uv+vis diff downward sw rad flux multiplied by timestep @@ -736,6 +766,7 @@ type = real kind = kind_phys intent = inout + optional = True [gflux] standard_name = cumulative_surface_ground_heat_flux_multiplied_by_timestep long_name = cumulative groud conductive heat flux multiplied by timestep @@ -800,6 +831,7 @@ type = real kind = kind_phys intent = inout + optional = True [ep] standard_name = cumulative_surface_upward_potential_latent_heat_flux_multiplied_by_timestep long_name = cumulative surface upward potential latent heat flux multiplied by timestep @@ -840,6 +872,7 @@ type = real kind = kind_phys intent = in + optional = True [runoff] standard_name = total_runoff long_name = total water runoff @@ -904,6 +937,7 @@ type = real kind = kind_phys intent = inout + optional = True [lheatstrg] standard_name = flag_for_canopy_heat_storage_in_land_surface_scheme long_name = flag for canopy heat storage parameterization diff --git a/physics/GFS_surface_generic_pre.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_generic_pre.F90 similarity index 90% rename from physics/GFS_surface_generic_pre.F90 rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_generic_pre.F90 index 5d321814c..8d9fe7de9 100644 --- a/physics/GFS_surface_generic_pre.F90 +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_generic_pre.F90 @@ -61,8 +61,7 @@ end subroutine GFS_surface_generic_pre_init !! subroutine GFS_surface_generic_pre_run (nthreads, im, levs, vfrac, islmsk, isot, ivegsrc, stype, scolor,vtype, slope, & prsik_1, prslk_1, tsfc, phil, con_g, sigmaf, work3, zlvl, & - drain_cpl, dsnow_cpl, rain_cpl, snow_cpl, lndp_type, n_var_lndp, sfc_wts, & - lndp_var_list, lndp_prt_list, & + lndp_type, n_var_lndp, sfc_wts, lndp_var_list, lndp_prt_list, & z01d, zt1d, bexp1d, xlai1d, vegf1d, lndp_vgf, & cplflx, flag_cice, islmsk_cice, slimskin_cpl, & wind, u1, v1, cnvwind, smcwlt2, smcref2, vtype_save, stype_save,scolor_save, slope_save, & @@ -87,14 +86,10 @@ subroutine GFS_surface_generic_pre_run (nthreads, im, levs, vfrac, islmsk, isot, real(kind=kind_phys), dimension(:), intent(inout) :: sigmaf, work3, zlvl ! Stochastic physics / surface perturbations - real(kind=kind_phys), dimension(:), intent(out) :: drain_cpl - real(kind=kind_phys), dimension(:), intent(out) :: dsnow_cpl - real(kind=kind_phys), dimension(:), intent(in) :: rain_cpl - real(kind=kind_phys), dimension(:), intent(in) :: snow_cpl integer, intent(in) :: lndp_type, n_var_lndp - character(len=3), dimension(:), intent(in) :: lndp_var_list - real(kind=kind_phys), dimension(:), intent(in) :: lndp_prt_list - real(kind=kind_phys), dimension(:,:), intent(in) :: sfc_wts + character(len=3), dimension(:), intent(in), optional :: lndp_var_list + real(kind=kind_phys), dimension(:), intent(in), optional :: lndp_prt_list + real(kind=kind_phys), dimension(:,:), intent(in), optional :: sfc_wts real(kind=kind_phys), dimension(:), intent(out) :: z01d real(kind=kind_phys), dimension(:), intent(out) :: zt1d real(kind=kind_phys), dimension(:), intent(out) :: bexp1d @@ -103,14 +98,14 @@ subroutine GFS_surface_generic_pre_run (nthreads, im, levs, vfrac, islmsk, isot, real(kind=kind_phys), intent(out) :: lndp_vgf logical, intent(in) :: cplflx - real(kind=kind_phys), dimension(:), intent(in) :: slimskin_cpl + real(kind=kind_phys), dimension(:), intent(in), optional :: slimskin_cpl logical, dimension(:), intent(inout) :: flag_cice integer, dimension(:), intent(out) :: islmsk_cice real(kind=kind_phys), dimension(:), intent(out) :: wind real(kind=kind_phys), dimension(:), intent(in ) :: u1, v1 ! surface wind enhancement due to convection - real(kind=kind_phys), dimension(:), intent(inout ) :: cnvwind + real(kind=kind_phys), dimension(:), intent(inout ), optional :: cnvwind ! real(kind=kind_phys), dimension(:), intent(out) :: smcwlt2, smcref2 diff --git a/physics/GFS_surface_generic_pre.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_generic_pre.meta similarity index 92% rename from physics/GFS_surface_generic_pre.meta rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_generic_pre.meta index d78988787..30c69732c 100644 --- a/physics/GFS_surface_generic_pre.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_generic_pre.meta @@ -1,7 +1,8 @@ [ccpp-table-properties] name = GFS_surface_generic_pre type = scheme - dependencies = machine.F,surface_perturbation.F90 + relative_path = ../../ + dependencies = hooks/machine.F,SFC_Models/Land/Noah/surface_perturbation.F90 ######################################################################## [ccpp-arg-table] @@ -289,38 +290,6 @@ type = real kind = kind_phys intent = inout -[drain_cpl] - standard_name = tendency_of_lwe_thickness_of_rain_amount_on_dynamics_timestep_for_coupling - long_name = change in rain_cpl (coupling_type) - units = m - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = out -[dsnow_cpl] - standard_name = tendency_of_lwe_thickness_of_snowfall_amount_on_dynamics_timestep_for_coupling - long_name = change in show_cpl (coupling_type) - units = m - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = out -[rain_cpl] - standard_name = cumulative_lwe_thickness_of_precipitation_amount_for_coupling - long_name = total rain precipitation - units = m - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in -[snow_cpl] - standard_name = cumulative_lwe_thickness_of_snow_amount_for_coupling - long_name = total snow precipitation - units = m - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in [lndp_type] standard_name = control_for_stochastic_land_surface_perturbation long_name = index for stochastic land surface perturbations type @@ -343,6 +312,7 @@ type = real kind = kind_phys intent = in + optional = True [lndp_var_list] standard_name = land_surface_perturbation_variables long_name = variables to be perturbed for landperts @@ -351,6 +321,7 @@ type = character kind = len=3 intent = in + optional = True [lndp_prt_list] standard_name =land_surface_perturbation_magnitudes long_name = magnitude of perturbations for landperts @@ -359,6 +330,7 @@ type = real kind = kind_phys intent = in + optional = True [z01d] standard_name = perturbation_of_momentum_roughness_length long_name = perturbation of momentum roughness length @@ -436,6 +408,7 @@ type = real kind = kind_phys intent = in + optional = True [wind] standard_name = wind_speed_at_lowest_model_layer long_name = wind speed at lowest model level @@ -468,6 +441,7 @@ type = real kind = kind_phys intent = inout + optional = True [smcwlt2] standard_name = volume_fraction_of_condensed_water_in_soil_at_wilting_point long_name = wilting point (volumetric) diff --git a/physics/GFS_surface_loop_control_part1.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_loop_control_part1.F90 similarity index 100% rename from physics/GFS_surface_loop_control_part1.F90 rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_loop_control_part1.F90 diff --git a/physics/GFS_surface_loop_control_part1.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_loop_control_part1.meta similarity index 97% rename from physics/GFS_surface_loop_control_part1.meta rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_loop_control_part1.meta index f178320ee..4bf962f6e 100644 --- a/physics/GFS_surface_loop_control_part1.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_loop_control_part1.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = GFS_surface_loop_control_part1 type = scheme - dependencies = machine.F + dependencies = ../../hooks/machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/GFS_surface_loop_control_part2.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_loop_control_part2.F90 similarity index 100% rename from physics/GFS_surface_loop_control_part2.F90 rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_loop_control_part2.F90 diff --git a/physics/GFS_surface_loop_control_part2.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_loop_control_part2.meta similarity index 98% rename from physics/GFS_surface_loop_control_part2.meta rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_loop_control_part2.meta index 7c9bc7408..ba19bf437 100644 --- a/physics/GFS_surface_loop_control_part2.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_loop_control_part2.meta @@ -2,7 +2,7 @@ [ccpp-table-properties] name = GFS_surface_loop_control_part2 type = scheme - dependencies = machine.F + dependencies = ../../hooks/machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/GFS_time_vary_pre.fv3.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_time_vary_pre.fv3.F90 similarity index 93% rename from physics/GFS_time_vary_pre.fv3.F90 rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_time_vary_pre.fv3.F90 index 5a678a820..6a556a88d 100644 --- a/physics/GFS_time_vary_pre.fv3.F90 +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_time_vary_pre.fv3.F90 @@ -94,10 +94,8 @@ subroutine GFS_time_vary_pre_timestep_init (jdat, idat, dtp, nsswr, real(kind=kind_phys), parameter :: con_24 = 24.0_kind_phys real(kind=kind_phys), parameter :: con_hr = 3600.0_kind_phys - real(kind=kind_sngl_prec) :: rinc4(5) real(kind=kind_dbl_prec) :: rinc8(5) - integer :: w3kindreal,w3kindint integer :: iw3jdn integer :: jd0, jd1 real :: fjd @@ -115,19 +113,9 @@ subroutine GFS_time_vary_pre_timestep_init (jdat, idat, dtp, nsswr, !--- jdat is being updated directly inside of FV3GFS_cap.F90 !--- update calendars and triggers - call w3kind(w3kindreal,w3kindint) - if (w3kindreal == 8) then - rinc8(1:5) = 0 - call w3difdat(jdat,idat,4,rinc8) - sec = rinc8(4) - else if (w3kindreal == 4) then - rinc4(1:5) = 0 - call w3difdat(jdat,idat,4,rinc4) - sec = rinc4(4) - else - write(0,*)' FATAL ERROR: Invalid w3kindreal' - call abort - endif + rinc8(1:5) = 0 + call w3difdat(jdat,idat,4,rinc8) + sec = rinc8(4) phour = sec/con_hr !--- set current bucket hour zhour = phour diff --git a/physics/GFS_time_vary_pre.fv3.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_time_vary_pre.fv3.meta similarity index 98% rename from physics/GFS_time_vary_pre.fv3.meta rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_time_vary_pre.fv3.meta index 3ec92287a..c6dd95bce 100644 --- a/physics/GFS_time_vary_pre.fv3.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_time_vary_pre.fv3.meta @@ -1,7 +1,8 @@ [ccpp-table-properties] name = GFS_time_vary_pre type = scheme - dependencies = funcphys.f90,machine.F + relative_path = ../../ + dependencies = tools/funcphys.f90,hooks/machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/GFS_time_vary_pre.scm.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_time_vary_pre.scm.F90 similarity index 92% rename from physics/GFS_time_vary_pre.scm.F90 rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_time_vary_pre.scm.F90 index 17cf09ca9..3293e09e4 100644 --- a/physics/GFS_time_vary_pre.scm.F90 +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_time_vary_pre.scm.F90 @@ -91,10 +91,8 @@ subroutine GFS_time_vary_pre_timestep_init (jdat, idat, dtp, nsswr, & real(kind=kind_phys), parameter :: con_24 = 24.0_kind_phys real(kind=kind_phys), parameter :: con_hr = 3600.0_kind_phys - real(kind=kind_sngl_prec) :: rinc4(5) real(kind=kind_dbl_prec) :: rinc8(5) - integer :: w3kindreal,w3kindint integer :: iw3jdn integer :: jd0, jd1 real :: fjd @@ -114,19 +112,9 @@ subroutine GFS_time_vary_pre_timestep_init (jdat, idat, dtp, nsswr, & !--- jdat is being updated directly inside of the time integration !--- loop of scm.F90 !--- update calendars and triggers - call w3kind(w3kindreal,w3kindint) - if (w3kindreal == 8) then - rinc8(1:5) = 0 - call w3difdat(jdat,idat,4,rinc8) - sec = rinc8(4) - else if (w3kindreal == 4) then - rinc4(1:5) = 0 - call w3difdat(jdat,idat,4,rinc4) - sec = rinc4(4) - else - write(0,*)' FATAL ERROR: Invalid w3kindreal' - call abort - endif + rinc8(1:5) = 0 + call w3difdat(jdat,idat,4,rinc8) + sec = rinc8(4) phour = sec/con_hr !--- set current bucket hour zhour = phour diff --git a/physics/GFS_time_vary_pre.scm.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_time_vary_pre.scm.meta similarity index 98% rename from physics/GFS_time_vary_pre.scm.meta rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_time_vary_pre.scm.meta index 20708c51e..af9afcdfe 100644 --- a/physics/GFS_time_vary_pre.scm.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_time_vary_pre.scm.meta @@ -1,7 +1,8 @@ [ccpp-table-properties] name = GFS_time_vary_pre type = scheme - dependencies = funcphys.f90,machine.F + relative_path = ../../ + dependencies = tools/funcphys.f90,hooks/machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/cnvc90.f b/physics/Interstitials/UFS_SCM_NEPTUNE/cnvc90.f similarity index 100% rename from physics/cnvc90.f rename to physics/Interstitials/UFS_SCM_NEPTUNE/cnvc90.f diff --git a/physics/cnvc90.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/cnvc90.meta similarity index 98% rename from physics/cnvc90.meta rename to physics/Interstitials/UFS_SCM_NEPTUNE/cnvc90.meta index 9728266d4..bbf161eb5 100644 --- a/physics/cnvc90.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/cnvc90.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = cnvc90 type = scheme - dependencies = + dependencies = ../../hooks/machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/dcyc2t3.f b/physics/Interstitials/UFS_SCM_NEPTUNE/dcyc2t3.f similarity index 97% rename from physics/dcyc2t3.f rename to physics/Interstitials/UFS_SCM_NEPTUNE/dcyc2t3.f index 36299651d..b42352f32 100644 --- a/physics/dcyc2t3.f +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/dcyc2t3.f @@ -44,7 +44,7 @@ module dcyc2t3 ! input/output: ! ! dtdt,dtdtnp, ! ! outputs: ! -! adjsfcdsw,adjsfcnsw,adjsfcdlw,adjsfculw, ! +! adjsfcdsw,adjsfcnsw,adjsfcdlw, ! ! adjsfculw_lnd,adjsfculw_ice,adjsfculw_wat,xmu,xcosz, ! ! adjnirbmu,adjnirdfu,adjvisbmu,adjvisdfu, ! ! adjdnnbmd,adjdnndfd,adjdnvbmd,adjdnvdfd) ! @@ -181,7 +181,7 @@ subroutine dcyc2t3_run & ! --- input/output: & dtdt,dtdtnp,htrlw, & ! --- outputs: - & adjsfcdsw,adjsfcnsw,adjsfcdlw,adjsfculw, & + & adjsfcdsw,adjsfcnsw,adjsfcdlw, & & adjsfculw_lnd,adjsfculw_ice,adjsfculw_wat,xmu,xcosz, & & adjnirbmu,adjnirdfu,adjvisbmu,adjvisdfu, & & adjnirbmd,adjnirdfd,adjvisbmd,adjvisdfd, & @@ -214,8 +214,9 @@ subroutine dcyc2t3_run & real(kind=kind_phys), dimension(:), intent(in) :: & & sinlat, coslat, xlon, coszen, tf, tsflw, sfcdlw, & - & sfcdsw, sfcnsw, sfculw, sfculw_med, tsfc, tsfc_radtime - + & sfcdsw, sfcnsw, sfculw, tsfc + real(kind=kind_phys), dimension(:), intent(in), optional :: & + & sfculw_med, tsfc_radtime real(kind=kind_phys), dimension(:), intent(in) :: & & tsfc_lnd, tsfc_ice, tsfc_wat, & & sfcemis_lnd, sfcemis_ice, sfcemis_wat @@ -227,7 +228,8 @@ subroutine dcyc2t3_run & real(kind=kind_phys), dimension(:,:), intent(in) :: swh, hlw, & & swhc, hlwc, p_lay, t_lay - real(kind=kind_phys), dimension(:,:), intent(in) :: p_lev, & + real(kind=kind_phys), dimension(:,:), intent(in) :: p_lev + real(kind=kind_phys), dimension(:,:), intent(in), optional :: & & flux2D_lwUP, flux2D_lwDOWN, fluxlwUP_jac real(kind_phys), intent(in ) :: con_g, con_cp, & @@ -237,12 +239,13 @@ subroutine dcyc2t3_run & ! --- input/output: - real(kind=kind_phys), dimension(:,:), intent(inout) :: dtdt, htrlw - real(kind=kind_phys), dimension(:,:), intent(inout) :: dtdtnp + real(kind=kind_phys), dimension(:,:), intent(inout) :: dtdt + real(kind=kind_phys), dimension(:,:), intent(inout), optional :: & + & dtdtnp, htrlw ! --- outputs: real(kind=kind_phys), dimension(:), intent(out) :: & - & adjsfcdsw, adjsfcnsw, adjsfcdlw, adjsfculw, xmu, xcosz, & + & adjsfcdsw, adjsfcnsw, adjsfcdlw, xmu, xcosz, & & adjnirbmu, adjnirdfu, adjvisbmu, adjvisdfu, & & adjnirbmd, adjnirdfd, adjvisbmd, adjvisdfd @@ -352,7 +355,7 @@ subroutine dcyc2t3_run & ! if (lprnt .and. i == ipr) write(0,*)' in dcyc3: dry==',dry(i) ! &,' wet=',wet(i),' icy=',icy(i),' tsfc3=',tsfc3(i,:) -! &,' sfcemis=',sfcemis(i,:),' adjsfculw=',adjsfculw(i,:) +! &,' sfcemis=',sfcemis(i,:) ! !> - normalize by average value over radiation period for daytime. diff --git a/physics/dcyc2t3.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/dcyc2t3.meta similarity index 98% rename from physics/dcyc2t3.meta rename to physics/Interstitials/UFS_SCM_NEPTUNE/dcyc2t3.meta index 65b05f4b3..b2187f0c5 100644 --- a/physics/dcyc2t3.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/dcyc2t3.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = dcyc2t3 type = scheme - dependencies = machine.F,physcons.F90 + dependencies = ../../hooks/machine.F ######################################################################## [ccpp-arg-table] @@ -399,6 +399,7 @@ type = real kind = kind_phys intent = in + optional = True [fluxlwUP_jac] standard_name = RRTMGP_jacobian_of_lw_flux_upward long_name = RRTMGP Jacobian upward longwave flux profile @@ -407,6 +408,7 @@ type = real kind = kind_phys intent = in + optional = True [t_lay] standard_name = air_temperature_of_new_state long_name = model layer mean temperature updated by physics @@ -439,6 +441,7 @@ type = real kind = kind_phys intent = in + optional = True [flux2D_lwDOWN] standard_name = RRTMGP_lw_flux_profile_downward_allsky_on_radiation_timestep long_name = RRTMGP downward longwave all-sky flux profile @@ -447,6 +450,7 @@ type = real kind = kind_phys intent = in + optional = True [pert_radtend] standard_name = flag_for_stochastic_radiative_heating_perturbations long_name = flag for stochastic radiative heating perturbations @@ -476,6 +480,7 @@ type = real kind = kind_phys intent = in + optional = True [dtdt] standard_name = process_split_cumulative_tendency_of_air_temperature long_name = total radiative heating rate at current time @@ -492,6 +497,7 @@ type = real kind = kind_phys intent = inout + optional = True [htrlw] standard_name = updated_tendency_of_air_temperature_due_to_longwave_heating_on_physics_timestep long_name = total sky longwave heating rate on physics time step @@ -500,6 +506,7 @@ type = real kind = kind_phys intent = inout + optional = True [adjsfcdsw] standard_name = surface_downwelling_shortwave_flux long_name = surface downwelling shortwave flux at current time @@ -524,14 +531,6 @@ type = real kind = kind_phys intent = out -[adjsfculw] - standard_name = surface_upwelling_longwave_flux - long_name = surface upwelling longwave flux at current time - units = W m-2 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = out [adjsfculw_lnd] standard_name = surface_upwelling_longwave_flux_over_land long_name = surface upwelling longwave flux at current time over land diff --git a/physics/gcycle.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/gcycle.F90 similarity index 99% rename from physics/gcycle.F90 rename to physics/Interstitials/UFS_SCM_NEPTUNE/gcycle.F90 index f5eecbd18..c2949f9a4 100644 --- a/physics/gcycle.F90 +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/gcycle.F90 @@ -37,15 +37,16 @@ subroutine gcycle (me, nthrds, nx, ny, isc, jsc, nsst, tile_num, nlunit, fn_nml, real(kind=kind_phys), intent(in) :: fhcyc, phour, landfrac(:), lakefrac(:), & min_seaice, min_lakeice, & xlat_d(:), xlon_d(:) - real(kind=kind_phys), intent(inout) :: smc(:,:), & - slc(:,:), & - stc(:,:), & + real(kind=kind_phys), intent(inout), optional :: & smois(:,:), & sh2o(:,:), & tslb(:,:), & + tref(:) + real(kind=kind_phys), intent(inout) :: smc(:,:), & + slc(:,:), & + stc(:,:), & tiice(:,:), & tg3(:), & - tref(:), & tsfc(:), & tsfco(:), & tisfc(:), & diff --git a/physics/iccn_def.F b/physics/Interstitials/UFS_SCM_NEPTUNE/iccn_def.F similarity index 100% rename from physics/iccn_def.F rename to physics/Interstitials/UFS_SCM_NEPTUNE/iccn_def.F diff --git a/physics/iccninterp.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/iccninterp.F90 similarity index 87% rename from physics/iccninterp.F90 rename to physics/Interstitials/UFS_SCM_NEPTUNE/iccninterp.F90 index c08b5c5e5..dd752d9b8 100644 --- a/physics/iccninterp.F90 +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/iccninterp.F90 @@ -23,6 +23,7 @@ SUBROUTINE read_cidata (me, master) integer, intent(in) :: me integer, intent(in) :: master !--- locals + integer :: ncerr integer :: i, n, k, ncid, varid,j,it real(kind=kind_phys), allocatable, dimension(:) :: hyam,hybm real(kind=4), allocatable, dimension(:,:,:) :: ci_ps @@ -31,29 +32,29 @@ SUBROUTINE read_cidata (me, master) allocate (ciplin(lonscip,latscip,kcipl,timeci)) allocate (ccnin(lonscip,latscip,kcipl,timeci)) allocate (ci_pres(lonscip,latscip,kcipl,timeci)) - call nf_open("cam5_4_143_NAAI_monclimo2.nc", NF90_NOWRITE, ncid) - call nf_inq_varid(ncid, "lat", varid) - call nf_get_var(ncid, varid, ci_lat) - call nf_inq_varid(ncid, "lon", varid) - call nf_get_var(ncid, varid, ci_lon) - call nf_inq_varid(ncid, "PS", varid) - call nf_get_var(ncid, varid, ci_ps) - call nf_inq_varid(ncid, "hyam", varid) - call nf_get_var(ncid, varid, hyam) - call nf_inq_varid(ncid, "hybm", varid) - call nf_get_var(ncid, varid, hybm) - call nf_inq_varid(ncid, "NAAI", varid) - call nf_get_var(ncid, varid, ciplin) + ncerr = nf90_open("cam5_4_143_NAAI_monclimo2.nc", NF90_NOWRITE, ncid) + ncerr = nf90_inq_varid(ncid, "lat", varid) + ncerr = nf90_get_var(ncid, varid, ci_lat) + ncerr = nf90_inq_varid(ncid, "lon", varid) + ncerr = nf90_get_var(ncid, varid, ci_lon) + ncerr = nf90_inq_varid(ncid, "PS", varid) + ncerr = nf90_get_var(ncid, varid, ci_ps) + ncerr = nf90_inq_varid(ncid, "hyam", varid) + ncerr = nf90_get_var(ncid, varid, hyam) + ncerr = nf90_inq_varid(ncid, "hybm", varid) + ncerr = nf90_get_var(ncid, varid, hybm) + ncerr = nf90_inq_varid(ncid, "NAAI", varid) + ncerr = nf90_get_var(ncid, varid, ciplin) do it = 1,timeci do k=1, kcipl ci_pres(:,:,k,it)=hyam(k)*1.e5+hybm(k)*ci_ps(:,:,it) end do end do - call nf_close(ncid) - call nf_open("cam5_4_143_NPCCN_monclimo2.nc", NF90_NOWRITE, ncid) - call nf_inq_varid(ncid, "NPCCN", varid) - call nf_get_var(ncid, varid, ccnin) - call nf_close(ncid) + ncerr = nf90_close(ncid) + ncerr = nf90_open("cam5_4_143_NPCCN_monclimo2.nc", NF90_NOWRITE, ncid) + ncerr = nf90_inq_varid(ncid, "NPCCN", varid) + ncerr = nf90_get_var(ncid, varid, ccnin) + ncerr = nf90_close(ncid) !--- deallocate (hyam, hybm, ci_ps) if (me == master) then @@ -128,7 +129,7 @@ END SUBROUTINE setindxci SUBROUTINE ciinterpol(me,npts,IDATE,FHOUR,jindx1,jindx2,ddy, & iindx1,iindx2,ddx,lev, prsl, ciplout,ccnout) ! - USE MACHINE, ONLY : kind_phys + USE MACHINE, ONLY : kind_phys, kind_dbl_prec use iccn_def implicit none integer i1,i2, iday,j,j1,j2,l,npts,nc,n1,n2,lev,k,i @@ -144,10 +145,8 @@ SUBROUTINE ciinterpol(me,npts,IDATE,FHOUR,jindx1,jindx2,ddy, & real(kind=kind_phys) ccnout(npts,lev),ccnpm(npts,kcipl) real(kind=kind_phys) cipres(npts,kcipl), prsl(npts,lev) real(kind=kind_phys) rjday + real(kind=kind_dbl_prec) rinc(5) integer jdow, jdoy, jday - real(8) RINC(5) - real(4) rinc4(5) - integer w3kindreal,w3kindint ! IDAT=0 IDAT(1)=IDATE(4) @@ -156,13 +155,7 @@ SUBROUTINE ciinterpol(me,npts,IDATE,FHOUR,jindx1,jindx2,ddy, & IDAT(5)=IDATE(1) RINC=0. RINC(2)=FHOUR - call w3kind(w3kindreal,w3kindint) - if(w3kindreal==4) then - rinc4=rinc - CALL W3MOVDAT(RINC4,IDAT,JDAT) - else - CALL W3MOVDAT(RINC,IDAT,JDAT) - endif + CALL W3MOVDAT(RINC,IDAT,JDAT) ! jdow = 0 jdoy = 0 diff --git a/physics/maximum_hourly_diagnostics.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/maximum_hourly_diagnostics.F90 similarity index 93% rename from physics/maximum_hourly_diagnostics.F90 rename to physics/Interstitials/UFS_SCM_NEPTUNE/maximum_hourly_diagnostics.F90 index cd1016053..74ebcb709 100644 --- a/physics/maximum_hourly_diagnostics.F90 +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/maximum_hourly_diagnostics.F90 @@ -15,6 +15,9 @@ module maximum_hourly_diagnostics real(kind=kind_phys), parameter ::PQ0=379.90516E0, A2A=17.2693882, A3=273.16, A4=35.86, RHmin=1.0E-6 ! *DH + ! Conversion from flashes per five minutes to flashes per minute. + real(kind=kind_phys), parameter :: scaling_factor = 0.2 + contains #if 0 @@ -63,8 +66,9 @@ subroutine maximum_hourly_diagnostics_run(im, levs, reset, lradar, imp_physics, real(kind_phys), intent(in ) :: prsl(:,:) real(kind_phys), intent(inout) :: pratemax(:) - real(kind_phys), intent(in), dimension(:,:) :: prsi, qgraupel, qsnowwat, qicewat, wgrs - real(kind_phys), intent(inout), dimension(:) :: ltg1_max, ltg2_max, ltg3_max + real(kind_phys), intent(in), dimension(:,:) :: prsi, qgraupel, qsnowwat, qicewat + real(kind_phys), intent(in), dimension(:,:), optional :: wgrs + real(kind_phys), intent(inout), dimension(:), optional :: ltg1_max, ltg2_max, ltg3_max character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -195,7 +199,10 @@ subroutine lightning_threat_indices endif IF ( ltg1 .LT. clim1 ) ltg1 = 0. - + + ! Scale to flashes per minue + ltg1 = ltg1 * scaling_factor + IF ( ltg1 .GT. ltg1_max(i) ) THEN ltg1_max(i) = ltg1 ENDIF @@ -208,14 +215,19 @@ subroutine lightning_threat_indices ltg2 = coef2 * totice_colint(i) IF ( ltg2 .LT. clim2 ) ltg2 = 0. + + ! Scale to flashes per minute + ltg2 = ltg2 * scaling_factor IF ( ltg2 .GT. ltg2_max(i) ) THEN ltg2_max(i) = ltg2 ENDIF + ! This calculation is already in flashes per minute. ltg3_max(i) = 0.95 * ltg1_max(i) + 0.05 * ltg2_max(i) - IF ( ltg3_max(i) .LT. clim3 ) ltg3_max(i) = 0. + ! Thus, we must scale clim3. The compiler will optimize this away. + IF ( ltg3_max(i) .LT. clim3 * scaling_factor ) ltg3_max(i) = 0. enddo end subroutine lightning_threat_indices diff --git a/physics/maximum_hourly_diagnostics.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/maximum_hourly_diagnostics.meta similarity index 98% rename from physics/maximum_hourly_diagnostics.meta rename to physics/Interstitials/UFS_SCM_NEPTUNE/maximum_hourly_diagnostics.meta index e9d0876d2..7108e2f97 100644 --- a/physics/maximum_hourly_diagnostics.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/maximum_hourly_diagnostics.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = maximum_hourly_diagnostics type = scheme - dependencies = machine.F + dependencies = ../../hooks/machine.F ######################################################################## [ccpp-arg-table] @@ -246,6 +246,7 @@ type = real kind = kind_phys intent = in + optional = True [qgraupel] standard_name = graupel_mixing_ratio long_name = ratio of mass of graupel to mass of dry air plus vapor (without condensates) @@ -296,27 +297,30 @@ [ltg1_max] standard_name = lightning_threat_index_1 long_name = lightning threat index 1 - units = flashes 5 min-1 + units = flashes min-1 dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout + optional = True [ltg2_max] standard_name = lightning_threat_index_2 long_name = lightning threat index 2 - units = flashes 5 min-1 + units = flashes min-1 dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout + optional = True [ltg3_max] standard_name = lightning_threat_index_3 long_name = lightning threat index 3 - units = flashes 5 min-1 + units = flashes min-1 dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout + optional = True [prsi] standard_name = air_pressure_at_interface long_name = air pressure at model layer interfaces diff --git a/physics/scm_sfc_flux_spec.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/scm_sfc_flux_spec.F90 similarity index 100% rename from physics/scm_sfc_flux_spec.F90 rename to physics/Interstitials/UFS_SCM_NEPTUNE/scm_sfc_flux_spec.F90 diff --git a/physics/scm_sfc_flux_spec.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/scm_sfc_flux_spec.meta similarity index 99% rename from physics/scm_sfc_flux_spec.meta rename to physics/Interstitials/UFS_SCM_NEPTUNE/scm_sfc_flux_spec.meta index 52722f1c4..85bf403ad 100644 --- a/physics/scm_sfc_flux_spec.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/scm_sfc_flux_spec.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = scm_sfc_flux_spec type = scheme - dependencies = machine.F + dependencies = ../../hooks/machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/sfcsub.F b/physics/Interstitials/UFS_SCM_NEPTUNE/sfcsub.F similarity index 99% rename from physics/sfcsub.F rename to physics/Interstitials/UFS_SCM_NEPTUNE/sfcsub.F index 7be07b39c..2ff33498b 100644 --- a/physics/sfcsub.F +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/sfcsub.F @@ -2805,7 +2805,7 @@ subroutine fixrdg(lugb,idim,jdim,fngrib, & use sfccyc_module, only : mdata implicit none integer lgrib,n,lskip,jret,j,ndata,lugi,jdim,idim,lugb, - & iret, me,kpds5,kdata,i,w3kindreal,w3kindint + & iret, me,kpds5,kdata,i ! character*(*) fngrib ! @@ -2813,7 +2813,6 @@ subroutine fixrdg(lugb,idim,jdim,fngrib, & logical gaus real (kind=kind_io8) blno,blto real (kind=kind_dbl_prec), allocatable :: data8(:) - real (kind=kind_sngl_prec), allocatable :: data4(:) ! logical*1, allocatable :: lbms(:) ! @@ -2872,20 +2871,8 @@ subroutine fixrdg(lugb,idim,jdim,fngrib, & jpds = kpds0 lskip = -1 kdata=idim*jdim - call w3kind(w3kindreal,w3kindint) - if (w3kindreal == 8) then call getgb(lugb,lugi,kdata,lskip,jpds,jgds,ndata,lskip, & kpds,kgds,lbms,data8,jret) - else if (w3kindreal == 4) then - allocate(data4(1:idim*jdim)) - call getgb(lugb,lugi,kdata,lskip,jpds,jgds,ndata,lskip, - & kpds,kgds,lbms,data4,jret) - data8(1:ndata) = real(data4(1:ndata), kind=kind_dbl_prec) - deallocate(data4) - else - write(0,*)' FATAL ERROR: Invalid w3kindreal' - call abort - endif ! if(jret == 0) then if(ndata.eq.0) then @@ -7081,7 +7068,7 @@ subroutine clima(lugb,iy,im,id,ih,fh,len,lsoil,slmskl,slmskw, & &, gaus, blno, blto, me,lprnt,iprnt, fnalbc2, ialb & &, tile_num_ch, i_index, j_index) ! - use machine , only : kind_io8,kind_io4 + use machine , only : kind_io8,kind_io4, kind_dbl_prec implicit none character(len=*), intent(in) :: tile_num_ch integer, intent(in) :: i_index(len), j_index(len) @@ -7141,9 +7128,7 @@ subroutine clima(lugb,iy,im,id,ih,fh,len,lsoil,slmskl,slmskw, & data dayhf/ 15.5, 45.0, 74.5,105.0,135.5,166.0, & 196.5,227.5,258.0,288.5,319.0,349.5,380.5/ ! - real(8) fha(5) - real(4) fha4(5) - integer w3kindreal,w3kindint + real (kind=kind_dbl_prec) fha(5) integer ida(8),jda(8),ivtyp, kpd7 ! real (kind=kind_io8), allocatable :: tsf(:,:),sno(:,:), @@ -7235,13 +7220,7 @@ subroutine clima(lugb,iy,im,id,ih,fh,len,lsoil,slmskl,slmskw, & ida(2) = im ida(3) = id ida(5) = ih - call w3kind(w3kindreal,w3kindint) - if(w3kindreal == 4) then - fha4 = fha - call w3movdat(fha4,ida,jda) - else - call w3movdat(fha,ida,jda) - endif + call w3movdat(fha,ida,jda) jy = jda(1) jm = jda(2) jd = jda(3) @@ -7311,13 +7290,7 @@ subroutine clima(lugb,iy,im,id,ih,fh,len,lsoil,slmskl,slmskw, & ida(2) = im ida(3) = id ida(5) = ih - call w3kind(w3kindreal,w3kindint) - if(w3kindreal == 4) then - fha4 = fha - call w3movdat(fha4,ida,jda) - else - call w3movdat(fha,ida,jda) - endif + call w3movdat(fha,ida,jda) jy = jda(1) jm = jda(2) jd = jda(3) @@ -7491,9 +7464,6 @@ subroutine clima(lugb,iy,im,id,ih,fh,len,lsoil,slmskl,slmskw, & endif call abort endif -! -! soil type - print *,'in FIXREAD fnsotc =',fnsotc ! if(fnsotc(1:8).ne.' ') then if ( index(fnsotc, "tileX.nc") == 0) then ! grib file @@ -7700,7 +7670,7 @@ subroutine clima(lugb,iy,im,id,ih,fh,len,lsoil,slmskl,slmskw, & ! points. so for efficiency, don't have fixrdc try to ! find a value at landice points as defined by the vet type (vet). allocate(slmask_noice(len)) - slmask_noice = 1.0 + slmask_noice = slmskl do i = 1, len if (nint(vet(i)) < 1 .or. & nint(vet(i)) == landice_cat) then @@ -8443,7 +8413,7 @@ subroutine fixrdc(lugb,fngrib,kpds5,kpds7,mon,slmask, & implicit none integer imax,jmax,ijmax,i,j,n,jret,inttyp,iret,imsk, & & jmsk,len,lugb,kpds5,mon,lskip,lgrib,ndata,lugi,me,kmami & - &, jj,w3kindreal,w3kindint + &, jj real (kind=kind_io8) wlon,elon,rnlat,dlat,dlon,rslat,blno,blto ! ! @@ -8455,7 +8425,6 @@ subroutine fixrdc(lugb,fngrib,kpds5,kpds7,mon,slmask, & real (kind=kind_io8) gdata(len), slmask(len) real (kind=kind_io8), allocatable :: data(:,:), rslmsk(:,:) real (kind=kind_dbl_prec), allocatable :: data8(:) - real (kind=kind_sngl_prec), allocatable :: data4(:) real (kind=kind_io8), allocatable :: rlngrb(:), rltgrb(:) ! logical lmask, yr2kc, gaus, ijordr @@ -8523,17 +8492,8 @@ subroutine fixrdc(lugb,fngrib,kpds5,kpds7,mon,slmask, & jpds = kpds0 jpds(9) = mon if(jpds(9).eq.13) jpds(9) = 1 - call w3kind(w3kindreal,w3kindint) - if (w3kindreal==8) then - call getgb(lugb,lugi,mdata,lskip,jpds,jgds,ndata,lskip, - & kpds,kgds,lbms,data8,jret) - else if (w3kindreal==4) then - allocate(data4(1:mdata)) - call getgb(lugb,lugi,mdata,lskip,jpds,jgds,ndata,lskip, - & kpds,kgds,lbms,data4,jret) - data8(1:ndata) = real(data4(1:ndata), kind=kind_dbl_prec) - deallocate(data4) - endif + call getgb(lugb,lugi,mdata,lskip,jpds,jgds,ndata,lskip, + & kpds,kgds,lbms,data8,jret) if (me .eq. 0) write(6,*) ' input grib file dates=', & (kpds(i),i=8,11) if(jret.eq.0) then @@ -8618,7 +8578,7 @@ subroutine fixrda(lugb,fngrib,kpds5,slmask, & integer nrepmx,nvalid,imo,iyr,idy,jret,ihr,nrept,lskip,lugi, & & lgrib,j,ndata,i,inttyp,jmax,imax,ijmax,ij,jday,len,iret, & & jmsk,imsk,ih,kpds5,lugb,iy,id,im,jh,jd,jdoy,jdow,jm,me, & - & monend,jy,iy4,kmami,iret2,jj,w3kindreal,w3kindint + & monend,jy,iy4,kmami,iret2,jj real (kind=kind_io8) rnlat,rslat,wlon,elon,dlon,dlat,fh,blno, & & rjday,blto ! @@ -8640,7 +8600,6 @@ subroutine fixrda(lugb,fngrib,kpds5,slmask, & real (kind=kind_io8) gdata(len), slmask(len) real (kind=kind_io8), allocatable :: data(:,:),rslmsk(:,:) real (kind=kind_dbl_prec), allocatable :: data8(:) - real (kind=kind_sngl_prec), allocatable :: data4(:) real (kind=kind_io8), allocatable :: rlngrb(:), rltgrb(:) ! logical lmask, yr2kc, gaus, ijordr @@ -8661,8 +8620,7 @@ subroutine fixrda(lugb,fngrib,kpds5,slmask, & integer mjday(12) data mjday/31,28,31,30,31,30,31,31,30,31,30,31/ ! - real(8) fha(5) - real(4) fha4(5) + real (kind=kind_dbl_prec) fha(5) integer ida(8),jda(8) ! allocate(data8(1:mdata)) @@ -8681,13 +8639,7 @@ subroutine fixrda(lugb,fngrib,kpds5,slmask, & ida(2)=im ida(3)=id ida(5)=ih - call w3kind(w3kindreal,w3kindint) - if(w3kindreal==4) then - fha4=fha - call w3movdat(fha4,ida,jda) - else - call w3movdat(fha,ida,jda) - endif + call w3movdat(fha,ida,jda) jy=jda(1) jm=jda(2) jd=jda(3) @@ -8770,17 +8722,8 @@ subroutine fixrda(lugb,fngrib,kpds5,slmask, & jpds(10)=idy ! jpds(11)=ihr jpds(21)=(iyr-1)/100+1 - call w3kind(w3kindreal,w3kindint) - if (w3kindreal == 8) then - call getgb(lugb,lugi,mdata,lskip,jpds,jgds,ndata,lskip, - & kpds,kgds,lbms,data8,jret) - elseif (w3kindreal == 4) then - allocate (data4(1:mdata)) - call getgb(lugb,lugi,mdata,lskip,jpds,jgds,ndata,lskip, - & kpds,kgds,lbms,data4,jret) - data8(1:ndata) = real(data4(1:ndata), kind=kind_dbl_prec) - deallocate(data4) - endif + call getgb(lugb,lugi,mdata,lskip,jpds,jgds,ndata,lskip, + & kpds,kgds,lbms,data8,jret) if (me .eq. 0) write(6,*) ' input grib file dates=', & (kpds(i),i=8,11) if(jret.eq.0) then diff --git a/physics/sgscloud_radpost.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/sgscloud_radpost.F90 similarity index 100% rename from physics/sgscloud_radpost.F90 rename to physics/Interstitials/UFS_SCM_NEPTUNE/sgscloud_radpost.F90 diff --git a/physics/sgscloud_radpost.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/sgscloud_radpost.meta similarity index 98% rename from physics/sgscloud_radpost.meta rename to physics/Interstitials/UFS_SCM_NEPTUNE/sgscloud_radpost.meta index 6ad91d496..046531a0a 100644 --- a/physics/sgscloud_radpost.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/sgscloud_radpost.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = sgscloud_radpost type = scheme - dependencies = machine.F + dependencies = ../../hooks/machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/sgscloud_radpre.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/sgscloud_radpre.F90 similarity index 97% rename from physics/sgscloud_radpre.F90 rename to physics/Interstitials/UFS_SCM_NEPTUNE/sgscloud_radpre.F90 index 44ab87bcc..95d172d4f 100644 --- a/physics/sgscloud_radpre.F90 +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/sgscloud_radpre.F90 @@ -81,18 +81,18 @@ subroutine sgscloud_radpre_run( & real(kind=kind_phys), dimension(:,:), intent(inout) :: qc, qi real(kind=kind_phys), dimension(:,:), intent(inout) :: qr, qs, qg ! note: qci_conv only allocated if GF is used - real(kind=kind_phys), dimension(:,:), intent(inout) :: qci_conv + real(kind=kind_phys), dimension(:,:), intent(inout), optional :: qci_conv real(kind=kind_phys), dimension(:,:), intent(inout) :: qlc, qli !for SAS - real(kind=kind_phys), dimension(:,:), intent(in) :: ud_mf + real(kind=kind_phys), dimension(:,:), intent(in), optional :: ud_mf real(kind=kind_phys), dimension(:,:), intent(in) :: T3D,delp real(kind=kind_phys), dimension(:,:), intent(in) :: qv,P3D,exner real(kind=kind_phys), dimension(:,:), intent(inout) :: & & clouds1,clouds2,clouds3,clouds4,clouds5, & & clouds8,clouds9 real(kind=kind_phys), dimension(:,:), intent(inout) :: qc_save, qi_save, qs_save - real(kind=kind_phys), dimension(:,:), intent(in) :: qc_bl, qi_bl, cldfra_bl + real(kind=kind_phys), dimension(:,:), intent(in), optional :: qc_bl, qi_bl, cldfra_bl real(kind=kind_phys), dimension(:), intent(in) :: slmsk, xlat, de_lgth - real(kind=kind_phys), dimension(:,:), intent(in) :: plyr, dz + real(kind=kind_phys), dimension(:,:), intent(in) :: plyr, dz real(kind=kind_phys), dimension(:,:), intent(inout) :: cldsa integer, dimension(:,:), intent(inout) :: mbota, mtopa integer, intent(in) :: iovr @@ -216,10 +216,10 @@ subroutine sgscloud_radpre_run( & qi(i,k) = ice_frac*qi_bl(i,k) !eff radius cloud ice (microns), from Mishra et al. (2014, JGR Atmos, fig 6b) - if(qi(i,k)>1.E-8)clouds5(i,k)=max(173.45 + 2.14*Tc, 20.) + clouds5(i,k)=max(173.45 + 2.14*Tc, 20.) !eff radius cloud ice (microns), from Mishra et al. (2014, JGR Atmos, fig 8b) !iwc = qi(i,k)*1.0e6*rho(i,k) - !IF(qi(i,k)>1.E-8)clouds5(i,k)=MAX(139.7 + 1.76*Tc + 13.49*LOG(iwc), 20.) + !clouds5(i,k)=MAX(139.7 + 1.76*Tc + 13.49*LOG(iwc), 20.) !calculate the ice water path using additional BL clouds clouds4(i,k) = max(0.0, qi(i,k) * gfac * delp(i,k)) @@ -229,7 +229,7 @@ subroutine sgscloud_radpre_run( & qs(i,k) = snow_frac*qi_bl(i,k) !eff radius cloud ice (microns), from Mishra et al. (2014, JGR Atmos, fig 6b) - if(qs(i,k)>1.E-8)clouds9(i,k)=max(2.*(173.45 + 2.14*Tc), 50.) + clouds9(i,k)=max(2.*(173.45 + 2.14*Tc), 50.) !calculate the snow water path using additional BL clouds clouds8(i,k) = max(0.0, qs(i,k) * gfac * delp(i,k)) diff --git a/physics/sgscloud_radpre.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/sgscloud_radpre.meta similarity index 97% rename from physics/sgscloud_radpre.meta rename to physics/Interstitials/UFS_SCM_NEPTUNE/sgscloud_radpre.meta index d5341bcd4..8e25428cc 100644 --- a/physics/sgscloud_radpre.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/sgscloud_radpre.meta @@ -1,7 +1,10 @@ [ccpp-table-properties] name = sgscloud_radpre type = scheme - dependencies = funcphys.f90,iounitdef.f,machine.F,module_bfmicrophysics.f,physcons.F90,radcons.f90,radiation_clouds.f,module_mp_thompson.F90 + relative_path = ../../ + dependencies = tools/funcphys.f90,hooks/machine.F + dependencies = hooks/physcons.F90,Radiation/RRTMG/radcons.f90 + dependencies = Radiation/radiation_clouds.f,MP/Thompson/module_mp_thompson.F90 ######################################################################## [ccpp-arg-table] @@ -218,6 +221,7 @@ type = real kind = kind_phys intent = in + optional = True [qci_conv] standard_name = convective_cloud_condesate_after_rainout long_name = convective cloud condesate after rainout @@ -226,6 +230,7 @@ type = real kind = kind_phys intent = inout + optional = True [qlc] standard_name = cloud_condensed_water_mixing_ratio_convective_transport_tracer long_name = ratio of mass of cloud water to mass of dry air plus vapor (without condensates) in the convectively transported tracer array @@ -302,6 +307,7 @@ type = real kind = kind_phys intent = in + optional = True [QI_BL] standard_name = subgrid_scale_cloud_ice_mixing_ratio long_name = subgrid cloud ice mixing ratio from PBL scheme @@ -310,6 +316,7 @@ type = real kind = kind_phys intent = in + optional = True [CLDFRA_BL] standard_name = subgrid_scale_cloud_area_fraction_in_atmosphere_layer long_name = subgrid cloud fraction from PBL scheme @@ -318,6 +325,7 @@ type = real kind = kind_phys intent = in + optional = True [delp] standard_name = layer_pressure_thickness_for_radiation long_name = layer pressure thickness on radiation levels diff --git a/physics/module_MP_FER_HIRES.F90 b/physics/MP/Ferrier_Aligo/module_MP_FER_HIRES.F90 similarity index 100% rename from physics/module_MP_FER_HIRES.F90 rename to physics/MP/Ferrier_Aligo/module_MP_FER_HIRES.F90 diff --git a/physics/mp_fer_hires.F90 b/physics/MP/Ferrier_Aligo/mp_fer_hires.F90 similarity index 98% rename from physics/mp_fer_hires.F90 rename to physics/MP/Ferrier_Aligo/mp_fer_hires.F90 index 938beae5d..f4fe9b62a 100644 --- a/physics/mp_fer_hires.F90 +++ b/physics/MP/Ferrier_Aligo/mp_fer_hires.F90 @@ -36,6 +36,7 @@ subroutine mp_fer_hires_init(ncol, nlev, dtp, imp_physics, & mpicomm, mpirank,mpiroot, & threads, errmsg, errflg) + USE mpi_f08 USE machine, ONLY : kind_phys USE MODULE_MP_FER_HIRES, ONLY : FERRIER_INIT_HR implicit none @@ -45,7 +46,7 @@ subroutine mp_fer_hires_init(ncol, nlev, dtp, imp_physics, & real(kind_phys), intent(in) :: dtp integer, intent(in) :: imp_physics integer, intent(in) :: imp_physics_fer_hires - integer, intent(in) :: mpicomm + type(MPI_Comm), intent(in) :: mpicomm integer, intent(in) :: mpirank integer, intent(in) :: mpiroot integer, intent(in) :: threads @@ -148,7 +149,7 @@ SUBROUTINE mp_fer_hires_run(NCOL, NLEV, DT ,SPEC_ADV & real(kind_phys), intent(inout) :: prec(:) real(kind_phys), intent(inout) :: refl_10cm(:,:) - real(kind_phys), intent(in ) :: rhgrd + real(kind_phys), intent(in ), optional :: rhgrd real(kind_phys), intent(in ) :: dx(:) character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg diff --git a/physics/mp_fer_hires.meta b/physics/MP/Ferrier_Aligo/mp_fer_hires.meta similarity index 98% rename from physics/mp_fer_hires.meta rename to physics/MP/Ferrier_Aligo/mp_fer_hires.meta index 9f7c63d4d..636edf945 100644 --- a/physics/mp_fer_hires.meta +++ b/physics/MP/Ferrier_Aligo/mp_fer_hires.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = mp_fer_hires type = scheme - dependencies = machine.F,module_MP_FER_HIRES.F90 + dependencies = ../../hooks/machine.F,module_MP_FER_HIRES.F90 ######################################################################## [ccpp-arg-table] @@ -55,7 +55,7 @@ long_name = MPI communicator units = index dimensions = () - type = integer + type = MPI_Comm intent = in [mpirank] standard_name = mpi_rank @@ -279,6 +279,7 @@ type = real kind = kind_phys intent = in + optional = True [dx] standard_name = characteristic_grid_lengthscale long_name = relative dx for the grid cell diff --git a/physics/GFDL_parse_tracers.F90 b/physics/MP/GFDL/GFDL_parse_tracers.F90 similarity index 100% rename from physics/GFDL_parse_tracers.F90 rename to physics/MP/GFDL/GFDL_parse_tracers.F90 diff --git a/physics/fv_sat_adj.F90 b/physics/MP/GFDL/fv_sat_adj.F90 similarity index 98% rename from physics/fv_sat_adj.F90 rename to physics/MP/GFDL/fv_sat_adj.F90 index 53543485b..22077b9bb 100644 --- a/physics/fv_sat_adj.F90 +++ b/physics/MP/GFDL/fv_sat_adj.F90 @@ -230,7 +230,7 @@ end subroutine fv_sat_adj_finalize !! \section arg_table_fv_sat_adj_run Argument Table !! \htmlinclude fv_sat_adj_run.html !! -subroutine fv_sat_adj_run(mdt, zvir, is, ie, isd, ied, kmp, km, kmdelz, js, je, jsd, jed, & +subroutine fv_sat_adj_run(mdt, zvir, is, ie, isd, ied, isc1, iec1, isc2, iec2, kmp, km, kmdelz, js, je, jsd, jed, jsc1, jec1, jsc2, jec2, & ng, hydrostatic, fast_mp_consv, te0_2d, te0, ngas, qvi, qv, ql, qi, qr, & qs, qg, hs, peln, delz, delp, pt, pkz, q_con, akap, cappa, area, dtdt, & out_dt, last_step, do_qa, qa, & @@ -245,6 +245,10 @@ subroutine fv_sat_adj_run(mdt, zvir, is, ie, isd, ied, kmp, km, kmdelz, js, je, integer, intent(in) :: ie integer, intent(in) :: isd integer, intent(in) :: ied + integer, intent(in) :: isc1 + integer, intent(in) :: iec1 + integer, intent(in) :: isc2 + integer, intent(in) :: iec2 integer, intent(in) :: kmp integer, intent(in) :: km integer, intent(in) :: kmdelz @@ -252,6 +256,10 @@ subroutine fv_sat_adj_run(mdt, zvir, is, ie, isd, ied, kmp, km, kmdelz, js, je, integer, intent(in) :: je integer, intent(in) :: jsd integer, intent(in) :: jed + integer, intent(in) :: jsc1 + integer, intent(in) :: jec1 + integer, intent(in) :: jsc2 + integer, intent(in) :: jec2 integer, intent(in) :: ng logical, intent(in) :: hydrostatic logical, intent(in) :: fast_mp_consv @@ -259,7 +267,11 @@ subroutine fv_sat_adj_run(mdt, zvir, is, ie, isd, ied, kmp, km, kmdelz, js, je, real(kind=kind_dyn), intent( out) :: te0(isd:ied, jsd:jed, 1:km) ! If multi-gases physics are not used, ngas is one and qvi identical to qv integer, intent(in) :: ngas - real(kind=kind_dyn), intent(inout) :: qvi(isd:ied, jsd:jed, 1:km, 1:ngas) +#ifdef MULTI_GASES + real(kind=kind_dyn), intent(inout), optional :: qvi(isd:ied, jsd:jed, 1:km, 1:ngas) +#else + real(kind=kind_dyn), intent(inout), optional :: qvi(:,:,:,:) +#endif real(kind=kind_dyn), intent(inout) :: qv(isd:ied, jsd:jed, 1:km) real(kind=kind_dyn), intent(inout) :: ql(isd:ied, jsd:jed, 1:km) real(kind=kind_dyn), intent(inout) :: qi(isd:ied, jsd:jed, 1:km) diff --git a/physics/fv_sat_adj.meta b/physics/MP/GFDL/fv_sat_adj.meta similarity index 72% rename from physics/fv_sat_adj.meta rename to physics/MP/GFDL/fv_sat_adj.meta index 5cdc96358..304bd3ab3 100644 --- a/physics/fv_sat_adj.meta +++ b/physics/MP/GFDL/fv_sat_adj.meta @@ -1,7 +1,9 @@ [ccpp-table-properties] name = fv_sat_adj type = scheme - dependencies = machine.F,module_gfdl_cloud_microphys.F90,module_mp_radar.F90,multi_gases.F90,physcons.F90 + dependencies = ../../hooks/machine.F,../../hooks/physcons.F90 + dependencies = module_gfdl_cloud_microphys.F90,multi_gases.F90 + dependencies = ../module_mp_radar.F90 ######################################################################## [ccpp-arg-table] @@ -135,6 +137,34 @@ dimensions = () type = integer intent = in +[isc1] + standard_name = starting_x_direction_index_alloc1 + long_name = starting X direction index for allocation + units = count + dimensions = () + type = integer + intent = in +[iec1] + standard_name = ending_x_direction_index_alloc1 + long_name = ending X direction index for allocation + units = count + dimensions = () + type = integer + intent = in +[isc2] + standard_name = starting_x_direction_index_alloc2 + long_name = starting X direction index for allocation + units = count + dimensions = () + type = integer + intent = in +[iec2] + standard_name = ending_x_direction_index_alloc2 + long_name = ending X direction index for allocation + units = count + dimensions = () + type = integer + intent = in [isd] standard_name = starting_x_direction_index_domain long_name = starting X direction index for domain @@ -198,6 +228,34 @@ dimensions = () type = integer intent = in +[jsc1] + standard_name = starting_y_direction_index_alloc1 + long_name = starting X direction index for allocation + units = count + dimensions = () + type = integer + intent = in +[jec1] + standard_name = ending_y_direction_index_alloc1 + long_name = ending X direction index for allocation + units = count + dimensions = () + type = integer + intent = in +[jsc2] + standard_name = starting_y_direction_index_alloc2 + long_name = starting X direction index for allocation + units = count + dimensions = () + type = integer + intent = in +[jec2] + standard_name = ending_y_direction_index_alloc2 + long_name = ending X direction index for allocation + units = count + dimensions = () + type = integer + intent = in [ng] standard_name = number_of_ghost_zones long_name = number of ghost zones defined in fv_mp @@ -246,15 +304,16 @@ standard_name = gas_tracers_for_multi_gas_physics_at_Lagrangian_surface long_name = gas tracers for multi gas physics at Lagrangian surface units = kg kg-1 - dimensions = (starting_x_direction_index_domain:ending_x_direction_index_domain,starting_y_direction_index_domain:ending_y_direction_index_domain,1:vertical_dimension_for_fast_physics,1:number_of_gases_for_multi_gases_physics) + dimensions = (starting_x_direction_index_alloc1:ending_x_direction_index_alloc1,starting_y_direction_index_alloc1:ending_y_direction_index_alloc1,1:vertical_dimension_for_fast_physics,1:number_of_gases_for_multi_gases_physics) type = real kind = kind_dyn intent = inout + optional = True [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) + dimensions = (starting_x_direction_index_alloc1:ending_x_direction_index_alloc1,starting_y_direction_index_alloc1:ending_y_direction_index_alloc1,1:vertical_dimension_for_fast_physics) type = real kind = kind_dyn intent = inout @@ -262,7 +321,7 @@ standard_name = cloud_liquid_water_specific_humidity_at_Lagrangian_surface long_name = cloud liquid water specific humidity updated by fast physics at Lagrangian surface units = kg kg-1 - dimensions = (starting_x_direction_index_domain:ending_x_direction_index_domain,starting_y_direction_index_domain:ending_y_direction_index_domain,1:vertical_dimension_for_fast_physics) + dimensions = (starting_x_direction_index_alloc1:ending_x_direction_index_alloc1,starting_y_direction_index_alloc1:ending_y_direction_index_alloc1,1:vertical_dimension_for_fast_physics) type = real kind = kind_dyn intent = inout @@ -270,7 +329,7 @@ standard_name = cloud_ice_specific_humidity_at_Lagrangian_surface long_name = cloud ice specific humidity updated by fast physics at Lagrangian surface units = kg kg-1 - dimensions = (starting_x_direction_index_domain:ending_x_direction_index_domain,starting_y_direction_index_domain:ending_y_direction_index_domain,1:vertical_dimension_for_fast_physics) + dimensions = (starting_x_direction_index_alloc1:ending_x_direction_index_alloc1,starting_y_direction_index_alloc1:ending_y_direction_index_alloc1,1:vertical_dimension_for_fast_physics) type = real kind = kind_dyn intent = inout @@ -278,7 +337,7 @@ standard_name = cloud_rain_specific_humidity_at_Lagrangian_surface long_name = cloud rain specific humidity updated by fast physics at Lagrangian surface units = kg kg-1 - dimensions = (starting_x_direction_index_domain:ending_x_direction_index_domain,starting_y_direction_index_domain:ending_y_direction_index_domain,1:vertical_dimension_for_fast_physics) + dimensions = (starting_x_direction_index_alloc1:ending_x_direction_index_alloc1,starting_y_direction_index_alloc1:ending_y_direction_index_alloc1,1:vertical_dimension_for_fast_physics) type = real kind = kind_dyn intent = inout @@ -286,7 +345,7 @@ standard_name = cloud_snow_specific_humidity_at_Lagrangian_surface long_name = cloud snow specific humidity updated by fast physics at Lagrangian surface units = kg kg-1 - dimensions = (starting_x_direction_index_domain:ending_x_direction_index_domain,starting_y_direction_index_domain:ending_y_direction_index_domain,1:vertical_dimension_for_fast_physics) + dimensions = (starting_x_direction_index_alloc1:ending_x_direction_index_alloc1,starting_y_direction_index_alloc1:ending_y_direction_index_alloc1,1:vertical_dimension_for_fast_physics) type = real kind = kind_dyn intent = inout @@ -294,7 +353,7 @@ standard_name = cloud_graupel_specific_humidity_at_Lagrangian_surface long_name = cloud graupel specific humidity updated by fast physics at Lagrangian surface units = kg kg-1 - dimensions = (starting_x_direction_index_domain:ending_x_direction_index_domain,starting_y_direction_index_domain:ending_y_direction_index_domain,1:vertical_dimension_for_fast_physics) + dimensions = (starting_x_direction_index_alloc1:ending_x_direction_index_alloc1,starting_y_direction_index_alloc1:ending_y_direction_index_alloc1,1:vertical_dimension_for_fast_physics) type = real kind = kind_dyn intent = inout @@ -302,7 +361,7 @@ standard_name = surface_geopotential_at_Lagrangian_surface long_name = surface geopotential at Lagrangian surface units = m2 s-2 - dimensions = (starting_x_direction_index_domain:ending_x_direction_index_domain,starting_y_direction_index_domain:ending_y_direction_index_domain) + dimensions = (starting_x_direction_index_alloc1:ending_x_direction_index_alloc1,starting_y_direction_index_alloc1:ending_y_direction_index_alloc1) type = real kind = kind_dyn intent = in @@ -310,7 +369,7 @@ standard_name = log_pressure_at_Lagrangian_surface long_name = logarithm of pressure at Lagrangian surface units = Pa - dimensions = (starting_x_direction_index:ending_x_direction_index,1:vertical_dimension_for_fast_physics_plus_one,starting_y_direction_index:ending_y_direction_index) + dimensions = (starting_x_direction_index_alloc2:ending_x_direction_index_alloc2,1:vertical_dimension_for_fast_physics_plus_one,starting_y_direction_index_alloc2:ending_y_direction_index_alloc2) type = real kind = kind_dyn intent = in @@ -318,7 +377,7 @@ standard_name = thickness_at_Lagrangian_surface long_name = thickness at Lagrangian_surface units = m - dimensions = (starting_x_direction_index:ending_x_direction_index,starting_y_direction_index:ending_y_direction_index,1:vertical_dimension_for_thickness_at_Lagrangian_surface) + dimensions = (starting_x_direction_index_alloc2:ending_x_direction_index_alloc2,starting_y_direction_index_alloc2:ending_y_direction_index_alloc2,1:vertical_dimension_for_thickness_at_Lagrangian_surface) type = real kind = kind_dyn intent = in @@ -326,7 +385,7 @@ standard_name = pressure_thickness_at_Lagrangian_surface long_name = pressure thickness at Lagrangian surface units = Pa - dimensions = (starting_x_direction_index_domain:ending_x_direction_index_domain,starting_y_direction_index_domain:ending_y_direction_index_domain,1:vertical_dimension_for_fast_physics) + dimensions = (starting_x_direction_index_alloc1:ending_x_direction_index_alloc1,starting_y_direction_index_alloc1:ending_y_direction_index_alloc1,1:vertical_dimension_for_fast_physics) type = real kind = kind_dyn intent = in @@ -334,7 +393,7 @@ standard_name = virtual_temperature_at_Lagrangian_surface long_name = virtual temperature at Lagrangian surface units = K - dimensions = (starting_x_direction_index_domain:ending_x_direction_index_domain,starting_y_direction_index_domain:ending_y_direction_index_domain,1:vertical_dimension_for_fast_physics) + dimensions = (starting_x_direction_index_alloc1:ending_x_direction_index_alloc1,starting_y_direction_index_alloc1:ending_y_direction_index_alloc1,1:vertical_dimension_for_fast_physics) type = real kind = kind_dyn intent = inout @@ -342,7 +401,7 @@ standard_name = finite_volume_mean_edge_pressure_raised_to_the_power_of_kappa long_name = finite-volume mean edge pressure in Pa raised to the power of kappa units = 1 - dimensions = (starting_x_direction_index:ending_x_direction_index,starting_y_direction_index:ending_y_direction_index,1:vertical_dimension_for_fast_physics) + dimensions = (starting_x_direction_index_alloc2:ending_x_direction_index_alloc2,starting_y_direction_index_alloc2:ending_y_direction_index_alloc2,1:vertical_dimension_for_fast_physics) type = real kind = kind_dyn intent = inout @@ -350,7 +409,7 @@ standard_name = cloud_condensed_water_specific_humidity_at_Lagrangian_surface long_name = cloud condensed water specific humidity updated by fast physics at Lagrangian surface units = kg kg-1 - dimensions = (starting_x_direction_index_domain:ending_x_direction_index_domain,starting_y_direction_index_domain:ending_y_direction_index_domain,1:vertical_dimension_for_condensed_water_at_Lagrangian_surface) + dimensions = (starting_x_direction_index_alloc1:ending_x_direction_index_alloc1,starting_y_direction_index_alloc1:ending_y_direction_index_alloc1,1:vertical_dimension_for_condensed_water_at_Lagrangian_surface) type = real kind = kind_dyn intent = inout @@ -374,7 +433,7 @@ standard_name = cell_area_for_fast_physics long_name = area of the grid cell for fast physics units = m2 - dimensions = (starting_x_direction_index_domain:ending_x_direction_index_domain,starting_y_direction_index_domain:ending_y_direction_index_domain) + dimensions = (starting_x_direction_index_alloc1:ending_x_direction_index_alloc1,starting_y_direction_index_alloc1:ending_y_direction_index_alloc1) type = real kind = kind_grid intent = in @@ -411,7 +470,7 @@ standard_name = cloud_fraction_at_Lagrangian_surface long_name = cloud fraction at Lagrangian surface units = none - dimensions = (starting_x_direction_index_domain:ending_x_direction_index_domain,starting_y_direction_index_domain:ending_y_direction_index_domain,1:vertical_dimension_for_fast_physics) + dimensions = (starting_x_direction_index_alloc1:ending_x_direction_index_alloc1,starting_y_direction_index_alloc1:ending_y_direction_index_alloc1,1:vertical_dimension_for_fast_physics) type = real kind = kind_dyn intent = out diff --git a/physics/gfdl_cloud_microphys.F90 b/physics/MP/GFDL/gfdl_cloud_microphys.F90 similarity index 96% rename from physics/gfdl_cloud_microphys.F90 rename to physics/MP/GFDL/gfdl_cloud_microphys.F90 index 0fd84c7ea..8b149616e 100644 --- a/physics/gfdl_cloud_microphys.F90 +++ b/physics/MP/GFDL/gfdl_cloud_microphys.F90 @@ -144,10 +144,10 @@ subroutine gfdl_cloud_microphys_run( real(kind=kind_phys), intent(in ), dimension(:,:) :: phii ! rain/snow/ice/graupel/precip amounts, fraction of frozen precip - real(kind_phys), intent(out ), dimension(:) :: rain0 - real(kind_phys), intent(out ), dimension(:) :: snow0 - real(kind_phys), intent(out ), dimension(:) :: ice0 - real(kind_phys), intent(out ), dimension(:) :: graupel0 + real(kind_phys), intent(out ), dimension(:), optional :: rain0 + real(kind_phys), intent(out ), dimension(:), optional :: snow0 + real(kind_phys), intent(out ), dimension(:), optional :: ice0 + real(kind_phys), intent(out ), dimension(:), optional :: graupel0 real(kind_phys), intent(out ), dimension(:) :: prcp0 real(kind_phys), intent(out ), dimension(:) :: sr @@ -157,10 +157,10 @@ subroutine gfdl_cloud_microphys_run( logical, intent (in) :: lradar real(kind=kind_phys), intent(inout), dimension(:,:) :: refl_10cm logical, intent (in) :: reset, effr_in - real(kind=kind_phys), intent(inout), dimension(:,:) :: rew, rei, rer, res, reg + real(kind=kind_phys), intent(inout), dimension(:,:), optional :: rew, rei, rer, res, reg logical, intent (in) :: cplchm ! ice and liquid water 3d precipitation fluxes - only allocated if cplchm is .true. - real(kind=kind_phys), intent(inout), dimension(:,:) :: pfi_lsan, pfl_lsan + real(kind=kind_phys), intent(inout), dimension(:,:), optional :: pfi_lsan, pfl_lsan character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg diff --git a/physics/gfdl_cloud_microphys.meta b/physics/MP/GFDL/gfdl_cloud_microphys.meta similarity index 97% rename from physics/gfdl_cloud_microphys.meta rename to physics/MP/GFDL/gfdl_cloud_microphys.meta index 5e752b473..01f848c77 100644 --- a/physics/gfdl_cloud_microphys.meta +++ b/physics/MP/GFDL/gfdl_cloud_microphys.meta @@ -1,7 +1,9 @@ [ccpp-table-properties] name = gfdl_cloud_microphys type = scheme - dependencies = machine.F,module_mp_radar.F90,module_gfdl_cloud_microphys.F90 + dependencies = ../../hooks/machine.F + dependencies = ../module_mp_radar.F90 + dependencies = module_gfdl_cloud_microphys.F90 ######################################################################## [ccpp-arg-table] @@ -309,6 +311,7 @@ type = real kind = kind_phys intent = out + optional = True [ice0] standard_name = lwe_thickness_of_ice_amount long_name = ice fall on physics timestep @@ -317,6 +320,7 @@ type = real kind = kind_phys intent = out + optional = True [snow0] standard_name = lwe_thickness_of_snow_amount long_name = snow fall on physics timestep @@ -325,6 +329,7 @@ type = real kind = kind_phys intent = out + optional = True [graupel0] standard_name = lwe_thickness_of_graupel_amount long_name = graupel fall on physics timestep @@ -333,6 +338,7 @@ type = real kind = kind_phys intent = out + optional = True [prcp0] standard_name = lwe_thickness_of_explicit_precipitation_amount long_name = explicit precipitation (rain, ice, snow, graupel) on physics timestep @@ -408,6 +414,7 @@ type = real kind = kind_phys intent = inout + optional = True [rei] standard_name = effective_radius_of_stratiform_cloud_ice_particle long_name = eff. radius of cloud ice water particle in micrometer @@ -416,6 +423,7 @@ type = real kind = kind_phys intent = inout + optional = True [rer] standard_name = effective_radius_of_stratiform_cloud_rain_particle long_name = effective radius of cloud rain particle in micrometers @@ -424,6 +432,7 @@ type = real kind = kind_phys intent = inout + optional = True [res] standard_name = effective_radius_of_stratiform_cloud_snow_particle long_name = effective radius of cloud snow particle in micrometers @@ -432,6 +441,7 @@ type = real kind = kind_phys intent = inout + optional = True [reg] standard_name = effective_radius_of_stratiform_cloud_graupel_particle long_name = eff. radius of cloud graupel particle in micrometer @@ -440,6 +450,7 @@ type = real kind = kind_phys intent = inout + optional = True [cplchm] standard_name = flag_for_chemistry_coupling long_name = flag controlling cplchm collection (default off) @@ -455,6 +466,7 @@ type = real kind = kind_phys intent = inout + optional = True [pfl_lsan] standard_name = liquid_flux_due_to_large_scale_precipitation long_name = instantaneous 3D flux of liquid water from nonconvective precipitation @@ -463,6 +475,7 @@ type = real kind = kind_phys intent = inout + optional = True [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/module_gfdl_cloud_microphys.F90 b/physics/MP/GFDL/module_gfdl_cloud_microphys.F90 similarity index 100% rename from physics/module_gfdl_cloud_microphys.F90 rename to physics/MP/GFDL/module_gfdl_cloud_microphys.F90 diff --git a/physics/multi_gases.F90 b/physics/MP/GFDL/multi_gases.F90 similarity index 100% rename from physics/multi_gases.F90 rename to physics/MP/GFDL/multi_gases.F90 diff --git a/physics/aer_cloud.F b/physics/MP/Morrison_Gettelman/aer_cloud.F similarity index 100% rename from physics/aer_cloud.F rename to physics/MP/Morrison_Gettelman/aer_cloud.F diff --git a/physics/aerclm_def.F b/physics/MP/Morrison_Gettelman/aerclm_def.F similarity index 100% rename from physics/aerclm_def.F rename to physics/MP/Morrison_Gettelman/aerclm_def.F diff --git a/physics/aerinterp.F90 b/physics/MP/Morrison_Gettelman/aerinterp.F90 similarity index 95% rename from physics/aerinterp.F90 rename to physics/MP/Morrison_Gettelman/aerinterp.F90 index 4e2dc9047..174a1a1a1 100644 --- a/physics/aerinterp.F90 +++ b/physics/MP/Morrison_Gettelman/aerinterp.F90 @@ -152,7 +152,7 @@ END SUBROUTINE read_aerdata ! !********************************************************************** SUBROUTINE read_aerdataf ( me, master, iflip, idate, FHOUR, errmsg, errflg) - use machine, only: kind_phys, kind_io4, kind_io8 + use machine, only: kind_phys, kind_dbl_prec use aerclm_def !--- in/out @@ -165,10 +165,8 @@ SUBROUTINE read_aerdataf ( me, master, iflip, idate, FHOUR, errmsg, errflg) logical :: file_exist integer IDAT(8),JDAT(8) real(kind=kind_phys) rjday - real(8) RINC(5) + real(kind=kind_dbl_prec) rinc(5) integer jdow, jdoy, jday - real(4) rinc4(5) - integer w3kindreal,w3kindint integer, allocatable :: invardims(:) ! @@ -186,13 +184,7 @@ SUBROUTINE read_aerdataf ( me, master, iflip, idate, FHOUR, errmsg, errflg) IDAT(5) = IDATE(1) RINC = 0. RINC(2) = FHOUR - call w3kind(w3kindreal,w3kindint) - if(w3kindreal == 4) then - rinc4 = rinc - CALL W3MOVDAT(RINC4,IDAT,JDAT) - else - CALL W3MOVDAT(RINC,IDAT,JDAT) - endif + CALL W3MOVDAT(RINC,IDAT,JDAT) ! jdow = 0 jdoy = 0 @@ -282,7 +274,7 @@ END SUBROUTINE setindxaer SUBROUTINE aerinterpol( me,master,nthrds,npts,IDATE,FHOUR,iflip, jindx1,jindx2, & ddy,iindx1,iindx2,ddx,lev,prsl,aerout, errmsg,errflg) ! - use machine, only: kind_phys, kind_io4, kind_io8 + use machine, only: kind_phys, kind_dbl_prec use aerclm_def implicit none @@ -304,11 +296,8 @@ SUBROUTINE aerinterpol( me,master,nthrds,npts,IDATE,FHOUR,iflip, jindx1,jindx2, real(kind=kind_phys) aerpm(npts,levsaer,ntrcaer) real(kind=kind_phys) prsl(npts,lev), aerpres(npts,levsaer) real(kind=kind_phys) rjday + real(kind=kind_dbl_prec) rinc(5) integer jdow, jdoy, jday - real(8) RINC(5) - real(4) rinc4(5) - integer w3kindreal,w3kindint - ! errflg = 0 errmsg = ' ' @@ -319,13 +308,7 @@ SUBROUTINE aerinterpol( me,master,nthrds,npts,IDATE,FHOUR,iflip, jindx1,jindx2, IDAT(5) = IDATE(1) RINC = 0. RINC(2) = FHOUR - call w3kind(w3kindreal,w3kindint) - if(w3kindreal == 4) then - rinc4 = rinc - CALL W3MOVDAT(RINC4,IDAT,JDAT) - else - CALL W3MOVDAT(RINC,IDAT,JDAT) - endif + CALL W3MOVDAT(RINC,IDAT,JDAT) ! jdow = 0 jdoy = 0 @@ -426,7 +409,7 @@ SUBROUTINE aerinterpol( me,master,nthrds,npts,IDATE,FHOUR,iflip, jindx1,jindx2, ENDDO else DO k=1, levsaer-1 !! from sfc to toa - IF(prsl(j,L) < aerpres(j,k) .and. prsl(j,L)>aerpres(j,k+1)) then + IF(prsl(j,L) <= aerpres(j,k) .and. prsl(j,L)>aerpres(j,k+1)) then i1 = k i2 = min(k+1,levsaer) exit diff --git a/physics/cldmacro.F b/physics/MP/Morrison_Gettelman/cldmacro.F similarity index 100% rename from physics/cldmacro.F rename to physics/MP/Morrison_Gettelman/cldmacro.F diff --git a/physics/cldwat2m_micro.F b/physics/MP/Morrison_Gettelman/cldwat2m_micro.F similarity index 100% rename from physics/cldwat2m_micro.F rename to physics/MP/Morrison_Gettelman/cldwat2m_micro.F diff --git a/physics/m_micro.F90 b/physics/MP/Morrison_Gettelman/m_micro.F90 similarity index 99% rename from physics/m_micro.F90 rename to physics/MP/Morrison_Gettelman/m_micro.F90 index 714372d53..c712d5fe8 100644 --- a/physics/m_micro.F90 +++ b/physics/MP/Morrison_Gettelman/m_micro.F90 @@ -199,7 +199,7 @@ subroutine m_micro_run( im, lm, flipv, dt_i & & prsl_i,u_i,v_i,phil, omega_i, QLLS_i,QILS_i, & & lwheat_i,swheat_i real (kind=kind_phys), dimension(:,0:),intent(in):: prsi_i, phii - real (kind=kind_phys), dimension(:,:), intent(in) :: & + real (kind=kind_phys), dimension(:,:),intent(in), optional :: & & CNV_DQLDT_i, CLCN_i, QLCN_i, QICN_i, & & CNV_MFD_i, cf_upi, CNV_FICE_i, CNV_NDROP_i, & & CNV_NICE_i, w_upi @@ -214,8 +214,9 @@ subroutine m_micro_run( im, lm, flipv, dt_i & ! & CNVPRCP ! output - real (kind=kind_phys),dimension(:,:), intent(out) :: lwm_o, qi_o, & - cldreffl, cldreffi, cldreffr, cldreffs, cldreffg + real (kind=kind_phys),dimension(:,:), intent(out) :: lwm_o, qi_o + real (kind=kind_phys),dimension(:,:), intent(out), optional :: & + cldreffl, cldreffi, cldreffr, cldreffs, cldreffg real (kind=kind_phys),dimension(:), intent(out) :: rn_o, sr_o character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -224,10 +225,10 @@ subroutine m_micro_run( im, lm, flipv, dt_i & ! Anning Cheng 10/24/2016 twat for total water, diagnostic purpose integer, dimension(:), intent(inout):: KCBL real (kind=kind_phys),dimension(:,:),intent(inout):: q_io, t_io, & - & ncpl_io,ncpi_io,CLLS_io - real (kind=kind_phys),dimension(:,:),intent(inout):: rnw_io,snw_io,& - & ncpr_io, ncps_io, & - & qgl_io, ncgl_io + & ncpi_io + real (kind=kind_phys),dimension(:,:),intent(inout), optional :: & + rnw_io, snw_io, ncpr_io, ncps_io, qgl_io, ncgl_io, ncpl_io, & + CLLS_io ! *GJF !Moo real (kind=kind_phys),dimension(im,lm),intent(inout):: CLLS_io diff --git a/physics/m_micro.meta b/physics/MP/Morrison_Gettelman/m_micro.meta similarity index 97% rename from physics/m_micro.meta rename to physics/MP/Morrison_Gettelman/m_micro.meta index a9b5ec4db..6068d4dd9 100644 --- a/physics/m_micro.meta +++ b/physics/MP/Morrison_Gettelman/m_micro.meta @@ -1,7 +1,9 @@ [ccpp-table-properties] name = m_micro type = scheme - dependencies = aer_cloud.F,aerclm_def.F,cldmacro.F,cldwat2m_micro.F,machine.F,micro_mg_utils.F90,micro_mg2_0.F90,micro_mg3_0.F90,physcons.F90,wv_saturation.F,machine.F + dependencies = ../../hooks/machine.F,../../hooks/physcons.F90 + dependencies = aer_cloud.F,aerclm_def.F,cldmacro.F,cldwat2m_micro.F + dependencies = micro_mg_utils.F90,micro_mg2_0.F90,micro_mg3_0.F90,wv_saturation.F ######################################################################## [ccpp-arg-table] @@ -393,6 +395,7 @@ type = real kind = kind_phys intent = in + optional = True [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 @@ -409,6 +412,7 @@ type = real kind = kind_phys intent = in + optional = True [lwheat_i] standard_name = tendency_of_air_temperature_due_to_longwave_heating_on_radiation_timestep long_name = total sky lw heating rate @@ -433,6 +437,7 @@ type = real kind = kind_phys intent = in + optional = True [cf_upi] standard_name = convective_cloud_fraction_for_microphysics long_name = convective cloud fraction for microphysics @@ -441,6 +446,7 @@ type = real kind = kind_phys intent = in + optional = True [frland] standard_name = land_area_fraction_for_microphysics long_name = land area fraction used in microphysics schemes @@ -465,6 +471,7 @@ type = real kind = kind_phys intent = in + optional = True [cnv_dqldt_i] standard_name = tendency_of_cloud_water_due_to_convective_microphysics long_name = tendency of cloud water due to convective microphysics @@ -473,6 +480,7 @@ type = real kind = kind_phys intent = in + optional = True [clcn_i] standard_name = convective_cloud_volume_fraction long_name = convective cloud volume fraction @@ -481,6 +489,7 @@ type = real kind = kind_phys intent = in + optional = True [u_i] standard_name = x_wind_of_new_state long_name = zonal wind updated by physics @@ -537,6 +546,7 @@ type = real kind = kind_phys intent = in + optional = True [cnv_ndrop_i] standard_name = number_concentration_of_cloud_liquid_water_particles_for_detrainment long_name = droplet number concentration in convective detrainment @@ -545,6 +555,7 @@ type = real kind = kind_phys intent = in + optional = True [cnv_nice_i] standard_name = number_concentration_of_ice_crystals_for_detrainment long_name = crystal number concentration in convective detrainment @@ -553,6 +564,7 @@ type = real kind = kind_phys intent = in + optional = True [q_io] standard_name = specific_humidity_of_new_state long_name = water vapor specific humidity updated by physics @@ -609,6 +621,7 @@ type = real kind = kind_phys intent = inout + optional = True [ncpi_io] standard_name = mass_number_concentration_of_cloud_ice_water_crystals_in_air_of_new_state long_name = number concentration of ice updated by physics @@ -632,6 +645,7 @@ type = real kind = kind_phys intent = inout + optional = True [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 @@ -640,6 +654,7 @@ type = real kind = kind_phys intent = inout + optional = True [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 @@ -648,6 +663,7 @@ type = real kind = kind_phys intent = inout + optional = True [ncpr_io] standard_name = local_rain_number_concentration long_name = number concentration of rain local to physics @@ -656,6 +672,7 @@ type = real kind = kind_phys intent = inout + optional = True [ncps_io] standard_name = local_snow_number_concentration long_name = number concentration of snow local to physics @@ -664,6 +681,7 @@ type = real kind = kind_phys intent = inout + optional = True [ncgl_io] standard_name = local_graupel_number_concentration long_name = number concentration of graupel local to physics @@ -672,6 +690,7 @@ type = real kind = kind_phys intent = inout + optional = True [clls_io] standard_name = cloud_fraction_for_MG long_name = cloud fraction used by Morrison-Gettelman MP @@ -680,6 +699,7 @@ type = real kind = kind_phys intent = inout + optional = True [kcbl] standard_name = vertical_index_at_cloud_base long_name = vertical index at cloud base @@ -695,6 +715,7 @@ type = real kind = kind_phys intent = out + optional = True [cldreffi] standard_name = effective_radius_of_stratiform_cloud_ice_particle long_name = effective radius of cloud ice water particle in micrometers @@ -703,6 +724,7 @@ type = real kind = kind_phys intent = out + optional = True [cldreffr] standard_name = effective_radius_of_stratiform_cloud_rain_particle long_name = effective radius of cloud rain particle in micrometers @@ -711,6 +733,7 @@ type = real kind = kind_phys intent = out + optional = True [cldreffs] standard_name = effective_radius_of_stratiform_cloud_snow_particle long_name = effective radius of cloud snow particle in micrometers @@ -719,6 +742,7 @@ type = real kind = kind_phys intent = out + optional = True [cldreffg] standard_name = effective_radius_of_stratiform_cloud_graupel_particle long_name = effective radius of cloud graupel particle in micrometers @@ -727,6 +751,7 @@ type = real kind = kind_phys intent = out + optional = True [ntrcaer] standard_name = number_of_aerosol_tracers_MG long_name = number of aerosol tracers for Morrison Gettelman MP diff --git a/physics/m_micro_post.F90 b/physics/MP/Morrison_Gettelman/m_micro_post.F90 similarity index 92% rename from physics/m_micro_post.F90 rename to physics/MP/Morrison_Gettelman/m_micro_post.F90 index a61ee4874..0a91e25ef 100644 --- a/physics/m_micro_post.F90 +++ b/physics/MP/Morrison_Gettelman/m_micro_post.F90 @@ -22,12 +22,12 @@ subroutine m_micro_post_run( & integer, intent(in) :: im, levs, fprcp logical, intent(in) :: mg3_as_mg2 - real(kind=kind_phys), intent(in ) :: ncpr(:,:) - real(kind=kind_phys), intent(in ) :: ncps(:,:) - real(kind=kind_phys), intent(in ) :: ncgl(:,:) - real(kind=kind_phys), intent(inout) :: qrn(:,:) - real(kind=kind_phys), intent(inout) :: qsnw(:,:) - real(kind=kind_phys), intent(inout) :: qgl(:,:) + real(kind=kind_phys), intent(in ),optional :: ncpr(:,:) + real(kind=kind_phys), intent(in ),optional :: ncps(:,:) + real(kind=kind_phys), intent(in ),optional :: ncgl(:,:) + real(kind=kind_phys), intent(inout),optional :: qrn(:,:) + real(kind=kind_phys), intent(inout),optional :: qsnw(:,:) + real(kind=kind_phys), intent(inout),optional :: qgl(:,:) real(kind=kind_phys), intent(in ) :: gq0_ice(:,:) real(kind=kind_phys), intent(out ) :: gq0_rain(:,:) real(kind=kind_phys), intent(out ) :: gq0_snow(:,:) diff --git a/physics/m_micro_post.meta b/physics/MP/Morrison_Gettelman/m_micro_post.meta similarity index 97% rename from physics/m_micro_post.meta rename to physics/MP/Morrison_Gettelman/m_micro_post.meta index 684ac3f21..62449c5fc 100644 --- a/physics/m_micro_post.meta +++ b/physics/MP/Morrison_Gettelman/m_micro_post.meta @@ -2,7 +2,7 @@ [ccpp-table-properties] name = m_micro_post type = scheme - dependencies = machine.F + dependencies = ../../hooks/machine.F ######################################################################## [ccpp-arg-table] @@ -44,6 +44,7 @@ type = real kind = kind_phys intent = in + optional = True [ncps] standard_name = local_snow_number_concentration long_name = number concentration of snow local to physics @@ -52,6 +53,7 @@ type = real kind = kind_phys intent = in + optional = True [ncgl] standard_name = local_graupel_number_concentration long_name = number concentration of graupel local to physics @@ -60,6 +62,7 @@ type = real kind = kind_phys intent = in + optional = True [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 @@ -68,6 +71,7 @@ type = real kind = kind_phys intent = inout + optional = True [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 @@ -76,6 +80,7 @@ type = real kind = kind_phys intent = inout + optional = True [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 @@ -84,6 +89,7 @@ type = real kind = kind_phys intent = inout + optional = True [gq0_ice] standard_name = cloud_ice_mixing_ratio_of_new_state long_name = ratio of mass of ice water to mass of dry air plus vapor (without condensates) updated by physics diff --git a/physics/m_micro_pre.F90 b/physics/MP/Morrison_Gettelman/m_micro_pre.F90 similarity index 94% rename from physics/m_micro_pre.F90 rename to physics/MP/Morrison_Gettelman/m_micro_pre.F90 index 9893e0db1..4709a1611 100644 --- a/physics/m_micro_pre.F90 +++ b/physics/MP/Morrison_Gettelman/m_micro_pre.F90 @@ -25,16 +25,15 @@ subroutine m_micro_pre_run (im, levs, do_shoc, skip_macro, fprcp, mg3_as_mg2, gq real(kind=kind_phys), intent(in) :: & gq0_ice(:,:), gq0_water(:,:), gq0_rain(:,:), gq0_snow(:,:), & gq0_graupel(:,:), gq0_rain_nc(:,:), gq0_snow_nc(:,:), & - gq0_graupel_nc(:,:), cld_shoc(:,:), cnvc(:,:), cnvw(:,:), & - gt0(:,:) - - real(kind=kind_phys), intent(inout) :: & + gq0_graupel_nc(:,:), cnvc(:,:), cnvw(:,:), gt0(:,:) + real(kind=kind_phys), intent(in), optional :: cld_shoc(:,:) + real(kind=kind_phys), intent(inout), optional :: & qrn(:,:), qsnw(:,:), qgl(:,:), ncpr(:,:), ncps(:,:), ncgl(:,:), & cld_frc_MG(:,:) real(kind=kind_phys), intent(out) :: clw_ice(:,:), clw_water(:,:) - real(kind=kind_phys), intent(in) :: clcn(:,:) + real(kind=kind_phys), intent(in), optional :: clcn(:,:) character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -132,4 +131,4 @@ subroutine m_micro_pre_run (im, levs, do_shoc, skip_macro, fprcp, mg3_as_mg2, gq end subroutine m_micro_pre_run - end module m_micro_pre \ No newline at end of file + end module m_micro_pre diff --git a/physics/m_micro_pre.meta b/physics/MP/Morrison_Gettelman/m_micro_pre.meta similarity index 97% rename from physics/m_micro_pre.meta rename to physics/MP/Morrison_Gettelman/m_micro_pre.meta index 7ac592833..2b10edba2 100644 --- a/physics/m_micro_pre.meta +++ b/physics/MP/Morrison_Gettelman/m_micro_pre.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = m_micro_pre type = scheme - dependencies = machine.F + dependencies = ../../hooks/machine.F ######################################################################## [ccpp-arg-table] @@ -121,6 +121,7 @@ type = real kind = kind_phys intent = in + optional = True [cnvc] standard_name = convective_cloud_cover long_name = convective cloud cover @@ -169,6 +170,7 @@ type = real kind = kind_phys intent = inout + optional = True [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 @@ -177,6 +179,7 @@ type = real kind = kind_phys intent = inout + optional = True [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 @@ -185,6 +188,7 @@ type = real kind = kind_phys intent = inout + optional = True [ncpr] standard_name = local_rain_number_concentration long_name = number concentration of rain local to physics @@ -193,6 +197,7 @@ type = real kind = kind_phys intent = inout + optional = True [ncps] standard_name = local_snow_number_concentration long_name = number concentration of snow local to physics @@ -201,6 +206,7 @@ type = real kind = kind_phys intent = inout + optional = True [ncgl] standard_name = local_graupel_number_concentration long_name = number concentration of graupel local to physics @@ -209,6 +215,7 @@ type = real kind = kind_phys intent = inout + optional = True [cld_frc_MG] standard_name = cloud_fraction_for_MG long_name = cloud fraction used by Morrison-Gettelman MP @@ -217,6 +224,7 @@ type = real kind = kind_phys intent = inout + optional = True [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 @@ -241,6 +249,7 @@ type = real kind = kind_phys intent = in + optional = True [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/micro_mg2_0.F90 b/physics/MP/Morrison_Gettelman/micro_mg2_0.F90 similarity index 100% rename from physics/micro_mg2_0.F90 rename to physics/MP/Morrison_Gettelman/micro_mg2_0.F90 diff --git a/physics/micro_mg3_0.F90 b/physics/MP/Morrison_Gettelman/micro_mg3_0.F90 similarity index 100% rename from physics/micro_mg3_0.F90 rename to physics/MP/Morrison_Gettelman/micro_mg3_0.F90 diff --git a/physics/micro_mg_utils.F90 b/physics/MP/Morrison_Gettelman/micro_mg_utils.F90 similarity index 100% rename from physics/micro_mg_utils.F90 rename to physics/MP/Morrison_Gettelman/micro_mg_utils.F90 diff --git a/physics/wv_saturation.F b/physics/MP/Morrison_Gettelman/wv_saturation.F similarity index 100% rename from physics/wv_saturation.F rename to physics/MP/Morrison_Gettelman/wv_saturation.F diff --git a/physics/module_mp_nssl_2mom.F90 b/physics/MP/NSSL/module_mp_nssl_2mom.F90 similarity index 77% rename from physics/module_mp_nssl_2mom.F90 rename to physics/MP/NSSL/module_mp_nssl_2mom.F90 index 409bf4019..ad90ec81f 100644 --- a/physics/module_mp_nssl_2mom.F90 +++ b/physics/MP/NSSL/module_mp_nssl_2mom.F90 @@ -1,7 +1,14 @@ !> \file module_mp_nssl_2mom.F90 + + + + + + + !--------------------------------------------------------------------- -! code snapshot: "Feb 24 2022" at "14:27:57" +! code snapshot: "Sep 22 2023" at "22:01:53" !--------------------------------------------------------------------- !--------------------------------------------------------------------- ! IMPORTANT: Best results are attained using the 5th-order WENO (Weighted Essentially Non-Oscillatory) advection option (4) for scalars: @@ -19,37 +26,32 @@ ! WENO references: Jiang and Shu, 1996, J. Comp. Phys. v. 126, 202-223; Shu 2003, Int. J. Comp. Fluid Dyn. v. 17 107-118; ! !>\ingroup mod_mp_nssl2m -!! This module provides a 2-moment bulk microphysics scheme described by -!! Mansell, Zeigler, and Bruning (2010, JAS) -!! -!! This module provides a 2-moment bulk microphysics scheme based on a combination of -!! Straka and Mansell (2005, JAM) and Zeigler (1985, JAS) and modified/upgraded in -!! in Mansell, Zeigler, and Bruning (2010, JAS). Two-moment adaptive sedimentation +!! This module provides a 1/2/3-moment bulk microphysics scheme based on a combination of +!! Straka and Mansell (2005, JAM) and Zeigler (1985, JAS) and modified/upgraded in +!! in Mansell, Zeigler, and Bruning (2010, JAS). Two-moment adaptive sedimentation !! follows Mansell (2010, JAS), using parameter infall = 4. !! !! Added info on graupel density and soaking is in Mansell and Ziegler (2013, JAS) !! -!! Average graupel particle density is predicted, which affects fall speed as well. -!! Hail density prediction is by default disabled in this version, but may be enabled -!! at some point if there is interest. +!! Average graupel and hail particle densities are predicted, which affects fall speed as well. !! !! Maintainer: Ted Mansell, National Severe Storms Laboratory !! !! Microphysics References: !! -!! Mansell, E. R., C. L. Ziegler, and E. C. Bruning, 2010: Simulated electrification of a small +!! Mansell, E. R., C. L. Ziegler, and E. C. Bruning, 2010: Simulated electrification of a small !! thunderstorm with two-moment bulk microphysics. J. Atmos. Sci., 67, 171-194, doi:10. 1175/2009JAS2965.1. !! -!! Mansell, E. R. and C. L. Ziegler, 2013: Aerosol effects on simulated storm electrification and -!! precipitation in a two-moment bulk microphysics model. J. Atmos. Sci., 70 (7), 2032-2050, +!! Mansell, E. R. and C. L. Ziegler, 2013: Aerosol effects on simulated storm electrification and +!! precipitation in a two-moment bulk microphysics model. J. Atmos. Sci., 70 (7), 2032-2050, !! doi:10.1175/JAS-D-12-0264.1. !! -!! Ziegler, C. L., 1985: Retrieval of thermal and microphysical variables in observed convective storms. +!! Ziegler, C. L., 1985: Retrieval of thermal and microphysical variables in observed convective storms. !! Part I: Model development and preliminary testing. J. Atmos. Sci., 42, 1487-1509. !! !! Sedimentation reference: !! -!! Mansell, E. R., 2010: On sedimentation and advection in multimoment bulk microphysics. +!! Mansell, E. R., 2010: On sedimentation and advection in multimoment bulk microphysics. !! J. Atmos. Sci., 67, 3084-3094, doi:10.1175/2010JAS3341.1. ! ! Possible parameters to adjust: @@ -63,18 +65,25 @@ ! Fierro, A. O., E.R. Mansell, C. Ziegler and D. R. MacGorman 2013: The ! implementation of an explicit charging and discharge lightning scheme ! within the WRF-ARW model: Benchmark simulations of a continental squall line, a -! tropical cyclone and a winter storm. Monthly Weather Review, Volume 141, 2390-2415 +! tropical cyclone and a winter storm. Monthly Weather Review, Volume 141, 2390-2415 ! -! Mansell et al. 2005: Charge structure and lightning sensitivity in a simulated +! Mansell et al. 2005: Charge structure and lightning sensitivity in a simulated ! multicell thunderstorm. J. Geophys. Res., 110, D12101, doi:10.1029/2004JD005287 ! ! Note: Some parameters below apply to unreleased features. ! ! !--------------------------------------------------------------------- +! Apr. 2023 +! - Update to 3-moment for rain, graupel, and hail +! - Change default graupel/hail fall speeds to icdx/icdxhl=6 (Milbrandt & Morrison 2013) +! and also set default ehw0=0.9 and ehlw0=0.9 to compensate for lower fall speeds. +! - Change default hail conversion to ihlcnh=-1, and then =1 for 2-mom or =3 for 3-mom, +! using wet growth diameter to convert large graupel +!--------------------------------------------------------------------- ! Sept. 2021: ! Fixes: -! Restored previous formulation of snow reflectivity, as it was realized that the last change incorrectly assumed a fixed +! Restored previous formulation of snow reflectivity, as it was realized that the last change incorrectly assumed a fixed ! density independent of size. Generally lower snow reflectivity values as a result (no effect on microphysics) ! Other: ! Generic fall speed coeffecients (axx,bxx) to accomodate future frozen drops category (no effect) @@ -221,7 +230,7 @@ MODULE module_mp_nssl_2mom real, private :: rho_qr = 1000., cnor = 8.0e5 ! cnor is set in namelist!! rain params real, private :: rho_qs = 100., cnos = 3.0e6 ! set in namelist!! snow params real, private :: rho_qh = 500., cnoh = 4.0e5 ! set in namelist!! graupel params - real, private :: rho_qhl= 900., cnohl = 4.0e4 ! set in namelist!! hail params + real, private :: rho_qhl= 800., cnohl = 4.0e4 ! set in namelist!! hail params real, private :: hdnmn = 170.0 ! minimum graupel density (for variable density graupel) real, private :: hldnmn = 500.0 ! minimum hail density (for variable density hail) @@ -234,8 +243,9 @@ MODULE module_mp_nssl_2mom real , private :: qcmincwrn = 2.0e-3 ! qc threshold for autonconversion (LFO; for 10ICE use qminrncw for ircnw != 5) real , private :: cwdiap = 20.0e-6 ! threshold diameter of cloud drops (Ferrier 1994 autoconversion) real , private :: cwdisp = 0.15 ! assume droplet dispersion parameter (can be 0.3 for maritime) - real , private :: ccn = 0.6e+09 ! set in namelist!! Central plains CCN value - real , public :: qccn ! ccn "mixing ratio" + real , private :: ccn = 0.6e+09 ! set in namelist!! Central plains CCN value + real , private :: ccnuf = 0 ! set in namelist!! Central plains CCN value + real , public :: qccn, qccnuf ! ccn "mixing ratio" real , private :: old_qccn = -1.0 integer, private :: iauttim = 1 ! 10-ice rain delay flag real , private :: auttim = 300. ! 10-ice rain delay time @@ -245,12 +255,17 @@ MODULE module_mp_nssl_2mom ! NMM WRF core does not have special boundary conditions for CCN, therefore set invertccn to true logical, parameter :: invertccn = .true. ! =true for base state of ccn=0, =false for ccn initialized in the base state #else - logical, parameter :: invertccn = .false. ! =true for base state of ccn=0, =false for ccn initialized in the base state + logical, private :: invertccn = .false. ! =true for base state of ccn=0, =false for ccn initialized in the base state #endif logical :: switchccn = .false. real :: old_cccn = -1.0 logical :: restoreccn = .true. ! whether or not to nudge CCN back to base state (qccn) (only applies if CCNA is NOT predicted) real :: ccntimeconst = 3600. ! time constant for CCN restore (either for CCNA or when restoreccn = true) + real, private :: restoreccnfrac = 1.0 ! fraction of evaporated droplets that restore CCN + real :: ufccntimeconst = 6.*3600. ! time constant for UFCCN decay (Blossey et al. 2018) + real :: ufbackground = 0.1e9 ! background ccnuf value (Blossey et al.) + logical :: decayufccn = .false. + integer :: i_uf_or_ccn = 0 ! 0 = ship adds UF; 1 = treat UF as regular ccn (add to qccn) ! sedimentation flags ! itfall -> 0 = 1st order fallout (other options removed) @@ -259,6 +274,7 @@ MODULE module_mp_nssl_2mom integer, private :: itfall = 0 integer, private :: iscfall = 1 integer, private :: irfall = -1 + integer, private :: isfall = 2 ! default limit with method II (more restrictive) logical, private :: do_accurate_sedimentation = .true. ! if true, recalculate fall speeds on sub time steps; (more expensive) ! if false, reuse fall speeds on multiple steps (can have a noticeable speedup) ! Mainly is an issue for small dz near the surface. @@ -269,14 +285,20 @@ MODULE module_mp_nssl_2mom ! 3 -> uses number-wgt for N and Z-weighted correction for N (Method I in Mansell, 2010 JAS) ! 4 -> Hybrid of 2 and 3: Uses minimum N from each method (z-wgt and m-wgt corrections) (Method I+II in Mansell, 2010 JAS) ! 5 -> uses number-wgt for N and uses average of N-wgt and q-wgt instead of Max. + integer :: imydiagalpha = 0 ! apply MY diagnostic shape parameter for fall speeds (1=for fall speed only; 2=also for microphysics rates) real, private :: rainfallfac = 1.0 ! factor to adjust rain fall speed (single moment only) real, private :: icefallfac = 1.5 ! factor to adjust ice fall speed real, private :: snowfallfac = 1.25 ! factor to adjust snow fall speed real, private :: graupelfallfac = 1.0 ! factor to adjust graupel fall speed real, private :: hailfallfac = 1.0 ! factor to adjust hail fall speed integer, private :: icefallopt = 3 ! 1= default, 2 = Ferrier ice fall speed; 3 = adjusted Ferrier (slightly high Vt) - integer, private :: icdx = 3 ! (graupel) 0=Ferrier; 1=leave drag coef. cd fixed; 2=vary by density, 4=set by user with cdxmin,cdxmax,etc. - integer, private :: icdxhl = 3 ! (hail) 0=Ferrier; 1=leave drag coef. cd fixed; 2=vary by density, 4=set by user with cdxmin,cdxmax,etc. + integer, private :: icdx = 6 ! (graupel) 0=Ferrier; 1=leave drag coef. cd fixed; 2=vary by density, 4=set by user with cdxmin,cdxmax,etc. + ! 6= Milbrandt and Morrison (2013) density-based fall speed + integer, private :: icdxhl = 6 ! (hail) 0=Ferrier; 1=leave drag coef. cd fixed; 2=vary by density, 4=set by user with cdxmin,cdxmax,etc. + ! 6= Milbrandt and Morrison (2013) density-based fall speed + real :: axh = 75.7149, bxh = 0.5 + real :: axf = 75.7149, bxf = 0.5 + real :: axhl = 206.984, bxhl = 0.6384 real , private :: cdhmin = 0.45, cdhmax = 0.8 ! defaults for graupel (icdx=4) real , private :: cdhdnmin = 500., cdhdnmax = 800.0 ! defaults for graupel (icdx=4) real , private :: cdhlmin = 0.45, cdhlmax = 0.6 ! defaults for hail (icdx=4) @@ -310,7 +332,7 @@ MODULE module_mp_nssl_2mom integer, private :: irimtim = 0 ! future use ! integer, private :: infdo = 1 ! 1 = calculate number-weighted fall speeds - integer, private :: irimdenopt = 1 ! = 1 for default Macklin; = 2 for experimental Cober and List (1993) + integer, private :: irimdenopt = 1 ! = 1 for default Heymsfield and Pflaum (1985); = 2 for experimental Cober and List (1993); = 3 Macklin real , private :: rimc1 = 300.0, rimc2 = 0.44 ! rime density coeff. and power (Default Heymsfield and Pflaum, 1985) real , private :: rimc3 = 170.0 ! minimum rime density real :: rimc4 = 900.0 ! maximum rime density @@ -325,7 +347,7 @@ MODULE module_mp_nssl_2mom ! (first nucleation is done with a KW sat. adj. step) integer, private :: issfilt = 0 ! flag to turn on filtering of supersaturation field integer, private :: icnuclimit = 0 ! limit droplet nucleation based on Konwar et al. (2012) and Chandrakar et al. (2016) - integer, private :: irenuc = 2 ! =1 to always allow renucleation of droplets within the cloud + integer, private :: irenuc = 2 ! =1 to always allow renucleation of droplets within the cloud (do no use, obsolete) ! =2 renucleation following Twomey/Cohard&Pinty ! =7 New renucleation that requires prediction of the number of activated nuclei ! i.e., not only at cloud base @@ -347,6 +369,7 @@ MODULE module_mp_nssl_2mom ! 0,2, 5.00e-10, 1, 0, 0, 0 : itype1,itype2,cimas0,icfn,ihrn,ibfc,iacr integer, private :: itype1 = 0, itype2 = 2 ! controls Hallett-Mossop process + integer, private :: in_freeze_rain_first = 0 ! =1 use IN to freezed rain drops (if none, then freeze droplets) integer, private :: icenucopt = 1 ! =1 Meyers/Ferrier primary ice nucleation; =2 Thompson/Cooper, =3 Phillips (Meyers/Demott), =4 DeMott (2010) real, private :: naer = 1.0e6 ! background large aerosol conc. for DeMott integer, private :: icfn = 2 ! contact freezing: 0 = off; 1 = hack (ok for single moment); 2 = full Cotton/Meyers version @@ -357,7 +380,9 @@ MODULE module_mp_nssl_2mom integer, private :: iremoveqwfrz = 1 ! Whether to remove (=1) or not (=0) the newly-frozen cloud droplets (ibfc=1) from the CWC used for charge separation integer, private :: iacr = 2 ! Flag for drop contact freezing with crytals ! (0=off; 1=drops > 500micron diameter; 2 = > 300micron) + integer, private :: icrcev = 1 ! 1 = old crcev; 2 = crcev scaled by vtrain ratio (num/mass); 3 = set to zero integer, private :: icracr = 1 ! Flag to turn rain self-collection on/off (=0 to turn off) + integer, private :: icracrthresh = 1 ! For rain self-coll. thresh. use: 1 = mean diam of 2mm; 2 = rain median volume diam of 1.9mm integer, private :: ibfr = 2 ! Flag for Bigg freezing conversion of freezing drops to graupel ! (1=min graupel size is vr1mm; 2=use min size of dfrz, 5= as for 2 and apply dbz conservation) integer, private :: ibiggopt = 2 ! 1 = old Bigg; 2 = experimental Bigg (only for imurain = 1, however) @@ -413,11 +438,15 @@ MODULE module_mp_nssl_2mom ! set eii1 = 0 to get a constant value of eii0 real , private :: eii0hl = 0.2 ,eii1hl = 0.0 ! hail-crystal coll. eff. parameters: eii0hl*exp(eii1hl*min(temcg(mgs),0.0)) ! set eii1hl = 0 to get a constant value of eii0hl + real, private :: ewi_dcmin = 15.0e-06 ! minimum droplet diameter for nonzero ewi + real, private :: ewi_dimin = 30.0e-06 ! minimum ice crystal diameter for nonzero ewi real , private :: eri0 = 0.1 ! rain efficiency to collect ice crystals real , private :: eri_cimin = 10.e-6 ! minimum ice crystal diameter for collection by rain real , private :: esi0 = 0.1 ! linear factor in snow-ice collection efficiency real , private :: ehs0 = 0.1, ehs1 = 0.1 ! graupel-snow coll. eff. parameters: ehs0*exp(ehs1*min(temcg(mgs),0.0)) ! set ehs1 = 0 to get a constant value of ehs0 + integer :: iessopt = 1 ! 1 = Original (no factor); 2 = factor based on wvel; 3 = factor based on SSI + ! 4 = as 3 but sets min factor of 0.1 and goes to full value at 0.5% SSI real , private :: ess0 = 0.5, ess1 = 0.05 ! snow aggregation coefficients: ess0*exp(ess1*min(temcg(mgs),0.0)) ! set ess1 = 0 to get a constant value of ess0 real , private :: esstem1 = -15. ! lower temperature where snow aggregation turns on @@ -452,11 +481,13 @@ MODULE module_mp_nssl_2mom ! 0 = no condensation on rain; 1 = bulk condensation on rain integer, parameter, private :: icond = 1 ! (Z only) icond = 1 calculates ice deposition (crystals and snow) BEFORE droplet condensation ! icond = 2 does not work (intended to calc. dep in loop with droplet cond.) + integer, private :: iqis0 = 2 ! = 1 for normal qis; = 2 to set qis to use T = 0C when T > 0C real , private :: dfrz = 0.15e-3 ! 0.25e-3 ! minimum diameter of frozen drops from Bigg freezing (used for vfrz) for iacr > 1 ! and for ciacrf for iacr=4 real , private :: dmlt = 3.0e-3 ! maximum diameter for rain melting from graupel and hail real , private :: dshd = 1.0e-3 ! nominal diameter for rain drops shed from graupel/hail + integer, private :: ivshdgs = 1 ! 0 = use 1mm for all shedding (non-mixedphase); 1 = use vshdgs with sheddiam integer, private :: ished2cld = 0 ! 1: Send shed liquid (from wet growth) to cloud droplets integer, private :: ihmlt = 2 ! 1=old melting with vmlt; 2=new melting using mean volume diam of graupel/hail @@ -480,6 +511,7 @@ MODULE module_mp_nssl_2mom real, private :: qhdpvdn = -1. real, private :: qhacidn = -1. + integer, private :: iraintypes = 0 logical, private :: mixedphase = .false. ! .false.=off, true=on to include mixed phase graupel integer, private :: imixedphase = 0 logical, private :: qsdenmod = .false. ! true = modify snow density by linear interpolation of snow and rain density @@ -511,17 +543,23 @@ MODULE module_mp_nssl_2mom real, parameter :: alpharmax = 8. ! limited for rwvent calculation - integer, private :: ihlcnh = 1 ! which graupel -> hail conversion to use + integer, private :: ihlcnh = -1 ! which graupel -> hail conversion to use ! 1 = Milbrandt and Yau (2005) using Ziegler 1985 wet growth diameter ! 2 = Straka and Mansell (2005) conversion using size threshold + ! 3 = Conversion using wet growth diameter real, private :: hlcnhdia = 1.e-3 ! threshold diameter for graupel -> hail conversion for ihlcnh = 1 option. real, private :: hlcnhqmin = 0.1e-3 ! minimum graupel mass content for graupel -> hail conversion (ihlcnh = 1) - real , private :: hldia1 = 20.0e-3 ! threshold diameter for graupel -> hail conversion for ihlcnh = 2 option. + real , private :: hldia1 = 10.0e-3 ! threshold diameter for graupel -> hail conversion for ihlcnh = 2 option. + integer, private :: incwet = 0 ! flag to do wet growth only on D > D_wet integer, private :: iusedw = 0 ! flag to use experimental wet growth ice diameter for gr -> hl conversion (=1 turns on) - real , private :: dwmin = 0.0 ! Minimum diameter with iusedw (can stay at 0 or be set to something larger) + real , private :: dwmin = 5.0e-3 ! Minimum diameter with iusedw (can stay at 0 or be set to something larger) + real , private :: dwetmin = 5.0e-3 ! Minimum diameter with iusedw (can stay at 0 or be set to something larger) + real , private :: dwmax = 15.e-3 ! for ihlcnh, always convert this size and larger whether or not there is wet growth real , private :: dwtempmin = 242. ! lowest temperature to allow wet growth conversion to hail real , private :: dwehwmin = 0. ! Minimum ehw to use to find wet growth diameter (if > ehw0, then wet growth diam becomes smaller) real , private :: dg0thresh = 0.15 ! graupel wet growth diameter above which we say do not bother + integer :: ifddenfac = 0 ! = 1 to use density threshold to count FD as GR when converting to HL + real :: fddenthresh = 500. ! if ifddenfac > 0, then hail from FD with lower density are considered to come from graupel integer :: icvhl2h = 0 ! allow conversion of hail back to graupel when hail density gets close to minimum allowed integer, private :: imurain = 1 ! 3 for gamma-volume, 1 for gamma-diameter DSD for rain. @@ -538,6 +576,8 @@ MODULE module_mp_nssl_2mom ! = 1 use mean diameter for breakup ! = 2 use maximum mass diameter for breakup ! = 3 use mass-weighted diameter for breakup + integer :: iraintailbreak = 0 ! 1 = on + real :: draintail = 8.e-3 ! starting size for rain breakup integer, private :: dmrauto = 0 ! = -1 no limiter on crcnw ! = 0 limit crcnw when qr > 1.2*L (Cohard-Pinty 2002) @@ -545,7 +585,7 @@ MODULE module_mp_nssl_2mom ! = 2 DTD mass-weighted version based on MY code ! = 3 Milbrandt version (from Cohard and Pinty code integer :: dmropt = 0 ! extra option for crcnw - integer :: dmhlopt = 1 ! options for graupel -> conversion + integer :: dmhlopt = 0 ! options for graupel -> hail conversion integer :: irescalerainopt = 3 ! 0 = default option ! 1 = qx(mgs,lc) > qxmin(lc) ! 2 = qx(mgs,lc) > qxmin(lc) .and. wvel(mgs) < 3.0 @@ -562,7 +602,7 @@ MODULE module_mp_nssl_2mom integer :: ivhmltsoak = 1 ! 0=off, 1=on : flag to simulate soaking (graupel/hail) during melting ! when liquid fraction is not predicted - logical :: iwetsoak = .true. ! soak and freeze during wet growth or not + logical, private :: iwetsoak = .true. ! soak and freeze during wet growth or not integer, private :: ioldlimiter = 0 ! test switch for new(=0) or old(=1) size limiter at the end of GS for 3-moment categories integer, private :: isnowfall = 2 ! Option for choosing between snow fall speed parameters ! 1 = original Zrnic et al. (Mansell et al. 2010) @@ -595,9 +635,12 @@ MODULE module_mp_nssl_2mom integer, private :: ibinnum = 2 ! number of bins for melting of smaller ice (for ibinhmlr = 1) integer, private :: iqhacrmlr = 1 ! turn on/off qhacrmlr integer, private :: iqhlacrmlr = 1 ! turn on/off qhlacrmlr + integer, private :: iqhacwshr = 1 ! turn on/off qhacw for T > 0 + integer, private :: iqhlacwshr = 1 ! turn on/off qhlacw for T > 0 real, private :: binmlrmxdia = 40.e-3 ! threshold diameter (graupel/hail) to switch bin-bulk melting to use standard chmlr real, private :: binmlrzrrfac = 1.0 ! factor for reflectivity change ice that sheds while melting real, private :: snowmeltdia = 0 ! If nonzero, sets the size of rain drops from melting snow. + real, private :: alphasmlr0 = 14.0 ! shape parameter for drops formed from melting/shedding snow real, private :: delta_alphamlr = 0.5 ! offset from alphamax at which melting does not further collapse the shape parameter integer :: iqvsopt = 0 ! =0 use old default for tabqvs; =1 use Bolton formulation (Rogers and Yau) @@ -739,6 +782,7 @@ MODULE module_mp_nssl_2mom real da1 (lc:lqmx) ! collection coefficients from Seifert 2005 real bb (lc:lqmx) + ! put ipelec here for now.... integer :: ipelec = 0 integer :: isaund = 0 @@ -764,8 +808,8 @@ MODULE module_mp_nssl_2mom double precision, parameter :: dgam = 0.01, dgami = 100. double precision gmoi(0:ngm0) ! ,gmod(0:ngm1,0:ngm2),gmdi(0:ngm1,0:ngm2) - integer, parameter :: nqiacralpha = 240 !480 ! 240 ! 120 ! 15 - integer, parameter :: nqiacrratio = 100 ! 500 !50 ! 25 + integer, parameter :: nqiacralpha = 300 !480 ! 240 ! 120 ! 15 + integer, parameter :: nqiacrratio = 400 ! 500 !50 ! 25 ! real, parameter :: maxratiolu = 25. real, parameter :: maxratiolu = 100. ! 25. real, parameter :: maxalphalu = 15. @@ -782,6 +826,10 @@ MODULE module_mp_nssl_2mom ! real :: ziacrratio(0:nqiacrratio,0:nqiacralpha) ! double precision :: gamxinflu(0:nqiacrratio,0:nqiacralpha,12,2) ! last index for graupel (1) or hail (2) +! for 3-moment collection coefficients + real, save :: dab0lu(ialpstart:nqiacralpha,ialpstart:nqiacralpha,lc:lqmx,lc:lqmx) ! collection coefficients from Seifert 2005 + real, save :: dab1lu(ialpstart:nqiacralpha,ialpstart:nqiacralpha,lc:lqmx,lc:lqmx) ! collection coefficients from Seifert 2005 + integer, parameter :: ngdnmm = 9 real :: mmgraupvt(ngdnmm,3) ! Milbrandt and Morrison (2013) fall speed coefficients for graupel/hail @@ -860,7 +908,7 @@ MODULE module_mp_nssl_2mom ! parameter( xvcmn=4.188e-18 ) ! mks min volume = 3 micron radius real, parameter :: xvcmn=0.523599*(2.*cwradn)**3 ! mks min volume = 2.5 micron radius - real, parameter :: xvcmx=0.523599*(2.*xcradmx)**3 ! mks min volume = 2.5 micron radius + real, parameter :: xvcmx=0.523599*(2.*xcradmx)**3 ! mks max volume = 60 micron radius real, parameter :: cwmasn = 1000.*xvcmn ! minimum mass, defined by radius of 5.0e-6 real, parameter :: cwmasx = 1000.*xvcmx ! maximum mass, defined by radius of 50.0e-6 real, parameter :: cwmasn5 = 1000.*0.523599*(2.*5.0e-6)**3 ! 5.23e-13 @@ -903,18 +951,20 @@ MODULE module_mp_nssl_2mom real, parameter :: cawbolton = 17.67 real, parameter :: tfrh = 233.15 +! -------------------------- + ! For CCPP, the following variables should be set by the host model, but initial values are set just in case real :: tfr = 273.15 - real :: cp = 1004.0, rd = 287.04 real :: rw = 461.5 ! gas const. for water vapor - REAL, PRIVATE :: cpl = 4190.0 - REAL, PRIVATE :: cpigb = 2106.0 - real :: cpi - real :: cap - real :: tfrcbw - real :: tfrcbi - real :: rovcp - + real :: cpl = 4190.0 + real :: cpigb = 2106.0 + real :: cpi = 1.0/1004.0 + real :: cap = 287.04/1004.0 + real :: tfrcbw = 273.15 - cbw + real :: tfrcbi = 273.15 - cbi + real :: rovcp = 287.04/1004.0 + real :: rdorv = 0.622 +! -------------------------- real, parameter :: poo = 1.0e+05 real, parameter :: advisc0 = 1.832e-05 ! reference dynamic viscosity (SMT; see Beard & Pruppacher 71) real, parameter :: advisc1 = 1.718e-05 ! dynamic viscosity constant used in thermal conductivity calc @@ -922,8 +972,8 @@ MODULE module_mp_nssl_2mom ! GHB: Needed for eqtset=2 in cm1 ! REAL, PRIVATE :: cv = cp - rd - real, private, parameter :: cv = 717.0 ! specific heat at constant volume - air - REAL, PRIVATE, parameter :: cvv = 1408.5 + real, private, parameter :: cv = 717.0 ! specific heat at constant volume - air + REAL, PRIVATE, parameter :: cvv = 1408.5 ! GHB real, parameter :: bfnu0 = (rnu + 2.0)/(rnu + 1.0) @@ -952,10 +1002,12 @@ MODULE module_mp_nssl_2mom logical, parameter :: do_satadj_for_wrfchem = .true. + integer, parameter :: ac_opt = 0 ! option flag for alternate aerosol (for NUWRF only) + logical, private :: nuaccoinp = .false. ! Note to users: Many of these options are for development and not guaranteed to perform well. ! Some may not be functional depending on the version of the code. -! Some may be useful for ensemble physics diversity. Feel free to contact me if you have questions +! Some may be useful for ensemble physics diversity. Feel free to contact Ted Mansell if you have questions ! in that regard. NAMELIST /nssl_mp_params/ & ndebug, ncdebug,& @@ -965,7 +1017,7 @@ MODULE module_mp_nssl_2mom idbzci, & vtmaxsed, & itfall,iscfall, & - infall, & + infall,irfall,isfall, & rssflg, & sssflg, & hssflg, & @@ -976,13 +1028,15 @@ MODULE module_mp_nssl_2mom icnuclimit, & irenuc, & restoreccn, ccntimeconst, cck, & + decayufccn, ufccntimeconst, & switchccn, old_cccn, & ciintmx, & itype1, itype2, & - icenucopt, & + icenucopt, in_freeze_rain_first, & naer, & icfn, & ibfc, iacr, icracr, & + icracrthresh, & cwfrz2snowfrac, cwfrz2snowratio, & ibfr, & ibiggopt, & @@ -998,7 +1052,7 @@ MODULE module_mp_nssl_2mom eri_cimin, & eii0hl, eii1hl, & ehs0, ehs1, & - ess0, ess1, & + ess0, ess1, iessopt, & esstem1,esstem2, & ircnw, qminrncw,& ! single-moment only iglcnvi, & @@ -1024,6 +1078,7 @@ MODULE module_mp_nssl_2mom hailfallfac, & icefallopt, & icdx,icdxhl, & + axh,bxh,axf,bxf,axhl,bxhl, & cdhmin, cdhmax, & cdhdnmin, cdhdnmax, & cdhlmin, cdhlmax, & @@ -1058,7 +1113,7 @@ MODULE module_mp_nssl_2mom rescale_low_alphah, & rescale_low_alphahl, & rescale_high_alpha, & - ihlcnh, hldia1,iusedw, dwehwmin, dwmin, dwtempmin, & + ihlcnh, hldia1,iusedw, dwehwmin, dwmin, dwmax, dwtempmin, dg0thresh, & icvhl2h, hldnmn,hdnmn, & hlcnhdia, hlcnhqmin, & isedonly, & @@ -1133,12 +1188,12 @@ SUBROUTINE nssl_2mom_init_const( & real, intent(in) :: con_g, con_rd, con_cp, con_rv, & con_t0c, con_cliq, con_csol, con_eps - cp608 = con_eps ! 0.608 ! constant used in conversion of T to Tv gr = con_g tfr = con_t0c cp = con_cp rd = con_rd rw = con_rv + rdorv = con_eps cpl = con_cliq ! 4190.0 cpigb = con_csol ! 2106.0 cpi = 1./cp @@ -1151,6 +1206,8 @@ SUBROUTINE nssl_2mom_init_const( & RETURN END SUBROUTINE nssl_2mom_init_const + + ! ##################################################################### ! ##################################################################### !>\ingroup mod_nsslmp @@ -1165,7 +1222,14 @@ SUBROUTINE nssl_2mom_init( & & nssl_icdxhl, & & nssl_icefallfac, & & nssl_snowfallfac, & + & nssl_cccn, & + & nssl_ufccn, & + & nssl_alphah, & + & nssl_alphahl, & + & nssl_alphar, & + & nssl_density_on, nssl_hail_on, nssl_ccn_on, nssl_icecrystals_on, ccn_is_ccna, & & errmsg, errflg, & + & infileunit, & & myrank, mpiroot & ) @@ -1177,24 +1241,38 @@ SUBROUTINE nssl_2mom_init( & & nssl_ehw0, & & nssl_ehlw0, & & nssl_icefallfac, & - & nssl_snowfallfac + & nssl_snowfallfac, & + & nssl_cccn, & + & nssl_alphah, & + & nssl_alphahl, & + & nssl_alphar integer, intent(in), optional :: & & nssl_icdx, & - & nssl_icdxhl, myrank, mpiroot + & nssl_icdxhl, myrank, mpiroot, & + & nssl_ufccn + logical, intent(in), optional :: nssl_density_on, nssl_hail_on, nssl_ccn_on, nssl_icecrystals_on + integer, intent(inout), optional :: ccn_is_ccna + + integer, intent(in),optional :: infileunit ! CCPP error handling character(len=*), intent( out) :: errmsg integer, intent( out) :: errflg - integer, intent(in) :: ims,ime, jms,jme, kms,kme - real, intent(in), dimension(20) :: nssl_params + integer, intent(in), optional :: ims,ime, jms,jme, kms,kme + + real, intent(in), dimension(20), optional :: nssl_params - integer, intent(in) :: ipctmp,mixphase,ihvol + integer, intent(in) :: ipctmp,mixphase + integer, optional, intent(in) :: ihvol logical, optional, intent(in) :: idoniconlytmp + integer :: igvol_local = 1 logical :: wrote_namelist = .false. logical :: wrf_dm_on_monitor + integer :: hail_on = -1, density_on = -1, icecrystals_on = 1 + integer :: ccn_on = -1 double precision :: arg real :: temq @@ -1202,22 +1280,59 @@ SUBROUTINE nssl_2mom_init( & integer :: i,il,j,l integer :: ltmp integer :: isub - real :: bxh,bxhl + real :: bxh1,bxhl1 real :: alp,ratio double precision :: x,y,y2,y7 logical :: turn_on_ccna, turn_on_cina + integer :: iufccn = 0 integer :: istat + + real :: alpjj, alpii, xnuii, xnujj + integer :: ii, jj errmsg = '' errflg = 0 turn_on_ccna = .false. turn_on_cina = .false. + +! IF ( present( igvol ) ) THEN +! igvol_local = igvol +! ENDIF + + IF ( present( nssl_hail_on ) ) THEN + IF ( nssl_hail_on ) THEN + hail_on = 1 + ELSE + hail_on = 0 + ENDIF + ENDIF + + IF ( present( nssl_density_on ) ) THEN + IF ( nssl_density_on ) THEN + density_on = 1 + ELSE + density_on = 0 + ENDIF + ENDIF + + IF ( present( nssl_icecrystals_on ) ) THEN + IF ( nssl_icecrystals_on ) THEN + icecrystals_on = 1 + ELSE + icecrystals_on = 0 + ! renucfrac = 1.0 ! why was this set to 1? + ffrzs = 1.0 + ENDIF + ENDIF + + ! ! set some global values from namelist input ! + IF ( present( nssl_params ) ) THEN ccn = Abs( nssl_params(1) ) alphah = nssl_params(2) alphahl = nssl_params(3) @@ -1228,26 +1343,60 @@ SUBROUTINE nssl_2mom_init( & rho_qh = nssl_params(8) rho_qhl = nssl_params(9) rho_qs = nssl_params(10) - alphar = nssl_params(15) - + IF ( Nint(nssl_params(13)) == 1 ) THEN + ! hack to switch CCN field to CCNA (activated ccn) +! invertccn = .true. + turn_on_ccna = .true. + irenuc = 7 + ENDIF + ccnuf = Abs( nssl_params(14) ) + IF ( present(nssl_ufccn) ) iufccn = nssl_ufccn + + ENDIF + alphar = nssl_params(15) ! ipelec = Nint(nssl_params(11)) ! isaund = Nint(nssl_params(12)) + + IF ( present(nssl_graupelfallfac) ) graupelfallfac = nssl_graupelfallfac IF ( present(nssl_hailfallfac) ) hailfallfac = nssl_hailfallfac - IF ( present(nssl_ehw0) ) ehw0 = nssl_ehw0 - IF ( present(nssl_ehlw0) ) ehlw0 = nssl_ehlw0 + IF ( present(nssl_ehw0) ) THEN + IF ( nssl_ehw0 > 0.0 ) ehw0 = nssl_ehw0 + ENDIF + IF ( present(nssl_ehlw0) ) THEN + IF ( nssl_ehlw0 > 0.0 ) ehlw0 = nssl_ehlw0 + ENDIF IF ( present(nssl_icdx) ) icdx = nssl_icdx IF ( present(nssl_icdxhl) ) icdxhl = nssl_icdxhl IF ( present(nssl_icefallfac) ) icefallfac = nssl_icefallfac IF ( present(nssl_snowfallfac) ) snowfallfac = nssl_snowfallfac + IF ( present(nssl_cccn) ) THEN + IF (nssl_cccn > 1 ) ccn = nssl_cccn + ENDIF + IF ( present(nssl_alphah) ) THEN + IF ( nssl_alphah > -1. ) alphah = nssl_alphah + ENDIF + IF ( present(nssl_alphahl) ) THEN + IF ( nssl_alphahl > -1. ) alphahl = nssl_alphahl + ENDIF + IF ( present(nssl_alphar) ) THEN + IF ( nssl_alphar > -1.0 ) alphar = nssl_alphar + ENDIF - IF ( Nint(nssl_params(13)) == 1 ) THEN - ! hack to switch CCN field to CCNA (activated ccn) -! invertccn = .true. - turn_on_ccna = .true. - irenuc = 7 + ipconc = ipctmp + + IF ( ipconc < 5 ) THEN + ihlcnh = 0 + ENDIF + + IF ( ihlcnh <= 0 ) THEN + IF ( ipconc == 5 ) THEN + ihlcnh = 3 + ELSEIF ( ipconc >= 6 ) THEN + ihlcnh = 3 ENDIF + ENDIF @@ -1275,8 +1424,43 @@ SUBROUTINE nssl_2mom_init( & + IF ( iufccn > 0 ) THEN ! make sure to use option that uses UF ccn + irenuc = 7 + IF ( ccnuf <= 0.0 ) decayufccn = .true. ! assume surface emission and need decay + IF ( i_uf_or_ccn > 0 ) THEN + ufbackground = 0.0 + ccntimeconst = ufccntimeconst + ENDIF + ENDIF + + IF ( present( nssl_ccn_on ) ) THEN + IF ( nssl_ccn_on ) THEN + ccn_on = 1 + ELSE + ccn_on = 0 + irenuc = 2 + ENDIF + ENDIF + IF ( irenuc >= 5 ) THEN turn_on_ccna = .true. + IF ( present( nssl_ccn_on ) ) THEN + IF ( .not. nssl_ccn_on ) THEN + errmsg = 'NSSL_MP Error: Must have nssl_ccn_on=1 for irenuc >= 5!' + errflg = 1 + return + ENDIF + ENDIF + ENDIF + + IF ( present( ccn_is_ccna ) .and. ccn_on == 1 ) THEN + IF ( ccn_is_ccna > 0 ) THEN + turn_on_ccna = .true. + ELSE + IF ( irenuc >= 5 ) THEN + ccn_is_ccna = 1 + ENDIF + ENDIF ENDIF cwccn = ccn @@ -1290,25 +1474,42 @@ SUBROUTINE nssl_2mom_init( & lh = lh + 1 lhl = lhl + 1 ENDIF - IF ( ihvol <= -1 .or. ihvol == 2 ) THEN - IF ( ihvol == -1 .or. ihvol == -2 ) THEN - lhab = lhab - 1 ! turns off hail - lhl = 0 - ! past me thought it would be a good idea to change graupel factors when hail is off.... - ! ehw0 = 0.75 - ! iehw = 2 - ! dfrz = Max( dfrz, 0.5e-3 ) - ENDIF - IF ( ihvol == -2 .or. ihvol == 2 ) THEN ! ice crystals are turned off - ! a value of -3 means to turn off ice crystals but turn on hail - renucfrac = 1.0 - ffrzs = 1.0 - ! idoci = 0 ! try this later + IF ( hail_on == -1 ) THEN ! hail_on is not set + hail_on = 1 + IF ( ihvol <= -1 .or. ihvol == 2 ) THEN + IF ( ihvol == -1 .or. ihvol == -2 ) THEN + lhab = lhab - 1 ! turns off hail + lhl = 0 + hail_on = 0 + ! past me thought it would be a good idea to change graupel factors when hail is off.... + ! ehw0 = 0.75 + ! iehw = 2 + ! dfrz = Max( dfrz, 0.5e-3 ) + ENDIF + IF ( ihvol == -2 .or. ihvol == 2 .or. icecrystals_on == 0 ) THEN ! ice crystals are turned off + ! a value of 2? means to turn off ice crystals but turn on hail + ! renucfrac = 1.0 ! why? + ffrzs = 1.0 + ! idoci = 0 ! try this later + ENDIF + ENDIF + + ELSE ! hail_on is set + IF ( hail_on == 0 ) THEN + lhab = lhab - 1 ! turns off hail + lhl = 0 + ELSE + ! assume default that hail is on ENDIF ENDIF + + IF ( density_on == -1 ) THEN ! density flag not set, so default is to predict it + density_on = 1 + ENDIF + IF ( iresetmoments == 0 ) iresetmoments = 1 ! lhl -! write(0,*) 'wrf_init: lhab,lhl = ',lhab,lhl +! write(0,*) 'wrf_init: lhab,lhl,hail_on,density_on = ',lhab,lhl,hail_on,density_on ! IF ( ipelec > 0 ) idonic = .true. @@ -1335,29 +1536,42 @@ SUBROUTINE nssl_2mom_init( & bx(lr) = 0.85 ax(lr) = 1647.81 fx(lr) = 135.477 + IF ( icdx == 6 ) THEN bx(lh) = 0.6 ! Milbrandt and Morrison (2013) for density of 550. ax(lh) = 157.71 - ELSEIF ( icdx > 0 ) THEN +! ELSEIF ( icdx == 1 ) THEN +! bx(lh) = bxh +! ax(lh) = axh + ELSEIF ( icdx > 1 ) THEN bx(lh) = 0.5 ax(lh) = 75.7149 - ELSE - bx(lh) = 0.37 ! 0.6 ! Ferrier 1994 + ELSEIF ( icdx == 0 ) THEN + bx(lh) = 0.37 ! 0.6 ! Ferrier 1994 graupel ax(lh) = 19.3 + ELSE ! icdx < 0 +! ax(lh) = 206.984 ! Ferrier 1994 hail/frozen drops +! bx(lh) = 0.6384 + bx(lh) = bxh + ax(lh) = axh ENDIF + ! bx(lh) = 0.6 IF ( lhl .gt. 1 ) THEN IF ( icdxhl == 6 ) THEN bx(lhl) = 0.593 ! Milbrandt and Morrison (2013) for density of 750. ax(lhl) = 179.36 + ELSEIF (icdxhl == 0 ) THEN + ax(lhl) = 206.984 ! Ferrier 1994 + bx(lhl) = 0.6384 ELSEIF (icdxhl > 0 ) THEN - bx(lhl) = 0.5 - ax(lhl) = 75.7149 + bx(lhl) = 0.5 + ax(lhl) = 75.7149 ELSE - ax(lhl) = 206.984 ! Ferrier 1994 - bx(lhl) = 0.6384 + bx(lhl) = bxhl + ax(lhl) = axhl ENDIF ENDIF @@ -1373,8 +1587,8 @@ SUBROUTINE nssl_2mom_init( & ! Uses incomplete gamma functions ! The terms with bxh or bxhl will be off if the actual bxh or bxhl is different from the base value (icdx=6 option) - bxh = bx(lh) - bxhl = bx(Max(lh,lhl)) + bxh1 = bx(lh) + bxhl1 = bx(Max(lh,lhl)) ! DO j = 0,nqiacralpha DO j = ialpstart,nqiacralpha @@ -1390,9 +1604,9 @@ SUBROUTINE nssl_2mom_init( & ! graupel (.,.,.,1) gamxinflu(i,j,1,1) = x/y gamxinflu(i,j,2,1) = gamxinfdp( 2.0+alp, ratio )/y - gamxinflu(i,j,3,1) = gamxinfdp( 2.5+alp+0.5*bxh, ratio )/y + gamxinflu(i,j,3,1) = gamxinfdp( 2.5+alp+0.5*bxh1, ratio )/y gamxinflu(i,j,5,1) = (gamma_dpr(5.0+alp) - gamxinfdp( 5.0+alp, ratio ))/y - gamxinflu(i,j,6,1) = (gamma_dpr(5.5+alp+0.5*bxh) - gamxinfdp( 5.5+alp+0.5*bxh, ratio ))/y + gamxinflu(i,j,6,1) = (gamma_dpr(5.5+alp+0.5*bxh1) - gamxinfdp( 5.5+alp+0.5*bxh1, ratio ))/y gamxinflu(i,j,9,1) = gamxinfdp( 1.0+alp, ratio )/y gamxinflu(i,j,10,1)= gamxinfdp( 4.0+alp, ratio )/y @@ -1401,9 +1615,9 @@ SUBROUTINE nssl_2mom_init( & ! hail (.,.,.,2) gamxinflu(i,j,1,2) = gamxinflu(i,j,1,1) gamxinflu(i,j,2,2) = gamxinflu(i,j,2,1) - gamxinflu(i,j,3,2) = gamxinfdp( 2.5+alp+0.5*bxhl, ratio )/y + gamxinflu(i,j,3,2) = gamxinfdp( 2.5+alp+0.5*bxhl1, ratio )/y gamxinflu(i,j,5,2) = gamxinflu(i,j,5,1) - gamxinflu(i,j,6,2) = (gamma_dpr(5.5+alp+0.5*bxhl) - gamxinfdp( 5.5+alp+0.5*bxhl, ratio ))/y + gamxinflu(i,j,6,2) = (gamma_dpr(5.5+alp+0.5*bxhl1) - gamxinfdp( 5.5+alp+0.5*bxhl1, ratio ))/y gamxinflu(i,j,9,2) = gamxinflu(i,j,9,1) gamxinflu(i,j,10,2)= gamxinflu(i,j,10,1) @@ -1411,16 +1625,16 @@ SUBROUTINE nssl_2mom_init( & ! gamxinflu(i,j,7,1) = gamxinfdp( alp - 1., ratio )/y gamxinflu(i,j,7,1) = (gamma_dpr(alp - 1.) - gamxinfdp( alp - 1., ratio ))/y ! gamxinflu(i,j,8,1) = gamxinfdp( alp - 0.5 + 0.5*bxh, ratio )/y - gamxinflu(i,j,8,1) = (gamma_dpr(alp - 0.5 + 0.5*bxh) - gamxinfdp( alp - 0.5 + 0.5*bxh, ratio ))/y -! gamxinflu(i,j,8,2) = gamxinfdp( alp - 0.5 + 0.5*bxhl, ratio )/y - gamxinflu(i,j,8,2) = (gamma_dpr(alp - 0.5 + 0.5*bxhl) - gamxinfdp( alp - 0.5 + 0.5*bxhl, ratio ))/y + gamxinflu(i,j,8,1) = (gamma_dpr(alp - 0.5 + 0.5*bxh1) - gamxinfdp( alp - 0.5 + 0.5*bxh1, ratio ))/y +! gamxinflu(i,j,8,2) = gamxinfdp( alp - 0.5 + 0.5*bxhl1, ratio )/y + gamxinflu(i,j,8,2) = (gamma_dpr(alp - 0.5 + 0.5*bxhl1) - gamxinfdp( alp - 0.5 + 0.5*bxhl1, ratio ))/y ELSE ! gamxinflu(i,j,7,1) = gamxinfdp( .1, ratio )/y gamxinflu(i,j,7,1) = (gamma_dpr(0.1) - gamxinfdp( 0.1, ratio ) )/y -! gamxinflu(i,j,8,1) = gamxinfdp( 1.1 - 0.5 + 0.5*bxh, ratio )/y -! gamxinflu(i,j,8,2) = gamxinfdp( 1.1 - 0.5 + 0.5*bxhl, ratio )/y - gamxinflu(i,j,8,1) = (gamma_dpr(1.1 - 0.5 + 0.5*bxh) - gamxinfdp( 1.1 - 0.5 + 0.5*bxh, ratio ) )/y - gamxinflu(i,j,8,2) = (gamma_dpr(1.1 - 0.5 + 0.5*bxhl) - gamxinfdp( 1.1 - 0.5 + 0.5*bxhl, ratio ) )/y +! gamxinflu(i,j,8,1) = gamxinfdp( 1.1 - 0.5 + 0.5*bxh1, ratio )/y +! gamxinflu(i,j,8,2) = gamxinfdp( 1.1 - 0.5 + 0.5*bxhl1, ratio )/y + gamxinflu(i,j,8,1) = (gamma_dpr(1.1 - 0.5 + 0.5*bxh1) - gamxinfdp( 1.1 - 0.5 + 0.5*bxh1, ratio ) )/y + gamxinflu(i,j,8,2) = (gamma_dpr(1.1 - 0.5 + 0.5*bxhl1) - gamxinfdp( 1.1 - 0.5 + 0.5*bxhl1, ratio ) )/y ENDIF gamxinflu(i,j,7,2) = gamxinflu(i,j,7,1) @@ -1454,9 +1668,8 @@ SUBROUTINE nssl_2mom_init( & qiacrratio(0,:) = 1.0 - isub = Min( 0, Max(-1,ihvol) ) ! is -1 or 0 - lccn = 0 + lccnuf = 0 lccna = 0 lnc = 0 lnr = 0 @@ -1478,34 +1691,41 @@ SUBROUTINE nssl_2mom_init( & ! lccn = 9 - ipconc = ipctmp IF ( ipconc == 0 ) THEN - IF ( ihvol >= 0 ) THEN + IF ( hail_on == 1 ) THEN ! turn on graupel density for 1-moment scheme lvh = 9 ltmp = 9 denscale(lvh) = 1 - ELSE ! no hail + ELSE ! no hail, 'LFO' scheme ltmp = lhab lhl = 0 ENDIF ELSEIF ( ipconc == 5 ) THEN - lccn = lhab+1 ! 9 - lnc = lhab+2 ! 10 - lnr = lhab+3 ! 11 - lni = lhab+4 !12 - lns = lhab+5 !13 - lnh = lhab+6 !14 + ltmp = lhab + IF ( iufccn > 0 ) THEN + ltmp = ltmp+1 + lccnuf = ltmp + denscale(lccnuf) = 1 + ENDIF + lccn= ltmp+1 ! 9 + lnc = ltmp+2 ! 10 + lnr = ltmp+3 ! 11 + lni = ltmp+4 !12 + lns = ltmp+5 !13 + lnh = ltmp+6 !14 ltmp = lnh - IF ( ihvol >= 0 ) THEN + IF ( hail_on == 1 ) THEN ltmp = ltmp + 1 lnhl = ltmp ! lhab+7 ! 15 ENDIF + IF ( density_on >= 1 ) THEN ltmp = ltmp + 1 lvh = ltmp ! lhab+8 + isub ! 16 + isub ! isub adjusts to 15 if hail is off ! ltmp = lvh - denscale(lccn:lvh) = 1 - IF ( ihvol >= 1 ) THEN + ENDIF + denscale(lccn:ltmp) = 1 + IF ( density_on == 1 .and. hail_on == 1 ) THEN ltmp = ltmp + 1 lvhl = ltmp ! ltmp = lvhl @@ -1523,25 +1743,31 @@ SUBROUTINE nssl_2mom_init( & ! ltmp = lhlw ENDIF ELSEIF ( ipconc >= 6 ) THEN - errmsg = 'NSSL microphysics has not been compiled for 3-moment. Sorry.' - errflg = 1 - return - lccn = lhab+1 ! 9 - lnc = lhab+2 ! 10 - lnr = lhab+3 ! 11 - lni = lhab+4 !12 - lns = lhab+5 !13 - lnh = lhab+6 !14 + ltmp = lhab + IF ( iufccn > 0 ) THEN + ltmp = ltmp+1 + lccnuf = ltmp + denscale(lccnuf) = 1 + ENDIF + + lccn= ltmp+1 ! 9 + lnc = ltmp+2 ! 10 + lnr = ltmp+3 ! 11 + lni = ltmp+4 !12 + lns = ltmp+5 !13 + lnh = ltmp+6 !14 ltmp = lnh IF ( lhl > 0 ) THEN ltmp = ltmp + 1 lnhl = ltmp ! lhab+7 ! 15 ENDIF + IF ( density_on == 1 ) THEN ltmp = ltmp + 1 lvh = ltmp ! lhab+8 + isub ! 16 + isub ! isub adjusts to 15 if hail is off + ENDIF ! ltmp = lvh - denscale(lccn:lvh) = 1 - IF ( ihvol >= 1 ) THEN + denscale(lccn:ltmp) = 1 + IF ( density_on == 1 .and. hail_on == 1 ) THEN ltmp = ltmp + 1 lvhl = ltmp ! ltmp = lvhl @@ -1561,19 +1787,14 @@ SUBROUTINE nssl_2mom_init( & lzh = ltmp ltmp = ltmp + 1 lzr = ltmp - ltmp = ltmp + 1 IF ( lhl > 1 ) THEN ltmp = ltmp + 1 lzhl = ltmp ENDIF + ! write(0,*) 'ipcon,lzr = ',ipconc,lzr,lzh,lzhl ENDIF ! ltmp = lvh ! denscale(lccn:lvh) = 1 - IF ( ihvol >= 1 ) THEN - lvhl = ltmp+1 - ltmp = lvhl - denscale(lvhl) = 1 - ENDIF IF ( mixedphase ) THEN ltmp = ltmp + 1 lsw = ltmp @@ -1593,7 +1814,8 @@ SUBROUTINE nssl_2mom_init( & - + ! write(0,*) 'wrf_init: lh,lhl,lzh,lzhl = ',lh,lhl,lzh,lzhl + ! write(0,*) 'wrf_init: ipconc = ',ipconc ! write(0,*) 'wrf_init: irenuc, turn_on_ccna = ',irenuc, turn_on_ccna IF ( turn_on_ccna ) THEN ltmp = ltmp + 1 @@ -1825,9 +2047,11 @@ SUBROUTINE nssl_2mom_init( & IF ( lhl .gt. 1 ) ido(lhl) = idohl IF ( irfall .lt. 0 ) irfall = infall + IF ( isfall .lt. 0 ) isfall = infall IF ( lzr > 0 ) irfall = 0 qccn = ccn/rho00 + qccnuf = ccnuf/rho00 IF ( old_cccn > 0.0 ) THEN old_qccn = old_cccn/rho00 ELSE @@ -1981,6 +2205,33 @@ SUBROUTINE nssl_2mom_init( & ENDDO ENDDO + dab0lu(:,:,:,:) = 0.0 + dab1lu(:,:,:,:) = 0.0 + + IF ( ipconc >= 6 ) THEN + DO il = lc,lhab ! collector + DO j = lc,lhab ! collected + IF ( il .ne. j ) THEN + + DO jj = ialpstart,nqiacralpha + alpjj = float(jj)*dqiacralpha + xnujj = (alpjj - 2.)/3. + DO ii = ialpstart,nqiacralpha + alpii = float(ii)*dqiacralpha + xnuii = (alpii - 2.)/3. + + dab0lu(ii,jj,il,j) = delabk(bb(il), bb(j), xnuii, xnujj, xmu(il), xmu(j), 0) + dab1lu(ii,jj,il,j) = delabk(bb(il), bb(j), xnuii, xnujj, xmu(il), xmu(j), 1) + + ENDDO + ENDDO +! write(0,*) 'il, j, dab0, dab1 = ',il, j, dab0(il,j), dab1(il,j) + ENDIF + ENDDO + ENDDO + + ENDIF + gf4br = gamma_sp(4.0+br) gf4ds = gamma_sp(4.0+ds) gf4p5 = gamma_sp(4.0+0.5) @@ -2029,18 +2280,25 @@ END SUBROUTINE nssl_2mom_init !>\ingroup mod_nsslmp !! Driver subroutine that copies state data to local 2D arrays for microphysics calls SUBROUTINE nssl_2mom_driver(qv, qc, qr, qi, qs, qh, qhl, ccw, crw, cci, csw, chw, chl, & - cn, vhw, vhl, cna, cni, f_cn, f_cna, f_cina, & - zrw, zhw, zhl, & + cn, vhw, vhl, cna, cni, f_cn, f_cna, f_cina, & + f_qc, f_qr, f_qi, f_qs, f_qh, f_qhl, & + cnuf, f_cnuf, & + zrw, zhw, zhl, f_zrw, f_zhw, f_zhl, f_vhw, f_vhl, & qsw, qhw, qhlw, & tt, th, pii, p, w, dn, dz, dtp, itimestep, & + is_theta_or_temp, & + ntmul, ntcnt, lastloop, & RAINNC,RAINNCV, & dx, dy, & axtra, & SNOWNC, SNOWNCV, GRPLNC, GRPLNCV, & SR,HAILNC, HAILNCV, & + hail_maxk1, hail_max2d, nwp_diagnostics, & tkediss, & re_cloud, re_ice, re_snow, re_rain, & + re_graup, re_hail, & has_reqc, has_reqi, has_reqs, has_reqr, & + has_reqg, has_reqh, & rainncw2, rainnci2, & dbz, vzf,compdbz, & rscghis_2d,rscghis_2dp,rscghis_2dn, & @@ -2074,6 +2332,8 @@ SUBROUTINE nssl_2mom_driver(qv, qc, qr, qi, qs, qh, qhl, ccw, crw, cci, csw, chw + + implicit none @@ -2091,7 +2351,9 @@ SUBROUTINE nssl_2mom_driver(qv, qc, qr, qi, qs, qh, qhl, ccw, crw, cci, csw, chw zrw, zhw, zhl, & qsw, qhw, qhlw, & qi,qhl,ccw,crw,cci,csw,chw,chl,vhw,vhl - real, dimension(ims:ime, kms:kme, jms:jme), optional, intent(inout):: dbz, vzf, cn, cna, cni + integer, optional, intent(in) :: is_theta_or_temp + logical, optional, intent(in) :: f_zrw, f_zhw, f_zhl, f_vhw, f_vhl ! not used yet + real, dimension(ims:ime, kms:kme, jms:jme), optional, intent(inout):: dbz, vzf, cn, cna, cni, cnuf real, dimension(ims:ime, jms:jme), optional, intent(inout):: compdbz real, dimension(ims:ime, jms:jme), optional, intent(inout):: rscghis_2d, & ! 2D accumulation arrays for vertically-integrated charging rate rscghis_2dp, & ! 2D accumulation arrays for vertically-integrated charging rate (positive only) @@ -2102,8 +2364,8 @@ SUBROUTINE nssl_2mom_driver(qv, qc, qr, qi, qs, qh, qhl, ccw, crw, cci, csw, chw scr,scw,sci,scs,sch,schl,sciona,sctot ! space charge real, dimension(ims:ime, kms:kme, jms:jme), optional, intent(inout):: & induc,noninduc,noninducp,noninducn ! charging rates: inductive, noninductive (all, positive, negative to graupel) - real, dimension(ims:ime, kms:kme, jms:jme), optional, intent(in) :: elecz ! elecsave = Ez - real, dimension(ims:ime, kms:kme, jms:jme,2),optional, intent(inout) :: scion + real, dimension(ims:ime, kms:kme, jms:jme), optional, intent(in) :: elecz ! elecsave = Ez + real, dimension(ims:ime, kms:kme, jms:jme,2),optional, intent(inout) :: scion real, dimension(ims:ime, kms:kme, jms:jme), intent(in):: p,w,dz,dn real, dimension(ims:ime, kms:kme, jms:jme), intent(in):: pii @@ -2124,22 +2386,30 @@ SUBROUTINE nssl_2mom_driver(qv, qc, qr, qi, qs, qh, qhl, ccw, crw, cci, csw, chw real, dimension(ims:ime, kms:kme, jms:jme), optional, intent(inout) :: axtra ! WRF variables - real, dimension(ims:ime, jms:jme), intent(inout):: & + real, dimension(ims:ime, jms:jme) :: & RAINNC,RAINNCV ! accumulated precip (NC) and rate (NCV) real, dimension(ims:ime, jms:jme), optional, intent(inout):: & SNOWNC,SNOWNCV,GRPLNC,GRPLNCV,SR ! accumulated precip (NC) and rate (NCV) real, dimension(ims:ime, jms:jme), optional, intent(inout):: & HAILNC,HAILNCV ! accumulated precip (NC) and rate (NCV) + real, dimension(ims:ime, jms:jme), optional, intent(inout) :: hail_maxk1, hail_max2d + integer, optional, intent(in) :: nwp_diagnostics +! for cm1, set nproctot=44 (or as needed) to get domain total rates integer, parameter :: nproc = 1 - REAL, DIMENSION(ims:ime, kms:kme, jms:jme), optional, INTENT(INOUT):: re_cloud, re_ice, re_snow, re_rain + double precision :: proctot(nproc),proctotmpi(nproc) + REAL, DIMENSION(ims:ime, kms:kme, jms:jme), optional, INTENT(INOUT):: re_cloud, re_ice, re_snow, & + re_rain, re_graup, re_hail REAL, DIMENSION(ims:ime, kms:kme, jms:jme), optional, INTENT(IN):: tkediss - INTEGER, INTENT(IN), optional :: has_reqc, has_reqi, has_reqs, has_reqr + INTEGER, INTENT(IN), optional :: has_reqc, has_reqi, has_reqs, has_reqr, has_reqg, has_reqh real, dimension(ims:ime, jms:jme), intent(out), optional :: & rainncw2, rainnci2 ! liquid rain, ice, accumulation rates real, optional, intent(in) :: dx,dy real, intent(in):: dtp integer, intent(in):: itimestep !, ccntype - logical, optional, intent(in) :: diagflag, f_cna, f_cn, f_cina + integer, intent(in), optional :: ntmul, ntcnt + logical, optional, intent(in) :: lastloop + logical, optional, intent(in) :: diagflag, f_cna, f_cn, f_cina, f_cnuf + logical, optional, intent(in) :: f_qc, f_qr, f_qi, f_qs, f_qh, f_qhl integer, optional, intent(in) :: ipelectmp, ke_diag ! CCPP error handling @@ -2151,7 +2421,12 @@ SUBROUTINE nssl_2mom_driver(qv, qc, qr, qi, qs, qh, qhl, ccw, crw, cci, csw, chw ! REAL, DIMENSION(ims:ime, kms:kme, jms:jme), optional,INTENT(INOUT):: qndrop LOGICAL :: flag_qndrop ! wrf-chem LOGICAL :: flag_qnifa , flag_qnwfa + logical :: flag_cnuf = .false. + logical :: flag_ccn = .false. + logical :: flag_qi = .true. + logical :: has_reqg_local = .false., has_reqh_local = .false. logical :: flag + logical :: nwp_diagflag = .false. real :: cinchange, t7max,testmax,wmax ! 20130903 acd_ck_washout start @@ -2176,12 +2451,14 @@ SUBROUTINE nssl_2mom_driver(qv, qc, qr, qi, qs, qh, qhl, ccw, crw, cci, csw, chw real, dimension(its:ite, kts:kte) :: rainprod2d, evapprod2d,tke2d real, dimension(its:ite, 1, kts:kte, na) :: an, ancuten real, dimension(its:ite, 1, kts:kte, nxtra) :: axtra2d + real, dimension(its:ite, 1, kts:kte, 3) :: alpha2d real, dimension(its:ite, 1, kts:kte) :: t0,t1,t2,t3,t4,t5,t6,t7,t8,t9 real, dimension(its:ite, 1, kts:kte) :: dn1,t00,t77,ssat,pn,wn,dz2d,dz2dinv,dbz2d,vzf2d real, dimension(its:ite, 1, na) :: xfall + real, dimension(its:ite, 1) :: hailmax1d,hailmaxk1 real, dimension(kts:kte, nproc) :: thproclocal integer, parameter :: nor = 0, ng = 0 - integer :: nx,ny,nz + integer :: nx,ny,nz,ngs integer ix,jy,kz,i,j,k,il,n integer :: infdo real :: ssival, ssifac, t8s, t9s, qvapor @@ -2223,15 +2500,9 @@ SUBROUTINE nssl_2mom_driver(qv, qc, qr, qi, qs, qh, qhl, ccw, crw, cci, csw, chw real :: fach(kts:kte) logical, parameter :: debugdriver = .false. - -#ifdef MPI - -#if defined(MPI) - integer, parameter :: ntot = 50 - double precision mpitotindp(ntot), mpitotoutdp(ntot) - INTEGER :: mpi_error_code = 1 -#endif -#endif + + integer :: loopcnt, loopmax, outerloopcnt + logical :: lastlooptmp ! ------------------------------------------------------------------- @@ -2246,13 +2517,52 @@ SUBROUTINE nssl_2mom_driver(qv, qc, qr, qi, qs, qh, qhl, ccw, crw, cci, csw, chw flag_qndrop = .false. flag_qnifa = .false. flag_qnwfa = .false. + flag_cnuf = .false. + flag_ccn = .false. + nwp_diagflag = .false. IF ( PRESENT ( nssl_progn ) ) flag_qndrop = nssl_progn + IF ( present ( f_cnuf ) ) flag_cnuf = f_cnuf + IF ( present ( nwp_diagnostics ) ) nwp_diagflag = ( nwp_diagnostics > 0 ) + IF ( present ( f_cn ) .and. present( cn ) ) THEN + flag_ccn = f_cn + ELSEIF ( present( cn ) ) THEN + flag_ccn = .true. + ENDIF + + IF ( present( f_qi ) ) THEN + flag_qi = f_qi + ELSE + IF ( ffrzs < 1.0 ) THEN + flag_qi = .true. + ELSE + flag_qi = .false. + ENDIF + ENDIF + IF ( .not. flag_qi .and. ffrzs < 1.0 ) ffrzs = 1.0 + + IF ( PRESENT ( has_reqg ) ) has_reqg_local = has_reqg > 0 + IF ( PRESENT ( has_reqh ) ) has_reqh_local = has_reqh > 0 - ! --- + loopmax = 1 + outerloopcnt = 1 + lastlooptmp = .true. + IF ( present( ntmul ) .and. present( ntcnt ) .and. present( lastloop ) ) THEN + loopmax = ntmul + outerloopcnt = ntcnt + lastlooptmp = lastloop + ENDIF + + + has_wetscav = .false. + IF ( wrfchem_flag > 0 ) THEN + IF ( PRESENT( wetscav_on ) ) THEN + has_wetscav = wetscav_on + ENDIF + ENDIF IF ( present( f_cna ) ) THEN f_cnatmp = f_cna @@ -2303,8 +2613,9 @@ SUBROUTINE nssl_2mom_driver(qv, qc, qr, qi, qs, qh, qhl, ccw, crw, cci, csw, chw nx = ite-its+1 ny = 1 ! set up as 2D slabs nz = kte-kts+1 + ngs = 64 - IF ( .not. present( cn ) ) THEN + IF ( .not. flag_ccn ) THEN renucfrac = 1.0 ENDIF @@ -2365,32 +2676,35 @@ SUBROUTINE nssl_2mom_driver(qv, qc, qr, qi, qs, qh, qhl, ccw, crw, cci, csw, chw ancuten(its:ite,1,kts:kte,:) = 0.0 thproclocal(:,:) = 0.0 + DO jy = jts,jye - xfall(:,:,:) = 0.0 - ! write(0,*) 'N2M: load an, jy,lccn = ',jy,lccn,qccn IF ( present( pcc2 ) .and. makediag ) THEN axtra2d(its:ite,1,kts:kte,:) = 0.0 ENDIF + IF ( nwp_diagflag ) THEN + alpha2d(its:ite,1,kts:kte,1) = alphar + alpha2d(its:ite,1,kts:kte,2) = alphah + alpha2d(its:ite,1,kts:kte,3) = alphahl + ENDIF + + ! copy from 3D array to 2D slab DO kz = kts,kte DO ix = its,ite - IF ( present( tt ) ) THEN an(ix,1,kz,lt) = tt(ix,kz,jy)/pii(ix,kz,jy) ELSE an(ix,1,kz,lt) = th(ix,kz,jy) ENDIF - - an(ix,1,kz,lv) = qv(ix,kz,jy) an(ix,1,kz,lc) = qc(ix,kz,jy) an(ix,1,kz,lr) = qr(ix,kz,jy) - IF ( present( qi ) ) THEN + IF ( flag_qi ) THEN an(ix,1,kz,li) = qi(ix,kz,jy) ELSE an(ix,1,kz,li) = 0.0 @@ -2401,13 +2715,16 @@ SUBROUTINE nssl_2mom_driver(qv, qc, qr, qi, qs, qh, qhl, ccw, crw, cci, csw, chw IF ( lccn > 1 ) THEN IF ( is_aerosol_aware .and. flag_qnwfa ) THEN ! - ELSEIF ( present( cn ) ) THEN + ELSEIF ( flag_ccn ) THEN IF ( lccna > 1 .and. .not. ( present( cna ) .and. f_cnatmp ) ) THEN an(ix,1,kz,lccna) = cn(ix,kz,jy) an(ix,1,kz,lccn) = qccn ! cn(ix,kz,jy) ELSE an(ix,1,kz,lccn) = cn(ix,kz,jy) ENDIF + IF ( i_uf_or_ccn > 0 .and. lccnuf > 1 ) THEN ! UF ccn are extra regular ccn + an(ix,1,kz,lccn) = an(ix,1,kz,lccn) + cnuf(ix,kz,jy) + ENDIF ELSE IF ( lccna == 0 .and. ( .not. f_cnatmp ) ) THEN an(ix,1,kz,lccn) = qccn - ccw(ix,kz,jy) @@ -2418,6 +2735,14 @@ SUBROUTINE nssl_2mom_driver(qv, qc, qr, qi, qs, qh, qhl, ccw, crw, cci, csw, chw ENDIF ENDIF + IF ( lccnuf > 0 .and. flag_cnuf ) THEN + IF ( i_uf_or_ccn == 0 ) THEN ! UF are UF + an(ix,1,kz,lccnuf) = Max(0.0, cnuf(ix,kz,jy) ) + ELSE ! UF were added to lccn + an(ix,1,kz,lccnuf) = 0.0 + ENDIF + ENDIF + IF ( lccna > 1 ) THEN IF ( present( cna ) .and. f_cnatmp ) THEN an(ix,1,kz,lccna) = cna(ix,kz,jy) @@ -2448,9 +2773,19 @@ SUBROUTINE nssl_2mom_driver(qv, qc, qr, qi, qs, qh, qhl, ccw, crw, cci, csw, chw IF ( lvh > 0 ) an(ix,1,kz,lvh) = vhw(ix,kz,jy) IF ( lvhl > 0 .and. present( vhl ) ) an(ix,1,kz,lvhl) = vhl(ix,kz,jy) + IF ( ipconc >= 6 ) THEN + IF ( lzr > 0 ) an(ix,1,kz,lzr) = zrw(ix,kz,jy)*zscale + IF ( lzh > 0 ) an(ix,1,kz,lzh) = zhw(ix,kz,jy)*zscale + IF ( lzhl > 0 ) an(ix,1,kz,lzhl) = zhl(ix,kz,jy)*zscale + ENDIF + ENDDO + ENDDO + + DO kz = kts,kte + DO ix = its,ite IF ( present( tt ) ) THEN @@ -2458,6 +2793,26 @@ SUBROUTINE nssl_2mom_driver(qv, qc, qr, qi, qs, qh, qhl, ccw, crw, cci, csw, chw ELSE t0(ix,1,kz) = th(ix,kz,jy)*pii(ix,kz,jy) ! temperature (Kelvin) ENDIF + t00(ix,1,kz) = 380.0/p(ix,kz,jy) + t77(ix,1,kz) = pii(ix,kz,jy) + dbz2d(ix,1,kz) = 0.0 + vzf2d(ix,1,kz) = 0.0 + ENDDO + ENDDO + + DO ix = its,ite + RAINNCV(ix,jy) = 0.0 + IF ( present( GRPLNCV ) ) GRPLNCV(ix,jy) = 0.0 + IF ( present( HAILNCV ) ) HAILNCV(ix,jy) = 0.0 + IF ( present( SNOWNCV ) ) SNOWNCV(ix,jy) = 0.0 + ENDDO + + DO loopcnt = 1,loopmax + + DO kz = kts,kte + DO ix = its,ite + + t1(ix,1,kz) = 0.0 t2(ix,1,kz) = 0.0 t3(ix,1,kz) = 0.0 @@ -2467,14 +2822,11 @@ SUBROUTINE nssl_2mom_driver(qv, qc, qr, qi, qs, qh, qhl, ccw, crw, cci, csw, chw t7(ix,1,kz) = 0.0 t8(ix,1,kz) = 0.0 t9(ix,1,kz) = 0.0 - t00(ix,1,kz) = 380.0/p(ix,kz,jy) - t77(ix,1,kz) = pii(ix,kz,jy) - dbz2d(ix,1,kz) = 0.0 - vzf2d(ix,1,kz) = 0.0 - dn1(ix,1,kz) = dn(ix,kz,jy) pn(ix,1,kz) = p(ix,kz,jy) wn(ix,1,kz) = w(ix,kz,jy) +! calculate dn1 in case we are substepping: rho = con_eps*prsl/(con_rd*tgrs*(qv_mp+con_eps)) + dn1(ix,1,kz) = rdorv*pn(ix,1,kz)/(rd*t0(ix,1,kz)*(an(ix,1,kz,lv) + rdorv)) ! wmax = Max(wmax,wn(ix,1,kz)) dz2d(ix,1,kz) = dz(ix,kz,jy) dz2dinv(ix,1,kz) = 1./dz(ix,kz,jy) @@ -2492,6 +2844,7 @@ SUBROUTINE nssl_2mom_driver(qv, qc, qr, qi, qs, qh, qhl, ccw, crw, cci, csw, chw ! ssival = Min(t8s,max(an(ix,1,kz,lv),0.0))/t9s ! qv/qvi + if ( ssival .gt. 1.0 ) then ! IF ( icenucopt == 1 ) THEN @@ -2544,19 +2897,20 @@ SUBROUTINE nssl_2mom_driver(qv, qc, qr, qi, qs, qh, qhl, ccw, crw, cci, csw, chw ELSEIF ( icenucopt == 4 ) THEN ! DeMott 2010 - IF ( t0(ix,jy,kz) < 268.16 .and. t0(ix,jy,kz) > 223.15 .and. ssival > 1.001 ) THEN ! + IF ( t0(ix,1,kz) < 268.16 .and. t0(ix,1,kz) > 223.15 .and. ssival > 1.001 ) THEN ! ! a = 0.0000594, b = 3.33, c = 0.0264, d = 0.0033, ! nint = a*(-Tc)**b * naer**(c*(-Tc) + d) ! nint has units of per (standard) liter, so mult by 1.e3 and scale by dn/rho00 ! naer needs units of cm**-3, so mult by 1.e-6 - ! dp1 = 1.e3*0.0000594*(273.16 - t0(ix,jy,kz))**3.33 * (1.e-6*cin*dn(ix,jy,kz))**(0.0264*(273.16 - t0(ix,jy,kz)) + 0.0033) - dp1 = 1.e3*dn(ix,jy,kz)/rho00*0.0000594*(273.16 - t0(ix,jy,kz))**3.33 * (1.e-6*naer)**(0.0264*(273.16 - t0(ix,jy,kz)) + 0.0033) - t7(ix,jy,kz) = Min(dp1, 1.0d30) + ! dp1 = 1.e3*0.0000594*(273.16 - t0(ix,1,kz))**3.33 * (1.e-6*cin*dn(ix,1,kz))**(0.0264*(273.16 - t0(ix,1,kz)) + 0.0033) + tmp = 1.e-6*naer + dp1 = 1.e3*dn1(ix,1,kz)/rho00*0.0000594*(273.16 - t0(ix,1,kz))**3.33 * tmp**(0.0264*(273.16 - t0(ix,1,kz)) + 0.0033) + t7(ix,1,kz) = Min(dp1, 1.0d30) ELSE - t7(ix,jy,kz) = 0.0 + ! t7(ix,1,kz) = 0.0 ENDIF ENDIF ! icenucopt @@ -2569,39 +2923,39 @@ SUBROUTINE nssl_2mom_driver(qv, qc, qr, qi, qs, qh, qhl, ccw, crw, cci, csw, chw ENDDO ! ix ENDDO ! kz - has_wetscav = .false. - IF ( wrfchem_flag > 0 ) THEN - IF ( PRESENT( wetscav_on ) ) THEN - has_wetscav = wetscav_on - IF ( has_wetscav ) THEN - IF ( PRESENT( rainprod ) ) rainprod2d(its:ite,kts:kte) = 0 - IF ( PRESENT( evapprod ) ) evapprod2d(its:ite,kts:kte) = 0 - ENDIF - ENDIF - ENDIF + IF ( wrfchem_flag > 0 ) THEN + IF ( has_wetscav ) THEN + IF ( PRESENT( rainprod ) ) rainprod2d(its:ite,kts:kte) = 0 + IF ( PRESENT( evapprod ) ) evapprod2d(its:ite,kts:kte) = 0 + ENDIF + ENDIF ! transform from number mixing ratios to number conc. + IF ( loopcnt == 1 ) THEN DO il = lnb,na IF ( denscale(il) == 1 ) THEN DO kz = kts,kte DO ix = its,ite - an(ix,1,kz,il) = an(ix,1,kz,il)*dn(ix,kz,jy) + an(ix,1,kz,il) = an(ix,1,kz,il)*dn1(ix,1,kz) ! dn(ix,kz,jy) ENDDO ENDDO ENDIF ENDDO ! il + ENDIF + ! sedimentation xfall(:,:,:) = 0.0 - IF ( .true. ) THEN + +! IF ( .true. ) THEN ! #ifndef CM1 ! for real cases when hydrometeor mixing ratios have been initialized without concentrations - IF ( itimestep == 1 .and. ipconc > 0 ) THEN + IF ( itimestep == 1 .and. ipconc > 0 .and. loopcnt == 1 ) THEN call calcnfromq(nx,ny,nz,an,na,nor,nor,dn1) ENDIF ! IF ( itimestep == 3 .and. ipconc > 0 ) THEN @@ -2611,9 +2965,9 @@ SUBROUTINE nssl_2mom_driver(qv, qc, qr, qi, qs, qh, qhl, ccw, crw, cci, csw, chw IF ( present(cu_used) .and. & ( present( qrcuten ) .or. present( qscuten ) .or. & - present( qicuten ) .or. present( qccuten ) ) ) THEN + present( qicuten ) .or. present( qccuten ) ) ) THEN !{ - IF ( cu_used == 1 ) THEN + IF ( cu_used == 1 ) THEN !{ DO kz = kts,kte DO ix = its,ite @@ -2627,10 +2981,22 @@ SUBROUTINE nssl_2mom_driver(qv, qc, qr, qi, qs, qh, qhl, ccw, crw, cci, csw, chw call calcnfromcuten(nx,ny,nz,ancuten,an,na,nor,nor,dn1) + DO kz = kts,kte + DO ix = its,ite + + + IF ( ipconc >= 6 ) THEN +! IF ( lzr > 0 ) an(ix,1,kz,lzr) = an(ix,1,kz,lzr) + ancuten(ix,1,kz,lzr) + ENDIF + + ENDDO + ENDDO - ENDIF + ENDIF !} - ENDIF + ENDIF !} + + call sediment1d(dtp,nx,ny,nz,an,na,nor,nor,xfall,dn1,dz2d,dz2dinv, & @@ -2644,10 +3010,12 @@ SUBROUTINE nssl_2mom_driver(qv, qc, qr, qi, qs, qh, qhl, ccw, crw, cci, csw, chw DO ix = its,ite IF ( lhl > 1 ) THEN - RAINNCV(ix,jy) = dtp*dn1(ix,1,1)*(xfall(ix,1,lr) + xfall(ix,1,ls)*1000./xdn0(lr) + & + RAINNCV(ix,jy) = RAINNCV(ix,jy) + & + dtp*dn1(ix,1,1)*(xfall(ix,1,lr) + xfall(ix,1,ls)*1000./xdn0(lr) + & & xfall(ix,1,lh)*1000./xdn0(lr) + xfall(ix,1,lhl)*1000./xdn0(lr) ) ELSE - RAINNCV(ix,jy) = dtp*dn1(ix,1,1)*(xfall(ix,1,lr) + xfall(ix,1,ls)*1000./xdn0(lr) + & + RAINNCV(ix,jy) = RAINNCV(ix,jy) + & + dtp*dn1(ix,1,1)*(xfall(ix,1,lr) + xfall(ix,1,ls)*1000./xdn0(lr) + & & xfall(ix,1,lh)*1000./xdn0(lr) ) ENDIF IF ( present ( rainncw2 ) ) THEN ! rain only @@ -2662,17 +3030,19 @@ SUBROUTINE nssl_2mom_driver(qv, qc, qr, qi, qs, qh, qhl, ccw, crw, cci, csw, chw & xfall(ix,1,lh)*1000./xdn0(lr) ) ENDIF ENDIF - IF ( present( SNOWNCV ) ) SNOWNCV(ix,jy) = dtp*dn1(ix,1,1)*xfall(ix,1,ls)*1000./xdn0(lr) + IF ( present( SNOWNCV ) ) SNOWNCV(ix,jy) = SNOWNCV(ix,jy) + dtp*dn1(ix,1,1)*xfall(ix,1,ls)*1000./xdn0(lr) IF ( present( GRPLNCV ) ) THEN IF ( lhl > 1 .and. .not. present( HAILNC) ) THEN ! if no separate hail accum, then add to graupel - GRPLNCV(ix,jy) = dtp*dn1(ix,1,1)*(xfall(ix,1,lh) + xfall(ix,1,lhl)) *1000./xdn0(lr) + GRPLNCV(ix,jy) = GRPLNCV(ix,jy) + dtp*dn1(ix,1,1)*(xfall(ix,1,lh) + xfall(ix,1,lhl)) *1000./xdn0(lr) ELSE - GRPLNCV(ix,jy) = dtp*dn1(ix,1,1)*xfall(ix,1,lh)*1000./xdn0(lr) + GRPLNCV(ix,jy) = GRPLNCV(ix,jy) + dtp*dn1(ix,1,1)*xfall(ix,1,lh)*1000./xdn0(lr) ENDIF ENDIF - RAINNC(ix,jy) = RAINNC(ix,jy) + RAINNCV(ix,jy) + IF ( loopcnt == loopmax ) RAINNC(ix,jy) = RAINNC(ix,jy) + RAINNCV(ix,jy) - IF ( present (SNOWNC) .and. present (SNOWNCV) ) SNOWNC(ix,jy) = SNOWNC(ix,jy) + SNOWNCV(ix,jy) + IF ( present (SNOWNC) .and. present (SNOWNCV) .and. loopcnt == loopmax ) THEN + SNOWNC(ix,jy) = SNOWNC(ix,jy) + SNOWNCV(ix,jy) + ENDIF IF ( lhl > 1 ) THEN !#ifdef CM1 ! IF ( .true. ) THEN @@ -2680,13 +3050,15 @@ SUBROUTINE nssl_2mom_driver(qv, qc, qr, qi, qs, qh, qhl, ccw, crw, cci, csw, chw IF ( present( HAILNC ) ) THEN !#endif HAILNCV(ix,jy) = dtp*dn1(ix,1,1)*xfall(ix,1,lhl)*1000./xdn0(lr) - HAILNC(ix,jy) = HAILNC(ix,jy) + HAILNCV(ix,jy) + IF ( loopcnt == loopmax ) HAILNC(ix,jy) = HAILNC(ix,jy) + HAILNCV(ix,jy) ! ELSEIF ( present( GRPLNCV ) ) THEN ! if no separate hail accum, then add to graupel ! GRPLNCV(ix,jy) = GRPLNCV(ix,jy) + dtp*dn1(ix,1,1)*xfall(ix,1,lhl)*1000./xdn0(lr) ENDIF ENDIF - IF ( present( GRPLNCV ) ) GRPLNC(ix,jy) = GRPLNC(ix,jy) + GRPLNCV(ix,jy) - IF ( present( SR ) .and. present (SNOWNCV) .and. present(GRPLNCV) ) THEN + IF ( present( GRPLNCV ) .and. loopcnt == loopmax ) THEN + GRPLNC(ix,jy) = GRPLNC(ix,jy) + GRPLNCV(ix,jy) + ENDIF + IF ( present( SR ) .and. present (SNOWNCV) .and. present(GRPLNCV) .and. loopcnt == loopmax ) THEN IF ( present( HAILNC ) ) THEN SR(ix,jy) = (SNOWNCV(ix,jy)+HAILNCV(ix,jy)+GRPLNCV(ix,jy))/(RAINNCV(ix,jy)+1.e-12) ELSE @@ -2695,7 +3067,7 @@ SUBROUTINE nssl_2mom_driver(qv, qc, qr, qi, qs, qh, qhl, ccw, crw, cci, csw, chw ENDIF ENDDO - ENDIF ! .false. +! ENDIF ! .false. IF ( isedonly /= 1 ) THEN ! call nssl_2mom_gs: main gather-scatter routine to calculate microphysics @@ -2717,15 +3089,22 @@ SUBROUTINE nssl_2mom_driver(qv, qc, qr, qi, qs, qh, qhl, ccw, crw, cci, csw, chw ! & ln,ipc,lvol,lz,lliq, & & cdx, & & xdn0,dbz2d,tke2d, & - & thproclocal,nproc,dx1,dy1, & + & thproclocal,nproc,dx1,dy1,ngs, & & timevtcalc,axtra2d, makediag & - & ,has_wetscav, rainprod2d, evapprod2d & + & ,has_wetscav, rainprod2d, evapprod2d, alpha2d & & ,errmsg,errflg & & ,elec2,its,ids,ide,jds,jde & & ) +! recalculate dn1 after temperature changes: rho = con_eps*prsl/(con_rd*tgrs*(qv_mp+con_eps)) + DO kz = kts,kte + DO ix = its,ite + dn1(ix,1,kz) = rdorv*pn(ix,1,kz)/(rd*t0(ix,1,kz)*(an(ix,1,kz,lv) + rdorv)) + ENDDO + ENDDO + ENDIF ! isedonly /= 1 @@ -2737,29 +3116,38 @@ SUBROUTINE nssl_2mom_driver(qv, qc, qr, qi, qs, qh, qhl, ccw, crw, cci, csw, chw & ,dz2d & & ,t0,t9 & & ,an,dn1,t77 & - & ,pn,wn & + & ,pn,wn & + & ,ngs & & ,axtra2d, makediag & & ,ssat,t00,t77,flag_qndrop) +! recalculate dn1 after temperature changes + DO kz = kts,kte + DO ix = its,ite + dn1(ix,1,kz) = rdorv*pn(ix,1,kz)/(rd*t0(ix,1,kz)*(an(ix,1,kz,lv) + rdorv)) + ENDDO + ENDDO + ENDIF + + ENDDO ! loopcnt=1,loopmax IF ( present( pcc2 ) .and. makediag ) THEN DO kz = kts,kte DO ix = its,ite ! example of using the 'axtra2d' array to get rates out of the microphysics routine for output. ! Search for 'axtra' to find example code below ! pcc2(ix,kz,jy) = axtra2d(ix,1,kz,1) - ENDDO ENDDO ENDIF ! compute diagnostic S-band reflectivity if needed - IF ( present( dbz ) .and. makediag ) THEN + IF ( present( dbz ) .and. makediag .and. lastlooptmp ) THEN ! calc dbz IF ( .true. ) THEN @@ -2797,7 +3185,8 @@ SUBROUTINE nssl_2mom_driver(qv, qc, qr, qi, qs, qh, qhl, ccw, crw, cci, csw, chw ! Following Greg Thompson, calculation for effective radii. Used by RRTMG LW/SW schemes if enabled in module_physics_init.F IF ( present( has_reqc ).and. present( has_reqi ) .and. present( has_reqs ) .and. & - present( re_cloud ).and. present( re_ice ) .and. present( re_snow ) ) THEN + present( re_cloud ).and. present( re_ice ) .and. present( re_snow ) .and. & + lastlooptmp) THEN IF ( has_reqc.ne.0 .or. has_reqi.ne.0 .or. has_reqs.ne.0) THEN DO kz = kts,kte DO ix = its,ite @@ -2815,16 +3204,16 @@ SUBROUTINE nssl_2mom_driver(qv, qc, qr, qi, qs, qh, qhl, ccw, crw, cci, csw, chw call calc_eff_radius & & (nx,ny,nz,na,jy & & ,nor,nor & - & ,t1=t1,t2=t2,t3=t3,t4=t4 & + & ,t1=t1,t2=t2,t3=t3,t4=t4,t5=t5,t6=t6,f_t5=has_reqg_local, f_t6=has_reqh_local & & ,an=an,dn=dn1 ) DO kz = kts,kte DO ix = its,ite re_cloud(ix,kz,jy) = MAX(2.51E-6, MIN(t1(ix,1,kz), 50.E-6)) - re_ice(ix,kz,jy) = MAX(10.01E-6, MIN(t2(ix,1,kz), 200.E-6)) + re_ice(ix,kz,jy) = MAX(10.01E-6, MIN(t2(ix,1,kz), 125.E-6)) re_snow(ix,kz,jy) = MAX(25.E-6, MIN(t3(ix,1,kz), 999.E-6)) ! check for case where snow needs to be treated as cloud ice (for rrtmg radiation) - IF ( .not. present(qi) ) re_ice(ix,kz,jy) = MAX(10.E-6, MIN(t3(ix,1,kz), 200.E-6)) + IF ( .not. present(qi) ) re_ice(ix,kz,jy) = MAX(10.E-6, MIN(t3(ix,1,kz), 125.E-6)) ENDDO ENDDO @@ -2837,19 +3226,53 @@ SUBROUTINE nssl_2mom_driver(qv, qc, qr, qi, qs, qh, qhl, ccw, crw, cci, csw, chw ENDDO ENDIF ENDIF + + IF ( present(has_reqg) .and. present( re_graup ) ) THEN + IF ( has_reqg /= 0 ) THEN + DO kz = kts,kte + DO ix = its,ite + re_graup(ix,kz,jy) = MAX(50.E-6, MIN(t5(ix,1,kz), 10.E-3)) + ENDDO + ENDDO + ENDIF + ENDIF + + IF ( present(has_reqh) .and. present( re_hail ) ) THEN + IF ( has_reqh /= 0 ) THEN + DO kz = kts,kte + DO ix = its,ite + re_hail(ix,kz,jy) = MAX(50.E-6, MIN(t5(ix,1,kz), 40.E-3)) + ENDDO + ENDDO + ENDIF + ENDIF ENDIF ENDIF + IF ( present( hail_maxk1 ) .and. present( hail_max2d ) .and. nwp_diagflag ) THEN + DO ix = its,ite + hailmax1d(ix,1) = hail_max2d(ix,jy) + hailmaxk1(ix,1) = hail_maxk1(ix,jy) + ENDDO + + call hailmaxd(dtp,nx,ny,nz,an,na,nor,nor,alpha2d,dn1, & + hailmax1d,hailmaxk1,1 ) + DO ix = its,ite + hail_max2d(ix,jy) = hailmax1d(ix,1) + hail_maxk1(ix,jy) = hailmaxk1(ix,1) + ENDDO +! ENDIF + ENDIF ! transform concentrations back to mixing ratios DO il = lnb,na IF ( denscale(il) == 1 ) THEN DO kz = kts,kte DO ix = its,ite - an(ix,1,kz,il) = an(ix,1,kz,il)/dn(ix,kz,jy) + an(ix,1,kz,il) = an(ix,1,kz,il)/dn1(ix,1,kz) ! dn(ix,kz,jy) ENDDO ENDDO ENDIF @@ -2870,14 +3293,14 @@ SUBROUTINE nssl_2mom_driver(qv, qc, qr, qi, qs, qh, qhl, ccw, crw, cci, csw, chw qv(ix,kz,jy) = an(ix,1,kz,lv) qc(ix,kz,jy) = an(ix,1,kz,lc) qr(ix,kz,jy) = an(ix,1,kz,lr) - IF ( present(qi) ) qi(ix,kz,jy) = an(ix,1,kz,li) + IF ( flag_qi ) qi(ix,kz,jy) = an(ix,1,kz,li) qs(ix,kz,jy) = an(ix,1,kz,ls) qh(ix,kz,jy) = an(ix,1,kz,lh) IF ( lhl > 1 ) qhl(ix,kz,jy) = an(ix,1,kz,lhl) IF ( lccn > 1 .and. is_aerosol_aware .and. flag_qnwfa ) THEN ! not used here - ELSEIF ( present( cn ) .and. lccn > 1 .and. .not. flag_qndrop) THEN + ELSEIF ( flag_ccn .and. lccn > 1 .and. .not. flag_qndrop) THEN IF ( lccna > 1 .and. .not. ( present( cna ) .and. f_cnatmp ) ) THEN cn(ix,kz,jy) = Max(0.0, an(ix,1,kz,lccna) ) ELSE @@ -2896,6 +3319,21 @@ SUBROUTINE nssl_2mom_driver(qv, qc, qr, qi, qs, qh, qhl, ccw, crw, cci, csw, chw ENDIF ENDIF + IF ( lccnuf > 0 .and. flag_cnuf ) THEN + IF ( i_uf_or_ccn > 0 ) THEN ! UF are ccn and lccnuf is zero, so put cnuf into lccnuf to do decay + an(ix,1,kz,lccnuf) = Max(0.0, cnuf(ix,kz,jy) ) + ENDIF + IF ( decayufccn ) THEN + IF ( an(ix,1,kz,lccnuf) > ufbackground ) THEN + an(ix,1,kz,lccnuf) = an(ix,1,kz,lccnuf) - (an(ix,1,kz,lccnuf) - & + ufbackground)*(1.0 - exp(-dtp/ufccntimeconst)) + ENDIF + ENDIF + cnuf(ix,kz,jy) = an(ix,1,kz,lccnuf) + ENDIF + + + IF ( ipconc >= 5 ) THEN ccw(ix,kz,jy) = an(ix,1,kz,lnc) @@ -2906,6 +3344,11 @@ SUBROUTINE nssl_2mom_driver(qv, qc, qr, qi, qs, qh, qhl, ccw, crw, cci, csw, chw IF ( lhl > 1 ) chl(ix,kz,jy) = an(ix,1,kz,lnhl) ENDIF + IF ( ipconc >= 6 ) THEN + IF ( lzr > 0 ) zrw(ix,kz,jy) = an(ix,1,kz,lzr) *zscaleinv + IF ( lzh > 0 ) zhw(ix,kz,jy) = an(ix,1,kz,lzh) *zscaleinv + IF ( lzhl > 0 ) zhl(ix,kz,jy) = an(ix,1,kz,lzhl)*zscaleinv + ENDIF @@ -2914,6 +3357,9 @@ SUBROUTINE nssl_2mom_driver(qv, qc, qr, qi, qs, qh, qhl, ccw, crw, cci, csw, chw #if ( WRF_CHEM == 1 ) IF ( has_wetscav ) THEN + IF ( loopmax > 1 ) THEN + ! wrferror not supported + ENDIF IF ( PRESENT( rainprod ) ) rainprod(ix,kz,jy) = rainprod2d(ix,kz) IF ( PRESENT( evapprod ) ) evapprod(ix,kz,jy) = evapprod2d(ix,kz) ENDIF @@ -2921,8 +3367,11 @@ SUBROUTINE nssl_2mom_driver(qv, qc, qr, qi, qs, qh, qhl, ccw, crw, cci, csw, chw ENDDO ENDDO - + + ENDDO ! jy + + @@ -3217,7 +3666,7 @@ END FUNCTION GAML02 ! ********************************************************** !>\ingroup mod_nsslmp !! Function calculates fraction of drops larger than 300 microns ( imurain == 3 ) - real FUNCTION GAML02d300(x) + real FUNCTION GAML02d300(x) implicit none integer ig, i, ii, n, np real x @@ -3558,11 +4007,245 @@ Function delabk(ba,bb,nua,nub,mua,mub,k) RETURN END Function delabk - + + +! ####################################################################### +! HAILMAXD - calculated maximum expected hail size +! ####################################################################### !>\ingroup mod_nsslmp -!! Sedimentation driver subroutine. Calls fallout column by column - subroutine sediment1d(dtp,nx,ny,nz,an,na,nor,norz,xfall,dn,dz3d,dz3dinv, & +!! Hail max size subroutine. + subroutine hailmaxd(dtp,nx,ny,nz,an,na,nor,norz,alpha2d,dn, & + & hailmax1d,hailmaxk1,jslab ) +! +! Calculate maximum hail size from the tail of of the distribution. The value +! of thresh_conc sets the minimum concentration in the integral over (Dmax, Inf). +! This uses the lookup tables for incomplete gamma functions and simply search for +! the expected value (and linearly interpolate) on D. +! +! Written by ERM 7/2023 +! +! +! + implicit none + + integer nx,ny,nz,nor,norz,ngt,jgs,na,ia + integer id ! =1 use density, =0 no density +! integer :: its,ite ! x-range to calculate + + integer ng1 + parameter(ng1 = 1) + + real an(-nor+1:nx+nor,-nor+1:ny+nor,-norz+1:nz+norz,na) + real dn(-nor+1:nx+nor,-nor+1:ny+nor,-norz+1:nz+norz) + +! real gz(-nor+ng1:nz+nor),z1d(-nor+ng1:nz+nor,4) + real dtp + real alpha2d(-nor+1:nx+nor,1,-norz+1:nz+norz,3) ! array for PSD shape parameters + real :: hailmax1d(nx,ny),hailmaxk1(nx,ny) + integer infdo + integer jslab ! which line of xfall to use + + integer ix,jy,kz,ndfall,n,k,il,in + double precision :: tmp, ratio, del, g1palp + real, parameter :: dz = 200. + + real :: db1(nx,nz+1),dtz1(nz+1,nx,0:1),dz2dinv(nz+1,nx),db1inv(nx,nz+1) + + real :: rhovtzx(nz,nx) + + real :: alp, diam, diam1, hwdn + +! real, parameter :: cmin = 0.001 ! threshold number per m^3 for maximum diamter (threshold from diag_nwp) + DOUBLE PRECISION, PARAMETER:: thresh_conc = 0.0005d0 ! number conc. of graupel/hail per cubic meter + real :: cwchtmp,cwchltmp, maxdia + +!----------------------------------------------------------------------------- + + integer :: ixb, jyb, kzb + integer :: ixe, jye, kze + integer :: plo, phi + integer :: ialp, i, j + + logical :: debug_mpi = .TRUE. + +! ################################################################### + + + IF ( lh > 1 ) THEN + cwchtmp = ((3. + dnu(lh))*(2. + dnu(lh))*(1.0 + dnu(lh)))**(-1./3.) + ENDIF + IF ( lhl > 1 ) THEN + cwchltmp = ((3. + dnu(lhl))*(2. + dnu(lhl))*(1.0 + dnu(lhl)))**(-1./3.) + ENDIF + + + kzb = 1 + kze = nz + + ixb = 1 ! aliased its + ixe = nx ! aliased ite + + + jy = jslab + jgs = jy + + +! hailmax1d(:,jy) = 0.0 +! hailmaxk1(:,jy) = 0.0 + + if ( ndebug .gt. 0 ) write(0,*) 'dbg = 3a' + + +! first graupel, even if hail is also predicted, since graupel can sometime be large on its own + IF ( lh > 1 .and. lnh > 1 ) THEN + DO kz = kzb,kze + DO ix = ixb,ixe + IF ( an(ix,jy,kz,lh) .gt. qxmin(lh) .and. an(ix,jy,kz,lnh) .gt. thresh_conc ) THEN + IF ( lvh .gt. 1 ) THEN + hwdn = dn(ix,jy,kz)*an(ix,jy,kz,lh)/an(ix,jy,kz,lvh) + ELSE + hwdn = rho_qh + ENDIF + + tmp = 1. + alpha2d(ix,1,kz,2) + i = Int(dgami*(tmp)) + del = tmp - dgam*i + g1palp = gmoi(i) + (gmoi(i+1) - gmoi(i))*del*dgami + + tmp = dn(ix,jy,kz)*an(ix,jy,kz,lh)/(hwdn*an(ix,jy,kz,lnh)) + diam = (6.0*tmp/pi)**(1./3.) + IF ( lzh > 1 ) THEN ! 3moment + cwchtmp = ((3. + alpha2d(ix,1,kz,2))*(2. + alpha2d(ix,1,kz,2))*(1.0 + alpha2d(ix,1,kz,2)))**(-1./3.) + ENDIF + diam1 = diam*cwchtmp ! characteristic diameter, i.e., 1/lambda + ! want cxd1 = thresh_conc + ! tmp = gaminterp(ratio,alpha(mgs,lh),1,1) + ! cxd1 = cx(mgs,lh)*(tmp)/g1palp + ! tmp = thresh_conc*g1palp/cx + ! + tmp = thresh_conc*g1palp/an(ix,jy,kz,lnh) + alp = alpha2d(ix,1,kz,2) + ! gamxinflu(i,j,luindex,ilh) + j = Int(Max(0.0,Min(maxalphalu,alp))*dqiacralphainv) + ratio = 0.0 + maxdia = 0.0 + ! eventually could replace with bisection search, but final value of i is usually small + ! compared to nqiacrratio + DO i = 0,nqiacrratio-1 + IF ( gamxinflu(i,j,1,1) >= tmp .and. tmp >= gamxinflu(i+1,j,1,1) ) THEN + ! interpolate here for FWIW + ratio = i*dqiacrratio + del = tmp - gamxinflu(i,j,1,1) + ratio = (float(i) + del/(gamxinflu(i+1,j,1,1) - gamxinflu(i,j,1,1)))*dqiacrratio + exit + ENDIF + ENDDO + + IF ( ratio > 0.0 ) THEN + maxdia = ratio*diam1 ! units of m + ENDIF + + IF ( kz == kzb ) THEN + hailmaxk1(ix,jy) = Max( maxdia, hailmaxk1(ix,jy) ) +! IF ( maxdia > 0.1 ) THEN +! IF ( an(ix,jy,kz,lh) > 1.e-4 ) THEN +! write(0,*) 'maxdia,tmp,alp,ratio,diam,diam1= ',maxdia,tmp,alp,ratio,diam*100.,diam1*100. +! write(0,*) 'hwdn, cxhl, qx, g1palp = ',hwdn, an(ix,jy,kz,lnhl), an(ix,jy,kz,lhl), g1palp +! write(0,*) 'j,gamxinflu(0,2,4) = ',j,gamxinflu(0,j,1,1),gamxinflu(2,j,1,1), & +! gamxinflu(4,j,1,1) +! ENDIF + ENDIF + + hailmax1d(ix,jy) = Max(maxdia, hailmax1d(ix,jy) ) + + ! + + ENDIF + + ENDDO + ENDDO + + ENDIF ! lh + +! And diam for hail if present + IF ( lhl > 1 .and. lnhl > 1 ) THEN + DO kz = kzb,kze + DO ix = ixb,ixe + IF ( an(ix,jy,kz,lhl) .gt. qxmin(lhl) .and. an(ix,jy,kz,lnhl) .gt. thresh_conc ) THEN + IF ( lvhl .gt. 1 ) THEN + hwdn = dn(ix,jy,kz)*an(ix,jy,kz,lhl)/an(ix,jy,kz,lvhl) + ELSE + hwdn = rho_qhl + ENDIF + + tmp = 1. + alpha2d(ix,1,kz,3) + i = Int(dgami*(tmp)) + del = tmp - dgam*i + g1palp = gmoi(i) + (gmoi(i+1) - gmoi(i))*del*dgami + + tmp = dn(ix,jy,kz)*an(ix,jy,kz,lhl)/(hwdn*an(ix,jy,kz,lnhl)) + diam = (6.0*tmp/pi)**(1./3.) + IF ( lzhl > 1 ) THEN ! 3moment + cwchltmp = ((3. + alpha2d(ix,1,kz,3))*(2. + alpha2d(ix,1,kz,3))*(1.0 + alpha2d(ix,1,kz,3)))**(-1./3.) + ENDIF + diam1 = diam*cwchltmp ! characteristic diameter, i.e., 1/lambda + ! want cxd1 = thresh_conc + ! tmp = gaminterp(ratio,alpha(mgs,lh),1,1) + ! cxd1 = cx(mgs,lh)*(tmp)/g1palp + ! tmp = thresh_conc*g1palp/cx + ! + tmp = thresh_conc*g1palp/an(ix,jy,kz,lnhl) + alp = alpha2d(ix,1,kz,3) + ! gamxinflu(i,j,luindex,ilh) + j = Int(Max(0.0,Min(maxalphalu,alp))*dqiacralphainv) + ratio = 0.0 + maxdia = 0.0 + ! eventually could replace with bisection search, but final value of i is usually small + ! compared to nqiacrratio + DO i = 0,nqiacrratio-1 + IF ( gamxinflu(i,j,1,1) >= tmp .and. tmp >= gamxinflu(i+1,j,1,1) ) THEN + ! interpolate here for FWIW + ratio = i*dqiacrratio + del = tmp - gamxinflu(i,j,1,1) + ratio = (float(i) + del/(gamxinflu(i+1,j,1,1) - gamxinflu(i,j,1,1)))*dqiacrratio + exit + ENDIF + ENDDO + + IF ( ratio > 0.0 ) THEN + maxdia = ratio*diam1 ! units of m + ENDIF + + IF ( kz == kzb ) THEN + hailmaxk1(ix,jy) = Max( maxdia, hailmaxk1(ix,jy) ) +! IF ( maxdia > 0.1 ) THEN +! IF ( an(ix,jy,kz,lhl) > 1.e-4 ) THEN +! write(0,*) 'maxdia,tmp,alp,ratio,diam,diam1= ',maxdia,tmp,alp,ratio,diam*100.,diam1*100. +! write(0,*) 'hwdn, cxhl, qx, g1palp = ',hwdn, an(ix,jy,kz,lnhl), an(ix,jy,kz,lhl), g1palp +! write(0,*) 'j,gamxinflu(0,2,4) = ',j,gamxinflu(0,j,1,1),gamxinflu(2,j,1,1), & +! gamxinflu(4,j,1,1) +! ENDIF + ENDIF + + hailmax1d(ix,jy) = Max(maxdia, hailmax1d(ix,jy) ) + + ! + + ENDIF + + ENDDO + ENDDO + + ENDIF + + + END SUBROUTINE HAILMAXD +! ####################################################################### +! ####################################################################### +!>\ingroup mod_nsslmp +!! Sedimentation driver subroutine. Calls fallout column by column + subroutine sediment1d(dtp,nx,ny,nz,an,na,nor,norz,xfall,dn,dz3d,dz3dinv, & & t0,t7,infdo,jslab,its,jts, & & timesed1,timesed2,timesed3,zmaxsed,timesetvt) ! used for timing ! @@ -3591,7 +4274,7 @@ subroutine sediment1d(dtp,nx,ny,nz,an,na,nor,norz,xfall,dn,dz3d,dz3dinv, & ! real gz(-nor+ng1:nz+nor),z1d(-nor+ng1:nz+nor,4) real dtp real xfall(nx,ny,na) ! array for stuff landing on the ground - real xfall0(nx,ny) ! dummy array +! real xfall0(nx,ny) ! dummy array integer infdo integer jslab ! which line of xfall to use @@ -3599,47 +4282,81 @@ subroutine sediment1d(dtp,nx,ny,nz,an,na,nor,norz,xfall,dn,dz3d,dz3dinv, & real tmp, vtmax, dtptmp, dtfrac real, parameter :: dz = 200. - real :: xvt(nz+1,nx,3,lc:lhab) ! (nx,nz,2,lc:lhab) ! 1=mass-weighted, 2=number-weighted - real :: tmpn(-nor+ng1:nx+nor,-nor+ng1:ny+nor,-norz+ng1:nz+norz) - real :: tmpn2(-nor+ng1:nx+nor,-nor+ng1:ny+nor,-norz+ng1:nz+norz) - real :: z(-nor+ng1:nx+nor,-norz+ng1:nz+norz,lr:lhab) - real :: db1(nx,nz+1),dtz1(nz+1,nx,0:1),dz2dinv(nz+1,nx),db1inv(nx,nz+1) +! real :: xvt(nz+1,nx,3,lc:lhab) ! (nx,nz,2,lc:lhab) ! 1=mass-weighted, 2=number-weighted +! real :: tmpn(-nor+ng1:nx+nor,-nor+ng1:ny+nor,-norz+ng1:nz+norz) +! real :: tmpn2(-nor+ng1:nx+nor,-nor+ng1:ny+nor,-norz+ng1:nz+norz) +! real :: z(-nor+ng1:nx+nor,-norz+ng1:nz+norz,lr:lhab) +! real :: db1(nx,nz+1),dtz1(nz+1,nx,0:1),dz2dinv(nz+1,nx),db1inv(nx,nz+1) - real :: rhovtzx(nz,nx) +! real :: rhovtzx(nz,nx) + + real, allocatable :: db1(:,:), dtz1(:,:,:),dz2dinv(:,:),db1inv(:,:) ! db1(nx,nz+1),dtz1(nz+1,nx,0:1),dz2dinv(nz+1,nx),db1inv(nx,nz+1) + real, allocatable :: rhovtzx(:,:) + real, allocatable :: xfall0(:,:), xvt(:,:,:,:),tmpn(:,:,:),tmpn2(:,:,:),z(:,:,:) double precision :: timesed1,timesed2,timesed3, zmaxsed,timesetvt,dummy double precision :: dt1,dt2,dt3,dt4 - integer,parameter :: ngs = 128 + integer :: ngs ! = 512 integer :: ngscnt,mgs,ipconc0 - real :: qx(ngs,lv:lhab) - real :: qxw(ngs,ls:lhab) - real :: cx(ngs,lc:lhab) - real :: xv(ngs,lc:lhab) - real :: vtxbar(ngs,lc:lhab,3) - real :: xmas(ngs,lc:lhab) - real :: xdn(ngs,lc:lhab) - real :: xdia(ngs,lc:lhab,3) - real :: vx(ngs,li:lhab) - real :: alpha(ngs,lc:lhab) - real :: zx(ngs,lr:lhab) - logical :: hasmass(nx,lc+1:lhab) - - integer igs(ngs),kgs(ngs) - - real rho0(ngs),temcg(ngs) - - real temg(ngs) - - real rhovt(ngs) - - real cwnc(ngs),cinc(ngs) - real fadvisc(ngs),cwdia(ngs),cipmas(ngs) - - real cimasn,cimasx,cnina(ngs),cimas(ngs) - - real cnostmp(ngs) +! real :: qx(ngs,lv:lhab) +! real :: qxw(ngs,ls:lhab) +! real :: cx(ngs,lc:lhab) +! real :: xv(ngs,lc:lhab) +! real :: vtxbar(ngs,lc:lhab,3) +! real :: xmas(ngs,lc:lhab) +! real :: xdn(ngs,lc:lhab) +! real :: xdia(ngs,lc:lhab,3) +! real :: vx(ngs,li:lhab) +! real :: alpha(ngs,lc:lhab) +! real :: zx(ngs,lr:lhab) +! logical :: hasmass(nx,lc+1:lhab) +! +! integer igs(ngs),kgs(ngs) +! +! real rho0(ngs),temcg(ngs) +! +! real temg(ngs) +! +! real rhovt(ngs) +! +! real cwnc(ngs),cinc(ngs) +! real fadvisc(ngs),cwdia(ngs),cipmas(ngs) +! +! real cimasn,cimasx,cnina(ngs),cimas(ngs) +! +! real cnostmp(ngs) + + real, allocatable :: qx(:,:) + real, allocatable :: qxw(:,:) + real, allocatable :: cx(:,:) + real, allocatable :: xv(:,:) + real, allocatable :: vtxbar(:,:,:) + real, allocatable :: xmas(:,:) + real, allocatable :: xdn(:,:) + real, allocatable :: xdia(:,:,:) + real, allocatable :: vx(:,:) + real, allocatable :: alpha(:,:) + real, allocatable :: zx(:,:) + logical, allocatable :: hasmass(:,:) + + integer, allocatable :: igs(:),kgs(:) + + real, allocatable :: rho0(:),temcg(:) + + real, allocatable :: temg(:) + + real, allocatable :: rhovt(:) + + real, allocatable :: cwnc(:),cinc(:) + real, allocatable :: fadvisc(:),cwdia(:),cipmas(:) + + real, allocatable :: cnina(:),cimas(:) + + real, allocatable :: cnostmp(:) + + real :: cimasn,cimasx !----------------------------------------------------------------------------- @@ -3653,7 +4370,30 @@ subroutine sediment1d(dtp,nx,ny,nz,an,na,nor,norz,xfall,dn,dz3d,dz3dinv, & ! ################################################################### - + allocate( db1(nx,nz+1),dtz1(nz+1,nx,0:1),dz2dinv(nz+1,nx),db1inv(nx,nz+1),rhovtzx(nz,nx) ) + allocate( xfall0(nx,ny), xvt(nz+1,nx,3,lc:lhab), tmpn(-nor+ng1:nx+nor,-nor+ng1:ny+nor,-norz+ng1:nz+norz) ) + allocate( tmpn2(-nor+ng1:nx+nor,-nor+ng1:ny+nor,-norz+ng1:nz+norz), z(-nor+ng1:nx+nor,-norz+ng1:nz+norz,lr:lhab)) + + ngs = nz+3 + + allocate( qx(ngs,lv:lhab), & + qxw(ngs,ls:lhab), & + cx(ngs,lc:lhab), & + xv(ngs,lc:lhab), & + vtxbar(ngs,lc:lhab,3), & + xmas(ngs,lc:lhab), & + xdn(ngs,lc:lhab), & + xdia(ngs,lc:lhab,3), & + vx(ngs,li:lhab), & + alpha(ngs,lc:lhab), & + zx(ngs,lr:lhab), & + hasmass(nx,lc+1:lhab), & + igs(ngs),kgs(ngs), & + rho0(ngs),temcg(ngs),temg(ngs), rhovt(ngs), & + cwnc(ngs),cinc(ngs), & + fadvisc(ngs),cwdia(ngs),cipmas(ngs), & + cnina(ngs),cimas(ngs), & + cnostmp(ngs) ) kzb = 1 kze = nz @@ -3825,7 +4565,8 @@ subroutine sediment1d(dtp,nx,ny,nz,an,na,nor,norz,xfall,dn,dz3d,dz3dinv, & IF ( il >= lr .and. ( infall .eq. 3 .or. infall .eq. 4 ) .and. ln(il) > 0 ) THEN - IF ( (il .eq. lr .and. irfall .eq. infall .and. lzr < 1) .or. (il .ge. lh .and. lz(il) .lt. 1 ) ) THEN + IF ( (il .eq. lr .and. irfall .eq. infall .and. lzr < 1) .or. & + (il .ge. lh .and. lz(il) .lt. 1 ) .or. (il == ls .and. isfall == infall ) ) THEN call calczgr1d(nx,ny,nz,nor,na,an,ixe,kze, & & z,db1,jgs,ipconc, dnu(il), il, ln(il), qxmin(il), xvmn(il), xvmx(il), lvol(il), xdn0(il), ix ) ENDIF @@ -3850,6 +4591,14 @@ subroutine sediment1d(dtp,nx,ny,nz,an,na,nor,norz,xfall,dn,dz3d,dz3dinv, & ENDIF ENDIF +! reflectivity + + IF ( ipconc .ge. 6 ) THEN + IF ( lz(il) .gt. 1 ) THEN + call fallout1d(nx,ny,nz,nor,na,dtptmp,dtfrac,jgs,xvt(1,1,3,il), & + & an,db1,lz(il),0,xfall,dtz1,ix) + ENDIF + ENDIF if (ndebug .gt. 0 ) write(0,*) 'dbg = 3d' @@ -3863,9 +4612,11 @@ subroutine sediment1d(dtp,nx,ny,nz,an,na,nor,norz,xfall,dn,dz3d,dz3dinv, & ! to put a lower bound on number conc. ! - IF ( ( infall .eq. 3 .or. infall .eq. 4 ) .and. ( il .eq. lh .or. il .eq. lhl .or. & + IF ( ( infall .eq. 3 .or. infall .eq. 4 ) .and. ( (il == ls .and. isfall .eq. infall ) & + & .or. il .eq. lh .or. il .eq. lhl .or. il == lf .or. & & ( il .eq. lr .and. irfall .eq. infall) ) ) THEN + ! set up for method I+II DO kz = kzb,kze ! DO ix = ixb,ixe tmpn2(ix,jy,kz) = z(ix,kz,il) @@ -3878,7 +4629,7 @@ subroutine sediment1d(dtp,nx,ny,nz,an,na,nor,norz,xfall,dn,dz3d,dz3dinv, & ENDDO ELSE - + ! set up for method II only DO kz = kzb,kze ! DO ix = ixb,ixe tmpn(ix,jy,kz) = an(ix,jy,kz,ln(il)) @@ -3907,7 +4658,8 @@ subroutine sediment1d(dtp,nx,ny,nz,an,na,nor,norz,xfall,dn,dz3d,dz3dinv, & xfall0(:,jgs) = 0.0 IF ( ( infall .eq. 3 .or. infall .eq. 4 ) .and. & - & ( il .ge. lh .or. (il .eq. lr .and. irfall .eq. infall) ) ) THEN + & ( il .ge. lh .or. (il .eq. lr .and. irfall .eq. infall) & + .or. (il .eq. ls .and. isfall .eq. infall) ) ) THEN call fallout1d(nx,ny,nz,nor,1,dtptmp,dtfrac,jgs,xvt(1,1,3,il), & & tmpn2,db1,1,0,xfall0,dtz1,ix) call fallout1d(nx,ny,nz,nor,1,dtptmp,dtfrac,jgs,xvt(1,1,1,il), & @@ -3918,12 +4670,12 @@ subroutine sediment1d(dtp,nx,ny,nz,an,na,nor,norz,xfall,dn,dz3d,dz3dinv, & ENDIF IF ( ( infall .eq. 3 .or. infall .eq. 4 ) .and. ( (il .eq. lr .and. irfall .eq. infall) & - & .or. il .ge. lh ) ) THEN + & .or. il .ge. lh .or. (il == ls .and. isfall .eq. infall ) ) ) THEN ! "Method I" - dbz correction call calcnfromz1d(nx,ny,nz,nor,na,an,tmpn2,ixe,kze, & & z,db1,jgs,ipconc, dnu(il), il, ln(il), qxmin(il), xvmn(il), xvmx(il),tmpn, & - & lvol(il), rho_qh, infall, ix) + & lvol(il), xdn0(il), infall, ix) ELSEIF ( infall .eq. 5 .and. il .ge. lh .or. ( il == lr .and. irfall == 5 ) ) THEN @@ -3934,7 +4686,7 @@ subroutine sediment1d(dtp,nx,ny,nz,an,na,nor,norz,xfall,dn,dz3d,dz3dinv, & ! ENDDO ENDDO - ELSEIF ( .not. (il .eq. lr .and. irfall .eq. 0) ) THEN + ELSEIF ( .not. (il .eq. lr .and. irfall .eq. 0) .and. .not. (il .eq. ls .and. isfall .eq. 0) ) THEN ! "Method II" M-wgt N-fallout correction DO kz = kzb,kze @@ -3961,8 +4713,29 @@ subroutine sediment1d(dtp,nx,ny,nz,an,na,nor,norz,xfall,dn,dz3d,dz3dinv, & ENDDO ! ix + deallocate( db1,dtz1,dz2dinv,db1inv,rhovtzx ) + deallocate( xfall0, xvt, tmpn ) + deallocate( tmpn2, z) + + deallocate( qx, & + qxw, & + cx, & + xv, & + vtxbar, & + xmas, & + xdn, & + xdia, & + vx, & + alpha, & + zx, & + hasmass, & + igs,kgs, & + rho0,temcg,temg, rhovt, & + cwnc,cinc, & + fadvisc,cwdia,cipmas, & + cnina,cimas, & + cnostmp ) - RETURN END SUBROUTINE SEDIMENT1D @@ -4120,13 +4893,14 @@ subroutine calczgr1d(nx,ny,nz,nor,na,a,ixe,kze, & integer ix,jy,kz - real vr,qr,nrx,rd,xv,g1,zx,chw,xdn + real vr,qr,nrx,rd,xv,g1,zx,chw,xdn,ynu jy = jgs ix = ixcol - IF ( l .eq. lh .or. l .eq. lhl .or. ( l .eq. lr .and. imurain == 1 ) ) THEN + IF ( l .eq. lh .or. l .eq. lhl .or. ( l .eq. lr .and. imurain == 1 ) & + .or. ( l .eq. ls .and. imusnow == 1 ) ) THEN DO kz = 1,kze @@ -4176,16 +4950,19 @@ subroutine calczgr1d(nx,ny,nz,nor,na,a,ixe,kze, & ENDDO - ELSEIF ( l .eq. lr .and. imurain == 3) THEN + ELSEIF ( (l == ls .and. imusnow == 3) .or. ( l .eq. lr .and. imurain == 3 ) ) THEN - xdn = 1000. + xdn = rho_qx ! 1000. + IF ( l == ls ) ynu = snu + IF ( l == lr ) ynu = rnu DO kz = 1,kze + IF ( a(ix,jy,kz,l) .gt. qmin .and. a(ix,jy,kz,ln) .gt. 1.e-15 ) THEN vr = db(ix,kz)*a(ix,jy,kz,l)/(xdn*a(ix,jy,kz,ln)) -! z(ix,kz,l) = 3.6e18*(rnu+2.0)*a(ix,jy,kz,ln)*vr**2/(rnu+1.0) - z(ix,kz,l) = 3.6*(rnu+2.0)*a(ix,jy,kz,ln)*vr**2/(rnu+1.0) +! z(ix,kz,l) = 3.6e18*(ynu+2.0)*a(ix,jy,kz,ln)*vr**2/(ynu+1.0) + z(ix,kz,l) = 3.6*(ynu+2.0)*a(ix,jy,kz,ln)*vr**2/(ynu+1.0) ! qr = a(ix,jy,kz,lr) ! nrx = a(ix,jy,kz,lnr) @@ -4598,6 +5375,15 @@ subroutine calcnfromq(nx,ny,nz,an,na,nor,norz,dn, & ENDIF ENDIF + IF ( lzr > 1 ) THEN ! set reflectivity moment + IF ( an(ix,jy,kz,lr) > qxmin_init(lr) .and. an(ix,jy,kz,lzr) < zxmin .and. & + an(ix,jy,kz,lnr) > cxmin ) THEN + q = an(ix,jy,kz,lr) + nrx = an(ix,jy,kz,lnr) + an(ix,jy,kz,lzr) = 36.*g1r*dn(ix,kz)**2*q**2/(pi**2*xdnr**2*nrx) ! *dninv + ENDIF + ENDIF + ! snow IF ( lns > 1 ) THEN IF ( an(ix,jy,kz,lns) <= 0.1*cxmin .and. an(ix,jy,kz,ls) > qxmin_init(ls) ) THEN @@ -4660,6 +5446,15 @@ subroutine calcnfromq(nx,ny,nz,an,na,nor,norz,dn, & ENDIF ENDIF + IF ( lzh > 1 ) THEN ! set reflectivity moment + IF ( an(ix,jy,kz,lh) > qxmin_init(lh) .and. an(ix,jy,kz,lzh) < zxmin .and. & + an(ix,jy,kz,lnh) > cxmin ) THEN + q = an(ix,jy,kz,lh) + nrx = an(ix,jy,kz,lnh) + an(ix,jy,kz,lzh) = 36.*g1h*dn(ix,kz)**2*q**2/(pi**2*xdnh**2*nrx) ! *dninv + ENDIF + ENDIF + ! hail IF ( lnhl > 1 .and. lhl > 1 ) THEN @@ -4680,7 +5475,6 @@ subroutine calcnfromq(nx,ny,nz,an,na,nor,norz,dn, & an(ix,jy,kz,lnhl) = nrx ! *dninv ! convert to number mixing ratio - ELSEIF ( an(ix,jy,kz,lhl) <= qxmin(lhl) .or. & ( an(ix,jy,kz,lnhl) <= cxmin .and. an(ix,jy,kz,lhl) <= qxmin_init(lhl)) ) THEN @@ -4689,6 +5483,15 @@ subroutine calcnfromq(nx,ny,nz,an,na,nor,norz,dn, & ENDIF ENDIF + + IF ( lzhl > 1 ) THEN ! set reflectivity moment + IF ( an(ix,jy,kz,lhl) > qxmin_init(lhl) .and. an(ix,jy,kz,lzhl) < zxmin .and. & + an(ix,jy,kz,lnhl) > cxmin ) THEN + q = an(ix,jy,kz,lhl) + nrx = an(ix,jy,kz,lnhl) + an(ix,jy,kz,lzhl) = 36.*g1hl*dn(ix,kz)**2*q**2/(pi**2*xdnhl**2*nrx) ! *dninv + ENDIF + ENDIF ! ENDIF @@ -4859,6 +5662,9 @@ subroutine calcnfromcuten(nx,ny,nz,an,anold,na,nor,norz,dn) anold(ix,jy,kz,lnr) = anold(ix,jy,kz,lnr) + an(ix,jy,kz,lr)/xmass ENDIF + IF ( lzr > 1 ) THEN ! set reflectivity moment + an(ix,jy,kz,lzr) = 36.*g1r*dn(ix,kz)**2*q**2/(pi**2*xdnr**2*nrx) ! *dninv + ENDIF ENDIF ENDIF @@ -4909,6 +5715,9 @@ subroutine calcnfromcuten(nx,ny,nz,an,anold,na,nor,norz,dn) ! ! an(ix,jy,kz,lnh) = nrx ! *dninv ! convert to number mixing ratio ! +! IF ( lzh > 1 ) THEN ! set reflectivity moment +! an(ix,jy,kz,lzh) = 36.*g1h*dn(ix,kz)**2*q**2/(pi**2*xdnh**2*nrx) ! *dninv +! ENDIF ! ENDIF ! ENDIF ! @@ -4932,6 +5741,9 @@ subroutine calcnfromcuten(nx,ny,nz,an,anold,na,nor,norz,dn) ! ! an(ix,jy,kz,lnhl) = nrx ! *dninv ! convert to number mixing ratio ! +! IF ( lzhl > 1 ) THEN ! set reflectivity moment +! an(ix,jy,kz,lzhl) = 36.*g1hl*dn(ix,kz)**2*q**2/(pi**2*xdnhl**2*nrx) ! *dninv +! ENDIF ! ENDIF ! ENDIF @@ -4950,7 +5762,7 @@ END subroutine calcnfromcuten SUBROUTINE calc_eff_radius & & (nx,ny,nz,na,jyslab & & ,nor,norz & - & ,t1,t2,t3,t4 & + & ,t1,t2,t3,t4,t5,t6, f_t5,f_t6 & & ,qcw,qci,qsw,qrw & & ,ccw,cci,csw,crw & & ,an,dn ) @@ -4972,6 +5784,9 @@ SUBROUTINE calc_eff_radius & real,optional :: t2(-nor+1:nx+nor,-nor+1:ny+nor,-norz+1:nz+norz) real,optional :: t3(-nor+1:nx+nor,-nor+1:ny+nor,-norz+1:nz+norz) real,optional :: t4(-nor+1:nx+nor,-nor+1:ny+nor,-norz+1:nz+norz) + real,optional :: t5(-nor+1:nx+nor,-nor+1:ny+nor,-norz+1:nz+norz) + real,optional :: t6(-nor+1:nx+nor,-nor+1:ny+nor,-norz+1:nz+norz) + logical, optional :: f_t5, f_t6 ! flags to fill t5/t6 for graupel/hail real, optional :: an(-nor+1:nx+nor,-nor+1:ny+nor,-norz+1:nz+norz,na) real dn(-nor+1:nx+nor,-nor+1:ny+nor,-norz+1:nz+norz) @@ -6490,6 +7305,9 @@ SUBROUTINE setvtz(ngscnt,qx,qxmin,qxw,cx,rho0,rhovt,xdia,cno,cnostmp, & ELSEIF ( icdxhl .eq. 6 ) THEN ! Milbrandt and Morrison (2013) aax = axx(mgs,lhl) bbx = bxx(mgs,lhl) + ELSEIF ( icdxhl <= 0 ) THEN ! + aax = ax(lhl) + bbx = bx(lhl) ENDIF ENDIF ! } @@ -6798,7 +7616,11 @@ subroutine ziegfall1d(nx,ny,nz,nor,norz,na,dtp,jgs,ixcol, & real vtmax real xvbarmax - + + real, parameter :: c1r=19.0, c2r=0.6, c3r=1.8, c4r=17.0 ! rain + real, parameter :: c1h=5.5, c2h=0.7, c3h=4.5, c4h=8.5 ! Graupel + real, parameter :: c1hl=3.7, c2hl=0.3, c3hl=9.0, c4hl=6.5, c5hl=1.0, c6hl=6.5 ! Hail + integer l1, l2 double precision :: dpt1, dpt2 @@ -7074,68 +7896,549 @@ subroutine ziegfall1d(nx,ny,nz,nor,norz,na,dtp,jgs,ixcol, & ELSEIF ( imurain == 3 ) THEN alpha(:,lr) = xnu(lr) ENDIF - - - + IF ( ipconc == 5 .and. imydiagalpha > 0 ) THEN + DO mgs = 1,ngscnt + IF ( qx(mgs,lr) .gt. qxmin(lr) .and. cx(mgs,lr) > cxmin ) THEN + xv(mgs,lr) = rho0(mgs)*qx(mgs,lr)/(xdn(mgs,lr)*cx(mgs,lr)) ! + xdia(mgs,lr,3) = (xv(mgs,lr)*6.0*cwc1)**(1./3.) + alpha(mgs,lr) = Min(alphamax, c1r*tanh(c2r*(xdia(mgs,lr,3)*1000. - c3r)) + c4r) + ENDIF + IF ( qx(mgs,lh) .gt. qxmin(lh) .and. cx(mgs,lh) > cxmin ) THEN + xv(mgs,lh) = rho0(mgs)*qx(mgs,lh)/(xdn(mgs,lh)*cx(mgs,lh)) ! + xdia(mgs,lh,3) = (xv(mgs,lh)*6.*piinv)**(1./3.) ! mwfac*xdia(mgs,lh,1) ! (xv(mgs,lh)*cwc0*6.0)**(1./3.) + alpha(mgs,lh) = Min(alphamax, c1h*tanh(c2h*(xdia(mgs,lh,3)*1000. - c3h)) + c4h) + ENDIF +! alpha(:,lr) = 0. ! 10. +! alpha(:,lh) = 0. ! 10. + IF ( lhl > 0 ) THEN + IF ( qx(mgs,lhl) .gt. qxmin(lhl) .and. cx(mgs,lhl) > cxmin ) THEN + xv(mgs,lhl) = rho0(mgs)*qx(mgs,lhl)/(xdn(mgs,lhl)*cx(mgs,lhl)) ! + xdia(mgs,lhl,3) = (xv(mgs,lhl)*6.*piinv)**(1./3.) + IF ( xdia(mgs,lhl,3) < 0.008 ) THEN + alpha(mgs,lhl) = Min(alphamax, c1hl*tanh(c2hl*(xdia(mgs,lhl,3)*1000. - c3hl)) + c4hl) + ELSE + alpha(mgs,lhl) = Min(alphamax, c5hl*xdia(mgs,lhl,3)*1000. + c6hl) + ENDIF + ENDIF + ENDIF + ENDDO + ENDIF ! -! Set density -! - if (ndebugzf .gt. 0 ) write(0,*) 'ZIEGFALL: call setvtz' +! Set 6th moments ! + IF ( ipconc .ge. 6 .or. lzr > 1) THEN - call setvtz(ngscnt,qx,qxmin,qxw,cx,rho0,rhovt,xdia,cno,cnostmp, & - & xmas,vtxbar,xdn,xvmn,xvmx,xv,cdx,cdxgs, & - & ipconc,ndebugzf,ngs,nz,kgs,fadvisc, & - & cwmasn,cwmasx,cwradn,cnina,cimn,cimx, & - & itype1,itype2,temcg,infdo,alpha,ildo,axx,bxx) -! & itype1,itype2,temcg,infdo,alpha,ildo,axh,bxh,axhl,bxhl) + zx(:,:) = 0.0 + +! DO il = lr,lhab + DO il = l1,l2 + + IF ( lz(il) .ge. 1 ) THEN + + DO mgs = 1,ngscnt + zx(mgs,il) = Max(an(igs(mgs),jy,kgs(mgs),lz(il)), 0.0) + ENDDO + + + ENDIF + + ENDDO + + ENDIF + -! -! put fall speeds into the x-z arrays -! - DO il = l1,l2 - do mgs = 1,ngscnt - vtmax = 150.0 +! Find shape parameter rain - - IF ( vtxbar(mgs,il,2) .gt. vtxbar(mgs,il,1) .or. & - & ( vtxbar(mgs,il,1) .gt. vtxbar(mgs,il,3) .and. vtxbar(mgs,il,3) > 0.0) ) THEN - - - - vtxbar(mgs,il,1) = Max( vtxbar(mgs,il,1), vtxbar(mgs,il,2) ) - vtxbar(mgs,il,3) = Max( vtxbar(mgs,il,3), vtxbar(mgs,il,1) ) + + IF ( lz(lr) > 1 .and. (ildo == 0 .or. ildo == lr ) .and. imurain == 3 ) THEN ! { RAIN SHAPE PARAM + il = lr + DO mgs = 1,ngscnt + + IF ( iresetmoments == 1 .or. iresetmoments == il ) THEN +! IF ( .false. .and. zx(mgs,lr) <= zxmin ) THEN + IF ( zx(mgs,lr) <= zxmin ) THEN + qx(mgs,lr) = 0.0 + cx(mgs,lr) = 0.0 + an(igs(mgs),jgs,kgs(mgs),lv) = an(igs(mgs),jgs,kgs(mgs),lv) + an(igs(mgs),jgs,kgs(mgs),lr) + an(igs(mgs),jgs,kgs(mgs),lr) = qx(mgs,lr) + an(igs(mgs),jgs,kgs(mgs),ln(lr)) = cx(mgs,lr) +! ELSEIF ( zx(mgs,lr) <= 0.0 .and. cx(mgs,lr) > 0.0 .and. qx(mgs,il) .gt. qxmin(il)) THEN +! write(91,*) 'ZF: overdepletion of Zr: z,c,q = ',zx(mgs,il),cx(mgs,il),qx(mgs,il) + ELSEIF ( cx(mgs,lr) <= cxmin ) THEN + zx(mgs,lr) = 0.0 + qx(mgs,lr) = 0.0 + an(igs(mgs),jgs,kgs(mgs),lv) = an(igs(mgs),jgs,kgs(mgs),lv) + an(igs(mgs),jgs,kgs(mgs),lr) + an(igs(mgs),jgs,kgs(mgs),lr) = qx(mgs,lr) + an(igs(mgs),jgs,kgs(mgs),lz(lr)) = zx(mgs,lr) + ENDIF + ENDIF + - ENDIF + + IF ( qx(mgs,lr) .gt. qxmin(lr) ) THEN - - IF ( vtxbar(mgs,il,1) .gt. vtmax .or. vtxbar(mgs,il,2) .gt. vtmax .or. & - & vtxbar(mgs,il,3) .gt. vtmax ) THEN - - vtxbar(mgs,il,1) = Min(vtmax,vtxbar(mgs,il,1) ) - vtxbar(mgs,il,2) = Min(vtmax,vtxbar(mgs,il,2) ) - vtxbar(mgs,il,3) = Min(vtmax,vtxbar(mgs,il,3) ) - -! call commasmpi_abort() - ENDIF + xv(mgs,lr) = rho0(mgs)*qx(mgs,lr)/(xdn(mgs,lr)*Max(1.0e-11,cx(mgs,lr))) + IF ( xv(mgs,lr) .gt. xvmx(lr) ) THEN +! tmp = cx(mgs,lr) +! xv(mgs,lr) = xvmx(lr) +! cx(mgs,lr) = rho0(mgs)*qx(mgs,lr)/(xvmx(lr)*xdn(mgs,lr)) +! an(igs(mgs),jgs,kgs(mgs),ln(il)) = cx(mgs,il) +! IF ( tmp < cx(mgs,il) ) THEN ! breakup +! g1 = 36.*(alpha(mgs,lr)+2.0)/((alpha(mgs,lr)+1.0)*pi**2) +!! zx(mgs,lr) = zx(mgs,lr) + g1*(rho0(mgs)/(1000.))**2*( (qx(mgs,il)/tmp)**2 * (tmp-cx(mgs,il)) ) +!! an(igs(mgs),jgs,kgs(mgs),lz(lr)) = zx(mgs,lr) +! ENDIF + ELSEIF ( xv(mgs,lr) .lt. xvmn(lr) ) THEN + xv(mgs,lr) = xvmn(lr) + cx(mgs,lr) = rho0(mgs)*qx(mgs,lr)/(xvmn(lr)*xdn(mgs,lr)) + an(igs(mgs),jgs,kgs(mgs),ln(il)) = cx(mgs,il) + ENDIF + IF ( zx(mgs,il) > 0.0 .and. cx(mgs,il) <= 0.0 ) THEN +! have mass and reflectivity but no concentration, so set concentration, using default alpha + g1 = 36.*(alpha(mgs,lr)+2.0)/((alpha(mgs,lr)+1.0)*pi**2) + z = zx(mgs,il) + qr = qx(mgs,il) + + cx(mgs,il) = g1*dn(igs(mgs),jy,kgs(mgs))**2*(qr)*qr/(z*1000.*1000) + an(igs(mgs),jgs,kgs(mgs),ln(il)) = cx(mgs,il) + + ELSEIF ( zx(mgs,il) <= zxmin .and. cx(mgs,il) > cxmin ) THEN +! have mass and concentration but no reflectivity, so set reflectivity, using default alpha + g1 = 36.*(alpha(mgs,lr)+2.0)/((alpha(mgs,lr)+1.0)*pi**2) + chw = cx(mgs,il) + qr = qx(mgs,il) + +! xv(mgs,lr) = rho0(mgs)*qx(mgs,lr)/(1000.*Max(1.0e-9,cx(mgs,lr))) +! vr = xv(mgs,lr) + +! z = 36.*(alpha(mgs,lr)+2.0)*nrx*vr**2/((alpha(mgs,lr)+1.0)*pi**2) +! zx(mgs,il) = z +! an(igs(mgs),jy,kgs(mgs),lz(il)) = z + + zx(mgs,il) = g1*dn(igs(mgs),jy,kgs(mgs))**2*(qr)*qr/(xdn(mgs,lr)**2*chw) + an(igs(mgs),jgs,kgs(mgs),lz(il)) = zx(mgs,il) + + ELSEIF ( zx(mgs,il) <= zxmin .and. cx(mgs,il) <= 0.0 ) THEN +! How did this happen? + ! set values according to dBZ of -10, or Z = 0.1 +! write(91,*) 'alpha = ',alpha(mgs,il) + IF ( qx(mgs,il) < 1.e-8 ) THEN + qx(mgs,il) = 0.0 + an(igs(mgs),jgs,kgs(mgs),lv) = an(igs(mgs),jgs,kgs(mgs),lv) + an(igs(mgs),jgs,kgs(mgs),il) + an(igs(mgs),jgs,kgs(mgs),il) = qx(mgs,il) + ELSE +! 0.1 = 1.e18*0.224*an(ix,jy,kz,lzh)*(hwdn/rwdn)**2 + zx(mgs,il) = 1.e-19/0.224*(xdn0(lr)/xdn0(il))**2 + an(igs(mgs),jgs,kgs(mgs),lz(il)) = zx(mgs,il) + + g1 = 36.*(alpha(mgs,lr)+2.0)/((alpha(mgs,lr)+1.0)*pi**2) + z = zx(mgs,il) + qr = qx(mgs,il) + cx(mgs,il) = g1*dn(igs(mgs),jy,kgs(mgs))**2*(qr)*qr/(z*1000.*1000) + an(igs(mgs),jgs,kgs(mgs),ln(il)) = cx(mgs,il) + ENDIF + ENDIF + + IF ( zx(mgs,lr) > 0.0 ) THEN + xv(mgs,lr) = rho0(mgs)*qx(mgs,lr)/(1000.*Max(1.0e-9,cx(mgs,lr))) + vr = xv(mgs,lr) +! z = 36.*(alpha(kz)+2.0)*a(ix,jy,kz,lnr)*vr**2/((alpha(kz)+1.0)*pi**2) + qr = qx(mgs,lr) + nrx = cx(mgs,lr) + z = zx(mgs,lr) + +! xv = (db(1,kz)*a(1,1,kz,lr))**2/(a(1,1,kz,lnr)) +! rd = z*(pi/6.*1000.)**2/xv + +! determine shape parameter alpha by iteration + IF ( z .gt. 0.0 ) THEN +! alpha(mgs,lr) = 3. + alp = 36.*(alpha(mgs,lr)+2.0)*nrx*vr**2/(z*pi**2) - 1. + DO i = 1,20 +! IF ( 100.*Abs(alp - alpha(mgs,lr))/Abs(alpha(mgs,lr)) .lt. 1. ) EXIT + IF ( Abs(alp - alpha(mgs,lr)) .lt. 0.01 ) EXIT + alpha(mgs,lr) = Max( rnumin, Min( rnumax, alp ) ) + alp = 36.*(alpha(mgs,lr)+2.0)*nrx*vr**2/(z*pi**2) - 1. +! write(0,*) 'i,alp = ',i,alp + alp = Max( rnumin, Min( rnumax, alp ) ) + ENDDO +! write(0,*) 'kz, alp, alpha(kz) = ',kz,alp,alpha(mgs,lr),qr*1000,z*1.e18,vr,nrx + + +! check for artificial breakup (rain larger than allowed max size) + IF ( xv(mgs,il) .gt. xvmx(il) ) THEN + tmp = cx(mgs,il) + xv(mgs,il) = Min( xvmx(il), Max( xvmn(il),xv(mgs,il) ) ) + xmas(mgs,il) = xv(mgs,il)*xdn(mgs,il) + cx(mgs,il) = rho0(mgs)*qx(mgs,il)/(xmas(mgs,il)) + IF ( tmp < cx(mgs,il) ) THEN ! breakup + + g1 = 36.*(alpha(mgs,lr)+2.0)/((alpha(mgs,lr)+1.0)*pi**2) + zx(mgs,il) = zx(mgs,il) + g1*(rho0(mgs)/xdn(mgs,il))**2*( (qx(mgs,il)/tmp)**2 * (tmp-cx(mgs,il)) ) + an(igs(mgs),jgs,kgs(mgs),lz(il)) = zx(mgs,il) + + vr = xv(mgs,lr) + qr = qx(mgs,lr) + nrx = cx(mgs,lr) + z = zx(mgs,lr) + + +! determine shape parameter alpha by iteration + alp = 36.*(alpha(mgs,lr)+2.0)*nrx*vr**2/(z*pi**2) - 1. + DO i = 1,20 + IF ( Abs(alp - alpha(mgs,lr)) .lt. 0.01 ) EXIT + alpha(mgs,lr) = Max( rnumin, Min( rnumax, alp ) ) + alp = 36.*(alpha(mgs,lr)+2.0)*nrx*vr**2/(z*pi**2) - 1. + alp = Max( rnumin, Min( rnumax, alp ) ) + ENDDO - xvt(kgs(mgs),igs(mgs),1,il) = vtxbar(mgs,il,1) - xvt(kgs(mgs),igs(mgs),2,il) = vtxbar(mgs,il,2) - IF ( infdo .ge. 2 ) THEN - xvt(kgs(mgs),igs(mgs),3,il) = vtxbar(mgs,il,3) - ELSE - xvt(kgs(mgs),igs(mgs),3,il) = 0.0 - ENDIF + + ENDIF + ENDIF -! xvt(kgs(mgs),igs(mgs),2,il) = xvt(kgs(mgs),igs(mgs),1,il) +! +! Check whether the shape parameter is at or less than the minimum, and if it is, reset the +! concentration or reflectivity to match (prevents reflectivity from being out of balance with Q and N) +! +! IF ( alpha(mgs,il) <= rnumin .or. alp == rnumin .or. alp == rnumax ) THEN + IF ( .true. .and. (alpha(mgs,il) <= rnumin .or. alp == rnumin .or. alp == rnumax) ) THEN + + IF ( rescale_high_alpha .and. alp >= rnumax - 0.01 ) THEN ! reset c at high alpha to prevent growth in Z + g1 = 36.*(alpha(mgs,lr)+2.0)/((alpha(mgs,lr)+1.0)*pi**2) + cx(mgs,il) = g1*dn(igs(mgs),jy,kgs(mgs))**2*(qr)*qr/z*(1./(xdn(mgs,il)))**2 + an(igs(mgs),jy,kgs(mgs),ln(il)) = cx(mgs,il) + + ELSEIF ( rescale_low_alphar .and. alp <= rnumin ) THEN + + z = 36.*(alpha(mgs,lr)+2.0)*nrx*vr**2/((alpha(mgs,lr)+1.0)*pi**2) + zx(mgs,il) = z + an(igs(mgs),jy,kgs(mgs),lz(il)) = z + + ENDIF + ENDIF + + ENDIF + ENDIF + + ELSE + + zx(mgs,lr) = 0.0 + cx(mgs,lr) = 0.0 + an(igs(mgs),jgs,kgs(mgs),ln(lr)) = cx(mgs,lr) + an(igs(mgs),jgs,kgs(mgs),lz(lr)) = zx(mgs,lr) + + ENDIF + + ENDDO + ENDIF ! } + + + IF ( ipconc .ge. 6 ) THEN + +! Find shape parameters for graupel,hail + + DO il = lr,lhab + + IF ( lz(il) .gt. 1 .and. (ildo == 0 .or. ildo == il ) .and. ( .not. ( il == lr .and. imurain == 3 )) ) THEN + + DO mgs = 1,ngscnt + + IF ( iresetmoments == 1 .or. iresetmoments == il .or. iresetmoments == -1 ) THEN + IF ( zx(mgs,il) <= zxmin ) THEN ! .and. qx(mgs,il) > 0.05e-3 ) THEN + qx(mgs,il) = 0.0 + cx(mgs,il) = 0.0 + an(igs(mgs),jgs,kgs(mgs),lv) = an(igs(mgs),jgs,kgs(mgs),lv) + an(igs(mgs),jgs,kgs(mgs),il) + an(igs(mgs),jgs,kgs(mgs),il) = qx(mgs,il) + an(igs(mgs),jgs,kgs(mgs),ln(il)) = cx(mgs,il) + ELSEIF ( iresetmoments == -1 .and. qx(mgs,il) < qxmin(il) ) THEN + zx(mgs,il) = 0.0 + cx(mgs,il) = 0.0 + an(igs(mgs),jgs,kgs(mgs),lv) = an(igs(mgs),jgs,kgs(mgs),lv) + an(igs(mgs),jgs,kgs(mgs),il) + + qx(mgs,il) = 0.0 + an(igs(mgs),jgs,kgs(mgs),il) = qx(mgs,il) + an(igs(mgs),jgs,kgs(mgs),ln(il)) = cx(mgs,il) + an(igs(mgs),jgs,kgs(mgs),lz(il)) = zx(mgs,il) + + ELSEIF ( cx(mgs,il) <= cxmin .and. iresetmoments /= -1 ) THEN ! .and. qx(mgs,il) > 0.05e-3 ) THEN +!! write(91,*) 'cx=0; qx,zx = ',1000.*qx(mgs,il),1.e18*zx(mgs,il) + zx(mgs,il) = 0.0 + qx(mgs,il) = 0.0 + an(igs(mgs),jgs,kgs(mgs),lv) = an(igs(mgs),jgs,kgs(mgs),lv) + an(igs(mgs),jgs,kgs(mgs),il) + an(igs(mgs),jgs,kgs(mgs),il) = qx(mgs,il) + an(igs(mgs),jgs,kgs(mgs),lz(il)) = zx(mgs,il) + ENDIF + ENDIF + + IF ( zx(mgs,il) <= zxmin .and. cx(mgs,il) <= cxmin ) THEN + zx(mgs,il) = 0.0 + cx(mgs,il) = 0.0 + an(igs(mgs),jgs,kgs(mgs),lv) = an(igs(mgs),jgs,kgs(mgs),lv) + an(igs(mgs),jgs,kgs(mgs),il) + qx(mgs,il) = 0.0 + an(igs(mgs),jgs,kgs(mgs),il) = qx(mgs,il) + an(igs(mgs),jgs,kgs(mgs),ln(il)) = cx(mgs,il) + an(igs(mgs),jgs,kgs(mgs),lz(il)) = zx(mgs,il) + ENDIF + + IF ( qx(mgs,il) .gt. qxmin(il) ) THEN + + xv(mgs,il) = rho0(mgs)*qx(mgs,il)/(xdn(mgs,il)*Max(1.0e-9,cx(mgs,il))) + xmas(mgs,il) = xv(mgs,il)*xdn(mgs,il) + + IF ( xv(mgs,il) .lt. xvmn(il) ) THEN +! tmp = cx(mgs,il) + xv(mgs,il) = Min( xvmx(il), Max( xvmn(il),xv(mgs,il) ) ) + xmas(mgs,il) = xv(mgs,il)*xdn(mgs,il) + cx(mgs,il) = rho0(mgs)*qx(mgs,il)/(xmas(mgs,il)) +! IF ( tmp < cx(mgs,il) ) THEN ! breakup +! g1 = 36.*(6.0 + alpha(mgs,il))*(5.0 + alpha(mgs,il))*(4.0 + alpha(mgs,il))/ & +! & ((3.0 + alpha(mgs,il))*(2.0 + alpha(mgs,il))*(1.0 + alpha(mgs,il))*pi**2) +! zx(mgs,il) = zx(mgs,il) + g1*(rho0(mgs)/xdn(mgs,il))**2*( (qx(mgs,il)/tmp)**2 * (tmp-cx(mgs,il)) ) +! an(igs(mgs),jgs,kgs(mgs),lz(il)) = zx(mgs,il) +! +! ENDIF + ENDIF + + IF ( zx(mgs,il) > 0.0 .and. cx(mgs,il) <= 0.0 ) THEN +! have mass and reflectivity but no concentration, so set concentration, using default alpha + g1 = (6.0 + alpha(mgs,il))*(5.0 + alpha(mgs,il))*(4.0 + alpha(mgs,il))/ & + & ((3.0 + alpha(mgs,il))*(2.0 + alpha(mgs,il))*(1.0 + alpha(mgs,il))) + z = zx(mgs,il) + qr = qx(mgs,il) + cx(mgs,il) = g1*dn(igs(mgs),jy,kgs(mgs))**2*(6*qr)**2/(z*(pi*xdn(mgs,il))**2) + an(igs(mgs),jgs,kgs(mgs),ln(il)) = cx(mgs,il) + + ELSEIF ( zx(mgs,il) <= zxmin .and. cx(mgs,il) > cxmin ) THEN +! have mass and concentration but no reflectivity, so set reflectivity, using default alpha + g1 = (6.0 + alpha(mgs,il))*(5.0 + alpha(mgs,il))*(4.0 + alpha(mgs,il))/ & + & ((3.0 + alpha(mgs,il))*(2.0 + alpha(mgs,il))*(1.0 + alpha(mgs,il))) + chw = cx(mgs,il) + qr = qx(mgs,il) +! zx(mgs,il) = g1*dn(igs(mgs),jy,kgs(mgs))**2*(qr)*qr/chw + zx(mgs,il) = Min(zxmin*1.1, g1*dn(igs(mgs),jy,kgs(mgs))**2*(6*qr)**2/(chw*(pi*xdn(mgs,il))**2) ) + an(igs(mgs),jgs,kgs(mgs),lz(il)) = zx(mgs,il) + ELSEIF ( zx(mgs,il) <= zxmin .and. cx(mgs,il) <= 0.0 ) THEN +! How did this happen? +! write(91,*) 'ziegfall: something screwy with moments: il = ',il +! write(91,*) 'q,n,z = ', 1.e3*qx(mgs,il),cx(mgs,il),zx(mgs,il) +! write(91,*) 'alpha = ',alpha(mgs,il) + + IF ( qx(mgs,il) < 1.e-8 ) THEN + qx(mgs,il) = 0.0 + an(igs(mgs),jgs,kgs(mgs),lv) = an(igs(mgs),jgs,kgs(mgs),lv) + an(igs(mgs),jgs,kgs(mgs),il) + an(igs(mgs),jgs,kgs(mgs),il) = qx(mgs,il) + ELSE +! write(0,*) 'alpha = ',alpha(mgs,il) + ! set values according to dBZ of -10 +! 0.1 = 1.e18*0.224*an(ix,jy,kz,lzh)*(hwdn/rwdn)**2 + zx(mgs,il) = 1.e-19/0.224*(xdn0(lr)/xdn0(il))**2 + an(igs(mgs),jgs,kgs(mgs),lz(il)) = zx(mgs,il) + + g1 = (6.0 + alpha(mgs,il))*(5.0 + alpha(mgs,il))*(4.0 + alpha(mgs,il))/ & + & ((3.0 + alpha(mgs,il))*(2.0 + alpha(mgs,il))*(1.0 + alpha(mgs,il))) + z = zx(mgs,il) + qr = qx(mgs,il) + cx(mgs,il) = g1*dn(igs(mgs),jy,kgs(mgs))**2*(6*qr)**2/(z*(pi*xdn(mgs,il))**2) + an(igs(mgs),jgs,kgs(mgs),ln(il)) = cx(mgs,il) + ENDIF + ENDIF + ENDIF + + IF ( qx(mgs,il) .gt. qxmin(il) .and. cx(mgs,il) .gt. cxmin ) THEN + chw = cx(mgs,il) + qr = qx(mgs,il) + z = zx(mgs,il) + + IF ( zx(mgs,il) .gt. 0. ) THEN + +! rd = z*(pi/6.*1000.)**2*chw/(0.224*(dn(igs(mgs),jy,kgs(mgs))*qr)**2) + rd = z*(pi/6.*xdn(mgs,il))**2*chw/((dn(igs(mgs),jy,kgs(mgs))*qr)**2) + + alp = (6.+alpha(mgs,il))*(5.0+alpha(mgs,il))*(4.0+alpha(mgs,il))/ & + & ((3.0+alpha(mgs,il))*(2.0+alpha(mgs,il))*rd) - 1.0 + DO i = 1,10 + IF ( Abs(alp - alpha(mgs,il)) .lt. 0.01 ) EXIT + alpha(mgs,il) = Max( alphamin, Min( alphamax, alp ) ) + alp = (6.+alpha(mgs,il))*(5.0+alpha(mgs,il))*(4.0+alpha(mgs,il))/ & + & ((3.0+alpha(mgs,il))*(2.0+alpha(mgs,il))*rd) - 1.0 +! write(0,*) 'i,alp = ',i,alp + alp = Max( alphamin, Min( alphamax, alp ) ) + ENDDO + + + +! check for artificial breakup (graupel/hail larger than allowed max size) + + IF ( imaxdiaopt == 1 ) THEN + xvbarmax = xvmx(il) + ELSEIF ( imaxdiaopt == 2 ) THEN ! test against maximum mass diameter + xvbarmax = xvmx(il) /((3. + alpha(mgs,il))**3/((3. + alpha(mgs,il))*(2. + alpha(mgs,il))*(1. + alpha(mgs,il)))) + ELSEIF ( imaxdiaopt == 3 ) THEN ! test against mass-weighted diameter + xvbarmax = xvmx(il) /((4. + alpha(mgs,il))**3/((3. + alpha(mgs,il))*(2. + alpha(mgs,il))*(1. + alpha(mgs,il)))) + ENDIF + + IF ( xv(mgs,il) .gt. xvbarmax ) THEN + tmp = cx(mgs,il) + xv(mgs,il) = Min( xvbarmax, Max( xvmn(il),xv(mgs,il) ) ) + xmas(mgs,il) = xv(mgs,il)*xdn(mgs,il) + cx(mgs,il) = rho0(mgs)*qx(mgs,il)/(xmas(mgs,il)) + IF ( tmp < cx(mgs,il) ) THEN ! breakup + g1 = 36.*(6.0 + alpha(mgs,il))*(5.0 + alpha(mgs,il))*(4.0 + alpha(mgs,il))/ & + & ((3.0 + alpha(mgs,il))*(2.0 + alpha(mgs,il))*(1.0 + alpha(mgs,il))*pi**2) + zx(mgs,il) = zx(mgs,il) + g1*(rho0(mgs)/xdn(mgs,il))**2*( (qx(mgs,il)/tmp)**2 * (tmp-cx(mgs,il)) ) + an(igs(mgs),jgs,kgs(mgs),lz(il)) = zx(mgs,il) + + chw = cx(mgs,il) + qr = qx(mgs,il) + z = zx(mgs,il) + + rd = z*(pi/6.*xdn(mgs,il))**2*chw/((rho0(mgs)*qr)**2) + alp = (6.0+alpha(mgs,il))*(5.0+alpha(mgs,il))*(4.0+alpha(mgs,il))/ & + & ((3.0+alpha(mgs,il))*(2.0+alpha(mgs,il))*rd) - 1.0 + DO i = 1,10 + IF ( Abs(alp - alpha(mgs,il)) .lt. 0.01 ) EXIT + alpha(mgs,il) = Max( alphamin, Min( alphamax, alp ) ) + alp = (6.+alpha(mgs,il))*(5.0+alpha(mgs,il))*(4.0+alpha(mgs,il))/ & + & ((3.0+alpha(mgs,il))*(2.0+alpha(mgs,il))*rd) - 1.0 + alp = Max( alphamin, Min( alphamax, alp ) ) + ENDDO + + + ENDIF + ENDIF + +! +! Check whether the shape parameter is at or less than the minimum, and if it is, reset the +! concentration or reflectivity to match (prevents reflectivity from being out of balance with Q and N) +! + IF ( (rescale_low_alpha .or. rescale_high_alpha ) .and. & + & ( alpha(mgs,il) <= alphamin .or. alp == alphamin .or. alp == alphamax ) ) THEN + + g1 = (6.0 + alpha(mgs,il))*(5.0 + alpha(mgs,il))*(4.0 + alpha(mgs,il))/ & + & ((3.0 + alpha(mgs,il))*(2.0 + alpha(mgs,il))*(1.0 + alpha(mgs,il))) + + IF ( rescale_high_alpha .and. alp >= alphamax - 0.01 ) THEN ! reset c at high alpha to prevent growth in Z + cx(mgs,il) = g1*dn(igs(mgs),jy,kgs(mgs))**2*(qr)*qr/z*(6./(pi*xdn(mgs,il)))**2 + an(igs(mgs),jy,kgs(mgs),ln(il)) = cx(mgs,il) + + ELSEIF ( rescale_low_alpha .and. alp <= alphamin .and. .not. (il == lh .and. icvhl2h > 0 ) ) THEN + +!! z1 = g1*dn(igs(mgs),jy,kgs(mgs))**2*( 0.224*qr)*qr/chw + z1 = g1*dn(igs(mgs),jy,kgs(mgs))**2*(qr)*qr/chw + z = z1*(6./(pi*xdn(mgs,il)))**2 + zx(mgs,il) = z + an(igs(mgs),jy,kgs(mgs),lz(il)) = z + ENDIF + ENDIF + ELSE + ENDIF + ENDIF + ENDDO ! mgs + + ENDIF ! lz(il) .gt. 1 + + ENDDO ! il + +! CALL cld_cpu('Z-MOMENT-ZFAll') + + ENDIF + + IF ( lzhl > 1 ) THEN + IF ( lhl .gt. 1 ) THEN + + ENDIF + ENDIF + + + +! +! Set density +! + if (ndebugzf .gt. 0 ) write(0,*) 'ZIEGFALL: call setvtz' +! + + call setvtz(ngscnt,qx,qxmin,qxw,cx,rho0,rhovt,xdia,cno,cnostmp, & + & xmas,vtxbar,xdn,xvmn,xvmx,xv,cdx,cdxgs, & + & ipconc,ndebugzf,ngs,nz,kgs,fadvisc, & + & cwmasn,cwmasx,cwradn,cnina,cimn,cimx, & + & itype1,itype2,temcg,infdo,alpha,ildo,axx,bxx) +! & itype1,itype2,temcg,infdo,alpha,ildo,axh,bxh,axhl,bxhl) + + + +! +! put fall speeds into the x-z arrays +! + DO il = l1,l2 + do mgs = 1,ngscnt + + vtmax = 150.0 + + + IF ( vtxbar(mgs,il,2) .gt. vtxbar(mgs,il,1) .or. & + & ( vtxbar(mgs,il,1) .gt. vtxbar(mgs,il,3) .and. vtxbar(mgs,il,3) > 0.0) ) THEN + + +! IF ( qx(mgs,il) > 1.e-4 .and. & +! & .not. ( il == lr .and. 1.e3*xdia(mgs,il,3) > 5.0 ) ) THEN +! write(0,*) 'infdo,mgs = ',infdo,lzr,mgs +! write(0,*) 'Moment problem with vtxbar for il at i,j,k = ',il,igs(mgs),jy,kgs(mgs) +! write(0,*) 'nx,ny,nz,ng = ',nx,ny,nz,nor +! write(0,*) 'cwmasn,cwmasx = ',cwmasn,cwmasx +! write(0,*) 'vt1,2,3 = ',vtxbar(mgs,il,1),vtxbar(mgs,il,2),vtxbar(mgs,il,3) +! write(0,*) 'q,n,d = ', 1.e3*qx(mgs,il),cx(mgs,il),1.e3*xdia(mgs,il,3) +! IF ( il .ge. lr .and. lz(il) > 1 ) write(0,*) 'z = ', zx(mgs,il) +! IF ( il .ge. lg .or. il == lr ) THEN +! write(0,*) 'alpha = ',alpha(mgs,il) +! ENDIF +! ENDIF + + vtxbar(mgs,il,1) = Max( vtxbar(mgs,il,1), vtxbar(mgs,il,2) ) + vtxbar(mgs,il,3) = Max( vtxbar(mgs,il,3), vtxbar(mgs,il,1) ) + + ENDIF + + + IF ( vtxbar(mgs,il,1) .gt. vtmax .or. vtxbar(mgs,il,2) .gt. vtmax .or. & + & vtxbar(mgs,il,3) .gt. vtmax ) THEN + +! IF ( ndebugzf >= 0 .and. 1.e3*qx(mgs,il) > 0.1 ) THEN +! write(0,*) 'infdo = ',infdo +! write(0,*) 'Problem with vtxbar for il at i,j,k = ',il,igs(mgs),jy,kgs(mgs) +! write(0,*) 'nx,ny,nz,ng = ',nx,ny,nz,nor +! write(0,*) 'cwmasn,cwmasx = ',cwmasn,cwmasx +! write(0,*) 'vt1,2,3 = ',vtxbar(mgs,il,1),vtxbar(mgs,il,2),vtxbar(mgs,il,3) +! write(0,*) 'q,n,d = ', 1.e3*qx(mgs,il),cx(mgs,il),1.e3*xdia(mgs,il,3) +! IF ( il .ge. lr .and. lz(il) > 1 ) write(0,*) 'z = ', zx(mgs,il) +! IF ( il .ge. lg ) THEN +! write(0,*) 'alpha = ',alpha(mgs,il) +! ENDIF +! ENDIF + vtxbar(mgs,il,1) = Min(vtmax,vtxbar(mgs,il,1) ) + vtxbar(mgs,il,2) = Min(vtmax,vtxbar(mgs,il,2) ) + vtxbar(mgs,il,3) = Min(vtmax,vtxbar(mgs,il,3) ) + +! call commasmpi_abort() + ENDIF + + + xvt(kgs(mgs),igs(mgs),1,il) = vtxbar(mgs,il,1) + xvt(kgs(mgs),igs(mgs),2,il) = vtxbar(mgs,il,2) + IF ( infdo .ge. 2 ) THEN + xvt(kgs(mgs),igs(mgs),3,il) = vtxbar(mgs,il,3) + ELSE + xvt(kgs(mgs),igs(mgs),3,il) = 0.0 + ENDIF + +! xvt(kgs(mgs),igs(mgs),2,il) = xvt(kgs(mgs),igs(mgs),1,il) enddo ENDDO @@ -7630,6 +8933,8 @@ subroutine radardd02(nx,ny,nz,nor,na,an,temk, & IF ( ipconc .le. 2 ) THEN gtmp(ix,kz) = dadr*an(ix,jy,kz,lr)**(0.25) dtmp(ix,kz) = zrc*gtmp(ix,kz)**7 + ELSEIF ( lzr .gt. 1 ) THEN + dtmp(ix,kz) = 1e18*an(ix,jy,kz,lzr) ELSEIF ( an(ix,jy,kz,lnr) .gt. 1.e-3 ) THEN IF ( imurain == 3 ) THEN vr = db(ix,jy,kz)*an(ix,jy,kz,lr)/(1000.*an(ix,jy,kz,lnr)) @@ -7822,7 +9127,7 @@ subroutine radardd02(nx,ny,nz,nor,na,an,temk, & ELSE ! new form using a mass relationship m = p d^2 (instead of d^3 -- Cox 1988 QJRMS) so that density depends on size ! p = 0.106214 for m = p v^(2/3) - dnsnow = 0.346159*sqrt(an(ix,jy,kz,lns)/(an(ix,jy,kz,ls)*db(ix,jy,kz)) ) + dnsnow = 0.0346159*sqrt(an(ix,jy,kz,lns)/(an(ix,jy,kz,ls)*db(ix,jy,kz)) ) IF ( .true. .or. dnsnow < 900. ) THEN gtmp(ix,kz) = 1.e18*323.3226* 0.106214**2*(ksq*an(ix,jy,kz,ls) + & & (1.-ksq)*qxw)*an(ix,jy,kz,ls)*db(ix,jy,kz)**2*gsnow73/ & @@ -7898,6 +9203,10 @@ subroutine radardd02(nx,ny,nz,nor,na,an,temk, & IF ( izieg .ge. 1 .and. ipconc .ge. 5 ) THEN ltest = .false. + IF ( lzh > 1 ) THEN + IF ( an(ix,jy,kz,lzh) > 0.0 .and. an(ix,jy,kz,lh) > qhmin .and. & + an(ix,jy,kz,lnh) >= cxmin ) ltest = .true. + ENDIF IF ( ltest .or. (an(ix,jy,kz,lh) .ge. qhmin .and. an(ix,jy,kz,lnh) .ge. cxmin )) THEN @@ -7943,6 +9252,9 @@ subroutine radardd02(nx,ny,nz,nor,na,an,temk, & ENDIF IF ( lzh .gt. 1 ) THEN + x = (0.224*qh + 0.776*qxw)/an(ix,jy,kz,lh) ! weighted average of dielectric const + dtmph = 1.e18*x*an(ix,jy,kz,lzh)*(hwdn/rwdn)**2 + dtmp(ix,kz) = dtmp(ix,kz) + dtmph ELSE g1 = (6.0 + alphah)*(5.0 + alphah)*(4.0 + alphah)/((3.0 + alphah)*(2.0 + alphah)*(1.0 + alphah)) ! zx = g1*(db(ix,jy,kz)*an(ix,jy,kz,lh))**2/chw @@ -8015,6 +9327,10 @@ subroutine radardd02(nx,ny,nz,nor,na,an,temk, & IF ( ipconc .ge. 5 ) THEN ltest = .false. + IF ( lzhl > 1 ) THEN + IF ( an(ix,jy,kz,lzhl) > 0.0 .and. an(ix,jy,kz,lhl) > qhlmin .and. & + an(ix,jy,kz,lnhl) > 0.0 ) ltest = .true. + ENDIF IF ( ltest .or. ( an(ix,jy,kz,lhl) .ge. qhlmin .and. an(ix,jy,kz,lnhl) .gt. 0.) ) THEN !{ chl = an(ix,jy,kz,lnhl) @@ -8038,6 +9354,9 @@ subroutine radardd02(nx,ny,nz,nor,na,an,temk, & ENDIF IF ( lzhl .gt. 1 ) THEN !{ + x = (0.224*an(ix,jy,kz,lhl) + 0.776*qxw)/an(ix,jy,kz,lhl) ! weighted average of dielectric const + dtmphl = 1.e18*x*an(ix,jy,kz,lzhl)*(hldn/rwdn)**2 + dtmp(ix,kz) = dtmp(ix,kz) + dtmphl ELSE !} g1 = (6.0 + alphahl)*(5.0 + alphahl)*(4.0 + alphahl)/((3.0 + alphahl)*(2.0 + alphahl)*(1.0 + alphahl)) @@ -8118,8 +9437,7 @@ subroutine radardd02(nx,ny,nz,nor,na,an,temk, & ! write(0,*) 'Hail,snow c: ',an(ix,jy,kz,lnh),an(ix,jy,kz,lns) ! write(0,*) 'dtmps,dtmph = ',dtmps,dtmph ! ENDIF - - IF ( ndebug>1 .and. .not. dtmp(ix,kz) .lt. 1.e30 .or. dbz(ix,jy,kz) > 190.0 ) THEN + IF ( .not. dtmp(ix,kz) .lt. 1.e30 .or. dbz(ix,jy,kz) > 190.0 ) THEN ! IF ( ix == 31 .and. kz == 20 .and. jy == 23 ) THEN ! write(0,*) 'my_rank = ',my_rank write(0,*) 'ix,jy,kz = ',ix,jy,kz @@ -8190,6 +9508,8 @@ END subroutine radardd02 ! ##################################################################### ! ! Subroutine for explicit cloud condensation and droplet nucleation +! +! 11/30/2022: Fixed droplet evaporation heating term for CM1 eqtset=2 (was only doing eqtset=1) ! SUBROUTINE NUCOND & & (nx,ny,nz,na,jyslab & @@ -8198,6 +9518,7 @@ SUBROUTINE NUCOND & & ,t0,t9 & & ,an,dn,p2 & & ,pn,w & + & ,ngs & & ,axtra,io_flag & & ,ssfilt,t00,t77,flag_qndrop & & ) @@ -8256,6 +9577,7 @@ SUBROUTINE NUCOND & logical :: io_flag real :: dv + real :: ccnefactwo, sstmp, cn1, cnuctmp ! ! declarations microphysics and for gather/scatter @@ -8264,7 +9586,6 @@ SUBROUTINE NUCOND & real, parameter :: cwmas20 = 1000.*0.523599*(2.*20.e-6)**3 ! mass of 20-micron radius droplet, for sat. adj. integer nxmpb,nzmpb,nxz integer mgs,ngs,numgs,inumgs - parameter (ngs=500) integer ngscnt,igs(ngs),kgs(ngs) integer kgsp(ngs),kgsm(ngs) integer nsvcnt @@ -8283,6 +9604,7 @@ SUBROUTINE NUCOND & real ccnc(ngs), ccna(ngs), cnuc(ngs), cwnccn(ngs) + real :: ccnc_nu(ngs), ccnc_ac(ngs), ccnc_co(ngs) real ccncuf(ngs) real sscb ! 'cloud base' SS threshold parameter ( sscb = 2.0 ) @@ -8295,7 +9617,7 @@ SUBROUTINE NUCOND & integer ifilt ! =1 to filter ssat, =0 to set ssfilt=ssat parameter ( ifilt = 0 ) real temp1,temp2 ! ,ssold - real :: ssmax(ngs) = 0.0 ! maximum SS experienced by a parcel + real :: ssmax(ngs) ! maximum SS experienced by a parcel real ssmx real dnnet,dqnet ! real cnu,rnu,snu,cinu @@ -8419,7 +9741,6 @@ SUBROUTINE NUCOND & integer :: count - ! ------------------------------------------------------------------------------- itile = nxi jtile = ny @@ -8433,6 +9754,7 @@ SUBROUTINE NUCOND & kzbeg = 1 nzbeg = 1 + IF ( ac_opt > 0 ) ccnefactwo = (1.63e-3/(cck * beta(3./2., cck/2.)))**(1.0/(cck + 2.0)) f5 = 237.3 * 17.27 * 2.5e6 / cp ! combined constants for rain condensation (Soong and Ogura 73) jy = 1 @@ -8543,6 +9865,7 @@ SUBROUTINE NUCOND & qx(:,:) = 0.0 cx(:,:) = 0.0 + zx(:,:) = 0.0 xv(:,:) = 0.0 xmas(:,:) = 0.0 @@ -8602,6 +9925,7 @@ SUBROUTINE NUCOND & ELSE ! equation set 2 in cm1 tmp = qx(mgs,li)+qx(mgs,ls)+qx(mgs,lh) IF ( lhl > 1 ) tmp = tmp + qx(mgs,lhl) + IF ( lf > 1 ) tmp = tmp + qx(mgs,lf) cvm = cv+cvv*qx(mgs,lv)+cpl*(qx(mgs,lc)+qx(mgs,lr)) & +cpigb*(tmp) cpm = cp+cpv*qx(mgs,lv)+cpl*(qx(mgs,lc)+qx(mgs,lr)) & @@ -8656,12 +9980,16 @@ SUBROUTINE NUCOND & ELSE ssmax(mgs) = 0.0 ENDIF - IF ( lccn .gt. 1 ) THEN - ccnc(mgs) = an(igs(mgs),jy,kgs(mgs),lccn) + IF ( lccn .gt. 1 .and. ac_opt == 0 ) THEN + IF ( lccnuf .gt. 1 .and. i_uf_or_ccn > 0 ) THEN + ccnc(mgs) = an(igs(mgs),jy,kgs(mgs),lccn) + an(igs(mgs),jy,kgs(mgs),lccnuf) + ELSE + ccnc(mgs) = an(igs(mgs),jy,kgs(mgs),lccn) + ENDIF ELSE ccnc(mgs) = cwnccn(mgs) ENDIF - IF ( lccnuf .gt. 1 ) THEN + IF ( lccnuf .gt. 1 .and. i_uf_or_ccn == 0 ) THEN ccncuf(mgs) = an(igs(mgs),jy,kgs(mgs),lccnuf) ELSE ccncuf(mgs) = 0.0 @@ -8716,6 +10044,237 @@ SUBROUTINE NUCOND & ventrxn(:) = ventrn +! Find shape parameter rain + + IF ( lzr > 1 .and. rcond == 2 ) THEN ! { RAIN SHAPE PARAM + DO mgs = 1,ngscnt + zx(mgs,lr) = Max(an(igs(mgs),jy,kgs(mgs),lzr), 0.0) + ENDDO + +! CALL cld_cpu('Z-MOMENT-1r2') + il = lr + DO mgs = 1,ngscnt + + IF ( zx(mgs,il) <= zxmin ) THEN + qx(mgs,lv) = qx(mgs,lv) + qx(mgs,il) + qx(mgs,il) = 0.0 + cx(mgs,il) = 0.0 + an(igs(mgs),jgs,kgs(mgs),lv) = an(igs(mgs),jgs,kgs(mgs),lv) + an(igs(mgs),jgs,kgs(mgs),il) + an(igs(mgs),jgs,kgs(mgs),il) = qx(mgs,il) + an(igs(mgs),jgs,kgs(mgs),ln(il)) = cx(mgs,il) + ELSEIF ( cx(mgs,il) <= 0.0 ) THEN + qx(mgs,lv) = qx(mgs,lv) + qx(mgs,il) + zx(mgs,il) = 0.0 + qx(mgs,il) = 0.0 + an(igs(mgs),jgs,kgs(mgs),lv) = an(igs(mgs),jgs,kgs(mgs),lv) + an(igs(mgs),jgs,kgs(mgs),il) + an(igs(mgs),jgs,kgs(mgs),il) = qx(mgs,il) + an(igs(mgs),jgs,kgs(mgs),lz(il)) = zx(mgs,il) + ENDIF + + IF ( qx(mgs,lr) .gt. qxmin(lr) ) THEN + + xv(mgs,lr) = rho0(mgs)*qx(mgs,lr)/(xdn(mgs,lr)*Max(1.0e-11,cx(mgs,lr))) + IF ( xv(mgs,lr) .gt. xvmx(lr) ) THEN + xv(mgs,lr) = xvmx(lr) + cx(mgs,lr) = rho0(mgs)*qx(mgs,lr)/(xvmx(lr)*xdn(mgs,lr)) + ELSEIF ( xv(mgs,lr) .lt. xvmn(lr) ) THEN + xv(mgs,lr) = xvmn(lr) + cx(mgs,lr) = rho0(mgs)*qx(mgs,lr)/(xvmn(lr)*xdn(mgs,lr)) + ENDIF + + IF ( zx(mgs,il) > 0.0 .and. cx(mgs,il) <= 0.0 ) THEN +! have mass and reflectivity but no concentration, so set concentration, using default alpha + IF ( imurain == 3 ) THEN + g1 = 36.*(alpha(mgs,lr)+2.0)/((alpha(mgs,lr)+1.0)*pi**2) + z1 = zx(mgs,il) + qr = qx(mgs,il) + cx(mgs,il) = g1*dn(igs(mgs),jy,kgs(mgs))**2*(qr)*qr/(z1*1000.*1000) + ELSE + g1 = 36.*(6.0 + alpha(mgs,il))*(5.0 + alpha(mgs,il))*(4.0 + alpha(mgs,il))/ & + & ((3.0 + alpha(mgs,il))*(2.0 + alpha(mgs,il))*(1.0 + alpha(mgs,il))*pi**2) + z1 = zx(mgs,il) + qr = qx(mgs,il) + cx(mgs,il) = g1*dn(igs(mgs),jy,kgs(mgs))**2*(qr)*qr/(z1*1000.*1000) + + ENDIF +! an(igs(mgs),jgs,kgs(mgs),ln(il)) = zx(mgs,il) + ELSEIF ( zx(mgs,il) <= zxmin .and. cx(mgs,il) > 0.0 ) THEN +! have mass and concentration but no reflectivity, so set reflectivity, using default alpha + IF ( imurain == 3 ) THEN + g1 = 36.*(alpha(mgs,lr)+2.0)/((alpha(mgs,lr)+1.0)*pi**2) + chw = cx(mgs,il) + qr = qx(mgs,il) + zx(mgs,il) = g1*dn(igs(mgs),jy,kgs(mgs))**2*(qr)*qr/(chw*1000.*1000) + ELSE + g1 = 36.*(6.0 + alpha(mgs,il))*(5.0 + alpha(mgs,il))*(4.0 + alpha(mgs,il))/ & + & ((3.0 + alpha(mgs,il))*(2.0 + alpha(mgs,il))*(1.0 + alpha(mgs,il))*pi**2) + chw = cx(mgs,il) + qr = qx(mgs,il) + zx(mgs,il) = g1*dn(igs(mgs),jy,kgs(mgs))**2*(qr)*qr/(chw*1000.*1000) + + ENDIF + + ELSEIF ( zx(mgs,il) <= zxmin .and. cx(mgs,il) <= 0.0 ) THEN +! How did this happen? + ! set values according to dBZ of -10, or Z = 0.1 +! 0.1 = 1.e18*0.224*an(ix,jy,kz,lzh)*(hwdn/rwdn)**2 + zx(mgs,il) = 1.e-19/0.224*(xdn0(lr)/xdn0(il))**2 + an(igs(mgs),jgs,kgs(mgs),lz(il)) = zx(mgs,il) + + IF ( imurain == 3 ) THEN + g1 = 36.*(alpha(mgs,lr)+2.0)/((alpha(mgs,lr)+1.0)*pi**2) + z1 = zx(mgs,il) + qr = qx(mgs,il) + cx(mgs,il) = g1*dn(igs(mgs),jy,kgs(mgs))**2*(qr)*qr/(z1*1000.*1000) + an(igs(mgs),jgs,kgs(mgs),ln(il)) = cx(mgs,il) + ELSEIF ( imurain == 1 ) THEN + g1 = (6.0 + alpha(mgs,il))*(5.0 + alpha(mgs,il))*(4.0 + alpha(mgs,il))/ & + & ((3.0 + alpha(mgs,il))*(2.0 + alpha(mgs,il))*(1.0 + alpha(mgs,il))) + z1 = zx(mgs,il) + qr = qx(mgs,il) + cx(mgs,il) = g1*dn(igs(mgs),jy,kgs(mgs))**2*(6*qr)**2/(z1*(pi*xdn(mgs,il))**2) + an(igs(mgs),jgs,kgs(mgs),ln(il)) = cx(mgs,il) + + ENDIF + ENDIF + + IF ( zx(mgs,lr) > 0.0 ) THEN + vr = rho0(mgs)*qx(mgs,lr)/(1000.*cx(mgs,lr)) +! z1 = 36.*(alpha(kz)+2.0)*a(ix,jy,kz,lnr)*vr**2/((alpha(kz)+1.0)*pi**2) + qr = qx(mgs,lr) + nrx = cx(mgs,lr) + z1 = zx(mgs,lr) + +! xv = (db(1,kz)*a(1,1,kz,lr))**2/(a(1,1,kz,lnr)) +! rd = z1*(pi/6.*1000.)**2/xv + + +! determine shape parameter alpha by iteration + IF ( z1 .gt. 0.0 ) THEN + + IF ( imurain == 3 ) THEN + alp = 36.*(alpha(mgs,lr)+2.0)*nrx*vr**2/(z1*pi**2) - 1. +! write(0,*) 'kz, alp, alpha(kz) = ',kz,alp,alpha(kz),rd,z1,xv + DO i = 1,20 + IF ( Abs(alp - alpha(mgs,lr)) .lt. 0.01 ) EXIT + alpha(mgs,lr) = Max( rnumin, Min( rnumax, alp ) ) + alp = 36.*(alpha(mgs,lr)+2.0)*nrx*vr**2/(z1*pi**2) - 1. +! write(0,*) 'i,alp = ',i,alp + alp = Max( rnumin, Min( rnumax, alp ) ) + ENDDO + + ELSE ! imurain == 1 + g1 = 36.*(6.0 + alpha(mgs,il))*(5.0 + alpha(mgs,il))*(4.0 + alpha(mgs,il))/ & + & ((3.0 + alpha(mgs,il))*(2.0 + alpha(mgs,il))*(1.0 + alpha(mgs,il))*pi**2) + + rd1 = z1*(pi/6.*xdn(mgs,il))**2*nrx/(rho0(mgs)*qr)**2 + + alp = (6.+alpha(mgs,il))*(5.0+alpha(mgs,il))*(4.0+alpha(mgs,il))/ & + & ((3.0+alpha(mgs,il))*(2.0+alpha(mgs,il))*rd1) - 1.0 + + DO i = 1,10 + IF ( Abs(alp - alpha(mgs,il)) .lt. 0.01 ) EXIT + alpha(mgs,il) = Max( alphamin, Min( alphamax, alp ) ) + + alp = (6.+alpha(mgs,il))*(5.0+alpha(mgs,il))*(4.0+alpha(mgs,il))/ & + & ((3.0+alpha(mgs,il))*(2.0+alpha(mgs,il))*rd1) - 1.0 + + alp = Max( alphamin, Min( alphamax, alp ) ) + ENDDO + + + ENDIF +! ENDIF + +! +! Check whether the shape parameter is at or less than the minimum, and if it is, reset the +! concentration or reflectivity to match (prevents reflectivity from being out of balance with Q and N) +! + IF ( imurain == 3 ) THEN + IF ( .true. .and. (alpha(mgs,il) <= rnumin .or. alp == rnumin .or. alp == rnumax) ) THEN + + IF ( rescale_high_alpha .and. alp >= rnumax - 0.01 ) THEN ! reset c at high alpha to prevent growth in Z + g1 = 36.*(alpha(mgs,lr)+2.0)/((alpha(mgs,lr)+1.0)*pi**2) + cx(mgs,il) = g1*dn(igs(mgs),jy,kgs(mgs))**2*(qr)*qr/z1*(1./(xdn(mgs,il)))**2 + an(igs(mgs),jy,kgs(mgs),ln(il)) = cx(mgs,il) + + ELSEIF ( rescale_low_alphar .and. alp <= rnumin ) THEN + + z1 = 36.*(alpha(mgs,lr)+2.0)*nrx*vr**2/((alpha(mgs,lr)+1.0)*pi**2) + zx(mgs,il) = z1 + ENDIF + ENDIF + + ELSEIF ( imurain == 1 ) THEN + + g1 = (6.0 + alpha(mgs,il))*(5.0 + alpha(mgs,il))*(4.0 + alpha(mgs,il))/ & + & ((3.0 + alpha(mgs,il))*(2.0 + alpha(mgs,il))*(1.0 + alpha(mgs,il))) + + IF ( (rescale_low_alpha .or. rescale_high_alpha ) .and. & + & ( alpha(mgs,il) <= alphamin .or. alp == alphamin .or. alp == alphamax ) ) THEN + + + + IF ( rescale_high_alpha .and. alp >= alphamax - 0.01 ) THEN ! reset c at high alpha to prevent growth in Z + cx(mgs,il) = g1*rho0(mgs)**2*(qr)*qr/zx(mgs,lr)*(6./(pi*xdn(mgs,il)))**2 + an(igs(mgs),jy,kgs(mgs),ln(il)) = cx(mgs,il) + + ELSEIF ( rescale_low_alpha .and. alp <= alphamin ) THEN ! alpha = alphamin, so reset Z to prevent growth in C + z1 = g1*rho0(mgs)**2*(qr)*qr/nrx + z2 = z1*(6./(pi*xdn(mgs,il)))**2 + zx(mgs,il) = z2 + an(igs(mgs),jy,kgs(mgs),lz(il)) = z2 + ENDIF + ENDIF ! imurain + + ENDIF ! z > 0 + + tmp = alpha(mgs,lr) + 4./3. + i = Int(dgami*(tmp)) + del = tmp - dgam*i + x = gmoi(i) + (gmoi(i+1) - gmoi(i))*del*dgami + + tmp = alpha(mgs,lr) + 1. + i = Int(dgami*(tmp)) + del = tmp - dgam*i + y = gmoi(i) + (gmoi(i+1) - gmoi(i))*del*dgami + +! ventrx(mgs) = Gamma(alpha(mgs,lr) + 4./3.)/(alpha(mgs,lr) + 1.)**(1./3.)/Gamma(alpha(mgs,lr) + 1.) + ventrx(mgs) = x/(y*(alpha(mgs,lr) + 1.)**(1./3.)) + + IF ( imurain == 3 .and. izwisventr == 2 ) THEN + + tmp = alpha(mgs,lr) + 1.5 + br/6. + i = Int(dgami*(tmp)) + del = tmp - dgam*i + x = gmoi(i) + (gmoi(i+1) - gmoi(i))*del*dgami + +! ventrx(mgs) = Gamma(alpha(mgs,lr) + 1.5 + br/6.)/Gamma(alpha(mgs,lr) + 1.) + ventrxn(mgs) = x/(y*(alpha(mgs,lr) + 1.)**((1.+br)/6. + 1./3.)) + + ELSEIF ( imurain == 1 .and. iferwisventr == 2 ) THEN + + tmp = alpha(mgs,lr) + 2.5 + br/2. + i = Int(dgami*(tmp)) + del = tmp - dgam*i + x = gmoi(i) + (gmoi(i+1) - gmoi(i))*del*dgami + +! ventrx(mgs) = Gamma(alpha(mgs,lr) + 1.5 + br/6.)/Gamma(alpha(mgs,lr) + 1.) + ventrxn(mgs) = x/y + + + ENDIF + + + ENDIF + ENDIF + + ENDIF + + ENDDO +! CALL cld_cpu('Z-MOMENT-1r2') + ENDIF ! } + ! write(0,*) 'NUCOND: Set ssf variables, ssmxinit =',ssmxinit ssmx = 0.0 @@ -8735,6 +10294,8 @@ SUBROUTINE NUCOND & ssfkp1(mgs) = ssfilt(igs(mgs),jgs,Min(nz-1,kgs(mgs)+1)) ssfkm1(mgs) = ssfilt(igs(mgs),jgs,Max(1,kgs(mgs)-1)) +! IF ( wvel(mgs) /= 0.0 ) write(0,*) 'mgs,wvel1,ssf = ',mgs,wvel(mgs),ssf(mgs) + ENDDO @@ -8744,7 +10305,7 @@ SUBROUTINE NUCOND & ! cloud water variables ! - if ( ndebug .gt. 0 )write(0,*) 'ICEZVD_DR: Set cloud water variables' + if ( ndebug .gt. 0 ) write(0,*) 'ICEZVD_DR: Set cloud water variables' do mgs = 1,ngscnt xv(mgs,lc) = 0.0 @@ -8868,23 +10429,22 @@ SUBROUTINE NUCOND & QEVAP= Min( qx(mgs,lc), R1*(qss(mgs)-qvap(mgs)) ) - IF ( qx(mgs,lc) .LT. QEVAP ) THEN ! GO TO 63 + IF ( qx(mgs,lc) <= QEVAP ) THEN ! GO TO 63 qwvp(mgs) = qwvp(mgs) + qx(mgs,lc) - thetap(mgs) = thetap(mgs) - felv(mgs)*qx(mgs,lc)/(cp*pi0(mgs)) + thetap(mgs) = thetap(mgs) - felvcp(mgs)*qx(mgs,lc)/(pi0(mgs)) IF ( io_flag .and. nxtra > 1 ) THEN axtra(igs(mgs),jy,kgs(mgs),1) = -qx(mgs,lc)/dtp ENDIF qx(mgs,lc) = 0. IF ( restoreccn ) THEN - IF ( irenuc <= 2 ) THEN - IF ( .not. invertccn ) THEN - ccnc(mgs) = Max( ccnc(mgs), Min( qccn*rho0(mgs), ccnc(mgs) + cx(mgs,lc) ) ) - ELSE - ccnc(mgs) = ccnc(mgs) + cx(mgs,lc) - ENDIF - ENDIF - IF ( lccna > 1 ) THEN - ccna(mgs) = ccna(mgs) - cx(mgs,lc) + IF ( lccna > 1 ) THEN + ccna(mgs) = ccna(mgs) - restoreccnfrac*cx(mgs,lc) + ELSEIF ( irenuc <= 2 ) THEN + IF ( .not. invertccn ) THEN + ccnc(mgs) = Max( ccnc(mgs), Min( qccn*rho0(mgs), ccnc(mgs) + restoreccnfrac*cx(mgs,lc) ) ) + ELSE + ccnc(mgs) = ccnc(mgs) + restoreccnfrac*cx(mgs,lc) + ENDIF ENDIF ENDIF cx(mgs,lc) = 0. @@ -8894,39 +10454,37 @@ SUBROUTINE NUCOND & qx(mgs,lc) = qx(mgs,lc) - QEVAP IF ( qx(mgs,lc) .le. 0. ) THEN IF ( restoreccn ) THEN - IF ( irenuc <= 2 ) THEN + IF ( lccna > 1 ) THEN + ccna(mgs) = ccna(mgs) - restoreccnfrac*cx(mgs,lc) + ELSEIF ( irenuc <= 2 ) THEN ! ccnc(mgs) = Max( ccnc(mgs), Min( qccn*rho0(mgs), ccnc(mgs) + cx(mgs,lc) ) ) ! ccnc(mgs) = ccnc(mgs) + cx(mgs,lc) IF ( .not. invertccn ) THEN - ccnc(mgs) = Max( ccnc(mgs), Min( qccn*rho0(mgs), ccnc(mgs) + cx(mgs,lc) ) ) + ccnc(mgs) = Max( ccnc(mgs), Min( qccn*rho0(mgs), ccnc(mgs) + restoreccnfrac*cx(mgs,lc) ) ) ELSE - ccnc(mgs) = ccnc(mgs) + cx(mgs,lc) + ccnc(mgs) = ccnc(mgs) + restoreccnfrac*cx(mgs,lc) ENDIF ENDIF - IF ( lccna > 1 ) THEN - ccna(mgs) = ccna(mgs) - cx(mgs,lc) - ENDIF ENDIF cx(mgs,lc) = 0. ELSE tmp = 0.9*QEVAP*cx(mgs,lc)/qctmp ! let droplets get smaller but also remove some. A factor of 1.0 would maintain same size IF ( restoreccn ) THEN - IF ( irenuc <= 2 ) THEN + IF ( lccna > 1 ) THEN + ccna(mgs) = ccna(mgs) - restoreccnfrac*tmp + ELSEIF ( irenuc <= 2 ) THEN ! ccnc(mgs) = Max( ccnc(mgs), Min( qccn*rho0(mgs), ccnc(mgs) + tmp ) ) ! ccnc(mgs) = ccnc(mgs) + tmp IF ( .not. invertccn ) THEN - ccnc(mgs) = Max( ccnc(mgs), Min( qccn*rho0(mgs), ccnc(mgs) + tmp ) ) + ccnc(mgs) = Max( ccnc(mgs), Min( qccn*rho0(mgs), ccnc(mgs) + restoreccnfrac*tmp ) ) ELSE - ccnc(mgs) = ccnc(mgs) + tmp + ccnc(mgs) = ccnc(mgs) + restoreccnfrac*tmp ENDIF ENDIF - IF ( lccna > 1 ) THEN - ccna(mgs) = ccna(mgs) - tmp - ENDIF ENDIF cx(mgs,lc) = cx(mgs,lc) - tmp ENDIF - thetap(mgs) = thetap(mgs) - felv(mgs)*QEVAP/(CP*pi0(mgs)) + thetap(mgs) = thetap(mgs) - felvcp(mgs)*QEVAP/(pi0(mgs)) IF ( io_flag .and. nxtra > 1 ) THEN axtra(igs(mgs),jy,kgs(mgs),1) = -QEVAP/dtp ENDIF @@ -9208,11 +10766,24 @@ SUBROUTINE NUCOND & !! & dx*dy*dz3d(igs(mgs),jy,kgs(mgs)) - theta(mgs) = thetap(mgs) + theta0(mgs) - temg(mgs) = theta(mgs)*f1 - ltemq = (temg(mgs)-163.15)/fqsat+1.5 - ltemq = Min( nqsat, Max(1,ltemq) ) - qvs(mgs) = pqs(mgs)*tabqvs(ltemq) + IF ( lzr > 1 .and. rcond == 2 .and. qx(mgs,lr) .gt. qxmin(lr) & + & .and. cx(mgs,lr) .gt. 1.e-9 ) THEN + tmp = qx(mgs,lr)/cx(mgs,lr) + IF ( imurain == 3 ) THEN + g1 = 36.*(alpha(mgs,lr)+2.0)/((alpha(mgs,lr)+1.0)*pi**2) + ELSE + g1 = 36.*(6.0 + alpha(mgs,il))*(5.0 + alpha(mgs,il))*(4.0 + alpha(mgs,il))/ & + & ((3.0 + alpha(mgs,il))*(2.0 + alpha(mgs,il))*(1.0 + alpha(mgs,il))*pi**2) + + ENDIF + zx(mgs,lr) = zx(mgs,lr) + g1*(rho0(mgs)/(xdn(mgs,lr)))**2*( 2.*( tmp ) * dqr ) + ENDIF + + theta(mgs) = thetap(mgs) + theta0(mgs) + temg(mgs) = theta(mgs)*f1 + ltemq = (temg(mgs)-163.15)/fqsat+1.5 + ltemq = Min( nqsat, Max(1,ltemq) ) + qvs(mgs) = pqs(mgs)*tabqvs(ltemq) ! es(mgs) = 6.1078e2*tabqvs(ltemq) ! @@ -9249,7 +10820,8 @@ SUBROUTINE NUCOND & ! IF ( ssf(mgs) > ssmx .and. ssf(mgs) < 5.0 .and. ccnc(mgs) > 0.1*cwnccn(mgs) ) THEN ! this one works ! IF ( ssf(mgs) > ssmx .and. ssf(mgs) < 20.0 ) THEN ! test -- fails ! IF ( ssf(mgs) > ssmx .and. ssf(mgs) < 20.0 .and. ccnc(mgs) > 0.1*cwnccn(mgs)) THEN ! test -- is OK - IF ( ssf(mgs) > ssmx .and. ssf(mgs) < 20.0 .and. ccnc(mgs) > 0.05*cwnccn(mgs)) THEN ! test + IF ( ssf(mgs) > ssmx .and. ssf(mgs) < 20.0 .and. & + ( ccnc(mgs) > 0.05*cwnccn(mgs) .or. ( ac_opt > 0 .and. ccnc_ac(mgs) - cx(mgs,lc) > 0.0 ) ) ) THEN ! test ! IF ( ssf(mgs) > ssmx ) THEN ! original condition CALL QVEXCESS(ngs,mgs,qwvp,qv0,qx(1,lc),pres,thetap,theta0,dcloud, & & pi0,tabqvs,nqsat,fqsat,cbw,fcqv1,felvcp,ssmx,pk,ngscnt) @@ -9260,7 +10832,7 @@ SUBROUTINE NUCOND & ELSE dcloud = 0.0 ENDIF - + thetap(mgs) = thetap(mgs) + felvcp(mgs)*DCLOUD/(pi0(mgs)) qwvp(mgs) = qwvp(mgs) - DCLOUD qx(mgs,lc) = qx(mgs,lc) + DCLOUD @@ -9285,11 +10857,16 @@ SUBROUTINE NUCOND & IF ( .not. flag_qndrop ) THEN ! { do not calculate number of droplets if using wrf-chem + IF ( ac_opt == 0 ) THEN + cnuctmp = cnuc(mgs) + ELSE + cnuctmp = ccnc_ac(mgs) + ENDIF ! IF ( ssmax(mgs) .lt. sscb .and. qx(mgs,lc) .gt. qxmin(lc)) THEN IF ( dcloud .gt. qxmin(lc) .and. wvel(mgs) > 0.0) THEN ! CN(mgs) = CCNE*wvel(mgs)**cnexp ! *Min(1.0,1./dtp) ! 0.3465 - CN(mgs) = CCNE0*cnuc(mgs)**(2./(2.+cck))*wvel(mgs)**cnexp ! *Min(1.0,1./dtp) ! 0.3465 + CN(mgs) = CCNE0*cnuctmp**(2./(2.+cck))*wvel(mgs)**cnexp ! *Min(1.0,1./dtp) ! 0.3465 IF ( ny .le. 2 .and. cn(mgs) .gt. 0.0 & & .and. ncdebug .ge. 1 ) THEN write(iunit,*) 'CN: ',cn(mgs)*1.e-6, cx(mgs,lc)*1.e-6, qx(mgs,lc)*1.e3, & @@ -9311,12 +10888,16 @@ SUBROUTINE NUCOND & ENDIF IF ( cn(mgs) .gt. 0.0 ) THEN - IF ( cn(mgs) .gt. ccnc(mgs) ) THEN - cn(mgs) = ccnc(mgs) -! ccnc(mgs) = 0.0 + IF ( ac_opt == 0 ) THEN + IF ( cn(mgs) .gt. ccnc(mgs) ) THEN + cn(mgs) = ccnc(mgs) +! ccnc(mgs) = 0.0 + ENDIF + ELSE + cn(mgs) = Min( cn(mgs), ccnc_ac(mgs) ) ENDIF ! cx(mgs,lc) = cx(mgs,lc) + cn(mgs) - IF ( irenuc <= 2 ) ccnc(mgs) = Max(0.0, ccnc(mgs) - cn(mgs)) + IF ( irenuc <= 2 .and. lccna < 1 ) ccnc(mgs) = Max(0.0, ccnc(mgs) - cn(mgs)) ccna(mgs) = ccna(mgs) + cn(mgs) ENDIF @@ -9362,7 +10943,8 @@ SUBROUTINE NUCOND & DSSDZ=0. r2dzm=0.50/dz3d(igs(mgs),jy,kgs(mgs)) - IF ( irenuc >= 0 .and. .not. flag_qndrop) THEN ! turn off nucleation when flag_qndrop (using WRF-CHEM for activation) + + IF ( irenuc >= 0 .and. ac_opt == 0 .and. .not. flag_qndrop ) THEN ! turn off nucleation when flag_qndrop (using WRF-CHEM for activation) IF ( irenuc < 2 ) THEN !{ @@ -9439,6 +11021,7 @@ SUBROUTINE NUCOND & ! nucleation CN(mgs) = Min(cn(mgs), ccnc(mgs)) cn(mgs) = Min(cn(mgs), 0.5*dqc/cwmasn) ! limit the nucleation mass to half of the condensation mass + CN(mgs) = Min( CN(mgs), Max(0.0, (cnuc(mgs) - ccna(mgs) )) ) IF ( .false. .and. ny <= 2 ) THEN write(0,*) 'i,k, cwmasn = ',igs(mgs),kgs(mgs),cwmasn @@ -9466,8 +11049,136 @@ SUBROUTINE NUCOND & cx(mgs,lc) = cx(mgs,lc) + cn(mgs) - ccnc(mgs) = Max(0.0, ccnc(mgs) - cn(mgs)) + IF ( lccna < 1 ) ccnc(mgs) = Max(0.0, ccnc(mgs) - cn(mgs)) + + ELSEIF ( irenuc == 3 ) THEN !} { + ! Phillips Donner Garner 2007 +! if (ndebug .gt. 0) write(0,*) 'ICEZVD_DR: Cloud reNucleation, wvel = ',wvel(mgs) +! CN(mgs) = cwccn*Min(ssf(mgs),ssfcut)**cck + +! Need to calculate new ssf since condensation has happened: + temp1 = (theta0(mgs)+thetap(mgs))*pk(mgs) ! t77(ix,jy,kz) + ltemq = Int( (temp1-163.15)/fqsat+1.5 ) + ltemq = Min( nqsat, Max(1,ltemq) ) + + c1= pqs(mgs)*tabqvs(ltemq) + + ssf(mgs) = 0.0 + IF ( c1 > 0. ) THEN + ssf(mgs) = 100.*(qx(mgs,lv)/c1 - 1.0) ! from "new" values + ENDIF + CN(mgs) = cnuc(mgs)*Min(1.0, (ssf(mgs))**cck ) ! + + CN(mgs) = Max( 0.0, CN(mgs) - ccna(mgs) ) ! this was from + ! Philips, Donner et al. 2007, but results in too much limitation of + ! nucleation + CN(mgs) = Min(cn(mgs), ccnc(mgs)) + cn(mgs) = Min(cn(mgs), 0.5*dqc/cwmasn) ! limit the nucleation mass to half of the condensation mass + + cx(mgs,lc) = cx(mgs,lc) + cn(mgs) + + ! 6/13/2016: Phillips et al. appears not to decrement CCN, but only increments CCNa. + ! This would allow an initially non-homogeneous (vertically, e.g.) initial value of CCN/rho_air + ccnc(mgs) = Max(0.0, ccnc(mgs) - cn(mgs)) + + ELSEIF ( irenuc == 4 ) THEN !} { + ! modification of Phillips Donner Garner 2007 +! if (ndebug .gt. 0) write(0,*) 'ICEZVD_DR: Cloud reNucleation, wvel = ',wvel(mgs) +! CN(mgs) = CCNE0*cnuc(mgs)**(2./(2.+cck))*Max(0.0,wvel(mgs))**cnexp +! cn(mgs) = Min( cn(mgs), cnuc(mgs) ) +! Need to calculate new ssf since condensation has happened: + temp1 = (theta0(mgs)+thetap(mgs))*pk(mgs) ! t77(ix,jy,kz) + ltemq = Int( (temp1-163.15)/fqsat+1.5 ) + ltemq = Min( nqsat, Max(1,ltemq) ) + + c1= pqs(mgs)*tabqvs(ltemq) + IF ( c1 > 0. ) THEN + ssf(mgs) = Max(0.0, 100.*((qv0(mgs) + qwvp(mgs))/c1 - 1.0) ) ! from "new" values + ELSE + ssf(mgs) = 0.0 + ENDIF + CN(mgs) = cnuc(mgs)*Min(ssf2kmax, ssf(mgs)**cck) ! this allows cn(mgs) > cnuc(mgs) + + CN(mgs) = Max( 0.0, CN(mgs) - ccna(mgs) ) ! this was from + ! Philips, Donner et al. 2007, but results in too much limitation of + ! nucleation +! CN(mgs) = Min(cn(mgs), ccnc(mgs)) + cn(mgs) = Min(cn(mgs), 0.5*dqc/cwmasn) ! limit the nucleation mass to half of the condensation mass + + IF ( cn(mgs) > 0.0 ) THEN + cx(mgs,lc) = cx(mgs,lc) + cn(mgs) + ! ccnc(mgs) = Max(0.0, ccnc(mgs) - cn(mgs)) + + dcrit = 2.0*2.5e-7 + + dcloud = 1000.*dcrit**3*Pi/6.*cn(mgs) + qx(mgs,lc) = qx(mgs,lc) + DCLOUD + thetap(mgs) = thetap(mgs) + felvcp(mgs)*DCLOUD/(pi0(mgs)) + qwvp(mgs) = qwvp(mgs) - DCLOUD + ENDIF + ! 6/13/2016: Phillips et al. appears not to decrement CCN, but only increments CCNa. + ! This would allow an initially non-homogeneous (vertically, e.g.) initial value of CCN/rho_air +! ccnc(mgs) = Max(0.0, ccnc(mgs) - cn(mgs)) + + + + ELSEIF ( irenuc == 6 ) THEN !} { + + ! simple Twomey scheme but limit activation to try to do most activation near cloud base, but keep some CCN available for renuclation +! if (ndebug .gt. 0) write(0,*) 'ICEZVD_DR: Cloud reNucleation, wvel = ',wvel(mgs) + cn(mgs) = 0.0 +! IF ( ccna(mgs) < 0.7*cnuc(mgs) .and. ccnc(mgs) > 0.69*cnuc(mgs) - ccna(mgs)) THEN ! here, assume we are near cloud base and use Twomey formulation + IF ( ccna(mgs) < 0.7*cnuc(mgs) ) THEN ! here, assume we are near cloud base and use Twomey formulation + CN(mgs) = Min( 0.9*cnuc(mgs), CCNE0*cnuc(mgs)**(2./(2.+cck))*Max(0.0,wvel(mgs))**cnexp )! *Min(1.0,1./dtp) ! 0.3465 +! IF ( cn(mgs) + ccna(mgs) > 0.71*cnuc ) THEN + ! prevent this branch from activating more than 70% of CCN + CN(mgs) = Min( CN(mgs), Max(0.0, (0.7*cnuc(mgs) - ccna(mgs) )) ) +! CN(mgs) = Min( CN(mgs), Max(0.0, 0.71*ccnc(mgs) - ccna(mgs) ) ) + + ELSE + ! if a large fraction of CCN have been activated, then assume we are in the cloud interior and use local SSw as in Phillips et al. 2007. + + temp1 = (theta0(mgs)+thetap(mgs))*pk(mgs) ! t77(ix,jy,kz) +! t0(ix,jy,kz) = temp1 + ltemq = Int( (temp1-163.15)/fqsat+1.5 ) + ltemq = Min( nqsat, Max(1,ltemq) ) + +! c1 = t00(igs(mgs),jy,kgs(mgs))*tabqvs(ltemq) + c1= pqs(mgs)*tabqvs(ltemq) + IF ( c1 > 0. ) THEN + ssf(mgs) = Max(0.0, 100.*((qv0(mgs) + qwvp(mgs))/c1 - 1.0) ) ! from "new" values + ELSE + ssf(mgs) = 0.0 + ENDIF +! CN(mgs) = cnuc(mgs)*Min(0.99, Min(ssf(mgs),ssfcut)**cck ) ! + CN(mgs) = cnuc(mgs)*Min(2.0, Max(0.0,ssf(mgs))**cck ) ! +! CN(mgs) = cnuc(mgs)*Min(ssf(mgs),ssfcut)**cck ! + + + CN(mgs) = Min(0.01*cnuc(mgs), Max( 0.0, CN(mgs) - ccna(mgs) ) ) ! this was from +! cn(mgs) = 0.0 + ENDIF +! ccne = ccnefac*1.e6*(1.e-6*Abs(cwccn))**(2./(2.+cck)) +!!! CN(mgs) = Max( 0.0, CN(mgs) - ccna(mgs) ) ! this was from + ! Philips, Donner et al. 2007, but results in too much limitation of + ! nucleation +! CN(mgs) = Min(cn(mgs), ccnc(mgs)) +! cn(mgs) = Min(cn(mgs), 0.5*dqc/cwmasn) ! limit the nucleation mass to half of the condensation mass + + IF ( cn(mgs) > 0.0 ) THEN + cx(mgs,lc) = cx(mgs,lc) + cn(mgs) + + ! create some small droplets at minimum size (CP 2000), although it adds very little liquid + + dcrit = 2.0*2.5e-7 + + dcloud = 1000.*dcrit**3*Pi/6.*cn(mgs) + qx(mgs,lc) = qx(mgs,lc) + DCLOUD + thetap(mgs) = thetap(mgs) + felvcp(mgs)*DCLOUD/(pi0(mgs)) + qwvp(mgs) = qwvp(mgs) - DCLOUD + ! ccnc(mgs) = Max(0.0, ccnc(mgs) - cn(mgs)) + ENDIF ELSEIF ( irenuc == 5 ) THEN !} { ! modification of Phillips Donner Garner 2007 @@ -9525,17 +11236,22 @@ SUBROUTINE NUCOND & ! 6/13/2016: Phillips et al. appears not to decrement CCN, but only increments CCNa. ! This would allow an initially non-homogeneous (vertically, e.g.) initial value of CCN/rho_air ! ccnc(mgs) = Max(0.0, ccnc(mgs) - cn(mgs)) - ELSEIF ( irenuc == 7 ) THEN !} { + ELSEIF ( irenuc == 7 .or. irenuc == 17 ) THEN !} { ! simple Twomey scheme but limit activation to try to do most activation near cloud base, but keep some CCN available for renuclation ! if (ndebug .gt. 0) write(0,*) 'ICEZVD_DR: Cloud reNucleation, wvel = ',wvel(mgs) cn(mgs) = 0.0 + IF ( irenuc == 7 ) THEN + frac = 0.9 + ELSE + frac = 0.98 + ENDIF ! IF ( ccna(mgs) < 0.7*cnuc(mgs) .and. ccnc(mgs) > 0.69*cnuc(mgs) - ccna(mgs)) THEN ! here, assume we are near cloud base and use Twomey formulation - IF ( ccna(mgs) < 0.9*cnuc(mgs) ) THEN ! { here, assume we are near cloud base and use Twomey formulation - CN(mgs) = Min( 0.91*cnuc(mgs), CCNE0*cnuc(mgs)**(2./(2.+cck))*Max(0.0,wvel(mgs))**cnexp )! *Min(1.0,1./dtp) ! 0.3465 + IF ( ccna(mgs) < frac*cnuc(mgs) ) THEN ! { here, assume we are near cloud base and use Twomey formulation + CN(mgs) = Min( (frac+0.01)*cnuc(mgs), CCNE0*cnuc(mgs)**(2./(2.+cck))*Max(0.0,wvel(mgs))**cnexp )! *Min(1.0,1./dtp) ! 0.3465 ! IF ( cn(mgs) + ccna(mgs) > 0.71*cnuc ) THEN ! prevent this branch from activating more than 70% of CCN - CN(mgs) = Min( CN(mgs), Max(0.0, (0.9*cnuc(mgs) - ccna(mgs) )) ) + CN(mgs) = Min( CN(mgs), Max(0.0, (frac*cnuc(mgs) - ccna(mgs) )) ) ! CN(mgs) = Min( CN(mgs), Max(0.0, 0.71*ccnc(mgs) - ccna(mgs) ) ) ! write(0,*) '1: k,cn = ',kgs(mgs),cn(mgs),ssf(mgs) !! IF ( ccncuf(mgs) > 0.0 .and. cn(mgs) < 1.e-3 .and. ssmax(mgs) > 1.0 ) THEN @@ -9573,7 +11289,7 @@ SUBROUTINE NUCOND & ! write(0,*) 'k,cn = ',kgs(mgs),cn(mgs),ssf(mgs) ! write(0,*) 'ccn-ccna = ',cnuc(mgs) - ccna(mgs),ccnc(mgs) - ccna(mgs) ! IF ( ccncuf(mgs) > 0.0 .and. cn(mgs) < 1.e-3 .and. ssmax(mgs) > 1.0 ) THEN - IF ( ccncuf(mgs) > 0.0 .and. ssf(mgs) > ssmxuf .and. ssmax(mgs) > ssmxuf ) THEN + IF ( ccncuf(mgs) > 0.0 .and. ssf(mgs) > ssmxuf .and. ( ssmax(mgs) > ssmxuf .or. lss < 1 ) ) THEN CNuf(mgs) = Min( ccncuf(mgs), CCNE0*ccncuf(mgs)**(2./(2.+cck))*Max(0.0,wvel(mgs))**cnexp )! *Min(1.0,1./dtp) ! 0.3465 ! IF ( cnuf(mgs) >= 0.0 ) write(0,*) 'cnuf, k = ',cnuf(mgs),ccncuf(mgs),kgs(mgs) ENDIF @@ -9675,7 +11391,7 @@ SUBROUTINE NUCOND & IF ( cn(mgs) > 0.0 ) THEN cx(mgs,lc) = cx(mgs,lc) + cn(mgs) - ccnc(mgs) = Max(0.0, ccnc(mgs) - cn(mgs)) + ! ccnc(mgs) = Max(0.0, ccnc(mgs) - cn(mgs)) ! create some small droplets at minimum size (CP 2000), although it adds very little liquid @@ -9694,8 +11410,6 @@ SUBROUTINE NUCOND & ccna(mgs) = ccna(mgs) + cn(mgs) - - ENDIF ! irenuc >= 0 .and. .not. flag_qndrop IF( cx(mgs,lc) .GT. 0. .AND. qx(mgs,lc) .LE. qxmin(lc)) cx(mgs,lc)=0. @@ -9748,7 +11462,11 @@ SUBROUTINE NUCOND & ELSEIF ( imaxsupopt == 4 ) THEN cn(mgs) = Min( Max(ccnc(mgs),cwnccn(mgs)), rho0(mgs)*qvex/Max( cwmasn5, Max(cwmas20,xmas(mgs,lc)) ) ) ENDIF - ccnc(mgs) = Max( 0.0, ccnc(mgs) - cn(mgs) ) + IF ( lccna > 1 ) THEN + ccna(mgs) = ccna(mgs) + cn(mgs) + ELSE + ccnc(mgs) = Max( 0.0, ccnc(mgs) - cn(mgs) ) + ENDIF cx(mgs,lc) = cx(mgs,lc) + cn(mgs) ENDIF @@ -9853,15 +11571,21 @@ SUBROUTINE NUCOND & ! qx(mgs,lr) = an(igs(mgs),jy,kgs(mgs),lr) end if + IF ( lzr > 1 .and. rcond == 2 ) THEN + an(igs(mgs),jy,kgs(mgs),lzr) = zx(mgs,lr) + & + & min( an(igs(mgs),jy,kgs(mgs),lzr), 0.0 ) + ENDIF IF ( ipconc .ge. 2 ) THEN an(igs(mgs),jy,kgs(mgs),lnc) = Max(cx(mgs,lc) , 0.0) IF ( lss > 1 ) an(igs(mgs),jy,kgs(mgs),lss) = Max( 0.0, ssmax(mgs) ) - IF ( lccn .gt. 1 ) THEN - an(igs(mgs),jy,kgs(mgs),lccn) = Max(0.0, ccnc(mgs) ) + IF ( ac_opt == 0 ) THEN + IF ( lccn .gt. 1 .and. lccna .lt. 1 ) THEN + an(igs(mgs),jy,kgs(mgs),lccn) = Max(0.0, ccnc(mgs) ) + ENDIF ENDIF - IF ( lccnuf .gt. 1 ) THEN + IF ( lccnuf .gt. 1 .and. .not. ( lccna .gt. 1 .and. i_uf_or_ccn > 0 ) ) THEN an(igs(mgs),jy,kgs(mgs),lccnuf) = Max(0.0, ccncuf(mgs) ) ENDIF IF ( lccna .gt. 1 ) THEN @@ -9938,6 +11662,42 @@ SUBROUTINE NUCOND & IF ( lhl .gt. 1 ) THEN + IF ( lzhl .gt. 1 ) THEN + + an(ix,jy,kz,lzhl) = Max(0.0, an(ix,jy,kz,lzhl) ) + + IF ( an(ix,jy,kz,lhl) .ge. frac*qxmin(lhl) .and. rescale_low_alpha ) THEN ! check 6th moment + + IF ( an(ix,jy,kz,lnhl) .gt. 0.0 ) THEN + + IF ( lvhl .gt. 1 ) THEN + IF ( an(ix,jy,kz,lvhl) .gt. 0.0 ) THEN + hwdn = dn(ix,jy,kz)*an(ix,jy,kz,lhl)/an(ix,jy,kz,lvhl) + ELSE + hwdn = xdn0(lhl) + ENDIF + hwdn = Max( xdnmn(lhl), hwdn ) + ELSE + hwdn = xdn0(lhl) + ENDIF + + chw = an(ix,jy,kz,lnhl) + g1 = (6.0+alphamin)*(5.0+alphamin)*(4.0+alphamin)/ & + & ((3.0+alphamin)*(2.0+alphamin)*(1.0+alphamin)) + z1 = g1*dn(ix,jy,kz)**2*( an(ix,jy,kz,lhl) )*an(ix,jy,kz,lhl)/chw + z1 = z1*(6./(pi*hwdn))**2 + ELSE + z1 = 0.0 + ENDIF + + an(ix,jy,kz,lzhl) = Min( z1, an(ix,jy,kz,lzhl) ) + + IF ( an(ix,jy,kz,lnhl) .lt. 1.e-5 ) THEN +! an(ix,jy,kz,lzhl) = 0.9*an(ix,jy,kz,lzhl) + ENDIF + ENDIF + + ENDIF !lzhl if ( an(ix,jy,kz,lhl) .lt. frac*qxmin(lhl) .or. zerocx(lhl) ) then @@ -10038,6 +11798,42 @@ SUBROUTINE NUCOND & + IF ( lzh .gt. 1 ) THEN + + an(ix,jy,kz,lzh) = Max(0.0, an(ix,jy,kz,lzh) ) + + IF ( .false. .and. an(ix,jy,kz,lh) .ge. frac*qxmin(lh) .and. rescale_low_alpha ) THEN + + IF ( an(ix,jy,kz,lnh) .gt. 0.0 ) THEN + + IF ( lvh .gt. 1 ) THEN + IF ( an(ix,jy,kz,lvh) .gt. 0.0 ) THEN + hwdn = dn(ix,jy,kz)*an(ix,jy,kz,lh)/an(ix,jy,kz,lvh) + ELSE + hwdn = xdn0(lh) + ENDIF + hwdn = Max( xdnmn(lh), hwdn ) + ELSE + hwdn = xdn0(lh) + ENDIF + + chw = an(ix,jy,kz,lnh) + g1 = (6.0+alphamin)*(5.0+alphamin)*(4.0+alphamin)/ & + & ((3.0+alphamin)*(2.0+alphamin)*(1.0+alphamin)) + z1 = g1*dn(ix,jy,kz)**2*( an(ix,jy,kz,lh) )*an(ix,jy,kz,lh)/chw + z1 = z1*(6./(pi*hwdn))**2 + ELSE + z1 = 0.0 + ENDIF + + an(ix,jy,kz,lzh) = Min( z1, an(ix,jy,kz,lzh) ) + + IF ( an(ix,jy,kz,lnh) .lt. 1.e-5 ) THEN +! an(ix,jy,kz,lzh) = 0.9*an(ix,jy,kz,lzh) + ENDIF + ENDIF + + ENDIF if ( an(ix,jy,kz,lh) .lt. frac*qxmin(lh) .or. zerocx(lh) ) then @@ -10198,6 +11994,9 @@ SUBROUTINE NUCOND & end if + IF ( lzr > 1 ) THEN + an(ix,jy,kz,lzr) = Max(0.0, an(ix,jy,kz,lzr) ) + ENDIF if ( an(ix,jy,kz,lr) .lt. frac*qxmin(lr) .or. zerocx(lr) & & ) then @@ -10208,6 +12007,10 @@ SUBROUTINE NUCOND & an(ix,jy,kz,lnr) = 0.0 ENDIF + IF ( lzr > 1 ) THEN + an(ix,jy,kz,lzr) = 0.0 + ENDIF + end if ! @@ -10260,18 +12063,25 @@ SUBROUTINE NUCOND & an(ix,jy,kz,lv) = an(ix,jy,kz,lv) + an(ix,jy,kz,lc) an(ix,jy,kz,lc)= 0.0 IF ( ipconc .ge. 2 ) THEN - IF ( lccn .gt. 1 ) THEN - an(ix,jy,kz,lccn) = & - & an(ix,jy,kz,lccn) + Max(0.0,an(ix,jy,kz,lnc)) + IF ( lccn .gt. 1 .or. ac_opt == 1 ) THEN + IF ( irenuc < 5 .and. lccna <= 1 ) THEN + IF ( ac_opt == 0 ) THEN + an(ix,jy,kz,lccn) = an(ix,jy,kz,lccn) + Max(0.0,an(ix,jy,kz,lnc)) + ENDIF + ELSEIF ( lccna > 1 ) THEN + an(ix,jy,kz,lccna) = Max( 0.0, an(ix,jy,kz,lccna) - Max(0.0,an(ix,jy,kz,lnc)) ) + ENDIF ENDIF an(ix,jy,kz,lnc) = 0.0 + IF ( lccn > 1 ) an(ix,jy,kz,lccn) = Max( 0.0, an(ix,jy,kz,lccn) ) - IF ( lccna > 0 ) THEN ! apply exponential decay to activated CCN to restore to environmental value + IF ( lccna > 0 .and. ac_opt == 0 ) THEN ! apply exponential decay to activated CCN to restore to environmental value + IF ( restoreccn ) THEN tmp = an(ix,jy,kz,li) + an(ix,jy,kz,ls) IF ( an(ix,jy,kz,lccna) > 1. .and. tmp < qxmin(li) ) an(ix,jy,kz,lccna) = an(ix,jy,kz,lccna)*Exp(-dtp/ccntimeconst) - - ELSEIF ( lccn > 1 .and. restoreccn ) THEN + ENDIF + ELSEIF ( lccn > 1 .and. restoreccn .and. ac_opt == 0 ) THEN ! in this case, we are treating the ccn field as ccna tmp = an(ix,jy,kz,li) + an(ix,jy,kz,ls) ! IF ( ny == 2 .and. ix == nx/2 ) THEN @@ -10335,9 +12145,9 @@ subroutine nssl_2mom_gs & ! & ln,ipc,lvol,lz,lliq, & & cdx, & & xdn0,tmp3d,tkediss & - & ,thproc,numproc,dx1,dy1 & + & ,thproc,numproc,dx1,dy1,ngs & & ,timevtcalc,axtra,io_flag & - & , has_wetscav,rainprod2d, evapprod2d & + & , has_wetscav,rainprod2d, evapprod2d, alpha2d & & ,errmsg,errflg & & ,elec,its,ids,ide,jds,jde & & ) @@ -10425,6 +12235,12 @@ subroutine nssl_2mom_gs & real rainprod2d(-nor+1:nx+nor,-norz+ng1:nz+norz) real evapprod2d(-nor+1:nx+nor,-norz+ng1:nz+norz) + + real :: alpha2d(-nor+1:nx+nor,-norz+ng1:nz+norz,3) + + real, parameter :: tfrdry = 243.15 + + logical lrescalelow(lc:lhab) real tkediss(-nor+1:nx+nor,-norz+ng1:nz+norz) real axtra(-nor+ng1:nx+nor,-nor+ng1:ny+nor,-norz+ng1:nz+norz,nxtra) @@ -10570,7 +12386,6 @@ subroutine nssl_2mom_gs & ! integer nxmpb,nzmpb,nxz integer jgs,mgs,ngs,numgs - parameter (ngs=500) !500) integer, parameter :: ngsz = 500 integer ntt parameter (ntt=300) @@ -10633,7 +12448,8 @@ subroutine nssl_2mom_gs & real ex1, ft, rhoinv(ngs) double precision ec0(ngs) - real ac1,bc, taus, c1,d1,e1,f1,p380,tmp,tmp1,tmp2,tmp3,tmp4,tmp5,temp3 ! , sstdy, super + real ac1,bc, taus, c1,d1,e1,f1,p380,tmp,tmp1,tmp2,tmp3,tmp4,tmp5,tmp6,temp3 ! , sstdy, super + real :: flim real dw,dwr double precision :: tmpz, tmpzmlt real ratio, delx, dely @@ -10714,7 +12530,7 @@ subroutine nssl_2mom_gs & real temgx(ngs),temcgx(ngs) real qvs(ngs),qis(ngs),qss(ngs),pqs(ngs) real elv(ngs),elf(ngs),els(ngs) - real tsqr(ngs),ssi(ngs),ssw(ngs) + real tsqr(ngs),ssi(ngs),ssw(ngs),ssi0(ngs) real qcwtmp(ngs),qtmp,qtot(ngs) real qcond(ngs) real ctmp, sctmp @@ -10729,6 +12545,7 @@ subroutine nssl_2mom_gs & parameter ( rwradmn = 50.e-6 ) real dh0 real dg0(ngs),df0(ngs) + real dhwet(ngs),dhlwet(ngs),dfwet(ngs) real clionpmx,clionnmx parameter (clionpmx=1.e9,clionnmx=1.e9) ! Takahashi 84 @@ -10736,7 +12553,7 @@ subroutine nssl_2mom_gs & ! other arrays real fwet1(ngs),fwet2(ngs) - real fmlt1(ngs),fmlt2(ngs) + real fmlt1(ngs),fmlt2(ngs),fmlt1e(ngs) real fvds(ngs),fvce(ngs),fiinit(ngs) real fvent(ngs),fraci(ngs),fracl(ngs) ! @@ -10760,6 +12577,7 @@ subroutine nssl_2mom_gs & ! real :: sfm1(ngs),sfm2(ngs) real :: gfm1(ngs),gfm2(ngs) + real :: ffm1(ngs),ffm2(ngs) real :: hfm1(ngs),hfm2(ngs) logical :: wetsfc(ngs),wetsfchl(ngs),wetsfcf(ngs) @@ -10800,6 +12618,10 @@ subroutine nssl_2mom_gs & real :: alpha(ngs,lc:lhab) real :: dab0lh(ngs,lc:lhab,lc:lhab) real :: dab1lh(ngs,lc:lhab,lc:lhab) + real :: zx(ngs,lr:lhab) + real :: zxmxd(ngs,lr:lhab) + real :: g1x(ngs,lr:lhab) + real :: qsimxdep(ngs) ! max sublimation of qi+qs+qis real :: qsimxsub(ngs) ! max depositionof qi+qs+qis @@ -10815,6 +12637,7 @@ subroutine nssl_2mom_gs & real ventrxn(ngs) real g1shr, alphashr real g1mlr, alphamlr + real g1smlr, alphasmlr real massfacshr, massfacmlr real :: qhgt8mm ! ice mass greater than 8mm @@ -10827,6 +12650,8 @@ subroutine nssl_2mom_gs & real, parameter :: srasheym = 0.1389 ! slope fraction from Rasmussen and Heymsfield ! real swvent(ngs),hwvent(ngs),rwvent(ngs),hlvent(ngs),hwventy(ngs),hlventy(ngs),rwventz(ngs) + real hxventtmp + real hlventinc(ngs),hwventinc(ngs) integer, parameter :: ndiam = 10 integer :: numdiam real hwvent0(ndiam+4),hlvent0 ! 0 to d1 @@ -10940,15 +12765,15 @@ subroutine nssl_2mom_gs & real qrcnw(ngs), qwcnr(ngs) real zrcnw(ngs),zracr(ngs),zracw(ngs),zrcev(ngs) - real qracw(ngs) ! qwacr(ngs), real qiacw(ngs) !, qwaci(ngs) real qsacw(ngs) ! ,qwacs(ngs), real qhacw(ngs) ! qwach(ngs), - real :: qhlacw(ngs) ! + real :: qhlacw(ngs), qxacwtmp, qxacrtmp, qxacitmp, qxacstmp ! real vhacw(ngs), vsacw(ngs), vhlacw(ngs), vhlacr(ngs) + real qfcev(ngs) real qfmul1(ngs),cfmul1(ngs) ! real qsacws(ngs) @@ -10957,7 +12782,7 @@ subroutine nssl_2mom_gs & ! arrays for x-ac-r and r-ac-x; ! real qsacr(ngs),qracs(ngs) - real qhacr(ngs),qhacrmlr(ngs) ! ,qrach(ngs) + real qhacr(ngs),qhacrmlr(ngs),qhacwmlr(ngs) ! ,qrach(ngs) real vhacr(ngs), zhacr(ngs), zhacrf(ngs), zrach(ngs), zrachl(ngs) real qiacr(ngs),qraci(ngs) @@ -10965,7 +12790,7 @@ subroutine nssl_2mom_gs & real qracif(ngs),qiacrf(ngs),qiacrs(ngs),ciacrs(ngs) - real :: qhlacr(ngs),qhlacrmlr(ngs) + real :: qhlacr(ngs),qhlacrmlr(ngs), qhlacwmlr(ngs) real qsacrs(ngs) !,qracss(ngs) ! ! ice - ice interactions @@ -11011,7 +12836,8 @@ subroutine nssl_2mom_gs & real zfmlr(ngs), zfdsv(ngs), zfsbv(ngs), zhlcnf(ngs), zfshr(ngs), zfshrr(ngs) real zhmlrtmp,zhmlr0inf,zhlmlr0inf real zhmlrr(ngs),zhlmlrr(ngs),zhshrr(ngs),zhlshrr(ngs),zfmlrr(ngs) - real zsmlr(ngs), zsmlrr(ngs), zsshr(ngs) +! real zsmlr(ngs) + real zsmlrr(ngs), zsshr(ngs), zsshrr(ngs) real zhcns(ngs), zhcni(ngs) real zhwdn(ngs), zfwdn(ngs) ! change in Z due to density changes real zhldn(ngs) ! change in Z due to density changes @@ -11052,9 +12878,10 @@ subroutine nssl_2mom_gs & ! real :: qhldpv(ngs), qhlsbv(ngs) ! qhlcnv(ngs),qhlevv(ngs), real :: qhlmlr(ngs), qhldsv(ngs), qhlmlrsave(ngs) - real :: qhlwet(ngs), qhldry(ngs), qhlshr(ngs) + real :: qhlwet(ngs), qhldry(ngs), qhlshr(ngs), qxwettmp ! real :: qrfz(ngs),qsfz(ngs),qhfz(ngs),qhlfz(ngs) + real :: qffz(ngs) ! real qhdpv(ngs),qhsbv(ngs) ! qhcnv(ngs),qhevv(ngs), real qhmlr(ngs),qhdsv(ngs),qhcev(ngs),qhcndv(ngs),qhevv(ngs) @@ -11064,6 +12891,7 @@ subroutine nssl_2mom_gs & real qhshh(ngs) !accreted water that remains on graupel real qhmlh(ngs) !melt water that remains on graupel real qhfzh(ngs) !water that freezes on mixed-phase graupel + real qffzf(ngs) !water that freezes on mixed-phase FD real qhlfzhl(ngs) !water that freezes on mixed-phase hail real qhmlrlg(ngs),qhlmlrlg(ngs) ! melting from the larger diameters @@ -11115,6 +12943,7 @@ subroutine nssl_2mom_gs & real qrshr(ngs) real fsw(ngs),fhw(ngs),fhlw(ngs),ffw(ngs) !liquid water fractions real fswmax(ngs),fhwmax(ngs),fhlwmax(ngs) !liquid water fractions + real ffwmax(ngs) real qhcnf(ngs) real :: qhlcnh(ngs) real qhcngh(ngs),qhcngm(ngs),qhcngl(ngs) @@ -11128,7 +12957,7 @@ subroutine nssl_2mom_gs & real ehxr(ngs),ehlr(ngs),egmr(ngs) real eri(ngs),esi(ngs),egli(ngs),eghi(ngs),efi(ngs),efis(ngs) real ehxi(ngs),ehli(ngs),egmi(ngs),ehi(ngs),ehis(ngs),ehlis(ngs) - real ers(ngs),ess(ngs),egls(ngs),eghs(ngs),efs(ngs),ehs(ngs) + real ers(ngs),ess(ngs),egls(ngs),eghs(ngs),efs(ngs),ehs(ngs),ehsfac(ngs) real ehscnv(ngs) real ehxs(ngs),ehls(ngs),egms(ngs),egmip(ngs) @@ -11187,12 +13016,13 @@ subroutine nssl_2mom_gs & real pqgli(ngs),pqghi(ngs),pqfwi(ngs) real pqgmi(ngs),pqhli(ngs) ! ,pqhxi(ngs) real pqiri(ngs),pqipi(ngs) ! pqwai(ngs), - real pqlwsi(ngs),pqlwhi(ngs),pqlwhli(ngs) + real pqlwsi(ngs),pqlwhi(ngs),pqlwhli(ngs),pqlwfi(ngs) real pqlwlghi(ngs),pqlwlghli(ngs) real pqlwlghd(ngs),pqlwlghld(ngs) + real pvhwi(ngs), pvhwd(ngs) real pvfwi(ngs), pvfwd(ngs) @@ -11204,7 +13034,7 @@ subroutine nssl_2mom_gs & real pqgld(ngs),pqghd(ngs),pqfwd(ngs) real pqgmd(ngs),pqhld(ngs) ! ,pqhxd(ngs) real pqird(ngs),pqipd(ngs) ! pqwad(ngs), - real pqlwsd(ngs),pqlwhd(ngs),pqlwhld(ngs) + real pqlwsd(ngs),pqlwhd(ngs),pqlwhld(ngs),pqlwfd(ngs) ! ! real pqxii(ngs,nhab),pqxid(ngs,nhab) ! @@ -11352,7 +13182,7 @@ subroutine nssl_2mom_gs & real frcrglgm, frcrglgh, frcrglfw, frcrglgl1 real frcgmrgl, frcgmrgm, frcgmrgh, frcgmrfw, frcgmrgm1 real frcrgmgl, frcrgmgm, frcrgmgh, frcrgmfw, frcrgmgm1 - real sum, qweps, gf2a, gf4a, dqldt, dqidt, dqdt + real total, qweps, gf2a, gf4a, dqldt, dqidt, dqdt real frcghrgl, frcghrgm, frcghrgh, frcghrfw, frcghrgh1, frcrghgl real frcrghgm, frcrghgh, frcrghfw, frcrghgh1 real a1,a2,a3,a4,a5,a6 @@ -11384,9 +13214,22 @@ subroutine nssl_2mom_gs & real :: term1,term2,term3,term4 real :: qaacw ! combined qsacw-qhacw for WSM6 variation + real :: cwchtmp + + real, parameter :: c1r=19.0, c2r=0.6, c3r=1.8, c4r=17.0 ! rain + real, parameter :: c1h=5.5, c2h=0.7, c3h=4.5, c4h=8.5 ! Graupel + real, parameter :: c1hl=3.7, c2hl=0.3, c3hl=9.0, c4hl=6.5, c5hl=1.0, c6hl=6.5 ! Hail +! inline functions for Newton method + real :: galpha, dgalpha + real :: a_in + logical, parameter :: newton = .false. + + galpha(a_in) = ((4. + a_in)*(5. + a_in)*(6. + a_in))/((1. + a_in)*(2. + a_in)*(3. + a_in)) + dgalpha(a_in) = (876. + 1260.*a_in + 621.*a_in**2 + 126.*a_in**3 + 9.*a_in**4)/ & + & (36. + 132.*a_in + 193.*a_in**2 + 144.*a_in**3 + 58.*a_in**4 + 12.*a_in**5 + a_in**6) ! ! #################################################################### ! @@ -11416,6 +13259,11 @@ subroutine nssl_2mom_gs & jstag = 0 kstag = 1 + lrescalelow(:) = rescale_low_alpha + lrescalelow(lr) = rescale_low_alphar .and. rescale_low_alpha + lrescalelow(lh) = rescale_low_alphah .and. rescale_low_alpha + IF ( lf > 1 ) lrescalelow(lf) = rescale_low_alphah .and. rescale_low_alpha + IF ( lhl > 1 ) lrescalelow(lhl) = rescale_low_alphahl .and. rescale_low_alpha ! @@ -11533,11 +13381,18 @@ subroutine nssl_2mom_gs & vmlt = Min(xvmx(lr), 0.523599*(dmlt)**3 ) vshd = Min(xvmx(lr), 0.523599*(dshd)**3 ) - snowmeltmass = pi/6.0 * 1000. * snowmeltdia**3 ! maximum rain particle mass from melting snow (if snowmeltdia > 0) + IF ( snowmeltdia > 0.0 ) THEN + snowmeltmass = pi/6.0 * 1000. * snowmeltdia**3 ! maximum rain particle mass from melting snow (if snowmeltdia > 0) + ENDIF tdtol = 1.0e-05 tfrcbw = tfr - cbw tfrcbi = tfr - cbi + + IF ( mixedphase ) THEN + ibinhmlr = 0 + ibinhlmlr = 0 + ENDIF ! ! ! #ifdef COMMAS @@ -11689,35 +13544,25 @@ subroutine nssl_2mom_gs & do ix = nxmpb,itile pqs(1) = t00(ix,jy,kz) -! pqs(kz) = t00(ix,jy,kz) theta(1) = an(ix,jy,kz,lt) temg(1) = t0(ix,jy,kz) temcg(1) = temg(1) - tfr tqvcon = temg(1)-cbw - ltemq = (temg(1)-163.15)/fqsat+1.5 + ltemq = (temg(1)-163.15)/fqsat + 1.5 ltemq = Min( nqsat, Max(1,ltemq) ) qvs(1) = pqs(1)*tabqvs(ltemq) - qis(1) = pqs(1)*tabqis(ltemq) + IF ( iqis0 == 1 .or. temg(1) <= tfr+0.5 ) THEN + qis(1) = pqs(1)*tabqis(ltemq) + ELSE + ltemq = (tfr - 163.15)/fqsat + 1.5 + qis(1) = pqs(1)*tabqis(ltemq) + ENDIF qss(1) = qvs(1) -! IF ( jy .eq. 1 .and. ix .eq. 24 ) THEN -! write(91,*) 'kz,qv,th: ',kz,an(ix,jy,kz,lv),an(ix,jy,kz,lt),pqs(kz),tabqvs(ltemq),qvs(kz) -! ENDIF - if ( temg(1) .lt. tfr ) then -! if( qcw(kz) .le. qxmin(lc) .and. qci(kz) .gt. qxmin(li)) -! > qss(kz) = qis(kz) -! if( qcw(kz) .gt. qxmin(lc) .and. qci(kz) .gt. qxmin(li)) -! > qss(kz) = (qcw(kz)*qvs(kz) + qci(kz)*qis(kz)) / -! > (qcw(kz) + qci(kz)) - qss(1) = qis(1) - else -! IF ( an(ix,jy,kz,lv) .gt. qss(kz) ) THEN -! write(iunit,*) 'qss exceeded at ',ix,jy,kz,qss(kz),an(ix,jy,kz,lv),temg(kz) -! write(iunit,*) 'other temg = ',theta(kz)*(pinit(kz)+p2(ix,jy,kz)) -! ENDIF + qss(1) = qis(1) end if ! ishail = .false. @@ -11793,7 +13638,12 @@ subroutine nssl_2mom_gs & ltemq = (temg(mgs)-163.15)/fqsat+1.5 ltemq = Min( nqsat, Max(1,ltemq) ) qvs(mgs) = pqs(mgs)*tabqvs(ltemq) - qis(mgs) = pqs(mgs)*tabqis(ltemq) + IF ( iqis0 == 1 .or. temg(mgs) <= tfr+0.5 ) THEN + qis(mgs) = pqs(mgs)*tabqis(ltemq) + ELSE + ltemq = (tfr - 163.15)/fqsat + 1.5 + qis(mgs) = pqs(mgs)*tabqis(ltemq) + ENDIF qss(mgs) = qvs(mgs) ! es(mgs) = 6.1078e2*tabqvs(ltemq) ! eis(mgs) = 6.1078e2*tabqis(ltemq) @@ -11834,93 +13684,21 @@ subroutine nssl_2mom_gs & - scx(:,:) = 0.0 + ! -! set shape parameters +! set concentrations ! - IF ( imurain == 1 ) THEN - alpha(:,lr) = alphar - ELSEIF ( imurain == 3 ) THEN - alpha(:,lr) = xnu(lr) - ENDIF - - alpha(:,li) = xnu(li) - alpha(:,lc) = xnu(lc) - - IF ( imusnow == 1 ) THEN - alpha(:,ls) = alphas - ELSEIF ( imusnow == 3 ) THEN - alpha(:,ls) = xnu(ls) - ENDIF +! ssmax = 0.0 - DO il = lr,lhab - do mgs = 1,ngscnt - IF ( il .ge. lg ) alpha(mgs,il) = dnu(il) - - - DO ic = lc,lhab - dab0lh(mgs,il,ic) = dab0(il,ic) ! dab0(ic,il) - dab1lh(mgs,il,ic) = dab1(il,ic) ! dab1(ic,il) - ENDDO - ENDDO - end do + if ( ndebug .gt. 0 .and. my_rank>=0 ) write(0,*) 'ICEZVD_GS: dbg = 5b' -! DO mgs = 1,ngscnt - DO il = lr,lhab - da0lx(:,il) = da0(il) - ENDDO - da0lh(:) = da0(lh) - da0lr(:) = da0(lr) - da1lr(:) = da1(lr) - da0lc(:) = da0(lc) - da1lc(:) = da1(lc) - - - IF ( lzh < 1 .or. lzhl < 1 ) THEN - rzxhlh(:) = rzhl/rz - ELSEIF ( lzh > 1 .and. lzhl > 1 ) THEN - rzxhlh(:) = 1. - ENDIF - IF ( lzr > 1 ) THEN - rzxh(:) = 1. - rzxhl(:) = 1. - ELSE - rzxh(:) = rz - rzxhl(:) = rzhl - ENDIF - - IF ( imurain == 1 .and. imusnow == 3 .and. lzr < 1 ) THEN - rzxs(:) = rzs - ELSEIF ( imurain == imusnow .or. lzr > 1 ) THEN - rzxs(:) = 1. - ENDIF - ! ENDDO - - IF ( lhl .gt. 1 ) THEN - DO mgs = 1,ngscnt - da0lhl(mgs) = da0(lhl) - ENDDO - ENDIF - - ventrx(:) = ventr - ventrxn(:) = ventrn - gf1palp(:) = gamma_sp(1.0 + alphar) - -! -! set concentrations -! -! ssmax = 0.0 - - - if ( ndebug .gt. 0 .and. my_rank>=0 ) write(0,*) 'ICEZVD_GS: dbg = 5b' - - if ( ipconc .ge. 1 ) then - do mgs = 1,ngscnt - cx(mgs,li) = Max(an(igs(mgs),jy,kgs(mgs),lni), 0.0) - IF ( qx(mgs,li) .le. qxmin(li) ) THEN - cx(mgs,li) = 0.0 - ENDIF + if ( ipconc .ge. 1 ) then + do mgs = 1,ngscnt + cx(mgs,li) = Max(an(igs(mgs),jy,kgs(mgs),lni), 0.0) + IF ( qx(mgs,li) .le. qxmin(li) ) THEN + cx(mgs,li) = 0.0 + ENDIF IF ( lcina .gt. 1 ) THEN cina(mgs) = an(igs(mgs),jy,kgs(mgs),lcina) @@ -12074,6 +13852,124 @@ subroutine nssl_2mom_gs & +! +! 6th moments +! + + IF ( ipconc .ge. 6 ) THEN + zx(:,:) = 0.0 + DO il = lr,lhab + IF ( lz(il) .gt. 1 ) THEN + DO mgs = 1,ngscnt + zx(mgs,il) = Max( an(igs(mgs),jy,kgs(mgs),lz(il)), 0.0 ) + ENDDO + ENDIF + ENDDO + + ENDIF + + IF ( ipconc .ge. 6 ) THEN + + IF ( lz(lr) .lt. 1 ) THEN + g1x(:,lr) = (6.0 + alphar)*(5.0 + alphar)*(4.0 + alphar)/ & + & ((3.0 + alphar)*(2.0 + alphar)*(1.0 + alphar)) + + + DO mgs = 1,ngscnt + IF ( cx(mgs,lr) .gt. 0.0 .and. qx(mgs,lr) .gt. qxmin(lr) ) THEN + + vr = rho0(mgs)*qx(mgs,lr)/(1000.*cx(mgs,lr)) + IF ( lzr < 1 ) THEN + IF ( imurain == 3 ) THEN + zx(mgs,lr) = 3.6476*(rnu+2.0)*cx(mgs,lr)*vr**2/(rnu+1.0) + ELSE ! imurain == 1 + zx(mgs,lr) = 3.6476*g1x(mgs,lr)*cx(mgs,lr)*vr**2 + ENDIF + ENDIF + + ENDIF + ENDDO + ENDIF + + ENDIF + + + scx(:,:) = 0.0 +! +! set shape parameters +! + if ( ndebug .gt. 0 .and. my_rank>=0 ) write(0,*) my_rank, 'ICEZVD_GS: dbg = set alpha' + IF ( imurain == 1 ) THEN + alpha(:,lr) = alphar + ELSEIF ( imurain == 3 ) THEN + alpha(:,lr) = xnu(lr) + ENDIF + + alpha(:,li) = xnu(li) + alpha(:,lc) = xnu(lc) + + IF ( imusnow == 1 ) THEN + alpha(:,ls) = alphas + ELSEIF ( imusnow == 3 ) THEN + alpha(:,ls) = xnu(ls) + ENDIF + + if ( ndebug .gt. 0 .and. my_rank>=0 ) write(0,*) my_rank, 'ICEZVD_GS: dbg = set dab' + + DO il = lr,lhab + do mgs = 1,ngscnt + IF ( il .ge. lg ) alpha(mgs,il) = dnu(il) + + + DO ic = lc,lhab + dab0lh(mgs,il,ic) = dab0(il,ic) ! dab0(ic,il) + dab1lh(mgs,il,ic) = dab1(il,ic) ! dab1(ic,il) + ENDDO + end do + ENDDO + + +! DO mgs = 1,ngscnt + DO il = lr,lhab + da0lx(:,il) = da0(il) + ENDDO + da0lh(:) = da0(lh) + da0lr(:) = da0(lr) + da1lr(:) = da1(lr) + da0lc(:) = da0(lc) + da1lc(:) = da1(lc) + + if ( ndebug .gt. 0 .and. my_rank>=0 ) write(0,*) my_rank, 'ICEZVD_GS: dbg = set rz' + + IF ( lzh < 1 .or. lzhl < 1 ) THEN + rzxhlh(:) = rzhl/rz + ELSEIF ( lzh > 1 .and. lzhl > 1 ) THEN + rzxhlh(:) = 1. + ENDIF + IF ( lzr > 1 ) THEN + rzxh(:) = 1. + rzxhl(:) = 1. + ELSE + rzxh(:) = rz + rzxhl(:) = rzhl + ENDIF + + IF ( imurain == 1 .and. imusnow == 3 .and. lzr < 1 ) THEN + rzxs(:) = rzs + ELSEIF ( imurain == imusnow .or. lzr > 1 ) THEN + rzxs(:) = 1. + ENDIF + ! ENDDO + + IF ( lhl .gt. 1 ) THEN + DO mgs = 1,ngscnt + da0lhl(mgs) = da0(lhl) + ENDDO + ENDIF + + ventrx(:) = ventr + ventrxn(:) = ventrn + gf1palp(:) = gamma_sp(1.0 + alphar) ! ! set factors @@ -12112,6 +14008,7 @@ subroutine nssl_2mom_gs & tmp = qx(mgs,li)+qx(mgs,ls)+qx(mgs,lh) IF ( lhl > 1 ) tmp = tmp + qx(mgs,lhl) + IF ( lf > 1 ) tmp = tmp + qx(mgs,lf) cvm = cv+cvv*qx(mgs,lv)+cpl*(qx(mgs,lc)+qx(mgs,lr)) & +cpigb*(tmp) @@ -12231,62 +14128,880 @@ subroutine nssl_2mom_gs & ENDIF - IF ( lhl .gt. 1 ) THEN + IF ( lhl .gt. 1 ) THEN + + xdn(mgs,lhl) = xdn0(lhl) + xdntmp(mgs,lhl) = xdn0(lhl) + + IF ( lvol(lhl) .gt. 1 ) THEN + IF ( vx(mgs,lhl) .gt. 0.0 .and. qx(mgs,lhl) .gt. qxmin(lhl) ) THEN + + IF ( mixedphase .and. lhlw > 1 ) THEN + ELSE + dnmx = xdnmx(lhl) + ENDIF + + xdn(mgs,lhl) = Min( dnmx, Max( xdnmn(lhl), rho0(mgs)*qx(mgs,lhl)/vx(mgs,lhl) ) ) + vx(mgs,lhl) = rho0(mgs)*qx(mgs,lhl)/xdn(mgs,lhl) + xdntmp(mgs,lhl) = xdn(mgs,lhl) + + ELSEIF ( vx(mgs,lhl) == 0.0 .and. qx(mgs,lhl) .gt. qxmin(lhl) ) THEN ! if volume is zero, need to initialize the default value + + vx(mgs,lhl) = rho0(mgs)*qx(mgs,lhl)/xdn(mgs,lhl) + + ENDIF + ENDIF + + ENDIF + + + end do + + IF ( ipconc == 5 .and. imydiagalpha == 2 ) THEN + + cwchtmp = ((3. + dnu(lh))*(2. + dnu(lh))*(1.0 + dnu(lh)))**(-1./3.) + + DO mgs = 1,ngscnt + !IF ( igs(mgs) == 19 ) write(0,*) 'k,qr,qh,cr,ch = ',kgs(mgs),qx(mgs,lr),cx(mgs,lr),qx(mgs,lh),cx(mgs,lh) + IF ( qx(mgs,lr) .gt. qxmin(lr) .and. cx(mgs,lr) > cxmin ) THEN + xv(mgs,lr) = rho0(mgs)*qx(mgs,lr)/(xdn(mgs,lr)*cx(mgs,lr)) ! + xdia(mgs,lr,3) = (xv(mgs,lr)*6.0*cwc1)**(1./3.) + ! alpha(mgs,lr) = Min(alphamax, c1r*tanh(c2r*(xdia(mgs,lr,3)*1000. - c3r)) + c4r) + ! IF ( igs(mgs) == 19 ) write(0,*) 'imy: i,k,alpr,xdia = ',igs(mgs),kgs(mgs),alpha(mgs,lr),xdia(mgs,lr,3)*1000. + + ! M&M-C 2010: + tmp = 4. + alphar + i = Int(dgami*(tmp)) + del = tmp - dgam*i + x = gmoi(i) + (gmoi(i+1) - gmoi(i))*del*dgami + + tmp = 1. + alphar + i = Int(dgami*(tmp)) + del = tmp - dgam*i + y = gmoi(i) + (gmoi(i+1) - gmoi(i))*del*dgami + + tmp = (x/y)**(1./3.)*xdia(mgs,lr,3)*cwchtmp + + alpha(mgs,lr) = Min(15., 11.8*(1000.*tmp - 0.7)**2 + 2.) + ENDIF + IF ( qx(mgs,lh) .gt. qxmin(lh) .and. cx(mgs,lh) > cxmin ) THEN +! MY 2005: + xv(mgs,lh) = rho0(mgs)*qx(mgs,lh)/(xdn(mgs,lh)*cx(mgs,lh)) ! + xdia(mgs,lh,3) = (xv(mgs,lh)*6.*piinv)**(1./3.) ! mwfac*xdia(mgs,lh,1) ! (xv(mgs,lh)*cwc0*6.0)**(1./3.) +! alpha(mgs,lh) = Min(alphamax, c1h*tanh(c2h*(xdia(mgs,lh,3)*1000. - c3h)) + c4h) + + ! M&M-C 2010: + tmp = 4. + dnu(lh) + i = Int(dgami*(tmp)) + del = tmp - dgam*i + x = gmoi(i) + (gmoi(i+1) - gmoi(i))*del*dgami + + tmp = 1. + dnu(lh) + i = Int(dgami*(tmp)) + del = tmp - dgam*i + y = gmoi(i) + (gmoi(i+1) - gmoi(i))*del*dgami + + tmp = (x/y)**(1./3.)*xdia(mgs,lh,3)*cwchtmp + + alpha(mgs,lh) = Min(15., 11.8*(1000.*tmp - 0.7)**2 + 2.) + ! alphan(mgs,lh) = alpha(mgs,lh) + + ! IF ( igs(mgs) == 19 ) write(0,*) 'imy: i,k,alph,xdia = ',igs(mgs),kgs(mgs),alpha(mgs,lh),xdia(mgs,lh,3)*1000. + il = lh + DO ic = lc,lh-1 ! lhab + i = Nint( alpha(mgs,il)*dqiacralphainv ) + IF ( ic == lc .or. ic == li .or. ic == ls .or. (ic == lr .and. imurain == 3) ) THEN + alp = (3.*alpha(mgs,ic) + 2.) + j = Nint( (3.*alpha(mgs,ic) + 2.)*dqiacralphainv ) + ELSE ! IF ( ic == lr .and. imurain == 1 ) ! rain + alp = alpha(mgs,ic) + j = Nint( alpha(mgs,ic)*dqiacralphainv ) + ENDIF + + dab0lh(mgs,ic,il) = dab0lu(j,i,ic,il) + dab1lh(mgs,ic,il) = dab1lu(j,i,ic,il) + dab0lh(mgs,il,ic) = dab0lu(i,j,il,ic) + dab1lh(mgs,il,ic) = dab1lu(i,j,il,ic) + ENDDO + ENDIF +! alpha(:,lr) = 0. ! 10. +! alpha(:,lh) = 0. ! 10. + IF ( lhl > 0 ) THEN + IF ( qx(mgs,lhl) .gt. qxmin(lhl) .and. cx(mgs,lhl) > cxmin ) THEN + xv(mgs,lhl) = rho0(mgs)*qx(mgs,lhl)/(xdn(mgs,lhl)*cx(mgs,lhl)) ! + xdia(mgs,lhl,3) = (xv(mgs,lhl)*6.*piinv)**(1./3.) + IF ( xdia(mgs,lhl,3) < 0.008 ) THEN + alpha(mgs,lhl) = Min(alphamax, c1hl*tanh(c2hl*(xdia(mgs,lhl,3)*1000. - c3hl)) + c4hl) + ELSE + alpha(mgs,lhl) = Min(alphamax, c5hl*xdia(mgs,lhl,3)*1000. + c6hl) + ENDIF + + il = lhl + DO ic = lc,lh-1 ! lhab + i = Nint( alpha(mgs,il)*dqiacralphainv ) + IF ( ic == lc .or. ic == li .or. ic == ls .or. (ic == lr .and. imurain == 3) ) THEN + alp = (3.*alpha(mgs,ic) + 2.) + j = Nint( (3.*alpha(mgs,ic) + 2.)*dqiacralphainv ) + ELSE ! IF ( ic == lr .and. imurain == 1 ) ! rain + alp = alpha(mgs,ic) + j = Nint( alpha(mgs,ic)*dqiacralphainv ) + ENDIF + + dab0lh(mgs,ic,il) = dab0lu(j,i,ic,il) + dab1lh(mgs,ic,il) = dab1lu(j,i,ic,il) + dab0lh(mgs,il,ic) = dab0lu(i,j,il,ic) + dab1lh(mgs,il,ic) = dab1lu(i,j,il,ic) + ENDDO + + ENDIF + ENDIF + + + + ENDDO + ENDIF + + + IF ( imurain == 3 ) THEN + IF ( lzr > 1 ) THEN + alphashr = 0.0 + alphamlr = -2.0/3.0 + alphasmlr = -2.0/3.0 + ELSE + alphashr = xnu(lr) + alphamlr = xnu(lr) + alphasmlr = xnu(lr) + ENDIF +! massfacshr = ( (2. + 3.*(1. +alphashr) )/( 3.*(1. + alphashr) ) )**(1./3.) ! this is the diameter factor +! massfacmlr = ( (2. + 3.*(1. +alphamlr) )/( 3.*(1. + alphamlr) ) )**(1./3.) + massfacshr = ( (2. + 3.*(1. +alphashr) )**3/( 3.*(1. + alphashr) ) ) ! this is the mass or volume factor + massfacmlr = ( (2. + 3.*(1. +alphamlr) )**3/( 3.*(1. + alphamlr) ) ) + ELSEIF ( imurain == 1 ) THEN + IF ( lzr > 1 ) THEN + alphashr = 4.0 + alphamlr = 4.0 + alphasmlr = alphasmlr0 + ELSE + alphashr = alphar + alphamlr = alphar + alphasmlr = alphar + ENDIF +! massfacshr = (3.0 + alphashr)*((3.+alphashr)*(2.+alphashr)*(1. + alphashr) )**(-1./3.) ! this is the diameter factor +! massfacmlr = (3.0 + alphamlr)*((3.+alphamlr)*(2.+alphamlr)*(1. + alphamlr) )**(-1./3.) + massfacshr = (3.0 + alphashr)**3/((3.+alphashr)*(2.+alphashr)*(1. + alphashr) ) ! this is the mass or volume factor + massfacmlr = (3.0 + alphamlr)**3/((3.+alphamlr)*(2.+alphamlr)*(1. + alphamlr) ) + ENDIF + +! Find shape parameter rain + + g1shr = 1.0 + g1mlr = 1.0 + g1smlr = 1.0 + +! CALL cld_cpu('Z-MOMENT-1') + + IF ( ipconc >= 6 ) THEN + + ! set base g1x in case rain is not 3-moment + IF ( ipconc >= 6 .and. imurain == 3 ) THEN + il = lr + DO mgs = 1,ngscnt +! g1x(mgs,il) = 36.*(alpha(mgs,lr)+2.0)/((alpha(mgs,lr)+1.0)*pi**2) + g1x(mgs,il) = (alpha(mgs,lr)+2.0)/((alpha(mgs,lr)+1.0)) + ENDDO + ENDIF + + IF (lzr > 1 ) THEN + IF ( imurain == 3 ) THEN + g1shr = (alphashr+2.0)/((alphashr+1.0)) + g1mlr = (alphamlr+2.0)/((alphamlr+1.0)) + g1smlr = (alphasmlr+2.0)/((alphasmlr+1.0)) + ELSEIF ( imurain == 1 ) THEN +! g1shr = 36.*(6.0 + alphashr)*(5.0 + alphashr)*(4.0 + alphashr)/ & +! & (pi**2*(3.0 + alphashr)*(2.0 + alphashr)*(1.0 + alphashr)) + g1shr = (6.0 + alphashr)*(5.0 + alphashr)*(4.0 + alphashr)/ & + & ((3.0 + alphashr)*(2.0 + alphashr)*(1.0 + alphashr)) +! g1mlr = 36.*(6.0 + alphamlr)*(5.0 + alphamlr)*(4.0 + alphamlr)/ & +! & (pi**2*(3.0 + alphamlr)*(2.0 + alphamlr)*(1.0 + alphamlr)) + g1mlr = (6.0 + alphamlr)*(5.0 + alphamlr)*(4.0 + alphamlr)/ & + & ((3.0 + alphamlr)*(2.0 + alphamlr)*(1.0 + alphamlr)) + g1smlr = (6.0 + alphasmlr)*(5.0 + alphasmlr)*(4.0 + alphasmlr)/ & + & ((3.0 + alphasmlr)*(2.0 + alphasmlr)*(1.0 + alphasmlr)) + ENDIF + ENDIF + + IF ( lzr > 1 .and. imurain == 3 ) THEN ! { RAIN SHAPE PARAM + + +! CALL cld_cpu('Z-MOMENT-1r') + il = lr + DO mgs = 1,ngscnt + + + IF ( iresetmoments == 1 .or. iresetmoments == il .or. iresetmoments == -1 ) THEN ! .or. qx(mgs,il) <= qxmin(il) THEN + IF ( zx(mgs,il) <= zxmin ) THEN ! .and. qx(mgs,il) > 0.05e-3 THEN +!! write(91,*) 'zx=0; qx,cx = ',1000.*qx(mgs,il),cx(mgs,il) + qx(mgs,il) = 0.0 + cx(mgs,il) = 0.0 + an(igs(mgs),jgs,kgs(mgs),lv) = an(igs(mgs),jgs,kgs(mgs),lv) + an(igs(mgs),jgs,kgs(mgs),il) + an(igs(mgs),jgs,kgs(mgs),il) = qx(mgs,il) + an(igs(mgs),jgs,kgs(mgs),ln(il)) = cx(mgs,il) + ELSEIF ( iresetmoments == -1 .and. qx(mgs,il) < qxmin(il) ) THEN + zx(mgs,il) = 0.0 + cx(mgs,il) = 0.0 + an(igs(mgs),jgs,kgs(mgs),lv) = an(igs(mgs),jgs,kgs(mgs),lv) + an(igs(mgs),jgs,kgs(mgs),il) + + qx(mgs,il) = 0.0 + an(igs(mgs),jgs,kgs(mgs),il) = qx(mgs,il) + an(igs(mgs),jgs,kgs(mgs),ln(il)) = cx(mgs,il) + an(igs(mgs),jgs,kgs(mgs),lz(il)) = zx(mgs,il) + + ELSEIF ( cx(mgs,il) <= cxmin .and. iresetmoments /= -1 ) THEN ! .and. qx(mgs,il) > 0.05e-3 THEN + + qx(mgs,lv) = qx(mgs,lv) + qx(mgs,il) + zx(mgs,lr) = 0.0 + qx(mgs,lr) = 0.0 + an(igs(mgs),jgs,kgs(mgs),lv) = an(igs(mgs),jgs,kgs(mgs),lv) + an(igs(mgs),jgs,kgs(mgs),lr) + an(igs(mgs),jgs,kgs(mgs),lr) = qx(mgs,lr) + an(igs(mgs),jgs,kgs(mgs),lz(lr)) = zx(mgs,lr) + ENDIF + ENDIF + + IF ( .false. .and. zx(mgs,il) <= zxmin .and. cx(mgs,il) <= cxmin ) THEN + zx(mgs,il) = 0.0 + cx(mgs,il) = 0.0 + an(igs(mgs),jgs,kgs(mgs),lv) = an(igs(mgs),jgs,kgs(mgs),lv) + an(igs(mgs),jgs,kgs(mgs),il) + + qx(mgs,il) = 0.0 + an(igs(mgs),jgs,kgs(mgs),il) = qx(mgs,il) + an(igs(mgs),jgs,kgs(mgs),ln(il)) = cx(mgs,il) + an(igs(mgs),jgs,kgs(mgs),lz(il)) = zx(mgs,il) + ENDIF + + IF ( qx(mgs,lr) .gt. qxmin(lr) ) THEN + + xv(mgs,lr) = rho0(mgs)*qx(mgs,lr)/(xdn(mgs,lr)*Max(1.0e-11,cx(mgs,lr))) + IF ( xv(mgs,lr) .gt. xvmx(lr) ) THEN +! xv(mgs,lr) = xvmx(lr) +! cx(mgs,lr) = rho0(mgs)*qx(mgs,lr)/(xvmx(lr)*xdn(mgs,lr)) + ELSEIF ( xv(mgs,lr) .lt. xvmn(lr) ) THEN + xv(mgs,lr) = xvmn(lr) + cx(mgs,lr) = rho0(mgs)*qx(mgs,lr)/(xvmn(lr)*xdn(mgs,lr)) + ENDIF + + IF ( zx(mgs,il) > 0.0 .and. cx(mgs,il) <= 0.0 ) THEN +! have mass and reflectivity but no concentration, so set concentration, using default alpha + g1 = 36.*(alpha(mgs,lr)+2.0)/((alpha(mgs,lr)+1.0)*pi**2) + z = zx(mgs,il) + qr = qx(mgs,il) + cx(mgs,il) = g1*dn(igs(mgs),jy,kgs(mgs))**2*(qr)*qr/(z*xdn(mgs,lr)**2) +! an(igs(mgs),jgs,kgs(mgs),ln(il)) = zx(mgs,il) + ELSEIF ( zx(mgs,il) <= zxmin .and. cx(mgs,il) > 0.0 ) THEN +! have mass and concentration but no reflectivity, so set reflectivity, using default alpha + g1 = 36.*(alpha(mgs,lr)+2.0)/((alpha(mgs,lr)+1.0)*pi**2) + chw = cx(mgs,il) + qr = qx(mgs,il) + zx(mgs,il) = g1*dn(igs(mgs),jy,kgs(mgs))**2*(qr)*qr/(xdn(mgs,lr)**2*chw) + an(igs(mgs),jgs,kgs(mgs),lz(lr)) = zx(mgs,lr) + + ELSEIF ( zx(mgs,il) <= zxmin .and. cx(mgs,il) <= 0.0 ) THEN +! How did this happen? + ! set values according to dBZ of -10, or Z = 0.1 +! 0.1 = 1.e18*0.224*an(ix,jy,kz,lzh)*(hwdn/rwdn)**2 + zx(mgs,il) = 1.e-19/0.224*(xdn0(lr)/xdn0(il))**2 + an(igs(mgs),jgs,kgs(mgs),lz(il)) = zx(mgs,il) + + g1 = 36.*(alpha(mgs,lr)+2.0)/((alpha(mgs,lr)+1.0)*pi**2) + z = zx(mgs,il) + qr = qx(mgs,il) + cx(mgs,il) = g1*dn(igs(mgs),jy,kgs(mgs))**2*(qr)*qr/(z*1000.*1000) + an(igs(mgs),jgs,kgs(mgs),ln(il)) = cx(mgs,il) + ENDIF + + IF ( zx(mgs,lr) > 0.0 ) THEN + xv(mgs,lr) = rho0(mgs)*qx(mgs,lr)/(1000.*cx(mgs,lr)) + vr = xv(mgs,lr) + qr = qx(mgs,lr) + nrx = cx(mgs,lr) + z = zx(mgs,lr) + +! xv = (db(1,kz)*a(1,1,kz,lr))**2/(a(1,1,kz,lnr)) +! rd = z*(pi/6.*1000.)**2/xv + +! determine shape parameter alpha by iteration + IF ( z .gt. 0.0 ) THEN +! alpha(mgs,lr) = 3. + alp = 36.*(alpha(mgs,lr)+2.0)*nrx*vr**2/(z*pi**2) - 1. + DO i = 1,20 + IF ( Abs(alp - alpha(mgs,lr)) .lt. 0.01 ) EXIT + alpha(mgs,lr) = Max( rnumin, Min( rnumax, alp ) ) + alp = 36.*(alpha(mgs,lr)+2.0)*nrx*vr**2/(z*pi**2) - 1. + alp = Max( rnumin, Min( rnumax, alp ) ) + ENDDO + +! check for artificial breakup (rain larger than allowed max size) + IF ( (xv(mgs,il) .gt. xvmx(il) .or. (ioldlimiter >= 2 .and. xv(mgs,il) .gt. xvmx(il)/8.) )) THEN + tmp = cx(mgs,il) + IF ( ioldlimiter >= 2 ) THEN ! MY-style active breakup + x = (6.*rho0(mgs)*qx(mgs,il)/(pi*xdn(mgs,il)*cx(mgs,il)))**(1./3.) + x1 = Max(0.0e-3, x - 3.0e-3) + x2 = Max(0.5, x/6.0e-3) + x3 = x2**3 + cx(mgs,il) = cx(mgs,il)*Max((1.+2.222e3*x1**2), x3) + xv(mgs,il) = xv(mgs,il)/Max((1.+2.222e3*x1**2), x3) + ELSE ! simple cutoff + xv(mgs,il) = Min( xvmx(il), Max( xvmn(il),xv(mgs,il) ) ) + xmas(mgs,il) = xv(mgs,il)*xdn(mgs,il) + cx(mgs,il) = rho0(mgs)*qx(mgs,il)/(xmas(mgs,il)) + ENDIF + !xmas(mgs,il) = xv(mgs,il)*xdn(mgs,il) + !cx(mgs,il) = rho0(mgs)*qx(mgs,il)/(xmas(mgs,il)) + + IF ( tmp < cx(mgs,il) ) THEN ! breakup + + g1 = 36.*(alpha(mgs,lr)+2.0)/((alpha(mgs,lr)+1.0)*pi**2) + zx(mgs,il) = zx(mgs,il) + g1*(rho0(mgs)/xdn(mgs,il))**2*( (qx(mgs,il)/tmp)**2 * (tmp-cx(mgs,il)) ) + an(igs(mgs),jgs,kgs(mgs),lz(il)) = zx(mgs,il) + + vr = xv(mgs,lr) + qr = qx(mgs,lr) + nrx = cx(mgs,lr) + z = zx(mgs,lr) + + +! determine shape parameter alpha by iteration + alp = 36.*(alpha(mgs,lr)+2.0)*nrx*vr**2/(z*pi**2) - 1. + DO i = 1,20 + IF ( Abs(alp - alpha(mgs,lr)) .lt. 0.01 ) EXIT + alpha(mgs,lr) = Max( rnumin, Min( rnumax, alp ) ) + alp = 36.*(alpha(mgs,lr)+2.0)*nrx*vr**2/(z*pi**2) - 1. + alp = Max( rnumin, Min( rnumax, alp ) ) + ENDDO + + + ENDIF + ENDIF + +! +! Check whether the shape parameter is at or less than the minimum, and if it is, reset the +! concentration or reflectivity to match (prevents reflectivity from being out of balance with Q and N) +! + g1 = 36.*(alpha(mgs,lr)+2.0)/((alpha(mgs,lr)+1.0)*pi**2) + IF ( .true. .and. (alpha(mgs,il) <= rnumin .or. alp == rnumin .or. alp == rnumax) ) THEN + + IF ( rescale_high_alpha .and. alp >= rnumax - 0.01 ) THEN ! reset c at high alpha to prevent growth in Z + cx(mgs,il) = g1*dn(igs(mgs),jy,kgs(mgs))**2*(qr)*qr/z*(1./(xdn(mgs,il)))**2 + an(igs(mgs),jy,kgs(mgs),ln(il)) = cx(mgs,il) + + ELSEIF ( rescale_low_alphar .and. alp <= rnumin ) THEN + z = 36.*(alpha(mgs,lr)+2.0)*nrx*vr**2/((alpha(mgs,lr)+1.0)*pi**2) + zx(mgs,il) = z + an(igs(mgs),jy,kgs(mgs),lz(il)) = zx(mgs,il) + ENDIF + ENDIF + + ! set g1x to use as G factor later. If alpha is in the range ( rnumin < alpha < rnumax ), then + ! this will be the same as computing G from alpha. If alpha = rnumax, however, it probably means that + ! the moments are not matched correctly, so we compute G from the moments instead so that the dZ/dt rates + ! stay consistent with dN/dt and dq/dt. + IF ( alp >= rnumax - 0.01 ) THEN +! g1x(mgs,il) = 6**2*zx(mgs,il)/(cx(mgs,il)*(pi*xv(mgs,lr))**2) +! g1x(mgs,il) = xdn(mgs,il)*zx(mgs,il)*cx(mgs,il)/((rho0(mgs)*qx(mgs,lr))**2) + g1x(mgs,il) = (pi*xdn(mgs,il))**2*zx(mgs,il)*cx(mgs,il)/((6.*rho0(mgs)*qx(mgs,il))**2) + ELSE + g1x(mgs,il) = g1 + ENDIF + + tmp = alpha(mgs,lr) + 4./3. + i = Int(dgami*(tmp)) + del = tmp - dgam*i + x = gmoi(i) + (gmoi(i+1) - gmoi(i))*del*dgami + + tmp = alpha(mgs,lr) + 1. + i = Int(dgami*(tmp)) + del = tmp - dgam*i + y = gmoi(i) + (gmoi(i+1) - gmoi(i))*del*dgami + + gf1palp(mgs) = y + +! ventrx(mgs) = Gamma_sp(alpha(mgs,lr) + 4./3.)/(alpha(mgs,lr) + 1.)**(1./3.)/Gamma_sp(alpha(mgs,lr) + 1.) + ventrx(mgs) = x/(y*(alpha(mgs,lr) + 1.)**(1./3.)) + + IF ( imurain == 3 .and. izwisventr == 2 ) THEN + + tmp = alpha(mgs,lr) + 1.5 + br/6. + i = Int(dgami*(tmp)) + del = tmp - dgam*i + x = gmoi(i) + (gmoi(i+1) - gmoi(i))*del*dgami + +! ventrx(mgs) = Gamma_sp(alpha(mgs,lr) + 1.5 + br/6.)/Gamma_sp(alpha(mgs,lr) + 1.) + ventrxn(mgs) = x/(y*(alpha(mgs,lr) + 1.)**((1.+br)/6. + 1./3.)) + +! This whole section is imurain == 3, so this branch never runs +! ELSEIF ( imurain == 1 .and. iferwisventr == 2 ) THEN +! +! tmp = alpha(mgs,lr) + 2.5 + br/2. +! i = Int(dgami*(tmp)) +! del = tmp - dgam*i +! x = gmoi(i) + (gmoi(i+1) - gmoi(i))*del*dgami +! +!! ventrx(mgs) = Gamma_sp(alpha(mgs,lr) + 1.5 + br/6.)/Gamma_sp(alpha(mgs,lr) + 1.) +! ventrxn(mgs) = x/y + + + ENDIF + + ENDIF + ENDIF + + ENDIF + + ENDDO +! CALL cld_cpu('Z-MOMENT-1r') + ENDIF ! } + + ENDIF ! ipconc >= 6 + +! Find shape parameters for graupel and hail + IF ( ipconc .ge. 6 ) THEN + + DO il = lr,lhab + + ! set base values of g1x + IF ( (.not. ( il == lr .and. imurain == 3 )) .and. ( il == lr .or. il == lh .or. il == lhl .or. il == lf ) ) THEN + DO mgs = 1,ngscnt + g1x(mgs,il) = (6.0 + alpha(mgs,il))*(5.0 + alpha(mgs,il))*(4.0 + alpha(mgs,il))/ & + & ((3.0 + alpha(mgs,il))*(2.0 + alpha(mgs,il))*(1.0 + alpha(mgs,il))) + ENDDO + ENDIF + + IF ( lz(il) .gt. 1 .and. ( .not. ( il == lr .and. imurain == 3 )) ) THEN + + DO mgs = 1,ngscnt + + + IF ( iresetmoments == 1 .or. iresetmoments == il .or. iresetmoments == -1 ) THEN ! .or. qx(mgs,il) <= qxmin(il) ) THEN + IF ( zx(mgs,il) <= zxmin ) THEN ! .and. qx(mgs,il) > 0.05e-3 ) THEN +!! write(91,*) 'zx=0; qx,cx = ',1000.*qx(mgs,il),cx(mgs,il) + qx(mgs,il) = 0.0 + cx(mgs,il) = 0.0 + zx(mgs,il) = 0.0 + an(igs(mgs),jgs,kgs(mgs),lv) = an(igs(mgs),jgs,kgs(mgs),lv) + an(igs(mgs),jgs,kgs(mgs),il) + an(igs(mgs),jgs,kgs(mgs),il) = qx(mgs,il) + an(igs(mgs),jgs,kgs(mgs),ln(il)) = cx(mgs,il) + an(igs(mgs),jgs,kgs(mgs),lz(il)) = zx(mgs,il) + ELSEIF ( iresetmoments == -1 .and. qx(mgs,il) < qxmin(il) ) THEN + zx(mgs,il) = 0.0 + cx(mgs,il) = 0.0 + an(igs(mgs),jgs,kgs(mgs),lv) = an(igs(mgs),jgs,kgs(mgs),lv) + an(igs(mgs),jgs,kgs(mgs),il) + + qx(mgs,il) = 0.0 + an(igs(mgs),jgs,kgs(mgs),il) = qx(mgs,il) + an(igs(mgs),jgs,kgs(mgs),ln(il)) = cx(mgs,il) + an(igs(mgs),jgs,kgs(mgs),lz(il)) = zx(mgs,il) + + ELSEIF ( cx(mgs,il) <= cxmin .and. iresetmoments /= -1 ) THEN ! .and. qx(mgs,il) > 0.05e-3 ) THEN + qx(mgs,lv) = qx(mgs,lv) + qx(mgs,il) + zx(mgs,il) = 0.0 + cx(mgs,il) = 0.0 + qx(mgs,il) = 0.0 + an(igs(mgs),jgs,kgs(mgs),lv) = an(igs(mgs),jgs,kgs(mgs),lv) + an(igs(mgs),jgs,kgs(mgs),il) + an(igs(mgs),jgs,kgs(mgs),il) = qx(mgs,il) + an(igs(mgs),jgs,kgs(mgs),lz(il)) = zx(mgs,il) + an(igs(mgs),jgs,kgs(mgs),ln(il)) = cx(mgs,il) + ENDIF + ENDIF + + IF ( zx(mgs,il) <= zxmin .and. cx(mgs,il) <= cxmin ) THEN + zx(mgs,il) = 0.0 + cx(mgs,il) = 0.0 + an(igs(mgs),jgs,kgs(mgs),lv) = an(igs(mgs),jgs,kgs(mgs),lv) + an(igs(mgs),jgs,kgs(mgs),il) + + qx(mgs,il) = 0.0 + an(igs(mgs),jgs,kgs(mgs),il) = qx(mgs,il) + an(igs(mgs),jgs,kgs(mgs),ln(il)) = cx(mgs,il) + an(igs(mgs),jgs,kgs(mgs),lz(il)) = zx(mgs,il) + ENDIF + + IF ( qx(mgs,il) .gt. qxmin(il) ) THEN + + xv(mgs,il) = rho0(mgs)*qx(mgs,il)/(xdn(mgs,il)*Max(1.0e-9,cx(mgs,il))) + xmas(mgs,il) = xv(mgs,il)*xdn(mgs,il) + + IF ( xv(mgs,il) .lt. xvmn(il) ) THEN + xv(mgs,il) = Min( xvmx(il), Max( xvmn(il),xv(mgs,il) ) ) + xmas(mgs,il) = xv(mgs,il)*xdn(mgs,il) + cx(mgs,il) = rho0(mgs)*qx(mgs,il)/(xmas(mgs,il)) + ENDIF + + IF ( zx(mgs,il) > 0.0 .and. cx(mgs,il) <= 0.0 ) THEN +! have mass and reflectivity but no concentration, so set concentration, using default alpha + g1 = (6.0 + alpha(mgs,il))*(5.0 + alpha(mgs,il))*(4.0 + alpha(mgs,il))/ & + & ((3.0 + alpha(mgs,il))*(2.0 + alpha(mgs,il))*(1.0 + alpha(mgs,il))) + z = zx(mgs,il) + qr = qx(mgs,il) +! cx(mgs,il) = g1*dn(igs(mgs),jy,kgs(mgs))**2*(qr)*qr/z + cx(mgs,il) = g1*dn(igs(mgs),jy,kgs(mgs))**2*(6.*qr)**2/(z*(pi*xdn(mgs,il))**2) + + ELSEIF ( zx(mgs,il) <= zxmin .and. cx(mgs,il) > cxmin ) THEN +! have mass and concentration but no reflectivity, so set reflectivity, using default alpha +! g1 = (6.0 + alpha(mgs,il))*(5.0 + alpha(mgs,il))*(4.0 + alpha(mgs,il))/ & +! & ((3.0 + alpha(mgs,il))*(2.0 + alpha(mgs,il))*(1.0 + alpha(mgs,il))) + chw = cx(mgs,il) + qr = qx(mgs,il) +! zx(mgs,il) = g1*dn(igs(mgs),jy,kgs(mgs))**2*(qr)*qr/chw +! zx(mgs,il) = Min(zxmin*1.1, g1*dn(igs(mgs),jy,kgs(mgs))**2*(6.*qr)**2/(chw*(pi*xdn(mgs,il))**2) ) + g1 = (6.0 + alphamax)*(5.0 + alphamax)*(4.0 + alphamax)/ & + & ((3.0 + alphamax)*(2.0 + alphamax)*(1.0 + alphamax)) + zx(mgs,il) = Max(zxmin*1.1, g1*dn(igs(mgs),jy,kgs(mgs))**2*(6*qr)**2/(chw*(pi*xdn(mgs,il))**2) ) + an(igs(mgs),jgs,kgs(mgs),lz(il)) = zx(mgs,il) + + ELSEIF ( zx(mgs,il) <= zxmin .and. cx(mgs,il) <= 0.0 ) THEN +! How did this happen? + ! set values according to dBZ of -10, or Z = 0.1 +! 0.1 = 1.e18*0.224*an(ix,jy,kz,lzh)*(hwdn/rwdn)**2 + zx(mgs,il) = 1.e-19/0.224*(xdn0(lr)/xdn0(il))**2 + an(igs(mgs),jgs,kgs(mgs),lz(il)) = zx(mgs,il) + + g1 = (6.0 + alpha(mgs,il))*(5.0 + alpha(mgs,il))*(4.0 + alpha(mgs,il))/ & + & ((3.0 + alpha(mgs,il))*(2.0 + alpha(mgs,il))*(1.0 + alpha(mgs,il))) + z = zx(mgs,il) + qr = qx(mgs,il) +! cx(mgs,il) = g1*dn(igs(mgs),jy,kgs(mgs))**2*(qr)*qr/z + cx(mgs,il) = g1*dn(igs(mgs),jy,kgs(mgs))**2*(6.*qr)**2/(z*(pi*xdn(mgs,il))**2) + an(igs(mgs),jgs,kgs(mgs),ln(il)) = cx(mgs,il) + ELSE + + chw = cx(mgs,il) + qr = qx(mgs,il) + z = zx(mgs,il) + + IF ( zx(mgs,il) .gt. 0. ) THEN + +! rdi = z*(pi/6.*1000.)**2*chw/((rho0(mgs)*qr)**2) + rdi = z*(pi/6.*xdn(mgs,il))**2*chw/((rho0(mgs)*qr)**2) + +! alp = 1.e18*(6.+alpha(mgs,il))*(5.0+alpha(mgs,il))*(4.0+alpha(mgs,il))/ +! : ((3.0+alpha(mgs,il))*(2.0+alpha(mgs,il))*rdi) - 1.0 + alp = (6.0+alpha(mgs,il))*(5.0+alpha(mgs,il))*(4.0+alpha(mgs,il))/ & + & ((3.0+alpha(mgs,il))*(2.0+alpha(mgs,il))*rdi) - 1.0 +! print*,'kz, alp, alpha(mgs,il) = ',kz,alp,alpha(mgs,il),rdi,z,xv + alp = Max( alphamin, Min( alphamax, alp ) ) + + IF ( newton ) THEN + DO i = 1,10 + IF ( Abs(alp - alpha(mgs,il)) .lt. 0.01 ) EXIT + alpha(mgs,il) = Max( alphamin, Min( alphamax, alp ) ) + alp = alp + ( galpha(alp) - rdi )/dgalpha(alp) + alp = Max( alphamin, Min( alphamax, alp ) ) + ENDDO + + ELSE + DO i = 1,10 +! IF ( 100.*Abs(alp - alpha(mgs,il))/(Abs(alpha(mgs,il))+1.e-5) .lt. 1. ) EXIT + IF ( Abs(alp - alpha(mgs,il)) .lt. 0.01 ) EXIT + alpha(mgs,il) = Max( alphamin, Min( alphamax, alp ) ) +! alp = 1.e18*(6.+alpha(mgs,il))*(5.0+alpha(mgs,il))*(4.0+alpha(mgs,il))/ +! : ((3.0+alpha(mgs,il))*(2.0+alpha(mgs,il))*rdi) - 1.0 + alp = (6.+alpha(mgs,il))*(5.0+alpha(mgs,il))*(4.0+alpha(mgs,il))/ & + & ((3.0+alpha(mgs,il))*(2.0+alpha(mgs,il))*rdi) - 1.0 +! print*,'i,alp = ',i,alp + alp = Max( alphamin, Min( alphamax, alp ) ) + ENDDO + ENDIF + + +! check for artificial breakup (graupel/hail larger than allowed max size) + IF ( imaxdiaopt == 1 ) THEN + xvbarmax = xvmx(il) + ELSEIF ( imaxdiaopt == 2 ) THEN ! test against maximum mass diameter + xvbarmax = xvmx(il) /((3. + alpha(mgs,il))**3/((3. + alpha(mgs,il))*(2. + alpha(mgs,il))*(1. + alpha(mgs,il)))) + ELSEIF ( imaxdiaopt == 3 ) THEN ! test against mass-weighted diameter + xvbarmax = xvmx(il) /((4. + alpha(mgs,il))**3/((3. + alpha(mgs,il))*(2. + alpha(mgs,il))*(1. + alpha(mgs,il)))) + ELSE + xvbarmax = xvmx(il) + ENDIF + + IF ( xv(mgs,il) .gt. xvbarmax .or. (il == lr .and. ioldlimiter >= 2 .and. xv(mgs,il) .gt. xvmx(il)/8.)) THEN + tmp = cx(mgs,il) + IF( ioldlimiter >= 2 .and. il == lr) THEN ! MY-style drop limiter for rain + x = (6.*rho0(mgs)*qx(mgs,il)/(pi*xdn(mgs,il)*cx(mgs,il)))**(1./3.) + x1 = Max(0.0e-3, x - 3.0e-3) + x2 = Max(0.5, x/6.0e-3) + x3 = x2**3 + cx(mgs,il) = cx(mgs,il)*Max((1.+2.222e3*x1**2), x3) + xv(mgs,il) = xv(mgs,il)/Max((1.+2.222e3*x1**2), x3) + ELSE + xv(mgs,il) = Min( xvbarmax, Max( xvmn(il),xv(mgs,il) ) ) + xmas(mgs,il) = xv(mgs,il)*xdn(mgs,il) + cx(mgs,il) = rho0(mgs)*qx(mgs,il)/(xmas(mgs,il)) + ENDIF + IF ( tmp < cx(mgs,il) ) THEN ! artificial breakup has happened, so need to adjust reflectivity and find new shape parameter + g1 = 36.*(6.0 + alpha(mgs,il))*(5.0 + alpha(mgs,il))*(4.0 + alpha(mgs,il))/ & + & ((3.0 + alpha(mgs,il))*(2.0 + alpha(mgs,il))*(1.0 + alpha(mgs,il))*pi**2) + zx(mgs,il) = zx(mgs,il) + g1*(rho0(mgs)/xdn(mgs,il))**2*( (qx(mgs,il)/tmp)**2 * (tmp-cx(mgs,il)) ) + an(igs(mgs),jgs,kgs(mgs),lz(il)) = zx(mgs,il) + + chw = cx(mgs,il) + qr = qx(mgs,il) + z = zx(mgs,il) + + rdi = z*(pi/6.*xdn(mgs,il))**2*chw/((rho0(mgs)*qr)**2) + alp = (6.0+alpha(mgs,il))*(5.0+alpha(mgs,il))*(4.0+alpha(mgs,il))/ & + & ((3.0+alpha(mgs,il))*(2.0+alpha(mgs,il))*rdi) - 1.0 + DO i = 1,10 + IF ( Abs(alp - alpha(mgs,il)) .lt. 0.01 ) EXIT + alpha(mgs,il) = Max( alphamin, Min( alphamax, alp ) ) + alp = (6.+alpha(mgs,il))*(5.0+alpha(mgs,il))*(4.0+alpha(mgs,il))/ & + & ((3.0+alpha(mgs,il))*(2.0+alpha(mgs,il))*rdi) - 1.0 + alp = Max( alphamin, Min( alphamax, alp ) ) + ENDDO + + + ENDIF + ENDIF + +! +! Check whether the shape parameter is at or less than the minimum, and if it is, reset the +! concentration or reflectivity to match (prevents reflectivity from being out of balance with Q and N) +! + g1 = (6.0 + alpha(mgs,il))*(5.0 + alpha(mgs,il))*(4.0 + alpha(mgs,il))/ & + & ((3.0 + alpha(mgs,il))*(2.0 + alpha(mgs,il))*(1.0 + alpha(mgs,il))) + + IF ( ( lrescalelow(il) .or. rescale_high_alpha ) .and. & + & ( alpha(mgs,il) <= alphamin .or. alp == alphamin .or. alp == alphamax ) ) THEN + + + + IF ( rescale_high_alpha .and. alp >= alphamax - 0.01 ) THEN ! reset c at high alpha to prevent growth in Z + cx(mgs,il) = g1*dn(igs(mgs),jy,kgs(mgs))**2*(qr)*qr/z*(6./(pi*xdn(mgs,il)))**2 + an(igs(mgs),jy,kgs(mgs),ln(il)) = cx(mgs,il) + + ELSEIF ( lrescalelow(il) .and. alp <= alphamin .and. .not. (il == lh .and. icvhl2h > 0 ) .and. & + .not. ( il == lr .and. .not. rescale_low_alphar ) ) THEN ! alpha = alphamin, so reset Z to prevent growth in C + wtest = .false. + IF ( irescalerainopt == 0 ) THEN + wtest = .false. + ELSEIF ( irescalerainopt == 1 ) THEN + wtest = qx(mgs,lc) > qxmin(lc) + ELSEIF ( irescalerainopt == 2 ) THEN + wtest = qx(mgs,lc) > qxmin(lc) .and. wvel(mgs) < rescale_wthresh + ELSEIF ( irescalerainopt == 3 ) THEN + wtest = temcg(mgs) > rescale_tempthresh .and. qx(mgs,lc) > qxmin(lc) .and. wvel(mgs) < rescale_wthresh + ENDIF + + IF ( il == lr .and. ( wtest ) ) THEN +! IF ( temcg(mgs) > 0.0 .and. il == lr .and. qx(mgs,lc) > qxmin(lc) ) THEN + ! certain situations where rain number is adjusted instead of Z. Helps avoid rain being 'zapped' by autoconverted + ! drops (i.e., favor preserving Z when alpha tries to go negative) + chw = g1*dn(igs(mgs),jy,kgs(mgs))**2*(qr)*qr/z*(6./(pi*xdn(mgs,il)))**2 ! g1*dn(igs(mgs),jy,kgs(mgs))**2*(qr)*qr/z1 + cx(mgs,il) = chw + an(igs(mgs),jy,kgs(mgs),ln(il)) = chw + ELSE + + ! Usual resetting of reflectivity moment to force consisntency between Q, N, Z, and alpha when alpha = alphamin + z1 = g1*dn(igs(mgs),jy,kgs(mgs))**2*(qr)*qr/chw + z = z1*(6./(pi*xdn(mgs,il)))**2 + zx(mgs,il) = z + an(igs(mgs),jy,kgs(mgs),lz(il)) = z + ENDIF + ENDIF + ENDIF + + + ! set g1x to use as G factor later. If alpha is in the range ( rnumin < alpha < rnumax ), then + ! this will be the same as computing G from alpha. If alpha = rnumax, however, it probably means that + ! the moments are not matched correctly, so we compute G from the moments instead so that the dZ/dt rates + ! stay consistent with dN/dt and dq/dt. +! g1x(mgs,il) = zx(mgs,il)*chw*(pi*xdn(mgs,il))**2/(6.*qr*dn(igs(mgs),jy,kgs(mgs)))**2 +! g1x(mgs,il) = g1 ! zx(mgs,il)*cx(mgs,il)/(qr)**2 + IF ( alp >= alphamax - 0.5 ) THEN +! g1x(mgs,il) = 6**2*zx(mgs,il)/(cx(mgs,il)*(pi*xv(mgs,lr))**2) +! g1x(mgs,il) = (xdn(mgs,il))**2*zx(mgs,il)*cx(mgs,il)/((rho0(mgs)*qx(mgs,il))**2) + g1x(mgs,il) = (pi*xdn(mgs,il))**2*zx(mgs,il)*cx(mgs,il)/((6.*rho0(mgs)*qx(mgs,il))**2) + ELSE + g1x(mgs,il) = g1 + ENDIF + + ENDIF + +! IF ( ny .eq. 2 ) THEN +! IF ( qr .gt. 1.e-3 ) THEN +! write(0,*) 'alphah at nstep,i,k = ',dtp*(nstep-1),igs(mgs),kgs(mgs),alpha(mgs,il),qr*1000. +! ENDIF +! ENDIF + + + ENDIF ! .true. + + IF ( il == lr ) THEN + +! tmp = alpha(mgs,lr) + 4./3. +! i = Int(dgami*(tmp)) +! del = tmp - dgam*i +! x = gmoi(i) + (gmoi(i+1) - gmoi(i))*del*dgami +! +! tmp = alpha(mgs,lr) + 1. +! i = Int(dgami*(tmp)) +! del = tmp - dgam*i +! y = gmoi(i) + (gmoi(i+1) - gmoi(i))*del*dgami +! +!! ventrx(mgs) = Gamma_sp(alpha(mgs,lr) + 4./3.)/(alpha(mgs,lr) + 1.)**(1./3.)/Gamma_sp(alpha(mgs,lr) + 1.) +! ventrx(mgs) = x/(y*(alpha(mgs,lr) + 1.)**(1./3.)) + - xdn(mgs,lhl) = xdn0(lhl) - xdntmp(mgs,lhl) = xdn0(lhl) + tmp = alpha(mgs,lr) + 1. + i = Int(dgami*(tmp)) + del = tmp - dgam*i + y = gmoi(i) + (gmoi(i+1) - gmoi(i))*del*dgami - IF ( lvol(lhl) .gt. 1 ) THEN - IF ( vx(mgs,lhl) .gt. 0.0 .and. qx(mgs,lhl) .gt. qxmin(lhl) ) THEN + gf1palp(mgs) = y - IF ( mixedphase .and. lhlw > 1 ) THEN - ELSE - dnmx = xdnmx(lhl) - ENDIF + IF ( iferwisventr == 2 ) THEN + tmp = alpha(mgs,lr) + 2.5 + br/2. + i = Int(dgami*(tmp)) + del = tmp - dgam*i + x = gmoi(i) + (gmoi(i+1) - gmoi(i))*del*dgami - xdn(mgs,lhl) = Min( dnmx, Max( xdnmn(lhl), rho0(mgs)*qx(mgs,lhl)/vx(mgs,lhl) ) ) - vx(mgs,lhl) = rho0(mgs)*qx(mgs,lhl)/xdn(mgs,lhl) - xdntmp(mgs,lhl) = xdn(mgs,lhl) - - ELSEIF ( vx(mgs,lhl) == 0.0 .and. qx(mgs,lhl) .gt. qxmin(lhl) ) THEN ! if volume is zero, need to initialize the default value +! ventrx(mgs) = Gamma_sp(alpha(mgs,lr) + 1.5 + br/6.)/Gamma_sp(alpha(mgs,lr) + 1.) - vx(mgs,lhl) = rho0(mgs)*qx(mgs,lhl)/xdn(mgs,lhl) - + ventrxn(mgs) = x/y + ENDIF - ENDIF - - ENDIF + + ENDIF ! il==lr + + + ELSE ! below mass threshold +! g1 = (6.0 + alpha(mgs,il))*(5.0 + alpha(mgs,il))*(4.0 + alpha(mgs,il))/ +! & ((3.0 + alpha(mgs,il))*(2.0 + alpha(mgs,il))*(1.0 + alpha(mgs,il))) +! z1 = g1*rho0(mgs)**2*(qr)*qr/chw +! z = 1.e18*z1*(6./(pi*1000.))**2 +! z = z1*(6./(pi*1000.))**2 +! zx(mgs,il) = z +! an(igs(mgs),jy,kgs(mgs),lz(il)) = z + ENDIF ! ( qx(mgs,il) .gt. qxmin(il) ) + + + +! ENDIF + ENDDO ! mgs +! CALL cld_cpu('Z-DELABK') + +! IF ( il == lr ) THEN +! xnutmp = (alpha(mgs,il) - 2.)/3. +! da0lr(mgs) = delbk(bb(il), xnutmp, xmu(il), 0) +! ENDIF + + IF ( .not. ( il == lr .and. imurain == 3 ) ) THEN +! CALL cld_cpu('Z-DELABK') + DO mgs = 1,ngscnt + IF ( qx(mgs,il) > qxmin(il) ) THEN + xnutmp = (alpha(mgs,il) - 2.)/3. + +! IF ( .true. ) THEN + DO ic = lc,lh-1 ! lhab + IF ( il .ne. ic .and. qx(mgs,ic) .gt. qxmin(ic)) THEN + xnuc = xnu(ic) + IF ( ic == lc .and. idiagnosecnu > 0 ) xnuc = alpha(mgs,lc) ! alpha for droplets is actually nu + IF ( il /= lr .and. ic == lr .and. lzr > 1 ) THEN + IF ( imurain == 3 ) THEN + xnuc = alpha(mgs,lr) ! alpha is nu already + ELSE + xnuc = ( alpha(mgs,lr) - 2. )/3. ! convert alpha to nu + ENDIF + ENDIF + ! delabk(ba,bb,nua,nub,mua,mub,k), where a (il) is collector and b (ic) is collected + IF ( .false. ) THEN + dab0lh(mgs,ic,il) = delabk(bb(ic), bb(il), xnuc, xnutmp, xmu(ic), xmu(il), 0) !dab0(il,ic) + dab1lh(mgs,ic,il) = delabk(bb(ic), bb(il), xnuc, xnutmp, xmu(ic), xmu(il), 1) !dab1(il,ic) + dab0lh(mgs,il,ic) = delabk(bb(il), bb(ic), xnutmp, xnuc, xmu(il), xmu(ic), 0) !dab0(il,ic) + dab1lh(mgs,il,ic) = delabk(bb(il), bb(ic), xnutmp, xnuc, xmu(il), xmu(ic), 1) !dab1(il,ic) + ELSE ! use lookup table -- not interpolating yet because table resolution of 0.05 is good enough + i = Nint( alpha(mgs,il)*dqiacralphainv ) + IF ( ic == lc .or. ic == li .or. ic == ls .or. (ic == lr .and. imurain == 3) ) THEN + alp = (3.*alpha(mgs,ic) + 2.) + j = Nint( (3.*alpha(mgs,ic) + 2.)*dqiacralphainv ) + ELSE ! IF ( ic == lr .and. imurain == 1 ) ! rain + alp = alpha(mgs,ic) + j = Nint( alpha(mgs,ic)*dqiacralphainv ) + ENDIF + + dab0lh(mgs,ic,il) = dab0lu(j,i,ic,il) + dab1lh(mgs,ic,il) = dab1lu(j,i,ic,il) + dab0lh(mgs,il,ic) = dab0lu(i,j,il,ic) + dab1lh(mgs,il,ic) = dab1lu(i,j,il,ic) + +! tmp1 = dab0lu(j,i,ic,il) +! tmp2 = dab1lu(j,i,ic,il) +! tmp3 = dab0lu(i,j,il,ic) +! tmp4 = dab1lu(i,j,il,ic) +! tmp5 = delabk(bb(il), bb(ic), xnutmp, xnuc, xmu(ic), xmu(il), 0) !dab0(il,ic) +! tmp6 = delabk(bb(il), bb(ic), xnutmp, xnuc, xmu(ic), xmu(il), 1) !dab1(il,ic) +! tmp5 = delabk(bb(il), bb(ic), xnutmp, xnuc, xmu(il), xmu(ic), 0) !dab0(il,ic) +! tmp6 = delabk(bb(il), bb(ic), xnutmp, xnuc, xmu(il), xmu(ic), 1) !dab1(il,ic) + + IF ( .false. .and. ny <= 2 ) THEN + write(0,*) + write(0,*) 'bb: ', bb(il), bb(ic), xnutmp, xnuc, xmu(il), xmu(ic) + write(0,*) 'il,ic = ',il,ic,alpha(mgs,il),i,xnuc,alp,j + write(0,*) 'dab0lh,tmp1 = ',dab0lh(mgs,ic,il),tmp1 + write(0,*) 'dab1lh,tmp2 = ',dab1lh(mgs,ic,il),tmp2 + write(0,*) 'dab0lh,tmp3 = ',dab0lh(mgs,il,ic),tmp3,tmp5 + write(0,*) 'dab1lh,tmp4 = ',dab1lh(mgs,il,ic),tmp4,tmp6 + + ENDIF + + ENDIF + + ENDIF + ENDDO - end do +! ENDIF + + da0lx(mgs,il) = delbk(bb(il), xnutmp, xmu(il), 0) + IF ( il .eq. lh ) THEN + da0lh(mgs) = delbk(bb(il), xnutmp, xmu(il), 0) + IF ( lzr > 1 ) THEN + rzxh(mgs) = 1. + ELSE + rzxh(mgs) = ((4. + alpha(mgs,il))*(5. + alpha(mgs,il))*(6. + alpha(mgs,il))*(1. + xnu(lr)))/ & + & ((1. + alpha(mgs,il))*(2. + alpha(mgs,il))*(3. + alpha(mgs,il))*(2. + xnu(lr))) + ENDIF + + IF ( lzhl < 1 ) THEN + rzxhlh(mgs) = rzxhl(mgs)/(((4. + alpha(mgs,il))*(5. + alpha(mgs,il))*(6. + alpha(mgs,il))*(1. + xnu(lr)))/ & + & ((1. + alpha(mgs,il))*(2. + alpha(mgs,il))*(3. + alpha(mgs,il))*(2. + xnu(lr)))) + ENDIF + ELSEIF ( il .eq. lhl ) THEN + da0lhl(mgs) = delbk(bb(il), xnutmp, xmu(il), 0) + IF ( lzr > 1 ) THEN + rzxhl(mgs) = 1. + ELSE + rzxhl(mgs) = ((4.0 + alpha(mgs,il))*(5. + alpha(mgs,il))*(6. + alpha(mgs,il))*(1. + xnu(lr)))/ & + & ((1. + alpha(mgs,il))*(2. + alpha(mgs,il))*(3. + alpha(mgs,il))*(2. + xnu(lr))) + ENDIF + ELSEIF ( il == lr ) THEN + xnutmp = (alpha(mgs,il) - 2.)/3. + da0lr(mgs) = delbk(bb(il), xnutmp, xmu(il), 0) + da1lr(mgs) = delbk(bb(il), xnutmp, xmu(il), 1) + ENDIF + + ENDIF ! ( qx(mgs,il) > qxmin(il) ) + ENDDO ! mgs +! CALL cld_cpu('Z-DELABK') + ENDIF ! il /= lr +! CALL cld_cpu('Z-DELABK') + + ENDIF ! lz(il) .gt. 1 + + ENDDO ! il + + ENDIF ! ipconc .ge. 6 - IF ( imurain == 3 ) THEN - IF ( lzr > 1 ) THEN - alphashr = 0.0 - alphamlr = -2.0/3.0 - ELSE - alphashr = xnu(lr) - alphamlr = xnu(lr) - ENDIF -! massfacshr = ( (2. + 3.*(1. +alphashr) )/( 3.*(1. + alphashr) ) )**(1./3.) ! this is the diameter factor -! massfacmlr = ( (2. + 3.*(1. +alphamlr) )/( 3.*(1. + alphamlr) ) )**(1./3.) - massfacshr = ( (2. + 3.*(1. +alphashr) )**3/( 3.*(1. + alphashr) ) ) ! this is the mass or volume factor - massfacmlr = ( (2. + 3.*(1. +alphamlr) )**3/( 3.*(1. + alphamlr) ) ) - ELSEIF ( imurain == 1 ) THEN - IF ( lzr > 1 ) THEN - alphashr = 4.0 - alphamlr = 4.0 - ELSE - alphashr = alphar - alphamlr = alphar - ENDIF -! massfacshr = (3.0 + alphashr)*((3.+alphashr)*(2.+alphashr)*(1. + alphashr) )**(-1./3.) ! this is the diameter factor -! massfacmlr = (3.0 + alphamlr)*((3.+alphamlr)*(2.+alphamlr)*(1. + alphamlr) )**(-1./3.) - massfacshr = (3.0 + alphashr)**3/((3.+alphashr)*(2.+alphashr)*(1. + alphashr) ) ! this is the mass or volume factor - massfacmlr = (3.0 + alphamlr)**3/((3.+alphamlr)*(2.+alphamlr)*(1. + alphamlr) ) - ENDIF - +! CALL cld_cpu('Z-MOMENT-1') ! ! set some values for ice nucleation @@ -12318,7 +15033,7 @@ subroutine nssl_2mom_gs & ! & itype1a,itype2a,temcg,infdo,alpha) - infdo = 0 + infdo = 1 IF ( rimdenvwgt > 0 ) infdo = 1 call setvtz(ngscnt,qx,qxmin,qxw,cx,rho0,rhovt,xdia,cno,cnostmp, & @@ -12332,9 +15047,9 @@ subroutine nssl_2mom_gs & IF ( lwsm6 .and. ipconc == 0 ) THEN tmp = Max(qxmin(lh), qxmin(ls)) DO mgs = 1,ngscnt - sum = qx(mgs,lh) + qx(mgs,ls) - IF ( sum > tmp ) THEN - vt2ave(mgs) = (qx(mgs,lh)*vtxbar(mgs,lh,1) + qx(mgs,ls)*vtxbar(mgs,ls,1))/sum + total = qx(mgs,lh) + qx(mgs,ls) + IF ( total > tmp ) THEN + vt2ave(mgs) = (qx(mgs,lh)*vtxbar(mgs,lh,1) + qx(mgs,ls)*vtxbar(mgs,ls,1))/total ELSE vt2ave(mgs) = 0.0 ENDIF @@ -12480,6 +15195,17 @@ subroutine nssl_2mom_gs & + IF ( ipconc >= 6 ) THEN + frac = 0.4d0 + zxmxd(:,:) = 0.0 + DO il = lr,lhab + IF ( lz(il) > 0 .or. ( il == lr ) ) THEN + DO mgs = 1,ngscnt + zxmxd(mgs,il) = frac*zx(mgs,il)*dtpinv + ENDDO + ENDIF + ENDDO + ENDIF @@ -12517,10 +15243,10 @@ subroutine nssl_2mom_gs & vshdgs(mgs,il) = vshd ! base value - IF ( qx(mgs,il) > qxmin(il) ) THEN + IF ( qx(mgs,il) > qxmin(il) .and. ivshdgs > 0 ) THEN ! tmpdiam is weighted diameter of d^(shedalp-1), so for shedalp=3, this is the area-weighted diameter or maximum mass diameter. - tmpdiam = (shedalp+alpha(mgs,il))*xdia(mgs,il,1)*( xdn(mgs,il)/917. )**(1./3.) ! erm added density factor for equiv. solid ice sphere 10.12.2015 + tmpdiam = (shedalp+alpha(mgs,il))*xdia(mgs,il,1) ! *( xdn(mgs,il)/917. )**(1./3.) ! erm added density factor for equiv. solid ice sphere 10.12.2015 IF ( tmpdiam > sheddiam0 ) THEN vshdgs(mgs,il) = 0.523599*(1.5e-3)**3/massfacshr ! 1.5mm drops from very large ice @@ -12577,13 +15303,13 @@ subroutine nssl_2mom_gs & ers(mgs) = 0.0 ess(mgs) = 0.0 ehs(mgs) = 0.0 ! used as sticking efficiency, so collection efficiency is ehs*ehsclsn + ehsfac(mgs) = 1.0 ! factor based on ice saturation ehls(mgs) = 0.0 ! used as sticking efficiency, so collection efficiency is ehls*ehlsclsn ehscnv(mgs) = 0.0 ! ehxs(mgs) = 0.0 ! eiw(mgs) = 0.0 eii(mgs) = 0.0 - ehsclsn(mgs) = 0.0 ehiclsn(mgs) = 0.0 ehlsclsn(mgs) = 0.0 @@ -12678,7 +15404,7 @@ subroutine nssl_2mom_gs & if ( qx(mgs,li).gt.qxmin(li) .and. qx(mgs,lc).gt.qxmin(lc) ) then - if (xdia(mgs,lc,1).gt.15.0e-06 .and. xdia(mgs,li,1).gt.30.0e-06) then + if (xdia(mgs,lc,1).gt.ewi_dcmin .and. xdia(mgs,li,1).gt.ewi_dimin) then ! erm 5/10/2007 test following change: ! if (xdia(mgs,lc,1).gt.12.0e-06 .and. xdia(mgs,li,1).gt.50.0e-06) then eiw(mgs) = 0.5 @@ -12802,7 +15528,7 @@ subroutine nssl_2mom_gs & ELSE fac = Abs(ess0) - IF ( .true. .and. ess0 < 0.0 ) THEN + IF ( iessopt == 2 ) THEN ! experimental code ! IF ( wvel(mgs) > 2.0 .or. wvel(mgs) < -0.5 .or. ssi(mgs) < 1.0 ) THEN IF ( wvel(mgs) > 2.0 ) THEN ! assume convective cell or downdraft @@ -12810,9 +15536,25 @@ subroutine nssl_2mom_gs & ELSEIF ( wvel(mgs) > 1.0 ) THEN ! transition to stratiform range of values fac = Max(0.0, 2.0 - wvel(mgs))*fac ENDIF + ELSEIF ( iessopt == 3 ) THEN ! factor based on ice supersat + IF ( ssi(mgs) <= 1.0 ) THEN + fac = 0.0 + ehsfac(mgs) = 0.0 + ELSEIF ( ssi(mgs) <= 1.02 ) THEN + fac = fac*(ssi(mgs) - 1.0)/0.02 + ehsfac(mgs) = (ssi(mgs) - 1.0)/0.02 + ENDIF + ELSEIF ( iessopt == 4 ) THEN ! factor based on ice supersat; very roughly based on Hosler et al. 1957 (J. Met.) + IF ( ssi(mgs) <= 1.0 ) THEN + fac = 0.1 + ehsfac(mgs) = 0.1 + ELSEIF ( ssi(mgs) <= 1.005 ) THEN + fac = Max(0.1, fac*(ssi(mgs) - 1.0)/0.005) + ehsfac(mgs) = Max(0.1, (ssi(mgs) - 1.0)/0.005) + ENDIF ENDIF - IF ( temcg(mgs) > esstem1 .and. temcg(mgs) < esstem2 ) THEN ! only nonzero for T > -25 + IF ( temcg(mgs) > esstem1 .and. temcg(mgs) < esstem2 ) THEN ! only nonzero for T > esstem1 ess(mgs) = fac*Exp(ess1*(esstem2) )*(temcg(mgs) - esstem1)/(esstem2 - esstem1) ! linear ramp up from zero at esstem1 to value at esstem2 ELSEIF ( temcg(mgs) >= esstem2 ) THEN ess(mgs) = fac*Exp(ess1*Min( temcg(mgs), 0.0 ) ) @@ -12923,7 +15665,11 @@ subroutine nssl_2mom_gs & ELSE ehscnv(mgs) = exp(0.09*min(temcg(mgs),0.0)) ENDIF - if ( qx(mgs,lh).gt.qxmin(lh) .and. qx(mgs,lc) > qxmin(lc) ) then + + IF ( qx(mgs,lh).gt.qxmin(lh) .and. qx(mgs,lc) >= qxmin(lc) ) THEN +! ehsclsn(mgs) = ehs_collsn +! ehs(mgs) = ehscnv(mgs)*ehsfac(mgs)*Min(1.0, Max(0.0,xdn(mgs,lh) - 300.)/300. ) +! ELSEIF ( qx(mgs,lh).gt.qxmin(lh) .and. qx(mgs,lc) >= qxmin(lc) ) then ehsclsn(mgs) = ehs_collsn IF ( xdia(mgs,ls,3) < 40.e-6 ) THEN ehsclsn(mgs) = 0.0 @@ -12933,10 +15679,9 @@ subroutine nssl_2mom_gs & ehsclsn(mgs) = ehs_collsn ENDIF ! ehs(mgs) = ehscnv(mgs)*Min(1.0, Max(0., xdn(mgs,lh) - xdnmn(lh)*1.2)/xdnmn(lh) ) ! shut off qhacs as graupel goes to lowest density - ehs(mgs) = ehscnv(mgs)*Min(1.0, Max(0.0,xdn(mgs,lh) - 300.)/300. ) ! shut off qhacs as graupel goes to low density + ehs(mgs) = ehscnv(mgs)*Min(1.0, Max(0.0,xdn(mgs,lh) - 300.)/300. ) ! shut off qhacs as graupel goes to low density; limits scavenging of snow in bright band ! ehs(mgs) = ehscnv(mgs) ! *Min(1.0, Max(0.0,xdn(mgs,lh) - 300.)/300. ) ! shut off qhacs as graupel goes to low density ehs(mgs) = Min(ehs(mgs),ehsmax) - IF ( qx(mgs,lc) < qxmin(lc) ) ehs(mgs) = 0.0 end if ENDIF ! @@ -12944,7 +15689,7 @@ subroutine nssl_2mom_gs & ehiclsn(mgs) = ehi_collsn ehi(mgs)=eii0*exp(eii1*min(temcg(mgs),0.0)) ehi(mgs) = Min( ehimax, Max( ehi(mgs), ehimin ) ) - if ( temg(mgs) .gt. 273.15 .or. ( qx(mgs,lc) < qxmin(lc)) ) ehi(mgs) = 0.0 +! if ( temg(mgs) .gt. 273.15 .or. ( qx(mgs,lc) < qxmin(lc)) ) ehi(mgs) = 0.0 end if IF ( lis > 1 ) THEN @@ -12952,7 +15697,7 @@ subroutine nssl_2mom_gs & ehisclsn(mgs) = ehi_collsn ehis(mgs)=eii0*exp(eii1*min(temcg(mgs),0.0)) ehis(mgs) = Min( ehimax, Max( ehis(mgs), ehimin ) ) - if ( temg(mgs) .gt. 273.15 .or. ( qx(mgs,lc) < qxmin(lc)) ) ehis(mgs) = 0.0 +! if ( temg(mgs) .gt. 273.15 .or. ( qx(mgs,lc) < qxmin(lc)) ) ehis(mgs) = 0.0 end if ENDIF @@ -13089,6 +15834,7 @@ subroutine nssl_2mom_gs & end do + ! ! ! @@ -13162,6 +15908,7 @@ subroutine nssl_2mom_gs & do mgs = 1,ngscnt qraci(mgs) = 0.0 craci(mgs) = 0.0 + qracs(mgs) = 0.0 IF ( eri(mgs) .gt. 0.0 .and. iacr .ge. 1 .and. xdia(mgs,lr,3) .gt. 2.*rwradmn ) THEN IF ( ipconc .ge. 3 ) THEN @@ -13207,8 +15954,9 @@ subroutine nssl_2mom_gs & ENDIF end do ! + IF ( ipconc < 3 ) THEN do mgs = 1,ngscnt - qracs(mgs) = 0.0 + qracs(mgs) = 0.0 IF ( ers(mgs) .gt. 0.0 .and. ipconc < 3 ) THEN IF ( lwsm6 .and. ipconc == 0 ) THEN vt = vt2ave(mgs) @@ -13225,6 +15973,7 @@ subroutine nssl_2mom_gs & & , qsmxd(mgs)) ENDIF end do + ENDIF ! ! @@ -13371,6 +16120,7 @@ subroutine nssl_2mom_gs & ! do mgs = 1,ngscnt qhacw(mgs) = 0.0 + qhacwmlr(mgs) = 0.0 rarx(mgs,lh) = 0.0 vhacw(mgs) = 0.0 vhsoak(mgs) = 0.0 @@ -13437,6 +16187,11 @@ subroutine nssl_2mom_gs & ENDIF + qhacwmlr(mgs) = qhacw(mgs) + IF ( temg(mgs) > tfr .and. iqhacwshr == 0 ) THEN + qhacw(mgs) = 0.0 + ENDIF + IF ( lvol(lh) .gt. 1 .or. lhl .gt. 1 ) THEN ! calculate rime density for graupel volume and/or for graupel conversion to hail IF ( temg(mgs) .lt. 273.15) THEN @@ -13466,14 +16221,18 @@ subroutine nssl_2mom_gs & rimdn(mgs,lh) = 1000.*(0.051 + 0.114*tmp - 0.0055*tmp**2) - ELSEIF ( irimdenopt == 3 ) THEN ! Macklin + ELSEIF ( irimdenopt == 3 .or. irimdenopt == 4) THEN ! Macklin (3) or Saunders and Hosseini 2001 tmp = (-((0.5)*(1.e+06)*xdia(mgs,lc,1)) & & *( (1.0-rimdenvwgt)*vtxbar(mgs,lh,1) + rimdenvwgt*vtxbar(mgs,lh,2) ) & & /(temg(mgs)-273.15)) ! tmp = Min( 5.5/0.6, Max( 0.3/0.6, tmp ) ) - rimdn(mgs,lh) = Min(900., Max( 170., 110.*tmp**0.76 ) ) + IF ( irimdenopt == 3 ) THEN + rimdn(mgs,lh) = Min(900., Max( 170., 110.*tmp**0.76 ) ) + ELSEIF ( irimdenopt == 4 ) THEN ! Saunders and Hosseini + rimdn(mgs,lh) = Min(917., Max( 10., 900.0*(1.0 - 0.905**tmp ) ) ) + ENDIF ENDIF ELSE @@ -13687,6 +16446,7 @@ subroutine nssl_2mom_gs & do mgs = 1,ngscnt qhlacw(mgs) = 0.0 + qhlacwmlr(mgs) = 0.0 vhlacw(mgs) = 0.0 vhlsoak(mgs) = 0.0 IF ( lhl > 1 .and. .true.) THEN @@ -13715,10 +16475,15 @@ subroutine nssl_2mom_gs & qhlacw(mgs) = Min( qhlacw(mgs), 0.5*qx(mgs,lc)*dtpinv ) + qhlacwmlr(mgs) = qhlacw(mgs) + IF ( temg(mgs) > tfr .and. iqhlacwshr == 0 ) THEN + qhlacw(mgs) = 0.0 + ENDIF + IF ( lvol(lhl) .gt. 1 ) THEN IF ( temg(mgs) .lt. 273.15) THEN - IF ( irimdenopt == 1 ) THEN ! Rasmussen and Heymsfeld (1985) + IF ( irimdenopt == 1 ) THEN ! Heymsfeld and Pflaum (1985) rimdn(mgs,lhl) = rimc1*(-((0.5)*(1.e+06)*xdia(mgs,lc,1)) & & *((0.60)*( (1.0-rimdenvwgt)*vtxbar(mgs,lhl,1) + rimdenvwgt*vtxbar(mgs,lhl,2) )) & & /(temg(mgs)-273.15))**(rimc2) @@ -13732,13 +16497,17 @@ subroutine nssl_2mom_gs & rimdn(mgs,lhl) = 1000.*(0.051 + 0.114*tmp - 0.005*tmp**2) - ELSEIF ( irimdenopt == 3 ) THEN ! Macklin + ELSEIF ( irimdenopt == 3 .or. irimdenopt == 4) THEN ! Macklin (3) or Saunders and Hosseini 2001 tmp = -0.5*(1.e+06)*xdia(mgs,lc,1) & & *( (1.0-rimdenvwgt)*vtxbar(mgs,lhl,1) + rimdenvwgt*vtxbar(mgs,lhl,2) ) & & /(temg(mgs)-273.15) ! tmp = Min( 5.5/0.6, Max( 0.3/0.6, tmp ) ) - rimdn(mgs,lhl) = Min(900., Max( 170., 110.*tmp**0.76 ) ) + IF ( irimdenopt == 3 ) THEN + rimdn(mgs,lhl) = Min(900., Max( 170., 110.*tmp**0.76 ) ) + ELSEIF ( irimdenopt == 4 ) THEN ! Saunders and Hosseini + rimdn(mgs,lhl) = Min(917., Max( 10., 900.0*(1.0 - 0.905**tmp ) ) ) + ENDIF ENDIF ELSE @@ -14053,7 +16822,7 @@ subroutine nssl_2mom_gs & frach = 0.5 *(1. + Tanh(0.2e12 *( xvfrz - 1.15*xvbiggsnow))) qiacrs(mgs) = (1.-frach)*qiacr(mgs) - ciacrs(mgs) = (1.-frach)*ciacr(mgs) ! *rzxh(mgs) + ciacrs(mgs) = (1.-frach)*ciacrf(mgs) ! *rzxh(mgs) ENDIF ENDIF @@ -14083,7 +16852,7 @@ subroutine nssl_2mom_gs & tmp = xv(mgs,ls)/(xvmx(ls)*Max(1.,100./Min(100.,xdn(mgs,ls)))) ! fraction of max snow mass IF ( tmp .lt. essfrac1 ) THEN ec0(mgs) = 1.0 - ELSEIF ( tmp .gt. essfrac2 ) THEN + ELSEIF ( tmp .ge. essfrac2 ) THEN ec0(mgs) = 0.0 ELSE ec0(mgs) = (essfrac2 - tmp)/(essfrac2 - essfrac1) @@ -14160,7 +16929,21 @@ subroutine nssl_2mom_gs & ec0(mgs) = 2.e9 IF ( qx(mgs,lr) .gt. qxmin(lr) ) THEN rwrad = 0.5*xdia(mgs,lr,3) - IF ( xdia(mgs,lr,3) .gt. 2.0e-3 .or. icracr <= 0 ) THEN + + + ! check median volume diameter + IF ( icracrthresh > 1 ) THEN + IF ( imurain == 1 ) THEN + tmp = (3.67+alpha(mgs,lr))*xdia(mgs,lr,1) ! median volume diameter; units of mm (Ulbrich 1983, JCAM) + ELSE ! imurain == 3, + tmp = (1.678+alpha(mgs,lr))**(1./3.)*xdia(mgs,lr,1) ! units of mm (using method of Ulbrich 1983. See ventillation_stuff.nb) + ENDIF + ELSE + tmp = xdia(mgs,lr,3) - 0.1e-3 + ENDIF + +! IF ( xdia(mgs,lr,3) .gt. 2.0e-3 .or. icracr <= 0 ) THEN + IF ( tmp .gt. 1.9e-3 .or. icracr <= 0 ) THEN ec0(mgs) = 0.0 cracr(mgs) = 0.0 ELSE @@ -14242,6 +17025,7 @@ subroutine nssl_2mom_gs & ! if (ndebug .gt. 0 ) write(0,*) 'ICEZVD_GS: conc 22kk' chaci(:) = 0.0 + chaci0(:) = 0.0 if ( ipconc .ge. 1 .or. ipelec .ge. 1 ) then do mgs = 1,ngscnt IF ( ehi(mgs) .gt. 0.0 .or. ( ehiclsn(mgs) > 0.0 .and. ipelec > 0 )) THEN @@ -14292,6 +17076,7 @@ subroutine nssl_2mom_gs & ! if (ndebug .gt. 0 ) write(0,*) 'ICEZVD_GS: conc 22nn' chacs(:) = 0.0 + chacs0(:) = 0.0 if ( ipconc .ge. 1 .or. ipelec .ge. 1 ) then do mgs = 1,ngscnt IF ( ehs(mgs) .gt. 0 ) THEN @@ -14451,7 +17236,7 @@ subroutine nssl_2mom_gs & ! Ziegler (1985) autoconversion ! ! - IF ( ipconc .ge. 2 .and. ircnw /= -1) THEN ! DTD: added flag for autoconversion. If -1, turns off autoconversion + IF ( ipconc .ge. 2 ) THEN if (ndebug .gt. 0 ) write(0,*) 'conc 26a' DO mgs = 1,ngscnt @@ -14534,6 +17319,47 @@ subroutine nssl_2mom_gs & IF ( crcnw(mgs) < 1.e-30 ) qrcnw(mgs) = 0.0 + IF ( ipconc >= 6 ) THEN + IF ( lzr > 1 .and. qrcnw(mgs) > 0.0 ) THEN +! vr = rho0(mgs)*qrcnw(mgs)/(1000.*crcnw(mgs)) +! zrcnw(mgs) = 36.*(xnu(lr)+2.0)*crcnw(mgs)*vr**2/((xnu(lr)+1.0)*pi**2) + ! DTD: If rain exists at a grid point already either use the alpha-preserving Z-rate eqn. (dmrauto == 1) + ! or a mass-weighted average of the alpha-preserving Z-rate eqn. and the init. rate eqn. (dmrauto == 2) + ! or the original initiation rate equation (dmrauto == 0). Not sure if this is the correct way to go but seems to work ok. + IF (qx(mgs,lr) .gt. qxmin(lr) .and. ( dmrauto == 1 .or. dmrauto ==2 ) ) THEN + tmp3 = qx(mgs,lr)/cx(mgs,lr) + tmp4 = g1x(mgs,lr)*(6.*rho0(mgs)/(pi*xdn(mgs,lr)))**2* & + & ( 2.*tmp3 * qrcnw(mgs) - tmp3**2 * crcnw(mgs) ) + if (imurain == 3) then + vr = rho0(mgs)*qrcnw(mgs)/(1000.) + tmp3 = 36.*(xnu(lc)+2.0)*vr**2/(crcnw(mgs)*(xnu(lc)+1.0)*pi**2) + else + tmp3 = galpharaut*(6.*rho0(mgs)*qrcnw(mgs)/(pi*xdn0(lr)))**2/crcnw(mgs) + endif + IF ( dmrauto == 1 ) THEN ! Preserve alpha + zrcnw(mgs) = tmp4 + ELSEIF ( dmrauto == 2 ) THEN ! Mass-weighted average + zrcnw(mgs) = (tmp3*qrcnw(mgs)+tmp4*qx(mgs,lr))/(qrcnw(mgs)+qx(mgs,lr)) + ENDIF + else ! original formulation + IF ( imurain == 3 ) THEN + vr = rho0(mgs)*qrcnw(mgs)/(1000.) ! crcnw(mgs) not divided here but is in next line, cancels one factor in the numerator + zrcnw(mgs) = 36.*(xnu(lc)+2.0)*vr**2/(crcnw(mgs)*(xnu(lc)+1.0)*pi**2) + ELSE ! rain in gamma of diameter + IF ( dmropt <= 1 .or. dmropt >= 4 .or. ( qx(mgs,lr) < qxmin(lr) .and. cx(mgs,lr) < cxmin ) ) THEN + zrcnw(mgs) = galpharaut*(6.*rho0(mgs)*qrcnw(mgs)/(pi*xdn0(lr)))**2/crcnw(mgs) + ELSE + tmp3 = qx(mgs,lr)/cx(mgs,lr) + zrcnw(mgs) = g1x(mgs,lr)*(6.*rho0(mgs)/(pi*xdn(mgs,lr)))**2* & + & ( 2.*tmp3 * qrcnw(mgs) - tmp3**2 * crcnw(mgs) ) + ENDIF +! vr = rho0(mgs)*qrcnw(mgs)/(1000.) ! crcnw(mgs) not divided here but is in next line, cancels one factor in the numerator +! zrcnw(mgs) = 36.*(xnu(lc)+2.0)*vr**2/(crcnw(mgs)*(xnu(lc)+1.0)*pi**2) + ENDIF + endif +! z = 36.*(alpha(mgs,lr)+2.0)*nrx*vr**2/((alpha(mgs,lr)+1.0)*pi**2) + ENDIF + ENDIF ! ipconc >= 6 ! IF ( crcnw(mgs) .gt. cautn(mgs) .and. crcnw(mgs) .gt. 1.0 ) ! : THEN ! write(0,*) 'crcnw,cautn ',crcnw(mgs)/cautn(mgs), @@ -14744,6 +17570,15 @@ subroutine nssl_2mom_gs & ELSE !{ + IF ( ipconc >= 6 .and. lzr > 1 ) THEN + ! interpolate along x, i.e., ratio; + tmp1 = ziacrratio(i,j) + delx*dqiacrratioinv*(ziacrratio(ip1,j) - ziacrratio(i,j)) + tmp2 = ziacrratio(i,jp1) + delx*dqiacrratioinv*(ziacrratio(ip1,jp1) - ziacrratio(i,jp1)) + + ! interpolate along alpha; + + zrfrz(mgs) = (tmp1 + dely*dqiacralphainv*(tmp2 - tmp1))*zx(mgs,lr)*dtpinv + ENDIF IF ( ibiggsmallrain > 0 .and. xv(mgs,lr) < 2.*xvmn(lr) .and. ( ibiggsnow == 1 .or. ibiggsnow == 3 ) ) THEN ! IF ( ibiggsmallrain > 0 .and. xv(mgs,lr) < xvbiggsnow .and. ( ibiggsnow == 1 .or. ibiggsnow == 3 ) ) THEN @@ -14753,6 +17588,10 @@ subroutine nssl_2mom_gs & crfrzs(mgs) = crfrz(mgs) qrfrzs(mgs) = qrfrz(mgs) + IF ( ipconc >= 6 .and. lzr > 1 ) THEN + zrfrzs(mgs) = zrfrz(mgs) + zrfrzf(mgs) = 0. + ENDIF ELSEIF ( dbigg < Max( biggsnowdiam, Max(dfrz,dhmn)) .and. ( ibiggsnow == 1 .or. ibiggsnow == 3 ) ) THEN ! { convert some to snow or ice crystals ! temporarily store qrfrz and crfrz in snow terms and caclulate new crfrzf, qrfrzf, and zrfrzf. Leave crfrz etc. alone! @@ -14764,6 +17603,10 @@ subroutine nssl_2mom_gs & crfrzf(mgs) = 0.0 qrfrzf(mgs) = 0.0 + IF (ipconc >= 6 .and. lzr > 1 ) THEN + zrfrzs(mgs) = zrfrz(mgs) + zrfrzf(mgs) = 0. + ENDIF ELSE !{ ! recalculate using dhmn for ratio @@ -14803,10 +17646,23 @@ subroutine nssl_2mom_gs & crfrzs(mgs) = crfrzs(mgs) - crfrzf(mgs) qrfrzs(mgs) = qrfrzs(mgs) - qrfrzf(mgs) + IF ( ipconc >= 6 .and. lzr > 1 ) THEN + zrfrzs(mgs) = zrfrz(mgs) + ! interpolate along x, i.e., ratio; + tmp1 = ziacrratio(i,j) + delx*dqiacrratioinv*(ziacrratio(ip1,j) - ziacrratio(i,j)) + tmp2 = ziacrratio(i,jp1) + delx*dqiacrratioinv*(ziacrratio(ip1,jp1) - ziacrratio(i,jp1)) + + ! interpolate along alpha; + + zrfrzf(mgs) = (tmp1 + dely*dqiacralphainv*(tmp2 - tmp1))*zx(mgs,lr)*dtpinv + zrfrzs(mgs) = zrfrzs(mgs) - zrfrzf(mgs) + zrfrzf(mgs) = (1000./900.)**2*zrfrzf(mgs) + ENDIF ENDIF ! } ELSE crfrzs(mgs) = 0.0 qrfrzs(mgs) = 0.0 + zrfrzs(mgs) = 0.0 ENDIF ! } ENDIF !} @@ -14819,6 +17675,10 @@ subroutine nssl_2mom_gs & crfrz(mgs) = fac*crfrz(mgs) crfrzs(mgs) = fac*crfrzs(mgs) crfrzf(mgs) = fac*crfrzf(mgs) + IF ( ipconc >= 6 .and. lzr > 1 ) THEN + zrfrz(mgs) = fac*zrfrz(mgs) + zrfrzf(mgs) = fac*zrfrzf(mgs) + ENDIF ENDIF ENDIF !} @@ -15363,8 +18223,16 @@ subroutine nssl_2mom_gs & x = 1. + alpha(mgs,lr) - IF ( lzr > 1 ) THEN ! 3 moment -! + IF ( ipconc >= 6 .and. lzr > 1 ) THEN ! 3 moment + tmp = 1. + alpr ! alpha(mgs,lr) + i = Int(dgami*(tmp)) + del = tmp - dgam*i + g1palp = gmoi(i) + (gmoi(i+1) - gmoi(i))*del*dgami + + tmp = 2.5 + alpha(mgs,lr) + 0.5*bx(lr) + i = Int(dgami*(tmp)) + del = tmp - dgam*i + y = (gmoi(i) + (gmoi(i+1) - gmoi(i))*del*dgami)/g1palp ! ratio of gamma functions ELSE y = ventrxn(mgs) ENDIF @@ -15380,6 +18248,13 @@ subroutine nssl_2mom_gs & & 0.308*fvent(mgs)*y* & & Sqrt(ax(lr)*rhovt(mgs))*(vent1/vent2) + rwventz(mgs) = 0.0 + +! rwventz(mgs) = & +! & 0.78*x + & +! & 0.308*fvent(mgs)*y* & +! & Sqrt(ax(lr)*rhovt(mgs))*(vent1/vent2) + ELSEIF ( iferwisventr == 2 ) THEN @@ -15392,6 +18267,23 @@ subroutine nssl_2mom_gs & & *(xdia(mgs,lr,1)**((1.0+br)/2.0)) ) + IF ( ipconc >= 7 ) THEN + alpr = Min(alpharmax,alpha(mgs,lr) ) + + tmp = alpr + 5.5 + br/2. + i = Int(dgami*(tmp)) + del = tmp - dgam*i + y = gmoi(i) + (gmoi(i+1) - gmoi(i))*del*dgami + +! rwventz(mgs) = & +! & 0.78*(4. + alpha(mgs,lr))*(3. + alpha(mgs,lr))*(2. + alpha(mgs,lr))*(1. + alpha(mgs,lr)) + & + rwventz(mgs) = & + & 0.78*(4. + alpr)*(3. + alpr)*(2. + alpr)*(1. + alpr) + & + & 0.308*fvent(mgs)* & + & Sqrt(ax(lr)*rhovt(mgs))*(y/gf1palp(mgs))*(xdia(mgs,lr,1)**((1.0+br)/2.0)) + + ENDIF + ENDIF ! iferwisventr @@ -15434,6 +18326,9 @@ subroutine nssl_2mom_gs & hwventa = (0.78)*gmoi(igmhwa) hwventb = (0.308)*gmoi(igmhwb) ! hwventc = (4.0*gr/(3.0*cdx(lh)))**(0.25) + hwvent(:) = 0.0 + hwventy(:) = 0.0 + do mgs = 1,ngscnt IF ( qx(mgs,lh) .gt. qxmin(lh) ) THEN hwventc = (4.0*gr/(3.0*cdxgs(mgs,lh)))**(0.25) @@ -15554,6 +18449,8 @@ subroutine nssl_2mom_gs & & -ftka(mgs)*temcg(mgs)/rho0(mgs) ) & & / (felf(mgs)) fmlt2(mgs) = -fcw(mgs)*temcg(mgs)/felf(mgs) + fmlt1e(mgs) = (2.0*pi)* & + & ( felv(mgs)*fwvdf(mgs)*(qss0(mgs)-qx(mgs,lv)) ) / (felf(mgs)) end do ! ! Vapor Deposition constants @@ -15581,6 +18478,7 @@ subroutine nssl_2mom_gs & qhlmlrlg(:) = 0.0 ENDIF qhfzh(:) = 0.0 + qffzf(:) = 0.0 qhlfzhl(:) = 0.0 qhfzhlg(:) = 0.0 qhlfzhllg(:) = 0.0 @@ -15588,9 +18486,10 @@ subroutine nssl_2mom_gs & vffzf(:) = 0.0 vhlfzhl(:) = 0.0 qsfzs(:) = 0.0 - zsmlr(:) = 0.0 +! zsmlr(:) = 0.0 zhmlr(:) = 0.0 zhmlrr(:) = 0.0 + zsmlrr(:) = 0.0 zhshr(:) = 0.0 zhlmlr(:) = 0.0 zhlshr(:) = 0.0 @@ -15642,7 +18541,7 @@ subroutine nssl_2mom_gs & qhmlr(mgs) = & & meltfac*min( & & fmlt1(mgs)*cx(mgs,lh)*hwvent(mgs)*xdia(mgs,lh,1) & - & + fmlt2(mgs)*(qhacrmlr(mgs)+qhacw(mgs)) & + & + fmlt2(mgs)*(qhacrmlr(mgs)+qhacwmlr(mgs)) & & , 0.0 ) ELSEIF ( ibinhmlr == 1 ) THEN ! use incomplete gamma functions to approximate the bin results @@ -15674,13 +18573,13 @@ subroutine nssl_2mom_gs & qhlmlr(mgs) = & & meltfac*min( & & fmlt1(mgs)*cx(mgs,lhl)*hlvent(mgs)*xdia(mgs,lhl,1) & - & + fmlt2(mgs)*(qhlacrmlr(mgs)+qhlacw(mgs)) & + & + fmlt2(mgs)*(qhlacrmlr(mgs)+qhlacwmlr(mgs)) & & , 0.0 ) ELSEIF ( ibinhlmlr == 1 ) THEN ! use incomplete gamma functions to approximate the bin results -! #ifdef Z3MOM -! #if (defined Z3MOM) && defined( COMMAS ) || defined( COMMASTMP ) +! #ifdef 1 +! #if (defined 1) && defined( COMMAS ) || defined( COMMASTMP ) ELSEIF ( ibinhlmlr == -1 ) THEN ! OLD VERSION use incomplete gamma functions to approximate the bin results @@ -15711,7 +18610,7 @@ subroutine nssl_2mom_gs & chmlr(mgs) = max( chmlr(mgs), Min( -chmxd(mgs), -0.95*cx(mgs,lh)*dtpinv ) ) ENDIF ! qhmlr(mgs) = max( max( qhmlr(mgs), -qhmxd(mgs) ) , -0.5*qx(mgs,lh)*dtpinv ) !limits to 1/2 qh or max depletion - qhmlh(mgs) = 0. + qhmlh(mgs) = 0. ! not used ! Rasmussen and Heymsfield say melt water remains on graupel up to 9 mm before shedding @@ -15788,8 +18687,15 @@ subroutine nssl_2mom_gs & ! ENDIF - IF ( chmlr(mgs) < 0.0 .and. (ibinhmlr < 1 .or. lzh < 1) ) THEN ! { already done if ibinhmlr > 0 + IF ( ipconc >= 6 .and. lzr .gt. 1 .and. lzh < 1 .and. qx(mgs,lh) > qxmin(lh) ) THEN ! Only compute if rain is 3-moment but graupel is not, otherwise is computed later + tmp = qx(mgs,lh)/cx(mgs,lh) + alp = alpha(mgs,lh) + g1 = g1x(mgs,lh) ! (6.0 + alp)*(5.0 + alp)*(4.0 + alp)/((3.0 + alp)*(2.0 + alp)*(1.0 + alp)) + + zhmlr(mgs) = g1*(6.*rho0(mgs)/(pi*xdn(mgs,lh)))**2*( 2.*tmp * qhmlr(mgs) - tmp**2 * chmlr(mgs) ) + + ENDIF IF ( ibinhmlr == 0 .or. lzh < 1 ) THEN IF ( ihmlt .eq. 1 ) THEN @@ -15895,6 +18801,17 @@ subroutine nssl_2mom_gs & ENDIF !} + IF ( ipconc >= 8 .and. lzhl .gt. 1 .and. ibinhlmlr <= 0 ) THEN + IF ( cx(mgs,lhl) > 0.0 ) THEN + + tmp = qx(mgs,lhl)/cx(mgs,lhl) + alp = alpha(mgs,lhl) +! g1 = (6.0 + alp)*(5.0 + alp)*(4.0 + alp)/((3.0 + alp)*(2.0 + alp)*(1.0 + alp)) + g1 = g1x(mgs,lhl) ! (6.0 + alp)*(5.0 + alp)*(4.0 + alp)/((3.0 + alp)*(2.0 + alp)*(1.0 + alp)) + + zhlmlr(mgs) = g1*(6.*rho0(mgs)/(pi*xdn(mgs,lhl)))**2*( tmp * qhlmlr(mgs) ) + ENDIF + ENDIF ENDIF ! } ENDIF ! }.not. mixedphase @@ -15932,6 +18849,7 @@ subroutine nssl_2mom_gs & ENDDO ! ! + qhdsv(:) = 0.0 qhldsv(:) = 0.0 do mgs = 1,ngscnt @@ -15941,6 +18859,7 @@ subroutine nssl_2mom_gs & & fvds(mgs)*cx(mgs,li)*civent(mgs)*cicap(mgs)*depfac qsdsv(mgs) = & & fvds(mgs)*cx(mgs,ls)*swvent(mgs)*swcap(mgs)*depfac + ! IF ( ny .eq. 2 .and. igs(mgs) .eq. 302 .and. temg(mgs) .le. tfrh+10 .and. qx(mgs,lv) .gt. qis(mgs) ! : .and. qx(mgs,li) .gt. qxmin(li) ) THEN ! write(0,*) 'qidsv = ',nstep,kgs(mgs),qidsv(mgs),temg(mgs)-tfrh,100.*(qx(mgs,lv)/qis(mgs) - 1.),1.e6*xdia(mgs,li,1), @@ -16177,20 +19096,41 @@ subroutine nssl_2mom_gs & ! end of qlimit + qhcev(:) = 0.0 + chcev(:) = 0.0 + qhlcev(:) = 0.0 + chlcev(:) = 0.0 + qfcev(:) = 0.0 + do mgs = 1,ngscnt qisbv(mgs) = 0.0 qssbv(mgs) = 0.0 qidpv(mgs) = 0.0 qsdpv(mgs) = 0.0 + qhsbv(mgs) = 0.0 + qscev(mgs) = 0.0 + cscev(mgs) = 0.0 IF ( icond .eq. 1 .or. temg(mgs) .le. tfrh & - & .or. (qx(mgs,lr) .le. qxmin(lr) .and. qx(mgs,lc) .le. qxmin(lc)) ) THEN + & .or. (qx(mgs,lr) .le. qxmin(lr) .and. qx(mgs,lc) .le. qxmin(lc)) ) THEN ! last condition (qr qxmin(lh) ) THEN + IF ( temg(mgs) < tfr .or. .not. qhmlr(mgs) < 0.0 ) THEN + ! no liquid from melting, so evaporation is greater. Thus can calculate sublimation rate qhsbv(mgs) = max( min(qhdsv(mgs), 0.0), -qhmxd(mgs) ) - qhdpv(mgs) = Max(qhdsv(mgs), 0.0) + ENDIF + + IF ( .true. .and. qhmlr(mgs) < 0.0 .and. .not. mixedphase ) THEN + ! Liquid is forming, so find the evaporation that was subtracted from melting (if it is not condensing) +! qhcev(mgs) = & +! & evapfac*min( & +! & fmlt1e(mgs)*cx(mgs,lh)*hwvent(mgs)*xdia(mgs,lh,1), 0.0 ) + + qhcev(mgs) = evapfac*2.0*pi*(qx(mgs,lv)-qss0(mgs))* & + & cx(mgs,lh)*xdia(mgs,lh,1)*hwvent(mgs)/(qss0(mgs)*(fav(mgs)+fbv(mgs))) + + qhcev(mgs) = max(qhcev(mgs), -qhmxd(mgs)) + IF ( temg(mgs) > tfr ) qhcev(mgs) = Min(0.0, qhcev(mgs) ) + + ENDIF + ENDIF qhlsbv(mgs) = 0.0 qhldpv(mgs) = 0.0 IF ( lhl .gt. 1 ) THEN + IF ( qx(mgs,lhl) > qxmin(lhl) ) THEN + IF ( temg(mgs) < tfr .or. .not. qhlmlr(mgs) < 0.0 ) THEN qhlsbv(mgs) = max( min(qhldsv(mgs), 0.0), -qxmxd(mgs,lhl) ) qhldpv(mgs) = Max(qhldsv(mgs), 0.0) + ENDIF + IF ( qhlmlr(mgs) < 0.0 .and. .not. mixedphase ) THEN + ! Liquid is forming, so find the evaporation that was subtracted from melting (if it is not condensing) + qhlcev(mgs) = evapfac*2.0*pi*(qx(mgs,lv)-qss0(mgs))* & + & cx(mgs,lhl)*xdia(mgs,lhl,1)*hlvent(mgs)/(qss0(mgs)*(fav(mgs)+fbv(mgs))) + + qhlcev(mgs) = max(qhlcev(mgs), -qhlmxd(mgs)) + IF ( temg(mgs) > tfr ) qhlcev(mgs) = Min(0.0, qhlcev(mgs) ) + + ENDIF + ENDIF ENDIF temp1 = qidpv(mgs) + qsdpv(mgs) + qhdpv(mgs) + qhldpv(mgs) @@ -16345,6 +19318,10 @@ subroutine nssl_2mom_gs & end if end do + + + + ! ! ! compute dry growth rate of snow, graupel, and hail @@ -16371,7 +19348,7 @@ subroutine nssl_2mom_gs & ! do mgs = 1,ngscnt - IF ( temg(mgs) < tfr ) THEN + IF ( tfrdry < temg(mgs) .and. temg(mgs) < tfr ) THEN ! ! qswet(mgs) = ! > ( xdia(mgs,ls,1)*swvent(mgs)*cx(mgs,ls)*fwet1(mgs) @@ -16382,31 +19359,39 @@ subroutine nssl_2mom_gs & ! IF ( dnu(lh) .ne. 0. ) THEN ! qhwet(mgs) = qhdry(mgs) ! ELSE + IF ( incwet == 0 ) THEN qhwet(mgs) = & & ( xdia(mgs,lh,1)*hwvent(mgs)*cx(mgs,lh)*fwet1(mgs) & & + fwet2(mgs)*(qhaci(mgs) + qhacs(mgs)) ) qhwet(mgs) = max( 0.0, qhwet(mgs)) + ELSE + ENDIF + ! ENDIF qhlwet(mgs) = 0.0 IF ( lhl .gt. 1 ) THEN - qhlwet(mgs) = & - & ( xdia(mgs,lhl,1)*hlvent(mgs)*cx(mgs,lhl)*fwet1(mgs) & - & + fwet2(mgs)*(qhlaci(mgs) + qhlacs(mgs)) ) - qhlwet(mgs) = max( 0.0, qhlwet(mgs)) + IF ( incwet == 0 ) THEN + qhlwet(mgs) = & + & ( xdia(mgs,lhl,1)*hlvent(mgs)*cx(mgs,lhl)*fwet1(mgs) & + & + fwet2(mgs)*(qhlaci(mgs) + qhlacs(mgs)) ) + qhlwet(mgs) = max( 0.0, qhlwet(mgs)) + + ELSE + ENDIF ! incwet ENDIF ELSE qhwet(mgs) = qhdry(mgs) qhlwet(mgs) = qhldry(mgs) - ENDIF ! ! qhlwet(mgs) = qhldry(mgs) end do + ! ! shedding rate ! @@ -16466,7 +19451,7 @@ subroutine nssl_2mom_gs & qhshr(mgs) = -qhdry(mgs) qhlshr(mgs) = -qhldry(mgs) ELSE ! new and correct - + ! note that the qxacr terms should be zero here, so shedding at T > 0 is all from the droplets qsshr(mgs) = - qsacr(mgs) - qsacw(mgs) ! -qsdry(mgs) qhlshr(mgs) = - qhlacw(mgs) - qhlacr(mgs) ! -qhldry(mgs) qhshr(mgs) = - qhacw(mgs) - qhacr(mgs) ! -qhdry(mgs) @@ -16802,7 +19787,93 @@ subroutine nssl_2mom_gs & ltest = xdia(mgs,lh,1)*(4. + alpha(mgs,lh)) > Abs( hlcnhdia ) ! test on mass-weighted diameter ENDIF - dg0(mgs) = -1. + IF ( iusedw == 0 .and. ihlcnh == 1 ) THEN + dg0(mgs) = -1. + ELSE + IF (((qhacw(mgs) + qhacr(mgs))*dtp > qxmin(lh) .and. qx(mgs,lh) > hlcnhqmin .and. temg(mgs) .le. tfr-2.0 & + .and. temg(mgs) .gt. dwtempmin ) .or. ( wetgrowth(mgs) .and. qx(mgs,lh) > hlcnhqmin ) ) THEN +! dw = 0.01*( Exp( -temcg(mgs)/( 1.1e4 * rho0(mgs)*ehw(mgs)*qx(mgs,lc) - 1.3e3*rho0(mgs)*qx(mgs,li) + 1.0 ) ) - 1.0 ) +! dwr = 0.01*( Exp( -temcg(mgs)/( 1.1e4 * rho0(mgs)*(ehw(mgs)*qx(mgs,lc)+ehr(mgs)*qx(mgs,lr)) - & +! 1.3e3*rho0(mgs)*qx(mgs,li) + 1.0 ) ) - 1.0 ) + x = 1.1e4 * rho0(mgs)*(ehw(mgs)*qx(mgs,lc)+ehr(mgs)*qx(mgs,lr)) - & + 1.3e3*rho0(mgs)*qx(mgs,li) + 1.0 + IF ( x > 1.e-20 ) THEN + arg = Min(70.0, (-temcg(mgs)/x )) ! prevent overflow of the exp function in 32 bit + dwr = 0.01*(exp(arg) - 1.0) + ELSE + dwr = 1.e30 + ENDIF + d = dwr + IF ( dwr < 0.2 .and. dwr > 0.0 .and. rho0(mgs)*(qx(mgs,lc)+qx(mgs,lr)) > 1.e-4 ) THEN + sqrtrhovt = Sqrt( rhovt(mgs) ) + fventh = sqrtrhovt*(fpndl(mgs)**(1./3.)) * (fakvisc(mgs))**(-0.5) + fventm = sqrtrhovt*(fschm(mgs)**(1./3.)) * (fakvisc(mgs))**(-0.5) + ltemq = (tfr-163.15)/fqsat+1.5 + qvs0 = pqs(mgs)*tabqvs(ltemq) + denomdp = felf(mgs) + fcw(mgs)*temcg(mgs) + denominvdp = 1.d0/(felf(mgs) + fcw(mgs)*temcg(mgs)) + +! write(91,*) 'dw,dwr,temcg = ',100.*dw,100.*dwr,temcg(mgs) + h1 = ( -ftka(mgs)*temcg(mgs) - felv(mgs)*fwvdf(mgs)*rho0(mgs)*(qx(mgs,lv) - qvs0) ) + h2 = ehi(mgs)*qx(mgs,li)*rho0(mgs)*fci(mgs)*temcg(mgs) + h3 = Max(dwehwmin, ehw(mgs))*qx(mgs,lc) + h4 = ehr(mgs)* qx(mgs,lr) + ! iterate to find minimum diameter for wet growth. Start with value of dwr + DO n = 1,10 + d = Max(d, 1.e-4) + dold = d + vth = axx(mgs,lh)*d**bxx(mgs,lh) + x2 = fventh*sqrtrhovt*Sqrt(d*vth) + IF ( x2 > 1.4 ) THEN + ah = 0.78 + 0.308*x2 ! heat ventillation + ELSE + ah = 1.0 + 0.108*x2**2 ! mass ventillation (Beard and Pruppacher 1971, eq. 9) + ENDIF + + IF ( .false. ) THEN ! this option includes 'am' separate from ah, which makes only small differences. Otherwise equivalent to second option + x1 = fventm*sqrtrhovt*Sqrt(d*vth) + IF ( x1 > 1.4 ) THEN + am = 0.78 + 0.308*x1 ! mass ventillation (Beard and Pruppacher 1971, eq. 8) + ELSE + am = 1.0 + 0.108*x1**2 ! mass ventillation (Beard and Pruppacher 1971, eq. 9) + ENDIF + + d = 8.*denominvdp*( am*felv(mgs)*fwvdf(mgs)*rho0(mgs)*(qvs0 - qx(mgs,lv)) - ah*ftka(mgs)*temcg(mgs) )/ & + (dtp* ( ( Max(0.001,vth - vtxbar(mgs,lc,1))*h3 + & + Max(0.001,vth - vtxbar(mgs,lr,1))*h4) *rho0(mgs) + & + Max(0.001,vth - vtxbar(mgs,li,1))*h2*denominvdp)) + + ELSE + + ! Based on Farley and Orville (1986), eq. 5-9 but neglecting the Ci*(T0-Ts) term in (8) since we want Ts=T0 + ! Simplified mass rates as dm_w/dt = pi/4*d**2*(Vh - Vc)*rhoair*qc*ehw, etc. + d = 8.*ah*h1/ & + ( ( Max(0.001,vth - vtxbar(mgs,lc,1))*h3 + & + Max(0.001,vth - vtxbar(mgs,lr,1))*h4) *rho0(mgs)*denomdp + & + Max(0.001,vth - vtxbar(mgs,li,1))*h2) + + ENDIF + IF ( Abs(dold - d)/dold < 0.05 .or. ( n > 3 .and. d > dg0thresh ) ) EXIT + + ENDDO + ENDIF + + dg0(mgs) = Min( dwmax, Max( d, dwmin ) ) + ELSE + IF ( qx(mgs,lh) > qxmin(lh) .and. qx(mgs,lh) > hlcnhqmin .and. temg(mgs) .le. tfr-2.0 ) THEN + dg0(mgs) = dwmax + ELSE + dg0(mgs) = dg0thresh + 0.0001 + ENDIF + ENDIF + + IF ( ihlcnh == 3 .and. (qhacw(mgs) + qhacr(mgs))*dtp > qxmin(lh) .and. qx(mgs,lh) > hlcnhqmin & + .and. temg(mgs) .le. tfr-2.0 ) THEN + ! set a secondary condition on to capture large graupel that is riming but not in wet growth + dg0(mgs) = Min( dg0(mgs), dg0thresh - 0.0001 ) + ENDIF + + ENDIF wtest = (dg0(mgs) > 0.0 .and. dg0(mgs) < dg0thresh ) @@ -16837,18 +19908,6 @@ subroutine nssl_2mom_gs & tmp = qhacw(mgs) + qhacr(mgs) + qhaci(mgs) + qhacs(mgs) ! qtmp = Min( 1.0, xdia(mgs,lh,3)/(2.0*dh0) )*(tmp) qtmp = Min( 100.0, xdia(mgs,lh,3)/(2.0*dh0) )*(tmp) -! IF ( .false. .and. qx(mgs,lhl) + qtmp*dtp .lt. 0.5e-3 ) THEN -! hdia1 = Max(dh0, xdia(mgs,lh,3) ) -! qtmp = qtmp + Min(qxmxd(mgs,lh), Max( 0.0, & -! & ((pi*xdn(mgs,lh)*cx(mgs,lh)) / (6.0*rho0(mgs)*dtp)) & -! & *exp(-hdia1/xdia(mgs,lh,1)) & -! & *( (hdia1**3) + 3.0*(hdia1**2)*xdia(mgs,lh,1) & -! & + 6.0*(hdia1)*(xdia(mgs,lh,1)**2) + 6.0*(xdia(mgs,lh,1)**3) ) ) ) - -! ENDIF - -! qhlcnh(mgs) = Min( 0.5*(qx(mgs,lh))+tmp, xdia(mgs,lh,3)/(2.0*dh0)*(tmp) ) -! qhlcnh(mgs) = Min( qxmxd(mgs,lh), xdia(mgs,lh,3)/(2.0*dh0)*(tmp) ) qhlcnh(mgs) = Min( qxmxd(mgs,lh), qtmp ) IF ( ipconc .ge. 5 ) THEN !{ @@ -16858,8 +19917,6 @@ subroutine nssl_2mom_gs & chlcnhhl(mgs) = Min( cxmxd(mgs,lh), rho0(mgs)*qhlcnh(mgs)/(pi*xdn(mgs,lh)*dh0**3/6.0) ) r = rho0(mgs)*qhlcnh(mgs)/(xdn(mgs,lh)*xv(mgs,lh)) ! number of graupel particles at mean volume diameter -! chlcnh(mgs) = Min( Max( 1./8.*r , chlcnh(mgs)), r ) -! chlcnh(mgs) = Min( chlcnh(mgs), r ) chlcnh(mgs) = Max( chlcnhhl(mgs), r ) ENDIF !} @@ -16874,12 +19931,119 @@ subroutine nssl_2mom_gs & ELSEIF ( ihlcnh == 3 ) THEN !{ + IF ( wtest .and. & + ( qhacw(mgs)*dtp > qxmin(lh) .and. temg(mgs) .lt. tfr-2. .and. qx(mgs,lh) > hlcnhqmin ) ) THEN + ! convert number, mass, and reflectivity for d > dw + IF ( ipconc == 5 ) THEN + ! dg0(mgs) = Min( dg0(mgs), hldia1 ) + !dg0(mgs) = hldia1 + ENDIF + + ratio = Min( maxratiolu, dg0(mgs)/xdia(mgs,lh,1) ) + + + ! mass + tmp2 = gaminterp(ratio,alpha(mgs,lh),4,1) + IF ( ipconc == 5 ) THEN + ! tmp2 = Min( 0.25, tmp2 ) + ENDIF + qxd1 = qx(mgs,lh)*(tmp2) + qhlcnh(mgs) = dtpinv*qxd1 + flim = 1.0 + tmp3 = qxmxd(mgs,lh) + IF (qxd1 > tmp3 ) THEN +! flim = tmp3/(qxd1) +! qhlcnh(mgs) = flim*qhlcnh(mgs) + ENDIF + + + + IF ( ( qxd1 > qxmin(lhl) .and. ipconc > 5 ) .or. ( qxd1 > 10.*qxmin(lhl) .and. ipconc == 5) ) THEN + + ! number + tmp = gaminterp(ratio,alpha(mgs,lh),1,1) + IF ( ipconc == 5 ) THEN + ! tmp = Min( 0.2, tmp ) + ENDIF + cxd1 = flim*cx(mgs,lh)*( tmp) + chlcnh(mgs) = dtpinv*cxd1 + chlcnhhl(mgs) = chlcnh(mgs) + + IF ( qx(mgs,lhl) > qxmin(lhl) .and. dmhlopt > 0 ) THEN + tmp = rho0(mgs)*qhlcnh(mgs)/chlcnhhl(mgs) + IF ( tmp < xmas(mgs,lhl) ) THEN + ! dh0 = ( qxd1*dh0 + qx(mgs,lhl)*xmas(mgs,lhl))/( qxd1 + qx(mgs,lhl)) ! weighted average + dh0 = (( qxd1*tmp**(1./3.) + qx(mgs,lhl)*xmas(mgs,lhl)**(1./3.))/( qxd1 + qx(mgs,lhl)))**3 ! weighted average + chlcnhhl(mgs) = Min( chlcnhhl(mgs), rho0(mgs)*qhlcnh(mgs)/dh0 ) + ELSE +! dh0 = Max( dh0, xmas(mgs,lhl) ) ! when enough hail is established, do not dilute the size + ENDIF + ENDIF + + + ! reflectivity + IF ( ipconc >= 6 .and. lzh > 1 .and. lzhl > 1 ) THEN + tmp3 = gaminterp(ratio,alpha(mgs,lh),11,1) + zxd1 = flim*zx(mgs,lh)*(tmp3) + zhlcnh(mgs) = dtpinv*zxd1 + ELSE + zxd1 = 0 + ENDIF + + ELSE + qhlcnh(mgs) = 0.0 + ENDIF + + vhlcnh(mgs) = rho0(mgs)*qhlcnh(mgs)/xdn(mgs,lh) + vhlcnhl(mgs) = rho0(mgs)*qhlcnh(mgs)/Max(xdnmn(lhl), xdn(mgs,lh)) + + ENDIF + + ENDIF !} ENDDO ELSEIF ( ihlcnh == 2 ) THEN ! 10-ice type conversion +! +! Staka and Mansell (2005) type conversion +! +! hldia1 is set in micro_module and namelist +! IF ( .true. ) THEN + + ! convert number, mass, and reflectivity for d > hldia1, + ! regardless of wet growth status, but as long as riming > 0 + DO mgs = 1,ngscnt + IF ( qhacw(mgs)*dtp > qxmin(lh) .and. temg(mgs) .lt. tfr-2. .and. qx(mgs,lh) > qxmin(lh) ) THEN + ratio = Min( maxratiolu, hldia1/xdia(mgs,lh,1) ) + + ! number + tmp = gaminterp(ratio,alpha(mgs,lh),1,1) + cxd1 = cx(mgs,lh)*( tmp) + chlcnh(mgs) = dtpinv*cxd1 + chlcnhhl(mgs) = chlcnh(mgs) + + ! mass + tmp2 = gaminterp(ratio,alpha(mgs,lh),4,1) + qxd1 = qx(mgs,lh)*(tmp2) + qhlcnh(mgs) = dtpinv*qxd1 + + ! reflectivity + IF ( lzh > 1 .and. lzhl > 1 ) THEN + tmp3 = gaminterp(ratio,alpha(mgs,lh),11,1) + zxd1 = zx(mgs,lh)*(tmp3) + zhlcnh(mgs) = dtpinv*zxd1 + ELSE + zxd1 = 0 + ENDIF + vhlcnh(mgs) = rho0(mgs)*qhlcnh(mgs)/xdn(mgs,lh) + vhlcnhl(mgs) = rho0(mgs)*qhlcnh(mgs)/Max(xdnmn(lhl), xdn(mgs,lh)) + + ENDIF + + ENDDO +! ENDIF ELSEIF ( ihlcnh == 0 ) THEN do mgs = 1,ngscnt @@ -17115,6 +20279,10 @@ subroutine nssl_2mom_gs & ciacrf(mgs) = qrzfac(mgs)*ciacrf(mgs) ciacrs(mgs) = qrzfac(mgs)*ciacrs(mgs) +! IF ( lzh .gt. 1 ) THEN +! zrfrzf(mgs) = 3.6476*rho0(mgs)**2*(alpha(mgs,lr)+2.)/(xdn0(lr)**2*(alpha(mgs,lr)+1.)) * & +! ( 2.*tmp * qrfrzf(mgs) - tmp**2 * crfrzf(mgs) ) +! ENDIF vrfrzf(mgs) = qrzfac(mgs)*vrfrzf(mgs) viacrf(mgs) = qrzfac(mgs)*viacrf(mgs) @@ -17154,7 +20322,13 @@ subroutine nssl_2mom_gs & IF ( qrcev(mgs) .lt. 0. .and. lnr > 1 ) THEN ! qrcev(mgs) = -qrmxd(mgs) ! crcev(mgs) = (rho0(mgs)/(xmas(mgs,lr)+1.e-20))*qrcev(mgs) - crcev(mgs) = (cx(mgs,lr)/(qx(mgs,lr)))*qrcev(mgs) + IF ( icrcev == 1 ) THEN + crcev(mgs) = (cx(mgs,lr)/(qx(mgs,lr)))*qrcev(mgs) + ELSEIF ( icrcev == 2 ) THEN + crcev(mgs) = (cx(mgs,lr)/(qx(mgs,lr)))*qrcev(mgs)*vtxbar(mgs,lr,2)/vtxbar(mgs,lr,1) + ELSE + crcev(mgs) = 0.0 + ENDIF ELSE crcev(mgs) = 0.0 ENDIF @@ -17166,12 +20340,6 @@ subroutine nssl_2mom_gs & ! ! evaporation/condensation of wet graupel and snow ! - qscev(:) = 0.0 - cscev(:) = 0.0 - qhcev(:) = 0.0 - chcev(:) = 0.0 - qhlcev(:) = 0.0 - chlcev(:) = 0.0 IF ( lhwlg > 1 ) THEN qhcevlg(:) = 0.0 chcevlg(:) = 0.0 @@ -17181,6 +20349,7 @@ subroutine nssl_2mom_gs & chlcevlg(:) = 0.0 ENDIF + ! ! ! @@ -18128,6 +21297,14 @@ subroutine nssl_2mom_gs & pqlwlghld(:) = 0.0 pqlwhli(:) = 0.0 pqlwhld(:) = 0.0 + IF ( ipconc > 5 ) THEN + pzhwi(:) = 0.0 + pzhwd(:) = 0.0 + pzrwi(:) = 0.0 + pzrwd(:) = 0.0 + pzhli(:) = 0.0 + pzhld(:) = 0.0 + ENDIF ! @@ -18366,7 +21543,8 @@ subroutine nssl_2mom_gs & qrcev(mgs) = frac*qrcev(mgs) qhlacr(mgs) = frac*qhlacr(mgs) vhlacr(mgs) = frac*vhlacr(mgs) -! qhcev(mgs) = frac*qhcev(mgs) + qhcev(mgs) = frac*qhcev(mgs) + qhlcev(mgs) = frac*qhlcev(mgs) IF ( warmonly < 0.5 ) THEN @@ -18412,6 +21590,8 @@ subroutine nssl_2mom_gs & ! STOP ENDIF + + end do IF ( warmonly < 0.5 ) THEN @@ -18440,7 +21620,7 @@ subroutine nssl_2mom_gs & & -qhcns(mgs) & & +(1-il5(mgs))*qsmlr(mgs) + qsshr(mgs) & !null at this point when wet snow included ! > +il5(mgs)*(qssbv(mgs)) & - & + (qssbv(mgs)) & + & + qssbv(mgs) & & + Min(0.0, qscev(mgs)) & & -qsmul(mgs) @@ -18555,53 +21735,634 @@ subroutine nssl_2mom_gs & & +(1-il5(mgs))*qhmlr(mgs) !null at this point when wet graupel included end do -! -! Hail -! - IF ( lhl .gt. 1 ) THEN +! +! Hail +! + IF ( lhl .gt. 1 ) THEN + + do mgs = 1,ngscnt + pqhli(mgs) = & + & +il5(mgs)*(qhldpv(mgs) ) & ! + (1.0-ifrzg)*(qiacrf(mgs)+qrfrzf(mgs) + qracif(mgs))) & + & +il5(mgs)*(1.0-ifrzg)*(qrfrzf(mgs) ) & + & +qhlacr(mgs)+qhlacw(mgs) & +! & +qhlacs(mgs)+qhlaci(mgs) & + & + qhlcnh(mgs) + pqhld(mgs) = & + & qhlshr(mgs) & + & +(1-il5(mgs))*qhlmlr(mgs) & +! > +il5(mgs)*qhlsbv(mgs) & + & + qhlsbv(mgs) & + & -qhlmul1(mgs) - qhcnhl(mgs) + + end do + + ENDIF ! lhl + + ENDIF ! warmonly + +! +! Liquid water on snow and graupel +! + + vhmlr(:) = 0.0 + vhlmlr(:) = 0.0 + vhfzh(:) = 0.0 + vhlfzhl(:) = 0.0 + + IF ( mixedphase ) THEN + ELSE ! set arrays for non-mixedphase graupel + +! vhshdr(:) = 0.0 + vhmlr(:) = qhmlr(:) ! not actually volume, but treated as q in rate equation +! vhsoak(:) = 0.0 + +! vhlshdr(:) = 0.0 + vhlmlr(:) = qhlmlr(:) ! not actually volume, but treated as q in rate equation +! vhlmlr(:) = rho0(:)*qhlmlr(:)/xdn(:,lhl) +! vhlsoak(:) = 0.0 + + ENDIF ! mixedphase + + + +! +! Graupel reflectivity +! + if (ndebug .gt. 0 .and. my_rank>=0 ) write(0,*) my_rank, 'graupel reflectivity' + + do mgs = 1,ngscnt + +! zhmlr(mgs) = 0.0 +! zhshr(mgs) = 0.0 +! zhmlrr(mgs) = 0.0 +! zhshrr(mgs) = 0.0 + zhdsv(mgs) = 0.0 +! IF ( lf < 1 ) THEN + IF ( ffrzh > 0.0 ) THEN + ziacr(mgs) = 0.0 + ziacrf(mgs) = 0.0 + ENDIF +! ENDIF + zhcns(mgs) = 0.0 + zhcni(mgs) = 0.0 + zhacs(mgs) = 0.0 + zhaci(mgs) = 0.0 + + ENDDO + + IF ( lzh .gt. 1 ) THEN ! + do mgs = 1,ngscnt + + + IF ( qx(mgs,lh) .gt. qxmin(lh) .and. cx(mgs,lh) .gt. 0.0 ) THEN + tmp = qx(mgs,lh)/cx(mgs,lh) + alp = Max( alphamin, alpha(mgs,lh) ) +! g1 = (6.0 + alp)*(5.0 + alp)*(4.0 + alp)/((3.0 + alp)*(2.0 + alp)*(1.0 + alp)) + g1 = g1x(mgs,lh) ! (6.0 + alp)*(5.0 + alp)*(4.0 + alp)/((3.0 + alp)*(2.0 + alp)*(1.0 + alp)) +! g1r = 36.*(alpha(mgs,lr)+2.0)/((alpha(mgs,lr)+1.0)*pi**2) + + zhaci(mgs) = g1*(6.*rho0(mgs)/(pi*xdn(mgs,lh)))**2*( 2.*( tmp ) * qhaci(mgs) ) + zhacs(mgs) = g1*(6.*rho0(mgs)/(pi*xdn(mgs,lh)))**2*( 2.*( tmp ) * qhacs(mgs) ) + + IF ( .not. mixedphase .and. ibinhmlr < 1 ) THEN + zhmlr(mgs) = g1*(6.*rho0(mgs)/(pi*xdn(mgs,lh)))**2*( 2.*tmp * qhmlr(mgs) - tmp**2 * chmlr(mgs) ) + ENDIF + + zhshr(mgs) = g1*(6.*rho0(mgs)/(pi*xdn(mgs,lh)))**2*( 2.*tmp * qhshr(mgs) - tmp**2 * chshr(mgs) ) + +! IF ( lzr > 0 .and. qhshr(mgs) /= 0.0 .and. chshrr(mgs) /= 0.0 .and. ibinhmlr < 1 ) THEN + IF ( lzr > 0 .and. qhshr(mgs) /= 0.0 .and. chshrr(mgs) /= 0.0 ) THEN +! IF ( temg(mgs) > tfr + 2.0 ) THEN +! zhshrr(mgs) = g1*(6.*rho0(mgs)/(pi*xdn(mgs,lr)))**2*( 2.*tmp * qhshr(mgs) - tmp**2 * chshrr(mgs) ) +! IF ( zhshrr(mgs) > 0. ) THEN +! zhshrr(mgs) = g1*(6.*rho0(mgs)/(pi*xdn(mgs,lr)))**2*( 2.*tmp * qhshr(mgs) - tmp**2 * chshr(mgs) ) +! ENDIF +! z1 = g1shr*(6.*rho0(mgs)/(pi*xdn(mgs,lr)))**2*( qhshr(mgs)**2/ chshrr(mgs) ) ! should this be g1shr? +! zhshrr(mgs) = Max( z1, zhshrr(mgs)) +! ELSE +! zhshrr(mgs) = g1shr*(6.*rho0(mgs)/(pi*xdn(mgs,lr)))**2*( qhshr(mgs)**2/ chshrr(mgs) ) + + + IF ( temg(mgs) >= tfr ) THEN + ! zhshrr(mgs) = g1*(6.*rho0(mgs)/(pi*xdn0(lr)))**2*( 2.*tmp * qhshr(mgs) - tmp**2 * chshrr(mgs) ) + ! IF ( zhshrr(mgs) > 0.0 ) THEN + ! zhshrr(mgs) = g1*(6.*rho0(mgs)/(pi*xdn0(lr)))**2*( 2.*tmp * qhshr(mgs) - tmp**2 * chshr(mgs) ) + ! ENDIF + IF ( (shedalp + alpha(mgs,lh))*xdia(mgs,lh,1) < sheddiam ) THEN ! if not shedding small drops, then use alpha of hail + z1 = g1*(6.0*rho0(mgs)/(pi*xdn(mgs,lr)))**2*( qhshr(mgs)**2/ chshrr(mgs) ) + ELSE + z1 = g1shr*(6.0*rho0(mgs)/(pi*xdn(mgs,lr)))**2*( qhshr(mgs)**2/ chshrr(mgs) ) ! should this be g1shr? + ENDIF + zhshrr(mgs) = z1 +! z1 = g1mlr*(rho0(mgs)/(xdn(mgs,lr)))**2*( qhshr(mgs)**2/ chshrr(mgs) ) ! should this be g1shr? +! zhshrr(mgs) = Max( z1, zhshrr(mgs)) + ELSE + zhshrr(mgs) = g1shr*(6.*rho0(mgs)/(pi*xdn(mgs,lr)))**2*( qhshr(mgs)**2/ chshrr(mgs) ) + ENDIF + + zhshrr(mgs) = Min( 0.0, zhshrr(mgs) ) + ENDIF + + IF ( zhshr(mgs) > 0.0 ) THEN + write(0,*) 'Problem with zhshr! zhshr,qhshr,chshr = ',zhshr(mgs),qhshr(mgs),chshr(mgs) + write(0,*) 'g1,tmp, qx,cx,zx = ',g1,tmp,qx(mgs,lh),cx(mgs,lh),zx(mgs,lh) + write(0,*) ( 2.*tmp * qhshr(mgs) - tmp**2 * chshr(mgs) ), 2.*tmp * qhshr(mgs), - tmp**2 * chshr(mgs) + write(0,*) 'temcg = ',temcg(mgs),'chshr recalc = ',(cx(mgs,lh)/(qx(mgs,lh)+1.e-20))*qhshr(mgs) + + STOP + ENDIF + + +! zhshr(mgs) = (xdn0(lr)/(xdn(mgs,lh)))**2*( zx(mgs,lh) * qhshr(mgs) ) + + qtmp = qhdpv(mgs) + qhcev(mgs) + qhsbv(mgs) + ctmp = chdpv(mgs) + chcev(mgs) + chsbv(mgs) + + zhdsv(mgs) = g1*(6.*rho0(mgs)/(pi*xdn(mgs,lh)))**2*( 2.*( tmp ) * qtmp - tmp**2 * ctmp ) + + alp = Max( alphahacx, alpha(mgs,lh) ) +! g1 = (6.0 + alp)*(5.0 + alp)*(4.0 + alp)/((3.0 + alp)*(2.0 + alp)*(1.0 + alp)) + g1 = g1x(mgs,lh) ! (6.0 + alp)*(5.0 + alp)*(4.0 + alp)/((3.0 + alp)*(2.0 + alp)*(1.0 + alp)) + + IF ( .true. ) THEN ! { + IF ( qhacr(mgs) .gt. 0.0 ) THEN +! zhacr(mgs) = g1*(6.*rho0(mgs)/(pi*1000.))**2*( 2.*( qx(mgs,lh)/cx(mgs,lh)) * qhacr(mgs) ) + +! g1r = 36.*(alpha(mgs,lr)+2.0)/((alpha(mgs,lr)+1.0)*pi**2) +! zhacr(mgs) = g1*(6.*rho0(mgs)/(pi*xdn(mgs,lh)))**2*( 2.*( qx(mgs,lh)/cx(mgs,lh)) * qhacr(mgs) ) + zhacr(mgs) = g1*(6.*rho0(mgs)/(pi*xdn(mgs,lh)))**2*( 2.*( qx(mgs,lh)/cx(mgs,lh)) * qhacr(mgs) ) +! zhacrf(mgs) = g1*zhacr + + +! z = g1*(6.*rho0(mgs)/(pi*1000.))**2*( (qx(mgs,lh)+dtp*qhacr(mgs))**2)/(cx(mgs,lh)) + + IF ( z > zx(mgs,lh) ) THEN +! zhacr(mgs) = (z - zx(mgs,lh))*dtpinv + ELSE +! zhacr(mgs) = 0.0 + ENDIF + ENDIF + +! zhacr(mgs) = g1*(6.*rho0(mgs)/(pi*1000.))**2*( 2.*( tmp ) * qhacr(mgs) ) +! zhacr(mgs) = g1*(6.*rho0(mgs)/(pi*1000.))**2*( 2.*( tmp ) * qhacr(mgs) - tmp**2 * chacr(mgs) ) + +! alp = Max( 1.0, alpha(mgs,lh)+1. ) +! g1 = (6.0 + alp)*(5.0 + alp)*(4.0 + alp)/ +! : ((3.0 + alp)*(2.0 + alp)*(1.0 + alp)) + IF ( qhacw(mgs) .gt. 0.0 ) THEN +! zhacw(mgs) = g1*(6.*rho0(mgs)/(pi*1000.))**2*( 2.*( qx(mgs,lh)/cx(mgs,lh)) * qhacw(mgs) ) + zhacw(mgs) = g1*(6.*rho0(mgs)/(pi*xdn(mgs,lh)))**2*( 2.*( qx(mgs,lh)/cx(mgs,lh)) * qhacw(mgs) ) + +! z = g1*(6.*rho0(mgs)/(pi*1000.))**2*( (qx(mgs,lh)+dtp*(qhacw(mgs)-qhmul1(mgs)))**2)/(cx(mgs,lh)) + IF ( z > zx(mgs,lh) ) THEN +! zhacw(mgs) = (z - zx(mgs,lh))*dtpinv + ENDIF + ENDIF + + ELSE ! } { ! this is not used because of the 'true' above + + IF ( qhacw(mgs) .gt. 0.0 .or. qhacr(mgs) .gt. 0.0 ) THEN + z = g1*(6.*rho0(mgs)/(pi*1000.))**2*( (qx(mgs,lh)+dtp*(qhacr(mgs) + qhacw(mgs)-qhmul1(mgs)))**2)/(cx(mgs,lh)) +! zhacw(mgs) = g1*(6.*rho0(mgs)/(pi*1000.))**2*( 2.*( qx(mgs,lh)/cx(mgs,lh)) * qhacw(mgs) ) + IF ( z > zx(mgs,lh) ) THEN + zhacw(mgs) = (z - zx(mgs,lh))*dtpinv + ENDIF + ENDIF + + ENDIF ! } + + IF ( qhlcnh(mgs) .gt. 0.0 .and. ihlcnh < 2 ) THEN + zhlcnh(mgs) = g1*(6.*rho0(mgs)/(pi*xdn(mgs,lh)))**2*( 2.*( tmp ) * qhlcnh(mgs) - tmp**2 * chlcnh(mgs) ) + ENDIF + ENDIF +! qsplinter(mgs) + IF ( ffrzh*qiacrf(mgs) .gt. 0.0 .and. cx(mgs,lr) .gt. 0.0 .and. qx(mgs,lr) .gt. qxmin(lr) ) THEN + tmp = qx(mgs,lr)/cx(mgs,lr) +! alp = 3.0 +! g1 = (6.0 + alp)*(5.0 + alp)*(4.0 + alp)/((3.0 + alp)*(2.0 + alp)*(1.0 + alp)) + IF ( imurain == 3 ) THEN + ! note that 3.6476 = (6/pi)**2 + ziacr(mgs) = 3.6476*rho0(mgs)**2*(alpha(mgs,lr)+2.)/(xdn0(lr)**2*(alpha(mgs,lr)+1.))* & + & ( 2.*tmp * qiacrf(mgs) - tmp**2 * ciacrf(mgs) ) + ELSE ! imurain == 1 + ziacr(mgs) = 3.6476*rho0(mgs)**2*g1x(mgs,lr)/(xdn0(lr)**2)* & + & ( 2.*tmp * qiacrf(mgs) - tmp**2 * ciacrf(mgs) ) + ENDIF + ziacr(mgs) = Min( ziacr(mgs), zxmxd(mgs,lr) ) +! ziacrf(mgs) = (xdn(mgs,lr)/xdn(mgs,lh))**2 * ziacr(mgs) + ziacrf(mgs) = (xdn(mgs,lr)/xdnmx(lh))**2 * ziacr(mgs) +! z = g1*(6.*rho0(mgs)/(pi*1000.))**2*( 2.*tmp * (qiacrf(mgs) - qsplinter(mgs)) - tmp**2 * ciacrf(mgs) ) +! ziacrf(mgs) = Min( ziacrf(mgs), z ) + ENDIF + + + + IF ( ffrzh*qrfrzf(mgs) .gt. 0.0 .and. cx(mgs,lr) .gt. 0.0 ) THEN + tmp = qx(mgs,lr)/cx(mgs,lr) +! alp = 3.0 +! g1 = (6.0 + alp)*(5.0 + alp)*(4.0 + alp)/((3.0 + alp)*(2.0 + alp)*(1.0 + alp)) + IF ( imurain == 3 ) THEN + zrfrz(mgs) = 3.6476*rho0(mgs)**2*(alpha(mgs,lr)+2.)/(xdn0(lr)**2*(alpha(mgs,lr)+1.)) * & + & ( 2.*tmp * qrfrzf(mgs) - tmp**2 * crfrzf(mgs) ) + zrfrzf(mgs) = (xdn(mgs,lr)/xdn(mgs,lh))**2 * zrfrz(mgs) + ELSEIF ( imurain == 1 .and. ibiggopt /= 2 ) THEN +! zrfrz(mgs) = 3.6476*rho0(mgs)**2*g1x(mgs,lr)/(xdn0(lr)**2) * & +! & ( 2.*tmp * qrfrzf(mgs) - tmp**2 * crfrz(mgs) ) + zrfrz(mgs) = 3.6476*rho0(mgs)**2*g1x(mgs,lr)/(xdn0(lr)**2) * & + & ( 2.*tmp * qrfrz(mgs) - tmp**2 * crfrz(mgs) ) + zrfrzf(mgs) = 3.6476*rho0(mgs)**2*g1x(mgs,lr)/(rhofrz**2) * & + & ( 2.*tmp * qrfrzf(mgs) - tmp**2 * crfrzf(mgs) ) + ENDIF + zrfrz(mgs) = Min( zrfrz(mgs), Max(0.4,qrfrz(mgs)/qx(mgs,lr))*zx(mgs,lr)*dtpinv ) +! zrfrzf(mgs) = (xdn(mgs,lr)/xdn(mgs,lh))**2 * zrfrz(mgs) +! zrfrzf(mgs) = (xdn(mgs,lr)/xdnmx(lh))**2 * zrfrz(mgs) +! z = g1*(6.*rho0(mgs)/(pi*1000.))**2*( 2.*tmp * (qrfrzf(mgs)-qsplinter2(mgs)) - tmp**2 * crfrzf(mgs) ) +! zrfrzf(mgs) = Min( zrfrzf(mgs), z ) + ! change this to be alpha=0? + ENDIF + + IF ( lhl > 1 .and. qhcnhl(mgs) .gt. 0.0 ) THEN + tmp = qx(mgs,lhl)/cx(mgs,lhl) + zhcnhl(mgs) = g1x(mgs,lhl)*(6.*rho0(mgs)/(pi*xdn(mgs,lhl)))**2*( 2.*( tmp ) * qhcnhl(mgs) - tmp**2 * chcnhl(mgs) ) + + ENDIF + + IF ( qhcns(mgs) > 0.0 .and. chcns(mgs) > 0.0 .and. cx(mgs,ls) > cxmin .and. vhcns(mgs) > 0 ) THEN + tmp = qx(mgs,ls)/cx(mgs,ls) + r = rho0(mgs)*qhcns(mgs)/vhcns(mgs) ! density of new graupel particles + IF ( imusnow == 3 ) THEN + zhcns(mgs) = 3.6476*rho0(mgs)**2*(alpha(mgs,ls)+2.)/(r**2*(alpha(mgs,ls)+1.)) * & + & ( 2.*tmp * qhcns(mgs) - tmp**2 * chcns(mgs) ) + ELSE + write(0,*) 'Value of imusnow not valid. Must be 3 (fix me for =1). imusnow = ',imusnow + STOP + ENDIF + ENDIF + + IF ( qhcni(mgs) > 0.0 .and. chcni(mgs) > 0.0 .and. cx(mgs,li) > cxmin .and. vhcni(mgs) > 0 ) THEN + tmp = qx(mgs,li)/cx(mgs,li) + r = rho0(mgs)*qhcni(mgs)/vhcni(mgs) ! density of new graupel particles + zhcni(mgs) = 3.6476*rho0(mgs)**2*(alpha(mgs,li)+2.)/(r**2*(alpha(mgs,li)+1.)) * & + & ( 2.*tmp * qhcni(mgs) - tmp**2 * chcni(mgs) ) + ENDIF + + + pzhwi(mgs) = & + & +ifrzg*ffrzh*(zrfrzf(mgs) & + & +il5(mgs)*ifiacrg*(ziacrf(mgs) ) ) & +! : + zhcnsh(mgs) + zhcnih(mgs) & + & + zhacw(mgs) & + & + zhacr(mgs) & + & + zhcnhl(mgs) & + & + zhacs(mgs) & + & + zhaci(mgs) & + & + f2h*zhcni(mgs) + f2h*zhcns(mgs) & + & + Max( 0.0, zhdsv(mgs) ) + + pzhwd(mgs) = 0.0 & + & + (1-il5(mgs))*zhmlr(mgs) & + & + zhshr(mgs) & + & + Min( 0.0, zhdsv(mgs) ) & + & - il5(mgs)*zhlcnh(mgs) + + + IF ( igs(mgs) == 44 .and. kgs(mgs) == 23 .or. dtp*( pqhwi(mgs) + pqhwd(mgs) ) > qxmin(lh) ) THEN +! write(0,*) 'i,k,time = ',igs(mgs),kgs(mgs),time_real +! write(0,*) 'pzhwi,d = ',pzhwi(mgs),pzhwd(mgs),dtp*( pzhwi(mgs) + pzhwd(mgs) ),zx(mgs,lh) +! write(0,*) 'pqhwi,d = ',pqhwi(mgs),pqhwd(mgs),dtp*( pqhwi(mgs) + pqhwd(mgs) ),qx(mgs,lh) +! write(0,*) 'pchwi,d = ',pchwi(mgs),pchwd(mgs),dtp*( pchwi(mgs) + pchwd(mgs) ),cx(mgs,lh) + ENDIF + + +! IF ( zhcnhl(mgs) < 0.0 ) THEN +! write(0,*) 'Problem with zhcnhl! zhcnhl,qhcnhl,chcnhl = ',zhcnhl(mgs),qhcnhl(mgs),chcnhl(mgs) +! write(0,*) 'g1,tmp = ',g1x(mgs,lhl),tmp +! write(0,*) ( 2.*( tmp ) * qhcnhl(mgs) - tmp**2 * chcnhl(mgs) ) +! +!! STOP +! ENDIF + end do + + if (ndebug .gt. 0 .and. my_rank>=0 ) write(0,*) my_rank, 'end graupel reflectivity' + + ENDIF + +! +! Hail reflectivity +! + + do mgs = 1,ngscnt + + zhldsv(mgs) = 0.0 + zhlacr(mgs) = 0.0 + zhlacw(mgs) = 0.0 + + ENDDO + + IF ( lzhl .gt. 1 .or. ( lzr > 1 .and. lnhl > 1 ) ) THEN ! also run for 2-moment hail for 3-moment rain sources + + if (ndebug .gt. 0 .and. my_rank>=0 ) write(0,*) my_rank, 'hail reflectivity' + + do mgs = 1,ngscnt + + IF ( qx(mgs,lhl) .gt. qxmin(lhl) .and. cx(mgs,lhl) .gt. 0.0 ) THEN + tmp = qx(mgs,lhl)/cx(mgs,lhl) + alp = Max( alphamin, alpha(mgs,lhl) ) +! g1 = (6.0 + alp)*(5.0 + alp)*(4.0 + alp)/((3.0 + alp)*(2.0 + alp)*(1.0 + alp)) + g1 = g1x(mgs,lhl) ! (6.0 + alp)*(5.0 + alp)*(4.0 + alp)/((3.0 + alp)*(2.0 + alp)*(1.0 + alp)) + + IF ( .not. mixedphase .and. qhlmlr(mgs) /= 0.0 .and. chlmlr(mgs) /= 0.0 .and. ibinhlmlr < 1 ) THEN + zhlmlr(mgs) = g1*(6.*rho0(mgs)/(pi*xdn(mgs,lhl)))**2*( 2.*tmp * qhlmlr(mgs) - tmp**2 * chlmlr(mgs) ) + ENDIF + + zhlshr(mgs) = g1*(6.*rho0(mgs)/(pi*xdn(mgs,lhl)))**2*( 2.*tmp * qhlshr(mgs) - tmp**2 * chlshr(mgs) ) + IF ( lzr > 1 .and. qhlshr(mgs) /= 0.0 .and. chlshrr(mgs) /= 0.0 ) THEN + IF ( temg(mgs) >= tfr ) THEN + ! zhlshrr(mgs) = g1*(6.*rho0(mgs)/(pi*xdn0(lr)))**2*( 2.*tmp * qhlshr(mgs) - tmp**2 * chlshrr(mgs) ) + ! IF ( zhlshrr(mgs) > 0.0 ) THEN + ! zhlshrr(mgs) = g1*(6.*rho0(mgs)/(pi*xdn0(lr)))**2*( 2.*tmp * qhlshr(mgs) - tmp**2 * chlshr(mgs) ) + ! ENDIF + IF ( (shedalp + alpha(mgs,lhl))*xdia(mgs,lhl,1) < sheddiam ) THEN ! if not shedding small drops, then use alpha of hail + z1 = g1*(6.0*rho0(mgs)/(pi*xdn(mgs,lr)))**2*( qhlshr(mgs)**2/ chlshrr(mgs) ) + ELSE + z1 = g1shr*(6.0*rho0(mgs)/(pi*xdn(mgs,lr)))**2*( qhlshr(mgs)**2/ chlshrr(mgs) ) ! should this be g1shr? + ENDIF + zhlshrr(mgs) = z1 +! z1 = g1mlr*(rho0(mgs)/(xdn(mgs,lr)))**2*( qhlshr(mgs)**2/ chlshrr(mgs) ) ! should this be g1shr? +! zhlshrr(mgs) = Max( z1, zhlshrr(mgs)) + ELSE + zhlshrr(mgs) = g1shr*(6.*rho0(mgs)/(pi*xdn(mgs,lr)))**2*( qhlshr(mgs)**2/ chlshrr(mgs) ) + ENDIF + + zhlshrr(mgs) = Min( 0.0, zhlshrr(mgs) ) + ENDIF + + IF ( zhlshr(mgs) > 0.0 ) THEN + write(0,*) 'Problem with zhlshr! zhlshr,qhlshr,chlshr = ',zhlshr(mgs),qhlshr(mgs),chlshr(mgs) + write(0,*) 'g1,tmp, qx,cx,zx = ',g1,tmp,qx(mgs,lhl),cx(mgs,lhl),zx(mgs,lhl) + write(0,*) ( 2.*tmp * qhlshr(mgs) - tmp**2 * chlshr(mgs) ), 2.*tmp * qhlshr(mgs), - tmp**2 * chlshr(mgs) + write(0,*) 'temcg = ',temcg(mgs),'chlshr recalc = ',(cx(mgs,lhl)/(qx(mgs,lhl)+1.e-20))*qhlshr(mgs) + + STOP + ENDIF +! zhlshr(mgs) = Min( 0.0, zhlshr(mgs) ) + +! zhlshr(mgs) = (xdn0(lr)/(xdn(mgs,lhl)))**2*( zx(mgs,lhl) * qhlshr(mgs) ) + + qtmp = qhldpv(mgs) + qhlcev(mgs) + ctmp = chldpv(mgs) + chlcev(mgs) + + zhldsv(mgs) = g1*(6.*rho0(mgs)/(pi*xdn(mgs,lhl)))**2*( 2.*( tmp ) * qtmp - tmp**2 * ctmp ) + + alp = Max( alphahacx, alpha(mgs,lhl) ) +! g1 = (6.0 + alp)*(5.0 + alp)*(4.0 + alp)/((3.0 + alp)*(2.0 + alp)*(1.0 + alp)) + g1 = g1x(mgs,lhl) ! (6.0 + alp)*(5.0 + alp)*(4.0 + alp)/((3.0 + alp)*(2.0 + alp)*(1.0 + alp)) + + IF ( .true. ) THEN ! { + IF ( qhlacr(mgs) .gt. 0.0 ) THEN +! z = g1*(6.*rho0(mgs)/(pi*1000.))**2*( (qx(mgs,lhl)+dtp*qhlacr(mgs))**2)/(cx(mgs,lhl)) + zhlacr(mgs) = g1*(6.*rho0(mgs)/(pi*xdn(mgs,lhl)))**2*( 2.*( tmp ) * qhlacr(mgs) ) +! zhlacr(mgs) = Min( zxmxd(mgs,lr), zhlacr(mgs) ) + +! IF ( z > zx(mgs,lhl) ) THEN +! zhlacr(mgs) = (z - zx(mgs,lhl))*dtpinv +! ELSE +! zhlacr(mgs) = 0.0 +! ENDIF + ENDIF + +! zhacr(mgs) = g1*(6.*rho0(mgs)/(pi*1000.))**2*( 2.*( tmp ) * qhacr(mgs) ) +! zhacr(mgs) = g1*(6.*rho0(mgs)/(pi*1000.))**2*( 2.*( tmp ) * qhacr(mgs) - tmp**2 * chacr(mgs) ) + + IF ( qhlacw(mgs) .gt. 0.0 ) THEN + alp = Max( 3.0, alpha(mgs,lhl)+1. ) + g1 = (6.0 + alp)*(5.0 + alp)*(4.0 + alp)/((3.0 + alp)*(2.0 + alp)*(1.0 + alp)) + +! z = g1*(6.*rho0(mgs)/(pi*1000.))**2*( (qx(mgs,lhl)+dtp*(qhlacw(mgs)-qhlmul1(mgs)))**2)/(cx(mgs,lhl)) +! zhlacw(mgs) = g1*(6.*rho0(mgs)/(pi*1000.))**2*( 2.*( qx(mgs,lhl)/cx(mgs,lhl)) * qhlacw(mgs) ) + zhlacw(mgs) = g1*(6.*rho0(mgs)/(pi*xdn(mgs,lhl)))**2*( 2.*tmp * qhlacw(mgs) ) + +! IF ( z > zx(mgs,lhl) ) THEN +! zhlacw(mgs) = (z - zx(mgs,lhl))*dtpinv +! ENDIF + g1 = g1x(mgs,lhl) ! (6.0 + alp)*(5.0 + alp)*(4.0 + alp)/((3.0 + alp)*(2.0 + alp)*(1.0 + alp)) + ENDIF + + ELSE ! } .false. { + + IF ( qhlacw(mgs) .gt. 0.0 .or. qhlacr(mgs) .gt. 0.0 ) THEN + z = g1*(6.*rho0(mgs)/(pi*1000.))**2*( (qx(mgs,lhl)+dtp*(qhlacr(mgs) + qhlacw(mgs)-qhlmul1(mgs)))**2)/(cx(mgs,lhl)) +! zhlacw(mgs) = g1*(6.*rho0(mgs)/(pi*1000.))**2*( 2.*( qx(mgs,lhl)/cx(mgs,lhl)) * qhlacw(mgs) ) + IF ( z > zx(mgs,lhl) ) THEN + zhlacw(mgs) = (z - zx(mgs,lhl))*dtpinv + ENDIF + ENDIF + + ENDIF ! } + + ENDIF +! qsplinter(mgs) + + IF ( lzhl > 1 ) THEN + pzhli(mgs) = ffrzh*(((1.0-ifrzg)*zrfrzf(mgs) & + & +il5(mgs)*(1.0-ifiacrg)*ziacrf(mgs) )) & + & + il5(mgs)*zhlcnh(mgs) & + & + zhlacw(mgs) & + & + zhlacr(mgs) & +! : + zhlacs(mgs) & + & + Max( 0.0, zhldsv(mgs) ) + + pzhld(mgs) = 0.0 & + & + (1-il5(mgs))*zhlmlr(mgs) & + & + zhlshr(mgs) & + & - zhcnhl(mgs) & + & + Min( 0.0, zhldsv(mgs) ) + + + IF ( .not. ( -1.0 < pzhli(mgs) .and. pzhli(mgs) < 1.e20 ) ) THEN + write(iunit,*) 'Problem with pzhli!' + write(iunit,*) 'zhlcnh,zhlacw,zhlacr,zhldsv = ',zhlcnh(mgs),zhlacw(mgs),zhlacr(mgs),zhldsv(mgs) + ENDIF + + IF ( .not. ( -1.0e20 < pzhld(mgs) .and. pzhld(mgs) < 1. ) ) THEN + write(iunit,*) 'Problem with pzhld!' + write(iunit,*) 'zhlmlr,zhlshr,zhldsv = ',zhlmlr(mgs),zhlshr(mgs),zhldsv(mgs) + ENDIF + + ENDIF ! lzhl > 1 + + end do + + ENDIF + +! +! rain reflectivity +! + if (ndebug .gt. 0 ) write(0,*) 'WARMZIEG: dbg = 11' + + IF ( lzr .gt. 1 ) THEN ! + + DO mgs = 1,ngscnt + + zracw(mgs) = 0.0 + zracr(mgs) = 0.0 + zrcev(mgs) = 0.0 + zrach(mgs) = 0.0 + zrachl(mgs) = 0.0 + zsshr(mgs) = 0.0 + zsshrr(mgs) = 0.0 +! zsmlr(mgs) = 0.0 + zsmlrr(mgs) = 0.0 + + IF ( qx(mgs,ls) .gt. qxmin(ls) .and. ( csmlr(mgs) /= 0.0 .or. csshr(mgs) /= 0.0 .or. & + csmlrr(mgs) /= 0.0 .or. csshrr(mgs) /= 0.0) ) THEN !{ + tmp = qx(mgs,ls)/cx(mgs,ls) + g1 = 36.*(xnu(ls)+2.0)/((xnu(ls)+1.0)*pi**2) + IF ( .not. mixedphase ) THEN +! zsmlr(mgs) = (xdn(mgs,ls)/xdn(mgs,lr))**2*g1*(rho0(mgs)/(xdn(mgs,ls)))**2* & +! & ( 2.*tmp * qsmlr(mgs) - tmp**2 * csmlr(mgs) ) + + IF ( csmlrr(mgs) /= 0.0 ) THEN + z1 = g1smlr*(6.*rho0(mgs)/(pi*xdn(mgs,lr)))**2*( qsmlr(mgs)**2/ csmlrr(mgs) ) + zsmlrr(mgs) = z1 + ENDIF + ENDIF + +! zsshr(mgs) = (xdn(mgs,ls)/xdn(mgs,lr))**2*g1*(rho0(mgs)/(xdn(mgs,ls)))**2* & +! & ( 2.*tmp * qsshr(mgs) - tmp**2 * csshr(mgs) ) + + IF ( csshrr(mgs) /= 0.0 ) THEN + z1 = g1smlr*(6.*rho0(mgs)/(pi*xdn(mgs,lr)))**2*( qsshr(mgs)**2/ csshrr(mgs) ) + zsshrr(mgs) = z1 + ENDIF + + ENDIF !} + + IF ( .not. mixedphase ) THEN !{ + IF ( zhmlr(mgs) < 0.0 .and. chmlrr(mgs) /= 0.0 .and. ibinhmlr == 0 ) THEN !{ + tmp = qx(mgs,lh)/cx(mgs,lh) +! zhmlrr(mgs) = Min(0.0, (xdn(mgs,lh)/xdn(mgs,lr))**2 * & +! & g1x(mgs,lh)*(6.*rho0(mgs)/(pi*xdn(mgs,lh)))**2*( 2.*tmp * qhmlr(mgs) - tmp**2 * chmlrr(mgs) ) ) + +! IF ( zhmlrr(mgs) >= 0. ) THEN +! zhmlrr(mgs) = (xdn(mgs,lh)/xdn(mgs,lr))**2 * zhmlr(mgs) +! ENDIF + IF ( (shedalp + alpha(mgs,lh))*xdia(mgs,lh,1) < sheddiam ) THEN ! if not shedding small drops, then use alpha of graupel + z1 = g1x(mgs,lh)*(6.*rho0(mgs)/(pi*xdn(mgs,lr)))**2*( qhmlr(mgs)**2/ chmlrr(mgs) ) + ELSE ! assume drops are shed off, so use either alpha for shedding or graupel alpha, whichever gives the lower g-factor (i.e., larger alpha) + z1 = Min(g1x(mgs,lh),g1shr)*(6.*rho0(mgs)/(pi*xdn(mgs,lr)))**2*( qhmlr(mgs)**2/ chmlrr(mgs) ) + ENDIF + zhmlrr(mgs) = z1 +! z1 = g1mlr*(rho0(mgs)/(xdn(mgs,lr)))**2*( qhmlr(mgs)**2/ chmlrr(mgs) ) +! zhmlrr(mgs) = Max( z1, zhmlrr(mgs)) + ENDIF !} + + +! zhshrr(mgs) = (xdn(mgs,lh)/xdn(mgs,lr))**2 * zhshr(mgs) + + IF ( lhl > 1 .and. qhlmlr(mgs) /= 0 .and. ibinhlmlr == 0) THEN + tmp = qx(mgs,lhl)/cx(mgs,lhl) +! zhlmlrr(mgs) = Min(0.0, (xdn(mgs,lhl)/xdn(mgs,lr))**2 * & +! & g1x(mgs,lhl)*(6.*rho0(mgs)/(pi*xdn(mgs,lhl)))**2*( 2.*tmp * qhlmlr(mgs) - tmp**2 * chlmlrr(mgs) ) ) + +! IF ( zhlmlrr(mgs) >= 0. ) THEN ! should be negative, if not, then use alternate calculation +! zhlmlrr(mgs) = (xdn(mgs,lhl)/xdn(mgs,lr))**2 * zhlmlr(mgs) +! ENDIF + + IF ( (shedalp + alpha(mgs,lhl))*xdia(mgs,lhl,1) < sheddiam ) THEN ! if not shedding small drops, then use alpha of hail + z1 = g1x(mgs,lhl)*(6.*rho0(mgs)/(pi*xdn(mgs,lr)))**2*( qhlmlr(mgs)**2/ chlmlrr(mgs) ) + ELSE ! assume drops are shed off, so use either alpha for shedding or graupel alpha, whichever gives the lower g-factor (i.e., larger alpha) + z1 = Min(g1x(mgs,lhl),g1shr)*(6.*rho0(mgs)/(pi*xdn(mgs,lr)))**2*( qhlmlr(mgs)**2/ chlmlrr(mgs) ) +! z1 = g1shr*(6.*rho0(mgs)/(pi*xdn(mgs,lr)))**2*( qhlmlr(mgs)**2/ chlmlrr(mgs) ) + ENDIF + zhlmlrr(mgs) = z1 + +! z1 = g1mlr*(rho0(mgs)/(xdn(mgs,lr)))**2*( qhlmlr(mgs)**2/ chlmlrr(mgs) ) +! zhlmlrr(mgs) = Max( z1, zhlmlrr(mgs)) +! zhlmlr(mgs) = +! zhlshrr(mgs) = (xdn(mgs,lhl)/xdn(mgs,lr))**2 * zhlshr(mgs) + ENDIF + + ENDIF ! } + + IF ( qx(mgs,lr) .gt. qxmin(lr) .and. cx(mgs,lr) .gt. 0.0 ) THEN + + tmp = qx(mgs,lr)/cx(mgs,lr) + g1 = g1x(mgs,lr) ! 36.*(alpha(mgs,lr)+2.0)/((alpha(mgs,lr)+1.0)*pi**2) + + + IF ( qracw(mgs) > 0.0 .and. cx(mgs,lr) > 0.0 ) THEN + zracw(mgs) = g1x(mgs,lr)*(6.*rho0(mgs)/(pi*1000.))**2*( 2.*tmp * qracw(mgs) ) + ENDIF + + IF ( cracr(mgs) > 0.0 .and. cx(mgs,lr) > 0.0 ) THEN + zracr(mgs) = g1x(mgs,lr)*(6.*rho0(mgs)/(pi*1000.))**2*( tmp**2 * cracr(mgs) ) + ENDIF + + qtmp = qrcev(mgs) + ctmp = crcev(mgs) + +! IF ( .false. .or. iferwisventr == 2 ) THEN +! zrcev(mgs) = Min(0.0, (12./(pii*xdn(mgs,lr)))*xdia(mgs,lr,1)**3*fvce(mgs)*rwcap(mgs)*rwventz(mgs) ) +! ELSE + zrcev(mgs) = g1x(mgs,lr)*(6.*rho0(mgs)/(pi*xdn(mgs,lr)))**2*( 2.*( tmp ) * qtmp - tmp**2 * ctmp ) + + + IF ( iferwisventr == 2 ) THEN + vent1 = Min(0.0, (12./(pii*xdn(mgs,lr)))*xdia(mgs,lr,1)**3*fvce(mgs)*rwcap(mgs)*rwventz(mgs)) + zrcev(mgs) = Max( zrcev(mgs), vent1 ) + ENDIF +! IF ( ny == 2 .and. igs(mgs) == 20 ) THEN +! write(0,*) 'k,zrcevold,new,maxdep : ',kgs(mgs),zrcev(mgs),vent1,-zxmxd(mgs,lr),alpha(mgs,lr),cx(mgs,lr) +! ENDIF + - do mgs = 1,ngscnt - pqhli(mgs) = & - & +il5(mgs)*(qhldpv(mgs) ) & ! + (1.0-ifrzg)*(qiacrf(mgs)+qrfrzf(mgs) + qracif(mgs))) & - & +il5(mgs)*(1.0-ifrzg)*(qrfrzf(mgs) ) & - & +qhlacr(mgs)+qhlacw(mgs) & -! & +qhlacs(mgs)+qhlaci(mgs) & - & + qhlcnh(mgs) - pqhld(mgs) = & - & qhlshr(mgs) & - & +(1-il5(mgs))*qhlmlr(mgs) & -! > +il5(mgs)*qhlsbv(mgs) & - & + qhlsbv(mgs) & - & -qhlmul1(mgs) - qhcnhl(mgs) +! ENDIF + zrcev(mgs) = Max( zrcev(mgs), -zxmxd(mgs,lr) ) - end do + IF ( qhacr(mgs) > 0.0 ) THEN + zrach(mgs) = g1x(mgs,lr)*(6.*rho0(mgs)/(pi*xdn(mgs,lr)))**2* & + & ( 2.*( qx(mgs,lr)/cx(mgs,lr)) * qhacr(mgs) - tmp**2 * chacr(mgs) ) + zrach(mgs) = Min( zrach(mgs), zxmxd(mgs,lr) ) + + ENDIF - ENDIF ! lhl + IF ( lhl > 1 .and. qhlacr(mgs) > 0.0 ) THEN + zrachl(mgs) = g1x(mgs,lr)*(6.*rho0(mgs)/(pi*xdn(mgs,lr)))**2* & + & ( 2.*( qx(mgs,lr)/cx(mgs,lr)) * qhlacr(mgs) - tmp**2 * chlacr(mgs) ) + zrachl(mgs) = Min( zrachl(mgs), zxmxd(mgs,lr) ) + ENDIF - ENDIF ! warmonly -! -! Liquid water on snow and graupel -! + + ENDIF - vhmlr(:) = 0.0 - vhlmlr(:) = 0.0 - vhfzh(:) = 0.0 - vhlfzhl(:) = 0.0 + pzrwi(mgs) = zrcnw(mgs) + zracw(mgs) + zracr(mgs) & + & + Max( 0.,zrcev(mgs) ) & + & - (1-il5(mgs))*zsmlrr(mgs) & + & - zsshrr(mgs) & + & - (1-il5(mgs))*zhmlrr(mgs) & + & - zhshrr(mgs) & + & - (1-il5(mgs))*zhlmlrr(mgs) & + & - zhlshrr(mgs) - IF ( mixedphase ) THEN - ELSE ! set arrays for non-mixedphase graupel - -! vhshdr(:) = 0.0 - vhmlr(:) = qhmlr(:) ! not actually volume, but treated as q in rate equation -! vhsoak(:) = 0.0 -! vhlshdr(:) = 0.0 - vhlmlr(:) = qhlmlr(:) ! not actually volume, but treated as q in rate equation -! vhlmlr(:) = rho0(:)*qhlmlr(:)/xdn(:,lhl) -! vhlsoak(:) = 0.0 + pzrwd(mgs) = 0.0 & + & + Min(0.,zrcev(mgs) ) & + & - zrach(mgs) & + & - zrachl(mgs) & + & - zrfrz(mgs) & + & - il5(mgs)*(ziacr(mgs) ) - ENDIF ! mixedphase + + IF ( zx(mgs,lr) + dtp*(pzrwi(mgs)+pzrwd(mgs)) <= 0.0 & + .and. qx(mgs,lr) > qxmin(lr) ) THEN + pzrwd(mgs) = -zx(mgs,lr)*dtpinv - pzrwi(mgs) + ENDIF + + ENDDO + + ENDIF @@ -18678,6 +22439,33 @@ subroutine nssl_2mom_gs & ! > + rho0(mgs)*qhshr(mgs)/xdn(mgs,lh) !xdn(mgs,lr) ! ENDIF + IF ( lzh > 1 .and. qx(mgs,lh) > qxmin(lh) ) THEN +! Calculate change in reflectivity due to density changes + + xdn_new = rho0(mgs)*(qx(mgs,lh) + dtp*(pqhwi(mgs) + pqhwd(mgs) ))/ & + & (vx(mgs,lh) + dtp*(pvhwi(mgs) + pvhwd(mgs)) ) + + IF ( mixedphase ) THEN + IF ( qxw(mgs,lh) .gt. 0.0 ) THEN + dnmx = xdnmx(lr) + ELSE + dnmx = xdnmx(lh) + ENDIF + ELSE + dnmx = xdnmx(lh) + ENDIF + + xdn_new = Max( Min( xdn_new, dnmx ), xdnmn(lh) ) + + drhodt = (xdn_new - xdn(mgs,lh))*dtpinv + + zhwdn(mgs) = -2.*g1x(mgs,lh)*(rho0(mgs)*qx(mgs,lh)*6.*pii )**2/(cx(mgs,lh)*xdn(mgs,lh)**3)*drhodt + + pzhwi(mgs) = pzhwi(mgs) + Max(0.0, zhwdn(mgs)) + pzhwd(mgs) = pzhwd(mgs) + Min(0.0, zhwdn(mgs)) + + + ENDIF IF ( .false. .and. ny .eq. 2 .and. kgs(mgs) .eq. 9 .and. igs(mgs) .eq. 19 ) THEN write(iunit,*) @@ -18760,6 +22548,32 @@ subroutine nssl_2mom_gs & & + rho0(mgs)*(1-il5(mgs))*vhlmlr(mgs)/xdn(mgs,lhl) & & + vhlshdr(mgs) - vhlsoak(mgs) + IF ( lzhl > 1 .and. qx(mgs,lhl) > qxmin(lhl) ) THEN +! Calculate change in reflectivity due to density changes + + xdn_new = rho0(mgs)*(qx(mgs,lhl) + dtp*(pqhli(mgs) + pqhld(mgs) ))/ & + & (vx(mgs,lhl) + dtp*(pvhli(mgs) + pvhld(mgs)) ) + + IF ( mixedphase ) THEN + IF ( qxw(mgs,lhl) .gt. 0.0 ) THEN + dnmx = xdnmx(lr) + ELSE + dnmx = xdnmx(lhl) + ENDIF + ELSE + dnmx = xdnmx(lhl) + ENDIF + xdn_new = Max( Min( xdn_new, dnmx ), xdnmn(lhl) ) + + drhodt = (xdn_new - xdn(mgs,lhl))*dtpinv + + zhldn(mgs) = -2.*g1x(mgs,lhl)*(rho0(mgs)*qx(mgs,lhl)*6.*pii )**2/(cx(mgs,lhl)*xdn(mgs,lhl)**3)*drhodt + + pzhli(mgs) = pzhli(mgs) + Max(0.0, zhldn(mgs)) + pzhld(mgs) = pzhld(mgs) + Min(0.0, zhldn(mgs)) + + + ENDIF ENDDO @@ -18989,7 +22803,7 @@ subroutine nssl_2mom_gs & write(iunit,*) -qracs(mgs)*(1-il2(mgs)) , qhacs(mgs) , qhlacs(mgs) write(iunit,*) -qhcns(mgs) write(iunit,*) +(1-il5(mgs))*qsmlr(mgs) , qsshr(mgs) - write(iunit,*) (qssbv(mgs)) + write(iunit,*) qssbv(mgs) write(iunit,*) Min(0.0, qscev(mgs)) write(iunit,*) -qsmul(mgs) ! @@ -19061,33 +22875,37 @@ subroutine nssl_2mom_gs & IF ( warmonly < 0.5 ) THEN pfrz(mgs) = & & (1-il5(mgs))* & - & (qhmlr(mgs)+qsmlr(mgs)+qhlmlr(mgs)) & !+qhmlh(mgs)) & - & +il5(mgs)*(qhfzh(mgs)+qsfzs(mgs)+qhlfzhl(mgs)) & + & (qhmlr(mgs)+ & + & qsmlr(mgs)+qhlmlr(mgs)) & !+qhmlh(mgs)) & & +il5(mgs)*(1-imixedphase)*( & & qsacw(mgs)+qhacw(mgs) + qhlacw(mgs) & & +qsacr(mgs)+qhacr(mgs) + qhlacr(mgs) & & +qsshr(mgs) & & +qhshr(mgs) & - & +qhlshr(mgs) +qrfrz(mgs)+qiacr(mgs) & + & +qhlshr(mgs) & + & +qrfrz(mgs)+qiacr(mgs) & & ) & & +il5(mgs)*(qwfrz(mgs) & & +qwctfz(mgs)+qiihr(mgs) & & +qiacw(mgs)) pmlt(mgs) = & & (1-il5(mgs))* & - & (qhmlr(mgs)+qsmlr(mgs)+qhlmlr(mgs)) !+qhmlh(mgs)) + & (qhmlr(mgs)+qsmlr(mgs)+ & + & qhlmlr(mgs)) !+qhmlh(mgs)) ! NOTE: psub is sum of sublimation and deposition psub(mgs) = & & il5(mgs)*( & & + qsdpv(mgs) + qhdpv(mgs) & & + qhldpv(mgs) & & + qidpv(mgs) + qisbv(mgs) ) & - & + qssbv(mgs) + qhsbv(mgs) + qhlsbv(mgs) & + & + qssbv(mgs) + qhsbv(mgs) & + & + qhlsbv(mgs) & & +il5(mgs)*(qiint(mgs)) pvap(mgs) = & - & qrcev(mgs) + qhcev(mgs) + qscev(mgs) + qhlcev(mgs) + & qrcev(mgs) + qhcev(mgs) + qscev(mgs) + qhlcev(mgs) + qfcev(mgs) pevap(mgs) = & - & Min(0.0,qrcev(mgs)) + Min(0.0,qhcev(mgs)) + Min(0.0,qscev(mgs)) + Min(0.0,qhlcev(mgs)) + & Min(0.0,qrcev(mgs)) + Min(0.0,qhcev(mgs)) + Min(0.0,qscev(mgs)) + Min(0.0,qhlcev(mgs)) & + + Min(0.0,qfcev(mgs)) ! NOTE: pdep is the deposition part only pdep(mgs) = & & il5(mgs)*( & @@ -19115,7 +22933,7 @@ subroutine nssl_2mom_gs & & + qidpv(mgs) + qisbv(mgs) ) & & +il5(mgs)*(qiint(mgs)) pvap(mgs) = & - & qrcev(mgs) + qhcev(mgs) + qhlcev(mgs) ! + qscev(mgs) + & qrcev(mgs) + qhcev(mgs) + qhlcev(mgs) + qfcev(mgs) ELSE pfrz(mgs) = 0.0 psub(mgs) = 0.0 @@ -19143,6 +22961,8 @@ subroutine nssl_2mom_gs & ! ! do mgs = 1,ngscnt + + qwvp(mgs) = qwvp(mgs) + & & dtp*(pqwvi(mgs)+pqwvd(mgs)) qx(mgs,lc) = qx(mgs,lc) + & @@ -19155,6 +22975,7 @@ subroutine nssl_2mom_gs & & dtp*(pqswi(mgs)+pqswd(mgs)) qx(mgs,lh) = qx(mgs,lh) + & & dtp*(pqhwi(mgs)+pqhwd(mgs)) + IF ( lhl .gt. 1 ) THEN qx(mgs,lhl) = qx(mgs,lhl) + & & dtp*(pqhli(mgs)+pqhld(mgs)) @@ -19224,12 +23045,32 @@ subroutine nssl_2mom_gs & + ENDIF + ENDIF + IF ( ipconc .ge. 6 ) THEN + IF ( lzr .gt. 1 ) THEN + zx(mgs,lr) = zx(mgs,lr) + & + & dtp*(pzrwi(mgs)+pzrwd(mgs)) + ENDIF + IF ( lzs .gt. 1 ) THEN + zx(mgs,ls) = zx(mgs,ls) + & + & dtp*(pzswi(mgs)+pzswd(mgs)) + ENDIF + IF ( lzh .gt. 1 ) THEN + zx(mgs,lh) = zx(mgs,lh) + & + & dtp*(pzhwi(mgs)+pzhwd(mgs)) + ENDIF + IF ( lzhl .gt. 1 ) THEN + zx(mgs,lhl) = zx(mgs,lhl) + & + & dtp*(pzhli(mgs)+pzhld(mgs)) +! IF ( pchli(mgs) .ne. 0. .or. pchld(mgs) .ne. 0 ) THEN +! write(0,*) 'dr: cx,pchli,pchld = ', cx(mgs,lhl),pchli(mgs),pchld(mgs), igs(mgs),kgs(mgs) +! ENDIF ENDIF ENDIF end do end if - IF ( has_wetscav ) THEN DO mgs = 1,ngscnt evapprod2d(igs(mgs),kgs(mgs)) = -(qrcev(mgs) + qssbv(mgs) + qhsbv(mgs) + qhlsbv(mgs)) @@ -19471,41 +23312,9 @@ subroutine nssl_2mom_gs & tqvcon = temg(mgs)-cbw ltemq = (temg(mgs)-163.15)/fqsat+1.5 ltemq = Min( nqsat, Max(1,ltemq) ) -! IF ( ltemq .lt. 1 .or. ltemq .gt. nqsat ) THEN -! C$PAR CRITICAL SECTION -! write(iunit,*) 'out of range ltemq!',temgtmp,temg(mgs), -! : thetap(mgs),theta0(mgs),pres(mgs),theta(mgs), -! : ltemq,igs(mgs),jy,kgs(mgs) -! write(iunit,*) an(igs(mgs),jy,kgs(mgs),lt), -! : ab(igs(mgs),jy,kgs(mgs),lt), -! : t0(igs(mgs),jy,kgs(mgs)) -! write(iunit,*) fcc3(mgs),qx(mgs,lc),qitmp(mgs),dtp,ptem(mgs) -! STOP -! C$PAR END CRITICAL SECTION -! END IF + qvs(mgs) = pqs(mgs)*tabqvs(ltemq) qis(mgs) = pqs(mgs)*tabqis(ltemq) -! qss(kz) = qvs(kz) -! if ( temg(kz) .lt. tfr ) then -! if( qcw(kz) .le. qxmin(lc) .and. qci(kz) .gt. qxmin(li)) -! > qss(kz) = qis(kz) -! if( qcw(kz) .gt. qxmin(lc) .and. qci(kz) .gt. qxmin(li)) -! > qss(kz) = (qcw(kz)*qvs(kz) + qci(kz)*qis(kz)) / -! > (qcw(kz) + qci(kz)) -! qss(kz) = qis(kz) -! end if -! dont get enough condensation with qcw .le./.gt. qxmin(lc) -! if ( temg(mgs) .lt. tfr ) then -! if( qx(mgs,lc) .ge. 0.0 .and. qitmp(mgs) .le. qxmin(li) ) -! > qss(mgs) = qvs(mgs) -! if( qx(mgs,lc) .eq. 0.0 .and. qitmp(mgs) .gt. qxmin(li)) -! > qss(mgs) = qis(mgs) -! if( qx(mgs,lc) .gt. 0.0 .and. qitmp(mgs) .gt. qxmin(li)) -! > qss(mgs) = (qx(mgs,lc)*qvs(mgs) + qitmp(mgs)*qis(mgs)) / -! > (qx(mgs,lc) + qitmp(mgs)) -! else -! qss(mgs) = qvs(mgs) -! end if qss(mgs) = qvs(mgs) if ( temg(mgs) .lt. tfr ) then if( qx(mgs,lc) .ge. 0.0 .and. qitmp(mgs) .le. qxmin(li) ) & @@ -19744,7 +23553,6 @@ subroutine nssl_2mom_gs & - if (ndebug .gt. 0 ) write(0,*) 'gs 11' do mgs = 1,ngscnt @@ -19775,6 +23583,29 @@ subroutine nssl_2mom_gs & ENDIF + + + +! +! 6th moments +! + + IF ( ipconc .ge. 6 ) THEN + DO il = lr,lhab + IF ( lz(il) .gt. 1 ) THEN + IF ( lf > 1 .and. il == lf ) THEN + lfsave(mgs,3) = an(igs(mgs),jy,kgs(mgs),lz(il)) + lfsave(mgs,4) = zx(mgs,il) + ENDIF + + an(igs(mgs),jy,kgs(mgs),lz(il)) = zx(mgs,il) + & + & min( an(igs(mgs),jy,kgs(mgs),lz(il)), 0.0 ) + zx(mgs,il) = an(igs(mgs),jy,kgs(mgs),lz(il)) + + ENDIF + ENDDO + + ENDIF ! end do ! @@ -19839,7 +23670,455 @@ subroutine nssl_2mom_gs & ENDIF !} ENDDO ! mgs + ELSE ! } { is three-moment, so have to adjust Z if size is too large + IF ( il == lr .and. imurain == 3 ) THEN ! { { RAIN + +! rdmx = +! rdmn = + + DO mgs = 1,ngscnt + + + IF ( iresetmoments == 1 .or. iresetmoments == il ) THEN + IF ( zx(mgs,lr) <= zxmin ) THEN + qx(mgs,lv) = qx(mgs,lv) + qx(mgs,il) + qx(mgs,lr) = 0.0 + cx(mgs,lr) = 0.0 + an(igs(mgs),jgs,kgs(mgs),lv) = an(igs(mgs),jgs,kgs(mgs),lv) + an(igs(mgs),jgs,kgs(mgs),lr) + an(igs(mgs),jgs,kgs(mgs),lr) = qx(mgs,lr) + an(igs(mgs),jgs,kgs(mgs),ln(lr)) = cx(mgs,lr) + ELSEIF ( cx(mgs,lr) <= cxmin ) THEN + qx(mgs,lv) = qx(mgs,lv) + qx(mgs,il) + zx(mgs,lr) = 0.0 + qx(mgs,lr) = 0.0 + an(igs(mgs),jgs,kgs(mgs),lv) = an(igs(mgs),jgs,kgs(mgs),lv) + an(igs(mgs),jgs,kgs(mgs),lr) + an(igs(mgs),jgs,kgs(mgs),lr) = qx(mgs,lr) + an(igs(mgs),jgs,kgs(mgs),lz(lr)) = zx(mgs,lr) + ENDIF + ENDIF + + IF ( qx(mgs,lr) .gt. qxmin(lr) ) THEN + + xv(mgs,lr) = rho0(mgs)*qx(mgs,lr)/(xdn(mgs,lr)*Max(1.0e-11,cx(mgs,lr))) + IF ( xv(mgs,lr) .gt. xvmx(lr) ) THEN +! xv(mgs,lr) = xvmx(lr) +! cx(mgs,lr) = rho0(mgs)*qx(mgs,lr)/(xvmx(lr)*xdn(mgs,lr)) + ELSEIF ( xv(mgs,lr) .lt. xvmn(lr) ) THEN + xv(mgs,lr) = xvmn(lr) + cx(mgs,lr) = rho0(mgs)*qx(mgs,lr)/(xvmn(lr)*xdn(mgs,lr)) + ENDIF + + IF ( zx(mgs,il) > 0.0 .and. cx(mgs,il) <= 0.0 ) THEN +! have mass and reflectivity but no concentration, so set concentration, using default alpha + g1 = 36.*(alpha(mgs,lr)+2.0)/((alpha(mgs,lr)+1.0)*pi**2) + z = zx(mgs,il) + qr = qx(mgs,il) + cx(mgs,il) = g1*dn(igs(mgs),jy,kgs(mgs))**2*(qr)*qr/(z*xdn(mgs,lr)**2) +! an(igs(mgs),jgs,kgs(mgs),ln(il)) = zx(mgs,il) + ELSEIF ( zx(mgs,il) <= zxmin .and. cx(mgs,il) > 0.0 ) THEN +! have mass and concentration but no reflectivity, so set reflectivity, using default alpha + g1 = 36.*(alpha(mgs,lr)+2.0)/((alpha(mgs,lr)+1.0)*pi**2) + chw = cx(mgs,il) + qr = qx(mgs,il) + zx(mgs,il) = g1*dn(igs(mgs),jy,kgs(mgs))**2*(qr)*qr/(xdn(mgs,lr)**2*chw) + an(igs(mgs),jgs,kgs(mgs),lz(lr)) = zx(mgs,lr) + + ELSEIF ( zx(mgs,il) <= zxmin .and. cx(mgs,il) <= 0.0 ) THEN +! How did this happen? + ! set values according to dBZ of -10, or Z = 0.1 +! 0.1 = 1.e18*0.224*an(ix,jy,kz,lzh)*(hwdn/rwdn)**2 + zx(mgs,il) = 1.e-19/0.224*(xdn0(lr)/xdn0(il))**2 + an(igs(mgs),jgs,kgs(mgs),lz(il)) = zx(mgs,il) + + g1 = 36.*(alpha(mgs,lr)+2.0)/((alpha(mgs,lr)+1.0)*pi**2) + z = zx(mgs,il) + qr = qx(mgs,il) + cx(mgs,il) = g1*dn(igs(mgs),jy,kgs(mgs))**2*(qr)*qr/(z*1000.*1000) + an(igs(mgs),jgs,kgs(mgs),ln(il)) = cx(mgs,il) + ENDIF + + IF ( zx(mgs,lr) > 0.0 ) THEN + xv(mgs,lr) = rho0(mgs)*qx(mgs,lr)/(1000.*cx(mgs,lr)) + vr = xv(mgs,lr) + qr = qx(mgs,lr) + nrx = cx(mgs,lr) + z = zx(mgs,lr) + +! xv = (db(1,kz)*a(1,1,kz,lr))**2/(a(1,1,kz,lnr)) +! rd = z*(pi/6.*1000.)**2/xv + +! determine shape parameter alpha by iteration + IF ( z .gt. 0.0 ) THEN + alp = 36.*(alpha(mgs,lr)+2.0)*nrx*vr**2/(z*pi**2) - 1. + DO i = 1,20 + IF ( Abs(alp - alpha(mgs,lr)) .lt. 0.01 ) EXIT + alpha(mgs,lr) = Max( rnumin, Min( rnumax, alp ) ) + alp = 36.*(alpha(mgs,lr)+2.0)*nrx*vr**2/(z*pi**2) - 1. + alp = Max( rnumin, Min( rnumax, alp ) ) + ENDDO + +! check for artificial breakup (rain larger than allowed max size) + IF ( xv(mgs,il) .gt. xvmx(il) .or. (ioldlimiter == 2 .and. xv(mgs,il) .gt. xvmx(il)/8.) ) THEN + tmp = cx(mgs,il) +! write(0,*) 'MY limiter: xv: ',xv(mgs,il), xv(mgs,il)/(xvmx(il)/8.) +! STOP + IF ( ioldlimiter == 2 ) THEN ! MY-style active breakup + x = (6.*rho0(mgs)*qx(mgs,il)/(pi*xdn(mgs,il)*cx(mgs,il)))**(1./3.) + x1 = Max(0.0e-3, x - 3.0e-3) + x2 = Max(0.5, x/6.0e-3) + x3 = x2**3 + cx(mgs,il) = cx(mgs,il)*Max((1.+2.222e3*x1**2), x3) + xv(mgs,il) = xv(mgs,il)/Max((1.+2.222e3*x1**2), x3) + ELSE ! simple cutoff + xv(mgs,il) = Min( xvmx(il), Max( xvmn(il),xv(mgs,il) ) ) + xmas(mgs,il) = xv(mgs,il)*xdn(mgs,il) + cx(mgs,il) = rho0(mgs)*qx(mgs,il)/(xmas(mgs,il)) + ENDIF + !xmas(mgs,il) = xv(mgs,il)*xdn(mgs,il) + !cx(mgs,il) = rho0(mgs)*qx(mgs,il)/(xmas(mgs,il)) + + + IF ( tmp < cx(mgs,il) ) THEN ! breakup + + g1 = 36.*(alpha(mgs,lr)+2.0)/((alpha(mgs,lr)+1.0)*pi**2) + zx(mgs,il) = zx(mgs,il) + g1*(rho0(mgs)/xdn(mgs,il))**2*( (qx(mgs,il)/tmp)**2 * (tmp-cx(mgs,il)) ) + an(igs(mgs),jgs,kgs(mgs),lz(il)) = zx(mgs,il) + + vr = xv(mgs,lr) + qr = qx(mgs,lr) + nrx = cx(mgs,lr) + z = zx(mgs,lr) + + +! determine shape parameter alpha by iteration + alp = 36.*(alpha(mgs,lr)+2.0)*nrx*vr**2/(z*pi**2) - 1. + DO i = 1,20 + IF ( Abs(alp - alpha(mgs,lr)) .lt. 0.01 ) EXIT + alpha(mgs,lr) = Max( rnumin, Min( rnumax, alp ) ) + alp = 36.*(alpha(mgs,lr)+2.0)*nrx*vr**2/(z*pi**2) - 1. + alp = Max( rnumin, Min( rnumax, alp ) ) + ENDDO + + + ENDIF + ENDIF + +! +! Check whether the shape parameter is at or less than the minimum, and if it is, reset the +! concentration or reflectivity to match (prevents reflectivity from being out of balance with Q and N) +! + g1 = 36.*(alpha(mgs,lr)+2.0)/((alpha(mgs,lr)+1.0)*pi**2) + IF ( .true. .and. (alpha(mgs,il) <= rnumin .or. alp == rnumin .or. alp == rnumax) ) THEN + + IF ( rescale_high_alpha .and. alp >= rnumax - 0.01 ) THEN ! reset c at high alpha to prevent growth in Z + cx(mgs,il) = g1*dn(igs(mgs),jy,kgs(mgs))**2*(qr)*qr/z*(1./(xdn(mgs,il)))**2 + an(igs(mgs),jy,kgs(mgs),ln(il)) = cx(mgs,il) + + ELSEIF ( rescale_low_alphar .and. alp <= rnumin ) THEN + z = 36.*(alpha(mgs,lr)+2.0)*nrx*vr**2/((alpha(mgs,lr)+1.0)*pi**2) + zx(mgs,il) = z + an(igs(mgs),jy,kgs(mgs),lz(il)) = zx(mgs,il) + ENDIF + ENDIF + + + + ENDIF + ENDIF + + ENDIF + + ENDDO +! CALL cld_cpu('Z-MOMENT-1r') + + + ELSEIF ( il == lh .or. il == lhl .or. il == lf .or. (il == lr .and. imurain == 1 )) THEN ! } { Rain, GRAUPEL OR HAIL + + + + DO mgs = 1,ngscnt + + IF ( lf > 1 .and. il == lf ) THEN + lfsave(mgs,5) = an(igs(mgs),jy,kgs(mgs),ln(il)) + lfsave(mgs,6) = cx(mgs,il) + ENDIF + + IF ( il == lhl .and. lnhlf > 1 ) THEN + IF ( cx(mgs,lhl) > cxmin ) THEN + frac = chxf(mgs,lhl)/cx(mgs,lhl) + ELSE + frac = 0.0 + ENDIF + ENDIF + + IF ( il == lh .and. lnhf > 1 ) THEN + IF ( cx(mgs,lh) > cxmin ) THEN + frach = chxf(mgs,lh)/cx(mgs,lh) + ELSE + frach = 0.0 + ENDIF + ENDIF + + + + IF ( iresetmoments == 1 .or. iresetmoments == il .or. iresetmoments == -1 ) THEN ! { .or. qx(mgs,il) <= qxmin(il) + IF ( zx(mgs,il) <= zxmin ) THEN ! .and. qx(mgs,il) > 0.05e-3 +!! write(91,*) 'zx=0; qx,cx = ',1000.*qx(mgs,il),cx(mgs,il) + qx(mgs,il) = 0.0 + cx(mgs,il) = 0.0 + an(igs(mgs),jgs,kgs(mgs),lv) = an(igs(mgs),jgs,kgs(mgs),lv) + an(igs(mgs),jgs,kgs(mgs),il) + an(igs(mgs),jgs,kgs(mgs),il) = qx(mgs,il) + an(igs(mgs),jgs,kgs(mgs),ln(il)) = cx(mgs,il) + ELSEIF ( iresetmoments == -1 .and. qx(mgs,il) < qxmin(il) ) THEN + zx(mgs,il) = 0.0 + cx(mgs,il) = 0.0 + an(igs(mgs),jgs,kgs(mgs),lv) = an(igs(mgs),jgs,kgs(mgs),lv) + an(igs(mgs),jgs,kgs(mgs),il) + + qx(mgs,il) = 0.0 + an(igs(mgs),jgs,kgs(mgs),il) = qx(mgs,il) + an(igs(mgs),jgs,kgs(mgs),ln(il)) = cx(mgs,il) + an(igs(mgs),jgs,kgs(mgs),lz(il)) = zx(mgs,il) + + ELSEIF ( cx(mgs,il) <= cxmin .and. iresetmoments /= -1 ) THEN ! .and. qx(mgs,il) > 0.05e-3 + qx(mgs,lv) = qx(mgs,lv) + qx(mgs,il) + zx(mgs,il) = 0.0 + qx(mgs,il) = 0.0 + an(igs(mgs),jgs,kgs(mgs),lv) = an(igs(mgs),jgs,kgs(mgs),lv) + an(igs(mgs),jgs,kgs(mgs),il) + an(igs(mgs),jgs,kgs(mgs),il) = qx(mgs,il) + an(igs(mgs),jgs,kgs(mgs),lz(il)) = zx(mgs,il) + ENDIF + ELSE + IF ( zx(mgs,il) < 0.0 ) THEN ! .and. qx(mgs,il) > 0.05e-3 + zx(mgs,il) = 0.0 + ENDIF + ENDIF !} + + + IF ( zx(mgs,il) <= zxmin .and. cx(mgs,il) <= cxmin ) THEN + zx(mgs,il) = 0.0 + cx(mgs,il) = 0.0 + an(igs(mgs),jgs,kgs(mgs),lv) = an(igs(mgs),jgs,kgs(mgs),lv) + an(igs(mgs),jgs,kgs(mgs),il) + qx(mgs,il) = 0.0 + an(igs(mgs),jgs,kgs(mgs),il) = qx(mgs,il) + an(igs(mgs),jgs,kgs(mgs),ln(il)) = cx(mgs,il) + an(igs(mgs),jgs,kgs(mgs),lz(il)) = zx(mgs,il) + ENDIF + + IF ( qx(mgs,il) .gt. qxmin(il) ) THEN !{ + + xv(mgs,il) = rho0(mgs)*qx(mgs,il)/(xdn(mgs,il)*Max(1.0e-9,cx(mgs,il))) + xmas(mgs,il) = xv(mgs,il)*xdn(mgs,il) + + IF ( xv(mgs,il) .lt. xvmn(il) ) THEN + xv(mgs,il) = Min( xvmx(il), Max( xvmn(il),xv(mgs,il) ) ) + xmas(mgs,il) = xv(mgs,il)*xdn(mgs,il) + cx(mgs,il) = rho0(mgs)*qx(mgs,il)/(xmas(mgs,il)) + ENDIF + + IF ( zx(mgs,il) > 0.0 .and. cx(mgs,il) <= 0.0 ) THEN !{ +! have mass and reflectivity but no concentration, so set concentration, using default alpha + g1 = (6.0 + alpha(mgs,il))*(5.0 + alpha(mgs,il))*(4.0 + alpha(mgs,il))/ & + & ((3.0 + alpha(mgs,il))*(2.0 + alpha(mgs,il))*(1.0 + alpha(mgs,il))) + z = zx(mgs,il) + qr = qx(mgs,il) +! cx(mgs,il) = g1*dn(igs(mgs),jy,kgs(mgs))**2*(qr)*qr/z + cx(mgs,il) = g1*dn(igs(mgs),jy,kgs(mgs))**2*(6.*qr)**2/(z*(pi*xdn(mgs,il))**2) + + + ELSEIF ( zx(mgs,il) <= zxmin .and. cx(mgs,il) > 0.0 ) THEN +! have mass and concentration but no reflectivity, so set reflectivity, using default alpha +! g1 = (6.0 + alpha(mgs,il))*(5.0 + alpha(mgs,il))*(4.0 + alpha(mgs,il))/ & +! & ((3.0 + alpha(mgs,il))*(2.0 + alpha(mgs,il))*(1.0 + alpha(mgs,il))) + chw = cx(mgs,il) + qr = qx(mgs,il) +! zx(mgs,il) = g1*dn(igs(mgs),jy,kgs(mgs))**2*(qr)*qr/chw +! zx(mgs,il) = Min(zxmin*1.1, g1*dn(igs(mgs),jy,kgs(mgs))**2*(6.*qr)**2/(chw*(pi*xdn(mgs,il))**2) ) + g1 = (6.0 + alphamax)*(5.0 + alphamax)*(4.0 + alphamax)/ & + & ((3.0 + alphamax)*(2.0 + alphamax)*(1.0 + alphamax)) + zx(mgs,il) = Max(zxmin*1.1, g1*dn(igs(mgs),jy,kgs(mgs))**2*(6*qr)**2/(chw*(pi*xdn(mgs,il))**2) ) + an(igs(mgs),jgs,kgs(mgs),lz(il)) = zx(mgs,il) + + ELSEIF ( zx(mgs,il) <= zxmin .and. cx(mgs,il) <= 0.0 ) THEN +! How did this happen? + ! set values according to dBZ of -10, or Z = 0.1 +! 0.1 = 1.e18*0.224*an(ix,jy,kz,lzh)*(hwdn/rwdn)**2 + +! write(0,*) 'GS: moment problem! il,c,z,q = ',il,cx(mgs,il),zx(mgs,il),qx(mgs,il) + + zx(mgs,il) = 1.e-19/0.224*(xdn0(lr)/xdn0(il))**2 + an(igs(mgs),jgs,kgs(mgs),lz(il)) = zx(mgs,il) + + g1 = (6.0 + alpha(mgs,il))*(5.0 + alpha(mgs,il))*(4.0 + alpha(mgs,il))/ & + & ((3.0 + alpha(mgs,il))*(2.0 + alpha(mgs,il))*(1.0 + alpha(mgs,il))) + z = zx(mgs,il) + qr = qx(mgs,il) +! cx(mgs,il) = g1*dn(igs(mgs),jy,kgs(mgs))**2*(qr)*qr/z + cx(mgs,il) = g1*dn(igs(mgs),jy,kgs(mgs))**2*(6.*qr)**2/(z*(pi*xdn(mgs,il))**2) + an(igs(mgs),jgs,kgs(mgs),ln(il)) = cx(mgs,il) + +! write(0,*) 'GS: moment problem! reset il,c,z,q = ',il,cx(mgs,il),zx(mgs,il),qx(mgs,il) + + ELSE + ! have all valid moments, so find shape parameter + chw = cx(mgs,il) + qr = qx(mgs,il) + z = zx(mgs,il) + + IF ( zx(mgs,il) .gt. 0. ) THEN !{ + +! rdi = z*(pi/6.*1000.)**2*chw/((rho0(mgs)*qr)**2) + rdi = z*(pi/6.*xdn(mgs,il))**2*chw/((rho0(mgs)*qr)**2) + +! alp = 1.e18*(6.+alpha(mgs,il))*(5.0+alpha(mgs,il))*(4.0+alpha(mgs,il))/ +! : ((3.0+alpha(mgs,il))*(2.0+alpha(mgs,il))*rdi) - 1.0 + alp = (6.0+alpha(mgs,il))*(5.0+alpha(mgs,il))*(4.0+alpha(mgs,il))/ & + & ((3.0+alpha(mgs,il))*(2.0+alpha(mgs,il))*rdi) - 1.0 +! print*,'kz, alp, alpha(mgs,il) = ',kz,alp,alpha(mgs,il),rdi,z,xv + DO i = 1,10 +! IF ( 100.*Abs(alp - alpha(mgs,il))/(Abs(alpha(mgs,il))+1.e-5) .lt. 1. ) EXIT + IF ( Abs(alp - alpha(mgs,il)) .lt. 0.01 ) EXIT + alpha(mgs,il) = Max( alphamin, Min( alphamax, alp ) ) +! alp = 1.e18*(6.+alpha(mgs,il))*(5.0+alpha(mgs,il))*(4.0+alpha(mgs,il))/ +! : ((3.0+alpha(mgs,il))*(2.0+alpha(mgs,il))*rdi) - 1.0 + alp = (6.+alpha(mgs,il))*(5.0+alpha(mgs,il))*(4.0+alpha(mgs,il))/ & + & ((3.0+alpha(mgs,il))*(2.0+alpha(mgs,il))*rdi) - 1.0 +! print*,'i,alp = ',i,alp + alp = Max( alphamin, Min( alphamax, alp ) ) + ENDDO + + +! check for artificial breakup (graupel/hail larger than allowed max size) + IF ( xv(mgs,il) .gt. xvmx(il) ) THEN !{ + tmp = cx(mgs,il) + + + xv(mgs,il) = Min( xvmx(il), Max( xvmn(il),xv(mgs,il) ) ) + xmas(mgs,il) = xv(mgs,il)*xdn(mgs,il) + cx(mgs,il) = rho0(mgs)*qx(mgs,il)/(xmas(mgs,il)) + IF ( tmp < cx(mgs,il) ) THEN ! breakup + g1 = 36.*(6.0 + alpha(mgs,il))*(5.0 + alpha(mgs,il))*(4.0 + alpha(mgs,il))/ & + & ((3.0 + alpha(mgs,il))*(2.0 + alpha(mgs,il))*(1.0 + alpha(mgs,il))*pi**2) + zx(mgs,il) = zx(mgs,il) + g1*(rho0(mgs)/xdn(mgs,il))**2*( (qx(mgs,il)/tmp)**2 * (tmp-cx(mgs,il)) ) + an(igs(mgs),jgs,kgs(mgs),lz(il)) = zx(mgs,il) + + chw = cx(mgs,il) + qr = qx(mgs,il) + z = zx(mgs,il) + + rdi = z*(pi/6.*xdn(mgs,il))**2*chw/((rho0(mgs)*qr)**2) + alp = (6.0+alpha(mgs,il))*(5.0+alpha(mgs,il))*(4.0+alpha(mgs,il))/ & + & ((3.0+alpha(mgs,il))*(2.0+alpha(mgs,il))*rdi) - 1.0 + DO i = 1,10 + IF ( Abs(alp - alpha(mgs,il)) .lt. 0.01 ) EXIT + alpha(mgs,il) = Max( alphamin, Min( alphamax, alp ) ) + alp = (6.+alpha(mgs,il))*(5.0+alpha(mgs,il))*(4.0+alpha(mgs,il))/ & + & ((3.0+alpha(mgs,il))*(2.0+alpha(mgs,il))*rdi) - 1.0 + alp = Max( alphamin, Min( alphamax, alp ) ) + ENDDO + + + ENDIF + ENDIF !} + +! +! Check whether the shape parameter is at or less than the minimum, and if it is, reset the +! concentration or reflectivity to match (prevents reflectivity from being out of balance with Q and N) +! + g1 = (6.0 + alpha(mgs,il))*(5.0 + alpha(mgs,il))*(4.0 + alpha(mgs,il))/ & + & ((3.0 + alpha(mgs,il))*(2.0 + alpha(mgs,il))*(1.0 + alpha(mgs,il))) + + IF ( ( lrescalelow(il) .or. rescale_high_alpha ) .and. & + & ( alpha(mgs,il) <= alphamin .or. alp == alphamin .or. alp == alphamax ) ) THEN !{ + + IF ( rescale_high_alpha .and. alp >= alphamax - 0.01 ) THEN ! reset c at high alpha to prevent growth in Z + cx(mgs,il) = g1*dn(igs(mgs),jy,kgs(mgs))**2*(qr)*qr/z*(6./(pi*xdn(mgs,il)))**2 + an(igs(mgs),jy,kgs(mgs),ln(il)) = cx(mgs,il) + + ELSEIF ( lrescalelow(il) .and. alp <= alphamin .and. .not. (il == lh .and. icvhl2h > 0 ) .and. & + .not. ( il == lr .and. .not. rescale_low_alphar ) ) THEN ! alpha = alphamin, so reset Z to prevent growth in C + + wtest = .false. + IF ( irescalerainopt == 0 ) THEN + wtest = .false. + ELSEIF ( irescalerainopt == 1 ) THEN + wtest = qx(mgs,lc) > qxmin(lc) + ELSEIF ( irescalerainopt == 2 ) THEN + wtest = qx(mgs,lc) > qxmin(lc) .and. wvel(mgs) < rescale_wthresh + ELSEIF ( irescalerainopt == 3 ) THEN + wtest = temcg(mgs) > rescale_tempthresh .and. qx(mgs,lc) > qxmin(lc) .and. wvel(mgs) < rescale_wthresh + ENDIF + + IF ( il == lr .and. ( wtest .or. .not. rescale_low_alphar ) ) THEN + ! certain situations where rain number is adjusted instead of Z. Helps avoid rain being 'zapped' by autoconverted + ! drops (i.e., favor preserving Z when alpha tries to go negative) + chw = g1*dn(igs(mgs),jy,kgs(mgs))**2*(qr)*qr/z*(6./(pi*xdn(mgs,il)))**2 ! g1*dn(igs(mgs),jy,kgs(mgs))**2*(qr)*qr/z1 + cx(mgs,il) = chw + an(igs(mgs),jy,kgs(mgs),ln(il)) = chw + ELSE + ! Usual resetting of reflectivity moment to force consisntency between Q, N, Z, and alpha when alpha = alphamin + z1 = g1*dn(igs(mgs),jy,kgs(mgs))**2*(qr)*qr/chw + z = z1*(6./(pi*xdn(mgs,il)))**2 + zx(mgs,il) = z + an(igs(mgs),jy,kgs(mgs),lz(il)) = z + ENDIF + +! z1 = g1*dn(igs(mgs),jy,kgs(mgs))**2*(qr)*qr/chw +! z = z1*(6./(pi*xdn(mgs,il)))**2 +! zx(mgs,il) = z +! an(igs(mgs),jy,kgs(mgs),lz(il)) = z + ENDIF + + ENDIF !} + + + ENDIF !} + + + ENDIF ! !} + + + ENDIF !} + + IF ( lzr > 1 ) THEN + alpha2d(igs(mgs),kgs(mgs),1) = Max(alphamin, Min(alphamax, alpha(mgs,lr) )) + ENDIF + IF ( lzh > 1 ) THEN + alpha2d(igs(mgs),kgs(mgs),2) = Max(alphamin, Min(alphamax, alpha(mgs,lh) )) + ENDIF + IF ( lzhl > 1 ) THEN + alpha2d(igs(mgs),kgs(mgs),3) = Max(alphamin, Min(alphamax, alpha(mgs,lhl) )) + ENDIF + + IF ( il == lhl .and. lnhlf > 1 ) THEN + ! update chxf in case cx has changed + chxf(mgs,lhl) = frac*cx(mgs,lhl) + ENDIF + IF ( il == lh .and. lnhf > 1 ) THEN + ! update chxf in case cx has changed + chxf(mgs,lh) = frach*cx(mgs,lh) + ENDIF + + +! IF ( lf > 0 .and. il == lf .and. kgs(mgs) <= 20 .and. ( cx(mgs,lf) + dtp*( pcfwi(mgs) + pcfwd(mgs) ) > 200. .or. cx(mgs,lf) > 400. )) THEN +! write(0,*) 'ix,jy, kz, cf = ',igs(mgs)+ixbeg,jy+jybeg,kgs(mgs), an(igs(mgs),jy,kgs(mgs),ln(lf)),lfsave(mgs,5),lfsave(mgs,6) +! write(0,*) 'qold,qxold,zold,zxold = ',lfsave(mgs,1),lfsave(mgs,2),lfsave(mgs,3),lfsave(mgs,4) +! write(0,*) 'cf_new,pcfwi,pcfwd = ',cx(mgs,lf),cx(mgs,lf) + dtp*( pcfwi(mgs) + pcfwd(mgs) ),pcfwi(mgs) + pcfwd(mgs) +! +! ENDIF + + ENDDO ! mgs + +! CALL cld_cpu('Z-DELABK') + + +! CALL cld_cpu('Z-DELABK') + + + + + ENDIF ! } } + ENDIF ! }} ENDIF ! } diff --git a/physics/mp_nssl.F90 b/physics/MP/NSSL/mp_nssl.F90 similarity index 67% rename from physics/mp_nssl.F90 rename to physics/MP/NSSL/mp_nssl.F90 index 59ca877fa..7b21fbbe1 100644 --- a/physics/mp_nssl.F90 +++ b/physics/MP/NSSL/mp_nssl.F90 @@ -15,6 +15,7 @@ module mp_nssl private logical :: is_initialized = .False. + logical :: missing_vars_global = .False. real :: nssl_qccn contains @@ -26,16 +27,21 @@ module mp_nssl !! \htmlinclude mp_nssl_init.html !! subroutine mp_nssl_init(ncol, nlev, errflg, errmsg, threads, restart, & - mpirank, mpiroot, & - con_g, con_rd, con_cp, con_rv, & - con_t0c, con_cliq, con_csol, con_eps, & - imp_physics, imp_physics_nssl, & - nssl_cccn, nssl_alphah, nssl_alphahl, & - nssl_alphar, nssl_ehw0, nssl_ehlw0, & - nssl_ccn_on, nssl_hail_on, nssl_invertccn ) + mpirank, mpiroot,mpicomm, & + qc, qr, qi, qs, qh, & + ccw, crw, cci, csw, chw, vh, & + con_g, con_rd, con_cp, con_rv, & + con_t0c, con_cliq, con_csol, con_eps, & + imp_physics, imp_physics_nssl, & + nssl_cccn, nssl_alphah, nssl_alphahl, & + nssl_alphar, nssl_ehw0, nssl_ehlw0, & + nssl_ccn_on, nssl_hail_on, nssl_invertccn, nssl_3moment ) use module_mp_nssl_2mom, only: nssl_2mom_init, nssl_2mom_init_const +#ifdef MPI + use mpi_f08 +#endif implicit none @@ -50,16 +56,32 @@ subroutine mp_nssl_init(ncol, nlev, errflg, errmsg, threads, restart, & integer, intent(in) :: mpirank integer, intent(in) :: mpiroot + type(MPI_Comm), intent(in) :: mpicomm integer, intent(in) :: imp_physics integer, intent(in) :: imp_physics_nssl real(kind_phys), intent(in) :: nssl_cccn, nssl_alphah, nssl_alphahl - real(kind_phys), intent(in) :: nssl_alphar, nssl_ehw0, nssl_ehlw0 - logical, intent(in) :: nssl_ccn_on, nssl_hail_on, nssl_invertccn + real(kind_phys), intent(in) :: nssl_alphar, nssl_ehw0, nssl_ehlw0 + logical, intent(in) :: nssl_ccn_on, nssl_hail_on, nssl_invertccn, nssl_3moment + + real(kind_phys), intent(inout) :: qc (:,:) !(1:ncol,1:nlev) + real(kind_phys), intent(inout) :: qr (:,:) !(1:ncol,1:nlev) + real(kind_phys), intent(inout) :: qi (:,:) !(1:ncol,1:nlev) + real(kind_phys), intent(inout) :: qs (:,:) !(1:ncol,1:nlev) + real(kind_phys), intent(inout) :: qh (:,:) !(1:ncol,1:nlev) graupel + real(kind_phys), intent(inout), optional :: ccw(:,:) !(1:ncol,1:nlev) + real(kind_phys), intent(inout) :: crw(:,:) !(1:ncol,1:nlev) + real(kind_phys), intent(inout) :: cci(:,:) !(1:ncol,1:nlev) + real(kind_phys), intent(inout) :: csw(:,:) !(1:ncol,1:nlev) + real(kind_phys), intent(inout) :: chw(:,:) !(1:ncol,1:nlev) graupel number + real(kind_phys), intent(inout), optional :: vh (:,:) !(1:ncol,1:nlev) graupel volume ! Local variables: dimensions used in nssl_init integer :: ims,ime, jms,jme, kms,kme, nx, nz, i,k - real :: nssl_params(20) - integer :: ihailv + real(kind_phys) :: nssl_params(20) + integer :: ihailv,ipc + real(kind_phys), parameter :: qmin = 1.e-12 + integer :: ierr + logical :: missing_vars = .False. ! Initialize the CCPP error handling variables @@ -104,9 +126,9 @@ subroutine mp_nssl_init(ncol, nlev, errflg, errmsg, threads, restart, & nssl_params(:) = 0.0 - nssl_params(1) = nssl_cccn - nssl_params(2) = nssl_alphah - nssl_params(3) = nssl_alphahl + ! nssl_params(1) = nssl_cccn ! use direct interface instead + ! nssl_params(2) = nssl_alphah ! use direct interface instead + ! nssl_params(3) = nssl_alphahl ! use direct interface instead nssl_params(4) = 4.e5 ! nssl_cnoh -- not used for 2-moment nssl_params(5) = 4.e4 ! nssl_cnohl-- not used for 2-moment nssl_params(6) = 4.e5 ! nssl_cnor-- not used for 2-moment @@ -114,10 +136,6 @@ subroutine mp_nssl_init(ncol, nlev, errflg, errmsg, threads, restart, & nssl_params(8) = 500. ! nssl_rho_qh nssl_params(9) = 800. ! nssl_rho_qhl nssl_params(10) = 100. ! nssl_rho_qs - nssl_params(11) = 0 ! nssl_ipelec_tmp - nssl_params(12) = 11 ! nssl_isaund - nssl_params(13) = 0 ! 1= turn on cccna; 0 = turn off - nssl_params(15) = nssl_alphar nssl_qccn = nssl_cccn/1.225 ! if (mpirank==mpiroot) then @@ -129,13 +147,37 @@ subroutine mp_nssl_init(ncol, nlev, errflg, errmsg, threads, restart, & ELSE ihailv = -1 ENDIF + + IF ( nssl_3moment ) THEN + ipc = 8 + ELSE + ipc = 5 + ENDIF ! write(0,*) 'call nssl_2mom_init' - CALL nssl_2mom_init(ims,ime, jms,jme, kms,kme,nssl_params,ipctmp=5,mixphase=0, & - ihvol=ihailv,nssl_ehw0=nssl_ehw0,nssl_ehlw0=nssl_ehlw0,errmsg=errmsg,errflg=errflg,myrank=mpirank,mpiroot=mpiroot) + CALL nssl_2mom_init(ims,ime, jms,jme, kms,kme,nssl_params,ipctmp=ipc,mixphase=0, & + ihvol=ihailv,nssl_ehw0=nssl_ehw0,nssl_ehlw0=nssl_ehlw0,errmsg=errmsg, & + nssl_alphar=nssl_alphar, & + nssl_alphah=nssl_alphah, & + nssl_alphahl=nssl_alphahl, & + nssl_cccn=nssl_cccn, & + errflg=errflg,myrank=mpirank,mpiroot=mpiroot) ! For restart runs, the init is done here if (restart) then + + ! For restart, check if the IC is from a different scheme that does not have all the needed variables + missing_vars = .False. + IF ( Any( qc > qmin .and. ccw == 0.0 ) ) missing_vars = .true. + IF ( .not. missing_vars .and. Any( qi > qmin .and. cci == 0.0 ) ) missing_vars = .true. + IF ( .not. missing_vars .and. Any( qs > qmin .and. csw == 0.0 ) ) missing_vars = .true. + IF ( .not. missing_vars .and. Any( qr > qmin .and. crw == 0.0 ) ) missing_vars = .true. + IF ( .not. missing_vars .and. Any( qh > qmin .and. (chw == 0.0 .or. vh == 0.0) ) ) missing_vars = .true. + +#ifdef MPI + call MPI_Allreduce(missing_vars, missing_vars_global, 1, MPI_LOGICAL, MPI_LOR, mpicomm, ierr) +#endif + is_initialized = .true. return end if @@ -158,17 +200,18 @@ end subroutine mp_nssl_init !! \htmlinclude mp_nssl_run.html !! subroutine mp_nssl_run(ncol, nlev, con_g, con_rd, mpirank, & -! spechum, cccn, qc, qr, qi, qs, qh, qhl, & - spechum, cccn, cccna, qc, qr, qi, qs, qh, qhl, & - ccw, crw, cci, csw, chw, chl, vh, vhl, & - tgrs, prslk, prsl, phii, omega, dtp, & - prcp, rain, graupel, ice, snow, sr, & + spechum, cccn, cccna, qc, qr, qi, qs, qh, qhl, & + ccw, crw, cci, csw, chw, chl, vh, vhl, & + zrw, zhw, zhl, & + tgrs, prslk, prsl, phii, omega, dtp, & + prcp, rain, graupel, ice, snow, sr, & refl_10cm, do_radar_ref, first_time_step, restart, & - re_cloud, re_ice, re_snow, re_rain, & - nleffr, nieffr, nseffr, nreffr, & - imp_physics, convert_dry_rho, & - imp_physics_nssl, nssl_ccn_on, & - nssl_hail_on, nssl_invertccn, ntccn, ntccna, & + re_cloud, re_ice, re_snow, re_rain, & + nleffr, nieffr, nseffr, nreffr, & + imp_physics, convert_dry_rho, & + imp_physics_nssl, nssl_ccn_on, & + nssl_hail_on, nssl_invertccn, nssl_3moment, & + ntccn, ntccna, & errflg, errmsg) use module_mp_nssl_2mom, only: calcnfromq, na @@ -181,22 +224,25 @@ subroutine mp_nssl_run(ncol, nlev, con_g, con_rd, mpirank, & ! Hydrometeors logical, intent(in ) :: convert_dry_rho real(kind_phys), intent(inout) :: spechum(:,:) !(1:ncol,1:nlev) - real(kind_phys), intent(inout) :: cccn(:,:) !(1:ncol,1:nlev) - real(kind_phys), intent(inout) :: cccna(:,:) !(1:ncol,1:nlev) + real(kind_phys), intent(inout), optional :: cccn(:,:) !(1:ncol,1:nlev) + real(kind_phys), intent(inout), optional :: cccna(:,:) !(1:ncol,1:nlev) real(kind_phys), intent(inout) :: qc (:,:) !(1:ncol,1:nlev) real(kind_phys), intent(inout) :: qr (:,:) !(1:ncol,1:nlev) real(kind_phys), intent(inout) :: qi (:,:) !(1:ncol,1:nlev) real(kind_phys), intent(inout) :: qs (:,:) !(1:ncol,1:nlev) real(kind_phys), intent(inout) :: qh (:,:) !(1:ncol,1:nlev) graupel - real(kind_phys), intent(inout) :: qhl(:,:) !(1:ncol,1:nlev) hail - real(kind_phys), intent(inout) :: ccw(:,:) !(1:ncol,1:nlev) + real(kind_phys), intent(inout), optional :: qhl(:,:) !(1:ncol,1:nlev) hail + real(kind_phys), intent(inout), optional :: ccw(:,:) !(1:ncol,1:nlev) real(kind_phys), intent(inout) :: crw(:,:) !(1:ncol,1:nlev) real(kind_phys), intent(inout) :: cci(:,:) !(1:ncol,1:nlev) real(kind_phys), intent(inout) :: csw(:,:) !(1:ncol,1:nlev) real(kind_phys), intent(inout) :: chw(:,:) !(1:ncol,1:nlev) graupel number - real(kind_phys), intent(inout) :: chl(:,:) !(1:ncol,1:nlev) hail number - real(kind_phys), intent(inout) :: vh (:,:) !(1:ncol,1:nlev) graupel volume - real(kind_phys), intent(inout) :: vhl(:,:) !(1:ncol,1:nlev) hail volume + real(kind_phys), intent(inout), optional :: chl(:,:) !(1:ncol,1:nlev) hail number + real(kind_phys), intent(inout), optional :: vh (:,:) !(1:ncol,1:nlev) graupel volume + real(kind_phys), intent(inout), optional :: vhl(:,:) !(1:ncol,1:nlev) hail volume + real(kind_phys), intent(inout), optional :: zrw(:,:) !(1:ncol,1:nlev) rain reflectivity + real(kind_phys), intent(inout), optional :: zhw(:,:) !(1:ncol,1:nlev) graupel reflectivity + real(kind_phys), intent(inout), optional :: zhl(:,:) !(1:ncol,1:nlev) hail reflectivity ! State variables and timestep information real(kind_phys), intent(inout) :: tgrs (:,:) !(1:ncol,1:nlev) real(kind_phys), intent(in ) :: prsl (:,:) !(1:ncol,1:nlev) @@ -206,24 +252,24 @@ subroutine mp_nssl_run(ncol, nlev, con_g, con_rd, mpirank, & real(kind_phys), intent(in ) :: dtp ! Precip/rain/snow/graupel fall amounts and fraction of frozen precip real(kind_phys), intent( out) :: prcp (:) !(1:ncol) - real(kind_phys), intent( out) :: rain (:) !(1:ncol) - real(kind_phys), intent( out) :: graupel(:) !(1:ncol) - real(kind_phys), intent( out) :: ice (:) !(1:ncol) - real(kind_phys), intent( out) :: snow (:) !(1:ncol) + real(kind_phys), intent( out), optional :: rain (:) !(1:ncol) + real(kind_phys), intent( out), optional :: graupel(:) !(1:ncol) + real(kind_phys), intent( out), optional :: ice (:) !(1:ncol) + real(kind_phys), intent( out), optional :: snow (:) !(1:ncol) real(kind_phys), intent( out) :: sr (:) !(1:ncol) ! Radar reflectivity real(kind_phys), intent(inout) :: refl_10cm(:,:) !(1:ncol,1:nlev) logical, intent(in ) :: do_radar_ref, first_time_step logical, intent(in) :: restart ! Cloud effective radii - real(kind_phys), intent(inout) :: re_cloud(:,:) ! (1:ncol,1:nlev) - real(kind_phys), intent(inout) :: re_ice(:,:) ! (1:ncol,1:nlev) - real(kind_phys), intent(inout) :: re_snow(:,:) ! (1:ncol,1:nlev) - real(kind_phys), intent(inout) :: re_rain(:,:) ! (1:ncol,1:nlev) + real(kind_phys), intent(inout), optional :: re_cloud(:,:) ! (1:ncol,1:nlev) + real(kind_phys), intent(inout), optional :: re_ice(:,:) ! (1:ncol,1:nlev) + real(kind_phys), intent(inout), optional :: re_snow(:,:) ! (1:ncol,1:nlev) + real(kind_phys), intent(inout), optional :: re_rain(:,:) ! (1:ncol,1:nlev) integer, intent(in) :: nleffr, nieffr, nseffr, nreffr integer, intent(in) :: imp_physics integer, intent(in) :: imp_physics_nssl - logical, intent(in) :: nssl_ccn_on, nssl_hail_on, nssl_invertccn + logical, intent(in) :: nssl_ccn_on, nssl_hail_on, nssl_invertccn, nssl_3moment integer, intent(in) :: ntccn, ntccna integer, intent(out) :: errflg @@ -256,6 +302,9 @@ subroutine mp_nssl_run(ncol, nlev, con_g, con_rd, mpirank, & ! create temporaries for hail in case it does not exist !real(kind_phys) :: chl_mp(1:ncol,1:nlev) !< kg-1 (number mixing ratio) real(kind_phys) :: vhl_mp(1:ncol,1:nlev) !< m3 kg-1 (volume mixing ratio) + real(kind_phys) :: zrw_mp(1:ncol,1:nlev) !< m6 kg-1 (reflectivity) + real(kind_phys) :: zhw_mp(1:ncol,1:nlev) !< m6 kg-1 (reflectivity) + real(kind_phys) :: zhl_mp(1:ncol,1:nlev) !< m6 kg-1 (reflectivity) ! Vertical velocity and level width real(kind_phys) :: w(1:ncol,1:nlev) !< m s-1 real(kind_phys) :: dz(1:ncol,1:nlev) !< m @@ -298,13 +347,14 @@ subroutine mp_nssl_run(ncol, nlev, con_g, con_rd, mpirank, & its,ite, jts,jte, kts,kte, i,j,k integer :: itimestep ! timestep counter integer :: ntmul, n - real, parameter :: dtpmax = 60. ! allow up to dt=75 (1.25*60) + real(kind_phys), parameter :: dtpmax = 60. ! allow up to dt=75 (1.25*60) real(kind_phys) :: dtptmp integer, parameter :: ndebug = 0 logical :: invertccn - real :: cwmas + real(kind_phys) :: cwmas real(kind_phys), allocatable :: an(:,:,:,:) ! temporary scalar array + errflg = 0 @@ -342,10 +392,17 @@ subroutine mp_nssl_run(ncol, nlev, con_g, con_rd, mpirank, & ns_mp = csw/(1.0_kind_phys-spechum) nh_mp = chw/(1.0_kind_phys-spechum) vh_mp = vh/(1.0_kind_phys-spechum) + IF ( nssl_3moment ) THEN + zrw_mp = zrw/(1.0_kind_phys-spechum) + zhw_mp = zhw/(1.0_kind_phys-spechum) + ENDIF IF ( nssl_hail_on ) THEN qhl_mp = qhl/(1.0_kind_phys-spechum) nhl_mp = chl/(1.0_kind_phys-spechum) vhl_mp = vhl/(1.0_kind_phys-spechum) + IF ( nssl_3moment ) THEN + zhl_mp = zhl/(1.0_kind_phys-spechum) + ENDIF ENDIF ELSE ! qv_mp = spechum ! /(1.0_kind_phys-spechum) @@ -361,10 +418,18 @@ subroutine mp_nssl_run(ncol, nlev, con_g, con_rd, mpirank, & ni_mp = cci ns_mp = csw nh_mp = chw + vh_mp = vh + IF ( nssl_3moment ) THEN + zrw_mp = zrw + zhw_mp = zhw + ENDIF IF ( nssl_hail_on ) THEN qhl_mp = qhl ! /(1.0_kind_phys-spechum) nhl_mp = chl vhl_mp = vhl + IF ( nssl_3moment ) THEN + zhl_mp = zhl + ENDIF ENDIF ENDIF @@ -500,8 +565,8 @@ subroutine mp_nssl_run(ncol, nlev, con_g, con_rd, mpirank, & dtptmp = dtp ntmul = 1 ENDIF - - IF ( first_time_step .and. .not. restart ) THEN + + IF ( first_time_step .and. ( .not. restart .or. missing_vars_global ) ) THEN itimestep = 0 ! gets incremented to 1 in call loop IF ( nssl_ccn_on ) THEN IF ( invertccn ) THEN @@ -572,110 +637,114 @@ subroutine mp_nssl_run(ncol, nlev, con_g, con_rd, mpirank, & IF ( nssl_ccn_on ) THEN - - CALL nssl_2mom_driver( & - ITIMESTEP=itimestep, & - ! TH=th, & - tt=tgrs, & - QV=qv_mp, & - QC=qc_mp, & - QR=qr_mp, & - QI=qi_mp, & - QS=qs_mp, & - QH=qh_mp, & - QHL=qhl_mp, & - CCW=nc_mp, & - CRW=nr_mp, & - CCI=ni_mp, & - CSW=ns_mp, & - CHW=nh_mp, & - CHL=nhl_mp, & - VHW=vh_mp, & - VHL=vhl_mp, & - cn=cn_mp, & -! cna=cna_mp, f_cna=( ntccna > 0 ), & ! for future use - cna=cna_mp, f_cna=.false. , & - PII=prslk, & - P=prsl, & - W=w, & - DZ=dz, & - DTP=dtptmp, & - DN=rho, & - rainnc=xrain_mp, rainncv=xdelta_rain_mp, & - snownc=xsnow_mp, snowncv=xdelta_snow_mp, & -! icenc=ice_mp, icencv=delta_ice_mp, & - GRPLNC=xgraupel_mp, GRPLNCV=xdelta_graupel_mp, sr=sr, & - dbz = refl_10cm, & -! nssl_progn=.false., & - diagflag = diagflag, & - errmsg=errmsg,errflg=errflg, & - re_cloud=re_cloud_mp, & - re_ice=re_ice_mp, & - re_snow=re_snow_mp, & - re_rain=re_rain_mp, & - has_reqc=has_reqc, & ! ala G. Thompson - has_reqi=has_reqi, & ! ala G. Thompson - has_reqs=has_reqs, & ! ala G. Thompson - has_reqr=has_reqr, & + CALL nssl_2mom_driver( & + ITIMESTEP=itimestep, & + ! TH=th, & + tt=tgrs, & + QV=qv_mp, & + QC=qc_mp, & + QR=qr_mp, & + QI=qi_mp, & + QS=qs_mp, & + QH=qh_mp, & + QHL=qhl_mp, & + CCW=nc_mp, & + CRW=nr_mp, & + CCI=ni_mp, & + CSW=ns_mp, & + CHW=nh_mp, & + CHL=nhl_mp, & + VHW=vh_mp, & + VHL=vhl_mp, & + cn=cn_mp, & + ZRW=zrw_mp, & + ZHW=zhw_mp, & + ZHL=zhl_mp, & +! cna=cna_mp, f_cna=( ntccna > 0 ), & ! for future use + cna=cna_mp, f_cna=.false. , & + PII=prslk, & + P=prsl, & + W=w, & + DZ=dz, & + DTP=dtptmp, & + DN=rho, & + rainnc=xrain_mp, rainncv=xdelta_rain_mp, & + snownc=xsnow_mp, snowncv=xdelta_snow_mp, & + GRPLNC=xgraupel_mp, & + GRPLNCV=xdelta_graupel_mp, & + sr=sr, & + dbz = refl_10cm, & + diagflag = diagflag, & + errmsg=errmsg,errflg=errflg, & + re_cloud=re_cloud_mp, & + re_ice=re_ice_mp, & + re_snow=re_snow_mp, & + re_rain=re_rain_mp, & + has_reqc=has_reqc, & + has_reqi=has_reqi, & + has_reqs=has_reqs, & + has_reqr=has_reqr, & 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 & ) - ELSE - CALL nssl_2mom_driver( & - ITIMESTEP=itimestep, & - ! TH=th, & - tt=tgrs, & - QV=qv_mp, & - QC=qc_mp, & - QR=qr_mp, & - QI=qi_mp, & - QS=qs_mp, & - QH=qh_mp, & - QHL=qhl_mp, & -! CCW=qnc_mp, & - CCW=nc_mp, & - CRW=nr_mp, & - CCI=ni_mp, & - CSW=ns_mp, & - CHW=nh_mp, & - CHL=nhl_mp, & - VHW=vh_mp, & - VHL=vhl_mp, & - ! cn=cccn, & - PII=prslk, & - P=prsl, & - W=w, & - DZ=dz, & - DTP=dtptmp, & - DN=rho, & - rainnc=xrain_mp, rainncv=xdelta_rain_mp, & - snownc=xsnow_mp, snowncv=xdelta_snow_mp, & -! icenc=ice_mp, icencv=delta_ice_mp, & - GRPLNC=xgraupel_mp, GRPLNCV=xdelta_graupel_mp, sr=sr, & - dbz = refl_10cm, & -! nssl_progn=.false., & - diagflag = diagflag, & - errmsg=errmsg,errflg=errflg, & - re_cloud=re_cloud_mp, & - re_ice=re_ice_mp, & - re_snow=re_snow_mp, & - re_rain=re_rain_mp, & - has_reqc=has_reqc, & ! ala G. Thompson - has_reqi=has_reqi, & ! ala G. Thompson - has_reqs=has_reqs, & ! ala G. Thompson - has_reqr=has_reqr, & + CALL nssl_2mom_driver( & + ITIMESTEP=itimestep, & + ! TH=th, & + tt=tgrs, & + QV=qv_mp, & + QC=qc_mp, & + QR=qr_mp, & + QI=qi_mp, & + QS=qs_mp, & + QH=qh_mp, & + QHL=qhl_mp, & + CCW=nc_mp, & + CRW=nr_mp, & + CCI=ni_mp, & + CSW=ns_mp, & + CHW=nh_mp, & + CHL=nhl_mp, & + VHW=vh_mp, & + VHL=vhl_mp, & +! cn=cn_mp, & + ZRW=zrw_mp, & + ZHW=zhw_mp, & + ZHL=zhl_mp, & +! cna=cna_mp, f_cna=( ntccna > 0 ), & ! for future use +! cna=cna_mp, f_cna=.false. , & + PII=prslk, & + P=prsl, & + W=w, & + DZ=dz, & + DTP=dtptmp, & + DN=rho, & + rainnc=xrain_mp, rainncv=xdelta_rain_mp, & + snownc=xsnow_mp, snowncv=xdelta_snow_mp, & + GRPLNC=xgraupel_mp, & + GRPLNCV=xdelta_graupel_mp, & + sr=sr, & + dbz = refl_10cm, & + diagflag = diagflag, & + errmsg=errmsg,errflg=errflg, & + re_cloud=re_cloud_mp, & + re_ice=re_ice_mp, & + re_snow=re_snow_mp, & + re_rain=re_rain_mp, & + has_reqc=has_reqc, & + has_reqi=has_reqi, & + has_reqs=has_reqs, & + has_reqr=has_reqr, & 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 & ) - + ENDIF - - + DO i = 1,ncol delta_rain_mp(i) = delta_rain_mp(i) + xdelta_rain_mp(i) ! this is liquid equivalent of all precip delta_graupel_mp(i) = delta_graupel_mp(i) + xdelta_graupel_mp(i) ! this is liquid equivalent of graupel @@ -684,7 +753,7 @@ subroutine mp_nssl_run(ncol, nlev, con_g, con_rd, mpirank, & ENDDO ENDDO - + ENDIF @@ -750,10 +819,17 @@ subroutine mp_nssl_run(ncol, nlev, con_g, con_rd, mpirank, & csw = ns_mp/(1.0_kind_phys+qv_mp) chw = nh_mp/(1.0_kind_phys+qv_mp) vh = vh_mp/(1.0_kind_phys+qv_mp) + IF ( nssl_3moment ) THEN + zrw = zrw_mp/(1.0_kind_phys+qv_mp) + zhw = zhw_mp/(1.0_kind_phys+qv_mp) + ENDIF IF ( nssl_hail_on ) THEN qhl = qhl_mp/(1.0_kind_phys+qv_mp) chl = nhl_mp/(1.0_kind_phys+qv_mp) vhl = vhl_mp/(1.0_kind_phys+qv_mp) + IF ( nssl_3moment ) THEN + zhl = zhl_mp/(1.0_kind_phys+qv_mp) + ENDIF ENDIF ELSE ! spechum = qv_mp ! /(1.0_kind_phys+qv_mp) @@ -770,10 +846,17 @@ subroutine mp_nssl_run(ncol, nlev, con_g, con_rd, mpirank, & csw = ns_mp chw = nh_mp vh = vh_mp + IF ( nssl_3moment ) THEN + zrw = zrw_mp + zhw = zhw_mp + ENDIF IF ( nssl_hail_on ) THEN qhl = qhl_mp ! /(1.0_kind_phys+qv_mp) chl = nhl_mp vhl = vhl_mp + IF ( nssl_3moment ) THEN + zhl = zhl_mp + ENDIF ENDIF ENDIF diff --git a/physics/mp_nssl.meta b/physics/MP/NSSL/mp_nssl.meta similarity index 80% rename from physics/mp_nssl.meta rename to physics/MP/NSSL/mp_nssl.meta index 6bbf92c73..0f672eedb 100644 --- a/physics/mp_nssl.meta +++ b/physics/MP/NSSL/mp_nssl.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = mp_nssl type = scheme - dependencies = machine.F,module_mp_nssl_2mom.F90 + dependencies = ../../hooks/machine.F,module_mp_nssl_2mom.F90 [ccpp-arg-table] name = mp_nssl_init @@ -63,6 +63,103 @@ dimensions = () type = integer intent = in +[mpicomm] + standard_name = mpi_communicator + long_name = MPI communicator + units = index + dimensions = () + type = MPI_Comm + intent = in +[qc] + standard_name = cloud_liquid_water_mixing_ratio + long_name = cloud water mixing ratio wrt dry+vapor (no condensates) + units = kg kg-1 + dimensions = (horizontal_dimension ,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout +[qr] + standard_name = rain_mixing_ratio + long_name = rain water mixing ratio wrt dry+vapor (no condensates) + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout +[qi] + standard_name = cloud_ice_mixing_ratio + long_name = ice water mixing ratio wrt dry+vapor (no condensates) + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout +[qs] + standard_name = snow_mixing_ratio + long_name = snow water mixing ratio wrt dry+vapor (no condensates) + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout +[qh] + standard_name = graupel_mixing_ratio + long_name = graupel mixing ratio wrt dry+vapor (no condensates) + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout +[ccw] + standard_name = mass_number_concentration_of_cloud_liquid_water_particles_in_air + long_name = cloud droplet number concentration + units = kg-1 + dimensions = (horizontal_dimension,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout + optional = True +[crw] + standard_name = mass_number_concentration_of_rain_water_in_air + long_name = rain number concentration + units = kg-1 + dimensions = (horizontal_dimension,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout +[cci] + standard_name = mass_number_concentration_of_cloud_ice_water_crystals_in_air + long_name = ice number concentration + units = kg-1 + dimensions = (horizontal_dimension,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout +[csw] + standard_name = mass_number_concentration_of_snow_in_air + long_name = snow number concentration + units = kg-1 + dimensions = (horizontal_dimension,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout +[chw] + standard_name = mass_number_concentration_of_graupel_in_air + long_name = graupel number concentration + units = kg-1 + dimensions = (horizontal_dimension,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout +[vh] + standard_name = graupel_volume + long_name = graupel particle volume + units = m3 kg-1 + dimensions = (horizontal_dimension,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout + optional = True [con_g] standard_name = gravitational_acceleration long_name = gravitational acceleration @@ -210,6 +307,13 @@ dimensions = () type = logical intent = in +[nssl_3moment] + standard_name = nssl_3moment + long_name = 3-moment activation flag in NSSL microphysics scheme + units = flag + dimensions = () + type = logical + intent = in ######################################################################## [ccpp-arg-table] name = mp_nssl_run @@ -307,6 +411,7 @@ type = real kind = kind_phys intent = inout + optional = True [cccn] standard_name = cloud_condensation_nuclei_number_concentration_of_new_state long_name = number concentration of cloud condensation nuclei updated by physics @@ -315,6 +420,7 @@ type = real kind = kind_phys intent = inout + optional = True [cccna] standard_name = activated_cloud_condensation_nuclei_number_concentration_of_new_state long_name = number concentration of activated cloud condensation nuclei updated by physics @@ -323,6 +429,7 @@ type = real kind = kind_phys intent = inout + optional = True [ccw] standard_name = mass_number_concentration_of_cloud_liquid_water_particles_in_air_of_new_state long_name = cloud droplet number concentration @@ -331,6 +438,7 @@ type = real kind = kind_phys intent = inout + optional = True [crw] standard_name = mass_number_concentration_of_rain_of_new_state long_name = rain number concentration @@ -371,6 +479,7 @@ type = real kind = kind_phys intent = inout + optional = True [vh] standard_name = graupel_volume_of_new_state long_name = graupel particle volume @@ -379,6 +488,7 @@ type = real kind = kind_phys intent = inout + optional = True [vhl] standard_name = hail_volume_of_new_state long_name = hail particle volume @@ -387,6 +497,34 @@ type = real kind = kind_phys intent = inout + optional = True +[zrw] + standard_name = reflectivity_of_rain_of_new_state + long_name = rain reflectivity + units = m6 kg-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout + optional = True +[zhw] + standard_name = reflectivity_of_graupel_of_new_state + long_name = graupel reflectivity + units = m6 kg-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout + optional = True +[zhl] + standard_name = reflectivity_of_hail_of_new_state + long_name = hail reflectivity + units = m6 kg-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout + optional = True [tgrs] standard_name = air_temperature_of_new_state long_name = model layer mean temperature @@ -451,6 +589,7 @@ type = real kind = kind_phys intent = inout + optional = True [graupel] standard_name = lwe_thickness_of_graupel_amount long_name = graupel fall on physics timestep @@ -459,6 +598,7 @@ type = real kind = kind_phys intent = inout + optional = True [ice] standard_name = lwe_thickness_of_ice_amount long_name = ice fall on physics timestep @@ -467,6 +607,7 @@ type = real kind = kind_phys intent = inout + optional = True [snow] standard_name = lwe_thickness_of_snow_amount long_name = snow fall on physics timestep @@ -475,6 +616,7 @@ type = real kind = kind_phys intent = inout + optional = True [sr] standard_name = ratio_of_snowfall_to_rainfall long_name = ratio of snowfall to large-scale rainfall @@ -520,6 +662,7 @@ type = real kind = kind_phys intent = inout + optional = True [re_ice] standard_name = effective_radius_of_stratiform_cloud_ice_particle long_name = eff. radius of cloud ice water particle in micrometer @@ -528,6 +671,7 @@ type = real kind = kind_phys intent = inout + optional = True [re_snow] standard_name = effective_radius_of_stratiform_cloud_snow_particle long_name = effective radius of cloud snow particle in micrometer @@ -536,6 +680,7 @@ type = real kind = kind_phys intent = inout + optional = True [re_rain] standard_name = effective_radius_of_stratiform_cloud_rain_particle long_name = effective radius of cloud rain particle in micrometers @@ -544,6 +689,7 @@ type = real kind = kind_phys intent = inout + optional = True [nleffr] standard_name = index_of_cloud_liquid_water_effective_radius_in_xyz_dimensioned_restart_array long_name = the index of cloud liquid water effective radius in phy_f3d @@ -614,6 +760,13 @@ dimensions = () type = logical intent = in +[nssl_3moment] + standard_name = nssl_3moment + long_name = 3-moment activation flag in NSSL microphysics scheme + units = flag + dimensions = () + type = logical + intent = in [ntccn] standard_name = index_of_cloud_condensation_nuclei_number_concentration_in_tracer_concentration_array long_name = tracer index for cloud condensation nuclei number concentration diff --git a/physics/module_mp_thompson.F90 b/physics/MP/Thompson/module_mp_thompson.F90 similarity index 97% rename from physics/module_mp_thompson.F90 rename to physics/MP/Thompson/module_mp_thompson.F90 index 6a4ef5e02..3fc27ca4a 100644 --- a/physics/module_mp_thompson.F90 +++ b/physics/MP/Thompson/module_mp_thompson.F90 @@ -64,7 +64,7 @@ MODULE module_mp_thompson USE module_mp_radar #ifdef MPI - use mpi + use mpi_f08 #endif IMPLICIT NONE @@ -421,7 +421,7 @@ MODULE module_mp_thompson REAL:: t1_qs_me, t2_qs_me, t1_qg_me, t2_qg_me !..MPI communicator - INTEGER:: mpi_communicator + TYPE(MPI_Comm):: mpi_communicator !..Write tables with master MPI task after computing them in thompson_init LOGICAL:: thompson_table_writer @@ -448,7 +448,8 @@ SUBROUTINE thompson_init(is_aerosol_aware_in, & LOGICAL, INTENT(IN) :: is_aerosol_aware_in LOGICAL, INTENT(IN) :: merra2_aerosol_aware_in - INTEGER, INTENT(IN) :: mpicomm, mpirank, mpiroot + TYPE(MPI_Comm), INTENT(IN) :: mpicomm + INTEGER, INTENT(IN) :: mpirank, mpiroot INTEGER, INTENT(IN) :: threads CHARACTER(len=*), INTENT(INOUT) :: errmsg INTEGER, INTENT(INOUT) :: errflg @@ -708,9 +709,9 @@ SUBROUTINE thompson_init(is_aerosol_aware_in, & 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 2x min snow size) xDx(1) = D0i*1.0d0 - xDx(nbi+1) = 5.0d0*D0s + xDx(nbi+1) = 2.0d0*D0s do n = 2, nbi xDx(n) = DEXP(DFLOAT(n-1)/DFLOAT(nbi) & *DLOG(xDx(nbi+1)/xDx(1)) +DLOG(xDx(1))) @@ -993,6 +994,7 @@ SUBROUTINE mp_gt_driver(qv, qc, qr, qi, qs, qg, ni, nr, nc, & rainprod, evapprod, & #endif refl_10cm, diagflag, do_radar_ref, & + max_hail_diam_sfc, & vt_dbz_wt, first_time_step, & re_cloud, re_ice, re_snow, & has_reqc, has_reqi, has_reqs, & @@ -1044,9 +1046,10 @@ SUBROUTINE mp_gt_driver(qv, qc, qr, qi, qs, qg, ni, nr, nc, & re_cloud, re_ice, re_snow REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT):: pfils, pflls INTEGER, INTENT(IN) :: rand_perturb_on, kme_stoch, n_var_spp - REAL, DIMENSION(:,:), INTENT(IN) :: rand_pert - REAL, DIMENSION(:), INTENT(IN) :: spp_prt_list, spp_stddev_cutoff - CHARACTER(len=3), DIMENSION(:), INTENT(IN) :: spp_var_list + REAL, DIMENSION(:,:), INTENT(IN), OPTIONAL :: rand_pert + REAL, DIMENSION(:), INTENT(IN), OPTIONAL :: spp_prt_list + REAL, DIMENSION(:), INTENT(IN), OPTIONAL :: spp_stddev_cutoff + CHARACTER(len=10), DIMENSION(:), INTENT(IN), OPTIONAL :: spp_var_list INTEGER, INTENT(IN):: has_reqc, has_reqi, has_reqs #if ( WRF_CHEM == 1 ) REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT):: & @@ -1062,6 +1065,8 @@ SUBROUTINE mp_gt_driver(qv, qc, qr, qi, qs, qg, ni, nr, nc, & GRAUPELNC, GRAUPELNCV REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT):: & refl_10cm + REAL, DIMENSION(ims:ime, jms:jme), INTENT(INOUT):: & + max_hail_diam_sfc REAL, DIMENSION(ims:ime, kms:kme, jms:jme), OPTIONAL, INTENT(INOUT):: & vt_dbz_wt LOGICAL, INTENT(IN) :: first_time_step @@ -1074,7 +1079,7 @@ SUBROUTINE mp_gt_driver(qv, qc, qr, qi, qs, qg, ni, nr, nc, & ! Extended diagnostics, array pointers only associated if ext_diag flag is .true. LOGICAL, INTENT (IN) :: ext_diag LOGICAL, OPTIONAL, INTENT(IN):: aero_ind_fdb - REAL, DIMENSION(:,:,:), INTENT(INOUT):: & + REAL, DIMENSION(:,:,:), INTENT(INOUT), OPTIONAL :: & !vts1, txri, txrc, & prw_vcdc, & prw_vcde, tpri_inu, tpri_ide_d, & @@ -1416,6 +1421,7 @@ SUBROUTINE mp_gt_driver(qv, qc, qr, qi, qs, qg, ni, nr, nc, & qcten1(k) = 0. endif initialize_extended_diagnostics enddo + lsml = lsm(i,j) if (is_aerosol_aware .or. merra2_aerosol_aware) then do k = kts, kte nc1d(k) = nc(i,k,j) @@ -1423,7 +1429,6 @@ SUBROUTINE mp_gt_driver(qv, qc, qr, qi, qs, qg, ni, nr, nc, & nifa1d(k) = nifa(i,k,j) enddo else - lsml = lsm(i,j) do k = kts, kte if(lsml == 1) then nc1d(k) = Nt_c_l/rho(k) @@ -1509,6 +1514,14 @@ SUBROUTINE mp_gt_driver(qv, qc, qr, qi, qs, qg, ni, nr, nc, & enddo endif + if (merra2_aerosol_aware) then + do k = kts, kte + nc(i,k,j) = nc1d(k) + nwfa(i,k,j) = nwfa1d(k) + nifa(i,k,j) = nifa1d(k) + enddo + endif + do k = kts, kte qv(i,k,j) = qv1d(k) qc(i,k,j) = qc1d(k) @@ -1671,6 +1684,8 @@ SUBROUTINE mp_gt_driver(qv, qc, qr, qi, qs, qg, ni, nr, nc, & (nsteps>1 .and. istep==nsteps) .or. & (nsteps==1 .and. ndt==1)) THEN + max_hail_diam_sfc(i,j) = hail_mass_99th_percentile(kts, kte, qg1d, t1d, p1d, qv1d) + !> - Call calc_refl10cm() diagflag_present: IF ( PRESENT (diagflag) ) THEN @@ -1875,7 +1890,7 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & pfil1, pfll1) #ifdef MPI - use mpi + use mpi_f08 #endif implicit none @@ -1894,7 +1909,7 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & LOGICAL, INTENT(IN) :: ext_diag LOGICAL, INTENT(IN) :: sedi_semi INTEGER, INTENT(IN) :: decfl - REAL, DIMENSION(:), INTENT(OUT):: & + REAL, DIMENSION(:), INTENT(OUT), OPTIONAL :: & !vtsk1, txri1, txrc1, & prw_vcdc1, & prw_vcde1, tpri_inu1, tpri_ide1_d, & @@ -2456,17 +2471,7 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & !+---+-----------------------------------------------------------------+ !> - Calculate y-intercept, slope values for graupel. !+---+-----------------------------------------------------------------+ - do k = kte, kts, -1 - ygra1 = alog10(max(1.E-9, rg(k))) - zans1 = 3.4 + 2./7.*(ygra1+8.) + rand1 - N0_exp = 10.**(zans1) - N0_exp = MAX(DBLE(gonv_min), MIN(N0_exp, DBLE(gonv_max))) - lam_exp = (N0_exp*am_g*cgg(1)/rg(k))**oge1 - lamg = lam_exp * (cgg(3)*ogg2*ogg1)**obmg - ilamg(k) = 1./lamg - N0_g(k) = N0_exp/(cgg(2)*lam_exp) * lamg**cge(2) - enddo - + call graupel_psd_parameters(kts, kte, rand1, rg, ilamg, N0_g) endif !+---+-----------------------------------------------------------------+ @@ -2822,7 +2827,7 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & prr_rcg(k) = MIN(DBLE(rg(k)*odts), prr_rcg(k)) prg_rcg(k) = -prr_rcg(k) !> - Put in explicit drop break-up due to collisions. - pnr_rcg(k) = -5.*tnr_gacr(idx_g1,idx_g,idx_r1,idx_r) ! RAIN2M + pnr_rcg(k) = -1.5*tnr_gacr(idx_g1,idx_g,idx_r1,idx_r) ! RAIN2M endif endif endif @@ -3053,16 +3058,15 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & if (prr_sml(k) .gt. 0.) then prr_sml(k) = prr_sml(k) + 4218.*olfus*tempc & * (prr_rcs(k)+prs_scw(k)) - endif - prr_sml(k) = MIN(DBLE(rs(k)*odts), MAX(0.D0, prr_sml(k))) - pnr_sml(k) = smo0(k)/rs(k)*prr_sml(k) * 10.0**(-0.25*tempc) ! RAIN2M - pnr_sml(k) = MIN(DBLE(smo0(k)*odts), pnr_sml(k)) - - if (ssati(k).lt. 0.) then - prs_sde(k) = C_cube*t1_subl*diffu(k)*ssati(k)*rvs & - * (t1_qs_sd*smo1(k) & - + t2_qs_sd*rhof2(k)*vsc2(k)*smof(k)) - prs_sde(k) = MAX(DBLE(-rs(k)*odts), prs_sde(k)) + prr_sml(k) = MIN(DBLE(rs(k)*odts), prr_sml(k)) + pnr_sml(k) = smo0(k)/rs(k)*prr_sml(k) * 10.0**(-0.25*tempc) ! RAIN2M + pnr_sml(k) = MIN(DBLE(smo0(k)*odts), pnr_sml(k)) + elseif (ssati(k).lt. 0.) then + prr_sml(k) = 0.0 + prs_sde(k) = C_cube*t1_subl*diffu(k)*ssati(k)*rvs & + * (t1_qs_sd*smo1(k) & + + t2_qs_sd*rhof2(k)*vsc2(k)*smof(k)) + prs_sde(k) = MAX(DBLE(-rs(k)*odts), prs_sde(k)) endif endif @@ -3070,17 +3074,16 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & prr_gml(k) = (tempc*tcond(k)-lvap0*diffu(k)*delQvs(k)) & * N0_g(k)*(t1_qg_me*ilamg(k)**cge(10) & + t2_qg_me*rhof2(k)*vsc2(k)*ilamg(k)**cge(11)) -!-GT prr_gml(k) = prr_gml(k) + 4218.*olfus*tempc & -!-GT * (prr_rcg(k)+prg_gcw(k)) - prr_gml(k) = MIN(DBLE(rg(k)*odts), MAX(0.D0, prr_gml(k))) - pnr_gml(k) = N0_g(k)*cgg(2)*ilamg(k)**cge(2) / rg(k) & ! RAIN2M - * prr_gml(k) * 10.0**(-0.5*tempc) - - if (ssati(k).lt. 0.) then - prg_gde(k) = C_cube*t1_subl*diffu(k)*ssati(k)*rvs & - * N0_g(k) * (t1_qg_sd*ilamg(k)**cge(10) & - + t2_qg_sd*vsc2(k)*rhof2(k)*ilamg(k)**cge(11)) - prg_gde(k) = MAX(DBLE(-rg(k)*odts), prg_gde(k)) + if (prr_gml(k) .gt. 0.) then + prr_gml(k) = MIN(DBLE(rg(k)*odts), prr_gml(k)) + pnr_gml(k) = N0_g(k)*cgg(2)*ilamg(k)**cge(2) / rg(k) & ! RAIN2M + * prr_gml(k) * 10.0**(-0.5*tempc) + elseif (ssati(k).lt. 0.) then + prr_gml(k) = 0.0 + prg_gde(k) = C_cube*t1_subl*diffu(k)*ssati(k)*rvs & + * N0_g(k) * (t1_qg_sd*ilamg(k)**cge(10) & + + t2_qg_sd*vsc2(k)*rhof2(k)*ilamg(k)**cge(11)) + prg_gde(k) = MAX(DBLE(-rg(k)*odts), prg_gde(k)) endif endif @@ -3400,8 +3403,8 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & tcond(k) = (5.69 + 0.0168*tempc)*1.0E-5 * 418.936 ocp(k) = 1./(Cp*(1.+0.887*qv(k))) lvt2(k)=lvap(k)*lvap(k)*ocp(k)*oRv*otemp*otemp - - nwfa(k) = MAX(11.1E6*rho(k), (nwfa1d(k) + nwfaten(k)*DT)*rho(k)) + if (is_aerosol_aware) & + nwfa(k) = MAX(11.1E6*rho(k), (nwfa1d(k) + nwfaten(k)*DT)*rho(k)) enddo do k = kts, kte @@ -3535,17 +3538,7 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & !+---+-----------------------------------------------------------------+ !> - Calculate y-intercept, slope values for graupel. !+---+-----------------------------------------------------------------+ - do k = kte, kts, -1 - ygra1 = alog10(max(1.E-9, rg(k))) - zans1 = 3.4 + 2./7.*(ygra1+8.) + rand1 - N0_exp = 10.**(zans1) - N0_exp = MAX(DBLE(gonv_min), MIN(N0_exp, DBLE(gonv_max))) - lam_exp = (N0_exp*am_g*cgg(1)/rg(k))**oge1 - lamg = lam_exp * (cgg(3)*ogg2*ogg1)**obmg - ilamg(k) = 1./lamg - N0_g(k) = N0_exp/(cgg(2)*lam_exp) * lamg**cge(2) - enddo - + call graupel_psd_parameters(kts, kte, rand1, rg, ilamg, N0_g) endif !+---+-----------------------------------------------------------------+ @@ -3583,7 +3576,7 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & !+---+-----------------------------------------------------------------+ ! DROPLET NUCLEATION if (clap .gt. eps) then if (is_aerosol_aware .or. merra2_aerosol_aware) then - xnc = MAX(2., activ_ncloud(temp(k), w1d(k)+rand3, nwfa(k))) + xnc = MAX(2., activ_ncloud(temp(k), w1d(k)+rand3, nwfa(k), lsml)) else if(lsml == 1) then xnc = Nt_c_l @@ -3595,7 +3588,7 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & !+---+-----------------------------------------------------------------+ ! EVAPORATION elseif (clap .lt. -eps .AND. ssatw(k).lt.-1.E-6 .AND. & - (is_aerosol_aware .or. merra2_aerosol_aware)) then + is_aerosol_aware) then tempc = temp(k) - 273.15 otemp = 1./temp(k) rvs = rho(k)*qvs(k) @@ -3654,7 +3647,8 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & qvten(k) = qvten(k) - prw_vcd(k) qcten(k) = qcten(k) + prw_vcd(k) ncten(k) = ncten(k) + pnc_wcd(k) - nwfaten(k) = nwfaten(k) - pnc_wcd(k) + if (is_aerosol_aware) & + nwfaten(k) = nwfaten(k) - pnc_wcd(k) tten(k) = tten(k) + lvap(k)*ocp(k)*prw_vcd(k)*(1-IFDRY) rc(k) = MAX(R1, (qc1d(k) + DT*qcten(k))*rho(k)) if (rc(k).eq.R1) L_qc(k) = .false. @@ -3743,7 +3737,8 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & qrten(k) = qrten(k) - prv_rev(k) qvten(k) = qvten(k) + prv_rev(k) nrten(k) = nrten(k) - pnr_rev(k) - nwfaten(k) = nwfaten(k) + pnr_rev(k) + if (is_aerosol_aware) & + nwfaten(k) = nwfaten(k) + pnr_rev(k) tten(k) = tten(k) - lvap(k)*ocp(k)*prv_rev(k)*(1-IFDRY) rr(k) = MAX(R1, (qr1d(k) + DT*qrten(k))*rho(k)) @@ -4232,10 +4227,12 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & qv1d(k) = MAX(1.E-10, qv1d(k) + qvten(k)*DT) qc1d(k) = qc1d(k) + qcten(k)*DT nc1d(k) = MAX(2./rho(k), MIN(nc1d(k) + ncten(k)*DT, Nt_c_max)) - nwfa1d(k) = MAX(11.1E6, MIN(9999.E6, & - (nwfa1d(k)+nwfaten(k)*DT))) - nifa1d(k) = MAX(naIN1*0.01, MIN(9999.E6, & - (nifa1d(k)+nifaten(k)*DT))) + if (is_aerosol_aware) then + nwfa1d(k) = MAX(11.1E6, MIN(9999.E6, & + (nwfa1d(k)+nwfaten(k)*DT))) + nifa1d(k) = MAX(naIN1*0.01, MIN(9999.E6, & + (nifa1d(k)+nifaten(k)*DT))) + end if if (qc1d(k) .le. R1) then qc1d(k) = 0.0 nc1d(k) = 0.0 @@ -5356,14 +5353,15 @@ end subroutine table_ccnAct ! TO_DO ITEM: For radiation cooling producing fog, in which case the !.. updraft velocity could easily be negative, we could use the temp !.. and its tendency to diagnose a pretend postive updraft velocity. - real function activ_ncloud(Tt, Ww, NCCN) + real function activ_ncloud(Tt, Ww, NCCN, lsm_in) implicit none REAL, INTENT(IN):: Tt, Ww, NCCN + INTEGER, INTENT(IN):: lsm_in REAL:: n_local, w_local INTEGER:: i, j, k, l, m, n REAL:: A, B, C, D, t, u, x1, x2, y1, y2, nx, wy, fraction - + REAL:: lower_lim_nuc_frac ! ta_Na = (/10.0, 31.6, 100.0, 316.0, 1000.0, 3160.0, 10000.0/) ntb_arc ! ta_Ww = (/0.01, 0.0316, 0.1, 0.316, 1.0, 3.16, 10.0, 31.6, 100.0/) ntb_arw @@ -5410,6 +5408,14 @@ real function activ_ncloud(Tt, Ww, NCCN) l = 3 m = 2 + if (lsm_in .eq. 1) then ! land + lower_lim_nuc_frac = 0. + else if (lsm_in .eq. 0) then ! water + lower_lim_nuc_frac = 0.15 + else + lower_lim_nuc_frac = 0.15 ! catch-all for anything else + endif + A = tnccn_act(i-1,j-1,k,l,m) B = tnccn_act(i,j-1,k,l,m) C = tnccn_act(i,j,k,l,m) @@ -5424,7 +5430,8 @@ real function activ_ncloud(Tt, Ww, NCCN) ! u = (w_local-ta_Ww(j-1))/(ta_Ww(j)-ta_Ww(j-1)) fraction = (1.0-t)*(1.0-u)*A + t*(1.0-u)*B + t*u*C + (1.0-t)*u*D - + fraction = MAX(fraction, lower_lim_nuc_frac) + ! if (NCCN*fraction .gt. 0.75*Nt_c_max) then ! write(*,*) ' DEBUG-GT ', n_local, w_local, Tt, i, j, k ! endif @@ -6075,16 +6082,7 @@ subroutine calc_refl10cm (qv1d, qc1d, qr1d, nr1d, qs1d, qg1d, & !+---+-----------------------------------------------------------------+ if (ANY(L_qg .eqv. .true.)) then - do k = kte, kts, -1 - ygra1 = alog10(max(1.E-9, rg(k))) - zans1 = 3.4 + 2./7.*(ygra1+8.) + rand1 - N0_exp = 10.**(zans1) - N0_exp = MAX(DBLE(gonv_min), MIN(N0_exp, DBLE(gonv_max))) - lam_exp = (N0_exp*am_g*cgg(1)/rg(k))**oge1 - lamg = lam_exp * (cgg(3)*ogg2*ogg1)**obmg - ilamg(k) = 1./lamg - N0_g(k) = N0_exp/(cgg(2)*lam_exp) * lamg**cge(2) - enddo + call graupel_psd_parameters(kts, kte, rand1, rg, ilamg, N0_g) endif !+---+-----------------------------------------------------------------+ @@ -6461,6 +6459,88 @@ SUBROUTINE semi_lagrange_sedim(km,dzl,wwl,rql,precip,pfsan,dt,R1) END SUBROUTINE semi_lagrange_sedim +!>\ingroup aathompson +!! @brief Calculates graupel size distribution parameters +!! +!! Calculates graupel intercept and slope parameters for +!! for a vertical column +!! +!! @param[in] kts integer start index for vertical column +!! @param[in] kte integer end index for vertical column +!! @param[in] rand1 real random number for stochastic physics +!! @param[in] rg real array, size(kts:kte) for graupel mass concentration [kg m^3] +!! @param[out] ilamg double array, size(kts:kte) for inverse graupel slope parameter [m] +!! @param[out] N0_g double array, size(kts:kte) for graupel intercept paramter [m-4] +subroutine graupel_psd_parameters(kts, kte, rand1, rg, ilamg, N0_g) + + implicit none + + integer, intent(in) :: kts, kte + real, intent(in) :: rand1 + real, intent(in) :: rg(:) + double precision, intent(out) :: ilamg(:), N0_g(:) + + integer :: k + real :: ygra1, zans1 + double precision :: N0_exp, lam_exp, lamg + + do k = kte, kts, -1 + ygra1 = alog10(max(1.e-9, rg(k))) + zans1 = 3.4 + 2./7.*(ygra1+8.) + rand1 + N0_exp = 10.**(zans1) + N0_exp = max(dble(gonv_min), min(N0_exp, dble(gonv_max))) + lam_exp = (N0_exp*am_g*cgg(1)/rg(k))**oge1 + lamg = lam_exp * (cgg(3)*ogg2*ogg1)**obmg + ilamg(k) = 1./lamg + N0_g(k) = N0_exp/(cgg(2)*lam_exp) * lamg**cge(2) + enddo + +end subroutine graupel_psd_parameters + +!>\ingroup aathompson +!! @brief Calculates graupel/hail maximum diameter +!! +!! Calculates graupel/hail maximum diameter (currently the 99th percentile of mass distribtuion) +!! for a vertical column +!! +!! @param[in] kts integer start index for vertical column +!! @param[in] kte integer end index for vertical column +!! @param[in] qg real array, size(kts:kte) for graupel mass mixing ratio [kg kg^-1] +!! @param[in] temperature double array, size(kts:kte) temperature [K] +!! @param[in] pressure double array, size(kts:kte) pressure [Pa] +!! @param[in] qv real array, size(kts:kte) water vapor mixing ratio [kg kg^-1] +!! @param[out] max_hail_diam real maximum hail diameter [m] +function hail_mass_99th_percentile(kts, kte, qg, temperature, pressure, qv) result(max_hail_diam) + + implicit none + + integer, intent(in) :: kts, kte + real, intent(in) :: qg(:), temperature(:), pressure(:), qv(:) + real :: max_hail_diam + + integer :: k + real :: rho(kts:kte), rg(kts:kte), max_hail_column(kts:kte) + double precision :: ilamg(kts:kte), N0_g(kts:kte) + real, parameter :: random_number = 0. + + max_hail_column = 0. + rg = 0. + do k = kts, kte + rho(k) = 0.622*pressure(k)/(R*temperature(k)*(max(1.e-10, qv(k))+0.622)) + if (qg(k) .gt. R1) then + rg(k) = qg(k)*rho(k) + else + rg(k) = R1 + endif + enddo + + call graupel_psd_parameters(kts, kte, random_number, rg, ilamg, N0_g) + + where(rg .gt. 1.e-9) max_hail_column = 10.05 * ilamg + max_hail_diam = max_hail_column(kts) + +end function hail_mass_99th_percentile + !+---+-----------------------------------------------------------------+ !+---+-----------------------------------------------------------------+ END MODULE module_mp_thompson diff --git a/physics/module_mp_thompson_make_number_concentrations.F90 b/physics/MP/Thompson/module_mp_thompson_make_number_concentrations.F90 similarity index 100% rename from physics/module_mp_thompson_make_number_concentrations.F90 rename to physics/MP/Thompson/module_mp_thompson_make_number_concentrations.F90 diff --git a/physics/mp_thompson.F90 b/physics/MP/Thompson/mp_thompson.F90 similarity index 84% rename from physics/mp_thompson.F90 rename to physics/MP/Thompson/mp_thompson.F90 index e62e8a596..444790324 100644 --- a/physics/mp_thompson.F90 +++ b/physics/MP/Thompson/mp_thompson.F90 @@ -6,6 +6,7 @@ !! This module contains the aerosol-aware Thompson microphysics scheme. module mp_thompson + use mpi_f08 use machine, only : kind_phys use module_mp_thompson, only : thompson_init, mp_gt_driver, thompson_finalize, calc_effectRad @@ -63,11 +64,11 @@ subroutine mp_thompson_init(ncol, nlev, con_g, con_rd, con_eps, & ! Aerosols logical, intent(in ) :: is_aerosol_aware logical, intent(in ) :: merra2_aerosol_aware - real(kind_phys), intent(inout) :: nc(:,:) - real(kind_phys), intent(inout) :: nwfa(:,:) - real(kind_phys), intent(inout) :: nifa(:,:) - real(kind_phys), intent(inout) :: nwfa2d(:) - real(kind_phys), intent(inout) :: nifa2d(:) + real(kind_phys), intent(inout), optional :: nc(:,:) + real(kind_phys), intent(inout), optional :: nwfa(:,:) + real(kind_phys), intent(inout), optional :: nifa(:,:) + real(kind_phys), intent(inout), optional :: nwfa2d(:) + real(kind_phys), intent(inout), optional :: nifa2d(:) real(kind_phys), intent(in) :: aerfld(:,:,:) ! State variables real(kind_phys), intent(in ) :: tgrs(:,:) @@ -75,14 +76,14 @@ subroutine mp_thompson_init(ncol, nlev, con_g, con_rd, con_eps, & real(kind_phys), intent(in ) :: phil(:,:) real(kind_phys), intent(in ) :: area(:) ! MPI information - integer, intent(in ) :: mpicomm + type(MPI_Comm), intent(in ) :: mpicomm integer, intent(in ) :: mpirank integer, intent(in ) :: mpiroot ! Threading/blocking information integer, intent(in ) :: threads ! Extended diagnostics logical, intent(in ) :: ext_diag - real(kind_phys), intent(in ) :: diag3d(:,:,:) + real(kind_phys), intent(in ), optional :: diag3d(:,:,:) ! CCPP error handling character(len=*), intent( out) :: errmsg integer, intent( out) :: errflg @@ -151,6 +152,10 @@ subroutine mp_thompson_init(ncol, nlev, con_g, con_rd, con_eps, & !> - Convert specific humidity to water vapor mixing ratio. !> - Also, hydrometeor variables are mass or number mixing ratio !> - either kg of species per kg of dry air, or per kg of (dry + vapor). + if (merra2_aerosol_aware) then + call get_niwfa(aerfld, nifa, nwfa, ncol, nlev) + end if + qv = spechum/(1.0_kind_phys-spechum) @@ -163,7 +168,7 @@ subroutine mp_thompson_init(ncol, nlev, con_g, con_rd, con_eps, & ni = ni/(1.0_kind_phys-spechum) nr = nr/(1.0_kind_phys-spechum) - if (is_aerosol_aware) then + if (is_aerosol_aware .or. merra2_aerosol_aware) then nc = nc/(1.0_kind_phys-spechum) nwfa = nwfa/(1.0_kind_phys-spechum) nifa = nifa/(1.0_kind_phys-spechum) @@ -208,8 +213,6 @@ subroutine mp_thompson_init(ncol, nlev, con_g, con_rd, con_eps, & nwfa(i,k) = naCCN1+naCCN0*exp(-((hgt(i,k)-hgt(i,1))/1000.)*niCCN3) enddo enddo - else if (merra2_aerosol_aware) then - call get_niwfa(aerfld, nifa, nwfa, ncol, nlev) else if (mpirank==mpiroot) write(*,*) ' Apparently initial CCN aerosols are present.' if (MAXVAL(nwfa2d) .lt. eps) then @@ -327,6 +330,7 @@ subroutine mp_thompson_run(ncol, nlev, con_g, con_rd, & first_time_step, istep, nsteps, & prcp, rain, graupel, ice, snow, sr, & refl_10cm, fullradar_diag, & + max_hail_diam_sfc, & do_radar_ref, aerfld, & mpicomm, mpirank, mpiroot, blkno, & ext_diag, diag3d, reset_diag3d, & @@ -378,24 +382,25 @@ subroutine mp_thompson_run(ncol, nlev, con_g, con_rd, & real, intent(in ) :: dt_inner ! Precip/rain/snow/graupel fall amounts and fraction of frozen precip real(kind_phys), intent(inout) :: prcp(:) - real(kind_phys), intent(inout) :: rain(:) - real(kind_phys), intent(inout) :: graupel(:) - real(kind_phys), intent(inout) :: ice(:) - real(kind_phys), intent(inout) :: snow(:) + real(kind_phys), intent(inout), optional :: rain(:) + real(kind_phys), intent(inout), optional :: graupel(:) + real(kind_phys), intent(inout), optional :: ice(:) + real(kind_phys), intent(inout), optional :: snow(:) real(kind_phys), intent( out) :: sr(:) ! Radar reflectivity real(kind_phys), intent(inout) :: refl_10cm(:,:) + real(kind_phys), intent(inout) :: max_hail_diam_sfc(:) logical, intent(in ) :: do_radar_ref logical, intent(in) :: sedi_semi integer, intent(in) :: decfl ! MPI and block information integer, intent(in) :: blkno - integer, intent(in) :: mpicomm + type(MPI_Comm), intent(in) :: mpicomm integer, intent(in) :: mpirank integer, intent(in) :: mpiroot ! Extended diagnostic output logical, intent(in) :: ext_diag - real(kind_phys), target, intent(inout) :: diag3d(:,:,:) + real(kind_phys), target, intent(inout), optional :: diag3d(:,:,:) logical, intent(in) :: reset_diag3d ! CCPP error handling @@ -405,15 +410,15 @@ subroutine mp_thompson_run(ncol, nlev, con_g, con_rd, & ! SPP integer, intent(in) :: spp_mp integer, intent(in) :: n_var_spp - real(kind_phys), intent(in) :: spp_wts_mp(:,:) - real(kind_phys), intent(in) :: spp_prt_list(:) - character(len=3), intent(in) :: spp_var_list(:) - real(kind_phys), intent(in) :: spp_stddev_cutoff(:) + real(kind_phys), intent(in), optional :: spp_wts_mp(:,:) + real(kind_phys), intent(in), optional :: spp_prt_list(:) + character(len=10), intent(in), optional :: spp_var_list(:) + real(kind_phys), intent(in), optional :: spp_stddev_cutoff(:) logical, intent (in) :: cplchm ! ice and liquid water 3d precipitation fluxes - only allocated if cplchm is .true. - real(kind=kind_phys), intent(inout), dimension(:,:) :: pfi_lsan - real(kind=kind_phys), intent(inout), dimension(:,:) :: pfl_lsan + real(kind=kind_phys), intent(inout), dimension(:,:), optional :: pfi_lsan + real(kind=kind_phys), intent(inout), dimension(:,:), optional :: pfl_lsan ! Local variables @@ -555,6 +560,9 @@ subroutine mp_thompson_run(ncol, nlev, con_g, con_rd, & else dtstep = dtp end if + if (merra2_aerosol_aware) then + call get_niwfa(aerfld, nifa, nwfa, ncol, nlev) + end if !> - Convert specific humidity to water vapor mixing ratio. !> - Also, hydrometeor variables are mass or number mixing ratio @@ -574,7 +582,7 @@ subroutine mp_thompson_run(ncol, nlev, con_g, con_rd, & ni = ni/(1.0_kind_phys-spechum) nr = nr/(1.0_kind_phys-spechum) - if (is_aerosol_aware) then + if (is_aerosol_aware .or. merra2_aerosol_aware) then nc = nc/(1.0_kind_phys-spechum) nwfa = nwfa/(1.0_kind_phys-spechum) nifa = nifa/(1.0_kind_phys-spechum) @@ -681,11 +689,8 @@ subroutine mp_thompson_run(ncol, nlev, con_g, con_rd, & ncten3 => diag3d(:,:,36:36) qcten3 => diag3d(:,:,37:37) end if set_extended_diagnostic_pointers - if (merra2_aerosol_aware) then - call get_niwfa(aerfld, nifa, nwfa, ncol, nlev) - end if !> - Call mp_gt_driver() with or without aerosols, with or without effective radii, ... - if (is_aerosol_aware .or. merra2_aerosol_aware) then + if (is_aerosol_aware) then call mp_gt_driver(qv=qv, qc=qc, qr=qr, qi=qi, qs=qs, qg=qg, ni=ni, nr=nr, & nc=nc, nwfa=nwfa, nifa=nifa, nwfa2d=nwfa2d, nifa2d=nifa2d, & tt=tgrs, p=prsl, w=w, dz=dz, dt_in=dtstep, dt_inner=dt_inner, & @@ -696,6 +701,7 @@ 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, & + max_hail_diam_sfc=max_hail_diam_sfc, & has_reqc=has_reqc, has_reqi=has_reqi, has_reqs=has_reqs, & aero_ind_fdb=aero_ind_fdb, rand_perturb_on=spp_mp_opt, & kme_stoch=kme_stoch, & @@ -726,6 +732,48 @@ subroutine mp_thompson_run(ncol, nlev, con_g, con_rd, & qvten3=qvten3, qrten3=qrten3, qsten3=qsten3, qgten3=qgten3, & qiten3=qiten3, niten3=niten3, nrten3=nrten3, ncten3=ncten3, & qcten3=qcten3, pfils=pfils, pflls=pflls) + else if (merra2_aerosol_aware) then + call mp_gt_driver(qv=qv, qc=qc, qr=qr, qi=qi, qs=qs, qg=qg, ni=ni, nr=nr, & + nc=nc, nwfa=nwfa, nifa=nifa, & + tt=tgrs, p=prsl, w=w, dz=dz, dt_in=dtstep, dt_inner=dt_inner, & + sedi_semi=sedi_semi, decfl=decfl, lsm=islmsk, & + rainnc=rain_mp, rainncv=delta_rain_mp, & + snownc=snow_mp, snowncv=delta_snow_mp, & + icenc=ice_mp, icencv=delta_ice_mp, & + graupelnc=graupel_mp, graupelncv=delta_graupel_mp, sr=sr, & + refl_10cm=refl_10cm, & + diagflag=diagflag, do_radar_ref=do_radar_ref_mp, & + max_hail_diam_sfc=max_hail_diam_sfc, & + has_reqc=has_reqc, has_reqi=has_reqi, has_reqs=has_reqs, & + aero_ind_fdb=aero_ind_fdb, rand_perturb_on=spp_mp_opt, & + kme_stoch=kme_stoch, & + rand_pert=spp_wts_mp, spp_var_list=spp_var_list, & + spp_prt_list=spp_prt_list, n_var_spp=n_var_spp, & + spp_stddev_cutoff=spp_stddev_cutoff, & + ids=ids, ide=ide, jds=jds, jde=jde, kds=kds, kde=kde, & + ims=ims, ime=ime, jms=jms, jme=jme, kms=kms, kme=kme, & + its=its, ite=ite, jts=jts, jte=jte, kts=kts, kte=kte, & + fullradar_diag=fullradar_diag, istep=istep, nsteps=nsteps, & + first_time_step=first_time_step, errmsg=errmsg, errflg=errflg, & + ! Extended diagnostics + ext_diag=ext_diag, & + ! vts1=vts1, txri=txri, txrc=txrc, & + prw_vcdc=prw_vcdc, & + prw_vcde=prw_vcde, tpri_inu=tpri_inu, tpri_ide_d=tpri_ide_d, & + tpri_ide_s=tpri_ide_s, tprs_ide=tprs_ide, & + tprs_sde_d=tprs_sde_d, & + tprs_sde_s=tprs_sde_s, tprg_gde_d=tprg_gde_d, & + tprg_gde_s=tprg_gde_s, tpri_iha=tpri_iha, & + tpri_wfz=tpri_wfz, tpri_rfz=tpri_rfz, tprg_rfz=tprg_rfz, & + tprs_scw=tprs_scw, tprg_scw=tprg_scw, tprg_rcs=tprg_rcs, & + tprs_rcs=tprs_rcs, & + tprr_rci=tprr_rci, tprg_rcg=tprg_rcg, tprw_vcd_c=tprw_vcd_c, & + tprw_vcd_e=tprw_vcd_e, tprr_sml=tprr_sml, tprr_gml=tprr_gml, & + tprr_rcg=tprr_rcg, tprr_rcs=tprr_rcs, & + tprv_rev=tprv_rev, tten3=tten3, & + qvten3=qvten3, qrten3=qrten3, qsten3=qsten3, qgten3=qgten3, & + qiten3=qiten3, niten3=niten3, nrten3=nrten3, ncten3=ncten3, & + qcten3=qcten3, pfils=pfils, pflls=pflls) else call mp_gt_driver(qv=qv, qc=qc, qr=qr, qi=qi, qs=qs, qg=qg, ni=ni, nr=nr, & tt=tgrs, p=prsl, w=w, dz=dz, dt_in=dtstep, dt_inner=dt_inner, & @@ -736,6 +784,7 @@ 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, & + max_hail_diam_sfc=max_hail_diam_sfc, & has_reqc=has_reqc, has_reqi=has_reqi, has_reqs=has_reqs, & rand_perturb_on=spp_mp_opt, kme_stoch=kme_stoch, & rand_pert=spp_wts_mp, spp_var_list=spp_var_list, & @@ -812,48 +861,53 @@ subroutine mp_thompson_run(ncol, nlev, con_g, con_rd, & pfl_lsan(:,:) = pflls(:,:,1) end if - unset_extended_diagnostic_pointers: if (ext_diag) then - !vts1 => null() - !txri => null() - !txrc => null() - prw_vcdc => null() - prw_vcde => null() - tpri_inu => null() - tpri_ide_d => null() - tpri_ide_s => null() - tprs_ide => null() - tprs_sde_d => null() - tprs_sde_s => null() - tprg_gde_d => null() - tprg_gde_s => null() - tpri_iha => null() - tpri_wfz => null() - tpri_rfz => null() - tprg_rfz => null() - tprs_scw => null() - tprg_scw => null() - tprg_rcs => null() - tprs_rcs => null() - tprr_rci => null() - tprg_rcg => null() - tprw_vcd_c => null() - tprw_vcd_e => null() - tprr_sml => null() - tprr_gml => null() - tprr_rcg => null() - tprr_rcs => null() - tprv_rev => null() - tten3 => null() - qvten3 => null() - qrten3 => null() - qsten3 => null() - qgten3 => null() - qiten3 => null() - niten3 => null() - nrten3 => null() - ncten3 => null() - qcten3 => null() - end if unset_extended_diagnostic_pointers + ! DH* Not really needed because they go out of scope ... + ! But having them in here seems to cause problems with Intel? + ! It looked like this is also nullifying the pointers passed + ! from the CCPP caps. + !unset_extended_diagnostic_pointers: if (ext_diag) then + ! !vts1 => null() + ! !txri => null() + ! !txrc => null() + ! prw_vcdc => null() + ! prw_vcde => null() + ! tpri_inu => null() + ! tpri_ide_d => null() + ! tpri_ide_s => null() + ! tprs_ide => null() + ! tprs_sde_d => null() + ! tprs_sde_s => null() + ! tprg_gde_d => null() + ! tprg_gde_s => null() + ! tpri_iha => null() + ! tpri_wfz => null() + ! tpri_rfz => null() + ! tprg_rfz => null() + ! tprs_scw => null() + ! tprg_scw => null() + ! tprg_rcs => null() + ! tprs_rcs => null() + ! tprr_rci => null() + ! tprg_rcg => null() + ! tprw_vcd_c => null() + ! tprw_vcd_e => null() + ! tprr_sml => null() + ! tprr_gml => null() + ! tprr_rcg => null() + ! tprr_rcs => null() + ! tprv_rev => null() + ! tten3 => null() + ! qvten3 => null() + ! qrten3 => null() + ! qsten3 => null() + ! qgten3 => null() + ! qiten3 => null() + ! niten3 => null() + ! nrten3 => null() + ! ncten3 => null() + ! qcten3 => null() + !end if unset_extended_diagnostic_pointers + ! *DH end subroutine mp_thompson_run !>@} @@ -921,8 +975,8 @@ subroutine get_niwfa(aerfld, nifa, nwfa, ncol, nlev) aerfld(:,:,4)/1011.5142+ aerfld(:,:,5)/5683.3501)*1.e15 nwfa=((aerfld(:,:,6)/0.0045435214+aerfld(:,:,7)/0.2907854+aerfld(:,:,8)/12.91224+ & - aerfld(:,:,9)/206.2216+ aerfld(:,:,10)/4326.23)*1.+aerfld(:,:,11)/0.3053104*5+ & - aerfld(:,:,15)/0.3232698*1)*1.e15 + aerfld(:,:,9)/206.2216+ aerfld(:,:,10)/4326.23)*9.+aerfld(:,:,11)/0.3053104*5+ & + aerfld(:,:,15)/0.3232698*8)*1.e15 end subroutine get_niwfa end module mp_thompson diff --git a/physics/mp_thompson.meta b/physics/MP/Thompson/mp_thompson.meta similarity index 96% rename from physics/mp_thompson.meta rename to physics/MP/Thompson/mp_thompson.meta index 691698281..7d750ee93 100644 --- a/physics/mp_thompson.meta +++ b/physics/MP/Thompson/mp_thompson.meta @@ -1,7 +1,9 @@ [ccpp-table-properties] name = mp_thompson type = scheme - dependencies = machine.F,module_mp_radar.F90,module_mp_thompson.F90,module_mp_thompson_make_number_concentrations.F90 + dependencies = ../../hooks/machine.F + dependencies = ../module_mp_radar.F90 + dependencies = module_mp_thompson.F90,module_mp_thompson_make_number_concentrations.F90 ######################################################################## [ccpp-arg-table] @@ -159,6 +161,7 @@ type = real kind = kind_phys intent = inout + optional = True [nwfa2d] standard_name = tendency_of_hygroscopic_aerosols_at_surface_adjacent_layer long_name = instantaneous fake water-friendly surface aerosol source @@ -167,6 +170,7 @@ type = real kind = kind_phys intent = inout + optional = True [nifa2d] standard_name = tendency_of_nonhygroscopic_ice_nucleating_aerosols_at_surface_adjacent_layer long_name = instantaneous fake ice-friendly surface aerosol source @@ -175,6 +179,7 @@ type = real kind = kind_phys intent = inout + optional = True [nwfa] standard_name = mass_number_concentration_of_hygroscopic_aerosols long_name = number concentration of water-friendly aerosols @@ -183,6 +188,7 @@ type = real kind = kind_phys intent = inout + optional = True [nifa] standard_name = mass_number_concentration_of_nonhygroscopic_ice_nucleating_aerosols long_name = number concentration of ice-friendly aerosols @@ -191,6 +197,7 @@ type = real kind = kind_phys intent = inout + optional = True [tgrs] standard_name = air_temperature long_name = model layer mean temperature @@ -236,7 +243,7 @@ long_name = MPI communicator units = index dimensions = () - type = integer + type = MPI_Comm intent = in [mpirank] standard_name = mpi_rank @@ -274,6 +281,7 @@ type = real kind = kind_phys intent = in + optional = True [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP @@ -425,6 +433,7 @@ type = real kind = kind_phys intent = inout + optional = True [nwfa] standard_name = mass_number_concentration_of_hygroscopic_aerosols_of_new_state long_name = number concentration of water-friendly aerosols @@ -433,6 +442,7 @@ type = real kind = kind_phys intent = inout + optional = True [nifa] standard_name = mass_number_concentration_of_nonhygroscopic_ice_nucleating_aerosols_of_new_state long_name = number concentration of ice-friendly aerosols @@ -441,6 +451,7 @@ type = real kind = kind_phys intent = inout + optional = True [nwfa2d] standard_name = tendency_of_hygroscopic_aerosols_at_surface_adjacent_layer long_name = instantaneous fake water-friendly surface aerosol source @@ -449,6 +460,7 @@ type = real kind = kind_phys intent = in + optional = True [nifa2d] standard_name = tendency_of_nonhygroscopic_ice_nucleating_aerosols_at_surface_adjacent_layer long_name = instantaneous fake ice-friendly surface aerosol source @@ -457,6 +469,7 @@ type = real kind = kind_phys intent = in + optional = True [aero_ind_fdb] standard_name = do_smoke_aerosol_indirect_feedback long_name = flag for wfa ifa emission indirect feedback @@ -570,6 +583,7 @@ type = real kind = kind_phys intent = inout + optional = True [graupel] standard_name = lwe_thickness_of_graupel_amount long_name = graupel fall on physics timestep @@ -578,6 +592,7 @@ type = real kind = kind_phys intent = inout + optional = True [ice] standard_name = lwe_thickness_of_ice_amount long_name = ice fall on physics timestep @@ -586,6 +601,7 @@ type = real kind = kind_phys intent = inout + optional = True [snow] standard_name = lwe_thickness_of_snow_amount long_name = snow fall on physics timestep @@ -594,6 +610,7 @@ type = real kind = kind_phys intent = inout + optional = True [sr] standard_name = ratio_of_snowfall_to_rainfall long_name = ratio of snowfall to large-scale rainfall @@ -610,6 +627,14 @@ type = real kind = kind_phys intent = out +[max_hail_diam_sfc] + standard_name = max_hail_diameter_sfc + long_name = instantaneous maximum hail diameter at lowest model level + units = m + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout [fullradar_diag] standard_name = do_full_radar_reflectivity long_name = flag for computing full radar reflectivity @@ -637,7 +662,7 @@ long_name = MPI communicator units = index dimensions = () - type = integer + type = MPI_Comm intent = in [mpirank] standard_name = mpi_rank @@ -675,6 +700,7 @@ type = real kind = kind_phys intent = inout + optional = True [reset_diag3d] standard_name = flag_reset_extended_diagnostics_output_arrays_from_thompson_microphysics long_name = flag for resetting extended diagnostics output arrays from thompson microphysics @@ -689,6 +715,7 @@ dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real intent = in + optional = True [spp_mp] standard_name = control_for_microphysics_spp_perturbations long_name = control for microphysics spp perturbations @@ -711,6 +738,7 @@ type = real kind = kind_phys intent = in + optional = True [spp_stddev_cutoff] standard_name = magnitude_of_spp_standard_deviation_cutoff long_name = magnitude of spp standard deviation cutoff @@ -719,14 +747,16 @@ type = real kind = kind_phys intent = in + optional = True [spp_var_list] standard_name = perturbed_spp_schemes long_name = perturbed spp schemes units = none dimensions = (number_of_perturbed_spp_schemes) type = character - kind = len=3 + kind = len=10 intent = in + optional = True [cplchm] standard_name = flag_for_chemistry_coupling long_name = flag controlling cplchm collection (default off) @@ -742,6 +772,7 @@ type = real kind = kind_phys intent = inout + optional = True [pfl_lsan] standard_name = liquid_flux_due_to_large_scale_precipitation long_name = instantaneous 3D flux of liquid water from nonconvective precipitation @@ -750,6 +781,7 @@ type = real kind = kind_phys intent = inout + optional = True [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/mp_thompson_post.F90 b/physics/MP/Thompson/mp_thompson_post.F90 similarity index 98% rename from physics/mp_thompson_post.F90 rename to physics/MP/Thompson/mp_thompson_post.F90 index 392f734a5..c48c932f7 100644 --- a/physics/mp_thompson_post.F90 +++ b/physics/MP/Thompson/mp_thompson_post.F90 @@ -1,5 +1,6 @@ module mp_thompson_post + use mpi_f08 use machine, only : kind_phys implicit none @@ -66,7 +67,7 @@ subroutine mp_thompson_post_run(ncol, nlev, tgrs_save, tgrs, prslk, dtp, ttendli real(kind_phys), intent(in) :: ttendlim integer, intent(in) :: kdt ! MPI information - integer, intent(in ) :: mpicomm + type(MPI_Comm), intent(in ) :: mpicomm integer, intent(in ) :: mpirank integer, intent(in ) :: mpiroot ! CCPP error handling diff --git a/physics/mp_thompson_post.meta b/physics/MP/Thompson/mp_thompson_post.meta similarity index 98% rename from physics/mp_thompson_post.meta rename to physics/MP/Thompson/mp_thompson_post.meta index 82b035e99..85704316f 100644 --- a/physics/mp_thompson_post.meta +++ b/physics/MP/Thompson/mp_thompson_post.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = mp_thompson_post type = scheme - dependencies = machine.F + dependencies = ../../hooks/machine.F ######################################################################## [ccpp-arg-table] @@ -101,7 +101,7 @@ long_name = MPI communicator units = index dimensions = () - type = integer + type = MPI_Comm intent = in [mpirank] standard_name = mpi_rank diff --git a/physics/mp_thompson_pre.F90 b/physics/MP/Thompson/mp_thompson_pre.F90 similarity index 100% rename from physics/mp_thompson_pre.F90 rename to physics/MP/Thompson/mp_thompson_pre.F90 diff --git a/physics/mp_thompson_pre.meta b/physics/MP/Thompson/mp_thompson_pre.meta similarity index 97% rename from physics/mp_thompson_pre.meta rename to physics/MP/Thompson/mp_thompson_pre.meta index 12e812bb3..563eb2809 100644 --- a/physics/mp_thompson_pre.meta +++ b/physics/MP/Thompson/mp_thompson_pre.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = mp_thompson_pre type = scheme - dependencies = machine.F + dependencies = ../../hooks/machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/zhaocarr_gscond.f b/physics/MP/Zhao_Carr/zhaocarr_gscond.f similarity index 99% rename from physics/zhaocarr_gscond.f rename to physics/MP/Zhao_Carr/zhaocarr_gscond.f index 50f9358f4..2f70aa2f0 100644 --- a/physics/zhaocarr_gscond.f +++ b/physics/MP/Zhao_Carr/zhaocarr_gscond.f @@ -100,10 +100,10 @@ subroutine zhaocarr_gscond_run (im,km,dt,dtf,prsl,ps,q,clw1 & integer, intent(in) :: im, km, ipr real(kind=kind_phys), intent(in) :: dt, dtf real(kind=kind_phys), intent(in) :: prsl(:,:), ps(:) - real(kind=kind_phys), intent(inout) :: q(:,:) + real(kind=kind_phys), intent(inout) :: q(:,:), t(:,:) real(kind=kind_phys), intent(in) :: clw1(:,:), clw2(:,:) real(kind=kind_phys), intent(out) :: cwm(:,:) - real(kind=kind_phys), intent(inout) :: t(:,:) & + real(kind=kind_phys), intent(inout), optional :: & &, tp(:,:), qp(:,:), psp(:) & &, tp1(:,:), qp1(:,:), psp1(:) real(kind=kind_phys), intent(in) :: u(:,:) diff --git a/physics/zhaocarr_gscond.meta b/physics/MP/Zhao_Carr/zhaocarr_gscond.meta similarity index 97% rename from physics/zhaocarr_gscond.meta rename to physics/MP/Zhao_Carr/zhaocarr_gscond.meta index 493397722..b8cb2ea64 100644 --- a/physics/zhaocarr_gscond.meta +++ b/physics/MP/Zhao_Carr/zhaocarr_gscond.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = zhaocarr_gscond type = scheme - dependencies = funcphys.f90,machine.F,physcons.F90 + dependencies = ../../tools/funcphys.f90,../../hooks/machine.F,../../hooks/physcons.F90 ######################################################################## [ccpp-arg-table] @@ -141,6 +141,7 @@ type = real kind = kind_phys intent = inout + optional = True [qp] standard_name = specific_humidity_two_timesteps_back long_name = water vapor specific humidity two timesteps back @@ -149,6 +150,7 @@ type = real kind = kind_phys intent = inout + optional = True [psp] standard_name = surface_air_pressure_two_timesteps_back long_name = surface air pressure two timesteps back @@ -157,6 +159,7 @@ type = real kind = kind_phys intent = inout + optional = True [psat] standard_name = saturation_pressure_at_triple_point_of_water long_name = saturation pressure at triple point of water @@ -245,6 +248,7 @@ type = real kind = kind_phys intent = inout + optional = True [qp1] standard_name = specific_humidity_on_previous_timestep_in_xyz_dimensioned_restart_array long_name = water vapor specific humidity at previous timestep @@ -253,6 +257,7 @@ type = real kind = kind_phys intent = inout + optional = True [psp1] standard_name = surface_air_pressure_on_previous_timestep long_name = surface air surface pressure at previous timestep @@ -261,6 +266,7 @@ type = real kind = kind_phys intent = inout + optional = True [u] standard_name = critical_relative_humidity long_name = critical relative humidity diff --git a/physics/zhaocarr_precpd.f b/physics/MP/Zhao_Carr/zhaocarr_precpd.f similarity index 100% rename from physics/zhaocarr_precpd.f rename to physics/MP/Zhao_Carr/zhaocarr_precpd.f diff --git a/physics/zhaocarr_precpd.meta b/physics/MP/Zhao_Carr/zhaocarr_precpd.meta similarity index 98% rename from physics/zhaocarr_precpd.meta rename to physics/MP/Zhao_Carr/zhaocarr_precpd.meta index 67f1a530b..86e6c7d67 100644 --- a/physics/zhaocarr_precpd.meta +++ b/physics/MP/Zhao_Carr/zhaocarr_precpd.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = zhaocarr_precpd type = scheme - dependencies = funcphys.f90,machine.F,physcons.F90 + dependencies = ../../tools/funcphys.f90,../../hooks/machine.F,../../hooks/physcons.F90 ######################################################################## [ccpp-arg-table] diff --git a/physics/calpreciptype.f90 b/physics/MP/calpreciptype.f90 similarity index 100% rename from physics/calpreciptype.f90 rename to physics/MP/calpreciptype.f90 diff --git a/physics/module_mp_radar.F90 b/physics/MP/module_mp_radar.F90 similarity index 100% rename from physics/module_mp_radar.F90 rename to physics/MP/module_mp_radar.F90 diff --git a/physics/hedmf.f b/physics/PBL/HEDMF/hedmf.f similarity index 99% rename from physics/hedmf.f rename to physics/PBL/HEDMF/hedmf.f index 4b010a121..b75526ba6 100644 --- a/physics/hedmf.f +++ b/physics/PBL/HEDMF/hedmf.f @@ -104,7 +104,7 @@ subroutine hedmf_run (im,km,ntrac,ntcw,dv,du,tau,rtg, & real(kind=kind_phys), intent(inout) :: dv(:,:), du(:,:), & & tau(:,:), rtg(:,:,:) ! dtend is only allocated if ldiag3d or qdiag3d are true - real(kind=kind_phys), intent(inout) :: dtend(:,:,:) + real(kind=kind_phys), intent(inout), optional :: dtend(:,:,:) integer, intent(in) :: dtidx(:,:) integer, intent(in) :: index_of_x_wind, index_of_y_wind, & & index_of_process_pbl, index_of_temperature, ntqv, rtg_ozone_index diff --git a/physics/hedmf.meta b/physics/PBL/HEDMF/hedmf.meta similarity index 99% rename from physics/hedmf.meta rename to physics/PBL/HEDMF/hedmf.meta index c2d873065..3d9b492c0 100644 --- a/physics/hedmf.meta +++ b/physics/PBL/HEDMF/hedmf.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = hedmf type = scheme - dependencies = funcphys.f90,machine.F,mfpbl.f,physcons.F90,tridi.f + dependencies = ../../tools/funcphys.f90,../../hooks/machine.F,../../hooks/physcons.F90,../mfpbl.f,../tridi.f ######################################################################## [ccpp-arg-table] @@ -530,8 +530,8 @@ dimensions = (horizontal_loop_extent,vertical_layer_dimension,cumulative_change_of_state_variables_outer_index_max) type = real kind = kind_phys - active = (flag_for_diagnostics_3D) intent = inout + optional = True [dtidx] standard_name = cumulative_change_of_state_variables_outer_index long_name = index of state-variable and process in last dimension of diagnostic tendencies array AKA cumulative_change_index diff --git a/physics/module_BL_MYJPBL.F90 b/physics/PBL/MYJ/module_BL_MYJPBL.F90 similarity index 100% rename from physics/module_BL_MYJPBL.F90 rename to physics/PBL/MYJ/module_BL_MYJPBL.F90 diff --git a/physics/myjpbl_wrapper.F90 b/physics/PBL/MYJ/myjpbl_wrapper.F90 similarity index 100% rename from physics/myjpbl_wrapper.F90 rename to physics/PBL/MYJ/myjpbl_wrapper.F90 diff --git a/physics/myjpbl_wrapper.meta b/physics/PBL/MYJ/myjpbl_wrapper.meta similarity index 99% rename from physics/myjpbl_wrapper.meta rename to physics/PBL/MYJ/myjpbl_wrapper.meta index 427088b86..a4786f40a 100644 --- a/physics/myjpbl_wrapper.meta +++ b/physics/PBL/MYJ/myjpbl_wrapper.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = myjpbl_wrapper type = scheme - dependencies = module_BL_MYJPBL.F90 + dependencies = ../../hooks/machine.F,module_BL_MYJPBL.F90 ######################################################################## [ccpp-arg-table] @@ -594,6 +594,7 @@ type = real kind = kind_phys intent = inout + optional = True [dtidx] standard_name = cumulative_change_of_state_variables_outer_index long_name = index of state-variable and process in last dimension of diagnostic tendencies array AKA cumulative_change_index diff --git a/physics/bl_mynn_common.f90 b/physics/PBL/MYNN_EDMF/bl_mynn_common.f90 similarity index 100% rename from physics/bl_mynn_common.f90 rename to physics/PBL/MYNN_EDMF/bl_mynn_common.f90 diff --git a/physics/module_bl_mynn.F90 b/physics/PBL/MYNN_EDMF/module_bl_mynn.F90 similarity index 85% rename from physics/module_bl_mynn.F90 rename to physics/PBL/MYNN_EDMF/module_bl_mynn.F90 index ec6b5700d..4983fc796 100644 --- a/physics/module_bl_mynn.F90 +++ b/physics/PBL/MYNN_EDMF/module_bl_mynn.F90 @@ -232,6 +232,18 @@ ! bl_mynn_cloudpdf = 2 (Chab-Becht). ! Removed WRF_CHEM dependencies. ! Many miscellaneous tweaks. +! v4.5.2 / CCPP +! Some code optimization. Removed many conditions from loops. Redesigned the mass- +! flux scheme to use 8 plumes instead of a variable n plumes. This results in +! the removal of the output variable "nudprafts" and adds maxwidth and ztop_plume. +! Revision option bl_mynn_cloudpdf = 2, which now ensures cloud fractions for all +! optically relevant mixing ratios (tip from Greg Thompson). Also, added flexibility +! for tuning near-surface cloud fractions to remove excess fog/low ceilings. +! Now outputs all SGS cloud mixing ratios as grid-mean values, not in-cloud. This +! results in a change in the pre-radiation code to no longer multiply mixing ratios +! by cloud fractions. +! Lots of code cleanup: removal of test code, comments, changing text case, etc. +! Many misc tuning/tweaks. ! ! Many of these changes are now documented in references listed above. !==================================================================== @@ -256,11 +268,11 @@ MODULE module_bl_mynn !=================================================================== ! From here on, these are MYNN-specific parameters: ! The parameters below depend on stability functions of module_sf_mynn. - real(kind_phys), PARAMETER :: cphm_st=5.0, cphm_unst=16.0, & + real(kind_phys), parameter :: cphm_st=5.0, cphm_unst=16.0, & cphh_st=5.0, cphh_unst=16.0 ! Closure constants - real(kind_phys), PARAMETER :: & + real(kind_phys), parameter :: & &pr = 0.74, & &g1 = 0.235, & ! NN2009 = 0.235 &b1 = 24.0, & @@ -275,7 +287,7 @@ MODULE module_bl_mynn &a2 = a1*( g1-c1 )/( g1*pr ), & &g2 = b2/b1*( 1.0-c3 ) +2.0*a1/b1*( 3.0-2.0*c2 ) - real(kind_phys), PARAMETER :: & + real(kind_phys), parameter :: & &cc2 = 1.0-c2, & &cc3 = 1.0-c3, & &e1c = 3.0*a2*b2*cc3, & @@ -286,15 +298,15 @@ MODULE module_bl_mynn ! Constants for min tke in elt integration (qmin), max z/L in els (zmax), ! and factor for eddy viscosity for TKE (Kq = Sqfac*Km): - real(kind_phys), PARAMETER :: qmin=0.0, zmax=1.0, Sqfac=3.0 + real(kind_phys), parameter :: qmin=0.0, zmax=1.0, Sqfac=3.0 ! Note that the following mixing-length constants are now specified in mym_length ! &cns=3.5, alp1=0.23, alp2=0.3, alp3=3.0, alp4=10.0, alp5=0.2 - real(kind_phys), PARAMETER :: gpw=5./3., qcgmin=1.e-8, qkemin=1.e-12 - real(kind_phys), PARAMETER :: tliq = 269. !all hydrometeors are liquid when T > tliq + real(kind_phys), parameter :: gpw=5./3., qcgmin=1.e-8, qkemin=1.e-12 + real(kind_phys), parameter :: tliq = 269. !all hydrometeors are liquid when T > tliq ! Constants for cloud PDF (mym_condensation) - real(kind_phys), PARAMETER :: rr2=0.7071068, rrp=0.3989423 + real(kind_phys), parameter :: rr2=0.7071068, rrp=0.3989423 !>Use Canuto/Kitamura mod (remove Ric and negative TKE) (1:yes, 0:no) !!For more info, see Canuto et al. (2008 JAS) and Kitamura (Journal of the @@ -304,35 +316,35 @@ MODULE module_bl_mynn !!(above) back to NN2009 values (see commented out lines next to the !!parameters above). This only removes the negative TKE problem !!but does not necessarily improve performance - neutral impact. - real(kind_phys), PARAMETER :: CKmod=1. + real(kind_phys), parameter :: CKmod=1. !>Use Ito et al. (2015, BLM) scale-aware (0: no, 1: yes). Note that this also has impacts !!on the cloud PDF and mass-flux scheme, using Honnert et al. (2011) similarity function !!for TKE in the upper PBL/cloud layer. - real(kind_phys), PARAMETER :: scaleaware=1. + real(kind_phys), parameter :: scaleaware=1. !>Of the following the options, use one OR the other, not both. !>Adding top-down diffusion driven by cloud-top radiative cooling - INTEGER, PARAMETER :: bl_mynn_topdown = 0 + integer, parameter :: bl_mynn_topdown = 0 !>Option to activate downdrafts, from Elynn Wu (0: deactive, 1: active) - INTEGER, PARAMETER :: bl_mynn_edmf_dd = 0 + integer, parameter :: bl_mynn_edmf_dd = 0 !>Option to activate heating due to dissipation of TKE (to activate, set to 1.0) - INTEGER, PARAMETER :: dheat_opt = 1 + integer, parameter :: dheat_opt = 1 !Option to activate environmental subsidence in mass-flux scheme - LOGICAL, PARAMETER :: env_subs = .false. + logical, parameter :: env_subs = .false. !Option to switch flux-profile relationship for surface (from Puhales et al. 2020) !0: use original Dyer-Hicks, 1: use Cheng-Brustaert and Blended COARE - INTEGER, PARAMETER :: bl_mynn_stfunc = 1 + integer, parameter :: bl_mynn_stfunc = 1 !option to print out more stuff for debugging purposes - LOGICAL, PARAMETER :: debug_code = .false. - INTEGER, PARAMETER :: idbg = 23 !specific i-point to write out + logical, parameter :: debug_code = .false. + integer, parameter :: idbg = 23 !specific i-point to write out ! Used in WRF-ARW module_physics_init.F - INTEGER :: mynn_level + integer :: mynn_level CONTAINS @@ -388,7 +400,8 @@ SUBROUTINE mynn_bl_driver( & &edmf_thl,edmf_ent,edmf_qc, & &sub_thl3D,sub_sqv3D, & &det_thl3D,det_sqv3D, & - &nupdraft,maxMF,ktop_plume, & + &maxwidth,maxMF,ztop_plume, & + &ktop_plume, & &spp_pbl,pattern_spp_pbl, & &rthraten, & &FLAG_QC,FLAG_QI,FLAG_QNC, & @@ -401,30 +414,30 @@ SUBROUTINE mynn_bl_driver( & !------------------------------------------------------------------- - INTEGER, INTENT(in) :: initflag + integer, intent(in) :: initflag !INPUT NAMELIST OPTIONS: - LOGICAL, INTENT(in) :: restart,cycling - INTEGER, INTENT(in) :: tke_budget - INTEGER, INTENT(in) :: bl_mynn_cloudpdf - INTEGER, INTENT(in) :: bl_mynn_mixlength - INTEGER, INTENT(in) :: bl_mynn_edmf - LOGICAL, INTENT(in) :: bl_mynn_tkeadvect - INTEGER, INTENT(in) :: bl_mynn_edmf_mom - INTEGER, INTENT(in) :: bl_mynn_edmf_tke - INTEGER, INTENT(in) :: bl_mynn_mixscalars - INTEGER, INTENT(in) :: bl_mynn_output - INTEGER, INTENT(in) :: bl_mynn_cloudmix - INTEGER, INTENT(in) :: bl_mynn_mixqt - INTEGER, INTENT(in) :: icloud_bl - real(kind_phys), INTENT(in) :: closure - - LOGICAL, INTENT(in) :: FLAG_QI,FLAG_QNI,FLAG_QC,FLAG_QNC,& + logical, intent(in) :: restart,cycling + integer, intent(in) :: tke_budget + integer, intent(in) :: bl_mynn_cloudpdf + integer, intent(in) :: bl_mynn_mixlength + integer, intent(in) :: bl_mynn_edmf + logical, intent(in) :: bl_mynn_tkeadvect + integer, intent(in) :: bl_mynn_edmf_mom + integer, intent(in) :: bl_mynn_edmf_tke + integer, intent(in) :: bl_mynn_mixscalars + integer, intent(in) :: bl_mynn_output + integer, intent(in) :: bl_mynn_cloudmix + integer, intent(in) :: bl_mynn_mixqt + integer, intent(in) :: icloud_bl + real(kind_phys), intent(in) :: closure + + logical, intent(in) :: FLAG_QI,FLAG_QNI,FLAG_QC,FLAG_QNC,& FLAG_QNWFA,FLAG_QNIFA,FLAG_QNBCA, & FLAG_OZONE,FLAG_QS - LOGICAL, INTENT(IN) :: mix_chem,enh_mix,rrfs_sd,smoke_dbg + logical, intent(in) :: mix_chem,enh_mix,rrfs_sd,smoke_dbg - INTEGER, INTENT(in) :: & + integer, intent(in) :: & & IDS,IDE,JDS,JDE,KDS,KDE & &,IMS,IME,JMS,JME,KMS,KME & &,ITS,ITE,JTS,JTE,KTS,KTE @@ -444,81 +457,87 @@ SUBROUTINE mynn_bl_driver( & ! to prevent a crash on Cheyenne. Do not change it back without testing if the code runs ! on Cheyenne with the GNU compiler. - real(kind_phys), INTENT(in) :: delt - real(kind_phys), DIMENSION(:), INTENT(in) :: dx - real(kind_phys), DIMENSION(:,:), INTENT(in) :: dz, & + real(kind_phys), intent(in) :: delt + real(kind_phys), dimension(:), intent(in) :: dx + real(kind_phys), dimension(:,:), intent(in) :: dz, & &u,v,w,th,sqv3D,p,exner,rho,T3D - real(kind_phys), DIMENSION(:,:), INTENT(in) :: & + real(kind_phys), dimension(:,:), intent(in) :: & &sqc3D,sqi3D,sqs3D,qni,qnc,qnwfa,qnifa,qnbca - real(kind_phys), DIMENSION(:,:), INTENT(in):: ozone - real(kind_phys), DIMENSION(:), INTENT(in):: ust, & + real(kind_phys), dimension(:,:), intent(in):: ozone + real(kind_phys), dimension(:), intent(in):: ust, & &ch,qsfc,ps,wspd - real(kind_phys), DIMENSION(:,:), INTENT(inout) :: & - &Qke,Tsq,Qsq,Cov,qke_adv - real(kind_phys), DIMENSION(:,:), INTENT(inout) :: & + real(kind_phys), dimension(:,:), intent(inout), optional :: & + &Qke,Tsq,Qsq,Cov + real(kind_phys), dimension(:,:), intent(inout) :: & + &qke_adv + real(kind_phys), dimension(:,:), intent(inout) :: & &rublten,rvblten,rthblten,rqvblten,rqcblten, & &rqiblten,rqsblten,rqniblten,rqncblten, & &rqnwfablten,rqnifablten,rqnbcablten - real(kind_phys), DIMENSION(:,:), INTENT(inout) :: dozone - real(kind_phys), DIMENSION(:,:), INTENT(in) :: rthraten + real(kind_phys), dimension(:,:), intent(inout) :: dozone + real(kind_phys), dimension(:,:), intent(in) :: rthraten - real(kind_phys), DIMENSION(:,:), INTENT(out) :: exch_h,exch_m - real(kind_phys), DIMENSION(:), INTENT(in) :: xland, & + real(kind_phys), dimension(:,:), intent(out), optional :: exch_h,exch_m + real(kind_phys), dimension(:), intent(in) :: xland, & &ts,znt,hfx,qfx,uoce,voce !These 10 arrays are only allocated when bl_mynn_output > 0 - real(kind_phys), DIMENSION(:,:), INTENT(inout) :: & + real(kind_phys), dimension(:,:), intent(inout), optional :: & & edmf_a,edmf_w,edmf_qt,edmf_thl,edmf_ent,edmf_qc, & & sub_thl3D,sub_sqv3D,det_thl3D,det_sqv3D -! real, DIMENSION(IMS:IME,KMS:KME) :: & +! real, dimension(ims:ime,kms:kme) :: & ! & edmf_a_dd,edmf_w_dd,edmf_qt_dd,edmf_thl_dd,edmf_ent_dd,edmf_qc_dd - real(kind_phys), DIMENSION(:), INTENT(inout) :: Pblh - real(kind_phys), DIMENSION(:), INTENT(inout) :: rmol + real(kind_phys), dimension(:), intent(inout) :: Pblh + real(kind_phys), dimension(:), intent(inout) :: rmol - real(kind_phys), DIMENSION(IMS:IME) :: psig_bl,psig_shcu + real(kind_phys), dimension(ims:ime) :: psig_bl,psig_shcu - INTEGER,DIMENSION(:),INTENT(INOUT) :: & - &KPBL,nupdraft,ktop_plume + integer,dimension(:),intent(INOUT) :: & + &KPBL + integer,dimension(:),intent(INOUT), optional :: & + &ktop_plume - real(kind_phys), DIMENSION(:), INTENT(out) :: maxmf + real(kind_phys), dimension(:), intent(out), optional :: & + &maxmf,maxwidth,ztop_plume - real(kind_phys), DIMENSION(:,:), INTENT(inout) :: el_pbl + real(kind_phys), dimension(:,:), intent(inout), optional :: el_pbl - real(kind_phys), DIMENSION(:,:), INTENT(inout) :: & + real(kind_phys), dimension(:,:), intent(inout), optional :: & &qWT,qSHEAR,qBUOY,qDISS,dqke ! 3D budget arrays are not allocated when tke_budget == 0 ! 1D (local) budget arrays are used for passing between subroutines. - real(kind_phys), DIMENSION(kts:kte) :: & + real(kind_phys), dimension(kts:kte) :: & &qwt1,qshear1,qbuoy1,qdiss1,dqke1,diss_heat - real(kind_phys), DIMENSION(:,:), intent(out) :: Sh3D,Sm3D + real(kind_phys), dimension(:,:), intent(out), optional :: Sh3D,Sm3D - real(kind_phys), DIMENSION(:,:), INTENT(inout) :: & + real(kind_phys), dimension(:,:), intent(inout), optional :: & &qc_bl,qi_bl,cldfra_bl - real(kind_phys), DIMENSION(KTS:KTE) :: qc_bl1D,qi_bl1D, & + real(kind_phys), dimension(kts:kte) :: qc_bl1D,qi_bl1D, & &cldfra_bl1D,qc_bl1D_old,qi_bl1D_old,cldfra_bl1D_old ! smoke/chemical arrays - INTEGER, INTENT(IN ) :: nchem, kdvel, ndvel - real(kind_phys), DIMENSION(:,:,:), INTENT(INOUT) :: chem3d - real(kind_phys), DIMENSION(:,:), INTENT(IN) :: vdep - real(kind_phys), DIMENSION(:), INTENT(IN) :: frp,EMIS_ANT_NO + integer, intent(IN ) :: nchem, kdvel, ndvel + real(kind_phys), dimension(:,:,:), intent(INOUT), optional :: chem3d + real(kind_phys), dimension(:,:), intent(IN), optional :: vdep + real(kind_phys), dimension(:), intent(IN), optional :: frp + real(kind_phys), dimension(:), intent(IN) :: EMIS_ANT_NO !local - real(kind_phys), DIMENSION(kts:kte ,nchem) :: chem1 - real(kind_phys), DIMENSION(kts:kte+1,nchem) :: s_awchem1 - real(kind_phys), DIMENSION(ndvel) :: vd1 - INTEGER :: ic + real(kind_phys), dimension(kts:kte ,nchem) :: chem1 + real(kind_phys), dimension(kts:kte+1,nchem) :: s_awchem1 + real(kind_phys), dimension(ndvel) :: vd1 + integer :: ic !local vars - INTEGER :: ITF,JTF,KTF, IMD,JMD - INTEGER :: i,j,k,kproblem - real(kind_phys), DIMENSION(KTS:KTE) :: & + integer :: ITF,JTF,KTF, IMD,JMD + integer :: i,j,k,kproblem + real(kind_phys), dimension(kts:kte) :: & &thl,tl,qv1,qc1,qi1,qs1,sqw, & &el, dfm, dfh, dfq, tcd, qcd, pdk, pdt, pdq, pdc, & - &vt, vq, sgm - real(kind_phys), DIMENSION(KTS:KTE) :: & + &vt, vq, sgm, kzero + real(kind_phys), dimension(kts:kte) :: & &thetav,sh,sm,u1,v1,w1,p1, & &ex1,dz1,th1,tk1,rho1,qke1,tsq1,qsq1,cov1, & &sqv,sqi,sqc,sqs, & @@ -527,45 +546,45 @@ SUBROUTINE mynn_bl_driver( & &qnbca1,dqnwfa1,dqnifa1,dqnbca1,dozone1 !mass-flux variables - real(kind_phys), DIMENSION(KTS:KTE) :: & + real(kind_phys), dimension(kts:kte) :: & &dth1mf,dqv1mf,dqc1mf,du1mf,dv1mf - real(kind_phys), DIMENSION(KTS:KTE) :: & + real(kind_phys), dimension(kts:kte) :: & &edmf_a1,edmf_w1,edmf_qt1,edmf_thl1, & &edmf_ent1,edmf_qc1 - real(kind_phys), DIMENSION(KTS:KTE) :: & + real(kind_phys), dimension(kts:kte) :: & &edmf_a_dd1,edmf_w_dd1,edmf_qt_dd1,edmf_thl_dd1, & &edmf_ent_dd1,edmf_qc_dd1 - real(kind_phys), DIMENSION(KTS:KTE) :: & + real(kind_phys), dimension(kts:kte) :: & &sub_thl,sub_sqv,sub_u,sub_v, & &det_thl,det_sqv,det_sqc,det_u,det_v - real(kind_phys), DIMENSION(KTS:KTE+1) :: & + real(kind_phys), dimension(kts:kte+1) :: & &s_aw1,s_awthl1,s_awqt1, & &s_awqv1,s_awqc1,s_awu1,s_awv1,s_awqke1, & &s_awqnc1,s_awqni1,s_awqnwfa1,s_awqnifa1, & &s_awqnbca1 - real(kind_phys), DIMENSION(KTS:KTE+1) :: & + real(kind_phys), dimension(kts:kte+1) :: & &sd_aw1,sd_awthl1,sd_awqt1, & &sd_awqv1,sd_awqc1,sd_awu1,sd_awv1,sd_awqke1 - real(kind_phys), DIMENSION(KTS:KTE+1) :: zw + real(kind_phys), dimension(kts:kte+1) :: zw real(kind_phys) :: cpm,sqcg,flt,fltv,flq,flqv,flqc, & &pmz,phh,exnerg,zet,phi_m, & &afk,abk,ts_decay, qc_bl2, qi_bl2, & - &th_sfc,ztop_plume,wsp + &th_sfc,wsp !top-down diffusion - real(kind_phys), DIMENSION(ITS:ITE) :: maxKHtopdown - real(kind_phys), DIMENSION(KTS:KTE) :: KHtopdown,TKEprodTD + real(kind_phys), dimension(ITS:ITE) :: maxKHtopdown + real(kind_phys), dimension(kts:kte) :: KHtopdown,TKEprodTD - LOGICAL :: INITIALIZE_QKE,problem + logical :: INITIALIZE_QKE,problem ! Stochastic fields - INTEGER, INTENT(IN) :: spp_pbl - real(kind_phys), DIMENSION(:,:), INTENT(IN) :: pattern_spp_pbl - real(kind_phys), DIMENSION(KTS:KTE) :: rstoch_col + integer, intent(IN) :: spp_pbl + real(kind_phys), dimension(:,:), intent(IN), optional :: pattern_spp_pbl + real(kind_phys), dimension(KTS:KTE) :: rstoch_col ! Substepping TKE - INTEGER :: nsub + integer :: nsub real(kind_phys) :: delt2 @@ -629,9 +648,11 @@ SUBROUTINE mynn_bl_driver( & !edmf_qc_dd(its:ite,kts:kte)=0. ENDIF ktop_plume(its:ite)=0 !int - nupdraft(its:ite)=0 !int + ztop_plume(its:ite)=0. + maxwidth(its:ite)=0. maxmf(its:ite)=0. maxKHtopdown(its:ite)=0. + kzero(kts:kte)=0. ! DH* CHECK HOW MUCH OF THIS INIT IF-BLOCK IS ACTUALLY NEEDED FOR RESTARTS !> - Within the MYNN-EDMF, there is a dependecy check for the first time step, @@ -740,7 +761,7 @@ SUBROUTINE mynn_bl_driver( & !keep snow out for now - increases ceiling bias sqw(k)=sqv(k)+sqc(k)+sqi(k)!+sqs(k) thl(k)=th1(k) - xlvcp/ex1(k)*sqc(k) & - & - xlscp/ex1(k)*(sqi(k)+sqs(k)) + & - xlscp/ex1(k)*(sqi(k))!+sqs(k)) !Use form from Tripoli and Cotton (1981) with their !suggested min temperature to improve accuracy. !thl(k)=th(i,k)*(1.- xlvcp/MAX(tk1(k),TKmin)*sqc(k) & @@ -987,10 +1008,10 @@ SUBROUTINE mynn_bl_driver( & else zw(k)=zw(k-1)+dz(i,k-1) endif - !keep snow out for now - increases ceiling bias + !keep snow out for now - increases ceiling bias sqw(k)= sqv(k)+sqc(k)+sqi(k)!+sqs(k) thl(k)= th1(k) - xlvcp/ex1(k)*sqc(k) & - & - xlscp/ex1(k)*(sqi(k)+sqs(k)) + & - xlscp/ex1(k)*(sqi(k))!+sqs(k)) !Use form from Tripoli and Cotton (1981) with their !suggested min temperature to improve accuracy. !thl(k)=th(i,k)*(1.- xlvcp/MAX(tk1(k),TKmin)*sqc(k) & @@ -1021,7 +1042,7 @@ SUBROUTINE mynn_bl_driver( & endif s_awchem1 = 0.0 -!> - Call get_pblh() to calculate the hybrid \f$\theta_{vli}-TKE\f$ +!> - Call get_pblh() to calculate the hybrid \f$\theta_{v}-TKE\f$ !! PBL height diagnostic. CALL GET_PBLH(KTS,KTE,PBLH(i),thetav,& & Qke1,zw,dz1,xland(i),KPBL(i)) @@ -1147,8 +1168,8 @@ SUBROUTINE mynn_bl_driver( & &FLAG_QNC,FLAG_QNI, & &FLAG_QNWFA,FLAG_QNIFA,FLAG_QNBCA, & &Psig_shcu(i), & - &nupdraft(i),ktop_plume(i), & - &maxmf(i),ztop_plume, & + &maxwidth(i),ktop_plume(i), & + &maxmf(i),ztop_plume(i), & &spp_pbl,rstoch_col ) endif @@ -1220,9 +1241,9 @@ SUBROUTINE mynn_bl_driver( & call mynn_tendencies(kts,kte,i, & &delt, dz1, rho1, & &u1, v1, th1, tk1, qv1, & - &qc1, qi1, qs1, qnc1, qni1, & + &qc1, qi1, kzero, qnc1, qni1, & !kzero replaces qs1 - not mixing snow &ps(i), p1, ex1, thl, & - &sqv, sqc, sqi, sqs, sqw, & + &sqv, sqc, sqi, kzero, sqw, & !kzero replaces sqs - not mixing snow &qnwfa1, qnifa1, qnbca1, ozone1, & &ust(i),flt,flq,flqv,flqc, & &wspd(i),uoce(i),voce(i), & @@ -1295,27 +1316,27 @@ SUBROUTINE mynn_bl_driver( & &dfm, dfh, dz1, K_m1, K_h1 ) !UPDATE 3D ARRAYS - exch_m(i,:) =k_m1(:) - exch_h(i,:) =k_h1(:) - rublten(i,:) =du1(:) - rvblten(i,:) =dv1(:) - rthblten(i,:)=dth1(:) - rqvblten(i,:)=dqv1(:) + exch_m(i,kts:kte) =k_m1(kts:kte) + exch_h(i,kts:kte) =k_h1(kts:kte) + rublten(i,kts:kte) =du1(kts:kte) + rvblten(i,kts:kte) =dv1(kts:kte) + rthblten(i,kts:kte)=dth1(kts:kte) + rqvblten(i,kts:kte)=dqv1(kts:kte) if (bl_mynn_cloudmix > 0) then - if (flag_qc) rqcblten(i,:)=dqc1(:) - if (flag_qi) rqiblten(i,:)=dqi1(:) - if (flag_qs) rqsblten(i,:)=dqs1(:) + if (flag_qc) rqcblten(i,kts:kte)=dqc1(kts:kte) + if (flag_qi) rqiblten(i,kts:kte)=dqi1(kts:kte) + if (flag_qs) rqsblten(i,kts:kte)=dqs1(kts:kte) else if (flag_qc) rqcblten(i,:)=0. if (flag_qi) rqiblten(i,:)=0. if (flag_qs) rqsblten(i,:)=0. endif if (bl_mynn_cloudmix > 0 .and. bl_mynn_mixscalars > 0) then - if (flag_qnc) rqncblten(i,:) =dqnc1(:) - if (flag_qni) rqniblten(i,:) =dqni1(:) - if (flag_qnwfa) rqnwfablten(i,:)=dqnwfa1(:) - if (flag_qnifa) rqnifablten(i,:)=dqnifa1(:) - if (flag_qnbca) rqnbcablten(i,:)=dqnbca1(:) + if (flag_qnc) rqncblten(i,kts:kte) =dqnc1(kts:kte) + if (flag_qni) rqniblten(i,kts:kte) =dqni1(kts:kte) + if (flag_qnwfa) rqnwfablten(i,kts:kte)=dqnwfa1(kts:kte) + if (flag_qnifa) rqnifablten(i,kts:kte)=dqnifa1(kts:kte) + if (flag_qnbca) rqnbcablten(i,kts:kte)=dqnbca1(kts:kte) else if (flag_qnc) rqncblten(i,:) =0. if (flag_qni) rqniblten(i,:) =0. @@ -1323,19 +1344,19 @@ SUBROUTINE mynn_bl_driver( & if (flag_qnifa) rqnifablten(i,:)=0. if (flag_qnbca) rqnbcablten(i,:)=0. endif - dozone(i,:)=dozone1(:) + dozone(i,kts:kte)=dozone1(kts:kte) if (icloud_bl > 0) then - qc_bl(i,:) =qc_bl1D(:) - qi_bl(i,:) =qi_bl1D(:) - cldfra_bl(i,:)=cldfra_bl1D(:) + qc_bl(i,kts:kte) =qc_bl1D(kts:kte) + qi_bl(i,kts:kte) =qi_bl1D(kts:kte) + cldfra_bl(i,kts:kte)=cldfra_bl1D(kts:kte) endif - el_pbl(i,:)=el(:) - qke(i,:) =qke1(:) - tsq(i,:) =tsq1(:) - qsq(i,:) =qsq1(:) - cov(i,:) =cov1(:) - sh3d(i,:) =sh(:) - sm3d(i,:) =sm(:) + el_pbl(i,kts:kte)=el(kts:kte) + qke(i,kts:kte) =qke1(kts:kte) + tsq(i,kts:kte) =tsq1(kts:kte) + qsq(i,kts:kte) =qsq1(kts:kte) + cov(i,kts:kte) =cov1(kts:kte) + sh3d(i,kts:kte) =sh(kts:kte) + sm3d(i,kts:kte) =sm(kts:kte) if (tke_budget .eq. 1) then !! TKE budget is now given in m**2/s**-3 (Puhales, 2020) @@ -1363,24 +1384,24 @@ SUBROUTINE mynn_bl_driver( & !update updraft/downdraft properties if (bl_mynn_output > 0) then !research mode == 1 if (bl_mynn_edmf > 0) then - edmf_a(i,:) =edmf_a1(:) - edmf_w(i,:) =edmf_w1(:) - edmf_qt(i,:) =edmf_qt1(:) - edmf_thl(i,:) =edmf_thl1(:) - edmf_ent(i,:) =edmf_ent1(:) - edmf_qc(i,:) =edmf_qc1(:) - sub_thl3D(i,:)=sub_thl(:) - sub_sqv3D(i,:)=sub_sqv(:) - det_thl3D(i,:)=det_thl(:) - det_sqv3D(i,:)=det_sqv(:) + edmf_a(i,kts:kte) =edmf_a1(kts:kte) + edmf_w(i,kts:kte) =edmf_w1(kts:kte) + edmf_qt(i,kts:kte) =edmf_qt1(kts:kte) + edmf_thl(i,kts:kte) =edmf_thl1(kts:kte) + edmf_ent(i,kts:kte) =edmf_ent1(kts:kte) + edmf_qc(i,kts:kte) =edmf_qc1(kts:kte) + sub_thl3D(i,kts:kte)=sub_thl(kts:kte) + sub_sqv3D(i,kts:kte)=sub_sqv(kts:kte) + det_thl3D(i,kts:kte)=det_thl(kts:kte) + det_sqv3D(i,kts:kte)=det_sqv(kts:kte) endif !if (bl_mynn_edmf_dd > 0) THEN - ! edmf_a_dd(i,:) =edmf_a_dd1(:) - ! edmf_w_dd(i,:) =edmf_w_dd1(:) - ! edmf_qt_dd(i,:) =edmf_qt_dd1(:) - ! edmf_thl_dd(i,:)=edmf_thl_dd1(:) - ! edmf_ent_dd(i,:)=edmf_ent_dd1(:) - ! edmf_qc_dd(i,:) =edmf_qc_dd1(:) + ! edmf_a_dd(i,kts:kte) =edmf_a_dd1(kts:kte) + ! edmf_w_dd(i,kts:kte) =edmf_w_dd1(kts:kte) + ! edmf_qt_dd(i,kts:kte) =edmf_qt_dd1(kts:kte) + ! edmf_thl_dd(i,kts:kte)=edmf_thl_dd1(kts:kte) + ! edmf_ent_dd(i,kts:kte)=edmf_ent_dd1(kts:kte) + ! edmf_qc_dd(i,kts:kte) =edmf_qc_dd1(kts:kte) !endif endif @@ -1509,27 +1530,27 @@ SUBROUTINE mym_initialize ( & ! !------------------------------------------------------------------- - integer, INTENT(IN) :: kts,kte - integer, INTENT(IN) :: bl_mynn_mixlength - logical, INTENT(IN) :: INITIALIZE_QKE -! real(kind_phys), INTENT(IN) :: ust, rmo, pmz, phh, flt, flq - real(kind_phys), INTENT(IN) :: rmo, Psig_bl, xland - real(kind_phys), INTENT(IN) :: dx, ust, zi - real(kind_phys), DIMENSION(kts:kte), INTENT(in) :: dz - real(kind_phys), DIMENSION(kts:kte+1), INTENT(in) :: zw - real(kind_phys), DIMENSION(kts:kte), INTENT(in) :: u,v,thl,& + integer, intent(in) :: kts,kte + integer, intent(in) :: bl_mynn_mixlength + logical, intent(in) :: INITIALIZE_QKE +! real(kind_phys), intent(in) :: ust, rmo, pmz, phh, flt, flq + real(kind_phys), intent(in) :: rmo, Psig_bl, xland + real(kind_phys), intent(in) :: dx, ust, zi + real(kind_phys), dimension(kts:kte), intent(in) :: dz + real(kind_phys), dimension(kts:kte+1), intent(in) :: zw + real(kind_phys), dimension(kts:kte), intent(in) :: u,v,thl,& &qw,cldfra_bl1D,edmf_w1,edmf_a1 - real(kind_phys), DIMENSION(kts:kte), INTENT(out) :: tsq,qsq,cov - real(kind_phys), DIMENSION(kts:kte), INTENT(inout) :: el,qke - real(kind_phys), DIMENSION(kts:kte) :: & + real(kind_phys), dimension(kts:kte), intent(out) :: tsq,qsq,cov + real(kind_phys), dimension(kts:kte), intent(inout) :: el,qke + real(kind_phys), dimension(kts:kte) :: & &ql,pdk,pdt,pdq,pdc,dtl,dqw,dtv, & &gm,gh,sm,sh,qkw,vt,vq - INTEGER :: k,l,lmax + integer :: k,l,lmax real(kind_phys):: phm,vkz,elq,elv,b1l,b2l,pmz=1.,phh=1., & &flt=0.,fltv=0.,flq=0.,tmpq - real(kind_phys), DIMENSION(kts:kte) :: theta,thetav - real(kind_phys), DIMENSION(kts:kte) :: rstoch_col - INTEGER ::spp_pbl + real(kind_phys), dimension(kts:kte) :: theta,thetav + real(kind_phys), dimension(kts:kte) :: rstoch_col + integer ::spp_pbl !> - At first ql, vt and vq are set to zero. DO k = kts,kte @@ -1706,17 +1727,17 @@ SUBROUTINE mym_level2 (kts,kte, & ! !------------------------------------------------------------------- - INTEGER, INTENT(IN) :: kts,kte + integer, intent(in) :: kts,kte #ifdef HARDCODE_VERTICAL # define kts 1 # define kte HARDCODE_VERTICAL #endif - real(kind_phys), DIMENSION(kts:kte), INTENT(in) :: dz - real(kind_phys), DIMENSION(kts:kte), INTENT(in) :: u,v, & + real(kind_phys), dimension(kts:kte), intent(in) :: dz + real(kind_phys), dimension(kts:kte), intent(in) :: u,v, & &thl,qw,ql,vt,vq,thetav - real(kind_phys), DIMENSION(kts:kte), INTENT(out) :: & + real(kind_phys), dimension(kts:kte), intent(out) :: & &dtl,dqw,dtv,gm,gh,sm,sh integer :: k @@ -1844,25 +1865,25 @@ SUBROUTINE mym_length ( & !------------------------------------------------------------------- - INTEGER, INTENT(IN) :: kts,kte + integer, intent(in) :: kts,kte #ifdef HARDCODE_VERTICAL # define kts 1 # define kte HARDCODE_VERTICAL #endif - INTEGER, INTENT(IN) :: bl_mynn_mixlength - real(kind_phys), DIMENSION(kts:kte), INTENT(in) :: dz - real(kind_phys), DIMENSION(kts:kte+1), INTENT(in) :: zw - real(kind_phys), INTENT(in) :: rmo,flt,fltv,flq,Psig_bl,xland - real(kind_phys), INTENT(IN) :: dx,zi - real(kind_phys), DIMENSION(kts:kte), INTENT(IN) :: u1,v1, & + integer, intent(in) :: bl_mynn_mixlength + real(kind_phys), dimension(kts:kte), intent(in) :: dz + real(kind_phys), dimension(kts:kte+1), intent(in) :: zw + real(kind_phys), intent(in) :: rmo,flt,fltv,flq,Psig_bl,xland + real(kind_phys), intent(in) :: dx,zi + real(kind_phys), dimension(kts:kte), intent(in) :: u1,v1, & &qke,vt,vq,cldfra_bl1D,edmf_w1,edmf_a1 - real(kind_phys), DIMENSION(kts:kte), INTENT(out) :: qkw, el - real(kind_phys), DIMENSION(kts:kte), INTENT(in) :: dtv + real(kind_phys), dimension(kts:kte), intent(out) :: qkw, el + real(kind_phys), dimension(kts:kte), intent(in) :: dtv real(kind_phys):: elt,vsc - real(kind_phys), DIMENSION(kts:kte), INTENT(IN) :: theta - real(kind_phys), DIMENSION(kts:kte) :: qtke,elBLmin,elBLavg,thetaw + real(kind_phys), dimension(kts:kte), intent(in) :: theta + real(kind_phys), dimension(kts:kte) :: qtke,elBLmin,elBLavg,thetaw real(kind_phys):: wt,wt2,zi2,h1,h2,hs,elBLmin0,elBLavg0,cldavg ! THE FOLLOWING CONSTANTS ARE IMPORTANT FOR REGULATING THE @@ -1879,22 +1900,22 @@ SUBROUTINE mym_length ( & !THEY ONLY IMPOSE LIMITS ON THE CALCULATION OF THE MIXING LENGTH !SCALES SO THAT THE BOULAC MIXING LENGTH (IN FREE ATMOS) DOES !NOT ENCROACH UPON THE BOUNDARY LAYER MIXING LENGTH (els, elb & elt). - real(kind_phys), PARAMETER :: minzi = 300. !< min mixed-layer height - real(kind_phys), PARAMETER :: maxdz = 750. !< max (half) transition layer depth + real(kind_phys), parameter :: minzi = 300. !< min mixed-layer height + real(kind_phys), parameter :: maxdz = 750. !< max (half) transition layer depth !! =0.3*2500 m PBLH, so the transition !! layer stops growing for PBLHs > 2.5 km. - real(kind_phys), PARAMETER :: mindz = 300. !< 300 !min (half) transition layer depth + real(kind_phys), parameter :: mindz = 300. !< 300 !min (half) transition layer depth !SURFACE LAYER LENGTH SCALE MODS TO REDUCE IMPACT IN UPPER BOUNDARY LAYER - real(kind_phys), PARAMETER :: ZSLH = 100. !< Max height correlated to surface conditions (m) - real(kind_phys), PARAMETER :: CSL = 2. !< CSL = constant of proportionality to L O(1) + real(kind_phys), parameter :: ZSLH = 100. !< Max height correlated to surface conditions (m) + real(kind_phys), parameter :: CSL = 2. !< CSL = constant of proportionality to L O(1) - INTEGER :: i,j,k + integer :: i,j,k real(kind_phys):: afk,abk,zwk,zwk1,dzk,qdz,vflx,bv,tau_cloud, & & wstar,elb,els,elf,el_stab,el_mf,el_stab_mf,elb_mf, & & PBLH_PLUS_ENT,Uonset,Ugrid,wt_u,el_les - real(kind_phys), PARAMETER :: ctau = 1000. !constant for tau_cloud + real(kind_phys), parameter :: ctau = 1000. !constant for tau_cloud ! tv0 = 0.61*tref ! gtr = 9.81/tref @@ -1985,9 +2006,9 @@ SUBROUTINE mym_length ( & uonset= 15. wt_u = (1.0 - min(max(ugrid - uonset, 0.0)/30.0, 0.5)) cns = 2.7 !was 3.5 - alp1 = 0.22 + alp1 = 0.23 alp2 = 0.3 - alp3 = 2.0 * wt_u !taper off bouyancy enhancement in shear-driven pbls + alp3 = 2.5 * wt_u !taper off bouyancy enhancement in shear-driven pbls alp4 = 5.0 alp5 = 0.3 alp6 = 50. @@ -2043,12 +2064,12 @@ SUBROUTINE mym_length ( & ! ** Length scale limited by the buoyancy effect ** IF ( dtv(k) .GT. 0.0 ) THEN - bv = max( sqrt( gtr*dtv(k) ), 0.001) + bv = max( sqrt( gtr*dtv(k) ), 0.0001) elb = MAX(alp2*qkw(k), & & alp6*edmf_a1(k-1)*edmf_w1(k-1)) / bv & & *( 1.0 + alp3*SQRT( vsc/(bv*elt) ) ) elb = MIN(elb, zwk) - elf = 0.80 * qkw(k)/bv + elf = 1.0 * qkw(k)/bv elBLavg(k) = MAX(elBLavg(k), alp6*edmf_a1(k-1)*edmf_w1(k-1)/bv) ELSE elb = 1.0e10 @@ -2068,8 +2089,10 @@ SUBROUTINE mym_length ( & !add blending to use BouLac mixing length in free atmos; !defined relative to the PBLH (zi) + transition layer (h1) !el(k) = MIN(elb/( elb/elt+elb/els+1.0 ),elf) - !try squared-blending - el(k) = SQRT( els**2/(1. + (els**2/elt**2) +(els**2/elb**2))) + !try squared-blending - but take out elb (makes it underdiffusive) + !el(k) = SQRT( els**2/(1. + (els**2/elt**2) +(els**2/elb**2))) + el(k) = sqrt( els**2/(1. + (els**2/elt**2))) + el(k) = min(el(k), elb) el(k) = MIN (el(k), elf) el(k) = el(k)*(1.-wt) + alp5*elBLavg(k)*wt @@ -2254,13 +2277,13 @@ SUBROUTINE boulac_length0(k,kts,kte,zw,dz,qtke,theta,lb1,lb2) ! lb2 = the average of the length up and length down !------------------------------------------------------------------- - INTEGER, INTENT(IN) :: k,kts,kte - real(kind_phys), DIMENSION(kts:kte), INTENT(IN) :: qtke,dz,theta - real(kind_phys), INTENT(OUT) :: lb1,lb2 - real(kind_phys), DIMENSION(kts:kte+1), INTENT(IN) :: zw + integer, intent(in) :: k,kts,kte + real(kind_phys), dimension(kts:kte), intent(in) :: qtke,dz,theta + real(kind_phys), intent(out) :: lb1,lb2 + real(kind_phys), dimension(kts:kte+1), intent(in) :: zw !LOCAL VARS - INTEGER :: izz, found + integer :: izz, found real(kind_phys):: dlu,dld real(kind_phys):: dzt, zup, beta, zup_inf, bbb, tl, zdo, zdo_sup, zzz @@ -2404,15 +2427,15 @@ SUBROUTINE boulac_length(kts,kte,zw,dz,qtke,theta,lb1,lb2) ! lb2 = the average of the length up and length down !------------------------------------------------------------------- - INTEGER, INTENT(IN) :: kts,kte - real(kind_phys), DIMENSION(kts:kte), INTENT(IN) :: qtke,dz,theta - real(kind_phys), DIMENSION(kts:kte), INTENT(OUT):: lb1,lb2 - real(kind_phys), DIMENSION(kts:kte+1), INTENT(IN) :: zw + integer, intent(in) :: kts,kte + real(kind_phys), dimension(kts:kte), intent(in) :: qtke,dz,theta + real(kind_phys), dimension(kts:kte), intent(out):: lb1,lb2 + real(kind_phys), dimension(kts:kte+1), intent(in) :: zw !LOCAL VARS - INTEGER :: iz, izz, found - real(kind_phys), DIMENSION(kts:kte) :: dlu,dld - real(kind_phys), PARAMETER :: Lmax=2000. !soft limit + integer :: iz, izz, found + real(kind_phys), dimension(kts:kte) :: dlu,dld + real(kind_phys), parameter :: Lmax=2000. !soft limit real(kind_phys):: dzt, zup, beta, zup_inf, bbb, tl, zdo, zdo_sup, zzz !print*,"IN MYNN-BouLac",kts, kte @@ -2618,40 +2641,40 @@ SUBROUTINE mym_turbulence ( & !------------------------------------------------------------------- - INTEGER, INTENT(IN) :: kts,kte + integer, intent(in) :: kts,kte #ifdef HARDCODE_VERTICAL # define kts 1 # define kte HARDCODE_VERTICAL #endif - INTEGER, INTENT(IN) :: bl_mynn_mixlength,tke_budget - real(kind_phys), INTENT(IN) :: closure - real(kind_phys), DIMENSION(kts:kte), INTENT(in) :: dz - real(kind_phys), DIMENSION(kts:kte+1), INTENT(in) :: zw - real(kind_phys), INTENT(in) :: rmo,flt,fltv,flq, & + integer, intent(in) :: bl_mynn_mixlength,tke_budget + real(kind_phys), intent(in) :: closure + real(kind_phys), dimension(kts:kte), intent(in) :: dz + real(kind_phys), dimension(kts:kte+1), intent(in) :: zw + real(kind_phys), intent(in) :: rmo,flt,fltv,flq, & &Psig_bl,Psig_shcu,xland,dx,zi - real(kind_phys), DIMENSION(kts:kte), INTENT(in) :: u,v,thl,thetav,qw, & + real(kind_phys), dimension(kts:kte), intent(in) :: u,v,thl,thetav,qw, & &ql,vt,vq,qke,tsq,qsq,cov,cldfra_bl1D,edmf_w1,edmf_a1, & &TKEprodTD - real(kind_phys), DIMENSION(kts:kte), INTENT(out) :: dfm,dfh,dfq, & + real(kind_phys), dimension(kts:kte), intent(out) :: dfm,dfh,dfq, & &pdk,pdt,pdq,pdc,tcd,qcd,el - real(kind_phys), DIMENSION(kts:kte), INTENT(inout) :: & + real(kind_phys), dimension(kts:kte), intent(inout) :: & qWT1D,qSHEAR1D,qBUOY1D,qDISS1D real(kind_phys):: q3sq_old,dlsq1,qWTP_old,qWTP_new real(kind_phys):: dudz,dvdz,dTdz,upwp,vpwp,Tpwp - real(kind_phys), DIMENSION(kts:kte) :: qkw,dtl,dqw,dtv,gm,gh,sm,sh + real(kind_phys), dimension(kts:kte) :: qkw,dtl,dqw,dtv,gm,gh,sm,sh - INTEGER :: k + integer :: k ! real(kind_phys):: cc2,cc3,e1c,e2c,e3c,e4c,e5c real(kind_phys):: e6c,dzk,afk,abk,vtt,vqq, & &cw25,clow,cupp,gamt,gamq,smd,gamv,elq,elh real(kind_phys):: cldavg - real(kind_phys), DIMENSION(kts:kte), INTENT(in) :: theta + real(kind_phys), dimension(kts:kte), intent(in) :: theta real(kind_phys):: a2fac, duz, ri !JOE-Canuto/Kitamura mod @@ -2664,10 +2687,10 @@ SUBROUTINE mym_turbulence ( & DOUBLE PRECISION e1, e2, e3, e4, enum, eden, wden ! Stochastic - INTEGER, INTENT(IN) :: spp_pbl - real(kind_phys), DIMENSION(KTS:KTE) :: rstoch_col + integer, intent(in) :: spp_pbl + real(kind_phys), dimension(kts:kte) :: rstoch_col real(kind_phys):: Prnum, shb - real(kind_phys), PARAMETER :: Prlimit = 5.0 + real(kind_phys), parameter :: Prlimit = 5.0 ! ! tv0 = 0.61*tref @@ -3042,7 +3065,7 @@ SUBROUTINE mym_turbulence ( & ! q-variance (pdq), and covariance (pdc) pdk(k) = elq*( sm(k)*gm(k) & & +sh(k)*gh(k)+gamv ) + & - & TKEprodTD(k) + & 0.5*TKEprodTD(k) ! xmchen pdt(k) = elh*( sh(k)*dtl(k)+gamt )*dtl(k) pdq(k) = elh*( sh(k)*dqw(k)+gamq )*dqw(k) pdc(k) = elh*( sh(k)*dtl(k)+gamt ) & @@ -3086,9 +3109,9 @@ SUBROUTINE mym_turbulence ( & !qBUOY1D(k) = elq*(sh(k)*(-dTdz*grav/thl(k)) + gamv) !! ORIGINAL CODE !! Buoyncy term takes the TKEprodTD(k) production now - qBUOY1D(k) = elq*(sh(k)*gh(k)+gamv)+TKEprodTD(k) !staggered + qBUOY1D(k) = elq*(sh(k)*gh(k)+gamv)+0.5*TKEprodTD(k) ! xmchen - !!!Dissipation Term (now it evaluated on mym_predict) + !!!Dissipation Term (now it evaluated in mym_predict) !qDISS1D(k) = (q3sq**(3./2.))/(b1*MAX(el(k),1.)) !! ORIGINAL CODE !! >> EOB @@ -3113,8 +3136,6 @@ SUBROUTINE mym_turbulence ( & qcd(k) = ( qcd(k+1)-qcd(k) )/( dzk ) END DO ! - - if (spp_pbl==1) then DO k = kts,kte dfm(k)= dfm(k) + dfm(k)* rstoch_col(k) * 1.5 * MAX(exp(-MAX(zw(k)-8000.,0.0)/2000.),0.001) @@ -3181,43 +3202,43 @@ SUBROUTINE mym_predict (kts,kte, & & delt, & & dz, & & ust, flt, flq, pmz, phh, & - & el, dfq, rho, & + & el, dfq, rho, & & pdk, pdt, pdq, pdc, & & qke, tsq, qsq, cov, & & s_aw,s_awqke,bl_mynn_edmf_tke, & & qWT1D, qDISS1D,tke_budget) !! TKE budget (Puhales, 2020) !------------------------------------------------------------------- - INTEGER, INTENT(IN) :: kts,kte + integer, intent(in) :: kts,kte #ifdef HARDCODE_VERTICAL # define kts 1 # define kte HARDCODE_VERTICAL #endif - real(kind_phys), INTENT(IN) :: closure - INTEGER, INTENT(IN) :: bl_mynn_edmf_tke,tke_budget - real(kind_phys), DIMENSION(kts:kte), INTENT(IN) :: dz, dfq, el, rho - real(kind_phys), DIMENSION(kts:kte), INTENT(INOUT) :: pdk, pdt, pdq, pdc - real(kind_phys), INTENT(IN) :: flt, flq, pmz, phh - real(kind_phys), INTENT(IN) :: ust, delt - real(kind_phys), DIMENSION(kts:kte), INTENT(INOUT) :: qke,tsq, qsq, cov + real(kind_phys), intent(in) :: closure + integer, intent(in) :: bl_mynn_edmf_tke,tke_budget + real(kind_phys), dimension(kts:kte), intent(in) :: dz, dfq, el, rho + real(kind_phys), dimension(kts:kte), intent(inout) :: pdk, pdt, pdq, pdc + real(kind_phys), intent(in) :: flt, flq, pmz, phh + real(kind_phys), intent(in) :: ust, delt + real(kind_phys), dimension(kts:kte), intent(inout) :: qke,tsq, qsq, cov ! WA 8/3/15 - real(kind_phys), DIMENSION(kts:kte+1), INTENT(INOUT) :: s_awqke,s_aw + real(kind_phys), dimension(kts:kte+1), intent(inout) :: s_awqke,s_aw !! TKE budget (Puhales, 2020, WRF 4.2.1) << EOB - real(kind_phys), DIMENSION(kts:kte), INTENT(OUT) :: qWT1D, qDISS1D - real(kind_phys), DIMENSION(kts:kte) :: tke_up,dzinv + real(kind_phys), dimension(kts:kte), intent(out) :: qWT1D, qDISS1D + real(kind_phys), dimension(kts:kte) :: tke_up,dzinv !! >> EOB - INTEGER :: k - real(kind_phys), DIMENSION(kts:kte) :: qkw, bp, rp, df3q + integer :: k + real(kind_phys), dimension(kts:kte) :: qkw, bp, rp, df3q real(kind_phys):: vkz,pdk1,phm,pdt1,pdq1,pdc1,b1l,b2l,onoff - real(kind_phys), DIMENSION(kts:kte) :: dtz - real(kind_phys), DIMENSION(kts:kte) :: a,b,c,d,x + real(kind_phys), dimension(kts:kte) :: dtz + real(kind_phys), dimension(kts:kte) :: a,b,c,d,x - real(kind_phys), DIMENSION(kts:kte) :: rhoinv - real(kind_phys), DIMENSION(kts:kte+1) :: rhoz,kqdz,kmdz + real(kind_phys), dimension(kts:kte) :: rhoinv + real(kind_phys), dimension(kts:kte+1) :: rhoz,kqdz,kmdz ! REGULATE THE MOMENTUM MIXING FROM THE MASS-FLUX SCHEME (on or off) IF (bl_mynn_edmf_tke == 0) THEN @@ -3263,7 +3284,7 @@ SUBROUTINE mym_predict (kts,kte, & kmdz(k) = MAX(kmdz(k), 0.5* s_aw(k)) kmdz(k) = MAX(kmdz(k), -0.5*(s_aw(k)-s_aw(k+1))) ENDDO -!JOE-end conservation mods + !end conservation mods pdk1 = 2.0*ust**3*pmz/( vkz ) phm = 2.0/ust *phh/( vkz ) @@ -3271,8 +3292,8 @@ SUBROUTINE mym_predict (kts,kte, & pdq1 = phm*flq**2 pdc1 = phm*flt*flq ! -! ** pdk(i,j,1)+pdk(i,j,2) corresponds to pdk1. ** - pdk(kts) = pdk1 -pdk(kts+1) +! ** pdk(1)+pdk(2) corresponds to pdk1. ** + pdk(kts) = pdk1 - pdk(kts+1) !! pdt(kts) = pdt1 -pdt(kts+1) !! pdq(kts) = pdq1 -pdq(kts+1) @@ -3367,7 +3388,7 @@ SUBROUTINE mym_predict (kts,kte, & ENDDO k=kte qWT1D(k)=dzinv(k)*(-kqdz(k)*(tke_up(k)-tke_up(k-1)) & - & + 0.5*rhoinv(k)*(-s_aw(k)*tke_up(k)-s_aw(k)*tke_up(k-1)+s_awqke(k))*onoff) !unstaggared + & + 0.5*rhoinv(k)*(-s_aw(k)*tke_up(k)-s_aw(k)*tke_up(k-1)+s_awqke(k))*onoff) !unstaggered !! >> EOBvt qDISS1D=bp*tke_up !! TKE dissipation rate !unstaggered END IF @@ -3596,39 +3617,43 @@ SUBROUTINE mym_condensation (kts,kte, & !------------------------------------------------------------------- - INTEGER, INTENT(IN) :: kts,kte, bl_mynn_cloudpdf + integer, intent(in) :: kts,kte, bl_mynn_cloudpdf #ifdef HARDCODE_VERTICAL # define kts 1 # define kte HARDCODE_VERTICAL #endif - real(kind_phys), INTENT(IN) :: HFX1,rmo,xland - real(kind_phys), INTENT(IN) :: dx,pblh1 - real(kind_phys), DIMENSION(kts:kte), INTENT(IN) :: dz - real(kind_phys), DIMENSION(kts:kte+1), INTENT(IN) :: zw - real(kind_phys), DIMENSION(kts:kte), INTENT(IN) :: p,exner,thl,qw, & + real(kind_phys), intent(in) :: HFX1,rmo,xland + real(kind_phys), intent(in) :: dx,pblh1 + real(kind_phys), dimension(kts:kte), intent(in) :: dz + real(kind_phys), dimension(kts:kte+1), intent(in) :: zw + real(kind_phys), dimension(kts:kte), intent(in) :: p,exner,thl,qw, & &qv,qc,qi,qs,tsq,qsq,cov,th - real(kind_phys), DIMENSION(kts:kte), INTENT(INOUT) :: vt,vq,sgm + real(kind_phys), dimension(kts:kte), intent(inout) :: vt,vq,sgm - real(kind_phys), DIMENSION(kts:kte) :: alp,a,bet,b,ql,q1,RH - real(kind_phys), DIMENSION(kts:kte), INTENT(OUT) :: qc_bl1D,qi_bl1D, & + real(kind_phys), dimension(kts:kte) :: alp,a,bet,b,ql,q1,RH + real(kind_phys), dimension(kts:kte), intent(out) :: qc_bl1D,qi_bl1D, & &cldfra_bl1D DOUBLE PRECISION :: t3sq, r3sq, c3sq real(kind_phys):: qsl,esat,qsat,dqsl,cld0,q1k,qlk,eq1,qll, & &q2p,pt,rac,qt,t,xl,rsl,cpm,Fng,qww,alpha,beta,bb, & - &ls,wt,cld_factor,fac_damp,liq_frac,ql_ice,ql_water, & - &qmq,qsat_tk,q1_rh,rh_hack - real(kind_phys), PARAMETER :: rhcrit=0.83 !for hom pdf min sigma - INTEGER :: i,j,k + &ls,wt,wt2,qpct,cld_factor,fac_damp,liq_frac,ql_ice,ql_water, & + &qmq,qsat_tk,q1_rh,rh_hack,dzm1,zsl,maxqc + real(kind_phys), parameter :: qpct_sfc=0.025 + real(kind_phys), parameter :: qpct_pbl=0.030 + real(kind_phys), parameter :: qpct_trp=0.040 + real(kind_phys), parameter :: rhcrit =0.83 !for cloudpdf = 2 + real(kind_phys), parameter :: rhmax =1.02 !for cloudpdf = 2 + integer :: i,j,k real(kind_phys):: erf !VARIABLES FOR ALTERNATIVE SIGMA real:: dth,dtl,dqw,dzk,els - real(kind_phys), DIMENSION(kts:kte), INTENT(IN) :: Sh,el + real(kind_phys), dimension(kts:kte), intent(in) :: Sh,el !variables for SGS BL clouds real(kind_phys) :: zagl,damp,PBLH2 @@ -3636,11 +3661,11 @@ SUBROUTINE mym_condensation (kts,kte, & !JAYMES: variables for tropopause-height estimation real(kind_phys) :: theta1, theta2, ht1, ht2 - INTEGER :: k_tropo + integer :: k_tropo ! Stochastic - INTEGER, INTENT(IN) :: spp_pbl - real(kind_phys), DIMENSION(KTS:KTE) :: rstoch_col + integer, intent(in) :: spp_pbl + real(kind_phys), dimension(kts:kte) :: rstoch_col real(kind_phys) :: qw_pert ! First, obtain an estimate for the tropopause height (k), using the method employed in the @@ -3794,29 +3819,31 @@ SUBROUTINE mym_condensation (kts,kte, & !Diagnostic statistical scheme of Chaboureau and Bechtold (2002), JAS !but with use of higher-order moments to estimate sigma - PBLH2=MAX(10.,PBLH1) + pblh2=MAX(10._kind_phys,pblh1) zagl = 0. + dzm1 = 0. DO k = kts,kte-1 - zagl = zagl + dz(k) - t = th(k)*exner(k) + zagl = zagl + 0.5*(dz(k) + dzm1) + dzm1 = dz(k) - xl = xl_blend(t) ! obtain latent heat - qsat_tk = qsat_blend(t, p(k)) ! saturation water vapor mixing ratio at tk and p - rh(k)=MAX(MIN(1.00,qw(k)/MAX(1.E-10,qsat_tk)),0.001) + t = th(k)*exner(k) + xl = xl_blend(t) ! obtain latent heat + qsat_tk= qsat_blend(t, p(k)) ! saturation water vapor mixing ratio at tk and p + rh(k) = MAX(MIN(rhmax, qw(k)/MAX(1.E-10,qsat_tk)),0.001_kind_phys) !dqw/dT: Clausius-Clapeyron - dqsl = qsat_tk*ep_2*xlv/( r_d*t**2 ) + dqsl = qsat_tk*ep_2*xlv/( r_d*t**2 ) alp(k) = 1.0/( 1.0+dqsl*xlvcp ) bet(k) = dqsl*exner(k) - rsl = xl*qsat_tk / (r_v*t**2) ! slope of C-C curve at t (=abs temperature) + rsl = xl*qsat_tk / (r_v*t**2) ! slope of C-C curve at t (=abs temperature) ! CB02, Eqn. 4 - cpm = cp + qw(k)*cpv ! CB02, sec. 2, para. 1 - a(k) = 1./(1. + xl*rsl/cpm) ! CB02 variable "a" - b(k) = a(k)*rsl ! CB02 variable "b" + cpm = cp + qw(k)*cpv ! CB02, sec. 2, para. 1 + a(k) = 1./(1. + xl*rsl/cpm) ! CB02 variable "a" + b(k) = a(k)*rsl ! CB02 variable "b" !SPP - qw_pert = qw(k) + qw(k)*0.5*rstoch_col(k)*real(spp_pbl) + qw_pert= qw(k) + qw(k)*0.5*rstoch_col(k)*real(spp_pbl) !This form of qmq (the numerator of Q1) no longer uses the a(k) factor qmq = qw_pert - qsat_tk ! saturation deficit/excess; @@ -3826,28 +3853,39 @@ SUBROUTINE mym_condensation (kts,kte, & r3sq = max( qsq(k), 0.0 ) !Calculate sigma using higher-order moments: sgm(k) = SQRT( r3sq ) - !Set limits on sigma relative to saturation water vapor + !Set constraints on sigma relative to saturation water vapor sgm(k) = min( sgm(k), qsat_tk*0.666 ) - sgm(k) = max( sgm(k), qsat_tk*0.035 ) + !sgm(k) = max( sgm(k), qsat_tk*0.035 ) + + !introduce vertical grid spacing dependence on min sgm + wt = max(500. - max(dz(k)-100.,0.0), 0.0_kind_phys)/500. !=1 for dz < 100 m, =0 for dz > 600 m + sgm(k) = sgm(k) + sgm(k)*0.2*(1.0-wt) !inflate sgm for coarse dz + + !allow min sgm to vary with dz and z. + qpct = qpct_pbl*wt + qpct_trp*(1.0-wt) + qpct = min(qpct, max(qpct_sfc, qpct_pbl*zagl/500.) ) + sgm(k) = max( sgm(k), qsat_tk*qpct ) + q1(k) = qmq / sgm(k) ! Q1, the normalized saturation !Add condition for falling/settling into low-RH layers, so at least - !some cloud fraction is applied for all qc and qi. - rh_hack = rh(k) - !ensure adequate RH & q1 when qi is at least 1e-9 - if (qi(k)>1.e-9) then - rh_hack =min(1.0, rhcrit + 0.06*(9.0 + log10(qi(k)))) + !some cloud fraction is applied for all qc, qs, and qi. + rh_hack= rh(k) + wt2 = min(max( zagl - pblh2, 0.0 )/300., 1.0) + !ensure adequate RH & q1 when qi is at least 1e-9 (above the PBLH) + if ((qi(k)+qs(k))>1.e-9 .and. (zagl .gt. pblh2)) then + rh_hack =min(rhmax, rhcrit + wt2*0.045*(9.0 + log10(qi(k)+qs(k)))) rh(k) =max(rh(k), rh_hack) !add rh-based q1 - q1_rh =-3. + 3.*(rh_hack-rhcrit)/(1.-rhcrit) + q1_rh =-3. + 3.*(rh(k)-rhcrit)/(1.-rhcrit) q1(k) =max(q1_rh, q1(k) ) endif - !ensure adequate RH & q1 when qc is at least 1e-6 - if (qc(k)>1.e-6) then - rh_hack =min(1.0, rhcrit + 0.09*(6.0 + log10(qc(k)))) + !ensure adequate rh & q1 when qc is at least 1e-6 (above the PBLH) + if (qc(k)>1.e-6 .and. (zagl .gt. pblh2)) then + rh_hack =min(rhmax, rhcrit + wt2*0.08*(6.0 + log10(qc(k)))) rh(k) =max(rh(k), rh_hack) !add rh-based q1 - q1_rh =-3. + 3.*(rh_hack-rhcrit)/(1.-rhcrit) + q1_rh =-3. + 3.*(rh(k)-rhcrit)/(1.-rhcrit) q1(k) =max(q1_rh, q1(k) ) endif @@ -3864,20 +3902,17 @@ SUBROUTINE mym_condensation (kts,kte, & ! Specify hydrometeors ! JAYMES- this option added 8 May 2015 ! The cloud water formulations are taken from CB02, Eq. 8. - IF (q1k < 0.) THEN !unsaturated -#ifdef SINGLE_PREC - ql_water = sgm(k)*EXP(1.2*q1k-1.) -#else - ql_water = sgm(k)*EXP(1.2*q1k-1.) -#endif - ql_ice = sgm(k)*EXP(1.2*q1k-1.) - ELSE IF (q1k > 2.) THEN !supersaturated - ql_water = sgm(k)*q1k - ql_ice = sgm(k)*q1k - ELSE !slightly saturated (0 > q1 < 2) - ql_water = sgm(k)*(EXP(-1.) + 0.66*q1k + 0.086*q1k**2) - ql_ice = sgm(k)*(EXP(-1.) + 0.66*q1k + 0.086*q1k**2) - ENDIF + maxqc = max(qw(k) - qsat_tk, 0.0) + if (q1k < 0.) then !unsaturated + ql_water = sgm(k)*exp(1.2*q1k-1.) + ql_ice = sgm(k)*exp(1.2*q1k-1.) + elseif (q1k > 2.) then !supersaturated + ql_water = min(sgm(k)*q1k, maxqc) + ql_ice = sgm(k)*q1k + else !slightly saturated (0 > q1 < 2) + ql_water = min(sgm(k)*(exp(-1.) + 0.66*q1k + 0.086*q1k**2), maxqc) + ql_ice = sgm(k)*(exp(-1.) + 0.66*q1k + 0.086*q1k**2) + endif !In saturated grid cells, use average of SGS and resolved values !if ( qc(k) > 1.e-6 ) ql_water = 0.5 * ( ql_water + qc(k) ) @@ -3922,17 +3957,22 @@ SUBROUTINE mym_condensation (kts,kte, & ! Fng = 1.-1.5*q1k !ENDIF ! Use the form of "Fng" from Bechtold and Siebesma (1998, JAS) - IF (q1k .GE. 1.0) THEN + if (q1k .ge. 1.0) then Fng = 1.0 - ELSEIF (q1k .GE. -1.7 .AND. q1k .LT. 1.0) THEN - Fng = EXP(-0.4*(q1k-1.0)) - ELSEIF (q1k .GE. -2.5 .AND. q1k .LT. -1.7) THEN - Fng = 3.0 + EXP(-3.8*(q1k+1.7)) - ELSE - Fng = MIN(23.9 + EXP(-1.6*(q1k+2.5)), 60.) - ENDIF + elseif (q1k .ge. -1.7 .and. q1k .lt. 1.0) then + Fng = exp(-0.4*(q1k-1.0)) + elseif (q1k .ge. -2.5 .and. q1k .lt. -1.7) then + Fng = 3.0 + exp(-3.8*(q1k+1.7)) + else + Fng = min(23.9 + exp(-1.6*(q1k+2.5)), 60._kind_phys) + endif + + cfmax = min(cldfra_bl1D(k), 0.6_kind_phys) + !Further limit the cf going into vt & vq near the surface + zsl = min(max(25., 0.1*pblh2), 100.) + wt = min(zagl/zsl, 1.0) !=0 at z=0 m, =1 above ekman layer + cfmax = cfmax*wt - cfmax= min(cldfra_bl1D(k), 0.6) bb = b(k)*t/th(k) ! bb is "b" in BCMT95. Their "b" differs from ! "b" in CB02 (i.e., b(k) above) by a factor ! of T/theta. Strictly, b(k) above is formulated in @@ -3954,7 +3994,7 @@ SUBROUTINE mym_condensation (kts,kte, & fac_damp = min(zagl * 0.0025, 1.0) !cld_factor = 1.0 + fac_damp*MAX(0.0, ( RH(k) - 0.75 ) / 0.26 )**1.9 !HRRRv4 !cld_factor = 1.0 + fac_damp*min((max(0.0, ( RH(k) - 0.92 )) / 0.25 )**2, 0.3) - cld_factor = 1.0 + fac_damp*min((max(0.0, ( RH(k) - 0.92 )) / 0.145)**2, 0.35) + cld_factor = 1.0 + fac_damp*min((max(0.0, ( RH(k) - 0.92 )) / 0.145)**2, 0.37) cldfra_bl1D(K) = min( 1., cld_factor*cldfra_bl1D(K) ) enddo @@ -4023,17 +4063,17 @@ SUBROUTINE mynn_tendencies(kts,kte,i, & &bl_mynn_mixscalars ) !------------------------------------------------------------------- - INTEGER, INTENT(in) :: kts,kte,i + integer, intent(in) :: kts,kte,i #ifdef HARDCODE_VERTICAL # define kts 1 # define kte HARDCODE_VERTICAL #endif - INTEGER, INTENT(in) :: bl_mynn_cloudmix,bl_mynn_mixqt, & + integer, intent(in) :: bl_mynn_cloudmix,bl_mynn_mixqt, & bl_mynn_edmf,bl_mynn_edmf_mom, & bl_mynn_mixscalars - LOGICAL, INTENT(IN) :: FLAG_QI,FLAG_QNI,FLAG_QC,FLAG_QS, & + logical, intent(IN) :: FLAG_QI,FLAG_QNI,FLAG_QC,FLAG_QS, & &FLAG_QNC,FLAG_QNWFA,FLAG_QNIFA,FLAG_QNBCA ! thl - liquid water potential temperature @@ -4043,47 +4083,47 @@ SUBROUTINE mynn_tendencies(kts,kte,i, & ! flq - surface flux of qw ! mass-flux plumes - real(kind_phys), DIMENSION(kts:kte+1), INTENT(in) :: s_aw, & + real(kind_phys), dimension(kts:kte+1), intent(in) :: s_aw, & &s_awthl,s_awqt,s_awqnc,s_awqni,s_awqv,s_awqc,s_awu,s_awv, & &s_awqnwfa,s_awqnifa,s_awqnbca, & &sd_aw,sd_awthl,sd_awqt,sd_awqv,sd_awqc,sd_awu,sd_awv ! tendencies from mass-flux environmental subsidence and detrainment - real(kind_phys), DIMENSION(kts:kte), INTENT(in) :: sub_thl,sub_sqv, & + real(kind_phys), dimension(kts:kte), intent(in) :: sub_thl,sub_sqv, & &sub_u,sub_v,det_thl,det_sqv,det_sqc,det_u,det_v - real(kind_phys), DIMENSION(kts:kte), INTENT(in) :: u,v,th,tk,qv,qc,qi,& + real(kind_phys), dimension(kts:kte), intent(in) :: u,v,th,tk,qv,qc,qi,& &qs,qni,qnc,rho,p,exner,dfq,dz,tsq,qsq,cov,tcd,qcd, & &cldfra_bl1d,diss_heat - real(kind_phys), DIMENSION(kts:kte), INTENT(inout) :: thl,sqw,sqv,sqc,& + real(kind_phys), dimension(kts:kte), intent(inout) :: thl,sqw,sqv,sqc,& &sqi,sqs,qnwfa,qnifa,qnbca,ozone,dfm,dfh - real(kind_phys), DIMENSION(kts:kte), INTENT(inout) :: du,dv,dth,dqv, & + real(kind_phys), dimension(kts:kte), intent(inout) :: du,dv,dth,dqv, & &dqc,dqi,dqs,dqni,dqnc,dqnwfa,dqnifa,dqnbca,dozone - real(kind_phys), INTENT(IN) :: flt,flq,flqv,flqc,uoce,voce - real(kind_phys), INTENT(IN) :: ust,delt,psfc,wspd + real(kind_phys), intent(in) :: flt,flq,flqv,flqc,uoce,voce + real(kind_phys), intent(in) :: ust,delt,psfc,wspd !debugging real(kind_phys):: wsp,wsp2,tk2,th2 - LOGICAL :: problem + logical :: problem integer :: kproblem -! real(kind_phys), INTENT(IN) :: gradu_top,gradv_top,gradth_top,gradqv_top +! real(kind_phys), intent(in) :: gradu_top,gradv_top,gradth_top,gradqv_top !local vars - real(kind_phys), DIMENSION(kts:kte) :: dtz,dfhc,dfmc,delp - real(kind_phys), DIMENSION(kts:kte) :: sqv2,sqc2,sqi2,sqs2,sqw2, & + real(kind_phys), dimension(kts:kte) :: dtz,dfhc,dfmc,delp + real(kind_phys), dimension(kts:kte) :: sqv2,sqc2,sqi2,sqs2,sqw2, & &qni2,qnc2,qnwfa2,qnifa2,qnbca2,ozone2 - real(kind_phys), DIMENSION(kts:kte) :: zfac,plumeKh,rhoinv - real(kind_phys), DIMENSION(kts:kte) :: a,b,c,d,x - real(kind_phys), DIMENSION(kts:kte+1) :: rhoz, & !rho on model interface + real(kind_phys), dimension(kts:kte) :: zfac,plumeKh,rhoinv + real(kind_phys), dimension(kts:kte) :: a,b,c,d,x + real(kind_phys), dimension(kts:kte+1) :: rhoz, & !rho on model interface &khdz,kmdz real(kind_phys):: rhs,gfluxm,gfluxp,dztop,maxdfh,mindfh,maxcf,maxKh,zw real(kind_phys):: t,esat,qsl,onoff,kh,km,dzk,rhosfc real(kind_phys):: ustdrag,ustdiff,qvflux real(kind_phys):: th_new,portion_qc,portion_qi,condensate,qsat - INTEGER :: k,kk + integer :: k,kk !Activate nonlocal mixing from the mass-flux scheme for !number concentrations and aerosols (0.0 = no; 1.0 = yes) - real(kind_phys), PARAMETER :: nonloc = 1.0 + real(kind_phys), parameter :: nonloc = 1.0 dztop=.5*(dz(kte)+dz(kte-1)) @@ -4141,38 +4181,33 @@ SUBROUTINE mynn_tendencies(kts,kte,i, & k=kts -!original approach (drag in b-vector): -! a(1)=0. -! b(1)=1. + dtz(k)*(dfm(k+1)+ust**2/wspd) - 0.5*dtz(k)*s_aw(k+1)*onoff -! c(1)=-dtz(k)*dfm(k+1) - 0.5*dtz(k)*s_aw(k+1)*onoff -! d(1)=u(k) + dtz(k)*uoce*ust**2/wspd - dtz(k)*s_awu(k+1)*onoff + & -! sub_u(k)*delt + det_u(k)*delt - !rho-weighted (drag in b-vector): a(k)= -dtz(k)*kmdz(k)*rhoinv(k) - b(k)=1.+dtz(k)*(kmdz(k+1)+rhosfc*ust**2/wspd)*rhoinv(k) & - & - 0.5*dtz(k)*s_aw(k+1)*onoff - 0.5*dtz(k)*rhoinv(k)*sd_aw(k+1)*onoff + b(k)=1.+dtz(k)*(kmdz(k+1)+rhosfc*ust**2/wspd)*rhoinv(k) & + & - 0.5*dtz(k)*rhoinv(k)*s_aw(k+1)*onoff & + & - 0.5*dtz(k)*rhoinv(k)*sd_aw(k+1)*onoff c(k)= -dtz(k)*kmdz(k+1)*rhoinv(k) & - & - 0.5*dtz(k)*s_aw(k+1)*onoff - 0.5*dtz(k)*rhoinv(k)*sd_aw(k+1)*onoff - d(k)=u(k) + dtz(k)*uoce*ust**2/wspd - dtz(k)*s_awu(k+1)*onoff - & - & dtz(k)*rhoinv(k)*sd_awu(k+1)*onoff + sub_u(k)*delt + det_u(k)*delt - -!rho-weighted with drag term moved out of b-array -! a(k)= -dtz(k)*kmdz(k)*rhoinv(k) -! b(k)=1.+dtz(k)*(kmdz(k+1))*rhoinv(k) - 0.5*dtz(k)*rhoinv(k)*s_aw(k+1)*onoff - 0.5*dtz(k)*rhoinv(k)*sd_aw(k+1)*onoff -! c(k)= -dtz(k)*kmdz(k+1)*rhoinv(k) - 0.5*dtz(k)*rhoinv(k)*s_aw(k+1)*onoff - 0.5*dtz(k)*rhoinv(k)*sd_aw(k+1)*onoff -! d(k)=u(k)*(1.-ust**2/wspd*dtz(k)*rhosfc/rho(k)) + dtz(k)*uoce*ust**2/wspd - & -! !!!d(k)=u(k)*(1.-ust**2/wspd*dtz(k)) + dtz(k)*uoce*ust**2/wspd - & -! & dtz(k)*rhoinv(k)*s_awu(k+1)*onoff - dtz(k)*rhoinv(k)*sd_awu(k+1)*onoff + sub_u(k)*delt + det_u(k)*delt - - DO k=kts+1,kte-1 - a(k)= -dtz(k)*kmdz(k)*rhoinv(k) + 0.5*dtz(k)*rhoinv(k)*s_aw(k)*onoff + 0.5*dtz(k)*rhoinv(k)*sd_aw(k)*onoff - b(k)=1.+dtz(k)*(kmdz(k)+kmdz(k+1))*rhoinv(k) + & - & 0.5*dtz(k)*rhoinv(k)*(s_aw(k)-s_aw(k+1))*onoff + 0.5*dtz(k)*rhoinv(k)*(sd_aw(k)-sd_aw(k+1))*onoff - c(k)= -dtz(k)*kmdz(k+1)*rhoinv(k) - 0.5*dtz(k)*rhoinv(k)*s_aw(k+1)*onoff - 0.5*dtz(k)*rhoinv(k)*sd_aw(k+1)*onoff - d(k)=u(k) + dtz(k)*rhoinv(k)*(s_awu(k)-s_awu(k+1))*onoff + dtz(k)*rhoinv(k)*(sd_awu(k)-sd_awu(k+1))*onoff + & - & sub_u(k)*delt + det_u(k)*delt - ENDDO + & - 0.5*dtz(k)*rhoinv(k)*s_aw(k+1)*onoff & + & - 0.5*dtz(k)*rhoinv(k)*sd_aw(k+1)*onoff + d(k)=u(k) + dtz(k)*uoce*ust**2/wspd & + & - dtz(k)*rhoinv(k)*s_awu(k+1)*onoff & + & + dtz(k)*rhoinv(k)*sd_awu(k+1)*onoff & + & + sub_u(k)*delt + det_u(k)*delt + + do k=kts+1,kte-1 + a(k)= -dtz(k)*kmdz(k)*rhoinv(k) & + & + 0.5*dtz(k)*rhoinv(k)*s_aw(k)*onoff & + & + 0.5*dtz(k)*rhoinv(k)*sd_aw(k)*onoff + b(k)=1.+ dtz(k)*(kmdz(k)+kmdz(k+1))*rhoinv(k) & + & + 0.5*dtz(k)*rhoinv(k)*(s_aw(k)-s_aw(k+1))*onoff & + & + 0.5*dtz(k)*rhoinv(k)*(sd_aw(k)-sd_aw(k+1))*onoff + c(k)= - dtz(k)*kmdz(k+1)*rhoinv(k) & + & - 0.5*dtz(k)*rhoinv(k)*s_aw(k+1)*onoff & + & - 0.5*dtz(k)*rhoinv(k)*sd_aw(k+1)*onoff + d(k)=u(k) + dtz(k)*rhoinv(k)*(s_awu(k)-s_awu(k+1))*onoff & + & - dtz(k)*rhoinv(k)*(sd_awu(k)-sd_awu(k+1))*onoff & + & + sub_u(k)*delt + det_u(k)*delt + enddo !! no flux at the top ! a(kte)=-1. @@ -4207,37 +4242,33 @@ SUBROUTINE mynn_tendencies(kts,kte,i, & k=kts -!original approach (drag in b-vector): -! a(1)=0. -! b(1)=1. + dtz(k)*(dfm(k+1)+ust**2/wspd) - 0.5*dtz(k)*s_aw(k+1)*onoff -! c(1)= - dtz(k)*dfm(k+1) - 0.5*dtz(k)*s_aw(k+1)*onoff -! d(1)=v(k) + dtz(k)*voce*ust**2/wspd - dtz(k)*s_awv(k+1)*onoff + & -! sub_v(k)*delt + det_v(k)*delt - !rho-weighted (drag in b-vector): a(k)= -dtz(k)*kmdz(k)*rhoinv(k) - b(k)=1.+dtz(k)*(kmdz(k+1) + rhosfc*ust**2/wspd)*rhoinv(k) & - & - 0.5*dtz(k)*s_aw(k+1)*onoff - 0.5*dtz(k)*rhoinv(k)*sd_aw(k+1)*onoff - c(k)= -dtz(k)*kmdz(k+1)*rhoinv(k) - 0.5*dtz(k)*s_aw(k+1)*onoff - 0.5*dtz(k)*rhoinv(k)*sd_aw(k+1)*onoff - d(k)=v(k) + dtz(k)*voce*ust**2/wspd - dtz(k)*s_awv(k+1)*onoff - dtz(k)*rhoinv(k)*sd_awv(k+1)*onoff + & - & sub_v(k)*delt + det_v(k)*delt - -!rho-weighted with drag term moved out of b-array -! a(k)= -dtz(k)*kmdz(k)*rhoinv(k) -! b(k)=1.+dtz(k)*(kmdz(k+1))*rhoinv(k) - 0.5*dtz(k)*rhoinv(k)*s_aw(k+1)*onoff - 0.5*dtz(k)*rhoinv(k)*sd_aw(k+1)*onoff -! c(k)= -dtz(k)*kmdz(k+1)*rhoinv(k) - 0.5*dtz(k)*rhoinv(k)*s_aw(k+1)*onoff - 0.5*dtz(k)*rhoinv(k)*sd_aw(k+1)*onoff -! d(k)=v(k)*(1.-ust**2/wspd*dtz(k)*rhosfc/rho(k)) + dtz(k)*voce*ust**2/wspd - & -! !!!d(k)=v(k)*(1.-ust**2/wspd*dtz(k)) + dtz(k)*voce*ust**2/wspd - & -! & dtz(k)*rhoinv(k)*s_awv(k+1)*onoff - dtz(k)*rhoinv(k)*sd_awv(k+1)*onoff + sub_v(k)*delt + det_v(k)*delt - - DO k=kts+1,kte-1 - a(k)= -dtz(k)*kmdz(k)*rhoinv(k) + 0.5*dtz(k)*rhoinv(k)*s_aw(k)*onoff + 0.5*dtz(k)*rhoinv(k)*sd_aw(k)*onoff - b(k)=1.+dtz(k)*(kmdz(k)+kmdz(k+1))*rhoinv(k) + & - & 0.5*dtz(k)*rhoinv(k)*(s_aw(k)-s_aw(k+1))*onoff + 0.5*dtz(k)*rhoinv(k)*(sd_aw(k)-sd_aw(k+1))*onoff - c(k)= -dtz(k)*kmdz(k+1)*rhoinv(k) - 0.5*dtz(k)*rhoinv(k)*s_aw(k+1)*onoff - 0.5*dtz(k)*rhoinv(k)*sd_aw(k+1)*onoff - d(k)=v(k) + dtz(k)*rhoinv(k)*(s_awv(k)-s_awv(k+1))*onoff + dtz(k)*rhoinv(k)*(sd_awv(k)-sd_awv(k+1))*onoff + & - & sub_v(k)*delt + det_v(k)*delt - ENDDO + b(k)=1.+dtz(k)*(kmdz(k+1) + rhosfc*ust**2/wspd)*rhoinv(k) & + & - 0.5*dtz(k)*rhoinv(k)*s_aw(k+1)*onoff & + & - 0.5*dtz(k)*rhoinv(k)*sd_aw(k+1)*onoff + c(k)= -dtz(k)*kmdz(k+1)*rhoinv(k) & + & - 0.5*dtz(k)*rhoinv(k)*s_aw(k+1)*onoff & + & - 0.5*dtz(k)*rhoinv(k)*sd_aw(k+1)*onoff + d(k)=v(k) + dtz(k)*voce*ust**2/wspd & + & - dtz(k)*rhoinv(k)*s_awv(k+1)*onoff & + & + dtz(k)*rhoinv(k)*sd_awv(k+1)*onoff & + & + sub_v(k)*delt + det_v(k)*delt + + do k=kts+1,kte-1 + a(k)= -dtz(k)*kmdz(k)*rhoinv(k) & + & + 0.5*dtz(k)*rhoinv(k)*s_aw(k)*onoff & + & + 0.5*dtz(k)*rhoinv(k)*sd_aw(k)*onoff + b(k)=1.+dtz(k)*(kmdz(k)+kmdz(k+1))*rhoinv(k) & + & + 0.5*dtz(k)*rhoinv(k)*(s_aw(k)-s_aw(k+1))*onoff & + & + 0.5*dtz(k)*rhoinv(k)*(sd_aw(k)-sd_aw(k+1))*onoff + c(k)= -dtz(k)*kmdz(k+1)*rhoinv(k) & + & - 0.5*dtz(k)*rhoinv(k)*s_aw(k+1)*onoff & + & - 0.5*dtz(k)*rhoinv(k)*sd_aw(k+1)*onoff + d(k)=v(k) + dtz(k)*rhoinv(k)*(s_awv(k)-s_awv(k+1))*onoff & + & - dtz(k)*rhoinv(k)*(sd_awv(k)-sd_awv(k+1))*onoff & + & + sub_v(k)*delt + det_v(k)*delt + enddo !! no flux at the top ! a(kte)=-1. @@ -4586,7 +4617,8 @@ SUBROUTINE mynn_tendencies(kts,kte,i, & !============================================ ! MIX SNOW ( sqs ) !============================================ -IF (bl_mynn_cloudmix > 0 .AND. FLAG_QS) THEN +!hard-code to not mix snow +IF (bl_mynn_cloudmix > 0 .AND. .false.) THEN k=kts !rho-weighted: @@ -4813,8 +4845,8 @@ SUBROUTINE mynn_tendencies(kts,kte,i, & d(kte)=qnbca(kte) ! CALL tridiag(kte,a,b,c,d) -! CALL tridiag2(kte,a,b,c,d,x) - CALL tridiag3(kte,a,b,c,d,x) + CALL tridiag2(kte,a,b,c,d,x) +! CALL tridiag3(kte,a,b,c,d,x) DO k=kts,kte !qnbca2(k)=d(k-kts+1) @@ -4891,9 +4923,6 @@ SUBROUTINE mynn_tendencies(kts,kte,i, & sqi2(k) = 0.0 ! if sqw2 > qsat sqc2(k) = 0.0 ENDIF - !dqv(k) = (sqv2(k) - sqv(k))/delt - !dqc(k) = (sqc2(k) - sqc(k))/delt - !dqi(k) = (sqi2(k) - sqi(k))/delt ENDDO ENDIF @@ -4902,7 +4931,7 @@ SUBROUTINE mynn_tendencies(kts,kte,i, & ! WATER VAPOR TENDENCY !===================== DO k=kts,kte - Dqv(k)=(sqv2(k)/(1.-sqv2(k)) - qv(k))/delt + Dqv(k)=(sqv2(k) - sqv(k))/delt !if (sqv2(k) < 0.0)print*,"neg qv:",sqv2(k),k ENDDO @@ -4913,7 +4942,7 @@ SUBROUTINE mynn_tendencies(kts,kte,i, & !print*,"FLAG_QC:",FLAG_QC IF (FLAG_QC) THEN DO k=kts,kte - Dqc(k)=(sqc2(k)/(1.-sqv2(k)) - qc(k))/delt + Dqc(k)=(sqc2(k) - sqc(k))/delt !if (sqc2(k) < 0.0)print*,"neg qc:",sqc2(k),k ENDDO ELSE @@ -4941,7 +4970,7 @@ SUBROUTINE mynn_tendencies(kts,kte,i, & !=================== IF (FLAG_QI) THEN DO k=kts,kte - Dqi(k)=(sqi2(k)/(1.-sqv2(k)) - qi(k))/delt + Dqi(k)=(sqi2(k) - sqi(k))/delt !if (sqi2(k) < 0.0)print*,"neg qi:",sqi2(k),k ENDDO ELSE @@ -4953,9 +4982,9 @@ SUBROUTINE mynn_tendencies(kts,kte,i, & !=================== ! CLOUD SNOW TENDENCY !=================== - IF (FLAG_QS) THEN + IF (.false.) THEN !disabled DO k=kts,kte - Dqs(k)=(sqs2(k)/(1.-sqs2(k)) - qs(k))/delt + Dqs(k)=(sqs2(k) - sqs(k))/delt ENDDO ELSE DO k=kts,kte @@ -4979,10 +5008,11 @@ SUBROUTINE mynn_tendencies(kts,kte,i, & ELSE !-MIX CLOUD SPECIES? !CLOUDS ARE NOT NIXED (when bl_mynn_cloudmix == 0) DO k=kts,kte - Dqc(k)=0. + Dqc(k) =0. Dqnc(k)=0. - Dqi(k)=0. + Dqi(k) =0. Dqni(k)=0. + Dqs(k) =0. ENDDO ENDIF @@ -5207,36 +5237,36 @@ SUBROUTINE mynn_mix_chem(kts,kte,i, & enh_mix, smoke_dbg ) !------------------------------------------------------------------- - INTEGER, INTENT(in) :: kts,kte,i - real(kind_phys), DIMENSION(kts:kte), INTENT(IN) :: dfh,dz,tcd,qcd - real(kind_phys), DIMENSION(kts:kte), INTENT(INOUT) :: rho - real(kind_phys), INTENT(IN) :: flt - real(kind_phys), INTENT(IN) :: delt,pblh - INTEGER, INTENT(IN) :: nchem, kdvel, ndvel - real(kind_phys), DIMENSION( kts:kte+1), INTENT(IN) :: s_aw - real(kind_phys), DIMENSION( kts:kte, nchem ), INTENT(INOUT) :: chem1 - real(kind_phys), DIMENSION( kts:kte+1,nchem), INTENT(IN) :: s_awchem - real(kind_phys), DIMENSION( ndvel ), INTENT(IN) :: vd1 - real(kind_phys), INTENT(IN) :: emis_ant_no,frp - LOGICAL, INTENT(IN) :: rrfs_sd,enh_mix,smoke_dbg + integer, intent(in) :: kts,kte,i + real(kind_phys), dimension(kts:kte), intent(in) :: dfh,dz,tcd,qcd + real(kind_phys), dimension(kts:kte), intent(inout) :: rho + real(kind_phys), intent(in) :: flt + real(kind_phys), intent(in) :: delt,pblh + integer, intent(in) :: nchem, kdvel, ndvel + real(kind_phys), dimension( kts:kte+1), intent(in) :: s_aw + real(kind_phys), dimension( kts:kte, nchem ), intent(inout) :: chem1 + real(kind_phys), dimension( kts:kte+1,nchem), intent(in) :: s_awchem + real(kind_phys), dimension( ndvel ), intent(in) :: vd1 + real(kind_phys), intent(in) :: emis_ant_no,frp + logical, intent(in) :: rrfs_sd,enh_mix,smoke_dbg !local vars - real(kind_phys), DIMENSION(kts:kte) :: dtz - real(kind_phys), DIMENSION(kts:kte) :: a,b,c,d,x + real(kind_phys), dimension(kts:kte) :: dtz + real(kind_phys), dimension(kts:kte) :: a,b,c,d,x real(kind_phys):: rhs,dztop real(kind_phys):: t,dzk real(kind_phys):: hght real(kind_phys):: khdz_old, khdz_back - INTEGER :: k,kk,kmaxfire ! JLS 12/21/21 - INTEGER :: ic ! Chemical array loop index + integer :: k,kk,kmaxfire ! JLS 12/21/21 + integer :: ic ! Chemical array loop index - INTEGER, SAVE :: icall + integer, SAVE :: icall - real(kind_phys), DIMENSION(kts:kte) :: rhoinv - real(kind_phys), DIMENSION(kts:kte+1) :: rhoz,khdz - real(kind_phys), PARAMETER :: NO_threshold = 10.0 ! For anthropogenic sources - real(kind_phys), PARAMETER :: frp_threshold = 10.0 ! RAR 02/11/22: I increased the frp threshold to enhance mixing over big fires - real(kind_phys), PARAMETER :: pblh_threshold = 100.0 + real(kind_phys), dimension(kts:kte) :: rhoinv + real(kind_phys), dimension(kts:kte+1) :: rhoz,khdz + real(kind_phys), parameter :: NO_threshold = 10.0 ! For anthropogenic sources + real(kind_phys), parameter :: frp_threshold = 10.0 ! RAR 02/11/22: I increased the frp threshold to enhance mixing over big fires + real(kind_phys), parameter :: pblh_threshold = 100.0 dztop=.5*(dz(kte)+dz(kte-1)) @@ -5335,14 +5365,14 @@ SUBROUTINE retrieve_exchange_coeffs(kts,kte,& !------------------------------------------------------------------- - INTEGER , INTENT(in) :: kts,kte + integer , intent(in) :: kts,kte - real(kind_phys), DIMENSION(KtS:KtE), INTENT(in) :: dz,dfm,dfh + real(kind_phys), dimension(KtS:KtE), intent(in) :: dz,dfm,dfh - real(kind_phys), DIMENSION(KtS:KtE), INTENT(out) :: K_m, K_h + real(kind_phys), dimension(KtS:KtE), intent(out) :: K_m, K_h - INTEGER :: k + integer :: k real(kind_phys):: dzk K_m(kts)=0. @@ -5368,13 +5398,13 @@ SUBROUTINE tridiag(n,a,b,c,d) !------------------------------------------------------------------- - INTEGER, INTENT(in):: n - real(kind_phys), DIMENSION(n), INTENT(in) :: a,b - real(kind_phys), DIMENSION(n), INTENT(inout) :: c,d + integer, intent(in):: n + real(kind_phys), dimension(n), intent(in) :: a,b + real(kind_phys), dimension(n), intent(inout) :: c,d - INTEGER :: i + integer :: i real(kind_phys):: p - real(kind_phys), DIMENSION(n) :: q + real(kind_phys), dimension(n) :: q c(n)=0. q(1)=-c(1)/b(1) @@ -5508,23 +5538,23 @@ SUBROUTINE GET_PBLH(KTS,KTE,zi,thetav1D,qke1D,zw1D,dz1D,landsea,kzi) !value could be found to work best in all conditions. !--------------------------------------------------------------- - INTEGER,INTENT(IN) :: KTS,KTE + integer,intent(in) :: KTS,KTE #ifdef HARDCODE_VERTICAL # define kts 1 # define kte HARDCODE_VERTICAL #endif - real(kind_phys), INTENT(OUT) :: zi - real(kind_phys), INTENT(IN) :: landsea - real(kind_phys), DIMENSION(KTS:KTE), INTENT(IN) :: thetav1D, qke1D, dz1D - real(kind_phys), DIMENSION(KTS:KTE+1), INTENT(IN) :: zw1D + real(kind_phys), intent(out) :: zi + real(kind_phys), intent(in) :: landsea + real(kind_phys), dimension(kts:kte), intent(in) :: thetav1D, qke1D, dz1D + real(kind_phys), dimension(kts:kte+1), intent(in) :: zw1D !LOCAL VARS real(kind_phys):: PBLH_TKE,qtke,qtkem1,wt,maxqke,TKEeps,minthv real(kind_phys):: delt_thv !delta theta-v; dependent on land/sea point - real(kind_phys), PARAMETER :: sbl_lim = 200. !upper limit of stable BL height (m). - real(kind_phys), PARAMETER :: sbl_damp = 400. !transition length for blending (m). - INTEGER :: I,J,K,kthv,ktke,kzi + real(kind_phys), parameter :: sbl_lim = 200. !upper limit of stable BL height (m). + real(kind_phys), parameter :: sbl_damp = 400. !transition length for blending (m). + integer :: I,J,K,kthv,ktke,kzi !Initialize KPBL (kzi) kzi = 2 @@ -5689,12 +5719,12 @@ SUBROUTINE DMP_mf( & & F_QNWFA,F_QNIFA,F_QNBCA, & & Psig_shcu, & ! output info - & nup2,ktop,maxmf,ztop, & + & maxwidth,ktop,maxmf,ztop, & ! inputs for stochastic perturbations & spp_pbl,rstoch_col ) ! inputs: - INTEGER, INTENT(IN) :: KTS,KTE,KPBL,momentum_opt,tke_opt,scalar_opt + integer, intent(in) :: KTS,KTE,KPBL,momentum_opt,tke_opt,scalar_opt #ifdef HARDCODE_VERTICAL # define kts 1 @@ -5702,133 +5732,137 @@ SUBROUTINE DMP_mf( & #endif ! Stochastic - INTEGER, INTENT(IN) :: spp_pbl - real(kind_phys), DIMENSION(KTS:KTE) :: rstoch_col + integer, intent(in) :: spp_pbl + real(kind_phys), dimension(kts:kte) :: rstoch_col - real(kind_phys),DIMENSION(KTS:KTE), INTENT(IN) :: & + real(kind_phys),dimension(kts:kte), intent(in) :: & &U,V,W,TH,THL,TK,QT,QV,QC, & &exner,dz,THV,P,rho,qke,qnc,qni,qnwfa,qnifa,qnbca - real(kind_phys),DIMENSION(KTS:KTE+1), INTENT(IN) :: zw !height at full-sigma - real(kind_phys), INTENT(IN) :: flt,fltv,flq,flqv,Psig_shcu, & + real(kind_phys),dimension(kts:kte+1), intent(in) :: zw !height at full-sigma + real(kind_phys), intent(in) :: flt,fltv,flq,flqv,Psig_shcu, & &landsea,ts,dx,dt,ust,pblh - LOGICAL, OPTIONAL :: F_QC,F_QI,F_QNC,F_QNI,F_QNWFA,F_QNIFA,F_QNBCA + logical, optional :: F_QC,F_QI,F_QNC,F_QNI,F_QNWFA,F_QNIFA,F_QNBCA ! outputs - updraft properties - real(kind_phys),DIMENSION(KTS:KTE), INTENT(OUT) :: edmf_a,edmf_w, & + real(kind_phys),dimension(kts:kte), intent(out) :: edmf_a,edmf_w, & & edmf_qt,edmf_thl,edmf_ent,edmf_qc !add one local edmf variable: - real(kind_phys),DIMENSION(KTS:KTE) :: edmf_th + real(kind_phys),dimension(kts:kte) :: edmf_th ! output - INTEGER, INTENT(OUT) :: nup2,ktop - real(kind_phys), INTENT(OUT) :: maxmf - real(kind_phys), INTENT(OUT) :: ztop + integer, intent(out) :: ktop + real(kind_phys), intent(out) :: maxmf,ztop,maxwidth ! outputs - variables needed for solver - real(kind_phys),DIMENSION(KTS:KTE+1) :: s_aw, & !sum ai*rho*wis_awphi + real(kind_phys),dimension(kts:kte+1) :: s_aw, & !sum ai*rho*wis_awphi &s_awthl,s_awqt,s_awqv,s_awqc,s_awqnc,s_awqni, & &s_awqnwfa,s_awqnifa,s_awqnbca,s_awu,s_awv, & &s_awqke,s_aw2 - real(kind_phys),DIMENSION(KTS:KTE), INTENT(INOUT) :: & + real(kind_phys),dimension(kts:kte), intent(inout) :: & &qc_bl1d,cldfra_bl1d,qc_bl1d_old,cldfra_bl1d_old - INTEGER, PARAMETER :: nup=10, debug_mf=0 + integer, parameter :: nup=8, debug_mf=0 + real(kind_phys) :: nup2 !------------- local variables ------------------- ! updraft properties defined on interfaces (k=1 is the top of the ! first model layer - real(kind_phys),DIMENSION(KTS:KTE+1,1:NUP) :: & + real(kind_phys),dimension(kts:kte+1,1:NUP) :: & &UPW,UPTHL,UPQT,UPQC,UPQV, & &UPA,UPU,UPV,UPTHV,UPQKE,UPQNC, & &UPQNI,UPQNWFA,UPQNIFA,UPQNBCA ! entrainment variables - real(kind_phys),DIMENSION(KTS:KTE,1:NUP) :: ENT,ENTf - INTEGER,DIMENSION(KTS:KTE,1:NUP) :: ENTi + real(kind_phys),dimension(kts:kte,1:NUP) :: ENT,ENTf + integer,dimension(kts:kte,1:NUP) :: ENTi ! internal variables - INTEGER :: K,I,k50 + integer :: K,I,k50 real(kind_phys):: fltv2,wstar,qstar,thstar,sigmaW,sigmaQT, & &sigmaTH,z0,pwmin,pwmax,wmin,wmax,wlv,Psig_w,maxw,maxqc,wpbl real(kind_phys):: B,QTn,THLn,THVn,QCn,Un,Vn,QKEn,QNCn,QNIn, & - QNWFAn,QNIFAn,QNBCAn, & - Wn2,Wn,EntEXP,EntEXM,EntW,BCOEFF,THVkm1,THVk,Pk,rho_int + & QNWFAn,QNIFAn,QNBCAn, & + & Wn2,Wn,EntEXP,EntEXM,EntW,BCOEFF,THVkm1,THVk,Pk,rho_int ! w parameters - real(kind_phys), PARAMETER :: & + real(kind_phys), parameter :: & &Wa=2./3., & &Wb=0.002, & &Wc=1.5 ! Lateral entrainment parameters ( L0=100 and ENT0=0.1) were taken from ! Suselj et al (2013, jas). Note that Suselj et al (2014,waf) use L0=200 and ENT0=0.2. - real(kind_phys),PARAMETER :: & - & L0=100., & - & ENT0=0.1 - - ! Implement ideas from Neggers (2016, JAMES): - real(kind_phys), PARAMETER :: Atot = 0.10 ! Maximum total fractional area of all updrafts - real(kind_phys), PARAMETER :: lmax = 1000.! diameter of largest plume - real(kind_phys), PARAMETER :: dl = 100. ! diff size of each plume - the differential multiplied by the integrand - real(kind_phys), PARAMETER :: dcut = 1.2 ! max diameter of plume to parameterize relative to dx (km) - real(kind_phys):: d != -2.3 to -1.7 ;=-1.9 in Neggers paper; power law exponent for number density (N=Cl^d). + real(kind_phys),parameter :: & + & L0=100., & + & ENT0=0.1 + + ! Parameters/variables for regulating plumes: + real(kind_phys), parameter :: Atot = 0.10 ! Maximum total fractional area of all updrafts + real(kind_phys), parameter :: lmax = 1000.! diameter of largest plume (absolute maximum, can be smaller) + real(kind_phys), parameter :: lmin = 300. ! diameter of smallest plume (absolute minimum, can be larger) + real(kind_phys), parameter :: dlmin = 0. ! delta increase in the diameter of smallest plume (large fltv) + real(kind_phys) :: minwidth ! actual width of smallest plume + real(kind_phys) :: dl ! variable increment of plume size + real(kind_phys), parameter :: dcut = 1.2 ! max diameter of plume to parameterize relative to dx (km) + real(kind_phys):: 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. - real(kind_phys):: cn,c,l,n,an2,hux,maxwidth,wspd_pbl,cloud_base,width_flx + real(kind_phys):: cn,c,l,n,an2,hux,wspd_pbl,cloud_base,width_flx ! chem/smoke - INTEGER, INTENT(IN) :: nchem - real(kind_phys),DIMENSION(:, :) :: chem1 - real(kind_phys),DIMENSION(kts:kte+1, nchem) :: s_awchem - real(kind_phys),DIMENSION(nchem) :: chemn - real(kind_phys),DIMENSION(KTS:KTE+1,1:NUP, nchem) :: UPCHEM - INTEGER :: ic - real(kind_phys),DIMENSION(KTS:KTE+1, nchem) :: edmf_chem - LOGICAL, INTENT(IN) :: mix_chem + integer, intent(in) :: nchem + real(kind_phys),dimension(:, :) :: chem1 + real(kind_phys),dimension(kts:kte+1, nchem) :: s_awchem + real(kind_phys),dimension(nchem) :: chemn + real(kind_phys),dimension(kts:kte+1,1:NUP, nchem) :: UPCHEM + integer :: ic + real(kind_phys),dimension(kts:kte+1, nchem) :: edmf_chem + logical, intent(in) :: mix_chem !JOE: add declaration of ERF real(kind_phys):: ERF - LOGICAL :: superadiabatic + logical :: superadiabatic ! VARIABLES FOR CHABOUREAU-BECHTOLD CLOUD FRACTION - real(kind_phys),DIMENSION(KTS:KTE), INTENT(INOUT) :: vt, vq, sgm + real(kind_phys),dimension(kts:kte), intent(inout) :: vt, vq, sgm real(kind_phys):: sigq,xl,rsl,cpm,a,qmq,mf_cf,Aup,Q1,diffqt,qsat_tk,& Fng,qww,alpha,beta,bb,f,pt,t,q2p,b9,satvp,rhgrid, & Ac_mf,Ac_strat,qc_mf - real(kind_phys), PARAMETER :: cf_thresh = 0.5 ! only overwrite stratus CF less than this value + real(kind_phys), parameter :: cf_thresh = 0.5 ! only overwrite stratus CF less than this value ! Variables for plume interpolation/saturation check - real(kind_phys),DIMENSION(KTS:KTE) :: exneri,dzi + real(kind_phys),dimension(kts:kte) :: exneri,dzi,rhoz real(kind_phys):: THp, QTp, QCp, QCs, esat, qsl - real(kind_phys):: csigma,acfac,ac_wsp,ac_cld + real(kind_phys):: csigma,acfac,ac_wsp !plume overshoot - INTEGER :: overshoot + integer :: overshoot real(kind_phys):: bvf, Frz, dzp !Flux limiter: not let mass-flux of heat between k=1&2 exceed (fluxportion)*(surface heat flux). !This limiter makes adjustments to the entire column. real(kind_phys):: adjustment, flx1 - real(kind_phys), PARAMETER :: fluxportion=0.75 ! set liberally, so has minimal impact. 0.5 starts to have a noticeable impact + real(kind_phys), parameter :: fluxportion=0.75 ! set liberally, so has minimal impact. Note that + ! 0.5 starts to have a noticeable impact ! over land (decrease maxMF by 10-20%), but no impact over water. !Subsidence - real(kind_phys),DIMENSION(KTS:KTE) :: sub_thl,sub_sqv,sub_u,sub_v, & !tendencies due to subsidence + real(kind_phys),dimension(kts:kte) :: sub_thl,sub_sqv,sub_u,sub_v, & !tendencies due to subsidence det_thl,det_sqv,det_sqc,det_u,det_v, & !tendencied due to detrainment envm_a,envm_w,envm_thl,envm_sqv,envm_sqc, & envm_u,envm_v !environmental variables defined at middle of layer - real(kind_phys),DIMENSION(KTS:KTE+1) :: envi_a,envi_w !environmental variables defined at model interface + real(kind_phys),dimension(kts:kte+1) :: envi_a,envi_w !environmental variables defined at model interface real(kind_phys):: temp,sublim,qc_ent,qv_ent,qt_ent,thl_ent,detrate, & detrateUV,oow,exc_fac,aratio,detturb,qc_grid,qc_sgs, & - qc_plume,exc_heat,exc_moist,tk_int - real(kind_phys), PARAMETER :: Cdet = 1./45. - real(kind_phys), PARAMETER :: dzpmax = 300. !limit dz used in detrainment - can be excessing in thick layers + qc_plume,exc_heat,exc_moist,tk_int,tvs + real(kind_phys), parameter :: Cdet = 1./45. + real(kind_phys), parameter :: dzpmax = 300. !limit dz used in detrainment - can be excessing in thick layers !parameter "Csub" determines the propotion of upward vertical velocity that contributes to !environmenatal subsidence. Some portion is expected to be compensated by downdrafts instead of !gentle environmental subsidence. 1.0 assumes all upward vertical velocity in the mass-flux scheme !is compensated by "gentle" environmental subsidence. - real(kind_phys), PARAMETER :: Csub=0.25 + real(kind_phys), parameter :: Csub=0.25 !Factor for the pressure gradient effects on momentum transport - real(kind_phys), PARAMETER :: pgfac = 0.00 ! Zhang and Wu showed 0.4 is more appropriate for lower troposphere + real(kind_phys), parameter :: pgfac = 0.00 ! Zhang and Wu showed 0.4 is more appropriate for lower troposphere real(kind_phys):: Uk,Ukm1,Vk,Vkm1,dxsa ! check the inputs @@ -5859,9 +5893,9 @@ SUBROUTINE DMP_mf( & UPQNWFA=0. UPQNIFA=0. UPQNBCA=0. - IF ( mix_chem ) THEN - UPCHEM(KTS:KTE+1,1:NUP,1:nchem)=0.0 - ENDIF + if ( mix_chem ) then + UPCHEM(kts:kte+1,1:NUP,1:nchem)=0.0 + endif ENT=0.001 ! Initialize mean updraft properties @@ -5871,9 +5905,9 @@ SUBROUTINE DMP_mf( & edmf_thl=0. edmf_ent=0. edmf_qc =0. - IF ( mix_chem ) THEN + if ( mix_chem ) then edmf_chem(kts:kte+1,1:nchem) = 0.0 - ENDIF + endif ! Initialize the variables needed for implicit solver s_aw=0. @@ -5889,153 +5923,163 @@ SUBROUTINE DMP_mf( & s_awqnwfa=0. s_awqnifa=0. s_awqnbca=0. - IF ( mix_chem ) THEN + if ( mix_chem ) then s_awchem(kts:kte+1,1:nchem) = 0.0 - ENDIF + endif ! Initialize explicit tendencies for subsidence & detrainment sub_thl = 0. sub_sqv = 0. - sub_u = 0. - sub_v = 0. + sub_u = 0. + sub_v = 0. det_thl = 0. det_sqv = 0. det_sqc = 0. - det_u = 0. - det_v = 0. + det_u = 0. + det_v = 0. + nup2 = nup !start with nup, but set to zero if activation criteria fails ! Taper off MF scheme when significant resolved-scale motions ! are present This function needs to be asymetric... - k = 1 - maxw = 0.0 + maxw = 0.0 cloud_base = 9000.0 -! DO WHILE (ZW(k) < pblh + 500.) - DO k=1,kte-1 - IF(zw(k) > pblh + 500.) exit + do k=1,kte-1 + if (zw(k) > pblh + 500.) exit wpbl = w(k) - IF(w(k) < 0.)wpbl = 2.*w(k) - maxw = MAX(maxw,ABS(wpbl)) + if (w(k) < 0.)wpbl = 2.*w(k) + maxw = max(maxw,abs(wpbl)) !Find highest k-level below 50m AGL - IF(ZW(k)<=50.)k50=k + if (ZW(k)<=50.)k50=k !Search for cloud base - qc_sgs = MAX(qc(k), qc_bl1d(k)*cldfra_bl1d(k)) - IF(qc_sgs> 1E-5 .AND. cloud_base == 9000.0)THEN + qc_sgs = max(qc(k), qc_bl1d(k)) + if (qc_sgs> 1E-5 .and. (cldfra_bl1d(k) .ge. 0.5) .and. cloud_base == 9000.0) then cloud_base = 0.5*(ZW(k)+ZW(k+1)) - ENDIF + endif + enddo - !k = k + 1 - ENDDO - !print*," maxw before manipulation=", maxw - maxw = MAX(0.,maxw - 1.0) ! do nothing for small w (< 1 m/s), but - Psig_w = MAX(0.0, 1.0 - maxw) ! linearly taper off for w > 1.0 m/s - Psig_w = MIN(Psig_w, Psig_shcu) - !print*," maxw=", maxw," Psig_w=",Psig_w," Psig_shcu=",Psig_shcu + !do nothing for small w (< 1 m/s), but linearly taper off for w > 1.0 m/s + maxw = max(0.,maxw - 1.0) + Psig_w = max(0.0, 1.0 - maxw) + Psig_w = min(Psig_w, Psig_shcu) !Completely shut off MF scheme for strong resolved-scale vertical velocities. fltv2 = fltv - IF(Psig_w == 0.0 .and. fltv > 0.0) fltv2 = -1.*fltv + if(Psig_w == 0.0 .and. fltv > 0.0) fltv2 = -1.*fltv ! If surface buoyancy is positive we do integration, otherwise no. ! Also, ensure that it is at least slightly superadiabatic up through 50 m superadiabatic = .false. - IF((landsea-1.5).GE.0)THEN + if ((landsea-1.5).ge.0) then hux = -0.001 ! WATER ! dT/dz must be < - 0.1 K per 100 m. - ELSE + else hux = -0.005 ! LAND ! dT/dz must be < - 0.5 K per 100 m. - ENDIF - DO k=1,MAX(1,k50-1) !use "-1" because k50 used interface heights (zw). - IF (k == 1) then - IF ((th(k)-ts)/(0.5*dz(k)) < hux) THEN + endif + tvs = ts*(1.0+p608*qv(kts)) + do k=1,max(1,k50-1) !use "-1" because k50 used interface heights (zw). + if (k == 1) then + if ((thv(k)-tvs)/(0.5*dz(k)) < hux) then superadiabatic = .true. - ELSE + else superadiabatic = .false. exit - ENDIF - ELSE - IF ((th(k)-th(k-1))/(0.5*(dz(k)+dz(k-1))) < hux) THEN + endif + else + if ((thv(k)-thv(k-1))/(0.5*(dz(k)+dz(k-1))) < hux) then superadiabatic = .true. - ELSE + else superadiabatic = .false. exit - ENDIF - ENDIF - ENDDO + endif + endif + enddo ! Determine the numer of updrafts/plumes in the grid column: ! 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. + ! (1) largest plume = 1.2 * dx. + ! (2) Apply a scale-break, assuming no plumes with diameter larger than 1.1*PBLH can exist. ! (3) max plume size beneath clouds deck approx = 0.5 * cloud_base. ! (4) add wspd-dependent limit, when plume model breaks down. (hurricanes) ! (5) limit to reduce max plume sizes in weakly forced conditions. This is only ! meant to "soften" the activation of the mass-flux scheme. ! Criteria (1) - NUP2 = max(1,min(NUP,INT(dx*dcut/dl))) + maxwidth = min(dx*dcut, lmax) !Criteria (2) - maxwidth = 1.1*PBLH + maxwidth = min(maxwidth, 1.1_kind_phys*PBLH) ! Criteria (3) - maxwidth = MIN(maxwidth,0.5*cloud_base) + if ((landsea-1.5) .lt. 0) then !land + maxwidth = MIN(maxwidth, 0.5_kind_phys*cloud_base) + else !water + maxwidth = MIN(maxwidth, 0.9_kind_phys*cloud_base) + endif ! Criteria (4) - wspd_pbl=SQRT(MAX(u(kts)**2 + v(kts)**2, 0.01)) + wspd_pbl=SQRT(MAX(u(kts)**2 + v(kts)**2, 0.01_kind_phys)) !Note: area fraction (acfac) is modified below ! Criteria (5) - only a function of flt (not fltv) if ((landsea-1.5).LT.0) then !land - !width_flx = MAX(MIN(1000.*(0.6*tanh((flt - 0.050)/0.03) + .5),1000.), 0.) - width_flx = MAX(MIN(1000.*(0.6*tanh((flt - 0.040)/0.03) + .5),1000.), 0.) + width_flx = MAX(MIN(1000.*(0.6*tanh((fltv - 0.040)/0.04) + .5),1000._kind_phys), 0._kind_phys) else !water - width_flx = MAX(MIN(1000.*(0.6*tanh((flt - 0.003)/0.01) + .5),1000.), 0.) + width_flx = MAX(MIN(1000.*(0.6*tanh((fltv - 0.007)/0.02) + .5),1000._kind_phys), 0._kind_phys) + endif + maxwidth = MIN(maxwidth, width_flx) + minwidth = lmin + !allow min plume size to increase in large flux conditions (eddy diffusivity should be + !large enough to handle the representation of small plumes). + if (maxwidth .ge. (lmax - 1.0) .and. fltv .gt. 0.2)minwidth = lmin + dlmin*min((fltv-0.2)/0.3, 1._kind_phys) + + if (maxwidth .le. minwidth) then ! deactivate MF component + nup2 = 0 + maxwidth = 0.0 endif - maxwidth = MIN(maxwidth,width_flx) - ! Convert maxwidth to number of plumes - NUP2 = MIN(MAX(INT((maxwidth - MOD(maxwidth,100.))/100), 0), NUP2) - !Initialize values for 2d output fields: - ktop = 0 - ztop = 0.0 - maxmf= 0.0 + ! Initialize values for 2d output fields: + ktop = 0 + ztop = 0.0 + maxmf= 0.0 - IF ( fltv2 > 0.002 .AND. NUP2 .GE. 1 .AND. superadiabatic) then - !PRINT*," Conditions met to run mass-flux scheme",fltv2,pblh +!Begin plume processing if passes criteria +if ( fltv2 > 0.002 .AND. (maxwidth > minwidth) .AND. superadiabatic) then ! Find coef C for number size density N cn = 0. - d=-1.9 !set d to value suggested by Neggers 2015 (JAMES). - !d=-1.9 + .2*tanh((fltv2 - 0.05)/0.15) - do I=1,NUP !NUP2 - IF(I > NUP2) exit - l = dl*I ! diameter of plume + d =-1.9 !set d to value suggested by Neggers 2015 (JAMES). + dl = (maxwidth - minwidth)/real(nup-1,kind=kind_phys) + do i=1,NUP + ! diameter of plume + l = minwidth + dl*real(i-1) cn = cn + l**d * (l*l)/(dx*dx) * dl ! sum fractional area of each plume enddo C = Atot/cn !Normalize C according to the defined total fraction (Atot) ! Make updraft area (UPA) a function of the buoyancy flux if ((landsea-1.5).LT.0) then !land - !acfac = .5*tanh((fltv2 - 0.03)/0.09) + .5 - !acfac = .5*tanh((fltv2 - 0.02)/0.09) + .5 acfac = .5*tanh((fltv2 - 0.02)/0.05) + .5 else !water acfac = .5*tanh((fltv2 - 0.01)/0.03) + .5 endif !add a windspeed-dependent adjustment to acfac that tapers off - !the mass-flux scheme linearly above sfc wind speeds of 20 m/s: - ac_wsp = 1.0 - min(max(wspd_pbl - 20.0, 0.0), 10.0)/10.0 - !reduce area fraction beneath cloud bases < 1200 m AGL - ac_cld = min(cloud_base/1200., 1.0) - acfac = acfac * min(ac_wsp, ac_cld) + !the mass-flux scheme linearly above sfc wind speeds of 10 m/s. + !Note: this effect may be better represented by an increase in + !entrainment rate for high wind consitions (more ambient turbulence). + if (wspd_pbl .le. 10.) then + ac_wsp = 1.0 + else + ac_wsp = 1.0 - min((wspd_pbl - 10.0)/15., 1.0) + endif + acfac = acfac * ac_wsp ! Find the portion of the total fraction (Atot) of each plume size: An2 = 0. - do I=1,NUP !NUP2 - IF(I > NUP2) exit - l = dl*I ! diameter of plume + do i=1,NUP + ! diameter of plume + l = minwidth + dl*real(i-1) N = C*l**d ! number density of plume n - UPA(1,I) = N*l*l/(dx*dx) * dl ! fractional area of plume n + UPA(1,i) = N*l*l/(dx*dx) * dl ! fractional area of plume n - UPA(1,I) = UPA(1,I)*acfac - An2 = An2 + UPA(1,I) ! total fractional area of all plumes + 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 end do @@ -6048,23 +6092,25 @@ SUBROUTINE DMP_mf( & qstar=max(flq,1.0E-5)/wstar thstar=flt/wstar - IF((landsea-1.5).GE.0)THEN + if ((landsea-1.5) .ge. 0) then csigma = 1.34 ! WATER - ELSE + else csigma = 1.34 ! LAND - ENDIF + endif if (env_subs) then exc_fac = 0.0 else if ((landsea-1.5).GE.0) then !water: increase factor to compensate for decreased pwmin/pwmax - exc_fac = 0.58*4.0*min(cloud_base/1000., 1.0) + exc_fac = 0.58*4.0 else !land: no need to increase factor - already sufficiently large superadiabatic layers exc_fac = 0.58 endif endif + !decrease excess for large wind speeds + exc_fac = exc_fac * ac_wsp !Note: sigmaW is typically about 0.5*wstar sigmaW =csigma*wstar*(z0/pblh)**(onethird)*(1 - 0.8*z0/pblh) @@ -6077,14 +6123,11 @@ SUBROUTINE DMP_mf( & wmax=MIN(sigmaW*pwmax,0.5) !SPECIFY SURFACE UPDRAFT PROPERTIES AT MODEL INTERFACE BETWEEN K = 1 & 2 - DO I=1,NUP !NUP2 - IF(I > NUP2) exit + do i=1,NUP wlv=wmin+(wmax-wmin)/NUP2*(i-1) !SURFACE UPDRAFT VERTICAL VELOCITY UPW(1,I)=wmin + real(i)/real(NUP)*(wmax-wmin) - !IF (UPW(1,I) > 0.5*ZW(2)/dt) UPW(1,I) = 0.5*ZW(2)/dt - UPU(1,I)=(U(KTS)*DZ(KTS+1)+U(KTS+1)*DZ(KTS))/(DZ(KTS)+DZ(KTS+1)) UPV(1,I)=(V(KTS)*DZ(KTS+1)+V(KTS+1)*DZ(KTS))/(DZ(KTS)+DZ(KTS+1)) UPQC(1,I)=0.0 @@ -6093,21 +6136,11 @@ SUBROUTINE DMP_mf( & exc_heat = exc_fac*UPW(1,I)*sigmaTH/sigmaW UPTHV(1,I)=(THV(KTS)*DZ(KTS+1)+THV(KTS+1)*DZ(KTS))/(DZ(KTS)+DZ(KTS+1)) & & + exc_heat -!was UPTHL(1,I)= UPTHV(1,I)/(1.+svp1*UPQT(1,I)) !assume no saturated parcel at surface UPTHL(1,I)=(THL(KTS)*DZ(KTS+1)+THL(KTS+1)*DZ(KTS))/(DZ(KTS)+DZ(KTS+1)) & & + exc_heat !calculate exc_moist by use of surface fluxes exc_moist=exc_fac*UPW(1,I)*sigmaQT/sigmaW - !calculate exc_moist by conserving rh: -! tk_int =(tk(kts)*dz(kts+1)+tk(kts+1)*dz(kts))/(dz(kts+1)+dz(kts)) -! pk =(p(kts)*dz(kts+1)+p(kts+1)*dz(kts))/(dz(kts+1)+dz(kts)) -! qtk =(qt(kts)*dz(kts+1)+qt(kts+1)*dz(kts))/(dz(kts)+dz(kts+1)) -! qsat_tk = qsat_blend(tk_int, pk) ! saturation water vapor mixing ratio at tk and p -! rhgrid =MAX(MIN(1.0,qtk/MAX(1.E-8,qsat_tk)),0.001) -! tk_int = tk_int + exc_heat -! qsat_tk = qsat_blend(tk_int, pk) -! exc_moist= max(rhgrid*qsat_tk - qtk, 0.0) UPQT(1,I)=(QT(KTS)*DZ(KTS+1)+QT(KTS+1)*DZ(KTS))/(DZ(KTS)+DZ(KTS+1))& & +exc_moist @@ -6117,36 +6150,36 @@ SUBROUTINE DMP_mf( & UPQNWFA(1,I)=(QNWFA(KTS)*DZ(KTS+1)+QNWFA(KTS+1)*DZ(KTS))/(DZ(KTS)+DZ(KTS+1)) UPQNIFA(1,I)=(QNIFA(KTS)*DZ(KTS+1)+QNIFA(KTS+1)*DZ(KTS))/(DZ(KTS)+DZ(KTS+1)) UPQNBCA(1,I)=(QNBCA(KTS)*DZ(KTS+1)+QNBCA(KTS+1)*DZ(KTS))/(DZ(KTS)+DZ(KTS+1)) - ENDDO + enddo - IF ( mix_chem ) THEN - DO I=1,NUP !NUP2 - IF(I > NUP2) exit + if ( mix_chem ) then + do i=1,NUP do ic = 1,nchem - UPCHEM(1,I,ic)=(chem1(KTS,ic)*DZ(KTS+1)+chem1(KTS+1,ic)*DZ(KTS))/(DZ(KTS)+DZ(KTS+1)) + UPCHEM(1,i,ic)=(chem1(KTS,ic)*DZ(KTS+1)+chem1(KTS+1,ic)*DZ(KTS))/(DZ(KTS)+DZ(KTS+1)) enddo - ENDDO - ENDIF + enddo + endif !Initialize environmental variables which can be modified by detrainment - DO k=kts,kte - envm_thl(k)=THL(k) - envm_sqv(k)=QV(k) - envm_sqc(k)=QC(k) - envm_u(k)=U(k) - envm_v(k)=V(k) - ENDDO + envm_thl(kts:kte)=THL(kts:kte) + envm_sqv(kts:kte)=QV(kts:kte) + envm_sqc(kts:kte)=QC(kts:kte) + envm_u(kts:kte)=U(kts:kte) + envm_v(kts:kte)=V(kts:kte) + do k=kts,kte-1 + rhoz(k) = (rho(k)*dz(k+1)+rho(k+1)*dz(k))/(dz(k+1)+dz(k)) + enddo + rhoz(kte) = rho(kte) !dxsa is scale-adaptive factor governing the pressure-gradient term of the momentum transport dxsa = 1. - MIN(MAX((12000.0-dx)/(12000.0-3000.0), 0.), 1.) ! do integration updraft - DO I=1,NUP !NUP2 - IF(I > NUP2) exit + do i=1,NUP QCn = 0. overshoot = 0 - l = dl*I ! diameter of plume - DO k=KTS+1,KTE-1 + l = minwidth + dl*real(i-1) ! diameter of plume + do k=kts+1,kte-1 !Entrainment from Tian and Kuang (2016) !ENT(k,i) = 0.35/(MIN(MAX(UPW(K-1,I),0.75),1.9)*l) wmin = 0.3 + l*0.0005 !* MAX(pblh-ZW(k+1), 0.0)/pblh @@ -6161,7 +6194,7 @@ SUBROUTINE DMP_mf( & ENT(k,i) = max(ENT(k,i),0.0003) !ENT(k,i) = max(ENT(k,i),0.05/ZW(k)) !not needed for Tian and Kuang - !JOE - increase entrainment for plumes extending very high. + !increase entrainment for plumes extending very high. IF(ZW(k) >= MIN(pblh+1500., 4000.))THEN ENT(k,i)=ENT(k,i) + (ZW(k)-MIN(pblh+1500.,4000.))*5.0E-6 ENDIF @@ -6339,6 +6372,7 @@ SUBROUTINE DMP_mf( & exit !exit k-loop END IF ENDDO + IF (debug_mf == 1) THEN IF (MAXVAL(UPW(:,I)) > 10.0 .OR. MINVAL(UPA(:,I)) < 0.0 .OR. & MAXVAL(UPA(:,I)) > Atot .OR. NUP2 > 10) THEN @@ -6358,30 +6392,26 @@ SUBROUTINE DMP_mf( & ENDIF ENDIF ENDDO - ELSE +ELSE !At least one of the conditions was not met for activating the MF scheme. NUP2=0. - END IF !end criteria for mass-flux scheme +END IF !end criteria check for mass-flux scheme - ktop=MIN(ktop,KTE-1) ! Just to be safe... - IF (ktop == 0) THEN - ztop = 0.0 - ELSE - ztop=zw(ktop) - ENDIF - - IF(nup2 > 0) THEN +ktop=MIN(ktop,KTE-1) +IF (ktop == 0) THEN + ztop = 0.0 +ELSE + ztop=zw(ktop) +ENDIF - !Calculate the fluxes for each variable - !All s_aw* variable are == 0 at k=1 - DO i=1,NUP !NUP2 - IF(I > NUP2) exit +IF (nup2 > 0) THEN + !Calculate the fluxes for each variable + !All s_aw* variable are == 0 at k=1 + DO i=1,NUP DO k=KTS,KTE-1 - IF(k > ktop) exit - rho_int = (rho(k)*DZ(k+1)+rho(k+1)*DZ(k))/(DZ(k+1)+DZ(k)) - s_aw(k+1) = s_aw(k+1) + rho_int*UPA(K,i)*UPW(K,i)*Psig_w - s_awthl(k+1)= s_awthl(k+1) + rho_int*UPA(K,i)*UPW(K,i)*UPTHL(K,i)*Psig_w - s_awqt(k+1) = s_awqt(k+1) + rho_int*UPA(K,i)*UPW(K,i)*UPQT(K,i)*Psig_w + s_aw(k+1) = s_aw(k+1) + rhoz(k)*UPA(K,i)*UPW(K,i)*Psig_w + s_awthl(k+1)= s_awthl(k+1) + rhoz(k)*UPA(K,i)*UPW(K,i)*UPTHL(K,i)*Psig_w + s_awqt(k+1) = s_awqt(k+1) + rhoz(k)*UPA(K,i)*UPW(K,i)*UPQT(K,i)*Psig_w !to conform to grid mean properties, move qc to qv in grid mean !saturated layers, so total water fluxes are preserved but !negative qc fluxes in unsaturated layers is reduced. @@ -6390,72 +6420,76 @@ SUBROUTINE DMP_mf( & ! else ! qc_plume = 0.0 ! endif - s_awqc(k+1) = s_awqc(k+1) + rho_int*UPA(K,i)*UPW(K,i)*qc_plume*Psig_w - IF (momentum_opt > 0) THEN - s_awu(k+1) = s_awu(k+1) + rho_int*UPA(K,i)*UPW(K,i)*UPU(K,i)*Psig_w - s_awv(k+1) = s_awv(k+1) + rho_int*UPA(K,i)*UPW(K,i)*UPV(K,i)*Psig_w - ENDIF - IF (tke_opt > 0) THEN - s_awqke(k+1)= s_awqke(k+1) + rho_int*UPA(K,i)*UPW(K,i)*UPQKE(K,i)*Psig_w - ENDIF + s_awqc(k+1) = s_awqc(k+1) + rhoz(k)*UPA(K,i)*UPW(K,i)*qc_plume*Psig_w s_awqv(k+1) = s_awqt(k+1) - s_awqc(k+1) ENDDO - ENDDO - - IF ( mix_chem ) THEN - DO k=KTS,KTE - IF(k > KTOP) exit - rho_int = (rho(k)*DZ(k+1)+rho(k+1)*DZ(k))/(DZ(k+1)+DZ(k)) - DO i=1,NUP !NUP2 - IF(I > NUP2) exit - do ic = 1,nchem - s_awchem(k+1,ic) = s_awchem(k+1,ic) + rho_int*UPA(K,i)*UPW(K,i)*UPCHEM(K,i,ic)*Psig_w - enddo - ENDDO - ENDDO - ENDIF - - IF (scalar_opt > 0) THEN - DO k=KTS,KTE - IF(k > KTOP) exit - rho_int = (rho(k)*DZ(k+1)+rho(k+1)*DZ(k))/(DZ(k+1)+DZ(k)) - DO I=1,NUP !NUP2 - IF (I > NUP2) exit - s_awqnc(k+1)= s_awqnc(K+1) + rho_int*UPA(K,i)*UPW(K,i)*UPQNC(K,i)*Psig_w - s_awqni(k+1)= s_awqni(K+1) + rho_int*UPA(K,i)*UPW(K,i)*UPQNI(K,i)*Psig_w - s_awqnwfa(k+1)= s_awqnwfa(K+1) + rho_int*UPA(K,i)*UPW(K,i)*UPQNWFA(K,i)*Psig_w - s_awqnifa(k+1)= s_awqnifa(K+1) + rho_int*UPA(K,i)*UPW(K,i)*UPQNIFA(K,i)*Psig_w - s_awqnbca(k+1)= s_awqnbca(K+1) + rho_int*UPA(K,i)*UPW(K,i)*UPQNBCA(K,i)*Psig_w - ENDDO - ENDDO - ENDIF + ENDDO + !momentum + if (momentum_opt > 0) then + do i=1,nup + do k=kts,kte-1 + s_awu(k+1) = s_awu(k+1) + rhoz(k)*UPA(K,i)*UPW(K,i)*UPU(K,i)*Psig_w + s_awv(k+1) = s_awv(k+1) + rhoz(k)*UPA(K,i)*UPW(K,i)*UPV(K,i)*Psig_w + enddo + enddo + endif + !tke + if (tke_opt > 0) then + do i=1,nup + do k=kts,kte-1 + s_awqke(k+1)= s_awqke(k+1) + rhoz(k)*UPA(K,i)*UPW(K,i)*UPQKE(K,i)*Psig_w + enddo + enddo + endif + !chem + if ( mix_chem ) then + do k=kts,kte + do i=1,nup + do ic = 1,nchem + s_awchem(k+1,ic) = s_awchem(k+1,ic) + rhoz(k)*UPA(K,i)*UPW(K,i)*UPCHEM(K,i,ic)*Psig_w + enddo + enddo + enddo + endif + + if (scalar_opt > 0) then + do k=kts,kte + do I=1,nup + s_awqnc(k+1) = s_awqnc(K+1) + rhoz(k)*UPA(K,i)*UPW(K,i)*UPQNC(K,i)*Psig_w + s_awqni(k+1) = s_awqni(K+1) + rhoz(k)*UPA(K,i)*UPW(K,i)*UPQNI(K,i)*Psig_w + s_awqnwfa(k+1)= s_awqnwfa(K+1) + rhoz(k)*UPA(K,i)*UPW(K,i)*UPQNWFA(K,i)*Psig_w + s_awqnifa(k+1)= s_awqnifa(K+1) + rhoz(k)*UPA(K,i)*UPW(K,i)*UPQNIFA(K,i)*Psig_w + s_awqnbca(k+1)= s_awqnbca(K+1) + rhoz(k)*UPA(K,i)*UPW(K,i)*UPQNBCA(K,i)*Psig_w + enddo + enddo + endif - !Flux limiter: Check ratio of heat flux at top of first model layer - !and at the surface. Make sure estimated flux out of the top of the - !layer is < fluxportion*surface_heat_flux - IF (s_aw(kts+1) /= 0.) THEN + !Flux limiter: Check ratio of heat flux at top of first model layer + !and at the surface. Make sure estimated flux out of the top of the + !layer is < fluxportion*surface_heat_flux + IF (s_aw(kts+1) /= 0.) THEN dzi(kts) = 0.5*(DZ(kts)+DZ(kts+1)) !dz centered at model interface flx1 = MAX(s_aw(kts+1)*(TH(kts)-TH(kts+1))/dzi(kts),1.0e-5) - ELSE + ELSE flx1 = 0.0 !print*,"ERROR: s_aw(kts+1) == 0, NUP=",NUP," NUP2=",NUP2,& ! " superadiabatic=",superadiabatic," KTOP=",KTOP - ENDIF - adjustment=1.0 - !Print*,"Flux limiter in MYNN-EDMF, adjustment=",fluxportion*flt/dz(kts)/flx1 - !Print*,"flt/dz=",flt/dz(kts)," flx1=",flx1," s_aw(kts+1)=",s_aw(kts+1) - IF (flx1 > fluxportion*flt/dz(kts) .AND. flx1>0.0) THEN + ENDIF + adjustment=1.0 + !Print*,"Flux limiter in MYNN-EDMF, adjustment=",fluxportion*flt/dz(kts)/flx1 + !Print*,"flt/dz=",flt/dz(kts)," flx1=",flx1," s_aw(kts+1)=",s_aw(kts+1) + IF (flx1 > fluxportion*flt/dz(kts) .AND. flx1>0.0) THEN adjustment= fluxportion*flt/dz(kts)/flx1 - s_aw = s_aw*adjustment - s_awthl= s_awthl*adjustment - s_awqt = s_awqt*adjustment - s_awqc = s_awqc*adjustment - s_awqv = s_awqv*adjustment - s_awqnc= s_awqnc*adjustment - s_awqni= s_awqni*adjustment - s_awqnwfa= s_awqnwfa*adjustment - s_awqnifa= s_awqnifa*adjustment - s_awqnbca= s_awqnbca*adjustment + s_aw = s_aw*adjustment + s_awthl = s_awthl*adjustment + s_awqt = s_awqt*adjustment + s_awqc = s_awqc*adjustment + s_awqv = s_awqv*adjustment + s_awqnc = s_awqnc*adjustment + s_awqni = s_awqni*adjustment + s_awqnwfa = s_awqnwfa*adjustment + s_awqnifa = s_awqnifa*adjustment + s_awqnbca = s_awqnbca*adjustment IF (momentum_opt > 0) THEN s_awu = s_awu*adjustment s_awv = s_awv*adjustment @@ -6467,62 +6501,57 @@ SUBROUTINE DMP_mf( & s_awchem = s_awchem*adjustment ENDIF UPA = UPA*adjustment - ENDIF - !Print*,"adjustment=",adjustment," fluxportion=",fluxportion," flt=",flt - - !Calculate mean updraft properties for output: - !all edmf_* variables at k=1 correspond to the interface at top of first model layer - DO k=KTS,KTE-1 - IF(k > KTOP) exit - rho_int = (rho(k)*DZ(k+1)+rho(k+1)*DZ(k))/(DZ(k+1)+DZ(k)) - DO I=1,NUP !NUP2 - IF(I > NUP2) exit - edmf_a(K) =edmf_a(K) +UPA(K,i) - edmf_w(K) =edmf_w(K) +rho_int*UPA(K,i)*UPW(K,i) - edmf_qt(K) =edmf_qt(K) +rho_int*UPA(K,i)*UPQT(K,i) - edmf_thl(K)=edmf_thl(K)+rho_int*UPA(K,i)*UPTHL(K,i) - edmf_ent(K)=edmf_ent(K)+rho_int*UPA(K,i)*ENT(K,i) - edmf_qc(K) =edmf_qc(K) +rho_int*UPA(K,i)*UPQC(K,i) - ENDDO - + ENDIF + !Print*,"adjustment=",adjustment," fluxportion=",fluxportion," flt=",flt + + !Calculate mean updraft properties for output: + !all edmf_* variables at k=1 correspond to the interface at top of first model layer + do k=kts,kte-1 + do I=1,nup + edmf_a(K) =edmf_a(K) +UPA(K,i) + edmf_w(K) =edmf_w(K) +rhoz(k)*UPA(K,i)*UPW(K,i) + edmf_qt(K) =edmf_qt(K) +rhoz(k)*UPA(K,i)*UPQT(K,i) + edmf_thl(K)=edmf_thl(K)+rhoz(k)*UPA(K,i)*UPTHL(K,i) + edmf_ent(K)=edmf_ent(K)+rhoz(k)*UPA(K,i)*ENT(K,i) + edmf_qc(K) =edmf_qc(K) +rhoz(k)*UPA(K,i)*UPQC(K,i) + enddo + enddo + do k=kts,kte-1 !Note that only edmf_a is multiplied by Psig_w. This takes care of the !scale-awareness of the subsidence below: - IF (edmf_a(k)>0.) THEN - edmf_w(k)=edmf_w(k)/edmf_a(k) - edmf_qt(k)=edmf_qt(k)/edmf_a(k) - edmf_thl(k)=edmf_thl(k)/edmf_a(k) - edmf_ent(k)=edmf_ent(k)/edmf_a(k) - edmf_qc(k)=edmf_qc(k)/edmf_a(k) - edmf_a(k)=edmf_a(k)*Psig_w - - !FIND MAXIMUM MASS-FLUX IN THE COLUMN: - IF(edmf_a(k)*edmf_w(k) > maxmf) maxmf = edmf_a(k)*edmf_w(k) - ENDIF - ENDDO ! end k - - !smoke/chem - IF ( mix_chem ) THEN - DO k=kts,kte-1 - IF(k > KTOP) exit - rho_int = (rho(k)*dz(k+1)+rho(k+1)*dz(k))/(dz(k+1)+dz(k)) - DO I=1,NUP !NUP2 - IF(I > NUP2) exit + if (edmf_a(k)>0.) then + edmf_w(k)=edmf_w(k)/edmf_a(k) + edmf_qt(k)=edmf_qt(k)/edmf_a(k) + edmf_thl(k)=edmf_thl(k)/edmf_a(k) + edmf_ent(k)=edmf_ent(k)/edmf_a(k) + edmf_qc(k)=edmf_qc(k)/edmf_a(k) + edmf_a(k)=edmf_a(k)*Psig_w + !FIND MAXIMUM MASS-FLUX IN THE COLUMN: + if(edmf_a(k)*edmf_w(k) > maxmf) maxmf = edmf_a(k)*edmf_w(k) + endif + enddo ! end k + + !smoke/chem + if ( mix_chem ) then + do k=kts,kte-1 + do I=1,nup do ic = 1,nchem - edmf_chem(k,ic) = edmf_chem(k,ic) + rho_int*UPA(K,I)*UPCHEM(k,i,ic) + edmf_chem(k,ic) = edmf_chem(k,ic) + rhoz(k)*UPA(K,I)*UPCHEM(k,i,ic) enddo - ENDDO - - IF (edmf_a(k)>0.) THEN + enddo + enddo + do k=kts,kte-1 + if (edmf_a(k)>0.) then do ic = 1,nchem edmf_chem(k,ic) = edmf_chem(k,ic)/edmf_a(k) enddo - ENDIF - ENDDO ! end k - ENDIF + endif + enddo ! end k + endif - !Calculate the effects environmental subsidence. - !All envi_*variables are valid at the interfaces, like the edmf_* variables - IF (env_subs) THEN + !Calculate the effects environmental subsidence. + !All envi_*variables are valid at the interfaces, like the edmf_* variables + IF (env_subs) THEN DO k=kts+1,kte-1 !First, smooth the profiles of w & a, since sharp vertical gradients !in plume variables are not likely extended to env variables @@ -6557,18 +6586,16 @@ SUBROUTINE DMP_mf( & !calculate tendencies from subsidence and detrainment valid at the middle of !each model layer. The lowest model layer uses an assumes w=0 at the surface. dzi(kts) = 0.5*(dz(kts)+dz(kts+1)) - rho_int = (rho(kts)*dz(kts+1)+rho(kts+1)*dz(kts))/(dz(kts+1)+dz(kts)) sub_thl(kts)= 0.5*envi_w(kts)*envi_a(kts)* & - (rho(kts+1)*thl(kts+1)-rho(kts)*thl(kts))/dzi(kts)/rho_int + (rho(kts+1)*thl(kts+1)-rho(kts)*thl(kts))/dzi(kts)/rhoz(k) sub_sqv(kts)= 0.5*envi_w(kts)*envi_a(kts)* & - (rho(kts+1)*qv(kts+1)-rho(kts)*qv(kts))/dzi(kts)/rho_int + (rho(kts+1)*qv(kts+1)-rho(kts)*qv(kts))/dzi(kts)/rhoz(k) DO k=kts+1,kte-1 dzi(k) = 0.5*(dz(k)+dz(k+1)) - rho_int = (rho(k)*dz(k+1)+rho(k+1)*dz(k))/(dz(k+1)+dz(k)) sub_thl(k)= 0.5*(envi_w(k)+envi_w(k-1))*0.5*(envi_a(k)+envi_a(k-1)) * & - (rho(k+1)*thl(k+1)-rho(k)*thl(k))/dzi(k)/rho_int + (rho(k+1)*thl(k+1)-rho(k)*thl(k))/dzi(k)/rhoz(k) sub_sqv(k)= 0.5*(envi_w(k)+envi_w(k-1))*0.5*(envi_a(k)+envi_a(k-1)) * & - (rho(k+1)*qv(k+1)-rho(k)*qv(k))/dzi(k)/rho_int + (rho(k+1)*qv(k+1)-rho(k)*qv(k))/dzi(k)/rhoz(k) ENDDO DO k=KTS,KTE-1 @@ -6578,17 +6605,15 @@ SUBROUTINE DMP_mf( & ENDDO IF (momentum_opt > 0) THEN - rho_int = (rho(kts)*dz(kts+1)+rho(kts+1)*dz(kts))/(dz(kts+1)+dz(kts)) sub_u(kts)=0.5*envi_w(kts)*envi_a(kts)* & - (rho(kts+1)*u(kts+1)-rho(kts)*u(kts))/dzi(kts)/rho_int + (rho(kts+1)*u(kts+1)-rho(kts)*u(kts))/dzi(kts)/rhoz(k) sub_v(kts)=0.5*envi_w(kts)*envi_a(kts)* & - (rho(kts+1)*v(kts+1)-rho(kts)*v(kts))/dzi(kts)/rho_int + (rho(kts+1)*v(kts+1)-rho(kts)*v(kts))/dzi(kts)/rhoz(k) DO k=kts+1,kte-1 - rho_int = (rho(k)*dz(k+1)+rho(k+1)*dz(k))/(dz(k+1)+dz(k)) sub_u(k)=0.5*(envi_w(k)+envi_w(k-1))*0.5*(envi_a(k)+envi_a(k-1)) * & - (rho(k+1)*u(k+1)-rho(k)*u(k))/dzi(k)/rho_int + (rho(k+1)*u(k+1)-rho(k)*u(k))/dzi(k)/rhoz(k) sub_v(k)=0.5*(envi_w(k)+envi_w(k-1))*0.5*(envi_a(k)+envi_a(k-1)) * & - (rho(k+1)*v(k+1)-rho(k)*v(k))/dzi(k)/rho_int + (rho(k+1)*v(k+1)-rho(k)*v(k))/dzi(k)/rhoz(k) ENDDO DO k=KTS,KTE-1 @@ -6596,23 +6621,23 @@ SUBROUTINE DMP_mf( & det_v(k) = Cdet*(envm_v(k)-v(k))*envi_a(k)*Psig_w ENDDO ENDIF - ENDIF !end subsidence/env detranment + ENDIF !end subsidence/env detranment - !First, compute exner, plume theta, and dz centered at interface - !Here, k=1 is the top of the first model layer. These values do not - !need to be defined at k=kte (unused level). - DO K=KTS,KTE-1 - exneri(k) = (exner(k)*DZ(k+1)+exner(k+1)*DZ(k))/(DZ(k+1)+DZ(k)) + !First, compute exner, plume theta, and dz centered at interface + !Here, k=1 is the top of the first model layer. These values do not + !need to be defined at k=kte (unused level). + DO K=KTS,KTE-1 + exneri(k) = (exner(k)*dz(k+1)+exner(k+1)*dz(k))/(dz(k+1)+dz(k)) edmf_th(k)= edmf_thl(k) + xlvcp/exneri(k)*edmf_qc(K) - dzi(k) = 0.5*(DZ(k)+DZ(k+1)) - ENDDO + dzi(k) = 0.5*(dz(k)+dz(k+1)) + ENDDO !JOE: ADD CLDFRA_bl1d, qc_bl1d. Note that they have already been defined in ! mym_condensation. Here, a shallow-cu component is added, but no cumulus ! clouds can be added at k=1 (start loop at k=2). - do k=kts+1,kte-2 - IF(k > KTOP) exit - IF(0.5*(edmf_qc(k)+edmf_qc(k-1))>0.0 .and. (cldfra_bl1d(k) < cf_thresh))THEN + do k=kts+1,kte-2 + if (k > KTOP) exit + if(0.5*(edmf_qc(k)+edmf_qc(k-1))>0.0 .and. (cldfra_bl1d(k) < cf_thresh))THEN !interpolate plume quantities to mass levels Aup = (edmf_a(k)*dzi(k-1)+edmf_a(k-1)*dzi(k))/(dzi(k-1)+dzi(k)) THp = (edmf_th(k)*dzi(k-1)+edmf_th(k-1)*dzi(k))/(dzi(k-1)+dzi(k)) @@ -6686,8 +6711,8 @@ SUBROUTINE DMP_mf( & !mf_cf = min(max(0.5 + 0.36 * atan(1.20*(Q1+0.4)),0.01),0.6) !Original CB mf_cf = min(max(0.5 + 0.36 * atan(1.55*Q1),0.01),0.6) - mf_cf = max(mf_cf, 1.75 * Aup) - mf_cf = min(mf_cf, 5.0 * Aup) + mf_cf = max(mf_cf, 1.8 * Aup) + mf_cf = min(mf_cf, 5.0 * Aup) endif !IF ( debug_code ) THEN @@ -6705,10 +6730,7 @@ SUBROUTINE DMP_mf( & if (QCp * Aup > 5e-5) then qc_bl1d(k) = 1.86 * (QCp * Aup) - 2.2e-5 else - qc_bl1d(k) = 1.18 * (QCp * Aup) - endif - if (mf_cf .ge. Aup) then - qc_bl1d(k) = qc_bl1d(k) / mf_cf + qc_bl1d(k) = 1.18 * (QCp * Aup) endif cldfra_bl1d(k) = mf_cf Ac_mf = mf_cf @@ -6718,9 +6740,6 @@ SUBROUTINE DMP_mf( & else qc_bl1d(k) = 1.18 * (QCp * Aup) endif - if (mf_cf .ge. Aup) then - qc_bl1d(k) = qc_bl1d(k) / mf_cf - endif cldfra_bl1d(k) = mf_cf Ac_mf = mf_cf endif @@ -6752,13 +6771,13 @@ SUBROUTINE DMP_mf( & endif !check for (qc in plume) .and. (cldfra_bl < threshold) enddo !k-loop - ENDIF !end nup2 > 0 +ENDIF !end nup2 > 0 - !modify output (negative: dry plume, positive: moist plume) - if (ktop > 0) then - maxqc = maxval(edmf_qc(1:ktop)) - if ( maxqc < 1.E-8) maxmf = -1.0*maxmf - endif +!modify output (negative: dry plume, positive: moist plume) +if (ktop > 0) then + maxqc = maxval(edmf_qc(1:ktop)) + if ( maxqc < 1.E-8) maxmf = -1.0*maxmf +endif ! ! debugging @@ -6927,62 +6946,68 @@ SUBROUTINE DDMF_JPL(kts,kte,dt,zw,dz,p, & &qc_bl1d,cldfra_bl1d, & &rthraten ) - INTEGER, INTENT(IN) :: KTS,KTE,KPBL - real(kind_phys),DIMENSION(KTS:KTE), INTENT(IN) :: U,V,TH,THL,TK,QT,QV,QC,& - THV,P,rho,exner,dz - real(kind_phys),DIMENSION(KTS:KTE), INTENT(IN) :: rthraten + integer, intent(in) :: KTS,KTE,KPBL + real(kind_phys), dimension(kts:kte), intent(in) :: & + U,V,TH,THL,TK,QT,QV,QC,THV,P,rho,exner,dz + real(kind_phys), dimension(kts:kte), intent(in) :: rthraten ! zw .. heights of the downdraft levels (edges of boxes) - real(kind_phys),DIMENSION(KTS:KTE+1), INTENT(IN) :: ZW - real(kind_phys), INTENT(IN) :: WTHL,WQT - real(kind_phys), INTENT(IN) :: dt,ust,pblh + real(kind_phys), dimension(kts:kte+1), intent(in) :: ZW + real(kind_phys), intent(in) :: WTHL,WQT + real(kind_phys), intent(in) :: dt,ust,pblh ! outputs - downdraft properties - real(kind_phys),DIMENSION(KTS:KTE), INTENT(OUT) :: edmf_a_dd,edmf_w_dd, & - & edmf_qt_dd,edmf_thl_dd, edmf_ent_dd,edmf_qc_dd + real(kind_phys), dimension(kts:kte), intent(out) :: & + edmf_a_dd,edmf_w_dd, & + edmf_qt_dd,edmf_thl_dd, edmf_ent_dd,edmf_qc_dd ! outputs - variables needed for solver (sd_aw - sum ai*wi, sd_awphi - sum ai*wi*phii) - real(kind_phys),DIMENSION(KTS:KTE+1) :: sd_aw, sd_awthl, sd_awqt, sd_awu, & - sd_awv, sd_awqc, sd_awqv, sd_awqke, sd_aw2 + real(kind_phys), dimension(kts:kte+1) :: & + sd_aw, sd_awthl, sd_awqt, sd_awu, & + sd_awv, sd_awqc, sd_awqv, sd_awqke, sd_aw2 - real(kind_phys),DIMENSION(KTS:KTE), INTENT(IN) :: qc_bl1d, cldfra_bl1d + real(kind_phys), dimension(kts:kte), intent(in) :: & + qc_bl1d, cldfra_bl1d - INTEGER, PARAMETER :: NDOWN=5, debug_mf=0 !fixing number of plumes to 5 + integer, parameter:: ndown = 5 ! draw downdraft starting height randomly between cloud base and cloud top - INTEGER, DIMENSION(1:NDOWN) :: DD_initK - real(kind_phys) , DIMENSION(1:NDOWN) :: randNum + integer, dimension(1:NDOWN) :: DD_initK + real(kind_phys), dimension(1:NDOWN) :: randNum ! downdraft properties - real(kind_phys),DIMENSION(KTS:KTE+1,1:NDOWN) :: DOWNW,DOWNTHL,DOWNQT,& - DOWNQC,DOWNA,DOWNU,DOWNV,DOWNTHV + real(kind_phys), dimension(kts:kte+1,1:NDOWN) :: & + DOWNW,DOWNTHL,DOWNQT,DOWNQC,DOWNA,DOWNU,DOWNV,DOWNTHV ! entrainment variables - Real(Kind_phys),DIMENSION(KTS+1:KTE+1,1:NDOWN) :: ENT,ENTf - INTEGER,DIMENSION(KTS+1:KTE+1,1:NDOWN) :: ENTi + real(kind_phys), dimension(KTS+1:KTE+1,1:NDOWN) :: ENT,ENTf + integer, dimension(KTS+1:KTE+1,1:NDOWN) :: ENTi ! internal variables - INTEGER :: K,I,ki, kminrad, qlTop, p700_ind, qlBase - real(kind_phys):: wthv,wstar,qstar,thstar,sigmaW,sigmaQT,sigmaTH,z0, & - pwmin,pwmax,wmin,wmax,wlv,wtv,went,mindownw - real(kind_phys):: B,QTn,THLn,THVn,QCn,Un,Vn,QKEn,Wn2,Wn,THVk,Pk, & - EntEXP,EntW, Beta_dm, EntExp_M, rho_int - real(kind_phys):: jump_thetav, jump_qt, jump_thetal, & + integer :: K,I,ki, kminrad, qlTop, p700_ind, qlBase + real(kind_phys):: wthv,wstar,qstar,thstar,sigmaW,sigmaQT, & + sigmaTH,z0,pwmin,pwmax,wmin,wmax,wlv,wtv,went,mindownw + real(kind_phys):: B,QTn,THLn,THVn,QCn,Un,Vn,QKEn,Wn2,Wn, & + THVk,Pk,EntEXP,EntW,beta_dm,EntExp_M,rho_int + real(kind_phys):: jump_thetav, jump_qt, jump_thetal, & refTHL, refTHV, refQT ! DD specific internal variables real(kind_phys):: minrad,zminrad, radflux, F0, wst_rad, wst_dd logical :: cloudflg - - real(kind_phys):: sigq,xl,rsl,cpm,a,mf_cf,diffqt,& + real(kind_phys):: sigq,xl,rsl,cpm,a,mf_cf,diffqt, & Fng,qww,alpha,beta,bb,f,pt,t,q2p,b9,satvp,rhgrid ! w parameters - real(kind_phys),PARAMETER :: & - &Wa=1., & - &Wb=1.5,& - &Z00=100.,& - &BCOEFF=0.2 + real(kind_phys),parameter :: & + &Wa=1., Wb=1.5, Z00=100., BCOEFF=0.2 ! entrainment parameters - real(kind_phys),PARAMETER :: & - & L0=80,& - & ENT0=0.2 - + real(kind_phys),parameter :: & + &L0=80, ENT0=0.2 + !downdraft properties + real(kind_phys):: & + & dp, & !diameter of plume + & dl, & !diameter increment + & Adn !total area of downdrafts + !additional printouts for debugging + integer, parameter :: debug_mf=0 + + dl = (1000.-500.)/real(ndown) pwmin=-3. ! drawing from the negative tail -3sigma to -1sigma pwmax=-1. @@ -7052,6 +7077,14 @@ SUBROUTINE DDMF_JPL(kts,kte,dt,zw,dz,p, & if ( radflux < 0.0 ) F0 = abs(radflux) + F0 enddo F0 = max(F0, 1.0) + + !Allow the total fractional area of the downdrafts to be proportional + !to the radiative forcing: + !for 50 W/m2, Adn = 0.10 + !for 100 W/m2, Adn = 0.15 + !for 150 W/m2, Adn = 0.20 + Adn = min( 0.05 + F0*0.001, 0.3) + !found Sc cloud and cloud not at surface, trigger downdraft if (cloudflg) then @@ -7066,14 +7099,14 @@ SUBROUTINE DDMF_JPL(kts,kte,dt,zw,dz,p, & ! call Poisson(1,NDOWN,kts+1,kte,ENTf,ENTi) - ! entrainent: Ent=Ent0/dz*P(dz/L0) - do i=1,NDOWN - do k=kts+1,kte -! ENT(k,i)=real(ENTi(k,i))*Ent0/(ZW(k+1)-ZW(k)) - ENT(k,i) = 0.002 - ENT(k,i) = min(ENT(k,i),0.9/(ZW(k+1)-ZW(k))) - enddo - enddo +! ! entrainent: Ent=Ent0/dz*P(dz/L0) +! do i=1,NDOWN +! do k=kts+1,kte +!! ENT(k,i)=real(ENTi(k,i))*Ent0/(ZW(k+1)-ZW(k)) +! ENT(k,i) = 0.002 +! ENT(k,i) = min(ENT(k,i),0.9/(ZW(k+1)-ZW(k))) +! enddo +! enddo !!![EW: INVJUMP] find 700mb height then subtract trpospheric lapse rate!!! p700_ind = MINLOC(ABS(p-70000),1)!p1D is 70000 @@ -7116,8 +7149,10 @@ SUBROUTINE DDMF_JPL(kts,kte,dt,zw,dz,p, & !DOWNW(ki,I)=0.5*(wlv+wtv) DOWNW(ki,I)=wlv + !multiply downa by cloud fraction, so it's impact will diminish if + !clouds are mixed away over the course of the longer radiation time step !DOWNA(ki,I)=0.5*ERF(wtv/(sqrt(2.)*sigmaW))-0.5*ERF(wlv/(sqrt(2.)*sigmaW)) - DOWNA(ki,I)=.1/real(NDOWN) + DOWNA(ki,I)=Adn/real(NDOWN) DOWNU(ki,I)=(u(ki-1)*DZ(ki) + u(ki)*DZ(ki-1)) /(DZ(ki)+DZ(ki-1)) DOWNV(ki,I)=(v(ki-1)*DZ(ki) + v(ki)*DZ(ki-1)) /(DZ(ki)+DZ(ki-1)) @@ -7144,16 +7179,21 @@ SUBROUTINE DDMF_JPL(kts,kte,dt,zw,dz,p, & enddo - !print*, " Begin integration of downdrafts:" DO I=1,NDOWN + dp = 500. + dl*real(I) ! diameter of plume (meters) !print *, "Plume # =", I,"=======================" DO k=DD_initK(I)-1,KTS+1,-1 + + !Entrainment from Tian and Kuang (2016), with constraints + wmin = 0.3 + dp*0.0005 + ENT(k,i) = 0.33/(MIN(MAX(-1.0*DOWNW(k+1,I),wmin),0.9)*dp) + !starting at the first interface level below cloud top !EntExp=exp(-ENT(K,I)*dz(k)) !EntExp_M=exp(-ENT(K,I)/3.*dz(k)) - EntExp =ENT(K,I)*dz(k) - EntExp_M=ENT(K,I)*0.333*dz(k) + EntExp =ENT(K,I)*dz(k) !for all scalars + EntExp_M=ENT(K,I)*0.333*dz(k) !test for momentum QTn =DOWNQT(k+1,I) *(1.-EntExp) + QT(k)*EntExp THLn=DOWNTHL(k+1,I)*(1.-EntExp) + THL(k)*EntExp @@ -7187,11 +7227,11 @@ SUBROUTINE DDMF_JPL(kts,kte,dt,zw,dz,p, & BCOEFF*B/mindownw)*MIN(dz(k), 250.) !Do not allow a parcel to accelerate more than 1.25 m/s over 200 m. - !Add max increase of 2.0 m/s for coarse vertical resolution. - IF (Wn < DOWNW(K+1,I) - MIN(1.25*dz(k)/200., 2.0))THEN - Wn = DOWNW(K+1,I) - MIN(1.25*dz(k)/200., 2.0) + !Add max acceleration of -2.0 m/s for coarse vertical resolution. + IF (Wn < DOWNW(K+1,I) - MIN(1.25*dz(k)/200., -2.0))THEN + Wn = DOWNW(K+1,I) - MIN(1.25*dz(k)/200., -2.0) ENDIF - !Add symmetrical max decrease in w + !Add symmetrical max decrease in velocity (less negative) IF (Wn > DOWNW(K+1,I) + MIN(1.25*dz(k)/200., 2.0))THEN Wn = DOWNW(K+1,I) + MIN(1.25*dz(k)/200., 2.0) ENDIF @@ -7237,7 +7277,6 @@ SUBROUTINE DDMF_JPL(kts,kte,dt,zw,dz,p, & ! Even though downdraft starts at different height, average all up to qlTop DO k=qlTop,KTS,-1 DO I=1,NDOWN - IF (I > NDOWN) exit edmf_a_dd(K) =edmf_a_dd(K) +DOWNA(K-1,I) edmf_w_dd(K) =edmf_w_dd(K) +DOWNA(K-1,I)*DOWNW(K-1,I) edmf_qt_dd(K) =edmf_qt_dd(K) +DOWNA(K-1,I)*DOWNQT(K-1,I) @@ -7287,8 +7326,8 @@ SUBROUTINE SCALE_AWARE(dx,PBL1,Psig_bl,Psig_shcu) ! Psig_bl tapers local mixing ! Psig_shcu tapers nonlocal mixing - real(kind_phys), INTENT(IN) :: dx,pbl1 - real(kind_phys), INTENT(OUT) :: Psig_bl,Psig_shcu + real(kind_phys), intent(in) :: dx,pbl1 + real(kind_phys), intent(out) :: Psig_bl,Psig_shcu real(kind_phys) :: dxdh Psig_bl=1.0 @@ -7361,28 +7400,28 @@ FUNCTION esat_blend(t) IMPLICIT NONE - real(kind_phys), INTENT(IN):: t + real(kind_phys), intent(in):: t real(kind_phys):: esat_blend,XC,ESL,ESI,chi !liquid - real(kind_phys), PARAMETER:: J0= .611583699E03 - real(kind_phys), PARAMETER:: J1= .444606896E02 - real(kind_phys), PARAMETER:: J2= .143177157E01 - real(kind_phys), PARAMETER:: J3= .264224321E-1 - real(kind_phys), PARAMETER:: J4= .299291081E-3 - real(kind_phys), PARAMETER:: J5= .203154182E-5 - real(kind_phys), PARAMETER:: J6= .702620698E-8 - real(kind_phys), PARAMETER:: J7= .379534310E-11 - real(kind_phys), PARAMETER:: J8=-.321582393E-13 + real(kind_phys), parameter:: J0= .611583699E03 + real(kind_phys), parameter:: J1= .444606896E02 + real(kind_phys), parameter:: J2= .143177157E01 + real(kind_phys), parameter:: J3= .264224321E-1 + real(kind_phys), parameter:: J4= .299291081E-3 + real(kind_phys), parameter:: J5= .203154182E-5 + real(kind_phys), parameter:: J6= .702620698E-8 + real(kind_phys), parameter:: J7= .379534310E-11 + real(kind_phys), parameter:: J8=-.321582393E-13 !ice - real(kind_phys), PARAMETER:: K0= .609868993E03 - real(kind_phys), PARAMETER:: K1= .499320233E02 - real(kind_phys), PARAMETER:: K2= .184672631E01 - real(kind_phys), PARAMETER:: K3= .402737184E-1 - real(kind_phys), PARAMETER:: K4= .565392987E-3 - real(kind_phys), PARAMETER:: K5= .521693933E-5 - real(kind_phys), PARAMETER:: K6= .307839583E-7 - real(kind_phys), PARAMETER:: K7= .105785160E-9 - real(kind_phys), PARAMETER:: K8= .161444444E-12 + real(kind_phys), parameter:: K0= .609868993E03 + real(kind_phys), parameter:: K1= .499320233E02 + real(kind_phys), parameter:: K2= .184672631E01 + real(kind_phys), parameter:: K3= .402737184E-1 + real(kind_phys), parameter:: K4= .565392987E-3 + real(kind_phys), parameter:: K5= .521693933E-5 + real(kind_phys), parameter:: K6= .307839583E-7 + real(kind_phys), parameter:: K7= .105785160E-9 + real(kind_phys), parameter:: K8= .161444444E-12 XC=MAX(-80.,t - t0c) !note t0c = 273.15, tice is set in module mynn_common to 240 @@ -7412,28 +7451,28 @@ FUNCTION qsat_blend(t, P) IMPLICIT NONE - real(kind_phys), INTENT(IN):: t, P + real(kind_phys), intent(in):: t, P real(kind_phys):: qsat_blend,XC,ESL,ESI,RSLF,RSIF,chi !liquid - real(kind_phys), PARAMETER:: J0= .611583699E03 - real(kind_phys), PARAMETER:: J1= .444606896E02 - real(kind_phys), PARAMETER:: J2= .143177157E01 - real(kind_phys), PARAMETER:: J3= .264224321E-1 - real(kind_phys), PARAMETER:: J4= .299291081E-3 - real(kind_phys), PARAMETER:: J5= .203154182E-5 - real(kind_phys), PARAMETER:: J6= .702620698E-8 - real(kind_phys), PARAMETER:: J7= .379534310E-11 - real(kind_phys), PARAMETER:: J8=-.321582393E-13 + real(kind_phys), parameter:: J0= .611583699E03 + real(kind_phys), parameter:: J1= .444606896E02 + real(kind_phys), parameter:: J2= .143177157E01 + real(kind_phys), parameter:: J3= .264224321E-1 + real(kind_phys), parameter:: J4= .299291081E-3 + real(kind_phys), parameter:: J5= .203154182E-5 + real(kind_phys), parameter:: J6= .702620698E-8 + real(kind_phys), parameter:: J7= .379534310E-11 + real(kind_phys), parameter:: J8=-.321582393E-13 !ice - real(kind_phys), PARAMETER:: K0= .609868993E03 - real(kind_phys), PARAMETER:: K1= .499320233E02 - real(kind_phys), PARAMETER:: K2= .184672631E01 - real(kind_phys), PARAMETER:: K3= .402737184E-1 - real(kind_phys), PARAMETER:: K4= .565392987E-3 - real(kind_phys), PARAMETER:: K5= .521693933E-5 - real(kind_phys), PARAMETER:: K6= .307839583E-7 - real(kind_phys), PARAMETER:: K7= .105785160E-9 - real(kind_phys), PARAMETER:: K8= .161444444E-12 + real(kind_phys), parameter:: K0= .609868993E03 + real(kind_phys), parameter:: K1= .499320233E02 + real(kind_phys), parameter:: K2= .184672631E01 + real(kind_phys), parameter:: K3= .402737184E-1 + real(kind_phys), parameter:: K4= .565392987E-3 + real(kind_phys), parameter:: K5= .521693933E-5 + real(kind_phys), parameter:: K6= .307839583E-7 + real(kind_phys), parameter:: K7= .105785160E-9 + real(kind_phys), parameter:: K8= .161444444E-12 XC=MAX(-80.,t - t0c) @@ -7470,7 +7509,7 @@ FUNCTION xl_blend(t) IMPLICIT NONE - real(kind_phys), INTENT(IN):: t + real(kind_phys), intent(in):: t real(kind_phys):: xl_blend,xlvt,xlst,chi !note: t0c = 273.15, tice is set in mynn_common @@ -7499,11 +7538,11 @@ FUNCTION phim(zet) ! stable conditions [z/L ~ O(10)]. IMPLICIT NONE - real(kind_phys), INTENT(IN):: zet + real(kind_phys), intent(in):: zet real(kind_phys):: dummy_0,dummy_1,dummy_11,dummy_2,dummy_22,dummy_3,dummy_33,dummy_4,dummy_44,dummy_psi - real(kind_phys), PARAMETER :: am_st=6.1, bm_st=2.5, rbm_st=1./bm_st - real(kind_phys), PARAMETER :: ah_st=5.3, bh_st=1.1, rbh_st=1./bh_st - real(kind_phys), PARAMETER :: am_unst=10., ah_unst=34. + real(kind_phys), parameter :: am_st=6.1, bm_st=2.5, rbm_st=1./bm_st + real(kind_phys), parameter :: ah_st=5.3, bh_st=1.1, rbh_st=1./bh_st + real(kind_phys), parameter :: am_unst=10., ah_unst=34. real(kind_phys):: phi_m,phim if ( zet >= 0.0 ) then @@ -7551,11 +7590,11 @@ FUNCTION phih(zet) ! stable conditions [z/L ~ O(10)]. IMPLICIT NONE - real(kind_phys), INTENT(IN):: zet + real(kind_phys), intent(in):: zet real(kind_phys):: dummy_0,dummy_1,dummy_11,dummy_2,dummy_22,dummy_3,dummy_33,dummy_4,dummy_44,dummy_psi - real(kind_phys), PARAMETER :: am_st=6.1, bm_st=2.5, rbm_st=1./bm_st - real(kind_phys), PARAMETER :: ah_st=5.3, bh_st=1.1, rbh_st=1./bh_st - real(kind_phys), PARAMETER :: am_unst=10., ah_unst=34. + real(kind_phys), parameter :: am_st=6.1, bm_st=2.5, rbm_st=1./bm_st + real(kind_phys), parameter :: ah_st=5.3, bh_st=1.1, rbh_st=1./bh_st + real(kind_phys), parameter :: am_unst=10., ah_unst=34. real(kind_phys):: phh,phih if ( zet >= 0.0 ) then diff --git a/physics/mynnedmf_wrapper.F90 b/physics/PBL/MYNN_EDMF/mynnedmf_wrapper.F90 similarity index 94% rename from physics/mynnedmf_wrapper.F90 rename to physics/PBL/MYNN_EDMF/mynnedmf_wrapper.F90 index 3c7de235f..6dc068758 100644 --- a/physics/mynnedmf_wrapper.F90 +++ b/physics/PBL/MYNN_EDMF/mynnedmf_wrapper.F90 @@ -131,7 +131,8 @@ SUBROUTINE mynnedmf_wrapper_run( & & edmf_a,edmf_w,edmf_qt, & & edmf_thl,edmf_ent,edmf_qc, & & sub_thl,sub_sqv,det_thl,det_sqv,& - & nupdraft,maxMF,ktop_plume, & + & maxwidth,maxMF,ztop_plume, & + & ktop_plume, & & dudt, dvdt, dtdt, & & dqdt_water_vapor, dqdt_liquid_cloud, & ! <=== ntqv, ntcw & dqdt_ice, dqdt_snow, & ! <=== ntiw, ntsw @@ -171,7 +172,7 @@ SUBROUTINE mynnedmf_wrapper_run( & implicit none !------------------------------------------------------------------- - real(kind_phys) :: huge + real(kind_phys), intent(in) :: huge character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -243,38 +244,39 @@ SUBROUTINE mynnedmf_wrapper_run( & real(kind_phys), dimension(:,:), intent(inout) :: & & dtdt, dudt, dvdt, & & dqdt_water_vapor, dqdt_liquid_cloud, dqdt_ice, & - & dqdt_snow, & - & dqdt_cloud_droplet_num_conc, dqdt_ice_num_conc, & - & dqdt_ozone, dqdt_water_aer_num_conc, dqdt_ice_aer_num_conc - real(kind_phys), dimension(:,:), intent(inout) ::dqdt_cccn + & dqdt_snow, dqdt_ice_num_conc, dqdt_ozone + real(kind_phys), dimension(:,:), intent(inout), optional :: & + & dqdt_cloud_droplet_num_conc, dqdt_water_aer_num_conc, & + & dqdt_ice_aer_num_conc + real(kind_phys), dimension(:,:), intent(inout), optional :: qke, & + & EL_PBL, Sh3D, Sm3D, qc_bl, qi_bl, cldfra_bl, dqdt_cccn real(kind_phys), dimension(:,:), intent(inout) :: & - & qke, qke_adv, EL_PBL, Sh3D, Sm3D, & - & qc_bl, qi_bl, cldfra_bl + & qke_adv !These 10 arrays are only allocated when bl_mynn_output > 0 - real(kind_phys), dimension(:,:), intent(inout) :: & + real(kind_phys), dimension(:,:), intent(inout), optional :: & & edmf_a,edmf_w,edmf_qt, & & edmf_thl,edmf_ent,edmf_qc, & & sub_thl,sub_sqv,det_thl,det_sqv real(kind_phys), dimension(:,:), intent(inout) :: & - & dqke,qWT,qSHEAR,qBUOY,qDISS - real(kind_phys), dimension(:,:), intent(inout) :: & & t3d,qgrs_water_vapor,qgrs_liquid_cloud,qgrs_ice, & & qgrs_snow real(kind_phys), dimension(:,:), intent(in) :: & + & qgrs_cloud_ice_num_conc, & & u,v,omega, & & exner,prsl,prsi, & - & qgrs_cloud_droplet_num_conc, & - & qgrs_cloud_ice_num_conc, & - & qgrs_ozone, & + & qgrs_ozone + real(kind_phys), dimension(:,:), intent(in), optional :: & & qgrs_water_aer_num_conc, & + & qgrs_cloud_droplet_num_conc, & & qgrs_ice_aer_num_conc - real(kind_phys), dimension(:,:), intent(in) ::qgrs_cccn - real(kind_phys), dimension(:,:), intent(out) :: & - & Tsq, Qsq, Cov, exch_h, exch_m + real(kind_phys), dimension(:,:), intent(in), optional :: qgrs_cccn + real(kind_phys), dimension(:,:), intent(out), optional :: & + & Tsq, Qsq, Cov, exch_h, exch_m, dqke, qWT, qSHEAR, qBUOY, & + & qDISS real(kind_phys), dimension(:), intent(in) :: xmu real(kind_phys), dimension(:,:), intent(in) :: htrsw, htrlw ! spp_wts_pbl only allocated if spp_pbl == 1 - real(kind_phys), dimension(:,:), intent(in) :: spp_wts_pbl + real(kind_phys), dimension(:,:), intent(in), optional :: spp_wts_pbl !LOCAL real(kind_phys), dimension(im,levs) :: & @@ -286,10 +288,10 @@ SUBROUTINE mynnedmf_wrapper_run( & real(kind_phys), allocatable :: old_ozone(:,:) !smoke/chem arrays - real(kind_phys), dimension(:), intent(inout) :: frp + real(kind_phys), dimension(:), intent(inout), optional :: frp logical, intent(in) :: mix_chem, enh_mix, rrfs_sd - real(kind_phys), dimension(:,:,:), intent(inout) :: chem3d - real(kind_phys), dimension(:,: ), intent(inout) :: vdep + real(kind_phys), dimension(:,:,:), intent(inout), optional :: chem3d + real(kind_phys), dimension(:,: ), intent(in), optional :: vdep real(kind_phys), dimension(im) :: emis_ant_no !MYNN-2D @@ -297,8 +299,9 @@ SUBROUTINE mynnedmf_wrapper_run( & & dx,zorl,slmsk,tsurf,qsfc,ps, & & hflx,qflx,ust,wspd,rb,recmol + real(kind_phys), dimension(:), intent(in), optional :: & + & dusfc_cice,dvsfc_cice,dtsfc_cice,dqsfc_cice real(kind_phys), dimension(:), intent(in) :: & - & dusfc_cice,dvsfc_cice,dtsfc_cice,dqsfc_cice, & & stress_wat,hflx_wat,qflx_wat, & & oceanfrac,fice @@ -309,14 +312,17 @@ SUBROUTINE mynnedmf_wrapper_run( & & pblh,dusfc_diag,dvsfc_diag,dtsfc_diag,dqsfc_diag real(kind_phys), dimension(:), intent(out) :: & & ch,dtsfc1,dqsfc1,dusfc1,dvsfc1, & - & dtsfci_diag,dqsfci_diag,dusfci_diag,dvsfci_diag, & - & maxMF + & dtsfci_diag,dqsfci_diag,dusfci_diag,dvsfci_diag + real(kind_phys), dimension(:), intent(out), optional :: & + & maxMF,maxwidth,ztop_plume integer, dimension(:), intent(inout) :: & - & kpbl,nupdraft,ktop_plume + & kpbl + integer, dimension(:), intent(inout), optional :: & + & ktop_plume - real(kind_phys), dimension(:), intent(inout) :: & + real(kind_phys), dimension(:), intent(inout), optional :: & & dusfc_cpl,dvsfc_cpl,dtsfc_cpl,dqsfc_cpl - real(kind_phys), dimension(:), intent(inout) :: & + real(kind_phys), dimension(:), intent(inout), optional :: & & dusfci_cpl,dvsfci_cpl,dtsfci_cpl,dqsfci_cpl !LOCAL @@ -325,6 +331,7 @@ SUBROUTINE mynnedmf_wrapper_run( & integer :: idtend real(kind_phys), dimension(im) :: dusfci1,dvsfci1,dtsfci1,dqsfci1 real(kind_phys), allocatable :: save_qke_adv(:,:) + real(kind_phys), dimension(levs) :: kzero ! Initialize CCPP error handling variables errmsg = '' @@ -355,6 +362,7 @@ SUBROUTINE mynnedmf_wrapper_run( & !print*,"in MYNN, initflag=",initflag endif + kzero = zero !generic zero array !initialize arrays for test EMIS_ANT_NO = 0. @@ -391,7 +399,7 @@ SUBROUTINE mynnedmf_wrapper_run( & FLAG_QNI= .true. FLAG_QC = .true. FLAG_QNC= .true. - FLAG_QS = .false. !.true. + FLAG_QS = .true. FLAG_QNWFA= nssl_ccn_on ! ERM: Perhaps could use this field for CCN field? FLAG_QNIFA= .false. FLAG_QNBCA= .false. @@ -400,7 +408,7 @@ SUBROUTINE mynnedmf_wrapper_run( & sqv(i,k) = qgrs_water_vapor(i,k) sqc(i,k) = qgrs_liquid_cloud(i,k) sqi(i,k) = qgrs_ice(i,k) - sqs(i,k) = 0.0 !qgrs_snow(i,k) + sqs(i,k) = qgrs_snow(i,k) ozone(i,k) = qgrs_ozone(i,k) qnc(i,k) = qgrs_cloud_droplet_num_conc(i,k) qni(i,k) = qgrs_cloud_ice_num_conc(i,k) @@ -418,7 +426,7 @@ SUBROUTINE mynnedmf_wrapper_run( & FLAG_QI = .true. FLAG_QNI= .true. FLAG_QC = .true. - FLAG_QS = .false. + FLAG_QS = .true. !pipe it in, but do not mix FLAG_QNC= .true. FLAG_QNWFA= .true. FLAG_QNIFA= .true. @@ -428,7 +436,7 @@ SUBROUTINE mynnedmf_wrapper_run( & sqv(i,k) = qgrs_water_vapor(i,k) sqc(i,k) = qgrs_liquid_cloud(i,k) sqi(i,k) = qgrs_ice(i,k) - sqs(i,k) = 0. !qgrs_snow(i,k) + sqs(i,k) = qgrs_snow(i,k) qnc(i,k) = qgrs_cloud_droplet_num_conc(i,k) qni(i,k) = qgrs_cloud_ice_num_conc(i,k) ozone(i,k) = qgrs_ozone(i,k) @@ -441,7 +449,7 @@ SUBROUTINE mynnedmf_wrapper_run( & FLAG_QI = .true. FLAG_QNI= .true. FLAG_QC = .true. - FLAG_QS = .false. + FLAG_QS = .true. FLAG_QNC= .true. FLAG_QNWFA= .false. FLAG_QNIFA= .false. @@ -451,7 +459,7 @@ SUBROUTINE mynnedmf_wrapper_run( & sqv(i,k) = qgrs_water_vapor(i,k) sqc(i,k) = qgrs_liquid_cloud(i,k) sqi(i,k) = qgrs_ice(i,k) - sqs(i,k) = 0. !qgrs_snow(i,k) + sqs(i,k) = qgrs_snow(i,k) qnc(i,k) = qgrs_cloud_droplet_num_conc(i,k) qni(i,k) = qgrs_cloud_ice_num_conc(i,k) ozone(i,k) = qgrs_ozone(i,k) @@ -464,7 +472,7 @@ SUBROUTINE mynnedmf_wrapper_run( & FLAG_QI = .true. FLAG_QNI= .true. FLAG_QC = .true. - FLAG_QS = .false. + FLAG_QS = .true. FLAG_QNC= .false. FLAG_QNWFA= .false. FLAG_QNIFA= .false. @@ -474,7 +482,7 @@ SUBROUTINE mynnedmf_wrapper_run( & sqv(i,k) = qgrs_water_vapor(i,k) sqc(i,k) = qgrs_liquid_cloud(i,k) sqi(i,k) = qgrs_ice(i,k) - sqs(i,k) = 0. !qgrs_snow(i,k) + sqs(i,k) = qgrs_snow(i,k) qnc(i,k) = 0. qni(i,k) = qgrs_cloud_ice_num_conc(i,k) ozone(i,k) = qgrs_ozone(i,k) @@ -565,7 +573,7 @@ SUBROUTINE mynnedmf_wrapper_run( & call moisture_check2(levs, delt, & delp(i,:), exner(i,:), & sqv(i,:), sqc(i,:), & - sqi(i,:), sqs(i,:), & + sqi(i,:), kzero(:), & t3d(i,:) ) enddo @@ -748,7 +756,7 @@ SUBROUTINE mynnedmf_wrapper_run( & & edmf_thl=edmf_thl,edmf_ent=edmf_ent,edmf_qc=edmf_qc,& !output & sub_thl3D=sub_thl,sub_sqv3D=sub_sqv, & & det_thl3D=det_thl,det_sqv3D=det_sqv, & - & nupdraft=nupdraft,maxMF=maxMF, & !output + & maxwidth=maxwidth,maxMF=maxMF,ztop_plume=ztop_plume,& !output & ktop_plume=ktop_plume, & !output & spp_pbl=spp_pbl,pattern_spp_pbl=spp_wts_pbl, & !input & RTHRATEN=htrlw, & !input @@ -834,7 +842,7 @@ SUBROUTINE mynnedmf_wrapper_run( & dqdt_cloud_droplet_num_conc(i,k) = RQNCBLTEN(i,k) dqdt_ice(i,k) = RQIBLTEN(i,k) !/(1.0 + qv(i,k)) dqdt_ice_num_conc(i,k) = RQNIBLTEN(i,k) - dqdt_snow(i,k) = 0.0 !RQSBLTEN(i,k) !/(1.0 + qv(i,k)) + dqdt_snow(i,k) = RQSBLTEN(i,k) !/(1.0 + qv(i,k)) !dqdt_ozone(i,k) = 0.0 dqdt_water_aer_num_conc(i,k) = RQNWFABLTEN(i,k) dqdt_ice_aer_num_conc(i,k) = RQNIFABLTEN(i,k) @@ -869,7 +877,7 @@ SUBROUTINE mynnedmf_wrapper_run( & dqdt_cloud_droplet_num_conc(i,k) = RQNCBLTEN(i,k) dqdt_ice(i,k) = RQIBLTEN(i,k) !/(1.0 + qv(i,k)) dqdt_ice_num_conc(i,k) = RQNIBLTEN(i,k) - dqdt_snow(i,k) = 0.0 !RQSBLTEN(i,k) !/(1.0 + qv(i,k)) + dqdt_snow(i,k) = RQSBLTEN(i,k) !/(1.0 + qv(i,k)) enddo enddo if(ldiag3d .and. .not. flag_for_pbl_generic_tend) then @@ -887,7 +895,7 @@ SUBROUTINE mynnedmf_wrapper_run( & dqdt_liquid_cloud(i,k) = RQCBLTEN(i,k) !/(1.0 + qv(i,k)) dqdt_ice(i,k) = RQIBLTEN(i,k) !/(1.0 + qv(i,k)) dqdt_ice_num_conc(i,k) = RQNIBLTEN(i,k) - dqdt_snow(i,k) = 0.0 !RQSBLTEN(i,k) !/(1.0 + qv(i,k)) + dqdt_snow(i,k) = RQSBLTEN(i,k) !/(1.0 + qv(i,k)) !dqdt_ozone(i,k) = 0.0 enddo enddo @@ -917,7 +925,7 @@ SUBROUTINE mynnedmf_wrapper_run( & dqdt_cloud_droplet_num_conc(i,k) = RQNCBLTEN(i,k) dqdt_ice(i,k) = RQIBLTEN(i,k) !/(1.0 + qv(i,k)) dqdt_ice_num_conc(i,k) = RQNIBLTEN(i,k) - !dqdt_snow(i,k) = RQSBLTEN(i,k) !/(1.0 + qv(i,k)) + dqdt_snow(i,k) = RQSBLTEN(i,k) !/(1.0 + qv(i,k)) IF ( nssl_ccn_on ) THEN ! dqdt_cccn(i,k) = RQNWFABLTEN(i,k) ENDIF @@ -1005,8 +1013,8 @@ SUBROUTINE mynnedmf_wrapper_run( & print*,"dudt:",dudt(1,1),dudt(1,2),dudt(1,levs) print*,"dvdt:",dvdt(1,1),dvdt(1,2),dvdt(1,levs) print*,"dqdt:",dqdt_water_vapor(1,1),dqdt_water_vapor(1,2),dqdt_water_vapor(1,levs) - print*,"ktop_plume:",ktop_plume(1)," maxmf:",maxmf(1) - print*,"nup:",nupdraft(1) + print*,"ztop_plume:",ztop_plume(1)," maxmf:",maxmf(1) + print*,"maxwidth:",maxwidth(1) print* endif diff --git a/physics/mynnedmf_wrapper.meta b/physics/PBL/MYNN_EDMF/mynnedmf_wrapper.meta similarity index 96% rename from physics/mynnedmf_wrapper.meta rename to physics/PBL/MYNN_EDMF/mynnedmf_wrapper.meta index ec4706aba..f2adfc4f5 100644 --- a/physics/mynnedmf_wrapper.meta +++ b/physics/PBL/MYNN_EDMF/mynnedmf_wrapper.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = mynnedmf_wrapper type = scheme - dependencies = machine.F,module_bl_mynn.F90,physcons.F90,bl_mynn_common.f90 + dependencies = ../../hooks/machine.F,module_bl_mynn.F90,bl_mynn_common.f90 ######################################################################## [ccpp-arg-table] @@ -320,6 +320,7 @@ type = real kind = kind_phys intent = in + optional = True [qgrs_cloud_ice_num_conc] standard_name = mass_number_concentration_of_cloud_ice_water_crystals_in_air long_name = number concentration of ice @@ -344,6 +345,7 @@ type = real kind = kind_phys intent = in + optional = True [qgrs_ice_aer_num_conc] standard_name = mass_number_concentration_of_nonhygroscopic_ice_nucleating_aerosols long_name = number concentration of ice-friendly aerosols @@ -352,6 +354,7 @@ type = real kind = kind_phys intent = in + optional = True [qgrs_cccn] standard_name = cloud_condensation_nuclei_number_concentration long_name = number concentration of cloud condensation nuclei @@ -360,6 +363,7 @@ type = real kind = kind_phys intent = inout + optional = True [prsl] standard_name = air_pressure long_name = mean layer pressure @@ -568,6 +572,7 @@ type = real kind = kind_phys intent = in + optional = True [dvsfc_cice] standard_name = surface_y_momentum_flux_from_coupled_process long_name = sfc y momentum flux for coupling @@ -576,6 +581,7 @@ type = real kind = kind_phys intent = in + optional = True [dtsfc_cice] standard_name = surface_upward_sensible_heat_flux_from_coupled_process long_name = sfc sensible heat flux for coupling @@ -584,6 +590,7 @@ type = real kind = kind_phys intent = in + optional = True [dqsfc_cice] standard_name = surface_upward_latent_heat_flux_from_coupled_process long_name = sfc latent heat flux for coupling @@ -592,6 +599,7 @@ type = real kind = kind_phys intent = in + optional = True [hflx_wat] standard_name = kinematic_surface_upward_sensible_heat_flux_over_water long_name = kinematic surface upward sensible heat flux over water @@ -661,6 +669,7 @@ type = real kind = kind_phys intent = inout + optional = True [dvsfci_cpl] standard_name = surface_y_momentum_flux_for_coupling long_name = instantaneous sfc v momentum flux @@ -669,6 +678,7 @@ type = real kind = kind_phys intent = inout + optional = True [dtsfci_cpl] standard_name = surface_upward_sensible_heat_flux_for_coupling long_name = instantaneous sfc sensible heat flux @@ -677,6 +687,7 @@ type = real kind = kind_phys intent = inout + optional = True [dqsfci_cpl] standard_name = surface_upward_latent_heat_flux_for_coupling long_name = instantaneous sfc latent heat flux @@ -685,6 +696,7 @@ type = real kind = kind_phys intent = inout + optional = True [dusfc_cpl] standard_name = cumulative_surface_x_momentum_flux_for_coupling_multiplied_by_timestep long_name = cumulative sfc u momentum flux multiplied by timestep @@ -693,6 +705,7 @@ type = real kind = kind_phys intent = inout + optional = True [dvsfc_cpl] standard_name = cumulative_surface_y_momentum_flux_for_coupling_multiplied_by_timestep long_name = cumulative sfc v momentum flux multiplied by timestep @@ -701,6 +714,7 @@ type = real kind = kind_phys intent = inout + optional = True [dtsfc_cpl] standard_name = cumulative_surface_upward_sensible_heat_flux_for_coupling_multiplied_by_timestep long_name = cumulative sfc sensible heat flux multiplied by timestep @@ -709,6 +723,7 @@ type = real kind = kind_phys intent = inout + optional = True [dqsfc_cpl] standard_name = cumulative_surface_upward_latent_heat_flux_for_coupling_multiplied_by_timestep long_name = cumulative sfc latent heat flux multiplied by timestep @@ -717,6 +732,7 @@ type = real kind = kind_phys intent = inout + optional = True [recmol] standard_name = reciprocal_of_obukhov_length long_name = one over obukhov length @@ -733,6 +749,7 @@ type = real kind = kind_phys intent = inout + optional = True [qke_adv] standard_name = turbulent_kinetic_energy long_name = turbulent kinetic energy @@ -749,6 +766,7 @@ type = real kind = kind_phys intent = out + optional = True [qsq] standard_name = variance_of_specific_humidity long_name = water vapor fluctuation squared @@ -757,6 +775,7 @@ type = real kind = kind_phys intent = out + optional = True [cov] standard_name = covariance_of_air_temperature_and_specific_humidity long_name = covariance of temperature and moisture @@ -765,6 +784,7 @@ type = real kind = kind_phys intent = out + optional = True [el_pbl] standard_name = turbulent_mixing_length long_name = mixing length in meters @@ -773,6 +793,7 @@ type = real kind = kind_phys intent = inout + optional = True [Sh3D] standard_name = stability_function_for_heat long_name = stability function for heat @@ -781,6 +802,7 @@ type = real kind = kind_phys intent = inout + optional = True [Sm3D] standard_name = stability_function_for_momentum long_name = stability function for momentum @@ -789,6 +811,7 @@ type = real kind = kind_phys intent = inout + optional = True [exch_h] standard_name = atmosphere_heat_diffusivity_for_mynnedmf long_name = diffusivity for heat for MYNN PBL (defined for all mass levels) @@ -797,6 +820,7 @@ type = real kind = kind_phys intent = out + optional = True [exch_m] standard_name = atmosphere_momentum_diffusivity_for_mynnedmf long_name = diffusivity for momentum for MYNN PBL (defined for all mass levels) @@ -805,6 +829,7 @@ type = real kind = kind_phys intent = out + optional = True [dqke] standard_name = total_time_rate_of_change_of_tke long_name = total tke tendency @@ -813,6 +838,7 @@ type = real kind = kind_phys intent = out + optional = True [qwt] standard_name = tke_tendency_due_to_vertical_transport long_name = tke tendency due to vertical transport and diffusion @@ -821,6 +847,7 @@ type = real kind = kind_phys intent = out + optional = True [qshear] standard_name = tke_tendency_due_to_shear long_name = tke tendency due to shear @@ -829,6 +856,7 @@ type = real kind = kind_phys intent = out + optional = True [qbuoy] standard_name = tke_tendency_due_to_buoyancy long_name = tke tendency due to buoyancy production or consumption @@ -837,6 +865,7 @@ type = real kind = kind_phys intent = out + optional = True [qdiss] standard_name = tke_tendency_due_to_dissipation long_name = tke tendency due to the dissipation of tke @@ -845,6 +874,7 @@ type = real kind = kind_phys intent = out + optional = True [PBLH] standard_name = atmosphere_boundary_layer_thickness long_name = PBL thickness @@ -868,6 +898,7 @@ type = real kind = kind_phys intent = inout + optional = True [QI_BL] standard_name = subgrid_scale_cloud_ice_mixing_ratio long_name = subgrid cloud ice mixing ratio from PBL scheme @@ -876,6 +907,7 @@ type = real kind = kind_phys intent = inout + optional = True [CLDFRA_BL] standard_name = subgrid_scale_cloud_area_fraction_in_atmosphere_layer long_name = subgrid cloud fraction from PBL scheme @@ -884,6 +916,7 @@ type = real kind = kind_phys intent = inout + optional = True [edmf_a] standard_name = emdf_updraft_area long_name = updraft area from mass flux scheme @@ -892,6 +925,7 @@ type = real kind = kind_phys intent = inout + optional = True [edmf_w] standard_name = emdf_updraft_vertical_velocity long_name = updraft vertical velocity from mass flux scheme @@ -900,6 +934,7 @@ type = real kind = kind_phys intent = inout + optional = True [edmf_qt] standard_name = emdf_updraft_total_water long_name = updraft total water from mass flux scheme @@ -908,6 +943,7 @@ type = real kind = kind_phys intent = inout + optional = True [edmf_thl] standard_name = emdf_updraft_theta_l long_name = updraft theta-l from mass flux scheme @@ -916,6 +952,7 @@ type = real kind = kind_phys intent = inout + optional = True [edmf_ent] standard_name = emdf_updraft_entrainment_rate long_name = updraft entrainment rate from mass flux scheme @@ -924,6 +961,7 @@ type = real kind = kind_phys intent = inout + optional = True [edmf_qc] standard_name = emdf_updraft_cloud_water long_name = updraft cloud water from mass flux scheme @@ -932,6 +970,7 @@ type = real kind = kind_phys intent = inout + optional = True [sub_thl] standard_name = theta_subsidence_tendency long_name = updraft theta subsidence tendency @@ -940,6 +979,7 @@ type = real kind = kind_phys intent = inout + optional = True [sub_sqv] standard_name = water_vapor_subsidence_tendency long_name = updraft water vapor subsidence tendency @@ -948,6 +988,7 @@ type = real kind = kind_phys intent = inout + optional = True [det_thl] standard_name = theta_detrainment_tendency long_name = updraft theta detrainment tendency @@ -956,6 +997,7 @@ type = real kind = kind_phys intent = inout + optional = True [det_sqv] standard_name = water_vapor_detrainment_tendency long_name = updraft water vapor detrainment tendency @@ -964,13 +1006,16 @@ type = real kind = kind_phys intent = inout -[nupdraft] - standard_name = number_of_plumes - long_name = number of plumes per grid column - units = count + optional = True +[maxwidth] + standard_name = maximum_width_of_plumes + long_name = maximum width of plumes per grid column + units = m dimensions = (horizontal_loop_extent) - type = integer - intent = inout + type = real + kind = kind_phys + intent = out + optional = True [maxMF] standard_name = maximum_mass_flux long_name = maximum mass flux within a column @@ -979,6 +1024,16 @@ type = real kind = kind_phys intent = out + optional = True +[ztop_plume] + standard_name = height_of_tallest_plume_in_a_column + long_name = height of tallest plume in a column + units = m + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = out + optional = True [ktop_plume] standard_name = k_level_of_highest_plume long_name = k-level of highest plume @@ -986,6 +1041,7 @@ dimensions = (horizontal_loop_extent) type = integer intent = inout + optional = True [dudt] standard_name = process_split_cumulative_tendency_of_x_wind long_name = updated tendency of the x wind @@ -1058,6 +1114,7 @@ type = real kind = kind_phys intent = inout + optional = True [dqdt_ice_num_conc] standard_name = process_split_cumulative_tendency_of_mass_number_concentration_of_cloud_ice_water_crystals_in_air long_name = number conc. of ice tendency due to model physics @@ -1074,6 +1131,7 @@ type = real kind = kind_phys intent = inout + optional = True [dqdt_ice_aer_num_conc] standard_name = process_split_cumulative_tendency_of_mass_number_concentration_of_nonhygroscopic_ice_nucleating_aerosols long_name = number conc. of ice-friendly aerosols tendency due to model physics @@ -1082,6 +1140,7 @@ type = real kind = kind_phys intent = inout + optional = True [dqdt_cccn] standard_name = tendency_of_cloud_condensation_nuclei_number_concentration_due_to_model_physics long_name = number concentration of cloud condensation nuclei tendency due to model physics @@ -1090,6 +1149,7 @@ type = real kind = kind_phys intent = inout + optional = True [flag_for_pbl_generic_tend] standard_name = flag_for_generic_tendency_due_to_planetary_boundary_layer long_name = true if GFS_PBL_generic should calculate tendencies @@ -1105,6 +1165,7 @@ type = real kind = kind_phys intent = inout + optional = True [dtidx] standard_name = cumulative_change_of_state_variables_outer_index long_name = index of state-variable and process in last dimension of diagnostic tendencies array AKA cumulative_change_index @@ -1382,6 +1443,7 @@ type = real kind = kind_phys intent = inout + optional = True [frp] standard_name = frp_hourly long_name = hourly fire radiative power @@ -1390,6 +1452,7 @@ type = real kind = kind_phys intent = inout + optional = True [rrfs_sd] standard_name = do_smoke_coupling long_name = flag controlling rrfs_sd collection (default off) @@ -1433,6 +1496,7 @@ type = real kind = kind_phys intent = in + optional = True [smoke_dbg] standard_name = do_smoke_debug long_name = flag for rrfs smoke plumerise debug @@ -1462,6 +1526,7 @@ type = real kind = kind_phys intent = in + optional = True [spp_pbl] standard_name = control_for_pbl_spp_perturbations long_name = control for pbl spp perturbations diff --git a/physics/mfscu.f b/physics/PBL/SATMEDMF/mfscu.f similarity index 100% rename from physics/mfscu.f rename to physics/PBL/SATMEDMF/mfscu.f diff --git a/physics/mfscuq.f b/physics/PBL/SATMEDMF/mfscuq.f similarity index 100% rename from physics/mfscuq.f rename to physics/PBL/SATMEDMF/mfscuq.f diff --git a/physics/satmedmfvdif.F b/physics/PBL/SATMEDMF/satmedmfvdif.F similarity index 99% rename from physics/satmedmfvdif.F rename to physics/PBL/SATMEDMF/satmedmfvdif.F index 79f7bbea1..7e2d511f1 100644 --- a/physics/satmedmfvdif.F +++ b/physics/PBL/SATMEDMF/satmedmfvdif.F @@ -84,7 +84,8 @@ subroutine satmedmfvdif_run(im,km,ntrac,ntcw,ntiw,ntke, & integer, intent(out) :: kpbl(:) ! logical, intent(in) :: gen_tend, ldiag3d - real(kind=kind_phys), intent(inout), dimension(:,:,:) :: dtend + real(kind=kind_phys), intent(inout), dimension(:,:,:), optional ::& + & dtend integer, intent(in) :: index_of_temperature,index_of_x_wind, & & index_of_y_wind, ntqv, ntoz, dtidx(:,:), index_of_process_pbl ! diff --git a/physics/satmedmfvdif.meta b/physics/PBL/SATMEDMF/satmedmfvdif.meta similarity index 99% rename from physics/satmedmfvdif.meta rename to physics/PBL/SATMEDMF/satmedmfvdif.meta index 3609ed50f..2f0e0514d 100644 --- a/physics/satmedmfvdif.meta +++ b/physics/PBL/SATMEDMF/satmedmfvdif.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = satmedmfvdif type = scheme - dependencies = funcphys.f90,machine.F,mfpblt.f,mfscu.f,tridi.f + dependencies = ../../tools/funcphys.f90,../../hooks/machine.F,../mfpblt.f,mfscu.f,../tridi.f ######################################################################## [ccpp-arg-table] @@ -503,7 +503,8 @@ dimensions = (horizontal_loop_extent,vertical_layer_dimension,cumulative_change_of_state_variables_outer_index_max) type = real kind = kind_phys - intent = in + intent = inout + optional = True [dtidx] standard_name = cumulative_change_of_state_variables_outer_index long_name = index of state-variable and process in last dimension of diagnostic tendencies array AKA cumulative_change_index diff --git a/physics/satmedmfvdifq.F b/physics/PBL/SATMEDMF/satmedmfvdifq.F similarity index 98% rename from physics/satmedmfvdifq.F rename to physics/PBL/SATMEDMF/satmedmfvdifq.F index 75925a5f3..c0e43e809 100644 --- a/physics/satmedmfvdifq.F +++ b/physics/PBL/SATMEDMF/satmedmfvdifq.F @@ -22,7 +22,7 @@ module satmedmfvdifq !! and to reduce the negative wind speed bias in upper troposphere !! !! Incorporate the LES-based changes for TC simulation -!! (Chen et al.,2022, https://doi.org/10.1175/WAF-D-21-0168.1) +!! (Chen et al.,2022 \cite Chen_2022) !! with additional improvements on MF working with Cu schemes !! Xiaomin Chen, 5/2/2022 !! @@ -75,8 +75,8 @@ end subroutine satmedmfvdifq_init !! \section detail_satmedmfvidfq GFS satmedmfvdifq Detailed Algorithm subroutine satmedmfvdifq_run(im,km,ntrac,ntcw,ntrw, & & ntiw,ntke,grav,rd,cp,rv,hvap,hfus,fv,eps,epsm1, & - & dv,du,tdt,rtg,u1,v1,t1,q1,swh,hlw,xmu, & - & garea,zvfun,sigmaf, & + & dv,du,tdt,rtg,u1,v1,t1,q1,usfco,vsfco,icplocn2atm, & + & swh,hlw,xmu,garea,zvfun,sigmaf, & & psk,rbsoil,zorl,u10m,v10m,fm,fh, & & tsea,heat,evap,stress,spd1,kpbl, & & prsi,del,prsl,prslk,phii,phil,delt, & @@ -110,6 +110,7 @@ subroutine satmedmfvdifq_run(im,km,ntrac,ntcw,ntrw, & & tdt(:,:), rtg(:,:,:) real(kind=kind_phys), intent(in) :: & & u1(:,:), v1(:,:), & + & usfco(:), vsfco(:), & & t1(:,:), q1(:,:,:), & & swh(:,:), hlw(:,:), & & xmu(:), garea(:), & @@ -123,9 +124,11 @@ subroutine satmedmfvdifq_run(im,km,ntrac,ntcw,ntrw, & & prsi(:,:), del(:,:), & & prsl(:,:), prslk(:,:), & & phii(:,:), phil(:,:) - real(kind=kind_phys), intent(inout), dimension(:,:,:) :: dtend + real(kind=kind_phys), intent(inout), dimension(:,:,:), optional ::& + & dtend integer, intent(in) :: dtidx(:,:), index_of_temperature, & & index_of_x_wind, index_of_y_wind, index_of_process_pbl + integer, intent(in) :: icplocn2atm real(kind=kind_phys), intent(out) :: & & dusfc(:), dvsfc(:), & & dtsfc(:), dqsfc(:), & @@ -142,6 +145,7 @@ subroutine satmedmfvdifq_run(im,km,ntrac,ntcw,ntrw, & !---------------------------------------------------------------------- !*** !*** local variables + real(kind=kind_phys) spd1_m !*** integer i,is,k,n,ndt,km1,kmpbl,kmscu,ntrac1,idtend integer kps,kbx,kmx @@ -443,7 +447,9 @@ subroutine satmedmfvdifq_run(im,km,ntrac,ntcw,ntrw, & endif enddo ! -! compute a function for green vegetation fraction and surface roughness +!> - Compute a function for green vegetation fraction and surface roughness. +!! Entrainment rate in updraft is a function of vegetation fraction and surface +!! roughness length ! do i = 1,im tem = (sigmaf(i) - vegflo) / (vegfup - vegflo) @@ -745,7 +751,7 @@ subroutine satmedmfvdifq_run(im,km,ntrac,ntcw,ntrw, & endif enddo ! -! compute mean tke within pbl +!> - Compute mean tke within pbl ! do i = 1, im sumx(i) = 0. @@ -766,8 +772,8 @@ subroutine satmedmfvdifq_run(im,km,ntrac,ntcw,ntrw, & endif enddo ! -! compute wind shear term as a sink term for updraft and downdraft -! velocity +!> - Compute wind shear term as a sink term for updraft and downdraft +!! velocity ! kps = max(kmpbl, kmscu) do k = 2, kps @@ -2374,8 +2380,14 @@ subroutine satmedmfvdifq_run(im,km,ntrac,ntcw,ntrw, & enddo enddo do i = 1,im - dusfc(i) = -1.*rho_a(i)*stress(i)*u1(i,1)/spd1(i) - dvsfc(i) = -1.*rho_a(i)*stress(i)*v1(i,1)/spd1(i) + if(icplocn2atm == 0) then + dusfc(i) = -1.*rho_a(i)*stress(i)*u1(i,1)/spd1(i) + dvsfc(i) = -1.*rho_a(i)*stress(i)*v1(i,1)/spd1(i) + else if (icplocn2atm ==1) then + spd1_m=sqrt( (u1(i,1)-usfco(i))**2+(v1(i,1)-vsfco(i))**2 ) + dusfc(i) = -1.*rho_a(i)*stress(i)*(u1(i,1)-usfco(i))/spd1_m + dvsfc(i) = -1.*rho_a(i)*stress(i)*(v1(i,1)-vsfco(i))/spd1_m + endif enddo ! if(ldiag3d .and. .not. gen_tend) then diff --git a/physics/satmedmfvdifq.meta b/physics/PBL/SATMEDMF/satmedmfvdifq.meta similarity index 96% rename from physics/satmedmfvdifq.meta rename to physics/PBL/SATMEDMF/satmedmfvdifq.meta index b6680dccb..cdbfa67b7 100644 --- a/physics/satmedmfvdifq.meta +++ b/physics/PBL/SATMEDMF/satmedmfvdifq.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = satmedmfvdifq type = scheme - dependencies = funcphys.f90,machine.F,mfpbltq.f,mfscuq.f,tridi.f + dependencies = ../../tools/funcphys.f90,../../hooks/machine.F,../mfpbltq.f,mfscuq.f,../tridi.f ######################################################################## [ccpp-arg-table] @@ -217,6 +217,29 @@ type = real kind = kind_phys intent = in +[usfco] + standard_name = x_ocean_current + long_name = zonal current at ocean surface + units = m s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in +[vsfco] + standard_name = y_ocean_current + long_name = meridional current at ocean surface + units = m s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in +[icplocn2atm] + standard_name = control_for_air_sea_flux_computation_over_water + long_name = air-sea flux option + units = 1 + dimensions = () + type = integer + intent = in [t1] standard_name = air_temperature long_name = layer mean air temperature @@ -602,7 +625,8 @@ dimensions = (horizontal_loop_extent,vertical_layer_dimension,cumulative_change_of_state_variables_outer_index_max) type = real kind = kind_phys - intent = in + intent = inout + optional = True [dtidx] standard_name = cumulative_change_of_state_variables_outer_index long_name = index of state-variable and process in last dimension of diagnostic tendencies array AKA cumulative_change_index diff --git a/physics/moninshoc.f b/physics/PBL/SHOC/moninshoc.f similarity index 99% rename from physics/moninshoc.f rename to physics/PBL/SHOC/moninshoc.f index eb6cbd002..994b78bf6 100644 --- a/physics/moninshoc.f +++ b/physics/PBL/SHOC/moninshoc.f @@ -78,7 +78,8 @@ subroutine moninshoc_run (im,km,ntrac,ntcw,ncnd,dv,du,tau,rtg, & tau real(kind=kind_phys), dimension(:,:,:), intent(inout) :: rtg - real(kind=kind_phys), dimension(:,:,:), intent(inout) :: dtend + real(kind=kind_phys), dimension(:,:,:), intent(inout), optional ::& + & dtend integer, dimension(:,:), intent(in) :: dtidx integer, intent(in) :: index_of_temperature, index_of_x_wind, & index_of_y_wind, index_of_process_pbl, ntqv diff --git a/physics/moninshoc.meta b/physics/PBL/SHOC/moninshoc.meta similarity index 99% rename from physics/moninshoc.meta rename to physics/PBL/SHOC/moninshoc.meta index dca5736f5..37e090943 100644 --- a/physics/moninshoc.meta +++ b/physics/PBL/SHOC/moninshoc.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = moninshoc type = scheme - dependencies = funcphys.f90,machine.F,mfpbl.f,tridi.f + dependencies = ../../tools/funcphys.f90,../../hooks/machine.F,../mfpbl.f,../tridi.f ######################################################################## [ccpp-arg-table] @@ -456,7 +456,8 @@ dimensions = (horizontal_loop_extent,vertical_layer_dimension,cumulative_change_of_state_variables_outer_index_max) type = real kind = kind_phys - intent = in + intent = inout + optional = True [dtidx] standard_name = cumulative_change_of_state_variables_outer_index long_name = index of state-variable and process in last dimension of diagnostic tendencies array AKA cumulative_change_index diff --git a/physics/shoc.F90 b/physics/PBL/SHOC/shoc.F90 similarity index 99% rename from physics/shoc.F90 rename to physics/PBL/SHOC/shoc.F90 index 797be6aec..9afe3b725 100644 --- a/physics/shoc.F90 +++ b/physics/PBL/SHOC/shoc.F90 @@ -52,7 +52,8 @@ subroutine shoc_run (nx, nzm, tcr, tcrf, con_cp, con_g, con_hvap, con_hfus, con_ real(kind=kind_phys), intent(in), dimension(:,:) :: prsl, delp, phil, u, v, omega, rhc, prnum real(kind=kind_phys), intent(in), dimension(:,:) :: phii ! - real(kind=kind_phys), intent(inout), dimension(:,:) :: gt0, cld_sgs, tke, tkh, wthv_sec + real(kind=kind_phys), intent(inout), dimension(:,:) :: gt0, tke, tkh, wthv_sec + real(kind=kind_phys), intent(inout), dimension(:,:), optional :: cld_sgs real(kind=kind_phys), intent(inout), dimension(:,:,:) :: gq0 character(len=*), intent(out) :: errmsg diff --git a/physics/shoc.meta b/physics/PBL/SHOC/shoc.meta similarity index 99% rename from physics/shoc.meta rename to physics/PBL/SHOC/shoc.meta index 984c6aec5..7da3eda0b 100644 --- a/physics/shoc.meta +++ b/physics/PBL/SHOC/shoc.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = shoc type = scheme - dependencies = funcphys.f90,machine.F + dependencies = ../../tools/funcphys.f90,../../hooks/machine.F ######################################################################## [ccpp-arg-table] @@ -367,6 +367,7 @@ type = real kind = kind_phys intent = inout + optional = True [tke] standard_name = turbulent_kinetic_energy_convective_transport_tracer long_name = turbulent kinetic energy in the convectively transported tracer array diff --git a/physics/ysuvdif.F90 b/physics/PBL/YSU/ysuvdif.F90 similarity index 99% rename from physics/ysuvdif.F90 rename to physics/PBL/YSU/ysuvdif.F90 index bfae11d39..ad28256c0 100644 --- a/physics/ysuvdif.F90 +++ b/physics/PBL/YSU/ysuvdif.F90 @@ -101,7 +101,7 @@ subroutine ysuvdif_run(im,km,ux,vx,tx,qx,p2d,p2di,pi2d,karman, & intent(inout) :: utnp,vtnp,ttnp real(kind=kind_phys), dimension( :,:,: ) , & intent(inout) :: qtnp - real(kind=kind_phys), optional, intent(inout) :: dtend(:,:,:) + real(kind=kind_phys), optional, intent(inout), optional :: dtend(:,:,:) integer, intent(in) :: dtidx(:,:), ntqv, index_of_temperature, & index_of_x_wind, index_of_y_wind, index_of_process_pbl ! diff --git a/physics/ysuvdif.meta b/physics/PBL/YSU/ysuvdif.meta similarity index 99% rename from physics/ysuvdif.meta rename to physics/PBL/YSU/ysuvdif.meta index 0007197bd..0e2eb4ccd 100644 --- a/physics/ysuvdif.meta +++ b/physics/PBL/YSU/ysuvdif.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = ysuvdif type = scheme - dependencies = machine.F + dependencies = ../../hooks/machine.F ######################################################################## [ccpp-arg-table] @@ -466,7 +466,8 @@ dimensions = (horizontal_loop_extent,vertical_layer_dimension,cumulative_change_of_state_variables_outer_index_max) type = real kind = kind_phys - intent = in + intent = inout + optional = True [dtidx] standard_name = cumulative_change_of_state_variables_outer_index long_name = index of state-variable and process in last dimension of diagnostic tendencies array AKA cumulative_change_index diff --git a/physics/mfpbl.f b/physics/PBL/mfpbl.f similarity index 100% rename from physics/mfpbl.f rename to physics/PBL/mfpbl.f diff --git a/physics/mfpblt.f b/physics/PBL/mfpblt.f similarity index 100% rename from physics/mfpblt.f rename to physics/PBL/mfpblt.f diff --git a/physics/mfpbltq.f b/physics/PBL/mfpbltq.f similarity index 100% rename from physics/mfpbltq.f rename to physics/PBL/mfpbltq.f diff --git a/physics/shinhongvdif.F90 b/physics/PBL/saYSU/shinhongvdif.F90 similarity index 100% rename from physics/shinhongvdif.F90 rename to physics/PBL/saYSU/shinhongvdif.F90 diff --git a/physics/shinhongvdif.meta b/physics/PBL/saYSU/shinhongvdif.meta similarity index 99% rename from physics/shinhongvdif.meta rename to physics/PBL/saYSU/shinhongvdif.meta index dcd3b96cd..3e919d78f 100644 --- a/physics/shinhongvdif.meta +++ b/physics/PBL/saYSU/shinhongvdif.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = shinhongvdif type = scheme - dependencies = machine.F + dependencies = ../../hooks/machine.F ######################################################################## [ccpp-arg-table] @@ -444,6 +444,7 @@ type = real kind = kind_phys intent = inout + optional = True [dtidx] standard_name = cumulative_change_of_state_variables_outer_index long_name = index of state-variable and process in last dimension of diagnostic tendencies array AKA cumulative_change_index diff --git a/physics/tridi.f b/physics/PBL/tridi.f similarity index 100% rename from physics/tridi.f rename to physics/PBL/tridi.f diff --git a/physics/iounitdef.f b/physics/Radiation/RRTMG/iounitdef.f similarity index 100% rename from physics/iounitdef.f rename to physics/Radiation/RRTMG/iounitdef.f diff --git a/physics/module_bfmicrophysics.f b/physics/Radiation/RRTMG/module_bfmicrophysics.f similarity index 100% rename from physics/module_bfmicrophysics.f rename to physics/Radiation/RRTMG/module_bfmicrophysics.f diff --git a/physics/rad_sw_pre.F90 b/physics/Radiation/RRTMG/rad_sw_pre.F90 similarity index 100% rename from physics/rad_sw_pre.F90 rename to physics/Radiation/RRTMG/rad_sw_pre.F90 diff --git a/physics/rad_sw_pre.meta b/physics/Radiation/RRTMG/rad_sw_pre.meta similarity index 96% rename from physics/rad_sw_pre.meta rename to physics/Radiation/RRTMG/rad_sw_pre.meta index ccbdbf74b..9d14c6ffc 100644 --- a/physics/rad_sw_pre.meta +++ b/physics/Radiation/RRTMG/rad_sw_pre.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = rad_sw_pre type = scheme - dependencies = iounitdef.f,machine.F + dependencies = iounitdef.f,../../hooks/machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/radcons.f90 b/physics/Radiation/RRTMG/radcons.f90 similarity index 100% rename from physics/radcons.f90 rename to physics/Radiation/RRTMG/radcons.f90 diff --git a/physics/radlw_datatb.f b/physics/Radiation/RRTMG/radlw_datatb.f similarity index 100% rename from physics/radlw_datatb.f rename to physics/Radiation/RRTMG/radlw_datatb.f diff --git a/physics/radlw_main.F90 b/physics/Radiation/RRTMG/radlw_main.F90 similarity index 99% rename from physics/radlw_main.F90 rename to physics/Radiation/RRTMG/radlw_main.F90 index 7bc1ea80c..cdf5c69ef 100644 --- a/physics/radlw_main.F90 +++ b/physics/Radiation/RRTMG/radlw_main.F90 @@ -609,7 +609,7 @@ subroutine rrtmg_lw_run & integer, intent(in) :: npts, nlay, nlp1, ilwcliq, ilwcice, & isubclw, iovr, iovr_dcorr, iovr_exp, iovr_exprand, iovr_rand,& iovr_maxrand, iovr_max - integer, intent(in) :: icseed(npts) + integer, intent(in), optional :: icseed(npts) logical, intent(in) :: lprnt, inc_minor_gas diff --git a/physics/radlw_main.meta b/physics/Radiation/RRTMG/radlw_main.meta similarity index 99% rename from physics/radlw_main.meta rename to physics/Radiation/RRTMG/radlw_main.meta index 3dccc97b3..0b0819042 100644 --- a/physics/radlw_main.meta +++ b/physics/Radiation/RRTMG/radlw_main.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = rrtmg_lw type = scheme - dependencies = machine.F,mersenne_twister.f,physcons.F90,radlw_datatb.f,radlw_param.f + dependencies = ../../hooks/machine.F,../mersenne_twister.f,../../hooks/physcons.F90,radlw_datatb.f,radlw_param.f ######################################################################## [ccpp-arg-table] @@ -134,6 +134,7 @@ dimensions = (horizontal_loop_extent) type = integer intent = in + optional = True [aeraod] standard_name = aerosol_optical_depth_for_longwave_bands_01_16 long_name = aerosol optical depth for longwave bands 01-16 diff --git a/physics/radlw_param.f b/physics/Radiation/RRTMG/radlw_param.f similarity index 100% rename from physics/radlw_param.f rename to physics/Radiation/RRTMG/radlw_param.f diff --git a/physics/radlw_param.meta b/physics/Radiation/RRTMG/radlw_param.meta similarity index 100% rename from physics/radlw_param.meta rename to physics/Radiation/RRTMG/radlw_param.meta diff --git a/physics/radsw_datatb.f b/physics/Radiation/RRTMG/radsw_datatb.f similarity index 100% rename from physics/radsw_datatb.f rename to physics/Radiation/RRTMG/radsw_datatb.f diff --git a/physics/radsw_main.F90 b/physics/Radiation/RRTMG/radsw_main.F90 similarity index 99% rename from physics/radsw_main.F90 rename to physics/Radiation/RRTMG/radsw_main.F90 index fe63963f5..42ee92213 100644 --- a/physics/radsw_main.F90 +++ b/physics/Radiation/RRTMG/radsw_main.F90 @@ -689,7 +689,8 @@ subroutine rrtmg_sw_run & isubcsw, iovr, iswmode, iovr_dcorr, iovr_exp, iovr_exprand, & iovr_rand, iovr_maxrand, iovr_max - integer, dimension(:), intent(in) :: idxday, icseed + integer, dimension(:), intent(in) :: idxday + integer, dimension(:), intent(in), optional :: icseed logical, intent(in) :: lprnt, lsswr, inc_minor_gas, top_at_1 diff --git a/physics/radsw_main.meta b/physics/Radiation/RRTMG/radsw_main.meta similarity index 99% rename from physics/radsw_main.meta rename to physics/Radiation/RRTMG/radsw_main.meta index 1edb6fcac..00a93e438 100644 --- a/physics/radsw_main.meta +++ b/physics/Radiation/RRTMG/radsw_main.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = rrtmg_sw type = scheme - dependencies = machine.F,mersenne_twister.f,physcons.F90,radsw_datatb.f,radsw_param.f + dependencies = ../../hooks/machine.F,../mersenne_twister.f,../../hooks/physcons.F90,radsw_datatb.f,radsw_param.f ######################################################################## [ccpp-arg-table] @@ -134,6 +134,7 @@ dimensions = (horizontal_loop_extent) type = integer intent = in + optional = True [aeraod] standard_name = aerosol_optical_depth_for_shortwave_bands_01_16 long_name = aerosol optical depth for shortwave bands 01-16 diff --git a/physics/radsw_param.f b/physics/Radiation/RRTMG/radsw_param.f similarity index 100% rename from physics/radsw_param.f rename to physics/Radiation/RRTMG/radsw_param.f diff --git a/physics/radsw_param.meta b/physics/Radiation/RRTMG/radsw_param.meta similarity index 100% rename from physics/radsw_param.meta rename to physics/Radiation/RRTMG/radsw_param.meta diff --git a/physics/rrtmg_lw_cloud_optics.F90 b/physics/Radiation/RRTMG/rrtmg_lw_cloud_optics.F90 similarity index 100% rename from physics/rrtmg_lw_cloud_optics.F90 rename to physics/Radiation/RRTMG/rrtmg_lw_cloud_optics.F90 diff --git a/physics/rrtmg_lw_post.F90 b/physics/Radiation/RRTMG/rrtmg_lw_post.F90 similarity index 100% rename from physics/rrtmg_lw_post.F90 rename to physics/Radiation/RRTMG/rrtmg_lw_post.F90 diff --git a/physics/rrtmg_lw_post.meta b/physics/Radiation/RRTMG/rrtmg_lw_post.meta similarity index 99% rename from physics/rrtmg_lw_post.meta rename to physics/Radiation/RRTMG/rrtmg_lw_post.meta index 7f219c24f..6ed7c2365 100644 --- a/physics/rrtmg_lw_post.meta +++ b/physics/Radiation/RRTMG/rrtmg_lw_post.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = rrtmg_lw_post type = scheme - dependencies = machine.F + dependencies = ../../hooks/machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/rrtmg_sw_cloud_optics.F90 b/physics/Radiation/RRTMG/rrtmg_sw_cloud_optics.F90 similarity index 100% rename from physics/rrtmg_sw_cloud_optics.F90 rename to physics/Radiation/RRTMG/rrtmg_sw_cloud_optics.F90 diff --git a/physics/rrtmg_sw_post.F90 b/physics/Radiation/RRTMG/rrtmg_sw_post.F90 similarity index 100% rename from physics/rrtmg_sw_post.F90 rename to physics/Radiation/RRTMG/rrtmg_sw_post.F90 diff --git a/physics/rrtmg_sw_post.meta b/physics/Radiation/RRTMG/rrtmg_sw_post.meta similarity index 99% rename from physics/rrtmg_sw_post.meta rename to physics/Radiation/RRTMG/rrtmg_sw_post.meta index 6a9f4efb5..9914051ce 100644 --- a/physics/rrtmg_sw_post.meta +++ b/physics/Radiation/RRTMG/rrtmg_sw_post.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = rrtmg_sw_post type = scheme - dependencies = machine.F,radsw_param.f + dependencies = ../../hooks/machine.F,radsw_param.f ######################################################################## [ccpp-arg-table] diff --git a/physics/rrtmgp_aerosol_optics.F90 b/physics/Radiation/RRTMGP/rrtmgp_aerosol_optics.F90 similarity index 96% rename from physics/rrtmgp_aerosol_optics.F90 rename to physics/Radiation/RRTMGP/rrtmgp_aerosol_optics.F90 index 9a92ea98a..7e78c19a3 100644 --- a/physics/rrtmgp_aerosol_optics.F90 +++ b/physics/Radiation/RRTMGP/rrtmgp_aerosol_optics.F90 @@ -50,16 +50,17 @@ subroutine rrtmgp_aerosol_optics_run(doSWrad, doLWrad, nCol, nLev, nDay, idxday, lon, & ! Longitude lat, & ! Latitude lsmask ! Land/sea/sea-ice mask - real(kind_phys), dimension(:,:),intent(in) :: & + real(kind_phys), dimension(:,:),intent(in), optional :: & p_lay, & ! Pressure @ layer-centers (Pa) tv_lay, & ! Virtual-temperature @ layer-centers (K) - relhum, & ! Relative-humidity @ layer-centers + relhum ! Relative-humidity @ layer-centers + real(kind_phys), dimension(:,:),intent(in) :: & p_lk ! Exner function @ layer-centers (1) real(kind_phys), dimension(:, :,:),intent(in) :: & tracer ! trace gas concentrations real(kind_phys), dimension(:, :,:),intent(in) :: & aerfld ! aerosol input concentrations - real(kind_phys), dimension(:,:),intent(in) :: & + real(kind_phys), dimension(:,:),intent(in), optional :: & p_lev ! Pressure @ layer-interfaces (Pa) real (kind=kind_phys), dimension(:,:), intent(out) :: & ext550 ! 3d optical extinction for total aerosol species diff --git a/physics/rrtmgp_aerosol_optics.meta b/physics/Radiation/RRTMGP/rrtmgp_aerosol_optics.meta similarity index 97% rename from physics/rrtmgp_aerosol_optics.meta rename to physics/Radiation/RRTMGP/rrtmgp_aerosol_optics.meta index cc9eb1cc2..4212adcc6 100644 --- a/physics/rrtmgp_aerosol_optics.meta +++ b/physics/Radiation/RRTMGP/rrtmgp_aerosol_optics.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = rrtmgp_aerosol_optics type = scheme - dependencies = iounitdef.f,machine.F,radiation_aerosols.f,radiation_tools.F90 + dependencies = ../../hooks/machine.F,../radiation_aerosols.f,../radiation_tools.F90 ######################################################################## [ccpp-arg-table] @@ -88,6 +88,7 @@ type = real kind = kind_phys intent = in + optional = True [p_lay] standard_name = air_pressure_at_layer_for_RRTMGP long_name = air pressure at vertical layer for radiation calculation @@ -96,6 +97,7 @@ type = real kind = kind_phys intent = in + optional = True [p_lk] standard_name = dimensionless_exner_function long_name = dimensionless Exner function at model layer centers @@ -112,6 +114,7 @@ type = real kind = kind_phys intent = in + optional = True [relhum] standard_name = relative_humidity long_name = layer relative humidity @@ -120,6 +123,7 @@ type = real kind = kind_phys intent = in + optional = True [lsmask] standard_name = area_type long_name = landmask: sea/land/ice=0/1/2 diff --git a/physics/rrtmgp_lw_cloud_optics.F90 b/physics/Radiation/RRTMGP/rrtmgp_lw_cloud_optics.F90 similarity index 99% rename from physics/rrtmgp_lw_cloud_optics.F90 rename to physics/Radiation/RRTMGP/rrtmgp_lw_cloud_optics.F90 index 9915c0040..059086a97 100644 --- a/physics/rrtmgp_lw_cloud_optics.F90 +++ b/physics/Radiation/RRTMGP/rrtmgp_lw_cloud_optics.F90 @@ -16,7 +16,7 @@ module rrtmgp_lw_cloud_optics use radiation_tools, only: check_error_msg use netcdf #ifdef MPI - use mpi + use mpi_f08 #endif implicit none @@ -89,8 +89,9 @@ subroutine rrtmgp_lw_cloud_optics_init(rrtmgp_root_dir, rrtmgp_lw_file_clouds, doGP_cldoptics_LUT ! Use RRTMGP cloud-optics: LUTs? integer, intent(inout) :: & nrghice ! Number of ice-roughness categories + type(MPI_Comm), intent(in) :: & + mpicomm ! MPI communicator integer, intent(in) :: & - mpicomm, & ! MPI communicator mpirank, & ! Current MPI rank mpiroot ! Master MPI rank diff --git a/physics/rrtmgp_lw_gas_optics.F90 b/physics/Radiation/RRTMGP/rrtmgp_lw_gas_optics.F90 similarity index 99% rename from physics/rrtmgp_lw_gas_optics.F90 rename to physics/Radiation/RRTMGP/rrtmgp_lw_gas_optics.F90 index 8cd38f210..7cf80e3f3 100644 --- a/physics/rrtmgp_lw_gas_optics.F90 +++ b/physics/Radiation/RRTMGP/rrtmgp_lw_gas_optics.F90 @@ -15,7 +15,7 @@ module rrtmgp_lw_gas_optics use radiation_tools, only: check_error_msg use netcdf #ifdef MPI - use mpi + use mpi_f08 #endif implicit none @@ -87,8 +87,9 @@ subroutine rrtmgp_lw_gas_optics_init(rrtmgp_root_dir, rrtmgp_lw_file_gas, rrtmgp_lw_file_gas ! RRTMGP file containing K-distribution data character(len=*), dimension(:), intent(in) :: & active_gases_array ! List of active gases from namelist as array + type(MPI_Comm),intent(in) :: & + mpicomm ! MPI communicator integer,intent(in) :: & - mpicomm, & ! MPI communicator mpirank, & ! Current MPI rank mpiroot ! Master MPI rank diff --git a/physics/rrtmgp_lw_main.F90 b/physics/Radiation/RRTMGP/rrtmgp_lw_main.F90 similarity index 98% rename from physics/rrtmgp_lw_main.F90 rename to physics/Radiation/RRTMGP/rrtmgp_lw_main.F90 index 67f7f749a..82a5e274a 100644 --- a/physics/rrtmgp_lw_main.F90 +++ b/physics/Radiation/RRTMGP/rrtmgp_lw_main.F90 @@ -7,6 +7,7 @@ !! ! ########################################################################################### module rrtmgp_lw_main + use mpi_f08 use machine, only: kind_phys, kind_dbl_prec use mo_optical_props, only: ty_optical_props_1scl, ty_optical_props_2str use mo_cloud_optics, only: ty_cloud_optics @@ -19,7 +20,6 @@ module rrtmgp_lw_main use rrtmgp_lw_gas_optics, only: lw_gas_props,rrtmgp_lw_gas_optics_init use rrtmgp_lw_cloud_optics, only: lw_cloud_props, rrtmgp_lw_cloud_optics_init, abssnow0, & abssnow1, absrain - use module_radiation_gases, only: NF_VGAS, getgases, getozn use GFS_rrtmgp_pre, only: iStr_h2o, iStr_co2, iStr_o3, iStr_n2o, iStr_ch4, & iStr_o2, iStr_ccl4, iStr_cfc11, iStr_cfc12, iStr_cfc22, & eps, oneminus, ftiny @@ -52,7 +52,7 @@ subroutine rrtmgp_lw_main_init(rrtmgp_root_dir, rrtmgp_lw_file_gas, rrtmgp_lw_fi ! clouds optical properties rrtmgp_lw_file_gas ! RRTMGP file containing coefficients used to compute ! gaseous optical properties - character(len=*), dimension(:), intent(in) :: & + character(len=*), dimension(:), intent(in), optional :: & active_gases_array ! List of active gases from namelist as array) logical, intent(in) :: & doGP_cldoptics_PADE, & ! Use RRTMGP cloud-optics: PADE approximation? @@ -61,8 +61,9 @@ subroutine rrtmgp_lw_main_init(rrtmgp_root_dir, rrtmgp_lw_file_gas, rrtmgp_lw_fi doGP_sgs_cnv ! Flag to include sgs convective clouds integer, intent(inout) :: & nrghice ! Number of ice-roughness categories + type(MPI_Comm),intent(in) :: & + mpicomm ! MPI communicator integer,intent(in) :: & - mpicomm, & ! MPI communicator mpirank, & ! Current MPI rank mpiroot, & ! Master MPI rank rrtmgp_phys_blksz, & ! Number of horizontal points to process at once. @@ -136,12 +137,12 @@ subroutine rrtmgp_lw_main_run(doLWrad, doLWclrsky, top_at_1, doGP_lwscat, iovr_exp, & ! Flag for exponential cloud overlap method iovr_exprand, & ! Flag for exponential-random cloud overlap method isubc_lw ! Flag for cloud-seeding (rng) for cloud-sampling - integer,intent(in),dimension(:) :: & + integer,intent(in),dimension(:), optional :: & icseed_lw ! Seed for random number generation for longwave radiation real(kind_phys), dimension(:), intent(in) :: & semis, & ! Surface-emissivity (1) tsfg ! Skin temperature (K) - real(kind_phys), dimension(:,:), intent(in) :: & + real(kind_phys), dimension(:,:), intent(in), optional :: & p_lay, & ! Pressure @ model layer-centers (Pa) t_lay, & ! Temperature (K) p_lev, & ! Pressure @ model layer-interfaces (Pa) @@ -151,7 +152,8 @@ subroutine rrtmgp_lw_main_run(doLWrad, doLWclrsky, top_at_1, doGP_lwscat, vmr_o3, & ! Molar-mixing ratio ozone vmr_ch4, & ! Molar-mixing ratio methane vmr_n2o, & ! Molar-mixing ratio nitrous oxide - vmr_co2, & ! Molar-mixing ratio carbon dioxide + vmr_co2 ! Molar-mixing ratio carbon dioxide + real(kind_phys), dimension(:,:), intent(in) :: & cld_frac, & ! Cloud-fraction for stratiform clouds cld_lwp, & ! Water path for stratiform liquid cloud-particles cld_reliq, & ! Effective radius for stratiform liquid cloud-particles @@ -160,7 +162,8 @@ subroutine rrtmgp_lw_main_run(doLWrad, doLWclrsky, top_at_1, doGP_lwscat, cld_swp, & ! Water path for snow hydrometeors cld_resnow, & ! Effective radius for snow hydrometeors cld_rwp, & ! Water path for rain hydrometeors - cld_rerain, & ! Effective radius for rain hydrometeors + cld_rerain ! Effective radius for rain hydrometeors + real(kind_phys), dimension(:,:), intent(in), optional :: & precip_frac, & ! Precipitation fraction (not active, currently precipitation optics uses cloud-fraction) cld_cnv_lwp, & ! Water path for convective liquid cloud-particles cld_cnv_reliq, & ! Effective radius for convective liquid cloud-particles @@ -175,11 +178,11 @@ subroutine rrtmgp_lw_main_run(doLWrad, doLWclrsky, top_at_1, doGP_lwscat, aerlw_tau, & ! Aerosol optical depth aerlw_ssa, & ! Aerosol single scattering albedo aerlw_g ! Aerosol asymmetry paramter - character(len=*), dimension(:), intent(in) :: & + character(len=*), dimension(:), intent(in), optional :: & active_gases_array ! List of active gases from namelist as array ! Outputs - real(kind_phys), dimension(:,:), intent(inout) :: & + real(kind_phys), dimension(:,:), intent(inout), optional :: & fluxlwUP_jac, & ! Jacobian of upwelling LW surface radiation (W/m2/K) fluxlwUP_allsky, & ! All-sky flux (W/m2) fluxlwDOWN_allsky, & ! All-sky flux (W/m2) diff --git a/physics/rrtmgp_lw_main.meta b/physics/Radiation/RRTMGP/rrtmgp_lw_main.meta similarity index 95% rename from physics/rrtmgp_lw_main.meta rename to physics/Radiation/RRTMGP/rrtmgp_lw_main.meta index fd96eb14b..ac1da1490 100644 --- a/physics/rrtmgp_lw_main.meta +++ b/physics/Radiation/RRTMGP/rrtmgp_lw_main.meta @@ -1,12 +1,13 @@ [ccpp-table-properties] name = rrtmgp_lw_main type = scheme - dependencies = machine.F,radiation_tools.F90,GFS_rrtmgp_pre.F90,rte-rrtmgp/rrtmgp/mo_gas_optics_rrtmgp.F90 + dependencies = ../../hooks/machine.F,../radiation_tools.F90,../mersenne_twister.f + dependencies = rte-rrtmgp/rrtmgp/mo_gas_optics_rrtmgp.F90,rte-rrtmgp/extensions/mo_fluxes_byband.F90 dependencies = rte-rrtmgp/rte/mo_rte_kind.F90,rte-rrtmgp/rrtmgp/mo_gas_concentrations.F90,rte-rrtmgp/rte/mo_optical_props.F90 dependencies = rte-rrtmgp/rte/mo_source_functions.F90,rte-rrtmgp/rte/mo_rte_lw.F90,rte-rrtmgp/rte/mo_fluxes.F90 dependencies = rte-rrtmgp/rte/kernels/mo_fluxes_broadband_kernels.F90, rte-rrtmgp/rte/kernels/mo_rte_solver_kernels.F90 - dependencies = mersenne_twister.f,rrtmgp_sampling.F90,rte-rrtmgp/extensions/mo_fluxes_byband.F90 - dependencies = rrtmgp_lw_gas_optics.F90, rrtmgp_lw_cloud_optics.F90 + dependencies = rrtmgp_lw_gas_optics.F90, rrtmgp_lw_cloud_optics.F90,rrtmgp_sampling.F90 + dependencies = ../../Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_pre.F90 ######################################################################## [ccpp-arg-table] @@ -90,7 +91,7 @@ long_name = MPI communicator units = index dimensions = () - type = integer + type = MPI_Comm intent = in [rrtmgp_phys_blksz] standard_name = number_of_columns_per_RRTMGP_LW_block @@ -114,6 +115,7 @@ type = character kind = len=* intent = in + optional = True [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP @@ -150,7 +152,7 @@ intent = in [top_at_1] standard_name = flag_for_vertical_ordering_in_radiation - long_name = flag for vertical ordering in radiaiton + long_name = flag for vertical ordering in radiation units = flag dimensions = () type = logical @@ -288,6 +290,7 @@ dimensions = (horizontal_loop_extent) type = integer intent = in + optional = True [semis] standard_name = surface_longwave_emissivity long_name = surface lw emissivity in fraction @@ -312,6 +315,7 @@ type = real kind = kind_phys intent = in + optional = True [p_lev] standard_name = air_pressure_at_interface_for_RRTMGP long_name = air pressure at vertical interface for radiation calculation @@ -320,6 +324,7 @@ type = real kind = kind_phys intent = in + optional = True [t_lay] standard_name = air_temperature_at_layer_for_RRTMGP long_name = air temperature at vertical layer for radiation calculation @@ -328,6 +333,7 @@ type = real kind = kind_phys intent = in + optional = True [t_lev] standard_name = air_temperature_at_interface_for_RRTMGP long_name = air temperature at vertical interface for radiation calculation @@ -336,6 +342,7 @@ type = real kind = kind_phys intent = in + optional = True [vmr_o2] standard_name = volume_mixing_ratio_for_o2 long_name = molar mixing ratio of o2 in with respect to dry air @@ -344,6 +351,7 @@ type = real kind = kind_phys intent = in + optional = True [vmr_h2o] standard_name = volume_mixing_ratio_for_h2o long_name = molar mixing ratio of h2o in with respect to dry air @@ -352,6 +360,7 @@ type = real kind = kind_phys intent = in + optional = True [vmr_o3] standard_name = volume_mixing_ratio_for_o3 long_name = molar mixing ratio of o3 in with respect to dry air @@ -360,6 +369,7 @@ type = real kind = kind_phys intent = in + optional = True [vmr_ch4] standard_name = volume_mixing_ratio_for_ch4 long_name = molar mixing ratio of ch4 in with respect to dry air @@ -368,6 +378,7 @@ type = real kind = kind_phys intent = in + optional = True [vmr_n2o] standard_name = volume_mixing_ratio_for_n2o long_name = molar mixing ratio of n2o in with respect to dry air @@ -376,6 +387,7 @@ type = real kind = kind_phys intent = in + optional = True [vmr_co2] standard_name = volume_mixing_ratio_for_co2 long_name = molar mixing ratio of co2 in with respect to dry air @@ -384,6 +396,7 @@ type = real kind = kind_phys intent = in + optional = True [cld_frac] standard_name = total_cloud_fraction long_name = layer total cloud fraction @@ -464,6 +477,7 @@ type = real kind = kind_phys intent = in + optional = True [cld_cnv_lwp] standard_name = convective_cloud_liquid_water_path long_name = layer convective cloud liquid water path @@ -472,6 +486,7 @@ type = real kind = kind_phys intent = in + optional = True [cld_cnv_iwp] standard_name = convective_cloud_ice_water_path long_name = layer convective cloud ice water path @@ -480,6 +495,7 @@ type = real kind = kind_phys intent = in + optional = True [cld_cnv_reliq] standard_name = mean_effective_radius_for_liquid_convective_cloud long_name = mean effective radius for liquid convective cloud @@ -488,6 +504,7 @@ type = real kind = kind_phys intent = in + optional = True [cld_cnv_reice] standard_name = mean_effective_radius_for_ice_convective_cloud long_name = mean effective radius for ice convective cloud @@ -496,6 +513,7 @@ type = real kind = kind_phys intent = in + optional = True [cld_pbl_lwp] standard_name = MYNN_SGS_cloud_liquid_water_path long_name = layer convective cloud liquid water path @@ -504,6 +522,7 @@ type = real kind = kind_phys intent = in + optional = True [cld_pbl_iwp] standard_name = MYNN_SGS_cloud_ice_water_path long_name = layer convective cloud ice water path @@ -512,6 +531,7 @@ type = real kind = kind_phys intent = in + optional = True [cld_pbl_reliq] standard_name = mean_effective_radius_for_liquid_MYNN_SGS_cloud long_name = mean effective radius for liquid MYNN_SGS cloud @@ -520,6 +540,7 @@ type = real kind = kind_phys intent = in + optional = True [cld_pbl_reice] standard_name = mean_effective_radius_for_ice_MYNN_SGS_cloud long_name = mean effective radius for ice MYNN_SGS cloud @@ -528,6 +549,7 @@ type = real kind = kind_phys intent = in + optional = True [cloud_overlap_param] standard_name = cloud_overlap_param long_name = cloud overlap parameter @@ -536,6 +558,7 @@ type = real kind = kind_phys intent = in + optional = True [active_gases_array] standard_name = list_of_active_gases_used_by_RRTMGP long_name = list of active gases used by RRTMGP @@ -544,6 +567,7 @@ type = character kind = len=* intent = in + optional = True [aerlw_tau] standard_name = aerosol_optical_depth_for_longwave_bands_01_16 long_name = aerosol optical depth for longwave bands 01-16 @@ -576,6 +600,7 @@ type = real kind = kind_phys intent = inout + optional = True [fluxlwDOWN_radtime] standard_name = RRTMGP_lw_flux_profile_downward_allsky_on_radiation_timestep long_name = RRTMGP downward longwave all-sky flux profile @@ -584,6 +609,7 @@ type = real kind = kind_phys intent = inout + optional = True [fluxlwUP_allsky] standard_name = RRTMGP_lw_flux_profile_upward_allsky long_name = RRTMGP upward longwave all-sky flux profile @@ -592,6 +618,7 @@ type = real kind = kind_phys intent = inout + optional = True [fluxlwDOWN_allsky] standard_name = RRTMGP_lw_flux_profile_downward_allsky long_name = RRTMGP downward longwave all-sky flux profile @@ -600,6 +627,7 @@ type = real kind = kind_phys intent = inout + optional = True [fluxlwUP_clrsky] standard_name = RRTMGP_lw_flux_profile_upward_clrsky long_name = RRTMGP upward longwave clr-sky flux profile @@ -608,6 +636,7 @@ type = real kind = kind_phys intent = inout + optional = True [fluxlwDOWN_clrsky] standard_name = RRTMGP_lw_flux_profile_downward_clrsky long_name = RRTMGP downward longwave clr-sky flux profile @@ -616,6 +645,7 @@ type = real kind = kind_phys intent = inout + optional = True [fluxlwUP_jac] standard_name = RRTMGP_jacobian_of_lw_flux_upward long_name = RRTMGP Jacobian upward longwave flux profile @@ -624,6 +654,7 @@ type = real kind = kind_phys intent = inout + optional = True [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP @@ -638,4 +669,4 @@ units = 1 dimensions = () type = integer - intent = out \ No newline at end of file + intent = out diff --git a/physics/rrtmgp_sampling.F90 b/physics/Radiation/RRTMGP/rrtmgp_sampling.F90 similarity index 100% rename from physics/rrtmgp_sampling.F90 rename to physics/Radiation/RRTMGP/rrtmgp_sampling.F90 diff --git a/physics/rrtmgp_sw_cloud_optics.F90 b/physics/Radiation/RRTMGP/rrtmgp_sw_cloud_optics.F90 similarity index 99% rename from physics/rrtmgp_sw_cloud_optics.F90 rename to physics/Radiation/RRTMGP/rrtmgp_sw_cloud_optics.F90 index 4293a7be6..552fda295 100644 --- a/physics/rrtmgp_sw_cloud_optics.F90 +++ b/physics/Radiation/RRTMGP/rrtmgp_sw_cloud_optics.F90 @@ -6,7 +6,7 @@ module rrtmgp_sw_cloud_optics use radiation_tools, only: check_error_msg use netcdf #ifdef MPI - use mpi + use mpi_f08 #endif implicit none @@ -79,8 +79,9 @@ subroutine rrtmgp_sw_cloud_optics_init( rrtmgp_root_dir, rrtmgp_sw_file_clouds, doGP_cldoptics_LUT ! Use RRTMGP cloud-optics: LUTs? integer, intent(inout) :: & nrghice ! Number of ice-roughness categories + type(MPI_Comm), intent(in) :: & + mpicomm ! MPI communicator integer, intent(in) :: & - mpicomm, & ! MPI communicator mpirank, & ! Current MPI rank mpiroot ! Master MPI rank diff --git a/physics/rrtmgp_sw_gas_optics.F90 b/physics/Radiation/RRTMGP/rrtmgp_sw_gas_optics.F90 similarity index 99% rename from physics/rrtmgp_sw_gas_optics.F90 rename to physics/Radiation/RRTMGP/rrtmgp_sw_gas_optics.F90 index f62a75e4b..5713d188d 100644 --- a/physics/rrtmgp_sw_gas_optics.F90 +++ b/physics/Radiation/RRTMGP/rrtmgp_sw_gas_optics.F90 @@ -13,7 +13,7 @@ module rrtmgp_sw_gas_optics use radiation_tools, only: check_error_msg use netcdf #ifdef MPI - use mpi + use mpi_f08 #endif implicit none @@ -105,8 +105,9 @@ subroutine rrtmgp_sw_gas_optics_init(rrtmgp_root_dir, rrtmgp_sw_file_gas, rrtmgp_sw_file_gas ! RRTMGP file containing K-distribution data character(len=*), dimension(:), intent(in) :: & active_gases_array ! List of active gases from namelist as array + type(MPI_Comm),intent(in) :: & + mpicomm ! MPI communicator integer,intent(in) :: & - mpicomm, & ! MPI communicator mpirank, & ! Current MPI rank mpiroot ! Master MPI rank diff --git a/physics/rrtmgp_sw_main.F90 b/physics/Radiation/RRTMGP/rrtmgp_sw_main.F90 similarity index 98% rename from physics/rrtmgp_sw_main.F90 rename to physics/Radiation/RRTMGP/rrtmgp_sw_main.F90 index 124532b03..fb0fe2052 100644 --- a/physics/rrtmgp_sw_main.F90 +++ b/physics/Radiation/RRTMGP/rrtmgp_sw_main.F90 @@ -1,6 +1,7 @@ ! ########################################################################################### ! ########################################################################################### module rrtmgp_sw_main + use mpi_f08 use machine, only: kind_phys, kind_dbl_prec use mo_optical_props, only: ty_optical_props_2str use mo_cloud_optics, only: ty_cloud_optics @@ -40,7 +41,7 @@ subroutine rrtmgp_sw_main_init(rrtmgp_root_dir, rrtmgp_sw_file_gas, rrtmgp_sw_fi rrtmgp_root_dir, & ! RTE-RRTMGP root directory rrtmgp_sw_file_clouds, & ! RRTMGP file containing K-distribution data rrtmgp_sw_file_gas ! RRTMGP file containing cloud-optics data - character(len=*), dimension(:), intent(in) :: & + character(len=*), dimension(:), intent(in), optional :: & active_gases_array ! List of active gases from namelist as array) logical, intent(in) :: & doGP_cldoptics_PADE, & ! Use RRTMGP cloud-optics: PADE approximation? @@ -49,8 +50,9 @@ subroutine rrtmgp_sw_main_init(rrtmgp_root_dir, rrtmgp_sw_file_gas, rrtmgp_sw_fi doGP_sgs_cnv ! Flag to include sgs convective clouds integer, intent(inout) :: & nrghice ! Number of ice-roughness categories + type(MPI_Comm),intent(in) :: & + mpicomm ! MPI communicator integer,intent(in) :: & - mpicomm, & ! MPI communicator mpirank, & ! Current MPI rank mpiroot, & ! Master MPI rank rrtmgp_phys_blksz, & ! Number of horizontal points to process at once. @@ -118,7 +120,8 @@ subroutine rrtmgp_sw_main_run(doSWrad, doSWclrsky, top_at_1, doGP_sgs_cnv, doGP_ isubc_sw, & ! iSFC integer,intent(in),dimension(:) :: & - idx, & ! Index array for daytime points + idx ! Index array for daytime points + integer,intent(in),dimension(:), optional :: & icseed_sw ! Seed for random number generation for shortwave radiation real(kind_phys), dimension(:), intent(in) :: & sfc_alb_nir_dir, & ! Surface albedo (direct) @@ -126,7 +129,7 @@ subroutine rrtmgp_sw_main_run(doSWrad, doSWclrsky, top_at_1, doGP_sgs_cnv, doGP_ sfc_alb_uvvis_dir, & ! Surface albedo (direct) sfc_alb_uvvis_dif, & ! Surface albedo (diffuse) coszen ! Cosize of SZA - real(kind_phys), dimension(:,:), intent(in) :: & + real(kind_phys), dimension(:,:), intent(in), optional :: & p_lay, & ! Pressure @ model layer-centers (Pa) t_lay, & ! Temperature (K) p_lev, & ! Pressure @ model layer-interfaces (Pa) @@ -136,7 +139,8 @@ subroutine rrtmgp_sw_main_run(doSWrad, doSWclrsky, top_at_1, doGP_sgs_cnv, doGP_ vmr_o3, & ! Molar-mixing ratio ozone vmr_ch4, & ! Molar-mixing ratio methane vmr_n2o, & ! Molar-mixing ratio nitrous oxide - vmr_co2, & ! Molar-mixing ratio carbon dioxide + vmr_co2 ! Molar-mixing ratio carbon dioxide + real(kind_phys), dimension(:,:), intent(in) :: & cld_frac, & ! Cloud-fraction for stratiform clouds cld_lwp, & ! Water path for stratiform liquid cloud-particles cld_reliq, & ! Effective radius for stratiform liquid cloud-particles @@ -145,7 +149,8 @@ subroutine rrtmgp_sw_main_run(doSWrad, doSWclrsky, top_at_1, doGP_sgs_cnv, doGP_ cld_swp, & ! Water path for snow hydrometeors cld_resnow, & ! Effective radius for snow hydrometeors cld_rwp, & ! Water path for rain hydrometeors - cld_rerain, & ! Effective radius for rain hydrometeors + cld_rerain ! Effective radius for rain hydrometeors + real(kind_phys), dimension(:,:), intent(in), optional :: & precip_frac, & ! Precipitation fraction cld_cnv_lwp, & ! Water path for convective liquid cloud-particles cld_cnv_reliq, & ! Effective radius for convective liquid cloud-particles @@ -160,7 +165,7 @@ subroutine rrtmgp_sw_main_run(doSWrad, doSWclrsky, top_at_1, doGP_sgs_cnv, doGP_ aersw_tau, & ! Aerosol optical depth aersw_ssa, & ! Aerosol single scattering albedo aersw_g ! Aerosol asymmetry paramter - character(len=*), dimension(:), intent(in) :: & + character(len=*), dimension(:), intent(in), optional :: & active_gases_array ! List of active gases from namelist as array real(kind_phys), intent(in) :: & solcon ! Solar constant @@ -172,7 +177,7 @@ subroutine rrtmgp_sw_main_run(doSWrad, doSWclrsky, top_at_1, doGP_sgs_cnv, doGP_ errflg ! CCPP error flag real(kind_phys), dimension(:,:), intent(inout) :: & cldtausw ! Approx 10.mu band layer cloud optical depth - real(kind_phys), dimension(:,:), intent(inout) :: & + real(kind_phys), dimension(:,:), intent(inout), optional :: & fluxswUP_allsky, & ! RRTMGP upward all-sky flux profiles (W/m2) fluxswDOWN_allsky, & ! RRTMGP downward all-sky flux profiles (W/m2) fluxswUP_clrsky, & ! RRTMGP upward clear-sky flux profiles (W/m2) diff --git a/physics/rrtmgp_sw_main.meta b/physics/Radiation/RRTMGP/rrtmgp_sw_main.meta similarity index 96% rename from physics/rrtmgp_sw_main.meta rename to physics/Radiation/RRTMGP/rrtmgp_sw_main.meta index dbb93a5df..9bfda6fa1 100644 --- a/physics/rrtmgp_sw_main.meta +++ b/physics/Radiation/RRTMGP/rrtmgp_sw_main.meta @@ -1,12 +1,13 @@ [ccpp-table-properties] name = rrtmgp_sw_main type = scheme - dependencies = machine.F,radiation_tools.F90,GFS_rrtmgp_pre.F90,rte-rrtmgp/rrtmgp/mo_gas_optics_rrtmgp.F90 + dependencies = ../../hooks/machine.F,../radiation_tools.F90,../mersenne_twister.f + dependencies = rte-rrtmgp/rrtmgp/mo_gas_optics_rrtmgp.F90,rte-rrtmgp/extensions/mo_fluxes_byband.F90 dependencies = rte-rrtmgp/rte/mo_rte_kind.F90,rte-rrtmgp/rrtmgp/mo_gas_concentrations.F90,rte-rrtmgp/rte/mo_optical_props.F90 dependencies = rte-rrtmgp/rte/mo_rte_sw.F90,rte-rrtmgp/rte/mo_fluxes.F90 dependencies = rte-rrtmgp/rte/kernels/mo_fluxes_broadband_kernels.F90, rte-rrtmgp/rte/kernels/mo_rte_solver_kernels.F90 - dependencies = mersenne_twister.f,rrtmgp_sampling.F90,rte-rrtmgp/extensions/mo_fluxes_byband.F90 - dependencies = rrtmgp_sw_gas_optics.F90, rrtmgp_sw_cloud_optics.F90 + dependencies = rrtmgp_sw_gas_optics.F90, rrtmgp_sw_cloud_optics.F90,rrtmgp_sampling.F90 + dependencies = ../../Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_pre.F90 ######################################################################## [ccpp-arg-table] @@ -104,7 +105,7 @@ long_name = MPI communicator units = index dimensions = () - type = integer + type = MPI_Comm intent = in [active_gases_array] standard_name = list_of_active_gases_used_by_RRTMGP @@ -114,6 +115,7 @@ type = character kind = len=* intent = in + optional = True [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP @@ -296,6 +298,7 @@ dimensions = (horizontal_loop_extent) type = integer intent = in + optional = True [p_lay] standard_name = air_pressure_at_layer_for_RRTMGP long_name = air pressure at vertical layer for radiation calculation @@ -304,6 +307,7 @@ type = real kind = kind_phys intent = in + optional = True [p_lev] standard_name = air_pressure_at_interface_for_RRTMGP long_name = air pressure at vertical interface for radiation calculation @@ -312,6 +316,7 @@ type = real kind = kind_phys intent = in + optional = True [t_lay] standard_name = air_temperature_at_layer_for_RRTMGP long_name = air temperature at vertical layer for radiation calculation @@ -320,6 +325,7 @@ type = real kind = kind_phys intent = in + optional = True [t_lev] standard_name = air_temperature_at_interface_for_RRTMGP long_name = air temperature at vertical interface for radiation calculation @@ -328,6 +334,7 @@ type = real kind = kind_phys intent = in + optional = True [vmr_o2] standard_name = volume_mixing_ratio_for_o2 long_name = molar mixing ratio of o2 in with respect to dry air @@ -336,6 +343,7 @@ type = real kind = kind_phys intent = in + optional = True [vmr_h2o] standard_name = volume_mixing_ratio_for_h2o long_name = molar mixing ratio of h2o in with respect to dry air @@ -344,6 +352,7 @@ type = real kind = kind_phys intent = in + optional = True [vmr_o3] standard_name = volume_mixing_ratio_for_o3 long_name = molar mixing ratio of o3 in with respect to dry air @@ -352,6 +361,7 @@ type = real kind = kind_phys intent = in + optional = True [vmr_ch4] standard_name = volume_mixing_ratio_for_ch4 long_name = molar mixing ratio of ch4 in with respect to dry air @@ -360,6 +370,7 @@ type = real kind = kind_phys intent = in + optional = True [vmr_n2o] standard_name = volume_mixing_ratio_for_n2o long_name = molar mixing ratio of n2o in with respect to dry air @@ -368,6 +379,7 @@ type = real kind = kind_phys intent = in + optional = True [vmr_co2] standard_name = volume_mixing_ratio_for_co2 long_name = molar mixing ratio of co2 in with respect to dry air @@ -376,6 +388,7 @@ type = real kind = kind_phys intent = in + optional = True [cld_frac] standard_name = total_cloud_fraction long_name = layer total cloud fraction @@ -456,6 +469,7 @@ type = real kind = kind_phys intent = in + optional = True [cld_cnv_lwp] standard_name = convective_cloud_liquid_water_path long_name = layer convective cloud liquid water path @@ -464,6 +478,7 @@ type = real kind = kind_phys intent = in + optional = True [cld_cnv_iwp] standard_name = convective_cloud_ice_water_path long_name = layer convective cloud ice water path @@ -472,6 +487,7 @@ type = real kind = kind_phys intent = in + optional = True [cld_cnv_reliq] standard_name = mean_effective_radius_for_liquid_convective_cloud long_name = mean effective radius for liquid convective cloud @@ -480,6 +496,7 @@ type = real kind = kind_phys intent = in + optional = True [cld_cnv_reice] standard_name = mean_effective_radius_for_ice_convective_cloud long_name = mean effective radius for ice convective cloud @@ -488,6 +505,7 @@ type = real kind = kind_phys intent = in + optional = True [cld_pbl_lwp] standard_name = MYNN_SGS_cloud_liquid_water_path long_name = layer convective cloud liquid water path @@ -496,6 +514,7 @@ type = real kind = kind_phys intent = in + optional = True [cld_pbl_iwp] standard_name = MYNN_SGS_cloud_ice_water_path long_name = layer convective cloud ice water path @@ -504,6 +523,7 @@ type = real kind = kind_phys intent = in + optional = True [cld_pbl_reliq] standard_name = mean_effective_radius_for_liquid_MYNN_SGS_cloud long_name = mean effective radius for liquid MYNN_SGS cloud @@ -512,6 +532,7 @@ type = real kind = kind_phys intent = in + optional = True [cld_pbl_reice] standard_name = mean_effective_radius_for_ice_MYNN_SGS_cloud long_name = mean effective radius for ice MYNN_SGS cloud @@ -520,6 +541,7 @@ type = real kind = kind_phys intent = in + optional = True [cloud_overlap_param] standard_name = cloud_overlap_param long_name = cloud overlap parameter @@ -528,6 +550,7 @@ type = real kind = kind_phys intent = in + optional = True [sfc_alb_nir_dir] standard_name = surface_albedo_due_to_near_IR_direct long_name = surface albedo due to near IR direct beam @@ -568,6 +591,7 @@ type = character kind = len=* intent = in + optional = True [aersw_tau] standard_name = aerosol_optical_depth_for_shortwave_bands_01_16 long_name = aerosol optical depth for shortwave bands 01-16 @@ -615,6 +639,7 @@ type = real kind = kind_phys intent = inout + optional = True [fluxswDOWN_allsky] standard_name = RRTMGP_sw_flux_profile_downward_allsky long_name = RRTMGP downward shortwave all-sky flux profile @@ -623,6 +648,7 @@ type = real kind = kind_phys intent = inout + optional = True [fluxswUP_clrsky] standard_name = RRTMGP_sw_flux_profile_upward_clrsky long_name = RRTMGP upward shortwave clr-sky flux profile @@ -631,6 +657,7 @@ type = real kind = kind_phys intent = inout + optional = True [fluxswDOWN_clrsky] standard_name = RRTMGP_sw_flux_profile_downward_clrsky long_name = RRTMGP downward shortwave clr-sky flux profile @@ -639,6 +666,7 @@ type = real kind = kind_phys intent = inout + optional = True [cldtausw] standard_name = cloud_optical_depth_layers_at_0p55mu_band long_name = approx .55mu band layer cloud optical depth diff --git a/physics/Radiation/RRTMGP/rte-rrtmgp b/physics/Radiation/RRTMGP/rte-rrtmgp new file mode 160000 index 000000000..74a0e098b --- /dev/null +++ b/physics/Radiation/RRTMGP/rte-rrtmgp @@ -0,0 +1 @@ +Subproject commit 74a0e098b2163425e4b5466c2dfcf8ae26d560a5 diff --git a/physics/mersenne_twister.f b/physics/Radiation/mersenne_twister.f similarity index 100% rename from physics/mersenne_twister.f rename to physics/Radiation/mersenne_twister.f diff --git a/physics/radiation_aerosols.f b/physics/Radiation/radiation_aerosols.f similarity index 100% rename from physics/radiation_aerosols.f rename to physics/Radiation/radiation_aerosols.f diff --git a/physics/radiation_astronomy.f b/physics/Radiation/radiation_astronomy.f similarity index 100% rename from physics/radiation_astronomy.f rename to physics/Radiation/radiation_astronomy.f diff --git a/physics/radiation_cloud_overlap.F90 b/physics/Radiation/radiation_cloud_overlap.F90 similarity index 100% rename from physics/radiation_cloud_overlap.F90 rename to physics/Radiation/radiation_cloud_overlap.F90 diff --git a/physics/radiation_clouds.f b/physics/Radiation/radiation_clouds.f similarity index 99% rename from physics/radiation_clouds.f rename to physics/Radiation/radiation_clouds.f index 111be4019..979405cdb 100644 --- a/physics/radiation_clouds.f +++ b/physics/Radiation/radiation_clouds.f @@ -348,7 +348,7 @@ subroutine radiation_clouds_prop & & iovr_dcorr, iovr_exp, iovr_exprand, idcor, idcor_con, & & idcor_hogan, idcor_oreopoulos, lcrick, lcnorm, & & imfdeepcnv, imfdeepcnv_gf, imfdeepcnv_c3, & - & do_mynnedmf, lgfdlmprad, & + & do_mynnedmf, lgfdlmprad, xr_cnvcld, & & uni_cld, lmfshal, lmfdeep2, cldcov, clouds1, & & effrl, effri, effrr, effrs, effr_in, & & effrl_inout, effri_inout, effrs_inout, & @@ -538,7 +538,8 @@ subroutine radiation_clouds_prop & logical, intent(in) :: uni_cld, lmfshal, lmfdeep2, effr_in, & - & do_mynnedmf, lgfdlmprad, top_at_1, lcrick, lcnorm + & do_mynnedmf, lgfdlmprad, top_at_1, lcrick, lcnorm, & + & xr_cnvcld real (kind=kind_phys), dimension(:,:,:), intent(in) :: ccnd, & & tracer1 @@ -727,7 +728,7 @@ subroutine radiation_clouds_prop & call progcld_thompson_wsm6 (plyr,plvl,tlyr,qlyr,qstl, & ! --- inputs & rhly,tracer1,xlat,xlon,slmsk,dz,delp, & & ntrac-1, ntcw-1,ntiw-1,ntrw-1, & - & ntsw-1,ntgl-1,con_ttp, & + & ntsw-1,ntgl-1,con_ttp,xr_cnvcld, & & IX, NLAY, NLP1, uni_cld, lmfshal, lmfdeep2, & & cldcov(:,1:NLAY), cnvw, effrl_inout, & & effri_inout, effrs_inout, & @@ -801,7 +802,7 @@ subroutine radiation_clouds_prop & call progcld_thompson_wsm6 (plyr,plvl,tlyr,qlyr,qstl, & ! --- inputs & rhly,tracer1,xlat,xlon,slmsk,dz,delp, & & ntrac-1, ntcw-1,ntiw-1,ntrw-1, & - & ntsw-1,ntgl-1,con_ttp, & + & ntsw-1,ntgl-1,con_ttp,xr_cnvcld, & & IX, NLAY, NLP1, uni_cld, lmfshal, lmfdeep2, & & cldcov(:,1:NLAY), cnvw, effrl, effri, effrs, & & lwp_ex, iwp_ex, lwp_fc, iwp_fc, & @@ -1964,7 +1965,7 @@ subroutine progcld_thompson_wsm6 & & ( plyr,plvl,tlyr,qlyr,qstl,rhly,clw, & ! --- inputs: & xlat,xlon,slmsk,dz,delp, & & ntrac,ntcw,ntiw,ntrw,ntsw,ntgl,con_ttp, & - & IX, NLAY, NLP1, & + & xr_cnvcld, IX, NLAY, NLP1, & & uni_cld, lmfshal, lmfdeep2, cldcov, cnvw, & & re_cloud,re_ice,re_snow, & & lwp_ex, iwp_ex, lwp_fc, iwp_fc, & @@ -2051,7 +2052,8 @@ subroutine progcld_thompson_wsm6 & integer, intent(in) :: IX, NLAY, NLP1 integer, intent(in) :: ntrac, ntcw, ntiw, ntrw, ntsw, ntgl - logical, intent(in) :: uni_cld, lmfshal, lmfdeep2, lcnorm + logical, intent(in) :: uni_cld, lmfshal, lmfdeep2, lcnorm, & + & xr_cnvcld real (kind=kind_phys), dimension(:,:), intent(in) :: plvl, plyr, & & tlyr, qlyr, qstl, rhly, cldcov, delp, dz, dzlay, & @@ -2122,23 +2124,43 @@ subroutine progcld_thompson_wsm6 & ! enddo ! endif +!> - Include grid-mean suspended cloud condensate in Xu-Randall cloud fraction +!> if xr_cnvcld is true: + + if(xr_cnvcld)then do k = 1, NLAY do i = 1, IX clwf(i,k) = clw(i,k,ntcw) + clw(i,k,ntiw) + clw(i,k,ntsw) & + clw(i,k,ntrw) + cnvw(i,k) enddo enddo + else + do k = 1, NLAY + do i = 1, IX + clwf(i,k) = clw(i,k,ntcw) + clw(i,k,ntiw) + clw(i,k,ntsw) + & + clw(i,k,ntrw) + enddo + enddo + endif !> - Compute total-cloud liquid/ice condensate path in \f$ g/m^2 \f$. !> The total condensate includes convective condensate. do k = 1, NLAY-1 do i = 1, IX - tem1 = cnvw(i,k)*(1.-tem2d(i,k)) + if(xr_cnvcld)then + tem1 = cnvw(i,k)*(1.-tem2d(i,k)) + else + tem1 = 0. + endif cwp(i,k) = max(0.0, (clw(i,k,ntcw)+tem1) * & gfac * delp(i,k)) if(tem1 > 1.e-12 .and. clw(i,k,ntcw) < 1.e-12) & rew(i,k)=reliq_def - tem2 = cnvw(i,k)*tem2d(i,k) + if(xr_cnvcld)then + tem2 = cnvw(i,k)*tem2d(i,k) + else + tem2 = 0. + endif cip(i,k) = max(0.0, (clw(i,k,ntiw) + & snow2ice*clw(i,k,ntsw) + tem2) * & gfac * delp(i,k)) diff --git a/physics/radiation_gases.f b/physics/Radiation/radiation_gases.f similarity index 76% rename from physics/radiation_gases.f rename to physics/Radiation/radiation_gases.f index ccc3b598a..4c626b348 100644 --- a/physics/radiation_gases.f +++ b/physics/Radiation/radiation_gases.f @@ -1,17 +1,14 @@ !> \file radiation_gases.f -!! This file contains routines that set up ozone climatological -!! profiles and other constant gas profiles, such as co2, ch4, n2o, -!! o2, and those of cfc gases. All data are entered as mixing ratio -!! by volume, except ozone which is mass mixing ratio (g/g). +!! This file contains routines that set up gas profiles, such as co2, +!! ch4, n2o, o2, and those of cfc gases. All data are entered as mixing +!! ratio by volume ! ========================================================== !!!!! ! 'module_radiation_gases' description !!!!! ! ========================================================== !!!!! ! ! -! set up ozone climatological profiles and other constant gas ! -! profiles, such as co2, ch4, n2o, o2, and those of cfc gases. All ! -! data are entered as mixing ratio by volume, except ozone which is ! -! mass mixing ratio (g/g). ! +! set up constant gas profiles, such as co2, ch4, n2o, o2, and those ! +! of cfc gases. All data are entered as mixing ratio by volume ! ! ! ! in the module, the externally callabe subroutines are : ! ! ! @@ -23,16 +20,10 @@ ! ! ! 'gas_update' -- read in data and update with time ! ! input: ! -! ( iyear, imon, iday, ihour, loz1st, ldoco2, me ) ! +! ( iyear, imon, iday, ihour, ldoco2, me ) ! ! output: ! ! ( errflg, errmsg ) ! ! ! -! 'getozn' -- setup climatological ozone profile ! -! input: ! -! ( prslk,xlat, ! -! IMAX, LM ) ! -! output: ! -! ( o3mmr ) ! ! ! ! 'getgases' -- setup constant gas profiles for LW and SW ! ! input: ! @@ -47,7 +38,6 @@ ! 'module module_iounitdef' in 'iounitdef.f' ! ! ! ! unit used for radiative active gases: ! -! ozone : mass mixing ratio (g/g) ! ! co2 : volume mixing ratio (p/p) ! ! n2o : volume mixing ratio (p/p) ! ! ch4 : volume mixing ratio (p/p) ! @@ -81,15 +71,6 @@ ! seasonal cycle calculations ! ! aug 2011 - y-t hou fix a bug in subr getgases doing vertical ! ! co2 mapping. (for top_at_1 case, not affact opr). ! -! aug 2012 - y-t hou modified subr getozn. moved the if-first ! -! block to subr gas_init to ensure threading safe in ! -! climatology ozone applications. (not affect gfs) ! -! also changed the initialization subr into two parts:! -! 'gas_init' is called at the start of run to set up ! -! module parameters; and 'gas_update' is called within! -! the time loop to check and update data sets. defined! -! the climatology ozone parameters k1oz,k2oz,facoz as ! -! module variables and are set in subr 'gas_update' ! ! nov 2012 - y-t hou modified control parameters thru module ! ! 'physparam'. ! ! jan 2013 - z. janjic/y. hou modified ilon (longitude index) ! @@ -105,10 +86,8 @@ !> \defgroup module_radiation_gases_mod Radiation Gases Module !> @{ -!> This module sets up ozone climatological profiles and other constant -!! gas profiles, such as co2, ch4, n2o, o2, and those of cfc gases. All -!! data are entered as mixing ratio by volume, except ozone which is -!! mass mixing ratio (g/g). +!> This module sets up constant gas profiles, such as co2, ch4, n2o, o2, +!! and those of cfc gases. All data are entered as mixing ratio by volume. !!\image html rad_gas_AGGI.png "Figure 1: Atmospheric radiative forcing, relative to 1750, by long-lived greenhouse gases and the 2016 update of the NOAA Annual Greenhouse Gas Index (AGGI)" !! NOAA Annual Greenhouse Gas Index (AGGI) shows that from 1990 to 2016, !! radiative forcing by long-lived greenhouse gases (LLGHGs) increased by @@ -121,10 +100,6 @@ !!\n ICO2=1: use observed global annual mean value !!\n ICO2=2: use observed monthly 2-d data table in \f$15^o\f$ horizontal resolution !! -!! O3 Distribution (namelist control parameter -\b NTOZ): -!!\n NTOZ=0: use seasonal and zonal averaged climatological ozone -!!\n NTOZ>0: use 3-D prognostic ozone -!! !! Trace Gases (currently using the global mean climatology in unit of ppmv): !! \f$CH_4-1.50\times10^{-6}\f$; !! \f$N_2O-0.31\times10^{-6}\f$; @@ -137,14 +112,11 @@ !! !!\version NCEP-Radiation_gases v5.1 Nov 2012 -!> This module sets up ozone climatological profiles and other constant gas -!! profiles, such as co2, ch4, n2o, o2, and those of cfc gases. +!> This module sets up constant gas rofiles, such as co2, ch4, n2o, o2, and those +!! of cfc gases. module module_radiation_gases use machine, only : kind_phys, kind_io4 use funcphys, only : fpkapx - use ozne_def, only : JMR => latsozc, LOZ => levozc, & - & blte => blatc, dlte=> dphiozc, & - & timeozc => timeozc use module_iounitdef, only : NIO3CLM, NICO2CN ! implicit none @@ -182,22 +154,8 @@ module module_radiation_gases ! gfdl 1999 value real (kind=kind_phys), parameter :: f113vmr_def= 8.2000e-11 -! --- ozone seasonal climatology parameters defined in module ozne_def -! - 4x5 ozone data parameter -! integer, parameter :: JMR=45, LOZ=17 -! real (kind=kind_phys), parameter :: blte=-86.0, dlte=4.0 -! - geos ozone data -! integer, parameter :: JMR=18, LOZ=17 -! real (kind=kind_phys), parameter :: blte=-85.0, dlte=10.0 - ! --- module variables to be set in subroutin gas_init and/or gas_update -! variables for climatology ozone (ioznflg = 0) - - real (kind=kind_phys), allocatable :: pkstr(:), o3r(:,:,:) - integer :: k1oz = 0, k2oz = 0 - real (kind=kind_phys) :: facoz = 0.0 - ! arrays for co2 2-d monthly data and global mean values from observed data real (kind=kind_phys), allocatable :: co2vmr_sav(:,:,:) @@ -212,33 +170,30 @@ module module_radiation_gases ! --- public interfaces - public gas_init, gas_update, getgases, getozn + public gas_init, gas_update, getgases ! ================= contains ! ================= -!> This subroutine sets up ozone, co2, etc. parameters. If climatology -!! ozone then read in monthly ozone data. +!> This subroutine sets up co2, etc. parameters. !!\param me print message control flag !!\param co2usr_file co2 user defined data table !!\param co2cyc_file co2 climotology monthly cycle data table !!\param ictmflg data ic time/date control flag !!\param ico2flg co2 data source control flag -!!\param ioznflg ozone data control flag !!\param con_pi physical constant Pi !!\param errflg error flag !!\param errmsg error message !>\section gas_init_gen gas_init General Algorithm !----------------------------------- subroutine gas_init( me, co2usr_file, co2cyc_file, ico2flg, & - & ictmflg, ioznflg, con_pi, errflg, errmsg) + & ictmflg, con_pi, errflg, errmsg) ! =================================================================== ! ! ! -! gas_init sets up ozone, co2, etc. parameters. if climatology ozone ! -! then read in monthly ozone data. ! +! gas_init sets up co2, etc. parameters. ! ! ! ! inputs: ! ! me - print message control flag ! @@ -259,9 +214,6 @@ subroutine gas_init( me, co2usr_file, co2cyc_file, ico2flg, & ! further data extrapolation. ! ! =yyyy1: use yyyy data for the fcst. if needed, do ! ! extrapolation to match the fcst time. ! -! ioznflg - ozone data control flag ! -! =0: use climatological ozone profile ! -! >0: use interactive ozone profile ! ! co2usr_file - external co2 user defined data table ! ! co2cyc_file - external co2 climotology monthly cycle data table ! ! con_pi - physical constant Pi ! @@ -270,9 +222,6 @@ subroutine gas_init( me, co2usr_file, co2cyc_file, ico2flg, & ! errflg - error flag ! ! errmsg - error message ! ! ! -! internal module variables: ! -! pkstr, o3r - arrays for climatology ozone data ! -! ! ! usage: call gas_init ! ! ! ! subprograms called: none ! @@ -282,9 +231,10 @@ subroutine gas_init( me, co2usr_file, co2cyc_file, ico2flg, & implicit none ! --- inputs: - integer, intent(in) :: me, ictmflg, ioznflg, ico2flg + integer, intent(in) :: me, ictmflg, ico2flg character(len=26),intent(in) :: co2usr_file,co2cyc_file real(kind=kind_phys), intent(in) :: con_pi + ! --- output: character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -292,10 +242,7 @@ subroutine gas_init( me, co2usr_file, co2cyc_file, ico2flg, & ! --- locals: real (kind=kind_phys), dimension(IMXCO2,JMXCO2) :: co2dat real (kind=kind_phys) :: co2g1, co2g2 - real (kind=kind_phys) :: pstr(LOZ) - real (kind=kind_io4) :: o3clim4(JMR,LOZ,12), pstr4(LOZ) - integer :: imond(12), ilat(JMR,12) integer :: i, j, k, iyr, imo logical :: file_exist, lextpl character :: cline*100, cform*8 @@ -317,78 +264,6 @@ subroutine gas_init( me, co2usr_file, co2cyc_file, ico2flg, & kyrsav = 0 kmonsav = 1 -! --- ... climatology ozone data section - - if ( ioznflg > 0 ) then - if ( me == 0 ) then - print *,' - Using interactive ozone distribution' - endif - else - if ( timeozc /= 12 ) then - print *,' - Using climatology ozone distribution' - print *,' timeozc=',timeozc, ' is not monthly mean', & - & ' - job aborting in subroutin gas_init!!!' - errflg = 1 - errmsg = 'ERROR(gas_init): Climatological o3 distribution '// & - & 'is not monthly mean' - return - endif - - allocate (pkstr(LOZ), o3r(JMR,LOZ,12)) - rewind NIO3CLM - - if ( LOZ == 17 ) then ! For the operational ozone climatology - do k = 1, LOZ - read (NIO3CLM,15) pstr4(k) - 15 format(f10.3) - enddo - - do imo = 1, 12 - do j = 1, JMR - read (NIO3CLM,16) imond(imo), ilat(j,imo), & - & (o3clim4(j,k,imo),k=1,10) - 16 format(i2,i4,10f6.2) - read (NIO3CLM,20) (o3clim4(j,k,imo),k=11,LOZ) - 20 format(6x,10f6.2) - enddo - enddo - else ! For newer ozone climatology - read (NIO3CLM) - do k = 1, LOZ - read (NIO3CLM) pstr4(k) - enddo - - do imo = 1, 12 - do k = 1, LOZ - read (NIO3CLM) (o3clim4(j,k,imo),j=1,JMR) - enddo - enddo - endif ! end if_LOZ_block -! - do imo = 1, 12 - do k = 1, LOZ - do j = 1, JMR - o3r(j,k,imo) = o3clim4(j,k,imo) * 1.655e-6 - enddo - enddo - enddo - - do k = 1, LOZ - pstr(k) = pstr4(k) - enddo - - if ( me == 0 ) then - print *,' - Using climatology ozone distribution' - print *,' Found ozone data for levels pstr=', & - & (pstr(k),k=1,LOZ) -! print *,' O3=',(o3r(15,k,1),k=1,LOZ) - endif - - do k = 1, LOZ - pkstr(k) = fpkapx(pstr(k)*100.0) - enddo - endif ! end if_ioznflg_block - ! --- ... co2 data section co2_glb = co2vmr_def @@ -542,20 +417,18 @@ end subroutine gas_init !!\param imon month of the year !!\param iday day of the month !!\param ihour hour of the day -!!\param loz1st clim ozone 1st time update control flag !!\param ldoco2 co2 update control flag !!\param me print message control flag !!\param co2dat_file co2 2d monthly obsv data table !!\param co2gbl_file co2 global annual mean data table !!\param ictmflg data ic time/date control flag !!\param ico2flg co2 data source control flag -!!\param ioznflg ozone data control flag !!\param errflg error flag !!\param errmsg error message !>\section gen_gas_update gas_update General Algorithm !----------------------------------- - subroutine gas_update(iyear, imon, iday, ihour, loz1st, ldoco2, & - & me, co2dat_file, co2gbl_file, ictmflg, ico2flg, ioznflg, & + subroutine gas_update(iyear, imon, iday, ihour, ldoco2, & + & me, co2dat_file, co2gbl_file, ictmflg, ico2flg, & & errflg, errmsg ) ! =================================================================== ! @@ -568,7 +441,6 @@ subroutine gas_update(iyear, imon, iday, ihour, loz1st, ldoco2, & ! imon - month of the year 1 ! ! iday - day of the month 1 ! ! ihour - hour of the day 1 ! -! loz1st - clim ozone 1st time update control flag 1 ! ! ldoco2 - co2 update control flag 1 ! ! me - print message control flag 1 ! ! ico2flg - co2 data source control flag ! @@ -588,9 +460,6 @@ subroutine gas_update(iyear, imon, iday, ihour, loz1st, ldoco2, & ! further data extrapolation. ! ! =yyyy1: use yyyy data for the fcst. if needed, do ! ! extrapolation to match the fcst time. ! -! ioznflg - ozone data control flag ! -! =0: use climatological ozone profile ! -! >0: use interactive ozone profile ! ! ivflip - vertical profile indexing flag ! ! co2dat_file - external co2 2d monthly obsv data table ! ! co2gbl_file - external co2 global annual mean data table ! @@ -604,8 +473,6 @@ subroutine gas_update(iyear, imon, iday, ihour, loz1st, ldoco2, & ! co2cyc_sav - monthly cycle co2 vol mixing ratio IMXCO2*JMXCO2*12 ! ! co2_glb - global annual mean co2 mixing ratio ! ! gco2cyc - global monthly mean co2 variation 12 ! -! k1oz,k2oz,facoz ! -! - climatology ozone parameters 1 ! ! ! ! usage: call gas_update ! ! ! @@ -617,9 +484,8 @@ subroutine gas_update(iyear, imon, iday, ihour, loz1st, ldoco2, & ! --- inputs: integer, intent(in) :: iyear,imon,iday,ihour,me,ictmflg,ico2flg - integer, intent(in) :: ioznflg character(len=26),intent(in) :: co2dat_file, co2gbl_file - logical, intent(in) :: loz1st, ldoco2 + logical, intent(in) :: ldoco2 ! --- output: character(len=*), intent(out) :: errmsg @@ -644,35 +510,6 @@ subroutine gas_update(iyear, imon, iday, ihour, loz1st, ldoco2, & errmsg = '' errflg = 0 -!> - Ozone data section - - if ( ioznflg == 0 ) then - midmon = mdays(imon)/2 + 1 - change = loz1st .or. ( (iday==midmon) .and. (ihour==0) ) -! - if ( change ) then - if ( iday < midmon ) then - k1oz = mod(imon+10, 12) + 1 - midm = mdays(k1oz)/2 + 1 - k2oz = imon - midp = mdays(k1oz) + midmon - else - k1oz = imon - midm = midmon - k2oz = mod(imon, 12) + 1 - midp = mdays(k2oz)/2 + 1 + mdays(k1oz) - endif - endif -! - if (iday < midmon) then - id = iday + mdays(k1oz) - else - id = iday - endif - - facoz = float(id - midm) / float(midp - midm) - endif - !> - co2 data section if ( ico2flg == 0 ) return ! use prescribed global mean co2 data @@ -1104,119 +941,6 @@ subroutine getgases( plvl, xlon, xlat, IMAX, LMAX, ico2flg, & end subroutine getgases !----------------------------------- -!> This subroutine sets up climatological ozone profile for radiation -!! calculation. This code is originally written by Shrinivas Moorthi. -!!\param prslk (IMAX,LM), exner function = \f$(p/p0)^{rocp}\f$ -!!\param xlat (IMAX), latitude in radians, default to pi/2 -> -!! -pi/2 range, otherwise see in-line comment -!!\param IMAX, LM (1), horizontal and vertical dimensions -!!\param top_at_1 (1), vertical profile indexing flag -!!\param o3mmr (IMAX,LM), output ozone profile in mass mixing -!! ratio (g/g) -!>\section getozn_gen getozn General Algorithm -!----------------------------------- - subroutine getozn( prslk,xlat, IMAX, LM, top_at_1, o3mmr) - -! =================================================================== ! -! ! -! getozn sets up climatological ozone profile for radiation calculation! -! ! -! this code is originally written By Shrinivas Moorthi ! -! ! -! inputs: ! -! prslk (IMAX,LM) - exner function = (p/p0)**rocp ! -! xlat (IMAX) - latitude in radians, default to pi/2 -> -pi/2 ! -! range, otherwise see in-line comment ! -! IMAX, LM - horizontal and vertical dimensions ! -! top_at_1 - vertical profile indexing flag ! -! ! -! outputs: ! -! o3mmr (IMAX,LM) - output ozone profile in mass mixing ratio (g/g)! -! ! -! module variables: ! -! k1oz, k2oz - ozone data interpolation indices ! -! facoz - ozone data interpolation factor ! -! ! -! usage: call getozn ! -! ! -! =================================================================== ! -! - implicit none - -! --- inputs: - integer, intent(in) :: IMAX, LM - logical, intent(in) :: top_at_1 - real (kind=kind_phys), intent(in) :: prslk(:,:), xlat(:) - -! --- outputs: - real (kind=kind_phys), intent(out) :: o3mmr(:,:) - -! --- locals: - real (kind=kind_phys) :: o3i(IMAX,LOZ), wk1(IMAX), deglat, elte, & - & tem, tem1, tem2, tem3, tem4, temp - integer :: i, j, k, l, j1, j2, ll -! -!===> ... begin here -! - elte = blte + (JMR-1)*dlte - - do i = 1, IMAX - deglat = xlat(i) * raddeg ! if xlat in pi/2 -> -pi/2 range -! deglat = 90.0 - xlat(i)*raddeg ! if xlat in 0 -> pi range - - if (deglat > blte .and. deglat < elte) then - tem1 = (deglat - blte) / dlte + 1 - j1 = tem1 - j2 = j1 + 1 - tem1 = tem1 - j1 - elseif (deglat <= blte) then - j1 = 1 - j2 = 1 - tem1 = 1.0 - elseif (deglat >= elte) then - j1 = JMR - j2 = JMR - tem1 = 1.0 - endif - - tem2 = 1.0 - tem1 - do j = 1, LOZ - tem3 = tem2*o3r(j1,j,k1oz) + tem1*o3r(j2,j,k1oz) - tem4 = tem2*o3r(j1,j,k2oz) + tem1*o3r(j2,j,k2oz) - o3i(i,j) = tem4*facoz + tem3*(1.0 - facoz) - enddo - enddo - - do l = 1, LM - ll = l - if (.not. top_at_1) ll = LM -l + 1 - - do i = 1, IMAX - wk1(i) = prslk(i,ll) - enddo - - do k = 1, LOZ-1 - temp = 1.0 / (pkstr(k+1) - pkstr(k)) - - do i = 1, IMAX - if (wk1(i) > pkstr(k) .and. wk1(i) <= pkstr(k+1)) then - tem = (pkstr(k+1) - wk1(i)) * temp - o3mmr(I,ll) = tem * o3i(i,k) + (1.0 - tem) * o3i(i,k+1) - endif - enddo - enddo - - do i = 1, IMAX - if (wk1(i) > pkstr(LOZ)) o3mmr(i,ll) = o3i(i,LOZ) - if (wk1(i) < pkstr(1)) o3mmr(i,ll) = o3i(i,1) - enddo - enddo -! - return -!................................... - end subroutine getozn -!----------------------------------- - ! !........................................! end module module_radiation_gases ! diff --git a/physics/radiation_surface.f b/physics/Radiation/radiation_surface.f similarity index 99% rename from physics/radiation_surface.f rename to physics/Radiation/radiation_surface.f index 7b7caf849..8bbfd6ed5 100644 --- a/physics/radiation_surface.f +++ b/physics/Radiation/radiation_surface.f @@ -421,8 +421,9 @@ subroutine setalb & & lakefrac, & & slmsk, snodi, zorlf, coszf, tsknf, tairf, hprif, & & alvsf, alnsf, alvwf, alnwf, facsf, facwf, fice, tisfc, & - & icealbdvis, icealbdnir, icealbivis, icealbinir, & & sncovr, sncovr_ice, snoalb, albPpert ! sfc-perts, mgehne + real (kind=kind_phys), dimension(:), intent(in), optional :: & + & icealbdvis, icealbdnir, icealbivis, icealbinir real (kind=kind_phys), intent(in) :: pertalb, con_ttp! sfc-perts, mgehne real (kind=kind_phys), dimension(:), intent(in) :: & & fracl, fraco, fraci diff --git a/physics/radiation_tools.F90 b/physics/Radiation/radiation_tools.F90 similarity index 100% rename from physics/radiation_tools.F90 rename to physics/Radiation/radiation_tools.F90 diff --git a/physics/gfdl_sfc_layer.F90 b/physics/SFC_Layer/GFDL/gfdl_sfc_layer.F90 similarity index 100% rename from physics/gfdl_sfc_layer.F90 rename to physics/SFC_Layer/GFDL/gfdl_sfc_layer.F90 diff --git a/physics/gfdl_sfc_layer.meta b/physics/SFC_Layer/GFDL/gfdl_sfc_layer.meta similarity index 99% rename from physics/gfdl_sfc_layer.meta rename to physics/SFC_Layer/GFDL/gfdl_sfc_layer.meta index f1c7a4ce2..ac98437e9 100644 --- a/physics/gfdl_sfc_layer.meta +++ b/physics/SFC_Layer/GFDL/gfdl_sfc_layer.meta @@ -1,7 +1,9 @@ [ccpp-table-properties] name = gfdl_sfc_layer type = scheme - dependencies = machine.F,module_sf_exchcoef.f90,namelist_soilveg_ruc.F90,noahmp_tables.f90 + dependencies = ../../hooks/machine.F,module_sf_exchcoef.f90 + dependencies = ../../SFC_Models/Land/RUC/namelist_soilveg_ruc.F90 + dependencies = ../../SFC_Models/Land/Noahmp/noahmp_tables.f90 ######################################################################## [ccpp-arg-table] diff --git a/physics/module_sf_exchcoef.f90 b/physics/SFC_Layer/GFDL/module_sf_exchcoef.f90 similarity index 100% rename from physics/module_sf_exchcoef.f90 rename to physics/SFC_Layer/GFDL/module_sf_exchcoef.f90 diff --git a/physics/module_SF_JSFC.F90 b/physics/SFC_Layer/MYJ/module_SF_JSFC.F90 similarity index 100% rename from physics/module_SF_JSFC.F90 rename to physics/SFC_Layer/MYJ/module_SF_JSFC.F90 diff --git a/physics/myjsfc_wrapper.F90 b/physics/SFC_Layer/MYJ/myjsfc_wrapper.F90 similarity index 100% rename from physics/myjsfc_wrapper.F90 rename to physics/SFC_Layer/MYJ/myjsfc_wrapper.F90 diff --git a/physics/myjsfc_wrapper.meta b/physics/SFC_Layer/MYJ/myjsfc_wrapper.meta similarity index 99% rename from physics/myjsfc_wrapper.meta rename to physics/SFC_Layer/MYJ/myjsfc_wrapper.meta index 40b6b78f3..0ae09985e 100644 --- a/physics/myjsfc_wrapper.meta +++ b/physics/SFC_Layer/MYJ/myjsfc_wrapper.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = myjsfc_wrapper type = scheme - dependencies = module_SF_JSFC.F90 + dependencies = ../../hooks/machine.F,module_SF_JSFC.F90 ######################################################################## [ccpp-arg-table] diff --git a/physics/module_sf_mynn.F90 b/physics/SFC_Layer/MYNN/module_sf_mynn.F90 similarity index 89% rename from physics/module_sf_mynn.F90 rename to physics/SFC_Layer/MYNN/module_sf_mynn.F90 index c60247cf6..588cb0898 100644 --- a/physics/module_sf_mynn.F90 +++ b/physics/SFC_Layer/MYNN/module_sf_mynn.F90 @@ -26,7 +26,7 @@ MODULE module_sf_mynn ! ! LAND only: ! "iz0tlnd" namelist option is used to select the following momentum options: -! (default) =0: Zilitinkevich (1995); Czil now set to 0.085 +! (default) =0: Zilitinkevich (1995); Czil now set to 0.095 ! =1: Czil_new (modified according to Chen & Zhang 2008) ! =2: Modified Yang et al (2002, 2008) - generalized for all landuse ! =3: constant zt = z0/7.4 (original form; Garratt 1992) @@ -106,6 +106,7 @@ MODULE module_sf_mynn REAL(kind_phys), DIMENSION(0:1000 ),SAVE :: psim_stab,psim_unstab, & psih_stab,psih_unstab +!$acc declare create(psim_stab, psim_unstab, psih_stab, psih_unstab) CONTAINS @@ -224,7 +225,7 @@ SUBROUTINE SFCLAY_mynn( & ! (water =1: z0 from Davis et al (2008), zt & zq from COARE3.0/3.5 ! only) =2: z0 from Davis et al (2008), zt & zq from Garratt (1992) ! =3: z0 from Taylor and Yelland (2004), zt and zq from COARE 3.0/3.5 -!-- iz0tlnd =0: Zilitinkevich (1995) with Czil=0.085, +!-- iz0tlnd =0: Zilitinkevich (1995) with Czil=0.095, ! (land =1: Czil_new (modified according to Chen & Zhang 2008) ! only) =2: Modified Yang et al (2002, 2008) - generalized for all landuse ! =3: constant zt = z0/7.4 (Garratt 1992) @@ -283,7 +284,7 @@ SUBROUTINE SFCLAY_mynn( & th3d,pi3d !GJF: This array must be assumed-shape since it is conditionally-allocated - REAL(kind_phys), DIMENSION( :,: ), & + REAL(kind_phys), DIMENSION( :,: ), OPTIONAL, & INTENT(IN) :: pattern_spp_sfc !=================================== ! 2D VARIABLES @@ -303,21 +304,23 @@ SUBROUTINE SFCLAY_mynn( & REAL(kind_phys), DIMENSION( ims:ime ) , & INTENT(INOUT) :: HFLX,HFX, & QFLX,QFX, & - LH, & - MOL,RMOL, & + RMOL, & QSFC, & QGH, & ZNT, & - ZOL, & - USTM, & CPM, & - CHS2, & - CQS2, & CHS, & CH, & FLHC,FLQC, & GZ1OZ0,WSPD, & - PSIM,PSIH, & + PSIM,PSIH + REAL(kind_phys), DIMENSION( ims:ime ), OPTIONAL , & + INTENT(INOUT) :: USTM, & + CHS2, & + CQS2, & + LH, & + ZOL, & + MOL, & WSTAR LOGICAL, DIMENSION( ims:ime ), INTENT(IN) :: & @@ -371,6 +374,20 @@ SUBROUTINE SFCLAY_mynn( & errflg = 0 errmsg = '' +!$acc enter data copyin( dz8w,U3D,V3D,QV3D,QC3D,P3D,T3D, & +!$acc pattern_spp_sfc) + +!$acc enter data copyin( UST_WAT(:), UST_LND(:), UST_ICE(:), & +!$acc MOL(:), QFLX(:), HFLX(:), & +!$acc QSFC(:), QSFC_WAT(:), QSFC_LND(:), & +!$acc QSFC_ICE(:)) + +!$acc enter data create( dz8w1d(:), dz2w1d(:), U1D(:), & +!$acc V1D(:), U1D2(:), V1D2(:), & +!$acc QV1D(:), QC1D(:), P1D(:), & +!$acc T1D(:), rstoch1D(:), qstar(:)) + + IF (debug_code >= 1) THEN write(*,*)"======= printing of constants:" write(*,*)"cp=", cp," g=", grav @@ -382,6 +399,10 @@ SUBROUTINE SFCLAY_mynn( & itf=ite !MIN0(ite,ide-1) ktf=kte !MIN0(kte,kde-1) +!$acc parallel loop present(dz8w,U3D,V3D,QV3D,QC3D,P3D,T3D, & +!$acc pattern_spp_sfc,dz8w1d,dz2w1d,U1D, & +!$acc V1D,U1D2,V1D2,QV1D,QC1D,P1D,T1D, & +!$acc rstoch1D,qstar) DO i=its,ite dz8w1d(I) = dz8w(i,kts) dz2w1d(I) = dz8w(i,kts+1) @@ -403,6 +424,9 @@ SUBROUTINE SFCLAY_mynn( & ENDDO IF (itimestep==1 .AND. iter==1) THEN +!$acc parallel loop present(U1D,V1D,UST_WAT,UST_LND,UST_ICE,MOL, & +!$acc QFLX,HFLX,QV3D,QSFC,QSFC_WAT, & +!$acc QSFC_LND,QSFC_ICE) DO i=its,ite IF (.not. flag_restart) THEN !Everything here is used before calculated @@ -432,6 +456,9 @@ SUBROUTINE SFCLAY_mynn( & ENDDO ENDIF +!$acc exit data delete( dz8w,U3D,V3D,QV3D,QC3D,P3D,T3D, & +!$acc pattern_spp_sfc, QC1D) + CALL SFCLAY1D_mynn(flag_iter, & J,U1D,V1D,T1D,QV1D,P1D,dz8w1d, & U1D2,V1D2,dz2w1d, & @@ -471,6 +498,16 @@ SUBROUTINE SFCLAY_mynn( & its,ite, jts,jte, kts,kte, & errmsg, errflg ) +!$acc exit data copyout( UST_WAT(:), UST_LND(:), UST_ICE(:), & +!$acc MOL(:), QFLX(:), HFLX(:), & +!$acc QSFC(:), QSFC_WAT(:), QSFC_LND(:), & +!$acc QSFC_ICE(:)) + +!$acc exit data delete( dz8w1d(:), dz2w1d(:), U1D(:), & +!$acc V1D(:), U1D2(:), V1D2(:), & +!$acc QV1D(:), T1D(:), P1D(:), & +!$acc rstoch1D(:), qstar(:)) + END SUBROUTINE SFCLAY_MYNN !------------------------------------------------------------------- @@ -572,18 +609,20 @@ SUBROUTINE SFCLAY1D_mynn(flag_iter, & RMOL REAL(kind_phys), DIMENSION( ims:ime ), & INTENT(INOUT) :: HFLX,QFLX, & - LH,MOL, & QGH,QSFC, & ZNT, & - ZOL, & CPM, & - CHS2,CQS2, & CHS,CH, & FLHC,FLQC, & GZ1OZ0, & WSPD, & PSIM, & - PSIH, & + PSIH + REAL(kind_phys), DIMENSION( ims:ime ), OPTIONAL, & + INTENT(INOUT) :: MOL, & + ZOL, & + LH, & + CHS2,CQS2, & USTM LOGICAL, DIMENSION( ims:ime ), INTENT(IN) :: & @@ -621,14 +660,32 @@ SUBROUTINE SFCLAY1D_mynn(flag_iter, & !-------------------------------------------- !JOE-additinal output REAL(kind_phys), DIMENSION( ims:ime ), & - & INTENT(OUT) :: wstar, & - & qstar + & INTENT(OUT) :: qstar + REAL(kind_phys), DIMENSION( ims:ime ), OPTIONAL, & + & INTENT(OUT) :: wstar + !JOE-end ! CCPP error handling character(len=*), intent(inout) :: errmsg integer, intent(inout) :: errflg +! Local fixed-size errmsg character array for error messages on accelerator +! devices distinct from the host (e.g. GPUs). Necessary since OpenACC does +! not support assumed-size (len=*) arrays like errmsg. Additional +! device_errflg integer to denote when device_errmsg needs to be synced +! with errmsg. + character(len=512) :: device_errmsg + integer :: device_errflg + +! Special versions of the fixed-size errmsg character array for error messages +! on the device and it's errflag counterpart. These are necessary to ensure +! the return statements at lines 1417 and 2030 are executed only for this +! special case, and not any and all error messages set on the device. + character(len=512) :: device_special_errmsg + integer :: device_special_errflg + + !---------------------------------------------------------------- ! LOCAL VARS !---------------------------------------------------------------- @@ -678,7 +735,65 @@ SUBROUTINE SFCLAY1D_mynn(flag_iter, & ! Initialize error-handling errflg = 0 errmsg = '' + device_errflg = errflg + device_errmsg = errmsg + device_special_errflg = errflg + device_special_errmsg = errmsg !------------------------------------------------------------------- +!$acc update device(psim_stab, psim_unstab, psih_stab, psih_unstab) + +!$acc enter data create( ZA, ZA2, THV1D, TH1D, TC1D, TV1D, & +!$acc RHO1D, QVSH, PSIH2, PSIM10, PSIH10, WSPDI, & +!$acc GOVRTH, PSFC, THCON, & +!$acc zratio_lnd, zratio_ice, zratio_wat, & +!$acc TSK_lnd, TSK_ice, TSK_wat, & +!$acc THSK_lnd, THSK_ice, THSK_wat, & +!$acc THVSK_lnd, THVSK_ice, THVSK_wat, & +!$acc GZ1OZ0_lnd, GZ1OZ0_ice, GZ1OZ0_wat, & +!$acc GZ1OZt_lnd, GZ1OZt_ice, GZ1OZt_wat, & +!$acc GZ2OZ0_lnd, GZ2OZ0_ice, GZ2OZ0_wat, & +!$acc GZ2OZt_lnd, GZ2OZt_ice, GZ2OZt_wat, & +!$acc GZ10OZ0_lnd, GZ10OZ0_ice, GZ10OZ0_wat, & +!$acc GZ10OZt_lnd, GZ10OZt_ice, GZ10OZt_wat, & +!$acc ZNTstoch_lnd, ZNTstoch_ice, ZNTstoch_wat, & +!$acc ZT_lnd, ZT_ice, ZT_wat, & +!$acc ZQ_lnd, ZQ_ice, ZQ_wat, & +!$acc PSIQ_lnd, PSIQ_ice, PSIQ_wat, & +!$acc PSIQ2_lnd, PSIQ2_ice, PSIQ2_wat, & +!$acc QSFCMR_lnd, QSFCMR_ice, QSFCMR_wat ) + +!$acc enter data copyin(flag_iter, dry, wet, icy, CPM, MAVAIL, & +!$acc QFX, FLHC, FLQC, CHS, CH, CHS2, CQS2, USTM, & +!$acc HFX, LH, wstar, qstar, PBLH, ZOL, MOL, RMOL, & +!$acc T2, TH2, Q2, QV1D, PSFCPA, & +!$acc WSPD, U10, V10, U1D, V1D, U1D2, V1D2, & +!$acc T1D, P1D, rstoch1D, sigmaf, & +!$acc shdmax, vegtype, z0pert, ztpert, dx, QGH, & +!$acc dz2w1d, dz8w1d, & +!$acc stress_wat, stress_lnd, stress_ice, & +!$acc rb_wat, rb_lnd, rb_ice, & +!$acc tskin_wat, tskin_lnd, tskin_ice, & +!$acc tsurf_wat, tsurf_lnd, tsurf_ice, & +!$acc psim, psih, & +!$acc UST_wat, UST_lnd, UST_ice, & +!$acc ZNT_wat, ZNT_lnd, ZNT_ice, & +!$acc QSFC, QSFC_lnd, QSFC_wat, QSFC_ice, & +!$acc QFLX, QFLX_lnd, QFLX_wat, QFLX_ice, & +!$acc HFLX, HFLX_lnd, HFLX_wat, HFLX_ice, & +!$acc PSIX_wat, PSIX_lnd, PSIX_ice, & +!$acc PSIX10_wat, PSIX10_lnd, PSIX10_ice, & +!$acc PSIT2_lnd, PSIT2_wat, PSIT2_ice, & +!$acc PSIT_lnd, PSIT_wat, PSIT_ice, & +!$acc ch_lnd, ch_wat, ch_ice, & +!$acc cm_lnd, cm_wat, cm_ice, & +!$acc snowh_lnd, snowh_wat, snowh_ice, & +!$acc device_errmsg, device_errflg, & +!$acc device_special_errmsg, device_special_errflg) + +!$acc parallel loop present(PSFCPA, PSFC, QSFC, T1D, flag_iter, tsurf_lnd, & +!$acc QSFC_wat, QSFCMR_wat, wet, TSK_wat, tskin_wat, & +!$acc QSFC_lnd, QSFCMR_lnd, dry, TSK_lnd, tskin_lnd, & +!$acc QSFC_ice, QSFCMR_ice, icy, TSK_ice, tskin_ice) DO I=its,ite ! PSFC ( in cmb) is used later in saturation checks @@ -791,6 +906,10 @@ SUBROUTINE SFCLAY1D_mynn(flag_iter, & endif ! flag_iter ENDDO +!$acc serial present(pblh, PSFCPA, dz8w1d, qflx, hflx, & +!$acc dry, tskin_lnd, tsurf_lnd, qsfc_lnd, znt_lnd, ust_lnd, snowh_lnd, & +!$acc icy, tskin_ice, tsurf_ice, qsfc_ice, znt_ice, ust_ice, snowh_ice, & +!$acc wet, tskin_wat, tsurf_wat, qsfc_wat, znt_wat, ust_wat, snowh_wat) IF (debug_code >= 1) THEN write(0,*)"ITIMESTEP=",ITIMESTEP," iter=",iter DO I=its,ite @@ -815,7 +934,12 @@ SUBROUTINE SFCLAY1D_mynn(flag_iter, & ENDIF ENDDO ENDIF +!$acc end serial +!$acc parallel loop present(PSFC, PSFCPA, QVSH, QV1D, THCON, flag_iter, & +!$acc dry, tskin_lnd, TSK_lnd, tsurf_lnd, THSK_lnd, THVSK_lnd, qsfc_lnd, & +!$acc icy, tskin_ice, TSK_ice, tsurf_ice, THSK_ice, THVSK_ice, qsfc_ice, & +!$acc wet, tskin_wat, TSK_wat, tsurf_wat, THSK_wat, THVSK_wat, qsfc_wat) DO I=its,ite ! PSFC ( in cmb) is used later in saturation checks PSFC(I)=PSFCPA(I)/1000. @@ -829,7 +953,7 @@ SUBROUTINE SFCLAY1D_mynn(flag_iter, & ! CONVERT SKIN TEMPERATURES TO POTENTIAL TEMPERATURE: THSK_lnd(I) = TSK_lnd(I)*THCON(I) !(K) THVSK_lnd(I) = THSK_lnd(I)*(1.+EP1*qsfc_lnd(I)) - if(THVSK_lnd(I) < 170. .or. THVSK_lnd(I) > 360.) & + if(THVSK_lnd(I) < 160. .or. THVSK_lnd(I) > 390.) & print *,'THVSK_lnd(I)',itimestep,i,THVSK_lnd(I),THSK_lnd(i),tsurf_lnd(i),tskin_lnd(i),qsfc_lnd(i) endif if(icy(i)) then @@ -838,7 +962,7 @@ SUBROUTINE SFCLAY1D_mynn(flag_iter, & ! CONVERT SKIN TEMPERATURES TO POTENTIAL TEMPERATURE: THSK_ice(I) = TSK_ice(I)*THCON(I) !(K) THVSK_ice(I) = THSK_ice(I)*(1.+EP1*qsfc_ice(I)) !(K) - if(THVSK_ice(I) < 170. .or. THVSK_ice(I) > 360.) & + if(THVSK_ice(I) < 160. .or. THVSK_ice(I) > 390.) & print *,'THVSK_ice(I)',itimestep,i,THVSK_ice(I),THSK_ice(i),tsurf_ice(i),tskin_ice(i),qsfc_ice(i) endif if(wet(i)) then @@ -847,24 +971,27 @@ SUBROUTINE SFCLAY1D_mynn(flag_iter, & ! CONVERT SKIN TEMPERATURES TO POTENTIAL TEMPERATURE: THSK_wat(I) = TSK_wat(I)*THCON(I) !(K) THVSK_wat(I) = THSK_wat(I)*(1.+EP1*QVSH(I)) !(K) - if(THVSK_wat(I) < 170. .or. THVSK_wat(I) > 360.) & + if(THVSK_wat(I) < 160. .or. THVSK_wat(I) > 390.) & print *,'THVSK_wat(I)',i,THVSK_wat(I),THSK_wat(i),tsurf_wat(i),tskin_wat(i),qsfc_wat(i) endif endif ! flag_iter ENDDO +!$acc parallel loop present(TH1D, T1D, P1D, TC1D) DO I=its,ite ! CONVERT LOWEST LAYER TEMPERATURE TO POTENTIAL TEMPERATURE: TH1D(I)=T1D(I)*(100000./P1D(I))**ROVCP !(Theta, K) TC1D(I)=T1D(I)-273.15 !(T, Celsius) ENDDO +!$acc parallel loop present(THV1D, TH1D, QVSH, TV1D, T1D) DO I=its,ite ! CONVERT TO VIRTUAL TEMPERATURE THV1D(I)=TH1D(I)*(1.+EP1*QVSH(I)) !(K) TV1D(I)=T1D(I)*(1.+EP1*QVSH(I)) !(K) ENDDO +!$acc parallel loop present(RHO1D, P1D, TV1D, TH1D, ZA, ZA2, dz2w1d, dz8w1d, GOVRTH) DO I=its,ite RHO1D(I)=P1D(I)/(Rd*TV1D(I)) !now using value calculated in sfc driver ZA(I)=0.5*dz8w1d(I) !height of first half-sigma level @@ -873,11 +1000,16 @@ SUBROUTINE SFCLAY1D_mynn(flag_iter, & ENDDO !tgs - should QFX and HFX be separate for land, ice and water? +!$acc parallel loop present(QFX, QFLX, RHO1D, HFX, HFLX) DO I=its,ite QFX(i)=QFLX(i)*RHO1D(I) HFX(i)=HFLX(i)*RHO1D(I)*cp ENDDO +!$acc serial present(THV1D, TV1D, RHO1D, GOVRTH, & +!$acc dry, tsk_lnd, thvsk_lnd, & +!$acc icy, tsk_ice, thvsk_ice, & +!$acc wet, tsk_wat, thvsk_wat) IF (debug_code ==2) THEN !write(*,*)"ITIMESTEP=",ITIMESTEP DO I=its,ite @@ -890,7 +1022,9 @@ SUBROUTINE SFCLAY1D_mynn(flag_iter, & write(*,*)"RHO1D=", RHO1D(i)," GOVRTH=",GOVRTH(i) ENDDO ENDIF +!$acc end serial +!$acc parallel loop present(T1D,P1D,QGH,QV1D,CPM) DO I=its,ite ! QGH CHANGED TO USE LOWEST-LEVEL AIR TEMP ! Q2SAT = QGH IN LSM @@ -908,6 +1042,10 @@ SUBROUTINE SFCLAY1D_mynn(flag_iter, & CPM(I)=CP*(1.+0.84*QV1D(I)) ENDDO +!$acc serial present(QGH, & +!$acc wet, QSFC_wat, QSFCMR_wat, & +!$acc dry, QSFC_lnd, QSFCMR_lnd, & +!$acc icy, QSFC_ice, QSFCMR_ice) IF (debug_code == 2) THEN write(*,*)"ITIMESTEP=",ITIMESTEP DO I=its,ite @@ -925,7 +1063,13 @@ SUBROUTINE SFCLAY1D_mynn(flag_iter, & endif ENDDO ENDIF +!$acc end serial +!$acc parallel loop present(flag_iter,U1D,V1D,WSPD,wet,dry,icy, & +!$acc THV1D,THVSK_wat,THVSK_lnd,THVSK_ice, & +!$acc hfx,RHO1D,qfx,WSTAR,pblh,dx,GOVRTH,ZA, & +!$acc TSK_wat,TSK_lnd,TSK_ice, & +!$acc rb_wat,rb_lnd,rb_ice) DO I=its,ite if( flag_iter(i) ) then ! DH* 20200401 - note. A weird bug in Intel 18 on hera prevents using the @@ -1067,6 +1211,35 @@ SUBROUTINE SFCLAY1D_mynn(flag_iter, & !-------------------------------------------------------------------- !-------------------------------------------------------------------- +!$acc parallel loop present(flag_iter, PSFCPA, dz8w1d, pblh, & +!$acc device_errmsg, device_errflg, & +!$acc device_special_errmsg, device_special_errflg, & +!$acc wet, dry, icy, & +!$acc ZT_wat, ZT_lnd, ZT_ice, & +!$acc ZNT_wat, ZNT_lnd, ZNT_ice, & +!$acc ZNTstoch_wat, ZNTstoch_lnd, ZNTstoch_ice, & +!$acc UST_wat, UST_lnd, UST_ice, & +!$acc ZQ_wat, ZQ_lnd, ZQ_ice, & +!$acc snowh_wat, snowh_lnd, snowh_ice, & +!$acc THVSK_wat, THVSK_lnd, THVSK_ice, & +!$acc tskin_wat, tskin_lnd, tskin_ice, & +!$acc tsurf_wat, tsurf_lnd, tsurf_ice, & +!$acc qsfc_wat, qsfc_lnd, qsfc_ice, & +!$acc GZ1OZ0_wat, GZ1OZt_wat, GZ2OZ0_wat, GZ2OZt_wat, GZ10OZ0_wat, GZ10OZt_wat, & +!$acc GZ1OZ0_lnd, GZ1OZt_lnd, GZ2OZ0_lnd, GZ2OZt_lnd, GZ10OZ0_lnd, GZ10OZt_lnd, & +!$acc GZ1OZ0_ice, GZ1OZt_ice, GZ2OZ0_ice, GZ2OZt_ice, GZ10OZ0_ice, GZ10OZt_ice, & +!$acc zratio_wat, zratio_lnd, zratio_ice, & +!$acc stress_wat, stress_lnd, stress_ice, & +!$acc rb_wat, rb_lnd, rb_ice, & +!$acc qflx, qflx_lnd, & +!$acc hflx, hflx_lnd, & +!$acc psim, psih, psim10, psih10, psih2, & +!$acc psix_wat, psix10_wat, psit_wat, psit2_wat, psiq_wat, psiq2_wat, & +!$acc psix_lnd, psix10_lnd, psit_lnd, psit2_lnd, psiq_lnd, psiq2_lnd, & +!$acc psix_ice, psix10_ice, psit_ice, psit2_ice, psiq_ice, psiq2_ice, & +!$acc WSPD, WSPDI, U1D, V1D, TC1D, THV1D, rstoch1D, USTM, ZA, ZOL, QVSH, & +!$acc shdmax, vegtype, z0pert, ztpert, mol, rmol, wstar, qstar, sigmaf) + DO I=its,ite if( flag_iter(i) ) then @@ -1082,10 +1255,12 @@ SUBROUTINE SFCLAY1D_mynn(flag_iter, & if (sfc_z0_type >= 0) then ! Avoid calculation is using wave model ! CALCULATE z0 (znt) !-------------------------------------- + IF (debug_code == 2) THEN write(*,*)"=============Input to ZNT over water:" write(*,*)"u*:",UST_wat(i)," wspd=",WSPD(i)," visc=",visc," za=",ZA(I) ENDIF + IF ( PRESENT(ISFTCFLX) ) THEN IF ( ISFTCFLX .EQ. 0 ) THEN IF (COARE_OPT .EQ. 3.0) THEN @@ -1170,7 +1345,7 @@ SUBROUTINE SFCLAY1D_mynn(flag_iter, & ENDIF ELSEIF ( ISFTCFLX .EQ. 4 ) THEN !GFS zt formulation - CALL GFS_zt_wat(ZT_wat(i),ZNTstoch_wat(i),restar,WSPD(i),ZA(i),sfc_z0_type,errmsg,errflg) + CALL GFS_zt_wat(ZT_wat(i),ZNTstoch_wat(i),restar,WSPD(i),ZA(i),sfc_z0_type,device_errmsg,device_errflg) ZQ_wat(i)=ZT_wat(i) ENDIF ELSE @@ -1183,6 +1358,7 @@ SUBROUTINE SFCLAY1D_mynn(flag_iter, & rstoch1D(i),spp_sfc) ENDIF ENDIF + IF (debug_code > 1) THEN write(*,*)"=============Output ZT & ZQ over water:" write(*,*)"ZT:",ZT_wat(i)," ZQ:",ZQ_wat(i) @@ -1210,6 +1386,8 @@ SUBROUTINE SFCLAY1D_mynn(flag_iter, & else ZNTstoch_lnd(I) = ZNT_lnd(I) endif + !add limit to prevent ridiculous values of z0 (more than dz/15) + ZNTstoch_lnd(I) = min(ZNTstoch_lnd(I), dz8w1d(i)*0.0666_kind_phys) !-------------------------------------- ! LAND @@ -1230,9 +1408,16 @@ SUBROUTINE SFCLAY1D_mynn(flag_iter, & ELSEIF ( IZ0TLND .EQ. 2 ) THEN ! DH note - at this point, qstar is either not initialized ! or initialized to zero, but certainly not set correctly - errmsg = 'Logic error: qstar is not set correctly when calling Yang_2008' - errflg = 1 + device_special_errmsg = 'Logic error: qstar is not set correctly when calling Yang_2008' + device_special_errflg = 1 +#ifndef _OPENACC +! Necessary since OpenACC does not support branching in parallel code +! Must sync errmsg and errflg with device_errmsg and device_errflg, respectively +! so that proper error message and error flag codes are returned. + errmsg = device_special_errmsg + errflg = device_special_errflg return +#endif CALL Yang_2008(ZNTSTOCH_lnd(i),ZT_lnd(i),ZQ_lnd(i),UST_lnd(i),MOL(I),& qstar(I),restar,visc) ELSEIF ( IZ0TLND .EQ. 3 ) THEN @@ -1249,6 +1434,7 @@ SUBROUTINE SFCLAY1D_mynn(flag_iter, & UST_lnd(I),KARMAN,1.0_kind_phys,0,spp_sfc,rstoch1D(i)) ENDIF ENDIF + IF (ZNTstoch_lnd(i) < 1E-8 .OR. Zt_lnd(i) < 1E-10) THEN write(0,*)"===(land) capture bad input in mynn sfc layer, i=:",i write(0,*)" ZNT=", ZNTstoch_lnd(i)," ZT=",Zt_lnd(i) @@ -1258,7 +1444,6 @@ SUBROUTINE SFCLAY1D_mynn(flag_iter, & " dz=",dz8w1d(i)," qflx=",qflx_lnd(i)," hflx=",hflx_lnd(i)," hpbl=",pblh(i) ENDIF - GZ1OZ0_lnd(I)= LOG((ZA(I)+ZNTstoch_lnd(I))/ZNTstoch_lnd(I)) GZ1OZt_lnd(I)= LOG((ZA(I)+ZNTstoch_lnd(i))/ZT_lnd(i)) GZ2OZ0_lnd(I)= LOG((2.0+ZNTstoch_lnd(I))/ZNTstoch_lnd(I)) @@ -1821,6 +2006,26 @@ SUBROUTINE SFCLAY1D_mynn(flag_iter, & endif ! flag_iter ENDDO ! end i-loop +#ifdef _OPENACC +! Necessary since OpenACC does not support branching in parallel code. +! Must sync host errflg, errmsg to determine if return must be triggered +! and correct error message and error flag code returned. +! This code is being executed on the HOST side only, pulling data from DEVICE. +!$acc exit data copyout(device_special_errflg, device_special_errmsg) + IF (device_special_errflg /= 0) THEN + errflg = device_special_errflg + errmsg = device_special_errmsg + return + ENDIF +#endif + +!$acc serial present(wet, dry, icy, & +!$acc PSIM, PSIH, CPM, RHO1D, ZOL, wspd, MOL, & +!$acc wstar, qstar, THV1D, HFX, MAVAIL, QVSH, & +!$acc THVSK_wat, THVSK_lnd, THVSK_ice, & +!$acc UST_wat, UST_lnd, UST_ice, & +!$acc ZNTstoch_wat, ZNTstoch_lnd, ZNTstoch_ice, & +!$acc zt_wat, zt_lnd, zt_ice) IF (debug_code == 2) THEN DO I=its,ite IF(wet(i))write(*,*)"==== AT END OF MAIN LOOP, i=",i, "(wet)" @@ -1841,10 +2046,29 @@ SUBROUTINE SFCLAY1D_mynn(flag_iter, & write(*,*)"=============================================" ENDDO ! end i-loop ENDIF +!$acc end serial !---------------------------------------------------------- ! COMPUTE SURFACE HEAT AND MOISTURE FLUXES !---------------------------------------------------------- +!$acc parallel loop present(flag_iter, dry, wet, icy, & +!$acc QFX, HFX, FLHC, FLQC, LH, CHS, CH, CHS2, CQS2, & +!$acc RHO1D, MAVAIL, USTM, & +!$acc UST_lnd, UST_wat, UST_ice, & +!$acc PSIQ_lnd, PSIT_lnd, PSIX_lnd, & +!$acc PSIQ_wat, PSIT_wat, PSIX_wat, & +!$acc PSIQ_ice, PSIT_ice, PSIX_ice, & +!$acc PSIQ2_lnd, PSIT2_lnd, & +!$acc PSIQ2_wat, PSIT2_wat, & +!$acc PSIQ2_ice, PSIT2_ice, & +!$acc QSFC, QSFC_lnd, QSFC_wat, QSFC_ice, & +!$acc QFLX, QFLX_lnd, QFLX_wat, QFLX_ice, & +!$acc HFLX, HFLX_lnd, HFLX_wat, HFLX_ice, & +!$acc QSFCMR_lnd, QSFCMR_wat, QSFCMR_ice, & +!$acc QV1D, WSPD, WSPDI, CPM, TH1D, & +!$acc THSK_lnd, THSK_wat, THSK_ice, & +!$acc ch_lnd, ch_wat, ch_ice, & +!$acc cm_lnd, cm_wat, cm_ice) DO I=its,ite if( flag_iter(i) ) then @@ -2040,6 +2264,18 @@ SUBROUTINE SFCLAY1D_mynn(flag_iter, & ENDDO ! end i-loop IF (compute_diag) then + !$acc parallel loop present(flag_iter, dry, wet, icy, & + !$acc ZA, ZA2, T2, TH2, TH1D, Q2, QV1D, PSFCPA, & + !$acc THSK_lnd, THSK_wat, THSK_ice, & + !$acc QSFC_lnd, QSFC_wat, QSFC_ice, & + !$acc U10, V10, U1D, V1D, U1D2, V1D2, & + !$acc ZNTstoch_lnd, ZNTstoch_lnd, ZNTstoch_ice, & + !$acc PSIX_lnd, PSIX_wat, PSIX_ice, & + !$acc PSIX10_lnd, PSIX10_wat, PSIX10_ice, & + !$acc PSIT2_lnd, PSIT2_wat, PSIT2_ice, & + !$acc PSIT_lnd, PSIT_wat, PSIT_ice, & + !$acc PSIQ2_lnd, PSIQ2_wat, PSIQ2_ice, & + !$acc PSIQ_lnd, PSIQ_wat, PSIQ_ice) DO I=its,ite if( flag_iter(i) ) then !----------------------------------------------------- @@ -2153,6 +2389,16 @@ SUBROUTINE SFCLAY1D_mynn(flag_iter, & !----------------------------------------------------- ! DEBUG - SUSPICIOUS VALUES !----------------------------------------------------- +!$acc serial present(dry, wet, icy, CPM, MAVAIL, & +!$acc HFX, LH, wstar, RHO1D, PBLH, ZOL, ZA, MOL, & +!$acc PSIM, PSIH, WSTAR, T1D, TH1D, THV1D, QVSH, & +!$acc UST_wat, UST_lnd, UST_ice, & +!$acc THSK_wat, THSK_lnd, THSK_ice, & +!$acc THVSK_wat, THVSK_lnd, THVSK_ice, & +!$acc ZNTstoch_wat, ZNTstoch_lnd, ZNTstoch_ice, & +!$acc ZT_wat, ZT_lnd, ZT_ice, & +!$acc QSFC_wat, QSFC_lnd, QSFC_ice, & +!$acc PSIX_wat, PSIX_lnd, PSIX_ice) IF ( debug_code == 2) THEN DO I=its,ite yesno = 0 @@ -2257,6 +2503,62 @@ SUBROUTINE SFCLAY1D_mynn(flag_iter, & ENDIF ENDDO ! end i-loop ENDIF ! end debug option +!$acc end serial + +!$acc exit data copyout(CPM, FLHC, FLQC, CHS, CH, CHS2, CQS2,& +!$acc USTM, wstar, qstar, ZOL, MOL, RMOL, & +!$acc HFX, QFX, LH, QSFC, QFLX, HFLX, & +!$acc T2, TH2, Q2, WSPD, U10, V10, & +!$acc QGH, psim, psih, & +!$acc stress_wat, stress_lnd, stress_ice, & +!$acc rb_wat, rb_lnd, rb_ice, & +!$acc UST_wat, UST_lnd, UST_ice, & +!$acc ZNT_wat, ZNT_lnd, ZNT_ice, & +!$acc QSFC_lnd, QSFC_wat, QSFC_ice, & +!$acc QFLX_lnd, QFLX_wat, QFLX_ice, & +!$acc HFLX_lnd, HFLX_wat, HFLX_ice, & +!$acc PSIX_wat, PSIX_lnd, PSIX_ice, & +!$acc PSIX10_wat, PSIX10_lnd, PSIX10_ice, & +!$acc PSIT2_lnd, PSIT2_wat, PSIT2_ice, & +!$acc PSIT_lnd, PSIT_wat, PSIT_ice, & +!$acc ch_lnd, ch_wat, ch_ice, & +!$acc cm_lnd, cm_wat, cm_ice, & +!$acc device_errmsg, device_errflg) + +! Final sync of device and host error flags and messages +IF (device_errflg /= 0) THEN + errflg = device_errflg + errmsg = device_errmsg +ENDIF + +!$acc exit data delete( flag_iter, dry, wet, icy, dx, & +!$acc MAVAIL, PBLH, PSFCPA, z0pert, ztpert, & +!$acc QV1D, U1D, V1D, U1D2, V1D2, T1D, P1D, & +!$acc rstoch1D, sigmaf, shdmax, vegtype, & +!$acc dz2w1d, dz8w1d, & +!$acc snowh_wat, snowh_lnd, snowh_ice, & +!$acc tskin_wat, tskin_lnd, tskin_ice, & +!$acc tsurf_wat, tsurf_lnd, tsurf_ice) + +!$acc exit data delete( ZA, ZA2, THV1D, TH1D, TC1D, TV1D, & +!$acc RHO1D, QVSH, PSIH2, PSIM10, PSIH10, WSPDI, & +!$acc GOVRTH, PSFC, THCON, & +!$acc zratio_lnd, zratio_ice, zratio_wat, & +!$acc TSK_lnd, TSK_ice, TSK_wat, & +!$acc THSK_lnd, THSK_ice, THSK_wat, & +!$acc THVSK_lnd, THVSK_ice, THVSK_wat, & +!$acc GZ1OZ0_lnd, GZ1OZ0_ice, GZ1OZ0_wat, & +!$acc GZ1OZt_lnd, GZ1OZt_ice, GZ1OZt_wat, & +!$acc GZ2OZ0_lnd, GZ2OZ0_ice, GZ2OZ0_wat, & +!$acc GZ2OZt_lnd, GZ2OZt_ice, GZ2OZt_wat, & +!$acc GZ10OZ0_lnd, GZ10OZ0_ice, GZ10OZ0_wat, & +!$acc GZ10OZt_lnd, GZ10OZt_ice, GZ10OZt_wat, & +!$acc ZNTstoch_lnd, ZNTstoch_ice, ZNTstoch_wat, & +!$acc ZT_lnd, ZT_ice, ZT_wat, & +!$acc ZQ_lnd, ZQ_ice, ZQ_wat, & +!$acc PSIQ_lnd, PSIQ_ice, PSIQ_wat, & +!$acc PSIQ2_lnd, PSIQ2_ice, PSIQ2_wat, & +!$acc QSFCMR_lnd, QSFCMR_ice, QSFCMR_wat ) END SUBROUTINE SFCLAY1D_mynn !------------------------------------------------------------------- @@ -2272,6 +2574,7 @@ END SUBROUTINE SFCLAY1D_mynn SUBROUTINE zilitinkevich_1995(Z_0,Zt,Zq,restar,ustar,KARMAN,& & landsea,IZ0TLND2,spp_sfc,rstoch) + !$acc routine seq IMPLICIT NONE REAL(kind_phys), INTENT(IN) :: Z_0,restar,ustar,KARMAN,landsea INTEGER, OPTIONAL, INTENT(IN) :: IZ0TLND2 @@ -2309,7 +2612,7 @@ SUBROUTINE zilitinkevich_1995(Z_0,Zt,Zq,restar,ustar,KARMAN,& IF ( IZ0TLND2 .EQ. 1 ) THEN CZIL = 10.0 ** ( -0.40 * ( Z_0 / 0.07 ) ) ELSE - CZIL = 0.085 !0.075 !0.10 + CZIL = 0.095 !0.075 !0.10 END IF Zt = Z_0*EXP(-KARMAN*CZIL*SQRT(restar)) @@ -2341,6 +2644,7 @@ SUBROUTINE davis_etal_2008(Z_0,ustar) !This is an update version from Davis et al. 2008, which !corrects a small-bias in Z_0 (AHW real-time 2012). + !$acc routine seq IMPLICIT NONE REAL(kind_phys), INTENT(IN) :: ustar REAL(kind_phys), INTENT(OUT) :: Z_0 @@ -2368,7 +2672,7 @@ END SUBROUTINE davis_etal_2008 !>This formulation for roughness length was designed account for. !!wave steepness. SUBROUTINE Taylor_Yelland_2001(Z_0,ustar,wsp10) - + !$acc routine seq IMPLICIT NONE REAL(kind_phys), INTENT(IN) :: ustar,wsp10 REAL(kind_phys), INTENT(OUT) :: Z_0 @@ -2396,7 +2700,7 @@ END SUBROUTINE Taylor_Yelland_2001 !! The Charnock parameter CZC is varied from .011 to .018. !! between 10-m wsp = 10 and 18.. SUBROUTINE charnock_1955(Z_0,ustar,wsp10,visc,zu) - + !$acc routine seq IMPLICIT NONE REAL(kind_phys), INTENT(IN) :: ustar, visc, wsp10, zu REAL(kind_phys), INTENT(OUT) :: Z_0 @@ -2421,7 +2725,7 @@ END SUBROUTINE charnock_1955 !!The Charnock parameter CZC is varied from about .005 to .028 !!between 10-m wind speeds of 6 and 19 m/s. SUBROUTINE edson_etal_2013(Z_0,ustar,wsp10,visc,zu) - + !$acc routine seq IMPLICIT NONE REAL(kind_phys), INTENT(IN) :: ustar, visc, wsp10, zu REAL(kind_phys), INTENT(OUT) :: Z_0 @@ -2450,7 +2754,7 @@ END SUBROUTINE edson_etal_2013 !!data. The formula for land uses a constant ratio (Z_0/7.4) taken !!from Garratt (1992). SUBROUTINE garratt_1992(Zt,Zq,Z_0,Ren,landsea) - + !$acc routine seq IMPLICIT NONE REAL(kind_phys), INTENT(IN) :: Ren, Z_0,landsea REAL(kind_phys), INTENT(OUT) :: Zt,Zq @@ -2486,7 +2790,7 @@ END SUBROUTINE garratt_1992 !! !!This is for use over water only. SUBROUTINE fairall_etal_2003(Zt,Zq,Ren,ustar,visc,rstoch,spp_sfc) - + !$acc routine seq IMPLICIT NONE REAL(kind_phys), INTENT(IN) :: Ren,ustar,visc,rstoch INTEGER, INTENT(IN) :: spp_sfc @@ -2530,7 +2834,7 @@ END SUBROUTINE fairall_etal_2003 !! The actual reference is unknown. This was passed along by Jim Edson (personal communication). !! This is for use over water only, preferably open ocean. SUBROUTINE fairall_etal_2014(Zt,Zq,Ren,ustar,visc,rstoch,spp_sfc) - + !$acc routine seq IMPLICIT NONE REAL(kind_phys), INTENT(IN) :: Ren,ustar,visc,rstoch INTEGER, INTENT(IN) :: spp_sfc @@ -2578,6 +2882,7 @@ END SUBROUTINE fairall_etal_2014 !!This should only be used over land! SUBROUTINE Yang_2008(Z_0,Zt,Zq,ustar,tstar,qst,Ren,visc) + !$acc routine seq IMPLICIT NONE REAL(kind_phys), INTENT(IN) :: Z_0, Ren, ustar, tstar, qst, visc REAL(kind_phys) :: ht, &! roughness height at critical Reynolds number @@ -2613,6 +2918,7 @@ END SUBROUTINE Yang_2008 !>\ingroup mynn_sfc SUBROUTINE GFS_z0_lnd(z0max,shdmax,z1,vegtype,ivegsrc,z0pert) + !$acc routine seq REAL(kind_phys), INTENT(OUT) :: z0max REAL(kind_phys), INTENT(IN) :: shdmax,z1,z0pert INTEGER, INTENT(IN) :: vegtype,ivegsrc @@ -2673,6 +2979,7 @@ END SUBROUTINE GFS_z0_lnd !>\ingroup mynn_sfc SUBROUTINE GFS_zt_lnd(ztmax,z0max,sigmaf,ztpert,ustar_lnd) + !$acc routine seq REAL(kind_phys), INTENT(OUT) :: ztmax REAL(kind_phys), INTENT(IN) :: z0max,sigmaf,ztpert,ustar_lnd REAL(kind_phys) :: czilc, tem1, tem2 @@ -2701,6 +3008,7 @@ END SUBROUTINE GFS_zt_lnd !>\ingroup mynn_sfc SUBROUTINE GFS_z0_wat(z0rl_wat,ustar_wat,WSPD,z1,sfc_z0_type,redrag) + !$acc routine seq REAL(kind_phys), INTENT(OUT) :: z0rl_wat REAL(kind_phys), INTENT(INOUT):: ustar_wat REAL(kind_phys), INTENT(IN) :: wspd,z1 @@ -2752,19 +3060,27 @@ SUBROUTINE GFS_z0_wat(z0rl_wat,ustar_wat,WSPD,z1,sfc_z0_type,redrag) END SUBROUTINE GFS_z0_wat !-------------------------------------------------------------------- !>\ingroup mynn_sfc - SUBROUTINE GFS_zt_wat(ztmax,z0rl_wat,restar,WSPD,z1,sfc_z0_type,errmsg,errflg) - + SUBROUTINE GFS_zt_wat(ztmax,z0rl_wat,restar,WSPD,z1,sfc_z0_type,device_errmsg,device_errflg) + !$acc routine seq real(kind_phys), INTENT(OUT) :: ztmax real(kind_phys), INTENT(IN) :: wspd,z1,z0rl_wat,restar INTEGER, INTENT(IN) :: sfc_z0_type - character(len=*), intent(out) :: errmsg - integer, intent(out) :: errflg + +! Using device_errmsg and device_errflg rather than the CCPP errmsg and errflg +! so that this subroutine can be run on an accelerator device with OpenACC. +! character(len=*), intent(out) :: errmsg +! integer, intent(out) :: errflg + character(len=512), intent(out) :: device_errmsg + integer, intent(out) :: device_errflg + real(kind_phys) :: z0,z0max,wind10m,rat,ustar_wat real(kind_phys), PARAMETER :: charnock = 0.014, z0s_max=.317e-2 ! Initialize error-handling - errflg = 0 - errmsg = '' +! errflg = 0 +! errmsg = '' + device_errflg = 0 + device_errmsg = '' ! z0 = 0.01 * z0rl_wat !Already converted to meters in the wrapper @@ -2795,9 +3111,12 @@ SUBROUTINE GFS_zt_wat(ztmax,z0rl_wat,restar,WSPD,z1,sfc_z0_type,errmsg,errflg) 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 - errflg = 1 - errmsg = 'ERROR(GFS_zt_wat): sfc_z0_type not valid.' +! errflg = 1 +! errmsg = 'ERROR(GFS_zt_wat): sfc_z0_type not valid.' + device_errflg = 1 + device_errmsg = 'ERROR(GFS_zt_wat): sfc_z0_type not valid.' return + endif END SUBROUTINE GFS_zt_wat @@ -2807,6 +3126,7 @@ END SUBROUTINE GFS_zt_wat !! Weiguo Wang, 2019-0425 SUBROUTINE znot_m_v6(uref, znotm) + !$acc routine seq use machine , only : kind_phys IMPLICIT NONE ! Calculate areodynamical roughness over water with input 10-m wind @@ -2856,6 +3176,7 @@ END SUBROUTINE znot_m_v6 !! SUBROUTINE znot_t_v6(uref, znott) + !$acc routine seq IMPLICIT NONE !> Calculate scalar roughness over water with input 10-m wind !! For low-to-moderate winds, try to match the Ck-U10 relationship from COARE algorithm @@ -2922,6 +3243,7 @@ END SUBROUTINE znot_t_v6 !! SUBROUTINE znot_m_v7(uref, znotm) + !$acc routine seq IMPLICIT NONE !> Calculate areodynamical roughness over water with input 10-m wind !! For low-to-moderate winds, try to match the Cd-U10 relationship from COARE V3.5 (Edson et al. 2013) @@ -2971,6 +3293,7 @@ END SUBROUTINE znot_m_v7 !! SUBROUTINE znot_t_v7(uref, znott) + !$acc routine seq IMPLICIT NONE !> Calculate scalar roughness over water with input 10-m wind !! For low-to-moderate winds, try to match the Ck-U10 relationship from COARE algorithm @@ -3040,6 +3363,7 @@ END SUBROUTINE znot_t_v7 !! This should only be used over snow/ice! SUBROUTINE Andreas_2002(Z_0,bvisc,ustar,Zt,Zq) + !$acc routine seq IMPLICIT NONE REAL(kind_phys), INTENT(IN) :: Z_0, bvisc, ustar REAL(kind_phys), INTENT(OUT) :: Zt, Zq @@ -3313,6 +3637,7 @@ END SUBROUTINE PSI_CB2005 !! and Holtslag (1991) for stable conditions. SUBROUTINE Li_etal_2010(zL, Rib, zaz0, z0zt) + !$acc routine seq IMPLICIT NONE REAL(kind_phys), INTENT(OUT) :: zL REAL(kind_phys), INTENT(IN) :: Rib, zaz0, z0zt @@ -3471,6 +3796,7 @@ REAL(kind_phys) function zolri2(zol2,ri2,za,z0,zt,psi_opt) REAL(kind_phys) function zolrib(ri,za,z0,zt,logz0,logzt,zol1,psi_opt) + !$acc routine seq ! This iterative algorithm to compute z/L from bulk-Ri IMPLICIT NONE @@ -3480,7 +3806,7 @@ REAL(kind_phys) function zolrib(ri,za,z0,zt,logz0,logzt,zol1,psi_opt) REAL(kind_phys) :: zol20,zol3,zolt,zolold INTEGER :: n INTEGER, PARAMETER :: nmax = 20 - REAL(kind_phys), DIMENSION(nmax):: zLhux + !REAL(kind_phys), DIMENSION(nmax):: zLhux REAL(kind_phys) :: psit2,psix2 !print*,"+++++++INCOMING: z/L=",zol1," ri=",ri @@ -3522,7 +3848,7 @@ REAL(kind_phys) function zolrib(ri,za,z0,zt,logz0,logzt,zol1,psi_opt) endif !print*,"n=",n," psit2=",psit2," psix2=",psix2 zolrib=ri*psix2**2/psit2 - zLhux(n)=zolrib + !zLhux(n)=zolrib n=n+1 enddo @@ -3530,7 +3856,7 @@ REAL(kind_phys) function zolrib(ri,za,z0,zt,logz0,logzt,zol1,psi_opt) !print*,"iter FAIL, n=",n," Ri=",ri," z/L=",zolri !if convergence fails, use approximate values: CALL Li_etal_2010(zolrib, ri, za/z0, z0/zt) - zLhux(n)=zolrib + !zLhux(n)=zolrib !print*,"FAILED, n=",n," Ri=",ri," z0=",z0 !print*,"z/L=",zLhux(1:nmax) else @@ -3595,6 +3921,7 @@ END SUBROUTINE psi_init ! !>\ingroup mynn_sfc real(kind_phys) function psim_stable_full(zolf) + !$acc routine seq real(kind_phys) :: zolf !psim_stable_full=-6.1*log(zolf+(1+zolf**2.5)**(1./2.5)) @@ -3605,6 +3932,7 @@ real(kind_phys) function psim_stable_full(zolf) !>\ingroup mynn_sfc real(kind_phys) function psih_stable_full(zolf) + !$acc routine seq real(kind_phys) :: zolf !psih_stable_full=-5.3*log(zolf+(1+zolf**1.1)**(1./1.1)) @@ -3615,6 +3943,7 @@ real(kind_phys) function psih_stable_full(zolf) !>\ingroup mynn_sfc real(kind_phys) function psim_unstable_full(zolf) + !$acc routine seq real(kind_phys) :: zolf,x,ym,psimc,psimk x=(1.-16.*zolf)**.25 @@ -3633,6 +3962,7 @@ real(kind_phys) function psim_unstable_full(zolf) !>\ingroup mynn_sfc real(kind_phys) function psih_unstable_full(zolf) + !$acc routine seq real(kind_phys) :: zolf,y,yh,psihc,psihk y=(1.-16.*zolf)**.5 @@ -3654,6 +3984,7 @@ real(kind_phys) function psih_unstable_full(zolf) !>\ingroup mynn_sfc !! REAL(kind_phys) function psim_stable_full_gfs(zolf) + !$acc routine seq REAL(kind_phys) :: zolf REAL(kind_phys), PARAMETER :: alpha4 = 20. REAL(kind_phys) :: aa @@ -3667,6 +3998,7 @@ REAL(kind_phys) function psim_stable_full_gfs(zolf) !>\ingroup mynn_sfc !! real(kind_phys) function psih_stable_full_gfs(zolf) + !$acc routine seq real(kind_phys) :: zolf real(kind_phys), PARAMETER :: alpha4 = 20. real(kind_phys) :: bb @@ -3680,6 +4012,7 @@ real(kind_phys) function psih_stable_full_gfs(zolf) !>\ingroup mynn_sfc !! real(kind_phys) function psim_unstable_full_gfs(zolf) + !$acc routine seq real(kind_phys) :: zolf real(kind_phys) :: hl1,tem1 real(kind_phys), PARAMETER :: a0=-3.975, a1=12.32, & @@ -3700,6 +4033,7 @@ real(kind_phys) function psim_unstable_full_gfs(zolf) !>\ingroup mynn_sfc !! real(kind_phys) function psih_unstable_full_gfs(zolf) + !$acc routine seq real(kind_phys) :: zolf real(kind_phys) :: hl1,tem1 real(kind_phys), PARAMETER :: a0p=-7.941, a1p=24.75, & @@ -3720,6 +4054,7 @@ real(kind_phys) function psih_unstable_full_gfs(zolf) !>\ingroup mynn_sfc !! look-up table functions - or, if beyond -10 < z/L < 10, recalculate real(kind_phys) function psim_stable(zolf,psi_opt) + !$acc routine seq integer :: nzol,psi_opt real(kind_phys) :: rzol,zolf @@ -3740,6 +4075,7 @@ real(kind_phys) function psim_stable(zolf,psi_opt) !>\ingroup mynn_sfc real(kind_phys) function psih_stable(zolf,psi_opt) + !$acc routine seq integer :: nzol,psi_opt real(kind_phys) :: rzol,zolf @@ -3760,6 +4096,7 @@ real(kind_phys) function psih_stable(zolf,psi_opt) !>\ingroup mynn_sfc real(kind_phys) function psim_unstable(zolf,psi_opt) + !$acc routine seq integer :: nzol,psi_opt real(kind_phys) :: rzol,zolf @@ -3780,6 +4117,7 @@ real(kind_phys) function psim_unstable(zolf,psi_opt) !>\ingroup mynn_sfc real(kind_phys) function psih_unstable(zolf,psi_opt) + !$acc routine seq integer :: nzol,psi_opt real(kind_phys) :: rzol,zolf diff --git a/physics/mynnsfc_wrapper.F90 b/physics/SFC_Layer/MYNN/mynnsfc_wrapper.F90 similarity index 92% rename from physics/mynnsfc_wrapper.F90 rename to physics/SFC_Layer/MYNN/mynnsfc_wrapper.F90 index 1a970c9f4..8df0116a8 100644 --- a/physics/mynnsfc_wrapper.F90 +++ b/physics/SFC_Layer/MYNN/mynnsfc_wrapper.F90 @@ -135,7 +135,7 @@ SUBROUTINE mynnsfc_wrapper_run( & integer, dimension(:), intent(in) :: vegtype real(kind_phys), dimension(:), intent(in) :: & & sigmaf,shdmax,z0pert,ztpert - real(kind_phys), dimension(:,:), intent(in) :: & + real(kind_phys), dimension(:,:), intent(in), optional :: & & spp_wts_sfc real(kind_phys), dimension(:,:), & @@ -168,15 +168,17 @@ SUBROUTINE mynnsfc_wrapper_run( & !MYNN-2D real(kind_phys), dimension(:), intent(in) :: & - & dx, pblh, slmsk, ps, & + & dx, pblh, slmsk, ps + real(kind_phys), dimension(:), intent(in),optional :: & & qsfc_lnd_ruc, qsfc_ice_ruc real(kind_phys), dimension(:), intent(inout) :: & - & ustm, hflx, qflx, wspd, qsfc, & + & hflx, qflx, wspd, qsfc, & & FLHC, FLQC, U10, V10, TH2, T2, Q2, & - & CHS2, CQS2, rmol, zol, mol, ch, & - & lh, wstar - !LOCAL + & rmol, ch + real(kind_phys), dimension(:), intent(inout), optional :: & + & ustm, zol, mol, lh, wstar, CHS2, CQS2 + !LOCAL real(kind_phys), dimension(im) :: & & hfx, znt, psim, psih, & & chs, ck, cd, mavail, xland, GZ1OZ0, & @@ -191,6 +193,16 @@ SUBROUTINE mynnsfc_wrapper_run( & & IMS,IME,JMS,JME,KMS,KME, & & ITS,ITE,JTS,JTE,KTS,KTE +!$acc enter data create(hfx, znt, psim, psih, chs, & +!$acc mavail, xland, GZ1OZ0, cpm, qgh, & +!$acc qfx, snowh_wat) + +!$acc enter data create(dz, th, qv) + +!$acc enter data copyin(rmol, phii, t3d, exner, qvsh, slmsk, xland) + +!$acc enter data copyin(dry, wet, icy, znt_lnd, znt_wat, znt_ice, qsfc_lnd, qsfc_ice, qsfc_lnd_ruc, qsfc_ice_ruc) + ! Initialize CCPP error handling variables errmsg = '' errflg = 0 @@ -203,6 +215,7 @@ SUBROUTINE mynnsfc_wrapper_run( & ! write(0,*)"iter=",iter ! endif +!$acc kernels ! prep MYNN-only variables dz(:,:) = 0 th(:,:) = 0 @@ -210,6 +223,9 @@ SUBROUTINE mynnsfc_wrapper_run( & hfx(:) = 0 qfx(:) = 0 rmol(:) = 0 +!$acc end kernels + +!$acc parallel loop collapse(2) present(dz, phii, th, t3d, exner, qv, qvsh) do k=1,2 !levs do i=1,im dz(i,k)=(phii(i,k+1) - phii(i,k))*g_inv @@ -219,6 +235,7 @@ SUBROUTINE mynnsfc_wrapper_run( & enddo enddo +!$acc parallel loop present(slmsk, xland, qgh, mavail, cpm, snowh_wat) 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 SFCLAY_mynn @@ -235,6 +252,7 @@ SUBROUTINE mynnsfc_wrapper_run( & snowh_wat(i) = 0.0 enddo +!$acc kernels ! cm -> m where (dry) znt_lnd=znt_lnd*0.01 where (wet) znt_wat=znt_wat*0.01 @@ -245,6 +263,7 @@ SUBROUTINE mynnsfc_wrapper_run( & where (dry) qsfc_lnd = qsfc_lnd_ruc/(1.+qsfc_lnd_ruc) ! spec. hum where (icy) qsfc_ice = qsfc_ice_ruc/(1.+qsfc_ice_ruc) ! spec. hum. end if +!$acc end kernels ! if (lprnt) then ! write(0,*)"CALLING SFCLAY_mynn; input:" @@ -274,6 +293,8 @@ SUBROUTINE mynnsfc_wrapper_run( & ! write(0,*)"PBLH=",pblh(1)," xland=",xland(1) ! endif +!$acc exit data delete(qsfc_lnd_ruc, qsfc_ice_ruc) +!$acc exit data delete(phii, qvsh, slmsk) CALL SFCLAY_mynn( & u3d=u,v3d=v,t3d=t3d,qv3d=qv,p3d=prsl,dz8w=dz, & @@ -318,6 +339,13 @@ SUBROUTINE mynnsfc_wrapper_run( & errmsg=errmsg, errflg=errflg ) if (errflg/=0) return +!$acc exit data delete(hfx, znt, psim, psih, chs, & +!$acc mavail, xland, GZ1OZ0, cpm, qgh, & +!$acc qfx, snowh_wat, t3d, exner) +!$acc exit data delete(dz, th, qv) +!$acc exit data copyout(rmol) +!$acc exit data copyout(qsfc_lnd, qsfc_ice) + !! POST MYNN SURFACE LAYER (INTERSTITIAL) WORK: !do i = 1, im ! !* Taken from sfc_nst.f @@ -336,10 +364,15 @@ SUBROUTINE mynnsfc_wrapper_run( & ! znt_ice(i)=znt_ice(i)*100. !enddo +!$acc kernels ! m -> cm where (dry) znt_lnd=znt_lnd*100. where (wet) znt_wat=znt_wat*100. where (icy) znt_ice=znt_ice*100. +!$acc end kernels + +!$acc exit data delete(dry, wet, icy) +!$acc exit data copyout(znt_lnd, znt_wat, znt_ice) ! if (lprnt) then ! write(0,*) diff --git a/physics/mynnsfc_wrapper.meta b/physics/SFC_Layer/MYNN/mynnsfc_wrapper.meta similarity index 98% rename from physics/mynnsfc_wrapper.meta rename to physics/SFC_Layer/MYNN/mynnsfc_wrapper.meta index d89cc5d35..957beacbb 100644 --- a/physics/mynnsfc_wrapper.meta +++ b/physics/SFC_Layer/MYNN/mynnsfc_wrapper.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = mynnsfc_wrapper type = scheme - dependencies = machine.F,module_sf_mynn.F90 + dependencies = ../../hooks/machine.F,../../hooks/physcons.F90,module_sf_mynn.F90 ######################################################################## [ccpp-arg-table] @@ -702,6 +702,7 @@ type = real kind = kind_phys intent = in + optional = True [qsfc_ice_ruc] standard_name = water_vapor_mixing_ratio_at_surface_over_ice long_name = water vapor mixing ratio at surface over ice @@ -710,6 +711,7 @@ type = real kind = kind_phys intent = in + optional = True [ustm] standard_name = surface_friction_velocity_for_momentum long_name = friction velocity isolated for momentum only @@ -718,6 +720,7 @@ type = real kind = kind_phys intent = inout + optional = True [zol] standard_name = ratio_of_height_to_monin_obukhov_length long_name = monin obukhov surface stability parameter @@ -726,6 +729,7 @@ type = real kind = kind_phys intent = inout + optional = True [mol] standard_name = surface_temperature_scale long_name = temperature flux divided by ustar (temperature scale) @@ -734,6 +738,7 @@ type = real kind = kind_phys intent = inout + optional = True [rmol] standard_name = reciprocal_of_obukhov_length long_name = one over obukhov length @@ -782,6 +787,7 @@ type = real kind = kind_phys intent = inout + optional = True [flhc] standard_name = surface_exchange_coefficient_for_heat long_name = surface exchange coefficient for heat @@ -846,6 +852,7 @@ type = real kind = kind_phys intent = inout + optional = True [chs2] standard_name = surface_exchange_coefficient_for_heat_at_2m long_name = exchange coefficient for heat at 2 meters @@ -854,6 +861,7 @@ type = real kind = kind_phys intent = inout + optional = True [cqs2] standard_name = surface_exchange_coefficient_for_moisture_at_2m long_name = exchange coefficient for moisture at 2 meters @@ -862,6 +870,7 @@ type = real kind = kind_phys intent = inout + optional = True [spp_wts_sfc] standard_name = spp_weights_for_surface_layer_scheme long_name = spp weights for surface layer scheme @@ -870,6 +879,7 @@ type = real kind = kind_phys intent = in + optional = True [spp_sfc] standard_name = control_for_surface_layer_spp_perturbations long_name = control for surface layer spp perturbations diff --git a/physics/date_def.f b/physics/SFC_Layer/UFS/date_def.f similarity index 100% rename from physics/date_def.f rename to physics/SFC_Layer/UFS/date_def.f diff --git a/physics/SFC_Layer/UFS/module_nst_model.f90 b/physics/SFC_Layer/UFS/module_nst_model.f90 new file mode 100644 index 000000000..74c75924b --- /dev/null +++ b/physics/SFC_Layer/UFS/module_nst_model.f90 @@ -0,0 +1,976 @@ +!>\file module_nst_model.f90 +!! This file contains the diurnal thermocline layer model (DTM) of +!! the GFS NSST scheme. + +!>\defgroup dtm_module GFS NSST Diurnal Thermocline Model +!> This module contains the diurnal thermocline layer model (DTM) of +!! the GFS NSST scheme. +!>\ingroup gfs_nst_main_mod + +!> This module contains the diurnal thermocline layer model (DTM) of +!! the GFS NSST scheme. +module nst_module + ! + ! the module of diurnal thermocline layer model + ! + use machine , only : kind_phys + use module_nst_parameters , only : z_w_max, z_w_min, z_w_ini, eps_z_w, eps_conv + use module_nst_parameters , only : eps_sfs, niter_z_w, niter_conv, niter_sfs, ri_c + use module_nst_parameters , only : ri_g, omg_m, omg_sh, kw => tc_w, visw, t0k, cp_w + use module_nst_parameters , only : z_c_max, z_c_ini, ustar_a_min, delz, exp_const + use module_nst_parameters , only : rad2deg, const_rot, tw_max, sst_max + use module_nst_parameters , only : zero, one + use module_nst_water_prop , only : sw_rad_skin, sw_ps_9b, sw_ps_9b_aw + + implicit none + + private + + public :: dtm_1p, dtm_1p_fca, dtm_1p_tla, dtm_1p_mwa, dtm_1p_mda, dtm_1p_mta, convdepth + public :: cal_w, cal_ttop, cool_skin, dtl_reset + +contains + + !>\ingroup gfs_nst_main_mod + !! This subroutine contains the module of diurnal thermocline layer model. + subroutine dtm_1p(kdt,timestep,rich,tox,toy,i0,q,sss,sep,q_ts,hl_ts,rho, & + alpha,beta,alon,sinlat,soltim,grav,le,d_conv, & + xt,xs,xu,xv,xz,xzts,xtts) + + integer, intent(in) :: kdt + real(kind=kind_phys), intent(in) :: timestep,rich,tox,toy,i0,q,sss,sep,q_ts,& + hl_ts,rho,alpha,beta,alon,sinlat,soltim,& + grav,le,d_conv + real(kind=kind_phys), intent(inout) :: xt,xs,xu,xv,xz,xzts,xtts + ! local variables + + ! + ! input variables + ! + ! timestep: integration time step in seconds + ! rich : critical ri (flow dependent) + ! tox : x wind stress (n*m^-2 or kg/m/s^2) + ! toy : y wind stress (n*m^-2 or kg/m/s^2) + ! i0 : solar radiation flux at the surface (wm^-2) + ! q : non-solar heat flux at the surface (wm^-2) + ! sss : salinity (ppt) + ! sep : sr(e-p) (ppt*m/s) + ! q_ts : d(q)/d(ts) : q = the sum of non-solar heat fluxes + ! hl_ts : d(hl)/d(ts) + ! rho : sea water density (kg*m^-3) + ! alpha : thermal expansion coefficient (1/k) + ! beta : saline contraction coefficient (1/ppt) + ! sinlat : sine (lat) + ! grav : gravity accelleration + ! le : le=(2.501-.00237*tsea)*1e6 + ! d-conv : fcl thickness + ! + ! inout variables + ! + ! xt : dtl heat content (m*k) + ! xs : dtl salinity content (m*ppt) + ! xu : dtl x current content (m*m/s) + ! xv : dtl y current content (m*m/s) + ! xz : dtl thickness (m) + ! xzts : d(xz)/d(ts) (m/k ) + ! xtts : d(xt)/d(ts) (m) + ! + ! logical lprnt + + ! if (lprnt) print *,' first xt=',xt + if ( xt <= zero ) then ! dtl doesn't exist yet + call dtm_onset(kdt,timestep,rich,tox,toy,i0,q,sss,sep,q_ts,hl_ts,rho,alpha, & + beta,alon,sinlat,soltim,grav,le,xt,xs,xu,xv,xz,xzts,xtts) + elseif ( xt > zero ) then ! dtl already exists + ! + ! forward the system one time step + ! + call eulerm(kdt,timestep,rich,tox,toy,i0,q,sss,sep,q_ts,hl_ts,rho,alpha, & + beta,alon,sinlat,soltim,grav,le,d_conv, & + xt,xs,xu,xv,xz,xzts,xtts) + endif ! if ( xt == 0 ) then + + end subroutine dtm_1p + + !>\ingroup gfs_nst_main_mod + !! This subroutine integrates one time step with modified Euler method. + subroutine eulerm(kdt,timestep,rich,tox,toy,i0,q,sss,sep,q_ts,hl_ts,rho,alpha, & + beta,alon,sinlat,soltim,grav,le,d_conv, & + xt,xs,xu,xv,xz,xzts,xtts) + + ! + ! subroutine eulerm: integrate one time step with modified euler method + ! + integer, intent(in) :: kdt + real(kind=kind_phys), intent(in) :: timestep,rich,tox,toy,i0,q,sss,sep,q_ts, & + hl_ts,rho,alpha,beta,alon,sinlat,soltim, & + grav,le,d_conv + real(kind=kind_phys), intent(inout) :: xt,xs,xu,xv,xz,xzts,xtts + ! local variables + real(kind=kind_phys) :: xt0,xs0,xu0,xv0,xz0,xzts0,xtts0 + real(kind=kind_phys) :: fw,aw,q_warm + real(kind=kind_phys) :: xt1,xs1,xu1,xv1,xz1,xzts1,xtts1 + real(kind=kind_phys) :: xt2,xs2,xu2,xv2,xz2,xzts2,xtts2 + real(kind=kind_phys) :: dzw,drho,fc + real(kind=kind_phys) :: alat,speed + ! logical lprnt + + ! + ! input variables + ! + ! timestep: integration time step in seconds + ! rich : critial ri (flow/mass dependent) + ! tox : x wind stress (n*m^-2 or kg/m/s^2) + ! toy : y wind stress (n*m^-2 or kg/m/s^2) + ! i0 : solar radiation flux at the surface (wm^-2) + ! q : non-solar heat flux at the surface (wm^-2) + ! sss : salinity (ppt) + ! sep : sr(e-p) (ppt*m/s) + ! q_ts : d(q)/d(ts) : q = the sum of non-solar heat fluxes + ! hl_ts : d(hl)/d(ts) + ! rho : sea water density (kg*m^-3) + ! alpha : thermal expansion coefficient (1/k) + ! beta : saline contraction coefficient (1/ppt) + ! alon : longitude (deg) + ! sinlat : sine (lat) + ! soltim : solar time + ! grav : gravity accelleration + ! le : le=(2.501-.00237*tsea)*1e6 + ! d_conv : fcl thickness (m) + ! + ! inout variables + ! + ! xt : dtl heat content (m*k) + ! xs : dtl salinity content (m*ppt) + ! xu : dtl x current content (m*m/s) + ! xv : dtl y current content (m*m/s) + ! xz : dtl thickness (m) + ! xzts : d(xz)/d(ts) (m/k ) + ! xtts : d(xt)/d(ts) (m) + + xt0 = xt + xs0 = xs + xu0 = xu + xv0 = xv + xz0 = xz + xtts0 = xtts + xzts0 = xzts + speed = max(1.0e-8, xu0*xu0+xv0*xv0) + + alat = asin(sinlat)*rad2deg + + fc = const_rot*sinlat + + call sw_ps_9b(xz0,fw) + + q_warm = fw*i0-q !total heat abs in warm layer + + call sw_ps_9b_aw(xz0,aw) + + drho = -alpha*q_warm/(rho*cp_w) + omg_m*beta*sep + + ! dzw = xz0*(tox*xu0+toy*xv0) / (rho*(xu0*xu0+xv0*xv0)) & + ! + xz0*xz0*xz0*drho*grav / (4.0*rich*(xu0*xu0+xv0*xv0)) + dzw = xz0 * ((tox*xu0+toy*xv0) / (rho*speed) & + + xz0*xz0*drho*grav / (4.0*rich*speed)) + + xt1 = xt0 + timestep*q_warm/(rho*cp_w) + xs1 = xs0 + timestep*sep + xu1 = xu0 + timestep*(fc*xv0+tox/rho) + xv1 = xv0 + timestep*(-fc*xu0+toy/rho) + xz1 = xz0 + timestep*dzw + + ! if (lprnt) print *,' xt1=',xt1,' xz1=',xz1,' xz0=',xz0,' dzw=',dzw, & + ! 'timestep=',timestep,tox,toy,xu0,xv0,rho,drho,grav,rich + + if ( xt1 <= zero .or. xz1 <= zero .or. xz1 > z_w_max ) then + call dtl_reset(xt,xs,xu,xv,xz,xzts,xtts) + return + endif + + ! call dtm_1p_zwa(kdt,timestep,i0,q,rho,d_conv,xt1,xs1,xu1,xv1,xz1,tr_mda,tr_fca,tr_tla,tr_mwa) + + xzts1 = xzts0 + timestep*((1.0/(xu0*xu0+xv0*xv0)) * & + ( (alpha*q_ts/cp_w+omg_m*beta*sss*hl_ts/le)*grav*xz0**3/(4.0*rich*rho) & + +( (tox*xu0+toy*xv0)/rho+(3.0*drho-alpha*i0*aw*xz0/(rho*cp_w)) & + *grav*xz0*xz0/(4.0*rich) )*xzts0 )) + xtts1 = xtts0 + timestep*(i0*aw*xzts0-q_ts)/(rho*cp_w) + + ! if ( 2.0*xt1/xz1 > 0.001 ) then + ! write(*,'(a,i5,2f8.3,4f8.2,f10.6,10f8.4)') 'eulerm_01 : ',kdt,alat,alon,soltim/3600.,i0,q,q_warm,sep,& + ! 2.0*xt1/xz1,2.0*xs1/xz1,2.0*xu1/xz1,2.0*xv1/xz1,xz1,xtts1,xzts1,d_conv,t_fcl,te + ! endif + + call sw_ps_9b(xz1,fw) + q_warm = fw*i0-q !total heat abs in warm layer + call sw_ps_9b_aw(xz1,aw) + drho = -alpha*q_warm/(rho*cp_w) + omg_m*beta*sep + dzw = xz1*(tox*xu1+toy*xv1) / (rho*(xu1*xu1+xv1*xv1)) & + + xz1*xz1*xz1*drho*grav / (4.0*rich*(xu1*xu1+xv1*xv1)) + + xt2 = xt0 + timestep*q_warm/(rho*cp_w) + xs2 = xs0 + timestep*sep + xu2 = xu0 + timestep*(fc*xv1+tox/rho) + xv2 = xv0 + timestep*(-fc*xu1+toy/rho) + xz2 = xz0 + timestep*dzw + + ! if (lprnt) print *,' xt2=',xt2,' xz2=',xz2 + + if ( xt2 <= zero .or. xz2 <= zero .or. xz2 > z_w_max ) then + call dtl_reset(xt,xs,xu,xv,xz,xzts,xtts) + return + endif + + xzts2 = xzts0 + timestep*((1.0/(xu1*xu1+xv1*xv1)) * & + ( (alpha*q_ts/cp_w+omg_m*beta*sss*hl_ts/le)*grav*xz1**3/(4.0*rich*rho) & + +( (tox*xu1+toy*xv1)/rho+(3.0*drho-alpha*i0*aw*xz1/(rho*cp_w))* & + grav*xz1*xz1/(4.0*rich) )*xzts1 )) + xtts2 = xtts0 + timestep*(i0*aw*xzts1-q_ts)/(rho*cp_w) + + xt = 0.5*(xt1 + xt2) + xs = 0.5*(xs1 + xs2) + xu = 0.5*(xu1 + xu2) + xv = 0.5*(xv1 + xv2) + xz = 0.5*(xz1 + xz2) + xzts = 0.5*(xzts1 + xzts2) + xtts = 0.5*(xtts1 + xtts2) + + if ( xt <= zero .or. xz < zero .or. xz > z_w_max ) then + call dtl_reset(xt,xs,xu,xv,xz,xzts,xtts) + endif + + ! if (lprnt) print *,' xt=',xt,' xz=',xz + ! if ( 2.0*xt/xz > 0.001 ) then + ! write(*,'(a,i5,2f8.3,4f8.2,f10.6,10f8.4)') 'eulerm_02 : ',kdt,alat,alon,soltim/3600.,i0,q,q_warm,sep,& + ! 2.0*xt/xz,2.0*xs/xz,2.0*xu/xz,2.0*xv/xz,xz,xtts,xzts,d_conv,t_fcl,te + ! endif + return + + end subroutine eulerm + + !>\ingroup gfs_nst_main_mod + !! This subroutine applies xz adjustment. + subroutine dtm_1p_zwa(kdt,timestep,i0,q,rho,d_conv,xt,xs,xu,xv,xz,tr_mda,tr_fca,tr_tla,tr_mwa) + ! apply xz adjustment: minimum depth adjustment (mda) + ! free convection adjustment (fca); + ! top layer adjustment (tla); + ! maximum warming adjustment (mwa) + ! + integer, intent(in) :: kdt + real(kind=kind_phys), intent(in) :: timestep,i0,q,rho,d_conv + real(kind=kind_phys), intent(inout) :: xt,xs,xu,xv,xz + real(kind=kind_phys), intent(out) :: tr_mda,tr_fca,tr_tla,tr_mwa + ! local variables + real(kind=kind_phys) :: dz,t0,ttop0,ttop,fw,q_warm + ! TODO: xz_mwa is unset but used below in max function + real(kind=kind_phys) :: xz_fca,xz_tla,xz_mwa + ! + real(kind=kind_phys) :: xz_mda + + tr_mda = zero; tr_fca = zero; tr_tla = zero; tr_mwa = zero + + ! apply mda + if ( z_w_min > xz ) then + xz_mda = z_w_min + endif + ! apply fca + if ( d_conv > zero ) then + xz_fca = 2.0*xt/((2.0*xt/xz)*(1.0-d_conv/(2.0*xz))) + tr_fca = 1.0 + if ( xz_fca >= z_w_max ) then + call dtl_reset_cv(xt,xs,xu,xv,xz) + go to 10 + endif + endif + ! apply tla + dz = min(xz,max(d_conv,delz)) + call sw_ps_9b(dz,fw) + q_warm=fw*i0-q !total heat abs in warm layer + + if ( q_warm > zero ) then + call cal_ttop(kdt,timestep,q_warm,rho,dz,xt,xz,ttop0) + ! ttop = (2.0*xt/xz)*(1.0-dz/(2.0*xz)) + ttop = ((xt+xt)/xz)*(1.0-dz/(xz+xz)) + if ( ttop > ttop0 ) then + xz_tla = (xt+sqrt(xt*(xt-delz*ttop0)))/ttop0 + tr_tla = 1.0 + if ( xz_tla >= z_w_max ) then + call dtl_reset_cv(xt,xs,xu,xv,xz) + go to 10 + endif + endif + endif + + ! apply mwa + t0 = 2.0*xt/xz + if ( t0 > tw_max ) then + if ( xz >= z_w_max ) then + call dtl_reset_cv(xt,xs,xu,xv,xz) + go to 10 + endif + endif + + xz = max(xz_mda,xz_fca,xz_tla,xz_mwa) + +10 continue + + end subroutine dtm_1p_zwa + + !>\ingroup gfs_nst_main_mod + !! This subroutine applies free convection adjustment(fca). + subroutine dtm_1p_fca(d_conv,xt,xtts,xz,xzts) + + ! apply xz adjustment: free convection adjustment (fca); + ! + real(kind=kind_phys), intent(in) :: d_conv,xt,xtts + real(kind=kind_phys), intent(inout) :: xz,xzts + ! local variables + real(kind=kind_phys) :: t_fcl,t0 + ! + t0 = 2.0*xt/xz + t_fcl = t0*(1.0-d_conv/(2.0*xz)) + xz = 2.0*xt/t_fcl + ! xzts = 2.0*xtts/t_fcl + + end subroutine dtm_1p_fca + + !>\ingroup gfs_nst_main_mod + !! This subroutine applies top layer adjustment (tla). + subroutine dtm_1p_tla(dz,te,xt,xtts,xz,xzts) + + ! apply xz adjustment: top layer adjustment (tla); + ! + real(kind=kind_phys), intent(in) :: dz,te,xt,xtts + real(kind=kind_phys), intent(inout) :: xz,xzts + ! local variables + real(kind=kind_phys) :: tem + ! + tem = xt*(xt-dz*te) + if (tem > zero) then + xz = (xt+sqrt(xt*(xt-dz*te)))/te + else + xz = z_w_max + endif + ! xzts = xtts*(1.0+0.5*(2.0*xt-dz*te)/sqrt(xt*(xt-dz*te)))/te + end subroutine dtm_1p_tla + + !>\ingroup gfs_nst_main_mod + !! This subroutine applies maximum warming adjustment (mwa). + subroutine dtm_1p_mwa(xt,xtts,xz,xzts) + + ! apply xz adjustment: maximum warming adjustment (mwa) + ! + real(kind=kind_phys), intent(in) :: xt,xtts + real(kind=kind_phys), intent(inout) :: xz,xzts + ! local variables + ! + xz = 2.0*xt/tw_max + ! xzts = 2.0*xtts/tw_max + end subroutine dtm_1p_mwa + + !>\ingroup gfs_nst_main_mod + !! This subroutine applies minimum depth adjustment (xz adjustment). + subroutine dtm_1p_mda(xt,xtts,xz,xzts) + + ! apply xz adjustment: minimum depth adjustment (mda) + ! + real(kind=kind_phys), intent(in) :: xt,xtts + real(kind=kind_phys), intent(inout) :: xz,xzts + ! local variables + real(kind=kind_phys) :: ta + ! + xz = max(z_w_min,xz) + ta = 2.0*xt/xz + ! xzts = 2.0*xtts/ta + + end subroutine dtm_1p_mda + + !>\ingroup gfs_nst_main_mod + !! This subroutine applies maximum temperature adjustment (mta). + subroutine dtm_1p_mta(dta,xt,xtts,xz,xzts) + + ! apply xz adjustment: maximum temperature adjustment (mta) + ! + real(kind=kind_phys), intent(in) :: dta,xt,xtts + real(kind=kind_phys), intent(inout) :: xz,xzts + ! local variables + real(kind=kind_phys) :: ta + ! + ta = max(zero,2.0*xt/xz-dta) + if ( ta > zero ) then + xz = 2.0*xt/ta + else + xz = z_w_max + endif + ! xzts = 2.0*xtts/ta + + end subroutine dtm_1p_mta + + !>\ingroup gfs_nst_main_mod + !! This subroutine calculates depth for convective adjustment. + subroutine convdepth(kdt,timestep,i0,q,sss,sep,rho,alpha,beta,xt,xs,xz,d_conv) + + ! + ! calculate depth for convective adjustment + ! + + integer, intent(in) :: kdt + real(kind=kind_phys), intent(in) :: timestep,i0,q,sss,sep,rho,alpha,beta + real(kind=kind_phys), intent(in) :: xt,xs,xz + real(kind=kind_phys), intent(out) :: d_conv + real(kind=kind_phys) :: t,s,d_conv_ini,d_conv2,fxp,aw,s1,s2,fac1 + integer :: n + ! + ! input variables + ! + ! timestep: time step in seconds + ! i0 : solar radiation flux at the surface (wm^-2) + ! q : non-solar heat flux at the surface (wm^-2) + ! sss : salinity (ppt) + ! sep : sr(e-p) (ppt*m/s) + ! rho : sea water density (kg*m^-3) + ! alpha : thermal expansion coefficient (1/k) + ! beta : saline contraction coefficient (1/ppt) + ! xt : initial heat content (k*m) + ! xs : initial salinity content (ppt*m) + ! xz : initial dtl thickness (m) + ! + ! output variables + ! + ! d_conv : free convection depth (m) + + ! t : initial diurnal warming t (k) + ! s : initial diurnal warming s (ppt) + + n = 0 + t = 2.0*xt/xz + s = 2.0*xs/xz + + s1 = alpha*rho*t-omg_m*beta*rho*s + + if ( s1 == zero ) then + d_conv = zero + else + + fac1 = alpha*q/cp_w+omg_m*beta*rho*sep + if ( i0 <= zero ) then + d_conv2=(2.0*xz*timestep/s1)*fac1 + if ( d_conv2 > zero ) then + d_conv = sqrt(d_conv2) + else + d_conv = zero + endif + elseif ( i0 > zero ) then + + d_conv_ini = zero + + iter_conv: do n = 1, niter_conv + call sw_ps_9b(d_conv_ini,fxp) + call sw_ps_9b_aw(d_conv_ini,aw) + s2 = alpha*(q-(fxp-aw*d_conv_ini)*i0)/cp_w+omg_m*beta*rho*sep + d_conv2=(2.0*xz*timestep/s1)*s2 + if ( d_conv2 < zero ) then + d_conv = zero + exit iter_conv + endif + d_conv = sqrt(d_conv2) + if ( abs(d_conv-d_conv_ini) < eps_conv .and. n <= niter_conv ) exit iter_conv + d_conv_ini = d_conv + enddo iter_conv + d_conv = max(zero,min(d_conv,z_w_max)) + endif ! if ( i0 <= zero ) then + + endif ! if ( s1 == zero ) then + + ! if ( d_conv > 0.01 ) then + ! write(*,'(a,i4,i3,10f9.3,3f10.6,f10.1,f6.2)') ' d_conv : ',kdt,n,d_conv,d_conv_ini,q,i0,rho,cp_w,timestep,xt,xs,xz,sep, & + ! s1,s2,d_conv2,aw + ! endif + + end subroutine convdepth + + !>\ingroup gfs_nst_main_mod + subroutine dtm_onset(kdt,timestep,rich,tox,toy,i0,q,sss,sep,q_ts,hl_ts,rho, & + alpha,beta,alon,sinlat,soltim,grav,le,xt,xs,xu,xv,xz,xzts,xtts) + ! + ! determine xz iteratively (starting wit fw = 0.5) and then update the other 6 variables + ! + + integer,intent(in) :: kdt + real(kind=kind_phys), intent(in) :: timestep,rich,tox,toy,i0,q,sss,sep,q_ts, & + hl_ts,rho,alpha,beta,alon,sinlat,soltim,grav,le + real(kind=kind_phys), intent(out) :: xt,xs,xu,xv,xz,xzts,xtts + real(kind=kind_phys) :: xt0,xs0,xu0,xv0,xz0 + real(kind=kind_phys) :: xt1,xs1,xu1,xv1,xz1 + real(kind=kind_phys) :: fw,aw,q_warm,ft0,fs0,fu0,fv0,fz0,ft1,fs1,fu1,fv1,fz1 + real(kind=kind_phys) :: coeff1,coeff2,ftime,z_w,z_w_tmp,fc,warml,alat + integer :: n + ! + ! input variables + ! + ! timestep: time step in seconds + ! tox : x wind stress (n*m^-2 or kg/m/s^2) + ! toy : y wind stress (n*m^-2 or kg/m/s^2) + ! i0 : solar radiation flux at the surface (wm^-2) + ! q : non-solar heat flux at the surface (wm^-2) + ! sss : salinity (ppt) + ! sep : sr(e-p) (ppt*m/s) + ! rho : sea water density (kg*m^-3) + ! alpha : thermal expansion coefficient (1/k) + ! beta : saline contraction coefficient (1/ppt) + ! alon : longitude + ! sinlat : sine(latitude) + ! grav : gravity accelleration + ! le : le=(2.501-.00237*tsea)*1e6 + ! + ! output variables + ! + ! xt : onset t content in dtl + ! xs : onset s content in dtl + ! xu : onset u content in dtl + ! xv : onset v content in dtl + ! xz : onset dtl thickness (m) + ! xzts : onset d(xz)/d(ts) (m/k ) + ! xtts : onset d(xt)/d(ts) (m) + + fc=1.46/10000.0/2.0*sinlat + alat = asin(sinlat) + ! + ! initializing dtl (just before the onset) + ! + xt0 = zero + xs0 = zero + xu0 = zero + xv0 = zero + + z_w_tmp=z_w_ini + + call sw_ps_9b(z_w_tmp,fw) + ! fw=0.5 ! + q_warm=fw*i0-q !total heat abs in warm layer + + if ( abs(alat) > 1.0 ) then + ftime=sqrt((2.0-2.0*cos(fc*timestep))/(fc*fc*timestep)) + else + ftime=timestep + endif + + coeff1=alpha*grav/cp_w + coeff2=omg_m*beta*grav*rho + warml = coeff1*q_warm-coeff2*sep + + if ( warml > zero .and. q_warm > zero) then + iters_z_w: do n = 1,niter_z_w + if ( warml > zero .and. q_warm > zero ) then + z_w=sqrt(2.0*rich*ftime/rho)*sqrt(tox**2+toy**2)/sqrt(warml) + else + z_w = z_w_max + exit iters_z_w + endif + + ! write(*,'(a,i4,i4,10f9.3,f9.6,f3.0)') ' z_w = ',kdt,n,z_w,z_w_tmp,timestep,q_warm,q,i0,fw,tox,toy,sep,warml,omg_m + + if (abs(z_w - z_w_tmp) < eps_z_w .and. z_w/=z_w_max .and. n < niter_z_w) exit iters_z_w + z_w_tmp=z_w + call sw_ps_9b(z_w_tmp,fw) + q_warm = fw*i0-q + warml = coeff1*q_warm-coeff2*sep + end do iters_z_w + else + z_w=z_w_max + endif + + xz0 = max(z_w,z_w_min) + + ! + ! update xt, xs, xu, xv + ! + if ( z_w < z_w_max .and. q_warm > zero) then + + call sw_ps_9b(z_w,fw) + q_warm=fw*i0-q !total heat abs in warm layer + + ft0 = q_warm/(rho*cp_w) + fs0 = sep + fu0 = fc*xv0+tox/rho + fv0 = -fc*xu0+toy/rho + + xt1 = xt0 + timestep*ft0 + xs1 = xs0 + timestep*fs0 + xu1 = xu0 + timestep*fu0 + xv1 = xv0 + timestep*fv0 + + fz0 = xz0*((tox*xu1+toy*xv1)/rho+omg_m*beta*grav*sep*xz0*xz0/(4.0*rich) & + -alpha*grav*q_warm*xz0*xz0/(4.0*rich*cp_w*rho))/(xu1*xu1+xv1*xv1) + xz1 = xz0 + timestep*fz0 + + xz1 = max(xz1,z_w_min) + + if ( xt1 < zero .or. xz1 > z_w_max ) then + call dtl_reset(xt,xs,xu,xv,xz,xtts,xzts) + return + endif + + call sw_ps_9b(xz1,fw) + q_warm=fw*i0-q !total heat abs in warm layer + + ft1 = q_warm/(rho*cp_w) + fs1 = sep + fu1 = fc*xv1+tox/rho + fv1 = -fc*xu1+toy/rho + + fz1 = xz1*((tox*xu1+toy*xv1)/rho+omg_m*beta*grav*sep*xz1*xz1/(4.0*rich) & + -alpha*grav*q_warm*xz1*xz1/(4.0*rich*cp_w*rho))/(xu1*xu1+xv1*xv1) + + xt = xt0 + 0.5*timestep*(ft0+ft1) + xs = xs0 + 0.5*timestep*(fs0+fs1) + xu = xu0 + 0.5*timestep*(fu0+fu1) + xv = xv0 + 0.5*timestep*(fv0+fv1) + xz = xz0 + 0.5*timestep*(fz0+fz1) + + xz = max(xz,z_w_min) + + call sw_ps_9b_aw(xz,aw) + + ! xzts = (q_ts+(cp_w*omg_m*beta*sss/(le*alpha))*hl_ts)*xz/(i0*xz*aw+2.0*q_warm-2.0*(rho*cp_w*omg_m*beta*sss/alpha)*(sep/sss)) + xzts = (q_ts+omg_m*rho*cp_w*beta*sss*hl_ts*xz/(le*alpha))/(i0*xz*aw+2.0*q_warm-2.0*omg_m*rho*cp_w*beta*sss*sep/(le*alpha)) + xtts = timestep*(i0*aw*xzts-q_ts)/(rho*cp_w) + endif + + if ( xt < zero .or. xz > z_w_max ) then + call dtl_reset(xt,xs,xu,xv,xz,xtts,xzts) + endif + + return + + end subroutine dtm_onset + + !>\ingroup gfs_nst_main_mod + !! This subroutine computes coefficients (\a w_0 and \a w_d) to + !! calculate d(tw)/d(ts). + subroutine cal_w(kdt,xz,xt,xzts,xtts,w_0,w_d) + ! + ! abstract: calculate w_0,w_d + ! + ! input variables + ! + ! kdt : the number of time step + ! xt : dtl heat content + ! xz : dtl depth + ! xzts : d(zw)/d(ts) + ! xtts : d(xt)/d(ts) + ! + ! output variables + ! + ! w_0 : coefficint 1 to calculate d(tw)/d(ts) + ! w_d : coefficint 2 to calculate d(tw)/d(ts) + + integer, intent(in) :: kdt + real(kind=kind_phys), intent(in) :: xz,xt,xzts,xtts + real(kind=kind_phys), intent(out) :: w_0,w_d + + w_0 = 2.0*(xtts-xt*xzts/xz)/xz + w_d = (2.0*xt*xzts/xz**2-w_0)/xz + + ! if ( 2.0*xt/xz > 1.0 ) then + ! write(*,'(a,i4,2f9.3,4f10.4))') ' cal_w : ',kdt,xz,xt,w_0,w_d,xzts,xtts + ! endif + end subroutine cal_w + + !>\ingroup gfs_nst_main_mod + !! This subroutine calculates the diurnal warming amount at the top layer + !! with thickness of \a delz. + subroutine cal_ttop(kdt,timestep,q_warm,rho,dz,xt,xz,ttop) + ! + ! abstract: calculate + ! + ! input variables + ! + ! kdt : the number of record + ! timestep : the number of record + ! q_warm : total heat abs in layer dz + ! rho : sea water density + ! dz : dz = max(delz,d_conv) top layer thickness defined to adjust xz + ! xt : heat content in dtl at previous time + ! xz : dtl thickness at previous time + ! + ! output variables + ! + ! ttop : the diurnal warming amount at the top layer with thickness of delz + + integer, intent(in) :: kdt + real(kind=kind_phys), intent(in) :: timestep,q_warm,rho,dz,xt,xz + real(kind=kind_phys), intent(out) :: ttop + real(kind=kind_phys) :: dt_warm,t0 + + dt_warm = (xt+xt)/xz + t0 = dt_warm*(1.0-dz/(xz+xz)) + ttop = t0 + q_warm*timestep/(rho*cp_w*dz) + + end subroutine cal_ttop + + !>\ingroup gfs_nst_main_mod + !! This subroutine adjust dtm-1p dtl thickness by applying shear flow stability + !! with assumed exponential profile. + subroutine app_sfs(kdt,xt,xs,xu,xv,alpha,beta,grav,d_1p,xz) + ! + ! abstract: adjust dtm-1p dtl thickness by applying shear flow stability with assumed exponetial profile + ! + ! input variables + ! + ! kdt : the number of record + ! xt : heat content in dtl + ! xs : salinity content in dtl + ! xu : u-current content in dtl + ! xv : v-current content in dtl + ! alpha + ! beta + ! grav + ! d_1p : dtl depth before sfs applied + ! + ! output variables + ! + ! xz : dtl depth + + integer, intent(in) :: kdt + real(kind=kind_phys), intent(in) :: xt,xs,xu,xv,alpha,beta,grav,d_1p + real(kind=kind_phys), intent(out) :: xz + ! real(kind=kind_phys) :: ze,cc,xz0,l,d_sfs, t_sfs, tem + real(kind=kind_phys) :: cc,l,d_sfs,tem + real(kind=kind_phys), parameter :: c2 = 0.3782 + + cc = ri_g/(grav*c2) + + tem = alpha*xt - beta*xs + if (tem > zero) then + d_sfs = sqrt(2.0*cc*(xu*xu+xv*xv)/tem) + else + d_sfs = zero + endif + + ! xz0 = d_1p + ! iter_sfs: do n = 1, niter_sfs + ! l = int_epn(0.0,xz0,0.0,xz0,2) + ! d_sfs = cc*(xu*xu+xv*xv)/((alpha*xt-beta*xs)*l) + ! write(*,'(a,i6,i3,4f9.4))') ' app_sfs_iter : ',kdt,n,cc,l,xz0,d_sfs + ! if ( abs(d_sfs-xz0) < eps_sfs .and. n <= niter_sfs ) exit iter_sfs + ! xz0 = d_sfs + ! enddo iter_sfs + + ! ze = a2*d_sfs ! not used! + + l = int_epn(zero,d_sfs,zero,d_sfs,2) + + ! t_sfs = xt/l + ! xz = (xt+xt) / t_sfs + + xz = l + l + + ! write(*,'(a,i6,6f9.4))') ' app_sfs : ',kdt,xz0,d_sfs,d_1p,xz,2.0*xt/d_1p,t_sfs + end subroutine app_sfs + + !>\ingroup gfs_nst_main_mod + !! This subroutine calculates d(tz)/d(ts). + subroutine cal_tztr(kdt,xt,c_0,c_d,w_0,w_d,zc,zw,z,tztr) + ! + ! abstract: calculate d(tz)/d(ts) + ! + ! input variables + ! + ! kdt : the number of record + ! xt : heat content in dtl + ! xz : dtl depth (m) + ! c_0 : coefficint 1 to calculate d(tc)/d(ts) + ! c_d : coefficint 2 to calculate d(tc)/d(ts) + ! w_0 : coefficint 1 to calculate d(tw)/d(ts) + ! w_d : coefficint 2 to calculate d(tw)/d(ts) + ! + ! output variables + ! + ! tztr : d(tz)/d(tr) + + integer, intent(in) :: kdt + real(kind=kind_phys), intent(in) :: xt,c_0,c_d,w_0,w_d,zc,zw,z + real(kind=kind_phys), intent(out) :: tztr + + if ( xt > zero ) then + if ( z <= zc ) then + ! tztr = 1.0/(1.0-w_0+c_0)+z*(w_d-c_d)/(1.0-w_0+c_0) + tztr = (1.0+z*(w_d-c_d))/(1.0-w_0+c_0) + elseif ( z > zc .and. z < zw ) then + ! tztr = (1.0+c_0)/(1.0-w_0+c_0)+z*w_d/(1.0-w_0+c_0) + tztr = (1.0+c_0+z*w_d)/(1.0-w_0+c_0) + elseif ( z >= zw ) then + tztr = 1.0 + endif + elseif ( xt == zero ) then + if ( z <= zc ) then + ! tztr = 1.0/(1.0+c_0)-z*c_d/(1.0+c_0) + tztr = (1.0-z*c_d)/(1.0+c_0) + else + tztr = 1.0 + endif + else + tztr = 1.0 + endif + + ! write(*,'(a,i4,9f9.4))') ' cal_tztr : ',kdt,xt,c_0,c_d,w_0,w_d,zc,zw,z,tztr + end subroutine cal_tztr + + !>\ingroup gfs_nst_main_mod + !> This subroutine contains the upper ocean cool-skin parameterization + !! (Fairall et al, 1996 \cite fairall_et_al_1996). + subroutine cool_skin(ustar_a,f_nsol,f_sol_0,evap,sss,alpha,beta,rho_w,rho_a,ts,q_ts,hl_ts,grav,le,deltat_c,z_c,c_0,c_d) + ! + ! upper ocean cool-skin parameterizaion, fairall et al, 1996. + ! + ! input: + ! ustar_a : atmosphreic friction velocity at the air-sea interface (m/s) + ! f_nsol : the "nonsolar" part of the surface heat flux (w/m^s) + ! f_sol_0 : solar radiation at the ocean surface (w/m^2) + ! evap : latent heat flux (w/m^2) + ! sss : ocean upper mixed layer salinity (ppu) + ! alpha : thermal expansion coefficient + ! beta : saline contraction coefficient + ! rho_w : oceanic density + ! rho_a : atmospheric density + ! ts : oceanic surface temperature + ! q_ts : d(q)/d(ts) : q = the sum of non-solar heat fluxes + ! hl_ts : d(hl)/d(ts) + ! grav : gravity + ! le : + ! + ! output: + ! deltat_c: cool-skin temperature correction (degrees k) + ! z_c : molecular sublayer (cool-skin) thickness (m) + ! c_0 : coefficient1 to calculate d(tz)/d(ts) + ! c_d : coefficient2 to calculate d(tz)/d(ts) + + ! + real(kind=kind_phys), intent(in) :: ustar_a,f_nsol,f_sol_0,evap,sss,alpha,beta,rho_w,rho_a,ts,q_ts,hl_ts,grav,le + real(kind=kind_phys), intent(out) :: deltat_c,z_c,c_0,c_d + ! declare local variables + real(kind=kind_phys), parameter :: a1=0.065, a2=11.0, a3=6.6e-5, a4=8.0e-4, tcw=0.6, tcwi=1.0/tcw + real(kind=kind_phys) :: a_c,b_c,zc_ts,bc1,bc2 + real(kind=kind_phys) :: xi,hb,ustar1_a,bigc,deltaf,fxp + real(kind=kind_phys) :: zcsq + real(kind=kind_phys) :: cc1,cc2,cc3 + + + z_c = z_c_ini ! initial guess + + ustar1_a = max(ustar_a,ustar_a_min) + + call sw_rad_skin(z_c,fxp) + deltaf = f_sol_0*fxp + + hb = alpha*(f_nsol-deltaf)+beta*sss*cp_w*evap/le + bigc = 16*grav*cp_w*(rho_w*visw)**3/(rho_a*rho_a*kw*kw) + + if ( hb > 0 ) then + xi = 6./(1+(bigc*hb/ustar1_a**4)**0.75)**0.3333333 + else + xi = 6.0 + endif + z_c = min(z_c_max,xi*visw/(sqrt(rho_a/rho_w)*ustar1_a )) + + call sw_rad_skin(z_c,fxp) + + deltaf = f_sol_0*fxp + deltaf = f_nsol - deltaf + if ( deltaf > 0 ) then + deltat_c = deltaf * z_c / kw + else + deltat_c = zero + z_c = zero + endif + ! + ! calculate c_0 & c_d + ! + if ( z_c > zero ) then + cc1 = 6.0*visw / (tcw*ustar1_a*sqrt(rho_a/rho_w)) + cc2 = bigc*alpha / max(ustar_a,ustar_a_min)**4 + cc3 = beta*sss*cp_w/(alpha*le) + zcsq = z_c * z_c + a_c = a2 + a3/zcsq - (a3/(a4*z_c)+a3/zcsq) * exp(-z_c/a4) + + if ( hb > zero .and. zcsq > zero .and. alpha > zero) then + bc1 = zcsq * (q_ts+cc3*hl_ts) + bc2 = zcsq * f_sol_0*a_c - 4.0*(cc1*tcw)**3*(hb/alpha)**0.25/(cc2**0.75*zcsq) + zc_ts = bc1/bc2 + ! b_c = z_c**2*(q_ts+cc3*hl_ts)/(z_c**2*f_sol_0*a_c-4.0*(cc1*tcw)**3*(hb/alpha)**0.25/(cc2**0.75*z_c**2)) ! d(z_c)/d(ts) + b_c = (q_ts+cc3*hl_ts)/(f_sol_0*a_c & + - 4.0*(cc1*tcw)**3*(hb/alpha)**0.25/(cc2**0.75*zcsq*zcsq)) ! d(z_c)/d(ts) + c_0 = (z_c*q_ts+(f_nsol-deltaf-f_sol_0*a_c*z_c)*b_c)*tcwi + c_d = (f_sol_0*a_c*z_c*b_c-q_ts)*tcwi + + else + b_c = zero + zc_ts = zero + c_0 = z_c*q_ts*tcwi + c_d = -q_ts*tcwi + endif + + ! if ( c_0 < 0.0 ) then + ! write(*,'(a,2f12.6,10f10.6)') ' c_0, c_d = ',c_0,c_d,b_c,zc_ts,hb,bc1,bc2,z_c,cc1,cc2,cc3,z_c**2 + ! endif + + ! c_0 = z_c*q_ts/tcw + ! c_d = -q_ts/tcw + + else + c_0 = zero + c_d = zero + endif ! if ( z_c > 0.0 ) then + + end subroutine cool_skin + ! + !====================== + ! + !>\ingroup gfs_nst_main_mod + !! This function calculates a definitive integral of an exponential curve (power of 2). + real function int_epn(z1,z2,zmx,ztr,n) + ! + ! abstract: calculate a definitive integral of an exponetial curve (power of 2) + ! + real(kind_phys) :: z1,z2,zmx,ztr,zi + real(kind_phys) :: fa,fb,fi,int + integer :: m,i,n + + m = nint((z2-z1)/delz) + fa = exp(-exp_const*((z1-zmx)/(ztr-zmx))**n) + fb = exp(-exp_const*((z2-zmx)/(ztr-zmx))**n) + int = zero + do i = 1, m-1 + zi = z1 + delz*float(i) + fi = exp(-exp_const*((zi-zmx)/(ztr-zmx))**n) + int = int + fi + enddo + int_epn = delz*((fa+fb)/2.0 + int) + end function int_epn + + !>\ingroup gfs_nst_main_mod + !! This subroutine resets the value of xt,xs,xu,xv,xz. + subroutine dtl_reset_cv(xt,xs,xu,xv,xz) + real(kind=kind_phys), intent(inout) :: xt,xs,xu,xv,xz + xt = zero + xs = zero + xu = zero + xv = zero + xz = z_w_max + end subroutine dtl_reset_cv + + !>\ingroup gfs_nst_main_mod + !! This subroutine resets the value of xt,xs,xu,xv,xz,xtts,xzts. + subroutine dtl_reset(xt,xs,xu,xv,xz,xzts,xtts) + real(kind=kind_phys), intent(inout) :: xt,xs,xu,xv,xz,xzts,xtts + xt = zero + xs = zero + xu = zero + xv = zero + xz = z_w_max + xtts = zero + xzts = zero + end subroutine dtl_reset + +end module nst_module diff --git a/physics/SFC_Layer/UFS/module_nst_parameters.f90 b/physics/SFC_Layer/UFS/module_nst_parameters.f90 new file mode 100644 index 000000000..5308345e2 --- /dev/null +++ b/physics/SFC_Layer/UFS/module_nst_parameters.f90 @@ -0,0 +1,156 @@ +!>\file module_nst_parameters.f90 +!! This file contains constants and paramters used in GFS +!! near surface sea temperature scheme. + +!>\defgroup nst_parameters GFS NSST Parameter Module +!! \ingroup gfs_nst_main_mod +!! This module contains constants and parameters used in GFS +!! near surface sea temperature scheme. +!! history: +!! 20210305: X.Li, reduce z_w_max from 30 m to 20 m +module module_nst_parameters + + use machine, only : kind_phys + ! + ! air constants and coefficients from the atmospehric model + use physcons, only: & + eps => con_eps & !< con_rd/con_rv (nd) + ,cp_a => con_cp & !< spec heat air @p (j/kg/k) + ,epsm1 => con_epsm1 & !< eps - 1 (nd) + ,hvap => con_hvap & !< lat heat h2o cond (j/kg) + ,sigma_r => con_sbc & !< stefan-boltzmann (w/m2/k4) + ,grav => con_g & !< acceleration due to gravity (kg/m/s^2) + ,omega => con_omega & !< ang vel of earth (1/s) + ,rvrdm1 => con_fvirt & !< con_rv/con_rd-1. (nd) + ,rd => con_rd & !< gas constant air (j/kg/k) + ,rocp => con_rocp & !< r/cp + ,pi => con_pi + + implicit none + + private + + public :: sigma_r + public :: zero, one, half + public :: niter_conv, niter_z_w, niter_sfs + public :: z_w_max, z_w_min, z_w_ini, z_c_max, z_c_ini, eps_z_w, eps_conv, eps_sfs + public :: ri_c, ri_g, omg_m, omg_sh, tc_w, visw, cp_w, t0k, ustar_a_min, delz, exp_const + public :: rad2deg, const_rot, tw_max, sst_max, solar_time_6am, tau_min, wd_max + + real(kind_phys), parameter :: zero = 0.0_kind_phys, one = 1.0_kind_phys, half = 0.5_kind_phys + ! + ! note: take timestep from here later + integer :: & + niter_conv = 5, & + niter_z_w = 5, & + niter_sfs = 5 + ! + ! general constants + real (kind=kind_phys), parameter :: & + sec_in_day = 86400. & + ,sec_in_hour = 3600. & + ,solar_time_6am = 21600.0 & + ,const_rot = 0.000073 & !< constant to calculate corioli force + ,ri_c = 0.65 & + ,ri_g = 0.25 & + ,eps_z_w = 0.01 & !< criteria to finish iterations for z_w + ,eps_conv = 0.01 & !< criteria to finish iterations for d_conv + ,eps_sfs = 0.01 & !< criteria to finish iterations for d_sfs + ,z_w_max = 20.0 & !< max warm layer thickness + ,z_w_min = 0.2 & !< min warm layer thickness + ,z_w_ini = 0.2 & !< initial warm layer thickness in dtl_onset + ,z_c_max = 0.01 & !< maximum of sub-layer thickness (m) + ,z_c_ini = 0.001 & !< initial value of z_c + ,ustar_a_min = 0.031 & !< minimum of friction wind speed (m/s): 0.031 ~ 1m/s at 10 m hight + ,tau_min = 0.005 & !< minimum of wind stress for dtm + ,exp_const = 9.5 & !< coefficient in exponet profile + ,delz = 0.1 & !< vertical increment for integral calculation (m) + ,von = 0.4 & !< von karman's "constant" + ,t0k = 273.16 & !< celsius to kelvin + ,gray = 0.97 & + ,sst_max = 308.16 & + ,tw_max = 5.0 & + ,wd_max = 2.0 & + ,omg_m = 1.0 & !< trace factor to apply salinity effect + ,omg_rot = 1.0 & !< trace factor to apply rotation effect + ,omg_sh = 1.0 & !< trace factor to apply sensible heat due to rainfall effect + ,visw = 1.e-6 & !< m2/s kinematic viscosity water + ,novalue = 0 & + ,smallnumber = 1.e-6 & + ,timestep_oc = sec_in_day/8. & !< time step in the ocean model (3 hours) + ,radian = 2.*pi/180. & + ,rad2deg = 180./pi & + ,cp_w = 4000. & !< specific heat water (j/kg/k ) + ,rho0_w = 1022.0 & !< density water (kg/m3 ) (or 1024.438) + ,vis_w = 1.e-6 & !< kinematic viscosity water (m2/s ) + ,tc_w = 0.6 & !< thermal conductivity water (w/m/k ) + ,capa_w = 3950.0 & !< heat capacity of sea water ! + ,thref = 1.0e-3 !< reference value of specific volume (m**3/kg) + +!!$!============================================ +!!$ +!!$ ,lvapor=2.453e6 & ! latent heat of vaporization note: make it function of t ????? note the same as hvap +!!$ ,alpha=1 ! thermal expansion coefficient +!!$ ,beta ! saline contraction coefficient +!!$ ,cp=1 !=1 specific heat of sea water +!!$ ,g=1 ! acceleration due to gravity +!!$ ,kw=1 ! thermal conductivity of water +!!$ ,nu=1 !kinematic wiscosity +!!$ ,rho_w=1 !water density +!!$ ,rho_a=1 !air density +!!$ ,l_vapr=2.453e6 +!!$ ,novalue=--1.0e+10 +!!$ +!!$c factors +!!$ beta=1.2 !given as 1.25 in fairall et al.(1996) +!!$ von=0.4 ! von karman's "constant" +!!$c fdg=1.00 ! fairall's lkb rr to von karman adjustment +!!$ fdg=1.00 !based on results from flux workshop august 1995 +!!$ tok=273.16 ! celsius to kelvin +!!$ twopi=3.14159*2. +!!$ +!!$c air constants and coefficients +!!$ rgas=287.1 !j/kg/k gas const. dry air +!!$ xlv=(2.501-0.00237*ts)*1e+6 !j/kg latent heat of vaporization at ts +!!$ cpa=1004.67 !j/kg/k specific heat of dry air (businger 1982) +!!$ cpv=cpa*(1+0.84*q) !moist air - currently not used (businger 1982) +!!$ rhoa=p*100./(rgas*(t+tok)*(1.+.61*q)) !kg/m3 moist air density ( " ) +!!$ visa=1.326e-5*(1+6.542e-3*t+8.301e-6*t*t-4.84e-9*t*t*t) !m2/s +!!$ !kinematic viscosity of dry air - andreas (1989) crrel rep. 89-11 +!!$c +!!$c cool skin constants +!!$ al=2.1e-5*(ts+3.2)**0.79 !water thermal expansion coefft. +!!$ be=0.026 !salinity expansion coefft. +!!$ cpw=4000. !j/kg/k specific heat water +!!$ rhow=1022. !kg/m3 density water +!!$ visw=1.e-6 !m2/s kinematic viscosity water +!!$ tcw=0.6 !w/m/k thermal conductivity water +!!$ bigc=16.*grav*cpw*(rhow*visw)**3/(tcw*tcw*rhoa*rhoa) +!!$ wetc=0.622*xlv*qs/(rgas*(ts+tok)**2) !correction for dq;slope of sat. vap. +!!$ +!!$! +!!$! functions +!!$ +!!$ +!!$ real, parameter :: timestep=86400. !integration time step, second +!!$ +!!$ real, parameter :: grav =9.81 !gravity, kg/m/s^2 +!!$ real, parameter :: capa =3950.0 !heat capacity of sea water +!!$ real, parameter :: rhoref = 1024.438 !sea water reference density, kg/m^3 +!!$ real , parameter :: hslab=50.0 !slab ocean depth +!!$ real , parameter :: bad=-1.0e+10 +!!$ real , parameter :: tmin=2.68e+02 +!!$ real , parameter :: tmax=3.11e+02 +!!$ +!!$ real, parameter :: grav =9.81 !gravity, kg/m/s^2 +!!$ real, parameter :: capa =3950.0 !heat capacity of sea water +!!$ real, parameter :: rhoref = 1024.438 !sea water reference density, kg/m^3 +!!$ real, parameter :: tmin=2.68e+02 !normal minimal temp +!!$ real, parameter :: tmax=3.11e+02 !normal max temp +!!$ real, parameter :: smin=1.0 !normal minimal salt +!!$ real, parameter :: smax=50. !normal maximum salt +!!$ real, parameter :: visct=1.e-5 !viscocity for temperature diffusion +!!$ real, parameter :: viscs=1.e-5 !viscocity for salt diffusion +!!$ +!!$ +end module module_nst_parameters diff --git a/physics/SFC_Layer/UFS/module_nst_water_prop.f90 b/physics/SFC_Layer/UFS/module_nst_water_prop.f90 new file mode 100644 index 000000000..858659e90 --- /dev/null +++ b/physics/SFC_Layer/UFS/module_nst_water_prop.f90 @@ -0,0 +1,734 @@ + +!>\file module_nst_water_prop.f90 +!! This file contains GFS NSST water property subroutines. + +!>\defgroup waterprop GFS NSST Water Property +!!This module contains GFS NSST water property subroutines. +!!\ingroup gfs_nst_main_mod +module module_nst_water_prop + use machine , only : kind_phys + use module_nst_parameters , only : t0k, zero, one, half + + implicit none + ! + private + public :: rhocoef, density, sw_rad_skin, grv, sw_ps_9b, sw_ps_9b_aw, get_dtzm_point, get_dtzm_2d + + ! + interface sw_ps_9b + module procedure sw_ps_9b + end interface sw_ps_9b + interface sw_ps_9b_aw + module procedure sw_ps_9b_aw + end interface sw_ps_9b_aw + ! + interface sw_rad + module procedure sw_fairall_6exp_v1 ! sw_wick_v1 + end interface sw_rad + interface sw_rad_aw + module procedure sw_fairall_6exp_v1_aw + end interface sw_rad_aw + interface sw_rad_sum + module procedure sw_fairall_6exp_v1_sum + end interface sw_rad_sum + interface sw_rad_upper + module procedure sw_soloviev_3exp_v2 + end interface sw_rad_upper + interface sw_rad_upper_aw + module procedure sw_soloviev_3exp_v2_aw + end interface sw_rad_upper_aw + interface sw_rad_skin + module procedure sw_ohlmann_v1 + end interface sw_rad_skin +contains + ! ------------------------------------------------------ + !>\ingroup gfs_nst_main_mod + !! This subroutine computes thermal expansion coefficient (alpha) + !! and saline contraction coefficient (beta). + subroutine rhocoef(t, s, rhoref, alpha, beta) + ! ------------------------------------------------------ + + ! compute thermal expansion coefficient (alpha) + ! and saline contraction coefficient (beta) using + ! the international equation of state of sea water + ! (1980). ref: pond and pickard, introduction to + ! dynamical oceanography, pp310. + ! note: compression effects are not included + + real(kind=kind_phys), intent(in) :: t, s, rhoref + real(kind=kind_phys), intent(out) :: alpha, beta + real(kind=kind_phys) :: tc + + tc = t - t0k + + alpha = & + 6.793952e-2 & + - 2.0 * 9.095290e-3 * tc + 3.0 * 1.001685e-4 * tc**2 & + - 4.0 * 1.120083e-6 * tc**3 + 5.0 * 6.536332e-9 * tc**4 & + - 4.0899e-3 * s & + + 2.0 * 7.6438e-5 * tc * s - 3.0 * 8.2467e-7 * tc**2 * s & + + 4.0 * 5.3875e-9 * tc**3 * s & + + 1.0227e-4 * s**1.5 - 2.0 * 1.6546e-6 * tc * s**1.5 + + ! note: rhoref - specify + ! + alpha = -alpha/rhoref + + beta = & + 8.24493e-1 - 4.0899e-3 * tc & + + 7.6438e-5 * tc**2 - 8.2467e-7 * tc**3 & + + 5.3875e-9 * tc**4 - 1.5 * 5.72466e-3 * s**.5 & + + 1.5 * 1.0227e-4 * tc * s**.5 & + - 1.5 * 1.6546e-6 * tc**2 * s**.5 & + + 2.0 * 4.8314e-4 * s + + beta = beta / rhoref + + end subroutine rhocoef + ! ---------------------------------------- + !>\ingroup gfs_nst_main_mod + !! This subroutine computes sea water density. + subroutine density(t, s, rho) + ! ---------------------------------------- + + ! input + real(kind=kind_phys), intent(in) :: t !unit, k + real(kind=kind_phys), intent(in) :: s !unit, 1/1000 + ! output + real(kind=kind_phys), intent(out) :: rho !unit, kg/m^3 + ! local + real(kind=kind_phys) :: tc + + ! compute density using the international equation + ! of state of sea water 1980, (pond and pickard, + ! introduction to dynamical oceanography, pp310). + ! compression effects are not included + + rho = zero + tc = t - t0k + + ! effect of temperature on density (lines 1-3) + ! effect of temperature and salinity on density (lines 4-8) + rho = & + 999.842594 + 6.793952e-2 * tc & + - 9.095290e-3 * tc**2 + 1.001685e-4 * tc**3 & + - 1.120083e-6 * tc**4 + 6.536332e-9 * tc**5 & + + 8.24493e-1 * s - 4.0899e-3 * tc * s & + + 7.6438e-5 * tc**2 * s - 8.2467e-7 * tc**3 * s & + + 5.3875e-9 * tc**4 * s - 5.72466e-3 * s**1.5 & + + 1.0227e-4 * tc * s**1.5 - 1.6546e-6 * tc**2 * s**1.5 & + + 4.8314e-4 * s**2 + + end subroutine density + ! + !====================== + ! + !>\ingroup gfs_nst_main_mod + !! This subroutine computes the fraction of the solar radiation absorbed + !! by the depth z following Paulson and Simpson (1981) \cite paulson_and_simpson_1981 . + elemental subroutine sw_ps_9b(z,fxp) + ! + ! fraction of the solar radiation absorbed by the ocean at the depth z + ! following paulson and simpson, 1981 + ! + ! input: + ! z: depth (m) + ! + ! output: + ! fxp: fraction of the solar radiation absorbed by the ocean at depth z (w/m^2) + ! + real(kind=kind_phys), intent(in) :: z + real(kind=kind_phys), intent(out) :: fxp + real(kind=kind_phys), dimension(9), parameter :: f=(/0.237,0.36,0.179,0.087,0.08,0.0246,0.025,0.007,0.0004/) + real(kind=kind_phys), dimension(9), parameter :: gamma=(/34.8,2.27,3.15e-2,5.48e-3,8.32e-4,1.26e-4,3.13e-4,7.82e-5,1.44e-5/) + ! + if(z>zero) then + fxp=one-(f(1)*exp(-z/gamma(1))+f(2)*exp(-z/gamma(2))+f(3)*exp(-z/gamma(3))+ & + f(4)*exp(-z/gamma(4))+f(5)*exp(-z/gamma(5))+f(6)*exp(-z/gamma(6))+ & + f(7)*exp(-z/gamma(7))+f(8)*exp(-z/gamma(8))+f(9)*exp(-z/gamma(9))) + else + fxp=zero + endif + ! + end subroutine sw_ps_9b + ! + !====================== + ! + ! + !====================== + ! + !>\ingroup gfs_nst_main_mod + !! This subroutine + elemental subroutine sw_ps_9b_aw(z,aw) + ! + ! d(fw)/d(z) for 9-band + ! + ! input: + ! z: depth (m) + ! + ! output: + ! fxp: fraction of the solar radiation absorbed by the ocean at depth z (w/m^2) + ! + real(kind=kind_phys), intent(in) :: z + real(kind=kind_phys), intent(out) :: aw + real(kind=kind_phys), dimension(9), parameter :: f=(/0.237,0.36,0.179,0.087,0.08,0.0246,0.025,0.007,0.0004/) + real(kind=kind_phys), dimension(9), parameter :: gamma=(/34.8,2.27,3.15e-2,5.48e-3,8.32e-4,1.26e-4,3.13e-4,7.82e-5,1.44e-5/) + ! + if(z>zero) then + aw=(f(1)/gamma(1))*exp(-z/gamma(1))+(f(2)/gamma(2))*exp(-z/gamma(2))+(f(3)/gamma(3))*exp(-z/gamma(3))+ & + (f(1)/gamma(4))*exp(-z/gamma(4))+(f(2)/gamma(5))*exp(-z/gamma(5))+(f(6)/gamma(6))*exp(-z/gamma(6))+ & + (f(1)/gamma(7))*exp(-z/gamma(7))+(f(2)/gamma(8))*exp(-z/gamma(8))+(f(9)/gamma(9))*exp(-z/gamma(9)) + else + aw=zero + endif + ! + end subroutine sw_ps_9b_aw + ! + !====================== + !>\ingroup gfs_nst_main_mod + !! This subroutine computes fraction of the solar radiation absorbed by the ocean at the depth + !! z (Fairall et al. (1996) \cite fairall_et_al_1996, p. 1298) following Paulson and Simpson + !! (1981) \cite paulson_and_simpson_1981 . + elemental subroutine sw_fairall_6exp_v1(z,fxp) + ! + ! fraction of the solar radiation absorbed by the ocean at the depth z (fairall et all, 1996, p. 1298) + ! following paulson and simpson, 1981 + ! + ! input: + ! z: depth (m) + ! + ! output: + ! fxp: fraction of the solar radiation absorbed by the ocean at depth z (w/m^2) + ! + real(kind=kind_phys), intent(in) :: z + real(kind=kind_phys), intent(out) :: fxp + + real(kind=kind_phys), dimension(9), parameter :: f=(/0.237,0.36,0.179,0.087,0.08,0.0246,0.025,0.007,0.0004/) + real(kind=kind_phys), dimension(9), parameter :: gamma=(/34.8,2.27,3.15e-2,5.48e-3,8.32e-4,1.26e-4,3.13e-4,7.82e-5,1.44e-5/) + real(kind=kind_phys), dimension(9) :: zgamma + real(kind=kind_phys), dimension(9) :: f_c + ! + if(z>zero) then + zgamma=z/gamma + f_c=f*(one-one/zgamma*(one-exp(-zgamma))) + fxp=sum(f_c) + else + fxp=zero + endif + ! + end subroutine sw_fairall_6exp_v1 + ! + !====================== + ! + ! + !>\ingroup gfs_nst_main_mod + !! This subroutine calculates fraction of the solar radiation absorbed by the + !! ocean at the depth z (fairall et al.(1996) \cite fairall_et_al_1996; p.1298) + !! following Paulson and Simpson (1981) \cite paulson_and_simpson_1981. + elemental subroutine sw_fairall_6exp_v1_aw(z,aw) + ! + ! fraction of the solar radiation absorbed by the ocean at the depth z (fairall et all, 1996, p. 1298) + ! following paulson and simpson, 1981 + ! + ! input: + ! z: depth (m) + ! + ! output: + ! aw: d(fxp)/d(z) + ! + ! fxp: fraction of the solar radiation absorbed by the ocean at depth z (w/m^2) + ! + real(kind=kind_phys), intent(in) :: z + real(kind=kind_phys), intent(out) :: aw + + real(kind=kind_phys), dimension(9), parameter :: f=(/0.237,0.36,0.179,0.087,0.08,0.0246,0.025,0.007,0.0004/) + real(kind=kind_phys), dimension(9), parameter :: gamma=(/34.8,2.27,3.15e-2,5.48e-3,8.32e-4,1.26e-4,3.13e-4,7.82e-5,1.44e-5/) + real(kind=kind_phys), dimension(9) :: zgamma + real(kind=kind_phys), dimension(9) :: f_aw + ! + if(z>zero) then + zgamma=z/gamma + f_aw=(f/z)*((gamma/z)*(one-exp(-zgamma))-exp(-zgamma)) + aw=sum(f_aw) + ! write(*,'(a,f6.2,f12.6,9f10.4)') 'z,aw in sw_rad_aw : ',z,aw,f_aw + else + aw=zero + endif + ! + end subroutine sw_fairall_6exp_v1_aw + ! + !>\ingroup gfs_nst_main_mod + !! This subroutine computes fraction of the solar radiation absorbed by the ocean at the + !! depth z (Fairall et al.(1996) \cite fairall_et_al_1996 , p.1298) following Paulson and + !! Simpson (1981) \cite paulson_and_simpson_1981 . + !>\param[in] z depth (m) + !>\param[out] sum for convection depth calculation + elemental subroutine sw_fairall_6exp_v1_sum(z,sum) + ! + ! fraction of the solar radiation absorbed by the ocean at the depth z (fairall et all, 1996, p. 1298) + ! following paulson and simpson, 1981 + ! + ! input: + ! z: depth (m) + ! + ! output: + ! sum: for convection depth calculation + ! + ! + real(kind=kind_phys), intent(in) :: z + real(kind=kind_phys), intent(out) :: sum + + real(kind=kind_phys), dimension(9), parameter :: gamma=(/34.8,2.27,3.15e-2,5.48e-3,8.32e-4,1.26e-4,3.13e-4,7.82e-5,1.44e-5/) + real(kind=kind_phys), dimension(9) :: zgamma + real(kind=kind_phys), dimension(9) :: f_sum + ! + ! zgamma=z/gamma + ! f_sum=(zgamma/z)*exp(-zgamma) + ! sum=sum(f_sum) + + sum=( one/gamma(1))*exp(-z/gamma(1))+(one/gamma(2))*exp(-z/gamma(2))+(one/gamma(3))*exp(-z/gamma(3))+ & + (one/gamma(4))*exp(-z/gamma(4))+(one/gamma(5))*exp(-z/gamma(5))+(one/gamma(6))*exp(-z/gamma(6))+ & + (one/gamma(7))*exp(-z/gamma(7))+(one/gamma(8))*exp(-z/gamma(8))+(one/gamma(9))*exp(-z/gamma(9)) + ! + end subroutine sw_fairall_6exp_v1_sum + ! + !====================== + !>\ingroup gfs_nst_main_mod + !! Solar radiation absorbed by the ocean at the depth z (Fairall et al. (1996) + !! \cite fairall_et_al_1996, p.1298) + !!\param[in] f_sol_0 solar radiation at the ocean surface (\f$W m^{-2}\f$) + !!\param[in] z depth (m) + !!\param[out] df_sol_z solar radiation absorbed by the ocean at depth z (\f$W m^{-2}\f$) + elemental subroutine sw_fairall_simple_v1(f_sol_0,z,df_sol_z) + ! + ! solar radiation absorbed by the ocean at the depth z (fairall et all, 1996, p. 1298) + ! + ! input: + ! f_sol_0: solar radiation at the ocean surface (w/m^2) + ! z: depth (m) + ! + ! output: + ! df_sol_z: solar radiation absorbed by the ocean at depth z (w/m^2) + ! + real(kind=kind_phys), intent(in) :: z,f_sol_0 + real(kind=kind_phys), intent(out) :: df_sol_z + ! + if(z>zero) then + df_sol_z=f_sol_0*(0.137+11.0*z-6.6e-6/z*(one-exp(-z/8.e-4))) + else + df_sol_z=zero + endif + ! + end subroutine sw_fairall_simple_v1 + ! + !====================== + ! + !>\ingroup gfs_nst_main_mod + !! solar radiation absorbed by the ocean at the depth z (Zeng and Beljaars (2005) + !! \cite zeng_and_beljaars_2005 , p.5). + !>\param[in] f_sol_0 solar radiation at the ocean surface (\f$W m^{-2}\f$) + !>\param[in] z depth (m) + !>\param[out] df_sol_z solar radiation absorbed by the ocean at depth z (\f$W m^{-2}\f$) + elemental subroutine sw_wick_v1(f_sol_0,z,df_sol_z) + ! + ! solar radiation absorbed by the ocean at the depth z (zeng and beljaars, 2005, p.5) + ! + ! input: + ! f_sol_0: solar radiation at the ocean surface (w/m^2) + ! z: depth (m) + ! + ! output: + ! df_sol_z: solar radiation absorbed by the ocean at depth z (w/m^2) + ! + real(kind=kind_phys), intent(in) :: z,f_sol_0 + real(kind=kind_phys), intent(out) :: df_sol_z + ! + if(z>zero) then + df_sol_z=f_sol_0*(0.065+11.0*z-6.6e-5/z*(one-exp(-z/8.e-4))) + else + df_sol_z=zero + endif + ! + end subroutine sw_wick_v1 + ! + !====================== + ! + !>\ingroup gfs_nst_main_mod + !! This subroutine computes solar radiation absorbed by the ocean at the depth z + !! (Fairall et al.(1996) \cite fairall_et_al_1996 , p.1301) following + !! Soloviev and Vershinsky (1982) \cite soloviev_and_vershinsky_1982. + !>\param[in] f_sol_0 solar radiation at the ocean surface (\f$W m^{-2}\f$) + !>\param[in] z depth (m) + !>\param[out] df_sol_z solar radiation absorbed by the ocean at depth z (\f$W m^{-2}\f$) + elemental subroutine sw_soloviev_3exp_v1(f_sol_0,z,df_sol_z) + ! + ! solar radiation absorbed by the ocean at the depth z (fairall et all, 1996, p. 1301) + ! following soloviev, 1982 + ! + ! input: + ! f_sol_0: solar radiation at the ocean surface (w/m^2) + ! z: depth (m) + ! + ! output: + ! df_sol_z: solar radiation absorbed by the ocean at depth z (w/m^2) + ! + real(kind=kind_phys), intent(in) :: z,f_sol_0 + real(kind=kind_phys), intent(out) :: df_sol_z + real(kind=kind_phys), dimension(3) :: f_c + real(kind=kind_phys), dimension(3), parameter :: f=(/0.45,0.27,0.28/) + real(kind=kind_phys), dimension(3), parameter :: gamma=(/12.82,0.357,0.014/) + ! + if(z>zero) then + f_c = f*gamma(int(one-exp(-z/gamma))) + df_sol_z = f_sol_0*(one-sum(f_c)/z) + else + df_sol_z = zero + endif + ! + end subroutine sw_soloviev_3exp_v1 + ! + !====================== + ! + !>\ingroup gfs_nst_main_mod + elemental subroutine sw_soloviev_3exp_v2(f_sol_0,z,df_sol_z) + ! + ! solar radiation absorbed by the ocean at the depth z (fairall et all, 1996, p. 1301) + ! following soloviev, 1982 + ! + ! input: + ! f_sol_0: solar radiation at the ocean surface (w/m^2) + ! z: depth (m) + ! + ! output: + ! df_sol_z: solar radiation absorbed by the ocean at depth z (w/m^2) + ! + real(kind=kind_phys), intent(in) :: z,f_sol_0 + real(kind=kind_phys), intent(out) :: df_sol_z + ! + if(z>zero) then + df_sol_z=f_sol_0*(one & + -(0.28*0.014*(one-exp(-z/0.014)) & + + 0.27*0.357*(one-exp(-z/0.357)) & + + 0.45*12.82*(one-exp(-z/12.82)))/z & + ) + else + df_sol_z=zero + endif + ! + end subroutine sw_soloviev_3exp_v2 + + !>\ingroup gfs_nst_main_mod + elemental subroutine sw_soloviev_3exp_v2_aw(z,aw) + ! + ! aw = d(fxp)/d(z) + ! following soloviev, 1982 + ! + ! input: + ! z: depth (m) + ! + ! output: + ! aw: d(fxp)/d(z) + ! + real(kind=kind_phys), intent(in) :: z + real(kind=kind_phys), intent(out) :: aw + real(kind=kind_phys) :: fxp + ! + if(z>zero) then + fxp=(one & + -(0.28*0.014*(one-exp(-z/0.014)) & + + 0.27*0.357*(one-exp(-z/0.357)) & + + 0.45*12.82*(one-exp(-z/12.82)))/z & + ) + aw=one-fxp-(0.28*exp(-z/0.014)+0.27*exp(-z/0.357)+0.45*exp(-z/12.82)) + else + aw=zero + endif + end subroutine sw_soloviev_3exp_v2_aw + ! + ! + !====================== + ! + !>\ingroup gfs_nst_main_mod + elemental subroutine sw_ohlmann_v1(z,fxp) + ! + ! fraction of the solar radiation absorbed by the ocean at the depth z + ! + ! input: + ! z: depth (m) + ! + ! output: + ! fxp: fraction of the solar radiation absorbed by the ocean at depth z (w/m^2) + ! + real(kind=kind_phys), intent(in) :: z + real(kind=kind_phys), intent(out) :: fxp + ! + if(z>zero) then + fxp=.065+11.*z-6.6e-5/z*(one-exp(-z/8.0e-4)) + else + fxp=zero + endif + ! + end subroutine sw_ohlmann_v1 + ! + + !>\ingroup gfs_nst_main_mod + real(kind_phys) function grv(x) + real(kind=kind_phys) :: x !< sin(lat) + real(kind=kind_phys) :: gamma,c1,c2,c3,c4 + gamma=9.7803267715 + c1=0.0052790414 + c2=0.0000232718 + c3=0.0000001262 + c4=0.0000000007 + + grv=gamma*(one+(c1*x**2)+(c2*x**4)+(c3*x**6)+(c4*x**8)) + end function grv + + !>\ingroup gfs_nst_main_mod + !>This subroutine computes solar time from the julian date. + subroutine solar_time_from_julian(jday,xlon,soltim) + ! + ! calculate solar time from the julian date + ! + real(kind=kind_phys), intent(in) :: jday + real(kind=kind_phys), intent(in) :: xlon + real(kind=kind_phys), intent(out) :: soltim + real(kind=kind_phys) :: fjd,xhr,xmin,xsec,intime + ! + fjd=jday-floor(jday) + fjd=jday + xhr=floor(fjd*24.0)-sign(12.0,fjd-half) + xmin=nint(fjd*1440.0)-(xhr+sign(12.0,fjd-half))*60.0 + xsec=zero + intime=xhr+xmin/60.0+xsec/3600.0+24.0 + soltim=mod(xlon/15.0+intime,24.0)*3600.0 + end subroutine solar_time_from_julian + + ! + !*********************************************************************** + ! + !>\ingroup gfs_nst_main_mod + !> This subroutine computes julian day and fraction from year, + !! month, day and time UTC. + subroutine compjd(jyr,jmnth,jday,jhr,jmn,jd,fjd) + !fpp$ noconcur r + !$$$ subprogram documentation block + ! . . . . + ! subprogram: compjd computes julian day and fraction + ! prgmmr: kenneth campana org: w/nmc23 date: 89-07-07 + ! + ! abstract: computes julian day and fraction + ! from year, month, day and time utc. + ! + ! program history log: + ! 77-05-06 ray orzol,gfdl + ! 98-05-15 iredell y2k compliance + ! + ! usage: call compjd(jyr,jmnth,jday,jhr,jmn,jd,fjd) + ! input argument list: + ! jyr - year (4 digits) + ! jmnth - month + ! jday - day + ! jhr - hour + ! jmn - minutes + ! output argument list: + ! jd - julian day. + ! fjd - fraction of the julian day. + ! + ! subprograms called: + ! iw3jdn compute julian day number + ! + ! attributes: + ! language: fortran. + ! + !$$$ + ! + integer :: jyr,jmnth,jday,jhr,jmn,jd + integer :: iw3jdn + real (kind=kind_phys) fjd + jd=iw3jdn(jyr,jmnth,jday) + if(jhr.lt.12) then + jd=jd-1 + fjd=half+jhr/24.+jmn/1440. + else + fjd=(jhr-12)/24.+jmn/1440. + endif + end subroutine compjd + + !>\ingroup gfs_nst_main_mod + !>This subroutine computes dtm (the mean of \f$dT(z)\f$). + subroutine get_dtzm_point(xt,xz,dt_cool,zc,z1,z2,dtm) + ! ===================================================================== ! + ! ! + ! description: get dtm = mean of dT(z) (z1 - z2) with NSST dT(z) ! + ! dT(z) = (1-z/xz)*dt_warm - (1-z/zc)*dt_cool ! + ! ! + ! usage: ! + ! ! + ! call get_dtm12 ! + ! ! + ! inputs: ! + ! (xt,xz,dt_cool,zc,z1,z2, ! + ! outputs: ! + ! dtm) ! + ! ! + ! program history log: ! + ! ! + ! 2015 -- xu li createad original code ! + ! inputs: ! + ! xt - real, heat content in dtl 1 ! + ! xz - real, dtl thickness 1 ! + ! dt_cool - real, sub-layer cooling amount 1 ! + ! zc - sub-layer cooling thickness 1 ! + ! z1 - lower bound of depth of sea temperature 1 ! + ! z2 - upper bound of depth of sea temperature 1 ! + ! outputs: ! + ! dtm - mean of dT(z) (z1 to z2) 1 ! + ! + real (kind=kind_phys), intent(in) :: xt,xz,dt_cool,zc,z1,z2 + real (kind=kind_phys), intent(out) :: dtm + ! Local variables + real (kind=kind_phys) :: dt_warm,dtw,dtc + + ! + ! get the mean warming in the range of z=z1 to z=z2 + ! + dtw = zero + if ( xt > zero ) then + dt_warm = (xt+xt)/xz ! Tw(0) + if ( z1 < z2) then + if ( z2 < xz ) then + dtw = dt_warm*(one-(z1+z2)/(xz+xz)) + elseif ( z1 < xz .and. z2 >= xz ) then + dtw = half*(one-z1/xz)*dt_warm*(xz-z1)/(z2-z1) + endif + elseif ( z1 == z2 ) then + if ( z1 < xz ) then + dtw = dt_warm*(one-z1/xz) + endif + endif + endif + ! + ! get the mean cooling in the range of z=z1 to z=z2 + ! + dtc = zero + if ( zc > zero ) then + if ( z1 < z2) then + if ( z2 < zc ) then + dtc = dt_cool*(one-(z1+z2)/(zc+zc)) + elseif ( z1 < zc .and. z2 >= zc ) then + dtc = half*(one-z1/zc)*dt_cool*(zc-z1)/(z2-z1) + endif + elseif ( z1 == z2 ) then + if ( z1 < zc ) then + dtc = dt_cool*(one-z1/zc) + endif + endif + endif + + ! + ! get the mean T departure from Tf in the range of z=z1 to z=z2 + ! + dtm = dtw - dtc + + end subroutine get_dtzm_point + + !>\ingroup gfs_nst_main_mod + subroutine get_dtzm_2d(xt,xz,dt_cool,zc,wet,z1,z2,nx,ny,nth,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) ! + ! dT(z) = (1-z/xz)*dt_warm - (1-z/zc)*dt_cool ! + ! ! + ! usage: ! + ! ! + ! call get_dtzm_2d ! + ! ! + ! inputs: ! + ! (xt,xz,dt_cool,zc,z1,z2, ! + ! outputs: ! + ! dtm) ! + ! ! + ! program history log: ! + ! ! + ! 2015 -- xu li createad original code ! + ! inputs: ! + ! xt - real, heat content in dtl 1 ! + ! xz - real, dtl thickness 1 ! + ! dt_cool - real, sub-layer cooling amount 1 ! + ! zc - sub-layer cooling thickness 1 ! + ! wet - logical, flag for wet point (ocean or lake) 1 ! + ! icy - logical, flag for ice point (ocean or lake) 1 ! + ! nx - integer, dimension in x-direction (zonal) 1 ! + ! ny - integer, dimension in y-direction (meridional) 1 ! + ! z1 - lower bound of depth of sea temperature 1 ! + ! z2 - upper bound of depth of sea temperature 1 ! + ! nth - integer, num of openmp thread 1 ! + ! outputs: ! + ! dtm - mean of dT(z) (z1 to z2) 1 ! + ! + integer, intent(in) :: nx,ny, nth + real (kind=kind_phys), dimension(nx,ny), intent(in) :: xt,xz,dt_cool,zc + 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 + integer :: i,j + real (kind=kind_phys) :: dt_warm, dtw, dtc, xzi + + + !$omp parallel do num_threads (nth) private(j,i,dtw,dtc,xzi) + do j = 1, ny + do i= 1, nx + + dtm(i,j) = zero ! initialize dtm + + if ( wet(i,j) ) then + ! + ! get the mean warming in the range of z=z1 to z=z2 + ! + dtw = zero + if ( xt(i,j) > zero ) then + xzi = one / xz(i,j) + dt_warm = (xt(i,j)+xt(i,j)) * xzi ! Tw(0) + if (z1 < z2) then + if ( z2 < xz(i,j) ) then + dtw = dt_warm * (one-half*(z1+z2)*xzi) + elseif (z1 < xz(i,j) .and. z2 >= xz(i,j) ) then + dtw = half*(one-z1*xzi)*dt_warm*(xz(i,j)-z1)/(z2-z1) + endif + elseif (z1 == z2 ) then + if (z1 < xz(i,j) ) then + dtw = dt_warm * (one-z1*xzi) + endif + endif + endif + ! + ! get the mean cooling in the range of z=0 to z=zsea + ! + dtc = zero + if ( zc(i,j) > zero ) then + if ( z1 < z2) then + if ( z2 < zc(i,j) ) then + dtc = dt_cool(i,j) * (one-(z1+z2)/(zc(i,j)+zc(i,j))) + elseif ( z1 < zc(i,j) .and. z2 >= zc(i,j) ) then + dtc = half*(one-z1/zc(i,j))*dt_cool(i,j)*(zc(i,j)-z1)/(z2-z1) + endif + elseif ( z1 == z2 ) then + if ( z1 < zc(i,j) ) then + dtc = dt_cool(i,j) * (one-z1/zc(i,j)) + endif + endif + endif + ! get the mean T departure from Tf in the range of z=z1 to z=z2 + dtm(i,j) = dtw - dtc + endif ! if ( wet(i,j)) then + enddo + enddo + ! + + end subroutine get_dtzm_2d + +end module module_nst_water_prop diff --git a/physics/sfc_diag.f b/physics/SFC_Layer/UFS/sfc_diag.f similarity index 93% rename from physics/sfc_diag.f rename to physics/SFC_Layer/UFS/sfc_diag.f index 768814e8c..c8ef19e8f 100644 --- a/physics/sfc_diag.f +++ b/physics/SFC_Layer/UFS/sfc_diag.f @@ -17,6 +17,7 @@ subroutine sfc_diag_run (im,xlat_d,xlon_d, & & lsm,lsm_ruc,grav,cp,eps,epsm1,con_rocp, & & con_karman, & & shflx,cdq,wind, & + & usfco,vsfco,icplocn2atm, & & zf,ps,u1,v1,t1,q1,prslki,evap,fm,fh,fm10,fh2, & & ust,tskin,qsurf,thsfc_loc,diag_flux,diag_log, & & use_lake_model,iopt_lake,iopt_lake_clm, & @@ -31,6 +32,7 @@ subroutine sfc_diag_run (im,xlat_d,xlon_d, & ! integer, intent(in) :: im, lsm, lsm_ruc, iopt_lake, iopt_lake_clm logical, intent(in) :: use_lake2m + integer, intent(in) :: icplocn2atm logical, intent(in) :: thsfc_loc ! Flag for reference pot. temp. logical, intent(in) :: diag_flux ! Flag for flux method in 2-m diagnostics logical, intent(in) :: diag_log ! Flag for 2-m log diagnostics under stable conditions @@ -38,12 +40,13 @@ subroutine sfc_diag_run (im,xlat_d,xlon_d, & real(kind=kind_phys), intent(in) :: con_karman real(kind=kind_phys), dimension(:), intent( in) :: & & zf, ps, u1, v1, t1, q1, ust, tskin, & + & usfco, vsfco, & & qsurf, prslki, evap, fm, fh, fm10, fh2, & & shflx, cdq, wind, xlat_d, xlon_d real(kind=kind_phys), dimension(:), intent(out) :: & - & f10m, u10m, v10m, t2m, q2m, dpt2m - real(kind=kind_phys), dimension(:), intent(in) :: lake_t2m, & - & lake_q2m + & f10m, u10m, v10m, t2m, q2m, dpt2m + real(kind=kind_phys), dimension(:), intent(in), optional :: & + & lake_t2m, lake_q2m integer, dimension(:), intent(in) :: use_lake_model character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -89,8 +92,13 @@ subroutine sfc_diag_run (im,xlat_d,xlon_d, & do i = 1, im f10m(i) = fm10(i) / fm(i) - u10m(i) = f10m(i) * u1(i) - v10m(i) = f10m(i) * v1(i) + if (icplocn2atm ==0) then + u10m(i) = f10m(i) * u1(i) + v10m(i) = f10m(i) * v1(i) + else if (icplocn2atm ==1) then + u10m(i) = usfco(i)+f10m(i) * (u1(i)-usfco(i)) + v10m(i) = vsfco(i)+f10m(i) * (v1(i)-vsfco(i)) + endif have_2m = use_lake_model(i)>0 .and. use_lake2m .and. & & iopt_lake==iopt_lake_clm if(have_2m) then diff --git a/physics/sfc_diag.meta b/physics/SFC_Layer/UFS/sfc_diag.meta similarity index 93% rename from physics/sfc_diag.meta rename to physics/SFC_Layer/UFS/sfc_diag.meta index a16290b58..9ec3213d3 100644 --- a/physics/sfc_diag.meta +++ b/physics/SFC_Layer/UFS/sfc_diag.meta @@ -1,7 +1,8 @@ [ccpp-table-properties] name = sfc_diag type = scheme - dependencies = funcphys.f90,machine.F + relative_path = ../../ + dependencies = tools/funcphys.f90,hooks/machine.F,hooks/physcons.F90 ######################################################################## [ccpp-arg-table] @@ -123,6 +124,29 @@ type = real kind = kind_phys intent = in +[usfco] + standard_name = x_ocean_current + long_name = zonal current at ocean surface + units = m s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in +[vsfco] + standard_name = y_ocean_current + long_name = meridional current at ocean surface + units = m s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in +[icplocn2atm] + standard_name = control_for_air_sea_flux_computation_over_water + long_name = air-sea flux option + units = 1 + dimensions = () + type = integer + intent = in [t1] standard_name = air_temperature_at_surface_adjacent_layer long_name = 1st model layer air temperature @@ -194,7 +218,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - intent = inout + intent = in [tskin] standard_name = surface_skin_temperature long_name = surface skin temperature @@ -247,6 +271,7 @@ type = real kind = kind_phys intent = in + optional = True [diag_flux] standard_name = flag_for_flux_method_in_2m_diagnostics long_name = flag for flux method in 2-m diagnostics @@ -277,6 +302,7 @@ type = real kind = kind_phys intent = in + optional = True [cdq] standard_name = surface_drag_coefficient_for_heat_and_moisture_in_air long_name = surface exchange coeff heat & moisture @@ -290,7 +316,7 @@ long_name = model 2m diagnostics use the temperature and humidity calculated by the lake model units = flag dimensions = () - type = integer + type = logical intent = in [wind] standard_name = wind_speed_at_lowest_model_layer diff --git a/physics/sfc_diag_post.F90 b/physics/SFC_Layer/UFS/sfc_diag_post.F90 similarity index 86% rename from physics/sfc_diag_post.F90 rename to physics/SFC_Layer/UFS/sfc_diag_post.F90 index c1a43f170..2a7bd0f77 100644 --- a/physics/sfc_diag_post.F90 +++ b/physics/SFC_Layer/UFS/sfc_diag_post.F90 @@ -21,13 +21,13 @@ subroutine sfc_diag_post_run (im, lsm, lsm_noahmp, opt_diag, dry, lssav, dtf, co implicit none - integer, intent(in) :: im, lsm, lsm_noahmp,opt_diag - logical, intent(in) :: lssav - real(kind=kind_phys), intent(in) :: dtf, con_eps, con_epsm1 + integer, intent(in) :: im, lsm, lsm_noahmp,opt_diag + logical, intent(in) :: lssav + real(kind=kind_phys), intent(in) :: dtf, con_eps, con_epsm1 logical , dimension(:), intent(in) :: dry real(kind=kind_phys), dimension(:), intent(in) :: pgr, u10m, v10m real(kind=kind_phys), dimension(:), intent(inout) :: t2m, q2m, tmpmin, tmpmax, spfhmin, spfhmax - real(kind=kind_phys), dimension(:), intent(inout) :: t2mmp, q2mp + real(kind=kind_phys), dimension(:), intent(in), optional :: t2mmp, q2mp real(kind=kind_phys), dimension(:), intent(inout) :: wind10mmax, u10mmax, v10mmax, dpt2m character(len=*), intent(out) :: errmsg @@ -41,12 +41,12 @@ subroutine sfc_diag_post_run (im, lsm, lsm_noahmp, opt_diag, dry, lssav, dtf, co errflg = 0 if (lsm == lsm_noahmp) then - if (opt_diag == 2 .or. opt_diag == 3)then + if (opt_diag == 2 .or. opt_diag == 3) then do i=1,im if(dry(i)) then t2m(i) = t2mmp(i) q2m(i) = q2mp(i) - endif + endif enddo endif endif diff --git a/physics/sfc_diag_post.meta b/physics/SFC_Layer/UFS/sfc_diag_post.meta similarity index 97% rename from physics/sfc_diag_post.meta rename to physics/SFC_Layer/UFS/sfc_diag_post.meta index c50d3c4dc..7469b89b7 100644 --- a/physics/sfc_diag_post.meta +++ b/physics/SFC_Layer/UFS/sfc_diag_post.meta @@ -1,7 +1,8 @@ [ccpp-table-properties] name = sfc_diag_post type = scheme - dependencies = machine.F + relative_path = ../../ + dependencies = hooks/machine.F ######################################################################## [ccpp-arg-table] @@ -88,7 +89,8 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - intent = out + intent = in + optional = True [q2mp] standard_name = specific_humidity_at_2m_from_noahmp long_name = 2 meter specific humidity from noahmp @@ -96,7 +98,8 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - intent = out + intent = in + optional = True [t2m] standard_name = air_temperature_at_2m long_name = 2 meter temperature diff --git a/physics/sfc_diff.f b/physics/SFC_Layer/UFS/sfc_diff.f similarity index 94% rename from physics/sfc_diff.f rename to physics/SFC_Layer/UFS/sfc_diff.f index 6e834537a..e5cb4292e 100644 --- a/physics/sfc_diff.f +++ b/physics/SFC_Layer/UFS/sfc_diff.f @@ -60,7 +60,9 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) & sigmaf,vegtype,shdmax,ivegsrc, & !intent(in) & z0pert,ztpert, & ! mg, sfc-perts !intent(in) & flag_iter,redrag, & !intent(in) + & flag_lakefreeze, & !intent(in) & u10m,v10m,sfc_z0_type, & !hafs,z0 type !intent(in) + & u1,v1,usfco,vsfco,icplocn2atm, & & wet,dry,icy, & !intent(in) & thsfc_loc, & !intent(in) & tskin_wat, tskin_lnd, tskin_ice, & !intent(in) @@ -85,16 +87,20 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) integer, parameter :: kp = kind_phys integer, intent(in) :: im, ivegsrc integer, intent(in) :: sfc_z0_type ! option for calculating surface roughness length over ocean + integer, intent(in) :: icplocn2atm ! option for including ocean current in the computation of flux integer, dimension(:), intent(in) :: vegtype logical, intent(in) :: redrag ! reduced drag coeff. flag for high wind over sea (j.han) logical, dimension(:), intent(in) :: flag_iter, dry, icy + logical, dimension(:), intent(in) :: flag_lakefreeze logical, dimension(:), intent(inout) :: wet logical, intent(in) :: thsfc_loc ! Flag for reference pressure in theta calculation real(kind=kind_phys), dimension(:), intent(in) :: u10m,v10m + real(kind=kind_phys), dimension(:), intent(in) :: u1,v1 + real(kind=kind_phys), dimension(:), intent(in) :: usfco,vsfco real(kind=kind_phys), intent(in) :: rvrdm1, eps, epsm1, grav real(kind=kind_phys), dimension(:), intent(in) :: & & ps,t1,q1,z1,garea,prsl1,prslki,prsik1,prslk1, & @@ -125,6 +131,7 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) ! locals ! integer i + real(kind=kind_phys) :: windrel ! real(kind=kind_phys) :: rat, tv1, thv1, restar, wind10m, & czilc, tem1, tem2, virtfac @@ -168,7 +175,7 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) ! write(0,*)'in sfc_diff, sfc_z0_type=',sfc_z0_type do i=1,im - if(flag_iter(i)) then + if(flag_iter(i) .or. flag_lakefreeze(i)) then ! Need to initialize ztmax arrays ztmax_lnd(i) = 1. ! log(1) = 0 @@ -349,11 +356,29 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) & * virtfac endif - z0 = 0.01_kp * z0rl_wat(i) - z0max = max(zmin, min(z0,z1(i))) -! ustar_wat(i) = sqrt(grav * z0 / charnock) - wind10m = sqrt(u10m(i)*u10m(i)+v10m(i)*v10m(i)) + if (icplocn2atm == 0) then + wind10m=sqrt(u10m(i)*u10m(i)+v10m(i)*v10m(i)) + windrel=wind(i) + else if (icplocn2atm ==1) then + wind10m=sqrt((u10m(i)-usfco(i))**2+(v10m(i)-vsfco(i))**2) + windrel=sqrt((u1(i)-usfco(i))**2+(v1(i)-vsfco(i))**2) + endif + + if (sfc_z0_type == -1) then ! using wave model derived momentum roughness + tem1 = 0.11 * vis / ustar_wat(i) + z0 = tem1 + 0.01_kp * z0rl_wav(i) + if (redrag) then + z0max = max(min(z0, z0s_max),1.0e-7_kp) + else + z0max = max(min(z0,0.1_kp), 1.0e-7_kp) + endif + z0rl_wat(i) = 100.0_kp * z0max ! cm + else + z0 = 0.01_kp * z0rl_wat(i) + z0max = max(zmin, min(z0,z1(i))) + endif +! !** test xubin's new z0 ! ztmax = z0max @@ -383,7 +408,7 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) ! call stability ! --- inputs: - & (z1(i), zvfun(i), gdx, tv1, thv1, wind(i), + & (z1(i), zvfun(i), gdx, tv1, thv1, windrel, & z0max, ztmax_wat(i), tvs, grav, thsfc_loc, ! --- outputs: & rb_wat(i), fm_wat(i), fh_wat(i), fm10_wat(i), fh2_wat(i), @@ -423,17 +448,18 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) z0rl_wat(i) = 1.0e-4_kp endif - elseif (z0rl_wav(i) <= 1.0e-7_kp .or. & - & z0rl_wav(i) > 1.0_kp) then -! z0 = (charnock / grav) * ustar_wat(i) * ustar_wat(i) - tem1 = 0.11 * vis / ustar_wat(i) - z0 = tem1 + (charnock/grav)*ustar_wat(i)*ustar_wat(i) + elseif (z0rl_wav(i) <= 1.0e-7_kp .or. + & z0rl_wav(i) > 1.0_kp) then +! z0 = (charnock / grav) * ustar_wat(i) * ustar_wat(i) + tem1 = 0.11 * vis / ustar_wat(i) + z0 = tem1 + (charnock/grav)*ustar_wat(i)*ustar_wat(i) + + if (redrag) then + z0rl_wat(i) = 100.0_kp * max(min(z0, z0s_max),1.0e-7_kp) + else + z0rl_wat(i) = 100.0_kp * max(min(z0,0.1_kp), 1.0e-7_kp) + endif - if (redrag) then - z0rl_wat(i) = 100.0_kp * max(min(z0, z0s_max),1.0e-7_kp) - else - z0rl_wat(i) = 100.0_kp * max(min(z0,0.1_kp), 1.0e-7_kp) - endif endif endif ! end of if(open ocean) diff --git a/physics/sfc_diff.meta b/physics/SFC_Layer/UFS/sfc_diff.meta similarity index 93% rename from physics/sfc_diff.meta rename to physics/SFC_Layer/UFS/sfc_diff.meta index eb30b8c50..0964473cb 100644 --- a/physics/sfc_diff.meta +++ b/physics/SFC_Layer/UFS/sfc_diff.meta @@ -1,7 +1,8 @@ [ccpp-table-properties] name = sfc_diff type = scheme - dependencies = machine.F + relative_path = ../../ + dependencies = hooks/machine.F ######################################################################## [ccpp-arg-table] @@ -194,6 +195,13 @@ dimensions = () type = logical intent = in +[flag_lakefreeze] + standard_name = flag_for_lake_water_freeze + long_name = flag for lake water freeze + units = flag + dimensions = (horizontal_loop_extent) + type = logical + intent = in [u10m] standard_name = x_wind_at_10m long_name = 10 meter u wind speed @@ -210,6 +218,38 @@ type = real kind = kind_phys intent = in +[u1] + standard_name = x_wind_at_surface_adjacent_layer + long_name = x component of surface layer wind + units = m s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in +[v1] + standard_name = y_wind_at_surface_adjacent_layer + long_name = y component of surface layer wind + units = m s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in +[usfco] + standard_name = x_ocean_current + long_name = zonal current at ocean surface + units = m s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in +[vsfco] + standard_name = y_ocean_current + long_name = meridional current at ocean surface + units = m s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in [sfc_z0_type] standard_name = flag_for_surface_roughness_option_over_water long_name = surface roughness options over water @@ -217,6 +257,13 @@ dimensions = () type = integer intent = in +[icplocn2atm] + standard_name = control_for_air_sea_flux_computation_over_water + long_name = air-sea flux option + units = 1 + dimensions = () + type = integer + intent = in [wet] standard_name = flag_nonzero_wet_surface_fraction long_name = flag indicating presence of some ocean or lake surface area fraction diff --git a/physics/SFC_Layer/UFS/sfc_nst.f90 b/physics/SFC_Layer/UFS/sfc_nst.f90 new file mode 100644 index 000000000..c8c40a20d --- /dev/null +++ b/physics/SFC_Layer/UFS/sfc_nst.f90 @@ -0,0 +1,681 @@ +!>\file sfc_nst.f90 +!! This file contains the GFS NSST model. + +!> This module contains the CCPP-compliant GFS near-surface sea temperature scheme. +module sfc_nst + + use machine , only : kind_phys, kp => kind_phys + use funcphys , only : fpvs + use module_nst_parameters , only : one, zero, half + use module_nst_parameters , only : t0k, cp_w, omg_m, omg_sh, sigma_r, solar_time_6am, sst_max + use module_nst_parameters , only : ri_c, z_w_max, delz, wd_max, rad2deg, const_rot, tau_min, tw_max + use module_nst_water_prop , only : get_dtzm_point, density, rhocoef, grv, sw_ps_9b + use nst_module , only : cool_skin, dtm_1p, cal_w, cal_ttop, convdepth, dtm_1p_fca + use nst_module , only : dtm_1p_tla, dtm_1p_mwa, dtm_1p_mda, dtm_1p_mta, dtl_reset + ! + implicit none +contains + + !>\defgroup gfs_nst_main_mod GFS Near-Surface Sea Temperature Module + !! This module contains the CCPP-compliant GFS near-surface sea temperature scheme. + !> @{ + !! This subroutine calls the Thermal Skin-layer and Diurnal Thermocline models to update the NSST profile. + !! \section arg_table_sfc_nst_run Argument Table + !! \htmlinclude sfc_nst_run.html + !! + !> \section NSST_general_algorithm GFS Near-Surface Sea Temperature Scheme General Algorithm + subroutine sfc_nst_run & + ( im, hvap, cp, hfus, jcal, eps, epsm1, rvrdm1, rd, rhw0, & ! --- inputs: + pi, tgice, sbc, ps, u1, v1, usfco, vsfco, icplocn2atm, t1, & + q1, tref, cm, ch, lseaspray, fm, fm10, & + prsl1, prslki, prsik1, prslk1, wet, use_lake_model, xlon, & + sinlat, stress, & + sfcemis, dlwflx, sfcnsw, rain, timestep, kdt, solhr,xcosz, & + wind, flag_iter, flag_guess, nstf_name1, nstf_name4, & + nstf_name5, lprnt, ipr, thsfc_loc, & + tskin, tsurf, xt, xs, xu, xv, xz, zm, xtts, xzts, dt_cool, & ! --- input/output: + z_c, c_0, c_d, w_0, w_d, d_conv, ifd, qrain, & + qsurf, gflux, cmm, chh, evap, hflx, ep, errmsg, errflg & ! --- outputs: + ) + ! + ! ===================================================================== ! + ! description: ! + ! ! + ! ! + ! usage: ! + ! ! + ! call sfc_nst ! + ! inputs: ! + ! ( im, ps, u1, v1, t1, q1, tref, cm, ch, ! + ! lseaspray, fm, fm10, ! + ! prsl1, prslki, wet, use_lake_model, xlon, sinlat, stress, ! + ! sfcemis, dlwflx, sfcnsw, rain, timestep, kdt,solhr,xcosz, ! + ! wind, flag_iter, flag_guess, nstf_name1, nstf_name4, ! + ! nstf_name5, lprnt, ipr, thsfc_loc, ! + ! input/outputs: ! + ! 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, ! + ! -- outputs: + ! qsurf, gflux, cmm, chh, evap, hflx, ep ! + ! ) + ! ! + ! ! + ! subprogram/functions called: fpvs, density, rhocoef, cool_skin ! + ! ! + ! program history log: ! + ! 2007 -- xu li createad original code ! + ! 2008 -- s. moorthi adapted to the parallel version ! + ! may 2009 -- y.-t. hou modified to include input lw surface ! + ! emissivity from radiation. also replaced the ! + ! often comfusing combined sw and lw suface ! + ! flux with separate sfc net sw flux (defined ! + ! as dn-up) and lw flux. added a program doc block. ! + ! sep 2009 -- s. moorthi removed rcl and additional reformatting ! + ! and optimization + made pa as input pressure unit.! + ! 2009 -- xu li recreatead the code ! + ! feb 2010 -- s. moorthi added some changes made to the previous ! + ! version ! + ! Jul 2016 -- X. Li, modify the diurnal warming event reset ! + ! ! + ! ! + ! ==================== definition of variables ==================== ! + ! ! + ! inputs: size ! + ! im - integer, horiz dimension 1 ! + ! ps - real, surface pressure (pa) im ! + ! u1, v1 - real, u/v component of surface layer wind (m/s) im ! + ! usfco, vsfco - real, u/v component of surface current (m/s) im ! + ! icplocn2atm - integer, option to include ocean surface 1 ! + ! current in the computation of flux ! + ! t1 - real, surface layer mean temperature ( k ) im ! + ! q1 - real, surface layer mean specific humidity im ! + ! tref - real, reference/foundation temperature ( k ) im ! + ! cm - real, surface exchange coeff for momentum (m/s) im ! + ! ch - real, surface exchange coeff heat & moisture(m/s) im ! + ! lseaspray- logical, .t. for parameterization for sea spray 1 ! + ! fm - real, a stability profile function for momentum im ! + ! fm10 - real, a stability profile function for momentum im ! + ! at 10m ! + ! prsl1 - real, surface layer mean pressure (pa) im ! + ! prslki - real, im ! + ! prsik1 - real, im ! + ! prslk1 - real, im ! + ! wet - logical, =T if any ocn/lake water (F otherwise) im ! + ! use_lake_model- logical, =T if flake model is used for lake 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 ! + ! 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 ! + ! 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 ! + ! for both land and ocean (when nstf_name1 > 0) im ! + ! flag_guess-logical, .true.= guess step to get CD et al im ! + ! when iter = 1, flag_guess = .true. when wind < 2 im ! + ! when iter = 2, flag_guess = .false. for all grids im ! + ! nstf_name - integers , NSST related flag parameters 1 ! + ! nstf_name1 : 0 = NSSTM off 1 ! + ! 1 = NSSTM on but uncoupled 1 ! + ! 2 = NSSTM on and coupled 1 ! + ! nstf_name4 : zsea1 in mm 1 ! + ! nstf_name5 : zsea2 in mm 1 ! + ! lprnt - logical, control flag for check print out 1 ! + ! ipr - integer, grid index for check print out 1 ! + ! thsfc_loc- logical, flag for reference pressure in theta 1 ! + ! ! + ! input/outputs: + ! li added for oceanic components + ! tskin - real, ocean surface skin temperature ( k ) im ! + ! tsurf - real, the same as tskin ( k ) but for guess run im ! + ! xt - real, heat content in dtl im ! + ! xs - real, salinity content in dtl im ! + ! xu - real, u-current content in dtl im ! + ! xv - real, v-current content in dtl im ! + ! xz - real, dtl thickness im ! + ! zm - real, mxl thickness im ! + ! xtts - real, d(xt)/d(ts) im ! + ! xzts - real, d(xz)/d(ts) im ! + ! dt_cool - real, sub-layer cooling amount im ! + ! d_conv - real, thickness of free convection layer (fcl) im ! + ! z_c - sub-layer cooling thickness im ! + ! c_0 - coefficient1 to calculate d(tz)/d(ts) im ! + ! c_d - coefficient2 to calculate d(tz)/d(ts) im ! + ! w_0 - coefficient3 to calculate d(tz)/d(ts) im ! + ! w_d - coefficient4 to calculate d(tz)/d(ts) im ! + ! ifd - real, index to start dtlm run or not im ! + ! qrain - real, sensible heat flux due to rainfall (watts) im ! + + ! outputs: ! + + ! qsurf - real, surface air saturation specific humidity im ! + ! gflux - real, soil heat flux (w/m**2) im ! + ! cmm - real, im ! + ! chh - real, im ! + ! evap - real, evaperation from latent heat flux im ! + ! hflx - real, sensible heat flux im ! + ! ep - real, potential evaporation im ! + ! ! + ! ===================================================================== ! + + + + ! --- inputs: + integer, intent(in) :: im, kdt, ipr, nstf_name1, nstf_name4, nstf_name5 + integer, intent(in) :: icplocn2atm + + real (kind=kind_phys), intent(in) :: hvap, cp, hfus, jcal, eps, & + epsm1, rvrdm1, rd, rhw0, sbc, pi, tgice + real (kind=kind_phys), dimension(:), intent(in) :: ps, u1, v1, & + usfco, vsfco, t1, q1, cm, ch, fm, fm10, & + prsl1, prslki, prsik1, prslk1, xlon, xcosz, & + sinlat, stress, sfcemis, dlwflx, sfcnsw, rain, wind + real (kind=kind_phys), dimension(:), intent(in), optional :: & + tref + real (kind=kind_phys), intent(in) :: timestep + real (kind=kind_phys), intent(in) :: solhr + + ! For sea spray effect + logical, intent(in) :: lseaspray + ! + logical, dimension(:), intent(in) :: flag_iter, flag_guess, wet + integer, dimension(:), intent(in) :: use_lake_model + logical, intent(in) :: lprnt + logical, intent(in) :: thsfc_loc + + ! --- input/outputs: + ! control variables of dtl system (5+2) and sl (2) and coefficients for d(tz)/d(ts) calculation + real (kind=kind_phys), dimension(:), intent(inout) :: tskin, & + tsurf + real (kind=kind_phys), dimension(:), intent(inout), optional :: & + xt, xs, xu, xv, xz, zm, xtts, xzts, dt_cool, & + z_c, c_0, c_d, w_0, w_d, d_conv, ifd, qrain + + ! --- outputs: + real (kind=kind_phys), dimension(:), intent(inout) :: qsurf, gflux, cmm, chh, evap, hflx, ep + + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! + ! locals + ! + integer :: k,i + ! + real (kind=kind_phys), dimension(im) :: q0, qss, rch, rho_a, theta1, tv1, wndmag + + real(kind=kind_phys) :: elocp,tem,cpinv,hvapi + ! + ! nstm related prognostic fields + ! + logical :: flag(im) + real (kind=kind_phys), dimension(im) :: xt_old, xs_old, xu_old, xv_old, xz_old, & + zm_old,xtts_old, xzts_old, ifd_old, tref_old, tskin_old, dt_cool_old,z_c_old + + real(kind=kind_phys) :: ulwflx(im), nswsfc(im) + ! real(kind=kind_phys) rig(im), + ! & ulwflx(im),dlwflx(im), + ! & slrad(im),nswsfc(im) + real(kind=kind_phys) :: alpha,beta,rho_w,f_nsol,sss,sep, cosa,sina,taux,tauy, & + grav,dz,t0,ttop0,ttop + + real(kind=kind_phys) :: le,fc,dwat,dtmp,wetc,alfac,ustar_a,rich + real(kind=kind_phys) :: rnl_ts,hs_ts,hl_ts,rf_ts,q_ts + real(kind=kind_phys) :: fw,q_warm + real(kind=kind_phys) :: t12,alon,tsea,sstc,dta,dtz + real(kind=kind_phys) :: zsea1,zsea2,soltim + logical :: do_nst + ! + ! parameters for sea spray effect + ! + real (kind=kind_phys) :: f10m, u10m, v10m, ws10, ru10, qss1, & + bb1, hflxs, evaps, ptem + ! + ! real (kind=kind_phys), parameter :: alps=0.5, bets=0.5, gams=0.1, + ! real (kind=kind_phys), parameter :: alps=0.5, bets=0.5, gams=0.0, + ! real (kind=kind_phys), parameter :: alps=1.0, bets=1.0, gams=0.2, + real (kind=kind_phys), parameter :: alps=0.75,bets=0.75,gams=0.15, & + ws10cr=30., conlf=7.2e-9, consf=6.4e-8 + real (kind=kind_phys) :: windrel + ! + !====================================================================================================== + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + if (nstf_name1 == 0) return ! No NSST model used + + cpinv = one/cp + hvapi = one/hvap + elocp = hvap/cp + + sss = 34.0_kp ! temporarily, when sea surface salinity data is not ready + ! + ! flag for open water and where the iteration is on + ! + do_nst = .false. + do i = 1, im + ! flag(i) = wet(i) .and. .not.icy(i) .and. flag_iter(i) + flag(i) = wet(i) .and. flag_iter(i) .and. use_lake_model(i)/=1 + do_nst = do_nst .or. flag(i) + enddo + if (.not. do_nst) return + ! + ! 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. flag_guess(i) .and. use_lake_model(i)/=1) then + xt_old(i) = xt(i) + xs_old(i) = xs(i) + xu_old(i) = xu(i) + xv_old(i) = xv(i) + xz_old(i) = xz(i) + zm_old(i) = zm(i) + xtts_old(i) = xtts(i) + xzts_old(i) = xzts(i) + ifd_old(i) = ifd(i) + tskin_old(i) = tskin(i) + dt_cool_old(i) = dt_cool(i) + z_c_old(i) = z_c(i) + endif + enddo + + + ! --- ... initialize variables. all units are m.k.s. unless specified. + ! ps is in pascals, wind is wind speed, theta1 is surface air + ! estimated from level 1 temperature, rho_a is air density and + ! qss is saturation specific humidity at the water surface + !! + do i = 1, im + if ( flag(i) ) then + + 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)) + + q0(i) = max(q1(i), 1.0e-8_kp) + + if(thsfc_loc) then ! Use local potential temperature + theta1(i) = t1(i) * prslki(i) + else ! Use potential temperature referenced to 1000 hPa + theta1(i) = t1(i) / prslk1(i) ! potential temperature at the middle of lowest model layer + endif + + tv1(i) = t1(i) * (one + rvrdm1*q0(i)) + rho_a(i) = prsl1(i) / (rd*tv1(i)) + qss(i) = fpvs(tsurf(i)) ! pa + qss(i) = eps*qss(i) / (ps(i) + epsm1*qss(i)) ! pa + ! + evap(i) = zero + hflx(i) = zero + gflux(i) = zero + ep(i) = zero + + ! --- ... rcp = rho cp ch v + + if (icplocn2atm ==0) then + rch(i) = rho_a(i) * cp * ch(i) * wind(i) + cmm(i) = cm (i) * wind(i) + chh(i) = rho_a(i) * ch(i) * wind(i) + else if (icplocn2atm ==1) then + windrel= sqrt( (u1(i)-usfco(i))**2 + (v1(i)-vsfco(i))**2 ) + rch(i) = rho_a(i) * cp * ch(i) * windrel + cmm(i) = cm (i) * windrel + chh(i) = rho_a(i) * ch(i) * windrel + endif + + !> - Calculate latent and sensible heat flux over open water with tskin. + ! at previous time step + evap(i) = elocp * rch(i) * (qss(i) - q0(i)) + qsurf(i) = qss(i) + + if(thsfc_loc) then ! Use local potential temperature + hflx(i) = rch(i) * (tsurf(i) - theta1(i)) + else ! Use potential temperature referenced to 1000 hPa + hflx(i) = rch(i) * (tsurf(i)/prsik1(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) + ! &,' tsurf=',tsurf(i) + endif + enddo + + ! run nst model: dtm + slm + ! + zsea1 = 0.001_kp*real(nstf_name4) + zsea2 = 0.001_kp*real(nstf_name5) + + !> - Call module_nst_water_prop::density() to compute sea water density. + !> - Call module_nst_water_prop::rhocoef() to compute thermal expansion + !! coefficient (\a alpha) and saline contraction coefficient (\a beta). + do i = 1, im + if ( flag(i) ) then + tsea = tsurf(i) + t12 = tsea*tsea + ulwflx(i) = sfcemis(i) * sbc * t12 * t12 + alon = xlon(i)*rad2deg + grav = grv(sinlat(i)) + soltim = mod(alon/15.0_kp + solhr, 24.0_kp)*3600.0_kp + call density(tsea,sss,rho_w) ! sea water density + call rhocoef(tsea,sss,rho_w,alpha,beta) ! alpha & beta + ! + !> - Calculate sensible heat flux (\a qrain) due to rainfall. + ! + le = (2.501_kp-0.00237_kp*tsea)*1.0e6_kp + dwat = 2.11e-5_kp*(t1(i)/t0k)**1.94_kp ! water vapor diffusivity + dtmp = (one+3.309e-3_kp*(t1(i)-t0k)-1.44e-6_kp*(t1(i)-t0k) & + * (t1(i)-t0k))*0.02411_kp/(rho_a(i)*cp) ! heat diffusivity + wetc = 622.0_kp*le*qss(i)/(rd*t1(i)*t1(i)) + alfac = one / (one + (wetc*le*dwat)/(cp*dtmp)) ! wet bulb factor + tem = (1.0e3_kp * rain(i) / rho_w) * alfac * cp_w + qrain(i) = tem * (tsea-t1(i)+1.0e3_kp*(qss(i)-q0(i))*le/cp) + + !> - Calculate input non solar heat flux as upward = positive to models here + + f_nsol = hflx(i) + evap(i) + ulwflx(i) - dlwflx(i) + omg_sh*qrain(i) + + ! if (lprnt .and. i == ipr) print *,' f_nsol=',f_nsol,' hflx=', + ! &hflx(i),' evap=',evap(i),' ulwflx=',ulwflx(i),' dlwflx=',dlwflx(i) + ! &,' omg_sh=',omg_sh,' qrain=',qrain(i) + + sep = sss*(evap(i)/le-rain(i))/rho_w + ustar_a = sqrt(stress(i)/rho_a(i)) ! air friction velocity + ! + ! sensitivities of heat flux components to ts + ! + rnl_ts = 4.0_kp*sfcemis(i)*sbc*tsea*tsea*tsea ! d(rnl)/d(ts) + hs_ts = rch(i) + hl_ts = rch(i)*elocp*eps*hvap*qss(i)/(rd*t12) + rf_ts = tem * (one+rch(i)*hl_ts) + q_ts = rnl_ts + hs_ts + hl_ts + omg_sh*rf_ts + ! + !> - Call cool_skin(), which is the sub-layer cooling parameterization + !! (Fairfall et al. (1996) \cite fairall_et_al_1996). + ! & calculate c_0, c_d + ! + call cool_skin(ustar_a,f_nsol,nswsfc(i),evap(i),sss,alpha,beta, & + rho_w,rho_a(i),tsea,q_ts,hl_ts,grav,le, & + dt_cool(i),z_c(i),c_0(i),c_d(i)) + + tem = one / wndmag(i) + cosa = u1(i)*tem + sina = v1(i)*tem + taux = max(stress(i),tau_min)*cosa + tauy = max(stress(i),tau_min)*sina + fc = const_rot*sinlat(i) + ! + ! Run DTM-1p system. + ! + if ( (soltim > solar_time_6am .and. ifd(i) == zero) ) then + else + ifd(i) = one + ! + ! calculate fcl thickness with current forcing and previous time's profile + ! + ! if (lprnt .and. i == ipr) print *,' beg xz=',xz(i) + + !> - Call convdepth() to calculate depth for convective adjustments. + if ( f_nsol > zero .and. xt(i) > zero ) then + call convdepth(kdt,timestep,nswsfc(i),f_nsol,sss,sep,rho_w, & + alpha,beta,xt(i),xs(i),xz(i),d_conv(i)) + else + d_conv(i) = zero + endif + + ! if (lprnt .and. i == ipr) print *,' beg xz1=',xz(i) + ! + ! determine rich: wind speed dependent (right now) + ! + ! if ( wind(i) < 1.0 ) then + ! rich = 0.25 + 0.03*wind(i) + ! elseif ( wind(i) >= 1.0 .and. wind(i) < 1.5 ) then + ! rich = 0.25 + 0.1*wind(i) + ! elseif ( wind(i) >= 1.5 .and. wind(i) < 6.0 ) then + ! rich = 0.25 + 0.6*wind(i) + ! elseif ( wind(i) >= 6.0 ) then + ! rich = 0.25 + min(0.8*wind(i),0.50) + ! endif + + rich = ri_c + + !> - Call the diurnal thermocline layer model dtm_1p(). + call dtm_1p(kdt,timestep,rich,taux,tauy,nswsfc(i), & + f_nsol,sss,sep,q_ts,hl_ts,rho_w,alpha,beta,alon, & + sinlat(i),soltim,grav,le,d_conv(i), & + xt(i),xs(i),xu(i),xv(i),xz(i),xzts(i),xtts(i)) + + ! if (lprnt .and. i == ipr) print *,' beg xz2=',xz(i) + + ! apply mda + if ( xt(i) > zero ) then + !> - If \a dtl heat content \a xt > 0.0, call dtm_1p_mda() to apply + !! minimum depth adjustment (mda). + call dtm_1p_mda(xt(i),xtts(i),xz(i),xzts(i)) + if ( xz(i) >= z_w_max ) then + !> - If \a dtl thickness >= module_nst_parameters::z_w_max, call dtl_reset() + !! to reset xt/xs/x/xv to zero, and xz to module_nst_parameters::z_w_max. + call dtl_reset(xt(i),xs(i),xu(i),xv(i),xz(i),xtts(i), xzts(i)) + + ! if (lprnt .and. i == ipr) print *,' beg xz3=',xz(i),' z_w_max=' + ! &,z_w_max + endif + + ! apply fca + if ( d_conv(i) > zero ) then + !> - If thickness of free convection layer > 0.0, call dtm_1p_fca() + !! to apply free convection adjustment. + !> - If \a dtl thickness >= module_nst_parameters::z_w_max(), call dtl_reset() + !! to reset xt/xs/x/xv to zero, and xz to module_nst_parameters::z_w_max(). + call dtm_1p_fca(d_conv(i),xt(i),xtts(i),xz(i),xzts(i)) + if ( xz(i) >= z_w_max ) then + call dtl_reset (xt(i),xs(i),xu(i),xv(i),xz(i),xzts(i),xtts(i)) + endif + endif + + ! if (lprnt .and. i == ipr) print *,' beg xz4=',xz(i) + + ! apply tla + dz = min(xz(i),max(d_conv(i),delz)) + ! + !> - Call sw_ps_9b() to compute the fraction of the solar radiation + !! absorbed by the depth \a delz (Paulson and Simpson (1981) \cite paulson_and_simpson_1981). + !! And calculate the total heat absorbed in warm layer. + call sw_ps_9b(delz,fw) + q_warm = fw*nswsfc(i)-f_nsol !total heat absorbed in warm layer + + !> - Call cal_ttop() to calculate the diurnal warming amount at the top layer with + !! thickness of \a dz. + if ( q_warm > zero ) then + call cal_ttop(kdt,timestep,q_warm,rho_w,dz, xt(i),xz(i),ttop0) + + ! if (lprnt .and. i == ipr) print *,' d_conv=',d_conv(i),' delz=', + ! &delz,' kdt=',kdt,' timestep=',timestep,' nswsfc=',nswsfc(i), + ! &' f_nsol=',f_nsol,' rho_w=',rho_w,' dz=',dz,' xt=',xt(i), + ! &' xz=',xz(i),' qrain=',qrain(i) + + ttop = ((xt(i)+xt(i))/xz(i))*(one-dz/((xz(i)+xz(i)))) + + ! if (lprnt .and. i == ipr) print *,' beg xz4a=',xz(i) + ! &,' ttop=',ttop,' ttop0=',ttop0,' xt=',xt(i),' dz=',dz + ! &,' xznew=',(xt(i)+sqrt(xt(i)*(xt(i)-dz*ttop0)))/ttop0 + + !> - Call dtm_1p_tla() to apply top layer adjustment. + if ( ttop > ttop0 ) then + call dtm_1p_tla(dz,ttop0,xt(i),xtts(i),xz(i),xzts(i)) + + ! if (lprnt .and. i == ipr) print *,' beg xz4b=',xz(i),'z_w_max=', + ! &z_w_max + if ( xz(i) >= z_w_max ) then + call dtl_reset (xt(i),xs(i),xu(i),xv(i),xz(i),xzts(i),xtts(i)) + endif + endif + endif ! if ( q_warm > 0.0 ) then + + ! if (lprnt .and. i == ipr) print *,' beg xz5=',xz(i) + + ! apply mwa + !> - Call dt_1p_mwa() to apply maximum warming adjustment. + t0 = (xt(i)+xt(i))/xz(i) + if ( t0 > tw_max ) then + call dtm_1p_mwa(xt(i),xtts(i),xz(i),xzts(i)) + if ( xz(i) >= z_w_max ) then + call dtl_reset (xt(i),xs(i),xu(i),xv(i),xz(i),xzts(i),xtts(i)) + endif + endif + + ! if (lprnt .and. i == ipr) print *,' beg xz6=',xz(i) + + ! apply mta + !> - Call dtm_1p_mta() to apply maximum temperature adjustment. + sstc = tref(i) + (xt(i)+xt(i))/xz(i) - dt_cool(i) + + if ( sstc > sst_max ) then + dta = sstc - sst_max + call dtm_1p_mta(dta,xt(i),xtts(i),xz(i),xzts(i)) + ! write(*,'(a,f3.0,7f8.3)') 'mta, sstc,dta :',islimsk(i), + ! & sstc,dta,tref(i),xt(i),xz(i),2.0*xt(i)/xz(i),dt_cool(i) + if ( xz(i) >= z_w_max ) then + call dtl_reset (xt(i),xs(i),xu(i),xv(i),xz(i),xzts(i),xtts(i)) + endif + endif + ! + endif ! if ( xt(i) > 0.0 ) then + ! reset dtl at midnight and when solar zenith angle > 89.994 degree + if ( abs(soltim) < 2.0_kp*timestep ) then + call dtl_reset (xt(i),xs(i),xu(i),xv(i),xz(i),xzts(i),xtts(i)) + endif + + endif ! if (solar_time > solar_time_6am .and. ifd(i) == 0.0 ) then: too late to start the first day + + ! if (lprnt .and. i == ipr) print *,' beg xz7=',xz(i) + + ! update tsurf (when flag(i) .eqv. .true. ) + !> - Call get_dtzm_point() to computes \a dtz and \a tsurf. + call get_dtzm_point(xt(i),xz(i),dt_cool(i),z_c(i), zsea1,zsea2,dtz) + tsurf(i) = max(tgice, tref(i) + dtz ) + + ! 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) > zero ) then + call cal_w(kdt,xz(i),xt(i),xzts(i),xtts(i),w_0(i),w_d(i)) + else + w_0(i) = zero + w_d(i) = zero + endif + + ! if ( xt(i) > 0.0 ) then + ! rig(i) = grav*xz(i)*xz(i)*(alpha*xt(i)-beta*xs(i)) + ! & /(2.0*(xu(i)*xu(i)+xv(i)*xv(i))) + ! else + ! rig(i) = 0.25 + ! endif + + ! qrain(i) = rig(i) + zm(i) = wind(i) + + endif + enddo + + ! restore nst-related prognostic fields for guess run + do i=1, im + ! if (wet(i) .and. .not.icy(i)) then + if (wet(i) .and. use_lake_model(i)/=1) 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) + xv(i) = xv_old(i) + xz(i) = xz_old(i) + zm(i) = zm_old(i) + xtts(i) = xtts_old(i) + xzts(i) = xzts_old(i) + ifd(i) = ifd_old(i) + tskin(i) = tskin_old(i) + dt_cool(i) = dt_cool_old(i) + z_c(i) = z_c_old(i) + else + ! + ! update tskin when coupled and not guess run + ! (all other NSST variables have been updated in this case) + ! + 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 + enddo + + ! if (lprnt .and. i == ipr) print *,' beg xz8=',xz(i) + + if ( nstf_name1 > 1 ) then + !> - Calculate latent and sensible heat flux over open water with updated tskin + !! for the grids of open water and the iteration is on. + do i = 1, im + if ( flag(i) ) then + qss(i) = fpvs( tskin(i) ) + qss(i) = eps*qss(i) / (ps(i) + epsm1*qss(i)) + qsurf(i) = qss(i) + evap(i) = elocp*rch(i) * (qss(i) - q0(i)) + + if(thsfc_loc) then ! Use local potential temperature + hflx(i) = rch(i) * (tskin(i) - theta1(i)) + else ! Use potential temperature referenced to 1000 hPa + hflx(i) = rch(i) * (tskin(i)/prsik1(i) - theta1(i)) + endif + + endif + enddo + endif ! if ( nstf_name1 > 1 ) then + ! + !> - Include sea spray effects + ! + do i=1,im + if(lseaspray .and. flag(i)) then + f10m = fm10(i) / fm(i) + u10m = f10m * u1(i) + v10m = f10m * v1(i) + ws10 = sqrt(u10m*u10m + v10m*v10m) + ws10 = max(ws10,1.) + ws10 = min(ws10,ws10cr) + tem = .015 * ws10 * ws10 + ru10 = 1. - .087 * log(10./tem) + qss1 = fpvs(t1(i)) + qss1 = eps * qss1 / (prsl1(i) + epsm1 * qss1) + tem = rd * cp * t1(i) * t1(i) + tem = 1. + eps * hvap * hvap * qss1 / tem + bb1 = 1. / tem + evaps = conlf * (ws10**5.4) * ru10 * bb1 + evaps = evaps * rho_a(i) * hvap * (qss1 - q0(i)) + evap(i) = evap(i) + alps * evaps + hflxs = consf * (ws10**3.4) * ru10 + hflxs = hflxs * rho_a(i) * cp * (tskin(i) - t1(i)) + ptem = alps - gams + hflx(i) = hflx(i) + bets * hflxs - ptem * evaps + endif + enddo + ! + do i=1,im + if ( flag(i) ) then + tem = one / rho_a(i) + hflx(i) = hflx(i) * tem * cpinv + evap(i) = evap(i) * tem * hvapi + endif + enddo + ! + ! if (lprnt) print *,' tskin=',tskin(ipr) + + return + end subroutine sfc_nst_run + !> @} +end module sfc_nst diff --git a/physics/sfc_nst.meta b/physics/SFC_Layer/UFS/sfc_nst.meta similarity index 94% rename from physics/sfc_nst.meta rename to physics/SFC_Layer/UFS/sfc_nst.meta index dc35ec959..06089aa66 100644 --- a/physics/sfc_nst.meta +++ b/physics/SFC_Layer/UFS/sfc_nst.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = sfc_nst type = scheme - dependencies = date_def.f,funcphys.f90,machine.F,module_nst_model.f90,module_nst_parameters.f90,module_nst_water_prop.f90 + dependencies = date_def.f,../../tools/funcphys.f90,../../hooks/machine.F,module_nst_model.f90,module_nst_parameters.f90,module_nst_water_prop.f90 ######################################################################## [ccpp-arg-table] @@ -134,6 +134,29 @@ type = real kind = kind_phys intent = in +[usfco] + standard_name = x_ocean_current + long_name = zonal current at ocean surface + units = m s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in +[vsfco] + standard_name = y_ocean_current + long_name = meridional current at ocean surface + units = m s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in +[icplocn2atm] + standard_name = control_for_air_sea_flux_computation_over_water + long_name = air-sea flux option + units = 1 + dimensions = () + type = integer + intent = in [t1] standard_name = air_temperature_at_surface_adjacent_layer long_name = surface layer mean temperature @@ -158,6 +181,7 @@ type = real kind = kind_phys intent = in + optional = True [cm] standard_name = surface_drag_coefficient_for_momentum_in_air_over_water long_name = surface exchange coeff for momentum over water @@ -418,6 +442,7 @@ type = real kind = kind_phys intent = inout + optional = True [xs] standard_name = sea_water_salinity_in_diurnal_thermocline long_name = salinity content in diurnal thermocline layer @@ -426,6 +451,7 @@ type = real kind = kind_phys intent = inout + optional = True [xu] standard_name = x_current_in_diurnal_thermocline long_name = u-current content in diurnal thermocline layer @@ -434,6 +460,7 @@ type = real kind = kind_phys intent = inout + optional = True [xv] standard_name = y_current_in_diurnal_thermocline long_name = v-current content in diurnal thermocline layer @@ -442,6 +469,7 @@ type = real kind = kind_phys intent = inout + optional = True [xz] standard_name = diurnal_thermocline_layer_thickness long_name = diurnal thermocline layer thickness @@ -450,6 +478,7 @@ type = real kind = kind_phys intent = inout + optional = True [zm] standard_name = ocean_mixed_layer_thickness long_name = mixed layer thickness @@ -458,6 +487,7 @@ type = real kind = kind_phys intent = inout + optional = True [xtts] standard_name = derivative_of_heat_content_in_diurnal_thermocline_wrt_surface_skin_temperature long_name = d(xt)/d(ts) @@ -466,6 +496,7 @@ type = real kind = kind_phys intent = inout + optional = True [xzts] standard_name = derivative_of_diurnal_thermocline_layer_thickness_wrt_surface_skin_temperature long_name = d(xz)/d(ts) @@ -474,6 +505,7 @@ type = real kind = kind_phys intent = inout + optional = True [dt_cool] standard_name = molecular_sublayer_temperature_correction_in_sea_water long_name = sub-layer cooling amount @@ -482,6 +514,7 @@ type = real kind = kind_phys intent = inout + optional = True [z_c] standard_name = molecular_sublayer_thickness_in_sea_water long_name = sub-layer cooling thickness @@ -490,6 +523,7 @@ type = real kind = kind_phys intent = inout + optional = True [c_0] standard_name = coefficient_c_0 long_name = coefficient1 to calculate d(tz)/d(ts) @@ -498,6 +532,7 @@ type = real kind = kind_phys intent = inout + optional = True [c_d] standard_name = coefficient_c_d long_name = coefficient2 to calculate d(tz)/d(ts) @@ -506,6 +541,7 @@ type = real kind = kind_phys intent = inout + optional = True [w_0] standard_name = coefficient_w_0 long_name = coefficient3 to calculate d(tz)/d(ts) @@ -514,6 +550,7 @@ type = real kind = kind_phys intent = inout + optional = True [w_d] standard_name = coefficient_w_d long_name = coefficient4 to calculate d(tz)/d(ts) @@ -522,6 +559,7 @@ type = real kind = kind_phys intent = inout + optional = True [d_conv] standard_name = free_convection_layer_thickness_in_sea_water long_name = thickness of free convection layer @@ -530,6 +568,7 @@ type = real kind = kind_phys intent = inout + optional = True [ifd] standard_name = control_for_diurnal_thermocline_calculation long_name = index to start dtlm run or not @@ -538,6 +577,7 @@ type = real kind = kind_phys intent = inout + optional = True [qrain] standard_name = surface_sensible_heat_due_to_rainfall long_name = sensible heat flux due to rainfall @@ -546,6 +586,7 @@ type = real kind = kind_phys intent = inout + optional = True [qsurf] standard_name = surface_specific_humidity_over_water long_name = surface air saturation specific humidity over water diff --git a/physics/SFC_Layer/UFS/sfc_nst_post.f90 b/physics/SFC_Layer/UFS/sfc_nst_post.f90 new file mode 100644 index 000000000..0357a86f0 --- /dev/null +++ b/physics/SFC_Layer/UFS/sfc_nst_post.f90 @@ -0,0 +1,88 @@ +!> \file sfc_nst_post.f90 +!! This file contains code to be executed after the GFS NSST model. + +module sfc_nst_post + + use machine , only : kind_phys, kp => kind_phys + use module_nst_water_prop , only : get_dtzm_2d + + implicit none + +contains + + ! \defgroup GFS_NSST_POST GFS Near-Surface Sea Temperature Post + + !> \section arg_table_sfc_nst_post_run Argument Table + !! \htmlinclude sfc_nst_post_run.html + !! + ! \section NSST_general_post_algorithm General Algorithm + ! + ! \section NSST_detailed_post_algorithm Detailed Algorithm + ! @{ + subroutine sfc_nst_post_run & + ( im, kdt, rlapse, tgice, wet, use_lake_model, icy, oro, & + oro_uf, nstf_name1, & + nstf_name4, nstf_name5, xt, xz, dt_cool, z_c, tref, xlon, & + tsurf_wat, tsfc_wat, nthreads, dtzm, errmsg, errflg & + ) + ! --- inputs: + integer, intent(in) :: im, kdt, nthreads + logical, dimension(:), intent(in) :: wet, icy + integer, dimension(:), intent(in) :: use_lake_model + real (kind=kind_phys), intent(in) :: rlapse, tgice + real (kind=kind_phys), dimension(:), intent(in) :: oro, oro_uf + integer, intent(in) :: nstf_name1, nstf_name4, nstf_name5 + real (kind=kind_phys), dimension(:), intent(in) :: xlon + real (kind=kind_phys), dimension(:), intent(in), optional :: xt, xz, dt_cool, z_c, tref + + ! --- input/outputs: + real (kind=kind_phys), dimension(:), intent(inout) :: tsurf_wat, tsfc_wat + + ! --- outputs: + real (kind=kind_phys), dimension(:), intent(out) :: dtzm + + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! --- locals + integer :: i + real(kind=kind_phys) :: zsea1, zsea2 + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + ! if (lprnt) print *,' tseaz2=',tseal(ipr),' tref=',tref(ipr), + ! & ' 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_wat(i) = tsurf_wat(i) - (oro(i)-oro_uf(i)) * rlapse + ! endif + ! enddo + + ! --- ... run nsst model ... --- + + if (nstf_name1 > 1) then + zsea1 = 0.001_kp*real(nstf_name4) + zsea2 = 0.001_kp*real(nstf_name5) + call get_dtzm_2d (xt, xz, dt_cool, z_c, wet, zsea1, zsea2, im, 1, nthreads, dtzm) + do i = 1, im + ! if (wet(i) .and. .not.icy(i)) then + ! if (wet(i) .and. (frac_grid .or. .not. icy(i))) then + if (wet(i) .and. use_lake_model(i) /=1) then + tsfc_wat(i) = max(tgice, tref(i) + dtzm(i)) + ! tsfc_wat(i) = max(271.2, tref(i) + dtzm(i)) - & + ! (oro(i)-oro_uf(i))*rlapse + endif + enddo + endif + + ! if (lprnt) print *,' tseaz2=',tsea(ipr),' tref=',tref(ipr), & + ! & ' dt_cool=',dt_cool(ipr),' dt_warm=',dt_warm(ipr),' kdt=',kdt + + return + end subroutine sfc_nst_post_run + +end module sfc_nst_post diff --git a/physics/sfc_nst_post.meta b/physics/SFC_Layer/UFS/sfc_nst_post.meta similarity index 96% rename from physics/sfc_nst_post.meta rename to physics/SFC_Layer/UFS/sfc_nst_post.meta index 7f66118e9..ce4bee4e4 100644 --- a/physics/sfc_nst_post.meta +++ b/physics/SFC_Layer/UFS/sfc_nst_post.meta @@ -2,7 +2,7 @@ [ccpp-table-properties] name = sfc_nst_post type = scheme - dependencies = machine.F,module_nst_parameters.f90,module_nst_water_prop.f90 + dependencies = ../../hooks/machine.F,module_nst_parameters.f90,module_nst_water_prop.f90 ######################################################################## [ccpp-arg-table] @@ -104,6 +104,7 @@ type = real kind = kind_phys intent = in + optional = True [xz] standard_name = diurnal_thermocline_layer_thickness long_name = diurnal thermocline layer thickness @@ -112,6 +113,7 @@ type = real kind = kind_phys intent = in + optional = True [dt_cool] standard_name = molecular_sublayer_temperature_correction_in_sea_water long_name = sub-layer cooling amount @@ -120,6 +122,7 @@ type = real kind = kind_phys intent = in + optional = True [z_c] standard_name = molecular_sublayer_thickness_in_sea_water long_name = sub-layer cooling thickness @@ -128,6 +131,7 @@ type = real kind = kind_phys intent = in + optional = True [tref] standard_name = reference_sea_surface_temperature long_name = reference/foundation temperature @@ -136,6 +140,7 @@ type = real kind = kind_phys intent = in + optional = True [xlon] standard_name = longitude long_name = longitude diff --git a/physics/SFC_Layer/UFS/sfc_nst_pre.f90 b/physics/SFC_Layer/UFS/sfc_nst_pre.f90 new file mode 100644 index 000000000..c61f9b903 --- /dev/null +++ b/physics/SFC_Layer/UFS/sfc_nst_pre.f90 @@ -0,0 +1,91 @@ +!> \file sfc_nst_pre.f90 +!! This file contains preparation for the GFS NSST model. + +module sfc_nst_pre + + use machine , only : kind_phys + use module_nst_water_prop , only : get_dtzm_2d + use module_nst_parameters , only : zero, one + + implicit none + +contains + + !> \defgroup GFS_NSST_PRE GFS Near-Surface Sea Temperature Pre + !! + !! The NSST scheme is one of the three schemes used to represent the + !! surface in the GFS physics suite. The other two are the Noah land + !! surface model and the sice simplified ice model. + !! + !! \section arg_table_sfc_nst_pre_run Argument Table + !! \htmlinclude sfc_nst_pre_run.html + !! + !> \section NSST_general_pre_algorithm General Algorithm + subroutine sfc_nst_pre_run & + (im, wet, tgice, tsfco, tsurf_wat, & + tseal, xt, xz, dt_cool, z_c, tref, cplflx, & + oceanfrac, nthreads, errmsg, errflg) + + ! --- inputs: + integer, intent(in) :: im, nthreads + logical, dimension(:), intent(in) :: wet + real (kind=kind_phys), intent(in) :: tgice + real (kind=kind_phys), dimension(:), intent(in) :: tsfco, oceanfrac + real (kind=kind_phys), dimension(:), intent(in), optional :: xt, xz, dt_cool, z_c + logical, intent(in) :: cplflx + + ! --- input/outputs: + real (kind=kind_phys), dimension(:), intent(inout) :: tsurf_wat, tseal + real (kind=kind_phys), dimension(:), intent(inout), optional :: tref + + ! --- outputs: + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! --- locals + integer :: i + real(kind=kind_phys), parameter :: omz1 = 2.0_kind_phys + real(kind=kind_phys) :: tem2, dnsst + real(kind=kind_phys), dimension(im) :: dtzm, z_c_0 + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + do i=1,im + if (wet(i) .and. oceanfrac(i) > 0.0) then + ! tem = (oro(i)-oro_uf(i)) * rlapse + ! DH* 20190927 simplyfing this code because tem is zero + !tem = zero + !tseal(i) = tsfco(i) + tem + tseal(i) = tsfco(i) + !tsurf_wat(i) = tsurf_wat(i) + tem + ! *DH + endif + enddo + ! + ! update tsfc & tref with T1 from OGCM & NSST Profile if coupled + ! + if (cplflx) then + z_c_0 = zero + call get_dtzm_2d (xt, xz, dt_cool, z_c_0, wet, zero, omz1, im, 1, nthreads, dtzm) + do i=1,im + if (wet(i) .and. oceanfrac(i) > zero ) then + ! dnsst = tsfc_wat(i) - tref(i) ! retrive/get difference of Ts and Tf + tref(i) = max(tgice, tsfco(i) - dtzm(i)) ! update Tf with T1 and NSST T-Profile + ! tsfc_wat(i) = max(271.2,tref(i) + dnsst) ! get Ts updated due to Tf update + ! tseal(i) = tsfc_wat(i) + if (abs(xz(i)) > zero) then + tem2 = one / xz(i) + else + tem2 = zero + endif + tseal(i) = tref(i) + (xt(i)+xt(i)) * tem2 - dt_cool(i) + tsurf_wat(i) = tseal(i) + endif + enddo + endif + + return + end subroutine sfc_nst_pre_run +end module sfc_nst_pre diff --git a/physics/sfc_nst_pre.meta b/physics/SFC_Layer/UFS/sfc_nst_pre.meta similarity index 95% rename from physics/sfc_nst_pre.meta rename to physics/SFC_Layer/UFS/sfc_nst_pre.meta index 88788ff5c..3b26fe52d 100644 --- a/physics/sfc_nst_pre.meta +++ b/physics/SFC_Layer/UFS/sfc_nst_pre.meta @@ -2,7 +2,7 @@ [ccpp-table-properties] name = sfc_nst_pre type = scheme - dependencies = machine.F,module_nst_parameters.f90,module_nst_water_prop.f90 + dependencies = ../../hooks/machine.F,module_nst_parameters.f90,module_nst_water_prop.f90 ######################################################################## [ccpp-arg-table] @@ -62,6 +62,7 @@ type = real kind = kind_phys intent = in + optional = True [xz] standard_name = diurnal_thermocline_layer_thickness long_name = diurnal thermocline layer thickness @@ -70,6 +71,7 @@ type = real kind = kind_phys intent = in + optional = True [dt_cool] standard_name = molecular_sublayer_temperature_correction_in_sea_water long_name = sub-layer cooling amount @@ -78,6 +80,7 @@ type = real kind = kind_phys intent = in + optional = True [z_c] standard_name = molecular_sublayer_thickness_in_sea_water long_name = sub-layer cooling thickness @@ -86,6 +89,7 @@ type = real kind = kind_phys intent = in + optional = True [tref] standard_name = reference_sea_surface_temperature long_name = reference/foundation temperature @@ -94,6 +98,7 @@ type = real kind = kind_phys intent = inout + optional = True [cplflx] standard_name = flag_for_surface_flux_coupling long_name = flag controlling cplflx collection (default off) diff --git a/physics/clm_lake.f90 b/physics/SFC_Models/Lake/CLM/clm_lake.f90 similarity index 78% rename from physics/clm_lake.f90 rename to physics/SFC_Models/Lake/CLM/clm_lake.f90 index 4fc4112ce..565430a08 100644 --- a/physics/clm_lake.f90 +++ b/physics/SFC_Models/Lake/CLM/clm_lake.f90 @@ -1,4 +1,4 @@ -!> \file clm_lake.F90 +!> \file clm_lake.f90 !! Contains code related to the CLM lake model !! !! This lake scheme was taken from module_sf_lake in WRF 4.3.1, and @@ -7,7 +7,7 @@ !! The original documentation said: !! !! The lake scheme was retrieved from the Community Land Model version 4.5 -!! (Oleson et al. 2013) with some modifications by Gu et al. (2013). It is a +!! (Oleson et al. (2013) \cite Oleson2013) with some modifications by Gu et al. (2015) \cite Gu2015. It is a !! one-dimensional mass and energy balance scheme with 20-25 model layers, !! including up to 5 snow layers on the lake ice, 10 water layers, and 10 soil !! layers on the lake bottom. The lake scheme is used with actual lake points and @@ -15,15 +15,8 @@ !! lake points and lake depth in WRF (lake_min_elev and lakedepth_default). !! The lake scheme is independent of a land surface scheme and therefore !! can be used with any land surface scheme embedded in WRF. The lake scheme -!! developments and evaluations were included in Subin et al. (2012) and Gu et al. (2013) -!! -!! Subin et al. 2012: Improved lake model for climate simulations, J. Adv. Model. -!! -!! Earth Syst., 4, M02001. DOI:10.1029/2011MS000072; -!! -!! Gu et al. 2013: Calibration and validation of lake surface temperature simulations -!! -!! with the coupled WRF-Lake model. Climatic Change, 1-13, 10.1007/s10584-013-0978-y. +!! developments and evaluations were included in Subin et al. (2012) \cite Subin_2012 +!! and Gu et al. (2015) \cite Gu2015 . MODULE clm_lake @@ -42,30 +35,31 @@ MODULE clm_lake integer, parameter, public :: kind_lake = kind_dbl_prec logical :: LAKEDEBUG = .false. ! Enable lots of checks and debug prints and errors + logical :: DEBUG_PRINT = .false. ! Enable lots of checks and debug prints and errors logical, parameter :: PERGRO = .false. logical, parameter :: USE_ETALAKE = .false. - real(kind_lake), parameter :: ETALAKE = 1.1925*50**(-0.424) ! Set this to your desired value if USE_ETALAKE=.true. + real(kind_lake), parameter :: ETALAKE = 1.1925*50**(-0.424) !< Set this to your desired value if USE_ETALAKE=.true. ! Level counts must be consistent with model (GFS_typedefs.F90) - integer, parameter :: nlevsoil = 10 ! number of soil layers - integer, parameter :: nlevlake = 10 ! number of lake layers - integer, parameter :: nlevsnow = 5 ! maximum number of snow layers - real(kind_lake), parameter :: scalez = 0.025_kind_lake ! Soil layer thickness discretization (m) + integer, parameter :: nlevsoil = 10 !< number of soil layers + integer, parameter :: nlevlake = 10 !< number of lake layers + integer, parameter :: nlevsnow = 5 !< maximum number of snow layers + real(kind_lake), parameter :: scalez = 0.025_kind_lake !< Soil layer thickness discretization (m) - integer,parameter :: lbp = 1 ! pft-index bounds + integer,parameter :: lbp = 1 !< pft-index bounds integer,parameter :: ubp = 1 - integer,parameter :: lbc = 1 ! column-index bounds + integer,parameter :: lbc = 1 !< column-index bounds integer,parameter :: ubc = 1 - integer,parameter :: num_shlakec = 1 ! number of columns in lake filter - integer,parameter :: filter_shlakec(1) = 1 ! lake filter (columns) - integer,parameter :: num_shlakep = 1 ! number of pfts in lake filter - integer,parameter :: filter_shlakep(1) = 1 ! lake filter (pfts) + integer,parameter :: num_shlakec = 1 !< number of columns in lake filter + integer,parameter :: filter_shlakec(1) = 1 !< lake filter (columns) + integer,parameter :: num_shlakep = 1 !< number of pfts in lake filter + integer,parameter :: filter_shlakep(1) = 1 !< lake filter (pfts) integer,parameter :: pcolumn(1) = 1 integer,parameter :: pgridcell(1) = 1 - integer,parameter :: cgridcell(1) = 1 ! gridcell index of column - integer,parameter :: clandunit(1) = 1 ! landunit index of column + integer,parameter :: cgridcell(1) = 1 !< gridcell index of column + integer,parameter :: clandunit(1) = 1 !< landunit index of column integer,parameter :: begg = 1 integer,parameter :: endg = 1 @@ -80,44 +74,44 @@ MODULE clm_lake logical,parameter :: lakpoi(1) = .true. !Initialize physical constants not available from model: - real(kind_lake), parameter :: tcrit = 2.5 !critical temperature to determine rain or snow - real(kind_lake), parameter :: tkwat = 0.6 !thermal conductivity of water [W/m/k] - real(kind_lake), parameter :: tkice = 2.290 !thermal conductivity of ice [W/m/k] - real(kind_lake), parameter :: tkairc = 0.023 !thermal conductivity of air [W/m/k] - real(kind_lake), parameter :: snow_bd = 250 !constant snow bulk density (only used in special case here) [kg/m^3] + real(kind_lake), parameter :: tcrit = 2.5 !< critical temperature to determine rain or snow + real(kind_lake), parameter :: tkwat = 0.6 !< thermal conductivity of water [W/m/k] + real(kind_lake), parameter :: tkice = 2.290 !< thermal conductivity of ice [W/m/k] + real(kind_lake), parameter :: tkairc = 0.023 !< thermal conductivity of air [W/m/k] + real(kind_lake), parameter :: snow_bd = 250 !< constant snow bulk density (only used in special case here) [kg/m^3] ! Constants that are copied from model values by clm_lake_init: - real(kind_lake) :: pi !ratio of the circumference of a circle to its diameter - real(kind_lake) :: vkc !von Karman constant [-] - real(kind_lake) :: grav !gravity constant [m/s2] - real(kind_lake) :: sb !stefan-boltzmann constant [W/m2/K4] - real(kind_lake) :: tfrz !freezing temperature [K] - real(kind_lake) :: denh2o !density of liquid water [kg/m3] - real(kind_lake) :: denice !density of ice [kg/m3] - real(kind_lake) :: cpice !Specific heat of ice [J/kg-K] - real(kind_lake) :: cpliq !Specific heat of water [J/kg-K] - real(kind_lake) :: hfus !Latent heat of fusion for ice [J/kg] - real(kind_lake) :: hvap !Latent heat of evap for water [J/kg] - real(kind_lake) :: hsub !Latent heat of sublimation [J/kg] - real(kind_lake) :: invhvap !1/hvap [kg/J] - real(kind_lake) :: invhsub !1/hsub [kg/J] - real(kind_lake) :: rair !gas constant for dry air [J/kg/K] - real(kind_lake) :: cpair !specific heat of dry air [J/kg/K] - real(kind_lake) :: con_eps !ratio of gas constants of air and water vapor [unitless] - real(kind_lake) :: one_minus_con_eps !1 - con_eps [unitless] - real(kind_lake) :: con_fvirt !1/con_eps - 1 [unitless] + real(kind_lake) :: pi !< ratio of the circumference of a circle to its diameter + real(kind_lake) :: vkc !< von Karman constant [-] + real(kind_lake) :: grav !< gravity constant [m/s2] + real(kind_lake) :: sb !< stefan-boltzmann constant [W/m2/K4] + real(kind_lake) :: tfrz !< freezing temperature [K] + real(kind_lake) :: denh2o !< density of liquid water [kg/m3] + real(kind_lake) :: denice !< density of ice [kg/m3] + real(kind_lake) :: cpice !< Specific heat of ice [J/kg-K] + real(kind_lake) :: cpliq !< Specific heat of water [J/kg-K] + real(kind_lake) :: hfus !< Latent heat of fusion for ice [J/kg] + real(kind_lake) :: hvap !< Latent heat of evap for water [J/kg] + real(kind_lake) :: hsub !< Latent heat of sublimation [J/kg] + real(kind_lake) :: invhvap !< 1/hvap [kg/J] + real(kind_lake) :: invhsub !< 1/hsub [kg/J] + real(kind_lake) :: rair !< gas constant for dry air [J/kg/K] + real(kind_lake) :: cpair !< specific heat of dry air [J/kg/K] + real(kind_lake) :: con_eps !< ratio of gas constants of air and water vapor [unitless] + real(kind_lake) :: one_minus_con_eps !< 1 - con_eps [unitless] + real(kind_lake) :: con_fvirt !< 1/con_eps - 1 [unitless] - real(kind_lake), public, parameter :: spval = 1.e36 !special value for missing data (ocean) - real(kind_lake), parameter :: depth_c = 50. !below the level t_lake3d will be 277.0 !mchen - real(kind_lake), parameter :: zero_h2o = 1e-12 !lower mixing ratio is is treated as zero + real(kind_lake), public, parameter :: spval = 1.e36 !< special value for missing data (ocean) + real(kind_lake), parameter :: depth_c = 50. !< below the level t_lake3d will be 277.0 !mchen + real(kind_lake), parameter :: zero_h2o = 1e-12 !< lower mixing ratio is is treated as zero ! These are tunable constants - real(kind_lake), parameter :: wimp = 0.05 !Water impermeable if porosity less than wimp - real(kind_lake), parameter :: ssi = 0.033 !Irreducible water saturation of snow - real(kind_lake), parameter :: cnfac = 0.5 !Crank Nicholson factor between 0 and 1 + real(kind_lake), parameter :: wimp = 0.05 !< Water impermeable if porosity less than wimp + real(kind_lake), parameter :: ssi = 0.033 !< Irreducible water saturation of snow + real(kind_lake), parameter :: cnfac = 0.5 !< Crank Nicholson factor between 0 and 1 ! Initialize water type constants - integer,parameter :: istsoil = 1 !soil "water" type + integer,parameter :: istsoil = 1 !tgs - 7nov19 - salinity effect on freezing point (Tanya, Stan, Trevor). + !! The Great Salt Lake (GSL), Utah lat/long (39.5-42.0,-111.5- -117.7). + !! The GSL's salinity is 270 ppt above ~41.22 N with freezing point of -24 C, + !! and 150 ppt south of ~41.22 N with freezing point -10 C (info from Trevor Alcott). + !! The fresh-water Willard Bay should be excluded from the box around the Great Salt + !! Lake: lat/long 41.3539, -112.102, HRRR i,j = 494,667 (info from Stan and Trevor). + !! + !! 1jun2020: reset the GSL freezing point to be -5 C, + !! and add a check (after call to LakeMain) to keep the lake ice free for the whole year. if ((xlon_d.gt.-117.7 .and. xlon_d.lt.-111.5) .and. & ! excludes Willard Bay .not. (xlon_d.gt.-112.104 .and. xlon_d.lt.-112.100))then if(xlat_d.gt.39.5 .and. xlat_d.lt.41.22) then - if(lakedebug) then + if(debug_print) then print *,'The Great Salt Lake south of 41.22 N, lat,lon',xlat_d,xlon_d endif limit_temperature_by_climatology = .true. @@ -175,7 +169,7 @@ logical function limit_temperature_by_climatology(xlat_d,xlon_positive) elseif(( xlat_d.ge.41.22 .and. xlat_d.lt.42.) .and. .not. & ! excludes Willard Bay (xlat_d.gt.41.352 .and. xlat_d.lt.41.354)) then - if(lakedebug) then + if(debug_print) then print *,'The Great Salt Lake north of 41.22 N xlat_d,xlon_d ',xlat_d,xlon_d endif !print *,'Ice fraction on the GSL ', i,j,lake_icefrac3d(i,:,j) @@ -200,30 +194,31 @@ subroutine is_salty(xlat_d,xlon_positive, cannot_freeze, salty) xlon_d = xlon_positive if(xlon_d>180) xlon_d = xlon_d - 360 + ! for the Great Salt Lake cannot_freeze = limit_temperature_by_climatology(xlat_d,xlon_d) salty = cannot_freeze - other_locations: if(include_all_salty_locations) then ! --- The Mono Lake in California, salinity is 75 ppt with freezing point at ! --- -4.2 C (Stan). The Mono Lake lat/long (37.9-38.2, -119.3 - 118.8) if (xlon_d.gt.-119.3.and. xlon_d.lt.-118.8) then if(xlat_d.gt.37.9 .and. xlat_d.lt.38.2) then salty = .true. - if(lakedebug) then + if(debug_print) then print *,'Salty Mono Lake, i,j',xlat_d,xlon_d endif endif ! xlat_d endif ! xlon_d + other_locations: if(include_all_salty_locations) then ! --- Caspian Sea and Dead Sea are salty too (Sam, Tanya) if ( xlat_d>36.5_kind_phys .and. xlat_d<47.1_kind_phys .and. xlon_d>46.8_kind_phys .and. xlon_d<55.0_kind_phys ) then - if(lakedebug) then + if(debug_print) then print *,'Salty Caspian Sea ',xlat_d,xlon_d endif salty = .true. end if if ( xlon_d>35.3 .and. xlon_d<35.6 .and. xlat_d>31.3 .and. xlat_d<31.8) then - if(lakedebug) then + if(debug_print) then print *,'Salty Dead Sea ',xlat_d,xlon_d endif salty = .true. @@ -234,12 +229,40 @@ end subroutine is_salty !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + subroutine calculate_z_dz_lake(i,input_lakedepth,clm_lakedepth,z_lake,dz_lake) + implicit none + integer, intent(in) :: i + real(kind_phys), intent(inout) :: clm_lakedepth(:) ! lake depth used by clm + real(kind_phys), intent(in) :: input_lakedepth(:) ! lake depth before correction (m) + real(kind_lake) :: z_lake(nlevlake) ! layer depth for lake (m) + real(kind_lake) :: dz_lake(nlevlake) ! layer thickness for lake (m) + real(kind_lake) :: depthratio + + if (input_lakedepth(i) == spval .or. input_lakedepth(i) < 0.1) then + ! This is a safeguard against: + ! 1. missing in the lakedepth database (== spval) + ! 2. errors in model cycling or unexpected changes in the orography database (< 0.1) + clm_lakedepth(i) = zlak(nlevlake) + 0.5_kind_lake*dzlak(nlevlake) + z_lake(1:nlevlake) = zlak(1:nlevlake) + dz_lake(1:nlevlake) = dzlak(1:nlevlake) + else + depthratio = input_lakedepth(i) / (zlak(nlevlake) + 0.5_kind_lake*dzlak(nlevlake)) + z_lake(1) = zlak(1) + dz_lake(1) = dzlak(1) + dz_lake(2:nlevlake) = dzlak(2:nlevlake)*depthratio + z_lake(2:nlevlake) = zlak(2:nlevlake)*depthratio + dz_lake(1)*(1._kind_lake - depthratio) + end if + + end subroutine calculate_z_dz_lake + + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !> \section arg_table_clm_lake_run Argument Table !! \htmlinclude clm_lake_run.html !! SUBROUTINE clm_lake_run( & ! Model time and metadata: - im, km, me, master, fhour, IDATE, kdt, & + flag_restart, im, km, me, master, fhour, IDATE, kdt, & ! Configuration and initialization: iopt_lake, iopt_lake_clm, min_lakeice, lakedepth_default, use_lakedepth, & @@ -247,8 +270,8 @@ SUBROUTINE clm_lake_run( & ! Atmospheric model state inputs: tg3, pgr, zlvl, gt0, prsi, phii, qvcurr, gu0, gv0, xlat_d, xlon_d, & - ch, cm, dlwsfci, dswsfci, oro_lakedepth, wind, rho0, tsfc, & - flag_iter, ISLTYP, rainncprv, raincprv, & + ch, cm, dlwsfci, dswsfci, oro_lakedepth, wind, tsfc, & + flag_iter, flag_lakefreeze, ISLTYP, rainncprv, raincprv, & ! Feedback to atmosphere: evap_wat, evap_ice, hflx_wat, hflx_ice, gflx_wat, gflx_ice, & @@ -263,8 +286,8 @@ SUBROUTINE clm_lake_run( & salty, savedtke12d, snowdp2d, h2osno2d, snl2d, t_grnd2d, t_lake3d, & lake_icefrac3d, t_soisno3d, h2osoi_ice3d, h2osoi_liq3d, h2osoi_vol3d, & - z3d, dz3d, zi3d, z_lake3d, dz_lake3d, watsat3d, csol3d, sand3d, clay3d, & - tkmg3d, tkdry3d, tksatu3d, clm_lakedepth, cannot_freeze, & + z3d, dz3d, zi3d, t1, qv1, prsl1, & + input_lakedepth, clm_lakedepth, cannot_freeze, & ! Error reporting: errflg, errmsg) @@ -280,6 +303,7 @@ SUBROUTINE clm_lake_run( & ! ! Model time and metadata: ! + LOGICAL , INTENT (IN) :: flag_restart INTEGER , INTENT (IN) :: im,km,me,master INTEGER, INTENT(IN) :: IDATE(4), kdt REAL(KIND_PHYS), INTENT(IN) :: fhour @@ -300,10 +324,14 @@ SUBROUTINE clm_lake_run( & ! REAL(KIND_PHYS), DIMENSION(:), INTENT(IN):: & tg3, pgr, zlvl, qvcurr, xlat_d, xlon_d, ch, cm, & - dlwsfci, dswsfci, oro_lakedepth, wind, rho0, tsfc, & + dlwsfci, dswsfci, oro_lakedepth, wind, & + t1, qv1, prsl1 + REAL(KIND_PHYS), DIMENSION(:), INTENT(IN) :: & rainncprv, raincprv REAL(KIND_PHYS), DIMENSION(:,:), INTENT(in) :: gu0, gv0, prsi, gt0, phii LOGICAL, DIMENSION(:), INTENT(IN) :: flag_iter + LOGICAL, DIMENSION(:), INTENT(INOUT) :: flag_lakefreeze + INTEGER, DIMENSION(:), INTENT(IN) :: ISLTYP ! @@ -311,28 +339,29 @@ SUBROUTINE clm_lake_run( & ! REAL(KIND_PHYS), DIMENSION(:), INTENT(INOUT) :: & evap_wat, evap_ice, hflx_wat, hflx_ice, gflx_wat, gflx_ice, & - ep1d_water, ep1d_ice, tsurf_water, tsurf_ice, tsfc_wat, tisfc, & + ep1d_water, ep1d_ice, tsurf_water, tsurf_ice, tsfc_wat, tisfc, tsfc, & weasdi, snodi, hice, qss_water, qss_ice, & cmm_water, cmm_ice, chh_water, chh_ice, & - uustar_water, uustar_ice, lake_t_snow, albedo, zorlw, & - zorli, lake_t2m, lake_q2m, weasd, snowd, fice + uustar_water, uustar_ice, zorlw, zorli, weasd, snowd, fice + REAL(KIND_PHYS), DIMENSION(:), INTENT(INOUT) :: & + lake_t_snow, albedo, lake_t2m, lake_q2m LOGICAL, INTENT(INOUT) :: icy(:) ! ! Lake model internal state stored by caller: ! - INTEGER, DIMENSION( : ), INTENT(INOUT) :: salty - INTEGER, DIMENSION( : ), INTENT(INOUT) :: cannot_freeze + INTEGER, DIMENSION( : ), INTENT(INOUT) :: salty + INTEGER, DIMENSION( : ), INTENT(INOUT) :: cannot_freeze - real(kind_phys), dimension(: ) ,intent(inout) :: savedtke12d, & + real(kind_phys), dimension(: ) ,intent(inout) :: savedtke12d, & snowdp2d, & h2osno2d, & snl2d, & t_grnd2d - real(kind_phys), dimension( :,: ) ,INTENT(inout) :: t_lake3d, & + real(kind_phys), dimension( :,: ), INTENT(inout) :: t_lake3d, & lake_icefrac3d - real(kind_phys), dimension( :,-nlevsnow+1: ) ,INTENT(inout) :: t_soisno3d, & + real(kind_phys), dimension( :,-nlevsnow+1: ) ,INTENT(inout) :: t_soisno3d, & h2osoi_ice3d, & h2osoi_liq3d, & h2osoi_vol3d, & @@ -340,14 +369,8 @@ SUBROUTINE clm_lake_run( & dz3d real(kind_phys), dimension( :,-nlevsnow+0: ) ,INTENT(inout) :: zi3d - REAL(KIND_PHYS), DIMENSION( :,: ),INTENT(INOUT) :: z_lake3d - REAL(KIND_PHYS), DIMENSION( :,: ),INTENT(INOUT) :: dz_lake3d - REAL(KIND_PHYS), DIMENSION( :,: ),INTENT(INOUT) :: watsat3d - REAL(KIND_PHYS), DIMENSION( :,: ),INTENT(INOUT) :: csol3d, sand3d, clay3d - REAL(KIND_PHYS), DIMENSION( :,: ),INTENT(INOUT) :: tkmg3d - REAL(KIND_PHYS), DIMENSION( :,: ),INTENT(INOUT) :: tkdry3d - REAL(KIND_PHYS), DIMENSION( :,: ),INTENT(INOUT) :: tksatu3d - REAL(KIND_PHYS), DIMENSION( : ) ,INTENT(INOUT) :: clm_lakedepth + REAL(KIND_PHYS), DIMENSION( : ) ,INTENT(INOUT) :: clm_lakedepth + REAL(KIND_PHYS), DIMENSION( : ) ,INTENT(INOUT) :: input_lakedepth ! ! Error reporting: @@ -434,10 +457,11 @@ SUBROUTINE clm_lake_run( & character*255 :: message logical, parameter :: feedback_to_atmosphere = .true. ! FIXME: REMOVE - real(kind_lake) :: to_radians, lat_d, lon_d, qss + real(kind_lake) :: to_radians, lat_d, lon_d, qss, tkm, bd + real(kind_lake) :: rho0 ! lowest model level air density - integer :: month,num1,num2,day_of_month - real(kind_lake) :: wght1,wght2,Tclim + integer :: month,num1,num2,day_of_month,isl + real(kind_lake) :: wght1,wght2,Tclim,depthratio logical salty_flag, cannot_freeze_flag @@ -455,31 +479,19 @@ SUBROUTINE clm_lake_run( & lakedepth_default=lakedepth_default, fhour=fhour, & oro_lakedepth=oro_lakedepth, savedtke12d=savedtke12d, snowdp2d=snowdp2d, & h2osno2d=h2osno2d, snl2d=snl2d, t_grnd2d=t_grnd2d, t_lake3d=t_lake3d, & - lake_icefrac3d=lake_icefrac3d, z_lake3d=z_lake3d, dz_lake3d=dz_lake3d, & + lake_icefrac3d=lake_icefrac3d, & t_soisno3d=t_soisno3d, h2osoi_ice3d=h2osoi_ice3d, h2osoi_liq3d=h2osoi_liq3d, & - h2osoi_vol3d=h2osoi_vol3d, z3d=z3d, dz3d=dz3d, zi3d=zi3d, watsat3d=watsat3d, & - csol3d=csol3d, tkmg3d=tkmg3d, fice=fice, min_lakeice=min_lakeice, & + h2osoi_vol3d=h2osoi_vol3d, z3d=z3d, dz3d=dz3d, zi3d=zi3d, & + fice=fice, hice=hice, min_lakeice=min_lakeice, & tsfc=tsfc, & - use_lake_model=use_lake_model, use_lakedepth=use_lakedepth, tkdry3d=tkdry3d, & - tksatu3d=tksatu3d, im=im, prsi=prsi, xlat_d=xlat_d, xlon_d=xlon_d, & - clm_lake_initialized=clm_lake_initialized, sand3d=sand3d, clay3d=clay3d, & + use_lake_model=use_lake_model, use_lakedepth=use_lakedepth, & + im=im, prsi=prsi, xlat_d=xlat_d, xlon_d=xlon_d, & + clm_lake_initialized=clm_lake_initialized, input_lakedepth=input_lakedepth, & tg3=tg3, clm_lakedepth=clm_lakedepth, km=km, me=me, master=master, & errmsg=errmsg, errflg=errflg) if(errflg/=0) then return endif - if(any(clay3d>0 .and. clay3d<1)) then - write(message,*) 'Invalid clay3d. Abort.' - errmsg=trim(message) - errflg=1 - return - endif - if(any(dz_lake3d>0 .and. dz_lake3d<.1)) then - write(message,*) 'Invalid dz_lake3d. Abort.' - errmsg=trim(message) - errflg=1 - return - endif lake_points=0 snow_points=0 @@ -498,14 +510,14 @@ SUBROUTINE clm_lake_run( & wght2 = day_of_month/month_length(month) if(wght2<0 .or. wght2>1) then - if(lakedebug) then + if(debug_print) then write(0,*) 'Warning: wght2 is not 0..1: ',wght2 endif wght2 = max(0.0_kind_lake,min(1.0_kind_lake,wght2)) endif wght1 = 1.0_kind_lake - wght2 - if(LAKEDEBUG .and. me==0) then + if(debug_print ) then print *,'month,num1,num2,wght1,wght2',month,num1,num2,wght1,wght2 endif @@ -516,13 +528,13 @@ SUBROUTINE clm_lake_run( & call is_salty(xlat_d(i),xlon_d(i),salty_flag,cannot_freeze_flag) if(salty_flag) then - salty(i) = 1 + salty(i) = 1 ! The Great Salt Lake and Mono Lake else salty(i) = 0 endif if(cannot_freeze_flag) then - cannot_freeze(i) = 1 + cannot_freeze(i) = 1 ! only the Great Salt Lake else cannot_freeze(i) = 0 endif @@ -544,6 +556,26 @@ SUBROUTINE clm_lake_run( & lake_points = lake_points+1 + call calculate_z_dz_lake(i,input_lakedepth,clm_lakedepth,z_lake(1,:),dz_lake(1,:)) + + do c = 2,column + z_lake(c,:) = z_lake(1,:) + dz_lake(c,:) = dz_lake(1,:) + enddo + + ! Soil hydraulic and thermal properties + isl = ISLTYP(i) + if (isl == 0 ) isl = 14 + if (isl == 14 ) isl = isl + 1 + + watsat = 0.489_kind_lake - 0.00126_kind_lake*sand(isl) + csol = (2.128_kind_lake*sand(isl)+2.385_kind_lake*clay(isl)) / (sand(isl)+clay(isl))*1.e6_kind_lake ! J/(m3 K) + tkm = (8.80_kind_lake*sand(isl)+2.92_kind_lake*clay(isl))/(sand(isl)+clay(isl)) ! W/(m K) + bd = (1._kind_lake-watsat(1,1))*2.7e3_kind_lake + tkmg = tkm ** (1._kind_lake- watsat(1,1)) + tkdry = (0.135_kind_lake*bd + 64.7_kind_lake) / (2.7e3_kind_lake - 0.947_kind_lake*bd) + tksatu = tkmg(1,1)*0.57_kind_lake**watsat(1,1) + do c = 1,column forc_t(c) = SFCTMP ! [K] @@ -570,15 +602,7 @@ SUBROUTINE clm_lake_run( & t_grnd(c) = t_grnd2d(i) do k = 1,nlevlake t_lake(c,k) = t_lake3d(i,k) - !-- If T of salty lakes is above the freezing point, keep them ice free - if(salty(i)==1 .and. t_lake(c,k) > tfrz .and. lake_icefrac3d(i,k) > 0.) then - lake_icefrac(c,k) = 0. - else - lake_icefrac(c,k) = lake_icefrac3d(i,k) - endif - !lake_icefrac(c,k) = lake_icefrac3d(i,k) - z_lake(c,k) = z_lake3d(i,k) - dz_lake(c,k) = dz_lake3d(i,k) + lake_icefrac(c,k) = lake_icefrac3d(i,k) enddo do k = -nlevsnow+1,nlevsoil t_soisno(c,k) = t_soisno3d(i,k) @@ -591,14 +615,6 @@ SUBROUTINE clm_lake_run( & do k = -nlevsnow+0,nlevsoil zi(c,k) = zi3d(i,k) enddo - do k = 1,nlevsoil - watsat(c,k) = watsat3d(i,k) - csol(c,k) = csol3d(i,k) - tkmg(c,k) = tkmg3d(i,k) - tkdry(c,k) = tkdry3d(i,k) - tksatu(c,k) = tksatu3d(i,k) - enddo - enddo eflx_lwrad_net = -9999 @@ -633,23 +649,29 @@ SUBROUTINE clm_lake_run( & do c = 1,column if(cannot_freeze(i) == 1) then - t_grnd(c) = max(274.5_kind_lake,t_grnd(c)) + ! The Great Salt Lake do k = 1,nlevlake - t_lake(c,k) = max(274.5_kind_lake,t_lake(c,k)) - lake_icefrac(c,k) = 0. + lake_icefrac(c,k) = 0._kind_lake enddo - endif - - if(salty(i)/=0) then - Tclim = tfrz + wght1*saltlk_T(num1) & - + wght2*saltlk_T(num2) - if(lakedebug) print *,'Tclim,tsfc,t_lake3d',i,Tclim,t_grnd(c),t_lake(c,:),t_soisno(c,:) - t_grnd(c) = min(Tclim+3.0_kind_lake,(max(t_grnd(c),Tclim-3.0_kind_lake))) - do k = 1,nlevlake - t_lake(c,k) = min(Tclim+3.0_kind_lake,(max(t_lake(c,k),Tclim-3.0_kind_lake))) - enddo - t_soisno(c,1) = min(Tclim+3.0_kind_lake,(max(t_soisno(c,1),Tclim-3.0_kind_lake))) - if(lakedebug) print *,'After Tclim,tsfc,t_lake3d',i,Tclim,t_grnd(c),t_lake(c,:),t_soisno(c,:) + ! bound lake temperture with the climatology + Tclim = tfrz + wght1*saltlk_T(num1) & + + wght2*saltlk_T(num2) + if(debug_print) print *,'GSL - Tclim,tsfc,t_lake3d',i,Tclim,t_grnd(c),t_lake(c,:),t_soisno(c,:) + t_grnd(c) = min(Tclim+3.0_kind_lake,(max(t_grnd(c),Tclim-3.0_kind_lake))) + do k = 1,nlevlake + t_lake(c,k) = min(Tclim+3.0_kind_lake,(max(t_lake(c,k),Tclim-3.0_kind_lake))) + enddo + t_soisno(c,1) = min(Tclim+3.0_kind_lake,(max(t_soisno(c,1),Tclim-3.0_kind_lake))) + if(debug_print) print *,'GSL - after Tclim,tsfc,t_lake3d',i,Tclim,t_grnd(c),t_lake(c,:),t_soisno(c,:) + elseif(salty(i) == 1) then + ! Mono Lake never freezes, its temperature is above freezing point = -4.2 C + t_grnd(c) = max(tfrz-4.2_kind_lake,t_grnd(c)) + do k = 1,nlevlake + lake_icefrac(c,k) = 0._kind_lake + t_lake(c,k) = max(tfrz-4.2_kind_lake,t_lake(c,k)) + enddo + t_soisno(c,1) = max(tfrz-4.2_kind_lake,t_soisno(c,1)) + if(debug_print) print *,'Mono - tsfc,t_lake3d',i,t_grnd(c),t_lake(c,:),t_soisno(c,:) endif savedtke12d(i) = savedtke1(c) @@ -680,16 +702,20 @@ SUBROUTINE clm_lake_run( & !-- The CLM output is combined for fractional ice and water if( t_grnd(c) >= tfrz ) then - qfx = eflx_lh_tot(c)*invhvap + qfx = eflx_lh_tot(c)*invhvap else - qfx = eflx_lh_tot(c)*invhsub ! heat flux (W/m^2)=>mass flux(kg/(sm^2)) + qfx = eflx_lh_tot(c)*invhsub ! heat flux (W/m^2)=>mass flux(kg/(sm^2)) endif - evap_wat(i) = qfx/rho0(i) ! kinematic_surface_upward_latent_heat_flux_over_water - hflx_wat(i)=eflx_sh_tot(c)/(rho0(i)*cpair) ! kinematic_surface_upward_sensible_heat_flux_over_water + rho0 = prsl1(i) / (rair*t1(i)*(1.0 + con_fvirt*qv1(i))) + evap_wat(i) = qfx/rho0 ! kinematic_surface_upward_latent_heat_flux_over_water + hflx_wat(i) = eflx_sh_tot(c)/(rho0*cpair) ! kinematic_surface_upward_sensible_heat_flux_over_water gflx_wat(I) = eflx_gnet(c) ![W/m/m] upward_heat_flux_in_soil_over_water ep1d_water(i) = eflx_lh_tot(c) ![W/m/m] surface_upward_potential_latent_heat_flux_over_water tsurf_water(I) = t_grnd(c) ![K] surface skin temperature after iteration over water + tsurf_ice(i) = t_grnd(c) ! surface_skin_temperature_after_iteration_over_ice tsfc_wat(i) = t_grnd(c) ![K] surface skin temperature over water + tisfc(i) = t_grnd(c) + tsfc(i) = t_grnd(c) lake_t2m(I) = t_ref2m(c) ![K] temperature_at_2m_from_clm_lake lake_q2m(I) = q_ref2m(c) ! [frac] specific_humidity_at_2m_from_clm_lake albedo(i) = ( 0.6 * lake_icefrac3d(i,1) ) + & ! mid_day_surface_albedo_over_lake @@ -716,7 +742,9 @@ SUBROUTINE clm_lake_run( & cmm_water(i) = cm(i)*wind(i) ! surface_drag_wind_speed_for_momentum_in_air_over_water ice_point: if(fice(i)>=min_lakeice) then + ! Icy lake ! Most ice variables are identical to water variables. + if(debug_print) print *,'Icy xlat_d(i),xlon_d(i),frac_ice,frac_grid ',xlat_d(i),xlon_d(i),frac_ice,frac_grid if(frac_ice .or. frac_grid) then evap_ice(i) = evap_wat(i) ! kinematic_surface_upward_latent_heat_flux_over_ice hflx_ice(i) = hflx_wat(i) ! kinematic_surface_upward_sensible_heat_flux_over_ice @@ -728,11 +756,18 @@ SUBROUTINE clm_lake_run( & ! uustar_ice(i) = uustar_water(i) ! surface_friction_velocity_over_ice endif - tsurf_ice(i) = tsurf_water(i) ! surface_skin_temperature_after_iteration_over_ice + tsurf_ice(i) = t_grnd(c) ! surface_skin_temperature_after_iteration_over_ice tisfc(i) = t_grnd(c) ! surface_skin_temperature_over_ice + tsfc(i) = t_grnd(c) ! surface_skin_temperature_over_ice weasdi(i) = h2osno(c) ! water_equivalent_accumulated_snow_depth_over_ice - snodi(i) = snowdp(c) ! surface_snow_thickness_water_equivalent_over_ice - tsurf_ice(i) = t_grnd(c) ! surface_skin_temperature_after_iteration_over_ice + snodi(i) = snowdp(c)*1.e3 ! surface_snow_thickness_water_equivalent_over_ice + weasd(i) = weasdi(i) + snowd(i) = snodi(c) ! surface_snow_thickness_water_equivalent_over_ice + + + if (.not. icy(i)) then + flag_lakefreeze(i)=.true. + end if ! Ice points are icy: icy(i)=.true. ! flag_nonzero_sea_ice_surface_fraction @@ -744,7 +779,7 @@ SUBROUTINE clm_lake_run( & hice(I) = 0 ! sea_ice_thickness do k=1,nlevlake if(lake_icefrac3d(i,k)>0) then - hice(i) = hice(i) + dz_lake3d(i,k) + hice(i) = hice(i) + dz_lake(c,k) endif end do else ! Not an ice point @@ -754,8 +789,11 @@ SUBROUTINE clm_lake_run( & icy(i)=.false. weasdi(i) = 0 snodi(i) = 0 + weasd(i) = 0 + snowd(i) = 0 tisfc(i) = t_grnd(c) tsurf_ice(i) = tisfc(i) + tsfc(i) = t_grnd(c) hice(i) = 0 fice(i) = 0 endif ice_point @@ -774,7 +812,7 @@ SUBROUTINE clm_lake_run( & endif if_lake_is_here ENDDO lake_top_loop - if(LAKEDEBUG .and. lake_points>0 .and. (kdt<3 .or. mod(kdt,30)==3)) then + if(debug_print .and. lake_points>0 .and. (kdt<3 .or. mod(kdt,30)==3)) then 3082 format('lake points processed in timestep ',I0,' by rank ',I0,' = ',I0,' snow=',I0,' ice=',I0) print 3082,kdt,me,lake_points,snow_points,ice_points endif @@ -800,69 +838,69 @@ SUBROUTINE LakeMain(forc_t,forc_pbot,forc_psrf,forc_hgt,forc_hgt_q, & !I integer, intent(inout) :: errflg character(*), intent(inout) :: errmsg - real(kind_lake),intent(in) :: dtime ! timestep - real(kind_lake),intent(in) :: xlat_d, xlon_d ! grid location for debugging - real(kind_lake),intent(in) :: forc_t(1) ! atmospheric temperature (Kelvin) - real(kind_lake),intent(in) :: forc_pbot(1) ! atm bottom level pressure (Pa) - real(kind_lake),intent(in) :: forc_psrf(1) ! atmospheric surface pressure (Pa) - real(kind_lake),intent(in) :: forc_hgt(1) ! atmospheric reference height (m) - real(kind_lake),intent(in) :: forc_hgt_q(1) ! observational height of humidity [m] - real(kind_lake),intent(in) :: forc_hgt_t(1) ! observational height of temperature [m] - real(kind_lake),intent(in) :: forc_hgt_u(1) ! observational height of wind [m] - real(kind_lake),intent(in) :: forc_q(1) ! atmospheric specific humidity (kg/kg) - real(kind_lake),intent(in) :: forc_u(1) ! atmospheric wind speed in east direction (m/s) - real(kind_lake),intent(in) :: forc_v(1) ! atmospheric wind speed in north direction (m/s) + real(kind_lake),intent(in) :: dtime !< timestep + real(kind_lake),intent(in) :: xlat_d, xlon_d !< grid location for debugging + real(kind_lake),intent(in) :: forc_t(1) !< atmospheric temperature (Kelvin) + real(kind_lake),intent(in) :: forc_pbot(1) !< atm bottom level pressure (Pa) + real(kind_lake),intent(in) :: forc_psrf(1) !< atmospheric surface pressure (Pa) + real(kind_lake),intent(in) :: forc_hgt(1) !< atmospheric reference height (m) + real(kind_lake),intent(in) :: forc_hgt_q(1) !< observational height of humidity [m] + real(kind_lake),intent(in) :: forc_hgt_t(1) !< observational height of temperature [m] + real(kind_lake),intent(in) :: forc_hgt_u(1) !< observational height of wind [m] + real(kind_lake),intent(in) :: forc_q(1) !< atmospheric specific humidity (kg/kg) + real(kind_lake),intent(in) :: forc_u(1) !< atmospheric wind speed in east direction (m/s) + real(kind_lake),intent(in) :: forc_v(1) !< atmospheric wind speed in north direction (m/s) ! real(kind_lake),intent(in) :: forc_rho(1) ! density (kg/m**3) - real(kind_lake),intent(in) :: forc_lwrad(1) ! downward infrared (longwave) radiation (W/m**2) - real(kind_lake),intent(in) :: prec(1) ! snow or rain rate [mm/s] - real(kind_lake),intent(in) :: sabg(1) ! solar radiation absorbed by ground (W/m**2) - real(kind_lake),intent(in) :: lat(1) ! latitude (radians) - real(kind_lake),intent(in) :: z_lake(1,nlevlake) ! layer depth for lake (m) - real(kind_lake),intent(in) :: dz_lake(1,nlevlake) ! layer thickness for lake (m) - real(kind_lake),intent(out) :: ustar_out(1) ! friction velocity [m/s] - real(kind_lake), intent(in) :: lakedepth(1) ! column lake depth (m) + real(kind_lake),intent(in) :: forc_lwrad(1) !< downward infrared (longwave) radiation (W/m**2) + real(kind_lake),intent(in) :: prec(1) !< snow or rain rate [mm/s] + real(kind_lake),intent(in) :: sabg(1) !< solar radiation absorbed by ground (W/m**2) + real(kind_lake),intent(in) :: lat(1) !< latitude (radians) + real(kind_lake),intent(in) :: z_lake(1,nlevlake) !< layer depth for lake (m) + real(kind_lake),intent(in) :: dz_lake(1,nlevlake) !< layer thickness for lake (m) + real(kind_lake),intent(out) :: ustar_out(1) !< friction velocity [m/s] + real(kind_lake), intent(in) :: lakedepth(1) !< column lake depth (m) !!!!!!!!!!!!!!!!tep(in),hydro(in) ! real(kind_lake), intent(in) :: watsat(1,1:nlevsoil) ! volumetric soil water at saturation (porosity) !!!!!!!!!!!!!!!!hydro - logical , intent(in) :: do_capsnow(1) ! true => do snow capping - real(kind_lake), intent(in) :: watsat(1,nlevsoil) ! volumetric soil water at saturation (porosity) - real(kind_lake), intent(in) :: tksatu(1,nlevsoil) ! thermal conductivity, saturated soil [W/m-K] - real(kind_lake), intent(in) :: tkmg(1,nlevsoil) ! thermal conductivity, soil minerals [W/m-K] - real(kind_lake), intent(in) :: tkdry(1,nlevsoil) ! thermal conductivity, dry soil (W/m/Kelvin) - real(kind_lake), intent(in) :: csol(1,nlevsoil) ! heat capacity, soil solids (J/m**3/Kelvin) + logical , intent(in) :: do_capsnow(1) !< true => do snow capping + real(kind_lake), intent(in) :: watsat(1,nlevsoil) !< volumetric soil water at saturation (porosity) + real(kind_lake), intent(in) :: tksatu(1,nlevsoil) !< thermal conductivity, saturated soil [W/m-K] + real(kind_lake), intent(in) :: tkmg(1,nlevsoil) !< thermal conductivity, soil minerals [W/m-K] + real(kind_lake), intent(in) :: tkdry(1,nlevsoil) !< thermal conductivity, dry soil (W/m/Kelvin) + real(kind_lake), intent(in) :: csol(1,nlevsoil) !< heat capacity, soil solids (J/m**3/Kelvin) !in&out - real(kind_lake),intent(inout) :: h2osoi_vol(1,-nlevsnow+1:nlevsoil) ! volumetric soil water (0<=h2osoi_vol<=watsat)[m3/m3] - real(kind_lake),intent(inout) :: t_grnd(1) ! ground temperature (Kelvin) - real(kind_lake),intent(inout) :: h2osno(1) ! snow water (mm H2O) - real(kind_lake),intent(inout) :: snowdp(1) ! snow height (m) - real(kind_lake),intent(inout) :: z(1,-nlevsnow+1:nlevsoil) ! layer depth for snow & soil (m) - real(kind_lake),intent(inout) :: dz(1,-nlevsnow+1:nlevsoil) ! layer thickness for soil or snow (m) - real(kind_lake),intent(inout) :: t_soisno(1,-nlevsnow+1:nlevsoil) ! soil (or snow) temperature (Kelvin) - real(kind_lake),intent(inout) :: t_lake(1,nlevlake) ! lake temperature (Kelvin) - integer ,intent(inout) :: snl(1) ! number of snow layers - real(kind_lake),intent(inout) :: h2osoi_liq(1,-nlevsnow+1:nlevsoil) ! liquid water (kg/m2) - real(kind_lake),intent(inout) :: h2osoi_ice(1,-nlevsnow+1:nlevsoil) ! ice lens (kg/m2) - real(kind_lake),intent(inout) :: savedtke1(1) ! top level eddy conductivity from previous timestep (W/m.K) - real(kind_lake),intent(inout) :: zi(1,-nlevsnow+0:nlevsoil) ! interface level below a "z" level (m) - real(kind_lake),intent(inout) :: lake_icefrac(1,nlevlake) ! mass fraction of lake layer that is frozen + real(kind_lake),intent(inout) :: h2osoi_vol(1,-nlevsnow+1:nlevsoil) !< volumetric soil water (0<=h2osoi_vol<=watsat)[m3/m3] + real(kind_lake),intent(inout) :: t_grnd(1) !< ground temperature (Kelvin) + real(kind_lake),intent(inout) :: h2osno(1) !< snow water (mm H2O) + real(kind_lake),intent(inout) :: snowdp(1) !< snow height (m) + real(kind_lake),intent(inout) :: z(1,-nlevsnow+1:nlevsoil) !< layer depth for snow & soil (m) + real(kind_lake),intent(inout) :: dz(1,-nlevsnow+1:nlevsoil) !< layer thickness for soil or snow (m) + real(kind_lake),intent(inout) :: t_soisno(1,-nlevsnow+1:nlevsoil) !< soil (or snow) temperature (Kelvin) + real(kind_lake),intent(inout) :: t_lake(1,nlevlake) !< lake temperature (Kelvin) + integer ,intent(inout) :: snl(1) !< number of snow layers + real(kind_lake),intent(inout) :: h2osoi_liq(1,-nlevsnow+1:nlevsoil) !< liquid water (kg/m2) + real(kind_lake),intent(inout) :: h2osoi_ice(1,-nlevsnow+1:nlevsoil) !< ice lens (kg/m2) + real(kind_lake),intent(inout) :: savedtke1(1) !< top level eddy conductivity from previous timestep (W/m.K) + real(kind_lake),intent(inout) :: zi(1,-nlevsnow+0:nlevsoil) !< interface level below a "z" level (m) + real(kind_lake),intent(inout) :: lake_icefrac(1,nlevlake) !< mass fraction of lake layer that is frozen !out: - real(kind_lake),intent(out) :: eflx_gnet(1) !net heat flux into ground (W/m**2) - real(kind_lake),intent(out) :: eflx_lwrad_net(1) ! net infrared (longwave) rad (W/m**2) [+ = to atm] - real(kind_lake),intent(out) :: eflx_sh_tot(1) ! total sensible heat flux (W/m**2) [+ to atm] - real(kind_lake),intent(out) :: eflx_lh_tot(1) ! total latent heat flux (W/m8*2) [+ to atm] - real(kind_lake),intent(out) :: t_ref2m(1) ! 2 m height surface air temperature (Kelvin) - real(kind_lake),intent(out) :: q_ref2m(1) ! 2 m height surface specific humidity (kg/kg) - real(kind_lake),intent(out) :: taux(1) ! wind (shear) stress: e-w (kg/m/s**2) - real(kind_lake),intent(out) :: tauy(1) ! wind (shear) stress: n-s (kg/m/s**2) - real(kind_lake),intent(out) :: ram1(1) ! aerodynamical resistance (s/m) - ! for calculation of decay of eddy diffusivity with depth - ! Change the type variable to pass back to WRF. - real(kind_lake),intent(out) :: z0mg(1) ! roughness length over ground, momentum (m( + real(kind_lake),intent(out) :: eflx_gnet(1) !< net heat flux into ground (W/m**2) + real(kind_lake),intent(out) :: eflx_lwrad_net(1) !< net infrared (longwave) rad (W/m**2) [+ = to atm] + real(kind_lake),intent(out) :: eflx_sh_tot(1) !< total sensible heat flux (W/m**2) [+ to atm] + real(kind_lake),intent(out) :: eflx_lh_tot(1) !< total latent heat flux (W/m8*2) [+ to atm] + real(kind_lake),intent(out) :: t_ref2m(1) !< 2 m height surface air temperature (Kelvin) + real(kind_lake),intent(out) :: q_ref2m(1) !< 2 m height surface specific humidity (kg/kg) + real(kind_lake),intent(out) :: taux(1) !< wind (shear) stress: e-w (kg/m/s**2) + real(kind_lake),intent(out) :: tauy(1) !< wind (shear) stress: n-s (kg/m/s**2) + real(kind_lake),intent(out) :: ram1(1) !< aerodynamical resistance (s/m) + !! for calculation of decay of eddy diffusivity with depth + !! Change the type variable to pass back to WRF. + real(kind_lake),intent(out) :: z0mg(1) !< roughness length over ground, momentum (m( !local output @@ -956,7 +994,7 @@ SUBROUTINE LakeMain(forc_t,forc_pbot,forc_psrf,forc_hgt,forc_hgt_q, & !I t_lake,t_soisno,h2osoi_liq, & h2osoi_ice,savedtke1, & watsat, tksatu, tkmg, tkdry, csol, dtime, & - frac_iceold,qflx_snomelt,imelt,errmsg,errflg) + frac_iceold,qflx_snomelt,imelt,errmsg,errflg,xlat_d,xlon_d) if(errflg/=0) then return ! State is invalid now, so pass error to caller. endif @@ -989,6 +1027,13 @@ SUBROUTINE LakeMain(forc_t,forc_pbot,forc_psrf,forc_hgt,forc_hgt_q, & !I END SUBROUTINE LakeMain + ! DESCRIPTION: + !> Calculates lake temperatures and surface fluxes for shallow lakes. + !! + !! Shallow lakes have variable depth, possible snow layers above, freezing & thawing of lake water, + !! and soil layers with active temperature and gas diffusion below. + !! + !! WARNING: This subroutine assumes lake columns have one and only one pft. SUBROUTINE ShalLakeFluxes(forc_t,forc_pbot,forc_psrf,forc_hgt,forc_hgt_q, & !i forc_hgt_t,forc_hgt_u,forc_q, & forc_u,forc_v,forc_lwrad,forc_snow, & @@ -1001,18 +1046,10 @@ SUBROUTINE ShalLakeFluxes(forc_t,forc_pbot,forc_psrf,forc_hgt,forc_hgt_q, eflx_lh_grnd,t_veg,t_ref2m,q_ref2m,taux,tauy, & ram1,ws,ks,eflx_gnet,z0mg,ustar_out,errmsg,errflg,xlat_d,xlon_d) !============================================================================== - ! DESCRIPTION: - ! Calculates lake temperatures and surface fluxes for shallow lakes. - ! - ! Shallow lakes have variable depth, possible snow layers above, freezing & thawing of lake water, - ! and soil layers with active temperature and gas diffusion below. - ! - ! WARNING: This subroutine assumes lake columns have one and only one pft. - ! ! REVISION HISTORY: - ! Created by Zack Subin, 2009 - ! Reedited by Hongping Gu, 2010 - ! Updated for CCPP by Sam Trahan, 2022 + ! - Created by Zack Subin, 2009 + ! - Reedited by Hongping Gu, 2010 + ! - Updated for CCPP by Sam Trahan, 2022 !============================================================================== ! implicit none @@ -1021,62 +1058,62 @@ SUBROUTINE ShalLakeFluxes(forc_t,forc_pbot,forc_psrf,forc_hgt,forc_hgt_q, !in: - integer, intent(inout) :: errflg - character(len=*), intent(inout) :: errmsg - real(kind_lake),intent(in) :: xlat_d,xlon_d - real(kind_lake),intent(in) :: forc_t(1) ! atmospheric temperature (Kelvin) - real(kind_lake),intent(in) :: forc_pbot(1) ! atmospheric pressure (Pa) - real(kind_lake),intent(in) :: forc_psrf(1) ! atmospheric surface pressure (Pa) - real(kind_lake),intent(in) :: forc_hgt(1) ! atmospheric reference height (m) - real(kind_lake),intent(in) :: forc_hgt_q(1) ! observational height of humidity [m] - real(kind_lake),intent(in) :: forc_hgt_t(1) ! observational height of temperature [m] - real(kind_lake),intent(in) :: forc_hgt_u(1) ! observational height of wind [m] - real(kind_lake),intent(in) :: forc_q(1) ! atmospheric specific humidity (kg/kg) - real(kind_lake),intent(in) :: forc_u(1) ! atmospheric wind speed in east direction (m/s) - real(kind_lake),intent(in) :: forc_v(1) ! atmospheric wind speed in north direction (m/s) - real(kind_lake),intent(in) :: forc_lwrad(1) ! downward infrared (longwave) radiation (W/m**2) + integer, intent(inout) :: errflg !< + character(len=*), intent(inout) :: errmsg !< + real(kind_lake),intent(in) :: xlat_d,xlon_d !< + real(kind_lake),intent(in) :: forc_t(1) !< atmospheric temperature (Kelvin) + real(kind_lake),intent(in) :: forc_pbot(1) !< atmospheric pressure (Pa) + real(kind_lake),intent(in) :: forc_psrf(1) !< atmospheric surface pressure (Pa) + real(kind_lake),intent(in) :: forc_hgt(1) !< atmospheric reference height (m) + real(kind_lake),intent(in) :: forc_hgt_q(1) !< observational height of humidity [m] + real(kind_lake),intent(in) :: forc_hgt_t(1) !< observational height of temperature [m] + real(kind_lake),intent(in) :: forc_hgt_u(1) !< observational height of wind [m] + real(kind_lake),intent(in) :: forc_q(1) !< atmospheric specific humidity (kg/kg) + real(kind_lake),intent(in) :: forc_u(1) !< atmospheric wind speed in east direction (m/s) + real(kind_lake),intent(in) :: forc_v(1) !< atmospheric wind speed in north direction (m/s) + real(kind_lake),intent(in) :: forc_lwrad(1) !< downward infrared (longwave) radiation (W/m**2) ! real(kind_lake),intent(in) :: forc_rho(1) ! density (kg/m**3) - real(kind_lake),intent(in) :: forc_snow(1) ! snow rate [mm/s] - real(kind_lake),intent(in) :: forc_rain(1) ! rain rate [mm/s] - real(kind_lake),intent(in) :: h2osno(1) ! snow water (mm H2O) - real(kind_lake),intent(in) :: snowdp(1) ! snow height (m) - real(kind_lake),intent(in) :: sabg(1) ! solar radiation absorbed by ground (W/m**2) - real(kind_lake),intent(in) :: lat(1) ! latitude (radians) - real(kind_lake),intent(in) :: dz(1,-nlevsnow+1:nlevsoil) ! layer thickness for soil or snow (m) - real(kind_lake),intent(in) :: dz_lake(1,nlevlake) ! layer thickness for lake (m) - real(kind_lake),intent(in) :: t_soisno(1,-nlevsnow+1:nlevsoil) ! soil (or snow) temperature (Kelvin) - real(kind_lake),intent(in) :: t_lake(1,nlevlake) ! lake temperature (Kelvin) - integer ,intent(in) :: snl(1) ! number of snow layers - real(kind_lake),intent(in) :: h2osoi_liq(1,-nlevsnow+1:nlevsoil) ! liquid water (kg/m2) - real(kind_lake),intent(in) :: h2osoi_ice(1,-nlevsnow+1:nlevsoil) ! ice lens (kg/m2) - real(kind_lake),intent(in) :: savedtke1(1) ! top level eddy conductivity from previous timestep (W/m.K) + real(kind_lake),intent(in) :: forc_snow(1) !< snow rate [mm/s] + real(kind_lake),intent(in) :: forc_rain(1) !< rain rate [mm/s] + real(kind_lake),intent(in) :: h2osno(1) !< snow water (mm H2O) + real(kind_lake),intent(in) :: snowdp(1) !< snow height (m) + real(kind_lake),intent(in) :: sabg(1) !< solar radiation absorbed by ground (W/m**2) + real(kind_lake),intent(in) :: lat(1) !< latitude (radians) + real(kind_lake),intent(in) :: dz(1,-nlevsnow+1:nlevsoil) !< layer thickness for soil or snow (m) + real(kind_lake),intent(in) :: dz_lake(1,nlevlake) !< layer thickness for lake (m) + real(kind_lake),intent(in) :: t_soisno(1,-nlevsnow+1:nlevsoil) !< soil (or snow) temperature (Kelvin) + real(kind_lake),intent(in) :: t_lake(1,nlevlake) !< lake temperature (Kelvin) + integer ,intent(in) :: snl(1) !< number of snow layers + real(kind_lake),intent(in) :: h2osoi_liq(1,-nlevsnow+1:nlevsoil) !< liquid water (kg/m2) + real(kind_lake),intent(in) :: h2osoi_ice(1,-nlevsnow+1:nlevsoil) !< ice lens (kg/m2) + real(kind_lake),intent(in) :: savedtke1(1) !< top level eddy conductivity from previous timestep (W/m.K) !inout: - real(kind_lake),intent(inout) :: t_grnd(1) ! ground temperature (Kelvin) + real(kind_lake),intent(inout) :: t_grnd(1) !< ground temperature (Kelvin) !out: - real(kind_lake),intent(out):: ustar_out(1) ! friction velocity [m/s] - real(kind_lake),intent(out):: qflx_prec_grnd(1) ! water onto ground including canopy runoff [kg/(m2 s)] - real(kind_lake),intent(out):: qflx_evap_soi(1) ! soil evaporation (mm H2O/s) (+ = to atm) - real(kind_lake),intent(out):: qflx_evap_tot(1) ! qflx_evap_soi + qflx_evap_veg + qflx_tran_veg - real(kind_lake),intent(out):: eflx_sh_grnd(1) ! sensible heat flux from ground (W/m**2) [+ to atm] - real(kind_lake),intent(out):: eflx_lwrad_out(1) ! emitted infrared (longwave) radiation (W/m**2) - real(kind_lake),intent(out):: eflx_lwrad_net(1) ! net infrared (longwave) rad (W/m**2) [+ = to atm] - real(kind_lake),intent(out):: eflx_soil_grnd(1) ! soil heat flux (W/m**2) [+ = into soil] - real(kind_lake),intent(out):: eflx_sh_tot(1) ! total sensible heat flux (W/m**2) [+ to atm] - real(kind_lake),intent(out):: eflx_lh_tot(1) ! total latent heat flux (W/m8*2) [+ to atm] - real(kind_lake),intent(out):: eflx_lh_grnd(1) ! ground evaporation heat flux (W/m**2) [+ to atm] - real(kind_lake),intent(out):: t_veg(1) ! vegetation temperature (Kelvin) - real(kind_lake),intent(out):: t_ref2m(1) ! 2 m height surface air temperature (Kelvin) - real(kind_lake),intent(out):: q_ref2m(1) ! 2 m height surface specific humidity (kg/kg) - real(kind_lake),intent(out):: taux(1) ! wind (shear) stress: e-w (kg/m/s**2) - real(kind_lake),intent(out):: tauy(1) ! wind (shear) stress: n-s (kg/m/s**2) - real(kind_lake),intent(out):: ram1(1) ! aerodynamical resistance (s/m) - real(kind_lake),intent(out):: ws(1) ! surface friction velocity (m/s) - real(kind_lake),intent(out):: ks(1) ! coefficient passed to ShalLakeTemperature - ! for calculation of decay of eddy diffusivity with depth - real(kind_lake),intent(out):: eflx_gnet(1) !net heat flux into ground (W/m**2) - ! Change the type variable to pass back to WRF. - real(kind_lake),intent(out):: z0mg(1) ! roughness length over ground, momentum (m( + real(kind_lake),intent(out):: ustar_out(1) !< friction velocity [m/s] + real(kind_lake),intent(out):: qflx_prec_grnd(1) !< water onto ground including canopy runoff [kg/(m2 s)] + real(kind_lake),intent(out):: qflx_evap_soi(1) !< soil evaporation (mm H2O/s) (+ = to atm) + real(kind_lake),intent(out):: qflx_evap_tot(1) !< qflx_evap_soi + qflx_evap_veg + qflx_tran_veg + real(kind_lake),intent(out):: eflx_sh_grnd(1) !< sensible heat flux from ground (W/m**2) [+ to atm] + real(kind_lake),intent(out):: eflx_lwrad_out(1) !< emitted infrared (longwave) radiation (W/m**2) + real(kind_lake),intent(out):: eflx_lwrad_net(1) !< net infrared (longwave) rad (W/m**2) [+ = to atm] + real(kind_lake),intent(out):: eflx_soil_grnd(1) !< soil heat flux (W/m**2) [+ = into soil] + real(kind_lake),intent(out):: eflx_sh_tot(1) !< total sensible heat flux (W/m**2) [+ to atm] + real(kind_lake),intent(out):: eflx_lh_tot(1) !< total latent heat flux (W/m8*2) [+ to atm] + real(kind_lake),intent(out):: eflx_lh_grnd(1) !< ground evaporation heat flux (W/m**2) [+ to atm] + real(kind_lake),intent(out):: t_veg(1) !< vegetation temperature (Kelvin) + real(kind_lake),intent(out):: t_ref2m(1) !< 2 m height surface air temperature (Kelvin) + real(kind_lake),intent(out):: q_ref2m(1) !< 2 m height surface specific humidity (kg/kg) + real(kind_lake),intent(out):: taux(1) !< wind (shear) stress: e-w (kg/m/s**2) + real(kind_lake),intent(out):: tauy(1) !< wind (shear) stress: n-s (kg/m/s**2) + real(kind_lake),intent(out):: ram1(1) !< aerodynamical resistance (s/m) + real(kind_lake),intent(out):: ws(1) !< surface friction velocity (m/s) + real(kind_lake),intent(out):: ks(1) !< coefficient passed to ShalLakeTemperature + !! for calculation of decay of eddy diffusivity with depth + real(kind_lake),intent(out):: eflx_gnet(1) !< net heat flux into ground (W/m**2) + !! Change the type variable to pass back to WRF. + real(kind_lake),intent(out):: z0mg(1) !< roughness length over ground, momentum (m( @@ -1486,7 +1523,7 @@ SUBROUTINE ShalLakeFluxes(forc_t,forc_pbot,forc_psrf,forc_hgt,forc_hgt_q, qflx_evap_tot(p) = qflx_evap_soi(p) eflx_lh_tot(p) = htvp(c)*qflx_evap_soi(p) eflx_lh_grnd(p) = htvp(c)*qflx_evap_soi(p) - if(LAKEDEBUG) then + if(debug_print) then 1604 format('CLM_Lake ShalLakeFluxes: c=',I0,' sensible heat = ',F12.4,' latent heat =',F12.4, & ' ground temp = ', F12.4, ' h2osno = ', F12.4, ' at xlat_d=',F10.3,' xlon_d=',F10.3) print 1604, c, eflx_sh_tot(p), eflx_lh_tot(p), t_grnd(c), h2osno(c),xlat_d,xlon_d @@ -1564,24 +1601,24 @@ SUBROUTINE ShalLakeTemperature(t_grnd,h2osno,sabg,dz,dz_lake,z,zi, & ! t_lake,t_soisno,h2osoi_liq, & h2osoi_ice,savedtke1, & watsat, tksatu, tkmg, tkdry, csol, dtime, & - frac_iceold,qflx_snomelt,imelt,errmsg,errflg) + frac_iceold,qflx_snomelt,imelt,errmsg,errflg,xlat_d,xlon_d) !======================================================================================================= - ! !DESCRIPTION: - ! Calculates temperatures in the 20-25 layer column of (possible) snow, - ! lake water, and soil beneath lake. - ! Snow and soil temperatures are determined as in SoilTemperature, except - ! for appropriate boundary conditions at the top of the snow (the flux is fixed - ! to be the ground heat flux calculated in ShalLakeFluxes), the bottom of the snow - ! (adjacent to top lake layer), and the top of the soil (adjacent to the bottom - ! lake layer). Also, the soil is assumed to be always fully saturated (ShalLakeHydrology - ! will have to insure this). The whole column is solved simultaneously as one tridiagonal matrix. - ! Lake temperatures are determined from the Hostetler model as before, except now: - ! i) Lake water layers can freeze by any fraction and release latent heat; thermal - ! and mechanical properties are adjusted for ice fraction. - ! ii) Convective mixing (though not eddy diffusion) still occurs for frozen lakes. - ! iii) No sunlight is absorbed in the lake if there are snow layers. - ! iv) Light is allowed to reach the top soil layer (where it is assumed to be completely absorbed). - ! v) Lakes have variable depth, set ultimately in surface data set but now in initShalLakeMod. + ! DESCRIPTION: + !< Calculates temperatures in the 20-25 layer column of (possible) snow, + !! lake water, and soil beneath lake. + !! Snow and soil temperatures are determined as in SoilTemperature, except + !! for appropriate boundary conditions at the top of the snow (the flux is fixed + !! to be the ground heat flux calculated in ShalLakeFluxes), the bottom of the snow + !! (adjacent to top lake layer), and the top of the soil (adjacent to the bottom + !! lake layer). Also, the soil is assumed to be always fully saturated (ShalLakeHydrology + !! will have to insure this). The whole column is solved simultaneously as one tridiagonal matrix. + !! Lake temperatures are determined from the Hostetler model as before, except now: + !!\n i) Lake water layers can freeze by any fraction and release latent heat; thermal + !! and mechanical properties are adjusted for ice fraction. + !!\n ii) Convective mixing (though not eddy diffusion) still occurs for frozen lakes. + !!\n iii) No sunlight is absorbed in the lake if there are snow layers. + !!\n iv) Light is allowed to reach the top soil layer (where it is assumed to be completely absorbed). + !!\n v) Lakes have variable depth, set ultimately in surface data set but now in initShalLakeMod. ! ! Eddy + molecular diffusion: ! d ts d d ts 1 ds @@ -1652,49 +1689,51 @@ SUBROUTINE ShalLakeTemperature(t_grnd,h2osno,sabg,dz,dz_lake,z,zi, & ! implicit none !in: - integer, intent(inout) :: errflg - real(kind_lake), intent(in) :: watsat(1,nlevsoil) ! volumetric soil water at saturation (porosity) - real(kind_lake), intent(in) :: tksatu(1,nlevsoil) ! thermal conductivity, saturated soil [W/m-K] - real(kind_lake), intent(in) :: tkmg(1,nlevsoil) ! thermal conductivity, soil minerals [W/m-K] - real(kind_lake), intent(in) :: tkdry(1,nlevsoil) ! thermal conductivity, dry soil (W/m/Kelvin) - real(kind_lake), intent(in) :: csol(1,nlevsoil) ! heat capacity, soil solids (J/m**3/Kelvin) - character(*), intent(inout) :: errmsg - real(kind_lake), intent(in) :: t_grnd(1) ! ground temperature (Kelvin) - real(kind_lake), intent(inout) :: h2osno(1) ! snow water (mm H2O) - real(kind_lake), intent(in) :: sabg(1) ! solar radiation absorbed by ground (W/m**2) - real(kind_lake), intent(in) :: dz(1,-nlevsnow + 1:nlevsoil) ! layer thickness for snow & soil (m) - real(kind_lake), intent(in) :: dz_lake(1,nlevlake) ! layer thickness for lake (m) - real(kind_lake), intent(in) :: z(1,-nlevsnow+1:nlevsoil) ! layer depth for snow & soil (m) - real(kind_lake), intent(in) :: zi(1,-nlevsnow+0:nlevsoil) ! interface level below a "z" level (m) - ! the other z and dz variables - real(kind_lake), intent(in) :: z_lake(1,nlevlake) ! layer depth for lake (m) - real(kind_lake), intent(in) :: ws(1) ! surface friction velocity (m/s) - real(kind_lake), intent(in) :: ks(1) ! coefficient passed to ShalLakeTemperature - ! for calculation of decay of eddy diffusivity with depth - integer , intent(in) :: snl(1) ! negative of number of snow layers - real(kind_lake), intent(inout) :: eflx_gnet(1) ! net heat flux into ground (W/m**2) at the surface interface - real(kind_lake), intent(in) :: lakedepth(1) ! column lake depth (m) + real(kind_lake), intent(in) :: xlat_d !< latitude (degrees) + real(kind_lake), intent(in) :: xlon_d !< longitude (degrees) + integer, intent(inout) :: errflg !< + real(kind_lake), intent(in) :: watsat(1,nlevsoil) !< volumetric soil water at saturation (porosity) + real(kind_lake), intent(in) :: tksatu(1,nlevsoil) !< thermal conductivity, saturated soil [W/m-K] + real(kind_lake), intent(in) :: tkmg(1,nlevsoil) !< thermal conductivity, soil minerals [W/m-K] + real(kind_lake), intent(in) :: tkdry(1,nlevsoil) !< thermal conductivity, dry soil (W/m/Kelvin) + real(kind_lake), intent(in) :: csol(1,nlevsoil) !< heat capacity, soil solids (J/m**3/Kelvin) + character(*), intent(inout) :: errmsg !< + real(kind_lake), intent(in) :: t_grnd(1) !< ground temperature (Kelvin) + real(kind_lake), intent(inout) :: h2osno(1) !< snow water (mm H2O) + real(kind_lake), intent(in) :: sabg(1) !< solar radiation absorbed by ground (W/m**2) + real(kind_lake), intent(in) :: dz(1,-nlevsnow + 1:nlevsoil) !< layer thickness for snow & soil (m) + real(kind_lake), intent(in) :: dz_lake(1,nlevlake) !< layer thickness for lake (m) + real(kind_lake), intent(in) :: z(1,-nlevsnow+1:nlevsoil) !< layer depth for snow & soil (m) + real(kind_lake), intent(in) :: zi(1,-nlevsnow+0:nlevsoil) !< interface level below a "z" level (m) + !! the other z and dz variables + real(kind_lake), intent(in) :: z_lake(1,nlevlake) !< layer depth for lake (m) + real(kind_lake), intent(in) :: ws(1) !< surface friction velocity (m/s) + real(kind_lake), intent(in) :: ks(1) !< coefficient passed to ShalLakeTemperature + !! for calculation of decay of eddy diffusivity with depth + integer , intent(in) :: snl(1) !< negative of number of snow layers + real(kind_lake), intent(inout) :: eflx_gnet(1) !< net heat flux into ground (W/m**2) at the surface interface + real(kind_lake), intent(in) :: lakedepth(1) !< column lake depth (m) ! real(kind_lake), intent(in) :: watsat(1,nlevsoil) ! volumetric soil water at saturation (porosity) - real(kind_lake), intent(inout) :: snowdp(1) !snow height (m) - real(kind_lake), intent(in) :: dtime !timestep + real(kind_lake), intent(inout) :: snowdp(1) !< snow height (m) + real(kind_lake), intent(in) :: dtime !< timestep !out: - real(kind_lake), intent(out) :: eflx_sh_grnd(1) ! sensible heat flux from ground (W/m**2) [+ to atm] - real(kind_lake), intent(out) :: eflx_sh_tot(1) ! total sensible heat flux (W/m**2) [+ to atm] - real(kind_lake), intent(out) :: eflx_soil_grnd(1) ! heat flux into snow / lake (W/m**2) [+ = into soil] - ! Here this includes the whole lake radiation absorbed. - !real(kind_lake), intent(out) :: qmelt(1) ! snow melt [mm/s] [temporary] + real(kind_lake), intent(out) :: eflx_sh_grnd(1) !< sensible heat flux from ground (W/m**2) [+ to atm] + real(kind_lake), intent(out) :: eflx_sh_tot(1) !< total sensible heat flux (W/m**2) [+ to atm] + real(kind_lake), intent(out) :: eflx_soil_grnd(1) !< heat flux into snow / lake (W/m**2) [+ = into soil] + !! Here this includes the whole lake radiation absorbed. + !real(kind_lake), intent(out) :: qmelt(1) !< snow melt [mm/s] [temporary] - real(kind_lake), intent(inout) :: t_lake(1,nlevlake) ! lake temperature (Kelvin) - real(kind_lake), intent(inout) :: t_soisno(1,-nlevsnow+1:nlevsoil) ! soil (or snow) temperature (Kelvin) - real(kind_lake), intent(inout) :: h2osoi_liq(1,-nlevsnow+1:nlevsoil) ! liquid water (kg/m2) [for snow & soil layers] - real(kind_lake), intent(inout) :: h2osoi_ice(1,-nlevsnow+1:nlevsoil) ! ice lens (kg/m2) [for snow & soil layers] - real(kind_lake), intent(inout) :: lake_icefrac(1,nlevlake) ! mass fraction of lake layer that is frozen - real(kind_lake), intent(out) :: savedtke1(1) ! top level thermal conductivity (W/mK) - real(kind_lake), intent(out) :: frac_iceold(1,-nlevsnow+1:nlevsoil) ! fraction of ice relative to the tot water - real(kind_lake), intent(out) :: qflx_snomelt(1) !snow melt (mm H2O /s) - integer, intent(out) :: imelt(1,-nlevsnow+1:nlevsoil) !flag for melting (=1), freezing (=2), Not=0 (new) + real(kind_lake), intent(inout) :: t_lake(1,nlevlake) !< lake temperature (Kelvin) + real(kind_lake), intent(inout) :: t_soisno(1,-nlevsnow+1:nlevsoil) !< soil (or snow) temperature (Kelvin) + real(kind_lake), intent(inout) :: h2osoi_liq(1,-nlevsnow+1:nlevsoil) !< liquid water (kg/m2) [for snow & soil layers] + real(kind_lake), intent(inout) :: h2osoi_ice(1,-nlevsnow+1:nlevsoil) !< ice lens (kg/m2) [for snow & soil layers] + real(kind_lake), intent(inout) :: lake_icefrac(1,nlevlake) !< mass fraction of lake layer that is frozen + real(kind_lake), intent(out) :: savedtke1(1) !< top level thermal conductivity (W/mK) + real(kind_lake), intent(out) :: frac_iceold(1,-nlevsnow+1:nlevsoil) !< fraction of ice relative to the tot water + real(kind_lake), intent(out) :: qflx_snomelt(1) !< snow melt (mm H2O /s) + integer, intent(out) :: imelt(1,-nlevsnow+1:nlevsoil) !< flag for melting (=1), freezing (=2), Not=0 (new) ! OTHER LOCAL VARIABLES: @@ -2015,6 +2054,15 @@ SUBROUTINE ShalLakeTemperature(t_grnd,h2osno,sabg,dz,dz_lake,z,zi, & ! + cfus*dz_lake(c,j)*(1._kind_lake-lake_icefrac(c,j)) !& ! + (cwat-cice_eff)*lake_icefrac(c)*tfrz*dz_lake(c,j) !enthalpy reconciliation term t_lake_bef(c,j) = t_lake(c,j) + if(debug_print) then + if (abs(xlat_d-52.1152).lt.0.1 .and. & + abs(xlon_d-260.405).lt.0.1)then + print *,' ocvts(c) at xlat_d,xlon_d',xlat_d,xlon_d + print *,'j,dz_lake(c,j) ', j,dz_lake(c,j) + print*,'cv_lake(c,j),lake_icefrac(c,j),t_lake(c,j),cfus,ocvts(c)', & + cv_lake(c,j),lake_icefrac(c,j),t_lake(c,j),cfus,ocvts(c) + endif + endif end do end do @@ -2030,6 +2078,15 @@ SUBROUTINE ShalLakeTemperature(t_grnd,h2osno,sabg,dz,dz_lake,z,zi, & ! ocvts(c) = ocvts(c) + cv(c,j)*(t_soisno(c,j)-tfrz) & + hfus*h2osoi_liq(c,j) !& ! + (cpliq-cpice)*h2osoi_ice(c,j)*tfrz !enthalpy reconciliation term + if(debug_print) then + if (abs(xlat_d-52.1152).lt.0.1 .and. & + abs(xlon_d-260.405).lt.0.1)then + print *,' ocvts(c) at xlat_d,xlon_d',xlat_d,xlon_d + print *,' j,jtop(c)',j,jtop(c),'h2osoi_liq(c,j) ',h2osoi_liq(c,j),'h2osoi_ice(c,j)',h2osoi_ice(c,j) + print *,' cv(c,j),t_soisno(c,j),hfus,ocvts(c)',c,j,cv(c,j),t_soisno(c,j),hfus,ocvts(c) + print *,' h2osno(c)',h2osno(c) + endif + endif if (j == 1 .and. h2osno(c) > 0._kind_lake .and. j == jtop(c)) then ocvts(c) = ocvts(c) - h2osno(c)*hfus end if @@ -2373,9 +2430,9 @@ SUBROUTINE ShalLakeTemperature(t_grnd,h2osno,sabg,dz,dz_lake,z,zi, & ! c = filter_shlakec(fc) if (rhow(c,j) > rhow(c,j+1) .or. & (lake_icefrac(c,j) < 1._kind_lake .and. lake_icefrac(c,j+1) > 0._kind_lake) ) then - if(LAKEDEBUG) then + if(debug_print) then if (i==1) then - print *, 'Convective Mixing in column ', c, '.' + print *, 'Convective Ice Mixing in column ', c, 'lake_icefrac(c,j) ',lake_icefrac(c,j),lake_icefrac(c,j+1) endif endif qav(c) = qav(c) + dz_lake(c,i)*(t_lake(c,i)-tfrz) * & @@ -2447,6 +2504,8 @@ SUBROUTINE ShalLakeTemperature(t_grnd,h2osno,sabg,dz,dz_lake,z,zi, & ! rhow(c,i) = (1._kind_lake - lake_icefrac(c,i)) * & 1000._kind_lake*( 1.0_kind_lake - 1.9549e-05_kind_lake*(abs(t_lake(c,i)-277._kind_lake))**1.68_kind_lake ) & + lake_icefrac(c,i)*denice + if (debug_print .and. lake_icefrac(c,j) > 0.)print *,'rhow(c,i),lake_icefrac(c,i),t_lake(c,i)', & + i,rhow(c,i),lake_icefrac(c,i),t_lake(c,i),denice end if end do end do @@ -2462,7 +2521,7 @@ SUBROUTINE ShalLakeTemperature(t_grnd,h2osno,sabg,dz,dz_lake,z,zi, & ! c = filter_shlakec(fc) cv_lake(c,j) = dz_lake(c,j) * (cwat*(1._kind_lake-lake_icefrac(c,j)) + cice_eff*lake_icefrac(c,j)) - if (LAKEDEBUG) then + if (debug_print .and. lake_icefrac(c,j) > 0.) then print *,'Lake Ice Fraction, c, level:', c, j, lake_icefrac(c,j) endif end do @@ -2485,6 +2544,15 @@ SUBROUTINE ShalLakeTemperature(t_grnd,h2osno,sabg,dz,dz_lake,z,zi, & ! + cfus*dz_lake(c,j)*(1._kind_lake-lake_icefrac(c,j)) !& ! + (cwat-cice_eff)*lake_icefrac(c)*tfrz*dz_lake(c,j) !enthalpy reconciliation term fin(c) = fin(c) + phi(c,j) + if(debug_print) then + if (abs(xlat_d-52.1152).lt.0.1 .and. & + abs(xlon_d-260.405).lt.0.1)then + print *,' ncvts(c) at xlat_d,xlon_d',xlat_d,xlon_d + print *,' new cv_lake(c,j),t_lake(c,j),cfus,lake_icefrac(c,j),ncvts(c),fin(c)', & + j,cv_lake(c,j),t_lake(c,j),cfus,lake_icefrac(c,j),ncvts(c),fin(c) + print *,' new dz_lake(c,j),fin(c),phi(c,j)',c,dz_lake(c,j),fin(c),phi(c,j) + endif + endif end do end do @@ -2499,6 +2567,15 @@ SUBROUTINE ShalLakeTemperature(t_grnd,h2osno,sabg,dz,dz_lake,z,zi, & ! ncvts(c) = ncvts(c) + cv(c,j)*(t_soisno(c,j)-tfrz) & + hfus*h2osoi_liq(c,j) !& ! + (cpliq-cpice)*h2osoi_ice(c,j)*tfrz !enthalpy reconciliation term + if(debug_print) then + if (abs(xlat_d-52.1152).lt.0.1 .and. & + abs(xlon_d-260.405).lt.0.1)then + print *,' ncvts(c) at xlat_d,xlon_d',xlat_d,xlon_d + print *,'new j,jtop(c)',j,jtop(c),'h2osoi_liq(c,j) ',h2osoi_liq(c,j),'h2osoi_ice(c,j)',h2osoi_ice(c,j) + print *,'new cv(c,j),t_soisno(c,j),hfus,ncvts(c)',c,j,cv(c,j),t_soisno(c,j),hfus,ncvts(c) + print *,'new h2osno(c)',h2osno(c) + endif + endif if (j == 1 .and. h2osno(c) > 0._kind_lake .and. j == jtop(c)) then ncvts(c) = ncvts(c) - h2osno(c)*hfus end if @@ -2514,21 +2591,46 @@ SUBROUTINE ShalLakeTemperature(t_grnd,h2osno,sabg,dz,dz_lake,z,zi, & ! p = filter_shlakep(fp) c = pcolumn(p) errsoi(c) = (ncvts(c)-ocvts(c)) / dtime - fin(c) - if( (LAKEDEBUG .and. abs(errsoi(c)) < 1._kind_lake) ) then -! .or. (.not.LAKEDEBUG .and. abs(errsoi(c)) < 10._kind_lake)) then + if(debug_print) then + if (abs(xlat_d-52.1152).lt.0.1 .and. & + abs(xlon_d-260.405).lt.0.1)then + print *,'xlat_d,xlon_d',xlat_d,xlon_d + print *,'errsoi(c),fin(c),ncvts(c),ocvts(c),dtime,lake_icefrac(c,:),h2osno(c)', & + errsoi(c),fin(c),ncvts(c),ocvts(c),dtime,lake_icefrac(c,:),h2osno(c) + endif + endif + if( .not.LAKEDEBUG ) then + if (abs(errsoi(c)) < 10._kind_lake) then + eflx_sh_tot(p) = eflx_sh_tot(p) - errsoi(c) + eflx_sh_grnd(p) = eflx_sh_grnd(p) - errsoi(c) + eflx_soil_grnd(p) = eflx_soil_grnd(p) + errsoi(c) + eflx_gnet(p) = eflx_gnet(p) + errsoi(c) + if(debug_print) then + if (abs(errsoi(c)) > 1.e-1_kind_lake) then + print *,'errsoi incorporated at xlat_d,xlon_d',xlat_d,xlon_d + print *,'errsoi incorporated into sensible heat in ShalLakeTemperature: c, (W/m^2):', c, errsoi(c) + end if + endif + errsoi(c) = 0._kind_lake + endif + elseif ( LAKEDEBUG) then + if (abs(errsoi(c)) < 1._kind_lake) then eflx_sh_tot(p) = eflx_sh_tot(p) - errsoi(c) eflx_sh_grnd(p) = eflx_sh_grnd(p) - errsoi(c) eflx_soil_grnd(p) = eflx_soil_grnd(p) + errsoi(c) eflx_gnet(p) = eflx_gnet(p) + errsoi(c) - ! if (abs(errsoi(c)) > 1.e-3_kind_lake) then if (abs(errsoi(c)) > 1.e-1_kind_lake) then print *,'errsoi incorporated into sensible heat in ShalLakeTemperature: c, (W/m^2):', c, errsoi(c) end if errsoi(c) = 0._kind_lake - else if(LAKEDEBUG) then + else print *,'Soil Energy Balance Error at column, ', c, 'G, fintotal, column E tendency = ', & - eflx_gnet(p), fin(c), (ncvts(c)-ocvts(c)) / dtime - end if + eflx_gnet(p), fin(c), (ncvts(c)-ocvts(c)) / dtime,'xlat_d,xlon_d',xlat_d,xlon_d + print *,'errsoi(c),ncvts(c),ocvts(c)',errsoi(c),ncvts(c),ocvts(c),'xlat_d,xlon_d',xlat_d,xlon_d + print *,'lake_icefrac(c,:),h2osno(c)', lake_icefrac(c,:),h2osno(c) + print *,'t_lake(c,:),t_soisno(c,:)',t_lake(c,:),t_soisno(c,:) + end if + end if ! LAKEDEBUG end do ! This loop assumes only one point per column. @@ -2540,52 +2642,48 @@ end subroutine ShalLakeTemperature ! ! ROUTINE: SoilThermProp_Lake ! - ! !INTERFACE: + ! INTERFACE: + ! DESCRIPTION: + !> Calculation of thermal conductivities and heat capacities of + !! snow/soil layers + !!\n (1) The volumetric heat capacity is calculated as a linear combination + !! in terms of the volumetric fraction of the constituent phases. + !! + !!\n (2) The thermal conductivity of soil is computed from the algorithm of + !! Johansen (as reported by Farouki 1981), and of snow is from the + !! formulation used in SNTHERM (Jordan 1991). + !! The thermal conductivities at the interfaces between two neighboring + !! layers (j, j+1) are derived from an assumption that the flux across + !! the interface is equal to that from the node j to the interface and the + !! flux from the interface to the node j+1. + !! + !! For lakes, the proper soil layers (not snow) should always be saturated. subroutine SoilThermProp_Lake (snl,dz,zi,z,t_soisno,h2osoi_liq,h2osoi_ice, & watsat, tksatu, tkmg, tkdry, csol, tk, cv, tktopsoillay,errmsg,errflg) - ! - ! !DESCRIPTION: - ! Calculation of thermal conductivities and heat capacities of - ! snow/soil layers - ! (1) The volumetric heat capacity is calculated as a linear combination - ! in terms of the volumetric fraction of the constituent phases. - ! - ! (2) The thermal conductivity of soil is computed from the algorithm of - ! Johansen (as reported by Farouki 1981), and of snow is from the - ! formulation used in SNTHERM (Jordan 1991). - ! The thermal conductivities at the interfaces between two neighboring - ! layers (j, j+1) are derived from an assumption that the flux across - ! the interface is equal to that from the node j to the interface and the - ! flux from the interface to the node j+1. - ! - ! For lakes, the proper soil layers (not snow) should always be saturated. - ! - ! !USES: - implicit none !in - integer, intent(inout) :: errflg - character(*), intent(inout) :: errmsg - integer , intent(in) :: snl(1) ! number of snow layers - ! real(kind_lake), intent(in) :: h2osno(1) ! snow water (mm H2O) - real(kind_lake), intent(in) :: watsat(1,nlevsoil) ! volumetric soil water at saturation (porosity) - real(kind_lake), intent(in) :: tksatu(1,nlevsoil) ! thermal conductivity, saturated soil [W/m-K] - real(kind_lake), intent(in) :: tkmg(1,nlevsoil) ! thermal conductivity, soil minerals [W/m-K] - real(kind_lake), intent(in) :: tkdry(1,nlevsoil) ! thermal conductivity, dry soil (W/m/Kelvin) - real(kind_lake), intent(in) :: csol(1,nlevsoil) ! heat capacity, soil solids (J/m**3/Kelvin) - real(kind_lake), intent(in) :: dz(1,-nlevsnow+1:nlevsoil) ! layer thickness (m) - real(kind_lake), intent(in) :: zi(1,-nlevsnow+0:nlevsoil) ! interface level below a "z" level (m) - real(kind_lake), intent(in) :: z(1,-nlevsnow+1:nlevsoil) ! layer depth (m) - real(kind_lake), intent(in) :: t_soisno(1,-nlevsnow+1:nlevsoil) ! soil temperature (Kelvin) - real(kind_lake), intent(in) :: h2osoi_liq(1,-nlevsnow+1:nlevsoil) ! liquid water (kg/m2) - real(kind_lake), intent(in) :: h2osoi_ice(1,-nlevsnow+1:nlevsoil) ! ice lens (kg/m2) + integer, intent(inout) :: errflg + character(*), intent(inout) :: errmsg + integer , intent(in) :: snl(1) !< number of snow layers + ! real(kind_lake), intent(in) :: h2osno(1) !< snow water (mm H2O) + real(kind_lake), intent(in) :: watsat(1,nlevsoil) !< volumetric soil water at saturation (porosity) + real(kind_lake), intent(in) :: tksatu(1,nlevsoil) !< thermal conductivity, saturated soil [W/m-K] + real(kind_lake), intent(in) :: tkmg(1,nlevsoil) !< thermal conductivity, soil minerals [W/m-K] + real(kind_lake), intent(in) :: tkdry(1,nlevsoil) !< thermal conductivity, dry soil (W/m/Kelvin) + real(kind_lake), intent(in) :: csol(1,nlevsoil) !< heat capacity, soil solids (J/m**3/Kelvin) + real(kind_lake), intent(in) :: dz(1,-nlevsnow+1:nlevsoil) !< layer thickness (m) + real(kind_lake), intent(in) :: zi(1,-nlevsnow+0:nlevsoil) !< interface level below a "z" level (m) + real(kind_lake), intent(in) :: z(1,-nlevsnow+1:nlevsoil) !< layer depth (m) + real(kind_lake), intent(in) :: t_soisno(1,-nlevsnow+1:nlevsoil) !< soil temperature (Kelvin) + real(kind_lake), intent(in) :: h2osoi_liq(1,-nlevsnow+1:nlevsoil) !< liquid water (kg/m2) + real(kind_lake), intent(in) :: h2osoi_ice(1,-nlevsnow+1:nlevsoil) !< ice lens (kg/m2) !out - real(kind_lake), intent(out) :: cv(lbc:ubc,-nlevsnow+1:nlevsoil) ! heat capacity [J/(m2 K)] - real(kind_lake), intent(out) :: tk(lbc:ubc,-nlevsnow+1:nlevsoil) ! thermal conductivity [W/(m K)] - real(kind_lake), intent(out) :: tktopsoillay(lbc:ubc) ! thermal conductivity [W/(m K)] + real(kind_lake), intent(out) :: cv(lbc:ubc,-nlevsnow+1:nlevsoil) !< heat capacity [J/(m2 K)] + real(kind_lake), intent(out) :: tk(lbc:ubc,-nlevsnow+1:nlevsoil) !< thermal conductivity [W/(m K)] + real(kind_lake), intent(out) :: tktopsoillay(lbc:ubc) !< thermal conductivity [W/(m K)] !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! !CALLED FROM: ! subroutine ShalLakeTemperature in this module. @@ -2754,6 +2852,24 @@ end subroutine SoilThermProp_Lake ! ROUTINE: PhaseChange_Lake ! ! !INTERFACE: + + ! DESCRIPTION: + !> Calculation of the phase change within snow, soil, & lake layers: + !!\n (1) Check the conditions for which the phase change may take place, + !! i.e., the layer temperature is greater than the freezing point + !! and the ice mass is not equal to zero (i.e. melting), + !! or the layer temperature is less than the freezing point + !! and the liquid water mass is greater than the allowable supercooled + !! (i.e. freezing). + !!\n (2) Assess the amount of phase change from the energy excess (or deficit) + !! after setting the layer temperature to freezing point, depending on + !! how much water or ice is available. + !!\n (3) Re-adjust the ice and liquid mass, and the layer temperature: either to + !! the freezing point if enough water or ice is available to fully compensate, + !! or to a remaining temperature. + !! + !! The specific heats are assumed constant. Potential cycling errors resulting from + !! this assumption will be trapped at the end of ShalLakeTemperature. subroutine PhaseChange_Lake (snl,h2osno,dz,dz_lake, & !i t_soisno,h2osoi_liq,h2osoi_ice, & !i&o lake_icefrac,t_lake, snowdp, & !i&o @@ -2761,28 +2877,12 @@ subroutine PhaseChange_Lake (snl,h2osno,dz,dz_lake, & !i cv, cv_lake, & !i&o lhabs) !o !============================================================================================= - ! !DESCRIPTION: - ! Calculation of the phase change within snow, soil, & lake layers: - ! (1) Check the conditions for which the phase change may take place, - ! i.e., the layer temperature is great than the freezing point - ! and the ice mass is not equal to zero (i.e. melting), - ! or the layer temperature is less than the freezing point - ! and the liquid water mass is greater than the allowable supercooled - ! (i.e. freezing). - ! (2) Assess the amount of phase change from the energy excess (or deficit) - ! after setting the layer temperature to freezing point, depending on - ! how much water or ice is available. - ! (3) Re-adjust the ice and liquid mass, and the layer temperature: either to - ! the freezing point if enough water or ice is available to fully compensate, - ! or to a remaining temperature. - ! The specific heats are assumed constant. Potential cycling errors resulting from - ! this assumption will be trapped at the end of ShalLakeTemperature. - ! !CALLED FROM: + !CALLED FROM: ! subroutine ShalLakeTemperature in this module ! - ! !REVISION HISTORY: - ! 04/2009 Zack Subin: Initial code - ! June 2022 Sam Trahan: Modified for CCPP + !REVISION HISTORY: + ! - 04/2009 Zack Subin: Initial code + ! - June 2022 Sam Trahan: Modified for CCPP !============================================================================================== ! !USES: ! @@ -2790,29 +2890,29 @@ subroutine PhaseChange_Lake (snl,h2osno,dz,dz_lake, & !i implicit none !in: - integer , intent(in) :: snl(1) !number of snow layers - real(kind_lake), intent(inout) :: h2osno(1) !snow water (mm H2O) - real(kind_lake), intent(in) :: dz(1,-nlevsnow+1:nlevsoil) !layer thickness (m) - real(kind_lake), intent(in) :: dz_lake(1,nlevlake) !lake layer thickness (m) + integer , intent(in) :: snl(1) !< number of snow layers + real(kind_lake), intent(inout) :: h2osno(1) !< snow water (mm H2O) + real(kind_lake), intent(in) :: dz(1,-nlevsnow+1:nlevsoil) !< layer thickness (m) + real(kind_lake), intent(in) :: dz_lake(1,nlevlake) !< lake layer thickness (m) ! Needed in case snow height is less than critical value. !inout: - real(kind_lake), intent(inout) :: snowdp(1) !snow height (m) - real(kind_lake), intent(inout) :: t_soisno(1,-nlevsnow+1:nlevsoil) !soil temperature (Kelvin) - real(kind_lake), intent(inout) :: h2osoi_liq(1,-nlevsnow+1:nlevsoil) !liquid water (kg/m2) - real(kind_lake), intent(inout) :: h2osoi_ice(1,-nlevsnow+1:nlevsoil) !ice lens (kg/m2) - real(kind_lake), intent(inout) :: lake_icefrac(1,nlevlake) ! mass fraction of lake layer that is frozen - real(kind_lake), intent(inout) :: t_lake(1,nlevlake) ! lake temperature (Kelvin) + real(kind_lake), intent(inout) :: snowdp(1) !< snow height (m) + real(kind_lake), intent(inout) :: t_soisno(1,-nlevsnow+1:nlevsoil) !< soil temperature (Kelvin) + real(kind_lake), intent(inout) :: h2osoi_liq(1,-nlevsnow+1:nlevsoil) !< liquid water (kg/m2) + real(kind_lake), intent(inout) :: h2osoi_ice(1,-nlevsnow+1:nlevsoil) !< ice lens (kg/m2) + real(kind_lake), intent(inout) :: lake_icefrac(1,nlevlake) !< mass fraction of lake layer that is frozen + real(kind_lake), intent(inout) :: t_lake(1,nlevlake) !< lake temperature (Kelvin) !out: - real(kind_lake), intent(out) :: qflx_snomelt(1) !snow melt (mm H2O /s) - real(kind_lake), intent(out) :: eflx_snomelt(1) !snow melt heat flux (W/m**2) - integer, intent(out) :: imelt(1,-nlevsnow+1:nlevsoil) !flag for melting (=1), freezing (=2), Not=0 (new) + real(kind_lake), intent(out) :: qflx_snomelt(1) !< snow melt (mm H2O /s) + real(kind_lake), intent(out) :: eflx_snomelt(1) !< snow melt heat flux (W/m**2) + integer, intent(out) :: imelt(1,-nlevsnow+1:nlevsoil) !< flag for melting (=1), freezing (=2), Not=0 (new) !What's the sign of this? Is it just output? - real(kind_lake), intent(inout) :: cv(lbc:ubc,-nlevsnow+1:nlevsoil) ! heat capacity [J/(m2 K)] - real(kind_lake), intent(inout) :: cv_lake (lbc:ubc,1:nlevlake) ! heat capacity [J/(m2 K)] - real(kind_lake), intent(out):: lhabs(lbc:ubc) ! total per-column latent heat abs. (J/m^2) + real(kind_lake), intent(inout) :: cv(lbc:ubc,-nlevsnow+1:nlevsoil) !< heat capacity [J/(m2 K)] + real(kind_lake), intent(inout) :: cv_lake (lbc:ubc,1:nlevlake) !< heat capacity [J/(m2 K)] + real(kind_lake), intent(out):: lhabs(lbc:ubc) !< total per-column latent heat abs. (J/m^2) ! OTHER LOCAL VARIABLES: @@ -2972,7 +3072,19 @@ subroutine PhaseChange_Lake (snl,h2osno,dz,dz_lake, & !i end subroutine PhaseChange_Lake - + ! DESCRIPTION: + !> Calculation of Shallow Lake Hydrology. Full hydrology of snow layers is + !! done. However, there is no infiltration, and the water budget is balanced with + !! qflx_qrgwl. Lake water mass is kept constant. The soil is simply maintained at + !! volumetric saturation if ice melting frees up pore space. Likewise, if the water + !! portion alone at some point exceeds pore capacity, it is reduced. This is consistent + !! with the possibility of initializing the soil layer with excess ice. The only + !! real error with that is that the thermal conductivity will ignore the excess ice + !! (and accompanying thickness change). + !! + !! If snow layers are present over an unfrozen lake, and the top layer of the lake + !! is capable of absorbing the latent heat without going below freezing, + !! the snow-water is runoff and the latent heat is subtracted from the lake. subroutine ShalLakeHydrology(dz_lake,forc_rain,forc_snow, & !i begwb,qflx_evap_tot,forc_t,do_capsnow, & t_grnd,qflx_evap_soi, & @@ -2991,19 +3103,6 @@ subroutine ShalLakeHydrology(dz_lake,forc_rain,forc_snow, & dtime,errmsg,errflg) !================================================================================== - ! !DESCRIPTION: - ! Calculation of Shallow Lake Hydrology. Full hydrology of snow layers is - ! done. However, there is no infiltration, and the water budget is balanced with - ! qflx_qrgwl. Lake water mass is kept constant. The soil is simply maintained at - ! volumetric saturation if ice melting frees up pore space. Likewise, if the water - ! portion alone at some point exceeds pore capacity, it is reduced. This is consistent - ! with the possibility of initializing the soil layer with excess ice. The only - ! real error with that is that the thermal conductivity will ignore the excess ice - ! (and accompanying thickness change). - ! - ! If snow layers are present over an unfrozen lake, and the top layer of the lake - ! is capable of absorbing the latent heat without going below freezing, - ! the snow-water is runoff and the latent heat is subtracted from the lake. ! ! WARNING: This subroutine assumes lake columns have one and only one pft. ! @@ -3034,79 +3133,79 @@ subroutine ShalLakeHydrology(dz_lake,forc_rain,forc_snow, & integer, intent(inout) :: errflg character(*), intent(inout) :: errmsg - real(kind_lake) :: watsat(1,nlevsoil) ! volumetric soil water at saturation (porosity) - real(kind_lake) :: tksatu(1,nlevsoil) ! thermal conductivity, saturated soil [W/m-K] - real(kind_lake) :: tkmg(1,nlevsoil) ! thermal conductivity, soil minerals [W/m-K] - real(kind_lake) :: tkdry(1,nlevsoil) ! thermal conductivity, dry soil (W/m/Kelvin) - real(kind_lake) :: csol(1,nlevsoil) ! heat capacity, soil solids (J/m**3/Kelvin) - - ! integer , intent(in) :: clandunit(1) ! column's landunit - ! integer , intent(in) :: ityplun(1) ! landunit type - real(kind_lake), intent(in) :: dtime ! timestep - real(kind_lake), intent(in) :: dz_lake(1,nlevlake) ! layer thickness for lake (m) - real(kind_lake), intent(in) :: forc_rain(1) ! rain rate [mm/s] - real(kind_lake), intent(in) :: forc_snow(1) ! snow rate [mm/s] - real(kind_lake), intent(in) :: qflx_evap_tot(1) ! qflx_evap_soi + qflx_evap_veg + qflx_tran_veg - real(kind_lake), intent(in) :: forc_t(1) ! atmospheric temperature (Kelvin) - - !real(kind_lake), intent(in),optional :: flfall(1) ! fraction of liquid water within falling precipitation (unused) - - logical , intent(in) :: do_capsnow(1) ! true => do snow capping - real(kind_lake), intent(in) :: t_grnd(1) ! ground temperature (Kelvin) - real(kind_lake), intent(in) :: qflx_evap_soi(1) ! soil evaporation (mm H2O/s) (+ = to atm) - real(kind_lake), intent(in) :: qflx_snomelt(1) !snow melt (mm H2O /s) - integer, intent(in) :: imelt(1,-nlevsnow+1:nlevsoil) !flag for melting (=1), freezing (=2), Not=0 + real(kind_lake) :: watsat(1,nlevsoil) !< volumetric soil water at saturation (porosity) + real(kind_lake) :: tksatu(1,nlevsoil) !< thermal conductivity, saturated soil [W/m-K] + real(kind_lake) :: tkmg(1,nlevsoil) !< thermal conductivity, soil minerals [W/m-K] + real(kind_lake) :: tkdry(1,nlevsoil) !< thermal conductivity, dry soil (W/m/Kelvin) + real(kind_lake) :: csol(1,nlevsoil) !< heat capacity, soil solids (J/m**3/Kelvin) + + ! integer , intent(in) :: clandunit(1) !< column's landunit + ! integer , intent(in) :: ityplun(1) !< landunit type + real(kind_lake), intent(in) :: dtime !< timestep + real(kind_lake), intent(in) :: dz_lake(1,nlevlake) !< layer thickness for lake (m) + real(kind_lake), intent(in) :: forc_rain(1) !< rain rate [mm/s] + real(kind_lake), intent(in) :: forc_snow(1) !< snow rate [mm/s] + real(kind_lake), intent(in) :: qflx_evap_tot(1) !< qflx_evap_soi + qflx_evap_veg + qflx_tran_veg + real(kind_lake), intent(in) :: forc_t(1) !< atmospheric temperature (Kelvin) + + !real(kind_lake), intent(in),optional :: flfall(1) !< fraction of liquid water within falling precipitation (unused) + + logical , intent(in) :: do_capsnow(1) !< true => do snow capping + real(kind_lake), intent(in) :: t_grnd(1) !< ground temperature (Kelvin) + real(kind_lake), intent(in) :: qflx_evap_soi(1) !< soil evaporation (mm H2O/s) (+ = to atm) + real(kind_lake), intent(in) :: qflx_snomelt(1) !< snow melt (mm H2O /s) + integer, intent(in) :: imelt(1,-nlevsnow+1:nlevsoil) !< flag for melting (=1), freezing (=2), Not=0 !inout: - real(kind_lake), intent(inout) :: begwb(1) ! water mass begining of the time step + real(kind_lake), intent(inout) :: begwb(1) !< water mass begining of the time step ! inout: - real(kind_lake), intent(inout) :: z(1,-nlevsnow+1:nlevsoil) ! layer depth (m) - real(kind_lake), intent(inout) :: dz(1,-nlevsnow+1:nlevsoil) ! layer thickness depth (m) - real(kind_lake), intent(inout) :: zi(1,-nlevsnow+0:nlevsoil) ! interface depth (m) - integer , intent(inout) :: snl(1) ! number of snow layers - real(kind_lake), intent(inout) :: h2osno(1) ! snow water (mm H2O) - real(kind_lake), intent(inout) :: snowdp(1) ! snow height (m) - real(kind_lake), intent(inout) :: lake_icefrac(1,nlevlake) ! mass fraction of lake layer that is frozen - real(kind_lake), intent(inout) :: t_lake(1,nlevlake) ! lake temperature (Kelvin) - - real(kind_lake), intent(inout) :: frac_iceold(1,-nlevsnow+1:nlevsoil) ! fraction of ice relative to the tot water + real(kind_lake), intent(inout) :: z(1,-nlevsnow+1:nlevsoil) !< layer depth (m) + real(kind_lake), intent(inout) :: dz(1,-nlevsnow+1:nlevsoil) !< layer thickness depth (m) + real(kind_lake), intent(inout) :: zi(1,-nlevsnow+0:nlevsoil) !< interface depth (m) + integer , intent(inout) :: snl(1) !< number of snow layers + real(kind_lake), intent(inout) :: h2osno(1) !< snow water (mm H2O) + real(kind_lake), intent(inout) :: snowdp(1) !< snow height (m) + real(kind_lake), intent(inout) :: lake_icefrac(1,nlevlake) !< mass fraction of lake layer that is frozen + real(kind_lake), intent(inout) :: t_lake(1,nlevlake) !< lake temperature (Kelvin) + + real(kind_lake), intent(inout) :: frac_iceold(1,-nlevsnow+1:nlevsoil) !< fraction of ice relative to the tot water ! out: - real(kind_lake), intent(out) :: endwb(1) ! water mass end of the time step - real(kind_lake), intent(out) :: snowage(1) ! non dimensional snow age [-] - real(kind_lake), intent(out) :: snowice(1) ! average snow ice lens - real(kind_lake), intent(out) :: snowliq(1) ! average snow liquid water - real(kind_lake), intent(out) :: t_snow(1) ! vertically averaged snow temperature - real(kind_lake), intent(out) :: t_soisno(1,-nlevsnow+1:nlevsoil) ! snow temperature (Kelvin) - real(kind_lake), intent(out) :: h2osoi_ice(1,-nlevsnow+1:nlevsoil) ! ice lens (kg/m2) - real(kind_lake), intent(out) :: h2osoi_liq(1,-nlevsnow+1:nlevsoil) ! liquid water (kg/m2) - real(kind_lake), intent(out) :: h2osoi_vol(1,-nlevsnow+1:nlevsoil) ! volumetric soil water (0<=h2osoi_vol<=watsat)[m3/m3] - real(kind_lake), intent(out) :: qflx_drain(1) ! sub-surface runoff (mm H2O /s) - real(kind_lake), intent(out) :: qflx_surf(1) ! surface runoff (mm H2O /s) - real(kind_lake), intent(out) :: qflx_infl(1) ! infiltration (mm H2O /s) - real(kind_lake), intent(out) :: qflx_qrgwl(1) ! qflx_surf at glaciers, wetlands, lakes - real(kind_lake), intent(out) :: qcharge(1) ! aquifer recharge rate (mm/s) - real(kind_lake), intent(out) :: qflx_prec_grnd(1) ! water onto ground including canopy runoff [kg/(m2 s)] - real(kind_lake), intent(out) :: qflx_snowcap(1) ! excess precipitation due to snow capping (mm H2O /s) [+] - real(kind_lake), intent(out) :: qflx_snowcap_col(1) ! excess precipitation due to snow capping (mm H2O /s) [+] - real(kind_lake), intent(out) :: qflx_snow_grnd_pft(1) ! snow on ground after interception (mm H2O/s) [+] - real(kind_lake), intent(out) :: qflx_snow_grnd_col(1) ! snow on ground after interception (mm H2O/s) [+] - real(kind_lake), intent(out) :: qflx_rain_grnd(1) ! rain on ground after interception (mm H2O/s) [+] - real(kind_lake), intent(out) :: qflx_evap_tot_col(1) !pft quantity averaged to the column (assuming one pft) - real(kind_lake) ,intent(out) :: soilalpha(1) !factor that reduces ground saturated specific humidity (-) - real(kind_lake), intent(out) :: zwt(1) !water table depth - real(kind_lake), intent(out) :: fcov(1) !fractional area with water table at surface - real(kind_lake), intent(out) :: rootr_column(1,1:nlevsoil) !effective fraction of roots in each soil layer - real(kind_lake), intent(out) :: qflx_evap_grnd(1) ! ground surface evaporation rate (mm H2O/s) [+] - real(kind_lake), intent(out) :: qflx_sub_snow(1) ! sublimation rate from snow pack (mm H2O /s) [+] - real(kind_lake), intent(out) :: qflx_dew_snow(1) ! surface dew added to snow pack (mm H2O /s) [+] - real(kind_lake), intent(out) :: qflx_dew_grnd(1) ! ground surface dew formation (mm H2O /s) [+] - real(kind_lake), intent(out) :: qflx_rain_grnd_col(1) !rain on ground after interception (mm H2O/s) [+] + real(kind_lake), intent(out) :: endwb(1) !< water mass end of the time step + real(kind_lake), intent(out) :: snowage(1) !< non dimensional snow age [-] + real(kind_lake), intent(out) :: snowice(1) !< average snow ice lens + real(kind_lake), intent(out) :: snowliq(1) !< average snow liquid water + real(kind_lake), intent(out) :: t_snow(1) !< vertically averaged snow temperature + real(kind_lake), intent(out) :: t_soisno(1,-nlevsnow+1:nlevsoil) !< snow temperature (Kelvin) + real(kind_lake), intent(out) :: h2osoi_ice(1,-nlevsnow+1:nlevsoil) !< ice lens (kg/m2) + real(kind_lake), intent(out) :: h2osoi_liq(1,-nlevsnow+1:nlevsoil) !< liquid water (kg/m2) + real(kind_lake), intent(out) :: h2osoi_vol(1,-nlevsnow+1:nlevsoil) !< volumetric soil water (0<=h2osoi_vol<=watsat)[m3/m3] + real(kind_lake), intent(out) :: qflx_drain(1) !< sub-surface runoff (mm H2O /s) + real(kind_lake), intent(out) :: qflx_surf(1) !< surface runoff (mm H2O /s) + real(kind_lake), intent(out) :: qflx_infl(1) !< infiltration (mm H2O /s) + real(kind_lake), intent(out) :: qflx_qrgwl(1) !< qflx_surf at glaciers, wetlands, lakes + real(kind_lake), intent(out) :: qcharge(1) !< aquifer recharge rate (mm/s) + real(kind_lake), intent(out) :: qflx_prec_grnd(1) !< water onto ground including canopy runoff [kg/(m2 s)] + real(kind_lake), intent(out) :: qflx_snowcap(1) !< excess precipitation due to snow capping (mm H2O /s) [+] + real(kind_lake), intent(out) :: qflx_snowcap_col(1) !< excess precipitation due to snow capping (mm H2O /s) [+] + real(kind_lake), intent(out) :: qflx_snow_grnd_pft(1) !< snow on ground after interception (mm H2O/s) [+] + real(kind_lake), intent(out) :: qflx_snow_grnd_col(1) !< snow on ground after interception (mm H2O/s) [+] + real(kind_lake), intent(out) :: qflx_rain_grnd(1) !< rain on ground after interception (mm H2O/s) [+] + real(kind_lake), intent(out) :: qflx_evap_tot_col(1) !< pft quantity averaged to the column (assuming one pft) + real(kind_lake) ,intent(out) :: soilalpha(1) !< factor that reduces ground saturated specific humidity (-) + real(kind_lake), intent(out) :: zwt(1) !< water table depth + real(kind_lake), intent(out) :: fcov(1) !< fractional area with water table at surface + real(kind_lake), intent(out) :: rootr_column(1,1:nlevsoil) !< effective fraction of roots in each soil layer + real(kind_lake), intent(out) :: qflx_evap_grnd(1) !< ground surface evaporation rate (mm H2O/s) [+] + real(kind_lake), intent(out) :: qflx_sub_snow(1) !< sublimation rate from snow pack (mm H2O /s) [+] + real(kind_lake), intent(out) :: qflx_dew_snow(1) !< surface dew added to snow pack (mm H2O /s) [+] + real(kind_lake), intent(out) :: qflx_dew_grnd(1) !< ground surface dew formation (mm H2O /s) [+] + real(kind_lake), intent(out) :: qflx_rain_grnd_col(1) !< rain on ground after interception (mm H2O/s) [+] ! Block of biogeochem currently not used. real(kind_lake), pointer :: sucsat(:,:) ! minimum soil suction (mm) @@ -3483,7 +3582,7 @@ subroutine ShalLakeHydrology(dz_lake,forc_rain,forc_snow, & h2osno(c) = 0._kind_lake snl(c) = 0 ! The rest of the bookkeeping for the removed snow will be done below. - if (LAKEDEBUG) then + if (debug_print) then print *,'Snow layers removed above unfrozen lake for column, snowice:', & c, sumsnowice(c) endif @@ -3633,7 +3732,7 @@ subroutine ShalLakeHydrology(dz_lake,forc_rain,forc_snow, & ! Insure water balance using qflx_qrgwl qflx_qrgwl(c) = forc_rain(g) + forc_snow(g) - qflx_evap_tot(p) - (endwb(c)-begwb(c))/dtime - if (LAKEDEBUG) then + if (debug_print) then print *,'c, rain, snow, evap, endwb, begwb, qflx_qrgwl:', & c, forc_rain(g), forc_snow(g), qflx_evap_tot(p), endwb(c), begwb(c), qflx_qrgwl(c) endif @@ -3644,25 +3743,25 @@ subroutine ShalLakeHydrology(dz_lake,forc_rain,forc_snow, & end subroutine ShalLakeHydrology +! DESCRIPTION: +!> Computes saturation mixing ratio and the change in saturation +!! mixing ratio with respect to temperature. subroutine QSat (T, p, es, esdT, qs, qsdT) ! - ! !DESCRIPTION: - ! Computes saturation mixing ratio and the change in saturation - ! mixing ratio with respect to temperature. ! Reference: Polynomial approximations from: ! Piotr J. Flatau, et al.,1992: Polynomial fits to saturation ! vapor pressure. Journal of Applied Meteorology, 31, 1507-1513. ! - ! !USES: + ! USES: ! - ! !ARGUMENTS: + ! ARGUMENTS: implicit none - real(kind_lake), intent(in) :: T ! temperature (K) - real(kind_lake), intent(in) :: p ! surface atmospheric pressure (pa) - real(kind_lake), intent(out) :: es ! vapor pressure (pa) - real(kind_lake), intent(out) :: esdT ! d(es)/d(T) - real(kind_lake), intent(out) :: qs ! humidity (kg/kg) - real(kind_lake), intent(out) :: qsdT ! d(qs)/d(T) + real(kind_lake), intent(in) :: T !< temperature (K) + real(kind_lake), intent(in) :: p !< surface atmospheric pressure (pa) + real(kind_lake), intent(out) :: es !< vapor pressure (pa) + real(kind_lake), intent(out) :: esdT !< d(es)/d(T) + real(kind_lake), intent(out) :: qs !< humidity (kg/kg) + real(kind_lake), intent(out) :: qsdT !< d(qs)/d(T) ! ! !CALLED FROM: ! subroutine Biogeophysics1 in module Biogeophysics1Mod @@ -3762,21 +3861,21 @@ end subroutine QSat subroutine Tridiagonal (lbc, ubc, lbj, ubj, jtop, numf, filter, & a, b, c, r, u) ! - ! !DESCRIPTION: - ! Tridiagonal matrix solution + ! DESCRIPTION: + !< Tridiagonal matrix solution ! - ! !ARGUMENTS: + ! ARGUMENTS: implicit none - integer , intent(in) :: lbc, ubc ! lbinning and ubing column indices - integer , intent(in) :: lbj, ubj ! lbinning and ubing level indices - integer , intent(in) :: jtop(lbc:ubc) ! top level for each column - integer , intent(in) :: numf ! filter dimension - integer , intent(in) :: filter(1:numf) ! filter - real(kind_lake), intent(in) :: a(lbc:ubc, lbj:ubj) ! "a" left off diagonal of tridiagonal matrix - real(kind_lake), intent(in) :: b(lbc:ubc, lbj:ubj) ! "b" diagonal column for tridiagonal matrix - real(kind_lake), intent(in) :: c(lbc:ubc, lbj:ubj) ! "c" right off diagonal tridiagonal matrix - real(kind_lake), intent(in) :: r(lbc:ubc, lbj:ubj) ! "r" forcing term of tridiagonal matrix - real(kind_lake), intent(inout) :: u(lbc:ubc, lbj:ubj) ! solution + integer , intent(in) :: lbc, ubc !< lbinning and ubing column indices + integer , intent(in) :: lbj, ubj !< lbinning and ubing level indices + integer , intent(in) :: jtop(lbc:ubc) !< top level for each column + integer , intent(in) :: numf !< filter dimension + integer , intent(in) :: filter(1:numf) !< filter + real(kind_lake), intent(in) :: a(lbc:ubc, lbj:ubj) !< "a" left off diagonal of tridiagonal matrix + real(kind_lake), intent(in) :: b(lbc:ubc, lbj:ubj) !< "b" diagonal column for tridiagonal matrix + real(kind_lake), intent(in) :: c(lbc:ubc, lbj:ubj) !< "c" right off diagonal tridiagonal matrix + real(kind_lake), intent(in) :: r(lbc:ubc, lbj:ubj) !< "r" forcing term of tridiagonal matrix + real(kind_lake), intent(inout) :: u(lbc:ubc, lbj:ubj) !< solution ! ! !CALLED FROM: ! subroutine BiogeophysicsLake in module BiogeophysicsLakeMod @@ -3841,6 +3940,17 @@ subroutine Tridiagonal (lbc, ubc, lbj, ubj, jtop, numf, filter, & end subroutine Tridiagonal + ! DESCRIPTION: + !> Evaluate the change of snow mass and the snow water onto soil. + !! Water flow within snow is computed by an explicit and non-physical + !! based scheme, which permits a part of liquid water over the holding + !! capacity (a tentative value is used, i.e. equal to 0.033*porosity) to + !! percolate into the underlying layer. Except for cases where the + !! porosity of one of the two neighboring layers is less than 0.05, zero + !! flow is assumed. The water flow out of the bottom of the snow pack will + !! participate as the input of the soil water and runoff. This subroutine + !! uses a filter for columns containing snow which must be constructed prior + !! to being called. subroutine SnowWater(lbc, ubc, num_snowc, filter_snowc, & !i num_nosnowc, filter_nosnowc, & !i snl,do_capsnow,qflx_snomelt,qflx_rain_grnd, & !i @@ -3849,18 +3959,6 @@ subroutine SnowWater(lbc, ubc, num_snowc, filter_snowc, & !i h2osoi_ice,h2osoi_liq, & !i&o qflx_top_soil) !o !=============================================================================== - ! !DESCRIPTION: - ! Evaluate the change of snow mass and the snow water onto soil. - ! Water flow within snow is computed by an explicit and non-physical - ! based scheme, which permits a part of liquid water over the holding - ! capacity (a tentative value is used, i.e. equal to 0.033*porosity) to - ! percolate into the underlying layer. Except for cases where the - ! porosity of one of the two neighboring layers is less than 0.05, zero - ! flow is assumed. The water flow out of the bottom of the snow pack will - ! participate as the input of the soil water and runoff. This subroutine - ! uses a filter for columns containing snow which must be constructed prior - ! to being called. - ! ! !REVISION HISTORY: ! 15 September 1999: Yongjiu Dai; Initial code ! 15 December 1999: Paul Houser and Jon Radakovich; F90 Revision @@ -3873,32 +3971,32 @@ subroutine SnowWater(lbc, ubc, num_snowc, filter_snowc, & !i implicit none !in: - integer, intent(in) :: lbc, ubc ! column bounds - integer, intent(in) :: num_snowc ! number of snow points in column filter - integer, intent(in) :: filter_snowc(ubc-lbc+1) ! column filter for snow points - integer, intent(in) :: num_nosnowc ! number of non-snow points in column filter - integer, intent(in) :: filter_nosnowc(ubc-lbc+1) ! column filter for non-snow points - - integer , intent(in) :: snl(1) !number of snow layers - logical , intent(in) :: do_capsnow(1) !true => do snow capping - real(kind_lake), intent(in) :: dtime !timestep - real(kind_lake), intent(in) :: qflx_snomelt(1) !snow melt (mm H2O /s) - real(kind_lake), intent(in) :: qflx_rain_grnd(1) !rain on ground after interception (mm H2O/s) [+] - real(kind_lake), intent(in) :: qflx_sub_snow(1) !sublimation rate from snow pack (mm H2O /s) [+] - real(kind_lake), intent(in) :: qflx_evap_grnd(1) !ground surface evaporation rate (mm H2O/s) [+] - real(kind_lake), intent(in) :: qflx_dew_snow(1) !surface dew added to snow pack (mm H2O /s) [+] - real(kind_lake), intent(in) :: qflx_dew_grnd(1) !ground surface dew formation (mm H2O /s) [+] - real(kind_lake), intent(in) :: dz(1,-nlevsnow+1:nlevsoil) !layer depth (m) + integer, intent(in) :: lbc, ubc !< column bounds + integer, intent(in) :: num_snowc !< number of snow points in column filter + integer, intent(in) :: filter_snowc(ubc-lbc+1) !< column filter for snow points + integer, intent(in) :: num_nosnowc !< number of non-snow points in column filter + integer, intent(in) :: filter_nosnowc(ubc-lbc+1) !< column filter for non-snow points + + integer , intent(in) :: snl(1) !< number of snow layers + logical , intent(in) :: do_capsnow(1) !< true => do snow capping + real(kind_lake), intent(in) :: dtime !< timestep + real(kind_lake), intent(in) :: qflx_snomelt(1) !< snow melt (mm H2O /s) + real(kind_lake), intent(in) :: qflx_rain_grnd(1) !< rain on ground after interception (mm H2O/s) [+] + real(kind_lake), intent(in) :: qflx_sub_snow(1) !< sublimation rate from snow pack (mm H2O /s) [+] + real(kind_lake), intent(in) :: qflx_evap_grnd(1) !< ground surface evaporation rate (mm H2O/s) [+] + real(kind_lake), intent(in) :: qflx_dew_snow(1) !< surface dew added to snow pack (mm H2O /s) [+] + real(kind_lake), intent(in) :: qflx_dew_grnd(1) !< ground surface dew formation (mm H2O /s) [+] + real(kind_lake), intent(in) :: dz(1,-nlevsnow+1:nlevsoil) !< layer depth (m) !inout: - real(kind_lake), intent(inout) :: h2osoi_ice(1,-nlevsnow+1:nlevsoil) !ice lens (kg/m2) - real(kind_lake), intent(inout) :: h2osoi_liq(1,-nlevsnow+1:nlevsoil) !liquid water (kg/m2) + real(kind_lake), intent(inout) :: h2osoi_ice(1,-nlevsnow+1:nlevsoil) !< ice lens (kg/m2) + real(kind_lake), intent(inout) :: h2osoi_liq(1,-nlevsnow+1:nlevsoil) !< liquid water (kg/m2) !out: - real(kind_lake), intent(out) :: qflx_top_soil(1) !net water input into soil from top (mm/s) + real(kind_lake), intent(out) :: qflx_top_soil(1) !< net water input into soil from top (mm/s) ! OTHER LOCAL VARIABLES: @@ -4006,6 +4104,13 @@ subroutine SnowWater(lbc, ubc, num_snowc, filter_snowc, & !i end subroutine SnowWater +!> Determine the change in snow layer thickness due to compaction and +!! settling. +!! Three metamorphisms of changing snow characteristics are implemented, +!! i.e., destructive, overburden, and melt. The treatments of the former +!! two are from SNTHERM.89 and SNTHERM.99 (1991, 1999). The contribution +!! due to melt metamorphism is simply taken as a ratio of snow ice +!! fraction after the melting versus before the melting. subroutine SnowCompaction(lbc, ubc, num_snowc, filter_snowc, &!i snl,imelt,frac_iceold,t_soisno, &!i h2osoi_ice,h2osoi_liq,dtime, &!i @@ -4013,15 +4118,6 @@ subroutine SnowCompaction(lbc, ubc, num_snowc, filter_snowc, &!i !================================================================================ - ! !DESCRIPTION: - ! Determine the change in snow layer thickness due to compaction and - ! settling. - ! Three metamorphisms of changing snow characteristics are implemented, - ! i.e., destructive, overburden, and melt. The treatments of the former - ! two are from SNTHERM.89 and SNTHERM.99 (1991, 1999). The contribution - ! due to melt metamorphism is simply taken as a ratio of snow ice - ! fraction after the melting versus before the melting. - ! ! CALLED FROM: ! subroutine Hydrology2 in module Hydrology2Mod ! @@ -4037,20 +4133,20 @@ subroutine SnowCompaction(lbc, ubc, num_snowc, filter_snowc, &!i implicit none !in: - integer, intent(in) :: lbc, ubc ! column bounds - integer, intent(in) :: num_snowc ! number of column snow points in column filter - integer, intent(in) :: filter_snowc(ubc-lbc+1) ! column filter for snow points - integer, intent(in) :: snl(1) !number of snow layers - integer, intent(in) :: imelt(1,-nlevsnow+1:nlevsoil) !flag for melting (=1), freezing (=2), Not=0 - real(kind_lake), intent(in) :: dtime - real(kind_lake), intent(in) :: frac_iceold(1,-nlevsnow+1:nlevsoil) !fraction of ice relative to the tot water - real(kind_lake), intent(in) :: t_soisno(1,-nlevsnow+1:nlevsoil) !soil temperature (Kelvin) - real(kind_lake), intent(in) :: h2osoi_ice(1,-nlevsnow+1:nlevsoil) !ice lens (kg/m2) - real(kind_lake), intent(in) :: h2osoi_liq(1,-nlevsnow+1:nlevsoil) !liquid water (kg/m2) + integer, intent(in) :: lbc, ubc !< column bounds + integer, intent(in) :: num_snowc !< number of column snow points in column filter + integer, intent(in) :: filter_snowc(ubc-lbc+1) !< column filter for snow points + integer, intent(in) :: snl(1) !< number of snow layers + integer, intent(in) :: imelt(1,-nlevsnow+1:nlevsoil) !< flag for melting (=1), freezing (=2), Not=0 + real(kind_lake), intent(in) :: dtime !< + real(kind_lake), intent(in) :: frac_iceold(1,-nlevsnow+1:nlevsoil) !< fraction of ice relative to the tot water + real(kind_lake), intent(in) :: t_soisno(1,-nlevsnow+1:nlevsoil) !< soil temperature (Kelvin) + real(kind_lake), intent(in) :: h2osoi_ice(1,-nlevsnow+1:nlevsoil) !< ice lens (kg/m2) + real(kind_lake), intent(in) :: h2osoi_liq(1,-nlevsnow+1:nlevsoil) !< liquid water (kg/m2) !inout: - real(kind_lake), intent(inout) :: dz(1,-nlevsnow+1:nlevsoil) !layer depth (m) + real(kind_lake), intent(inout) :: dz(1,-nlevsnow+1:nlevsoil) !< layer depth (m) ! OTHER LOCAL VARIABLES: @@ -4137,21 +4233,24 @@ subroutine SnowCompaction(lbc, ubc, num_snowc, filter_snowc, &!i end subroutine SnowCompaction +!> Combine snow layers that are less than a minimum thickness or mass +!! If the snow element thickness or mass is less than a prescribed minimum, +!! then it is combined with a neighboring element. subroutine CombineSnowLayers(lbc, ubc, & !i num_snowc, filter_snowc, & !i&o snl,h2osno,snowdp,dz,zi, & !i&o t_soisno,h2osoi_ice,h2osoi_liq, & !i&o z) !o !========================================================================== - ! !DESCRIPTION: + ! DESCRIPTION: ! Combine snow layers that are less than a minimum thickness or mass ! If the snow element thickness or mass is less than a prescribed minimum, ! then it is combined with a neighboring element. The subroutine ! clm\_combo.f90 then executes the combination of mass and energy. - ! !CALLED FROM: + ! CALLED FROM: ! subroutine Hydrology2 in module Hydrology2Mod ! - ! !REVISION HISTORY: + ! REVISION HISTORY: ! 15 September 1999: Yongjiu Dai; Initial code ! 15 December 1999: Paul Houser and Jon Radakovich; F90 Revision ! 2/28/02, Peter Thornton: Migrated to new data structures. @@ -4162,25 +4261,25 @@ subroutine CombineSnowLayers(lbc, ubc, & !i ! !ARGUMENTS: implicit none !in: - integer, intent(in) :: lbc, ubc ! column bounds + integer, intent(in) :: lbc, ubc !< column bounds ! integer, intent(in) :: clandunit(1) !landunit index for each column ! integer, intent(in) :: ityplun(1) !landunit type !inout: - integer, intent(inout) :: num_snowc ! number of column snow points in column filter - integer, intent(inout) :: filter_snowc(ubc-lbc+1) ! column filter for snow points - integer , intent(inout) :: snl(1) !number of snow layers - real(kind_lake), intent(inout) :: h2osno(1) !snow water (mm H2O) - real(kind_lake), intent(inout) :: snowdp(1) !snow height (m) - real(kind_lake), intent(inout) :: dz(1,-nlevsnow+1:nlevsoil) !layer depth (m) - real(kind_lake), intent(inout) :: zi(1,-nlevsnow+0:nlevsoil) !interface level below a "z" level (m) - real(kind_lake), intent(inout) :: t_soisno(1,-nlevsnow+1:nlevsoil) !soil temperature (Kelvin) - real(kind_lake), intent(inout) :: h2osoi_ice(1,-nlevsnow+1:nlevsoil) !ice lens (kg/m2) - real(kind_lake), intent(inout) :: h2osoi_liq(1,-nlevsnow+1:nlevsoil) !liquid water (kg/m2) + integer, intent(inout) :: num_snowc !< number of column snow points in column filter + integer, intent(inout) :: filter_snowc(ubc-lbc+1) !< column filter for snow points + integer , intent(inout) :: snl(1) !< number of snow layers + real(kind_lake), intent(inout) :: h2osno(1) !< snow water (mm H2O) + real(kind_lake), intent(inout) :: snowdp(1) !< snow height (m) + real(kind_lake), intent(inout) :: dz(1,-nlevsnow+1:nlevsoil) !< layer depth (m) + real(kind_lake), intent(inout) :: zi(1,-nlevsnow+0:nlevsoil) !< interface level below a "z" level (m) + real(kind_lake), intent(inout) :: t_soisno(1,-nlevsnow+1:nlevsoil) !< soil temperature (Kelvin) + real(kind_lake), intent(inout) :: h2osoi_ice(1,-nlevsnow+1:nlevsoil) !< ice lens (kg/m2) + real(kind_lake), intent(inout) :: h2osoi_liq(1,-nlevsnow+1:nlevsoil) !< liquid water (kg/m2) !out: - real(kind_lake), intent(out) :: z(1,-nlevsnow+1:nlevsoil) !layer thickness (m) + real(kind_lake), intent(out) :: z(1,-nlevsnow+1:nlevsoil) !< layer thickness (m) ! !EOP ! @@ -4359,6 +4458,8 @@ subroutine CombineSnowLayers(lbc, ubc, & !i end subroutine CombineSnowLayers +! DESCRIPTION: +!> Subdivides snow layers if they exceed their prescribed maximum thickness. subroutine DivideSnowLayers(lbc, ubc, & !i num_snowc, filter_snowc, & !i&o snl,dz,zi,t_soisno, & !i&o @@ -4367,8 +4468,6 @@ subroutine DivideSnowLayers(lbc, ubc, & !i !============================================================================ - ! !DESCRIPTION: - ! Subdivides snow layers if they exceed their prescribed maximum thickness. ! !CALLED FROM: ! subroutine Hydrology2 in module Hydrology2Mod ! @@ -4384,22 +4483,22 @@ subroutine DivideSnowLayers(lbc, ubc, & !i implicit none !in: - integer, intent(in) :: lbc, ubc ! column bounds + integer, intent(in) :: lbc, ubc !< column bounds !inout: - integer, intent(inout) :: num_snowc ! number of column snow points in column filter - integer, intent(inout) :: filter_snowc(ubc-lbc+1) ! column filter for snow points - integer , intent(inout) :: snl(1) !number of snow layers - real(kind_lake), intent(inout) :: dz(1,-nlevsnow+1:nlevsoil) !layer depth (m) - real(kind_lake), intent(inout) :: zi(1,-nlevsnow+0:nlevsoil) !interface level below a "z" level (m) - real(kind_lake), intent(inout) :: t_soisno(1,-nlevsnow+1:nlevsoil) !soil temperature (Kelvin) - real(kind_lake), intent(inout) :: h2osoi_ice(1,-nlevsnow+1:nlevsoil) !ice lens (kg/m2) - real(kind_lake), intent(inout) :: h2osoi_liq(1,-nlevsnow+1:nlevsoil) !liquid water (kg/m2) + integer, intent(inout) :: num_snowc !< number of column snow points in column filter + integer, intent(inout) :: filter_snowc(ubc-lbc+1) !< column filter for snow points + integer , intent(inout) :: snl(1) !< number of snow layers + real(kind_lake), intent(inout) :: dz(1,-nlevsnow+1:nlevsoil) !< layer depth (m) + real(kind_lake), intent(inout) :: zi(1,-nlevsnow+0:nlevsoil) !< interface level below a "z" level (m) + real(kind_lake), intent(inout) :: t_soisno(1,-nlevsnow+1:nlevsoil) !< soil temperature (Kelvin) + real(kind_lake), intent(inout) :: h2osoi_ice(1,-nlevsnow+1:nlevsoil) !< ice lens (kg/m2) + real(kind_lake), intent(inout) :: h2osoi_liq(1,-nlevsnow+1:nlevsoil) !< liquid water (kg/m2) !out: - real(kind_lake), intent(out) :: z(1,-nlevsnow+1:nlevsoil) !layer thickness (m) + real(kind_lake), intent(out) :: z(1,-nlevsnow+1:nlevsoil) !< layer thickness (m) @@ -4587,11 +4686,13 @@ subroutine DivideSnowLayers(lbc, ubc, & !i end subroutine DivideSnowLayers +!> Combines two elements and returns the following combined +!! variables: dz, t, wliq, wice. subroutine Combo(dz, wliq, wice, t, dz2, wliq2, wice2, t2) ! - ! !DESCRIPTION: - ! Combines two elements and returns the following combined - ! variables: dz, t, wliq, wice. + ! DESCRIPTION: + !> Combines two elements and returns the following combined + !! variables: dz, t, wliq, wice. ! The combined temperature is based on the equation: ! the sum of the enthalpies of the two elements = ! that of the combined element. @@ -4600,14 +4701,14 @@ subroutine Combo(dz, wliq, wice, t, dz2, wliq2, wice2, t2) ! ! !ARGUMENTS: implicit none - real(kind_lake), intent(in) :: dz2 ! nodal thickness of 2 elements being combined [m] - real(kind_lake), intent(in) :: wliq2 ! liquid water of element 2 [kg/m2] - real(kind_lake), intent(in) :: wice2 ! ice of element 2 [kg/m2] - real(kind_lake), intent(in) :: t2 ! nodal temperature of element 2 [K] - real(kind_lake), intent(inout) :: dz ! nodal thickness of 1 elements being combined [m] - real(kind_lake), intent(inout) :: wliq ! liquid water of element 1 - real(kind_lake), intent(inout) :: wice ! ice of element 1 [kg/m2] - real(kind_lake), intent(inout) :: t ! nodel temperature of elment 1 [K] + real(kind_lake), intent(in) :: dz2 !< nodal thickness of 2 elements being combined [m] + real(kind_lake), intent(in) :: wliq2 !< liquid water of element 2 [kg/m2] + real(kind_lake), intent(in) :: wice2 !< ice of element 2 [kg/m2] + real(kind_lake), intent(in) :: t2 !< nodal temperature of element 2 [K] + real(kind_lake), intent(inout) :: dz !< nodal thickness of 1 elements being combined [m] + real(kind_lake), intent(inout) :: wliq !< liquid water of element 1 + real(kind_lake), intent(inout) :: wice !< ice of element 1 [kg/m2] + real(kind_lake), intent(inout) :: t !< nodel temperature of elment 1 [K] ! ! !CALLED FROM: ! subroutine CombineSnowLayers in this module @@ -4653,26 +4754,27 @@ subroutine Combo(dz, wliq, wice, t, dz2, wliq2, wice2, t2) end subroutine Combo +!> Constructs snow filter for use in vectorized loops for snow hydrology. subroutine BuildSnowFilter(lbc, ubc, num_nolakec, filter_nolakec,snl, & !i num_snowc, filter_snowc, & !o num_nosnowc, filter_nosnowc) !o ! - ! !DESCRIPTION: - ! Constructs snow filter for use in vectorized loops for snow hydrology. + ! DESCRIPTION: + !> Constructs snow filter for use in vectorized loops for snow hydrology. ! ! !USES: ! use clmtype ! ! !ARGUMENTS: implicit none - integer, intent(in) :: lbc, ubc ! column bounds - integer, intent(in) :: num_nolakec ! number of column non-lake points in column filter - integer, intent(in) :: filter_nolakec(ubc-lbc+1) ! column filter for non-lake points - integer, intent(in) :: snl(1) ! number of snow layers - integer, intent(out) :: num_snowc ! number of column snow points in column filter - integer, intent(out) :: filter_snowc(ubc-lbc+1) ! column filter for snow points - integer, intent(out) :: num_nosnowc ! number of column non-snow points in column filter - integer, intent(out) :: filter_nosnowc(ubc-lbc+1) ! column filter for non-snow points + integer, intent(in) :: lbc, ubc !< column bounds + integer, intent(in) :: num_nolakec !< number of column non-lake points in column filter + integer, intent(in) :: filter_nolakec(ubc-lbc+1) !< column filter for non-lake points + integer, intent(in) :: snl(1) !< number of snow layers + integer, intent(out) :: num_snowc !< number of column snow points in column filter + integer, intent(out) :: filter_snowc(ubc-lbc+1) !< column filter for snow points + integer, intent(out) :: num_nosnowc !< number of column non-snow points in column filter + integer, intent(out) :: filter_nosnowc(ubc-lbc+1) !< column filter for non-snow points ! ! !CALLED FROM: ! subroutine Hydrology2 in Hydrology2Mod @@ -4710,7 +4812,13 @@ subroutine BuildSnowFilter(lbc, ubc, num_nolakec, filter_nolakec,snl, & !i end subroutine BuildSnowFilter - + ! DESCRIPTION: + !> Calculation of the friction velocity, relation for potential + !! temperature and humidity profiles of surface boundary layer. + !! The scheme is based on the work of Zeng et al. (1998): + !! Intercomparison of bulk aerodynamic algorithms for the computation + !! of sea surface fluxes using TOGA CORE and TAO data. J. Climate, + !! Vol. 11, 2628-2644. subroutine FrictionVelocity(pgridcell,forc_hgt,forc_hgt_u, & !i forc_hgt_t,forc_hgt_q, & !i lbp, ubp, fn, filterp, & !i @@ -4721,15 +4829,7 @@ subroutine FrictionVelocity(pgridcell,forc_hgt,forc_hgt_u, & !i fm) !i&o !============================================================================= - ! !DESCRIPTION: - ! Calculation of the friction velocity, relation for potential - ! temperature and humidity profiles of surface boundary layer. - ! The scheme is based on the work of Zeng et al. (1998): - ! Intercomparison of bulk aerodynamic algorithms for the computation - ! of sea surface fluxes using TOGA CORE and TAO data. J. Climate, - ! Vol. 11, 2628-2644. - ! - ! !REVISION HISTORY: + ! REVISION HISTORY: ! 15 September 1999: Yongjiu Dai; Initial code ! 15 December 1999: Paul Houser and Jon Radakovich; F90 Revision ! 12/19/01, Peter Thornton @@ -4746,35 +4846,35 @@ subroutine FrictionVelocity(pgridcell,forc_hgt,forc_hgt_u, & !i !in: - integer , intent(in) :: pgridcell(1) ! pft's gridcell index - real(kind_lake), intent(in) :: forc_hgt(1) ! atmospheric reference height (m) - real(kind_lake), intent(in) :: forc_hgt_u(1) ! observational height of wind [m] - real(kind_lake), intent(in) :: forc_hgt_t(1) ! observational height of temperature [m] - real(kind_lake), intent(in) :: forc_hgt_q(1) ! observational height of humidity [m] - integer , intent(in) :: lbp, ubp ! pft array bounds - integer , intent(in) :: fn ! number of filtered pft elements - integer , intent(in) :: filterp(fn) ! pft filter - real(kind_lake), intent(in) :: displa(lbp:ubp) ! displacement height (m) - real(kind_lake), intent(in) :: z0m(lbp:ubp) ! roughness length over vegetation, momentum [m] - real(kind_lake), intent(in) :: z0h(lbp:ubp) ! roughness length over vegetation, sensible heat [m] - real(kind_lake), intent(in) :: z0q(lbp:ubp) ! roughness length over vegetation, latent heat [m] - real(kind_lake), intent(in) :: obu(lbp:ubp) ! monin-obukhov length (m) - integer, intent(in) :: iter ! iteration number - real(kind_lake), intent(in) :: ur(lbp:ubp) ! wind speed at reference height [m/s] - real(kind_lake), intent(in) :: um(lbp:ubp) ! wind speed including the stablity effect [m/s] + integer , intent(in) :: pgridcell(1) !< pft's gridcell index + real(kind_lake), intent(in) :: forc_hgt(1) !< atmospheric reference height (m) + real(kind_lake), intent(in) :: forc_hgt_u(1) !< observational height of wind [m] + real(kind_lake), intent(in) :: forc_hgt_t(1) !< observational height of temperature [m] + real(kind_lake), intent(in) :: forc_hgt_q(1) !< observational height of humidity [m] + integer , intent(in) :: lbp, ubp !< pft array bounds + integer , intent(in) :: fn !< number of filtered pft elements + integer , intent(in) :: filterp(fn) !< pft filter + real(kind_lake), intent(in) :: displa(lbp:ubp) !< displacement height (m) + real(kind_lake), intent(in) :: z0m(lbp:ubp) !< roughness length over vegetation, momentum [m] + real(kind_lake), intent(in) :: z0h(lbp:ubp) !< roughness length over vegetation, sensible heat [m] + real(kind_lake), intent(in) :: z0q(lbp:ubp) !< roughness length over vegetation, latent heat [m] + real(kind_lake), intent(in) :: obu(lbp:ubp) !< monin-obukhov length (m) + integer, intent(in) :: iter !< iteration number + real(kind_lake), intent(in) :: ur(lbp:ubp) !< wind speed at reference height [m/s] + real(kind_lake), intent(in) :: um(lbp:ubp) !< wind speed including the stablity effect [m/s] !out: - real(kind_lake), intent(out) :: ustar(lbp:ubp) ! friction velocity [m/s] - real(kind_lake), intent(out) :: temp1(lbp:ubp) ! relation for potential temperature profile - real(kind_lake), intent(out) :: temp12m(lbp:ubp) ! relation for potential temperature profile applied at 2-m - real(kind_lake), intent(out) :: temp2(lbp:ubp) ! relation for specific humidity profile - real(kind_lake), intent(out) :: temp22m(lbp:ubp) ! relation for specific humidity profile applied at 2-m - real(kind_lake), intent(out) :: u10(1) ! 10-m wind (m/s) (for dust model) - real(kind_lake), intent(out) :: fv(1) ! friction velocity (m/s) (for dust model) + real(kind_lake), intent(out) :: ustar(lbp:ubp) !< friction velocity [m/s] + real(kind_lake), intent(out) :: temp1(lbp:ubp) !< relation for potential temperature profile + real(kind_lake), intent(out) :: temp12m(lbp:ubp) !< relation for potential temperature profile applied at 2-m + real(kind_lake), intent(out) :: temp2(lbp:ubp) !< relation for specific humidity profile + real(kind_lake), intent(out) :: temp22m(lbp:ubp) !< relation for specific humidity profile applied at 2-m + real(kind_lake), intent(out) :: u10(1) !< 10-m wind (m/s) (for dust model) + real(kind_lake), intent(out) :: fv(1) !< friction velocity (m/s) (for dust model) !inout: - real(kind_lake), intent(inout) :: fm(lbp:ubp) ! needed for DGVM only to diagnose 10m wind + real(kind_lake), intent(inout) :: fm(lbp:ubp) !< needed for DGVM only to diagnose 10m wind ! OTHER LOCAL VARIABLES: @@ -4990,8 +5090,8 @@ end subroutine FrictionVelocity ! !INTERFACE: real(kind_lake) function StabilityFunc1(zeta) ! - ! !DESCRIPTION: - ! Stability function for rib < 0. + ! DESCRIPTION: + !> Stability function for rib < 0. ! ! !USES: ! use shr_const_mod, only: SHR_CONST_PI @@ -4999,7 +5099,7 @@ real(kind_lake) function StabilityFunc1(zeta) ! ! !ARGUMENTS: implicit none - real(kind_lake), intent(in) :: zeta ! dimensionless height used in Monin-Obukhov theory + real(kind_lake), intent(in) :: zeta !< dimensionless height used in Monin-Obukhov theory ! ! !CALLED FROM: ! subroutine FrictionVelocity in this module @@ -5033,7 +5133,7 @@ end function StabilityFunc1 real(kind_lake) function StabilityFunc2(zeta) ! ! !DESCRIPTION: - ! Stability function for rib < 0. + !> Stability function for rib < 0. ! ! !USES: !Removed by Zack Subin, 7/9/08 @@ -5041,7 +5141,7 @@ real(kind_lake) function StabilityFunc2(zeta) ! ! !ARGUMENTS: implicit none - real(kind_lake), intent(in) :: zeta ! dimensionless height used in Monin-Obukhov theory + real(kind_lake), intent(in) :: zeta !< dimensionless height used in Monin-Obukhov theory ! ! !CALLED FROM: ! subroutine FrictionVelocity in this module @@ -5071,23 +5171,23 @@ end function StabilityFunc2 subroutine MoninObukIni (ur, thv, dthv, zldis, z0m, um, obu) ! ! !DESCRIPTION: - ! Initialization of the Monin-Obukhov length. - ! The scheme is based on the work of Zeng et al. (1998): - ! Intercomparison of bulk aerodynamic algorithms for the computation - ! of sea surface fluxes using TOGA CORE and TAO data. J. Climate, - ! Vol. 11, 2628-2644. + !> Initialization of the Monin-Obukhov length. + !! The scheme is based on the work of Zeng et al. (1998): + !! Intercomparison of bulk aerodynamic algorithms for the computation + !! of sea surface fluxes using TOGA CORE and TAO data. J. Climate, + !! Vol. 11, 2628-2644. ! ! !USES: ! ! !ARGUMENTS: implicit none - real(kind_lake), intent(in) :: ur ! wind speed at reference height [m/s] - real(kind_lake), intent(in) :: thv ! virtual potential temperature (kelvin) - real(kind_lake), intent(in) :: dthv ! diff of vir. poten. temp. between ref. height and surface - real(kind_lake), intent(in) :: zldis ! reference height "minus" zero displacement heght [m] - real(kind_lake), intent(in) :: z0m ! roughness length, momentum [m] - real(kind_lake), intent(out) :: um ! wind speed including the stability effect [m/s] - real(kind_lake), intent(out) :: obu ! monin-obukhov length (m) + real(kind_lake), intent(in) :: ur !< wind speed at reference height [m/s] + real(kind_lake), intent(in) :: thv !< virtual potential temperature (kelvin) + real(kind_lake), intent(in) :: dthv !< diff of vir. poten. temp. between ref. height and surface + real(kind_lake), intent(in) :: zldis !< reference height "minus" zero displacement heght [m] + real(kind_lake), intent(in) :: z0m !< roughness length, momentum [m] + real(kind_lake), intent(out) :: um !< wind speed including the stability effect [m/s] + real(kind_lake), intent(out) :: obu !< monin-obukhov length (m) ! ! !CALLED FROM: ! subroutine BareGroundFluxes in module BareGroundFluxesMod.F90 @@ -5141,18 +5241,19 @@ end subroutine MoninObukIni !! subroutine clm_lake_init(con_pi,karman,con_g,con_sbc,con_t0c,rhowater,con_csol,con_cliq, & con_hfus,con_hvap,con_rd,con_cp,rholakeice,clm_lake_debug, & - con_eps_model,con_fvirt_model,errmsg,errflg) + clm_debug_print,con_eps_model,con_fvirt_model,errmsg,errflg) implicit none real(kind_phys), intent(in) :: con_pi,karman,con_g,con_sbc,con_t0c, & rhowater,con_csol,con_cliq, con_hfus,con_hvap,con_rd,con_cp, & rholakeice,con_eps_model,con_fvirt_model INTEGER, INTENT(OUT) :: errflg CHARACTER(*), INTENT(OUT) :: errmsg - logical, intent(in) :: clm_lake_debug + logical, intent(in) :: clm_lake_debug,clm_debug_print integer :: i, j LAKEDEBUG = clm_lake_debug - if(LAKEDEBUG) then + DEBUG_PRINT = clm_debug_print + if(debug_print) then write(0,*) 'clm_lake_init' endif @@ -5246,22 +5347,22 @@ SUBROUTINE lakeini(kdt, ISLTYP, gt0, snowd, weasd, lakedepth_default, fhour, & oro_lakedepth, savedtke12d, snowdp2d, h2osno2d, & !o snl2d, t_grnd2d, t_lake3d, lake_icefrac3d, & - z_lake3d, dz_lake3d, t_soisno3d, h2osoi_ice3d, & + t_soisno3d, h2osoi_ice3d, & h2osoi_liq3d, h2osoi_vol3d, z3d, dz3d, & - zi3d, watsat3d, csol3d, tkmg3d, & - fice, min_lakeice, tsfc, & + zi3d, & + fice, hice, min_lakeice, tsfc, & use_lake_model, use_lakedepth, & - tkdry3d, tksatu3d, im, prsi, & + im, prsi, & xlat_d, xlon_d, clm_lake_initialized, & - sand3d, clay3d, tg3, clm_lakedepth, & + input_lakedepth, tg3, clm_lakedepth, & km, me, master, errmsg, errflg) - ! Some fields in lakeini are not available during initialization, - ! so clm_lake_init cannot complete the initialization. What is not - ! in clm_lake_init, is initialized in lakeini on points where - ! use_lake_model(i)>0. The clm_lake_initialized(i) guards against - ! initializing a point twice. For that to work, - ! clm_lake_initialized must be a restart variable. + !> Some fields in lakeini are not available during initialization, + !! so clm_lake_init cannot complete the initialization. What is not + !! in clm_lake_init, is initialized in lakeini on points where + !! use_lake_model(i)>0. The clm_lake_initialized(i) guards against + !! initializing a point twice. For that to work, + !! clm_lake_initialized must be a restart variable. !============================================================================== ! This subroutine was first edited by Hongping Gu for coupling @@ -5276,66 +5377,45 @@ SUBROUTINE lakeini(kdt, ISLTYP, gt0, snowd, INTEGER , INTENT (IN) :: im, me, master, km, kdt REAL(KIND_PHYS), INTENT(IN) :: min_lakeice, fhour - REAL(KIND_PHYS), DIMENSION(IM), INTENT(INOUT):: FICE - REAL(KIND_PHYS), DIMENSION(IM), INTENT(IN):: TG3, xlat_d, xlon_d - REAL(KIND_PHYS), DIMENSION(IM), INTENT(IN):: tsfc - REAL(KIND_PHYS), DIMENSION(IM) ,INTENT(INOUT) :: clm_lake_initialized - integer, dimension(IM), intent(in) :: use_lake_model - !INTEGER , INTENT (IN) :: lakeflag - !INTEGER , INTENT (INOUT) :: lake_depth_flag + REAL(KIND_PHYS), DIMENSION(:), INTENT(INOUT):: FICE, hice + REAL(KIND_PHYS), DIMENSION(:), INTENT(IN):: TG3, xlat_d, xlon_d + REAL(KIND_PHYS), DIMENSION(:), INTENT(IN):: tsfc + REAL(KIND_PHYS), DIMENSION(:) ,INTENT(INOUT) :: clm_lake_initialized + integer, dimension(:), intent(in) :: use_lake_model LOGICAL, INTENT (IN) :: use_lakedepth - INTEGER, DIMENSION(IM), INTENT(IN) :: ISLTYP - REAL(KIND_PHYS), DIMENSION(IM), INTENT(INOUT) :: snowd,weasd - REAL(kind_phys), DIMENSION(IM,KM), INTENT(IN) :: gt0, prsi + INTEGER, DIMENSION(:), INTENT(IN) :: ISLTYP + REAL(KIND_PHYS), DIMENSION(:), INTENT(INOUT) :: snowd,weasd + REAL(kind_phys), DIMENSION(:,:), INTENT(IN) :: gt0 + REAL(kind_phys), DIMENSION(:,:), INTENT(IN) :: prsi real(kind_phys), intent(in) :: lakedepth_default - real(kind_phys), dimension(IM),intent(inout) :: clm_lakedepth - real(kind_phys), dimension(IM),intent(in) :: oro_lakedepth - real(kind_phys), dimension(IM),intent(out) :: savedtke12d - real(kind_phys), dimension(IM),intent(out) :: snowdp2d, & + real(kind_phys), dimension(:),intent(inout) :: clm_lakedepth + real(kind_phys), dimension(:),intent(inout) :: input_lakedepth + real(kind_phys), dimension(:),intent(in) :: oro_lakedepth + real(kind_phys), dimension(:),intent(out) :: savedtke12d + real(kind_phys), dimension(:),intent(out) :: snowdp2d, & h2osno2d, & snl2d, & t_grnd2d - real(kind_phys), dimension(IM,nlevlake),INTENT(out) :: t_lake3d, & - lake_icefrac3d, & - z_lake3d, & - dz_lake3d - real(kind_phys), dimension(IM,-nlevsnow+1:nlevsoil ),INTENT(out) :: t_soisno3d, & + real(kind_phys), dimension(:,:),INTENT(out) :: t_lake3d, & + lake_icefrac3d + real(kind_phys), dimension(:,-nlevsnow+1:),INTENT(out) :: t_soisno3d, & h2osoi_ice3d, & h2osoi_liq3d, & h2osoi_vol3d, & z3d, & dz3d - real(kind_phys), dimension(IM,nlevsoil),INTENT(out) :: watsat3d, & - csol3d, & - tkmg3d, & - tkdry3d, & - tksatu3d - real(kind_phys), dimension(IM,nlevsoil),INTENT(inout) :: clay3d, & - sand3d - - real(kind_phys), dimension( IM,-nlevsnow+0:nlevsoil ),INTENT(out) :: zi3d - - !LOGICAL, DIMENSION( : ),intent(out) :: lake - !REAL(KIND_PHYS), OPTIONAL, DIMENSION( : ), INTENT(IN) :: lake_depth ! no separate variable for this in CCPP - - real(kind_lake), dimension( 1:im,1:nlevsoil ) :: bsw3d, & - bsw23d, & - psisat3d, & - vwcsat3d, & - watdry3d, & - watopt3d, & - hksat3d, & - sucsat3d + + real(kind_phys), dimension(:,-nlevsnow+0:),INTENT(out) :: zi3d + + integer :: n,i,j,k,ib,lev,bottom ! indices real(kind_lake),dimension(1:im ) :: bd2d ! bulk density of dry soil material [kg/m^3] real(kind_lake),dimension(1:im ) :: tkm2d ! mineral conductivity real(kind_lake),dimension(1:im ) :: xksat2d ! maximum hydraulic conductivity of soil [mm/s] real(kind_lake),dimension(1:im ) :: depthratio2d ! ratio of lake depth to standard deep lake depth - real(kind_lake),dimension(1:im ) :: clay2d ! temporary - real(kind_lake),dimension(1:im ) :: sand2d ! temporary logical,parameter :: arbinit = .false. real(kind_lake),parameter :: defval = -999.0 @@ -5343,15 +5423,20 @@ SUBROUTINE lakeini(kdt, ISLTYP, gt0, snowd, integer :: numb_lak ! for debug character*256 :: message real(kind_lake) :: ht + real(kind_lake) :: rhosn + real(kind_lake) :: depth, lakedepth logical :: climatology_limits + real(kind_lake) :: z_lake(nlevlake) ! layer depth for lake (m) + real(kind_lake) :: dz_lake(nlevlake) ! layer thickness for lake (m) + integer, parameter :: xcheck=38 integer, parameter :: ycheck=92 integer :: used_lakedepth_default, init_points, month, julday integer :: mon, iday, num2, num1, juld, day2, day1, wght1, wght2 - real(kind_lake) :: Tclim + real(kind_lake) :: Tclim, watsat used_lakedepth_default=0 @@ -5385,103 +5470,52 @@ SUBROUTINE lakeini(kdt, ISLTYP, gt0, snowd, cycle endif - snowdp2d(i) = snowd(i)*1e-3 ! SNOW in kg/m^2 and snowdp in m - h2osno2d(i) = weasd(i) ! mm + input_lakedepth=clm_lakedepth snl2d(i) = defval do k = -nlevsnow+1,nlevsoil h2osoi_liq3d(i,k) = defval h2osoi_ice3d(i,k) = defval - t_soisno3d(i,k) = defval + h2osoi_vol3d(i,k) = defval + t_soisno3d(i,k) = defval z3d(i,k) = defval dz3d(i,k) = defval enddo do k = 1,nlevlake - t_lake3d(i,k) = defval + t_lake3d(i,k) = defval lake_icefrac3d(i,k) = defval - z_lake3d(i,k) = defval - dz_lake3d(i,k) = defval enddo - if(fice(i)>min_lakeice) then - lake_icefrac3d(i,1) = fice(i) - snowdp2d(i) = snowd(i)*1e-3 ! SNOW in kg/m^2 and snowdp in m - h2osno2d(i) = weasd(i) ! mm - else - fice(i) = 0. - snowd(i) = 0. - weasd(i) = 0. - snowdp2d(i) = 0. - h2osno2d(i) = 0. - endif + if (use_lake_model(i) == 1) then + ! for lake points only + z3d(i,:) = 0.0 + dz3d(i,:) = 0.0 + zi3d(i,:) = 0.0 + h2osoi_liq3d(i,:) = 0.0 + h2osoi_ice3d(i,:) = 0.0 + lake_icefrac3d(i,:) = 0.0 + h2osoi_vol3d(i,:) = 0.0 + snl2d(i) = 0.0 + + if(fice(i)>min_lakeice) then + lake_icefrac3d(i,1) = fice(i) + snowdp2d(i) = snowd(i)*1e-3 ! SNOW in kg/m^2 and snowdp in m + h2osno2d(i) = weasd(i) ! mm + else + fice(i) = 0. + snowd(i) = 0. + weasd(i) = 0. + snowdp2d(i) = 0. + h2osno2d(i) = 0. + endif - z3d(i,:) = 0.0 - dz3d(i,:) = 0.0 - zi3d(i,:) = 0.0 - h2osoi_liq3d(i,:) = 0.0 - h2osoi_ice3d(i,:) = 0.0 - lake_icefrac3d(i,:) = 0.0 - h2osoi_vol3d(i,:) = 0.0 - snl2d(i) = 0.0 - ! Soil hydraulic and thermal properties isl = ISLTYP(i) if (isl == 0 ) isl = 14 if (isl == 14 ) isl = isl + 1 - do k = 1,nlevsoil - sand3d(i,k) = sand(isl) - clay3d(i,k) = clay(isl) - - ! Cannot continue if either of these checks fail. - if(clay3d(i,k)>0 .and. clay3d(i,k)<1) then - write(message,*) 'bad clay3d ',clay3d(i,k) - write(0,'(A)') trim(message) - errmsg = trim(message) - errflg = 1 - return - endif - if(sand3d(i,k)>0 .and. sand3d(i,k)<1) then - write(message,*) 'bad sand3d ',sand3d(i,k) - write(0,'(A)') trim(message) - errmsg = trim(message) - errflg = 1 - return - endif - enddo - do k = 1,nlevsoil - clay2d(i) = clay3d(i,k) - sand2d(i) = sand3d(i,k) - watsat3d(i,k) = 0.489_kind_lake - 0.00126_kind_lake*sand2d(i) - bd2d(i) = (1._kind_lake-watsat3d(i,k))*2.7e3_kind_lake - xksat2d(i) = 0.0070556_kind_lake *( 10._kind_lake**(-0.884_kind_lake+0.0153_kind_lake*sand2d(i)) ) ! mm/s - tkm2d(i) = (8.80_kind_lake*sand2d(i)+2.92_kind_lake*clay2d(i))/(sand2d(i)+clay2d(i)) ! W/(m K) - - bsw3d(i,k) = 2.91_kind_lake + 0.159_kind_lake*clay2d(i) - bsw23d(i,k) = -(3.10_kind_lake + 0.157_kind_lake*clay2d(i) - 0.003_kind_lake*sand2d(i)) - psisat3d(i,k) = -(exp((1.54_kind_lake - 0.0095_kind_lake*sand2d(i) + 0.0063_kind_lake*(100.0_kind_lake-sand2d(i) & - -clay2d(i)))*log(10.0_kind_lake))*9.8e-5_kind_lake) - vwcsat3d(i,k) = (50.5_kind_lake - 0.142_kind_lake*sand2d(i) - 0.037_kind_lake*clay2d(i))/100.0_kind_lake - hksat3d(i,k) = xksat2d(i) - sucsat3d(i,k) = 10._kind_lake * ( 10._kind_lake**(1.88_kind_lake-0.0131_kind_lake*sand2d(i)) ) - tkmg3d(i,k) = tkm2d(i) ** (1._kind_lake- watsat3d(i,k)) - tksatu3d(i,k) = tkmg3d(i,k)*0.57_kind_lake**watsat3d(i,k) - tkdry3d(i,k) = (0.135_kind_lake*bd2d(i) + 64.7_kind_lake) / (2.7e3_kind_lake - 0.947_kind_lake*bd2d(i)) - csol3d(i,k) = (2.128_kind_lake*sand2d(i)+2.385_kind_lake*clay2d(i)) / (sand2d(i)+clay2d(i))*1.e6_kind_lake ! J/(m3 K) - watdry3d(i,k) = watsat3d(i,k) * (316230._kind_lake/sucsat3d(i,k)) ** (-1._kind_lake/bsw3d(i,k)) - watopt3d(i,k) = watsat3d(i,k) * (158490._kind_lake/sucsat3d(i,k)) ** (-1._kind_lake/bsw3d(i,k)) - end do - if (clm_lakedepth(i) == spval) then - clm_lakedepth(i) = zlak(nlevlake) + 0.5_kind_lake*dzlak(nlevlake) - z_lake3d(i,1:nlevlake) = zlak(1:nlevlake) - dz_lake3d(i,1:nlevlake) = dzlak(1:nlevlake) - else - depthratio2d(i) = clm_lakedepth(i) / (zlak(nlevlake) + 0.5_kind_lake*dzlak(nlevlake)) - z_lake3d(i,1) = zlak(1) - dz_lake3d(i,1) = dzlak(1) - dz_lake3d(i,2:nlevlake) = dzlak(2:nlevlake)*depthratio2d(i) - z_lake3d(i,2:nlevlake) = zlak(2:nlevlake)*depthratio2d(i) + dz_lake3d(i,1)*(1._kind_lake - depthratio2d(i)) - end if + call calculate_z_dz_lake(i,input_lakedepth,clm_lakedepth,z_lake,dz_lake) + z3d(i,1:nlevsoil) = zsoi(1:nlevsoil) zi3d(i,0:nlevsoil) = zisoi(0:nlevsoil) dz3d(i,1:nlevsoil) = dzsoi(1:nlevsoil) @@ -5559,19 +5593,45 @@ SUBROUTINE lakeini(kdt, ISLTYP, gt0, snowd, return endif + if(lake_icefrac3d(i,1) > 0.) then + depth = 0. + do k=2,nlevlake + depth = depth + dz_lake(k) + if(hice(i) >= depth) then + lake_icefrac3d(i,k) = max(0.,lake_icefrac3d(i,1)+(0.-lake_icefrac3d(i,1))/z_lake(nlevlake)*depth) + else + lake_icefrac3d(i,k) = 0. + endif + end do + endif t_lake3d(i,1) = tsfc(i) t_grnd2d(i) = tsfc(i) + if (lake_icefrac3d(i,1) <= 0.) then + t_lake3d(i,1) = max(tfrz,tsfc(i)) + t_grnd2d(i) = max(tfrz,tsfc(i)) + endif do k = 2, nlevlake - if(z_lake3d(i,k).le.depth_c) then - t_lake3d(i,k) = tsfc(i)+(277.0-tsfc(i))/depth_c*z_lake3d(i,k) + if(z_lake(k).le.depth_c) then + t_lake3d(i,k) = tsfc(i)+(277.2_kind_lake-tsfc(i))/depth_c*z_lake(k) else - t_lake3d(i,k) = 277.0 + t_lake3d(i,k) = 277.2_kind_lake end if + if (lake_icefrac3d(i,k) <= 0.) then + t_lake3d(i,k) = max(tfrz,t_lake3d(i,k)) + endif enddo ! initial t_soisno3d - t_soisno3d(i,1) = t_lake3d(i,nlevlake) + ! in snow + if(snowdp2d(i) > 0.) then + do k = snl2d(i)+1, 0 + t_soisno3d(i,k) =min(tfrz,tsfc(i)) + enddo + endif + + ! in soil + t_soisno3d(i,1) = t_lake3d(i,nlevlake) t_soisno3d(i,nlevsoil) = tg3(i) do k = 2, nlevsoil-1 t_soisno3d(i,k)=t_soisno3d(i,1)+(t_soisno3d(i,nlevsoil)-t_soisno3d(i,1))*dzsoi(k) @@ -5587,7 +5647,8 @@ SUBROUTINE lakeini(kdt, ISLTYP, gt0, snowd, do k = 1,nlevsoil h2osoi_vol3d(i,k) = 1.0_kind_lake - h2osoi_vol3d(i,k) = min(h2osoi_vol3d(i,k),watsat3d(i,k)) + watsat = 0.489_kind_lake - 0.00126_kind_lake*sand(isl) + h2osoi_vol3d(i,k) = min(h2osoi_vol3d(i,k),watsat) ! soil layers if (t_soisno3d(i,k) <= tfrz) then @@ -5599,6 +5660,17 @@ SUBROUTINE lakeini(kdt, ISLTYP, gt0, snowd, endif enddo + !tgs - in RAP and HRRR applications with cycled snow depth and snow + !water equivalent, the actual snow density could be computed. This is + !not used for now for consistency with the main Lake subroutine, where + !constant snow density (250.) is used. + if(h2osno2d(i).gt.0. .and. snowdp2d(i).gt.0.) then + rhosn = h2osno2d(i)/snowdp2d(i) + else + rhosn = snow_bd ! bdsno=250. + endif + + do k = -nlevsnow+1, 0 if (k > snl2d(i)) then h2osoi_ice3d(i,k) = dz3d(i,k)*snow_bd @@ -5607,10 +5679,12 @@ SUBROUTINE lakeini(kdt, ISLTYP, gt0, snowd, end do clm_lake_initialized(i) = 1 + + endif !if ( use_lakedepth ) then ENDDO do_init - if(LAKEDEBUG .and. init_points>0) then + if(debug_print .and. init_points>0) then print *,'points initialized in clm_lake',init_points end if diff --git a/physics/clm_lake.meta b/physics/SFC_Models/Lake/CLM/clm_lake.meta similarity index 91% rename from physics/clm_lake.meta rename to physics/SFC_Models/Lake/CLM/clm_lake.meta index bbaaded16..7754362f0 100644 --- a/physics/clm_lake.meta +++ b/physics/SFC_Models/Lake/CLM/clm_lake.meta @@ -1,12 +1,19 @@ [ccpp-table-properties] name = clm_lake type = scheme - dependencies = machine.F + dependencies = ../../../hooks/machine.F ######################################################################## [ccpp-arg-table] name = clm_lake_run type = scheme +[flag_restart] + standard_name = flag_for_restart + long_name = flag for restart (warmstart) or coldstart + units = flag + dimensions = () + type = logical + intent = in [im] standard_name = horizontal_loop_extent long_name = horizontal loop extent @@ -117,6 +124,7 @@ type = real kind = kind_phys intent = inout + optional = True [frac_grid] standard_name = flag_for_fractional_landmask long_name = flag for fractional grid @@ -266,6 +274,7 @@ type = real kind = kind_phys intent = in + optional = True [rainncprv] standard_name = lwe_thickness_of_explicit_precipitation_amount_on_previous_timestep long_name = explicit rainfall from previous timestep @@ -274,6 +283,7 @@ type = real kind = kind_phys intent = in + optional = True [oro_lakedepth] standard_name = lake_depth long_name = lake depth @@ -282,6 +292,15 @@ type = real kind = kind_phys intent = in +[input_lakedepth] + standard_name = lake_depth_before_correction + long_name = lake depth_before_correction + units = m + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = True [wind] standard_name = wind_speed_at_lowest_model_layer long_name = wind speed at lowest model level @@ -290,14 +309,6 @@ type = real kind = kind_phys intent = in -[rho0] - standard_name = air_pressure_at_surface_adjacent_layer - long_name = mean pressure at lowest model layer - units = Pa - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in [tsfc] standard_name = surface_skin_temperature long_name = surface skin temperature @@ -313,6 +324,13 @@ dimensions = (horizontal_loop_extent) type = logical intent = in +[flag_lakefreeze] + standard_name = flag_for_lake_water_freeze + long_name = flag for lake water freeze + units = flag + dimensions = (horizontal_loop_extent) + type = logical + intent = inout [isltyp] standard_name = soil_type_classification long_name = soil type at each grid cell @@ -512,6 +530,7 @@ type = real kind = kind_phys intent = inout + optional = True [albedo] standard_name = mid_day_surface_albedo_over_lake long_name = mid day surface albedo over lake @@ -520,6 +539,7 @@ type = real kind = kind_phys intent = inout + optional = True [zorlw] standard_name = surface_roughness_length_over_water long_name = surface roughness length over water @@ -544,6 +564,7 @@ type = real kind = kind_phys intent = out + optional = True [lake_q2m] standard_name = specific_humidity_at_2m_from_clm_lake long_name = specific humidity at 2m from clm lake @@ -552,6 +573,7 @@ type = real kind = kind_phys intent = out + optional = True [weasd] standard_name = lwe_thickness_of_surface_snow_amount long_name = water equiv of acc snow depth over land and sea ice @@ -590,6 +612,7 @@ dimensions = (horizontal_loop_extent) type = integer intent = inout + optional = True [cannot_freeze] standard_name = clm_lake_cannot_freeze long_name = lake at this point is so salty it cannot freeze @@ -597,6 +620,7 @@ dimensions = (horizontal_loop_extent) type = integer intent = inout + optional = True [savedtke12d] standard_name = top_level_eddy_conductivity_from_previous_timestep_in_clm_lake_model long_name = top level eddy conductivity from previous timestep in clm lake model @@ -605,6 +629,7 @@ type = real kind = kind_phys intent = inout + optional = True [snowdp2d] standard_name = actual_snow_depth_in_clm_lake_model long_name = actual acc snow depth over lake in clm lake model @@ -613,6 +638,7 @@ type = real kind = kind_phys intent = inout + optional = True [h2osno2d] standard_name = water_equivalent_accumulated_snow_depth_in_clm_lake_model long_name = water equiv of acc snow depth over lake in clm lake model @@ -621,6 +647,7 @@ type = real kind = kind_phys intent = inout + optional = True [snl2d] standard_name = snow_layers_in_clm_lake_model long_name = snow layers in clm lake model (treated as integer) @@ -629,6 +656,7 @@ type = real kind = kind_phys intent = inout + optional = True [t_grnd2d] standard_name = skin_temperature_from_lake_model long_name = skin_temperature_from_lake_model @@ -637,6 +665,7 @@ type = real kind = kind_phys intent = inout + optional = True [t_lake3d] standard_name = lake_layer_temperature_from_clm_lake_model long_name = lake layer temperature from clm lake model @@ -645,6 +674,7 @@ type = real kind = kind_phys intent = inout + optional = True [lake_icefrac3d] standard_name = lake_fractional_ice_cover_on_clm_lake_levels long_name = lake fractional ice cover on clm lake levels @@ -653,6 +683,7 @@ type = real kind = kind_phys intent = inout + optional = True [t_soisno3d] standard_name = soil_or_snow_layer_temperature_from_clm_lake_model long_name = soil or snow layer temperature from clm lake model @@ -661,6 +692,7 @@ type = real kind = kind_phys intent = inout + optional = True [h2osoi_ice3d] standard_name = soil_ice_water_content_in_clm_lake_model long_name = soil ice water content in clm lake model @@ -669,6 +701,7 @@ type = real kind = kind_phys intent = inout + optional = True [h2osoi_liq3d] standard_name = soil_liquid_water_content_in_clm_lake_model long_name = soil liquid water content in clm lake model @@ -677,6 +710,7 @@ type = real kind = kind_phys intent = inout + optional = True [h2osoi_vol3d] standard_name = volumetric_soil_water_in_clm_lake_model long_name = volumetric soil water in clm lake model @@ -685,6 +719,7 @@ type = real kind = kind_phys intent = inout + optional = True [z3d] standard_name = snow_level_depth_in_clm_lake_model long_name = snow level depth in clm lake model @@ -693,6 +728,7 @@ type = real kind = kind_phys intent = inout + optional = True [dz3d] standard_name = snow_level_thickness_in_clm_lake_model long_name = snow level thickness in clm lake model @@ -701,6 +737,7 @@ type = real kind = kind_phys intent = inout + optional = True [zi3d] standard_name = snow_interface_depth_in_clm_lake_model long_name = snow interface_depth in clm lake model @@ -709,80 +746,36 @@ type = real kind = kind_phys intent = inout -[z_lake3d] - standard_name = depth_of_lake_interface_layers - long_name = depth of lake interface layers - units = fraction - dimensions = (horizontal_loop_extent, lake_vertical_dimension_for_clm_lake_model) - type = real - kind = kind_phys - intent = inout -[dz_lake3d] - standard_name = thickness_of_lake_layers - long_name = thickness of lake layers - units = fraction - dimensions = (horizontal_loop_extent, lake_vertical_dimension_for_clm_lake_model) - type = real - kind = kind_phys - intent = inout -[watsat3d] - standard_name = saturated_volumetric_soil_water_in_lake_model - long_name = saturated volumetric soil water in lake model - units = m - dimensions = (horizontal_loop_extent, lake_vertical_dimension_for_clm_lake_model) - type = real - kind = kind_phys - intent = inout -[csol3d] - standard_name = soil_heat_capacity_in_lake_model - long_name = soil heat capacity in lake model - units = m - dimensions = (horizontal_loop_extent, lake_vertical_dimension_for_clm_lake_model) - type = real - kind = kind_phys - intent = inout -[sand3d] - standard_name = clm_lake_percent_sand - long_name = percent sand in clm lake model - units = percent - dimensions = (horizontal_loop_extent,soil_vertical_dimension_for_clm_lake_model) - type = integer - intent = inout -[clay3d] - standard_name = clm_lake_percent_clay - long_name = percent clay in clm lake model - units = percent - dimensions = (horizontal_loop_extent,soil_vertical_dimension_for_clm_lake_model) - type = integer - intent = inout -[tkmg3d] - standard_name = soil_mineral_thermal_conductivity_in_lake_model - long_name = soil mineral thermal conductivity in lake model + optional = True +[clm_lakedepth] + standard_name = clm_lake_depth + long_name = clm internal copy of lake depth with 10.0 replaced by default lake depth units = m - dimensions = (horizontal_loop_extent, lake_vertical_dimension_for_clm_lake_model) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys - intent = inout -[tkdry3d] - standard_name = dry_soil_thermal_conductivity_in_lake_model - long_name = dry soil thermal conductivity in lake model - units = m - dimensions = (horizontal_loop_extent, lake_vertical_dimension_for_clm_lake_model) + intent = in + optional = True +[t1] + standard_name = air_temperature_at_surface_adjacent_layer + long_name = mean temperature at lowest model layer + units = K + dimensions = (horizontal_loop_extent) type = real kind = kind_phys - intent = inout -[tksatu3d] - standard_name = saturated_soil_thermal_conductivity_in_lake_model - long_name = saturated soil thermal conductivity in lake model - units = m - dimensions = (horizontal_loop_extent, lake_vertical_dimension_for_clm_lake_model) + intent = in +[qv1] + standard_name = specific_humidity_at_surface_adjacent_layer + long_name = water vapor specific humidity at lowest model layer + units = kg kg-1 + dimensions = (horizontal_loop_extent) type = real kind = kind_phys - intent = inout -[clm_lakedepth] - standard_name = clm_lake_depth - long_name = clm internal copy of lake depth with 10.0 replaced by default lake depth - units = m + intent = in +[prsl1] + standard_name = air_pressure_at_surface_adjacent_layer + long_name = mean pressure at lowest model layer + units = Pa dimensions = (horizontal_loop_extent) type = real kind = kind_phys @@ -933,7 +926,13 @@ units = flag dimensions = () type = logical - active = (control_for_lake_model_selection == 3) + intent = in +[clm_debug_print] + standard_name = flag_for_printing_in_clm_lake_model + long_name = flag for printing in clm lake model + units = flag + dimensions = () + type = logical intent = in [errmsg] standard_name = ccpp_error_message diff --git a/physics/flake.F90 b/physics/SFC_Models/Lake/Flake/flake.F90 similarity index 100% rename from physics/flake.F90 rename to physics/SFC_Models/Lake/Flake/flake.F90 diff --git a/physics/flake_driver.F90 b/physics/SFC_Models/Lake/Flake/flake_driver.F90 similarity index 97% rename from physics/flake_driver.F90 rename to physics/SFC_Models/Lake/Flake/flake_driver.F90 index 3b5988254..9092b1c36 100644 --- a/physics/flake_driver.F90 +++ b/physics/SFC_Models/Lake/Flake/flake_driver.F90 @@ -65,9 +65,9 @@ SUBROUTINE flake_driver_run ( & real (kind=kind_phys),dimension(:),intent(inout) :: & & snwdph, hice, tsurf, t_sfc, hflx, evap, fice, ustar, qsfc, & - & ch, cm, chh, cmm, h_ML, t_wML, t_mnw, H_B, T_B, & - & t_bot1, t_bot2, c_t, T_snow, T_ice, tsurf_ice, lflx, gflx - + & ch, cm, chh, cmm, T_ice, tsurf_ice, lflx, gflx + real (kind=kind_phys),dimension(:),intent(inout), optional :: & + & h_ML, t_wML, t_mnw, H_B, T_B, t_bot1, t_bot2, c_t, T_snow real (kind=kind_phys), intent(in) :: julian logical, dimension(:), intent(in) :: flag_iter, wet @@ -442,10 +442,13 @@ subroutine flake_driver_post_run (im, use_lake_model, h_ML, T_wML, & ! integer, dimension(im), intent(in) :: islmsk real (kind=kind_phys), dimension(:), intent(in) :: & - & lakedepth, tsurf, h_ML, t_wML + & lakedepth, tsurf + real (kind=kind_phys), dimension(:), intent(in), optional :: & + & h_ML, t_wML - real (kind=kind_phys),dimension(:),intent(inout) :: & - & xz, zm, tref, tsfco + real (kind=kind_phys),dimension(:),intent(inout), optional :: & + & xz, zm, tref + real (kind=kind_phys),dimension(:),intent(inout) :: tsfco integer, dimension(:), intent(in) :: use_lake_model diff --git a/physics/flake_driver.meta b/physics/SFC_Models/Lake/Flake/flake_driver.meta similarity index 97% rename from physics/flake_driver.meta rename to physics/SFC_Models/Lake/Flake/flake_driver.meta index e665dc962..f5615ba08 100644 --- a/physics/flake_driver.meta +++ b/physics/SFC_Models/Lake/Flake/flake_driver.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = flake_driver type = scheme - dependencies = flake.F90,machine.F + dependencies = ../../../hooks/machine.F,flake.F90 ######################################################################## [ccpp-arg-table] @@ -311,6 +311,7 @@ type = real kind = kind_phys intent = inout + optional = True [t_wML] standard_name = lake_mixed_layer_temperature long_name = temperature of lake mixing layer @@ -319,6 +320,7 @@ type = real kind = kind_phys intent = inout + optional = True [t_mnw] standard_name = mean_temperature_of_the_water_column long_name = thee mean temperature of the water column @@ -327,6 +329,7 @@ type = real kind = kind_phys intent = inout + optional = True [H_B] standard_name = the_thermally_active_layer_depth_of_the_bottom_sediment long_name = the depth of the thermally active layer of the bottom sediment @@ -335,6 +338,7 @@ type = real kind = kind_phys intent = inout + optional = True [T_B] standard_name = temperature_at_the_bottom_of_the_sediment_upper_layer long_name = the temperature at the bottom of the sediment upper layer @@ -343,6 +347,7 @@ type = real kind = kind_phys intent = inout + optional = True [t_bot1] standard_name = lake_bottom_temperature long_name = the temperature at the water-bottom sediment interface @@ -351,6 +356,7 @@ type = real kind = kind_phys intent = inout + optional = True [t_bot2] standard_name = temperature_for_bottom_layer_of_water long_name = the temperature at the lake bottom layer water @@ -359,6 +365,7 @@ type = real kind = kind_phys intent = inout + optional = True [c_t] standard_name = shape_factor_of_water_temperature_vertical_profile long_name = the shape factor of water temperature vertical profile @@ -367,6 +374,7 @@ type = real kind = kind_phys intent = inout + optional = True [T_snow] standard_name = temperature_of_snow_on_lake long_name = the temperature of snow on a lake @@ -375,6 +383,7 @@ type = real kind = kind_phys intent = inout + optional = True [T_ice] standard_name = surface_skin_temperature_over_ice long_name = surface skin temperature over ice @@ -447,6 +456,7 @@ type = real kind = kind_phys intent = in + optional = True [t_wML] standard_name = lake_mixed_layer_temperature long_name = temperature of lake mixing layer @@ -455,6 +465,7 @@ type = real kind = kind_phys intent = in + optional = True [xz] standard_name = diurnal_thermocline_layer_thickness long_name = diurnal thermocline layer thickness @@ -463,6 +474,7 @@ type = real kind = kind_phys intent = out + optional = True [zm] standard_name = ocean_mixed_layer_thickness long_name = mixed layer thickness @@ -471,6 +483,7 @@ type = real kind = kind_phys intent = out + optional = True [tref] standard_name = reference_sea_surface_temperature long_name = reference/foundation temperature @@ -479,6 +492,7 @@ type = real kind = kind_phys intent = out + optional = True [tfco] standard_name = sea_surface_temperature long_name = sea surface temperature diff --git a/physics/lsm_noah.f b/physics/SFC_Models/Land/Noah/lsm_noah.f similarity index 99% rename from physics/lsm_noah.f rename to physics/SFC_Models/Land/Noah/lsm_noah.f index 836fc3b72..139c978a0 100644 --- a/physics/lsm_noah.f +++ b/physics/SFC_Models/Land/Noah/lsm_noah.f @@ -284,9 +284,10 @@ subroutine lsm_noah_run & ! --- output: real (kind=kind_phys), dimension(:), intent(inout) :: sncovr1, & & qsurf, gflux, drain, evap, hflx, ep, runoff, cmm, chh, & - & evbs, evcw, sbsno, snowc, stm, snohf, smcwlt2, smcref2, & + & evbs, evcw, sbsno, snowc, stm, snohf, smcwlt2, smcref2 + real (kind=kind_phys), dimension(:), intent(inout), optional :: & & wet1, lai, rca - + character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg diff --git a/physics/lsm_noah.meta b/physics/SFC_Models/Land/Noah/lsm_noah.meta similarity index 99% rename from physics/lsm_noah.meta rename to physics/SFC_Models/Land/Noah/lsm_noah.meta index e059a22c6..f26b075d9 100644 --- a/physics/lsm_noah.meta +++ b/physics/SFC_Models/Land/Noah/lsm_noah.meta @@ -1,7 +1,8 @@ [ccpp-table-properties] name = lsm_noah type = scheme - dependencies = funcphys.f90,machine.F,set_soilveg.f,sflx.f,surface_perturbation.F90 + dependencies = ../../../tools/funcphys.f90,../../../hooks/machine.F + dependencies = set_soilveg.f,sflx.f,surface_perturbation.F90,namelist_soilveg.f ######################################################################## [ccpp-arg-table] @@ -749,6 +750,7 @@ type = real kind = kind_phys intent = inout + optional = True [lai] standard_name = leaf_area_index long_name = leaf area index @@ -757,6 +759,7 @@ type = real kind = kind_phys intent = inout + optional = True [rca] standard_name = aerodynamic_resistance_in_canopy long_name = canopy resistance @@ -765,6 +768,7 @@ type = real kind = kind_phys intent = inout + optional = True [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/namelist_soilveg.f b/physics/SFC_Models/Land/Noah/namelist_soilveg.f similarity index 100% rename from physics/namelist_soilveg.f rename to physics/SFC_Models/Land/Noah/namelist_soilveg.f diff --git a/physics/set_soilveg.f b/physics/SFC_Models/Land/Noah/set_soilveg.f similarity index 99% rename from physics/set_soilveg.f rename to physics/SFC_Models/Land/Noah/set_soilveg.f index 37f2c2a73..35f4ace37 100644 --- a/physics/set_soilveg.f +++ b/physics/SFC_Models/Land/Noah/set_soilveg.f @@ -44,6 +44,9 @@ subroutine set_soilveg(me,isot,ivet,nlunit,errmsg,errflg) & DEFINED_SLOPE, FXEXP_DATA, NROOT_DATA, REFKDT_DATA, Z0_DATA, & CZIL_DATA, LAI_DATA, CSOIL_DATA + errmsg = '' + errflg = 0 + cmy end locals if(ivet.eq.2) then diff --git a/physics/sflx.f b/physics/SFC_Models/Land/Noah/sflx.f similarity index 100% rename from physics/sflx.f rename to physics/SFC_Models/Land/Noah/sflx.f diff --git a/physics/surface_perturbation.F90 b/physics/SFC_Models/Land/Noah/surface_perturbation.F90 similarity index 100% rename from physics/surface_perturbation.F90 rename to physics/SFC_Models/Land/Noah/surface_perturbation.F90 diff --git a/physics/module_sf_noahmp_glacier.F90 b/physics/SFC_Models/Land/Noahmp/module_sf_noahmp_glacier.F90 similarity index 99% rename from physics/module_sf_noahmp_glacier.F90 rename to physics/SFC_Models/Land/Noahmp/module_sf_noahmp_glacier.F90 index 6e34c43af..fcbe40a70 100644 --- a/physics/module_sf_noahmp_glacier.F90 +++ b/physics/SFC_Models/Land/Noahmp/module_sf_noahmp_glacier.F90 @@ -2652,7 +2652,7 @@ subroutine snowwater_glacier (nsnow ,nsoil ,imelt ,dt ,sfctmp , & !in !to obtain equilibrium state of snow in glacier region - if(sneqv > mwd) then ! 100 mm -> maximum water depth + if(sneqv > mwd .and. isnow /= 0) then ! 100 mm -> maximum water depth bdsnow = snice(0) / dzsnso(0) snoflow = (sneqv - mwd) snice(0) = snice(0) - snoflow diff --git a/physics/module_sf_noahmplsm.F90 b/physics/SFC_Models/Land/Noahmp/module_sf_noahmplsm.F90 similarity index 99% rename from physics/module_sf_noahmplsm.F90 rename to physics/SFC_Models/Land/Noahmp/module_sf_noahmplsm.F90 index dc7ac54d1..2ee763c02 100644 --- a/physics/module_sf_noahmplsm.F90 +++ b/physics/SFC_Models/Land/Noahmp/module_sf_noahmplsm.F90 @@ -198,7 +198,7 @@ module module_sf_noahmplsm real (kind=kind_phys), parameter :: denice = 917. !< density of ice (kg/m3) integer, private, parameter :: mband = 2 - integer, private, parameter :: nsoil = 9 + integer, private, parameter :: nsoil = 20 integer, private, parameter :: nstage = 8 type noahmp_parameters ! define a noahmp parameters type @@ -747,6 +747,7 @@ subroutine noahmp_sflx (parameters, & canhs = 0. ! -------------------------------------------------------------------------------------------------- + ! re-process atmospheric forcing call atm (parameters,ep_2, epsm1, sfcprs ,sfctmp ,q2 , & @@ -1989,7 +1990,7 @@ subroutine energy (parameters,ice ,vegtyp ,ist ,nsnow ,nsoil , & !in real (kind=kind_phys), parameter :: mpe = 1.e-6 real (kind=kind_phys), parameter :: psiwlt = -150. !metric potential for wilting point (m) - real (kind=kind_phys), parameter :: z0 = 0.002 ! bare-soil roughness length (m) (i.e., under the canopy) + real (kind=kind_phys), parameter :: z0 = 0.015 ! bare-soil roughness length (m) (i.e., under the canopy) ! --------------------------------------------------------------------------------------------------- ! initialize fluxes from veg. fraction @@ -2013,6 +2014,8 @@ subroutine energy (parameters,ice ,vegtyp ,ist ,nsnow ,nsoil , & !in chuc = 0. chv2 = 0. rb = 0. + laisun = 0. + laisha = 0. cdmnv = 0.0 ezpdv = 0.0 @@ -2116,7 +2119,7 @@ subroutine energy (parameters,ice ,vegtyp ,ist ,nsnow ,nsoil , & !in ! thermal properties of soil, snow, lake, and frozen soil call thermoprop (parameters,nsoil ,nsnow ,isnow ,ist ,dzsnso , & !in - dt ,snowh ,snice ,snliq , & !in + dt ,snowh ,snice ,snliq , shdfac, & !in smc ,sh2o ,tg ,stc ,ur , & !in lat ,z0m ,zlvl ,vegtyp , & !in df ,hcpct ,snicev ,snliqv ,epore , & !out @@ -2263,7 +2266,8 @@ subroutine energy (parameters,ice ,vegtyp ,ist ,nsnow ,nsoil , & !in csigmaf1, & !out !jref:start qc ,qsfc ,psfc , & !in - q2v ,chv2, chleaf, chuc) !inout + q2v ,chv2 ,chleaf ,chuc , & + rb) !out ! new coupling code @@ -2463,7 +2467,7 @@ end subroutine energy !>\ingroup NoahMP_LSM subroutine thermoprop (parameters,nsoil ,nsnow ,isnow ,ist ,dzsnso , & !in - dt ,snowh ,snice ,snliq , & !in + dt ,snowh ,snice ,snliq , shdfac, & !in smc ,sh2o ,tg ,stc ,ur , & !in lat ,z0m ,zlvl ,vegtyp , & !in df ,hcpct ,snicev ,snliqv ,epore , & !out @@ -2480,6 +2484,7 @@ subroutine thermoprop (parameters,nsoil ,nsnow ,isnow ,ist ,dzsnso , real (kind=kind_phys) , intent(in) :: dt !< time step [s] real (kind=kind_phys), dimension(-nsnow+1: 0), intent(in) :: snice !< snow ice mass (kg/m2) real (kind=kind_phys), dimension(-nsnow+1: 0), intent(in) :: snliq !< snow liq mass (kg/m2) + real (kind=kind_phys) , intent(in) :: shdfac !< green vegetation fraction [0.0-1.0] real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(in) :: dzsnso !< thickness of snow/soil layers [m] real (kind=kind_phys), dimension( 1:nsoil), intent(in) :: smc !< soil moisture (ice + liq.) [m3/m3] real (kind=kind_phys), dimension( 1:nsoil), intent(in) :: sh2o !< liquid soil moisture [m3/m3] @@ -2539,6 +2544,7 @@ subroutine thermoprop (parameters,nsoil ,nsnow ,isnow ,ist ,dzsnso , ! 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) + df(1) = df(1) * exp (sbeta * shdfac) ! compute lake thermal properties ! (no consideration of turbulent mixing for this version) @@ -2624,10 +2630,10 @@ subroutine csnow (parameters,isnow ,nsnow ,nsoil ,snice ,snliq ,dzsnso ! thermal conductivity of snow do iz = isnow+1, 0 -! tksno(iz) = 3.2217e-6*bdsnoi(iz)**2. ! stieglitz(yen,1965) +! tksno(iz) = 3.2217e-6*bdsnoi(iz)**2. ! stieglitz(yen,1965) ! tksno(iz) = 2e-2+2.5e-6*bdsnoi(iz)*bdsnoi(iz) ! anderson, 1976 -! tksno(iz) = 0.35 ! constant - tksno(iz) = 2.576e-6*bdsnoi(iz)**2. + 0.074 ! verseghy (1991) + tksno(iz) = 0.35 ! constant +! tksno(iz) = 2.576e-6*bdsnoi(iz)**2. + 0.074 ! verseghy (1991) ! tksno(iz) = 2.22*(bdsnoi(iz)/1000.)**1.88 ! douvill(yen, 1981) enddo @@ -3710,7 +3716,8 @@ subroutine vege_flux(parameters,nsnow ,nsoil ,isnow ,vegtyp ,veg , & t2mv ,psnsun ,psnsha ,canhs , & !out csigmaf1, & !out qc ,qsfc ,psfc , & !in - q2v ,cah2 ,chleaf ,chuc ) !inout + q2v ,cah2 ,chleaf ,chuc , & !inout + rb) !out ! -------------------------------------------------------------------------------------------------- ! use newton-raphson iteration to solve for vegetation (tv) and @@ -3834,6 +3841,7 @@ subroutine vege_flux(parameters,nsnow ,nsoil ,isnow ,vegtyp ,veg , & real (kind=kind_phys), intent(out) :: chuc !< under canopy exchange coefficient real (kind=kind_phys), intent(out) :: canhs !< canopy heat storage change (w/m2) real (kind=kind_phys), intent(out) :: q2v !< + real (kind=kind_phys), intent(out) :: rb !< bulk leaf boundary layer resistance (s/m) real (kind=kind_phys) :: cah !< sensible heat conductance, canopy air to zlvl air (m/s) real (kind=kind_phys) :: u10v !< 10 m wind speed in eastward dir (m/s) real (kind=kind_phys) :: v10v !< 10 m wind speed in eastward dir (m/s) @@ -3850,7 +3858,6 @@ subroutine vege_flux(parameters,nsnow ,nsoil ,isnow ,vegtyp ,veg , & real (kind=kind_phys) :: z0mo !roughness length for intermediate output only (m) real (kind=kind_phys) :: z0h !roughness length, sensible heat (m) real (kind=kind_phys) :: z0hg !roughness length, sensible heat (m) - real (kind=kind_phys) :: rb !bulk leaf boundary layer resistance (s/m) real (kind=kind_phys) :: ramc !aerodynamic resistance for momentum (s/m) real (kind=kind_phys) :: rahc !aerodynamic resistance for sensible heat (s/m) real (kind=kind_phys) :: rawc !aerodynamic resistance for water vapor (s/m) @@ -4050,11 +4057,6 @@ subroutine vege_flux(parameters,nsnow ,nsoil ,isnow ,vegtyp ,veg , & end if -! prepare for longwave rad. - - air = -emv*(1.+(1.-emv)*(1.-emg))*lwdn - emv*emg*sb*tg**4 - cir = (2.-emv*(1.-emg))*emv*sb -! if(opt_sfc == 4) then gdx = sqrt(garea1) @@ -4201,6 +4203,11 @@ subroutine vege_flux(parameters,nsnow ,nsoil ,isnow ,vegtyp ,veg , & end if end if +! prepare for longwave rad. + + air = -emv*(1.+(1.-emv)*(1.-emg))*lwdn - emv*emg*sb*tg**4 + cir = (2.-emv*(1.-emg))*emv*sb + ! prepare for sensible heat flux above veg. cah = 1./rahc @@ -4263,7 +4270,7 @@ subroutine vege_flux(parameters,nsnow ,nsoil ,isnow ,vegtyp ,veg , & ! update vegetation surface temperature tv = tv + dtv -! tah = ata + bta*tv ! canopy air t; update here for consistency + tah = ata + bta*tv ! canopy air t; update here for consistency ! for computing m-o length in the next iteration h = rhoair*cpair*(tah - sfctmp) /rahc @@ -4276,15 +4283,7 @@ subroutine vege_flux(parameters,nsnow ,nsoil ,isnow ,vegtyp ,veg , & qfx = (qsfc-qair)*rhoair*caw endif - - if (liter == 1) then - exit loop1 - endif - if (iter >= 5 .and. abs(dtv) <= 0.01 .and. liter == 0) then - liter = 1 - endif - - end do loop1 ! end stability iteration +! after canopy balance, do the under-canopy ground balance ! under-canopy fluxes and tg @@ -4294,8 +4293,6 @@ subroutine vege_flux(parameters,nsnow ,nsoil ,isnow ,vegtyp ,veg , & cev = rhoair*cpair / (gammag*(rawg+rsurf)) ! barlage: change to ground v3.6 cgh = 2.*df(isnow+1)/dzsnso(isnow+1) - loop2: do iter = 1, niterg - t = tdc(tg) call esat(t, esatw, esati, dsatw, dsati) if (t .gt. 0.) then @@ -4321,7 +4318,14 @@ subroutine vege_flux(parameters,nsnow ,nsoil ,isnow ,vegtyp ,veg , & gh = gh + cgh*dtg tg = tg + dtg - end do loop2 + if (liter == 1) then + exit loop1 + endif + if (iter >= 5 .and. abs(dtv) <= 0.01 .and. abs(dtg) <= 0.01 .and. liter == 0) then + liter = 1 ! if conditions are met, then do one final loop + endif + + end do loop1 ! tah = (cah*sfctmp + cvh*tv + cgh*tg)/(cah + cvh + cgh) @@ -4888,7 +4892,7 @@ subroutine bare_flux (parameters,nsnow ,nsoil ,isnow ,dt ,sag , & end if endif ! 4 -! use sfc_diag to calculate t2mv and q2v for opt_sfc=1&3 +! use sfc_diag to calculate t2mb and q2b for opt_sfc=1&3 if(opt_diag ==3) then if(opt_sfc == 1 .or. opt_sfc == 3) then @@ -5818,12 +5822,14 @@ subroutine thermalz0(parameters, fveg, z0m, z0mg, zlvl, if (opt_trs == z0heqz0m) then - z0m_out = exp(fveg * log(z0m) + (1.0 - fveg) * log(z0mg)) +! z0m_out = exp(fveg * log(z0m) + (1.0 - fveg) * log(z0mg)) + z0m_out = fveg * z0m + (1.0 - fveg) * z0mg z0h_out = z0m_out elseif (opt_trs == chen09) then - z0m_out = exp(fveg * log(z0m) + (1.0 - fveg) * log(z0mg)) +! z0m_out = exp(fveg * log(z0m) + (1.0 - fveg) * log(z0mg)) + z0m_out = fveg * z0m + (1.0 - fveg) * z0mg czil = 10.0 ** (- 0.4 * parameters%hvt) reyn = ustarx*z0m_out/viscosity ! Blumel99 eqn 36c @@ -5834,7 +5840,7 @@ subroutine thermalz0(parameters, fveg, z0m, z0mg, zlvl, endif z0h_out = exp( fveg * log(z0m * exp(-czil*0.4*258.2*sqrt(ustarx*z0m))) + & - (1.0 - fveg) * log(max(z0m/exp(kb_sigma_f0),1.0e-6)) ) + (1.0 - fveg) * log(max(z0mg/exp(kb_sigma_f0),1.0e-6)) ) elseif (opt_trs == tessel) then @@ -5881,7 +5887,7 @@ subroutine thermalz0(parameters, fveg, z0m, z0mg, zlvl, z0h_out = z0m_out * 0.01 endif - elseif (opt_trs == blumel99 .or. opt_trs == chen09) then + elseif (opt_trs == chen09 .or. opt_trs == blumel99) then reyn = ustarx*z0m_out/viscosity ! Blumel99 eqn 36c if (reyn > 2.0) then diff --git a/physics/SFC_Models/Land/Noahmp/module_soil_init.f90 b/physics/SFC_Models/Land/Noahmp/module_soil_init.f90 new file mode 100644 index 000000000..910aac04f --- /dev/null +++ b/physics/SFC_Models/Land/Noahmp/module_soil_init.f90 @@ -0,0 +1,220 @@ +module module_soil_init + +use machine, only : kind_phys + +contains + + subroutine noahmp_soil_init(im , & ! in + lsoil_lsm , & ! in + lsoil_input , & ! in + soil_depth_input , & ! in + soil_depth_output , & ! in + soil_moisture_input , & ! in + soil_liquid_input , & ! in + soil_temperature_input , & ! in + soil_type , & ! in + soil_moisture_output , & ! out + soil_liquid_output , & ! out + soil_temperature_output , & ! out + errmsg , & ! out + errflg ) ! out + + + use noahmp_tables, only: smcref_table, smcwlt_table, bexp_table, psisat_table, smcmax_table + + implicit none + + integer, intent(in ) :: im + integer, intent(in ) :: lsoil_lsm + integer, intent(in ) :: lsoil_input + real (kind=kind_phys), dimension(lsoil_input), intent(in ) :: soil_depth_input + real (kind=kind_phys), dimension(lsoil_lsm), intent(in ) :: soil_depth_output + real (kind=kind_phys), dimension(im,lsoil_input), intent(in ) :: soil_moisture_input + real (kind=kind_phys), dimension(im,lsoil_input), intent(in ) :: soil_liquid_input + real (kind=kind_phys), dimension(im,lsoil_input), intent(in ) :: soil_temperature_input + + integer, dimension(im), intent(in ) :: soil_type + + real (kind=kind_phys), dimension(im,lsoil_lsm), intent(inout) :: soil_moisture_output + real (kind=kind_phys), dimension(im,lsoil_lsm), intent(inout) :: soil_liquid_output + real (kind=kind_phys), dimension(im,lsoil_lsm), intent(inout) :: soil_temperature_output + + character(len=*), intent(out ) :: errmsg + integer, intent(out ) :: errflg + +!> local + + real (kind=kind_phys), dimension( 0:lsoil_input+1) :: interp_levels + real (kind=kind_phys), dimension(im,0:lsoil_input+1) :: soil_moisture_interp + real (kind=kind_phys), dimension(im,0:lsoil_input+1) :: soil_temperature_interp + real (kind=kind_phys), dimension( lsoil_input) :: level_bottom_input + real (kind=kind_phys), dimension( lsoil_lsm) :: level_thickness_output + real (kind=kind_phys), dimension( lsoil_lsm) :: level_field_capacity + real (kind=kind_phys), dimension( lsoil_lsm) :: level_porosity + real (kind=kind_phys), dimension( lsoil_lsm) :: level_wilting_point + real (kind=kind_phys), dimension( lsoil_lsm) :: level_water + + integer :: iloc, ilev, lhave, lwant,styp + real (kind=kind_phys) :: porosity, bexp, psisat, soil_matric_potential + real (kind=kind_phys) :: supercool_water, field_capacity, wilting_point + + real (kind=kind_phys), parameter :: latent_heat_fusion = 0.3336e06 + real (kind=kind_phys), parameter :: temperature_freezing = 273.16 + real (kind=kind_phys), parameter :: gravity = 9.80616 + + +! Initialize the CCPP error handling variables + + errmsg = '' + errflg = 0 + + if(lsoil_lsm > lsoil_input)then +! interp_levels includes the top(0m) and bottom of the input soil column + + level_bottom_input(1) = 2.0 * soil_depth_input(1) + do ilev = 2, lsoil_input + level_bottom_input(ilev) = level_bottom_input(ilev-1) + 2.0 * (soil_depth_input(ilev) - level_bottom_input(ilev-1)) + end do + + interp_levels(0) = 0.0 + interp_levels(1:lsoil_input) = soil_depth_input + interp_levels(lsoil_input+1) = level_bottom_input(lsoil_input) + + soil_temperature_interp(:,1:lsoil_input) = soil_temperature_input + soil_moisture_interp (:,1:lsoil_input) = soil_moisture_input + +! Linear creation of top and bottom boundary temperature and moisture + + do iloc = 1 , im + soil_temperature_interp(iloc,0) = soil_temperature_interp(iloc,1) + & + ( interp_levels(0) - interp_levels(1) ) * & + ( soil_temperature_interp(iloc,1) - soil_temperature_interp(iloc,2) ) / & + ( interp_levels(1) - interp_levels(2) ) + soil_temperature_interp(iloc,lsoil_input+1) = soil_temperature_interp(iloc,lsoil_input) - & + ( interp_levels(lsoil_input) - interp_levels(lsoil_input+1) ) * & + ( soil_temperature_interp(iloc,lsoil_input-1) - soil_temperature_interp(iloc,lsoil_input) ) / & + ( interp_levels(lsoil_input-1) - interp_levels(lsoil_input) ) + + + soil_moisture_interp(iloc,0) = soil_moisture_interp(iloc,1) + & + ( interp_levels(0) - interp_levels(1) ) * & + ( soil_moisture_interp(iloc,1) - soil_moisture_interp(iloc,2) ) / & + ( interp_levels(1) - interp_levels(2) ) + soil_moisture_interp(iloc,lsoil_input+1) = soil_moisture_interp(iloc,lsoil_input) - & + ( interp_levels(lsoil_input) - interp_levels(lsoil_input+1) ) * & + ( soil_moisture_interp(iloc,lsoil_input-1) - soil_moisture_interp(iloc,lsoil_input) ) / & + ( interp_levels(lsoil_input-1) - interp_levels(lsoil_input) ) + end do + +! Interpolate temperature and moisture to wanted levels + + level_want1 : do lwant = 1, lsoil_lsm + + if( soil_depth_output(lwant) > interp_levels(lsoil_input+1) ) then ! output_depth below input_depths + do iloc = 1 , im + soil_temperature_output(iloc,lwant) = soil_temperature_interp(iloc,lsoil_input+1) + soil_moisture_output (iloc,lwant) = soil_moisture_interp(iloc,lsoil_input+1) + end do +! exit level_want1 + end if + + level_have1 : do lhave = 0 , lsoil_input + if( ( soil_depth_output(lwant) >= interp_levels(lhave ) ) .and. & + ( soil_depth_output(lwant) <= interp_levels(lhave+1) ) ) then ! output_depth between input_depths + do iloc = 1 , im + soil_temperature_output(iloc,lwant) = soil_temperature_interp(iloc,lhave+1) + & + ( soil_depth_output(lwant) - interp_levels(lhave+1) ) * & + ( soil_temperature_interp(iloc,lhave) - soil_temperature_interp(iloc,lhave+1) ) / & + ( interp_levels(lhave) - interp_levels(lhave+1) ) + soil_moisture_output(iloc,lwant) = soil_moisture_interp(iloc,lhave+1) + & + ( soil_depth_output(lwant) - interp_levels(lhave+1) ) * & + ( soil_moisture_interp(iloc,lhave) - soil_moisture_interp(iloc,lhave+1) ) / & + ( interp_levels(lhave) - interp_levels(lhave+1) ) + end do + exit level_have1 + end if + end do level_have1 + end do level_want1 + + +! Some arbitrary limits to temperature + + where(soil_temperature_output < 200.0) soil_temperature_output = 200.0 + where(soil_temperature_output > 350.0) soil_temperature_output = 350.0 + +! Move water around to keep within [wilting point, field capacity] + + level_thickness_output(1) = 2.0 * soil_depth_output(1) + do ilev = 2, lsoil_lsm + level_thickness_output(ilev) = 2.0 * (soil_depth_output(ilev) - sum(level_thickness_output(1:ilev-1))) + end do + + do iloc = 1 , im + styp = soil_type(iloc) + if(styp .le. 0) styp = 16 + wilting_point = smcwlt_table(styp) + field_capacity = smcref_table(styp) + porosity = smcmax_table(styp) + level_wilting_point = level_thickness_output * wilting_point ! meters of water + level_field_capacity = level_thickness_output * field_capacity + level_porosity = level_thickness_output * porosity + level_water = level_thickness_output * soil_moisture_output(iloc,:) + + do ilev = 1 , lsoil_lsm-1 + if(level_water(ilev) > level_field_capacity(ilev)) then ! move excess water down to next layer + level_water(ilev+1) = level_water(ilev+1) + & + (level_water(ilev) - level_field_capacity(ilev)) + level_water(ilev) = level_field_capacity(ilev) + elseif(level_water(ilev) < level_wilting_point(ilev)) then ! take deficit water from next layer + level_water(ilev+1) = level_water(ilev+1) - & + (level_wilting_point(ilev) - level_water(ilev)) + level_water(ilev) = level_wilting_point(ilev) + end if + end do + + if(level_water(lsoil_lsm) > level_porosity(lsoil_lsm)) then + level_water(lsoil_lsm) = level_porosity(lsoil_lsm) + elseif(level_water(lsoil_lsm) < level_wilting_point(lsoil_lsm)) then + level_water(lsoil_lsm) = level_wilting_point(lsoil_lsm) + end if + + soil_moisture_output(iloc,:) = level_water / level_thickness_output + + end do + +! Initialize liquid soil moisture from total soil moisture and soil temperature using Niu and Yang (2006) + + do iloc = 1 , im + styp = soil_type(iloc) + if(styp .le. 0) styp = 16 + porosity = smcmax_table(styp) + bexp = bexp_table(styp) + psisat = psisat_table(styp) + do ilev = 1 , lsoil_lsm + if(soil_temperature_output(iloc,ilev) >= temperature_freezing) then + soil_liquid_output(iloc,ilev) = soil_moisture_output(iloc,ilev) + else + soil_matric_potential = latent_heat_fusion * (temperature_freezing - soil_temperature_output(iloc,ilev)) / & + (gravity * soil_temperature_output(iloc,ilev)) + supercool_water = porosity*(soil_matric_potential/psisat)**(-1./bexp) + soil_liquid_output(iloc,ilev) = supercool_water + end if + end do + end do + + else +! no need to do any interpolation if lsoil_input=lsoil_lsm + + do iloc = 1 , im + do ilev = 1 , lsoil_lsm + soil_moisture_output(iloc,ilev) = soil_moisture_input(iloc,ilev) + soil_liquid_output(iloc,ilev) = soil_liquid_input(iloc,ilev) + soil_temperature_output(iloc,ilev)= soil_temperature_input(iloc,ilev) + enddo + enddo + + endif + + end subroutine noahmp_soil_init + +end module module_soil_init diff --git a/physics/noahmp_tables.f90 b/physics/SFC_Models/Land/Noahmp/noahmp_tables.f90 similarity index 99% rename from physics/noahmp_tables.f90 rename to physics/SFC_Models/Land/Noahmp/noahmp_tables.f90 index 3b06d7f53..753c8ff24 100644 --- a/physics/noahmp_tables.f90 +++ b/physics/SFC_Models/Land/Noahmp/noahmp_tables.f90 @@ -484,6 +484,9 @@ subroutine read_mp_table_parameters(errmsg, errflg) sr2006_psi_e_a, sr2006_psi_e_b, sr2006_psi_e_c, sr2006_smcmax_a, & sr2006_smcmax_b + errmsg = '' + errflg = 0 + ! initialize our variables to bad values, so that if the namelist read fails, we come to a screeching halt as soon as we try to use anything. ! vegetation parameters isurban_table = -99999 @@ -783,7 +786,7 @@ subroutine read_mp_table_parameters(errmsg, errflg) open(15, status='old', form='formatted', action='read', iostat=ierr) end if if ( ierr /= 0 ) then - errmsg = 'warning: cannot find file noahmptable.tb' + errmsg = 'warning: cannot find file noahmptable.tbl' errflg = 1 return ! write(*,'("warning: cannot find file noahmptable.tbl")') @@ -914,7 +917,7 @@ subroutine read_mp_table_parameters(errmsg, errflg) open(15, status='old', form='formatted', action='read', iostat=ierr) end if if ( ierr /= 0 ) then - errmsg = 'warning: cannot find file noahmptable.tb' + errmsg = 'warning: cannot find file noahmptable.tbl' errflg = 1 return ! write(*,'("warning: cannot find file noahmptable.tbl")') @@ -957,7 +960,7 @@ subroutine read_mp_table_parameters(errmsg, errflg) open(15, status='old', form='formatted', action='read', iostat=ierr) end if if ( ierr /= 0 ) then - errmsg = 'warning: cannot find file noahmptable.tb' + errmsg = 'warning: cannot find file noahmptable.tbl' errflg = 1 return ! write(*,'("warning: cannot find file noahmptable.tbl")') @@ -982,7 +985,7 @@ subroutine read_mp_table_parameters(errmsg, errflg) open(15, status='old', form='formatted', action='read', iostat=ierr) end if if (ierr /= 0) then - errmsg = 'warning: cannot find file noahmptable.tb' + errmsg = 'warning: cannot find file noahmptable.tbl' errflg = 1 return ! write(*,'("warning: cannot find file noahmptable.tbl")') @@ -1011,7 +1014,7 @@ subroutine read_mp_table_parameters(errmsg, errflg) open(15, status='old', form='formatted', action='read', iostat=ierr) end if if (ierr /= 0) then - errmsg = 'warning: cannot find file noahmptable.tb' + errmsg = 'warning: cannot find file noahmptable.tbl' errflg = 1 return ! write(*,'("warning: cannot find file noahmptable.tbl")') @@ -1069,7 +1072,7 @@ subroutine read_mp_table_parameters(errmsg, errflg) open(15, status='old', form='formatted', action='read', iostat=ierr) end if if (ierr /= 0) then - errmsg = 'warning: cannot find file noahmptable.tb' + errmsg = 'warning: cannot find file noahmptable.tbl' errflg = 1 return ! write(*,'("warning: cannot find file noahmptable.tbl")') @@ -1096,7 +1099,7 @@ subroutine read_mp_table_parameters(errmsg, errflg) open(15, status='old', form='formatted', action='read', iostat=ierr) end if if (ierr /= 0) then - errmsg = 'warning: cannot find file noahmptable.tb' + errmsg = 'warning: cannot find file noahmptable.tbl' errflg = 1 return ! write(*,'("warning: cannot find file noahmptable.tbl")') @@ -1249,7 +1252,7 @@ subroutine read_mp_table_parameters(errmsg, errflg) open(15, status='old', form='formatted', action='read', iostat=ierr) end if if (ierr /= 0) then - errmsg = 'warning: cannot find file noahmptable.tb' + errmsg = 'warning: cannot find file noahmptable.tbl' errflg = 1 return ! write(*,'("warning: cannot find file noahmptable.tbl")') @@ -1278,7 +1281,7 @@ subroutine read_mp_table_parameters(errmsg, errflg) open(15, status='old', form='formatted', action='read', iostat=ierr) end if if (ierr /= 0) then - errmsg = 'warning: cannot find file noahmptable.tb' + errmsg = 'warning: cannot find file noahmptable.tbl' errflg = 1 return ! write(*,'("warning: cannot find file noahmptable.tbl")') diff --git a/physics/noahmpdrv.F90 b/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 similarity index 85% rename from physics/noahmpdrv.F90 rename to physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 index b998a9e4f..e02236061 100644 --- a/physics/noahmpdrv.F90 +++ b/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 @@ -12,7 +12,8 @@ module noahmpdrv use module_sf_noahmplsm - use module_mp_soil_init +! use module_mp_soil_init + use module_soil_init implicit none @@ -32,12 +33,11 @@ module noahmpdrv !! subroutine noahmpdrv_init(im,lsm, lsm_noahmp, me, isot, ivegsrc, & nlunit, pores, resid, & - lsm_cold_start,lsoil,lsoil_lsm, & - soiltyp,vegtype, & - tskin,tg3, & + lsoil,zsi,lsoil_lsm, & + zs,soiltyp,vegtype, & smc,slc,stc, & smois,tslb,sh2o, & !out - do_mynnsfclay, & + do_mynnsfclay,do_mynnedmf, & errmsg, errflg) use machine, only: kind_phys @@ -52,15 +52,12 @@ subroutine noahmpdrv_init(im,lsm, lsm_noahmp, me, isot, ivegsrc, & real (kind=kind_phys), dimension(:), intent(out) :: pores, resid - logical, intent(in) :: lsm_cold_start integer, intent(in) :: lsoil, lsoil_lsm + real (kind=kind_phys), dimension(:), intent(in) :: zsi,zs integer, dimension(:), intent(in) :: soiltyp integer, dimension(:), intent(in) :: vegtype - real (kind=kind_phys), dimension(:), intent(in) :: tskin - real (kind=kind_phys), dimension(:), intent(in) :: tg3 - real (kind=kind_phys), dimension(:,:), intent(in) :: smc real (kind=kind_phys), dimension(:,:), intent(in) :: slc real (kind=kind_phys), dimension(:,:), intent(in) :: stc @@ -71,29 +68,52 @@ subroutine noahmpdrv_init(im,lsm, lsm_noahmp, me, isot, ivegsrc, & logical, intent(in) :: do_mynnsfclay + logical, intent(in) :: do_mynnedmf character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg - real(kind=kind_phys), save :: zsin(4),zlvlin(4),dzsin(4) - real(kind=kind_phys), save :: zsout(9),zlvlout(9),dzsout(9) +! real(kind=kind_phys), save :: zsin(4),zlvlin(4),dzsin(4) +! real(kind=kind_phys), save :: zsout(9),zlvlout(9),dzsout(9) + real(kind=kind_phys), pointer :: zsin(:),dzsin(:) + real(kind=kind_phys), pointer :: zsout(:),dzsout(:) + integer n ! -- for zsin to zsout interpolation - hard wired from 4 -> 9 levels for now - data zsin / 0.05, 0.25, 0.70, 1.50 / ! Input Noah mid-levels for interpolation - data zlvlin / 0.10, 0.40, 1.00, 2.00 / ! Noah layer bottom interface levels - data dzsin /0.10, 0.30,0.6, 1.0 / ! Noah layer thickness +! data zsin / 0.05, 0.25, 0.70, 1.50 / ! Input Noah mid-levels for interpolation +! data zlvlin / 0.10, 0.40, 1.00, 2.00 / ! Noah layer bottom interface levels +! data dzsin /0.10, 0.30,0.6, 1.0 / ! Noah layer thickness + +! data zsout /0.01,0.04,0.10,0.30,0.60, 1.00,1.60, 3.00,4.56 / ! Noah MP mid-level calculation - one more bottom +! data zlvlout /0.02, 0.06, 0.14, 0.46, 0.74, 1.26, 1.94, 4.06,5.06 / ! Noah MP equiv. levels - interface +! data dzsout / 0.02,0.04,0.08,0.32,0.28,0.52,0.68,2.12,1.00 / ! Noah MP thickness - data zsout /0.01,0.04,0.10,0.30,0.60, 1.00,1.60, 3.00,4.56 / ! Noah MP mid-level calculation - one more bottom - data zlvlout /0.02, 0.06, 0.14, 0.46, 0.74, 1.26, 1.94, 4.06,5.06 / ! Noah MP equiv. levels - interface - data dzsout / 0.02,0.04,0.08,0.32,0.28,0.52,0.68,2.12,1.00 / ! Noah MP thickness + allocate (zsin(lsoil)) + allocate (dzsin(lsoil)) + allocate (zsout(lsoil_lsm)) + allocate (dzsout(lsoil_lsm)) + zsin(1)=zsi(1)*-0.5 + dzsin(1)=zsi(1)*-1. + do n=2,lsoil + zsin(n)=(zsi(n-1)+0.5*(zsi(n)-zsi(n-1)))*-1. + dzsin(n)=(zsi(n)-zsi(n-1))*-1. + enddo + zsout(1)=zs(1)*-0.5 + dzsout(1)=zs(1)*-1. + do n=2,lsoil_lsm + zsout(n)=(zs(n-1)+0.5*(zs(n)-zs(n-1)))*-1. + dzsout(n)=(zs(n)-zs(n-1))*-1. + enddo + ! Initialize CCPP error handling variables errmsg = '' errflg = 0 + ! Consistency checks if (lsm/=lsm_noahmp) then write(errmsg,'(*(a))') 'Logic error: namelist choice of ', & @@ -102,12 +122,12 @@ subroutine noahmpdrv_init(im,lsm, lsm_noahmp, me, isot, ivegsrc, & return end if - if (lsoil_lsm /= 9) then - errmsg = 'This version of NOAHMP LSM expects # of soil layers is 9 '// & - 'namelist parameter is not 9. Exiting...' - errflg = 1 - return - end if +! if (lsoil_lsm /= 9) then +! errmsg = 'This version of NOAHMP LSM expects # of soil layers is 9 '// & +! 'namelist parameter is not 9. Exiting...' +! errflg = 1 +! return +! end if if (ivegsrc /= 1) then errmsg = 'The NOAHMP LSM expects that the ivegsrc physics '// & @@ -121,6 +141,12 @@ subroutine noahmpdrv_init(im,lsm, lsm_noahmp, me, isot, ivegsrc, & errflg = 1 return end if + if ( do_mynnsfclay .and. .not. do_mynnedmf) then + errmsg = 'Problem : do_mynnsfclay = .true.' // & + 'but mynnpbl is .false.. Exiting ...' + errflg = 1 + return + end if !--- initialize soil vegetation @@ -139,15 +165,22 @@ subroutine noahmpdrv_init(im,lsm, lsm_noahmp, me, isot, ivegsrc, & pores (:) = smcmax_table (:) ! Noah MP tables values used resid (:) = smcdry_table (:) - ! -- call to init 9-layer Noah MP soil layers from coldstart - - if ( lsoil /= lsoil_lsm) then + ! -- call to init n-layer Noah MP soil layers from coldstart - call noahmpsoilinit (lsm_cold_start, im, lsoil_lsm,lsoil,& - zsout,dzsout,tskin,tg3,smc,slc,stc, & - sh2o,tslb,smois,soiltyp,vegtype, & - errmsg, errflg) - endif + call noahmp_soil_init ( im , & ! in + lsoil_lsm , & ! in + lsoil , & ! in + zsin , & ! in + zsout , & ! in + smc , & ! in + slc , & ! in + stc , & ! in + soiltyp , & ! in + smois , & ! out + sh2o , & ! out + tslb , & ! out + errmsg , & ! out + errflg ) ! out end subroutine noahmpdrv_init @@ -179,13 +212,13 @@ subroutine noahmpdrv_run & ( im, km, lsnowl, itime, ps, u1, v1, t1, q1, soiltyp,soilcol,& vegtype, sigmaf, dlwflx, dswsfc, snet, delt, tg3, cm, ch, & prsl1, prslk1, prslki, prsik1, zf,pblh, dry, wind, slopetyp,& - shdmin, shdmax, snoalb, sfalb, flag_iter,con_g, & + shdmin, shdmax, snoalb, sfalb, flag_iter,con_g,zs,dzs, & idveg, iopt_crs, iopt_btr, iopt_run, iopt_sfc, iopt_frz, & iopt_inf, iopt_rad, iopt_alb, iopt_snf, iopt_tbot,iopt_stc,& iopt_trs,iopt_diag,xlatin, xcoszin, iyrlen, julian, garea, & rainn_mp, rainc_mp, snow_mp, graupel_mp, ice_mp, rhonewsn1,& con_hvap, con_cp, con_jcal, rhoh2o, con_eps, con_epsm1, & - con_fvirt, con_rd, con_hfus, thsfc_loc, & + con_fvirt, con_rd, con_hfus, thsfc_loc, cpllnd, cpllnd2atm,& ! --- in/outs: weasd, snwdph, tskin, tprcp, srflag, smois, tslb, sh2o, & @@ -206,7 +239,7 @@ subroutine noahmpdrv_run & sncovr1, qsurf, gflux, drain, evap, hflx, ep, runoff, & cmm, chh, evbs, evcw, sbsno, pah, ecan, etran, edir, snowc,& stm, snohf,smcwlt2, smcref2, wet1, t2mmp, q2mp,zvfun, & - ztmax, errmsg, errflg, & + ztmax, rca, errmsg, errflg, & canopy_heat_storage_ccpp, & rainfall_ccpp, & sw_absorbed_total_ccpp, & @@ -263,16 +296,18 @@ subroutine noahmpdrv_run & real(kind=kind_phys), parameter :: a4 = 35.86 real(kind=kind_phys), parameter :: a23m4 = a2*(a3-a4) real(kind=kind_phys), intent(in) :: con_g + real(kind=kind_phys), dimension(:) , intent(in) :: zs ! depth of soil levels for land surface model + real(kind=kind_phys), dimension(:) , intent(in) :: dzs ! thickness of soil levels for land surface model real, parameter :: undefined = 9.99e20_kind_phys - integer, parameter :: nsoil = 9 ! hardwired to lsoil_lsm for now +! integer, parameter :: nsoil = 9 ! hardwired to lsoil_lsm for now integer, parameter :: nsnow = 3 ! max. snow layers integer, parameter :: iz0tlnd = 0 ! z0t treatment option - real(kind=kind_phys), save :: zsoil(nsoil) - data zsoil / -0.02, -0.06, -0.14, -0.46, -0.74, -1.26, -1.94, -4.06, -5.06 / +! real(kind=kind_phys), save :: zsoil(nsoil) +! data zsoil / -0.02, -0.06, -0.14, -0.46, -0.74, -1.26, -1.94, -4.06, -5.06 / ! ! --- CCPP interface fields (in call order) @@ -341,11 +376,11 @@ subroutine noahmpdrv_run & integer , intent(in) :: iyrlen ! year length [days] real(kind=kind_phys) , intent(in) :: julian ! julian day of year real(kind=kind_phys), dimension(:) , intent(in) :: garea ! area of the grid cell - real(kind=kind_phys), dimension(:) , intent(in) :: rainn_mp ! microphysics non-convective precipitation [mm] - real(kind=kind_phys), dimension(:) , intent(in) :: rainc_mp ! microphysics convective precipitation [mm] - real(kind=kind_phys), dimension(:) , intent(in) :: snow_mp ! microphysics snow [mm] - real(kind=kind_phys), dimension(:) , intent(in) :: graupel_mp ! microphysics graupel [mm] - real(kind=kind_phys), dimension(:) , intent(in) :: ice_mp ! microphysics ice/hail [mm] + real(kind=kind_phys), dimension(:) , intent(in), optional :: rainn_mp ! microphysics non-convective precipitation [mm] + real(kind=kind_phys), dimension(:) , intent(in), optional :: rainc_mp ! microphysics convective precipitation [mm] + real(kind=kind_phys), dimension(:) , intent(in), optional :: snow_mp ! microphysics snow [mm] + real(kind=kind_phys), dimension(:) , intent(in), optional :: graupel_mp ! microphysics graupel [mm] + real(kind=kind_phys), dimension(:) , intent(in), optional :: ice_mp ! microphysics ice/hail [mm] real(kind=kind_phys), dimension(:) , intent(in) :: rhonewsn1 ! precipitation ice density (kg/m^3) real(kind=kind_phys) , intent(in) :: con_hvap ! latent heat condensation [J/kg] real(kind=kind_phys) , intent(in) :: con_cp ! specific heat air [J/kg/K] @@ -359,6 +394,9 @@ subroutine noahmpdrv_run & logical , intent(in) :: thsfc_loc ! Flag for reference pressure in theta calculation + logical , intent(in) :: cpllnd ! Flag for land coupling (atm->lnd) + logical , intent(in) :: cpllnd2atm ! Flag for land coupling (lnd->atm) + real(kind=kind_phys), dimension(:) , intent(inout) :: weasd ! water equivalent accumulated snow depth [mm] real(kind=kind_phys), dimension(:) , intent(inout) :: snwdph ! snow depth [mm] real(kind=kind_phys), dimension(:) , intent(inout) :: tskin ! ground surface skin temperature [K] @@ -382,40 +420,40 @@ subroutine noahmpdrv_run & real(kind=kind_phys), dimension(:) , intent(inout) :: fm101 ! MOS function for momentum evaulated @ 10 m real(kind=kind_phys), dimension(:) , intent(inout) :: fh21 ! MOS function for heat evaulated @ 2m - real(kind=kind_phys), dimension(:) , intent(inout) :: snowxy ! actual no. of snow layers - real(kind=kind_phys), dimension(:) , intent(inout) :: tvxy ! vegetation leaf temperature [K] - real(kind=kind_phys), dimension(:) , intent(inout) :: tgxy ! bulk ground surface temperature [K] - real(kind=kind_phys), dimension(:) , intent(inout) :: canicexy ! canopy-intercepted ice [mm] - real(kind=kind_phys), dimension(:) , intent(inout) :: canliqxy ! canopy-intercepted liquid water [mm] - real(kind=kind_phys), dimension(:) , intent(inout) :: eahxy ! canopy air vapor pressure [Pa] - real(kind=kind_phys), dimension(:) , intent(inout) :: tahxy ! canopy air temperature [K] - real(kind=kind_phys), dimension(:) , intent(inout) :: cmxy ! bulk momentum drag coefficient [m/s] - real(kind=kind_phys), dimension(:) , intent(inout) :: chxy ! bulk sensible heat exchange coefficient [m/s] - real(kind=kind_phys), dimension(:) , intent(inout) :: fwetxy ! wetted or snowed fraction of the canopy [-] - real(kind=kind_phys), dimension(:) , intent(inout) :: sneqvoxy ! snow mass at last time step[mm h2o] - real(kind=kind_phys), dimension(:) , intent(inout) :: alboldxy ! snow albedo at last time step [-] - real(kind=kind_phys), dimension(:) , intent(inout) :: qsnowxy ! snowfall on the ground [mm/s] - real(kind=kind_phys), dimension(:) , intent(inout) :: wslakexy ! lake water storage [mm] - real(kind=kind_phys), dimension(:) , intent(inout) :: zwtxy ! water table depth [m] - real(kind=kind_phys), dimension(:) , intent(inout) :: waxy ! water in the "aquifer" [mm] - real(kind=kind_phys), dimension(:) , intent(inout) :: wtxy ! groundwater storage [mm] - real(kind=kind_phys), dimension(:,lsnowl:), intent(inout) :: tsnoxy ! snow temperature [K] - real(kind=kind_phys), dimension(:,lsnowl:), intent(inout) :: zsnsoxy ! snow/soil layer depth [m] - real(kind=kind_phys), dimension(:,lsnowl:), intent(inout) :: snicexy ! snow layer ice [mm] - real(kind=kind_phys), dimension(:,lsnowl:), intent(inout) :: snliqxy ! snow layer liquid water [mm] - real(kind=kind_phys), dimension(:) , intent(inout) :: lfmassxy ! leaf mass [g/m2] - real(kind=kind_phys), dimension(:) , intent(inout) :: rtmassxy ! mass of fine roots [g/m2] - real(kind=kind_phys), dimension(:) , intent(inout) :: stmassxy ! stem mass [g/m2] - real(kind=kind_phys), dimension(:) , intent(inout) :: woodxy ! mass of wood (incl. woody roots) [g/m2] - real(kind=kind_phys), dimension(:) , intent(inout) :: stblcpxy ! stable carbon in deep soil [g/m2] - real(kind=kind_phys), dimension(:) , intent(inout) :: fastcpxy ! short-lived carbon, shallow soil [g/m2] - real(kind=kind_phys), dimension(:) , intent(inout) :: xlaixy ! leaf area index [m2/m2] - real(kind=kind_phys), dimension(:) , intent(inout) :: xsaixy ! stem area index [m2/m2] - real(kind=kind_phys), dimension(:) , intent(inout) :: taussxy ! snow age factor [-] - real(kind=kind_phys), dimension(:,:) , intent(inout) :: smoiseq ! eq volumetric soil moisture [m3/m3] - real(kind=kind_phys), dimension(:) , intent(inout) :: smcwtdxy ! soil moisture content in the layer to the water table when deep - real(kind=kind_phys), dimension(:) , intent(inout) :: deeprechxy ! recharge to the water table when deep - real(kind=kind_phys), dimension(:) , intent(inout) :: rechxy ! recharge to the water table + real(kind=kind_phys), dimension(:) , intent(inout), optional :: snowxy ! actual no. of snow layers + real(kind=kind_phys), dimension(:) , intent(inout), optional :: tvxy ! vegetation leaf temperature [K] + real(kind=kind_phys), dimension(:) , intent(inout), optional :: tgxy ! bulk ground surface temperature [K] + real(kind=kind_phys), dimension(:) , intent(inout), optional :: canicexy ! canopy-intercepted ice [mm] + real(kind=kind_phys), dimension(:) , intent(inout), optional :: canliqxy ! canopy-intercepted liquid water [mm] + real(kind=kind_phys), dimension(:) , intent(inout), optional :: eahxy ! canopy air vapor pressure [Pa] + real(kind=kind_phys), dimension(:) , intent(inout), optional :: tahxy ! canopy air temperature [K] + real(kind=kind_phys), dimension(:) , intent(inout), optional :: cmxy ! bulk momentum drag coefficient [m/s] + real(kind=kind_phys), dimension(:) , intent(inout), optional :: chxy ! bulk sensible heat exchange coefficient [m/s] + real(kind=kind_phys), dimension(:) , intent(inout), optional :: fwetxy ! wetted or snowed fraction of the canopy [-] + real(kind=kind_phys), dimension(:) , intent(inout), optional :: sneqvoxy ! snow mass at last time step[mm h2o] + real(kind=kind_phys), dimension(:) , intent(inout), optional :: alboldxy ! snow albedo at last time step [-] + real(kind=kind_phys), dimension(:) , intent(inout), optional :: qsnowxy ! snowfall on the ground [mm/s] + real(kind=kind_phys), dimension(:) , intent(inout), optional :: wslakexy ! lake water storage [mm] + real(kind=kind_phys), dimension(:) , intent(inout), optional :: zwtxy ! water table depth [m] + real(kind=kind_phys), dimension(:) , intent(inout), optional :: waxy ! water in the "aquifer" [mm] + real(kind=kind_phys), dimension(:) , intent(inout), optional :: wtxy ! groundwater storage [mm] + real(kind=kind_phys), dimension(:,lsnowl:), intent(inout), optional :: tsnoxy ! snow temperature [K] + real(kind=kind_phys), dimension(:,lsnowl:), intent(inout), optional :: zsnsoxy ! snow/soil layer depth [m] + real(kind=kind_phys), dimension(:,lsnowl:), intent(inout), optional :: snicexy ! snow layer ice [mm] + real(kind=kind_phys), dimension(:,lsnowl:), intent(inout), optional :: snliqxy ! snow layer liquid water [mm] + real(kind=kind_phys), dimension(:) , intent(inout), optional :: lfmassxy ! leaf mass [g/m2] + real(kind=kind_phys), dimension(:) , intent(inout), optional :: rtmassxy ! mass of fine roots [g/m2] + real(kind=kind_phys), dimension(:) , intent(inout), optional :: stmassxy ! stem mass [g/m2] + real(kind=kind_phys), dimension(:) , intent(inout), optional :: woodxy ! mass of wood (incl. woody roots) [g/m2] + real(kind=kind_phys), dimension(:) , intent(inout), optional :: stblcpxy ! stable carbon in deep soil [g/m2] + real(kind=kind_phys), dimension(:) , intent(inout), optional :: fastcpxy ! short-lived carbon, shallow soil [g/m2] + real(kind=kind_phys), dimension(:) , intent(inout), optional :: xlaixy ! leaf area index [m2/m2] + real(kind=kind_phys), dimension(:) , intent(inout), optional :: xsaixy ! stem area index [m2/m2] + real(kind=kind_phys), dimension(:) , intent(inout), optional :: taussxy ! snow age factor [-] + real(kind=kind_phys), dimension(:,:) , intent(inout), optional :: smoiseq ! eq volumetric soil moisture [m3/m3] + real(kind=kind_phys), dimension(:) , intent(inout), optional :: smcwtdxy ! soil moisture content in the layer to the water table when deep + real(kind=kind_phys), dimension(:) , intent(inout), optional :: deeprechxy ! recharge to the water table when deep + real(kind=kind_phys), dimension(:) , intent(inout), optional :: rechxy ! recharge to the water table real(kind=kind_phys), dimension(:) , intent(out) :: albdvis ! albedo - direct visible [fraction] real(kind=kind_phys), dimension(:) , intent(out) :: albdnir ! albedo - direct NIR [fraction] real(kind=kind_phys), dimension(:) , intent(out) :: albivis ! albedo - diffuse visible [fraction] @@ -443,11 +481,13 @@ subroutine noahmpdrv_run & real(kind=kind_phys), dimension(:) , intent(out) :: snohf ! snow/freezing-rain latent heat flux [W/m2] real(kind=kind_phys), dimension(:) , intent(out) :: smcwlt2 ! dry soil moisture threshold [m3/m3] real(kind=kind_phys), dimension(:) , intent(out) :: smcref2 ! soil moisture threshold [m3/m3] - real(kind=kind_phys), dimension(:) , intent(out) :: wet1 ! normalized surface soil saturated fraction - real(kind=kind_phys), dimension(:) , intent(out) :: t2mmp ! combined T2m from tiles - real(kind=kind_phys), dimension(:) , intent(out) :: q2mp ! combined q2m from tiles + real(kind=kind_phys), dimension(:) , intent(out), optional :: wet1 ! normalized surface soil saturated fraction + real(kind=kind_phys), dimension(:) , intent(out), optional :: t2mmp ! combined T2m from tiles + real(kind=kind_phys), dimension(:) , intent(out), optional :: q2mp ! combined q2m from tiles real(kind=kind_phys), dimension(:) , intent(out) :: zvfun ! real(kind=kind_phys), dimension(:) , intent(out) :: ztmax ! thermal roughness length + real(kind=kind_phys), dimension(:) , intent(out), optional :: rca ! total canopy/stomatal resistance (s/m) + character(len=*) , intent(out) :: errmsg integer , intent(out) :: errflg @@ -501,7 +541,7 @@ subroutine noahmpdrv_run & integer :: iopt_pedo = 1 ! option for pedotransfer function integer :: iopt_crop = 0 ! option for crop model integer :: iopt_gla = 2 ! option for glacier treatment - integer :: iopt_z0m = 2 ! option for z0m treatment + integer :: iopt_z0m = 1 ! option for z0m treatment ! ! --- local inputs to noah-mp and glacier subroutines; listed in order in noah-mp call @@ -517,7 +557,7 @@ subroutine noahmpdrv_run & real (kind=kind_phys) :: spatial_scale ! in | spatial scale [m] (not used in noah-mp) real (kind=kind_phys) :: atmosphere_thickness ! in | thickness of lowest atmo layer [m] (not used in noah-mp) integer :: soil_levels ! in | soil levels - real (kind=kind_phys), dimension( 1:nsoil) :: soil_interface_depth ! in | soil layer-bottom depth from surface [m] + real (kind=kind_phys), dimension( 1:km) :: soil_interface_depth ! in | soil layer-bottom depth from surface [m] integer :: max_snow_levels ! in | maximum number of snow levels real (kind=kind_phys) :: vegetation_frac ! in | vegetation fraction [0.0-1.0] real (kind=kind_phys) :: area_grid ! in | @@ -526,7 +566,7 @@ subroutine noahmpdrv_run & integer :: ice_flag ! in | ice flag (1->ice) integer :: surface_type ! in | surface type flag 1->soil; 2->lake integer :: crop_type ! in | crop type category - real (kind=kind_phys), dimension( 1:nsoil) :: eq_soil_water_vol ! in | (opt_run=5) equilibrium soil water content [m3/m3] + real (kind=kind_phys), dimension( 1:km) :: eq_soil_water_vol ! in | (opt_run=5) equilibrium soil water content [m3/m3] real (kind=kind_phys) :: temperature_forcing ! in | forcing air temperature [K] real (kind=kind_phys) :: air_pressure_surface ! in | surface air pressure [Pa] real (kind=kind_phys) :: air_pressure_forcing ! in | forcing air pressure [Pa] @@ -551,9 +591,9 @@ subroutine noahmpdrv_run & real (kind=kind_phys) :: forcing_height ! inout | forcing height [m] real (kind=kind_phys) :: snow_albedo_old ! inout | snow albedo at last time step (class option) [-] real (kind=kind_phys) :: snow_water_equiv_old ! inout | snow water equivalent at last time step [mm] - real (kind=kind_phys), dimension(-nsnow+1:nsoil) :: temperature_snow_soil ! inout | snow/soil temperature [K] - real (kind=kind_phys), dimension( 1:nsoil) :: soil_liquid_vol ! inout | volumetric liquid soil moisture [m3/m3] - real (kind=kind_phys), dimension( 1:nsoil) :: soil_moisture_vol ! inout | volumetric soil moisture (ice + liq.) [m3/m3] + real (kind=kind_phys), dimension(-nsnow+1:km) :: temperature_snow_soil ! inout | snow/soil temperature [K] + real (kind=kind_phys), dimension( 1:km) :: soil_liquid_vol ! inout | volumetric liquid soil moisture [m3/m3] + real (kind=kind_phys), dimension( 1:km) :: soil_moisture_vol ! inout | volumetric soil moisture (ice + liq.) [m3/m3] real (kind=kind_phys) :: surface_temperature ! out | surface aerodynamic temp @@ -568,7 +608,7 @@ subroutine noahmpdrv_run & real (kind=kind_phys) :: snowfall ! inout | land model partitioned snowfall [mm/s] real (kind=kind_phys) :: rainfall ! inout | land model partitioned rainfall [mm/s] integer :: snow_levels ! inout | active snow levels [-] - real (kind=kind_phys), dimension(-nsnow+1:nsoil) :: interface_depth ! inout | layer-bottom depth from snow surf [m] + real (kind=kind_phys), dimension(-nsnow+1:km) :: interface_depth ! inout | layer-bottom depth from snow surf [m] real (kind=kind_phys) :: snow_depth ! inout | snow depth [m] real (kind=kind_phys) :: snow_water_equiv ! inout | snow water equivalent [mm] real (kind=kind_phys), dimension(-nsnow+1: 0) :: snow_level_ice ! inout | snow level ice [mm] @@ -671,7 +711,7 @@ subroutine noahmpdrv_run & real (kind=kind_phys) :: canopy_heat_storage ! out | within-canopy heat [W/m2] real (kind=kind_phys) :: spec_humid_sfc_veg ! out | surface specific humidty over vegetation [kg/kg] real (kind=kind_phys) :: spec_humid_sfc_bare ! out | surface specific humidty over bare soil [kg/kg] - + real (kind=kind_phys) :: ustarx ! inout |surface friction velocity real (kind=kind_phys) :: prslkix ! in exner function real (kind=kind_phys) :: prsik1x ! in exner function @@ -692,7 +732,7 @@ subroutine noahmpdrv_run & ! --- local variable ! - integer :: soil_category(nsoil) + integer :: soil_category(km) integer :: slope_category integer :: soil_color_category character(len=256) :: dataset_identifier @@ -709,6 +749,7 @@ subroutine noahmpdrv_run & real (kind=kind_phys) :: precip_freeze_frac_in ! used for penman calculation real (kind=kind_phys) :: virtfac1 ! virtual factor + real (kind=kind_phys) :: tflux ! surface flux temp real (kind=kind_phys) :: tvs1 ! surface virtual temp real (kind=kind_phys) :: vptemp ! virtual potential temp @@ -735,7 +776,12 @@ subroutine noahmpdrv_run & errmsg = '' errflg = 0 -do i = 1, im +! +! --- Just return if external land component is activated for two-way interaction +! + if (cpllnd .and. cpllnd2atm) return + + do i = 1, im if (flag_iter(i) .and. dry(i)) then @@ -765,7 +811,7 @@ subroutine noahmpdrv_run & spatial_scale = -9999.0 atmosphere_thickness = -9999.0 soil_levels = km - soil_interface_depth = zsoil + soil_interface_depth = zs max_snow_levels = nsnow vegetation_frac = sigmaf(i) max_vegetation_frac = shdmax(i) @@ -893,7 +939,7 @@ subroutine noahmpdrv_run & ! soil_color_category = 4 - call transfer_mp_parameters(vegetation_category, soil_category, & + call transfer_mp_parameters(km,vegetation_category, soil_category, & slope_category, soil_color_category, crop_type,parameters) parameters%prcpiceden = rhonewsn1(i) call noahmp_options(idveg ,iopt_crs, iopt_btr , iopt_run, iopt_sfc, & @@ -918,10 +964,10 @@ subroutine noahmpdrv_run & vegetation_frac = 0.0 call noahmp_glacier ( & i_location ,1 ,cosine_zenith ,nsnow , & - nsoil ,timestep , & + km ,timestep , & temperature_forcing ,air_pressure_forcing ,uwind_forcing ,vwind_forcing , & spec_humidity_forcing,sw_radiation_forcing ,precipitation_forcing,radiation_lw_forcing , & - temperature_soil_bot ,forcing_height ,snow_ice_frac_old ,zsoil , & + temperature_soil_bot ,forcing_height ,snow_ice_frac_old ,zs , & thsfc_loc ,prslkix ,prsik1x ,prslk1x , & air_pressure_surface ,pblhx ,iz0tlnd ,itime , & vegetation_frac ,area_grid ,psi_opt , & @@ -985,12 +1031,17 @@ subroutine noahmpdrv_run & t2mmp(i) = temperature_bare_2m q2mp(i) = spec_humidity_bare_2m - tskin(i) = temperature_ground + tskin(i) = temperature_radiative + tflux = temperature_ground surface_temperature = temperature_ground vegetation_fraction = vegetation_frac ch_vegetated = 0.0 ch_bare_ground = ch_noahmp canopy_heat_storage = 0.0 + lai_sunlit = 0.0 + lai_shaded = 0.0 + rs_sunlit = 0.0 + rs_shaded = 0.0 else ! not glacier @@ -1075,7 +1126,8 @@ subroutine noahmpdrv_run & q2mp(i) = spec_humidity_veg_2m * vegetation_fraction + & spec_humidity_bare_2m * (1-vegetation_fraction) - tskin(i) = surface_temperature + tskin(i) = temperature_radiative + tflux = surface_temperature endif ! glacial split ends @@ -1099,7 +1151,17 @@ subroutine noahmpdrv_run & chxy (i) = ch_noahmp zorl (i) = z0_total * 100.0 ! convert to cm ztmax (i) = z0h_total - + + !LAI-scale canopy resistance based on weighted sunlit shaded fraction + if(rs_sunlit .le. 0.0 .or. rs_shaded .le. 0.0 .or. & + lai_sunlit .eq. 0.0 .or. lai_shaded .eq. 0.0) then + rca(i) = parameters%rsmax + else !calculate LAI-scale canopy conductance (1/Rs) + rca(i) = ((1.0/(rs_sunlit+leaf_air_resistance)*lai_sunlit) + & + ((1.0/(rs_shaded+leaf_air_resistance))*lai_shaded)) + rca(i) = max((1.0/rca(i)),parameters%rsmin) !resistance + end if + smois (i,:) = soil_moisture_vol sh2o (i,:) = soil_liquid_vol snowxy (i) = float(snow_levels) @@ -1203,15 +1265,20 @@ subroutine noahmpdrv_run & rechxy (i) = recharge ! only need for run=5 smoiseq (i,:) = eq_soil_water_vol ! only need for run=5; listed as in - stm (i) = (0.02*soil_moisture_vol(1) + & - 0.04*soil_moisture_vol(2) + & - 0.08*soil_moisture_vol(3) + & - 0.32*soil_moisture_vol(4) + & - 0.28*soil_moisture_vol(5) + & - 0.52*soil_moisture_vol(6) + & - 0.68*soil_moisture_vol(7) + & - 2.12*soil_moisture_vol(8) + & - 1.00*soil_moisture_vol(9))*1000.0 + stm(i)=0.0 + do k=1,km + stm(i) = stm(i) + dzs(k)*soil_moisture_vol(k) + enddo + stm(i)=stm(i)*1000.0 +! stm (i) = (0.02*soil_moisture_vol(1) + & +! 0.04*soil_moisture_vol(2) + & +! 0.08*soil_moisture_vol(3) + & +! 0.32*soil_moisture_vol(4) + & +! 0.28*soil_moisture_vol(5) + & +! 0.52*soil_moisture_vol(6) + & +! 0.68*soil_moisture_vol(7) + & +! 2.12*soil_moisture_vol(8) + & +! 1.00*soil_moisture_vol(9))*1000.0 wet1 (i) = soil_moisture_vol(1) / smcmax_table(soil_category(1)) smcwlt2(i) = smcdry_table(soil_category(1)) !!!change to wilt? @@ -1226,9 +1293,9 @@ subroutine noahmpdrv_run & endif if(thsfc_loc) then ! Use local potential temperature - tvs1 = tskin(i) * virtfac1 + tvs1 = tflux * virtfac1 else ! Use potential temperature referenced to 1000 hPa - tvs1 = tskin(i)/prsik1(i) * virtfac1 + tvs1 = tflux/prsik1(i) * virtfac1 endif z0_total = max(min(z0_total,forcing_height),1.0e-6) @@ -1347,7 +1414,7 @@ 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, & + subroutine transfer_mp_parameters (km,vegtype,soiltype,slopetype, & soilcolor,croptype,parameters) use noahmp_tables @@ -1355,8 +1422,9 @@ subroutine transfer_mp_parameters (vegtype,soiltype,slopetype, & implicit none + integer, intent(in) :: km ! vertical soil layer dimension integer, intent(in) :: vegtype - integer, intent(in) :: soiltype(9) + integer, intent(in) :: soiltype(km) integer, intent(in) :: slopetype integer, intent(in) :: soilcolor integer, intent(in) :: croptype @@ -1435,8 +1503,8 @@ subroutine transfer_mp_parameters (vegtype,soiltype,slopetype, & 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 +! scale nroot based on the number of soil layers (the table is for 4-layer) + parameters%nroot = int(nroot_table(vegtype)*km/4.) !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 @@ -1779,249 +1847,4 @@ subroutine penman (sfctmp,sfcprs,ch,t2v,th2,prcp,fdown,ssoil, & ! ---------------------------------------------------------------------- end subroutine penman - subroutine noahmpsoilinit (lsm_cold_start, im, lsoil_lsm, lsoil, & ! in - zs, dzs,tskin_lnd,tg3, smc, slc, stc, & ! in - sh2o,tslb, smois, stype, vtype, & ! in - errmsg, errflg) - - use namelist_soilveg - use noahmp_tables, only:smcref_table,smcdry_table - - implicit none - - logical, intent(in ) :: lsm_cold_start - integer, intent(in ) :: im, lsoil - integer, intent(in ) :: lsoil_lsm - real (kind=kind_phys), dimension(im), intent(in ) :: tskin_lnd - real (kind=kind_phys), dimension(im), intent(in ) :: tg3 - real (kind=kind_phys), dimension(1:lsoil_lsm), intent(in ) :: zs - real (kind=kind_phys), dimension(1:lsoil_lsm), intent(in ) :: dzs - real (kind=kind_phys), dimension(im,lsoil), intent(in ) :: smc ! Noah - real (kind=kind_phys), dimension(im,lsoil), intent(in ) :: stc ! Noah - real (kind=kind_phys), dimension(im,lsoil), intent(in ) :: slc ! Noah - - integer, dimension(im), intent(in) :: stype, vtype - - real (kind=kind_phys), dimension(im,lsoil_lsm), intent(inout) :: smois! lsoil_lsm - real (kind=kind_phys), dimension(im,lsoil_lsm), intent(inout) :: tslb ! lsoil_lsm - real (kind=kind_phys), dimension(im,lsoil_lsm), intent(inout) :: sh2o ! lsoil_lsm - - character(len=*), intent(out) :: errmsg - integer, intent(out) :: errflg - -!> local - - logical :: debug_print - logical :: smadj ! for soil mosture adjustment - logical :: swi_init ! for initialization in terms of SWI (soil wetness index) - - real (kind=kind_phys), dimension(1:lsoil_lsm) :: factorsm - real (kind=kind_phys), dimension(im) :: smcref2 - real (kind=kind_phys), dimension(im) :: smcwlt2 - - integer, parameter :: slcats = 30 - real :: refsmc1,wltsmc1 - real :: REFSMCnoah(slcats),WLTSMCnoah(slcats) - - - integer , dimension( 1:im , 1:1 ) :: ivgtyp - integer , dimension( 1:im , 1:1) :: isltyp - real (kind=kind_phys), dimension( 1:im , 1:1 ) :: tsk - real (kind=kind_phys), dimension( 1:im , 1:1 ) :: tbot - real (kind=kind_phys), dimension( 1:im , 1:1 ) :: smtotn - real (kind=kind_phys), dimension( 1:im , 1:1 ) :: smtotr - real (kind=kind_phys), dimension( 1:im , 1:lsoil_lsm, 1:1 ) :: dumsm - real (kind=kind_phys), dimension( 1:im , 1:lsoil_lsm, 1:1 ) :: dumt -! real (kind=kind_phys), dimension( 1:im , 1:lsoil_lsm, 1:1 ) :: smfr - real (kind=kind_phys), dimension( 1:im , 1:lsoil_lsm, 1:1 ) :: soilm - real (kind=kind_phys), dimension( 1:im , 1:lsoil_lsm, 1:1 ) :: soiltemp - real (kind=kind_phys), dimension( 1:im , 1:lsoil_lsm, 1:1 ) :: soilh2o - - real (kind=kind_phys) :: st_input(1:im,1:lsoil_lsm*3,1:1) - real (kind=kind_phys) :: sm_input(1:im,1:lsoil_lsm*3,1:1) - - integer, dimension(1:lsoil) :: st_levels_input ! 4 - for Noah lsm - integer, dimension(1:lsoil) :: sm_levels_input ! 4 - for Noah lsm - - integer :: i,j,k,l,ii,jj,num_soil_layers - - - ! Initialize the CCPP error handling variables - - errmsg = '' - errflg = 0 - - num_soil_layers = lsoil ! 4 - hard-wired for cold start from Noah lsm for now - debug_print = .false. - - st_levels_input = (/ 5, 25, 70, 150/) ! Noah centers of soil layers - sm_levels_input = (/ 5, 25, 70, 150/) ! Noah centers of soil layers - - if (lsm_cold_start) then !need to change if warm start - - smadj = .true. - swi_init = .true. - - if (lsoil /= 4 ) then - write (0,*)'lsoil, lsoil =',lsoil - errflg = 1 - return - endif - - - if(debug_print) then - write (0,*)'lsm_cold_start = ',lsm_cold_start - write (0,*)'lsoil, lsoil_lsm =',lsoil, lsoil_lsm - endif - - endif !cold start - - - do i=1,im ! i = horizontal loop; extra dimension index? - - tbot(i,1) = tg3(i) - ivgtyp(i,1) = vtype(i) - isltyp(i,1) = stype(i) - tsk(i,1) = tskin_lnd(i) - enddo - - ! Noah lsm input - print*,'maxsmc=',MAXSMC,'smcref_table=',smcref_table - - do i = 1,slcats - - if (SATDK(i) /= 0.0 .and. BB(i) > 0.0) then - - REFSMC1 = MAXSMC(I)*(5.79E-9/SATDK(I)) & - **(1.0/(2.0*BB(I)+3.0)) - REFSMCnoah(I) = REFSMC1 + (MAXSMC(I)-REFSMC1) / 6. - WLTSMC1 = MAXSMC(I) * & - (200.0/SATPSI(I))**(-1.0/BB(I)) - WLTSMCnoah(I) = WLTSMC1 - 0.5 * WLTSMC1 - - endif - end do - - - do i=1,im ! i = horizontal loop - - st_input(i,1,1)=tsk(i,1) - sm_input(i,1,1)=0. - - !--- initialize smcwlt2 and smcref2 using Noah values - ii=stype(i) - if(ii.le.1)ii=1 - smcref2 (i) = refsmcNoah(ii) - smcwlt2 (i) = wltsmcNoah(ii) - - do k=1,lsoil - st_input(i,k+1,1)=stc(i,k) - ! convert volumetric soil moisture to SWI (soil wetness index) - if( swi_init) then - sm_input(i,k+1,1)=min(1.,max(0.,(smc(i,k) - smcwlt2(i))/ & - (smcref2(i) - smcwlt2(i)))) - endif - enddo - - do k=lsoil+2,lsoil_lsm * 3 - st_input(i,k,1)=0. - sm_input(i,k,1)=0. - enddo - - enddo ! i - horizontal loop - - CALL init_soil_3_mp ( im, tsk , tbot , dumsm , dumt , & - st_input , sm_input , & - zs , dzs , & - st_levels_input, sm_levels_input, & - lsoil_lsm , num_soil_layers, & - num_soil_layers, & - lsoil_lsm * 3 , lsoil_lsm * 3) - - do i=1,im - do k=1,lsoil_lsm - ! convert from SWI to Noah MP volumetric soil moisture - if(swi_init) then - soilm(i,k,1) = dumsm(i,k,1) * & - (smcref_table(isltyp(i,1))-smcdry_table(isltyp(i,1))) & - + smcdry_table(isltyp(i,1)) - endif - soiltemp(i,k,1) = dumt(i,k,1) - enddo ! k - enddo ! im loop - - ! smadj should be true when the Noah LSM is used - - if( smadj ) then - - ! With other LSMs as input, or when RUC soil moisture is cycled, it - ! should be set to .false. - - do i=1,im - - ! initialize factor - - do k=1,lsoil_lsm - factorsm(k)=1. - enddo - - ! Noah MP soil moisture bucket - - smtotr(i,1)=0. - - do k=1,lsoil_lsm -1 - smtotr(i,1)=smtotr(i,1) + soilm(i,k,1) *dzs(k) - enddo - - ! Noah soil moisture bucket - -! smtotn(i,1)=smc(i,1)*0.1 + smc(i,2)*0.2 + smc(i,3)*0.7 + smc(i,4)*1. - smtotn(i,1)=smc(i,1)*0.1 + smc(i,2)*0.3 + smc(i,3)*0.6 + smc(i,4)*1. ! the depths of 2 and 3 are corrected - - - ! Noah MP soil moisture correction to match Noah soil moisture bucket - - do k=1,lsoil_lsm-1 - soilm(i,k,1) = max(0.02,soilm(i,k,1)*smtotn(i,1)/(0.9*smtotr(i,1))) - enddo - - if( soilm(i,2,1) > soilm(i,1,1) .and. soilm(i,3,1) > soilm(i,2,1)) then - ! typical for daytime, no recent precip - factorsm(1) = 0.75 - factorsm(2) = 0.8 - factorsm(3) = 0.85 - factorsm(4) = 0.9 - factorsm(5) = 0.95 - endif - - do k=1,lsoil_lsm - soilm(i,k,1) = factorsm(k) * soilm(i,k,1) - enddo - - smtotr(i,1) = 0. - - do k=1,lsoil_lsm - 1 - smtotr(i,1)=smtotr(i,1) + soilm(i,k,1) *dzs(k) - enddo - - enddo ! i loop - - endif ! smadj==.true. - - ! Initialize liquid soil moisture from total soil moisture - ! and soil temperature - - call initslc(im,lsoil_lsm, isltyp, ivgtyp, & - soilh2o, soiltemp, soilm) - - do i=1,im - do k = 1, lsoil_lsm - smois(i,k) = soilm(i,k,1) - tslb(i,k) = soiltemp(i,k,1) - sh2o(i,k) = soilh2o(i,k,1) - enddo - enddo - - end subroutine noahmpsoilinit - end module noahmpdrv diff --git a/physics/noahmpdrv.meta b/physics/SFC_Models/Land/Noahmp/noahmpdrv.meta similarity index 94% rename from physics/noahmpdrv.meta rename to physics/SFC_Models/Land/Noahmp/noahmpdrv.meta index 4e56ffc5f..317567bcd 100644 --- a/physics/noahmpdrv.meta +++ b/physics/SFC_Models/Land/Noahmp/noahmpdrv.meta @@ -1,7 +1,9 @@ [ccpp-table-properties] name = noahmpdrv type = scheme - dependencies = funcphys.f90,machine.F,sfc_diff.f,module_mp_soil_init.f90,module_sf_noahmp_glacier.F90,module_sf_noahmplsm.F90,noahmp_tables.f90,set_soilveg.f + dependencies = ../../../tools/funcphys.f90,../../../hooks/machine.F + dependencies = module_sf_noahmp_glacier.F90,module_sf_noahmplsm.F90,noahmp_tables.f90 + dependencies = ../Noah/set_soilveg.f ######################################################################## [ccpp-arg-table] @@ -72,13 +74,6 @@ type = real intent = out kind = kind_phys -[lsm_cold_start] - standard_name = do_lsm_cold_start - long_name = flag to signify LSM is cold-started - units = flag - dimensions = () - type = logical - intent = in [lsoil] standard_name = vertical_dimension_of_soil long_name = soil vertical layer dimension @@ -86,6 +81,14 @@ dimensions = () type = integer intent = in +[zsi] + standard_name = depth_of_soil_layers_input + long_name = depth of soil levels for the input initial soil + units = m + dimensions = (vertical_dimension_of_soil) + type = real + kind = kind_phys + intent = in [lsoil_lsm] standard_name = vertical_dimension_of_soil_internal_to_land_surface_scheme long_name = number of soil layers internal to land surface model @@ -93,6 +96,14 @@ dimensions = () type = integer intent = in +[zs] + standard_name = depth_of_soil_layers + long_name = depth of soil levels for land surface model + units = m + dimensions = (vertical_dimension_of_soil_internal_to_land_surface_scheme) + type = real + kind = kind_phys + intent = in [vegtype] standard_name = vegetation_type_classification long_name = vegetation type at each grid cell @@ -107,22 +118,6 @@ dimensions = (horizontal_dimension) type = integer intent= in -[tskin] - 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 = in -[tg3] - standard_name = deep_soil_temperature - long_name = deep soil temperature - units = K - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = in [smc] standard_name = volume_fraction_of_condensed_water_in_soil long_name = volumetric fraction of soil moisture @@ -468,6 +463,22 @@ type = real kind = kind_phys intent = in +[zs] + standard_name = depth_of_soil_layers + long_name = depth of soil levels for land surface model + units = m + dimensions = (vertical_dimension_of_soil_internal_to_land_surface_scheme) + type = real + kind = kind_phys + intent = in +[dzs] + standard_name = thickness_of_soil_layers_for_land_surface_model + long_name = thickness of soil levels for land surface model + units = m + dimensions = (vertical_dimension_of_soil_internal_to_land_surface_scheme) + type = real + kind = kind_phys + intent = in [idveg] standard_name = control_for_land_surface_scheme_dynamic_vegetation long_name = choice for dynamic vegetation option (see noahmp module for definition) @@ -613,6 +624,7 @@ type = real kind = kind_phys intent = in + optional = True [rainc_mp] standard_name = convective_precipitation_rate_on_previous_timestep long_name = convective precipitation rate from previous timestep @@ -621,6 +633,7 @@ type = real kind = kind_phys intent = in + optional = True [snow_mp] standard_name = snowfall_rate_on_previous_timestep long_name = snow precipitation rate from previous timestep @@ -629,6 +642,7 @@ type = real kind = kind_phys intent = in + optional = True [graupel_mp] standard_name = graupel_precipitation_rate_on_previous_timestep long_name = graupel precipitation rate from previous timestep @@ -637,6 +651,7 @@ type = real kind = kind_phys intent = in + optional = True [ice_mp] standard_name = ice_precipitation_rate_on_previous_timestep long_name = ice precipitation rate from previous timestep @@ -645,6 +660,7 @@ type = real kind = kind_phys intent = in + optional = True [rhonewsn1] standard_name = surface_frozen_precipitation_density long_name = density of precipitation ice @@ -732,6 +748,20 @@ dimensions = () type = logical intent = in +[cpllnd] + standard_name = flag_for_land_coupling + long_name = flag controlling cpllnd collection (default off) + units = flag + dimensions = () + type = logical + intent = in +[cpllnd2atm] + standard_name = flag_for_one_way_land_coupling_to_atmosphere + long_name = flag controlling land coupling to the atmosphere (default off) + units = flag + dimensions = () + type = logical + intent = in [weasd] standard_name = water_equivalent_accumulated_snow_depth_over_land long_name = water equiv of acc snow depth over land @@ -923,6 +953,7 @@ type = real kind = kind_phys intent = inout + optional = True [tvxy] standard_name = canopy_temperature long_name = vegetation temperature @@ -931,6 +962,7 @@ type = real kind = kind_phys intent = inout + optional = True [tgxy] standard_name = ground_temperature long_name = ground temperature for noahmp @@ -939,6 +971,7 @@ type = real kind = kind_phys intent = inout + optional = True [canicexy] standard_name = canopy_intercepted_ice_mass long_name = canopy intercepted ice mass @@ -947,6 +980,7 @@ type = real kind = kind_phys intent = inout + optional = True [canliqxy] standard_name = canopy_intercepted_liquid_water long_name = canopy intercepted liquid water @@ -955,6 +989,7 @@ type = real kind = kind_phys intent = inout + optional = True [eahxy] standard_name = air_vapor_pressure_in_canopy long_name = canopy air vapor pressure @@ -963,6 +998,7 @@ type = real kind = kind_phys intent = inout + optional = True [tahxy] standard_name = air_temperature_in_canopy long_name = canopy air temperature @@ -971,6 +1007,7 @@ type = real kind = kind_phys intent = inout + optional = True [cmxy] standard_name = surface_drag_coefficient_for_momentum_for_noahmp long_name = surface drag coefficient for momentum for noahmp @@ -979,6 +1016,7 @@ type = real kind = kind_phys intent = inout + optional = True [chxy] standard_name = surface_drag_coefficient_for_heat_and_moisture_for_noahmp long_name = surface exchange coeff heat & moisture for noahmp @@ -987,6 +1025,7 @@ type = real kind = kind_phys intent = inout + optional = True [fwetxy] standard_name = wet_canopy_area_fraction long_name = area fraction of canopy that is wetted/snowed @@ -995,6 +1034,7 @@ type = real kind = kind_phys intent = inout + optional = True [sneqvoxy] standard_name = lwe_thickness_of_snowfall_amount_on_previous_timestep long_name = snow mass at previous time step @@ -1003,6 +1043,7 @@ type = real kind = kind_phys intent = inout + optional = True [alboldxy] standard_name = surface_albedo_assuming_deep_snow_on_previous_timestep long_name = snow albedo at previous time step @@ -1011,6 +1052,7 @@ type = real kind = kind_phys intent = inout + optional = True [qsnowxy] standard_name = lwe_snowfall_rate long_name = snow precipitation rate at surface @@ -1019,6 +1061,7 @@ type = real kind = kind_phys intent = inout + optional = True [wslakexy] standard_name = water_storage_in_lake long_name = lake water storage @@ -1027,6 +1070,7 @@ type = real kind = kind_phys intent = inout + optional = True [zwtxy] standard_name = water_table_depth long_name = water table depth @@ -1035,6 +1079,7 @@ type = real kind = kind_phys intent = inout + optional = True [waxy] standard_name = water_storage_in_aquifer long_name = water storage in aquifer @@ -1043,6 +1088,7 @@ type = real kind = kind_phys intent = inout + optional = True [wtxy] standard_name = water_storage_in_aquifer_and_saturated_soil long_name = water storage in aquifer and saturated soil @@ -1051,6 +1097,7 @@ type = real kind = kind_phys intent = inout + optional = True [tsnoxy] standard_name = temperature_in_surface_snow long_name = temperature_in_surface_snow @@ -1059,6 +1106,7 @@ type = real kind = kind_phys intent = inout + optional = True [zsnsoxy] standard_name = depth_from_snow_surface_at_bottom_interface long_name = depth from the top of the snow surface at the bottom of the layer @@ -1067,6 +1115,7 @@ type = real kind = kind_phys intent = inout + optional = True [snicexy] standard_name = lwe_thickness_of_ice_in_surface_snow long_name = lwe_thickness_of_ice_in_surface_snow @@ -1075,6 +1124,7 @@ type = real kind = kind_phys intent = inout + optional = True [snliqxy] standard_name = lwe_thickness_of_liquid_water_in_surface_snow long_name = snow layer liquid water @@ -1083,6 +1133,7 @@ type = real kind = kind_phys intent = inout + optional = True [lfmassxy] standard_name = leaf_mass_content long_name = leaf mass @@ -1091,6 +1142,7 @@ type = real kind = kind_phys intent = inout + optional = True [rtmassxy] standard_name = fine_root_mass_content long_name = fine root mass @@ -1099,6 +1151,7 @@ type = real kind = kind_phys intent = inout + optional = True [stmassxy] standard_name = stem_mass_content long_name = stem mass @@ -1107,6 +1160,7 @@ type = real kind = kind_phys intent = inout + optional = True [woodxy] standard_name = wood_mass_content long_name = wood mass including woody roots @@ -1115,6 +1169,7 @@ type = real kind = kind_phys intent = inout + optional = True [stblcpxy] standard_name = slow_soil_pool_mass_content_of_carbon long_name = stable carbon in deep soil @@ -1123,6 +1178,7 @@ type = real kind = kind_phys intent = inout + optional = True [fastcpxy] standard_name = fast_soil_pool_mass_content_of_carbon long_name = short-lived carbon in shallow soil @@ -1131,6 +1187,7 @@ type = real kind = kind_phys intent = inout + optional = True [xlaixy] standard_name = leaf_area_index long_name = leaf area index @@ -1139,6 +1196,7 @@ type = real kind = kind_phys intent = inout + optional = True [xsaixy] standard_name = stem_area_index long_name = stem area index @@ -1147,6 +1205,7 @@ type = real kind = kind_phys intent = inout + optional = True [taussxy] standard_name = dimensionless_age_of_surface_snow long_name = non-dimensional snow age @@ -1155,6 +1214,7 @@ type = real kind = kind_phys intent = inout + optional = True [smoiseq] standard_name = volumetric_equilibrium_soil_moisture long_name = equilibrium soil water content @@ -1163,6 +1223,7 @@ type = real kind = kind_phys intent = inout + optional = True [smcwtdxy] standard_name = volumetric_soil_moisture_between_soil_bottom_and_water_table long_name = soil water content between the bottom of the soil and the water table @@ -1171,6 +1232,7 @@ type = real kind = kind_phys intent = inout + optional = True [deeprechxy] standard_name = water_table_recharge_assuming_deep long_name = recharge to or from the water table when deep @@ -1179,6 +1241,7 @@ type = real kind = kind_phys intent = inout + optional = True [rechxy] standard_name = water_table_recharge_assuming_shallow long_name = recharge to or from the water table when shallow @@ -1187,6 +1250,7 @@ type = real kind = kind_phys intent = inout + optional = True [albdvis] standard_name = surface_albedo_direct_visible_over_land long_name = direct surface albedo visible band over land @@ -1411,6 +1475,7 @@ type = real kind = kind_phys intent = out + optional = True [t2mmp] standard_name = temperature_at_2m_from_noahmp long_name = 2 meter temperature from noahmp @@ -1419,6 +1484,7 @@ type = real kind = kind_phys intent = out + optional = True [q2mp] standard_name = specific_humidity_at_2m_from_noahmp long_name = 2 meter specific humidity from noahmp @@ -1427,6 +1493,7 @@ type = real kind = kind_phys intent = out + optional = True [zvfun] standard_name = function_of_surface_roughness_length_and_green_vegetation_fraction long_name = function of surface roughness length and green vegetation fraction @@ -1443,6 +1510,15 @@ type = real kind = kind_phys intent = out +[rca] + standard_name = aerodynamic_resistance_in_canopy + long_name = canopy resistance + units = s m-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = out + optional = True [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/noahmptable.tbl b/physics/SFC_Models/Land/Noahmp/noahmptable.tbl similarity index 96% rename from physics/noahmptable.tbl rename to physics/SFC_Models/Land/Noahmp/noahmptable.tbl index ae19817b9..44531919e 100644 --- a/physics/noahmptable.tbl +++ b/physics/SFC_Models/Land/Noahmp/noahmptable.tbl @@ -217,7 +217,7 @@ !--------------------------------------------------------------------------------------------------------------------------------------------------------------------- ch2op = 0.1, 0.1, 0.1, 0.1, 0.1, 0.1, 0.1, 0.1, 0.1, 0.1, 0.1, 0.1, 0.1, 0.1, 0.1, 0.1, 0.1, 0.1, 0.1, 0.1, dleaf = 0.04, 0.04, 0.04, 0.04, 0.04, 0.04, 0.04, 0.04, 0.04, 0.04, 0.04, 0.04, 0.04, 0.04, 0.04, 0.04, 0.04, 0.04, 0.04, 0.04, - z0mvt = 1.09, 1.10, 0.85, 0.80, 0.80, 0.20, 0.06, 0.60, 0.50, 0.12, 0.30, 0.15, 1.00, 0.14, 0.00, 0.00, 0.00, 0.30, 0.20, 0.03, + z0mvt = 1.00, 1.50, 0.75, 0.90, 0.85, 0.20, 0.10, 0.90, 0.60, 0.20, 0.30, 0.25, 1.00, 0.25, 0.00, 0.015, 0.00, 0.30, 0.10, 0.05, hvt = 20.0, 20.0, 18.0, 16.0, 16.0, 1.10, 1.10, 13.0, 10.0, 1.00, 5.00, 2.00, 15.0, 1.50, 0.00, 0.00, 0.00, 4.00, 2.00, 0.50, hvb = 8.50, 8.00, 7.00, 11.5, 10.0, 0.10, 0.10, 0.10, 0.10, 0.05, 0.10, 0.10, 1.00, 0.10, 0.00, 0.00, 0.00, 0.30, 0.20, 0.10, z0mhvt= 0.0545, 0.055, 0.047, 0.050, 0.050, 0.182, 0.0545, 0.046, 0.050, 0.120, 0.060, 0.075, 0.067, 0.093, 0.000, 0.000, 0.000, 0.075, 0.100, 0.060, @@ -226,32 +226,34 @@ !mfsno = 2.50, 2.50, 2.50, 2.50, 2.50, 2.50, 2.50, 2.50, 2.50, 2.50, 2.50, 2.50, 2.50, 2.50, 2.50, 2.50, 2.50, 2.50, 2.50, 2.50, ! c. he 12/17/2020: optimized mfsno values dependent on land type based on evaluation with snotel swe and modis scf, surface albedo mfsno = 1.00, 1.00, 1.00, 1.00, 1.00, 2.00, 2.00, 2.00, 2.00, 2.00, 3.00, 3.00, 4.00, 4.00, 2.50, 3.00, 3.00, 3.50, 3.50, 3.50, +!mfsno = 1.97, 1.97, 1.97, 1.97, 1.97, 1.97, 1.97, 1.97, 1.97, 1.97, 1.97, 1.97, 1.97, 1.97, 1.97, 1.97, 1.97, 1.97, 1.97, 1.97, ! c. he 12/17/2020: optimized snow cover factor (m) in scf formulation to replace original constant 2.5*z0,z0=0.002m, based on evaluation with snotel swe and modis scf, surface albedo ! scffac = 0.008, 0.008, 0.008, 0.008, 0.008, 0.016, 0.016, 0.020, 0.020, 0.020, 0.020, 0.014, 0.042, 0.026, 0.030, 0.016, 0.030, 0.030, 0.030, 0.030, - scffac = 0.005, 0.005, 0.005, 0.005, 0.005, 0.008, 0.008, 0.010, 0.010, 0.010, 0.010, 0.007, 0.021, 0.013, 0.015, 0.008, 0.015, 0.015, 0.015, 0.015, + scffac = 0.005, 0.005, 0.005, 0.005, 0.005, 0.008, 0.008, 0.010, 0.010, 0.010, 0.010, 0.007, 0.021, 0.013, 0.015, 0.008, 0.015, 0.015, 0.015, 0.015, +! scffac = 0.059, 0.059, 0.059, 0.059, 0.059, 0.059, 0.059, 0.059, 0.059, 0.059, 0.059, 0.059, 0.059, 0.059, 0.059, 0.059, 0.059, 0.059, 0.059, 0.059, cbiom = 0.02, 0.02, 0.02, 0.02, 0.02, 0.02, 0.02, 0.02, 0.02, 0.02, 0.02, 0.02, 0.02, 0.02, 0.02, 0.02, 0.02, 0.02, 0.02, 0.02, ! row 1: vis ! row 2: near ir rhol_vis=0.07, 0.10, 0.07, 0.10, 0.10, 0.07, 0.07, 0.07, 0.10, 0.11, 0.105, 0.11, 0.00, 0.11, 0.00, 0.00, 0.00, 0.10, 0.10, 0.10, - rhol_nir=0.35, 0.45, 0.35, 0.45, 0.45, 0.35, 0.35, 0.35, 0.45, 0.58, 0.515, 0.58, 0.00, 0.58, 0.00, 0.00, 0.00, 0.45, 0.45, 0.45, + rhol_nir=0.35, 0.45, 0.35, 0.45, 0.45, 0.35, 0.35, 0.35, 0.45, 0.35, 0.515, 0.35, 0.00, 0.35, 0.00, 0.00, 0.00, 0.45, 0.45, 0.45, ! row 1: vis ! row 2: near ir - rhos_vis=0.16, 0.16, 0.16, 0.16, 0.16, 0.16, 0.16, 0.16, 0.16, 0.36, 0.26, 0.36, 0.00, 0.36, 0.00, 0.00, 0.00, 0.16, 0.16, 0.16, - rhos_nir=0.39, 0.39, 0.39, 0.39, 0.39, 0.39, 0.39, 0.39, 0.39, 0.58, 0.485, 0.58, 0.00, 0.58, 0.00, 0.00, 0.00, 0.39, 0.39, 0.39, + rhos_vis=0.16, 0.16, 0.16, 0.16, 0.16, 0.16, 0.16, 0.16, 0.16, 0.31, 0.26, 0.31, 0.00, 0.31, 0.00, 0.00, 0.00, 0.16, 0.16, 0.16, + rhos_nir=0.39, 0.39, 0.39, 0.39, 0.39, 0.39, 0.39, 0.39, 0.39, 0.53, 0.485, 0.53, 0.00, 0.53, 0.00, 0.00, 0.00, 0.39, 0.39, 0.39, ! row 1: vis ! row 2: near ir - taul_vis=0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.07, 0.06, 0.07, 0.00, 0.07, 0.00, 0.00, 0.00, 0.05, 0.05, 0.05, - taul_nir=0.10, 0.25, 0.10, 0.25, 0.25, 0.10, 0.10, 0.10, 0.25, 0.25, 0.25, 0.25, 0.00, 0.25, 0.00, 0.00, 0.00, 0.25, 0.25, 0.25, + taul_vis=0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.06, 0.05, 0.00, 0.05, 0.00, 0.00, 0.00, 0.05, 0.05, 0.05, + taul_nir=0.10, 0.25, 0.10, 0.25, 0.25, 0.10, 0.10, 0.10, 0.25, 0.34, 0.25, 0.34, 0.00, 0.34, 0.00, 0.00, 0.00, 0.25, 0.25, 0.25, ! row 1: vis ! row 2: near ir - taus_vis=0.001, 0.001, 0.001, 0.001, 0.001, 0.001, 0.001, 0.001, 0.001, 0.220, 0.1105, 0.220, 0.000, 0.220, 0.000, 0.000, 0.000, 0.001, 0.001, 0.001, - taus_nir=0.001, 0.001, 0.001, 0.001, 0.001, 0.001, 0.001, 0.001, 0.001, 0.380, 0.1905, 0.380, 0.000, 0.380, 0.000, 0.000, 0.000, 0.001, 0.001, 0.001, + taus_vis=0.001, 0.001, 0.001, 0.001, 0.001, 0.001, 0.001, 0.001, 0.001, 0.120, 0.1105, 0.120, 0.000, 0.120, 0.000, 0.000, 0.000, 0.001, 0.001, 0.001, + taus_nir=0.001, 0.001, 0.001, 0.001, 0.001, 0.001, 0.001, 0.001, 0.001, 0.250, 0.1905, 0.250, 0.000, 0.250, 0.000, 0.000, 0.000, 0.001, 0.001, 0.001, - xl = 0.010, 0.010, 0.010, 0.250, 0.250, 0.010, 0.010, 0.010, 0.010, -0.30, -0.025, -0.30, 0.000, -0.30, 0.000, 0.000, 0.000, 0.250, 0.250, 0.250, + xl = 0.010, 0.10, 0.010, 0.250, 0.250, 0.010, 0.010, 0.010, 0.010, -0.30, -0.025, -0.30, 0.000, -0.30, 0.000, 0.000, 0.000, 0.250, 0.250, 0.250, ! make cwpvt vegetation dependent according to j. goudriaan, crop micrometeorology: a simulation study (simulation monographs), 1977). c. he, 12/17/2020 ! cwpvt = 0.18, 0.67, 0.18, 0.67, 0.29, 1.0, 2.0, 1.3, 1.0, 5.0, 1.17, 1.67, 1.67, 1.67, 0.18, 0.18, 0.18, 0.67, 1.0, 0.18, cwpvt = 0.09, 0.335, 0.09, 0.335, 0.145, 0.5, 1.0, 0.65, 0.5, 2.5, 0.585, 0.835, 0.835, 0.835, 0.09, 0.09, 0.09, 0.335, 0.5, 0.09, @@ -282,7 +284,7 @@ wdpool= 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, wrrat = 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, mrp = 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, - nroot = 9, 9, 9, 9, 9, 8, 8, 8, 8, 8, 4, 8, 3, 8, 3, 3, 0, 8, 8, 4, + nroot = 4, 4, 4, 4, 4, 3, 3, 3, 3, 3, 2, 3, 1, 3, 1, 1, 0, 3, 3, 2, rgl = 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, rs = 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, hs = 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, @@ -335,10 +337,10 @@ !-------------------------------------------------------------------------------------------------------------------------------------------------------------------------- ! 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 soil color index for soil albedo !-------------------------------------------------------------------------------------------------------------------------------------------------------------------------- - albsat_vis = 0.25, 0.23, 0.21, 0.20, 0.19, 0.18, 0.17, 0.16, 0.15, 0.14, 0.13, 0.12, 0.11, 0.10, 0.09, 0.08, 0.07, 0.06, 0.05, 0.04 ! saturated soil albedos - albsat_nir = 0.50, 0.46, 0.42, 0.40, 0.38, 0.36, 0.34, 0.32, 0.30, 0.28, 0.26, 0.24, 0.22, 0.20, 0.18, 0.16, 0.14, 0.12, 0.10, 0.08 ! saturated soil albedos - albdry_vis = 0.36, 0.34, 0.32, 0.31, 0.30, 0.29, 0.28, 0.27, 0.26, 0.25, 0.24, 0.23, 0.22, 0.20, 0.18, 0.16, 0.14, 0.12, 0.10, 0.08 ! dry soil albedos - albdry_nir = 0.61, 0.57, 0.53, 0.51, 0.49, 0.48, 0.45, 0.43, 0.41, 0.39, 0.37, 0.35, 0.33, 0.31, 0.29, 0.27, 0.25, 0.23, 0.21, 0.16 ! dry soil albedos + albsat_vis = 0.21, 0.20, 0.18, 0.17, 0.16, 0.15, 0.14, 0.13, 0.13, 0.12, 0.11, 0.10, 0.10, 0.09, 0.08, 0.08, 0.08, 0.07, 0.07, 0.06 ! saturated soil albedos + albsat_nir = 0.42, 0.40, 0.36, 0.34, 0.32, 0.30, 0.28, 0.26, 0.26, 0.24, 0.22, 0.20, 0.20, 0.18, 0.16, 0.16, 0.16, 0.14, 0.14, 0.13 ! saturated soil albedos + albdry_vis = 0.31, 0.30, 0.28, 0.27, 0.26, 0.24, 0.23, 0.22, 0.22, 0.22, 0.20, 0.19, 0.20, 0.18, 0.16, 0.16, 0.16, 0.14, 0.14, 0.13 ! dry soil albedos + albdry_nir = 0.52, 0.50, 0.46, 0.44, 0.42, 0.40, 0.38, 0.37, 0.36, 0.34, 0.32, 0.30, 0.30, 0.28, 0.27, 0.27, 0.27, 0.26, 0.25, 0.25 ! dry soil albedos albice = 0.80, 0.55 ! albedo land ice: 1=vis, 2=nir alblak = 0.60, 0.40 ! albedo frozen lakes: 1=vis, 2=nir omegas = 0.8 , 0.4 ! two-stream parameter omega for snow @@ -397,7 +399,7 @@ class_sno_age = 3600.0 ! snow aging e-folding time (s) in class albedo scheme class_alb_new = 0.84 ! fresh snow albedo in class scheme psiwlt = -150.0 !metric potential for wilting point (m) - z0soil = 0.002 ! bare-soil roughness length (m) (i.e., under the canopy) + z0soil = 0.015 ! bare-soil roughness length (m) (i.e., under the canopy) z0lake = 0.01 ! lake surface roughness length (m) / diff --git a/physics/lsm_ruc.F90 b/physics/SFC_Models/Land/RUC/lsm_ruc.F90 similarity index 94% rename from physics/lsm_ruc.F90 rename to physics/SFC_Models/Land/RUC/lsm_ruc.F90 index 665fe6d14..8df8cca24 100644 --- a/physics/lsm_ruc.F90 +++ b/physics/SFC_Models/Land/RUC/lsm_ruc.F90 @@ -87,21 +87,22 @@ subroutine lsm_ruc_init (me, master, isot, ivegsrc, nlunit, & real (kind_phys), dimension(:,:), intent(in) :: smc,slc,stc real (kind_phys), intent(in) :: min_seaice ! --- in/out: - real (kind_phys), dimension(:), intent(inout) :: wetness + real (kind_phys), dimension(:), intent(inout), optional :: wetness ! --- inout - real (kind_phys), dimension(:,:), intent(inout) :: sh2o, smfrkeep - real (kind_phys), dimension(:,:), intent(inout) :: tslb, smois + real (kind_phys), dimension(:,:), intent(inout), optional :: sh2o, smfrkeep + real (kind_phys), dimension(:,:), intent(inout), optional :: tslb, smois real (kind_phys), dimension(:), intent(inout) :: semis_lnd real (kind_phys), dimension(:), intent(inout) :: semis_ice - real (kind_phys), dimension(:), intent(inout) :: & - albdvis_lnd, albdnir_lnd, albivis_lnd, albinir_lnd, & + real (kind_phys), dimension(:), intent(inout) :: & + albdvis_lnd, albdnir_lnd, albivis_lnd, albinir_lnd + real (kind_phys), dimension(:), intent(inout), optional :: & albdvis_ice, albdnir_ice, albivis_ice, albinir_ice, & sfcqv_lnd, sfcqv_ice ! --- out real (kind_phys), dimension(:), intent(out) :: zs - real (kind_phys), dimension(:), intent(inout) :: sfalb_lnd_bck + real (kind_phys), dimension(:), intent(inout), optional :: sfalb_lnd_bck real (kind_phys), dimension(:,:), intent(inout) :: tsice real (kind_phys), dimension(:), intent(out) :: semisbase real (kind_phys), dimension(:), intent(out) :: pores, resid @@ -359,6 +360,8 @@ subroutine lsm_ruc_run & ! inputs & qsurf_ice, gflux_ice, evap_ice, ep1d_ice, hflx_ice, & & cm_ice, ch_ice, snowfallac_ice, acsnow_ice, snowmt_ice, & & albdvis_ice, albdnir_ice, albivis_ice, albinir_ice, & + & add_fire_heat_flux, fire_heat_flux_out, & + & frac_grid_burned_out, & ! --- out & rhosnf, sbsno, & & cmm_lnd, chh_lnd, cmm_ice, chh_ice, & @@ -379,11 +382,11 @@ subroutine lsm_ruc_run & ! inputs imp_physics_nssl real (kind_phys), dimension(:), intent(in) :: xlat_d, xlon_d real (kind_phys), dimension(:), intent(in) :: oro, sigma - + real (kind_phys), dimension(:), intent(in), optional :: sfalb_lnd_bck real (kind_phys), dimension(:), intent(in) :: & - & t1, sigmaf, laixy, dlwflx, dswsfc, tg3, & + & t1, sigmaf, dlwflx, dswsfc, tg3, & & coszen, prsl1, wind, shdmin, shdmax, & - & sfalb_lnd_bck, snoalb, zf, qc, q1, & + & snoalb, zf, qc, q1, & ! for land & cm_lnd, ch_lnd, & ! for water @@ -416,41 +419,51 @@ subroutine lsm_ruc_run & ! inputs real (kind_phys), dimension(:), intent(in) :: zs real (kind_phys), dimension(:), intent(in) :: srflag - real (kind_phys), dimension(:), intent(inout) :: & + real (kind_phys), dimension(:), intent(inout), optional :: & + & laixy, tsnow_lnd, sfcqv_lnd, sfcqc_lnd, sfcqc_ice, sfcqv_ice,& + & tsnow_ice + real (kind_phys), dimension(:), intent(inout) :: & & canopy, trans, smcwlt2, smcref2, & ! for land & weasd_lnd, snwdph_lnd, tskin_lnd, & - & tsurf_lnd, z0rl_lnd, tsnow_lnd, & - & sfcqc_lnd, sfcqv_lnd, & + & tsurf_lnd, z0rl_lnd, & ! for ice & weasd_ice, snwdph_ice, tskin_ice, & - & tsurf_ice, z0rl_ice, tsnow_ice, & - & sfcqc_ice, sfcqv_ice, fice + & tsurf_ice, z0rl_ice, fice ! --- in - real (kind_phys), dimension(:), intent(in) :: & - & rainnc, rainc, ice, snow, graupel, rhonewsn1 + real (kind_phys), dimension(:), intent(in), optional :: & + & rainnc, rainc, ice, snow, graupel + real (kind_phys), dimension(:), intent(in) :: rhonewsn1 + real (kind_phys), dimension(:), intent(in), optional :: & + fire_heat_flux_out, frac_grid_burned_out + logical, intent(in) :: add_fire_heat_flux ! --- in/out: ! --- on RUC levels + real (kind_phys), dimension(:,:), intent(inout), optional :: & + & smois, tslb, sh2o, keepfr, smfrkeep real (kind_phys), dimension(:,:), intent(inout) :: & - & smois, tsice, tslb, sh2o, keepfr, smfrkeep + & tsice ! --- output: + real (kind_phys), dimension(:), intent(inout), optional :: & + & sfalb_lnd, sfalb_ice, wetness, snowfallac_lnd, & + & snowfallac_ice, rhosnf real (kind_phys), dimension(:), intent(inout) :: & - & rhosnf, runof, drain, runoff, srunoff, evbs, evcw, & - & stm, wetness, semisbase, semis_lnd, semis_ice, & - & sfalb_lnd, sfalb_ice, & + & runof, drain, runoff, srunoff, evbs, evcw, & + & stm, semisbase, semis_lnd, semis_ice, & ! for land & sncovr1_lnd, qsurf_lnd, gflux_lnd, evap_lnd, & & cmm_lnd, chh_lnd, hflx_lnd, sbsno, & - & snowfallac_lnd, acsnow_lnd, snowmt_lnd, snohf, & + & acsnow_lnd, snowmt_lnd, snohf, & ! for ice & sncovr1_ice, qsurf_ice, gflux_ice, evap_ice, ep1d_ice, & & cmm_ice, chh_ice, hflx_ice, & - & snowfallac_ice, acsnow_ice, snowmt_ice + & acsnow_ice, snowmt_ice real (kind_phys), dimension(:), intent( out) :: & - & albdvis_lnd, albdnir_lnd, albivis_lnd, albinir_lnd, & + & albdvis_lnd, albdnir_lnd, albivis_lnd, albinir_lnd + real (kind_phys), dimension(:), intent( out), optional :: & & albdvis_ice, albdnir_ice, albivis_ice, albinir_ice logical, intent(in) :: flag_init, lsm_cold_start @@ -505,12 +518,13 @@ subroutine lsm_ruc_run & ! inputs & solnet_lnd, sfcexc, & & runoff1, runoff2, acrunoff, semis_bck, & & sfcems_lnd, hfx_lnd, shdfac, shdmin1d, shdmax1d, & + & fire_heat_flux1d, & & sneqv_lnd, snoalb1d_lnd, snowh_lnd, snoh_lnd, tsnav_lnd, & & snomlt_lnd, sncovr_lnd, soilw, soilm, ssoil_lnd, & & soilt_lnd, tbot, & & xlai, swdn, z0_lnd, znt_lnd, rhosnfr, infiltr, & - & precipfr, snfallac_lnd, acsn_lnd, & - & qsfc_lnd, qsg_lnd, qvg_lnd, qcg_lnd, soilt1_lnd, chklowq + & precipfr, snfallac_lnd, acsn_lnd, soilt1_lnd, chklowq, & + & qsfc_lnd, qsg_lnd, qvg_lnd, qcg_lnd, smcwlt, smcref ! ice real (kind_phys),dimension (im,1) :: & & albbck_ice, alb_ice, chs_ice, flhc_ice, flqc_ice, & @@ -540,7 +554,7 @@ subroutine lsm_ruc_run & ! inputs integer :: l, k, i, j, fractional_seaice, ilst real (kind_phys) :: dm, cimin(im) logical :: flag(im), flag_ice(im), flag_ice_uncoupled(im) - logical :: rdlai2d, myj, frpcpn + logical :: myj, frpcpn logical :: debug_print !-- diagnostic point @@ -645,15 +659,27 @@ subroutine lsm_ruc_run & ! inputs nsoil = lsoil_ruc do i = 1, im ! i - horizontal loop - ! reassign smcref2 and smcwlt2 to RUC values if(.not. land(i)) then !water and sea ice - smcref2 (i) = one - smcwlt2 (i) = zero + smcref (i,1) = one + smcwlt (i,1) = zero + xlai (i,1) = zero + elseif (kdt == 1) then + !land + ! reassign smcref2 and smcwlt2 to RUC values at kdt=1 + smcref (i,1) = REFSMC(stype(i)) + smcwlt (i,1) = WLTSMC(stype(i)) + !-- rdlai is .true. when the LAI data is available in the INPUT/sfc_data.nc on cold-start + if(rdlai) then + xlai(i,1) = laixy(i) + else + xlai(i,1) = LAITBL(vtype(i)) + endif else - !land - smcref2 (i) = REFSMC(stype(i)) - smcwlt2 (i) = WLTSMC(stype(i)) + !-- land and kdt > 1, parameters has sub-grid heterogeneity + smcref (i,1) = smcref2 (i) + smcwlt (i,1) = smcwlt2 (i) + xlai (i,1) = laixy (i) endif enddo @@ -813,10 +839,6 @@ subroutine lsm_ruc_run & ! inputs ffrozp(i,j) = real(nint(srflag(i)),kind_phys) endif - !-- rdlai is .false. when the LAI data is not available in the - ! - INPUT/sfc_data.nc - - rdlai2d = rdlai conflx2(i,1,j) = zf(i) * 2._kind_phys ! factor 2. is needed to get the height of ! atm. forcing inside RUC LSM (inherited @@ -843,14 +865,15 @@ subroutine lsm_ruc_run & ! inputs !!\n \a graupelncv - time-step graupel (\f$kg m^{-2} \f$) !!\n \a snowncv - time-step snow (\f$kg m^{-2} \f$) !!\n \a precipfr - time-step precipitation in solid form (\f$kg m^{-2} \f$) -!!\n \a shdfac - areal fractional coverage of green vegetation (0.0-1.0) -!!\n \a shdmin - minimum areal fractional coverage of green vegetation -> !shdmin1d -!!\n \a shdmax - maximum areal fractional coverage of green vegetation -> !shdmax1d +!!\n \a shdfac - areal fractional coverage of green vegetation (0.0-100.%) +!!\n \a shdmin - minimum areal fractional coverage of green vegetation in % -> !shdmin1d +!!\n \a shdmax - maximum areal fractional coverage of green vegetation in % -> !shdmax1d !!\n \a tbot - bottom soil temperature (local yearly-mean sfc air temp) lwdn(i,j) = dlwflx(i) !..downward lw flux at sfc in w/m2 swdn(i,j) = dswsfc(i) !..downward sw flux at sfc in w/m2 + ! all precip input to RUC LSM is in [mm] !prcp(i,j) = rhoh2o * tprcp(i) ! tprcp in [m] - convective plus explicit !raincv(i,j) = rhoh2o * rainc(i) ! total time-step convective precip @@ -918,17 +941,12 @@ subroutine lsm_ruc_run & ! inputs write (0,*)'MODIS landuse is not available' endif - if(rdlai2d) then - xlai(i,j) = laixy(i) - else - xlai(i,j) = zero - endif - semis_bck(i,j) = semisbase(i) ! --- units % shdfac(i,j) = sigmaf(i)*100._kind_phys shdmin1d(i,j) = shdmin(i)*100._kind_phys shdmax1d(i,j) = shdmax(i)*100._kind_phys + fire_heat_flux1d(i,j) = fire_heat_flux_out(i) ! JLS if (land(i)) then ! at least some land in the grid cell @@ -976,7 +994,6 @@ subroutine lsm_ruc_run & ! inputs snoalb1d_lnd(i,j) = snoalb(i) albbck_lnd(i,j) = min(0.9_kind_phys,albbcksol(i)) !sfalb_lnd_bck(i) - !-- spp_lsm if (spp_lsm == 1) then !-- spp for LSM is dimentioned as (1:lsoil_ruc) @@ -999,6 +1016,19 @@ subroutine lsm_ruc_run & ! inputs alb_lnd(i,j) = albbck_lnd(i,j) * (one-sncovr_lnd(i,j)) + snoalb(i) * sncovr_lnd(i,j) ! sfalb_lnd(i) solnet_lnd(i,j) = dswsfc(i)*(one-alb_lnd(i,j)) !..net sw rad flx (dn-up) at sfc in w/m2 + IF ( add_fire_heat_flux .and. fire_heat_flux_out(i) > 0) then ! JLS + if (debug_print) then + print *,'alb_lnd before fire, xlat/xlon ', alb_lnd(i,j), xlat_d(i),xlon_d(i) + print *,'fire_heat_flux_out, frac_grid_burned_out, xlat/xlon ', & + fire_heat_flux_out(i),frac_grid_burned_out(i),xlat_d(i),xlon_d(i) + endif + ! limit albedo in the areas affected by the fire + alb_lnd(i,j) = alb_lnd(i,j) * (one-frac_grid_burned_out(i)) + 0.08_kind_phys*frac_grid_burned_out(i) + if (debug_print) then + print *,'alb_lnd after fire, xlat/xlon ', alb_lnd(i,j), xlat_d(i),xlon_d(i) + endif + ENDIF + cmc(i,j) = canopy(i) ! [mm] soilt_lnd(i,j) = tsurf_lnd(i) ! sanity check for snow temperature tsnow @@ -1163,7 +1193,7 @@ subroutine lsm_ruc_run & ! inputs & wet(i,j), cmc(i,j), shdfac(i,j), alb_lnd(i,j), znt_lnd(i,j), & & z0_lnd(i,j), snoalb1d_lnd(i,j), albbck_lnd(i,j), & & xlai(i,j), landusef(i,:,j), nlcat, & - & soilctop(i,:,j), nscat, & + & soilctop(i,:,j), nscat, smcwlt(i,j), smcref(i,j), & & qsfc_lnd(i,j), qsg_lnd(i,j), qvg_lnd(i,j), qcg_lnd(i,j), & & dew_lnd(i,j), soilt1_lnd(i,j), & & tsnav_lnd(i,j), tbot(i,j), vtype_lnd(i,j), stype_lnd(i,j), & @@ -1178,8 +1208,9 @@ subroutine lsm_ruc_run & ! inputs & infiltr(i,j), runoff1(i,j), runoff2(i,j), acrunoff(i,j), & & sfcexc(i,j), acceta(i,j), ssoil_lnd(i,j), & & snfallac_lnd(i,j), acsn_lnd(i,j), snomlt_lnd(i,j), & - & smfrsoil(i,:,j),keepfrsoil(i,:,j), .false., & - & shdmin1d(i,j), shdmax1d(i,j), rdlai2d, & + & smfrsoil(i,:,j),keepfrsoil(i,:,j), & + & add_fire_heat_flux,fire_heat_flux1d(i,j), .false., & + & shdmin1d(i,j), shdmax1d(i,j), rdlai, & & ims,ime, jms,jme, kms,kme, & & its,ite, jts,jte, kts,kte, errmsg, errflg ) if(debug_print) then @@ -1218,7 +1249,7 @@ subroutine lsm_ruc_run & ! inputs 'ssoil(i,j) =',ssoil_lnd(i,j), & 'snfallac(i,j) =',snfallac_lnd(i,j), & 'acsn_lnd(i,j) =',acsn_lnd(i,j), & - 'snomlt(i,j) =',snomlt_lnd(i,j) + 'snomlt(i,j) =',snomlt_lnd(i,j),'xlai(i,j) =',xlai(i,j) endif endif @@ -1289,6 +1320,10 @@ subroutine lsm_ruc_run & ! inputs ! --- ... unit conversion (from m to mm) snwdph_lnd(i) = snowh_lnd(i,j) * rhoh2o + laixy(i) = xlai(i,j) + smcwlt2(i) = smcwlt(i,j) + smcref2(i) = smcref(i,j) + canopy(i) = cmc(i,j) ! mm weasd_lnd(i) = sneqv_lnd(i,j) ! mm sncovr1_lnd(i) = sncovr_lnd(i,j) @@ -1318,6 +1353,7 @@ subroutine lsm_ruc_run & ! inputs write (0,*)'LAND -i,j,stype_lnd,vtype_lnd',i,j,stype_lnd(i,j),vtype_lnd(i,j) write (0,*)'i,j,tsurf_lnd(i)',i,j,tsurf_lnd(i) write (0,*)'kdt,iter,stsoil(i,:,j)',kdt,iter,stsoil(i,:,j) + write (0,*)'laixy(i)',laixy(i) endif endif ! end of land @@ -1449,7 +1485,7 @@ subroutine lsm_ruc_run & ! inputs & wet_ice(i,j), cmc(i,j), shdfac(i,j), alb_ice(i,j), & & znt_ice(i,j), z0_ice(i,j), snoalb1d_ice(i,j), & & albbck_ice(i,j), xlai(i,j),landusef(i,:,j), nlcat, & - & soilctop(i,:,j), nscat, & + & soilctop(i,:,j), nscat, smcwlt(i,j), smcref(i,j), & & qsfc_ice(i,j), qsg_ice(i,j), qvg_ice(i,j), qcg_ice(i,j), & & dew_ice(i,j), soilt1_ice(i,j), & & tsnav_ice(i,j), tbot(i,j), vtype_ice(i,j), stype_ice(i,j), & @@ -1464,8 +1500,9 @@ subroutine lsm_ruc_run & ! inputs & infiltr(i,j), runoff1(i,j), runoff2(i,j), acrunoff(i,j), & & sfcexc(i,j), acceta(i,j), ssoil_ice(i,j), & & snfallac_ice(i,j), acsn_ice(i,j), snomlt_ice(i,j), & - & smfrice(i,:,j),keepfrice(i,:,j), .false., & - & shdmin1d(i,j), shdmax1d(i,j), rdlai2d, & + & smfrice(i,:,j),keepfrice(i,:,j), & + & add_fire_heat_flux,fire_heat_flux1d(i,j), .false., & + & shdmin1d(i,j), shdmax1d(i,j), rdlai, & & ims,ime, jms,jme, kms,kme, & & its,ite, jts,jte, kts,kte, & & errmsg, errflg) @@ -1502,6 +1539,10 @@ subroutine lsm_ruc_run & ! inputs albivis_ice(i) = sfalb_ice(i) albinir_ice(i) = sfalb_ice(i) + laixy(i) = zero + smcwlt2(i) = zero + smcref2(i) = one + stm(i) = 3.e3_kind_phys ! kg m-2 do k = 1, lsoil_ruc tsice(i,k) = stsice(i,k,j) @@ -1517,6 +1558,7 @@ subroutine lsm_ruc_run & ! inputs write (0,*)'ICE - i,j,stype_ice,vtype_ice)',i,j,stype_ice(i,j),vtype_ice(i,j) write (0,*)'i,j,tsurf_ice(i)',i,j,tsurf_ice(i) write (0,*)'kdt,iter,stsice(i,:,j)',kdt,iter,stsice(i,:,j) + write (0,*)'laixy(i)',laixy(i) endif endif ! ice @@ -1762,6 +1804,8 @@ subroutine rucinit (lsm_cold_start, im, lsoil_ruc, lsoil, & ! in tbot(i,j) = tg3(i) ivgtyp(i,j) = vtype(i) isltyp(i,j) = stype(i) + if(isltyp(i,j)==0) isltyp(i,j)=14 + if(ivgtyp(i,j)==0) ivgtyp(i,j)=17 if (landfrac(i) > zero .or. fice(i) > zero) then !-- land or ice tsk(i,j) = tskin_lnd(i) diff --git a/physics/lsm_ruc.meta b/physics/SFC_Models/Land/RUC/lsm_ruc.meta similarity index 96% rename from physics/lsm_ruc.meta rename to physics/SFC_Models/Land/RUC/lsm_ruc.meta index 34a5b8a8b..0abe4ada3 100644 --- a/physics/lsm_ruc.meta +++ b/physics/SFC_Models/Land/RUC/lsm_ruc.meta @@ -1,7 +1,8 @@ [ccpp-table-properties] name = lsm_ruc type = scheme - dependencies = machine.F,module_sf_ruclsm.F90,module_soil_pre.F90,namelist_soilveg_ruc.F90,set_soilveg_ruc.F90 + dependencies = ../../../hooks/machine.F,../../../hooks/physcons.F90 + dependencies = module_sf_ruclsm.F90,module_soil_pre.F90,namelist_soilveg_ruc.F90,set_soilveg_ruc.F90 ######################################################################## [ccpp-arg-table] @@ -319,6 +320,7 @@ type = real kind = kind_phys intent = inout + optional = True [sfcqv_ice] standard_name = water_vapor_mixing_ratio_at_surface_over_ice long_name = water vapor mixing ratio at surface over ice @@ -327,6 +329,7 @@ type = real kind = kind_phys intent = inout + optional = True [sfalb_lnd_bck] standard_name =surface_snow_free_albedo_over_land long_name = surface snow-free albedo over ice @@ -335,6 +338,7 @@ type = real kind = kind_phys intent = inout + optional = True [semisbase] standard_name = baseline_surface_longwave_emissivity long_name = baseline surface lw emissivity in fraction @@ -399,6 +403,7 @@ type = real kind = kind_phys intent = inout + optional = True [albdnir_ice] standard_name = surface_albedo_direct_NIR_over_ice long_name = direct surface albedo NIR band over ice @@ -407,6 +412,7 @@ type = real kind = kind_phys intent = inout + optional = True [albivis_ice] standard_name = surface_albedo_diffuse_visible_over_ice long_name = diffuse surface albedo visible band over ice @@ -415,6 +421,7 @@ type = real kind = kind_phys intent = inout + optional = True [albinir_ice] standard_name = surface_albedo_diffuse_NIR_over_ice long_name = diffuse surface albedo NIR band over ice @@ -423,6 +430,7 @@ type = real kind = kind_phys intent = inout + optional = True [zs] standard_name = depth_of_soil_layers long_name = depth of soil levels for land surface model @@ -439,6 +447,7 @@ type = real kind = kind_phys intent = inout + optional = True [smfrkeep] standard_name = volume_fraction_of_frozen_soil_moisture_for_land_surface_model long_name = volume fraction of frozen soil moisture for lsm @@ -447,6 +456,7 @@ type = real kind = kind_phys intent = inout + optional = True [tslb] standard_name = soil_temperature_for_land_surface_model long_name = soil temperature for land surface model @@ -455,6 +465,7 @@ type = real kind = kind_phys intent = inout + optional = True [smois] standard_name = volume_fraction_of_soil_moisture_for_land_surface_model long_name = volumetric fraction of soil moisture for lsm @@ -463,6 +474,7 @@ type = real kind = kind_phys intent = inout + optional = True [wetness] standard_name = normalized_soil_wetness_for_land_surface_model long_name = normalized soil wetness @@ -471,6 +483,7 @@ type = real kind = kind_phys intent = inout + optional = True [tsice] standard_name = temperature_in_ice_layer long_name = sea ice internal temperature @@ -813,7 +826,8 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - intent = in + intent = inout + optional = True [dlwflx] standard_name = surface_downwelling_longwave_flux long_name = surface downwelling longwave flux at current time @@ -875,6 +889,7 @@ type = real kind = kind_phys intent = in + optional = True [rainc] standard_name = lwe_thickness_of_convective_precipitation_amount_on_previous_timestep long_name = convective_precipitation_amount from previous timestep @@ -883,6 +898,7 @@ type = real kind = kind_phys intent = in + optional = True [ice] standard_name = lwe_thickness_of_ice_precipitation_amount_on_previous_timestep long_name = ice amount from previous timestep @@ -891,6 +907,7 @@ type = real kind = kind_phys intent = in + optional = True [snow] standard_name = snow_mass_on_previous_timestep long_name = snow amount from previous timestep @@ -899,6 +916,7 @@ type = real kind = kind_phys intent = in + optional = True [graupel] standard_name = lwe_thickness_of_graupel_amount_on_previous_timestep long_name = graupel amount from previous timestep @@ -907,6 +925,7 @@ type = real kind = kind_phys intent = in + optional = True [prsl1] standard_name = air_pressure_at_surface_adjacent_layer long_name = mean pressure at lowest model layer @@ -963,6 +982,7 @@ type = real kind = kind_phys intent = in + optional = True [snoalb] standard_name = upper_bound_of_max_albedo_assuming_deep_snow long_name = maximum snow albedo @@ -1153,6 +1173,7 @@ type = real kind = kind_phys intent = inout + optional = True [sfalb_ice] standard_name = surface_diffused_shortwave_albedo_over_ice long_name = mean surface diffused sw albedo over ice @@ -1161,6 +1182,7 @@ type = real kind = kind_phys intent = inout + optional = True [sncovr1_lnd] standard_name = surface_snow_area_fraction_over_land long_name = surface snow area fraction over land @@ -1233,6 +1255,7 @@ type = real kind = kind_phys intent = inout + optional = True [tsice] standard_name = temperature_in_ice_layer long_name = sea ice internal temperature @@ -1249,6 +1272,7 @@ type = real kind = kind_phys intent = inout + optional = True [sh2o] standard_name = volume_fraction_of_unfrozen_soil_moisture_for_land_surface_model long_name = volume fraction of unfrozen soil moisture for lsm @@ -1257,6 +1281,7 @@ type = real kind = kind_phys intent = inout + optional = True [keepfr] standard_name = control_for_frozen_soil_physics long_name = flag for frozen soil physics (RUC) @@ -1265,6 +1290,7 @@ type = real kind = kind_phys intent = inout + optional = True [smfrkeep] standard_name = volume_fraction_of_frozen_soil_moisture_for_land_surface_model long_name = volume fraction of frozen soil moisture for lsm @@ -1273,6 +1299,7 @@ type = real kind = kind_phys intent = inout + optional = True [canopy] standard_name = canopy_water_amount long_name = canopy water amount @@ -1305,6 +1332,7 @@ type = real kind = kind_phys intent = inout + optional = True [z0rl_lnd] standard_name = surface_roughness_length_over_land long_name = surface roughness length over land (temporary use as interstitial) @@ -1321,6 +1349,7 @@ type = real kind = kind_phys intent = inout + optional = True [sfcqv_lnd] standard_name = water_vapor_mixing_ratio_at_surface_over_land long_name = water vapor mixing ratio at surface over land @@ -1329,6 +1358,7 @@ type = real kind = kind_phys intent = inout + optional = True [qsurf_lnd] standard_name = surface_specific_humidity_over_land long_name = surface air saturation specific humidity over land @@ -1441,6 +1471,7 @@ type = real kind = kind_phys intent = inout + optional = True [snowfallac_lnd] standard_name = surface_snow_amount_assuming_variable_snow_density_over_land long_name = run-total snow accumulation on the ground with variable snow density over land @@ -1449,6 +1480,7 @@ type = real kind = kind_phys intent = inout + optional = True [acsnow_lnd] standard_name = surface_snow_lwe_thickness_amount_over_land long_name = run-total snowfall water equivalent over land @@ -1513,6 +1545,7 @@ type = real kind = kind_phys intent = inout + optional = True [sfcqv_ice] standard_name = water_vapor_mixing_ratio_at_surface_over_ice long_name = water vapor mixing ratio at surface over ice @@ -1521,6 +1554,7 @@ type = real kind = kind_phys intent = inout + optional = True [tsurf_ice] standard_name = surface_skin_temperature_after_iteration_over_ice long_name = surface skin temperature after iteration over ice @@ -1537,6 +1571,7 @@ type = real kind = kind_phys intent = inout + optional = True [z0rl_ice] standard_name = surface_roughness_length_over_ice long_name = surface roughness length over ice (temporary use as interstitial) @@ -1609,6 +1644,7 @@ type = real kind = kind_phys intent = inout + optional = True [acsnow_ice] standard_name = surface_snow_lwe_thickness_amount_over_ice long_name = run-total snowfall water equivalent over ice @@ -1633,6 +1669,7 @@ type = real kind = kind_phys intent = out + optional = True [albdnir_ice] standard_name = surface_albedo_direct_NIR_over_ice long_name = direct surface albedo NIR band over ice @@ -1641,6 +1678,7 @@ type = real kind = kind_phys intent = out + optional = True [albivis_ice] standard_name = surface_albedo_diffuse_visible_over_ice long_name = diffuse surface albedo visible band over ice @@ -1649,6 +1687,7 @@ type = real kind = kind_phys intent = out + optional = True [albinir_ice] standard_name = surface_albedo_diffuse_NIR_over_ice long_name = diffuse surface albedo NIR band over ice @@ -1657,6 +1696,7 @@ type = real kind = kind_phys intent = out + optional = True [rhosnf] standard_name = lsm_internal_surface_frozen_precipitation_density long_name = density of frozen precipitation @@ -1665,6 +1705,7 @@ type = real kind = kind_phys intent = inout + optional = True [sbsno] standard_name = snow_deposition_sublimation_upward_latent_heat_flux long_name = latent heat flux from snow depo/subl @@ -1747,6 +1788,31 @@ dimensions = () type = logical intent = in +[add_fire_heat_flux] + standard_name = flag_for_fire_heat_flux + long_name = flag to add fire heat flux to LSM + units = flag + dimensions = () + type = logical + intent = in +[fire_heat_flux_out] + standard_name = surface_fire_heat_flux + long_name = heat flux of fire at the surface + units = W m-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = True +[frac_grid_burned_out] + standard_name = fraction_of_grid_cell_burning + long_name = ration of the burnt area to the grid cell area + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = True [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/module_sf_ruclsm.F90 b/physics/SFC_Models/Land/RUC/module_sf_ruclsm.F90 similarity index 97% rename from physics/module_sf_ruclsm.F90 rename to physics/SFC_Models/Land/RUC/module_sf_ruclsm.F90 index 6294bc068..2d01f96c9 100644 --- a/physics/module_sf_ruclsm.F90 +++ b/physics/SFC_Models/Land/RUC/module_sf_ruclsm.F90 @@ -97,6 +97,7 @@ SUBROUTINE LSMRUC(xlat,xlon, & MAVAIL,CANWAT,VEGFRA, & ALB,ZNT,Z0,SNOALB,ALBBCK,LAI, & landusef, nlcat, soilctop, nscat, & + smcwlt, smcref, & QSFC,QSG,QVG,QCG,DEW,SOILT1,TSNAV, & TBOT,IVGTYP,ISLTYP,XLAND, & ISWATER,ISICE,XICE,XICE_THRESHOLD, & @@ -107,6 +108,7 @@ SUBROUTINE LSMRUC(xlat,xlon, & RUNOFF1,RUNOFF2,ACRUNOFF,SFCEXC, & SFCEVP,GRDFLX,SNOWFALLAC,ACSNOW,SNOM, & SMFR3D,KEEPFR3DFLAG, & + add_fire_heat_flux,fire_heat_flux, & myj,shdmin,shdmax,rdlai2d, & ims,ime, jms,jme, kms,kme, & its,ite, jts,jte, kts,kte, & @@ -239,6 +241,8 @@ SUBROUTINE LSMRUC(xlat,xlon, & real (kind_phys), DIMENSION( ims:ime , jms:jme ), INTENT(IN ):: SHDMIN real (kind_phys), DIMENSION( ims:ime , jms:jme ), INTENT(IN ):: hgt real (kind_phys), DIMENSION( ims:ime , jms:jme ), INTENT(IN ):: stdev + LOGICAL, intent(in) :: add_fire_heat_flux + real (kind_phys), DIMENSION( ims:ime , jms:jme ), INTENT(IN ):: fire_heat_flux LOGICAL, intent(in) :: rdlai2d real (kind_phys), DIMENSION( 1:nsl), INTENT(IN ) :: ZS @@ -252,6 +256,8 @@ SUBROUTINE LSMRUC(xlat,xlon, & SNOALB, & ALB, & LAI, & + SMCWLT, & + SMCREF, & EMISS, & EMISBCK, & MAVAIL, & @@ -757,6 +763,8 @@ SUBROUTINE LSMRUC(xlat,xlon, & !-- update background emissivity for land points, can have vegetation mosaic effect EMISBCK(I,J) = EMISSL(I,J) + smcwlt(i,j) = wilt + smcref(i,j) = ref IF (debug_print ) THEN if(init)then @@ -961,6 +969,7 @@ SUBROUTINE LSMRUC(xlat,xlon, & snoalb(i,j),albbck(i,j),lai(i,j), & hgt(i,j),stdev(i,j), & !new myj,seaice(i,j),isice, & + add_fire_heat_flux,fire_heat_flux(i,j), & !--- soil fixed fields QWRTZ, & rhocs,dqm,qmin,ref, & @@ -991,10 +1000,12 @@ SUBROUTINE LSMRUC(xlat,xlon, & if(mosaic_lu == 1) then ! greenness factor: between 0 for min greenness and 1 for max greenness. factor = max(zero,min(one,(vegfra(i,j)-shdmin(i,j))/max(one,(shdmax(i,j)-shdmin(i,j))))) + if (debug_print ) then if (abs(xlat-testptlat).lt.0.1 .and. & abs(xlon-testptlon).lt.0.1)then print *,' lat,lon=',xlat,xlon,' factor=',factor endif + endif if((ivgtyp(i,j) == natural .or. ivgtyp(i,j) == crop) .and. factor > 0.75) then ! cropland or grassland, apply irrigation during the growing seaspon when fraction @@ -1210,6 +1221,7 @@ SUBROUTINE SFCTMP (debug_print, delt,ktau,conflx,i,j, & !--- input varia QKMS,TKMS,PC,MAVAIL,CST,VEGFRA,ALB,ZNT, & ALB_SNOW,ALB_SNOW_FREE,lai,hgt,stdev, & MYJ,SEAICE,ISICE, & + add_fire_heat_flux,fire_heat_flux, & QWRTZ,rhocs,dqm,qmin,ref,wilt,psis,bclh,ksat, & !--- soil fixed fields sat,cn,zsmain,zshalf,DTDZS,DTDZS2,tbq, & cp,rovcp,g0,lv,stbolt,cw,c1sn,c2sn, & !--- constants @@ -1254,7 +1266,9 @@ SUBROUTINE SFCTMP (debug_print, delt,ktau,conflx,i,j, & !--- input varia SEAICE, & RHO, & QKMS, & - TKMS + TKMS, & + fire_heat_flux + LOGICAL, INTENT(IN ) :: add_fire_heat_flux INTEGER, INTENT(IN ) :: IVGTYP, ISLTYP !--- 2-D variables @@ -1507,7 +1521,7 @@ SUBROUTINE SFCTMP (debug_print, delt,ktau,conflx,i,j, & !--- input varia ENDIF if(snhei.gt.0.0081_kind_phys*rhowater/rhosn) then -!*** Update snow density for current temperature (Koren et al. 1999) +!*** Update snow density for current temperature (Koren et al 1999,doi:10.1029/1999JD900232.) BSN=delt/3600._kind_phys*c1sn*exp(0.08_kind_phys*min(zero,tsnav)-c2sn*rhosn*1.e-3_kind_phys) if(bsn*snwe*100._kind_phys.lt.1.e-4_kind_phys) goto 777 XSN=rhosn*(exp(bsn*snwe*100._kind_phys)-one)/(bsn*snwe*100._kind_phys) @@ -1673,7 +1687,7 @@ SUBROUTINE SFCTMP (debug_print, delt,ktau,conflx,i,j, & !--- input varia endif if(newsn > zero ) then - SNOWFRACnewsn=MIN(one,SNHEI/SNHEI_CRIT_newsn) + SNOWFRACnewsn=MIN(one,snowfallac*1.e-3_kind_phys/SNHEI_CRIT_newsn) endif !-- due to steep slopes and blown snow, limit snow fraction in the @@ -1686,10 +1700,11 @@ SUBROUTINE SFCTMP (debug_print, delt,ktau,conflx,i,j, & !--- input varia if(snowfrac < 0.75_kind_phys) snow_mosaic = one KEEP_SNOW_ALBEDO = zero - IF (NEWSN > zero .and. snowfracnewsn > 0.99_kind_phys .and. rhosnfall < 450._kind_phys) THEN + IF (snowfracnewsn > 0.99_kind_phys .and. rhosnfall < 450._kind_phys) THEN ! new snow KEEP_SNOW_ALBEDO = one - !snow_mosaic=0. ! ??? + ! turn off separate treatment of snow covered and snow-free portions of the grid cell + snow_mosaic=0. ! ??? ENDIF IF (debug_print ) THEN @@ -1720,7 +1735,7 @@ SUBROUTINE SFCTMP (debug_print, delt,ktau,conflx,i,j, & !--- input varia ! hwlps with these biases.. if( snow_mosaic == one) then ALBsn=alb_snow - if(newsn > zero .and. KEEP_SNOW_ALBEDO > 0.9_kind_phys .and. albsn < 0.4_kind_phys) then + if(KEEP_SNOW_ALBEDO > 0.9_kind_phys .and. albsn < 0.4_kind_phys) then !-- Albedo correction with fresh snow and deep snow pack !-- will reduce warm bias in western Canada !-- and US West coast, where max snow albedo is low (0.3-0.5). @@ -1811,6 +1826,13 @@ SUBROUTINE SFCTMP (debug_print, delt,ktau,conflx,i,j, & !--- input varia UPFLUX = T3 *SOILT XINET = EMISS_snowfree*(GLW-UPFLUX) RNET = GSWnew + XINET + IF ( add_fire_heat_flux .and. fire_heat_flux >0 ) then ! JLS + IF (debug_print ) THEN + print *,'RNET snow-free, fire_heat_flux, xlat/xlon',RNET, fire_heat_flux,xlat,xlon + ENDIF + RNET = RNET + fire_heat_flux + ENDIF + IF (debug_print ) THEN print *,'Fractional snow - snowfrac=',snowfrac print *,'Snowfrac<1 GSWin,GSWnew -',GSWin,GSWnew,'SOILT, RNET',soilt,rnet @@ -1835,7 +1857,7 @@ SUBROUTINE SFCTMP (debug_print, delt,ktau,conflx,i,j, & !--- input varia ilands = ivgtyp - CALL SOIL(debug_print,xlat,xlon, & + CALL SOIL(debug_print,xlat, xlon, testptlat, testptlon,& !--- input variables i,j,iland,isoil,delt,ktau,conflx,nzs,nddzs,nroot, & PRCPMS,RAINF,PATM,QVATM,QCATM,GLW,GSWnew,gswin, & @@ -1931,6 +1953,12 @@ SUBROUTINE SFCTMP (debug_print, delt,ktau,conflx,i,j, & !--- input varia if (SEAICE .LT. 0.5_kind_phys) then ! LAND + IF ( add_fire_heat_flux .and. fire_heat_flux>0 ) then ! JLS + IF (debug_print ) THEN + print *,'RNET snow, fire_heat_flux, xlat/xlon',RNET, fire_heat_flux,xlat,xlon + ENDIF + RNET = RNET + fire_heat_flux + ENDIF if(snow_mosaic==one)then snfr=one else @@ -2049,7 +2077,6 @@ SUBROUTINE SFCTMP (debug_print, delt,ktau,conflx,i,j, & !--- input varia hfx = hfxs*(one-snowfrac) + hfx*snowfrac s = ss*(one-snowfrac) + s*snowfrac evapl = evapls*(one-snowfrac) - sublim = sublim*snowfrac prcpl = prcpls*(one-snowfrac) + prcpl*snowfrac fltot = fltots*(one-snowfrac) + fltot*snowfrac ALB = MAX(keep_snow_albedo*alb, & @@ -2061,10 +2088,6 @@ SUBROUTINE SFCTMP (debug_print, delt,ktau,conflx,i,j, & !--- input varia runoff1 = runoff1s*(one-snowfrac) + runoff1*snowfrac runoff2 = runoff2s*(one-snowfrac) + runoff2*snowfrac - smelt = smelt * snowfrac - snoh = snoh * snowfrac - snflx = snflx * snowfrac - snom = snom * snowfrac mavail = mavails*(one-snowfrac) + one*snowfrac infiltr = infiltrs*(one-snowfrac) + infiltr*snowfrac @@ -2088,7 +2111,7 @@ SUBROUTINE SFCTMP (debug_print, delt,ktau,conflx,i,j, & !--- input varia qvg = qvgs*(one-snowfrac) + qvg*snowfrac qsg = qsgs*(one-snowfrac) + qsg*snowfrac qcg = qcgs*(one-snowfrac) + qcg*snowfrac - sublim = eeta*snowfrac + sublim = eeta eeta = eetas*(one-snowfrac) + eeta*snowfrac qfx = qfxs*(one-snowfrac) + qfx*snowfrac hfx = hfxs*(one-snowfrac) + hfx*snowfrac @@ -2102,10 +2125,6 @@ SUBROUTINE SFCTMP (debug_print, delt,ktau,conflx,i,j, & !--- input varia (emissn - emiss_snowfree) * snowfrac), emissn)) runoff1 = runoff1s*(one-snowfrac) + runoff1*snowfrac runoff2 = runoff2s*(one-snowfrac) + runoff2*snowfrac - smelt = smelt * snowfrac - snoh = snoh * snowfrac - snflx = snflx * snowfrac - snom = snom * snowfrac IF (debug_print ) THEN print *,'SOILT combined on ice', soilt ENDIF @@ -2188,15 +2207,13 @@ SUBROUTINE SFCTMP (debug_print, delt,ktau,conflx,i,j, & !--- input varia IF (debug_print ) then !if (abs(xlat-testptlat).lt.0.2 .and. abs(xlon-testptlon).lt.0.2)then print *,'Snowfallac xlat, xlon',xlat,xlon - print *,'newsn,rhonewsn,newsnowratio=',newsn,rhonewsn,newsnowratio + print *,'newsn [m],rhonewsn,newsnowratio=',newsn,rhonewsn,newsnowratio print *,'Time-step newsn depth [m], swe [m]',newsn,newsn*rhonewsn print *,'Time-step smelt: swe [m]' ,smelt*delt print *,'Time-step sublim: swe,[kg m-2]',sublim*delt endif - snowfallac = snowfallac + max(zero,(newsn*rhonewsn - & ! source of snow (swe) [m] - (smelt+sublim*1.e-3_kind_phys)*delt*newsnowratio) & ! sink: melting and sublimation, (swe) [m] - /rhonewsn)*rhowater ! snow accumulation in snow depth [mm] + snowfallac = snowfallac + newsn * 1.e3_kind_phys ! accumulated snow depth [mm], using variable snow density IF (debug_print ) THEN !if (abs(xlat-testptlat).lt.0.2 .and. abs(xlon-testptlon).lt.0.2)then @@ -2221,7 +2238,14 @@ SUBROUTINE SFCTMP (debug_print, delt,ktau,conflx,i,j, & !--- input varia if(SEAICE .LT. 0.5_kind_phys) then ! LAND - CALL SOIL(debug_print,xlat,xlon, & + IF ( add_fire_heat_flux .and. fire_heat_flux>0) then ! JLS + IF (debug_print ) THEN + print *,'RNET no snow, fire_heat_flux, xlat/xlon',RNET, fire_heat_flux,xlat,xlon + endif + RNET = RNET + fire_heat_flux + ENDIF + + CALL SOIL(debug_print,xlat, xlon, testptlat, testptlon,& !--- input variables i,j,iland,isoil,delt,ktau,conflx,nzs,nddzs,nroot, & PRCPMS,RAINF,PATM,QVATM,QCATM,GLW,GSWnew,GSWin, & @@ -2314,7 +2338,7 @@ END FUNCTION QSN !>\ingroup lsm_ruc_group !> This subroutine calculates energy and moisture budget for vegetated surfaces !! without snow, heat diffusion and Richards eqns in soil. - SUBROUTINE SOIL (debug_print,xlat,xlon, & + SUBROUTINE SOIL (debug_print,xlat,xlon,testptlat,testptlon,& i,j,iland,isoil,delt,ktau,conflx,nzs,nddzs,nroot,& !--- input variables PRCPMS,RAINF,PATM,QVATM,QCATM, & GLW,GSW,GSWin,EMISS,RNET, & @@ -2396,7 +2420,8 @@ SUBROUTINE SOIL (debug_print,xlat,xlon, & INTEGER, INTENT(IN ) :: nroot,ktau,nzs , & nddzs !nddzs=2*(nzs-2) INTEGER, INTENT(IN ) :: i,j,iland,isoil - real (kind_phys), INTENT(IN ) :: DELT,CONFLX,xlat,xlon + real (kind_phys), INTENT(IN ) :: DELT,CONFLX + real (kind_phys), INTENT(IN ) :: xlat,xlon,testptlat,testptlon LOGICAL, INTENT(IN ) :: myj !--- 3-D Atmospheric variables real (kind_phys), & @@ -2620,6 +2645,7 @@ SUBROUTINE SOIL (debug_print,xlat,xlon, & ! hydraulic condeuctivities !****************************************************************** CALL SOILPROP( debug_print, & + xlat, xlon, testptlat, testptlon, & !--- input variables nzs,fwsat,lwsat,tav,keepfr, & soilmois,soiliqw,soilice, & @@ -2655,6 +2681,7 @@ SUBROUTINE SOIL (debug_print,xlat,xlon, & ! TRANSF computes transpiration function !************************************************************** CALL TRANSF(debug_print, & + xlat, xlon, testptlat, testptlon, & !--- input variables nzs,nroot,soiliqw,tabs,lai,gswin, & !--- soil fixed fields @@ -2712,7 +2739,7 @@ SUBROUTINE SOIL (debug_print,xlat,xlon, & ! SOILTEMP soilves heat budget and diffusion eqn. in soil !************************************************************** - CALL SOILTEMP(debug_print,xlat,xlon, & + CALL SOILTEMP(debug_print,xlat,xlon,testptlat,testptlon,& !--- input variables i,j,iland,isoil, & delt,ktau,conflx,nzs,nddzs,nroot, & @@ -2782,6 +2809,7 @@ SUBROUTINE SOIL (debug_print,xlat,xlon, & ! and Richards eqn. !************************************************************************* CALL SOILMOIST (debug_print, & + xlat, xlon, testptlat, testptlon, & !-- input delt,nzs,nddzs,DTDZS,DTDZS2,RIW, & zsmain,zshalf,diffu,hydro, & @@ -3576,6 +3604,7 @@ SUBROUTINE SNOWSOIL ( debug_print,xlat,xlon, & ! hydraulic condeuctivities !****************************************************************** CALL SOILPROP(debug_print, & + xlat, xlon, testptlat, testptlon, & !--- input variables nzs,fwsat,lwsat,tav,keepfr, & soilmois,soiliqw,soilice, & @@ -3626,6 +3655,7 @@ SUBROUTINE SNOWSOIL ( debug_print,xlat,xlon, & ! TRANSF computes transpiration function !************************************************************** CALL TRANSF(debug_print, & + xlat, xlon, testptlat, testptlon, & !--- input variables nzs,nroot,soiliqw,tabs,lai,gswin, & !--- soil fixed fields @@ -3721,7 +3751,7 @@ SUBROUTINE SNOWSOIL ( debug_print,xlat,xlon, & !--- TQCAN FOR SOLUTION OF MOISTURE BALANCE (Smirnova et al. 1996, EQ.22,28) ! AND TSO,ETA PROFILES !************************************************************************* - CALL SOILMOIST (debug_print, & + CALL SOILMOIST (debug_print,xlat,xlon,testptlat,testptlon,& !-- input delt,nzs,nddzs,DTDZS,DTDZS2,RIW, & zsmain,zshalf,diffu,hydro, & @@ -4044,35 +4074,25 @@ SUBROUTINE SNOWSEAICE( debug_print,xlat,xlon, & RHOnewCSN=sheatsn * RHOnewSN if(isncond_opt == 1) then - if(newsnow <= zero .and. snhei > 3.0_kind_phys*SNHEI_crit .and. rhosn > 250._kind_phys) then - !-- some areas with large snow depth have unrealistically - !-- low snow density (in the Rockie's with snow depth > 1 m). - !-- Based on Sturm et al. the 2.5e-6 is typical for hard snow slabs. - !-- In future a better compaction scheme is needed for these areas. - thdifsn = 2.5e-6_kind_phys - else - !-- old version thdifsn = 0.265/RHOCSN - THDIFSN = 0.265_kind_phys/RHOCSN - endif + !-- old version thdifsn = 0.265/RHOCSN + THDIFSN = 0.265_kind_phys/RHOCSN else !-- 07Jun19 - thermal conductivity (K_eff) from Sturm et al.(1997) !-- keff = 10. ** (2.650 * RHOSN*1.e-3 - 1.652) fact = one if(rhosn < 156._kind_phys .or. (newsnow > zero .and. rhonewsn < 156._kind_phys)) then keff = 0.023_kind_phys + 0.234_kind_phys * rhosn * 1.e-3_kind_phys - !-- fact is added by tgs based on 4 Jan 2017 testing - fact = 5._kind_phys else keff = 0.138_kind_phys - 1.01_kind_phys * rhosn*1.e-3_kind_phys + 3.233_kind_phys * rhosn**2 * 1.e-6_kind_phys - fact = 2._kind_phys endif - if(newsnow <= zero .and. snhei > 3.0_kind_phys*SNHEI_crit .and. rhosn > 250._kind_phys) then + if(newsnow <= zero .and. snhei > one .and. rhosn > 250._kind_phys) then !-- some areas with large snow depth have unrealistically !-- low snow density (in the Rockie's with snow depth > 1 m). - !-- Based on Sturm et al. the 2.5e-6 is typical for hard snow slabs. + !-- Based on Sturm et al. keff=0.452 typical for hard snow slabs + !-- with rhosn=488 kg/m^3. Thdifsn = 0.452/(2090*488)=4.431718e-7 !-- In future a better compaction scheme is needed for these areas. - thdifsn = 2.5e-6_kind_phys + thdifsn = 4.431718e-7_kind_phys else thdifsn = keff/rhocsn * fact endif @@ -4508,35 +4528,25 @@ SUBROUTINE SNOWSEAICE( debug_print,xlat,xlon, & RHOCSN=sheatsn* RHOSN if(isncond_opt == 1) then - if(newsnow <= zero .and. snhei > 3.0_kind_phys*SNHEI_crit .and. rhosn > 250._kind_phys) then - !-- some areas with large snow depth have unrealistically - !-- low snow density (in the Rockie's with snow depth > 1 m). - !-- Based on Sturm et al. the 2.5e-6 is typical for hard snow slabs. - !-- In future a better compaction scheme is needed for these areas. - thdifsn = 2.5e-6_kind_phys - else - !-- old version thdifsn = 0.265/RHOCSN - THDIFSN = 0.265_kind_phys/RHOCSN - endif + !-- old version thdifsn = 0.265/RHOCSN + THDIFSN = 0.265_kind_phys/RHOCSN else !-- 07Jun19 - thermal conductivity (K_eff) from Sturm et al.(1997) !-- keff = 10. ** (2.650 * RHOSN*1.e-3 - 1.652) fact = one if(rhosn < 156._kind_phys .or. (newsn > zero .and. rhonewsn < 156._kind_phys)) then keff = 0.023_kind_phys + 0.234_kind_phys * rhosn * 1.e-3_kind_phys - !-- fact is added by tgs based on 4 Jan 2017 testing - fact = 5._kind_phys else keff = 0.138_kind_phys - 1.01_kind_phys * rhosn*1.e-3_kind_phys + 3.233_kind_phys * rhosn**2 * 1.e-6_kind_phys - fact = 2._kind_phys endif - if(newsnow <= zero .and. snhei > 3.0_kind_phys*SNHEI_crit .and. rhosn > 250._kind_phys) then + if(newsnow <= zero .and. snhei > one .and. rhosn > 250._kind_phys) then !-- some areas with large snow depth have unrealistically !-- low snow density (in the Rockie's with snow depth > 1 m). - !-- Based on Sturm et al. the 2.5e-6 is typical for hard snow slabs. + !-- Based on Sturm et al. keff=0.452 typical for hard snow slabs + !-- with rhosn=488 kg/m^3. Thdifsn = 0.452/(2090*488)=4.431718e-7 !-- In future a better compaction scheme is needed for these areas. - thdifsn = 2.5e-6_kind_phys + thdifsn = 4.431718e-7_kind_phys else thdifsn = keff/rhocsn * fact endif @@ -4677,7 +4687,7 @@ END SUBROUTINE SNOWSEAICE !>\ingroup lsm_ruc_group !> This subroutine solves energy budget equation and heat diffusion !! equation. - SUBROUTINE SOILTEMP( debug_print,xlat,xlon, & + SUBROUTINE SOILTEMP( debug_print,xlat,xlon,testptlat,testptlon,& i,j,iland,isoil, & !--- input variables delt,ktau,conflx,nzs,nddzs,nroot, & PRCPMS,RAINF,PATM,TABS,QVATM,QCATM, & @@ -4747,7 +4757,8 @@ SUBROUTINE SOILTEMP( debug_print,xlat,xlon, & INTEGER, INTENT(IN ) :: nroot,ktau,nzs , & nddzs !nddzs=2*(nzs-2) INTEGER, INTENT(IN ) :: i,j,iland,isoil - real (kind_phys), INTENT(IN ) :: DELT,CONFLX,PRCPMS, RAINF,xlat,xlon + real (kind_phys), INTENT(IN ) :: DELT,CONFLX,PRCPMS, RAINF + real (kind_phys), INTENT(IN ) :: xlat, xlon, testptlat, testptlon real (kind_phys), INTENT(INOUT) :: DRYCAN,WETCAN,TRANSUM !--- 3-D Atmospheric variables real (kind_phys), & @@ -5191,27 +5202,16 @@ SUBROUTINE SNOWTEMP( debug_print,xlat,xlon, & RHOCSN=sheatsn* RHOSN RHOnewCSN=sheatsn* RHOnewSN if(isncond_opt == 1) then - if(newsnow <= zero .and. snhei > 3.0_kind_phys*SNHEI_crit .and. rhosn > 250._kind_phys) then - !-- some areas with large snow depth have unrealistically - !-- low snow density (in the Rockie's with snow depth > 1 m). - !-- Based on Sturm et al. the 2.5e-6 is typical for hard snow slabs. - !-- In future a better compaction scheme is needed for these areas. - thdifsn = 2.5e-6_kind_phys - else - !-- old version thdifsn = 0.265/RHOCSN - THDIFSN = 0.265_kind_phys/RHOCSN - endif + !-- old version thdifsn = 0.265/RHOCSN + THDIFSN = 0.265_kind_phys/RHOCSN else !-- 07Jun19 - thermal conductivity (K_eff) from Sturm et al.(1997) !-- keff = 10. ** (2.650 * RHOSN*1.e-3 - 1.652) fact = one if(rhosn < 156._kind_phys .or. (newsnow > zero .and. rhonewsn < 156._kind_phys)) then keff = 0.023_kind_phys + 0.234_kind_phys * rhosn * 1.e-3_kind_phys - !-- fact is added by tgs based on 4 Jan 2017 testing - fact = 5._kind_phys else keff = 0.138_kind_phys - 1.01_kind_phys * rhosn*1.e-3_kind_phys + 3.233_kind_phys * rhosn**2 * 1.e-6_kind_phys - fact = 2._kind_phys if(debug_print) then print *,'SnowTemp xlat,xlon,rhosn,keff', xlat,xlon,rhosn,keff,keff/rhocsn*fact print *,'SNOWTEMP - 0.265/rhocsn',0.265_kind_phys/rhocsn @@ -5221,12 +5221,13 @@ SUBROUTINE SNOWTEMP( debug_print,xlat,xlon, & print *,'SNOWTEMP - xlat,xlon,newsnow,rhonewsn,rhosn,fact,keff',xlat,xlon,newsnow, rhonewsn,rhosn,fact,keff endif - if(newsnow <= zero .and. snhei > 3.0_kind_phys*SNHEI_crit .and. rhosn > 250._kind_phys) then + if(newsnow <= zero .and. snhei > one .and. rhosn > 250._kind_phys) then !-- some areas with large snow depth have unrealistically !-- low snow density (in the Rockie's with snow depth > 1 m). - !-- Based on Sturm et al. the 2.5e-6 is typical for hard snow slabs. + !-- Based on Sturm et al. keff=0.452 typical for hard snow slabs + !-- with rhosn=488 kg/m^3. Thdifsn = 0.452/(2090*488)=4.431718e-7 !-- In future a better compaction scheme is needed for these areas. - thdifsn = 2.5e-6_kind_phys + thdifsn = 4.431718e-7_kind_phys else thdifsn = keff/rhocsn * fact endif @@ -5585,7 +5586,7 @@ SUBROUTINE SNOWTEMP( debug_print,xlat,xlon, & nmelt = 1 soiltfrac=snowfrac*tfrz+(one-snowfrac)*SOILT QSG=min(QSG, QSN(soiltfrac,TBQ)/PP) - qvg=qsg + qvg=snowfrac*qsg+(one-snowfrac)*qvg T3 = STBOLT*TN*TN*TN UPFLUX = T3 * 0.5_kind_phys*(TN + SOILTfrac) XINET = EMISS*(GLW-UPFLUX) @@ -5774,27 +5775,16 @@ SUBROUTINE SNOWTEMP( debug_print,xlat,xlon, & RHOCSN=sheatsn* RHOSN if(isncond_opt == 1) then - if(newsnow <= zero .and. snhei > 3.0_kind_phys*SNHEI_crit .and. rhosn > 250._kind_phys) then - !-- some areas with large snow depth have unrealistically - !-- low snow density (in the Rockie's with snow depth > 1 m). - !-- Based on Sturm et al. the 2.5e-6 is typical for hard snow slabs. - !-- In future a better compaction scheme is needed for these areas. - thdifsn = 2.5e-6_kind_phys - else - !-- old version thdifsn = 0.265/RHOCSN - THDIFSN = 0.265_kind_phys/RHOCSN - endif + !-- old version thdifsn = 0.265/RHOCSN + THDIFSN = 0.265_kind_phys/RHOCSN else !-- 07Jun19 - thermal conductivity (K_eff) from Sturm et al.(1997) !-- keff = 10. ** (2.650 * RHOSN*1.e-3 - 1.652) fact = one if(rhosn < 156._kind_phys .or. (newsnow > zero .and. rhonewsn < 156._kind_phys)) then keff = 0.023_kind_phys + 0.234_kind_phys * rhosn * 1.e-3_kind_phys - !-- fact is added by tgs based on 4 Jan 2017 testing - fact = 5._kind_phys else keff = 0.138_kind_phys - 1.01_kind_phys * rhosn*1.e-3_kind_phys + 3.233_kind_phys * rhosn**2 * 1.e-6_kind_phys - fact = 2._kind_phys if(debug_print) then print *,'End SNOWTEMP - xlat,xlon,rhosn,keff',xlat,xlon,rhosn,keff print *,'End SNOWTEMP - 0.265/rhocsn',0.265/rhocsn @@ -5805,12 +5795,13 @@ SUBROUTINE SNOWTEMP( debug_print,xlat,xlon, & xlat,xlon,newsnow, rhonewsn,rhosn,fact,keff,keff/rhocsn*fact endif - if(newsnow <= zero .and. snhei > 3.0_kind_phys*SNHEI_crit .and. rhosn > 250._kind_phys) then + if(newsnow <= zero .and. snhei > one .and. rhosn > 250._kind_phys) then !-- some areas with large snow depth have unrealistically !-- low snow density (in the Rockie's with snow depth > 1 m). - !-- Based on Sturm et al. the 2.5e-6 is typical for hard snow slabs. + !-- Based on Sturm et al. keff=0.452 typical for hard snow slabs + !-- with rhosn=488 kg/m^3. Thdifsn = 0.452/(2090*488)=4.431718e-7 !-- In future a better compaction scheme is needed for these areas. - thdifsn = 2.5e-6_kind_phys + thdifsn = 4.431718e-7_kind_phys else thdifsn = keff/rhocsn * fact endif @@ -5957,6 +5948,7 @@ END SUBROUTINE SNOWTEMP !! This subroutine solves moisture budget and computes soil moisture !! and surface and sub-surface runoffs. SUBROUTINE SOILMOIST ( debug_print, & + xlat, xlon, testptlat, testptlon, & DELT,NZS,NDDZS,DTDZS,DTDZS2,RIW, & !--- input parameters ZSMAIN,ZSHALF,DIFFU,HYDRO, & QSG,QVG,QCG,QCATM,QVATM,PRCP, & @@ -6010,6 +6002,7 @@ SUBROUTINE SOILMOIST ( debug_print, & !--- input variables LOGICAL, INTENT(IN ) :: debug_print real (kind_phys), INTENT(IN ) :: DELT + real (kind_phys), INTENT(IN ) :: xlat, xlon, testptlat, testptlon INTEGER, INTENT(IN ) :: NZS,NDDZS ! input variables @@ -6097,8 +6090,12 @@ SUBROUTINE SOILMOIST ( debug_print, & DENOM=one+X2+X4-Q2*COSMC(K) COSMC(K+1)=Q4/DENOM IF (debug_print ) THEN - print *,'q2,soilmois(kn),DIFFU(KN),x2,HYDRO(KN+1),DTDZS2(KN-1),kn,k' & - ,q2,soilmois(kn),DIFFU(KN),x2,HYDRO(KN+1),DTDZS2(KN-1),kn,k + if (abs(xlat-testptlat).lt.0.05 .and. & + abs(xlon-testptlon).lt.0.05)then + print *,'xlat,xlon=',xlat,xlon + print *,'q2,soilmois(kn),DIFFU(KN),x2,HYDRO(KN+1),DTDZS2(KN-1),kn,k' & + ,q2,soilmois(kn),DIFFU(KN),x2,HYDRO(KN+1),DTDZS2(KN-1),kn,k + endif ENDIF RHSMC(K+1)=(SOILMOIS(KN)+Q2*RHSMC(K) & +TRANSP(KN) & @@ -6129,8 +6126,12 @@ SUBROUTINE SOILMOIST ( debug_print, & TOTLIQ=PRCP-DRIP/DELT-(one-VEGFRAC)*DEW*RAS-SMELT IF (debug_print ) THEN -print *,'UMVEG*PRCP,DRIP/DELT,UMVEG*DEW*RAS,SMELT', & - UMVEG*PRCP,DRIP/DELT,UMVEG*DEW*RAS,SMELT + if (abs(xlat-testptlat).lt.0.05 .and. & + abs(xlon-testptlon).lt.0.05)then + print *,'xlat,xlon=',xlat,xlon + print *,'UMVEG*PRCP,DRIP/DELT,UMVEG*DEW*RAS,SMELT', & + UMVEG*PRCP,DRIP/DELT,UMVEG*DEW*RAS,SMELT + endif ENDIF FLX=TOTLIQ @@ -6173,7 +6174,7 @@ SUBROUTINE SOILMOIST ( debug_print, & INFMAX1 = zero ENDIF IF (debug_print ) THEN - print *,'INFMAX1 before frozen part',INFMAX1 + print *,'INFMAX1 before frozen part',INFMAX1 ENDIF ! ----------- FROZEN GROUND VERSION -------------------------- @@ -6207,8 +6208,8 @@ SUBROUTINE SOILMOIST ( debug_print, & INFMAX = MAX(INFMAX1,HYDRO(1)*SOILMOIS(1)) INFMAX = MIN(INFMAX, -TOTLIQ) IF (debug_print ) THEN -print *,'INFMAX,INFMAX1,HYDRO(1)*SOILIQW(1),-TOTLIQ', & - INFMAX,INFMAX1,HYDRO(1)*SOILIQW(1),-TOTLIQ + print *,'INFMAX,INFMAX1,HYDRO(1)*SOILIQW(1),-TOTLIQ', & + INFMAX,INFMAX1,HYDRO(1)*SOILIQW(1),-TOTLIQ ENDIF !---- IF (-TOTLIQ.GT.INFMAX)THEN @@ -6258,8 +6259,12 @@ SUBROUTINE SOILMOIST ( debug_print, & END IF IF (debug_print ) THEN - print *,'SOILMOIS,SOILIQW, soilice',SOILMOIS,SOILIQW,soilice*riw - print *,'COSMC,RHSMC',COSMC,RHSMC + if (abs(xlat-testptlat).lt.0.05 .and. & + abs(xlon-testptlon).lt.0.05)then + print *,'xlat,xlon=',xlat,xlon + print *,'SOILMOIS,SOILIQW, soilice',SOILMOIS,SOILIQW,soilice*riw + print *,'COSMC,RHSMC',COSMC,RHSMC + endif ENDIF !--- FINAL SOLUTION FOR SOILMOIS ! DO K=2,NZS1 @@ -6285,7 +6290,11 @@ SUBROUTINE SOILMOIST ( debug_print, & END IF END DO IF (debug_print ) THEN - print *,'END soilmois,soiliqw,soilice',soilmois,SOILIQW,soilice*riw + if (abs(xlat-testptlat).lt.0.05 .and. & + abs(xlon-testptlon).lt.0.05)then + print *,'xlat,xlon=',xlat,xlon + print *,'END soilmois,soiliqw,soilice',soilmois,SOILIQW,soilice*riw + endif ENDIF MAVAIL=max(.00001_kind_phys,min(one,(SOILMOIS(1)/(REF-QMIN)*(one-snowfrac)+one*snowfrac))) @@ -6297,6 +6306,7 @@ END SUBROUTINE SOILMOIST !! This subroutine computes thermal diffusivity, and diffusional and !! hydraulic condeuctivities in soil. SUBROUTINE SOILPROP( debug_print, & + xlat, xlon, testptlat, testptlon, & nzs,fwsat,lwsat,tav,keepfr, & !--- input variables soilmois,soiliqw,soilice, & soilmoism,soiliqwm,soilicem, & @@ -6330,6 +6340,8 @@ SUBROUTINE SOILPROP( debug_print, & !--- soil properties LOGICAL, INTENT(IN ) :: debug_print INTEGER, INTENT(IN ) :: NZS + real (kind_phys), INTENT(IN ) :: xlat, xlon, testptlat, testptlon + real (kind_phys) , & INTENT(IN ) :: RHOCS, & BCLH, & @@ -6506,6 +6518,7 @@ END SUBROUTINE SOILPROP !> This subroutine solves the transpiration function (EQs. 18,19 in !! Smirnova et al.(1997) \cite Smirnova_1997) SUBROUTINE TRANSF( debug_print, & + xlat,xlon,testptlat,testptlon, & nzs,nroot,soiliqw,tabs,lai,gswin, & !--- input variables dqm,qmin,ref,wilt,zshalf,pc,iland, & !--- soil fixed fields tranf,transum) !--- output variables @@ -6526,6 +6539,7 @@ SUBROUTINE TRANSF( debug_print, & LOGICAL, INTENT(IN ) :: debug_print INTEGER, INTENT(IN ) :: nroot,nzs,iland + real (kind_phys), INTENT(IN ) :: xlat,xlon,testptlat,testptlon real (kind_phys) , & INTENT(IN ) :: GSWin, TABS, lai @@ -6572,7 +6586,7 @@ SUBROUTINE TRANSF( debug_print, & ap4=59.656_kind_phys gx=ap0+ap1*sm1+ap2*sm2+ap3*sm3+ap4*sm4 if(totliq.ge.ref) gx=one - if(totliq.le.zero) gx=zero + if(totliq.le.wilt) gx=zero if(gx.gt.one) gx=one if(gx.lt.zero) gx=zero DID=zshalf(2) @@ -6585,7 +6599,7 @@ SUBROUTINE TRANSF( debug_print, & TRANF(1)=(TOTLIQ-WILT)/(REF-WILT)*DID ENDIF !-- uncomment next line for non-linear root distribution - TRANF(1)=part(1) + !TRANF(1)=part(1) DO K=2,NROOT totliq=soiliqw(k)+qmin @@ -6595,7 +6609,7 @@ SUBROUTINE TRANSF( debug_print, & sm4=sm3*sm1 gx=ap0+ap1*sm1+ap2*sm2+ap3*sm3+ap4*sm4 if(totliq.ge.ref) gx=one - if(totliq.le.zero) gx=zero + if(totliq.le.wilt) gx=zero if(gx.gt.one) gx=one if(gx.lt.zero) gx=zero DID=zshalf(K+1)-zshalf(K) @@ -6609,8 +6623,16 @@ SUBROUTINE TRANSF( debug_print, & /(REF-WILT)*DID ENDIF !-- uncomment next line for non-linear root distribution -! TRANF(k)=part(k) + !TRANF(k)=part(k) END DO + IF (debug_print ) THEN + if (abs(xlat-testptlat).lt.0.05 .and. & + abs(xlon-testptlon).lt.0.05)then + print *,'xlat,xlon=',xlat,xlon + print *,'soiliqw =',soiliqw,'wilt=',wilt,'qmin= ',qmin + print *,'tranf = ',tranf + endif + ENDIF ! For LAI> 3 => transpiration at potential rate (F.Tardieu, 2013) if(lai > 4._kind_phys) then @@ -6622,7 +6644,11 @@ SUBROUTINE TRANSF( debug_print, & ! pctot=min(0.8,max(pc,pc*lai)) endif IF ( debug_print ) THEN - print *,'pctot,lai,pc',pctot,lai,pc + if (abs(xlat-testptlat).lt.0.05 .and. & + abs(xlon-testptlon).lt.0.05)then + print *,'xlat,xlon=',xlat,xlon + print *,'pctot,lai,pc',pctot,lai,pc + endif ENDIF !--- !--- air temperature function @@ -6632,9 +6658,6 @@ SUBROUTINE TRANSF( debug_print, & ELSE FTEM = one / (one + EXP(0.5_kind_phys * (TABS - 314.0_kind_phys))) ENDIF - IF ( debug_print ) THEN - print *,'tabs,ftem',tabs,ftem - ENDIF !--- incoming solar function cmin = one/rsmax_data cmax = one/rstbl(iland) @@ -6657,27 +6680,33 @@ SUBROUTINE TRANSF( debug_print, & else fsol = one endif - IF ( debug_print ) THEN - print *,'GSWin,lai,f1,fsol',gswin,lai,f1,fsol - ENDIF !--- total conductance totcnd =(cmin + (cmax - cmin)*pctot*ftem*fsol)/cmax IF ( debug_print ) THEN - print *,'iland,RGLTBL(iland),RSTBL(iland),RSMAX_DATA,totcnd' & - ,iland,RGLTBL(iland),RSTBL(iland),RSMAX_DATA,totcnd + if (abs(xlat-testptlat).lt.0.05 .and. & + abs(xlon-testptlon).lt.0.05)then + print *,'xlat,xlon=',xlat,xlon + print *,'GSWin,Tabs,lai,f1,cmax,cmin,pc,pctot,ftem,fsol',GSWin,Tabs,lai,f1,cmax,cmin,pc,pctot,ftem,fsol + print *,'iland,RGLTBL(iland),RSTBL(iland),RSMAX_DATA,totcnd' & + ,iland,RGLTBL(iland),RSTBL(iland),RSMAX_DATA,totcnd + endif ENDIF !-- TRANSUM - total for the rooting zone transum=zero DO K=1,NROOT ! linear root distribution - TRANF(k)=max(cmin,TRANF(k)*totcnd) + TRANF(k)=max(zero,TRANF(k)*totcnd) transum=transum+tranf(k) END DO IF ( debug_print ) THEN - print *,'transum,TRANF',transum,tranf - endif + if (abs(xlat-testptlat).lt.0.05 .and. & + abs(xlon-testptlon).lt.0.05)then + print *,'xlat,xlon=',xlat,xlon + print *,'transum,TRANF',transum,tranf + endif + ENDIF !----------------------------------------------------------------- END SUBROUTINE TRANSF diff --git a/physics/module_soil_pre.F90 b/physics/SFC_Models/Land/RUC/module_soil_pre.F90 similarity index 100% rename from physics/module_soil_pre.F90 rename to physics/SFC_Models/Land/RUC/module_soil_pre.F90 diff --git a/physics/namelist_soilveg_ruc.F90 b/physics/SFC_Models/Land/RUC/namelist_soilveg_ruc.F90 similarity index 100% rename from physics/namelist_soilveg_ruc.F90 rename to physics/SFC_Models/Land/RUC/namelist_soilveg_ruc.F90 diff --git a/physics/set_soilveg_ruc.F90 b/physics/SFC_Models/Land/RUC/set_soilveg_ruc.F90 similarity index 100% rename from physics/set_soilveg_ruc.F90 rename to physics/SFC_Models/Land/RUC/set_soilveg_ruc.F90 diff --git a/physics/SFC_Models/Land/sfc_land.F90 b/physics/SFC_Models/Land/sfc_land.F90 new file mode 100644 index 000000000..a85e8b787 --- /dev/null +++ b/physics/SFC_Models/Land/sfc_land.F90 @@ -0,0 +1,108 @@ +!> \file sfc_land.F90 +!! This file contains the code for coupling to land component + +!> This module contains the CCPP-compliant GFS land post +!! interstitial codes, which returns updated surface +!! properties such as latent heat and sensible heat +!! provided by the component version of land model + +!> This module contains the CCPP-compliant GFS land scheme. + module sfc_land + + use machine, only : kind_phys + + contains + +!> \defgroup sfc_land for coupling to land +!! @{ +!! \section diagram Calling Hierarchy Diagram +!! \section intraphysics Intraphysics Communication +!! +!> \brief Brief description of the subroutine +!! +!! \section arg_table_sfc_land_run Arguments +!! \htmlinclude sfc_land_run.html +!! + +!! +!! \section general General Algorithm +!! \section detailed Detailed Algorithm +!! @{ + subroutine sfc_land_run(im, cpllnd, cpllnd2atm, flag_iter, dry, & + sncovr1_lnd, qsurf_lnd, evap_lnd, hflx_lnd, & + ep_lnd, t2mmp_lnd, q2mp_lnd, gflux_lnd, & + runoff_lnd, drain_lnd, cmm_lnd, chh_lnd, zvfun_lnd, & + sncovr1, qsurf, evap, hflx, ep, t2mmp, q2mp, & + gflux, runoff, drain, cmm, chh, zvfun, & + errmsg, errflg) + + implicit none + + ! Inputs + integer , intent(in) :: im + logical , intent(in) :: cpllnd + logical , intent(in) :: cpllnd2atm + logical , intent(in) :: flag_iter(:) + logical , intent(in) :: dry(:) + real(kind=kind_phys), intent(in), optional :: sncovr1_lnd(:) + real(kind=kind_phys), intent(in), optional :: qsurf_lnd(:) + real(kind=kind_phys), intent(in), optional :: evap_lnd(:) + real(kind=kind_phys), intent(in), optional :: hflx_lnd(:) + real(kind=kind_phys), intent(in), optional :: ep_lnd(:) + real(kind=kind_phys), intent(in), optional :: t2mmp_lnd(:) + real(kind=kind_phys), intent(in), optional :: q2mp_lnd(:) + real(kind=kind_phys), intent(in), optional :: gflux_lnd(:) + real(kind=kind_phys), intent(in), optional :: runoff_lnd(:) + real(kind=kind_phys), intent(in), optional :: drain_lnd(:) + real(kind=kind_phys), intent(in), optional :: cmm_lnd(:) + real(kind=kind_phys), intent(in), optional :: chh_lnd(:) + real(kind=kind_phys), intent(in), optional :: zvfun_lnd(:) + ! Inputs/Outputs + real(kind=kind_phys), intent(inout) :: sncovr1(:) + real(kind=kind_phys), intent(inout) :: qsurf(:) + real(kind=kind_phys), intent(inout) :: evap(:) + real(kind=kind_phys), intent(inout) :: hflx(:) + real(kind=kind_phys), intent(inout) :: ep(:) + real(kind=kind_phys), intent(inout), optional :: t2mmp(:) + real(kind=kind_phys), intent(inout), optional :: q2mp(:) + real(kind=kind_phys), intent(inout) :: gflux(:) + real(kind=kind_phys), intent(inout) :: runoff(:) + real(kind=kind_phys), intent(inout) :: drain(:) + real(kind=kind_phys), intent(inout) :: cmm(:) + real(kind=kind_phys), intent(inout) :: chh(:) + real(kind=kind_phys), intent(inout) :: zvfun(:) + ! Outputs + character(len=*) , intent(out) :: errmsg + integer , intent(out) :: errflg + + ! Locals + integer :: i + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + ! Check coupling from component land to atmosphere + if (.not. cpllnd2atm) return + + ! Fill variables + do i = 1, im + sncovr1(i) = sncovr1_lnd(i) + qsurf(i) = qsurf_lnd(i) + hflx(i) = hflx_lnd(i) + evap(i) = evap_lnd(i) + ep(i) = ep_lnd(i) + t2mmp(i) = t2mmp_lnd(i) + q2mp(i) = q2mp_lnd(i) + gflux(i) = gflux_lnd(i) + drain(i) = drain_lnd(i) + runoff(i) = runoff_lnd(i) + cmm(i) = cmm_lnd(i) + chh(i) = chh_lnd(i) + zvfun(i) = zvfun_lnd(i) + enddo + + end subroutine sfc_land_run + +!> @} + end module sfc_land diff --git a/physics/SFC_Models/Land/sfc_land.meta b/physics/SFC_Models/Land/sfc_land.meta new file mode 100644 index 000000000..15790145e --- /dev/null +++ b/physics/SFC_Models/Land/sfc_land.meta @@ -0,0 +1,282 @@ +[ccpp-table-properties] + name = sfc_land + type = scheme + dependencies = ../../hooks/machine.F + +######################################################################## +[ccpp-arg-table] + name = sfc_land_run + type = scheme +[im] + standard_name = horizontal_loop_extent + long_name = horizontal loop extent + units = count + dimensions = () + type = integer + intent = in +[cpllnd] + standard_name = flag_for_land_coupling + long_name = flag controlling cpllnd collection (default off) + units = flag + dimensions = () + type = logical + intent = in +[cpllnd2atm] + standard_name = flag_for_one_way_land_coupling_to_atmosphere + long_name = flag controlling land coupling to the atmosphere (default off) + units = flag + dimensions = () + type = logical + intent = in +[flag_iter] + standard_name = flag_for_iteration + long_name = flag for iteration + units = flag + dimensions = (horizontal_loop_extent) + type = logical + intent = in +[dry] + standard_name = flag_nonzero_land_surface_fraction + long_name = flag indicating presence of some land surface area fraction + units = flag + dimensions = (horizontal_loop_extent) + type = logical + intent = in +[sncovr1_lnd] + standard_name = surface_snow_area_fraction_over_land_from_land + long_name = surface snow area fraction over land for coupling + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = True +[qsurf_lnd] + standard_name = surface_specific_humidity_over_land_from_land + long_name = surface air saturation specific humidity over land + units = kg kg-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = True +[evap_lnd] + standard_name = surface_upward_latent_heat_flux_over_land_from_land + long_name = sfc latent heat flux input over land for coupling + units = kg kg-1 m s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = True +[hflx_lnd] + standard_name = surface_upward_sensible_heat_flux_over_land_from_land + long_name = sfc sensible heat flux input over land for coupling + units = K m s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = True +[ep_lnd] + standard_name = surface_upward_potential_latent_heat_flux_over_land_from_land + long_name = surface upward potential latent heat flux over land for coupling + units = W m-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = True +[t2mmp_lnd] + standard_name = temperature_at_2m_over_land_from_land + long_name = 2 meter temperature over land for coupling + units = K + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = True +[q2mp_lnd] + standard_name = specific_humidity_at_2m_over_land_from_land + long_name = 2 meter specific humidity over land for coupling + units = kg kg-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = True +[gflux_lnd] + standard_name = upward_heat_flux_in_soil_over_land_from_land + long_name = soil heat flux over land for coupling + units = W m-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = True +[runoff_lnd] + standard_name = surface_runoff_flux_from_land + long_name = surface runoff flux over land for coupling + units = kg m-2 s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = True +[drain_lnd] + standard_name = subsurface_runoff_flux_from_land + long_name = subsurface runoff flux over land for coupling + units = kg m-2 s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = True +[cmm_lnd] + standard_name = surface_drag_wind_speed_for_momentum_in_air_over_land_from_land + long_name = momentum exchange coefficient over land for coupling + units = m s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = out + optional = True +[chh_lnd] + standard_name = surface_drag_mass_flux_for_heat_and_moisture_in_air_over_land_from_land + long_name = thermal exchange coefficient over land for coupling + units = kg m-2 s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = True +[zvfun_lnd] + standard_name = function_of_surface_roughness_length_and_green_vegetation_fraction_from_land + long_name = function of surface roughness length and green vegetation fraction + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = True +[sncovr1] + standard_name = surface_snow_area_fraction_over_land + long_name = surface snow area fraction + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout +[qsurf] + standard_name = surface_specific_humidity_over_land + long_name = surface air saturation specific humidity over land + units = kg kg-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout +[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_loop_extent) + type = real + kind = kind_phys + intent = inout +[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_loop_extent) + type = real + kind = kind_phys + intent = inout +[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_loop_extent) + type = real + kind = kind_phys + intent = inout +[t2mmp] + standard_name = temperature_at_2m_from_noahmp + long_name = 2 meter temperature from noahmp + units = K + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = True +[q2mp] + standard_name = specific_humidity_at_2m_from_noahmp + long_name = 2 meter specific humidity from noahmp + units = kg kg-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = True +[gflux] + standard_name = upward_heat_flux_in_soil_over_land + long_name = soil heat flux over land + units = W m-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout +[runoff] + standard_name = surface_runoff_flux + long_name = surface runoff flux + units = kg m-2 s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout +[drain] + standard_name = subsurface_runoff_flux + long_name = subsurface runoff flux + units = kg m-2 s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout +[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_loop_extent) + type = real + kind = kind_phys + intent = inout +[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_loop_extent) + type = real + kind = kind_phys + intent = inout +[zvfun] + standard_name = function_of_surface_roughness_length_and_green_vegetation_fraction + long_name = function of surface roughness length and green vegetation fraction + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out +[errflg] + standard_name = ccpp_error_code + long_name = error code for error handling in CCPP + units = 1 + dimensions = () + type = integer + intent = out diff --git a/physics/sfc_ocean.F b/physics/SFC_Models/Ocean/UFS/sfc_ocean.F similarity index 87% rename from physics/sfc_ocean.F rename to physics/SFC_Models/Ocean/UFS/sfc_ocean.F index 78d58d8f0..a0410a51c 100644 --- a/physics/sfc_ocean.F +++ b/physics/SFC_Models/Ocean/UFS/sfc_ocean.F @@ -25,6 +25,7 @@ subroutine sfc_ocean_run & ! --- inputs: & ( im, hvap, cp, rd, eps, epsm1, rvrdm1, ps, u1, v1, t1, q1, & & tskin, cm, ch, lseaspray, fm, fm10, & + & usfco, vsfco, icplocn2atm, & & prsl1, prslki, wet, use_lake_model, wind, &, ! --- inputs & flag_iter, use_med_flux, dqsfc_med, dtsfc_med, & & qsurf, cmm, chh, gflux, evap, hflx, ep, & ! --- outputs @@ -39,6 +40,7 @@ subroutine sfc_ocean_run & ! call sfc_ocean ! ! inputs: ! ! ( im, ps, u1, v1, t1, q1, tskin, cm, ch, lseaspray, fm, fm10, ! +! usfco, vsfco, icplocn2atm, ! ! prsl1, prslki, wet, use_lake_model, wind, flag_iter, ! ! use_med_flux, ! ! outputs: ! @@ -66,6 +68,10 @@ subroutine sfc_ocean_run & ! im - integer, horizontal dimension 1 ! ! ps - real, surface pressure im ! ! u1, v1 - real, u/v component of surface layer wind (m/s) im ! +! usfco - real, u component of surface ocean current (m/s) im ! +! vsfco - real, v component of surface ocean current (m/s) im ! +! icplocn2atm - integer, =1 if usfco and vsfco are used in the 1 ! +! computation of air-sea fluxes ! ! t1 - real, surface layer mean temperature ( k ) im ! ! q1 - real, surface layer mean specific humidity im ! ! tskin - real, ground surface skin temperature ( k ) im ! @@ -109,18 +115,20 @@ subroutine sfc_ocean_run & & eps, epsm1, rvrdm1 real (kind=kind_phys), dimension(:), intent(in) :: ps, u1, v1, & - & t1, q1, tskin, cm, ch, fm, fm10, prsl1, prslki, wind + & t1, q1, tskin, cm, ch, fm, fm10, prsl1, prslki, wind, & + & usfco, vsfco ! For sea spray effect logical, intent(in) :: lseaspray ! logical, dimension(:), intent(in) :: flag_iter, wet integer, dimension(:), intent(in) :: use_lake_model + integer, intent(in) :: icplocn2atm ! logical, intent(in) :: use_med_flux ! To receive fluxes from mediator - real (kind=kind_phys), dimension(:), intent(in) :: & + real (kind=kind_phys), dimension(:), intent(in), optional :: & & dqsfc_med, dtsfc_med ! --- outputs: @@ -135,6 +143,7 @@ subroutine sfc_ocean_run & real (kind=kind_phys) :: qss, rch, tem, & elocp, cpinv, hvapi real (kind=kind_phys), dimension(im) :: rho, q0 + real (kind=kind_phys), dimension(im) :: windrel integer :: i @@ -173,9 +182,15 @@ subroutine sfc_ocean_run & if (use_med_flux) then q0(i) = max( q1(i), qmin ) rho(i) = prsl1(i) / (rd*t1(i)*(one + rvrdm1*q0(i))) - - tem = ch(i) * wind(i) - cmm(i) = cm(i) * wind(i) + + if (icplocn2atm == 0) then + tem = ch(i) * wind(i) + cmm(i) = cm(i) * wind(i) + else if (icplocn2atm ==1) then + windrel(i)=sqrt( (u1(i)-usfco(i))**2+(v1(i)-vsfco(i))**2 ) + tem = ch(i) * windrel(i) + cmm(i) = cm(i) * windrel(i) + endif chh(i) = rho(i) * tem hflx(i) = dtsfc_med(i) @@ -192,9 +207,16 @@ subroutine sfc_ocean_run & ! --- ... rcp = rho cp ch v - rch = rho(i) * cp * ch(i) * wind(i) - tem = ch(i) * wind(i) - cmm(i) = cm(i) * wind(i) + if (icplocn2atm == 0) then + rch = rho(i) * cp * ch(i) * wind(i) + tem = ch(i) * wind(i) + cmm(i) = cm(i) * wind(i) + else if (icplocn2atm ==1) then + windrel(i)=sqrt( (u1(i)-usfco(i))**2+(v1(i)-vsfco(i))**2 ) + rch = rho(i) * cp * ch(i) * windrel(i) + tem = ch(i) * windrel(i) + cmm(i) = cm(i) * windrel(i) + endif chh(i) = rho(i) * tem !> - Calcualte sensible and latent heat flux over open water diff --git a/physics/sfc_ocean.meta b/physics/SFC_Models/Ocean/UFS/sfc_ocean.meta similarity index 92% rename from physics/sfc_ocean.meta rename to physics/SFC_Models/Ocean/UFS/sfc_ocean.meta index 15812e723..c0955d440 100644 --- a/physics/sfc_ocean.meta +++ b/physics/SFC_Models/Ocean/UFS/sfc_ocean.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = sfc_ocean type = scheme - dependencies = funcphys.f90,machine.F + dependencies = ../../../tools/funcphys.f90,../../../hooks/machine.F ######################################################################## [ccpp-arg-table] @@ -86,6 +86,29 @@ type = real kind = kind_phys intent = in +[usfco] + standard_name = x_ocean_current + long_name = zonal current at ocean surface + units = m s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in +[vsfco] + standard_name = y_ocean_current + long_name = meridional current at ocean surface + units = m s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in +[icplocn2atm] + standard_name = control_for_air_sea_flux_computation_over_water + long_name = air-sea flux option + units = 1 + dimensions = () + type = integer + intent = in [t1] standard_name = air_temperature_at_surface_adjacent_layer long_name = surface layer mean temperature @@ -209,6 +232,7 @@ type = real kind = kind_phys intent = in + optional = True [dtsfc_med] standard_name = surface_upward_sensible_heat_flux_over_ocean_from_mediator long_name = sfc sensible heat flux input over ocean for coupling @@ -217,6 +241,7 @@ type = real kind = kind_phys intent = in + optional = True [qsurf] standard_name = surface_specific_humidity_over_water long_name = surface air saturation specific humidity over water diff --git a/physics/sfc_cice.f b/physics/SFC_Models/SeaIce/CICE/sfc_cice.f similarity index 97% rename from physics/sfc_cice.f rename to physics/SFC_Models/SeaIce/CICE/sfc_cice.f index 36f2bccbf..0df1f67a5 100644 --- a/physics/sfc_cice.f +++ b/physics/SFC_Models/SeaIce/CICE/sfc_cice.f @@ -101,9 +101,10 @@ subroutine sfc_cice_run & ! real (kind=kind_phys), dimension(im), intent(in) :: u1, v1, & real (kind=kind_phys), dimension(:), intent(in) :: & - & t1, q1, cm, ch, prsl1, wind, dqsfc, dtsfc, dusfc, dvsfc - &, snowd + & t1, q1, cm, ch, prsl1, wind, snowd + real (kind=kind_phys), dimension(:), intent(in), optional :: & + & dqsfc, dtsfc, dusfc, dvsfc logical, dimension(:), intent(in) :: flag_cice, flag_iter ! --- outputs: diff --git a/physics/sfc_cice.meta b/physics/SFC_Models/SeaIce/CICE/sfc_cice.meta similarity index 98% rename from physics/sfc_cice.meta rename to physics/SFC_Models/SeaIce/CICE/sfc_cice.meta index 796fb2f5d..226c6e948 100644 --- a/physics/sfc_cice.meta +++ b/physics/SFC_Models/SeaIce/CICE/sfc_cice.meta @@ -1,7 +1,8 @@ [ccpp-table-properties] name = sfc_cice type = scheme - dependencies = machine.F + relative_path = ../../../ + dependencies = hooks/machine.F ######################################################################## [ccpp-arg-table] @@ -123,6 +124,7 @@ type = real kind = kind_phys intent = in + optional = True [dtsfc] standard_name = surface_upward_sensible_heat_flux_from_coupled_process long_name = sfc sensible heat flux for coupling @@ -131,6 +133,7 @@ type = real kind = kind_phys intent = in + optional = True [dusfc] standard_name = surface_x_momentum_flux_from_coupled_process long_name = sfc x momentum flux for coupling @@ -139,6 +142,7 @@ type = real kind = kind_phys intent = in + optional = True [dvsfc] standard_name = surface_y_momentum_flux_from_coupled_process long_name = sfc y momentum flux for coupling @@ -147,6 +151,7 @@ type = real kind = kind_phys intent = in + optional = True [snowd] standard_name = lwe_surface_snow_from_coupled_process long_name = sfc snow depth in meters over sea ice for coupling diff --git a/physics/sfc_sice.f b/physics/SFC_Models/SeaIce/CICE/sfc_sice.f similarity index 100% rename from physics/sfc_sice.f rename to physics/SFC_Models/SeaIce/CICE/sfc_sice.f diff --git a/physics/sfc_sice.meta b/physics/SFC_Models/SeaIce/CICE/sfc_sice.meta similarity index 99% rename from physics/sfc_sice.meta rename to physics/SFC_Models/SeaIce/CICE/sfc_sice.meta index 75aab21a4..828a83939 100644 --- a/physics/sfc_sice.meta +++ b/physics/SFC_Models/SeaIce/CICE/sfc_sice.meta @@ -1,7 +1,8 @@ [ccpp-table-properties] name = sfc_sice type = scheme - dependencies = funcphys.f90,machine.F + relative_path = ../../../ + dependencies = tools/funcphys.f90,hooks/machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/docs/ccpp_doxyfile b/physics/docs/ccpp_doxyfile index 595ba2d85..9beb66ece 100644 --- a/physics/docs/ccpp_doxyfile +++ b/physics/docs/ccpp_doxyfile @@ -115,7 +115,7 @@ WARN_LOGFILE = #--------------------------------------------------------------------------- INPUT = pdftxt/mainpage.txt \ - pdftxt/all_shemes_list.txt \ + pdftxt/all_schemes_list.txt \ pdftxt/GFS_v16_suite.txt \ pdftxt/GFS_v17_p8_suite.txt \ pdftxt/RAP_suite.txt \ diff --git a/physics/docs/ccppsrw_doxyfile b/physics/docs/ccppsrw_doxyfile index 09ebccf86..a45fad88f 100644 --- a/physics/docs/ccppsrw_doxyfile +++ b/physics/docs/ccppsrw_doxyfile @@ -1,8 +1,8 @@ # Doxyfile 1.9.3 DOXYFILE_ENCODING = UTF-8 -PROJECT_NAME = "CCPP Scidoc for SRW v2.1.0" -PROJECT_NUMBER = "SRW v2.1.0" +PROJECT_NAME = "CCPP SciDoc for UFS-SRW v3.0.0" +PROJECT_NUMBER = "SRW v3.0.0" PROJECT_BRIEF = "Common Community Physics Package Developed at DTC" PROJECT_LOGO = img/dtc_logo.png OUTPUT_DIRECTORY = doc @@ -115,9 +115,10 @@ WARN_LOGFILE = #--------------------------------------------------------------------------- INPUT = pdftxt/SRW_mainpage.txt \ - pdftxt/SRW_all_shemes_list.txt \ + pdftxt/SRW_all_schemes_list.txt \ pdftxt/GFS_v16_suite.txt \ pdftxt/HRRR_suite.txt \ + pdftxt/RAP_suite.txt \ pdftxt/RRFS_v1beta_suite.txt \ pdftxt/WoFS_v0_suite.txt \ pdftxt/RRFS_SGSCLOUD.txt \ @@ -144,6 +145,7 @@ INPUT = pdftxt/SRW_mainpage.txt \ pdftxt/RUCLSM.txt \ pdftxt/THOMPSON.txt \ pdftxt/suite_input.nml.txt \ + pdftxt/CLM_LAKE.txt \ pdftxt/GFS_SPP.txt \ ../fv_sat_adj.F90 \ ../GFS_time_vary_pre.fv3.F90 \ @@ -206,6 +208,7 @@ INPUT = pdftxt/SRW_mainpage.txt \ ../sfc_nst_pre.f \ ../sfc_nst_post.f \ ../sfc_ocean.F \ + ../clm_lake.f90 \ ../module_nst_model.f90 \ ../module_nst_parameters.f90 \ ../module_nst_water_prop.f90 \ @@ -283,7 +286,6 @@ INPUT = pdftxt/SRW_mainpage.txt \ ../mp_nssl.F90 \ ../module_mp_nssl_2mom.F90 \ ../funcphys.f90 \ - ../physparam.f \ ../physcons.F90 \ ../radcons.f90 \ ../mersenne_twister.f \ @@ -302,7 +304,7 @@ EXCLUDE = EXCLUDE_SYMLINKS = NO EXCLUDE_PATTERNS = EXCLUDE_SYMBOLS = -EXAMPLE_PATH = pdftxt/RE210 \ +EXAMPLE_PATH = pdftxt/RE300 \ doc/html EXAMPLE_PATTERNS = EXAMPLE_RECURSIVE = NO @@ -540,7 +542,7 @@ DIRECTORY_GRAPH = YES DIR_GRAPH_MAX_DEPTH = 1 DOT_IMAGE_FORMAT = SVG INTERACTIVE_SVG = NO -DOT_PATH = +DOT_PATH = DOTFILE_DIRS = MSCFILE_DIRS = DIAFILE_DIRS = diff --git a/physics/docs/library.bib b/physics/docs/library.bib index b6109b12c..4260fc3c2 100644 --- a/physics/docs/library.bib +++ b/physics/docs/library.bib @@ -1,13 +1,176 @@ %% This BibTeX bibliography file was created using BibDesk. %% https://bibdesk.sourceforge.io/ -%% Created for Man Zhang at 2022-10-13 16:15:17 -0600 +%% Created for Man Zhang at 2023-06-28 14:13:48 -0600 %% Saved with string encoding Unicode (UTF-8) +@article{Chen_2022, + author = {Xiaomin Chen and George H. Bryan and Andrew Hazelton and Frank D. Marks and Pat Fitzpatrick}, + date-added = {2023-06-28 14:13:19 -0600}, + date-modified = {2023-06-28 14:13:19 -0600}, + doi = {10.1175/waf-d-21-0168.1}, + journal = {Weather and Forecasting}, + month = {jun}, + number = {6}, + pages = {935--951}, + publisher = {American Meteorological Society}, + title = {Evaluation and Improvement of a {TKE}-Based Eddy-Diffusivity Mass-Flux ({EDMF}) Planetary Boundary Layer Scheme in Hurricane Conditions}, + url = {https://doi.org/10.1175%2Fwaf-d-21-0168.1}, + volume = {37}, + year = 2022, + bdsk-url-1 = {https://doi.org/10.1175%2Fwaf-d-21-0168.1}, + bdsk-url-2 = {https://doi.org/10.1175/waf-d-21-0168.1}} + +@article{Lin_2022, + author = {Jialin Lin and Taotao Qian and Peter Bechtold and Georg Grell and Guang J. Zhang and Ping Zhu and Saulo R. Freitas and Hannah Barnes and Jongil Han}, + date-added = {2023-06-07 10:16:46 -0600}, + date-modified = {2023-06-07 10:16:46 -0600}, + doi = {10.1080/07055900.2022.2082915}, + journal = {Atmosphere-Ocean}, + month = {jul}, + number = {3-4}, + pages = {422--476}, + publisher = {Informa {UK} Limited}, + title = {Atmospheric Convection}, + url = {https://doi.org/10.1080%2F07055900.2022.2082915}, + volume = {60}, + year = 2022, + bdsk-url-1 = {https://doi.org/10.1080%2F07055900.2022.2082915}, + bdsk-url-2 = {https://doi.org/10.1080/07055900.2022.2082915}} + +@techreport{He_2023, + author = {He, Cenlin and Valayamkunnath, Prasanth and Barlage, Michael and Chen, Fei and Gochis, David and Cabell, Ryan and Schneider, Tim and Rasmussen, Roy and Niu, Guo-Yue and Yang, Zong-Liang and Niyogi, Dev and Ek, Michael}, + date-added = {2023-06-06 12:37:33 -0600}, + date-modified = {2023-06-06 12:39:16 -0600}, + doi = {10.5065/EW8G-YR95}, + publisher = {NCAR/UCAR}, + title = {The Community Noah-MP Land Surface Modeling System Technical Description Version 5.0}, + url = {https://opensky.ucar.edu/islandora/object/technotes:599}, + year = {2023}, + bdsk-url-1 = {https://opensky.ucar.edu/islandora/object/technotes:599}, + bdsk-url-2 = {https://doi.org/10.5065/EW8G-YR95}} + +@article{Niu_2007, + author = {Guo-Yue Niu and Zong-Liang Yang}, + date-added = {2023-06-05 14:03:26 -0600}, + date-modified = {2023-06-05 14:03:26 -0600}, + doi = {10.1029/2007jd008674}, + journal = {Journal of Geophysical Research}, + month = {nov}, + number = {D21}, + publisher = {American Geophysical Union ({AGU})}, + title = {An observation-based formulation of snow cover fraction and its evaluation over large North American river basins}, + url = {https://doi.org/10.1029%2F2007jd008674}, + volume = {112}, + year = 2007, + bdsk-url-1 = {https://doi.org/10.1029%2F2007jd008674}, + bdsk-url-2 = {https://doi.org/10.1029/2007jd008674}} + +@techreport{Oleson2013, + author = {Oleson, Keith and Lawrence, David and Bonan, Gordon and Drewniak, Beth and Huang, Maoyi and Koven, Charles and Levis, Samuel and Li, Fang and Riley, William and Subin, Zachary and Swenson, Sean and Thornton, Peter and Bozbiyik, Anil and Fisher, Rosie and Heald, Colette and Kluzek, Erik and Lamarque, Jean-Francois and Lawrence, Peter and Leung, L and Lipscomb, William and Muszala, Stefan and Ricciuto, Daniel and Sacks, William and Sun, Ying and Tang, Jinyun and Yang, Zong-Liang}, + date-added = {2023-06-05 09:28:16 -0600}, + date-modified = {2023-06-05 09:30:30 -0600}, + doi = {10.5065/D6RR1W7M}, + keywords = {Land surface model, Climate model, Biogeochemistry, Biogeophysics}, + language = {en}, + publisher = {UCAR/NCAR}, + title = {Technical description of version 4.5 of the Community Land Model (CLM)}, + url = {http://opensky.ucar.edu/islandora/object/technotes:515}, + year = {2013}, + bdsk-url-1 = {http://opensky.ucar.edu/islandora/object/technotes:515}, + bdsk-url-2 = {https://doi.org/10.5065/D6RR1W7M}} + +@article{Kourzeneva_2012, + author = {Ekaterina Kourzeneva and Hermann Asensio and Eric Martin and Stephanie Faroux}, + date-added = {2023-05-30 11:29:07 -0600}, + date-modified = {2023-05-30 11:29:07 -0600}, + doi = {10.3402/tellusa.v64i0.15640}, + journal = {Tellus A: Dynamic Meteorology and Oceanography}, + month = {dec}, + number = {1}, + pages = {15640}, + publisher = {Stockholm University Press}, + title = {Global gridded dataset of lake coverage and lake depth for use in numerical weather prediction and climate modelling}, + url = {https://doi.org/10.3402%2Ftellusa.v64i0.15640}, + volume = {64}, + year = 2012, + bdsk-url-1 = {https://doi.org/10.3402%2Ftellusa.v64i0.15640}, + bdsk-url-2 = {https://doi.org/10.3402/tellusa.v64i0.15640}} + +@article{Gu2015, + abstract = {A one-dimensional (1-D) physically based lake model was coupled to the Weather Research and Forecasting (WRF) model version 3.2 developed by the National Center for Atmospheric Research to dynamically simulate physical processes of lakes and their effects on weather and climate at local and regional scales. Our study area is focused on the Great Lakes. This coupled model realistically reproduces the lake surface temperature (LST) at a buoy station in a shallow lake (Lake Erie) while generating strong LST biases ranging from −20 to 20 {\textdegree}C at a buoy station in a deep lake (Lake Superior). Through many sensitivity tests, we find that the biases in the deep lake LST simulations result from the drastic underestimation of heat transfer between the lower and upper parts of the lake through unrealistic eddy diffusion. Additional tests were made to calibrate the eddy diffusivity in WRF-Lake. It is found that when this parameter is multiplied by a factor ranging from 102 to 105 for various lake depths deeper than 15 m, the LST simulations for the deep lake buoy station show good agreement with observations, and the bias range reduces to {\textpm}4 {\textdegree}C. Essentially, the enlarged eddy diffusivity strengthens heat transfer within the lake columns in the deep lake, which is significantly underestimated in the lake model without calibration. Validation simulations with the calibrated eddy diffusivity were carried out for the whole of Lake Superior and Lake Erie. The LST simulations still have a substantial bias reduction when compared with those produced with the original eddy diffusivity, indicating that the calibrated parameter is representative. In addition, the improved 1-D lake model with WRF reasonably reproduces the remotely sensed LST geographic distribution.}, + author = {Gu, Hongping and Jin, Jiming and Wu, Yihua and Ek, Michael B. and Subin, Zachary M.}, + date-added = {2023-05-24 14:45:55 -0600}, + date-modified = {2023-05-24 14:45:55 -0600}, + day = {01}, + doi = {10.1007/s10584-013-0978-y}, + issn = {1573-1480}, + journal = {Climatic Change}, + month = {Apr}, + number = {3}, + pages = {471--483}, + title = {Calibration and validation of lake surface temperature simulations with the coupled WRF-lake model}, + url = {https://link.springer.com/content/pdf/10.1007/s10584-013-0978-y.pdf}, + volume = {129}, + year = {2015}, + bdsk-url-1 = {https://link.springer.com/content/pdf/10.1007/s10584-013-0978-y.pdf}, + bdsk-url-2 = {https://doi.org/10.1007/s10584-013-0978-y}} + +@article{Subin_2012, + author = {Zachary M. Subin and William J. Riley and Dmitrii Mironov}, + date-added = {2023-05-24 14:35:27 -0600}, + date-modified = {2023-05-24 14:35:27 -0600}, + doi = {10.1029/2011ms000072}, + journal = {Journal of Advances in Modeling Earth Systems}, + month = {feb}, + publisher = {American Geophysical Union ({AGU})}, + title = {An improved lake model for climate simulations: Model structure, evaluation, and sensitivity analyses in {CESM}1}, + url = {https://doi.org/10.1029%2F2011ms000072}, + volume = {4}, + year = 2012, + bdsk-url-1 = {https://doi.org/10.1029%2F2011ms000072}, + bdsk-url-2 = {https://doi.org/10.1029/2011ms000072}} + +@article{Lawrence_2019, + author = {David M. Lawrence and Rosie A. Fisher and Charles D. Koven and Keith W. Oleson and Sean C. Swenson and Gordon Bonan and Nathan Collier and Bardan Ghimire and Leo van Kampenhout and Daniel Kennedy and Erik Kluzek and Peter J. Lawrence and Fang Li and Hongyi Li and Danica Lombardozzi and William J. Riley and William J. Sacks and Mingjie Shi and Mariana Vertenstein and William R. Wieder and Chonggang Xu and Ashehad A. Ali and Andrew M. Badger and Gautam Bisht and Michiel van den Broeke and Michael A. Brunke and Sean P. Burns and Jonathan Buzan and Martyn Clark and Anthony Craig and Kyla Dahlin and Beth Drewniak and Joshua B. Fisher and Mark Flanner and Andrew M. Fox and Pierre Gentine and Forrest Hoffman and Gretchen Keppel-Aleks and Ryan Knox and Sanjiv Kumar and Jan Lenaerts and L. Ruby Leung and William H. Lipscomb and Yaqiong Lu and Ashutosh Pandey and Jon D. Pelletier and Justin Perket and James T. Randerson and Daniel M. Ricciuto and Benjamin M. Sanderson and Andrew Slater and Zachary M. Subin and Jinyun Tang and R. Quinn Thomas and Maria Val Martin and Xubin Zeng}, + date-added = {2023-05-24 14:34:12 -0600}, + date-modified = {2023-05-24 14:34:12 -0600}, + doi = {10.1029/2018ms001583}, + journal = {Journal of Advances in Modeling Earth Systems}, + month = {dec}, + number = {12}, + pages = {4245--4287}, + publisher = {American Geophysical Union ({AGU})}, + title = {The Community Land Model Version 5: Description of New Features, Benchmarking, and Impact of Forcing Uncertainty}, + url = {https://doi.org/10.1029%2F2018ms001583}, + volume = {11}, + year = 2019, + bdsk-url-1 = {https://doi.org/10.1029%2F2018ms001583}, + bdsk-url-2 = {https://doi.org/10.1029/2018ms001583}} + +@article{cite-key, + date-added = {2023-05-24 11:18:09 -0600}, + date-modified = {2023-05-24 11:18:09 -0600}} + +@article{gmd-15-6659-2022, + author = {Benjamin, S. G. and Smirnova, T. G. and James, E. P. and Anderson, E. J. and Fujisaki-Manome, A. and Kelley, J. G. W. and Mann, G. E. and Gronewold, A. D. and Chu, P. and Kelley, S. G. T.}, + date-added = {2023-05-24 10:51:47 -0600}, + date-modified = {2023-05-24 10:51:47 -0600}, + doi = {10.5194/gmd-15-6659-2022}, + journal = {Geoscientific Model Development}, + number = {17}, + pages = {6659--6676}, + title = {Inland lake temperature initialization via coupled cycling with atmospheric data assimilation}, + url = {https://gmd.copernicus.org/articles/15/6659/2022/}, + volume = {15}, + year = {2022}, + bdsk-url-1 = {https://gmd.copernicus.org/articles/15/6659/2022/}, + bdsk-url-2 = {https://doi.org/10.5194/gmd-15-6659-2022}} + @article{Chaboureau_2005, author = {Jean-Pierre Chaboureau}, date-added = {2022-10-13 16:14:54 -0600}, @@ -3597,8 +3760,6 @@ @inproceedings{yudin_et_al_2019 @article{mansell_2013, author = {Edward R. Mansell and Conrad L. Ziegler}, - date-added = {2015-02-26 22:32:59 +0000}, - date-modified = {2020-02-10 23:06:41 +0000}, doi = {10.1175/JAS-D-12-0264.1}, journal = {Journal of the Atmospheric Sciences}, keywords = {storm electrification, microphysics 2-moment}, @@ -3611,8 +3772,6 @@ @article{mansell_2013 @article{mansell_2010, author = {Edward R. Mansell}, - date-added = {2011-02-22 10:34:11 -0600}, - date-modified = {2011-02-22 10:35:34 -0600}, doi = {10.1175/2010JAS3341.1}, journal = {Journal of the Atmospheric Sciences}, keywords = {advection, microphysics 2-moment}, @@ -3624,8 +3783,6 @@ @article{mansell_2010 @article{mansell_etal_2010, author = {E. R. Mansell and C. L. Ziegler and E. C. Bruning}, - date-added = {2007-08-20 15:44:13 -0500}, - date-modified = {2010-04-13 16:55:16 -0500}, doi = {10.1175/2009JAS2965.1}, journal = {Journal of the Atmospheric Sciences}, keywords = {storm electrification, microphysics 2-moment}, @@ -3635,6 +3792,17 @@ @article{mansell_etal_2010 year = {2010}, bdsk-url-1 = {https://doi.org/10.1175/2009JAS2965.1}} +@article{mansell:2020, + Author = {Edward R. Mansell and Dawson, II, Daniel T. and Jerry M. Straka}, + Doi = {10.1175/JAS-D-19-0268.1}, + Journal = jas, + Keywords = {microphysics 3-moment}, + Pages = {3361-3385}, + Title = {Bin-emulating Hail Melting in 3-moment bulk microphysics}, + Volume = {77}, + Year = {2020}, + Bdsk-Url-1 = {https://dx.doi.org/10.1175/JAS-D-12-0264.1}, + @inproceedings{yudin_et_al_2020, author = {Yudin, V. A. and Yang, F. and Karol, S. I. and Fuller-Rowell T. J. and Kubaryk, A. and Juang, H. and Kar, S. and Alpert, J. C. and Li, Z.}, booktitle = {1st UFS Users' Workshop}, @@ -3663,6 +3831,18 @@ @article{tsiringakis_et_al_2017 year = {2017}, bdsk-url-1 = {https://doi.org/10.1002/qj.3021}} +@article{sturm_1997, + author = {Sturm, Matthew and Holmgren, Jon and K{\"o}nig, Max and Morris, Kim}, + doi = {10.3189/S0022143000002781}, + journal = {Journal of Glaciology}, + number = {143}, + pages = {26--41}, + publisher = {Cambridge University Press}, + title = {The thermal conductivity of seasonal snow}, + volume = {43}, + year = {1997}, + bdsk-url-1 = {https://doi.org/10.3189/S0022143000002781}} + @comment{BibDesk Static Groups{ diff --git a/physics/docs/pdftxt/CLM_LAKE.txt b/physics/docs/pdftxt/CLM_LAKE.txt new file mode 100644 index 000000000..498797511 --- /dev/null +++ b/physics/docs/pdftxt/CLM_LAKE.txt @@ -0,0 +1,60 @@ +/** +\page CLM_LAKE_model CLM Lake Model +\section des_clmlake Description + +The Community Land Model (CLM) lake model is a multi-level one-dimensional lake model that has been implemented within the operational 3-km HRRR and +13-km RAP for small lakes (Benjamin et al. (2022) \cite gmd-15-6659-2022). This implementation is from the Community Land Model version 4.5 (Oleson et al. (2013) \cite Oleson2013). +Subin et al. (2012) \cite Subin_2012 describe the 1-d CLM lake model as applied within the Community Earth System +Model (CESM) as a component of the overall CESM CLM (Lawrence et al. (2019) \cite Lawrence_2019). Gu et al. (2015) \cite Gu2015 +describe the introduction of the CLM lake model into the WRF model and inital experiments using its 1-d solution for both +lakes Superior (average depth of 147 m) and Erie (average depth of 19 m). + +The atmospheric inputs into the model are temperature, water vapor, horizontal wind components from the lowest atmospheric level +and shortwave and longwave radiative fluxes. The CLM lake model then provides latent heat and sensible heat fluxes back to the +atmosphere. It also computes 2-m temperature/moisture, skin temperature, lake temperature, ice fraction, ice thickness, snow water +equivalent and snow depth. The CLM lake model divides the vertical lake profile into 10 layers driven by wind-driven eddies. The +thickness of the top layer is fixed to 10-cm and the rest of the lake depth is divided evenly into the other 9 layers. Energy +transfer (heat and kinetic energy) occurs between lake layers via eddy and molecular diffusion as a function of the vertical +temperature gradient. The CLM lake model also uses a 10-layer soil model beneath the lake, a multi-layer ice formation model and +up to 5-layer snow-on-ice model. Multiple layers in lake model have the potential to better represent vertical mixing processes +in the lake. + +Testing of the CLM lake model within RAP/HRRR applications showed computational efficiency of the model with no change of even +0.1% in run time. The lake/snow variables have to be continuously transfered within the CLM lake model from one forecast to another, +constrained by the atmospheric data assimilation. The lake-cycling initialization in RAP/HRRR has been effective overall, owing to +accurate hourly estimates of near-surface temperature, moisture and winds, and shortwave and longwave estimates provided to the 1-d CLM +lake model every time step (Benjamin et al. (2022) \cite gmd-15-6659-2022). Cycling techniques showed improvements over initializing +lake temperatures from the SST analysis, which is problematic for small water bodies. The improvements are particularly eminent during transition +periods between cold and warm seasons, and in the regions with anomalous weather conditions. The CLM lake model has the potential +to improve surface prediction in the vicinity of small lakes. + +The CLM lake model requires bathymetry for the lake points in the model domain. Grid points are assigned as lake points when the +fraction of lake coverage in the grid cell exceeds 50% and when this point is disconnected from oceans. The lake water mask is +therefore binary, set to either 1 or 0. This binary approach for models with higher horizontal resolution --- for example, 3-km resolution in +in the UFS SRW App --- is capable of capturing the effect of lakes on regional heat and moisture fluxes. + +Lake depths for the RRFS lake configuration (Fig.1) are assigned from a global dataset provided by Kourzeneva et al.(2012) \cite Kourzeneva_2012, +this dataset is referred to as GLOBv3 bathymetry in the UFS_UTL. + +@image html https://user-images.githubusercontent.com/12705538/250180794-76af93a2-a7ba-4e9a-9478-5657198862b8.png "Figure 1: Lake depths for lakes in the 3-km RRFS domain." width=600 + +To cold-start the CLM lake model in regional configurations of the UFS: + +- Use the CLM option in the input.nml +\n - lkm = 1 +\n - iopt_lake = 2 +- Lake temperature is initialized from interpolation between SST at the surface and \f$-4^oC\f$ at 50-m depth +\n - A special case is for the Great Salt Lake, the temperature is limited with +/- 3 K from the bi-weekly climatology +- Temperature for soil under the lake is initialized from bottom lake temperature at the top to the substrate soil temperature at the bottom of soil layer +- Lake ice at the top level is initialized from the GFS ice concentration + +The differences of surface variables from the experimental RRFS 6-h forecast with/without CLM lake model are shown in Figure 2 for 2-m temperature and in Figure 3 for 2-m dewpoint. +@image html https://user-images.githubusercontent.com/12705538/250180790-63159300-33f6-4b34-9e9c-b65885213c30.png "Figure 2: Differences of 2-m temperature between the RRFS coupled to the CLM model and the RRFS without CLM." width=600 +@image html https://user-images.githubusercontent.com/12705538/250180787-8fc9a820-5f80-4f06-b50a-88b2d20ebc53.png "Figure 3: Differences of 2-m dew point between the RRFS coupled to the CLM model and the RRFS without CLM." width=600 + + + +\section intra_clmlake Intraphysics Communication +- \ref arg_table_clm_lake_run + +*/ diff --git a/physics/docs/pdftxt/CU_GF_deep.txt b/physics/docs/pdftxt/CU_GF_deep.txt index 92b8c3b7c..ca06666e5 100644 --- a/physics/docs/pdftxt/CU_GF_deep.txt +++ b/physics/docs/pdftxt/CU_GF_deep.txt @@ -3,44 +3,29 @@ \section gfcu_descrip Description The Grell-Freitas (GF) scheme, as described in Grell and Freitas (2014) \cite grell_and_freitas_2014, -Freitas et al. (2018) \cite freitas_et_al_2018, Freitas et al. (2021) \cite freitas_et_al_2021, and Lin et al. (2022) -(under review) follows the mass flux approach published by Grell (1993) \cite grell_1993. +Freitas et al. (2018) \cite freitas_et_al_2018, Freitas et al. (2021) \cite freitas_et_al_2021, and Lin et al. (2022) \cite Lin_2022 +follows 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. In order for this trimodal size spectrum to be -accurately represented, GF's deep and shallow convective schemes must be run together. -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 (Berry 1968 \cite berry_1968, -Jiang et al.(2010) \cite Jiang_2010, and Lee and Feingold (2010) \cite lee_and_feingold_2010 ). 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 process and will be submitted to GMD. +stochastics through allowing parameter perturbations. +The GF scheme includes mixed phase physics impact, momentum transport, 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 mass flux distribution of shallow, congestus and deep convection regimes is characterized by Probability Density Functions (PDFs). The three PDFs 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 PDFs. +The GF scheme takes into account aerosol dependence (considered experimental and not supported in this release), which is implemented through rain generation (following Berry (1968) \cite berry_1968 and evaporation formulations depending on the cloud concentration nuclei at cloud base (Jiang et al. (2010) \cite Jiang_2010), and Lee and Feingold (2010) \cite lee_and_feingold_2010). Wet scavenging is considered to add a memory impact. GF is able to transport tracers. Recently, GPU capabilities and cap suppressing (\p do_cap_suppress) based on radar data assimilation have been added, and they are used only for the RAP suite. + +The impacts of GF scheme in operational RAP/HRRR include: (a)uses mass-flux schemes, which are more physically realistic than (sounding) adjustment schemes; +(b)takes parameterization uncertainty into account by allowing parameters from multiple convective schemes which can be perturbed +internally or with temporal and spatial correlation patterns; (c)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; (d)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. \section version_cugf_enh CCPP Physics Updates -\version CCPP v6.0.0 - -- GPU capabilities have been added -- Cap suppressing (\p do_cap_suppress) based on radar data assimilation has been added. This is used only for the RAP suite -- Some fixed parameters have been made scale-aware -- Updated coupling between radiation and convection has been implemented - -\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 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 + +\version UFS-SRW v3.0.0 + +The Implementation of GF in RRFS prototypes +- Updates for aerosol-awareness (experimental) +- Scale-awareness is turned off when explicit microphysics is not active anywhere in the column +- GF is completely turned off at grid points when MYNN produces shallow convection at that point +- Radar reflectivity considers mass flux PDF as well as whether scale-awareness is turned on at the grid point in equation. + +The implementation of GF in HAFS is ongoing. \section intra_rough_gf Intraphysics Communication The GF scheme passes cloud hydrometeors to the grid-scale microphysics scheme (\ref THOMPSON ) through detrainment from each diff --git a/physics/docs/pdftxt/GFS_NOAHMP.txt b/physics/docs/pdftxt/GFS_NOAHMP.txt index bc2c58457..e48b7cafc 100644 --- a/physics/docs/pdftxt/GFS_NOAHMP.txt +++ b/physics/docs/pdftxt/GFS_NOAHMP.txt @@ -4,21 +4,15 @@ 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") +- Technical documentation freely available at He et al. (2023) \cite He_2023. -[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. -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 noahmp_update CCPP Physics Updates +\version UFS-SRW v3.0.0 +- As part of a larger-scale effort to unify how microphysics outputs (in particular snow) are used in the land models and outputs, an additional option for using the unified frozen precipitation fraction in NoahMP was added +- Diagnostic 2-meter temperature and humidity are based on vegetation and bare-ground tiles +- Bug fixes for GFS-based thermal roughness length scheme \section intra_noahmp Intraphysics Communication + \ref arg_table_noahmpdrv_run diff --git a/physics/docs/pdftxt/GFS_SAMFdeep.txt b/physics/docs/pdftxt/GFS_SAMFdeep.txt index 346637b3b..1112cb05c 100644 --- a/physics/docs/pdftxt/GFS_SAMFdeep.txt +++ b/physics/docs/pdftxt/GFS_SAMFdeep.txt @@ -65,9 +65,6 @@ rain conversion rate, entrainment and detrainment rates, overshooting layers, and maximum allowable cloudbase mass flux (as of June 2018). -\section v6_enh CCPP Physics Updates -\version CCPP v6.0.0 - \subsection ca_page Cellular Automata Stochastic Convective Organization Scheme \b Scientific \b Background diff --git a/physics/docs/pdftxt/GFS_SATMEDMFVDIFQ.txt b/physics/docs/pdftxt/GFS_SATMEDMFVDIFQ.txt index 4e00d7c3c..d5bc9489c 100644 --- a/physics/docs/pdftxt/GFS_SATMEDMFVDIFQ.txt +++ b/physics/docs/pdftxt/GFS_SATMEDMFVDIFQ.txt @@ -25,27 +25,34 @@ 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 v6_pbl_enh CCPP Physics Updates -\version CCPP v6.0.0 - -- Wind shear effect in characteristic mixing length calculation is included, which +- Wind shear effect in characteristic mixing length calculation is included, which reduces the mixing length in a strong shear environment such as a hurricane. -- To better predict surface inversion as well as capping inversion near the PBL top, -background diffusivity in the inversion layers is reduced as a function of surface +- To better predict surface inversion as well as capping inversion near the PBL top, +background diffusivity in the inversion layers is reduced as a function of surface roughness and green vegetation fraction. -- To reduce the PBL overgrowth, the PBL updraft overshoot is not only limited by -bulk Richardson number-based-PBL depth, but the virtual potential temperature at -top of the surface layer rather than that at the model first layer is also used as -the near-surface virtual potential temperature in the bulk-Richardson number +- To reduce the PBL overgrowth, the PBL updraft overshoot is not only limited by +bulk Richardson number-based PBL depth, but the virtual potential temperature at +the top of the surface layer rather than that at the model first layer is also used as +the near-surface virtual potential temperature in the bulk-Richardson number computation. This helps to largely suppress the unrealistic widespread popcorn-like precipitation. - Updraft entrainment rates for moisture, hydrometeors, and tracers are increased by about 30%. -- A positive definite total variation diminishing (TVD) mass-flux transport scheme for moisture, hydrometeors, +- A positive definite total variation diminishing (TVD) mass-flux transport scheme for moisture, hydrometeors, and tracers and a method for removing negative tracer mixing ratio values have been implemented. \sa NCEP Office Note 505 \cite https://doi.org/10.25923/cybh-w893 and 506 \cite https://doi.org/10.25923/5051-3r70 + +\section v6_pbl_enh CCPP Physics Updates +\version UFS-SRW v3.0.0 +- To reduce the negative hurricane intensity biases, a parameterization for environmental wind shear effect +is included in the GFS TKE-EDMF PBL and cumulus schemes. In addition, the entrainment rates are enhanced +proportional to the sub-cloud or PBL mean TKE (turbulent kinetic energy) when TKE is larger than a threshold +value. + +- To enhance the underestimated CAPE forecasts in the GFS, the entrainment rate in the TKE-EDMF PBL scheme is +increased as a function of vegetation fraction and surface roughness length. + + \section intra_satmedmfvdifq Intraphysics Communication - \ref arg_table_satmedmfvdifq_run diff --git a/physics/docs/pdftxt/GFS_UGWPv0.txt b/physics/docs/pdftxt/GFS_UGWPv0.txt index f2b3b143a..1b3f0166f 100644 --- a/physics/docs/pdftxt/GFS_UGWPv0.txt +++ b/physics/docs/pdftxt/GFS_UGWPv0.txt @@ -108,6 +108,52 @@ 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 ugwp_updates CCPP Physics Updates +\version UFS-SRW v3.0.0 + +We have added optional diagnostic outputs for the various tendencies supplied by the UGWP. They can be switched on by setting the two following input namelist variables equal to “.true.”: \p ldiag3d and \p ldiag_ugwp. + +The optional diagnostic outputs are: +- \b dws3dt_ogw: time-averaged wind speed tendency due to mesoscale gravity wave drag +- \b dws3dt_obl: time-averaged wind speed tendency due to blocking drag +- \b dws3dt_oss: time-averaged wind speed tendency due to small-scale gravity wave drag +- \b dws3dt_ofd: time-averaged wind speed tendency due to turbulent orographic form drag +- \b ldu3dt_ogw: time-averaged x wind tendency due to mesoscale orographic gravity wave drag +- \b ldu3dt_obl: time-averaged x wind tendency due to blocking drag +- \b ldu3dt_oss: time-averaged x wind tendency due to small scale gravity wave drag +- \b ldu3dt_ofd: time-averaged x wind tendency due to form drag +- \b ldu3dt_ngw: time-averaged u momentum tendency due to non-stationary gravity wave drag +- \b ldv3dt_ngw: time-averaged v momentum tendency due to non-stationary gravity wave drag +- \b ldt3dt_ngw: time-averaged temperature tendency due to non-stationary gravity wave drag +- \b dudt_ogw: instantaneous x wind tendency from mesoscale orographic gravity wave drag +- \b dvdt_ogw: instantaneous y wind tendency from mesoscale orographic gravity wave drag +- \b dudt_obl: instantaneous x wind tendency from blocking drag +- \b dvdt_obl: instantaneous y wind tendency from blocking drag +- \b dudt_oss: instantaneous x wind tendency from small scale GWD +- \b dvdt_oss: instantaneous y wind tendency from small scale GWD +- \b dudt_ofd: instantaneous x wind tendency from form drag +- \b dvdt_ofd: instantaneous y wind tendency from form drag +- \b du_ogwcol: instantaneous integrated x momentum flux from mesoscale orographic gravity wave drag +- \b dv_ogwcol: instantaneous integrated y momentum flux from mesoscale orographic gravity wave drag +- \b du_oblcol: instantaneous integrated x momentum flux from blocking drag +- \b dv_oblcol: instantaneous integrated y momentum flux from blocking drag +- \b du_osscol: instantaneous integrated x momentum flux from small scale gwd +- \b dv_osscol: instantaneous integrated y momentum flux from small scale gwd +- \b du_ofdcol: instantaneous integrated x momentum flux from form drag +- \b dv_ofdcol: instantaneous integrated y momentum flux from form drag +- \b du3_ogwcol: time-averaged surface x momentum flux from mesoscale orographic gravity wave drag +- \b dv3_ogwcol: time-averaged surface y momentum flux from mesoscale orographic gravity wave drag +- \b du3_oblcol: time-averaged surface x momentum flux from blocking drag +- \b dv3_oblcol: time-averaged surface y momentum flux from blocking drag +- \b du3_osscol: time-averaged surface x momentum flux from small scale gravity wave drag +- \b dv3_osscol: time-averaged surface y momentum flux from small scale gravity wave drag +- \b du3_ofdcol: time-averaged surface x momentum flux from form drag +- \b dv3_ofdcol: time-averaged surface y momentum flux from form drag + +Note that the relevant diag_table entries for these variables are included in: +ufs-weather-model/tests/parm/diag_table/diag_table_rap + + \section intra_UGWPv0 Intraphysics Communication - \ref arg_table_cires_ugwp_run diff --git a/physics/docs/pdftxt/GFS_v16_suite.txt b/physics/docs/pdftxt/GFS_v16_suite.txt index 11e997bf1..8966d6be8 100644 --- a/physics/docs/pdftxt/GFS_v16_suite.txt +++ b/physics/docs/pdftxt/GFS_v16_suite.txt @@ -25,9 +25,9 @@ National Centers for Environmental Prediction (NCEP) in 2021. The GFS_v16 suite \section gfs16_nml_opt_des Namelist \ref GFDL_cloud namelist options -\snippet RE210/FV3_GFS_v16_input.nml GFDL_CLOUD_MP_NML +\snippet RE300/FV3_GFS_v16_input.nml GFDL_CLOUD_MP_NML Other namelist options -\snippet RE210/FV3_GFS_v16_input.nml GFS_PHYSICS_NML +\snippet RE300/FV3_GFS_v16_input.nml GFS_PHYSICS_NML - nstf_name = \f$[2,0,0,0,0]^1 [2,1,0,0,0]^2\f$ - \f$^1\f$ NSST is on and coupled with spin up off diff --git a/physics/docs/pdftxt/HRRR_suite.txt b/physics/docs/pdftxt/HRRR_suite.txt index c08f50211..93601b62b 100644 --- a/physics/docs/pdftxt/HRRR_suite.txt +++ b/physics/docs/pdftxt/HRRR_suite.txt @@ -3,10 +3,10 @@ \section HRRR_suite_overview Overview -The HRRR suite contains the parameterizations used in the NOAA operational +The HRRR suite contains the evolving parameterizations used in the NOAA operational High-Resolution Rapid Refresh (HRRR) model, which runs at 3-km resolution. This suite is most applicable for runs at 3-km resolution since it does not -parameterize deep convection. +parameterize deep convection. It is one of the primary suite candidates for RRFS v1 operational implementation. For additional information about the HRRR model, visit: https://rapidrefresh.noaa.gov/hrrr/. @@ -17,6 +17,7 @@ The HRRR suite uses the parameterizations in the following order: - \ref SFC_MYNNSFL - \ref GFS_NSST - \ref RUCLSM + - \ref CLM_LAKE_model - \ref MYNNEDMF - \ref GFS_drag_suite - \ref GFS_OZPHYS @@ -28,6 +29,6 @@ The HRRR suite uses the parameterizations in the following order: \include suite_FV3_HRRR.xml \section hrrr_nml_option Namelist -\snippet RE210/FV3_HRRR_input.nml GFS_PHYSICS_NML +\snippet FV3_HRRR_input.nml GFS_PHYSICS_NML */ diff --git a/physics/docs/pdftxt/NSSLMICRO.txt b/physics/docs/pdftxt/NSSLMICRO.txt index 3d35c9fd2..44d1f069b 100644 --- a/physics/docs/pdftxt/NSSLMICRO.txt +++ b/physics/docs/pdftxt/NSSLMICRO.txt @@ -2,7 +2,7 @@ \page NSSLMICRO_page NSSL 2-moment Cloud Microphysics Scheme \section nssl2m_descrp Description -The NSSL two-moment bulk microphysical parameterization scheme that describes form and phase changes among a range of liquid and ice hydrometeors, as described in Mansell et al. (2010) \cite Mansell_etal_2010 and Mansell and Ziegler (2013) \cite Mansell_2013. The microphysical parameterization predicts the mass mixing ratio and number concentration of cloud droplets, raindrops, cloud ice crystals (columns), snow particles (including large crystals and aggregates), graupel, and (optionally) hail. +The NSSL 2/3-moment bulk microphysical parameterization scheme that describes form and phase changes among a range of liquid and ice hydrometeors, as described in Mansell et al. (2010) \cite Mansell_etal_2010, Mansell and Ziegler (2013) \cite Mansell_2013, and Mansell et al. (2020) \cite Mansell_etal_2020. The microphysical parameterization predicts the mass mixing ratio and number concentration of cloud droplets, raindrops, cloud ice crystals (columns), snow particles (including large crystals and aggregates), graupel, and (optionally) hail. Optionally, a third moment (reflectivity or 6th moment) of rain, graupel, and hail can be activated. The graupel and hail particle densities are also calculated by predicting the total particle volume. The graupel category therefore emulates a range of characteristics from high-density frozen drops (includes small hail) to low-density graupel (from rimed ice crystals/snow) in its size and density spectrum. The hail category is designed to simulate larger hail sizes. Hail is only produced from higher-density large graupel. @@ -10,7 +10,7 @@ Hydrometeor size distributions are assumed to follow a gamma functional form. Mi Cloud concentration nuclei (CCN) concentration is predicted as in Mansell et al. (2010) \cite Mansell_etal_2010 with a bulk activation spectrum approximating small aerosols. The model tracks the number of unactivated CCN, and the local CCN concentration is depleted as droplets are activated, either at cloud base or in cloud. The CCN are subjected to advection and subgrid turbulent mixing but have no other interactions with hydrometeors; for example, scavenging by raindrops is omitted. CCN are restored by droplet evaporation and by a gradual regeneration when no hydrometeors are present. Aerosol sensitivity is enhanced by explicitly treating droplet condensation instead of using a saturation adjustment. Supersaturation (within reason) is allowed to persist in updraft with low droplet concentration. -Excessive size sorting (common in 2-moment schemes) is effectively controlled by an adaptive breakup method that prevents reflectivity growth by sedimentation (Mansell 2010 \cite Mansell_2010). +Excessive size sorting (common in 2-moment schemes) is effectively controlled by an adaptive breakup method that prevents reflectivity growth by sedimentation (Mansell 2010 \cite Mansell_2010). Activating the 3-moment scheme provides a natural sedimentation feedback that narrows the size spectrum as size-sorting procedes without the the artificial breakup induced by the 2-moment scheme. The NSSL scheme is designed with deep (severe) convection in mind at grid spacings of up to 4 km, but can also be run at larger grid spacing as needed for nesting etc. It is also able to capture non-severe and winter weather. diff --git a/physics/docs/pdftxt/NoahMP.txt b/physics/docs/pdftxt/NoahMP.txt deleted file mode 100644 index f42aaaa00..000000000 --- a/physics/docs/pdftxt/NoahMP.txt +++ /dev/null @@ -1,41 +0,0 @@ -/** -\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/RAP_suite.txt b/physics/docs/pdftxt/RAP_suite.txt index 3b16315e7..26b9d31f3 100644 --- a/physics/docs/pdftxt/RAP_suite.txt +++ b/physics/docs/pdftxt/RAP_suite.txt @@ -3,9 +3,9 @@ \section rap_suite_overview Overview -The RAP suite contains the parameterizations used in the NOAA operational Rapid Refresh (RAP) model -which runs at 13-km resolution. Currently, the RAP suite is supported in SCM only. For additional -information about the RAP model, visit: https://rapidrefresh.noaa.gov. +The RAP suite contains the evolving parameterizations used in the NOAA operational Rapid Refresh (RAP) model +which runs at 13-km resolution. For additional +information about the RAP model, visit: https://rapidrefresh.noaa.gov. It is one of the primary suite candidates for RRFS v1 operational implementation. The RAP suite uses the parameterizations in the following order: - \ref SGSCLOUD_page @@ -23,9 +23,9 @@ The RAP suite uses the parameterizations in the following order: - \ref THOMPSON \section sdf_gsdsuite Suite Definition File -\include suite_SCM_RAP.xml +\include suite_FV3_RAP.xml \section RAP_nml_option Namelist -\snippet RE210/SCM_RAP_input.nml GFS_PHYSICS_NML +\snippet FV3_RAP_input.nml GFS_PHYSICS_NML */ diff --git a/physics/docs/pdftxt/RE300/FV3_GFS_v16_input.nml b/physics/docs/pdftxt/RE300/FV3_GFS_v16_input.nml new file mode 100644 index 000000000..6fd84ec22 --- /dev/null +++ b/physics/docs/pdftxt/RE300/FV3_GFS_v16_input.nml @@ -0,0 +1,335 @@ +&amip_interp_nml + data_set = 'reynolds_oi' + date_out_of_range = 'climo' + interp_oi_sst = .true. + no_anom_sst = .false. + use_ncep_ice = .false. + use_ncep_sst = .true. +/ + +&atmos_model_nml + blocksize = 40 + ccpp_suite = 'FV3_GFS_v16' + chksum_debug = .false. + dycore_only = .false. +/ + +&cires_ugwp_nml + knob_ugwp_azdir = 2, 4, 4, 4 + knob_ugwp_doaxyz = 1 + knob_ugwp_doheat = 1 + knob_ugwp_dokdis = 1 + knob_ugwp_effac = 1, 1, 1, 1 + knob_ugwp_ndx4lh = 1 + knob_ugwp_solver = 2 + knob_ugwp_source = 1, 1, 0, 0 + knob_ugwp_stoch = 0, 0, 0, 0 + knob_ugwp_version = 0 + knob_ugwp_wvspec = 1, 25, 25, 25 + launch_level = 27 +/ + +&diag_manager_nml + max_output_fields = 450 + prepend_date = .false. +/ + +&external_ic_nml + checker_tr = .false. + filtered_terrain = .true. + gfs_dwinds = .true. + levp = 65 + nt_checker = 0 +/ + +&fms_io_nml + checksum_required = .false. + max_files_r = 100 + max_files_w = 100 +/ + +&fms_nml + clock_grain = 'ROUTINE' + domains_stack_size = 12000000 + print_memory_usage = .false. +/ + +&fv_core_nml + a_imp = 1.0 + adjust_dry_mass = .false. + agrid_vel_rst = .false. + bc_update_interval = 6 + beta = 0.0 + consv_am = .false. + consv_te = 0.0 + d2_bg = 0.0 + d2_bg_k1 = 0.2 + d2_bg_k2 = 0.0 + d4_bg = 0.12 + d_con = 1.0 + d_ext = 0.0 + dddmp = 0.1 + delt_max = 0.002 + dnats = 1 + do_sat_adj = .true. + do_schmidt = .true. + do_vort_damp = .true. + dwind_2d = .false. + dz_min = 6 + external_eta = .true. + external_ic = .true. + fill = .true. + full_zs_filter = .false. + fv_debug = .false. + fv_sg_adj = 450 + gfs_phil = .false. + hord_dp = -5 + hord_mt = 5 + hord_tm = 5 + hord_tr = 10 + hord_vt = 5 + hydrostatic = .false. + io_layout = 1, 1 + k_split = 6 + ke_bg = 0.0 + kord_mt = 9 + kord_tm = -9 + kord_tr = 9 + kord_wz = 9 + layout = 5, 2 + make_nh = .false. + mountain = .false. + n_split = 6 + n_sponge = 10 + n_zs_filter = 0 + na_init = 0 + ncep_ic = .false. + nggps_ic = .true. + no_dycore = .false. + nord = 3 + npx = 220 + npy = 132 + npz = 64 + nrows_blend = 10 + ntiles = 1 + nudge_dz = .false. + nudge_qv = .true. + nwat = 6 + p_fac = 0.1 + phys_hydrostatic = .false. + print_freq = 6 + psm_bc = 1 + range_warn = .false. + read_increment = .false. + regional = .true. + regional_bcs_from_gsi = .false. + res_latlon_dynamics = '' + reset_eta = .false. + rf_cutoff = 750.0 + stretch_fac = 0.999 + target_lat = 38.5 + target_lon = -97.5 + tau = 10.0 + use_hydro_pressure = .false. + vtdm4 = 0.02 + warm_start = .false. + write_restart_with_bcs = .false. + z_tracer = .true. +/ + +&fv_grid_nml + grid_file = 'INPUT/grid_spec.nc' +/ + +!> [GFDL_CLOUD_MP_NML] +&gfdl_cloud_microphysics_nml + c_cracw = 0.8 + c_paut = 0.5 + c_pgacs = 0.01 + c_psaci = 0.05 + ccn_l = 300.0 + ccn_o = 100.0 + const_vg = .false. + const_vi = .false. + const_vr = .false. + const_vs = .false. + de_ice = .false. + do_qa = .true. + do_sedi_heat = .false. + dw_land = 0.16 + dw_ocean = 0.1 + fast_sat_adj = .true. + fix_negative = .true. + icloud_f = 1 + mono_prof = .true. + mp_time = 150.0 + prog_ccn = .false. + qi0_crt = 8e-05 + qi_lim = 1.0 + ql_gen = 0.001 + ql_mlt = 0.001 + qs0_crt = 0.001 + rad_graupel = .true. + rad_rain = .true. + rad_snow = .true. + reiflag = 2 + rh_inc = 0.3 + rh_inr = 0.3 + rh_ins = 0.3 + rthresh = 1e-05 + sedi_transport = .true. + tau_g2v = 900.0 + tau_i2s = 1000.0 + tau_l2v = 225.0 + tau_v2l = 150.0 + use_ccn = .true. + use_ppm = .false. + vg_max = 12.0 + vi_max = 1.0 + vr_max = 12.0 + vs_max = 2.0 + z_slope_ice = .true. + z_slope_liq = .true. +/ +!! [GFDL_CLOUD_MP_NML] + + +!>[GFS_PHYSICS_NML] +&gfs_physics_nml + cal_pre = .false. + cdmbgwd = 4.0, 0.15, 1.0, 1.0 + cnvcld = .true. + cnvgwd = .true. + debug = .false. + do_tofd = .true. + do_ugwp = .false. + dspheat = .true. + effr_in = .true. + fhcyc = 0.0 + fhlwr = 3600.0 + fhswr = 3600.0 + fhzero = 1.0 + h2o_phys = .true. + hybedmf = .false. + iaer = 5111 + ialb = 1 + iau_inc_files = '' + icliq_sw = 2 + ico2 = 2 + iems = 1 + imfdeepcnv = 2 + imfshalcnv = 2 + imp_physics = 11 + iopt_alb = 2 + iopt_btr = 1 + iopt_crs = 1 + iopt_dveg = 1 + iopt_frz = 1 + iopt_inf = 1 + iopt_rad = 1 + iopt_run = 1 + iopt_sfc = 1 + iopt_snf = 4 + iopt_stc = 1 + iopt_tbot = 2 + iopt_trs = 2 + iovr = 3 + isatmedmf = 1 + isol = 2 + isot = 1 + isubc_lw = 2 + isubc_sw = 2 + ivegsrc = 1 + ldiag3d = .false. + ldiag_ugwp = .false. + lgfdlmprad = .true. + lheatstrg = .true. + lsm = 1 + lsoil = 4 + lwhtr = .true. + nsfullradar_diag = 3600 + nst_anl = .true. + nstf_name = 2, 1, 0, 0, 0 + oz_phys = .false. + oz_phys_2015 = .true. + pdfcld = .false. + prautco = 0.00015, 0.00015 + pre_rad = .false. + print_diff_pgr = .false. + prslrd0 = 0.0 + psautco = 0.0008, 0.0005 + random_clds = .false. + redrag = .true. + satmedmf = .true. + sfclay_compute_flux = .false. + shal_cnv = .true. + swhtr = .true. + trans_trac = .true. + use_ufo = .true. +/ +!! [GFS_PHYSICS_NML] + +&interpolator_nml + interp_method = 'conserve_great_circle' +/ + +&mpp_io_nml + deflate_level = 1 + shuffle = 1 +/ + +&nam_sfcperts +/ + +&nam_sppperts +/ + +&nam_stochy +/ + +&namsfc + fabsl = 99999 + faisl = 99999 + faiss = 99999 + fnacna = '' + fnaisc = '../../../../../../../../../../../../scratch1/NCEPDEV/nems/role.epic/UFS_SRW_data/develop/fix/fix_am/CFSR.SEAICE.1982.2012.monthly.clim.grb' + fnglac = '../../../../../../../../../../../../scratch1/NCEPDEV/nems/role.epic/UFS_SRW_data/develop/fix/fix_am/global_glacier.2x2.grb' + fnmskh = '../../../../../../../../../../../../scratch1/NCEPDEV/nems/role.epic/UFS_SRW_data/develop/fix/fix_am/seaice_newland.grb' + fnmxic = '../../../../../../../../../../../../scratch1/NCEPDEV/nems/role.epic/UFS_SRW_data/develop/fix/fix_am/global_maxice.2x2.grb' + fnsmcc = '../../../../../../../../../../../../scratch1/NCEPDEV/nems/role.epic/UFS_SRW_data/develop/fix/fix_am/global_soilmgldas.t126.384.190.grb' + fnsnoa = '' + fnsnoc = '../../../../../../../../../../../../scratch1/NCEPDEV/nems/role.epic/UFS_SRW_data/develop/fix/fix_am/global_snoclim.1.875.grb' + fntsfa = '' + fntsfc = '../../../../../../../../../../../../scratch1/NCEPDEV/nems/role.epic/UFS_SRW_data/develop/fix/fix_am/RTGSST.1982.2012.monthly.clim.grb' + fnzorc = 'igbp' + fsicl = 99999 + fsics = 99999 + fslpl = 99999 + fsmcl = 99999, 99999, 99999 + fsnol = 99999 + fsnos = 99999 + fsotl = 99999 + ftsfl = 99999 + ftsfs = 90 + fvetl = 99999 + fvmnl = 99999 + fvmxl = 99999 + landice = .true. + ldebug = .false. +/ + +&namsfc_dict + fnabsc = '../fix_lam/C403.maximum_snow_albedo.tileX.nc' + fnalbc = '../fix_lam/C403.snowfree_albedo.tileX.nc' + fnalbc2 = '../fix_lam/C403.facsf.tileX.nc' + fnslpc = '../fix_lam/C403.slope_type.tileX.nc' + fnsotc = '../fix_lam/C403.soil_type.tileX.nc' + fntg3c = '../fix_lam/C403.substrate_temperature.tileX.nc' + fnvegc = '../fix_lam/C403.vegetation_greenness.tileX.nc' + fnvetc = '../fix_lam/C403.vegetation_type.tileX.nc' + fnvmnc = '../fix_lam/C403.vegetation_greenness.tileX.nc' + fnvmxc = '../fix_lam/C403.vegetation_greenness.tileX.nc' +/ + +&surf_map_nml +/ diff --git a/physics/docs/pdftxt/RE300/FV3_HRRR_input.nml b/physics/docs/pdftxt/RE300/FV3_HRRR_input.nml new file mode 100644 index 000000000..9a89b9a1f --- /dev/null +++ b/physics/docs/pdftxt/RE300/FV3_HRRR_input.nml @@ -0,0 +1,295 @@ +&amip_interp_nml + data_set = 'reynolds_oi' + date_out_of_range = 'climo' + interp_oi_sst = .true. + no_anom_sst = .false. + use_ncep_ice = .false. + use_ncep_sst = .true. +/ + +&atmos_model_nml + blocksize = 40 + ccpp_suite = 'FV3_HRRR' + chksum_debug = .false. + dycore_only = .false. +/ + +&cires_ugwp_nml + knob_ugwp_azdir = 2, 4, 4, 4 + knob_ugwp_doaxyz = 1 + knob_ugwp_doheat = 1 + knob_ugwp_dokdis = 1 + knob_ugwp_effac = 1, 1, 1, 1 + knob_ugwp_ndx4lh = 1 + knob_ugwp_solver = 2 + knob_ugwp_source = 1, 1, 0, 0 + knob_ugwp_stoch = 0, 0, 0, 0 + knob_ugwp_version = 0 + knob_ugwp_wvspec = 1, 25, 25, 25 + launch_level = 25 +/ + +&diag_manager_nml + max_output_fields = 450 + prepend_date = .false. +/ + +&external_ic_nml + checker_tr = .false. + filtered_terrain = .true. + gfs_dwinds = .true. + levp = 65 + nt_checker = 0 +/ + +&fms_io_nml + checksum_required = .false. + max_files_r = 100 + max_files_w = 100 +/ + +&fms_nml + clock_grain = 'ROUTINE' + domains_stack_size = 12000000 + print_memory_usage = .false. +/ + +&fv_core_nml + a_imp = 1.0 + adjust_dry_mass = .false. + bc_update_interval = 6 + beta = 0.0 + consv_am = .false. + consv_te = 0.0 + d2_bg = 0.0 + d2_bg_k1 = 0.2 + d2_bg_k2 = 0.04 + d4_bg = 0.12 + d_con = 1.0 + d_ext = 0.0 + dddmp = 0.1 + delt_max = 0.008 + dnats = 0 + do_sat_adj = .false. + do_schmidt = .true. + do_vort_damp = .true. + dwind_2d = .false. + dz_min = 2 + external_eta = .true. + external_ic = .true. + fill = .true. + full_zs_filter = .false. + fv_debug = .false. + fv_sg_adj = 300 + gfs_phil = .false. + hord_dp = -5 + hord_mt = 5 + hord_tm = 5 + hord_tr = 10 + hord_vt = 5 + hydrostatic = .false. + io_layout = 1, 1 + k_split = 2 + ke_bg = 0.0 + kord_mt = 9 + kord_tm = -9 + kord_tr = 9 + kord_wz = 9 + layout = 5, 2 + make_nh = .true. + mountain = .false. + n_split = 5 + n_sponge = 24 + n_zs_filter = 0 + na_init = 1 + ncep_ic = .false. + nggps_ic = .true. + no_dycore = .false. + nord = 3 + nord_tr = 2 + npx = 220 + npy = 132 + npz = 64 + nrows_blend = 10 + ntiles = 1 + nudge_qv = .false. + nwat = 6 + p_fac = 0.1 + phys_hydrostatic = .false. + print_freq = 6 + psm_bc = 1 + range_warn = .true. + read_increment = .false. + regional = .true. + regional_bcs_from_gsi = .false. + res_latlon_dynamics = 'fv3_increment.nc' + reset_eta = .false. + rf_cutoff = 2000.0 + stretch_fac = 0.999 + target_lat = 38.5 + target_lon = -97.5 + tau = 5.0 + use_hydro_pressure = .false. + vtdm4 = 0.02 + warm_start = .false. + write_restart_with_bcs = .false. + z_tracer = .true. +/ + +&fv_grid_nml + grid_file = 'INPUT/grid_spec.nc' +/ + +!>[GFS_PHYSICS_NML] +&gfs_physics_nml + bl_mynn_edmf = 1 + bl_mynn_edmf_mom = 1 + bl_mynn_tkeadvect = .true. + cal_pre = .false. + cdmbgwd = 3.5, 1.0 + cnvcld = .false. + cnvgwd = .false. + cplflx = .false. + debug = .false. + do_deep = .false. + do_gsl_drag_ls_bl = .true. + do_gsl_drag_ss = .true. + do_gsl_drag_tofd = .true. + do_mynnedmf = .true. + do_mynnsfclay = .true. + dspheat = .true. + effr_in = .true. + fhcyc = 0.0 + fhlwr = 1200.0 + fhswr = 1200.0 + fhzero = 1.0 + gwd_opt = 3 + h2o_phys = .true. + hybedmf = .false. + iaer = 5111 + ialb = 1 + iau_delthrs = 6 + iau_inc_files = '' + iaufhrs = 30 + icliq_sw = 2 + icloud_bl = 1 + ico2 = 2 + iems = 1 + imfdeepcnv = -1 + imfshalcnv = -1 + imp_physics = 8 + iopt_alb = 2 + iopt_btr = 1 + iopt_crs = 1 + iopt_dveg = 2 + iopt_frz = 1 + iopt_inf = 1 + iopt_rad = 1 + iopt_run = 1 + iopt_sfc = 1 + iopt_snf = 4 + iopt_stc = 1 + iopt_tbot = 2 + iopt_trs = 2 + iovr = 3 + isol = 2 + isot = 1 + isubc_lw = 2 + isubc_sw = 2 + ivegsrc = 1 + kice = 9 + ldiag3d = .false. + lheatstrg = .false. + lradar = .true. + lsm = 3 + lsoil = 4 + lsoil_lsm = 9 + ltaerosol = .true. + lwhtr = .true. + nsfullradar_diag = 3600 + nst_anl = .true. + nstf_name = 2, 1, 0, 0, 0 + oz_phys = .false. + oz_phys_2015 = .true. + pdfcld = .false. + pre_rad = .false. + print_diff_pgr = .false. + prslrd0 = 0.0 + random_clds = .false. + redrag = .true. + satmedmf = .false. + sfclay_compute_flux = .true. + shal_cnv = .false. + swhtr = .true. + trans_trac = .true. + ttendlim = -999 + use_ufo = .true. +/ +!![GFS_PHYSICS_NML] + +&interpolator_nml + interp_method = 'conserve_great_circle' +/ + +&nam_sfcperts +/ + +&nam_sppperts +/ + +&nam_stochy +/ + +&namsfc + fabsl = 99999 + faisl = 99999 + faiss = 99999 + fnacna = '' + fnaisc = '../../../../../../../../../../../../scratch1/NCEPDEV/nems/role.epic/UFS_SRW_data/develop/fix/fix_am/CFSR.SEAICE.1982.2012.monthly.clim.grb' + fnglac = '../../../../../../../../../../../../scratch1/NCEPDEV/nems/role.epic/UFS_SRW_data/develop/fix/fix_am/global_glacier.2x2.grb' + fnmskh = '../../../../../../../../../../../../scratch1/NCEPDEV/nems/role.epic/UFS_SRW_data/develop/fix/fix_am/seaice_newland.grb' + fnmxic = '../../../../../../../../../../../../scratch1/NCEPDEV/nems/role.epic/UFS_SRW_data/develop/fix/fix_am/global_maxice.2x2.grb' + fnsmcc = '../../../../../../../../../../../../scratch1/NCEPDEV/nems/role.epic/UFS_SRW_data/develop/fix/fix_am/global_soilmgldas.t126.384.190.grb' + fnsnoa = '' + fnsnoc = '../../../../../../../../../../../../scratch1/NCEPDEV/nems/role.epic/UFS_SRW_data/develop/fix/fix_am/global_snoclim.1.875.grb' + fntsfa = '' + fntsfc = '../../../../../../../../../../../../scratch1/NCEPDEV/nems/role.epic/UFS_SRW_data/develop/fix/fix_am/RTGSST.1982.2012.monthly.clim.grb' + fnzorc = 'igbp' + fsicl = 99999 + fsics = 99999 + fslpl = 99999 + fsmcl = 99999, 99999, 99999 + fsnol = 99999 + fsnos = 99999 + fsotl = 99999 + ftsfl = 99999 + ftsfs = 90 + fvetl = 99999 + fvmnl = 99999 + fvmxl = 99999 + ldebug = .true. +/ + +&namsfc_dict + fnabsc = '../fix_lam/C403.maximum_snow_albedo.tileX.nc' + fnalbc = '../fix_lam/C403.snowfree_albedo.tileX.nc' + fnalbc2 = '../fix_lam/C403.facsf.tileX.nc' + fnslpc = '../fix_lam/C403.slope_type.tileX.nc' + fnsotc = '../fix_lam/C403.soil_type.tileX.nc' + fntg3c = '../fix_lam/C403.substrate_temperature.tileX.nc' + fnvegc = '../fix_lam/C403.vegetation_greenness.tileX.nc' + fnvetc = '../fix_lam/C403.vegetation_type.tileX.nc' + fnvmnc = '../fix_lam/C403.vegetation_greenness.tileX.nc' + fnvmxc = '../fix_lam/C403.vegetation_greenness.tileX.nc' +/ + +&surf_map_nml + cd2 = -1 + cd4 = 0.12 + max_slope = 0.4 + n_del2_strong = 0 + n_del2_weak = 2 + n_del4 = 1 + peak_fac = 1.0 + zero_ocean = .false. +/ diff --git a/physics/docs/pdftxt/RE300/FV3_RAP_input.nml b/physics/docs/pdftxt/RE300/FV3_RAP_input.nml new file mode 100644 index 000000000..aa80cac21 --- /dev/null +++ b/physics/docs/pdftxt/RE300/FV3_RAP_input.nml @@ -0,0 +1,302 @@ +&amip_interp_nml + data_set = 'reynolds_oi' + date_out_of_range = 'climo' + interp_oi_sst = .true. + no_anom_sst = .false. + use_ncep_ice = .false. + use_ncep_sst = .true. +/ + +&atmos_model_nml + blocksize = 40 + ccpp_suite = 'FV3_RAP' + chksum_debug = .false. + dycore_only = .false. +/ + +&cires_ugwp_nml + knob_ugwp_azdir = 2, 4, 4, 4 + knob_ugwp_doaxyz = 1 + knob_ugwp_doheat = 1 + knob_ugwp_dokdis = 1 + knob_ugwp_effac = 1, 1, 1, 1 + knob_ugwp_ndx4lh = 1 + knob_ugwp_solver = 2 + knob_ugwp_source = 1, 1, 0, 0 + knob_ugwp_stoch = 0, 0, 0, 0 + knob_ugwp_version = 0 + knob_ugwp_wvspec = 1, 25, 25, 25 + launch_level = 25 +/ + +&diag_manager_nml + max_output_fields = 450 + prepend_date = .false. +/ + +&external_ic_nml + checker_tr = .false. + filtered_terrain = .true. + gfs_dwinds = .true. + levp = 65 + nt_checker = 0 +/ + +&fms_io_nml + checksum_required = .false. + max_files_r = 100 + max_files_w = 100 +/ + +&fms_nml + clock_grain = 'ROUTINE' + domains_stack_size = 12000000 + print_memory_usage = .false. +/ + +&fv_core_nml + a_imp = 1.0 + adjust_dry_mass = .false. + bc_update_interval = 6 + beta = 0.0 + consv_am = .false. + consv_te = 0.0 + d2_bg = 0.0 + d2_bg_k1 = 0.2 + d2_bg_k2 = 0.04 + d4_bg = 0.12 + d_con = 1.0 + d_ext = 0.0 + dddmp = 0.1 + delt_max = 0.008 + dnats = 0 + do_sat_adj = .false. + do_schmidt = .true. + do_vort_damp = .true. + dwind_2d = .false. + dz_min = 2 + external_eta = .true. + external_ic = .true. + fill = .true. + full_zs_filter = .false. + fv_debug = .false. + fv_sg_adj = 300 + gfs_phil = .false. + hord_dp = -5 + hord_mt = 5 + hord_tm = 5 + hord_tr = 10 + hord_vt = 5 + hydrostatic = .false. + io_layout = 1, 1 + k_split = 2 + ke_bg = 0.0 + kord_mt = 9 + kord_tm = -9 + kord_tr = 9 + kord_wz = 9 + layout = 5, 2 + make_nh = .true. + mountain = .false. + n_split = 5 + n_sponge = 24 + n_zs_filter = 0 + na_init = 1 + ncep_ic = .false. + nggps_ic = .true. + no_dycore = .false. + nord = 3 + nord_tr = 2 + npx = 220 + npy = 132 + npz = 64 + nrows_blend = 10 + ntiles = 1 + nudge_qv = .false. + nwat = 6 + p_fac = 0.1 + phys_hydrostatic = .false. + print_freq = 6 + psm_bc = 1 + range_warn = .true. + read_increment = .false. + regional = .true. + regional_bcs_from_gsi = .false. + res_latlon_dynamics = 'fv3_increment.nc' + reset_eta = .false. + rf_cutoff = 2000.0 + stretch_fac = 0.999 + target_lat = 38.5 + target_lon = -97.5 + tau = 5.0 + use_hydro_pressure = .false. + vtdm4 = 0.02 + warm_start = .false. + write_restart_with_bcs = .false. + z_tracer = .true. +/ + +&fv_grid_nml + grid_file = 'INPUT/grid_spec.nc' +/ + +!>[GFS_PHYSICS_NML] +&gfs_physics_nml + bl_mynn_edmf = 1 + bl_mynn_edmf_mom = 1 + bl_mynn_tkeadvect = .true. + cal_pre = .false. + cdmbgwd = 3.5, 1.0 + cnvcld = .false. + cnvgwd = .false. + cplflx = .false. + debug = .false. + do_deep = .true. + do_gsl_drag_ls_bl = .true. + do_gsl_drag_ss = .true. + do_gsl_drag_tofd = .true. + do_mynnedmf = .true. + do_mynnsfclay = .true. + do_shum = .false. + do_skeb = .false. + do_spp = .false. + do_sppt = .false. + dspheat = .true. + effr_in = .true. + fhcyc = 0 + fhlwr = 1200.0 + fhswr = 1200.0 + fhzero = 1.0 + gwd_opt = 3 + h2o_phys = .true. + hybedmf = .false. + iaer = 5111 + ialb = 1 + iau_delthrs = 6 + iau_inc_files = '' + iaufhrs = 30 + icliq_sw = 2 + icloud_bl = 1 + ico2 = 2 + iems = 1 + imfdeepcnv = 3 + imfshalcnv = 3 + imp_physics = 8 + iopt_alb = 2 + iopt_btr = 1 + iopt_crs = 1 + iopt_dveg = 2 + iopt_frz = 1 + iopt_inf = 1 + iopt_rad = 1 + iopt_run = 1 + iopt_sfc = 1 + iopt_snf = 4 + iopt_stc = 1 + iopt_tbot = 2 + iopt_trs = 2 + iovr = 3 + isol = 2 + isot = 1 + isubc_lw = 2 + isubc_sw = 2 + ivegsrc = 1 + kice = 9 + ldiag3d = .false. + lheatstrg = .false. + lndp_type = 0 + lradar = .true. + lsm = 3 + lsoil = 4 + lsoil_lsm = 9 + ltaerosol = .true. + lwhtr = .true. + n_var_lndp = 0 + n_var_spp = 0 + nsfullradar_diag = 3600 + nst_anl = .true. + nstf_name = 2, 1, 0, 0, 0 + oz_phys = .false. + oz_phys_2015 = .true. + pdfcld = .false. + pre_rad = .false. + print_diff_pgr = .false. + prslrd0 = 0.0 + random_clds = .false. + redrag = .true. + satmedmf = .false. + sfclay_compute_flux = .false. + shal_cnv = .true. + swhtr = .true. + trans_trac = .true. + ttendlim = -999 + use_ufo = .true. +/ +!![GFS_PHYSICS_NML] + +&interpolator_nml + interp_method = 'conserve_great_circle' +/ + +&nam_sfcperts +/ + +&nam_sppperts +/ + +&nam_stochy +/ + +&namsfc + fabsl = 99999 + faisl = 99999 + faiss = 99999 + fnacna = '' + fnaisc = '../../../../../../../../../../../scratch1/NCEPDEV/nems/role.epic/UFS_SRW_data/develop/fix/fix_am/CFSR.SEAICE.1982.2012.monthly.clim.grb' + fnglac = '../../../../../../../../../../../scratch1/NCEPDEV/nems/role.epic/UFS_SRW_data/develop/fix/fix_am/global_glacier.2x2.grb' + fnmskh = '../../../../../../../../../../../scratch1/NCEPDEV/nems/role.epic/UFS_SRW_data/develop/fix/fix_am/seaice_newland.grb' + fnmxic = '../../../../../../../../../../../scratch1/NCEPDEV/nems/role.epic/UFS_SRW_data/develop/fix/fix_am/global_maxice.2x2.grb' + fnsmcc = '../../../../../../../../../../../scratch1/NCEPDEV/nems/role.epic/UFS_SRW_data/develop/fix/fix_am/global_soilmgldas.t126.384.190.grb' + fnsnoa = '' + fnsnoc = '../../../../../../../../../../../scratch1/NCEPDEV/nems/role.epic/UFS_SRW_data/develop/fix/fix_am/global_snoclim.1.875.grb' + fntsfa = '' + fntsfc = '../../../../../../../../../../../scratch1/NCEPDEV/nems/role.epic/UFS_SRW_data/develop/fix/fix_am/RTGSST.1982.2012.monthly.clim.grb' + fnzorc = 'igbp' + fsicl = 99999 + fsics = 99999 + fslpl = 99999 + fsmcl = 99999, 99999, 99999 + fsnol = 99999 + fsnos = 99999 + fsotl = 99999 + ftsfl = 99999 + ftsfs = 90 + fvetl = 99999 + fvmnl = 99999 + fvmxl = 99999 + ldebug = .true. +/ + +&namsfc_dict + fnabsc = '../fix_lam/C403.maximum_snow_albedo.tileX.nc' + fnalbc = '../fix_lam/C403.snowfree_albedo.tileX.nc' + fnalbc2 = '../fix_lam/C403.facsf.tileX.nc' + fnslpc = '../fix_lam/C403.slope_type.tileX.nc' + fnsotc = '../fix_lam/C403.soil_type.tileX.nc' + fntg3c = '../fix_lam/C403.substrate_temperature.tileX.nc' + fnvegc = '../fix_lam/C403.vegetation_greenness.tileX.nc' + fnvetc = '../fix_lam/C403.vegetation_type.tileX.nc' + fnvmnc = '../fix_lam/C403.vegetation_greenness.tileX.nc' + fnvmxc = '../fix_lam/C403.vegetation_greenness.tileX.nc' +/ + +&surf_map_nml + cd2 = -1 + cd4 = 0.12 + max_slope = 0.4 + n_del2_strong = 0 + n_del2_weak = 2 + n_del4 = 1 + peak_fac = 1.0 + zero_ocean = .false. +/ diff --git a/physics/docs/pdftxt/RE300/FV3_RRFS_v1beta_input.nml b/physics/docs/pdftxt/RE300/FV3_RRFS_v1beta_input.nml new file mode 100644 index 000000000..aff1b47a5 --- /dev/null +++ b/physics/docs/pdftxt/RE300/FV3_RRFS_v1beta_input.nml @@ -0,0 +1,289 @@ +&amip_interp_nml + data_set = 'reynolds_oi' + date_out_of_range = 'climo' + interp_oi_sst = .true. + no_anom_sst = .false. + use_ncep_ice = .false. + use_ncep_sst = .true. +/ + +&atmos_model_nml + blocksize = 40 + ccpp_suite = 'FV3_RRFS_v1beta' + chksum_debug = .false. + dycore_only = .false. +/ + +!>[CIRES_UGWP_NML] +&cires_ugwp_nml + knob_ugwp_azdir = 2, 4, 4, 4 + knob_ugwp_doaxyz = 1 + knob_ugwp_doheat = 1 + knob_ugwp_dokdis = 1 + knob_ugwp_effac = 1, 1, 1, 1 + knob_ugwp_ndx4lh = 1 + knob_ugwp_solver = 2 + knob_ugwp_source = 1, 1, 0, 0 + knob_ugwp_stoch = 0, 0, 0, 0 + knob_ugwp_version = 0 + knob_ugwp_wvspec = 1, 25, 25, 25 + launch_level = 25 +/ +!![CIRES_UGWP_NML] + +&diag_manager_nml + max_output_fields = 450 + prepend_date = .false. +/ + +&external_ic_nml + checker_tr = .false. + filtered_terrain = .true. + gfs_dwinds = .true. + levp = 65 + nt_checker = 0 +/ + +&fms_io_nml + checksum_required = .false. + max_files_r = 100 + max_files_w = 100 +/ + +&fms_nml + clock_grain = 'ROUTINE' + domains_stack_size = 12000000 + print_memory_usage = .false. +/ + +&fv_core_nml + a_imp = 1.0 + adjust_dry_mass = .false. + bc_update_interval = 6 + beta = 0.0 + consv_am = .false. + consv_te = 0.0 + d2_bg = 0.0 + d2_bg_k1 = 0.2 + d2_bg_k2 = 0.04 + d4_bg = 0.12 + d_con = 1.0 + d_ext = 0.0 + dddmp = 0.1 + delt_max = 0.008 + dnats = 0 + do_sat_adj = .false. + do_schmidt = .true. + do_vort_damp = .true. + dwind_2d = .false. + dz_min = 2 + external_eta = .true. + external_ic = .true. + fill = .true. + full_zs_filter = .false. + fv_debug = .false. + fv_sg_adj = 300 + gfs_phil = .false. + hord_dp = 6 + hord_mt = 6 + hord_tm = 6 + hord_tr = 10 + hord_vt = 6 + hydrostatic = .false. + io_layout = 1, 1 + k_split = 2 + ke_bg = 0.0 + kord_mt = 9 + kord_tm = -9 + kord_tr = 9 + kord_wz = 9 + layout = 5, 2 + make_nh = .true. + mountain = .false. + n_split = 5 + n_sponge = 24 + n_zs_filter = 0 + na_init = 1 + ncep_ic = .false. + nggps_ic = .true. + no_dycore = .false. + nord = 3 + npx = 220 + npy = 132 + npz = 64 + nrows_blend = 10 + ntiles = 1 + nudge_qv = .false. + nwat = 6 + p_fac = 0.1 + phys_hydrostatic = .false. + print_freq = 6 + psm_bc = 1 + range_warn = .true. + read_increment = .false. + regional = .true. + regional_bcs_from_gsi = .false. + res_latlon_dynamics = 'fv3_increment.nc' + reset_eta = .false. + rf_cutoff = 2000.0 + stretch_fac = 0.999 + target_lat = 38.5 + target_lon = -97.5 + tau = 5.0 + use_hydro_pressure = .false. + vtdm4 = 0.02 + warm_start = .false. + write_restart_with_bcs = .false. + z_tracer = .true. +/ + +&fv_grid_nml + grid_file = 'INPUT/grid_spec.nc' +/ + +!>[GFS_PHYSICS_NML] +&gfs_physics_nml + bl_mynn_edmf = 1 + bl_mynn_edmf_mom = 1 + bl_mynn_tkeadvect = .true. + cal_pre = .false. + cdmbgwd = 3.5, 0.25 + cnvcld = .false. + cnvgwd = .false. + cplflx = .false. + debug = .false. + do_deep = .false. + do_mynnedmf = .true. + do_mynnsfclay = .true. + dspheat = .true. + effr_in = .true. + fhcyc = 0.0 + fhlwr = 1200.0 + fhswr = 1200.0 + fhzero = 1.0 + h2o_phys = .true. + hybedmf = .false. + iaer = 111 + ialb = 1 + iau_delthrs = 6 + iau_inc_files = '' + iaufhrs = 30 + icloud_bl = 1 + ico2 = 2 + iems = 1 + imfdeepcnv = -1 + imfshalcnv = -1 + imp_physics = 8 + iopt_alb = 2 + iopt_btr = 1 + iopt_crs = 1 + iopt_dveg = 2 + iopt_frz = 1 + iopt_inf = 1 + iopt_rad = 1 + iopt_run = 1 + iopt_sfc = 1 + iopt_snf = 4 + iopt_stc = 1 + iopt_tbot = 2 + iopt_trs = 2 + isol = 2 + isot = 1 + isubc_lw = 2 + isubc_sw = 2 + ivegsrc = 1 + ldiag3d = .false. + lheatstrg = .false. + lradar = .true. + lsm = 2 + lsoil = 4 + lsoil_lsm = 4 + ltaerosol = .true. + lwhtr = .true. + nsfullradar_diag = 3600 + nst_anl = .true. + nstf_name = 2, 1, 0, 0, 0 + oz_phys = .false. + oz_phys_2015 = .true. + pdfcld = .false. + pre_rad = .false. + print_diff_pgr = .false. + prslrd0 = 0.0 + random_clds = .false. + redrag = .true. + satmedmf = .false. + sfclay_compute_flux = .false. + shal_cnv = .false. + swhtr = .true. + trans_trac = .true. + ttendlim = -999 + use_ufo = .true. +/ +!![GFS_PHYSICS_NML] + +&interpolator_nml + interp_method = 'conserve_great_circle' +/ + +&nam_sfcperts +/ + +&nam_sppperts +/ + +&nam_stochy +/ + +&namsfc + fabsl = 99999 + faisl = 99999 + faiss = 99999 + fnacna = '' + fnaisc = '../../../../../../../../../../../../scratch1/NCEPDEV/nems/role.epic/UFS_SRW_data/develop/fix/fix_am/CFSR.SEAICE.1982.2012.monthly.clim.grb' + fnglac = '../../../../../../../../../../../../scratch1/NCEPDEV/nems/role.epic/UFS_SRW_data/develop/fix/fix_am/global_glacier.2x2.grb' + fnmskh = '../../../../../../../../../../../../scratch1/NCEPDEV/nems/role.epic/UFS_SRW_data/develop/fix/fix_am/seaice_newland.grb' + fnmxic = '../../../../../../../../../../../../scratch1/NCEPDEV/nems/role.epic/UFS_SRW_data/develop/fix/fix_am/global_maxice.2x2.grb' + fnsmcc = '../../../../../../../../../../../../scratch1/NCEPDEV/nems/role.epic/UFS_SRW_data/develop/fix/fix_am/global_soilmgldas.t126.384.190.grb' + fnsnoa = '' + fnsnoc = '../../../../../../../../../../../../scratch1/NCEPDEV/nems/role.epic/UFS_SRW_data/develop/fix/fix_am/global_snoclim.1.875.grb' + fntsfa = '' + fntsfc = '../../../../../../../../../../../../scratch1/NCEPDEV/nems/role.epic/UFS_SRW_data/develop/fix/fix_am/RTGSST.1982.2012.monthly.clim.grb' + fnzorc = 'igbp' + fsicl = 99999 + fsics = 99999 + fslpl = 99999 + fsmcl = 99999, 99999, 99999 + fsnol = 99999 + fsnos = 99999 + fsotl = 99999 + ftsfl = 99999 + ftsfs = 90 + fvetl = 99999 + fvmnl = 99999 + fvmxl = 99999 + ldebug = .true. +/ + +&namsfc_dict + fnabsc = '../fix_lam/C403.maximum_snow_albedo.tileX.nc' + fnalbc = '../fix_lam/C403.snowfree_albedo.tileX.nc' + fnalbc2 = '../fix_lam/C403.facsf.tileX.nc' + fnslpc = '../fix_lam/C403.slope_type.tileX.nc' + fnsotc = '../fix_lam/C403.soil_type.tileX.nc' + fntg3c = '../fix_lam/C403.substrate_temperature.tileX.nc' + fnvegc = '../fix_lam/C403.vegetation_greenness.tileX.nc' + fnvetc = '../fix_lam/C403.vegetation_type.tileX.nc' + fnvmnc = '../fix_lam/C403.vegetation_greenness.tileX.nc' + fnvmxc = '../fix_lam/C403.vegetation_greenness.tileX.nc' +/ + +&surf_map_nml + cd2 = -1 + cd4 = 0.12 + max_slope = 0.4 + n_del2_strong = 0 + n_del2_weak = 2 + n_del4 = 1 + peak_fac = 1.0 + zero_ocean = .false. +/ diff --git a/physics/docs/pdftxt/RE300/FV3_WoFS_v0_input.nml b/physics/docs/pdftxt/RE300/FV3_WoFS_v0_input.nml new file mode 100644 index 000000000..70206c335 --- /dev/null +++ b/physics/docs/pdftxt/RE300/FV3_WoFS_v0_input.nml @@ -0,0 +1,295 @@ +&amip_interp_nml + data_set = 'reynolds_oi' + date_out_of_range = 'climo' + interp_oi_sst = .true. + no_anom_sst = .false. + use_ncep_ice = .false. + use_ncep_sst = .true. +/ + +&atmos_model_nml + blocksize = 40 + ccpp_suite = 'FV3_WoFS_v0' + chksum_debug = .false. + dycore_only = .false. +/ + +!>[CIRES_UGWP_NML] +&cires_ugwp_nml + knob_ugwp_azdir = 2, 4, 4, 4 + knob_ugwp_doaxyz = 1 + knob_ugwp_doheat = 1 + knob_ugwp_dokdis = 1 + knob_ugwp_effac = 1, 1, 1, 1 + knob_ugwp_ndx4lh = 1 + knob_ugwp_solver = 2 + knob_ugwp_source = 1, 1, 0, 0 + knob_ugwp_stoch = 0, 0, 0, 0 + knob_ugwp_version = 0 + knob_ugwp_wvspec = 1, 25, 25, 25 + launch_level = 25 +/ +!![CIRES_UGWP_NML] + +&diag_manager_nml + max_output_fields = 450 + prepend_date = .false. +/ + +&external_ic_nml + checker_tr = .false. + filtered_terrain = .true. + gfs_dwinds = .true. + levp = 65 + nt_checker = 0 +/ + +&fms_io_nml + checksum_required = .false. + max_files_r = 100 + max_files_w = 100 +/ + +&fms_nml + clock_grain = 'ROUTINE' + domains_stack_size = 12000000 + print_memory_usage = .false. +/ + +&fv_core_nml + a_imp = 1.0 + adjust_dry_mass = .false. + bc_update_interval = 6 + beta = 0.0 + consv_am = .false. + consv_te = 0.0 + d2_bg = 0.0 + d2_bg_k1 = 0.2 + d2_bg_k2 = 0.04 + d4_bg = 0.12 + d_con = 1.0 + d_ext = 0.0 + dddmp = 0.1 + delt_max = 0.008 + dnats = 0 + do_sat_adj = .false. + do_schmidt = .true. + do_vort_damp = .true. + dwind_2d = .false. + dz_min = 2 + external_eta = .true. + external_ic = .true. + fill = .true. + full_zs_filter = .false. + fv_debug = .false. + fv_sg_adj = 300 + gfs_phil = .false. + hord_dp = 6 + hord_mt = 6 + hord_tm = 6 + hord_tr = 10 + hord_vt = 6 + hydrostatic = .false. + io_layout = 1, 1 + k_split = 2 + ke_bg = 0.0 + kord_mt = 9 + kord_tm = -9 + kord_tr = 9 + kord_wz = 9 + layout = 5, 2 + make_nh = .true. + mountain = .false. + n_split = 5 + n_sponge = 24 + n_zs_filter = 0 + na_init = 1 + ncep_ic = .false. + nggps_ic = .true. + no_dycore = .false. + nord = 3 + npx = 220 + npy = 132 + npz = 64 + nrows_blend = 10 + ntiles = 1 + nudge_qv = .false. + nwat = 7 + p_fac = 0.1 + phys_hydrostatic = .false. + print_freq = 6 + psm_bc = 1 + range_warn = .true. + read_increment = .false. + regional = .true. + regional_bcs_from_gsi = .false. + res_latlon_dynamics = 'fv3_increment.nc' + reset_eta = .false. + rf_cutoff = 2000.0 + stretch_fac = 0.999 + target_lat = 38.5 + target_lon = -97.5 + tau = 5.0 + use_hydro_pressure = .false. + vtdm4 = 0.02 + warm_start = .false. + write_restart_with_bcs = .false. + z_tracer = .true. +/ + +&fv_diagnostics_nml + do_hailcast = .true. +/ + +&fv_grid_nml + grid_file = 'INPUT/grid_spec.nc' +/ + +!>[GFS_PHYSICS_NML] +&gfs_physics_nml + bl_mynn_edmf = 1 + bl_mynn_edmf_mom = 1 + bl_mynn_tkeadvect = .true. + cal_pre = .false. + cdmbgwd = 3.5, 0.25 + cnvcld = .false. + cnvgwd = .false. + cplflx = .false. + debug = .false. + do_deep = .false. + do_mynnedmf = .true. + do_mynnsfclay = .true. + dspheat = .true. + effr_in = .true. + fhcyc = 0.0 + fhlwr = 1200.0 + fhswr = 1200.0 + fhzero = 1.0 + h2o_phys = .true. + hybedmf = .false. + iaer = 111 + ialb = 1 + iau_delthrs = 6 + iau_inc_files = '' + iaufhrs = 30 + icloud_bl = 1 + ico2 = 2 + iems = 1 + imfdeepcnv = -1 + imfshalcnv = -1 + imp_physics = 17 + iopt_alb = 2 + iopt_btr = 1 + iopt_crs = 1 + iopt_dveg = 2 + iopt_frz = 1 + iopt_inf = 1 + iopt_rad = 1 + iopt_run = 1 + iopt_sfc = 1 + iopt_snf = 4 + iopt_stc = 1 + iopt_tbot = 2 + isol = 2 + isot = 1 + isubc_lw = 2 + isubc_sw = 2 + ivegsrc = 1 + ldiag3d = .false. + lheatstrg = .false. + lradar = .true. + lsm = 1 + lsoil = 4 + lsoil_lsm = 4 + ltaerosol = .true. + lwhtr = .true. + nsfullradar_diag = 3600 + nssl_cccn = 600000000.0 + nssl_ccn_on = .true. + nssl_hail_on = .true. + nst_anl = .true. + nstf_name = 2, 1, 0, 0, 0 + oz_phys = .false. + oz_phys_2015 = .true. + pdfcld = .false. + pre_rad = .false. + print_diff_pgr = .false. + prslrd0 = 0.0 + random_clds = .false. + redrag = .true. + satmedmf = .false. + sfclay_compute_flux = .false. + shal_cnv = .false. + swhtr = .true. + trans_trac = .true. + ttendlim = -999 + use_ufo = .true. +/ +!![GFS_PHYSICS_NML] + +&interpolator_nml + interp_method = 'conserve_great_circle' +/ + +&nam_sfcperts +/ + +&nam_sppperts +/ + +&nam_stochy +/ + +&namsfc + fabsl = 99999 + faisl = 99999 + faiss = 99999 + fnacna = '' + fnaisc = '../../../../../../../../../../../../scratch1/NCEPDEV/nems/role.epic/UFS_SRW_data/develop/fix/fix_am/CFSR.SEAICE.1982.2012.monthly.clim.grb' + fnglac = '../../../../../../../../../../../../scratch1/NCEPDEV/nems/role.epic/UFS_SRW_data/develop/fix/fix_am/global_glacier.2x2.grb' + fnmskh = '../../../../../../../../../../../../scratch1/NCEPDEV/nems/role.epic/UFS_SRW_data/develop/fix/fix_am/seaice_newland.grb' + fnmxic = '../../../../../../../../../../../../scratch1/NCEPDEV/nems/role.epic/UFS_SRW_data/develop/fix/fix_am/global_maxice.2x2.grb' + fnsmcc = '../../../../../../../../../../../../scratch1/NCEPDEV/nems/role.epic/UFS_SRW_data/develop/fix/fix_am/global_soilmgldas.t126.384.190.grb' + fnsnoa = '' + fnsnoc = '../../../../../../../../../../../../scratch1/NCEPDEV/nems/role.epic/UFS_SRW_data/develop/fix/fix_am/global_snoclim.1.875.grb' + fntsfa = '' + fntsfc = '../../../../../../../../../../../../scratch1/NCEPDEV/nems/role.epic/UFS_SRW_data/develop/fix/fix_am/RTGSST.1982.2012.monthly.clim.grb' + fnzorc = 'igbp' + fsicl = 99999 + fsics = 99999 + fslpl = 99999 + fsmcl = 99999, 99999, 99999 + fsnol = 99999 + fsnos = 99999 + fsotl = 99999 + ftsfl = 99999 + ftsfs = 90 + fvetl = 99999 + fvmnl = 99999 + fvmxl = 99999 + ldebug = .true. +/ + +&namsfc_dict + fnabsc = '../fix_lam/C403.maximum_snow_albedo.tileX.nc' + fnalbc = '../fix_lam/C403.snowfree_albedo.tileX.nc' + fnalbc2 = '../fix_lam/C403.facsf.tileX.nc' + fnslpc = '../fix_lam/C403.slope_type.tileX.nc' + fnsotc = '../fix_lam/C403.soil_type.tileX.nc' + fntg3c = '../fix_lam/C403.substrate_temperature.tileX.nc' + fnvegc = '../fix_lam/C403.vegetation_greenness.tileX.nc' + fnvetc = '../fix_lam/C403.vegetation_type.tileX.nc' + fnvmnc = '../fix_lam/C403.vegetation_greenness.tileX.nc' + fnvmxc = '../fix_lam/C403.vegetation_greenness.tileX.nc' +/ + +&surf_map_nml + cd2 = -1 + cd4 = 0.12 + max_slope = 0.4 + n_del2_strong = 0 + n_del2_weak = 2 + n_del4 = 1 + peak_fac = 1.0 + zero_ocean = .false. +/ diff --git a/physics/docs/pdftxt/RE300/namelists/input.nml.FV3_GFS_v16 b/physics/docs/pdftxt/RE300/namelists/input.nml.FV3_GFS_v16 new file mode 100644 index 000000000..6dac0ecaf --- /dev/null +++ b/physics/docs/pdftxt/RE300/namelists/input.nml.FV3_GFS_v16 @@ -0,0 +1,330 @@ +&amip_interp_nml + data_set = 'reynolds_oi' + date_out_of_range = 'climo' + interp_oi_sst = .true. + no_anom_sst = .false. + use_ncep_ice = .false. + use_ncep_sst = .true. +/ + +&atmos_model_nml + blocksize = 40 + ccpp_suite = 'FV3_GFS_v16' + chksum_debug = .false. + dycore_only = .false. +/ + +&cires_ugwp_nml + knob_ugwp_azdir = 2, 4, 4, 4 + knob_ugwp_doaxyz = 1 + knob_ugwp_doheat = 1 + knob_ugwp_dokdis = 1 + knob_ugwp_effac = 1, 1, 1, 1 + knob_ugwp_ndx4lh = 1 + knob_ugwp_solver = 2 + knob_ugwp_source = 1, 1, 0, 0 + knob_ugwp_stoch = 0, 0, 0, 0 + knob_ugwp_version = 0 + knob_ugwp_wvspec = 1, 25, 25, 25 + launch_level = 27 +/ + +&diag_manager_nml + max_output_fields = 450 + prepend_date = .false. +/ + +&external_ic_nml + checker_tr = .false. + filtered_terrain = .true. + gfs_dwinds = .true. + levp = 65 + nt_checker = 0 +/ + +&fms_io_nml + checksum_required = .false. + max_files_r = 100 + max_files_w = 100 +/ + +&fms_nml + clock_grain = 'ROUTINE' + domains_stack_size = 12000000 + print_memory_usage = .false. +/ + +&fv_core_nml + a_imp = 1.0 + adjust_dry_mass = .false. + agrid_vel_rst = .false. + bc_update_interval = 6 + beta = 0.0 + consv_am = .false. + consv_te = 0.0 + d2_bg = 0.0 + d2_bg_k1 = 0.2 + d2_bg_k2 = 0.0 + d4_bg = 0.12 + d_con = 1.0 + d_ext = 0.0 + dddmp = 0.1 + delt_max = 0.002 + dnats = 1 + do_sat_adj = .true. + do_schmidt = .true. + do_vort_damp = .true. + dwind_2d = .false. + dz_min = 6 + external_eta = .true. + external_ic = .true. + fill = .true. + full_zs_filter = .false. + fv_debug = .false. + fv_sg_adj = 450 + gfs_phil = .false. + hord_dp = -5 + hord_mt = 5 + hord_tm = 5 + hord_tr = 10 + hord_vt = 5 + hydrostatic = .false. + io_layout = 1, 1 + k_split = 6 + ke_bg = 0.0 + kord_mt = 9 + kord_tm = -9 + kord_tr = 9 + kord_wz = 9 + layout = 5, 2 + make_nh = .false. + mountain = .false. + n_split = 6 + n_sponge = 10 + n_zs_filter = 0 + na_init = 0 + ncep_ic = .false. + nggps_ic = .true. + no_dycore = .false. + nord = 3 + npx = 220 + npy = 132 + npz = 64 + nrows_blend = 10 + ntiles = 1 + nudge_dz = .false. + nudge_qv = .true. + nwat = 6 + p_fac = 0.1 + phys_hydrostatic = .false. + print_freq = 6 + psm_bc = 1 + range_warn = .false. + read_increment = .false. + regional = .true. + regional_bcs_from_gsi = .false. + res_latlon_dynamics = '' + reset_eta = .false. + rf_cutoff = 750.0 + stretch_fac = 0.999 + target_lat = 38.5 + target_lon = -97.5 + tau = 10.0 + use_hydro_pressure = .false. + vtdm4 = 0.02 + warm_start = .false. + write_restart_with_bcs = .false. + z_tracer = .true. +/ + +&fv_grid_nml + grid_file = 'INPUT/grid_spec.nc' +/ + +&gfdl_cloud_microphysics_nml + c_cracw = 0.8 + c_paut = 0.5 + c_pgacs = 0.01 + c_psaci = 0.05 + ccn_l = 300.0 + ccn_o = 100.0 + const_vg = .false. + const_vi = .false. + const_vr = .false. + const_vs = .false. + de_ice = .false. + do_qa = .true. + do_sedi_heat = .false. + dw_land = 0.16 + dw_ocean = 0.1 + fast_sat_adj = .true. + fix_negative = .true. + icloud_f = 1 + mono_prof = .true. + mp_time = 150.0 + prog_ccn = .false. + qi0_crt = 8e-05 + qi_lim = 1.0 + ql_gen = 0.001 + ql_mlt = 0.001 + qs0_crt = 0.001 + rad_graupel = .true. + rad_rain = .true. + rad_snow = .true. + reiflag = 2 + rh_inc = 0.3 + rh_inr = 0.3 + rh_ins = 0.3 + rthresh = 1e-05 + sedi_transport = .true. + tau_g2v = 900.0 + tau_i2s = 1000.0 + tau_l2v = 225.0 + tau_v2l = 150.0 + use_ccn = .true. + use_ppm = .false. + vg_max = 12.0 + vi_max = 1.0 + vr_max = 12.0 + vs_max = 2.0 + z_slope_ice = .true. + z_slope_liq = .true. +/ + +&gfs_physics_nml + cal_pre = .false. + cdmbgwd = 4.0, 0.15, 1.0, 1.0 + cnvcld = .true. + cnvgwd = .true. + debug = .false. + do_tofd = .true. + do_ugwp = .false. + dspheat = .true. + effr_in = .true. + fhcyc = 0.0 + fhlwr = 3600.0 + fhswr = 3600.0 + fhzero = 1.0 + h2o_phys = .true. + hybedmf = .false. + iaer = 5111 + ialb = 1 + iau_inc_files = '' + icliq_sw = 2 + ico2 = 2 + iems = 1 + imfdeepcnv = 2 + imfshalcnv = 2 + imp_physics = 11 + iopt_alb = 2 + iopt_btr = 1 + iopt_crs = 1 + iopt_dveg = 1 + iopt_frz = 1 + iopt_inf = 1 + iopt_rad = 1 + iopt_run = 1 + iopt_sfc = 1 + iopt_snf = 4 + iopt_stc = 1 + iopt_tbot = 2 + iopt_trs = 2 + iovr = 3 + isatmedmf = 1 + isol = 2 + isot = 1 + isubc_lw = 2 + isubc_sw = 2 + ivegsrc = 1 + ldiag3d = .false. + ldiag_ugwp = .false. + lgfdlmprad = .true. + lheatstrg = .true. + lsm = 1 + lsoil = 4 + lwhtr = .true. + nsfullradar_diag = 3600 + nst_anl = .true. + nstf_name = 2, 1, 0, 0, 0 + oz_phys = .false. + oz_phys_2015 = .true. + pdfcld = .false. + prautco = 0.00015, 0.00015 + pre_rad = .false. + print_diff_pgr = .false. + prslrd0 = 0.0 + psautco = 0.0008, 0.0005 + random_clds = .false. + redrag = .true. + satmedmf = .true. + sfclay_compute_flux = .false. + shal_cnv = .true. + swhtr = .true. + trans_trac = .true. + use_ufo = .true. +/ + +&interpolator_nml + interp_method = 'conserve_great_circle' +/ + +&mpp_io_nml + deflate_level = 1 + shuffle = 1 +/ + +&nam_sfcperts +/ + +&nam_sppperts +/ + +&nam_stochy +/ + +&namsfc + fabsl = 99999 + faisl = 99999 + faiss = 99999 + fnacna = '' + fnaisc = '../../../../../../../../../../../../scratch1/NCEPDEV/nems/role.epic/UFS_SRW_data/develop/fix/fix_am/CFSR.SEAICE.1982.2012.monthly.clim.grb' + fnglac = '../../../../../../../../../../../../scratch1/NCEPDEV/nems/role.epic/UFS_SRW_data/develop/fix/fix_am/global_glacier.2x2.grb' + fnmskh = '../../../../../../../../../../../../scratch1/NCEPDEV/nems/role.epic/UFS_SRW_data/develop/fix/fix_am/seaice_newland.grb' + fnmxic = '../../../../../../../../../../../../scratch1/NCEPDEV/nems/role.epic/UFS_SRW_data/develop/fix/fix_am/global_maxice.2x2.grb' + fnsmcc = '../../../../../../../../../../../../scratch1/NCEPDEV/nems/role.epic/UFS_SRW_data/develop/fix/fix_am/global_soilmgldas.t126.384.190.grb' + fnsnoa = '' + fnsnoc = '../../../../../../../../../../../../scratch1/NCEPDEV/nems/role.epic/UFS_SRW_data/develop/fix/fix_am/global_snoclim.1.875.grb' + fntsfa = '' + fntsfc = '../../../../../../../../../../../../scratch1/NCEPDEV/nems/role.epic/UFS_SRW_data/develop/fix/fix_am/RTGSST.1982.2012.monthly.clim.grb' + fnzorc = 'igbp' + fsicl = 99999 + fsics = 99999 + fslpl = 99999 + fsmcl = 99999, 99999, 99999 + fsnol = 99999 + fsnos = 99999 + fsotl = 99999 + ftsfl = 99999 + ftsfs = 90 + fvetl = 99999 + fvmnl = 99999 + fvmxl = 99999 + landice = .true. + ldebug = .false. +/ + +&namsfc_dict + fnabsc = '../fix_lam/C403.maximum_snow_albedo.tileX.nc' + fnalbc = '../fix_lam/C403.snowfree_albedo.tileX.nc' + fnalbc2 = '../fix_lam/C403.facsf.tileX.nc' + fnslpc = '../fix_lam/C403.slope_type.tileX.nc' + fnsotc = '../fix_lam/C403.soil_type.tileX.nc' + fntg3c = '../fix_lam/C403.substrate_temperature.tileX.nc' + fnvegc = '../fix_lam/C403.vegetation_greenness.tileX.nc' + fnvetc = '../fix_lam/C403.vegetation_type.tileX.nc' + fnvmnc = '../fix_lam/C403.vegetation_greenness.tileX.nc' + fnvmxc = '../fix_lam/C403.vegetation_greenness.tileX.nc' +/ + +&surf_map_nml +/ diff --git a/physics/docs/pdftxt/RE300/namelists/input.nml.FV3_HRRR b/physics/docs/pdftxt/RE300/namelists/input.nml.FV3_HRRR new file mode 100644 index 000000000..e30bd44c6 --- /dev/null +++ b/physics/docs/pdftxt/RE300/namelists/input.nml.FV3_HRRR @@ -0,0 +1,298 @@ +&amip_interp_nml + data_set = 'reynolds_oi' + date_out_of_range = 'climo' + interp_oi_sst = .true. + no_anom_sst = .false. + use_ncep_ice = .false. + use_ncep_sst = .true. +/ + +&atmos_model_nml + blocksize = 40 + ccpp_suite = 'FV3_HRRR' + chksum_debug = .false. + dycore_only = .false. +/ + +&cires_ugwp_nml + knob_ugwp_azdir = 2, 4, 4, 4 + knob_ugwp_doaxyz = 1 + knob_ugwp_doheat = 1 + knob_ugwp_dokdis = 1 + knob_ugwp_effac = 1, 1, 1, 1 + knob_ugwp_ndx4lh = 1 + knob_ugwp_solver = 2 + knob_ugwp_source = 1, 1, 0, 0 + knob_ugwp_stoch = 0, 0, 0, 0 + knob_ugwp_version = 0 + knob_ugwp_wvspec = 1, 25, 25, 25 + launch_level = 25 +/ + +&diag_manager_nml + max_output_fields = 450 + prepend_date = .false. +/ + +&external_ic_nml + checker_tr = .false. + filtered_terrain = .true. + gfs_dwinds = .true. + levp = 65 + nt_checker = 0 +/ + +&fms_io_nml + checksum_required = .false. + max_files_r = 100 + max_files_w = 100 +/ + +&fms_nml + clock_grain = 'ROUTINE' + domains_stack_size = 12000000 + print_memory_usage = .false. +/ + +&fv_core_nml + a_imp = 1.0 + adjust_dry_mass = .false. + bc_update_interval = 6 + beta = 0.0 + consv_am = .false. + consv_te = 0.0 + d2_bg = 0.0 + d2_bg_k1 = 0.2 + d2_bg_k2 = 0.04 + d4_bg = 0.12 + d_con = 0.5 + d_ext = 0.0 + dddmp = 0.1 + delt_max = 0.008 + dnats = 0 + do_sat_adj = .false. + do_schmidt = .true. + do_vort_damp = .true. + dwind_2d = .false. + dz_min = 2 + external_eta = .true. + external_ic = .true. + fill = .true. + full_zs_filter = .false. + fv_debug = .false. + fv_sg_adj = 300 + gfs_phil = .false. + hord_dp = 6 + hord_mt = 6 + hord_tm = 6 + hord_tr = 8 + hord_vt = 6 + hydrostatic = .false. + io_layout = 1, 1 + k_split = 2 + ke_bg = 0.0 + kord_mt = 9 + kord_tm = -9 + kord_tr = 9 + kord_wz = 9 + layout = 5, 2 + make_nh = .true. + mountain = .false. + n_split = 5 + n_sponge = 9 + n_zs_filter = 0 + na_init = 1 + ncep_ic = .false. + nggps_ic = .true. + no_dycore = .false. + nord = 3 + nord_tr = 0 + npx = 220 + npy = 132 + npz = 64 + nrows_blend = 10 + ntiles = 1 + nudge_qv = .false. + nwat = 6 + p_fac = 0.1 + phys_hydrostatic = .false. + print_freq = 6 + psm_bc = 1 + range_warn = .true. + read_increment = .false. + regional = .true. + regional_bcs_from_gsi = .false. + res_latlon_dynamics = 'fv3_increment.nc' + reset_eta = .false. + rf_cutoff = 2000.0 + stretch_fac = 0.999 + target_lat = 38.5 + target_lon = -97.5 + tau = 5.0 + use_hydro_pressure = .false. + vtdm4 = 0.02 + warm_start = .false. + write_restart_with_bcs = .false. + z_tracer = .true. +/ + +&fv_grid_nml + grid_file = 'INPUT/grid_spec.nc' +/ + +&gfs_physics_nml + bl_mynn_edmf = 1 + bl_mynn_edmf_mom = 1 + bl_mynn_tkeadvect = .true. + cal_pre = .false. + cdmbgwd = 3.5, 1.0 + cnvcld = .false. + cnvgwd = .false. + cplflx = .false. + debug = .false. + diag_log = .true. + do_deep = .false. + do_gsl_drag_ls_bl = .true. + do_gsl_drag_ss = .true. + do_gsl_drag_tofd = .true. + do_mynnedmf = .true. + do_mynnsfclay = .true. + dspheat = .true. + effr_in = .true. + fhcyc = 0.0 + fhlwr = 1200.0 + fhswr = 1200.0 + fhzero = 1.0 + gwd_opt = 3 + h2o_phys = .true. + hybedmf = .false. + iaer = 5111 + ialb = 2 + iau_delthrs = 6 + iau_inc_files = '' + iaufhrs = 30 + icliq_sw = 2 + icloud_bl = 1 + ico2 = 2 + iems = 2 + imfdeepcnv = -1 + imfshalcnv = -1 + imp_physics = 8 + iopt_alb = 2 + iopt_btr = 1 + iopt_crs = 1 + iopt_dveg = 2 + iopt_frz = 1 + iopt_inf = 1 + iopt_rad = 1 + iopt_run = 1 + iopt_sfc = 1 + iopt_snf = 4 + iopt_stc = 1 + iopt_tbot = 2 + iopt_trs = 2 + iovr = 3 + isncond_opt = 2 + isncovr_opt = 3 + isol = 2 + isot = 1 + isubc_lw = 2 + isubc_sw = 2 + ivegsrc = 1 + kice = 9 + kice = 9 + ldiag3d = .false. + lheatstrg = .false. + lradar = .true. + lsm = 3 + lsoil = 4 + lsoil_lsm = 9 + ltaerosol = .true. + lwhtr = .true. + mosaic_lu = 0 + mosaic_soil = 0 + nsfullradar_diag = 3600 + oz_phys = .false. + oz_phys_2015 = .true. + pdfcld = .false. + pre_rad = .false. + print_diff_pgr = .false. + prslrd0 = 0.0 + random_clds = .false. + redrag = .true. + satmedmf = .false. + sfclay_compute_flux = .true. + shal_cnv = .false. + swhtr = .true. + thsfc_loc = .false. + trans_trac = .true. + ttendlim = -999 + use_ufo = .true. +/ + +&interpolator_nml + interp_method = 'conserve_great_circle' +/ + +&nam_sfcperts +/ + +&nam_sppperts +/ + +&nam_stochy +/ + +&namsfc + fabsl = 99999 + faisl = 99999 + faiss = 99999 + fnacna = '' + fnaisc = '../../../../../../../../../../../../scratch1/NCEPDEV/nems/role.epic/UFS_SRW_data/develop/fix/fix_am/CFSR.SEAICE.1982.2012.monthly.clim.grb' + fnglac = '../../../../../../../../../../../../scratch1/NCEPDEV/nems/role.epic/UFS_SRW_data/develop/fix/fix_am/global_glacier.2x2.grb' + fnmskh = '../../../../../../../../../../../../scratch1/NCEPDEV/nems/role.epic/UFS_SRW_data/develop/fix/fix_am/seaice_newland.grb' + fnmxic = '../../../../../../../../../../../../scratch1/NCEPDEV/nems/role.epic/UFS_SRW_data/develop/fix/fix_am/global_maxice.2x2.grb' + fnsmcc = '../../../../../../../../../../../../scratch1/NCEPDEV/nems/role.epic/UFS_SRW_data/develop/fix/fix_am/global_soilmgldas.t126.384.190.grb' + fnsnoa = '' + fnsnoc = '../../../../../../../../../../../../scratch1/NCEPDEV/nems/role.epic/UFS_SRW_data/develop/fix/fix_am/global_snoclim.1.875.grb' + fntsfa = '' + fntsfc = '../../../../../../../../../../../../scratch1/NCEPDEV/nems/role.epic/UFS_SRW_data/develop/fix/fix_am/RTGSST.1982.2012.monthly.clim.grb' + fnzorc = 'igbp' + fsicl = 99999 + fsics = 99999 + fslpl = 99999 + fsmcl = 99999, 99999, 99999 + fsnol = 99999 + fsnos = 99999 + fsotl = 99999 + ftsfl = 99999 + ftsfs = 90 + fvetl = 99999 + fvmnl = 99999 + fvmxl = 99999 + ldebug = .true. +/ + +&namsfc_dict + fnabsc = '../fix_lam/C403.maximum_snow_albedo.tileX.nc' + fnalbc = '../fix_lam/C403.snowfree_albedo.tileX.nc' + fnalbc2 = '../fix_lam/C403.facsf.tileX.nc' + fnslpc = '../fix_lam/C403.slope_type.tileX.nc' + fnsotc = '../fix_lam/C403.soil_type.tileX.nc' + fntg3c = '../fix_lam/C403.substrate_temperature.tileX.nc' + fnvegc = '../fix_lam/C403.vegetation_greenness.tileX.nc' + fnvetc = '../fix_lam/C403.vegetation_type.tileX.nc' + fnvmnc = '../fix_lam/C403.vegetation_greenness.tileX.nc' + fnvmxc = '../fix_lam/C403.vegetation_greenness.tileX.nc' +/ + +&surf_map_nml + cd2 = -1 + cd4 = 0.12 + max_slope = 0.4 + n_del2_strong = 0 + n_del2_weak = 2 + n_del4 = 1 + peak_fac = 1.0 + zero_ocean = .false. +/ diff --git a/physics/docs/pdftxt/RE300/namelists/input.nml.FV3_RAP b/physics/docs/pdftxt/RE300/namelists/input.nml.FV3_RAP new file mode 100644 index 000000000..ef3f44fc5 --- /dev/null +++ b/physics/docs/pdftxt/RE300/namelists/input.nml.FV3_RAP @@ -0,0 +1,300 @@ +&amip_interp_nml + data_set = 'reynolds_oi' + date_out_of_range = 'climo' + interp_oi_sst = .true. + no_anom_sst = .false. + use_ncep_ice = .false. + use_ncep_sst = .true. +/ + +&atmos_model_nml + blocksize = 40 + ccpp_suite = 'FV3_RAP' + chksum_debug = .false. + dycore_only = .false. +/ + +&cires_ugwp_nml + knob_ugwp_azdir = 2, 4, 4, 4 + knob_ugwp_doaxyz = 1 + knob_ugwp_doheat = 1 + knob_ugwp_dokdis = 1 + knob_ugwp_effac = 1, 1, 1, 1 + knob_ugwp_ndx4lh = 1 + knob_ugwp_solver = 2 + knob_ugwp_source = 1, 1, 0, 0 + knob_ugwp_stoch = 0, 0, 0, 0 + knob_ugwp_version = 0 + knob_ugwp_wvspec = 1, 25, 25, 25 + launch_level = 25 +/ + +&diag_manager_nml + max_output_fields = 450 + prepend_date = .false. +/ + +&external_ic_nml + checker_tr = .false. + filtered_terrain = .true. + gfs_dwinds = .true. + levp = 65 + nt_checker = 0 +/ + +&fms_io_nml + checksum_required = .false. + max_files_r = 100 + max_files_w = 100 +/ + +&fms_nml + clock_grain = 'ROUTINE' + domains_stack_size = 12000000 + print_memory_usage = .false. +/ + +&fv_core_nml + a_imp = 1.0 + adjust_dry_mass = .false. + bc_update_interval = 6 + beta = 0.0 + consv_am = .false. + consv_te = 0.0 + d2_bg = 0.0 + d2_bg_k1 = 0.2 + d2_bg_k2 = 0.04 + d4_bg = 0.12 + d_con = 1.0 + d_ext = 0.0 + dddmp = 0.1 + delt_max = 0.008 + dnats = 0 + do_sat_adj = .false. + do_schmidt = .true. + do_vort_damp = .true. + dwind_2d = .false. + dz_min = 2 + external_eta = .true. + external_ic = .true. + fill = .true. + full_zs_filter = .false. + fv_debug = .false. + fv_sg_adj = 300 + gfs_phil = .false. + hord_dp = -5 + hord_mt = 5 + hord_tm = 5 + hord_tr = 10 + hord_vt = 5 + hydrostatic = .false. + io_layout = 1, 1 + k_split = 2 + ke_bg = 0.0 + kord_mt = 9 + kord_tm = -9 + kord_tr = 9 + kord_wz = 9 + layout = 5, 2 + make_nh = .true. + mountain = .false. + n_split = 5 + n_sponge = 24 + n_zs_filter = 0 + na_init = 1 + ncep_ic = .false. + nggps_ic = .true. + no_dycore = .false. + nord = 3 + nord_tr = 2 + npx = 220 + npy = 132 + npz = 64 + nrows_blend = 10 + ntiles = 1 + nudge_qv = .false. + nwat = 6 + p_fac = 0.1 + phys_hydrostatic = .false. + print_freq = 6 + psm_bc = 1 + range_warn = .true. + read_increment = .false. + regional = .true. + regional_bcs_from_gsi = .false. + res_latlon_dynamics = 'fv3_increment.nc' + reset_eta = .false. + rf_cutoff = 2000.0 + stretch_fac = 0.999 + target_lat = 38.5 + target_lon = -97.5 + tau = 5.0 + use_hydro_pressure = .false. + vtdm4 = 0.02 + warm_start = .false. + write_restart_with_bcs = .false. + z_tracer = .true. +/ + +&fv_grid_nml + grid_file = 'INPUT/grid_spec.nc' +/ + +&gfs_physics_nml + bl_mynn_edmf = 1 + bl_mynn_edmf_mom = 1 + bl_mynn_tkeadvect = .true. + cal_pre = .false. + cdmbgwd = 3.5, 1.0 + cnvcld = .false. + cnvgwd = .false. + cplflx = .false. + debug = .false. + do_deep = .true. + do_gsl_drag_ls_bl = .true. + do_gsl_drag_ss = .true. + do_gsl_drag_tofd = .true. + do_mynnedmf = .true. + do_mynnsfclay = .true. + do_shum = .false. + do_skeb = .false. + do_spp = .false. + do_sppt = .false. + dspheat = .true. + effr_in = .true. + fhcyc = 0 + fhlwr = 1200.0 + fhswr = 1200.0 + fhzero = 1.0 + gwd_opt = 3 + h2o_phys = .true. + hybedmf = .false. + iaer = 5111 + ialb = 1 + iau_delthrs = 6 + iau_inc_files = '' + iaufhrs = 30 + icliq_sw = 2 + icloud_bl = 1 + ico2 = 2 + iems = 1 + imfdeepcnv = 3 + imfshalcnv = 3 + imp_physics = 8 + iopt_alb = 2 + iopt_btr = 1 + iopt_crs = 1 + iopt_dveg = 2 + iopt_frz = 1 + iopt_inf = 1 + iopt_rad = 1 + iopt_run = 1 + iopt_sfc = 1 + iopt_snf = 4 + iopt_stc = 1 + iopt_tbot = 2 + iopt_trs = 2 + iovr = 3 + isol = 2 + isot = 1 + isubc_lw = 2 + isubc_sw = 2 + ivegsrc = 1 + kice = 9 + ldiag3d = .false. + lheatstrg = .false. + lndp_type = 0 + lradar = .true. + lsm = 3 + lsoil = 4 + lsoil_lsm = 9 + ltaerosol = .true. + lwhtr = .true. + n_var_lndp = 0 + n_var_spp = 0 + nsfullradar_diag = 3600 + nst_anl = .true. + nstf_name = 2, 1, 0, 0, 0 + oz_phys = .false. + oz_phys_2015 = .true. + pdfcld = .false. + pre_rad = .false. + print_diff_pgr = .false. + prslrd0 = 0.0 + random_clds = .false. + redrag = .true. + satmedmf = .false. + sfclay_compute_flux = .false. + shal_cnv = .true. + swhtr = .true. + trans_trac = .true. + ttendlim = -999 + use_ufo = .true. +/ + +&interpolator_nml + interp_method = 'conserve_great_circle' +/ + +&nam_sfcperts +/ + +&nam_sppperts +/ + +&nam_stochy +/ + +&namsfc + fabsl = 99999 + faisl = 99999 + faiss = 99999 + fnacna = '' + fnaisc = '../../../../../../../../../../../scratch1/NCEPDEV/nems/role.epic/UFS_SRW_data/develop/fix/fix_am/CFSR.SEAICE.1982.2012.monthly.clim.grb' + fnglac = '../../../../../../../../../../../scratch1/NCEPDEV/nems/role.epic/UFS_SRW_data/develop/fix/fix_am/global_glacier.2x2.grb' + fnmskh = '../../../../../../../../../../../scratch1/NCEPDEV/nems/role.epic/UFS_SRW_data/develop/fix/fix_am/seaice_newland.grb' + fnmxic = '../../../../../../../../../../../scratch1/NCEPDEV/nems/role.epic/UFS_SRW_data/develop/fix/fix_am/global_maxice.2x2.grb' + fnsmcc = '../../../../../../../../../../../scratch1/NCEPDEV/nems/role.epic/UFS_SRW_data/develop/fix/fix_am/global_soilmgldas.t126.384.190.grb' + fnsnoa = '' + fnsnoc = '../../../../../../../../../../../scratch1/NCEPDEV/nems/role.epic/UFS_SRW_data/develop/fix/fix_am/global_snoclim.1.875.grb' + fntsfa = '' + fntsfc = '../../../../../../../../../../../scratch1/NCEPDEV/nems/role.epic/UFS_SRW_data/develop/fix/fix_am/RTGSST.1982.2012.monthly.clim.grb' + fnzorc = 'igbp' + fsicl = 99999 + fsics = 99999 + fslpl = 99999 + fsmcl = 99999, 99999, 99999 + fsnol = 99999 + fsnos = 99999 + fsotl = 99999 + ftsfl = 99999 + ftsfs = 90 + fvetl = 99999 + fvmnl = 99999 + fvmxl = 99999 + ldebug = .true. +/ + +&namsfc_dict + fnabsc = '../fix_lam/C403.maximum_snow_albedo.tileX.nc' + fnalbc = '../fix_lam/C403.snowfree_albedo.tileX.nc' + fnalbc2 = '../fix_lam/C403.facsf.tileX.nc' + fnslpc = '../fix_lam/C403.slope_type.tileX.nc' + fnsotc = '../fix_lam/C403.soil_type.tileX.nc' + fntg3c = '../fix_lam/C403.substrate_temperature.tileX.nc' + fnvegc = '../fix_lam/C403.vegetation_greenness.tileX.nc' + fnvetc = '../fix_lam/C403.vegetation_type.tileX.nc' + fnvmnc = '../fix_lam/C403.vegetation_greenness.tileX.nc' + fnvmxc = '../fix_lam/C403.vegetation_greenness.tileX.nc' +/ + +&surf_map_nml + cd2 = -1 + cd4 = 0.12 + max_slope = 0.4 + n_del2_strong = 0 + n_del2_weak = 2 + n_del4 = 1 + peak_fac = 1.0 + zero_ocean = .false. +/ diff --git a/physics/docs/pdftxt/RE300/namelists/input.nml.FV3_RRFS_v1beta b/physics/docs/pdftxt/RE300/namelists/input.nml.FV3_RRFS_v1beta new file mode 100644 index 000000000..97a0f1216 --- /dev/null +++ b/physics/docs/pdftxt/RE300/namelists/input.nml.FV3_RRFS_v1beta @@ -0,0 +1,285 @@ +&amip_interp_nml + data_set = 'reynolds_oi' + date_out_of_range = 'climo' + interp_oi_sst = .true. + no_anom_sst = .false. + use_ncep_ice = .false. + use_ncep_sst = .true. +/ + +&atmos_model_nml + blocksize = 40 + ccpp_suite = 'FV3_RRFS_v1beta' + chksum_debug = .false. + dycore_only = .false. +/ + +&cires_ugwp_nml + knob_ugwp_azdir = 2, 4, 4, 4 + knob_ugwp_doaxyz = 1 + knob_ugwp_doheat = 1 + knob_ugwp_dokdis = 1 + knob_ugwp_effac = 1, 1, 1, 1 + knob_ugwp_ndx4lh = 1 + knob_ugwp_solver = 2 + knob_ugwp_source = 1, 1, 0, 0 + knob_ugwp_stoch = 0, 0, 0, 0 + knob_ugwp_version = 0 + knob_ugwp_wvspec = 1, 25, 25, 25 + launch_level = 25 +/ + +&diag_manager_nml + max_output_fields = 450 + prepend_date = .false. +/ + +&external_ic_nml + checker_tr = .false. + filtered_terrain = .true. + gfs_dwinds = .true. + levp = 65 + nt_checker = 0 +/ + +&fms_io_nml + checksum_required = .false. + max_files_r = 100 + max_files_w = 100 +/ + +&fms_nml + clock_grain = 'ROUTINE' + domains_stack_size = 12000000 + print_memory_usage = .false. +/ + +&fv_core_nml + a_imp = 1.0 + adjust_dry_mass = .false. + bc_update_interval = 6 + beta = 0.0 + consv_am = .false. + consv_te = 0.0 + d2_bg = 0.0 + d2_bg_k1 = 0.2 + d2_bg_k2 = 0.04 + d4_bg = 0.12 + d_con = 1.0 + d_ext = 0.0 + dddmp = 0.1 + delt_max = 0.008 + dnats = 0 + do_sat_adj = .false. + do_schmidt = .true. + do_vort_damp = .true. + dwind_2d = .false. + dz_min = 2 + external_eta = .true. + external_ic = .true. + fill = .true. + full_zs_filter = .false. + fv_debug = .false. + fv_sg_adj = 300 + gfs_phil = .false. + hord_dp = 6 + hord_mt = 6 + hord_tm = 6 + hord_tr = 10 + hord_vt = 6 + hydrostatic = .false. + io_layout = 1, 1 + k_split = 2 + ke_bg = 0.0 + kord_mt = 9 + kord_tm = -9 + kord_tr = 9 + kord_wz = 9 + layout = 5, 2 + make_nh = .true. + mountain = .false. + n_split = 5 + n_sponge = 24 + n_zs_filter = 0 + na_init = 1 + ncep_ic = .false. + nggps_ic = .true. + no_dycore = .false. + nord = 3 + npx = 220 + npy = 132 + npz = 64 + nrows_blend = 10 + ntiles = 1 + nudge_qv = .false. + nwat = 6 + p_fac = 0.1 + phys_hydrostatic = .false. + print_freq = 6 + psm_bc = 1 + range_warn = .true. + read_increment = .false. + regional = .true. + regional_bcs_from_gsi = .false. + res_latlon_dynamics = 'fv3_increment.nc' + reset_eta = .false. + rf_cutoff = 2000.0 + stretch_fac = 0.999 + target_lat = 38.5 + target_lon = -97.5 + tau = 5.0 + use_hydro_pressure = .false. + vtdm4 = 0.02 + warm_start = .false. + write_restart_with_bcs = .false. + z_tracer = .true. +/ + +&fv_grid_nml + grid_file = 'INPUT/grid_spec.nc' +/ + +&gfs_physics_nml + bl_mynn_edmf = 1 + bl_mynn_edmf_mom = 1 + bl_mynn_tkeadvect = .true. + cal_pre = .false. + cdmbgwd = 3.5, 0.25 + cnvcld = .false. + cnvgwd = .false. + cplflx = .false. + debug = .false. + do_deep = .false. + do_mynnedmf = .true. + do_mynnsfclay = .true. + dspheat = .true. + effr_in = .true. + fhcyc = 0.0 + fhlwr = 1200.0 + fhswr = 1200.0 + fhzero = 1.0 + h2o_phys = .true. + hybedmf = .false. + iaer = 111 + ialb = 1 + iau_delthrs = 6 + iau_inc_files = '' + iaufhrs = 30 + icloud_bl = 1 + ico2 = 2 + iems = 1 + imfdeepcnv = -1 + imfshalcnv = -1 + imp_physics = 8 + iopt_alb = 2 + iopt_btr = 1 + iopt_crs = 1 + iopt_dveg = 2 + iopt_frz = 1 + iopt_inf = 1 + iopt_rad = 1 + iopt_run = 1 + iopt_sfc = 1 + iopt_snf = 4 + iopt_stc = 1 + iopt_tbot = 2 + iopt_trs = 2 + isol = 2 + isot = 1 + isubc_lw = 2 + isubc_sw = 2 + ivegsrc = 1 + ldiag3d = .false. + lheatstrg = .false. + lradar = .true. + lsm = 2 + lsoil = 4 + lsoil_lsm = 4 + ltaerosol = .true. + lwhtr = .true. + nsfullradar_diag = 3600 + nst_anl = .true. + nstf_name = 2, 1, 0, 0, 0 + oz_phys = .false. + oz_phys_2015 = .true. + pdfcld = .false. + pre_rad = .false. + print_diff_pgr = .false. + prslrd0 = 0.0 + random_clds = .false. + redrag = .true. + satmedmf = .false. + sfclay_compute_flux = .false. + shal_cnv = .false. + swhtr = .true. + trans_trac = .true. + ttendlim = -999 + use_ufo = .true. +/ + +&interpolator_nml + interp_method = 'conserve_great_circle' +/ + +&nam_sfcperts +/ + +&nam_sppperts +/ + +&nam_stochy +/ + +&namsfc + fabsl = 99999 + faisl = 99999 + faiss = 99999 + fnacna = '' + fnaisc = '../../../../../../../../../../../../scratch1/NCEPDEV/nems/role.epic/UFS_SRW_data/develop/fix/fix_am/CFSR.SEAICE.1982.2012.monthly.clim.grb' + fnglac = '../../../../../../../../../../../../scratch1/NCEPDEV/nems/role.epic/UFS_SRW_data/develop/fix/fix_am/global_glacier.2x2.grb' + fnmskh = '../../../../../../../../../../../../scratch1/NCEPDEV/nems/role.epic/UFS_SRW_data/develop/fix/fix_am/seaice_newland.grb' + fnmxic = '../../../../../../../../../../../../scratch1/NCEPDEV/nems/role.epic/UFS_SRW_data/develop/fix/fix_am/global_maxice.2x2.grb' + fnsmcc = '../../../../../../../../../../../../scratch1/NCEPDEV/nems/role.epic/UFS_SRW_data/develop/fix/fix_am/global_soilmgldas.t126.384.190.grb' + fnsnoa = '' + fnsnoc = '../../../../../../../../../../../../scratch1/NCEPDEV/nems/role.epic/UFS_SRW_data/develop/fix/fix_am/global_snoclim.1.875.grb' + fntsfa = '' + fntsfc = '../../../../../../../../../../../../scratch1/NCEPDEV/nems/role.epic/UFS_SRW_data/develop/fix/fix_am/RTGSST.1982.2012.monthly.clim.grb' + fnzorc = 'igbp' + fsicl = 99999 + fsics = 99999 + fslpl = 99999 + fsmcl = 99999, 99999, 99999 + fsnol = 99999 + fsnos = 99999 + fsotl = 99999 + ftsfl = 99999 + ftsfs = 90 + fvetl = 99999 + fvmnl = 99999 + fvmxl = 99999 + ldebug = .true. +/ + +&namsfc_dict + fnabsc = '../fix_lam/C403.maximum_snow_albedo.tileX.nc' + fnalbc = '../fix_lam/C403.snowfree_albedo.tileX.nc' + fnalbc2 = '../fix_lam/C403.facsf.tileX.nc' + fnslpc = '../fix_lam/C403.slope_type.tileX.nc' + fnsotc = '../fix_lam/C403.soil_type.tileX.nc' + fntg3c = '../fix_lam/C403.substrate_temperature.tileX.nc' + fnvegc = '../fix_lam/C403.vegetation_greenness.tileX.nc' + fnvetc = '../fix_lam/C403.vegetation_type.tileX.nc' + fnvmnc = '../fix_lam/C403.vegetation_greenness.tileX.nc' + fnvmxc = '../fix_lam/C403.vegetation_greenness.tileX.nc' +/ + +&surf_map_nml + cd2 = -1 + cd4 = 0.12 + max_slope = 0.4 + n_del2_strong = 0 + n_del2_weak = 2 + n_del4 = 1 + peak_fac = 1.0 + zero_ocean = .false. +/ diff --git a/physics/docs/pdftxt/RE300/namelists/input.nml.FV3_WoFS_v0 b/physics/docs/pdftxt/RE300/namelists/input.nml.FV3_WoFS_v0 new file mode 100644 index 000000000..1236cde3b --- /dev/null +++ b/physics/docs/pdftxt/RE300/namelists/input.nml.FV3_WoFS_v0 @@ -0,0 +1,291 @@ +&amip_interp_nml + data_set = 'reynolds_oi' + date_out_of_range = 'climo' + interp_oi_sst = .true. + no_anom_sst = .false. + use_ncep_ice = .false. + use_ncep_sst = .true. +/ + +&atmos_model_nml + blocksize = 40 + ccpp_suite = 'FV3_WoFS_v0' + chksum_debug = .false. + dycore_only = .false. +/ + +&cires_ugwp_nml + knob_ugwp_azdir = 2, 4, 4, 4 + knob_ugwp_doaxyz = 1 + knob_ugwp_doheat = 1 + knob_ugwp_dokdis = 1 + knob_ugwp_effac = 1, 1, 1, 1 + knob_ugwp_ndx4lh = 1 + knob_ugwp_solver = 2 + knob_ugwp_source = 1, 1, 0, 0 + knob_ugwp_stoch = 0, 0, 0, 0 + knob_ugwp_version = 0 + knob_ugwp_wvspec = 1, 25, 25, 25 + launch_level = 25 +/ + +&diag_manager_nml + max_output_fields = 450 + prepend_date = .false. +/ + +&external_ic_nml + checker_tr = .false. + filtered_terrain = .true. + gfs_dwinds = .true. + levp = 65 + nt_checker = 0 +/ + +&fms_io_nml + checksum_required = .false. + max_files_r = 100 + max_files_w = 100 +/ + +&fms_nml + clock_grain = 'ROUTINE' + domains_stack_size = 12000000 + print_memory_usage = .false. +/ + +&fv_core_nml + a_imp = 1.0 + adjust_dry_mass = .false. + bc_update_interval = 6 + beta = 0.0 + consv_am = .false. + consv_te = 0.0 + d2_bg = 0.0 + d2_bg_k1 = 0.2 + d2_bg_k2 = 0.04 + d4_bg = 0.12 + d_con = 1.0 + d_ext = 0.0 + dddmp = 0.1 + delt_max = 0.008 + dnats = 0 + do_sat_adj = .false. + do_schmidt = .true. + do_vort_damp = .true. + dwind_2d = .false. + dz_min = 2 + external_eta = .true. + external_ic = .true. + fill = .true. + full_zs_filter = .false. + fv_debug = .false. + fv_sg_adj = 300 + gfs_phil = .false. + hord_dp = 6 + hord_mt = 6 + hord_tm = 6 + hord_tr = 10 + hord_vt = 6 + hydrostatic = .false. + io_layout = 1, 1 + k_split = 2 + ke_bg = 0.0 + kord_mt = 9 + kord_tm = -9 + kord_tr = 9 + kord_wz = 9 + layout = 5, 2 + make_nh = .true. + mountain = .false. + n_split = 5 + n_sponge = 24 + n_zs_filter = 0 + na_init = 1 + ncep_ic = .false. + nggps_ic = .true. + no_dycore = .false. + nord = 3 + npx = 220 + npy = 132 + npz = 64 + nrows_blend = 10 + ntiles = 1 + nudge_qv = .false. + nwat = 7 + p_fac = 0.1 + phys_hydrostatic = .false. + print_freq = 6 + psm_bc = 1 + range_warn = .true. + read_increment = .false. + regional = .true. + regional_bcs_from_gsi = .false. + res_latlon_dynamics = 'fv3_increment.nc' + reset_eta = .false. + rf_cutoff = 2000.0 + stretch_fac = 0.999 + target_lat = 38.5 + target_lon = -97.5 + tau = 5.0 + use_hydro_pressure = .false. + vtdm4 = 0.02 + warm_start = .false. + write_restart_with_bcs = .false. + z_tracer = .true. +/ + +&fv_diagnostics_nml + do_hailcast = .true. +/ + +&fv_grid_nml + grid_file = 'INPUT/grid_spec.nc' +/ + +&gfs_physics_nml + bl_mynn_edmf = 1 + bl_mynn_edmf_mom = 1 + bl_mynn_tkeadvect = .true. + cal_pre = .false. + cdmbgwd = 3.5, 0.25 + cnvcld = .false. + cnvgwd = .false. + cplflx = .false. + debug = .false. + do_deep = .false. + do_mynnedmf = .true. + do_mynnsfclay = .true. + dspheat = .true. + effr_in = .true. + fhcyc = 0.0 + fhlwr = 1200.0 + fhswr = 1200.0 + fhzero = 1.0 + h2o_phys = .true. + hybedmf = .false. + iaer = 111 + ialb = 1 + iau_delthrs = 6 + iau_inc_files = '' + iaufhrs = 30 + icloud_bl = 1 + ico2 = 2 + iems = 1 + imfdeepcnv = -1 + imfshalcnv = -1 + imp_physics = 17 + iopt_alb = 2 + iopt_btr = 1 + iopt_crs = 1 + iopt_dveg = 2 + iopt_frz = 1 + iopt_inf = 1 + iopt_rad = 1 + iopt_run = 1 + iopt_sfc = 1 + iopt_snf = 4 + iopt_stc = 1 + iopt_tbot = 2 + isol = 2 + isot = 1 + isubc_lw = 2 + isubc_sw = 2 + ivegsrc = 1 + ldiag3d = .false. + lheatstrg = .false. + lradar = .true. + lsm = 1 + lsoil = 4 + lsoil_lsm = 4 + ltaerosol = .true. + lwhtr = .true. + nsfullradar_diag = 3600 + nssl_cccn = 600000000.0 + nssl_ccn_on = .true. + nssl_hail_on = .true. + nst_anl = .true. + nstf_name = 2, 1, 0, 0, 0 + oz_phys = .false. + oz_phys_2015 = .true. + pdfcld = .false. + pre_rad = .false. + print_diff_pgr = .false. + prslrd0 = 0.0 + random_clds = .false. + redrag = .true. + satmedmf = .false. + sfclay_compute_flux = .false. + shal_cnv = .false. + swhtr = .true. + trans_trac = .true. + ttendlim = -999 + use_ufo = .true. +/ + +&interpolator_nml + interp_method = 'conserve_great_circle' +/ + +&nam_sfcperts +/ + +&nam_sppperts +/ + +&nam_stochy +/ + +&namsfc + fabsl = 99999 + faisl = 99999 + faiss = 99999 + fnacna = '' + fnaisc = '../../../../../../../../../../../../scratch1/NCEPDEV/nems/role.epic/UFS_SRW_data/develop/fix/fix_am/CFSR.SEAICE.1982.2012.monthly.clim.grb' + fnglac = '../../../../../../../../../../../../scratch1/NCEPDEV/nems/role.epic/UFS_SRW_data/develop/fix/fix_am/global_glacier.2x2.grb' + fnmskh = '../../../../../../../../../../../../scratch1/NCEPDEV/nems/role.epic/UFS_SRW_data/develop/fix/fix_am/seaice_newland.grb' + fnmxic = '../../../../../../../../../../../../scratch1/NCEPDEV/nems/role.epic/UFS_SRW_data/develop/fix/fix_am/global_maxice.2x2.grb' + fnsmcc = '../../../../../../../../../../../../scratch1/NCEPDEV/nems/role.epic/UFS_SRW_data/develop/fix/fix_am/global_soilmgldas.t126.384.190.grb' + fnsnoa = '' + fnsnoc = '../../../../../../../../../../../../scratch1/NCEPDEV/nems/role.epic/UFS_SRW_data/develop/fix/fix_am/global_snoclim.1.875.grb' + fntsfa = '' + fntsfc = '../../../../../../../../../../../../scratch1/NCEPDEV/nems/role.epic/UFS_SRW_data/develop/fix/fix_am/RTGSST.1982.2012.monthly.clim.grb' + fnzorc = 'igbp' + fsicl = 99999 + fsics = 99999 + fslpl = 99999 + fsmcl = 99999, 99999, 99999 + fsnol = 99999 + fsnos = 99999 + fsotl = 99999 + ftsfl = 99999 + ftsfs = 90 + fvetl = 99999 + fvmnl = 99999 + fvmxl = 99999 + ldebug = .true. +/ + +&namsfc_dict + fnabsc = '../fix_lam/C403.maximum_snow_albedo.tileX.nc' + fnalbc = '../fix_lam/C403.snowfree_albedo.tileX.nc' + fnalbc2 = '../fix_lam/C403.facsf.tileX.nc' + fnslpc = '../fix_lam/C403.slope_type.tileX.nc' + fnsotc = '../fix_lam/C403.soil_type.tileX.nc' + fntg3c = '../fix_lam/C403.substrate_temperature.tileX.nc' + fnvegc = '../fix_lam/C403.vegetation_greenness.tileX.nc' + fnvetc = '../fix_lam/C403.vegetation_type.tileX.nc' + fnvmnc = '../fix_lam/C403.vegetation_greenness.tileX.nc' + fnvmxc = '../fix_lam/C403.vegetation_greenness.tileX.nc' +/ + +&surf_map_nml + cd2 = -1 + cd4 = 0.12 + max_slope = 0.4 + n_del2_strong = 0 + n_del2_weak = 2 + n_del4 = 1 + peak_fac = 1.0 + zero_ocean = .false. +/ diff --git a/physics/docs/pdftxt/RE300/suite_FV3_GFS_v16.xml b/physics/docs/pdftxt/RE300/suite_FV3_GFS_v16.xml new file mode 100644 index 000000000..122b937e1 --- /dev/null +++ b/physics/docs/pdftxt/RE300/suite_FV3_GFS_v16.xml @@ -0,0 +1,94 @@ + + + + + + + fv_sat_adj + + + + + GFS_time_vary_pre + GFS_rrtmg_setup + GFS_rad_time_vary + GFS_phys_time_vary + + + + + GFS_suite_interstitial_rad_reset + GFS_rrtmg_pre + GFS_radiation_surface + rad_sw_pre + rrtmg_sw + rrtmg_sw_post + rrtmg_lw_pre + rrtmg_lw + rrtmg_lw_post + GFS_rrtmg_post + + + + + GFS_suite_interstitial_phys_reset + GFS_suite_stateout_reset + get_prs_fv3 + GFS_suite_interstitial_1 + GFS_surface_generic_pre + GFS_surface_composites_pre + dcyc2t3 + GFS_surface_composites_inter + GFS_suite_interstitial_2 + + + + sfc_diff + GFS_surface_loop_control_part1 + sfc_nst_pre + sfc_nst + sfc_nst_post + lsm_noah + sfc_sice + GFS_surface_loop_control_part2 + + + + GFS_surface_composites_post + sfc_diag + sfc_diag_post + GFS_surface_generic_post + GFS_PBL_generic_pre + satmedmfvdifq + GFS_PBL_generic_post + GFS_GWD_generic_pre + cires_ugwp + cires_ugwp_post + GFS_GWD_generic_post + GFS_suite_stateout_update + ozphys_2015 + h2ophys + get_phi_fv3 + GFS_suite_interstitial_3 + GFS_DCNV_generic_pre + samfdeepcnv + GFS_DCNV_generic_post + GFS_SCNV_generic_pre + samfshalcnv + GFS_SCNV_generic_post + GFS_suite_interstitial_4 + cnvc90 + GFS_MP_generic_pre + gfdl_cloud_microphys + GFS_MP_generic_post + maximum_hourly_diagnostics + phys_tend + + + + + GFS_stochastics + + + + diff --git a/physics/docs/pdftxt/RE300/suite_FV3_HRRR.xml b/physics/docs/pdftxt/RE300/suite_FV3_HRRR.xml new file mode 100644 index 000000000..6ac35db14 --- /dev/null +++ b/physics/docs/pdftxt/RE300/suite_FV3_HRRR.xml @@ -0,0 +1,82 @@ + + + + + + + GFS_time_vary_pre + GFS_rrtmg_setup + GFS_rad_time_vary + GFS_phys_time_vary + + + + + GFS_suite_interstitial_rad_reset + sgscloud_radpre + GFS_rrtmg_pre + GFS_radiation_surface + rad_sw_pre + rrtmg_sw + rrtmg_sw_post + rrtmg_lw_pre + rrtmg_lw + sgscloud_radpost + rrtmg_lw_post + GFS_rrtmg_post + + + + + GFS_suite_interstitial_phys_reset + GFS_suite_stateout_reset + get_prs_fv3 + GFS_suite_interstitial_1 + GFS_surface_generic_pre + GFS_surface_composites_pre + dcyc2t3 + GFS_surface_composites_inter + GFS_suite_interstitial_2 + + + + mynnsfc_wrapper + GFS_surface_loop_control_part1 + lsm_ruc + clm_lake + GFS_surface_loop_control_part2 + + + + GFS_surface_composites_post + sfc_diag + sfc_diag_post + GFS_surface_generic_post + rrfs_smoke_wrapper + mynnedmf_wrapper + rrfs_smoke_postpbl + GFS_GWD_generic_pre + drag_suite + GFS_GWD_generic_post + GFS_suite_stateout_update + ozphys_2015 + h2ophys + get_phi_fv3 + GFS_suite_interstitial_3 + GFS_suite_interstitial_4 + GFS_MP_generic_pre + mp_thompson_pre + mp_thompson + mp_thompson_post + GFS_MP_generic_post + maximum_hourly_diagnostics + phys_tend + + + + + GFS_stochastics + + + + diff --git a/physics/docs/pdftxt/RE300/suite_FV3_RAP.xml b/physics/docs/pdftxt/RE300/suite_FV3_RAP.xml new file mode 100644 index 000000000..f03c1a1e8 --- /dev/null +++ b/physics/docs/pdftxt/RE300/suite_FV3_RAP.xml @@ -0,0 +1,90 @@ + + + + + + + GFS_time_vary_pre + GFS_rrtmg_setup + GFS_rad_time_vary + GFS_phys_time_vary + + + + + GFS_suite_interstitial_rad_reset + sgscloud_radpre + GFS_rrtmg_pre + GFS_radiation_surface + rad_sw_pre + rrtmg_sw + rrtmg_sw_post + rrtmg_lw_pre + rrtmg_lw + sgscloud_radpost + rrtmg_lw_post + GFS_rrtmg_post + + + + + GFS_suite_interstitial_phys_reset + GFS_suite_stateout_reset + get_prs_fv3 + GFS_suite_interstitial_1 + GFS_surface_generic_pre + GFS_surface_composites_pre + dcyc2t3 + GFS_surface_composites_inter + GFS_suite_interstitial_2 + + + + mynnsfc_wrapper + GFS_surface_loop_control_part1 + sfc_nst_pre + sfc_nst + sfc_nst_post + lsm_ruc + GFS_surface_loop_control_part2 + + + + GFS_surface_composites_post + sfc_diag + sfc_diag_post + GFS_surface_generic_post + mynnedmf_wrapper + GFS_GWD_generic_pre + drag_suite + GFS_GWD_generic_post + GFS_suite_stateout_update + ozphys_2015 + h2ophys + get_phi_fv3 + GFS_suite_interstitial_3 + GFS_DCNV_generic_pre + cu_gf_driver_pre + cu_gf_driver + GFS_DCNV_generic_post + GFS_SCNV_generic_pre + GFS_SCNV_generic_post + GFS_suite_interstitial_4 + cnvc90 + GFS_MP_generic_pre + mp_thompson_pre + mp_thompson + mp_thompson_post + GFS_MP_generic_post + cu_gf_driver_post + maximum_hourly_diagnostics + phys_tend + + + + + GFS_stochastics + + + + diff --git a/physics/docs/pdftxt/RE300/suite_FV3_RRFS_v1beta.xml b/physics/docs/pdftxt/RE300/suite_FV3_RRFS_v1beta.xml new file mode 100644 index 000000000..97228c0a6 --- /dev/null +++ b/physics/docs/pdftxt/RE300/suite_FV3_RRFS_v1beta.xml @@ -0,0 +1,84 @@ + + + + + + + GFS_time_vary_pre + GFS_rrtmg_setup + GFS_rad_time_vary + GFS_phys_time_vary + + + + + GFS_suite_interstitial_rad_reset + sgscloud_radpre + GFS_rrtmg_pre + GFS_radiation_surface + rad_sw_pre + rrtmg_sw + rrtmg_sw_post + rrtmg_lw_pre + rrtmg_lw + sgscloud_radpost + rrtmg_lw_post + GFS_rrtmg_post + + + + + GFS_suite_interstitial_phys_reset + GFS_suite_stateout_reset + get_prs_fv3 + GFS_suite_interstitial_1 + GFS_surface_generic_pre + GFS_surface_composites_pre + dcyc2t3 + GFS_surface_composites_inter + GFS_suite_interstitial_2 + + + + mynnsfc_wrapper + GFS_surface_loop_control_part1 + sfc_nst_pre + sfc_nst + sfc_nst_post + noahmpdrv + sfc_sice + GFS_surface_loop_control_part2 + + + + GFS_surface_composites_post + sfc_diag + sfc_diag_post + GFS_surface_generic_post + mynnedmf_wrapper + GFS_GWD_generic_pre + cires_ugwp + cires_ugwp_post + GFS_GWD_generic_post + GFS_suite_stateout_update + ozphys_2015 + h2ophys + get_phi_fv3 + GFS_suite_interstitial_3 + GFS_suite_interstitial_4 + GFS_MP_generic_pre + mp_thompson_pre + mp_thompson + mp_thompson_post + GFS_MP_generic_post + maximum_hourly_diagnostics + phys_tend + + + + + GFS_stochastics + + + + diff --git a/physics/docs/pdftxt/RE300/suite_FV3_WoFS_v0.xml b/physics/docs/pdftxt/RE300/suite_FV3_WoFS_v0.xml new file mode 100644 index 000000000..1a34ba1a1 --- /dev/null +++ b/physics/docs/pdftxt/RE300/suite_FV3_WoFS_v0.xml @@ -0,0 +1,80 @@ + + + + + + + GFS_time_vary_pre + GFS_rrtmg_setup + GFS_rad_time_vary + GFS_phys_time_vary + + + + + GFS_suite_interstitial_rad_reset + sgscloud_radpre + GFS_rrtmg_pre + GFS_radiation_surface + rad_sw_pre + rrtmg_sw + rrtmg_sw_post + rrtmg_lw_pre + rrtmg_lw + sgscloud_radpost + rrtmg_lw_post + GFS_rrtmg_post + + + + + GFS_suite_interstitial_phys_reset + GFS_suite_stateout_reset + get_prs_fv3 + GFS_suite_interstitial_1 + GFS_surface_generic_pre + GFS_surface_composites_pre + dcyc2t3 + GFS_surface_composites_inter + GFS_suite_interstitial_2 + + + + mynnsfc_wrapper + GFS_surface_loop_control_part1 + sfc_nst_pre + sfc_nst + sfc_nst_post + lsm_noah + sfc_sice + GFS_surface_loop_control_part2 + + + + GFS_surface_composites_post + sfc_diag + sfc_diag_post + GFS_surface_generic_post + mynnedmf_wrapper + GFS_GWD_generic_pre + cires_ugwp + cires_ugwp_post + GFS_GWD_generic_post + GFS_suite_stateout_update + ozphys_2015 + h2ophys + get_phi_fv3 + GFS_MP_generic_pre + mp_nssl + GFS_MP_generic_post + maximum_hourly_diagnostics + phys_tend + + + + + GFS_stochastics + + + + diff --git a/physics/docs/pdftxt/RRFS_v1beta_suite.txt b/physics/docs/pdftxt/RRFS_v1beta_suite.txt index 2731e227e..b2e4ba676 100644 --- a/physics/docs/pdftxt/RRFS_v1beta_suite.txt +++ b/physics/docs/pdftxt/RRFS_v1beta_suite.txt @@ -3,8 +3,8 @@ \section RRFS_v1beta_suite_overview Overview -The RRFS_v1beta suite is the primary suite target for the upcoming operational implementation of -the Rapid Refresh Forecast System (RRFS), which is used in the UFS SRW App. This suite is most +The RRFS_v1beta suite is one of the candidates for the future operational implementation of +the Rapid Refresh Forecast System (RRFS), which can be configured using the UFS SRW App. This suite is most applicable for runs at 3-km resolution since it does not parameterize deep convection. diff --git a/physics/docs/pdftxt/RUCLSM.txt b/physics/docs/pdftxt/RUCLSM.txt index 00b064e5f..e8212df21 100644 --- a/physics/docs/pdftxt/RUCLSM.txt +++ b/physics/docs/pdftxt/RUCLSM.txt @@ -9,15 +9,15 @@ as part of the RAP from 2012 through the present and as part of HRRR from 2014 t processes in the RUC LSM (Smirnova et al. 2016 \cite Smirnova_2016 ) have proven to be physically robust and capable of realistically representing the evolution of soil moisture, soil temperature, and snow in cycled models. Extension of the RAP domain to encompass all of North America and adjacent high-latitude ocean areas necessitated further development of the RUC LSM for application in the tundra permafrost regions and over Arctic -sea ice (Smirnova et al. 2000 \cite Smirnova_2000). Other modifications include refinements in the snow model and a more accurate specification of -albedo, roughness length, and other surface properties. These recent modifications in the RUC LSM are described and evaluated in +sea ice (Smirnova et al. 2000 \cite Smirnova_2000). Other modifications include refinements in the snow model (snow "mosaic" approach, improvements in computation of snow cover fraction and snow thermal conductivity) and a more accurate specification of +albedo, roughness length, and other surface properties. Some of these modifications in the RUC LSM are described and evaluated in Smirnova et al. 2016 \cite Smirnova_2016 . -The parameterizations in the RUC LSM describe complicated atmosphere–land surface interactions in an intentionally simplified fashion to avoid +The parameterizations in the RUC LSM describe complicated atmosphere–land surface interactions (Fig.1) in an intentionally simplified fashion to avoid excessive sensitivity to multiple uncertain surface parameters. Nevertheless, the RUC LSM, when coupled with the hourly-assimilating atmospheric model, demonstrated over years of ongoing cycling (Benjamin et al. 2004a,b \cite Benjamin_2004a \cite Benjamin_2004b ; Berbery et al. 1999 \cite Berbery_1999) that it can produce a realistic evolution of hydrologic and time-varying soil fields (i.e., soil moisture and temperature) that cannot be directly -observed over large areas, as well as the evolution of snow cover on the ground surface. This result is possible only if the soil–vegetation–snow +observed over large areas, as well as the evolution of snow cover on the ground surface. This result is possible only if the soil–vegetation–snow component of the coupled model, constrained only by atmospheric boundary conditions and the specification of surface characteristics, has sufficient skill to avoid long-term drift. @@ -28,88 +28,94 @@ included in phase 2(d) of the Project for the Intercomparison of Land Surface Pr Luo et al. 2003 \cite Luo_2003 ). The RUC LSM was also tested during the Snow Models Intercomparison Project (SnowMIP, SnowMIP2, ESM-SnowMIP), with emphasis on snow parameterizations for both grassland and forest locations in different parts of the world (Etchevers et al. 2002, 2004 \cite Etchevers_2002 \cite Etchevers_2004; Essery et al. 2009 \cite Essery_2009 ; Rutter et al. 2009 \cite Rutter_2009 , -Krinner et al. 2018 \cite Krinner_2018 ). The analysis of RUC LSM performance over 10 reference sites in ESM-SnowMIP rated it on the 5th place +Krinner et al. 2018 \cite Krinner_2018 ). The analysis of RUC LSM performance over 10 reference sites in ESM-SnowMIP rated it 4th place among the 26 participating models. The results were published in Menard et al.(2021) \cite Menard_2021 and Essery et al. (2020) \cite essery_et_al_2020. RUC LSM received high rankings in ESM-SnowMIP experiement in terms of multi-year snow cover and surface temperature simulations -for several sites located in different parts of the world (Menard et al.2021 \cite Menard_2021). +for several sites located in different parts of the world (Fig.2, Menard et al.2021 \cite Menard_2021). -RUC LSM is used in several weather prediction models around the world (Austria, New Zealand, Switzerland, RAP/HRRR in US). Recent RUC LSM implementation in the high-resolution model in the Swiss Alps led to some small modifications and adjustments to the snow model. -These adjustments will be available in the next CCPP public release. +RUC LSM is used in several weather prediction models around the world (Austria, New Zealand, Switzerland, RAP/HRRR in US). Recent RUC LSM implementation in the 1km-resolution model over Europe revealed some issues in the snow-covered high terrain (Swiss Alps), and this led to some small modifications and adjustments to the snow model. +These adjustments are available in the current CCPP public release. +Coupling of the RUC LSM to physically-based stochastic snow model (He et al.(2021) \cite he_et_al_2021) is also available in the current public release. -Coupling of the RUC LSM to physically-based stochastic snow model (He et al.(2021) \cite he_et_al_2021) will be implemented in the next public release. +The sensitivity of surface fluxes and turbine-height winds to the RUC LSM parameters has been explored by Geng Xia, NREL +to determine the uncertainty range for the selected parameters in the RUC LSM. -The sensitivity of surface fluxes and turbine-height winds to the RUC LSM parameters has been explored by Geng Xia, NREL. This study -will determine the uncertainty range for the selected parameters in the RUC LSM and will be described in the journal paper. -## RUC LSM characteristics that differ from NOAH LSM: -\image html ruc_lsm_veg_soil.png "Figure 1. RUC LSM Vegetation and Soil Model (Courtesy of T.G. Smirnova) " width=900 +## RUC LSM characteristics that differ from Noah LSM: +\image html ruc_lsm_veg_soil.png "Figure 1: RUC LSM Vegetation and Soil Model (Courtesy of T.G. Smirnova) " width=900 +@image html https://user-images.githubusercontent.com/12705538/250180784-d50a3d4c-93db-4d8d-b12d-2c0ca22da5c3.png "Figure 2: Model ranking as a function of normalized root mean square error of snow water equivalent and surface temperature (Courtesy of C. Menard)" width=900 - \b Implicit \b solution of energy and moisture budgets in the layer spanning the ground surface - \b 9 \b soil \b levels with high vertical resolution near surface -RUC LSM has more levels in oil than \ref GFS_NOAH model with higher resolution near the interface with the atmosphere +RUC LSM has more levels in soil than \ref GFS_NOAH model with higher resolution near the interface with the atmosphere - \b Prognostic \b soil moisture variable (\f$\theta-\theta_r\f$) The prognostic variables for soil moisture is volumetric soil moisture content minus residual value of soil moisture which is tied to soil particles and does not participate in moisture transport. - \b Frozen \b soil \b physics algorithm RUC LSM has a different approach to take into account freezing and thawing processes in soil. -- Treatment of \b mixed \b phase \b precipitation -It accounts for mixed phase precipitation provided by \ref THOMPSON used in RAP and HRRR. -- Simple treatment of \b sea \c ice which solves heat diffusion in sea ice and allows evolving snow cover on top of sea ice -- sub-grid-scale \b heterogeneity of surface parameters in RUC LSM +- Treatment of \b mixed \b phase \b precipitation accounts for mixed phase precipitation provided by \ref THOMPSON used in RAP and HRRR. +- Simple treatment of \b sea \b ice which solves heat diffusion in sea ice and allows evolving snow cover on top of sea ice +- Sub-grid-scale \b heterogeneity of surface parameters in RUC LSM (Fig.3). With the certain level of confidence in the skill of the model, the next requirement is to provide land static fields and surface -parameters with the best possible accuracy. RAP and HRRR use the same datasets as \ref GFS_NOAH. But instead of specifying surface -parameters for the dominant soil and land-use category in the grid box, RUC LSM takes into account the sub-grid scale heterogeneity +parameters with the best possible accuracy. RAP and HRRR use the same soil/vegetation calssifications as \ref GFS_NOAH. But in addition to +specifying surface +parameters for the dominant soil and land-use category in the grid box, RUC LSM has an option to take into account the sub-grid scale heterogeneity in the computation of such parameters as roughness length, emissivity, soil porosity, soil heat capacity and others. The difference in -roughness between the mosaic and dominant category presented on figure 2 is positive from contribution of the forests, which helped to -reduce high biases of surface wind speeds in these regions. Roughness lenghth has also seasonal variability in the cropland regions, -which again helped to improve the wind forecasts during the warm season. -\image html ruc_lsm_heterogeneity.png "Figure 2: sub-grid scale heterogeneity of surface parameters in RUC LSM (Courtesy of T.G. Smirnova)" width=900 +roughness between the mosaic and dominant category presented on Figure 3, is positive from contribution of the forests, which helped to +reduce high biases of surface wind speeds in these regions. In cropland regions, roughness length also has a seasonal variability depending on the growing phase of the plants. This again helped to improve the wind forecasts during the warm season. +Turning on sub-grid-scale heterogeneity option requries: \p mosaic_lu = 1 and \p mosaic_soil = 1 in the namelist, and fractions of soil and vegetation types in a grid cell. +\image html ruc_lsm_heterogeneity.png "Figure 3: sub-grid scale heterogeneity of surface parameters in RUC LSM (Courtesy of T.G. Smirnova)" width=900 -- New: simple irrigation in the cropland area +- New: simple irrigation in the cropland area with \p mosaic_lu = 1 - New: water/snow intercepted by canopy as function of vegetation fraction and leaf area index (LAI) ## RUC snow model characteristics: Snow forms additional two layers on top of soil in RUC LSM -- \b 2-layer \b snow model: when SWE < 1.6 cm - snow layer is combined with top soil layer -- Fractional snow cover (SWE < 3 cm): -- weighted average of snow-covered and snow-free areas to compute snow paramters (roughness, albedo) -- New: "mosaic" approach for patchy snow - - Seperate treatment of energy and moisture budgets for snow-covered and snow-free portions of the grid cell +- \b 2-layer \b snow model: when SWE < 1.6 cm - snow layer is combined with top soil layer; +- Fractional snow cover (SWE < 3 cm); +- Weighted average of snow-covered and snow-free areas to compute snow parameters (roughness, albedo); +- "Mosaic" approach for patchy snow (Fig.4): + - Separate treatment of energy and moisture budgets for snow-covered and snow-free portions of the grid cell - Aggregate solutions at the end of time step - - Reduced cold bias for areas with thin snow -\image html ruc_lsm_mosaic.png "Figure 3: recent development: mosaic approach for patchy snow (Courtesy of T.G. Smirnova) " width=900 -- Iterative snow melting algorithm -- Density of snow on the ground - a function of compaction parameter and snow depth and temperature -- Snow albedo - a function of temperature and snow fraction -- Snow interception by canopy - a function of vegetation fraction and LAI -- Density of falling snow/graupel/ice precipitation + - Outcome: reduced cold bias for areas with thin snow +\image html ruc_lsm_mosaic.png "Figure 4: 'Mosaic' approach for patchy snow (Courtesy of T.G. Smirnova) " width=900 + - New: additional options to compute snow cover fraction (\p isncovr_opt =2 and 3, Niu and Yang (2007) \cite Niu_2007). These options allowed to reduce overprediction of number of grid cells fully covered with snow which further reduced cold-biases over snow. Figure 5 demonstrates that option 3 of snow cover fraction computation (\p isncovr_opt = 3) in the UFS-based regional model matches better the satellite data for the test case on 6 February 2022. +- New: added an option to use of a new formulation of snow thermal conductivity (\p isncond_opt = 2, Sturm et al. (1997) \cite sturm_1997); +@image html https://user-images.githubusercontent.com/12705538/250180782-925303ec-7751-4d7e-be8f-b3f1323f35d4.png "Figure 5: Snow cover fraction from MODIS (a,b), Regional UFS-based system (RRFS) original (c), and modified with isncover_opt=3 (d), 6 February 2022. (Courtesy of T.G. Smirnova)" width=900 +- Iterative snow melting algorithm; +- Density of snow on the ground - a function of compaction parameter and snow depth and temperature; +- Snow albedo - a function of temperature and snow fraction; +- Snow interception by canopy - a function of vegetation fraction and leaf area index (LAI); +- Density of falling snow/graupel/ice precipitation (Fig.6) - The density of falling snow/graupel/ice is computed inside RUC LSM using empirical temperature-dependent equations; - Averaged density of frozen precipitation is defined from weighted contribution of each hydrometeor species: \f[ \rho_{fr}=\rho_{sn}*\alpha_{sn}+\rho_{gr}*\alpha_{gr}+\rho_{ice}*\alpha_{ice} + \f] +Where subscripts sn, gr, ice - snow, graupel and ice precipitation, respectively. - The depth of new snow is defined from its liquid equivalent and \f$\rho_{fr}\f$ -\image html ruc_lsm_frozen_precip.png "Figure 4: HRRR 23-h forecasts of snow accumulation, valid 08 UTC, 29 Dec 2015 (Courtesy of T.G. Smirnova)" width=900 +\image html ruc_lsm_frozen_precip.png "Figure 6: HRRR 23-h forecasts of snow accumulation, valid 08 UTC, 29 Dec 2015 (Courtesy of T.G. Smirnova)" width=900 -snow accumulation with variable density is provided as an additional product in the model guidance. Figure 4 shows one example of this product +Snow accumulation with variable density is provided as an additional product in the model guidance. Figure 6 shows one example of this product from the 23-h HRRR forecast for snowstorm on 29 Dec 2015. This product is in the middle panel. The panel on the left uses traditional 10:1 ratio, -and the right panel is oberved snow accumulation. We can see that the new product in the middle here has a better, further north location of maximum -snow accumulation, and high ammounts of snow in the product with 10:1 ratio are trimmed in central and southern Iowa where both observed and model +and the right panel is observed snow accumulation. We can see that the new product in the middle here has a better, further north location of maximum +snow accumulation, and high amounts of snow in the product with 10:1 ratio are trimmed in central and southern Iowa where both observed and model precipitation had a high content of sleet. There is even larger improvement in the Chicago area, where observed and model precipitation were almost totally sleet. \section v6_updates_ruc Physics Updates -\version CCPP V6.0.0 +\version UFS-SRW v3.0.0 - Initialization of land and ice emissivity with consideration of partial snow cover - Initialization of land and ice albedo with consideration of partial snow cover - Initialization of water vapor mixing ratio over land and ice +- Initialization of fractions of soil and vegetation types in a grid cell - Changes in the computation of a flag for sea ice: it is set to true only if \p flag_cice = .false. (uncoupled sea ice model) - Introduced separate variables for sea ice, for example: \p showfallac is replaced with \p snowfallac_ice -- Added accomodation of fractional surface grid (land and ice fractions are possible within the grid cell) -- Introduced solar angle dependence of albedo for snow-free land -- Introduced a SPP option for stochastic perturbations for emissivity, albedo and vegetation fraction -- Bug fix in hydraulic conductivity +- Added accommodation of fractional surface grid (land and ice fractions are possible within the grid cell) +- Solar angle dependence of albedo for snow-free land +- SPP option for stochastic perturbations for emissivity, albedo and vegetation fraction - Based on RRFS testing, the coefficient in the soil resistance formulation (Sakaguchi and Zeng (2009) \cite sakaguchi_and_zeng_2009) -was increased from 0.5 to 0.7 to increase soil resistance to evaporation +was increased from 0.7 to 1.0 to increase soil resistance to evaporation \section intra_ruclsm Intraphysics Communication diff --git a/physics/docs/pdftxt/SRW_all_shemes_list.txt b/physics/docs/pdftxt/SRW_all_schemes_list.txt similarity index 66% rename from physics/docs/pdftxt/SRW_all_shemes_list.txt rename to physics/docs/pdftxt/SRW_all_schemes_list.txt index bb320008e..d9ef65315 100644 --- a/physics/docs/pdftxt/SRW_all_shemes_list.txt +++ b/physics/docs/pdftxt/SRW_all_schemes_list.txt @@ -16,6 +16,7 @@ The UFS-SRW App. assembles the parameterizations in suites. - \subpage GFS_NOAH - \subpage RUCLSM - \subpage NoahMP + - \subpage CLM_LAKE_model \b Cumulus \b Parameterizations - \subpage GFS_SAMFdeep @@ -67,21 +68,21 @@ 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. -The UFS Short Range Weather Application (SRW App) v2.1.0 supports four physicsphysics suites. +The UFS Short Range Weather Application (SRW App) v3.0.0 supports four physics suites. -Table 1. Physics suites and primary schemes supported in SRW v2.1.0 +Table 1. Physics suites and primary schemes supported in SRW v3.0.0 \tableofcontents -| Physics suites | GFS_v16 | HRRR | RRFS_v1beta | WoFS_v0 | -|------------------|--------------------|--------------------------------|--------------------|---------------| -|\b Deep \b Cu | \ref GFS_SAMFdeep | \a off | \a off | \a off | -|\b Shallow \b Cu | \ref GFS_SAMFshal | \ref MYNNEDMF | \ref MYNNEDMF | \ref MYNNEDMF | -|\b Microphysics | \ref GFDL_cloud | \ref THOMPSON | \ref THOMPSON | \ref NSSLMICRO_page | -|\b PBL/TURB | \ref GFS_SATMEDMFVDIFQ | \ref MYNNEDMF | \ref MYNNEDMF | \ref MYNNEDMF | -|\b Radiation | \ref GFS_RRTMG | \ref GFS_RRTMG | \ref GFS_RRTMG | \ref GFS_RRTMG | -|\b Surface \b Layer | \ref GFS_SFCLYR | \ref SFC_MYNNSFL | \ref SFC_MYNNSFL | \ref SFC_MYNNSFL | -|\b LSM | \ref GFS_NOAH | \ref RUCLSM | \ref NoahMP | \ref GFS_NOAH | -|\b Gravity \b Wave \b Drag| \ref GFS_UGWP_v0 | \ref GFS_drag_suite | \ref GFS_UGWP_v0 | \ref GFS_UGWP_v0 | -|\b Sea \b Ice | \ref GFS_SFCSICE | \ref RUCLSM | \ref GFS_SFCSICE | \ref GFS_SFCSICE | +| Physics suites | GFS_v16 | HRRR | RRFS_v1beta | WoFS_v0 | RAP | +|--------------------|--------------------|--------------------------------|--------------------|---------------|---------------| +|\b Deep \b Cu | \ref GFS_SAMFdeep | \a off | \a off | \a off | \ref CU_GF | +|\b Shallow \b Cu | \ref GFS_SAMFshal | \ref MYNNEDMF | \ref MYNNEDMF | \ref MYNNEDMF | \ref CU_GF | +|\b Microphysics | \ref GFDL_cloud | \ref THOMPSON | \ref THOMPSON | \ref NSSLMICRO_page | \ref THOMPSON| +|\b PBL/TURB | \ref GFS_SATMEDMFVDIFQ | \ref MYNNEDMF | \ref MYNNEDMF | \ref MYNNEDMF | \ref MYNNEDMF | +|\b Radiation | \ref GFS_RRTMG | \ref GFS_RRTMG | \ref GFS_RRTMG | \ref GFS_RRTMG | \ref GFS_RRTMG | +|\b Surface \b Layer | \ref GFS_SFCLYR | \ref SFC_MYNNSFL | \ref SFC_MYNNSFL | \ref SFC_MYNNSFL | \ref SFC_MYNNSFL | +|\b LSM | \ref GFS_NOAH | \ref RUCLSM and \ref CLM_LAKE_model | \ref NoahMP | \ref GFS_NOAH | \ref RUCLSM | +|\b Gravity \b Wave \b Drag| \ref GFS_UGWP_v0 | \ref GFS_drag_suite | \ref GFS_UGWP_v0 | \ref GFS_UGWP_v0 | \ref GFS_drag_suite | +|\b Ice and \b Snow | \ref GFS_SFCSICE | \ref RUCLSM | \ref GFS_SFCSICE | \ref GFS_SFCSICE | \ref RUCLSM | \tableofcontents diff --git a/physics/docs/pdftxt/SRW_mainpage.txt b/physics/docs/pdftxt/SRW_mainpage.txt index 154b1b0eb..1f756c3ff 100644 --- a/physics/docs/pdftxt/SRW_mainpage.txt +++ b/physics/docs/pdftxt/SRW_mainpage.txt @@ -1,15 +1,23 @@ /** \mainpage Introduction -Welcome to the scientific documentation for the physical parameterizations available in the Unified Forecast System (UFS) Short-Range Weather (SRW) Application version 2.1.0 (available through https://github.com/ufs-community/ufs-srweather-app/) and the suites that can be configured using them. The SRW app targets predictions of atmospheric behavior on a +Welcome to the scientific documentation for the physical parameterizations available in the Unified Forecast System (UFS) Short-Range Weather (SRW) Application version 3.0.0 (available through https://github.com/ufs-community/ufs-srweather-app/) and the suites that can be configured using them. The SRW App targets predictions of atmospheric behavior on a limited spatial domain and on time scales from less than an hour out to several days. -The CCPP parameterizations are aggregated in suites by the host models. In this release, the UFS Short-Range Weather Application 2.1.0 +The CCPP parameterizations are aggregated in suites by the host models. In this release, the UFS Short-Range Weather Application 3.0.0 supports suites: - \ref GFS_v16_page - \ref HRRR_suite_page - \ref RRFS_v1beta_page - \ref WoFS_v0_page +- \ref rap_suite_page +\attention Important note:
All supported suites are a recent snapshot of +the UFS fork for CCPP . In this regard, they may differ substantially from the suites used in operational models. For example, the GFS_v16 Suite is +not the same code as in the operational GFS v16. While the suite is nominally the same, using the same schemes as the operational version, most +of the individual physics schemes hosted in the CCPP repository have changed, including new development and bug fixes compared to the versions included +in GFS version 16.0, which was released on 22 March 2021. +This implication should be also applied to all other suites: RAP/HRRR suites in this release do not correspond directly to the +the evolving version of the RAP/HRRR physics in operations. */ diff --git a/physics/docs/pdftxt/THOMPSON.txt b/physics/docs/pdftxt/THOMPSON.txt index 60a873de9..914a95922 100644 --- a/physics/docs/pdftxt/THOMPSON.txt +++ b/physics/docs/pdftxt/THOMPSON.txt @@ -70,10 +70,8 @@ for the model to provide useful guidance for aircraft icing forecasts - Can account for cloud phase changes and provides a sound physical basis for diagnosing precipitation type reaching the ground -\section v6_enh_thompson CCPP Physics Updates -\version CCPP v6.0.0 -Three mechanisms are available improve the stability of the scheme for weather forecast applications: +Recently, three mechanisms have been implemented to improve the stability of the scheme for weather forecast applications: \a inner \a loop, \a subcycle, and \a semi-Lagrangian \a sedimentation \a of \a rain \a and \a graupel. The inner loop and the subcycle are similar in that the physics time step is subdivided and the scheme is activated more often than others in the physics suite. However, they differ in implementation. @@ -82,7 +80,17 @@ Conversely, the subcycle method is controlled by CCPP Framework through the "sub The two methods should be used exclusively. The Semi-Lagrangian sedimentation of rain and graupel (based on Juang and Hong 2010 \cite Henry_Juang_2010 ) increases numerical stability by applying the subtime step only to sedimentation computation. Two namelist variables control the usage of the semi-Lagrangian sedimentation, \p sedi_semi and \p decfl. -\p sedi_semi is set to ‘true’ to activate the method. Decfl is a parameter that needs to avoid deformation of the arriving grids, currently, "10". +\p sedi_semi is set to ‘true’ to activate the method. \p Decfl is a parameter that needs to avoid deformation of the arriving grids, currently, "10". + +\section v6_enh_thompson CCPP Physics Updates +\version UFS-SRW v3.0.0 + +- The ice generation supersaturation requirement for nonaerosol option is reduced from 0.25 to 0.15. The purpose is to generate more ice in +the upper level and reduce the OLR bias. + +- For the non-aerosol option of the scheme, the cloud number concentration is divided into two parts (over land and others). The number +concentration over the ocean is reduced to a smaller number (50/L) from its default (100/L). The purpose is to reduce the bias in surface +downward shortwave radiative flux off the coastal region including the Southeast Pacific. \section intra_thompson Intraphysics Communication - \ref arg_table_mp_thompson_run diff --git a/physics/docs/pdftxt/WoFS_v0_suite.txt b/physics/docs/pdftxt/WoFS_v0_suite.txt index 8259ab770..bf868a461 100644 --- a/physics/docs/pdftxt/WoFS_v0_suite.txt +++ b/physics/docs/pdftxt/WoFS_v0_suite.txt @@ -4,8 +4,9 @@ \section wofs_v0_suite_overview Overview The WoFS_v0 suite is targeted for use in the upcoming operational implementation -of the NOAA's Warn-on-Forecast System (WoFS). This suite is most applicable for -runs at 3-km resolution since it does not parameterize deep convection. +of the NOAA's Warn-on-Forecast System (WoFS) and for the RRFS ensemble. +This suite is most applicable for runs at <= 3-km resolution since it does +not parameterize deep convection. The WoFS suite uses the parameterizations in the following order: - \ref SGSCLOUD_page diff --git a/physics/docs/pdftxt/all_shemes_list.txt b/physics/docs/pdftxt/all_schemes_list.txt similarity index 100% rename from physics/docs/pdftxt/all_shemes_list.txt rename to physics/docs/pdftxt/all_schemes_list.txt diff --git a/physics/docs/pdftxt/suite_input.nml.txt b/physics/docs/pdftxt/suite_input.nml.txt index be3785b74..c4bb5003b 100644 --- a/physics/docs/pdftxt/suite_input.nml.txt +++ b/physics/docs/pdftxt/suite_input.nml.txt @@ -50,11 +50,11 @@ show some variables in the namelist that must match the SDF. do_sfcperts gfs_rrtmg_pre flag for stochastic surface perturbations option .false. imp_physics choice of microphysics scheme choice of microphysics scheme: \n 99 \b Parameters \b related \b to \b radiation \b scheme \b options @@ -222,10 +222,13 @@ show some variables in the namelist that must match the SDF. xkzm_h \ref satmedmfvdifq background vertical diffusion for heat and q 1.0d0 xkzm_m \ref satmedmfvdifq background vertical diffusion for momentum 1.0d0 xkzm_s \ref satmedmfvdifq sigma threshold for background mom. diffusion 1.0d0 -dspfac \ref satmedmfvdifq TKE dissipative heating factor 1.0 +dspfac \ref satmedmfvdifq TKE dissipative heating factor 1.0 bl_upfr \ref satmedmfvdifq updraft fraction in boundary layer mass flux scheme 0.13 bl_dnfr \ref satmedmfvdifq downdraft fraction in boundary layer mass flux scheme 0.1 -grav_settling mynnedmf_wrapper flag to activate gravitational settling of cloud droplets as described in Nakanishi (2000) \cite nakanishi_2000 0 +rlmx \ref satmedmfvdifq maximum allowed mixing length in boundary layer mass flux scheme 300. +elmx \ref satmedmfvdifq maximum allowed dissipation mixing length in boundary layer mass flux scheme 300. +sfc_rlm \ref satmedmfvdifq choice of near surface mixing lenghth in boundary layer mass flux scheme 0 +tc_pbl \ref satmedmfvdifq control for TC applications in the PBL scheme 0 bl_mynn_mixlength mynnedmf_wrapper flag for different version of mixing length formulation \n .false. -bl_mynn_tkebudget mynnedmf_wrapper flag to activate TKE budget 0 +tke_budget mynnedmf_wrapper flag to activating TKE budget 0 bl_mynn_cloudpdf mynnedmf_wrapper flag to determine which cloud PDF to use \n 2 isot lsm_noah, lsm_ruc, \ref noahmpdrv flag for soil type dataset choice:\n 0 - +exticeden lsm_noah,lsm_ruc flag for calculating frozen precip ice density outside of the LSM .false. iopt_dveg \ref noahmpdrv options for dynamic vegetation \n 1 iopt_trs \ref noahmpdrv options for thermal roughness scheme:\n - - 2 + + 2 +mosaic_lu \ref lsm_ruc control for use of fractional landuse in RUC land surface model + + 0 +mosaic_soil \ref lsm_ruc control for use of fractional soil in RUC land surface model + + 0 +isncond_opt \ref lsm_ruc control for soil thermal conductivity option in RUC land surface model + + 1 +isncovr_opt \ref lsm_ruc control for snow cover fraction option in RUC land surface model + + 1 \b Parameters \b related \b to \b other \b surface \b scheme \b options +lkm \ref clm_lake 0: no lake; 1: lake; 2: lake&nsst 0 +iopt_lake \ref clm_lake 1: flake; 2: CLM lake 2 +lakedepth_threshold \ref clm_lake lakedepth must be greater than this value to enable a lake model 1.0 +lakefrac_threshold \ref clm_lake lakefrac must be greater than this value to enable a lake model 0.0 +use_lake2m \ref clm_lake use 2m T&Q from CLM lake model .false. nstf_name(5) sfc_nst NSST related paramters:\n