diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_ccpp_suite_sim_pre.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_ccpp_suite_sim_pre.F90 index fbaf5a1d9..2c276ca8c 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_ccpp_suite_sim_pre.F90 +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_ccpp_suite_sim_pre.F90 @@ -1,3 +1,6 @@ +!>\file GFS_ccpp_suite_sim_pre.F90 +!! Interstitial CCPP suite to couple UFS physics to CCPP suite simulator. + ! ######################################################################################## ! ! Description: Interstitial CCPP suite to couple UFS physics to ccpp_suite_simulator. @@ -22,7 +25,7 @@ module GFS_ccpp_suite_sim_pre ! SUBROUTINE GFS_ccpp_suite_sim_pre_run ! ! ###################################################################################### -!! \section arg_table_GFS_ccpp_suite_sim_pre_run +!> \section arg_table_GFS_ccpp_suite_sim_pre_run !! \htmlinclude GFS_ccpp_suite_sim_pre_run.html !! subroutine GFS_ccpp_suite_sim_pre_run(do_ccpp_suite_sim, dtend, ntqv, dtidx, dtp, & @@ -110,6 +113,7 @@ subroutine GFS_ccpp_suite_sim_pre_run(do_ccpp_suite_sim, dtend, ntqv, dtidx, dtp end subroutine GFS_ccpp_suite_sim_pre_run ! ###################################################################################### +!> subroutine load_ccpp_suite_sim(nlunit, nml_file, physics_process, iactive_T, & iactive_u, iactive_v, iactive_q, errmsg, errflg) diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/ccpp_suite_simulator.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/ccpp_suite_simulator.F90 index c1592263d..6a706456c 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/ccpp_suite_simulator.F90 +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/ccpp_suite_simulator.F90 @@ -1,20 +1,19 @@ -! ######################################################################################## -! -! Description: This suite simulates the evolution of the internal physics state -! represented by a CCPP Suite Definition File (SDF). -! -! To activate this suite it must be a) embedded within the SDF and b) activated through -! the physics namelist. -! The derived-data type "base_physics_process" contains the metadata needed to reconstruct -! the temporal evolution of the state. An array of base_physics_process, physics_process, -! is populated by the host during initialization and passed to the physics. Additionally, -! this type holds any data, or type-bound procedures, required by the suite simulator(s). -! -! For this initial demonstration we are using 2-dimensional (height, time) forcing data, -! which is on the same native vertical grid as the SCM. The dataset has a temporal -! resolution of 1-hour, created by averaging all local times from a Tropical Warm Pool -! International Cloud Experiment (TWPICE) case. This was to create a dataset with a -! (constant) diurnal cycle. +!>\file ccpp_suite_simulator.F90 +!! Description: This suite simulates the evolution of the internal physics state +!! represented by a CCPP Suite Definition File (SDF). +!! +!! To activate this suite it must be a) embedded within the SDF and b) activated through +!! the physics namelist. +!! The derived-data type "base_physics_process" contains the metadata needed to reconstruct +!! the temporal evolution of the state. An array of base_physics_process, physics_process, +!! is populated by the host during initialization and passed to the physics. Additionally, +!! this type holds any data, or type-bound procedures, required by the suite simulator(s). +!! +!! For this initial demonstration we are using 2-dimensional (height, time) forcing data, +!! which is on the same native vertical grid as the SCM. The dataset has a temporal +!! resolution of 1-hour, created by averaging all local times from a Tropical Warm Pool +!! International Cloud Experiment (TWPICE) case. This was to create a dataset with a +!! (constant) diurnal cycle. ! ! ######################################################################################## module ccpp_suite_simulator diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/module_ccpp_suite_simulator.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/module_ccpp_suite_simulator.F90 index c4f9fc4e4..e8a4188d3 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/module_ccpp_suite_simulator.F90 +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/module_ccpp_suite_simulator.F90 @@ -1,19 +1,15 @@ -! ######################################################################################## -! -! This module contains the type, base_physics_process, and supporting subroutines needed -! by the ccpp suite simulator. -! -! ######################################################################################## +!>\file module_ccpp_suite_simulator.F90 +!! This module contains the type, base_physics_process, and supporting subroutines needed +!! by the ccpp suite simulator. + module module_ccpp_suite_simulator -!> \section arg_table_module_ccpp_suite_simulator Argument table -!! \htmlinclude module_ccpp_suite_simulator.html -!! + use machine, only : kind_phys implicit none public base_physics_process - ! Type containing 1D (time) physics tendencies. +!> Type containing 1D (time) physics tendencies. type phys_tend_1d real(kind_phys), dimension(:), allocatable :: T real(kind_phys), dimension(:), allocatable :: u @@ -23,7 +19,7 @@ module module_ccpp_suite_simulator real(kind_phys), dimension(:), allocatable :: z end type phys_tend_1d - ! Type containing 2D (lev,time) physics tendencies. +!> Type containing 2D (lev,time) physics tendencies. type phys_tend_2d real(kind_phys), dimension(:), allocatable :: time real(kind_phys), dimension(:,:), allocatable :: T @@ -45,7 +41,7 @@ module module_ccpp_suite_simulator real(kind_phys), dimension(:,:,:), allocatable :: q end type phys_tend_3d - ! Type containing 4D (lon,lat,lev,time) physics tendencies. +!> Type containing 4D (lon,lat,lev,time) physics tendencies. type phys_tend_4d real(kind_phys), dimension(:), allocatable :: time real(kind_phys), dimension(:,:), allocatable :: lon @@ -56,24 +52,20 @@ module module_ccpp_suite_simulator real(kind_phys), dimension(:,:,:,:), allocatable :: q end type phys_tend_4d -! This type contains the meta information and data for each physics process. - -!> \section arg_table_base_physics_process Argument Table -!! \htmlinclude base_physics_process.html -!! +!> This type contains the meta information and data for each physics process. type base_physics_process - character(len=16) :: name ! Physics process name - logical :: time_split = .false. ! Is process time-split? - logical :: use_sim = .false. ! Is process "active"? - integer :: order ! Order of process in process-loop - type(phys_tend_1d) :: tend1d ! Instantaneous data - type(phys_tend_2d) :: tend2d ! 2-dimensional data - type(phys_tend_3d) :: tend3d ! Not used. Placeholder for 3-dimensional spatial data. - type(phys_tend_4d) :: tend4d ! Not used. Placeholder for 4-dimensional spatio-tempo data. - character(len=16) :: active_name ! "Active" scheme: Physics process name - integer :: iactive_scheme ! "Active" scheme: Order of process in process-loop - logical :: active_tsp ! "Active" scheme: Is process time-split? - integer :: nprg_active ! "Active" scheme: Number of prognostic variables + character(len=16) :: name !< Physics process name + logical :: time_split = .false. !< Is process time-split? + logical :: use_sim = .false. !< Is process "active"? + integer :: order !< Order of process in process-loop + type(phys_tend_1d) :: tend1d !< Instantaneous data + type(phys_tend_2d) :: tend2d !< 2-dimensional data + type(phys_tend_3d) :: tend3d !< Not used. Placeholder for 3-dimensional spatial data. + type(phys_tend_4d) :: tend4d !< Not used. Placeholder for 4-dimensional spatio-tempo data. + character(len=16) :: active_name !< "Active" scheme: Physics process name + integer :: iactive_scheme !< "Active" scheme: Order of process in process-loop + logical :: active_tsp !< "Active" scheme: Is process time-split? + integer :: nprg_active !< "Active" scheme: Number of prognostic variables contains generic, public :: linterp => linterp_1D, linterp_2D procedure, private :: linterp_1D @@ -84,11 +76,8 @@ module module_ccpp_suite_simulator contains - ! #################################################################################### - ! Type-bound procedure to compute tendency profile for time-of-day. - ! - ! For use with 1D data (level, time) tendencies with diurnal (24-hr) forcing. - ! #################################################################################### +!> Type-bound procedure to compute tendency profile for time-of-day. +!! For use with 1D data (level, time) tendencies with diurnal (24-hr) forcing. function linterp_1D(this, var_name, year, month, day, hour, min, sec) result(err_message) class(base_physics_process), intent(inout) :: this character(len=*), intent(in) :: var_name @@ -131,13 +120,10 @@ function linterp_1D(this, var_name, year, month, day, hour, min, sec) result(err end function linterp_1D - ! #################################################################################### - ! Type-bound procedure to compute tendency profile for time-of-day. - ! - ! For use with 2D data (location, level, time) tendencies with diurnal (24-hr) forcing. - ! This assumes that the location dimension has a [longitude, latitude] allocated with - ! each location. - ! #################################################################################### +!> Type-bound procedure to compute tendency profile for time-of-day. +!! For use with 2D data (location, level, time) tendencies with diurnal (24-hr) forcing. +!! This assumes that the location dimension has a [longitude, latitude] allocated with +!! each location. function linterp_2D(this, var_name, lon, lat, year, month, day, hour, min, sec) result(err_message) class(base_physics_process), intent(inout) :: this character(len=*), intent(in) :: var_name @@ -165,10 +151,8 @@ function linterp_2D(this, var_name, lon, lat, year, month, day, hour, min, sec) end select end function linterp_2D - ! #################################################################################### - ! Type-bound procedure to find nearest location. - ! For use with linterp_2D, NOT YET IMPLEMENTED. - ! #################################################################################### +!> Type-bound procedure to find nearest location. +!! For use with linterp_2D, NOT YET IMPLEMENTED. pure function find_nearest_loc_2d_1d(this, lon, lat) class(base_physics_process), intent(in) :: this real(kind_phys), intent(in) :: lon, lat @@ -177,10 +161,8 @@ pure function find_nearest_loc_2d_1d(this, lon, lat) find_nearest_loc_2d_1d = 1 end function find_nearest_loc_2d_1d - ! #################################################################################### - ! Type-bound procedure to compute linear interpolation weights for a diurnal (24-hour) - ! forcing. - ! #################################################################################### +!> Type-bound procedure to compute linear interpolation weights for a diurnal (24-hour) +!! forcing. subroutine cmp_time_wts(this, year, month, day, hour, minute, sec, w1, w2, ti, tf) ! Inputs class(base_physics_process), intent(in) :: this @@ -199,8 +181,7 @@ subroutine cmp_time_wts(this, year, month, day, hour, minute, sec, w1, w2, ti, t end subroutine cmp_time_wts - ! #################################################################################### - ! #################################################################################### +!> subroutine sim_LWRAD( year, month, day, hour, min, sec, process) type(base_physics_process), intent(inout) :: process integer, intent(in) :: year, month, day, hour, min, sec @@ -212,8 +193,7 @@ subroutine sim_LWRAD( year, month, day, hour, min, sec, process) end subroutine sim_LWRAD - ! #################################################################################### - ! #################################################################################### +!> subroutine sim_SWRAD( year, month, day, hour, min, sec, process) type(base_physics_process), intent(inout) :: process integer, intent(in) :: year, month, day, hour, min, sec @@ -225,8 +205,7 @@ subroutine sim_SWRAD( year, month, day, hour, min, sec, process) end subroutine sim_SWRAD - ! #################################################################################### - ! #################################################################################### +!> subroutine sim_GWD( year, month, day, hour, min, sec, process) type(base_physics_process), intent(inout) :: process integer, intent(in) :: year, month, day, hour, min, sec @@ -244,8 +223,7 @@ subroutine sim_GWD( year, month, day, hour, min, sec, process) end subroutine sim_GWD - ! #################################################################################### - ! #################################################################################### +!> subroutine sim_PBL( year, month, day, hour, min, sec, process) type(base_physics_process), intent(inout) :: process integer, intent(in) :: year, month, day, hour, min, sec @@ -266,8 +244,7 @@ subroutine sim_PBL( year, month, day, hour, min, sec, process) end subroutine sim_PBL - ! #################################################################################### - ! #################################################################################### +!> subroutine sim_DCNV( year, month, day, hour, min, sec, process) type(base_physics_process), intent(inout) :: process integer, intent(in) :: year, month, day, hour, min, sec @@ -288,8 +265,7 @@ subroutine sim_DCNV( year, month, day, hour, min, sec, process) end subroutine sim_DCNV - ! #################################################################################### - ! #################################################################################### +!> subroutine sim_SCNV( year, month, day, hour, min, sec, process) type(base_physics_process), intent(inout) :: process integer, intent(in) :: year, month, day, hour, min, sec @@ -310,8 +286,7 @@ subroutine sim_SCNV( year, month, day, hour, min, sec, process) end subroutine sim_SCNV - ! #################################################################################### - ! #################################################################################### +!> subroutine sim_cldMP( year, month, day, hour, min, sec, process) type(base_physics_process), intent(inout) :: process integer, intent(in) :: year, month, day, hour, min, sec diff --git a/physics/Radiation/RRTMG/iounitdef.f b/physics/Radiation/RRTMG/iounitdef.f index c6a4e591f..af3a700b8 100644 --- a/physics/Radiation/RRTMG/iounitdef.f +++ b/physics/Radiation/RRTMG/iounitdef.f @@ -1,3 +1,7 @@ +!>\file iounitdef.f +!! This file defines fortran unit numbers for input/output data +!! files for the NCEP GFS model. + !!!!! ========================================================== !!!!! !!!!! module "module_iounitdef description !!!!! !!!!! ========================================================== !!!!! diff --git a/physics/Radiation/RRTMG/module_bfmicrophysics.f b/physics/Radiation/RRTMG/module_bfmicrophysics.f index caff7fc61..6285653d2 100644 --- a/physics/Radiation/RRTMG/module_bfmicrophysics.f +++ b/physics/Radiation/RRTMG/module_bfmicrophysics.f @@ -1,5 +1,5 @@ -!>\file module_bfmicrophysics.f This file contains some subroutines used -!! in microphysics. +!>\file module_bfmicrophysics.f +!!This file contains some subroutines used in microphysics. !> This module contains some subroutines used in microphysics. MODULE module_microphysics diff --git a/physics/Radiation/RRTMG/rad_sw_pre.F90 b/physics/Radiation/RRTMG/rad_sw_pre.F90 index b7c3faf4c..83a0385a8 100644 --- a/physics/Radiation/RRTMG/rad_sw_pre.F90 +++ b/physics/Radiation/RRTMG/rad_sw_pre.F90 @@ -1,12 +1,11 @@ !>\file rad_sw_pre.F90 !! This file gathers the sunlit points for the shortwave radiation schemes. +!> This module gathers the sunlit points for the shortwave radiation schemes. module rad_sw_pre contains -!> \defgroup rad_sw_pre GFS Radiation-SW Pre -!! This module gathers the sunlit points for the shortwave radiation schemes. -!> @{ + !> \section arg_table_rad_sw_pre_run Argument Table !! \htmlinclude rad_sw_pre_run.html !! @@ -49,5 +48,4 @@ subroutine rad_sw_pre_run (im, lsswr, coszen, nday, idxday, errmsg, errflg) endif end subroutine rad_sw_pre_run -!> @} end module rad_sw_pre diff --git a/physics/Radiation/RRTMG/radcons.f90 b/physics/Radiation/RRTMG/radcons.f90 index 0ca7eeb19..decf79990 100644 --- a/physics/Radiation/RRTMG/radcons.f90 +++ b/physics/Radiation/RRTMG/radcons.f90 @@ -2,10 +2,6 @@ !! This file contains module radcons. -!> \defgroup radcons GFS RRTMG Constants Module -!> This module contains some of the most frequently used math and physics -!! constants for RRTMG. - !> This module contains some of the most frequently used math and physics !! constants for RRTMG. module radcons diff --git a/physics/Radiation/RRTMG/rrtmg_lw_cloud_optics.F90 b/physics/Radiation/RRTMG/rrtmg_lw_cloud_optics.F90 index 1dd225514..7477a498e 100644 --- a/physics/Radiation/RRTMG/rrtmg_lw_cloud_optics.F90 +++ b/physics/Radiation/RRTMG/rrtmg_lw_cloud_optics.F90 @@ -1,3 +1,6 @@ +!>\file rrtmg_lw_cloud_optics.F90 +!! + module mo_rrtmg_lw_cloud_optics use machine, only: kind_phys use mersenne_twister, only: random_setseed, random_number, random_stat diff --git a/physics/Radiation/RRTMGP/rrtmgp_lw_main.F90 b/physics/Radiation/RRTMGP/rrtmgp_lw_main.F90 index 39792eab7..2e22476d4 100644 --- a/physics/Radiation/RRTMGP/rrtmgp_lw_main.F90 +++ b/physics/Radiation/RRTMGP/rrtmgp_lw_main.F90 @@ -1,7 +1,6 @@ !> \file rrtmgp_lw_main.F90 !! This file contains the longwave RRTMGP radiation scheme. !! -! ########################################################################################### module rrtmgp_lw_main use mpi_f08 use machine, only: kind_phys, kind_dbl_prec @@ -25,15 +24,10 @@ module rrtmgp_lw_main public rrtmgp_lw_main_init, rrtmgp_lw_main_run contains -!! \section arg_table_rrtmgp_lw_main_init + +!> \section arg_table_rrtmgp_lw_main_init Argument Table !! \htmlinclude rrtmgp_lw_main_int.html !! -!> \ingroup rrtmgp_lw_main -!! -!! \brief -!! -!! \section rrtmgp_lw_main_init -!> @{ subroutine rrtmgp_lw_main_init(rrtmgp_root_dir, rrtmgp_lw_file_gas, rrtmgp_lw_file_clouds,& active_gases_array, doGP_cldoptics_PADE, doGP_cldoptics_LUT, doGP_sgs_pbl, & doGP_sgs_cnv, nrghice, mpicomm, mpirank, mpiroot, nLay, rrtmgp_phys_blksz, & @@ -41,33 +35,33 @@ subroutine rrtmgp_lw_main_init(rrtmgp_root_dir, rrtmgp_lw_file_gas, rrtmgp_lw_fi ! Inputs character(len=128),intent(in) :: & - rrtmgp_root_dir, & ! RTE-RRTMGP root directory - rrtmgp_lw_file_clouds, & ! RRTMGP file containing coefficients used to compute - ! clouds optical properties - rrtmgp_lw_file_gas ! RRTMGP file containing coefficients used to compute - ! gaseous optical properties + rrtmgp_root_dir, & !< RTE-RRTMGP root directory + rrtmgp_lw_file_clouds, & !< RRTMGP file containing coefficients used to compute + !< clouds optical properties + rrtmgp_lw_file_gas !< RRTMGP file containing coefficients used to compute + !! gaseous optical properties character(len=*), dimension(:), intent(in) :: & - active_gases_array ! List of active gases from namelist as array) + active_gases_array !< List of active gases from namelist as array) logical, intent(in) :: & - doGP_cldoptics_PADE, & ! Use RRTMGP cloud-optics: PADE approximation? - doGP_cldoptics_LUT, & ! Use RRTMGP cloud-optics: LUTs? - doGP_sgs_pbl, & ! Flag to include sgs PBL clouds - doGP_sgs_cnv ! Flag to include sgs convective clouds + doGP_cldoptics_PADE, & !< Use RRTMGP cloud-optics: PADE approximation? + doGP_cldoptics_LUT, & !< Use RRTMGP cloud-optics: LUTs? + doGP_sgs_pbl, & !< Flag to include sgs PBL clouds + doGP_sgs_cnv !< Flag to include sgs convective clouds integer, intent(inout) :: & - nrghice ! Number of ice-roughness categories + nrghice !< Number of ice-roughness categories type(MPI_Comm),intent(in) :: & - mpicomm ! MPI communicator + mpicomm !< MPI communicator integer,intent(in) :: & - mpirank, & ! Current MPI rank - mpiroot, & ! Master MPI rank - rrtmgp_phys_blksz, & ! Number of horizontal points to process at once. + mpirank, & !< Current MPI rank + mpiroot, & !< Master MPI rank + rrtmgp_phys_blksz, & !< Number of horizontal points to process at once. nLay ! Outputs character(len=*), intent(out) :: & - errmsg ! CCPP error message + errmsg !< CCPP error message integer, intent(out) :: & - errflg ! CCPP error code + errflg !< CCPP error code ! Initialize CCPP error handling variables errmsg = '' @@ -83,18 +77,10 @@ subroutine rrtmgp_lw_main_init(rrtmgp_root_dir, rrtmgp_lw_file_gas, rrtmgp_lw_fi errmsg, errflg) end subroutine rrtmgp_lw_main_init -!> @} - ! ###################################################################################### -!! \section arg_table_rrtmgp_lw_main_run + +!> \section arg_table_rrtmgp_lw_main_run Argument Table !! \htmlinclude rrtmgp_lw_main_run.html !! -!> \ingroup rrtmgp_lw_main -!! -!! \brief -!! -!! \section rrtmgp_lw_main_run -!> @{ - ! ###################################################################################### subroutine rrtmgp_lw_main_run(doLWrad, doLWclrsky, top_at_1, doGP_lwscat, & use_LW_jacobian, doGP_sgs_cnv, doGP_sgs_pbl, nCol, nLay, nGases,rrtmgp_phys_blksz,& nGauss_angles, icseed_lw, iovr, iovr_convcld, iovr_max, iovr_maxrand, iovr_rand, & @@ -109,83 +95,83 @@ subroutine rrtmgp_lw_main_run(doLWrad, doLWclrsky, top_at_1, doGP_lwscat, ! Inputs logical, intent(in) :: & - doLWrad, & ! Flag to perform longwave calculation - doLWclrsky, & ! Flag to compute clear-sky fluxes - top_at_1, & ! Flag for vertical ordering convention - use_LW_jacobian, & ! Flag to compute Jacobian of longwave surface flux - doGP_sgs_pbl, & ! Flag to include sgs PBL clouds - doGP_sgs_cnv, & ! Flag to include sgs convective clouds - doGP_lwscat ! Flag to include scattering in clouds + doLWrad, & !< Flag to perform longwave calculation + doLWclrsky, & !< Flag to compute clear-sky fluxes + top_at_1, & !< Flag for vertical ordering convention + use_LW_jacobian, & !< Flag to compute Jacobian of longwave surface flux + doGP_sgs_pbl, & !< Flag to include sgs PBL clouds + doGP_sgs_cnv, & !< Flag to include sgs convective clouds + doGP_lwscat !< Flag to include scattering in clouds integer,intent(in) :: & - nCol, & ! Number of horizontal points - nLay, & ! Number of vertical grid points. - nGases, & ! Number of active gases - rrtmgp_phys_blksz, & ! Number of horizontal points to process at once. - nGauss_angles, & ! Number of gaussian quadrature angles used - iovr, & ! Choice of cloud-overlap method - iovr_convcld, & ! Choice of convective cloud-overlap - iovr_max, & ! Flag for maximum cloud overlap method - iovr_maxrand, & ! Flag for maximum-random cloud overlap method - iovr_rand, & ! Flag for random cloud overlap method - iovr_dcorr, & ! Flag for decorrelation-length cloud overlap method - iovr_exp, & ! Flag for exponential cloud overlap method - iovr_exprand, & ! Flag for exponential-random cloud overlap method - isubc_lw ! Flag for cloud-seeding (rng) for cloud-sampling + nCol, & !< Number of horizontal points + nLay, & !< Number of vertical grid points. + nGases, & !< Number of active gases + rrtmgp_phys_blksz, & !< Number of horizontal points to process at once. + nGauss_angles, & !< Number of gaussian quadrature angles used + iovr, & !< Choice of cloud-overlap method + iovr_convcld, & !< Choice of convective cloud-overlap + iovr_max, & !< Flag for maximum cloud overlap method + iovr_maxrand, & !< Flag for maximum-random cloud overlap method + iovr_rand, & !< Flag for random cloud overlap method + iovr_dcorr, & !< Flag for decorrelation-length cloud overlap method + iovr_exp, & !< Flag for exponential cloud overlap method + iovr_exprand, & !< Flag for exponential-random cloud overlap method + isubc_lw !< Flag for cloud-seeding (rng) for cloud-sampling integer,intent(in),dimension(:) :: & - icseed_lw ! Seed for random number generation for longwave radiation + icseed_lw !< Seed for random number generation for longwave radiation real(kind_phys), dimension(:), intent(in) :: & - semis, & ! Surface-emissivity (1) - tsfg ! Skin temperature (K) + semis, & !< Surface-emissivity (1) + tsfg !< Skin temperature (K) real(kind_phys), dimension(:,:), intent(in) :: & - p_lay, & ! Pressure @ model layer-centers (Pa) - t_lay, & ! Temperature (K) - p_lev, & ! Pressure @ model layer-interfaces (Pa) - t_lev, & ! Temperature @ model levels (K) - vmr_o2, & ! Molar-mixing ratio oxygen - vmr_h2o, & ! Molar-mixing ratio water vapor - 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 - cld_frac, & ! Cloud-fraction for stratiform clouds - cld_lwp, & ! Water path for stratiform liquid cloud-particles - cld_reliq, & ! Effective radius for stratiform liquid cloud-particles - cld_iwp, & ! Water path for stratiform ice cloud-particles - cld_reice, & ! Effective radius for stratiform ice cloud-particles - cld_swp, & ! Water path for snow hydrometeors - cld_resnow, & ! Effective radius for snow hydrometeors - cld_rwp, & ! Water path for rain hydrometeors - cld_rerain, & ! Effective radius for rain hydrometeors - precip_frac, & ! Precipitation fraction (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 - cld_cnv_iwp, & ! Water path for convective ice cloud-particles - cld_cnv_reice, & ! Effective radius for convective ice cloud-particles - cld_pbl_lwp, & ! Water path for PBL liquid cloud-particles - cld_pbl_reliq, & ! Effective radius for PBL liquid cloud-particles - cld_pbl_iwp, & ! Water path for PBL ice cloud-particles - cld_pbl_reice, & ! Effective radius for PBL ice cloud-particles - cloud_overlap_param ! Cloud overlap parameter + p_lay, & !< Pressure @ model layer-centers (Pa) + t_lay, & !< Temperature (K) + p_lev, & !< Pressure @ model layer-interfaces (Pa) + t_lev, & !< Temperature @ model levels (K) + vmr_o2, & !< Molar-mixing ratio oxygen + vmr_h2o, & !< Molar-mixing ratio water vapor + 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 + cld_frac, & !< Cloud-fraction for stratiform clouds + cld_lwp, & !< Water path for stratiform liquid cloud-particles + cld_reliq, & !< Effective radius for stratiform liquid cloud-particles + cld_iwp, & !< Water path for stratiform ice cloud-particles + cld_reice, & !< Effective radius for stratiform ice cloud-particles + cld_swp, & !< Water path for snow hydrometeors + cld_resnow, & !< Effective radius for snow hydrometeors + cld_rwp, & !< Water path for rain hydrometeors + cld_rerain, & !< Effective radius for rain hydrometeors + precip_frac, & !< Precipitation fraction (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 + cld_cnv_iwp, & !< Water path for convective ice cloud-particles + cld_cnv_reice, & !< Effective radius for convective ice cloud-particles + cld_pbl_lwp, & !< Water path for PBL liquid cloud-particles + cld_pbl_reliq, & !< Effective radius for PBL liquid cloud-particles + cld_pbl_iwp, & !< Water path for PBL ice cloud-particles + cld_pbl_reice, & !< Effective radius for PBL ice cloud-particles + cloud_overlap_param !< Cloud overlap parameter real(kind_phys), dimension(:,:,:), intent(in) :: & - aerlw_tau, & ! Aerosol optical depth - aerlw_ssa, & ! Aerosol single scattering albedo - aerlw_g ! Aerosol asymmetry paramter + aerlw_tau, & !< Aerosol optical depth + aerlw_ssa, & !< Aerosol single scattering albedo + aerlw_g !< Aerosol asymmetry paramter character(len=*), dimension(:), intent(in) :: & - active_gases_array ! List of active gases from namelist as array + active_gases_array !< List of active gases from namelist as array ! Outputs real(kind_phys), dimension(:,:), intent(inout) :: & - fluxlwUP_jac, & ! Jacobian of upwelling LW surface radiation (W/m2/K) - fluxlwUP_allsky, & ! All-sky flux (W/m2) - fluxlwDOWN_allsky, & ! All-sky flux (W/m2) - fluxlwUP_clrsky, & ! Clear-sky flux (W/m2) - fluxlwDOWN_clrsky, & ! All-sky flux (W/m2) - fluxlwUP_radtime, & ! Copy of fluxes (Used for coupling) - fluxlwDOWN_radtime ! + fluxlwUP_jac, & !< Jacobian of upwelling LW surface radiation (W/m2/K) + fluxlwUP_allsky, & !< All-sky flux (W/m2) + fluxlwDOWN_allsky, & !< All-sky flux (W/m2) + fluxlwUP_clrsky, & !< Clear-sky flux (W/m2) + fluxlwDOWN_clrsky, & !< All-sky flux (W/m2) + fluxlwUP_radtime, & !< Copy of fluxes (Used for coupling) + fluxlwDOWN_radtime !< character(len=*), intent(out) :: & - errmsg ! CCPP error message + errmsg !< CCPP error message integer, intent(out) :: & - errflg ! CCPP error flag + errflg !< CCPP error flag ! Local variables type(ty_fluxes_byband) :: flux_allsky, flux_clrsky @@ -605,5 +591,4 @@ subroutine rrtmgp_lw_main_run(doLWrad, doLWclrsky, top_at_1, doGP_lwscat, enddo end subroutine rrtmgp_lw_main_run -!> @} end module rrtmgp_lw_main diff --git a/physics/Radiation/RRTMGP/rrtmgp_sw_gas_optics.F90 b/physics/Radiation/RRTMGP/rrtmgp_sw_gas_optics.F90 index 5713d188d..3229d2f16 100644 --- a/physics/Radiation/RRTMGP/rrtmgp_sw_gas_optics.F90 +++ b/physics/Radiation/RRTMGP/rrtmgp_sw_gas_optics.F90 @@ -1,10 +1,7 @@ !> \file rrtmgp_sw_gas_optics.F90 -!! -!> \defgroup rrtmgp_sw_gas_optics rrtmgp_sw_gas_optics.F90 -!! -!! \brief This module contains a routine to initialize the k-distribution data used +!! This module contains a routine to initialize the k-distribution data used !! by the RRTMGP shortwave radiation scheme. -!! + module rrtmgp_sw_gas_optics use machine, only: kind_phys use mo_rte_kind, only: wl @@ -79,43 +76,34 @@ module rrtmgp_sw_gas_optics scale_by_complement_upperSW ! Absorption is scaled by concentration of scaling_gas (F) or its complement (T) contains - ! ###################################################################################### -!>\defgroup rrtmgp_sw_gas_optics_mod GFS RRTMGP-SW Gas Optics Module -!> @{ -!! \section arg_table_rrtmgp_sw_gas_optics_init +!> \section arg_table_rrtmgp_sw_gas_optics_init Argument Table !! \htmlinclude rrtmgp_sw_gas_optics.html !! -!> \ingroup rrtmgp_sw_gas_optics -!! !! RRTMGP relies heavility on derived-data-types, which contain type-bound procedures !! that are referenced frequently throughout the RRTMGP shortwave scheme. The data needed !! for the correlated k-distribution is also contained within this type. Within this module, !! the full k-distribution data is read in, reduced by the "active gases" provided, and !! loaded into the RRTMGP DDT, ty_gas_optics_rrtmgp. -!! -!! \section rrtmgp_sw_gas_optics_init -!> @{ - ! ###################################################################################### subroutine rrtmgp_sw_gas_optics_init(rrtmgp_root_dir, rrtmgp_sw_file_gas, & active_gases_array, mpicomm, mpirank, mpiroot, errmsg, errflg) ! Inputs character(len=128),intent(in) :: & - rrtmgp_root_dir, & ! RTE-RRTMGP root directory - rrtmgp_sw_file_gas ! RRTMGP file containing K-distribution data + rrtmgp_root_dir, & !< RTE-RRTMGP root directory + rrtmgp_sw_file_gas !< RRTMGP file containing K-distribution data character(len=*), dimension(:), intent(in) :: & - active_gases_array ! List of active gases from namelist as array + active_gases_array !< List of active gases from namelist as array type(MPI_Comm),intent(in) :: & - mpicomm ! MPI communicator + mpicomm !< MPI communicator integer,intent(in) :: & - mpirank, & ! Current MPI rank - mpiroot ! Master MPI rank + mpirank, & !< Current MPI rank + mpiroot !< Master MPI rank ! Outputs character(len=*), intent(out) :: & - errmsg ! CCPP error message + errmsg !< CCPP error message integer, intent(out) :: & - errflg ! CCPP error code + errflg !< CCPP error code ! Local variables integer :: status, ncid, dimid, varID, mpierr, iChar @@ -497,6 +485,5 @@ subroutine rrtmgp_sw_gas_optics_init(rrtmgp_root_dir, rrtmgp_sw_file_gas, sb_defaultSW, rayl_lowerSW, rayl_upperSW)) end subroutine rrtmgp_sw_gas_optics_init -!> @} end module rrtmgp_sw_gas_optics diff --git a/physics/Radiation/RRTMGP/rrtmgp_sw_main.F90 b/physics/Radiation/RRTMGP/rrtmgp_sw_main.F90 index ab379cc9e..77691d836 100644 --- a/physics/Radiation/RRTMGP/rrtmgp_sw_main.F90 +++ b/physics/Radiation/RRTMGP/rrtmgp_sw_main.F90 @@ -99,95 +99,95 @@ subroutine rrtmgp_sw_main_run(doSWrad, doSWclrsky, top_at_1, doGP_sgs_cnv, doGP_ ! Inputs logical, intent(in) :: & - doSWrad, & ! Flag to perform shortwave calculation - doSWclrsky, & ! Flag to compute clear-sky fluxes - top_at_1, & ! Flag for vertical ordering convention - doGP_sgs_pbl, & ! Flag to include sgs PBL clouds - doGP_sgs_cnv ! Flag to include sgs convective clouds + doSWrad, & !< Flag to perform shortwave calculation + doSWclrsky, & !< Flag to compute clear-sky fluxes + top_at_1, & !< Flag for vertical ordering convention + doGP_sgs_pbl, & !< Flag to include sgs PBL clouds + doGP_sgs_cnv !< Flag to include sgs convective clouds integer,intent(in) :: & - nCol, & ! Number of horizontal points - nDay, & ! Number of daytime points - nLay, & ! Number of vertical grid points. - nGases, & ! Number of active gases - rrtmgp_phys_blksz, & ! Number of horizontal points to process at once. - iovr, & ! Choice of cloud-overlap method - iovr_convcld, & ! Choice of convective cloud-overlap - iovr_max, & ! Flag for maximum cloud overlap method - iovr_maxrand, & ! Flag for maximum-random cloud overlap method - iovr_rand, & ! Flag for random cloud overlap method - iovr_dcorr, & ! Flag for decorrelation-length cloud overlap method - iovr_exp, & ! Flag for exponential cloud overlap method - iovr_exprand, & ! Flag for exponential-random cloud overlap method - isubc_sw, & ! + nCol, & !< Number of horizontal points + nDay, & !< Number of daytime points + nLay, & !< Number of vertical grid points. + nGases, & !< Number of active gases + rrtmgp_phys_blksz, & !< Number of horizontal points to process at once. + iovr, & !< Choice of cloud-overlap method + iovr_convcld, & !< Choice of convective cloud-overlap + iovr_max, & !< Flag for maximum cloud overlap method + iovr_maxrand, & !< Flag for maximum-random cloud overlap method + iovr_rand, & !< Flag for random cloud overlap method + iovr_dcorr, & !< Flag for decorrelation-length cloud overlap method + iovr_exp, & !< Flag for exponential cloud overlap method + iovr_exprand, & !< Flag for exponential-random cloud overlap method + isubc_sw, & !< iSFC integer,intent(in),dimension(:) :: & - idx, & ! Index array for daytime points - icseed_sw ! Seed for random number generation for shortwave radiation + idx, & !< Index array for daytime points + icseed_sw !< Seed for random number generation for shortwave radiation real(kind_phys), dimension(:), intent(in) :: & - sfc_alb_nir_dir, & ! Surface albedo (direct) - sfc_alb_nir_dif, & ! Surface albedo (diffuse) - sfc_alb_uvvis_dir, & ! Surface albedo (direct) - sfc_alb_uvvis_dif, & ! Surface albedo (diffuse) - coszen ! Cosize of SZA + sfc_alb_nir_dir, & !< Surface albedo (direct) + sfc_alb_nir_dif, & !< Surface albedo (diffuse) + sfc_alb_uvvis_dir, & !< Surface albedo (direct) + sfc_alb_uvvis_dif, & !< Surface albedo (diffuse) + coszen !< Cosize of SZA real(kind_phys), dimension(:,:), intent(in) :: & - p_lay, & ! Pressure @ model layer-centers (Pa) - t_lay, & ! Temperature (K) - p_lev, & ! Pressure @ model layer-interfaces (Pa) - t_lev, & ! Temperature @ model levels (K) - vmr_o2, & ! Molar-mixing ratio oxygen - vmr_h2o, & ! Molar-mixing ratio water vapor - 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 - cld_frac, & ! Cloud-fraction for stratiform clouds - cld_lwp, & ! Water path for stratiform liquid cloud-particles - cld_reliq, & ! Effective radius for stratiform liquid cloud-particles - cld_iwp, & ! Water path for stratiform ice cloud-particles - cld_reice, & ! Effective radius for stratiform ice cloud-particles - cld_swp, & ! Water path for snow hydrometeors - cld_resnow, & ! Effective radius for snow hydrometeors - cld_rwp, & ! Water path for rain hydrometeors - cld_rerain, & ! Effective radius for rain hydrometeors - precip_frac, & ! Precipitation fraction - cld_cnv_lwp, & ! Water path for convective liquid cloud-particles - cld_cnv_reliq, & ! Effective radius for convective liquid cloud-particles - cld_cnv_iwp, & ! Water path for convective ice cloud-particles - cld_cnv_reice, & ! Effective radius for convective ice cloud-particles - cld_pbl_lwp, & ! Water path for PBL liquid cloud-particles - cld_pbl_reliq, & ! Effective radius for PBL liquid cloud-particles - cld_pbl_iwp, & ! Water path for PBL ice cloud-particles - cld_pbl_reice, & ! Effective radius for PBL ice cloud-particles - cloud_overlap_param ! + p_lay, & !< Pressure @ model layer-centers (Pa) + t_lay, & !< Temperature (K) + p_lev, & !< Pressure @ model layer-interfaces (Pa) + t_lev, & !< Temperature @ model levels (K) + vmr_o2, & !< Molar-mixing ratio oxygen + vmr_h2o, & !< Molar-mixing ratio water vapor + 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 + cld_frac, & !< Cloud-fraction for stratiform clouds + cld_lwp, & !< Water path for stratiform liquid cloud-particles + cld_reliq, & !< Effective radius for stratiform liquid cloud-particles + cld_iwp, & !< Water path for stratiform ice cloud-particles + cld_reice, & !< Effective radius for stratiform ice cloud-particles + cld_swp, & !< Water path for snow hydrometeors + cld_resnow, & !< Effective radius for snow hydrometeors + cld_rwp, & !< Water path for rain hydrometeors + cld_rerain, & !< Effective radius for rain hydrometeors + precip_frac, & !< Precipitation fraction + cld_cnv_lwp, & !< Water path for convective liquid cloud-particles + cld_cnv_reliq, & !< Effective radius for convective liquid cloud-particles + cld_cnv_iwp, & !< Water path for convective ice cloud-particles + cld_cnv_reice, & !< Effective radius for convective ice cloud-particles + cld_pbl_lwp, & !< Water path for PBL liquid cloud-particles + cld_pbl_reliq, & !< Effective radius for PBL liquid cloud-particles + cld_pbl_iwp, & !< Water path for PBL ice cloud-particles + cld_pbl_reice, & !< Effective radius for PBL ice cloud-particles + cloud_overlap_param !< real(kind_phys), dimension(:,:,:), intent(in) :: & - aersw_tau, & ! Aerosol optical depth - aersw_ssa, & ! Aerosol single scattering albedo - aersw_g ! Aerosol asymmetry paramter + aersw_tau, & !< Aerosol optical depth + aersw_ssa, & !< Aerosol single scattering albedo + aersw_g !< Aerosol asymmetry paramter character(len=*), dimension(:), intent(in) :: & - active_gases_array ! List of active gases from namelist as array + active_gases_array !< List of active gases from namelist as array real(kind_phys), intent(in) :: & - solcon ! Solar constant + solcon !< Solar constant ! Outputs character(len=*), intent(out) :: & - errmsg ! CCPP error message + errmsg !< CCPP error message integer, intent(out) :: & - errflg ! CCPP error flag + errflg !< CCPP error flag real(kind_phys), dimension(:,:), intent(inout) :: & - cldtausw ! Approx 10.mu band layer cloud optical depth + cldtausw !< Approx 10.mu band layer cloud optical depth real(kind_phys), dimension(:,:), intent(inout) :: & - 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) - fluxswDOWN_clrsky ! RRTMGP downward clear-sky flux profiles (W/m2) + 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) + fluxswDOWN_clrsky !< RRTMGP downward clear-sky flux profiles (W/m2) type(cmpfsw_type), dimension(:), intent(inout) :: & - scmpsw ! 2D surface fluxes, components: - ! uvbfc - total sky downward uv-b flux (W/m2) - ! uvbf0 - clear sky downward uv-b flux (W/m2) - ! nirbm - downward nir direct beam flux (W/m2) - ! nirdf - downward nir diffused flux (W/m2) - ! visbm - downward uv+vis direct beam flux (W/m2) - ! visdf - downward uv+vis diffused flux (W/m2) + scmpsw !< 2D surface fluxes, components: + !< uvbfc - total sky downward uv-b flux (W/m2) + !< uvbf0 - clear sky downward uv-b flux (W/m2) + !< nirbm - downward nir direct beam flux (W/m2) + !< nirdf - downward nir diffused flux (W/m2) + !< visbm - downward uv+vis direct beam flux (W/m2) + !< visdf - downward uv+vis diffused flux (W/m2) ! Local variables type(cmpfsw_type), dimension(rrtmgp_phys_blksz) :: scmpsw_clrsky, scmpsw_allsky diff --git a/physics/docs/_doxygen/custom.css b/physics/docs/_doxygen/custom.css new file mode 100644 index 000000000..ad6f35a52 --- /dev/null +++ b/physics/docs/_doxygen/custom.css @@ -0,0 +1,57 @@ +.github-corner svg { + fill: var(--primary-light-color); + color: var(--page-background-color); + width: 72px; + height: 72px; +} + +@media screen and (max-width: 767px) { + .github-corner svg { + width: 50px; + height: 50px; + } + #projectnumber { + margin-right: 22px; + } +} + +.alter-theme-button { + display: inline-block; + cursor: pointer; + background: var(--primary-color); + color: var(--page-background-color) !important; + border-radius: var(--border-radius-medium); + padding: var(--spacing-small) var(--spacing-medium); + text-decoration: none; +} + +.alter-theme-button:hover { + background: var(--primary-dark-color); +} + +html.dark-mode .darkmode_inverted_image img, /* < doxygen 1.9.3 */ +html.dark-mode .darkmode_inverted_image object[type="image/svg+xml"] /* doxygen 1.9.3 */ { + filter: brightness(89%) hue-rotate(180deg) invert(); +} + +.bordered_image { + border-radius: var(--border-radius-small); + border: 1px solid var(--separator-color); + display: inline-block; + overflow: hidden; +} + +html.dark-mode .bordered_image img, /* < doxygen 1.9.3 */ +html.dark-mode .bordered_image object[type="image/svg+xml"] /* doxygen 1.9.3 */ { + border-radius: var(--border-radius-small); +} + +.title_screenshot { + filter: drop-shadow(0px 3px 10px rgba(0,0,0,0.22)); + max-width: 500px; + margin: var(--spacing-large) 0; +} + +.title_screenshot .caption { + display: none; +} diff --git a/physics/docs/_doxygen/doxygen-awesome.css b/physics/docs/_doxygen/doxygen-awesome.css index 217fdedfc..5643749c2 100644 --- a/physics/docs/_doxygen/doxygen-awesome.css +++ b/physics/docs/_doxygen/doxygen-awesome.css @@ -894,7 +894,7 @@ div.contents p, div.contents li { } div.contents div.dyncontent { - margin: var(--spacing-medium) 0; + margin: var(--spacing-medium) 0; overflow-x: scroll; } @media (prefers-color-scheme: dark) { diff --git a/physics/docs/_doxygen/header.html b/physics/docs/_doxygen/header.html index 2e72051ea..8896efc85 100644 --- a/physics/docs/_doxygen/header.html +++ b/physics/docs/_doxygen/header.html @@ -1,22 +1,38 @@ - - + + + + + + + + + + $projectname: $title $title + + + + + + - $treeview $search $mathjax @@ -24,6 +40,13 @@ $extrastylesheet + + + + + +
diff --git a/physics/docs/ccpp_doxyfile b/physics/docs/ccpp_doxyfile index b1f079541..2dc1ac4de 100644 --- a/physics/docs/ccpp_doxyfile +++ b/physics/docs/ccpp_doxyfile @@ -42,7 +42,7 @@ DOXYFILE_ENCODING = UTF-8 # title of most generated pages and in a few other places. # The default value is: My Project. -PROJECT_NAME = "CCPP SciDoc" +PROJECT_NAME = "CCPP SciDoc v7.0.0" # The PROJECT_NUMBER tag can be used to enter a project or revision number. This # could be handy for archiving the generated documentation or if some version @@ -168,7 +168,7 @@ INLINE_INHERITED_MEMB = NO # shortest path that makes the file name unique will be used # The default value is: YES. -FULL_PATH_NAMES = NO +FULL_PATH_NAMES = YES # The STRIP_FROM_PATH tag can be used to strip a user-defined part of the path. # Stripping is only done if one of the specified strings matches the left-hand @@ -1364,7 +1364,8 @@ HTML_STYLESHEET = HTML_EXTRA_STYLESHEET = _doxygen/doxygen-awesome.css \ _doxygen/doxygen-awesome-sidebar-only.css \ _doxygen/doxygen-awesome-sidebar-only-darkmode-toggle.css \ - _doxygen/doxygen-awesome-ccpp.css + _doxygen/doxygen-awesome-ccpp.css \ + _doxygen/custom.css # The HTML_EXTRA_FILES tag can be used to specify one or more extra images or # other source files which should be copied to the HTML output directory. Note @@ -1388,7 +1389,7 @@ HTML_EXTRA_FILES = _doxygen/doxygen-awesome-darkmode-toggle.js \ # The default value is: AUTO_LIGHT. # This tag requires that the tag GENERATE_HTML is set to YES. -HTML_COLORSTYLE = AUTO_LIGHT +HTML_COLORSTYLE = LIGHT # The HTML_COLORSTYLE_HUE tag controls the color of the HTML output. Doxygen # will adjust the colors in the style sheet and background images according to diff --git a/physics/docs/library.bib b/physics/docs/library.bib index 77f167de8..d622bca48 100644 --- a/physics/docs/library.bib +++ b/physics/docs/library.bib @@ -1,13 +1,62 @@ %% This BibTeX bibliography file was created using BibDesk. %% https://bibdesk.sourceforge.io/ -%% Created for Man Zhang at 2024-06-17 12:34:22 -0600 +%% Created for Man Zhang at 2024-06-24 12:44:05 -0600 %% Saved with string encoding Unicode (UTF-8) +@article{Mansell_2020, + author = {Mansell, Edward R. and Dawson II, Daniel T. and Straka, Jerry M.}, + date-added = {2024-06-24 12:43:58 -0600}, + date-modified = {2024-06-24 12:43:58 -0600}, + doi = {10.1175/jas-d-19-0268.1}, + issn = {1520-0469}, + journal = {Journal of the Atmospheric Sciences}, + month = oct, + number = {10}, + pages = {3361{\^a}€“3385}, + publisher = {American Meteorological Society}, + title = {Bin-Emulating Hail Melting in Three-Moment Bulk Microphysics}, + url = {http://dx.doi.org/10.1175/JAS-D-19-0268.1}, + volume = {77}, + year = {2020}, + bdsk-url-1 = {http://dx.doi.org/10.1175/JAS-D-19-0268.1}} + +@article{tsiringakis_et_al_2017, + abstract = {At present atmospheric models for weather and climate use enhanced turbulent drag under stable conditions, because these empirically provide the necessary momentum drag for accurate forecast of synoptic systems. The enhanced mixing (also known as the `long tail'), introduces drag that cannot be physically justified and degrades the score for near-surface temperature, wind and boundary-layer height, and degrades fog and frost forecasting. This study hypothesizes that the insufficient representation of small-scale orographic gravity wave drag in the stable boundary layer may explain the need for the enhanced drag formulation. Hence, we introduce a new scheme in the Weather Research and Forecasting model that accounts for this drag as a superposition on the turbulent drag induced by a so-called short-tail mixing function. The latter is consistent with boundary-layer observations and large-eddy simulations. We evaluate this scheme, against a short-tail and a long-tail scheme for sixteen eight-day forecasts over the Atlantic Ocean and Europe in winter. The new scheme outperforms the short- and long-tail schemes on sea-level pressure, height of the 500 hPa field, 10 m wind and the cyclonic core pressure. Cyclonic core pressure bias is reduced by approximately 45 to 80\% compared to the short-tail scheme. Sea-level pressure bias is reduced by up to 0.48 hPa (50\%) over the whole domain compared to the short-tail run. The new scheme has even smaller biases than the long-tail scheme, supporting our hypothesis that small-scale gravity wave drag may explain the need for a long-tail function. Near-surface wind bias is reduced by up to 40\% compared to the long-tail and up to 32\% compared to the short-tail scheme, while the 2 m temperature bias is only slightly increased (19\%).}, + author = {Tsiringakis, A. and Steeneveld, G. J. and Holtslag, A. A. M.}, + doi = {https://doi.org/10.1002/qj.3021}, + eprint = {https://rmets.onlinelibrary.wiley.com/doi/pdf/10.1002/qj.3021}, + journal = {Quarterly Journal of the Royal Meteorological Society}, + keywords = {orographic gravity wave drag, stable boundary layer, WRF model, parametrization, meteorology}, + number = {704}, + pages = {1504-1516}, + title = {Small-scale orographic gravity wave drag in stable boundary layers and its impact on synoptic systems and near-surface meteorology}, + url = {https://rmets.onlinelibrary.wiley.com/doi/abs/10.1002/qj.3021}, + volume = {143}, + year = {2017}, + bdsk-url-1 = {https://rmets.onlinelibrary.wiley.com/doi/abs/10.1002/qj.3021}, + bdsk-url-2 = {https://doi.org/10.1002/qj.3021}} + +@article{choi_and_hong_2015, + abstract = {Abstract A subgrid orographic parameterization (SOP) is updated by including the effects of orographic anisotropy and flow-blocking drag (FBD). The impact of the updated SOP on short-range forecasts is investigated using a global atmospheric forecast model applied to a heavy snowfall event over Korea on 4 January 2010. When the SOP is updated, the orographic drag in the lower troposphere noticeably increases owing to the additional FBD over mountainous regions. The enhanced drag directly weakens the excessive wind speed in the low troposphere and indirectly improves the temperature and mass fields over East Asia. In addition, the snowfall overestimation over Korea is improved by the reduced heat fluxes from the surface. The forecast improvements are robust regardless of the horizontal resolution of the model between T126 and T510. The parameterization is statistically evaluated based on the skill of the medium-range forecasts for February 2014. For the medium-range forecasts, the skill improvements of the wind speed and temperature in the low troposphere are observed globally and for East Asia while both positive and negative effects appear indirectly in the middle-upper troposphere. The statistical skill for the precipitation is mostly improved due to the improvements in the synoptic fields. The improvements are also found for seasonal simulation throughout the troposphere and stratosphere during boreal winter.}, + author = {Choi, Hyun-Joo and Hong, Song-You}, + doi = {https://doi.org/10.1002/2015JD024230}, + eprint = {https://agupubs.onlinelibrary.wiley.com/doi/pdf/10.1002/2015JD024230}, + journal = {Journal of Geophysical Research: Atmospheres}, + keywords = {subgrid orographic parameterization, orographic anisotropy, flow-blocking drag, forecast skills, GRIMs}, + number = {24}, + pages = {12445-12457}, + title = {An updated subgrid orographic parameterization for global atmospheric forecast models}, + url = {https://agupubs.onlinelibrary.wiley.com/doi/abs/10.1002/2015JD024230}, + volume = {120}, + year = {2015}, + bdsk-url-1 = {https://agupubs.onlinelibrary.wiley.com/doi/abs/10.1002/2015JD024230}, + bdsk-url-2 = {https://doi.org/10.1002/2015JD024230}} + @article{Liou_1973, author = {Liou, Kuo-Nan}, date-added = {2024-06-17 12:33:23 -0600}, diff --git a/physics/docs/pdftxt/NSSLMICRO.txt b/physics/docs/pdftxt/NSSLMICRO.txt index 44d1f069b..57472a7e7 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 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 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_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. diff --git a/physics/docs/pdftxt/RE7/input_RRFS_v1.nml b/physics/docs/pdftxt/RE7/input_RRFS_v1.nml index f15c4e8ff..e80c532fa 100644 --- a/physics/docs/pdftxt/RE7/input_RRFS_v1.nml +++ b/physics/docs/pdftxt/RE7/input_RRFS_v1.nml @@ -1,40 +1,40 @@ !>[GFS_PHYSICS_NML] &gfs_physics_nml - addsmoke_flag = 1 - aero_dir_fdb = .true. - aero_ind_fdb = .false. - bl_mynn_edmf = 1 - bl_mynn_edmf_mom = 1 + addsmoke_flag = 1 + aero_dir_fdb = .true. + aero_ind_fdb = .false. + bl_mynn_edmf = 1 + bl_mynn_edmf_mom = 1 bl_mynn_tkeadvect = .true. - cal_pre = .false. - cdmbgwd = 3.5, 1.0 - clm_debug_print = .false. - clm_lake_debug = .false. - cnvcld = .false. - cnvgwd = .false. + cal_pre = .false. + cdmbgwd = 3.5, 1.0 + clm_debug_print = .false. + clm_lake_debug = .false. + cnvcld = .false. + cnvgwd = .false. coarsepm_settling = 1 - cplflx = .false. - diag_log = .true. - debug = .false. - do_deep = .true. + cplflx = .false. + diag_log = .true. + 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_plumerise = .true. + do_gsl_drag_ss = .true. + do_gsl_drag_tofd = .true. + do_mynnedmf = .true. + do_mynnsfclay = .true. + do_plumerise = .true. do_smoke_transport = .true. - do_tofd = .false. - do_ugwp = .false. - do_ugwp_v0 = .false. + do_tofd = .false. + do_ugwp = .false. + do_ugwp_v0 = .false. do_ugwp_v0_nst_only = .false. do_ugwp_v0_orog_only = .false. - drydep_opt = 1 - dspheat = .true. - dt_inner = 36 - dust_alpha = 10.0 + drydep_opt = 1 + dspheat = .true. + dt_inner = 36 + dust_alpha = 10.0 dust_drylimit_factor = 0.5 - dust_gamma = 1.3 + dust_gamma = 1.3 dust_moist_correction = 2.0 dust_opt = 1 ebb_dcycle = 2 diff --git a/physics/docs/pdftxt/suite_input.nml.txt b/physics/docs/pdftxt/suite_input.nml.txt index b2ad620fc..23558a468 100644 --- a/physics/docs/pdftxt/suite_input.nml.txt +++ b/physics/docs/pdftxt/suite_input.nml.txt @@ -45,6 +45,7 @@ show some variables in the namelist that must match the SDF. cpl_imp_dbg use_cice_alb rrfs_sd +rrfs_smoke_debug lsidea @@ -552,6 +553,7 @@ show some variables in the namelist that must match the SDF. 1 lsoil lsm_noah number of soil layers 4 +lsoil_lsm rdlai lsm_ruc flag to read leaf area index from input files .false. ivegsrc lsm_noah, lsm_ruc, \ref noahmpdrv, sfc_diff flag for vegetation type dataset choice: \n