Skip to content
Open
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
4 changes: 2 additions & 2 deletions src/core_atmosphere/Externals.cfg
Original file line number Diff line number Diff line change
@@ -1,8 +1,8 @@
[MMM-physics]
local_path = ./physics_mmm
protocol = git
repo_url = https://github.com/NCAR/MMM-physics.git
tag = 20250616-MPASv8.3
repo_url = https://github.com/Sonyou184/MMM-physics.git
branch = MMM2026-SHPBL
required = True

[GSL_UGWP]
Expand Down
154 changes: 87 additions & 67 deletions src/core_atmosphere/Registry.xml

Large diffs are not rendered by default.

8 changes: 8 additions & 0 deletions src/core_atmosphere/mpas_atm_core.F
Original file line number Diff line number Diff line change
Expand Up @@ -372,6 +372,7 @@ subroutine atm_mpas_init_block(dminfo, stream_manager, block, mesh, dt)
use mpas_vector_reconstruction
use mpas_stream_manager
use mpas_atm_boundaries, only : mpas_atm_setup_bdy_masks
use mpas_constants, only : omega
#ifdef DO_PHYSICS
! use mpas_atmphys_aquaplanet
use mpas_atmphys_control
Expand Down Expand Up @@ -405,6 +406,7 @@ subroutine atm_mpas_init_block(dminfo, stream_manager, block, mesh, dt)
real (kind=RKIND), dimension(:), pointer :: dvEdge, invDvEdge
real (kind=RKIND), dimension(:), pointer :: dcEdge, invDcEdge
real (kind=RKIND), dimension(:), pointer :: areaTriangle, invAreaTriangle
real (kind=RKIND), dimension(:), pointer :: fcell, latcell
integer, pointer :: nCells_ptr, nEdges_ptr, nVertices_ptr, nVertLevels_ptr, nEdgesSolve
integer :: nCells, nEdges, nVertices, nVertLevels
integer :: thread
Expand Down Expand Up @@ -444,6 +446,8 @@ subroutine atm_mpas_init_block(dminfo, stream_manager, block, mesh, dt)

call mpas_pool_get_array(mesh, 'areaTriangle', areaTriangle)
call mpas_pool_get_array(mesh, 'invAreaTriangle', invAreaTriangle)
call mpas_pool_get_array(mesh, 'fCell', fcell)
call mpas_pool_get_array(mesh, 'latCell', latcell)

call mpas_pool_get_dimension(mesh, 'nCells', nCells_ptr)
call mpas_pool_get_dimension(mesh, 'nEdges', nEdges_ptr)
Expand All @@ -469,6 +473,10 @@ subroutine atm_mpas_init_block(dminfo, stream_manager, block, mesh, dt)
invAreaTriangle(iVertex) = 1.0_RKIND / areaTriangle(iVertex)
end do

do iCell=1,nCells
fcell(iCell) = 2. * omega * sin(latcell(iCell))
end do

!!!!! End compute inverses
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

Expand Down
9 changes: 6 additions & 3 deletions src/core_atmosphere/physics/mpas_atmphys_control.F
Original file line number Diff line number Diff line change
Expand Up @@ -83,6 +83,8 @@ module mpas_atmphys_control
! * in the mesoscale_reference suite, replaced the MM5 surface layer scheme with the MM5 revised surface layer
! scheme as the default option for config_sfclayer_scheme.
! Laura D. Fowler (laura@ucar.edu) / 2024-06-18.
! * added the option bl_shinhong
! Songyou Hong (hong@ucar.edu) / 2025-11-27.


contains
Expand Down Expand Up @@ -133,8 +135,8 @@ subroutine physics_namelist_check(configs)
if (trim(config_microp_scheme) == 'suite') config_microp_scheme = 'mp_wsm6'
if (trim(config_convection_scheme) == 'suite') config_convection_scheme = 'cu_ntiedtke'
if (trim(config_pbl_scheme) == 'suite') config_pbl_scheme = 'bl_ysu'
if (trim(config_gwdo_scheme) == 'suite') config_gwdo_scheme = 'bl_ysu_gwdo'
if (trim(config_radt_lw_scheme) == 'suite') config_radt_lw_scheme = 'rrtmg_lw'
if (trim(config_gwdo_scheme) == 'suite') config_gwdo_scheme = 'bl_ysu_gwdo'
if (trim(config_radt_sw_scheme) == 'suite') config_radt_sw_scheme = 'rrtmg_sw'
if (trim(config_radt_cld_scheme) == 'suite') config_radt_cld_scheme = 'cld_fraction'
if (trim(config_sfclayer_scheme) == 'suite') config_sfclayer_scheme = 'sf_monin_obukhov_rev'
Expand Down Expand Up @@ -201,6 +203,7 @@ subroutine physics_namelist_check(configs)
!pbl scheme:
if(.not. (config_pbl_scheme .eq. 'off' .or. &
config_pbl_scheme .eq. 'bl_mynn' .or. &
config_pbl_scheme .eq. 'bl_shinhong' .or. &
config_pbl_scheme .eq. 'bl_ysu')) then

write(mpas_err_message,'(A,A20)') 'illegal value for pbl_scheme: ', &
Expand Down Expand Up @@ -279,10 +282,10 @@ subroutine physics_namelist_check(configs)
else
if(config_pbl_scheme == 'bl_mynn') then
config_sfclayer_scheme = 'sf_mynn'
elseif(config_pbl_scheme == 'bl_ysu') then
elseif(config_pbl_scheme == 'bl_shinhong' .or. config_pbl_scheme == 'bl_ysu') then
if(config_sfclayer_scheme /= 'sf_monin_obukhov' .and. &
config_sfclayer_scheme /= 'sf_monin_obukhov_rev') then
write(mpas_err_message,'(A,A20)') 'wrong choice for surface layer scheme with YSU PBL: ', &
write(mpas_err_message,'(A,A20)') 'wrong choice for surface layer scheme with SHINHONG/YSU PBL: ', &
trim(config_sfclayer_scheme)
call physics_error_fatal(mpas_err_message)
endif
Expand Down
156 changes: 155 additions & 1 deletion src/core_atmosphere/physics/mpas_atmphys_driver_pbl.F
Original file line number Diff line number Diff line change
Expand Up @@ -16,6 +16,7 @@ module mpas_atmphys_driver_pbl

use bl_mynn,only: bl_mynn_init
use module_bl_mynn,only: mynn_bl_driver
use module_bl_shinhong
use module_bl_ysu

implicit none
Expand All @@ -39,6 +40,7 @@ module mpas_atmphys_driver_pbl
!
! WRF physics called from driver_pbl:
! -----------------------------------
! * module_bl_shinhong : SHINHONG PBL scheme.
! * module_bl_ysu : YSU PBL scheme.
!
! add-ons and modifications to sourcecode:
Expand Down Expand Up @@ -78,6 +80,8 @@ module mpas_atmphys_driver_pbl
! Laura D. Fowler (laura@ucar.edu) / 2024-02-14.
! * updated the MYNN PBL scheme to the sourcecode from WRF version 4.6.
! Laura D. Fowler (laura@ucar.edu) / 2024-02.15.
! * added the option SHINHONG PBL scheme, incorporating revisions and additions from WRF version 4.7
! Songyou Hong (hong@ucar.edu) / 2025-11.27.


contains
Expand All @@ -102,6 +106,7 @@ subroutine allocate_pbl(configs)
if(.not.allocated(ust_p) ) allocate(ust_p(ims:ime,jms:jme) )
if(.not.allocated(wspd_p) ) allocate(wspd_p(ims:ime,jms:jme) )
if(.not.allocated(xland_p)) allocate(xland_p(ims:ime,jms:jme))
if(.not.allocated(fcell_p)) allocate(fcell_p(ims:ime,jms:jme))
if(.not.allocated(hpbl_p) ) allocate(hpbl_p(ims:ime,jms:jme) )
if(.not.allocated(kpbl_p) ) allocate(kpbl_p(ims:ime,jms:jme) )
if(.not.allocated(znt_p) ) allocate(znt_p(ims:ime,jms:jme) )
Expand All @@ -125,6 +130,21 @@ subroutine allocate_pbl(configs)

pbl_select: select case (trim(pbl_scheme))

case("bl_shinhong")
!from surface-layer model:
if(.not.allocated(br_p) ) allocate(br_p(ims:ime,jms:jme) )
if(.not.allocated(dx_p) ) allocate(dx_p(ims:ime,jms:jme) )
if(.not.allocated(ctopo_p) ) allocate(ctopo_p(ims:ime,jms:jme) )
if(.not.allocated(ctopo2_p)) allocate(ctopo2_p(ims:ime,jms:jme) )
if(.not.allocated(delta_p) ) allocate(delta_p(ims:ime,jms:jme) )
if(.not.allocated(psih_p) ) allocate(psih_p(ims:ime,jms:jme) )
if(.not.allocated(psim_p) ) allocate(psim_p(ims:ime,jms:jme) )
if(.not.allocated(u10_p) ) allocate(u10_p(ims:ime,jms:jme) )
if(.not.allocated(v10_p) ) allocate(v10_p(ims:ime,jms:jme) )
if(.not.allocated(exch_p) ) allocate(exch_p(ims:ime,kms:kme,jms:jme))
if(.not.allocated(wstar_p) ) allocate(wstar_p(ims:ime,jms:jme) )
if(.not.allocated(elpbl_p) ) allocate(elpbl_p(ims:ime,kms:kme,jms:jme) )
if(.not.allocated(tkepbl_p) ) allocate(tkepbl_p(ims:ime,kms:kme,jms:jme) )
case("bl_ysu")
!from surface-layer model:
if(.not.allocated(br_p) ) allocate(br_p(ims:ime,jms:jme) )
Expand Down Expand Up @@ -211,6 +231,7 @@ subroutine deallocate_pbl(configs)
if(allocated(ust_p) ) deallocate(ust_p )
if(allocated(wspd_p) ) deallocate(wspd_p )
if(allocated(xland_p)) deallocate(xland_p)
if(allocated(fcell_p)) deallocate(fcell_p)
if(allocated(hpbl_p) ) deallocate(hpbl_p )
if(allocated(kpbl_p) ) deallocate(kpbl_p )
if(allocated(znt_p) ) deallocate(znt_p )
Expand All @@ -234,6 +255,21 @@ subroutine deallocate_pbl(configs)

pbl_select: select case (trim(pbl_scheme))

case("bl_shinhong")
!from surface-layer model:
if(allocated(br_p) ) deallocate(br_p )
if(allocated(dx_p) ) deallocate(dx_p )
if(allocated(ctopo_p) ) deallocate(ctopo_p )
if(allocated(ctopo2_p)) deallocate(ctopo2_p)
if(allocated(delta_p) ) deallocate(delta_p )
if(allocated(psih_p) ) deallocate(psih_p )
if(allocated(psim_p) ) deallocate(psim_p )
if(allocated(u10_p) ) deallocate(u10_p )
if(allocated(v10_p) ) deallocate(v10_p )
if(allocated(exch_p) ) deallocate(exch_p )
if(allocated(wstar_p) ) deallocate(wstar_p )
if(allocated(elpbl_p) ) deallocate(elpbl_p )
if(allocated(tkepbl_p) ) deallocate(tkepbl_p )
case("bl_ysu")
!from surface-layer model:
if(allocated(br_p) ) deallocate(br_p )
Expand Down Expand Up @@ -321,13 +357,17 @@ subroutine pbl_from_MPAS(configs,mesh,sfc_input,diag_physics,tend_physics,its,it
!local pointers:
character(len=StrKIND),pointer:: pbl_scheme

real(kind=RKIND),dimension(:),pointer:: hfx,hpbl,qfx,ust,wspd,xland,znt
real(kind=RKIND),dimension(:),pointer:: hfx,hpbl,qfx,ust,wspd,xland,znt,fcell
real(kind=RKIND),dimension(:),pointer:: delta,wstar

!local pointers for YSU scheme:
logical,pointer:: config_ysu_pblmix
real(kind=RKIND),dimension(:),pointer:: br,fh,fm,u10,v10
real(kind=RKIND),dimension(:,:),pointer:: rthratenlw,rthratensw
!local pointers for SHINHONG scheme:
logical,pointer:: config_shinhong_nonlocal_flux
logical,pointer:: config_shinhong_scu_mixing
logical,pointer:: config_shinhong_ke_dissipation

!local pointers for MYNN scheme:
real(kind=RKIND),pointer:: len_disp
Expand All @@ -353,6 +393,7 @@ subroutine pbl_from_MPAS(configs,mesh,sfc_input,diag_physics,tend_physics,its,it
call mpas_pool_get_array(tend_physics,'rthratensw',rthratensw)

call mpas_pool_get_array(sfc_input,'xland',xland)
call mpas_pool_get_array(mesh,'fCell',fcell)

do j = jts,jte
do i = its,ite
Expand All @@ -363,6 +404,7 @@ subroutine pbl_from_MPAS(configs,mesh,sfc_input,diag_physics,tend_physics,its,it
ust_p(i,j) = ust(i)
wspd_p(i,j) = wspd(i)
xland_p(i,j) = xland(i)
fcell_p(i,j) = fcell(i)
kpbl_p(i,j) = 1
znt_p(i,j) = znt(i)
!... ocean currents are set to zero:
Expand All @@ -378,6 +420,56 @@ subroutine pbl_from_MPAS(configs,mesh,sfc_input,diag_physics,tend_physics,its,it

pbl_select: select case (trim(pbl_scheme))

case("bl_shinhong")
call mpas_pool_get_config(configs,'config_shinhong_nonlocal_flux',config_shinhong_nonlocal_flux)
call mpas_pool_get_config(configs,'config_shinhong_scu_mixing',config_shinhong_scu_mixing)
call mpas_pool_get_config(configs,'config_shinhong_ke_dissipation',config_shinhong_ke_dissipation)
call mpas_pool_get_config(configs,'config_len_disp',len_disp)

call mpas_pool_get_array(mesh,'meshDensity',meshDensity)
call mpas_pool_get_array(diag_physics,'br' ,br )
call mpas_pool_get_array(diag_physics,'delta',delta)
call mpas_pool_get_array(diag_physics,'fm' ,fm )
call mpas_pool_get_array(diag_physics,'fh' ,fh )
call mpas_pool_get_array(diag_physics,'u10' ,u10 )
call mpas_pool_get_array(diag_physics,'v10' ,v10 )
call mpas_pool_get_array(diag_physics,'wstar',wstar)

call mpas_pool_get_array(diag_physics,'el_pbl' ,el_pbl )
call mpas_pool_get_array(diag_physics,'tke_pbl' ,tke_pbl )

do j = jts,jte
do i = its,ite
dx_p(i,j) = len_disp / meshDensity(i)**0.25
enddo
enddo

do j = jts,jte
do i = its,ite
!from surface-layer model:
br_p(i,j) = br(i)
psim_p(i,j) = fm(i)
psih_p(i,j) = fh(i)
u10_p(i,j) = u10(i)
v10_p(i,j) = v10(i)
delta_p(i,j) = delta(i)
wstar_p(i,j) = wstar(i)
!initialization for YSU/SHINHONG PBL scheme:
ctopo_p(i,j) = 1._RKIND
ctopo2_p(i,j) = 1._RKIND
enddo
enddo

do j = jts,jte
do k = kts,kte
do i = its,ite
exch_p(i,k,j) = 0._RKIND
tkepbl_p(i,k,j) = tke_pbl(k,i)
elpbl_p(i,k,j) = el_pbl(k,i)
enddo
enddo
enddo

case("bl_ysu")
call mpas_pool_get_config(configs,'config_ysu_pblmix',config_ysu_pblmix)

Expand Down Expand Up @@ -608,6 +700,27 @@ subroutine pbl_to_MPAS(configs,diag_physics,tend_physics,its,ite)

pbl_select: select case (trim(pbl_scheme))

case("bl_shinhong")
call mpas_pool_get_array(diag_physics,'delta',delta )
call mpas_pool_get_array(diag_physics,'wstar' ,wstar )
call mpas_pool_get_array(diag_physics,'exch_h',exch_h)
call mpas_pool_get_array(diag_physics,'tke_pbl',tke_pbl)
call mpas_pool_get_array(diag_physics,'el_pbl',el_pbl)

do j = jts,jte
do i = its,ite
delta(i) = delta_p(i,j)
wstar(i) = wstar_p(i,j)
enddo
do k = kts,kte
do i = its,ite
exch_h(k,i) = exch_p(i,k,j)
tke_pbl(k,i) = tkepbl_p(i,k,j)
el_pbl(k,i) = elpbl_p(i,k,j)
enddo
enddo
enddo

case("bl_ysu")
call mpas_pool_get_array(diag_physics,'delta',delta )
call mpas_pool_get_array(diag_physics,'wstar' ,wstar )
Expand Down Expand Up @@ -774,6 +887,10 @@ subroutine driver_pbl(itimestep,configs,mesh,sfc_input,diag_physics,tend_physics
config_do_restart, &
bl_mynn_tkeadvect

logical,pointer:: config_shinhong_nonlocal_flux, &
config_shinhong_scu_mixing, &
config_shinhong_ke_dissipation

character(len=StrKIND),pointer:: pbl_scheme

integer,pointer:: bl_mynn_cloudpdf, &
Expand Down Expand Up @@ -822,6 +939,43 @@ subroutine driver_pbl(itimestep,configs,mesh,sfc_input,diag_physics,tend_physics

pbl_select: select case (trim(pbl_scheme))

case("bl_shinhong")
call mpas_timer_start('bl_shinhong')
call mpas_pool_get_config(configs,'config_shinhong_nonlocal_flux',config_shinhong_nonlocal_flux)
call mpas_pool_get_config(configs,'config_shinhong_scu_mixing',config_shinhong_scu_mixing)
call mpas_pool_get_config(configs,'config_shinhong_ke_dissipation',config_shinhong_ke_dissipation)

call shinhong ( &
p3d = pres_hyd_p , p3di = pres2_hyd_p , psfc = psfc_p , &
t3d = t_p , dz8w = dz_p , pi3d = pi_p , &
u3d = u_p , v3d = v_p , qv3d = qv_p , &
qc3d = qc_p , qi3d = qi_p , rublten = rublten_p , &
rvblten = rvblten_p , rthblten = rthblten_p , rqvblten = rqvblten_p , &
rqcblten = rqcblten_p , rqiblten = rqiblten_p , flag_qc = f_qc , &
flag_qi = f_qi , cp = cp , g = gravity , &
rovcp = rcp , rd = R_d , rovg = rdg , &
ep1 = ep_1 , ep2 = ep_2 , karman = karman , &
xlv = xlv , rv = R_v , znt = znt_p , &
ust = ust_p , hpbl = hpbl_p , psim = psim_p , &
psih = psih_p , xland = xland_p , hfx = hfx_p , &
qfx = qfx_p , wspd = wspd_p , br = br_p , &
dt = dt_pbl , kpbl2d = kpbl_p , exch_h = kzh_p , &
exch_m = kzm_p , wstar = wstar_p , delta = delta_p , &
shinhong_nonlocal_flux = config_shinhong_nonlocal_flux , &
shinhong_dissi_heating = config_shinhong_ke_dissipation , &
shinhong_scu_mixing = config_shinhong_scu_mixing , &
tke = tkepbl_p , el= elpbl_p , corf=fcell_p , &
uoce = uoce_p , voce = voce_p , rthraten = rthraten_p , &
u10 = u10_p , v10 = v10_p , ctopo = ctopo_p , &
ctopo2 = ctopo2_p , flag_bep = flag_bep , idiff = idiff , &
dx = dx_p , &
errmsg = errmsg , errflg = errflg , &
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 &
)
call mpas_timer_stop('bl_shinhong')

case("bl_ysu")
call mpas_timer_start('bl_ysu')
call ysu ( &
Expand Down
11 changes: 9 additions & 2 deletions src/core_atmosphere/physics/mpas_atmphys_packages.F
Original file line number Diff line number Diff line change
Expand Up @@ -39,7 +39,7 @@ function atmphys_setup_packages(configs,packages,iocontext) result(ierr)
character(len=StrKIND),pointer:: config_lsm_scheme
logical,pointer:: mp_kessler_in,mp_thompson_in,mp_thompson_aers_in,mp_wsm6_in
logical,pointer:: cu_grell_freitas_in,cu_kain_fritsch_in,cu_ntiedtke_in
logical,pointer:: bl_mynn_in,bl_ysu_in
logical,pointer:: bl_mynn_in,bl_ysu_in,bl_shinhong_in
logical,pointer:: sf_noahmp_in

integer :: ierr
Expand Down Expand Up @@ -150,8 +150,11 @@ function atmphys_setup_packages(configs,packages,iocontext) result(ierr)
nullify(bl_ysu_in)
call mpas_pool_get_package(packages,'bl_ysu_inActive',bl_ysu_in)

nullify(bl_shinhong_in)
call mpas_pool_get_package(packages,'bl_shinhong_inActive',bl_shinhong_in)

if(.not.associated(bl_mynn_in) .or. &
.not.associated(bl_ysu_in)) then
.not.associated(bl_ysu_in) .or. .not.associated(bl_shinhong_in) ) then
call mpas_log_write('====================================================================================',messageType=MPAS_LOG_ERR)
call mpas_log_write('* Error while setting up packages for planetary layer options in atmosphere core.', messageType=MPAS_LOG_ERR)
call mpas_log_write('====================================================================================',messageType=MPAS_LOG_ERR)
Expand All @@ -161,15 +164,19 @@ function atmphys_setup_packages(configs,packages,iocontext) result(ierr)

bl_mynn_in = .false.
bl_ysu_in = .false.
bl_shinhong_in = .false.

if(config_pbl_scheme=='bl_mynn') then
bl_mynn_in = .true.
elseif(config_pbl_scheme == 'bl_ysu') then
bl_ysu_in = .true.
elseif(config_pbl_scheme == 'bl_shinhong') then
bl_shinhong_in = .true.
endif

call mpas_log_write(' bl_mynn_in = $l', logicArgs=(/bl_mynn_in/))
call mpas_log_write(' bl_ysu_in = $l', logicArgs=(/bl_ysu_in/))
call mpas_log_write(' bl_shinhong_in = $l', logicArgs=(/bl_shinhong_in/))
call mpas_log_write('')

!--- initialization of all packages for parameterizations of land surface processes:
Expand Down
Loading