From 67cff7f4f5e29bc6e06ccf3adb9956e148ce4f3a Mon Sep 17 00:00:00 2001 From: Song You Hong Date: Wed, 30 Jul 2025 11:38:59 -0600 Subject: [PATCH 1/5] kim-gwdo option that is revised from the ysu-gwdo Committer: Song You Hong On branch KIM_GWDO Changes to be committed: modified: src/core_atmosphere/Registry.xml modified: src/core_atmosphere/physics/mpas_atmphys_driver_gwdo.F modified: src/core_atmosphere/physics/mpas_atmphys_driver_sfclayer.F modified: src/core_atmosphere/physics/mpas_atmphys_vars.F modified: src/core_atmosphere/physics/physics_wrf/module_bl_gwdo.F modified: src/core_atmosphere/physics/physics_wrf/module_sf_sfclayrev.F modified: src/core_init_atmosphere/Registry.xml modified: src/core_init_atmosphere/mpas_init_atm_gwd.F --- src/core_atmosphere/Registry.xml | 3 + .../physics/mpas_atmphys_driver_gwdo.F | 11 ++- .../physics/mpas_atmphys_driver_sfclayer.F | 12 ++- .../physics/mpas_atmphys_vars.F | 2 + .../physics/physics_wrf/module_bl_gwdo.F | 7 +- .../physics/physics_wrf/module_sf_sfclayrev.F | 8 +- src/core_init_atmosphere/Registry.xml | 8 +- src/core_init_atmosphere/mpas_init_atm_gwd.F | 73 ++++++++++++------- 8 files changed, 86 insertions(+), 38 deletions(-) diff --git a/src/core_atmosphere/Registry.xml b/src/core_atmosphere/Registry.xml index 4281c40bba..6c4f13c417 100644 --- a/src/core_atmosphere/Registry.xml +++ b/src/core_atmosphere/Registry.xml @@ -521,6 +521,7 @@ + @@ -3782,6 +3783,8 @@ + - @@ -463,6 +463,7 @@ + @@ -568,6 +569,7 @@ + @@ -932,6 +934,10 @@ + + box_mean) nu = nu + 1 - end do + if(mod(nx,2).eq.0.) then + do i=1,nx/2 + if (box(i,j) > box_mean) nu = nu + 1 + end do + else + do i=1,nx/2 + 1 + if (box(i,j) > box_mean) nu = nu + 1 + end do + endif + do i=nx/2+1,nx if (box(i,j) > box_mean) nd = nd + 1 end do @@ -987,11 +994,19 @@ real (kind=RKIND) function get_oa2(box, box_mean, nx, ny) nu = 0 nd = 0 - do j=1,ny/2 - do i=1,nx + if(mod(ny,2).eq.0.) then + do j=1,ny/2 + do i=1,nx if (box(i,j) > box_mean) nu = nu + 1 - end do - end do + end do + end do + else + do j=1,ny/2 + 1 + do i=1,nx + if (box(i,j) > box_mean) nu = nu + 1 + end do + end do + endif do j=ny/2+1,ny do i=1,nx if (box(i,j) > box_mean) nd = nd + 1 @@ -1036,9 +1051,10 @@ real (kind=RKIND) function get_oa3(box, box_mean, nx, ny) ratio = real(ny,RKIND)/real(nx,RKIND) do j=1,ny do i=1,nx - if (nint(real(i,RKIND) * ratio) < (ny - j)) then + if (nint(real(i,RKIND) * ratio) <= (ny - j + 1)) then if (box(i,j) > box_mean) nu = nu + 1 - else + endif + if (nint(real(i,RKIND) * ratio) >= (ny - j + 1)) then if (box(i,j) > box_mean) nd = nd + 1 end if end do @@ -1082,9 +1098,10 @@ real (kind=RKIND) function get_oa4(box, box_mean, nx, ny) ratio = real(ny,RKIND)/real(nx,RKIND) do j=1,ny do i=1,nx - if (nint(real(i,RKIND) * ratio) < j) then + if (nint(real(i,RKIND) * ratio) <= j) then if (box(i,j) > box_mean) nu = nu + 1 - else + endif + if (nint(real(i,RKIND) * ratio) >= j) then if (box(i,j) > box_mean) nd = nd + 1 end if end do @@ -1109,10 +1126,11 @@ end function get_oa4 !> \details ! !----------------------------------------------------------------------- - real (kind=RKIND) function get_ol1(box, nx, ny) + real (kind=RKIND) function get_ol1(box, box_mean, nx, ny) implicit none + real (kind=RKIND), intent(in) :: box_mean real (kind=RKIND), dimension(:,:), pointer, intent(in) :: box ! Subset of topography covering a grid cell integer, intent(in) :: nx, ny @@ -1125,7 +1143,7 @@ real (kind=RKIND) function get_ol1(box, nx, ny) do j=ny/4,3*ny/4 do i=1,nx - if (box(i,j) > hc) nw = nw + 1 + if (box(i,j) > box_mean) nw = nw + 1 nt = nt + 1 end do end do @@ -1145,10 +1163,11 @@ end function get_ol1 !> \details ! !----------------------------------------------------------------------- - real (kind=RKIND) function get_ol2(box, nx, ny) + real (kind=RKIND) function get_ol2(box, box_mean, nx, ny) implicit none + real (kind=RKIND), intent(in) :: box_mean real (kind=RKIND), dimension(:,:), pointer, intent(in) :: box ! Subset of topography covering a grid cell integer, intent(in) :: nx, ny @@ -1161,7 +1180,7 @@ real (kind=RKIND) function get_ol2(box, nx, ny) do j=1,ny do i=nx/4,3*nx/4 - if (box(i,j) > hc) nw = nw + 1 + if (box(i,j) > box_mean) nw = nw + 1 nt = nt + 1 end do end do @@ -1181,10 +1200,11 @@ end function get_ol2 !> \details ! !----------------------------------------------------------------------- - real (kind=RKIND) function get_ol3(box, nx, ny) + real (kind=RKIND) function get_ol3(box, box_mean, nx, ny) implicit none + real (kind=RKIND), intent(in) :: box_mean real (kind=RKIND), dimension(:,:), pointer, intent(in) :: box ! Subset of topography covering a grid cell integer, intent(in) :: nx, ny @@ -1197,7 +1217,7 @@ real (kind=RKIND) function get_ol3(box, nx, ny) do j=1,ny/2 do i=1,nx/2 - if (box(i,j) > hc) nw = nw + 1 + if (box(i,j) > box_mean) nw = nw + 1 nt = nt + 1 end do end do @@ -1223,10 +1243,11 @@ end function get_ol3 !> \details ! !----------------------------------------------------------------------- - real (kind=RKIND) function get_ol4(box, nx, ny) + real (kind=RKIND) function get_ol4(box, box_mean, nx, ny) implicit none + real (kind=RKIND), intent(in) :: box_mean real (kind=RKIND), dimension(:,:), pointer, intent(in) :: box ! Subset of topography covering a grid cell integer, intent(in) :: nx, ny @@ -1239,13 +1260,13 @@ real (kind=RKIND) function get_ol4(box, nx, ny) do j=ny/2+1,ny do i=1,nx/2 - if (box(i,j) > hc) nw = nw + 1 + if (box(i,j) > box_mean) nw = nw + 1 nt = nt + 1 end do end do do j=1,ny/2 do i=nx/2+1,nx - if (box(i,j) > hc) nw = nw + 1 + if (box(i,j) > box_mean) nw = nw + 1 nt = nt + 1 end do end do From df35a583668c0a4ebb66675e6fd4272d4e4bb860 Mon Sep 17 00:00:00 2001 From: Song You Hong Date: Sat, 2 Aug 2025 15:10:53 -0600 Subject: [PATCH 2/5] Rename bl_ysu_gwdo to bl_kim_gwdo add namelist variables Your branch is up to date with 'origin/KIM_GWDO'. Changes to be committed: modified: core_atmosphere/Registry.xml modified: core_atmosphere/physics/mpas_atmphys_control.F modified: core_atmosphere/physics/mpas_atmphys_driver.F modified: core_atmosphere/physics/mpas_atmphys_driver_gwdo.F modified: core_atmosphere/physics/mpas_atmphys_driver_sfclayer.F modified: core_atmosphere/physics/physics_wrf/module_bl_gwdo.F modified: core_atmosphere/physics/physics_wrf/module_sf_sfclayrev.F --- src/core_atmosphere/Registry.xml | 18 ++- .../physics/mpas_atmphys_control.F | 10 +- .../physics/mpas_atmphys_driver.F | 1 + .../physics/mpas_atmphys_driver_gwdo.F | 107 ++---------------- .../physics/mpas_atmphys_driver_sfclayer.F | 6 + .../physics/physics_wrf/module_bl_gwdo.F | 4 + .../physics/physics_wrf/module_sf_sfclayrev.F | 4 + 7 files changed, 50 insertions(+), 100 deletions(-) diff --git a/src/core_atmosphere/Registry.xml b/src/core_atmosphere/Registry.xml index 6c4f13c417..ff513a5794 100644 --- a/src/core_atmosphere/Registry.xml +++ b/src/core_atmosphere/Registry.xml @@ -2279,7 +2279,7 @@ + possible_values="`suite',`bl_kim_gwdo',`bl_ugwp_gwdo',`off'"/> + + + + diff --git a/src/core_atmosphere/physics/mpas_atmphys_control.F b/src/core_atmosphere/physics/mpas_atmphys_control.F index b3162019e5..1ff0417d4e 100644 --- a/src/core_atmosphere/physics/mpas_atmphys_control.F +++ b/src/core_atmosphere/physics/mpas_atmphys_control.F @@ -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. +! * renamed "bl_ysu_gwdo" to "bl_kim_gwdo" +! Songyou Hong (hong@ucar.edu) / 2025-08-24. contains @@ -133,7 +135,7 @@ 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_gwdo_scheme) == 'suite') config_gwdo_scheme = 'bl_kim_gwdo' if (trim(config_radt_lw_scheme) == 'suite') config_radt_lw_scheme = 'rrtmg_lw' 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' @@ -145,7 +147,7 @@ subroutine physics_namelist_check(configs) if (trim(config_microp_scheme) == 'suite') config_microp_scheme = 'mp_thompson' if (trim(config_convection_scheme) == 'suite') config_convection_scheme = 'cu_grell_freitas' if (trim(config_pbl_scheme) == 'suite') config_pbl_scheme = 'bl_mynn' - if (trim(config_gwdo_scheme) == 'suite') config_gwdo_scheme = 'bl_ysu_gwdo' + if (trim(config_gwdo_scheme) == 'suite') config_gwdo_scheme = 'bl_kim_gwdo' if (trim(config_radt_lw_scheme) == 'suite') config_radt_lw_scheme = 'rrtmg_lw' 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' @@ -211,7 +213,7 @@ subroutine physics_namelist_check(configs) !gravity wave drag over orography scheme: if(.not. (config_gwdo_scheme .eq. 'off' .or. & - config_gwdo_scheme .eq. 'bl_ysu_gwdo' .or. & + config_gwdo_scheme .eq. 'bl_kim_gwdo' .or. & config_gwdo_scheme .eq. 'bl_ugwp_gwdo')) then write(mpas_err_message,'(A,A20)') 'illegal value for gwdo_scheme: ', & @@ -481,7 +483,7 @@ subroutine physics_compatibility_check(dminfo, blockList, streamManager, ierr) call mpas_pool_get_config(blocklist % configs, 'config_gwdo_scheme', gwdo_scheme) - if (trim(gwdo_scheme) == 'bl_ysu_gwdo') then + if (trim(gwdo_scheme) == 'bl_kim_gwdo') then maxvar2d_local = -huge(maxvar2d_local) block => blockList do while (associated(block)) diff --git a/src/core_atmosphere/physics/mpas_atmphys_driver.F b/src/core_atmosphere/physics/mpas_atmphys_driver.F index 8e31672657..134d8ee904 100644 --- a/src/core_atmosphere/physics/mpas_atmphys_driver.F +++ b/src/core_atmosphere/physics/mpas_atmphys_driver.F @@ -143,6 +143,7 @@ subroutine physics_driver(domain,itimestep,xtime_s) config_sfclayer_scheme logical, pointer:: config_oml1d + logical, pointer:: config_gwdo_nonhyd, config_kim_tofd real(kind=RKIND),pointer:: config_bucket_radt !local variables: diff --git a/src/core_atmosphere/physics/mpas_atmphys_driver_gwdo.F b/src/core_atmosphere/physics/mpas_atmphys_driver_gwdo.F index 1fa749f690..c95b4402a7 100644 --- a/src/core_atmosphere/physics/mpas_atmphys_driver_gwdo.F +++ b/src/core_atmosphere/physics/mpas_atmphys_driver_gwdo.F @@ -10,22 +10,17 @@ module mpas_atmphys_driver_gwdo use mpas_kind_types use mpas_pool_routines use mpas_timer,only: mpas_timer_start,mpas_timer_stop - use mpas_atmphys_constants use mpas_atmphys_vars use mpas_atmphys_manager,only: curr_julday - !wrf physics: use module_bl_gwdo use module_bl_ugwp_gwdo - implicit none private public:: allocate_gwdo, & deallocate_gwdo, & driver_gwdo - - !MPAS driver for parameterization of gravity wave drag over orography. !Laura D. Fowler (send comments to laura@ucar.edu). !2013-05-01. @@ -66,29 +61,22 @@ module mpas_atmphys_driver_gwdo ! Laura D. Fowler (laura@ucar.edu) / 2023-05-15. ! * added the NOAA UFS unified gravity wave drag scheme ! Michael D. Toy (michael.toy@noaa.gov) / 2024-10-21 - - +! * Revised the ysu_gwdo follwing the studies (hong et al. 2025, koo and hong 2025), and renamed to kim_gwdo +! Songyou Hong (hong@ucar.edu) / 2025-11-27 contains - - !================================================================================================================= subroutine allocate_gwdo(configs) !================================================================================================================= - !input arguments: type(mpas_pool_type),intent(in):: configs - !local variables: character(len=StrKIND),pointer:: gwdo_scheme logical,pointer:: ugwp_diags,ngw_scheme - call mpas_pool_get_config(configs,'config_gwdo_scheme',gwdo_scheme) call mpas_pool_get_config(configs,'config_ugwp_diags',ugwp_diags) call mpas_pool_get_config(configs,'config_ngw_scheme',ngw_scheme) - if(.not.allocated(cosa_p) ) allocate(cosa_p(ims:ime,jms:jme) ) if(.not.allocated(sina_p) ) allocate(sina_p(ims:ime,jms:jme) ) - if(.not.allocated(dx_p) ) allocate(dx_p(ims:ime,jms:jme) ) if(.not.allocated(kpbl_p )) allocate(kpbl_p(ims:ime,jms:jme) ) if(.not.allocated(dusfcg_p)) allocate(dusfcg_p(ims:ime,jms:jme)) @@ -98,10 +86,8 @@ subroutine allocate_gwdo(configs) if(.not.allocated(rublten_p)) allocate(rublten_p(ims:ime,kms:kme,jms:jme)) if(.not.allocated(rvblten_p)) allocate(rvblten_p(ims:ime,kms:kme,jms:jme)) if(.not.allocated(rthblten_p)) allocate(rthblten_p(ims:ime,kms:kme,jms:jme)) - gwdo_select: select case (trim(gwdo_scheme)) - - case("bl_ysu_gwdo") + case("bl_kim_gwdo") if(.not.allocated(var2d_p) ) allocate(var2d_p(ims:ime,jms:jme) ) if(.not.allocated(con_p) ) allocate(con_p(ims:ime,jms:jme) ) if(.not.allocated(oa1_p) ) allocate(oa1_p(ims:ime,jms:jme) ) @@ -113,8 +99,6 @@ subroutine allocate_gwdo(configs) if(.not.allocated(ol3_p) ) allocate(ol3_p(ims:ime,jms:jme) ) if(.not.allocated(ol4_p) ) allocate(ol4_p(ims:ime,jms:jme) ) if(.not.allocated(elvmax_p)) allocate(elvmax_p(ims:ime,jms:jme)) - - case("bl_ugwp_gwdo") if(.not.allocated(var2dls_p) ) allocate(var2dls_p(ims:ime,jms:jme) ) if(.not.allocated(conls_p) ) allocate(conls_p(ims:ime,jms:jme) ) @@ -171,31 +155,22 @@ subroutine allocate_gwdo(configs) if(.not.allocated(ddy_j1tau_p)) allocate(ddy_j1tau_p(ims:ime,jms:jme)) if(.not.allocated(ddy_j2tau_p)) allocate(ddy_j2tau_p(ims:ime,jms:jme)) endif - case default - end select gwdo_select - end subroutine allocate_gwdo - !================================================================================================================= subroutine deallocate_gwdo(configs) !================================================================================================================= - !input arguments: type(mpas_pool_type),intent(in):: configs - !local variables: character(len=StrKIND),pointer:: gwdo_scheme logical,pointer:: ugwp_diags,ngw_scheme - call mpas_pool_get_config(configs,'config_gwdo_scheme',gwdo_scheme) call mpas_pool_get_config(configs,'config_ugwp_diags',ugwp_diags) call mpas_pool_get_config(configs,'config_ngw_scheme',ngw_scheme) - if(allocated(cosa_p) ) deallocate(cosa_p ) if(allocated(sina_p) ) deallocate(sina_p ) - if(allocated(dx_p) ) deallocate(dx_p ) if(allocated(kpbl_p) ) deallocate(kpbl_p ) if(allocated(dusfcg_p)) deallocate(dusfcg_p) @@ -205,10 +180,8 @@ subroutine deallocate_gwdo(configs) if(allocated(rublten_p)) deallocate(rublten_p) if(allocated(rvblten_p)) deallocate(rvblten_p) if(allocated(rthblten_p)) deallocate(rthblten_p) - gwdo_select: select case (trim(gwdo_scheme)) - - case("bl_ysu_gwdo") + case("bl_kim_gwdo") if(allocated(var2d_p) ) deallocate(var2d_p ) if(allocated(con_p) ) deallocate(con_p ) if(allocated(oa1_p) ) deallocate(oa1_p ) @@ -220,7 +193,6 @@ subroutine deallocate_gwdo(configs) if(allocated(ol3_p) ) deallocate(ol3_p ) if(allocated(ol4_p) ) deallocate(ol4_p ) if(allocated(elvmax_p)) deallocate(elvmax_p) - case("bl_ugwp_gwdo") if(allocated(var2dls_p) ) deallocate(var2dls_p ) if(allocated(conls_p) ) deallocate(conls_p ) @@ -277,17 +249,12 @@ subroutine deallocate_gwdo(configs) if(allocated(ddy_j1tau_p)) deallocate(ddy_j1tau_p) if(allocated(ddy_j2tau_p)) deallocate(ddy_j2tau_p) endif - case default - end select gwdo_select - end subroutine deallocate_gwdo - !================================================================================================================= subroutine gwdo_from_MPAS(configs,mesh,sfc_input,ngw_input,diag_physics,tend_physics,its,ite) !================================================================================================================= - !input arguments: type(mpas_pool_type),intent(in):: configs type(mpas_pool_type),intent(in):: mesh @@ -295,16 +262,13 @@ subroutine gwdo_from_MPAS(configs,mesh,sfc_input,ngw_input,diag_physics,tend_phy type(mpas_pool_type),intent(in):: ngw_input type(mpas_pool_type),intent(in):: diag_physics type(mpas_pool_type),intent(in):: tend_physics - integer,intent(in):: its,ite - !local variables: integer:: i,k,j character(len=StrKIND),pointer:: gwdo_scheme character(len=StrKIND),pointer:: convection_scheme,microp_scheme logical,pointer:: ugwp_diags,ngw_scheme real(kind=RKIND),parameter :: rad2deg = 180./3.1415926 - !local pointers: integer,dimension(:),pointer:: kpbl integer,dimension(:),pointer:: jindx1_tau,jindx2_tau @@ -325,9 +289,7 @@ subroutine gwdo_from_MPAS(configs,mesh,sfc_input,ngw_input,diag_physics,tend_phy real(kind=RKIND),dimension(:,:),pointer:: dtaux3d_ls,dtauy3d_ls,dtaux3d_bl,dtauy3d_bl, & dtaux3d_ss,dtauy3d_ss,dtaux3d_fd,dtauy3d_fd real(kind=RKIND),dimension(:,:),pointer:: dudt_ngw,dvdt_ngw,dtdt_ngw - !----------------------------------------------------------------------------------------------------------------- - call mpas_pool_get_config(configs,'config_len_disp',len_disp) call mpas_pool_get_config(configs,'config_gwdo_scheme',gwdo_scheme) call mpas_pool_get_config(configs,'config_ugwp_diags',ugwp_diags) @@ -335,11 +297,8 @@ subroutine gwdo_from_MPAS(configs,mesh,sfc_input,ngw_input,diag_physics,tend_phy call mpas_pool_get_config(configs,'config_convection_scheme',convection_scheme) call mpas_pool_get_config(configs,'config_microp_scheme',microp_scheme) call mpas_pool_get_array(mesh,'meshDensity',meshDensity) - - gwdo_select: select case (trim(gwdo_scheme)) - - case("bl_ysu_gwdo") + case("bl_kim_gwdo") call mpas_pool_get_array(sfc_input,'var2d',var2d) call mpas_pool_get_array(sfc_input,'elvmax',elvmax) call mpas_pool_get_array(sfc_input,'con' ,con ) @@ -366,7 +325,6 @@ subroutine gwdo_from_MPAS(configs,mesh,sfc_input,ngw_input,diag_physics,tend_phy elvmax_p(i,j)= elvmax(i) enddo enddo - case("bl_ugwp_gwdo") call mpas_pool_get_array(sfc_input,'var2dls',var2dls) call mpas_pool_get_array(sfc_input,'conls' ,conls ) @@ -514,14 +472,9 @@ subroutine gwdo_from_MPAS(configs,mesh,sfc_input,ngw_input,diag_physics,tend_phy enddo enddo endif - endif - case default - end select gwdo_select - - call mpas_pool_get_array(diag_physics,'kpbl' ,kpbl ) call mpas_pool_get_array(diag_physics,'dusfcg' ,dusfcg ) call mpas_pool_get_array(diag_physics,'dvsfcg' ,dvsfcg ) @@ -530,7 +483,6 @@ subroutine gwdo_from_MPAS(configs,mesh,sfc_input,ngw_input,diag_physics,tend_phy call mpas_pool_get_array(tend_physics,'rublten' ,rublten ) call mpas_pool_get_array(tend_physics,'rvblten' ,rvblten ) call mpas_pool_get_array(tend_physics,'rthblten',rthblten) - do j = jts,jte do i = its,ite sina_p(i,j) = 0._RKIND @@ -541,7 +493,6 @@ subroutine gwdo_from_MPAS(configs,mesh,sfc_input,ngw_input,diag_physics,tend_phy dvsfcg_p(i,j) = dvsfcg(i) enddo enddo - do j = jts,jte do k = kts,kte do i = its,ite @@ -553,31 +504,24 @@ subroutine gwdo_from_MPAS(configs,mesh,sfc_input,ngw_input,diag_physics,tend_phy enddo enddo enddo - end subroutine gwdo_from_MPAS - !================================================================================================================= subroutine gwdo_to_MPAS(configs,diag_physics,tend_physics,its,ite) !================================================================================================================= - !input arguments: integer,intent(in):: its,ite type(mpas_pool_type),intent(in):: configs - !inout arguments: type(mpas_pool_type),intent(inout):: diag_physics type(mpas_pool_type),intent(inout):: tend_physics - !local variables: integer:: i,k,j character(len=StrKIND),pointer:: gwdo_scheme logical,pointer:: ugwp_diags,ngw_scheme - !local pointers: real(kind=RKIND),dimension(:),pointer :: dusfcg,dvsfcg real(kind=RKIND),dimension(:,:),pointer:: dtaux3d,dtauy3d,rubldiff,rvbldiff,rublten,rvblten real(kind=RKIND),dimension(:,:),pointer:: rthblten - real(kind=RKIND),dimension(:),pointer :: oa1ls,oa2ls,oa3ls,oa4ls,ol1ls,ol2ls, & ol3ls,ol4ls,conls,var2dls real(kind=RKIND),dimension(:),pointer :: oa1ss,oa2ss,oa3ss,oa4ss,ol1ss,ol2ss, & @@ -587,9 +531,7 @@ subroutine gwdo_to_MPAS(configs,diag_physics,tend_physics,its,ite) real(kind=RKIND),dimension(:,:),pointer:: dtaux3d_ls,dtauy3d_ls,dtaux3d_bl,dtauy3d_bl, & dtaux3d_ss,dtauy3d_ss,dtaux3d_fd,dtauy3d_fd real(kind=RKIND),dimension(:,:),pointer:: dudt_ngw,dvdt_ngw,dtdt_ngw - !----------------------------------------------------------------------------------------------------------------- - call mpas_pool_get_config(configs,'config_gwdo_scheme',gwdo_scheme) call mpas_pool_get_config(configs,'config_ugwp_diags',ugwp_diags) call mpas_pool_get_config(configs,'config_ngw_scheme',ngw_scheme) @@ -602,10 +544,7 @@ subroutine gwdo_to_MPAS(configs,diag_physics,tend_physics,its,ite) call mpas_pool_get_array(tend_physics,'rublten' ,rublten ) call mpas_pool_get_array(tend_physics,'rvblten' ,rvblten ) call mpas_pool_get_array(tend_physics,'rthblten',rthblten) - - gwdo_select: select case (trim(gwdo_scheme)) - case("bl_ugwp_gwdo") if (ugwp_diags) then call mpas_pool_get_array(diag_physics,'dusfc_ls' ,dusfc_ls ) @@ -665,18 +604,14 @@ subroutine gwdo_to_MPAS(configs,diag_physics,tend_physics,its,ite) enddo endif endif - case default - end select gwdo_select - do j = jts,jte do i = its,ite dusfcg(i) = dusfcg_p(i,j) dvsfcg(i) = dvsfcg_p(i,j) enddo enddo - do j = jts,jte do k = kts,kte do i = its,ite @@ -690,55 +625,45 @@ subroutine gwdo_to_MPAS(configs,diag_physics,tend_physics,its,ite) enddo enddo enddo - end subroutine gwdo_to_MPAS - !================================================================================================================= subroutine driver_gwdo(itimestep,configs,mesh,sfc_input,ngw_input,diag_physics,tend_physics,its,ite) !================================================================================================================= - !input arguments: type(mpas_pool_type),intent(in):: configs type(mpas_pool_type),intent(in):: mesh type(mpas_pool_type),intent(in):: sfc_input - integer,intent(in):: its,ite integer,intent(in):: itimestep - !inout arguments: type(mpas_pool_type),intent(inout):: ngw_input type(mpas_pool_type),intent(inout):: diag_physics type(mpas_pool_type),intent(inout):: tend_physics - !local variables: character(len=StrKIND),pointer:: gwdo_scheme logical,pointer:: ugwp_diags,ngw_scheme + logical,pointer:: if_nonhyd integer,pointer:: ntau_d1y_ptr,ntau_d2t_ptr real(kind=RKIND),dimension(:),pointer :: days_limb_ptr real(kind=RKIND),dimension(:,:),pointer:: tau_limb_ptr integer:: ntau_d1y,ntau_d2t real(kind=RKIND),dimension(:),allocatable:: days_limb real(kind=RKIND),dimension(:,:),allocatable:: tau_limb - integer:: i real(kind=RKIND),dimension(:),allocatable:: dx_max - + real(kind=RKIND),pointer :: dx_factor !CCPP-compliant flags: character(len=StrKIND):: errmsg integer:: errflg - !----------------------------------------------------------------------------------------------------------------- !call mpas_log_write('') !call mpas_log_write('--- enter subroutine driver_gwdo:') - !initialization of CCPP-compliant flags: errmsg = ' ' errflg = 0 - call mpas_pool_get_config(configs,'config_gwdo_scheme',gwdo_scheme) call mpas_pool_get_config(configs,'config_ugwp_diags',ugwp_diags) call mpas_pool_get_config(configs,'config_ngw_scheme',ngw_scheme) - ! Call up variables needed for NGW scheme if (ngw_scheme) then call mpas_pool_get_dimension(mesh,'lat',ntau_d1y_ptr) @@ -752,14 +677,12 @@ subroutine driver_gwdo(itimestep,configs,mesh,sfc_input,ngw_input,diag_physics,t days_limb(:) = days_limb_ptr(:) tau_limb (:,:) = tau_limb_ptr(:,:) endif - - !copy MPAS arrays to local arrays: call gwdo_from_MPAS(configs,mesh,sfc_input,ngw_input,diag_physics,tend_physics,its,ite) - gwdo_select: select case (trim(gwdo_scheme)) - - case("bl_ysu_gwdo") + case("bl_kim_gwdo") + call mpas_pool_get_config(configs,'config_gwdo_factor',dx_factor) + call mpas_pool_get_config(configs,'config_gwdo_nonhyd',if_nonhyd) call mpas_timer_start('bl_gwdo') call gwdo ( & p3d = pres_hydd_p , p3di = pres2_hydd_p , pi3d = pi_p , & @@ -774,13 +697,13 @@ subroutine driver_gwdo(itimestep,configs,mesh,sfc_input,ngw_input,diag_physics,t oa2d2 = oa2_p , oa2d3 = oa3_p , oa2d4 = oa4_p , & ol2d1 = ol1_p , ol2d2 = ol2_p , ol2d3 = ol3_p , & ol2d4 = ol4_p , elvmax = elvmax_p , sina = sina_p , & - cosa = cosa_p , errmsg = errmsg , errflg = errflg , & + cosa = cosa_p , errmsg = errmsg , errflg = errflg , & + dx_factor = dx_factor , if_nonhyd = if_nonhyd, & 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_gwdo') - case("bl_ugwp_gwdo") call mpas_timer_start('bl_ugwp_gwdo') call gwdo_ugwp ( & @@ -825,19 +748,13 @@ subroutine driver_gwdo(itimestep,configs,mesh,sfc_input,ngw_input,diag_physics,t if(allocated(tau_limb) ) deallocate(tau_limb ) endif call mpas_timer_stop('bl_ugwp_gwdo') - case default - end select gwdo_select - !copy local arrays to MPAS grid: call gwdo_to_MPAS(configs,diag_physics,tend_physics,its,ite) - !call mpas_log_write('--- end subroutine driver_gwdo.') !call mpas_log_write('') - end subroutine driver_gwdo - !================================================================================================================= end module mpas_atmphys_driver_gwdo !================================================================================================================= diff --git a/src/core_atmosphere/physics/mpas_atmphys_driver_sfclayer.F b/src/core_atmosphere/physics/mpas_atmphys_driver_sfclayer.F index f60705a886..81d92d2f2e 100644 --- a/src/core_atmosphere/physics/mpas_atmphys_driver_sfclayer.F +++ b/src/core_atmosphere/physics/mpas_atmphys_driver_sfclayer.F @@ -856,12 +856,14 @@ subroutine driver_sfclayer(itimestep,configs,mesh,diag_physics,sfc_input,its,ite !local pointers: logical,pointer:: config_do_restart,config_frac_seaice + logical,pointer:: config_kim_tofd character(len=StrKIND),pointer:: sfclayer_scheme real(kind=RKIND),dimension(:),pointer:: areaCell !local variables: integer:: initflag real(kind=RKIND):: dx + real(kind=RKIND), pointer :: tofd_factor !CCPP-compliant flags: character(len=StrKIND):: errmsg @@ -878,6 +880,8 @@ subroutine driver_sfclayer(itimestep,configs,mesh,diag_physics,sfc_input,its,ite call mpas_pool_get_config(configs,'config_do_restart' ,config_do_restart ) call mpas_pool_get_config(configs,'config_frac_seaice' ,config_frac_seaice) call mpas_pool_get_config(configs,'config_sfclayer_scheme',sfclayer_scheme ) + call mpas_pool_get_config(configs,'config_kim_tofd' ,config_kim_tofd ) + call mpas_pool_get_config(configs,'config_tofd_factor' ,tofd_factor) call mpas_pool_get_array(mesh,'areaCell',areaCell) @@ -968,6 +972,7 @@ subroutine driver_sfclayer(itimestep,configs,mesh,diag_physics,sfc_input,its,ite lh = lh_p , tsk = tsk_p , flhc = flhc_p , & flqc = flqc_p , qgh = qgh_p , qsfc = qsfc_p , & rmol = rmol_p , var2d = var2d_p , u10 = u10_p , & + if_kim_tofd = config_kim_tofd, tofd_factor = tofd_factor , & v10 = v10_p , & th2 = th2m_p , t2 = t2m_p , q2 = q2_p , & gz1oz0 = gz1oz0_p , wspd = wspd_p , br = br_p , & @@ -999,6 +1004,7 @@ subroutine driver_sfclayer(itimestep,configs,mesh,diag_physics,sfc_input,its,ite lh = lh_sea , tsk = tsk_sea , flhc = flhc_sea , & flqc = flqc_sea , qgh = qgh_sea , qsfc = qsfc_sea , & rmol = rmol_sea , var2d = var2d_p , u10 = u10_sea , & + if_kim_tofd = config_kim_tofd, tofd_factor = tofd_factor , & v10 = v10_sea , & th2 = th2m_sea , t2 = t2m_sea , q2 = q2_sea , & gz1oz0 = gz1oz0_sea , wspd = wspd_sea , br = br_sea , & diff --git a/src/core_atmosphere/physics/physics_wrf/module_bl_gwdo.F b/src/core_atmosphere/physics/physics_wrf/module_bl_gwdo.F index e39e4add27..b7ac54fef6 100644 --- a/src/core_atmosphere/physics/physics_wrf/module_bl_gwdo.F +++ b/src/core_atmosphere/physics/physics_wrf/module_bl_gwdo.F @@ -19,6 +19,7 @@ subroutine gwdo(u3d,v3d,t3d,qv3d,p3d,p3di,pi3d,z, & elvmax,sina,cosa,znu,znw,p_top, & cp,g,rd,rv,ep1,pi, & dt,dx,kpbl2d,itimestep, & + dx_factor,if_nonhyd, & ids,ide, jds,jde, kds,kde, & ims,ime, jms,jme, kms,kme, & its,ite, jts,jte, kts,kte, & @@ -76,6 +77,8 @@ subroutine gwdo(u3d,v3d,t3d,qv3d,p3d,p3di,pi3d,z, & integer,intent(in),dimension(ims:ime,jms:jme):: kpbl2d real(kind=kind_phys),intent(in):: dt,cp,g,rd,rv,ep1,pi + real(kind=kind_phys),intent(in):: dx_factor + logical ,intent(in):: if_nonhyd real(kind=kind_phys),intent(in),optional:: p_top real(kind=kind_phys),intent(in),dimension(kms:kme),optional:: & @@ -212,6 +215,7 @@ subroutine gwdo(u3d,v3d,t3d,qv3d,p3d,p3di,pi3d,z, & ,ol2d1=ol2d1_hv, ol2d2=ol2d2_hv & ,ol2d3=ol2d3_hv, ol2d4=ol2d4_hv & ,omax=elvmax_hv & + ,dx_factor=dx_factor,if_nonhyd=if_nonhyd & ,g_=g,cp_=cp,rd_=rd,rv_=rv,fv_=ep1,pi_=pi & ,dxmeter=dx_hv,deltim=dt & ,its=its,ite=ite,kte=kte,kme=kte+1 & diff --git a/src/core_atmosphere/physics/physics_wrf/module_sf_sfclayrev.F b/src/core_atmosphere/physics/physics_wrf/module_sf_sfclayrev.F index b6e1f63144..e3fcd527a9 100644 --- a/src/core_atmosphere/physics/physics_wrf/module_sf_sfclayrev.F +++ b/src/core_atmosphere/physics/physics_wrf/module_sf_sfclayrev.F @@ -23,6 +23,7 @@ subroutine sfclayrev(u3d,v3d,t3d,qv3d,p3d,dz8w, & gz1oz0,wspd,br,isfflx,dx, & svp1,svp2,svp3,svpt0,ep1,ep2, & karman,p1000mb,lakemask, & + if_kim_tofd,tofd_factor, & ids,ide,jds,jde,kds,kde, & ims,ime,jms,jme,kms,kme, & its,ite,jts,jte,kts,kte, & @@ -45,6 +46,8 @@ subroutine sfclayrev(u3d,v3d,t3d,qv3d,p3d,dz8w, & real(kind=kind_phys),intent(in):: ep1,ep2,karman real(kind=kind_phys),intent(in):: p1000mb real(kind=kind_phys),intent(in):: cp,g,rovcp,r,xlv + real(kind=kind_phys),intent(in):: tofd_factor + logical ,intent(in):: if_kim_tofd real(kind=kind_phys),intent(in),dimension(ims:ime,jms:jme):: & dx, & @@ -213,6 +216,7 @@ subroutine sfclayrev(u3d,v3d,t3d,qv3d,p3d,dz8w, & psih=psih_hv,fm=fm_hv,fh=fh_hv,xland=xland_hv,lakemask=lakemask_hv, & hfx=hfx_hv,qfx=qfx_hv,tsk=tsk_hv,varf=var2d_hv,u10=u10_hv, & v10=v10_hv,th2=th2_hv,t2=t2_hv,q2=q2_hv,flhc=flhc_hv, & + if_kim_tofd=if_kim_tofd,tofd_factor=tofd_factor, & flqc=flqc_hv,qgh=qgh_hv,qsfc=qsfc_hv,lh=lh_hv, & gz1oz0=gz1oz0_hv,wspd=wspd_hv,br=br_hv,isfflx=l_isfflx,dx=dx_hv, & svp1=svp1,svp2=svp2,svp3=svp3,svpt0=svpt0,ep1=ep1,ep2=ep2,karman=karman, & From 8fea1768bcf3daf10928c5650aef62c81187bbf2 Mon Sep 17 00:00:00 2001 From: Song You Hong Date: Sun, 3 Aug 2025 11:35:38 -0600 Subject: [PATCH 3/5] modified: src/core_init_atmosphere/mpas_init_atm_gwd.F --- src/core_init_atmosphere/mpas_init_atm_gwd.F | 3 +++ 1 file changed, 3 insertions(+) diff --git a/src/core_init_atmosphere/mpas_init_atm_gwd.F b/src/core_init_atmosphere/mpas_init_atm_gwd.F index 656781c240..5e318ca567 100644 --- a/src/core_init_atmosphere/mpas_init_atm_gwd.F +++ b/src/core_init_atmosphere/mpas_init_atm_gwd.F @@ -97,6 +97,9 @@ end subroutine read_geogrid !> con !> ol{1,2,3,4} !> oa{1,2,3,4} + !> + !> Added elvmax for blocking, revised oa and ol computations + !> date : 24 August 2025, Songyou Hong (hong@ucar.edu) ! !----------------------------------------------------------------------- function compute_gwd_fields(domain) result(iErr) From e0d347a692afe4f02c2441234ee5b1f2d3924a8e Mon Sep 17 00:00:00 2001 From: Song You Hong Date: Tue, 5 Aug 2025 16:16:55 -0600 Subject: [PATCH 4/5] name list option modified: core_atmosphere/Registry.xml --- src/core_atmosphere/Registry.xml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/core_atmosphere/Registry.xml b/src/core_atmosphere/Registry.xml index ff513a5794..971a0a5f5b 100644 --- a/src/core_atmosphere/Registry.xml +++ b/src/core_atmosphere/Registry.xml @@ -2456,11 +2456,11 @@ units="-" description="Effective grid length ratio in kim_gwdo scheme" possible_values="Non-negative real values"/> - - From 4d69f94ed4bc2da94025d77daa4b59aafbc28611 Mon Sep 17 00:00:00 2001 From: Song You Hong Date: Thu, 21 Aug 2025 16:31:12 -0600 Subject: [PATCH 5/5] externals --- src/core_atmosphere/Externals.cfg | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/core_atmosphere/Externals.cfg b/src/core_atmosphere/Externals.cfg index 84dc47d1d8..393940f5f0 100644 --- a/src/core_atmosphere/Externals.cfg +++ b/src/core_atmosphere/Externals.cfg @@ -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/Songyou184/MMM-physics.git +branch=KIM_GWDO required = True [GSL_UGWP]