From 67cff7f4f5e29bc6e06ccf3adb9956e148ce4f3a Mon Sep 17 00:00:00 2001 From: Song You Hong Date: Wed, 30 Jul 2025 11:38:59 -0600 Subject: [PATCH 01/19] 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 02/19] 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 03/19] 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 04/19] 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 05/19] 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] From 2485f0e8e0eb6c5cb3475f3c4e0fac113bfc28e3 Mon Sep 17 00:00:00 2001 From: Song You Hong Date: Tue, 23 Dec 2025 11:39:01 -0700 Subject: [PATCH 06/19] modified: Registry.xml modified: mpas_atm_core.F modified: physics/mpas_atmphys_control.F modified: physics/mpas_atmphys_driver_pbl.F modified: physics/mpas_atmphys_packages.F modified: physics/mpas_atmphys_vars.F modified: physics/physics_wrf/Makefile new file: physics/physics_wrf/module_bl_shinhong.F --- src/core_atmosphere/Registry.xml | 156 +- src/core_atmosphere/Registry.xml-org | 3920 +++++++++++++++++ src/core_atmosphere/mpas_atm_core.F | 8 + src/core_atmosphere/physics/.a.swp | Bin 0 -> 12288 bytes .../physics/mpas_atmphys_control.F | 7 +- .../physics/mpas_atmphys_control.F-org | 538 +++ .../physics/mpas_atmphys_control.F-org2 | 540 +++ .../physics/mpas_atmphys_driver_gwdo.F-org | 838 ++++ .../physics/mpas_atmphys_driver_pbl.F | 156 +- .../physics/mpas_atmphys_driver_pbl.F-org | 977 ++++ .../mpas_atmphys_driver_sfclayer.F-org | 1092 +++++ .../physics/mpas_atmphys_packages.F | 11 +- .../physics/mpas_atmphys_packages.F-org | 205 + .../physics/mpas_atmphys_vars.F | 5 +- .../physics/mpas_atmphys_vars.F-org | 957 ++++ .../physics/mpas_atmphys_vars.F-org2 | 959 ++++ .../physics/physics_wrf/Makefile | 1 + .../physics/physics_wrf/module_bl_gwdo.F-org | 241 + .../physics/physics_wrf/module_bl_shinhong.F | 499 +++ .../physics_wrf/module_sf_sfclayrev.F-org | 281 ++ src/core_atmosphere/prt | 300 ++ 21 files changed, 11616 insertions(+), 75 deletions(-) create mode 100644 src/core_atmosphere/Registry.xml-org create mode 100644 src/core_atmosphere/physics/.a.swp create mode 100644 src/core_atmosphere/physics/mpas_atmphys_control.F-org create mode 100644 src/core_atmosphere/physics/mpas_atmphys_control.F-org2 create mode 100644 src/core_atmosphere/physics/mpas_atmphys_driver_gwdo.F-org create mode 100644 src/core_atmosphere/physics/mpas_atmphys_driver_pbl.F-org create mode 100644 src/core_atmosphere/physics/mpas_atmphys_driver_sfclayer.F-org create mode 100644 src/core_atmosphere/physics/mpas_atmphys_packages.F-org create mode 100644 src/core_atmosphere/physics/mpas_atmphys_vars.F-org create mode 100644 src/core_atmosphere/physics/mpas_atmphys_vars.F-org2 create mode 100644 src/core_atmosphere/physics/physics_wrf/module_bl_gwdo.F-org create mode 100644 src/core_atmosphere/physics/physics_wrf/module_bl_shinhong.F create mode 100644 src/core_atmosphere/physics/physics_wrf/module_sf_sfclayrev.F-org create mode 100644 src/core_atmosphere/prt diff --git a/src/core_atmosphere/Registry.xml b/src/core_atmosphere/Registry.xml index 971a0a5f5b..8fe33fdaf5 100644 --- a/src/core_atmosphere/Registry.xml +++ b/src/core_atmosphere/Registry.xml @@ -406,6 +406,7 @@ + @@ -471,6 +472,7 @@ + @@ -1435,10 +1437,13 @@ - - + + + packages="bl_mynn_in;bl_ysu_in;bl_shinhong_in;cu_ntiedtke_in;mp_kessler_in;mp_thompson_in;mp_thompson_aers_in;mp_wsm6_in"/> + packages="bl_mynn_in;bl_ysu_in;bl_shinhong_in;cu_ntiedtke_in;mp_thompson_in;mp_thompson_aers_in;mp_wsm6_in"/> + packages="bl_mynn_in;bl_ysu_in;bl_shinhong_in;cu_ntiedtke_in;mp_kessler_in;mp_thompson_in;mp_thompson_aers_in;mp_wsm6_in"/> + packages="bl_mynn_in;bl_ysu_in;bl_shinhong_in;cu_ntiedtke_in;mp_thompson_in;mp_thompson_aers_in;mp_wsm6_in"/> + + + + + + + possible_values="`suite',`bl_ysu',`bl_shinhong',`bl_mynn',`off'"/> - - @@ -2668,37 +2688,45 @@ + packages="bl_mynn_in;bl_ysu_in;bl_shinhong_in"/> + packages="bl_mynn_in;bl_ysu_in;bl_shinhong_in"/> + packages="bl_mynn_in;bl_ysu_in;bl_shinhong_in"/> + packages="bl_mynn_in;bl_ysu_in;bl_shinhong_in"/> + packages="bl_mynn_in;bl_ysu_in;bl_shinhong_in"/> + - + + + + + packages="bl_ysu_in;bl_shinhong_in"/> + packages="bl_ysu_in;bl_shinhong_in"/> + packages="bl_ysu_in;bl_shinhong_in"/> @@ -2718,10 +2746,6 @@ description="liquid water - liquid water potential temperature covariance" packages="bl_mynn_in"/> - - @@ -2738,10 +2762,6 @@ description="liquid water potential temperature variance" packages="bl_mynn_in"/> - - @@ -2809,121 +2829,121 @@ + packages="bl_mynn_in;bl_ysu_in;bl_shinhong_in"/> + packages="bl_mynn_in;bl_ysu_in;bl_shinhong_in"/> + packages="bl_mynn_in;bl_ysu_in;bl_shinhong_in"/> + packages="bl_mynn_in;bl_ysu_in;bl_shinhong_in"/> + packages="bl_mynn_in;bl_ysu_in;bl_shinhong_in"/> + packages="bl_mynn_in;bl_ysu_in;bl_shinhong_in"/> + packages="bl_mynn_in;bl_ysu_in;bl_shinhong_in"/> + packages="bl_mynn_in;bl_ysu_in;bl_shinhong_in"/> + packages="bl_mynn_in;bl_ysu_in;bl_shinhong_in"/> + packages="bl_mynn_in;bl_ysu_in;bl_shinhong_in"/> + packages="bl_mynn_in;bl_ysu_in;bl_shinhong_in"/> + packages="bl_mynn_in;bl_ysu_in;bl_shinhong_in"/> + packages="bl_mynn_in;bl_ysu_in;bl_shinhong_in"/> + packages="bl_mynn_in;bl_ysu_in;bl_shinhong_in"/> + packages="bl_mynn_in;bl_ysu_in;bl_shinhong_in"/> + packages="bl_mynn_in;bl_ysu_in;bl_shinhong_in"/> + packages="bl_mynn_in;bl_ysu_in;bl_shinhong_in"/> + packages="bl_mynn_in;bl_ysu_in;bl_shinhong_in"/> + packages="bl_mynn_in;bl_ysu_in;bl_shinhong_in"/> + packages="bl_mynn_in;bl_ysu_in;bl_shinhong_in"/> + packages="bl_mynn_in;bl_ysu_in;bl_shinhong_in"/> + packages="bl_mynn_in;bl_ysu_in;bl_shinhong_in"/> + packages="bl_mynn_in;bl_ysu_in;bl_shinhong_in"/> + packages="bl_mynn_in;bl_ysu_in;bl_shinhong_in"/> + packages="bl_mynn_in;bl_ysu_in;bl_shinhong_in"/> + packages="bl_mynn_in;bl_ysu_in;bl_shinhong_in"/> + packages="bl_mynn_in;bl_ysu_in;bl_shinhong_in"/> + packages="bl_ysu_in;bl_shinhong_in"/> + packages="bl_ysu_in;bl_shinhong_in"/> @@ -2945,19 +2965,19 @@ - - - - - @@ -3566,27 +3586,27 @@ + packages="bl_mynn_in;bl_ysu_in;bl_shinhong_in"/> + packages="bl_mynn_in;bl_ysu_in;bl_shinhong_in"/> + packages="bl_mynn_in;bl_ysu_in;bl_shinhong_in"/> + packages="bl_mynn_in;bl_ysu_in;bl_shinhong_in"/> + packages="bl_mynn_in;bl_ysu_in;bl_shinhong_in"/> + packages="bl_mynn_in;bl_ysu_in;bl_shinhong_in"/> - @@ -3912,7 +3932,7 @@ units="kg kg^{-1}" description="Rain water mixing ratio increment"/> - diff --git a/src/core_atmosphere/Registry.xml-org b/src/core_atmosphere/Registry.xml-org new file mode 100644 index 0000000000..4281c40bba --- /dev/null +++ b/src/core_atmosphere/Registry.xml-org @@ -0,0 +1,3920 @@ + + + + + + + + + + + + + + + + + + + + + + +#ifdef DO_PHYSICS + + + + + + + + + +#endif + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +#ifdef MPAS_CAM_DYCORE + + +#endif +#ifdef DO_PHYSICS + + + + + + + + + + + + + + + + + + + + + + + + + + +#endif + + + + + + + + + + + + + + + + + + + + + + +#ifdef DO_PHYSICS + + + + + + + + + + + + + + + + + + + + + +#endif + + + + + + + + + +#ifdef MPAS_CAM_DYCORE + + +#endif + + + + + + + + + + + + + + + + + + + + + + + + + + + +#ifdef DO_PHYSICS + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +#endif + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +#ifdef DO_PHYSICS + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +#endif + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +#ifdef DO_PHYSICS + + + + + + + + + + + + +#endif + + + + + + + + + + + + + + + + + + + + + +#ifdef DO_PHYSICS + + + + + + + +#endif + + + + +#ifdef DO_PHYSICS + + +#endif + + + + + + + + + + + + + + + + + + +#ifdef DO_PHYSICS + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +#endif + + + + + + + + + + + + + + + + + + +#ifdef DO_PHYSICS + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +#endif + + +#ifdef DO_PHYSICS + + + + + + + + + + + + + + + + + + + + + + + + + + +#endif + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +#ifdef MPAS_CAM_DYCORE + + + +#endif + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +#ifndef MPAS_CAM_DYCORE + + + + + + + + + + + + + + + + + + + + + + + +#endif + +#ifdef DO_PHYSICS + + + + + + + + + + + + + + + + + + + + + + + + + + +#endif + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +#ifndef MPAS_CAM_DYCORE + + + + + + + + + + + + + + + + + + + + + + + + +#endif + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +#ifdef DO_PHYSICS + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +#endif + + + + + + + + + + + + + + + + +#ifdef DO_PHYSICS + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +#endif + + + +#ifdef DO_PHYSICS + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +#endif + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +#include "diagnostics/Registry_diagnostics.xml" + +#ifdef DO_PHYSICS +#include "physics/Registry_noahmp.xml" +#endif + diff --git a/src/core_atmosphere/mpas_atm_core.F b/src/core_atmosphere/mpas_atm_core.F index f7d04a1f0c..7cfd10b1bf 100644 --- a/src/core_atmosphere/mpas_atm_core.F +++ b/src/core_atmosphere/mpas_atm_core.F @@ -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 @@ -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 @@ -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) @@ -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 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! diff --git a/src/core_atmosphere/physics/.a.swp b/src/core_atmosphere/physics/.a.swp new file mode 100644 index 0000000000000000000000000000000000000000..d16aed2e43777fc08d956b181397b4f0c237a643 GIT binary patch literal 12288 zcmeI%!Ait15C-5>yo#bP5cQ&s0=|tGz55`( ziKg0uc-WpRe;^&g3`6IG9zySix6_Co4Ti+8wfgb1-d_Te+FZ5gMKO_1iqwXSYU&(Q zh9{CeST|>NZx&rnPS06%b#k+RI0#wk1QXWDm{*xCi`2JeMfzB3Q8M1u9C-*pphI9~ z79NbgKlSacO}eo@>!?Q>0uX=z1Rwwb2tWV=5cp35RS}RUKhRP$)N&JpKe0I?KmY;| zfB*y_009U<00Izz00bb=Ljj%;^1MpOtKaqi|Mvd>>CYd2zqPp@&W2Zp00bZa0SG_< z0uX=z1Rwwb2=rcnQYX3Dnd>|`zCN2?Om_DQtMf{_@tE4o#ENGbC&nr*xcQY6How;@ K_9Y{K_x}O`Qa^$K literal 0 HcmV?d00001 diff --git a/src/core_atmosphere/physics/mpas_atmphys_control.F b/src/core_atmosphere/physics/mpas_atmphys_control.F index 1ff0417d4e..933e28d282 100644 --- a/src/core_atmosphere/physics/mpas_atmphys_control.F +++ b/src/core_atmosphere/physics/mpas_atmphys_control.F @@ -85,6 +85,8 @@ module mpas_atmphys_control ! 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. +! * added the option bl_shinhong +! Songyou Hong (hong@ucar.edu) / 2025-11-27. contains @@ -203,6 +205,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: ', & @@ -281,10 +284,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 diff --git a/src/core_atmosphere/physics/mpas_atmphys_control.F-org b/src/core_atmosphere/physics/mpas_atmphys_control.F-org new file mode 100644 index 0000000000..b3162019e5 --- /dev/null +++ b/src/core_atmosphere/physics/mpas_atmphys_control.F-org @@ -0,0 +1,538 @@ +! Copyright (c) 2013, Los Alamos National Security, LLC (LANS) +! and the University Corporation for Atmospheric Research (UCAR). +! +! Unless noted otherwise source code is licensed under the BSD license. +! Additional copyright and license information can be found in the LICENSE file +! distributed with this code, or at http://mpas-dev.github.com/license.html +! +!================================================================================================================= + module mpas_atmphys_control + use mpas_dmpar + use mpas_kind_types + use mpas_pool_routines + + use mpas_atmphys_utilities + use mpas_atmphys_vars, only: l_mp_tables + + implicit none + private + public:: physics_namelist_check, & + physics_registry_init, & + physics_tables_init, & + physics_compatibility_check + + logical,public:: moist_physics + + +!MPAS control and initialization routines. +!Laura D. Fowler (send comments to laura@ucar.edu). +!2013-05-01. +! +! subroutines called in mpas_atmphys_control: +! ------------------------------------------- +! * physics_namelist_check: checks that physics namelist parameters are defined correctly. +! * physics_registry_init : initializes thicknesses of soil layers for NOAH land-surface scheme. +! +! add-ons and modifications to sourcecode: +! ---------------------------------------- +! * removed the namelist option config_eddy_scheme and associated sourcecode. +! * removed the namelist option config_conv_shallow_scheme and associated sourcecode. +! * removed controls to the updated Kain-Fritsch convection scheme. +! Laura D. Fowler (laura@ucar.edu) / 2013-05-29. +! * throughout the sourcecode, replaced all "var_struct" defined arrays by local pointers. +! Laura D. Fowler (laura@ucar.edu) / 2014-04-22. +! * modified sourcecode to use pools. +! Laura D. Fowler (laura@ucar.edu) / 2014-05-15. +! * removed subroutine physics_idealized_init, also available in mpas_init_atm_cases.F in core_init_atmosphere. +! Laura D. Fowler (laura@ucar.edu) / 2014-08-11. +! * renamed config_conv_deep_scheme to config_convection_scheme. +! Laura D. Fowler (laura@ucar.edu) / 2014-09-18. +! * renamed "wsm6" to "mp_wsm6" and "kessler" to "mp_kessler". +! Laura D. Fowler (laura@ucar.edu) / 2016-03-09. +! * renamed "kain_fritsch" to "cu_kain_fritsch" and "tiedtke" to "cu_tiedtke". +! Laura D. Fowler (laura@ucar.edu) / 2016-03-22. +! * renamed "ysu" to "bl_ysu", "ysu_gwdo" to "bl_gwdo_ysu", and "monin_obukhov" to "sf_monin_obukhov". +! Laura D. Fowler (laura@ucar.edu) / 2016-03-25. +! * added the option mp_thompson. +! Laura D. Fowler (laura@ucar.edu) / 2016-03-25. +! * added the option cu_grell_freitas. +! Laura D. Fowler (laura@ucar.edu) / 2016-03-31. +! * added the options sf_mynn and bl_mynn and for the MYNN parameterization from WRF version 3.6.1. +! Laura D. Fowler (laura@ucar.edu) / 2016-04-11. +! * added the option cu_ntiedtke for the "new" Tiedtke parameterization of convection from WRF version 3.8.1. +! Laura D. Fowler (laura@ucar.edu) / 2016-09-19. +! * added the physics suite "convection_scale_aware" (see below for the physics options used in the suite). +! Laura D. Fowler (laura@ucar.edu) / 2016-10-28. +! * added the subroutine physics_tables_init which checks if the files containing the lokk-up tables for the +! Thompson cloud microphysics are available or not. +! Laura D. Fowler (laura@ucar.edu) / 2016-11-01. +! * modified checking the config_gwdo_scheme option to allow bl_ysu_gwdo to be run when the MYNN pbl and surface +! layer scheme options are chosen. +! Laura D. Fowler (laura@ucar.edu) / 2016-12-22. +! * modified logic in subroutine physics_tables_init so that the Thompson microphysics tables are read in each +! MPI task. +! Laura D. Fowler (laura@ucar.edu) / 2016-12-30. +! * added the option mp_thompson_aerosols. +! Laura D. Fowler (laura@ucar.edu) / 2018-01-31. +! * added the option sf_monin_obukhov_rev to run the revised surface layer scheme with the YSU PBL scheme. +! Laura D. Fowler (laura@ucar.edu) / 2023-05-15. +! * replaced the option "noah" with "sf_noah" to run the NOAH land surface scheme. +! Laura D. Fowler (laura@ucar.edu) / 2022-02-18. +! * added the option "sf_noahmp" to run the NOAH-MP land surface scheme. +! Laura D. Fowler (laura@ucar.edu) / 2022-07-15. +! * 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. + + + contains + + +!================================================================================================================= + subroutine physics_namelist_check(configs) +!================================================================================================================= + +!input arguments: + type(mpas_pool_type),intent(in):: configs + +!local pointers: + character(len=StrKIND),pointer:: config_physics_suite, & + config_microp_scheme, & + config_convection_scheme, & + config_lsm_scheme, & + config_pbl_scheme, & + config_gwdo_scheme, & + config_radt_cld_scheme, & + config_radt_lw_scheme, & + config_radt_sw_scheme, & + config_sfclayer_scheme + +!----------------------------------------------------------------------------------------------------------------- +!call mpas_log_write('') +!call mpas_log_write('--- enter subroutine physics_namelist_check:') + + call mpas_pool_get_config(configs,'config_physics_suite' ,config_physics_suite ) + call mpas_pool_get_config(configs,'config_microp_scheme' ,config_microp_scheme ) + call mpas_pool_get_config(configs,'config_convection_scheme',config_convection_scheme) + call mpas_pool_get_config(configs,'config_lsm_scheme' ,config_lsm_scheme ) + call mpas_pool_get_config(configs,'config_pbl_scheme' ,config_pbl_scheme ) + call mpas_pool_get_config(configs,'config_gwdo_scheme' ,config_gwdo_scheme ) + call mpas_pool_get_config(configs,'config_radt_cld_scheme' ,config_radt_cld_scheme ) + call mpas_pool_get_config(configs,'config_radt_lw_scheme' ,config_radt_lw_scheme ) + call mpas_pool_get_config(configs,'config_radt_sw_scheme' ,config_radt_sw_scheme ) + call mpas_pool_get_config(configs,'config_sfclayer_scheme' ,config_sfclayer_scheme ) + + call mpas_log_write('') + call mpas_log_write('----- Setting up physics suite '''//trim(config_physics_suite)//''' -----') + + ! + !setup schemes according to the selected physics suite: + ! + if (trim(config_physics_suite) == 'mesoscale_reference') then + + 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_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' + if (trim(config_lsm_scheme) == 'suite') config_lsm_scheme = 'sf_noah' + + else if (trim(config_physics_suite) == 'convection_permitting') then + + 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_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' + if (trim(config_sfclayer_scheme) == 'suite') config_sfclayer_scheme = 'sf_mynn' + if (trim(config_lsm_scheme) == 'suite') config_lsm_scheme = 'sf_noah' + + else if (trim(config_physics_suite) == 'none') then + + if (trim(config_microp_scheme) == 'suite') config_microp_scheme = 'off' + if (trim(config_convection_scheme) == 'suite') config_convection_scheme = 'off' + if (trim(config_pbl_scheme) == 'suite') config_pbl_scheme = 'off' + if (trim(config_gwdo_scheme) == 'suite') config_gwdo_scheme = 'off' + if (trim(config_radt_lw_scheme) == 'suite') config_radt_lw_scheme = 'off' + if (trim(config_radt_sw_scheme) == 'suite') config_radt_sw_scheme = 'off' + if (trim(config_radt_cld_scheme) == 'suite') config_radt_cld_scheme = 'off' + if (trim(config_sfclayer_scheme) == 'suite') config_sfclayer_scheme = 'off' + if (trim(config_lsm_scheme) == 'suite') config_lsm_scheme = 'off' + + else + + write(mpas_err_message,'(A)') 'Unrecognized choice of physics suite: config_physics_suite = '''// & + trim(config_physics_suite)//'''' + call physics_error_fatal(mpas_err_message) + + end if + +!cloud microphysics scheme: + if(.not. (config_microp_scheme .eq. 'off' .or. & + config_microp_scheme .eq. 'mp_kessler' .or. & + config_microp_scheme .eq. 'mp_thompson' .or. & + config_microp_scheme .eq. 'mp_thompson_aerosols' .or. & + config_microp_scheme .eq. 'mp_wsm6')) then + + write(mpas_err_message,'(A,A20)') 'illegal value for config_microp_scheme:', & + trim(config_microp_scheme) + call physics_error_fatal(mpas_err_message) + + endif + +!convection scheme: + if(.not. (config_convection_scheme .eq. 'off' .or. & + config_convection_scheme .eq. 'cu_grell_freitas' .or. & + config_convection_scheme .eq. 'cu_kain_fritsch' .or. & + config_convection_scheme .eq. 'cu_tiedtke' .or. & + config_convection_scheme .eq. 'cu_ntiedtke')) then + + write(mpas_err_message,'(A,A20)') 'illegal value for config_convection_scheme: ', & + trim(config_convection_scheme) + call physics_error_fatal(mpas_err_message) + + endif + +!pbl scheme: + if(.not. (config_pbl_scheme .eq. 'off' .or. & + config_pbl_scheme .eq. 'bl_mynn' .or. & + config_pbl_scheme .eq. 'bl_ysu')) then + + write(mpas_err_message,'(A,A20)') 'illegal value for pbl_scheme: ', & + trim(config_pbl_scheme) + call physics_error_fatal(mpas_err_message) + + endif + +!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_ugwp_gwdo')) then + + write(mpas_err_message,'(A,A20)') 'illegal value for gwdo_scheme: ', & + trim(config_gwdo_scheme) + call physics_error_fatal(mpas_err_message) + + endif + +!lw radiation scheme: + if(.not. (config_radt_lw_scheme .eq. 'off' .or. & + config_radt_lw_scheme .eq. 'cam_lw' .or. & + config_radt_lw_scheme .eq. 'rrtmg_lw')) then + + write(mpas_err_message,'(A,A20)') 'illegal value for longwave radiation scheme: ', & + trim(config_radt_lw_scheme) + call physics_error_fatal(mpas_err_message) + + endif + +!sw radiation scheme: + if(.not. (config_radt_sw_scheme .eq. 'off' .or. & + config_radt_sw_scheme .eq. 'cam_sw' .or. & + config_radt_sw_scheme .eq. 'rrtmg_sw')) then + + write(mpas_err_message,'(A,A20)') 'illegal value for shortwave radiation _scheme: ', & + trim(config_radt_sw_scheme) + call physics_error_fatal(mpas_err_message) + + endif + +!cloud fraction for radiation schemes: + if(.not. (config_radt_cld_scheme .eq. 'off' .or. & + config_radt_cld_scheme .eq. 'cld_incidence' .or. & + config_radt_cld_scheme .eq. 'cld_fraction' .or. & + config_radt_cld_scheme .eq. 'cld_fraction_thompson')) then + + write(mpas_err_message,'(A,A20)') 'illegal value for calculation of cloud fraction: ', & + trim(config_radt_cld_scheme) + call physics_error_fatal(mpas_err_message) + + endif + if((config_radt_lw_scheme.ne.'off' .and. config_radt_cld_scheme.eq.'off') .or. & + (config_radt_sw_scheme.ne.'off' .and. config_radt_cld_scheme.eq.'off')) then + + call mpas_log_write('') + write(mpas_err_message,'(A,A20)') & + ' config_radt_cld_scheme is not set for radiation calculation' + call physics_message(mpas_err_message) + write(mpas_err_message,'(A,A20)') & + ' switch calculation of cloud fraction to config_radt_cld_scheme = cld_incidence' + call physics_message(mpas_err_message) + config_radt_cld_scheme = "cld_incidence" + + endif + +!surface-layer scheme: + if(.not. (config_sfclayer_scheme .eq. 'off' .or. & + config_sfclayer_scheme .eq. 'sf_mynn' .or. & + config_sfclayer_scheme .eq. 'sf_monin_obukhov' .or. & + config_sfclayer_scheme .eq. 'sf_monin_obukhov_rev')) then + + write(mpas_err_message,'(A,A20)') 'illegal value for surface layer scheme: ', & + trim(config_sfclayer_scheme) + call physics_error_fatal(mpas_err_message) + else + if(config_pbl_scheme == 'bl_mynn') then + config_sfclayer_scheme = 'sf_mynn' + elseif(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: ', & + trim(config_sfclayer_scheme) + call physics_error_fatal(mpas_err_message) + endif + endif + endif + +!land-surface scheme: note that config_sfclayer_scheme must be defined for the land-surface +!scheme to be called: + if(config_lsm_scheme .ne. 'off' .and. config_sfclayer_scheme .eq. 'off') then + + call physics_error_fatal('land surface scheme: ' // & + 'set config_sfclayer_scheme different than off') + + elseif(.not. (config_lsm_scheme .eq. 'off ' .or. & + config_lsm_scheme .eq. 'sf_noah' .or. & + config_lsm_scheme .eq. 'sf_noahmp')) then + + write(mpas_err_message,'(A,A20)') 'illegal value for land surface scheme: ', & + trim(config_lsm_scheme) + call physics_error_fatal(mpas_err_message) + + endif + +!checks if any physics process is called. if not, return: + moist_physics = .true. + + if(config_microp_scheme .eq. 'off' .and. & + config_convection_scheme .eq. 'off' .and. & + config_lsm_scheme .eq. 'off' .and. & + config_pbl_scheme .eq. 'off' .and. & + config_radt_lw_scheme .eq. 'off' .and. & + config_radt_sw_scheme .eq. 'off' .and. & + config_sfclayer_scheme .eq. 'off') moist_physics = .false. + + call mpas_log_write('') + call mpas_log_write(' config_microp_scheme = '//trim(config_microp_scheme)) + call mpas_log_write(' config_convection_scheme = '//trim(config_convection_scheme)) + call mpas_log_write(' config_pbl_scheme = '//trim(config_pbl_scheme)) + call mpas_log_write(' config_gwdo_scheme = '//trim(config_gwdo_scheme)) + call mpas_log_write(' config_radt_cld_scheme = '//trim(config_radt_cld_scheme)) + call mpas_log_write(' config_radt_lw_scheme = '//trim(config_radt_lw_scheme)) + call mpas_log_write(' config_radt_sw_scheme = '//trim(config_radt_sw_scheme)) + call mpas_log_write(' config_sfclayer_scheme = '//trim(config_sfclayer_scheme)) + call mpas_log_write(' config_lsm_scheme = '//trim(config_lsm_scheme)) + call mpas_log_write('') + + end subroutine physics_namelist_check + +!================================================================================================================= + subroutine physics_registry_init(mesh,configs,sfc_input) +!================================================================================================================= + +!input arguments: + type(mpas_pool_type),intent(in):: mesh + type(mpas_pool_type),intent(in):: configs + +!inout arguments: + type(mpas_pool_type),intent(inout):: sfc_input + +!local pointers: + logical,pointer:: config_do_restart + character(len=StrKIND),pointer:: config_lsm_scheme + integer,pointer:: nCells + integer,dimension(:),pointer:: landmask + + real(kind=RKIND),dimension(:,:),pointer:: dzs + +!local variables: + integer:: iCell + +!----------------------------------------------------------------------------------------------------------------- + + call mpas_pool_get_config(configs,'config_do_restart',config_do_restart) + call mpas_pool_get_config(configs,'config_lsm_scheme',config_lsm_scheme) + + call mpas_pool_get_dimension(mesh,'nCells',nCells) + + call mpas_pool_get_array(sfc_input,'landmask',landmask) + call mpas_pool_get_array(sfc_input,'dzs' , dzs ) + +!initialization of input variables, if needed: + + if(.not. config_do_restart) then + + lsm_select: select case(trim(config_lsm_scheme)) + + case("sf_noah","sf_noahmp") + !initialize the thickness of the soil layers for the Noah scheme: + do iCell = 1, nCells + dzs(1,iCell) = 0.10_RKIND + dzs(2,iCell) = 0.30_RKIND + dzs(3,iCell) = 0.60_RKIND + dzs(4,iCell) = 1.00_RKIND + enddo + + case default + + end select lsm_select + + endif + +!call mpas_log_write('--- enter subroutine physics_namelist_check.') +!call mpas_log_write('') + + end subroutine physics_registry_init + +!================================================================================================================= + subroutine physics_tables_init(dminfo,configs) +!================================================================================================================= + +!input arguments: + type(dm_info),intent(in):: dminfo + type(mpas_pool_type),intent(in):: configs + +!local variables: + character(len=StrKIND),pointer:: config_microp_scheme + logical:: l_qr_acr_qg,l_qr_acr_qs,l_qi_aut_qs,l_freezeH2O + +!----------------------------------------------------------------------------------------------------------------- + + l_mp_tables = .true. + + if(dminfo % my_proc_id == IO_NODE) then + + call mpas_pool_get_config(configs,'config_microp_scheme',config_microp_scheme) + if(config_microp_scheme /= "mp_thompson" .or. & + config_microp_scheme /= "mp_thompson_aerosols") return + + l_qr_acr_qg = .false. + l_qr_acr_qs = .false. + l_qi_aut_qs = .false. + l_freezeH2O = .false. + + inquire(file='MP_THOMPSON_QRacrQG_DATA.DBL' ,exist=l_qr_acr_qg) + inquire(file='MP_THOMPSON_QRacrQS_DATA.DBL' ,exist=l_qr_acr_qs) + inquire(file='MP_THOMPSON_QIautQS_DATA.DBL' ,exist=l_qi_aut_qs) + inquire(file='MP_THOMPSON_freezeH2O_DATA.DBL',exist=l_freezeH2O) + +! call mpas_log_write('') +! call mpas_log_write('--- enter subroutine physics_tables_init:') +! call mpas_log_write('l_qr_acr_qg = $l',logicArgs=(/l_qr_acr_qg/)) +! call mpas_log_write('l_qr_acr_qs = $l',logicArgs=(/l_qr_acr_qs/)) +! call mpas_log_write('l_qi_aut_qs = $l',logicArgs=(/l_qi_aut_qs/)) +! call mpas_log_write('l_freezeH2O = $l',logicArgs=(/l_freezeH2O/)) + + if(.not. (l_qr_acr_qg .and. l_qr_acr_qs .and. l_qi_aut_qs .and. l_freezeH2O)) then + write(mpas_err_message,'(A)') & + '--- tables to run the Thompson cloud microphysics scheme do not exist: run build_tables first.' + call physics_error_fatal(mpas_err_message) + endif +! call mpas_log_write('l_mp_tables = $l',logicArgs=(/l_mp_tables/)) + + endif + + end subroutine physics_tables_init + +!================================================================================================================= +! routine physics_compatibility_check() +! +!> \brief Checks physics input fields and options for compatibility +!> \author Miles Curry and Michael Duda +!> \date 25 October 2018 +!> \details +!> This routine checks the input fields and run-time options provided +!> by the user for compatibility. For example, two run-time options may +!> be mutually exclusive, or an option may require that a certain input +!> field is provided. The checks performed by this routine are only for +!> physics related fields and options. +!> +!> A value of 0 is returned if there are no incompatibilities among +!> the provided input fields and run-time options, and a non-zero value +!> otherwise. +!> + subroutine physics_compatibility_check(dminfo, blockList, streamManager, ierr) +!================================================================================================================= + + implicit none + + type (dm_info), pointer :: dminfo + type (block_type), pointer :: blockList + type (MPAS_streamManager_type), pointer :: streamManager + integer, intent(out) :: ierr + + real (kind=RKIND) :: maxvar2d_local, maxvar2d_global + real (kind=RKIND), dimension(:), pointer :: var2d + integer, pointer :: nCellsSolve + integer, pointer :: iswater_lu + integer, pointer, dimension(:) :: ivgtyp + integer :: all_water, iall_water + character (len=StrKIND), pointer :: gwdo_scheme + type (block_type), pointer :: block + type (mpas_pool_type), pointer :: meshPool + type (mpas_pool_type), pointer :: sfc_inputPool + + ierr = 0 + + call mpas_pool_get_config(blocklist % configs, 'config_gwdo_scheme', gwdo_scheme) + + if (trim(gwdo_scheme) == 'bl_ysu_gwdo') then + maxvar2d_local = -huge(maxvar2d_local) + block => blockList + do while (associated(block)) + call mpas_pool_get_subpool(block % structs, 'mesh', meshPool) + call mpas_pool_get_subpool(block % structs, 'sfc_input', sfc_inputPool) + call mpas_pool_get_dimension(meshPool, 'nCellsSolve', nCellsSolve) + call mpas_pool_get_array(sfc_inputPool, 'var2d', var2d) + + maxvar2d_local = max(maxvar2d_local, maxval(var2d(1:nCellsSolve))) + + block => block % next + end do + + call mpas_dmpar_max_real(dminfo, maxvar2d_local, maxvar2d_global) + + ! + ! The GWDO check below can fail on regional simulations that are completely above + ! water. So, check to see if the simulation is completely above water and do not + ! throw the error if it is. + ! + call mpas_pool_get_array(sfc_inputPool, 'iswater', iswater_lu) + call mpas_pool_get_array(sfc_inputPool, 'ivgtyp', ivgtyp) + if (all(ivgtyp(1:nCellsSolve) == iswater_lu)) then + all_water = 1 ! All water + else + all_water = 0 ! Land present + end if + + call mpas_dmpar_min_int(dminfo, all_water, iall_water) + + if (maxvar2d_global <= 0.0_RKIND .and. iall_water /= 1) then + call mpas_log_write('*******************************************************************************', & + messageType=MPAS_LOG_ERR) + call mpas_log_write('The YSU GWDO scheme requires valid var2d, con, oa{1,2,3,4}, and ol{1,2,3,4} fields,', & + messageType=MPAS_LOG_ERR) + call mpas_log_write('but these fields appear to be zero everywhere in the model input.', & + messageType=MPAS_LOG_ERR) + call mpas_log_write('Either set config_gwdo_scheme = ''off'' in the &physics namelist, or generate', & + messageType=MPAS_LOG_ERR) + call mpas_log_write('the GWDO static fields with the init_atmosphere core.', & + messageType=MPAS_LOG_ERR) + call mpas_log_write('*******************************************************************************', & + messageType=MPAS_LOG_ERR) + ierr = ierr + 1 + end if + + end if + + end subroutine physics_compatibility_check + +!================================================================================================================= + end module mpas_atmphys_control +!================================================================================================================= + diff --git a/src/core_atmosphere/physics/mpas_atmphys_control.F-org2 b/src/core_atmosphere/physics/mpas_atmphys_control.F-org2 new file mode 100644 index 0000000000..1ff0417d4e --- /dev/null +++ b/src/core_atmosphere/physics/mpas_atmphys_control.F-org2 @@ -0,0 +1,540 @@ +! Copyright (c) 2013, Los Alamos National Security, LLC (LANS) +! and the University Corporation for Atmospheric Research (UCAR). +! +! Unless noted otherwise source code is licensed under the BSD license. +! Additional copyright and license information can be found in the LICENSE file +! distributed with this code, or at http://mpas-dev.github.com/license.html +! +!================================================================================================================= + module mpas_atmphys_control + use mpas_dmpar + use mpas_kind_types + use mpas_pool_routines + + use mpas_atmphys_utilities + use mpas_atmphys_vars, only: l_mp_tables + + implicit none + private + public:: physics_namelist_check, & + physics_registry_init, & + physics_tables_init, & + physics_compatibility_check + + logical,public:: moist_physics + + +!MPAS control and initialization routines. +!Laura D. Fowler (send comments to laura@ucar.edu). +!2013-05-01. +! +! subroutines called in mpas_atmphys_control: +! ------------------------------------------- +! * physics_namelist_check: checks that physics namelist parameters are defined correctly. +! * physics_registry_init : initializes thicknesses of soil layers for NOAH land-surface scheme. +! +! add-ons and modifications to sourcecode: +! ---------------------------------------- +! * removed the namelist option config_eddy_scheme and associated sourcecode. +! * removed the namelist option config_conv_shallow_scheme and associated sourcecode. +! * removed controls to the updated Kain-Fritsch convection scheme. +! Laura D. Fowler (laura@ucar.edu) / 2013-05-29. +! * throughout the sourcecode, replaced all "var_struct" defined arrays by local pointers. +! Laura D. Fowler (laura@ucar.edu) / 2014-04-22. +! * modified sourcecode to use pools. +! Laura D. Fowler (laura@ucar.edu) / 2014-05-15. +! * removed subroutine physics_idealized_init, also available in mpas_init_atm_cases.F in core_init_atmosphere. +! Laura D. Fowler (laura@ucar.edu) / 2014-08-11. +! * renamed config_conv_deep_scheme to config_convection_scheme. +! Laura D. Fowler (laura@ucar.edu) / 2014-09-18. +! * renamed "wsm6" to "mp_wsm6" and "kessler" to "mp_kessler". +! Laura D. Fowler (laura@ucar.edu) / 2016-03-09. +! * renamed "kain_fritsch" to "cu_kain_fritsch" and "tiedtke" to "cu_tiedtke". +! Laura D. Fowler (laura@ucar.edu) / 2016-03-22. +! * renamed "ysu" to "bl_ysu", "ysu_gwdo" to "bl_gwdo_ysu", and "monin_obukhov" to "sf_monin_obukhov". +! Laura D. Fowler (laura@ucar.edu) / 2016-03-25. +! * added the option mp_thompson. +! Laura D. Fowler (laura@ucar.edu) / 2016-03-25. +! * added the option cu_grell_freitas. +! Laura D. Fowler (laura@ucar.edu) / 2016-03-31. +! * added the options sf_mynn and bl_mynn and for the MYNN parameterization from WRF version 3.6.1. +! Laura D. Fowler (laura@ucar.edu) / 2016-04-11. +! * added the option cu_ntiedtke for the "new" Tiedtke parameterization of convection from WRF version 3.8.1. +! Laura D. Fowler (laura@ucar.edu) / 2016-09-19. +! * added the physics suite "convection_scale_aware" (see below for the physics options used in the suite). +! Laura D. Fowler (laura@ucar.edu) / 2016-10-28. +! * added the subroutine physics_tables_init which checks if the files containing the lokk-up tables for the +! Thompson cloud microphysics are available or not. +! Laura D. Fowler (laura@ucar.edu) / 2016-11-01. +! * modified checking the config_gwdo_scheme option to allow bl_ysu_gwdo to be run when the MYNN pbl and surface +! layer scheme options are chosen. +! Laura D. Fowler (laura@ucar.edu) / 2016-12-22. +! * modified logic in subroutine physics_tables_init so that the Thompson microphysics tables are read in each +! MPI task. +! Laura D. Fowler (laura@ucar.edu) / 2016-12-30. +! * added the option mp_thompson_aerosols. +! Laura D. Fowler (laura@ucar.edu) / 2018-01-31. +! * added the option sf_monin_obukhov_rev to run the revised surface layer scheme with the YSU PBL scheme. +! Laura D. Fowler (laura@ucar.edu) / 2023-05-15. +! * replaced the option "noah" with "sf_noah" to run the NOAH land surface scheme. +! Laura D. Fowler (laura@ucar.edu) / 2022-02-18. +! * added the option "sf_noahmp" to run the NOAH-MP land surface scheme. +! Laura D. Fowler (laura@ucar.edu) / 2022-07-15. +! * 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 + + +!================================================================================================================= + subroutine physics_namelist_check(configs) +!================================================================================================================= + +!input arguments: + type(mpas_pool_type),intent(in):: configs + +!local pointers: + character(len=StrKIND),pointer:: config_physics_suite, & + config_microp_scheme, & + config_convection_scheme, & + config_lsm_scheme, & + config_pbl_scheme, & + config_gwdo_scheme, & + config_radt_cld_scheme, & + config_radt_lw_scheme, & + config_radt_sw_scheme, & + config_sfclayer_scheme + +!----------------------------------------------------------------------------------------------------------------- +!call mpas_log_write('') +!call mpas_log_write('--- enter subroutine physics_namelist_check:') + + call mpas_pool_get_config(configs,'config_physics_suite' ,config_physics_suite ) + call mpas_pool_get_config(configs,'config_microp_scheme' ,config_microp_scheme ) + call mpas_pool_get_config(configs,'config_convection_scheme',config_convection_scheme) + call mpas_pool_get_config(configs,'config_lsm_scheme' ,config_lsm_scheme ) + call mpas_pool_get_config(configs,'config_pbl_scheme' ,config_pbl_scheme ) + call mpas_pool_get_config(configs,'config_gwdo_scheme' ,config_gwdo_scheme ) + call mpas_pool_get_config(configs,'config_radt_cld_scheme' ,config_radt_cld_scheme ) + call mpas_pool_get_config(configs,'config_radt_lw_scheme' ,config_radt_lw_scheme ) + call mpas_pool_get_config(configs,'config_radt_sw_scheme' ,config_radt_sw_scheme ) + call mpas_pool_get_config(configs,'config_sfclayer_scheme' ,config_sfclayer_scheme ) + + call mpas_log_write('') + call mpas_log_write('----- Setting up physics suite '''//trim(config_physics_suite)//''' -----') + + ! + !setup schemes according to the selected physics suite: + ! + if (trim(config_physics_suite) == 'mesoscale_reference') then + + 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_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' + if (trim(config_sfclayer_scheme) == 'suite') config_sfclayer_scheme = 'sf_monin_obukhov_rev' + if (trim(config_lsm_scheme) == 'suite') config_lsm_scheme = 'sf_noah' + + else if (trim(config_physics_suite) == 'convection_permitting') then + + 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_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' + if (trim(config_sfclayer_scheme) == 'suite') config_sfclayer_scheme = 'sf_mynn' + if (trim(config_lsm_scheme) == 'suite') config_lsm_scheme = 'sf_noah' + + else if (trim(config_physics_suite) == 'none') then + + if (trim(config_microp_scheme) == 'suite') config_microp_scheme = 'off' + if (trim(config_convection_scheme) == 'suite') config_convection_scheme = 'off' + if (trim(config_pbl_scheme) == 'suite') config_pbl_scheme = 'off' + if (trim(config_gwdo_scheme) == 'suite') config_gwdo_scheme = 'off' + if (trim(config_radt_lw_scheme) == 'suite') config_radt_lw_scheme = 'off' + if (trim(config_radt_sw_scheme) == 'suite') config_radt_sw_scheme = 'off' + if (trim(config_radt_cld_scheme) == 'suite') config_radt_cld_scheme = 'off' + if (trim(config_sfclayer_scheme) == 'suite') config_sfclayer_scheme = 'off' + if (trim(config_lsm_scheme) == 'suite') config_lsm_scheme = 'off' + + else + + write(mpas_err_message,'(A)') 'Unrecognized choice of physics suite: config_physics_suite = '''// & + trim(config_physics_suite)//'''' + call physics_error_fatal(mpas_err_message) + + end if + +!cloud microphysics scheme: + if(.not. (config_microp_scheme .eq. 'off' .or. & + config_microp_scheme .eq. 'mp_kessler' .or. & + config_microp_scheme .eq. 'mp_thompson' .or. & + config_microp_scheme .eq. 'mp_thompson_aerosols' .or. & + config_microp_scheme .eq. 'mp_wsm6')) then + + write(mpas_err_message,'(A,A20)') 'illegal value for config_microp_scheme:', & + trim(config_microp_scheme) + call physics_error_fatal(mpas_err_message) + + endif + +!convection scheme: + if(.not. (config_convection_scheme .eq. 'off' .or. & + config_convection_scheme .eq. 'cu_grell_freitas' .or. & + config_convection_scheme .eq. 'cu_kain_fritsch' .or. & + config_convection_scheme .eq. 'cu_tiedtke' .or. & + config_convection_scheme .eq. 'cu_ntiedtke')) then + + write(mpas_err_message,'(A,A20)') 'illegal value for config_convection_scheme: ', & + trim(config_convection_scheme) + call physics_error_fatal(mpas_err_message) + + endif + +!pbl scheme: + if(.not. (config_pbl_scheme .eq. 'off' .or. & + config_pbl_scheme .eq. 'bl_mynn' .or. & + config_pbl_scheme .eq. 'bl_ysu')) then + + write(mpas_err_message,'(A,A20)') 'illegal value for pbl_scheme: ', & + trim(config_pbl_scheme) + call physics_error_fatal(mpas_err_message) + + endif + +!gravity wave drag over orography scheme: + if(.not. (config_gwdo_scheme .eq. 'off' .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: ', & + trim(config_gwdo_scheme) + call physics_error_fatal(mpas_err_message) + + endif + +!lw radiation scheme: + if(.not. (config_radt_lw_scheme .eq. 'off' .or. & + config_radt_lw_scheme .eq. 'cam_lw' .or. & + config_radt_lw_scheme .eq. 'rrtmg_lw')) then + + write(mpas_err_message,'(A,A20)') 'illegal value for longwave radiation scheme: ', & + trim(config_radt_lw_scheme) + call physics_error_fatal(mpas_err_message) + + endif + +!sw radiation scheme: + if(.not. (config_radt_sw_scheme .eq. 'off' .or. & + config_radt_sw_scheme .eq. 'cam_sw' .or. & + config_radt_sw_scheme .eq. 'rrtmg_sw')) then + + write(mpas_err_message,'(A,A20)') 'illegal value for shortwave radiation _scheme: ', & + trim(config_radt_sw_scheme) + call physics_error_fatal(mpas_err_message) + + endif + +!cloud fraction for radiation schemes: + if(.not. (config_radt_cld_scheme .eq. 'off' .or. & + config_radt_cld_scheme .eq. 'cld_incidence' .or. & + config_radt_cld_scheme .eq. 'cld_fraction' .or. & + config_radt_cld_scheme .eq. 'cld_fraction_thompson')) then + + write(mpas_err_message,'(A,A20)') 'illegal value for calculation of cloud fraction: ', & + trim(config_radt_cld_scheme) + call physics_error_fatal(mpas_err_message) + + endif + if((config_radt_lw_scheme.ne.'off' .and. config_radt_cld_scheme.eq.'off') .or. & + (config_radt_sw_scheme.ne.'off' .and. config_radt_cld_scheme.eq.'off')) then + + call mpas_log_write('') + write(mpas_err_message,'(A,A20)') & + ' config_radt_cld_scheme is not set for radiation calculation' + call physics_message(mpas_err_message) + write(mpas_err_message,'(A,A20)') & + ' switch calculation of cloud fraction to config_radt_cld_scheme = cld_incidence' + call physics_message(mpas_err_message) + config_radt_cld_scheme = "cld_incidence" + + endif + +!surface-layer scheme: + if(.not. (config_sfclayer_scheme .eq. 'off' .or. & + config_sfclayer_scheme .eq. 'sf_mynn' .or. & + config_sfclayer_scheme .eq. 'sf_monin_obukhov' .or. & + config_sfclayer_scheme .eq. 'sf_monin_obukhov_rev')) then + + write(mpas_err_message,'(A,A20)') 'illegal value for surface layer scheme: ', & + trim(config_sfclayer_scheme) + call physics_error_fatal(mpas_err_message) + else + if(config_pbl_scheme == 'bl_mynn') then + config_sfclayer_scheme = 'sf_mynn' + elseif(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: ', & + trim(config_sfclayer_scheme) + call physics_error_fatal(mpas_err_message) + endif + endif + endif + +!land-surface scheme: note that config_sfclayer_scheme must be defined for the land-surface +!scheme to be called: + if(config_lsm_scheme .ne. 'off' .and. config_sfclayer_scheme .eq. 'off') then + + call physics_error_fatal('land surface scheme: ' // & + 'set config_sfclayer_scheme different than off') + + elseif(.not. (config_lsm_scheme .eq. 'off ' .or. & + config_lsm_scheme .eq. 'sf_noah' .or. & + config_lsm_scheme .eq. 'sf_noahmp')) then + + write(mpas_err_message,'(A,A20)') 'illegal value for land surface scheme: ', & + trim(config_lsm_scheme) + call physics_error_fatal(mpas_err_message) + + endif + +!checks if any physics process is called. if not, return: + moist_physics = .true. + + if(config_microp_scheme .eq. 'off' .and. & + config_convection_scheme .eq. 'off' .and. & + config_lsm_scheme .eq. 'off' .and. & + config_pbl_scheme .eq. 'off' .and. & + config_radt_lw_scheme .eq. 'off' .and. & + config_radt_sw_scheme .eq. 'off' .and. & + config_sfclayer_scheme .eq. 'off') moist_physics = .false. + + call mpas_log_write('') + call mpas_log_write(' config_microp_scheme = '//trim(config_microp_scheme)) + call mpas_log_write(' config_convection_scheme = '//trim(config_convection_scheme)) + call mpas_log_write(' config_pbl_scheme = '//trim(config_pbl_scheme)) + call mpas_log_write(' config_gwdo_scheme = '//trim(config_gwdo_scheme)) + call mpas_log_write(' config_radt_cld_scheme = '//trim(config_radt_cld_scheme)) + call mpas_log_write(' config_radt_lw_scheme = '//trim(config_radt_lw_scheme)) + call mpas_log_write(' config_radt_sw_scheme = '//trim(config_radt_sw_scheme)) + call mpas_log_write(' config_sfclayer_scheme = '//trim(config_sfclayer_scheme)) + call mpas_log_write(' config_lsm_scheme = '//trim(config_lsm_scheme)) + call mpas_log_write('') + + end subroutine physics_namelist_check + +!================================================================================================================= + subroutine physics_registry_init(mesh,configs,sfc_input) +!================================================================================================================= + +!input arguments: + type(mpas_pool_type),intent(in):: mesh + type(mpas_pool_type),intent(in):: configs + +!inout arguments: + type(mpas_pool_type),intent(inout):: sfc_input + +!local pointers: + logical,pointer:: config_do_restart + character(len=StrKIND),pointer:: config_lsm_scheme + integer,pointer:: nCells + integer,dimension(:),pointer:: landmask + + real(kind=RKIND),dimension(:,:),pointer:: dzs + +!local variables: + integer:: iCell + +!----------------------------------------------------------------------------------------------------------------- + + call mpas_pool_get_config(configs,'config_do_restart',config_do_restart) + call mpas_pool_get_config(configs,'config_lsm_scheme',config_lsm_scheme) + + call mpas_pool_get_dimension(mesh,'nCells',nCells) + + call mpas_pool_get_array(sfc_input,'landmask',landmask) + call mpas_pool_get_array(sfc_input,'dzs' , dzs ) + +!initialization of input variables, if needed: + + if(.not. config_do_restart) then + + lsm_select: select case(trim(config_lsm_scheme)) + + case("sf_noah","sf_noahmp") + !initialize the thickness of the soil layers for the Noah scheme: + do iCell = 1, nCells + dzs(1,iCell) = 0.10_RKIND + dzs(2,iCell) = 0.30_RKIND + dzs(3,iCell) = 0.60_RKIND + dzs(4,iCell) = 1.00_RKIND + enddo + + case default + + end select lsm_select + + endif + +!call mpas_log_write('--- enter subroutine physics_namelist_check.') +!call mpas_log_write('') + + end subroutine physics_registry_init + +!================================================================================================================= + subroutine physics_tables_init(dminfo,configs) +!================================================================================================================= + +!input arguments: + type(dm_info),intent(in):: dminfo + type(mpas_pool_type),intent(in):: configs + +!local variables: + character(len=StrKIND),pointer:: config_microp_scheme + logical:: l_qr_acr_qg,l_qr_acr_qs,l_qi_aut_qs,l_freezeH2O + +!----------------------------------------------------------------------------------------------------------------- + + l_mp_tables = .true. + + if(dminfo % my_proc_id == IO_NODE) then + + call mpas_pool_get_config(configs,'config_microp_scheme',config_microp_scheme) + if(config_microp_scheme /= "mp_thompson" .or. & + config_microp_scheme /= "mp_thompson_aerosols") return + + l_qr_acr_qg = .false. + l_qr_acr_qs = .false. + l_qi_aut_qs = .false. + l_freezeH2O = .false. + + inquire(file='MP_THOMPSON_QRacrQG_DATA.DBL' ,exist=l_qr_acr_qg) + inquire(file='MP_THOMPSON_QRacrQS_DATA.DBL' ,exist=l_qr_acr_qs) + inquire(file='MP_THOMPSON_QIautQS_DATA.DBL' ,exist=l_qi_aut_qs) + inquire(file='MP_THOMPSON_freezeH2O_DATA.DBL',exist=l_freezeH2O) + +! call mpas_log_write('') +! call mpas_log_write('--- enter subroutine physics_tables_init:') +! call mpas_log_write('l_qr_acr_qg = $l',logicArgs=(/l_qr_acr_qg/)) +! call mpas_log_write('l_qr_acr_qs = $l',logicArgs=(/l_qr_acr_qs/)) +! call mpas_log_write('l_qi_aut_qs = $l',logicArgs=(/l_qi_aut_qs/)) +! call mpas_log_write('l_freezeH2O = $l',logicArgs=(/l_freezeH2O/)) + + if(.not. (l_qr_acr_qg .and. l_qr_acr_qs .and. l_qi_aut_qs .and. l_freezeH2O)) then + write(mpas_err_message,'(A)') & + '--- tables to run the Thompson cloud microphysics scheme do not exist: run build_tables first.' + call physics_error_fatal(mpas_err_message) + endif +! call mpas_log_write('l_mp_tables = $l',logicArgs=(/l_mp_tables/)) + + endif + + end subroutine physics_tables_init + +!================================================================================================================= +! routine physics_compatibility_check() +! +!> \brief Checks physics input fields and options for compatibility +!> \author Miles Curry and Michael Duda +!> \date 25 October 2018 +!> \details +!> This routine checks the input fields and run-time options provided +!> by the user for compatibility. For example, two run-time options may +!> be mutually exclusive, or an option may require that a certain input +!> field is provided. The checks performed by this routine are only for +!> physics related fields and options. +!> +!> A value of 0 is returned if there are no incompatibilities among +!> the provided input fields and run-time options, and a non-zero value +!> otherwise. +!> + subroutine physics_compatibility_check(dminfo, blockList, streamManager, ierr) +!================================================================================================================= + + implicit none + + type (dm_info), pointer :: dminfo + type (block_type), pointer :: blockList + type (MPAS_streamManager_type), pointer :: streamManager + integer, intent(out) :: ierr + + real (kind=RKIND) :: maxvar2d_local, maxvar2d_global + real (kind=RKIND), dimension(:), pointer :: var2d + integer, pointer :: nCellsSolve + integer, pointer :: iswater_lu + integer, pointer, dimension(:) :: ivgtyp + integer :: all_water, iall_water + character (len=StrKIND), pointer :: gwdo_scheme + type (block_type), pointer :: block + type (mpas_pool_type), pointer :: meshPool + type (mpas_pool_type), pointer :: sfc_inputPool + + ierr = 0 + + call mpas_pool_get_config(blocklist % configs, 'config_gwdo_scheme', gwdo_scheme) + + if (trim(gwdo_scheme) == 'bl_kim_gwdo') then + maxvar2d_local = -huge(maxvar2d_local) + block => blockList + do while (associated(block)) + call mpas_pool_get_subpool(block % structs, 'mesh', meshPool) + call mpas_pool_get_subpool(block % structs, 'sfc_input', sfc_inputPool) + call mpas_pool_get_dimension(meshPool, 'nCellsSolve', nCellsSolve) + call mpas_pool_get_array(sfc_inputPool, 'var2d', var2d) + + maxvar2d_local = max(maxvar2d_local, maxval(var2d(1:nCellsSolve))) + + block => block % next + end do + + call mpas_dmpar_max_real(dminfo, maxvar2d_local, maxvar2d_global) + + ! + ! The GWDO check below can fail on regional simulations that are completely above + ! water. So, check to see if the simulation is completely above water and do not + ! throw the error if it is. + ! + call mpas_pool_get_array(sfc_inputPool, 'iswater', iswater_lu) + call mpas_pool_get_array(sfc_inputPool, 'ivgtyp', ivgtyp) + if (all(ivgtyp(1:nCellsSolve) == iswater_lu)) then + all_water = 1 ! All water + else + all_water = 0 ! Land present + end if + + call mpas_dmpar_min_int(dminfo, all_water, iall_water) + + if (maxvar2d_global <= 0.0_RKIND .and. iall_water /= 1) then + call mpas_log_write('*******************************************************************************', & + messageType=MPAS_LOG_ERR) + call mpas_log_write('The YSU GWDO scheme requires valid var2d, con, oa{1,2,3,4}, and ol{1,2,3,4} fields,', & + messageType=MPAS_LOG_ERR) + call mpas_log_write('but these fields appear to be zero everywhere in the model input.', & + messageType=MPAS_LOG_ERR) + call mpas_log_write('Either set config_gwdo_scheme = ''off'' in the &physics namelist, or generate', & + messageType=MPAS_LOG_ERR) + call mpas_log_write('the GWDO static fields with the init_atmosphere core.', & + messageType=MPAS_LOG_ERR) + call mpas_log_write('*******************************************************************************', & + messageType=MPAS_LOG_ERR) + ierr = ierr + 1 + end if + + end if + + end subroutine physics_compatibility_check + +!================================================================================================================= + end module mpas_atmphys_control +!================================================================================================================= + diff --git a/src/core_atmosphere/physics/mpas_atmphys_driver_gwdo.F-org b/src/core_atmosphere/physics/mpas_atmphys_driver_gwdo.F-org new file mode 100644 index 0000000000..a96ba7bf2a --- /dev/null +++ b/src/core_atmosphere/physics/mpas_atmphys_driver_gwdo.F-org @@ -0,0 +1,838 @@ +! Copyright (c) 2013, Los Alamos National Security, LLC (LANS) +! and the University Corporation for Atmospheric Research (UCAR). +! +! Unless noted otherwise source code is licensed under the BSD license. +! Additional copyright and license information can be found in the LICENSE file +! distributed with this code, or at http://mpas-dev.github.com/license.html +! +!================================================================================================================= + 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. +! +! subroutines in mpas_atmphys_driver_gwdo: +! ---------------------------------------- +! allocate_gwdo : allocate local arrays for parameterization of gravity wave drag. +! deallocate_gwdo: deallocate local arrays for parameterization of gravity wave drag. +! driver_gwdo : main driver (called from subroutine physics_driver). +! gwdo_from_MPAS : initialize local arrays. +! gwdo_to_MPAS : copy local arrays to MPAS arrays. +! +! WRF physics called from driver_gwdo: +! --------------------------- -------- +! * module_bl_gwdo : parameterization of gravity wave drag over orography. +! +! add-ons and modifications to sourcecode: +! ---------------------------------------- +! * removed the pre-processor option "do_hydrostatic_pressure" before call to subroutine gwdo. +! Laura D. Fowler (birch.ucar.edu) / 2013-05-29. +! * changed the definition of dx_p to the mean distance between cell centers. +! Laura D. Fowler (laura@ucar.edu) / 2013-08-23. +! * in call to subroutine gwdo, replaced the variable g (that originally pointed to gravity) +! with gravity, for simplicity. +! Laura D. Fowler (laura@ucar.edu) / 2014-03-21. +! * throughout the sourcecode, replaced all "var_struct" defined arrays by local pointers. +! Laura D. Fowler (laura@ucar.edu) / 2014-04-22. +! * modified sourcecode to use pools. +! Laura D. Fowler (laura@ucar.edu) / 2014-05-15. +! * renamed "ysu_gwdo" to "bl_gwdo_ysu". +! Laura D. Fowler (laura@ucar.edu) / 2016-03-25. +! * change the definition of dx_p to match that used in other physics parameterizations. +! Laura D. Fowler (laura@ucar.edu) / 2016-10-18. +! * modified the call to subroutine gwdo following the update of module_gwdo.F to that +! of WRF version 4.0.2. +! Laura D. Fowler (laura@ucar.edu) / 2019-01-30. +! * added the flags errmsg and errflg in the call to subroutine gwdo for compliance with the CCPP framework. +! 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 + + + 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)) + if(.not.allocated(dvsfcg_p)) allocate(dvsfcg_p(ims:ime,jms:jme)) + if(.not.allocated(dtaux3d_p)) allocate(dtaux3d_p(ims:ime,kms:kme,jms:jme)) + if(.not.allocated(dtauy3d_p)) allocate(dtauy3d_p(ims:ime,kms:kme,jms:jme)) + 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") + 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) ) + if(.not.allocated(oa2_p) ) allocate(oa2_p(ims:ime,jms:jme) ) + if(.not.allocated(oa3_p) ) allocate(oa3_p(ims:ime,jms:jme) ) + if(.not.allocated(oa4_p) ) allocate(oa4_p(ims:ime,jms:jme) ) + if(.not.allocated(ol1_p) ) allocate(ol1_p(ims:ime,jms:jme) ) + if(.not.allocated(ol2_p) ) allocate(ol2_p(ims:ime,jms:jme) ) + if(.not.allocated(ol3_p) ) allocate(ol3_p(ims:ime,jms:jme) ) + if(.not.allocated(ol4_p) ) allocate(ol4_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) ) + if(.not.allocated(oa1ls_p) ) allocate(oa1ls_p(ims:ime,jms:jme) ) + if(.not.allocated(oa2ls_p) ) allocate(oa2ls_p(ims:ime,jms:jme) ) + if(.not.allocated(oa3ls_p) ) allocate(oa3ls_p(ims:ime,jms:jme) ) + if(.not.allocated(oa4ls_p) ) allocate(oa4ls_p(ims:ime,jms:jme) ) + if(.not.allocated(ol1ls_p) ) allocate(ol1ls_p(ims:ime,jms:jme) ) + if(.not.allocated(ol2ls_p) ) allocate(ol2ls_p(ims:ime,jms:jme) ) + if(.not.allocated(ol3ls_p) ) allocate(ol3ls_p(ims:ime,jms:jme) ) + if(.not.allocated(ol4ls_p) ) allocate(ol4ls_p(ims:ime,jms:jme) ) + if(.not.allocated(var2dss_p) ) allocate(var2dss_p(ims:ime,jms:jme) ) + if(.not.allocated(conss_p) ) allocate(conss_p(ims:ime,jms:jme) ) + if(.not.allocated(oa1ss_p) ) allocate(oa1ss_p(ims:ime,jms:jme) ) + if(.not.allocated(oa2ss_p) ) allocate(oa2ss_p(ims:ime,jms:jme) ) + if(.not.allocated(oa3ss_p) ) allocate(oa3ss_p(ims:ime,jms:jme) ) + if(.not.allocated(oa4ss_p) ) allocate(oa4ss_p(ims:ime,jms:jme) ) + if(.not.allocated(ol1ss_p) ) allocate(ol1ss_p(ims:ime,jms:jme) ) + if(.not.allocated(ol2ss_p) ) allocate(ol2ss_p(ims:ime,jms:jme) ) + if(.not.allocated(ol3ss_p) ) allocate(ol3ss_p(ims:ime,jms:jme) ) + if(.not.allocated(ol4ss_p) ) allocate(ol4ss_p(ims:ime,jms:jme) ) + if(.not.allocated(hpbl_p) ) allocate(hpbl_p(ims:ime,jms:jme) ) + if(.not.allocated(br_p) ) allocate(br_p(ims:ime,jms:jme) ) + if(.not.allocated(xland_p ) ) allocate(xland_p(ims:ime,jms:jme) ) + if (ugwp_diags) then + if(.not.allocated(dusfc_ls_p)) allocate(dusfc_ls_p(ims:ime,jms:jme)) + if(.not.allocated(dvsfc_ls_p)) allocate(dvsfc_ls_p(ims:ime,jms:jme)) + if(.not.allocated(dusfc_bl_p)) allocate(dusfc_bl_p(ims:ime,jms:jme)) + if(.not.allocated(dvsfc_bl_p)) allocate(dvsfc_bl_p(ims:ime,jms:jme)) + if(.not.allocated(dusfc_ss_p)) allocate(dusfc_ss_p(ims:ime,jms:jme)) + if(.not.allocated(dvsfc_ss_p)) allocate(dvsfc_ss_p(ims:ime,jms:jme)) + if(.not.allocated(dusfc_fd_p)) allocate(dusfc_fd_p(ims:ime,jms:jme)) + if(.not.allocated(dvsfc_fd_p)) allocate(dvsfc_fd_p(ims:ime,jms:jme)) + if(.not.allocated(dtaux3d_ls_p)) allocate(dtaux3d_ls_p(ims:ime,kms:kme,jms:jme)) + if(.not.allocated(dtauy3d_ls_p)) allocate(dtauy3d_ls_p(ims:ime,kms:kme,jms:jme)) + if(.not.allocated(dtaux3d_bl_p)) allocate(dtaux3d_bl_p(ims:ime,kms:kme,jms:jme)) + if(.not.allocated(dtauy3d_bl_p)) allocate(dtauy3d_bl_p(ims:ime,kms:kme,jms:jme)) + if(.not.allocated(dtaux3d_ss_p)) allocate(dtaux3d_ss_p(ims:ime,kms:kme,jms:jme)) + if(.not.allocated(dtauy3d_ss_p)) allocate(dtauy3d_ss_p(ims:ime,kms:kme,jms:jme)) + if(.not.allocated(dtaux3d_fd_p)) allocate(dtaux3d_fd_p(ims:ime,kms:kme,jms:jme)) + if(.not.allocated(dtauy3d_fd_p)) allocate(dtauy3d_fd_p(ims:ime,kms:kme,jms:jme)) + if (ngw_scheme) then + if(.not.allocated(dudt_ngw_p)) allocate(dudt_ngw_p(ims:ime,kms:kme,jms:jme)) + if(.not.allocated(dvdt_ngw_p)) allocate(dvdt_ngw_p(ims:ime,kms:kme,jms:jme)) + if(.not.allocated(dtdt_ngw_p)) allocate(dtdt_ngw_p(ims:ime,kms:kme,jms:jme)) + endif + endif + if (ngw_scheme) then + if(.not.allocated(xlat_p)) allocate(xlat_p(ims:ime,jms:jme)) + if(.not.allocated(raincv_p) ) allocate(raincv_p(ims:ime,jms:jme) ) + if(.not.allocated(rainncv_p) ) allocate(rainncv_p(ims:ime,jms:jme) ) + if(.not.allocated(jindx1_tau_p)) allocate(jindx1_tau_p(ims:ime,jms:jme)) + if(.not.allocated(jindx2_tau_p)) allocate(jindx2_tau_p(ims:ime,jms:jme)) + 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) + if(allocated(dvsfcg_p)) deallocate(dvsfcg_p) + if(allocated(dtaux3d_p)) deallocate(dtaux3d_p) + if(allocated(dtauy3d_p)) deallocate(dtauy3d_p) + 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") + if(allocated(var2d_p) ) deallocate(var2d_p ) + if(allocated(con_p) ) deallocate(con_p ) + if(allocated(oa1_p) ) deallocate(oa1_p ) + if(allocated(oa2_p) ) deallocate(oa2_p ) + if(allocated(oa3_p) ) deallocate(oa3_p ) + if(allocated(oa4_p) ) deallocate(oa4_p ) + if(allocated(ol1_p) ) deallocate(ol1_p ) + if(allocated(ol2_p) ) deallocate(ol2_p ) + if(allocated(ol3_p) ) deallocate(ol3_p ) + if(allocated(ol4_p) ) deallocate(ol4_p ) + + case("bl_ugwp_gwdo") + if(allocated(var2dls_p) ) deallocate(var2dls_p ) + if(allocated(conls_p) ) deallocate(conls_p ) + if(allocated(oa1ls_p) ) deallocate(oa1ls_p ) + if(allocated(oa2ls_p) ) deallocate(oa2ls_p ) + if(allocated(oa3ls_p) ) deallocate(oa3ls_p ) + if(allocated(oa4ls_p) ) deallocate(oa4ls_p ) + if(allocated(ol1ls_p) ) deallocate(ol1ls_p ) + if(allocated(ol2ls_p) ) deallocate(ol2ls_p ) + if(allocated(ol3ls_p) ) deallocate(ol3ls_p ) + if(allocated(ol4ls_p) ) deallocate(ol4ls_p ) + if(allocated(var2dss_p) ) deallocate(var2dss_p ) + if(allocated(conss_p) ) deallocate(conss_p ) + if(allocated(oa1ss_p) ) deallocate(oa1ss_p ) + if(allocated(oa2ss_p) ) deallocate(oa2ss_p ) + if(allocated(oa3ss_p) ) deallocate(oa3ss_p ) + if(allocated(oa4ss_p) ) deallocate(oa4ss_p ) + if(allocated(ol1ss_p) ) deallocate(ol1ss_p ) + if(allocated(ol2ss_p) ) deallocate(ol2ss_p ) + if(allocated(ol3ss_p) ) deallocate(ol3ss_p ) + if(allocated(ol4ss_p) ) deallocate(ol4ss_p ) + if(allocated(hpbl_p) ) deallocate(hpbl_p ) + if(allocated(br_p) ) deallocate(br_p ) + if(allocated(xland_p) ) deallocate(xland_p ) + if (ugwp_diags) then + if(allocated(dusfc_ls_p)) deallocate(dusfc_ls_p) + if(allocated(dvsfc_ls_p)) deallocate(dvsfc_ls_p) + if(allocated(dusfc_bl_p)) deallocate(dusfc_bl_p) + if(allocated(dvsfc_bl_p)) deallocate(dvsfc_bl_p) + if(allocated(dusfc_ss_p)) deallocate(dusfc_ss_p) + if(allocated(dvsfc_ss_p)) deallocate(dvsfc_ss_p) + if(allocated(dusfc_fd_p)) deallocate(dusfc_fd_p) + if(allocated(dvsfc_fd_p)) deallocate(dvsfc_fd_p) + if(allocated(dtaux3d_ls_p)) deallocate(dtaux3d_ls_p) + if(allocated(dtauy3d_ls_p)) deallocate(dtauy3d_ls_p) + if(allocated(dtaux3d_bl_p)) deallocate(dtaux3d_bl_p) + if(allocated(dtauy3d_bl_p)) deallocate(dtauy3d_bl_p) + if(allocated(dtaux3d_ss_p)) deallocate(dtaux3d_ss_p) + if(allocated(dtauy3d_ss_p)) deallocate(dtauy3d_ss_p) + if(allocated(dtaux3d_fd_p)) deallocate(dtaux3d_fd_p) + if(allocated(dtauy3d_fd_p)) deallocate(dtauy3d_fd_p) + if (ngw_scheme) then + if(allocated(dudt_ngw_p)) deallocate(dudt_ngw_p) + if(allocated(dvdt_ngw_p)) deallocate(dvdt_ngw_p) + if(allocated(dtdt_ngw_p)) deallocate(dtdt_ngw_p) + endif + endif + if (ngw_scheme) then + if(allocated(xlat_p)) deallocate(xlat_p) + if(allocated(raincv_p) ) deallocate(raincv_p) + if(allocated(rainncv_p) ) deallocate(rainncv_p) + if(allocated(jindx1_tau_p)) deallocate(jindx1_tau_p) + if(allocated(jindx2_tau_p)) deallocate(jindx2_tau_p) + 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 + type(mpas_pool_type),intent(in):: sfc_input + 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 + real(kind=RKIND),pointer:: len_disp + real(kind=RKIND),dimension(:),pointer :: meshDensity + real(kind=RKIND),dimension(:),pointer :: oa1,oa2,oa3,oa4,ol1,ol2,ol3,ol4,con,var2d + 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, & + ol3ss,ol4ss,conss,var2dss + real(kind=RKIND),dimension(:),pointer :: dusfcg,dvsfcg + real(kind=RKIND),dimension(:,:),pointer:: dtaux3d,dtauy3d,rublten,rvblten + real(kind=RKIND),dimension(:,:),pointer:: rthblten + real(kind=RKIND),dimension(:),pointer :: dusfc_ls,dvsfc_ls,dusfc_bl,dvsfc_bl, & + dusfc_ss,dvsfc_ss,dusfc_fd,dvsfc_fd + real(kind=RKIND),dimension(:),pointer :: hpbl,xland,br1 + real(kind=RKIND),dimension(:),pointer :: latCell,ddy_j1tau,ddy_j2tau,raincv,rainncv + 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) + call mpas_pool_get_config(configs,'config_ngw_scheme',ngw_scheme) + 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") + call mpas_pool_get_array(sfc_input,'var2d',var2d) + call mpas_pool_get_array(sfc_input,'con' ,con ) + call mpas_pool_get_array(sfc_input,'oa1' ,oa1 ) + call mpas_pool_get_array(sfc_input,'oa2' ,oa2 ) + call mpas_pool_get_array(sfc_input,'oa3' ,oa3 ) + call mpas_pool_get_array(sfc_input,'oa4' ,oa4 ) + call mpas_pool_get_array(sfc_input,'ol1' ,ol1 ) + call mpas_pool_get_array(sfc_input,'ol2' ,ol2 ) + call mpas_pool_get_array(sfc_input,'ol3' ,ol3 ) + call mpas_pool_get_array(sfc_input,'ol4' ,ol4 ) + do j = jts,jte + do i = its,ite + var2d_p(i,j) = var2d(i) + con_p(i,j) = con(i) + oa1_p(i,j) = oa1(i) + oa2_p(i,j) = oa2(i) + oa3_p(i,j) = oa3(i) + oa4_p(i,j) = oa4(i) + ol1_p(i,j) = ol1(i) + ol2_p(i,j) = ol2(i) + ol3_p(i,j) = ol3(i) + ol4_p(i,j) = ol4(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 ) + call mpas_pool_get_array(sfc_input,'oa1ls' ,oa1ls ) + call mpas_pool_get_array(sfc_input,'oa2ls' ,oa2ls ) + call mpas_pool_get_array(sfc_input,'oa3ls' ,oa3ls ) + call mpas_pool_get_array(sfc_input,'oa4ls' ,oa4ls ) + call mpas_pool_get_array(sfc_input,'ol1ls' ,ol1ls ) + call mpas_pool_get_array(sfc_input,'ol2ls' ,ol2ls ) + call mpas_pool_get_array(sfc_input,'ol3ls' ,ol3ls ) + call mpas_pool_get_array(sfc_input,'ol4ls' ,ol4ls ) + call mpas_pool_get_array(sfc_input,'var2dss',var2dss) + call mpas_pool_get_array(sfc_input,'conss' ,conss ) + call mpas_pool_get_array(sfc_input,'oa1ss' ,oa1ss ) + call mpas_pool_get_array(sfc_input,'oa2ss' ,oa2ss ) + call mpas_pool_get_array(sfc_input,'oa3ss' ,oa3ss ) + call mpas_pool_get_array(sfc_input,'oa4ss' ,oa4ss ) + call mpas_pool_get_array(sfc_input,'ol1ss' ,ol1ss ) + call mpas_pool_get_array(sfc_input,'ol2ss' ,ol2ss ) + call mpas_pool_get_array(sfc_input,'ol3ss' ,ol3ss ) + call mpas_pool_get_array(sfc_input,'ol4ss' ,ol4ss ) + call mpas_pool_get_array(diag_physics,'hpbl',hpbl ) + call mpas_pool_get_array(diag_physics,'br' ,br1 ) + call mpas_pool_get_array(sfc_input,'xland' ,xland ) + do j = jts,jte + do i = its,ite + var2dls_p(i,j) = var2dls(i) + conls_p(i,j) = conls(i) + oa1ls_p(i,j) = oa1ls(i) + oa2ls_p(i,j) = oa2ls(i) + oa3ls_p(i,j) = oa3ls(i) + oa4ls_p(i,j) = oa4ls(i) + ol1ls_p(i,j) = ol1ls(i) + ol2ls_p(i,j) = ol2ls(i) + ol3ls_p(i,j) = ol3ls(i) + ol4ls_p(i,j) = ol4ls(i) + var2dss_p(i,j) = var2dss(i) + conss_p(i,j) = conss(i) + oa1ss_p(i,j) = oa1ss(i) + oa2ss_p(i,j) = oa2ss(i) + oa3ss_p(i,j) = oa3ss(i) + oa4ss_p(i,j) = oa4ss(i) + ol1ss_p(i,j) = ol1ss(i) + ol2ss_p(i,j) = ol2ss(i) + ol3ss_p(i,j) = ol3ss(i) + ol4ss_p(i,j) = ol4ss(i) + hpbl_p(i,j) = hpbl(i) + br_p(i,j) = br1(i) + xland_p(i,j) = xland(i) + enddo + enddo + if (ugwp_diags) then + call mpas_pool_get_array(diag_physics,'dusfc_ls' ,dusfc_ls ) + call mpas_pool_get_array(diag_physics,'dvsfc_ls' ,dvsfc_ls ) + call mpas_pool_get_array(diag_physics,'dusfc_bl' ,dusfc_bl ) + call mpas_pool_get_array(diag_physics,'dvsfc_bl' ,dvsfc_bl ) + call mpas_pool_get_array(diag_physics,'dusfc_ss' ,dusfc_ss ) + call mpas_pool_get_array(diag_physics,'dvsfc_ss' ,dvsfc_ss ) + call mpas_pool_get_array(diag_physics,'dusfc_fd' ,dusfc_fd ) + call mpas_pool_get_array(diag_physics,'dvsfc_fd' ,dvsfc_fd ) + call mpas_pool_get_array(diag_physics,'dtaux3d_ls' ,dtaux3d_ls ) + call mpas_pool_get_array(diag_physics,'dtauy3d_ls' ,dtauy3d_ls ) + call mpas_pool_get_array(diag_physics,'dtaux3d_bl' ,dtaux3d_bl ) + call mpas_pool_get_array(diag_physics,'dtauy3d_bl' ,dtauy3d_bl ) + call mpas_pool_get_array(diag_physics,'dtaux3d_ss' ,dtaux3d_ss ) + call mpas_pool_get_array(diag_physics,'dtauy3d_ss' ,dtauy3d_ss ) + call mpas_pool_get_array(diag_physics,'dtaux3d_fd' ,dtaux3d_fd ) + call mpas_pool_get_array(diag_physics,'dtauy3d_fd' ,dtauy3d_fd ) + do j = jts,jte + do i = its,ite + dusfc_ls_p(i,j) = dusfc_ls(i) + dvsfc_ls_p(i,j) = dvsfc_ls(i) + dusfc_bl_p(i,j) = dusfc_bl(i) + dvsfc_bl_p(i,j) = dvsfc_bl(i) + dusfc_ss_p(i,j) = dusfc_ss(i) + dvsfc_ss_p(i,j) = dvsfc_ss(i) + dusfc_fd_p(i,j) = dusfc_fd(i) + dvsfc_fd_p(i,j) = dvsfc_fd(i) + enddo + enddo + do j = jts,jte + do k = kts,kte + do i = its,ite + dtaux3d_ls_p(i,k,j) = dtaux3d_ls(k,i) + dtauy3d_ls_p(i,k,j) = dtauy3d_ls(k,i) + dtaux3d_bl_p(i,k,j) = dtaux3d_bl(k,i) + dtauy3d_bl_p(i,k,j) = dtauy3d_bl(k,i) + dtaux3d_ss_p(i,k,j) = dtaux3d_ss(k,i) + dtauy3d_ss_p(i,k,j) = dtauy3d_ss(k,i) + dtaux3d_fd_p(i,k,j) = dtaux3d_fd(k,i) + dtauy3d_fd_p(i,k,j) = dtauy3d_fd(k,i) + enddo + enddo + enddo + endif + if (ugwp_diags.and.ngw_scheme) then + call mpas_pool_get_array(diag_physics,'dudt_ngw',dudt_ngw) + call mpas_pool_get_array(diag_physics,'dvdt_ngw',dvdt_ngw) + call mpas_pool_get_array(diag_physics,'dtdt_ngw',dtdt_ngw) + do j = jts,jte + do k = kts,kte + do i = its,ite + dudt_ngw_p(i,k,j) = dudt_ngw(k,i) + dvdt_ngw_p(i,k,j) = dvdt_ngw(k,i) + dtdt_ngw_p(i,k,j) = dtdt_ngw(k,i) + enddo + enddo + enddo + endif + if (ngw_scheme) then + call mpas_pool_get_array(mesh,'latCell',latCell) + if(trim(convection_scheme) /= "off") & + call mpas_pool_get_array(diag_physics,'raincv',raincv) + if(trim(microp_scheme) /= "off") & + call mpas_pool_get_array(diag_physics,'rainncv',rainncv) + call mpas_pool_get_array(ngw_input,'jindx1_tau',jindx1_tau) + call mpas_pool_get_array(ngw_input,'jindx2_tau',jindx2_tau) + call mpas_pool_get_array(ngw_input,'ddy_j1tau', ddy_j1tau) + call mpas_pool_get_array(ngw_input,'ddy_j2tau', ddy_j2tau) + do j = jts,jte + do i = its,ite + xlat_p(i,j) = latCell(i)*rad2deg ! latitude in degrees + jindx1_tau_p(i,j) = jindx1_tau(i) + jindx2_tau_p(i,j) = jindx2_tau(i) + ddy_j1tau_p(i,j) = ddy_j1tau(i) + ddy_j2tau_p(i,j) = ddy_j2tau(i) + enddo + enddo + ! Treat rain rates conditionally + if(trim(convection_scheme) == "off") then + raincv_p(:,:) = 0._RKIND + else + do j = jts,jte + do i = its,ite + raincv_p(i,j) = raincv(i) + enddo + enddo + endif + if(trim(microp_scheme) == "off") then + rainncv_p(:,:) = 0._RKIND + else + do j = jts,jte + do i = its,ite + rainncv_p(i,j) = rainncv(i) + 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 ) + call mpas_pool_get_array(diag_physics,'dtaux3d' ,dtaux3d ) + call mpas_pool_get_array(diag_physics,'dtauy3d' ,dtauy3d ) + 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 + cosa_p(i,j) = 1._RKIND + dx_p(i,j) = len_disp / meshDensity(i)**0.25 + kpbl_p(i,j) = kpbl(i) + dusfcg_p(i,j) = dusfcg(i) + dvsfcg_p(i,j) = dvsfcg(i) + enddo + enddo + + do j = jts,jte + do k = kts,kte + do i = its,ite + dtaux3d_p(i,k,j) = dtaux3d(k,i) + dtauy3d_p(i,k,j) = dtauy3d(k,i) + rublten_p(i,k,j) = rublten(k,i) + rvblten_p(i,k,j) = rvblten(k,i) + rthblten_p(i,k,j) = rthblten(k,i) + 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, & + ol3ss,ol4ss,conss,var2dss + real(kind=RKIND),dimension(:),pointer :: dusfc_ls,dvsfc_ls,dusfc_bl,dvsfc_bl, & + dusfc_ss,dvsfc_ss,dusfc_fd,dvsfc_fd + 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) + call mpas_pool_get_array(diag_physics,'dusfcg' ,dusfcg ) + call mpas_pool_get_array(diag_physics,'dvsfcg' ,dvsfcg ) + call mpas_pool_get_array(diag_physics,'dtaux3d' ,dtaux3d ) + call mpas_pool_get_array(diag_physics,'dtauy3d' ,dtauy3d ) + call mpas_pool_get_array(diag_physics,'rubldiff',rubldiff) + call mpas_pool_get_array(diag_physics,'rvbldiff',rvbldiff) + 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 ) + call mpas_pool_get_array(diag_physics,'dvsfc_ls' ,dvsfc_ls ) + call mpas_pool_get_array(diag_physics,'dusfc_bl' ,dusfc_bl ) + call mpas_pool_get_array(diag_physics,'dvsfc_bl' ,dvsfc_bl ) + call mpas_pool_get_array(diag_physics,'dusfc_ss' ,dusfc_ss ) + call mpas_pool_get_array(diag_physics,'dvsfc_ss' ,dvsfc_ss ) + call mpas_pool_get_array(diag_physics,'dusfc_fd' ,dusfc_fd ) + call mpas_pool_get_array(diag_physics,'dvsfc_fd' ,dvsfc_fd ) + call mpas_pool_get_array(diag_physics,'dtaux3d_ls' ,dtaux3d_ls ) + call mpas_pool_get_array(diag_physics,'dtauy3d_ls' ,dtauy3d_ls ) + call mpas_pool_get_array(diag_physics,'dtaux3d_bl' ,dtaux3d_bl ) + call mpas_pool_get_array(diag_physics,'dtauy3d_bl' ,dtauy3d_bl ) + call mpas_pool_get_array(diag_physics,'dtaux3d_ss' ,dtaux3d_ss ) + call mpas_pool_get_array(diag_physics,'dtauy3d_ss' ,dtauy3d_ss ) + call mpas_pool_get_array(diag_physics,'dtaux3d_fd' ,dtaux3d_fd ) + call mpas_pool_get_array(diag_physics,'dtauy3d_fd' ,dtauy3d_fd ) + do j = jts,jte + do i = its,ite + dusfc_ls(i) = dusfc_ls_p(i,j) + dvsfc_ls(i) = dvsfc_ls_p(i,j) + dusfc_bl(i) = dusfc_bl_p(i,j) + dvsfc_bl(i) = dvsfc_bl_p(i,j) + dusfc_ss(i) = dusfc_ss_p(i,j) + dvsfc_ss(i) = dvsfc_ss_p(i,j) + dusfc_fd(i) = dusfc_fd_p(i,j) + dvsfc_fd(i) = dvsfc_fd_p(i,j) + enddo + enddo + do j = jts,jte + do k = kts,kte + do i = its,ite + dtaux3d_ls(k,i) = dtaux3d_ls_p(i,k,j) + dtauy3d_ls(k,i) = dtauy3d_ls_p(i,k,j) + dtaux3d_bl(k,i) = dtaux3d_bl_p(i,k,j) + dtauy3d_bl(k,i) = dtauy3d_bl_p(i,k,j) + dtaux3d_ss(k,i) = dtaux3d_ss_p(i,k,j) + dtauy3d_ss(k,i) = dtauy3d_ss_p(i,k,j) + dtaux3d_fd(k,i) = dtaux3d_fd_p(i,k,j) + dtauy3d_fd(k,i) = dtauy3d_fd_p(i,k,j) + enddo + enddo + enddo + if (ngw_scheme) then + call mpas_pool_get_array(diag_physics,'dudt_ngw' ,dudt_ngw ) + call mpas_pool_get_array(diag_physics,'dvdt_ngw' ,dvdt_ngw ) + call mpas_pool_get_array(diag_physics,'dtdt_ngw' ,dtdt_ngw ) + do j = jts,jte + do k = kts,kte + do i = its,ite + dudt_ngw(k,i) = dudt_ngw_p(i,k,j) + dvdt_ngw(k,i) = dvdt_ngw_p(i,k,j) + dtdt_ngw(k,i) = dtdt_ngw_p(i,k,j) + enddo + enddo + 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 + dtaux3d(k,i) = dtaux3d_p(i,k,j) + dtauy3d(k,i) = dtauy3d_p(i,k,j) + rubldiff(k,i) = rublten_p(i,k,j)-rublten(k,i) + rvbldiff(k,i) = rvblten_p(i,k,j)-rvblten(k,i) + rublten(k,i) = rublten_p(i,k,j) + rvblten(k,i) = rvblten_p(i,k,j) + rthblten(k,i) = rthblten_p(i,k,j) + 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 + 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 + +!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) + call mpas_pool_get_dimension(mesh,'days',ntau_d2t_ptr) + call mpas_pool_get_array(ngw_input,'DAYS',days_limb_ptr) + call mpas_pool_get_array(ngw_input,'ABSMF',tau_limb_ptr) + ntau_d1y = ntau_d1y_ptr + ntau_d2t = ntau_d2t_ptr + if(.not.allocated(days_limb)) allocate(days_limb(ntau_d2t)) + if(.not.allocated(tau_limb) ) allocate(tau_limb (ntau_d1y,ntau_d2t)) + 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") + call mpas_timer_start('bl_gwdo') + call gwdo ( & + p3d = pres_hydd_p , p3di = pres2_hydd_p , pi3d = pi_p , & + u3d = u_p , v3d = v_p , t3d = t_p , & + qv3d = qv_p , z = zmid_p , rublten = rublten_p , & + rvblten = rvblten_p , dtaux3d = dtaux3d_p , dtauy3d = dtauy3d_p , & + dusfcg = dusfcg_p , dvsfcg = dvsfcg_p , kpbl2d = kpbl_p , & + itimestep = itimestep , dt = dt_pbl , dx = dx_p , & + cp = cp , g = gravity , rd = R_d , & + rv = R_v , ep1 = ep_1 , pi = pii , & + var2d = var2d_p , oc12d = con_p , oa2d1 = oa1_p , & + oa2d2 = oa2_p , oa2d3 = oa3_p , oa2d4 = oa4_p , & + ol2d1 = ol1_p , ol2d2 = ol2_p , ol2d3 = ol3_p , & + ol2d4 = ol4_p , sina = sina_p , cosa = cosa_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_gwdo') + + case("bl_ugwp_gwdo") + call mpas_timer_start('bl_ugwp_gwdo') + call gwdo_ugwp ( & + p3d = pres_hydd_p , p3di = pres2_hydd_p, pi3d = pi_p , & + u3d = u_p , v3d = v_p , t3d = t_p , & + qv3d = qv_p , z = zmid_p , rublten = rublten_p , & + rvblten = rvblten_p , rthblten = rthblten_p , & + dtaux3d = dtaux3d_p , dtauy3d = dtauy3d_p , & + dusfcg = dusfcg_p , dvsfcg = dvsfcg_p , kpbl2d = kpbl_p , & + itimestep = itimestep , dt = dt_pbl , dx = dx_p , & + pblh = hpbl_p , br1 = br_p , xland = xland_p , & + cp = cp , g = gravity , rd = R_d , & + rv = R_v , ep1 = ep_1 , pi = pii , & + sina = sina_p , cosa = cosa_p , dz = dz_p , & + var2dls = var2dls_p , oc12dls = conls_p , oa2d1ls = oa1ls_p , & + oa2d2ls = oa2ls_p , oa2d3ls = oa3ls_p , oa2d4ls = oa4ls_p , & + ol2d1ls = ol1ls_p , ol2d2ls = ol2ls_p , ol2d3ls = ol3ls_p , & + ol2d4ls = ol4ls_p , var2dss = var2dss_p , oc12dss = conss_p , & + oa2d1ss = oa1ss_p , oa2d2ss = oa2ss_p , oa2d3ss = oa3ss_p , & + oa2d4ss = oa4ss_p , ol2d1ss = ol1ss_p , ol2d2ss = ol2ss_p , & + ol2d3ss = ol3ss_p , ol2d4ss = ol4ss_p , zi = z_p , & + dusfc_ls = dusfc_ls_p , dvsfc_ls = dvsfc_ls_p , dusfc_bl = dusfc_bl_p, & + dvsfc_bl = dvsfc_bl_p , dusfc_ss = dusfc_ss_p , dvsfc_ss = dvsfc_ss_p, & + dusfc_fd = dusfc_fd_p , dvsfc_fd = dvsfc_fd_p , & + dtaux3d_ls = dtaux3d_ls_p, dtauy3d_ls = dtauy3d_ls_p, & + dtaux3d_bl = dtaux3d_bl_p, dtauy3d_bl = dtauy3d_bl_p, & + dtaux3d_ss = dtaux3d_ss_p, dtauy3d_ss = dtauy3d_ss_p, & + dtaux3d_fd = dtaux3d_fd_p, dtauy3d_fd = dtauy3d_fd_p, & + ugwp_diags = ugwp_diags , ngw_scheme = ngw_scheme , xlatd = xlat_p , & + jindx1_tau = jindx1_tau_p, jindx2_tau = jindx2_tau_p, & + ddy_j1tau = ddy_j1tau_p , ddy_j2tau = ddy_j2tau_p , r_DoY = curr_julday, & + raincv = raincv_p , rainncv = rainncv_p , ntau_d1y = ntau_d1y , & + ntau_d2t = ntau_d2t , days_limb = days_limb , tau_limb = tau_limb , & + dudt_ngw = dudt_ngw_p , dvdt_ngw = dvdt_ngw_p , dtdt_ngw = dtdt_ngw_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 & + ) + if (ngw_scheme) then + if(allocated(days_limb)) deallocate(days_limb) + 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_pbl.F b/src/core_atmosphere/physics/mpas_atmphys_driver_pbl.F index 72a411aeba..c73c70eb2b 100644 --- a/src/core_atmosphere/physics/mpas_atmphys_driver_pbl.F +++ b/src/core_atmosphere/physics/mpas_atmphys_driver_pbl.F @@ -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 @@ -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: @@ -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 @@ -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) ) @@ -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) ) @@ -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 ) @@ -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 ) @@ -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 @@ -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 @@ -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: @@ -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) @@ -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 ) @@ -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, & @@ -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 ( & diff --git a/src/core_atmosphere/physics/mpas_atmphys_driver_pbl.F-org b/src/core_atmosphere/physics/mpas_atmphys_driver_pbl.F-org new file mode 100644 index 0000000000..72a411aeba --- /dev/null +++ b/src/core_atmosphere/physics/mpas_atmphys_driver_pbl.F-org @@ -0,0 +1,977 @@ +! Copyright (c) 2013, Los Alamos National Security, LLC (LANS) +! and the University Corporation for Atmospheric Research (UCAR). +! +! Unless noted otherwise source code is licensed under the BSD license. +! Additional copyright and license information can be found in the LICENSE file +! distributed with this code, or at http://mpas-dev.github.com/license.html +! +!================================================================================================================= + module mpas_atmphys_driver_pbl + 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 bl_mynn,only: bl_mynn_init + use module_bl_mynn,only: mynn_bl_driver + use module_bl_ysu + + implicit none + private + public:: allocate_pbl, & + deallocate_pbl, & + init_pbl, & + driver_pbl + +!MPAS driver for parameterization of Planetary Boundary Layer (PBL) processes. +!Laura D. Fowler (send comments to laura@ucar.edu). +!2013-05-01. +! +! subroutines in mpas_atmphys_driver_pbl: +! --------------------------------------- +! allocate_pbl : allocate local arrays for parameterization of PBL processes. +! deallocate_pbl: deallocate local arrays for parameterization of PBL processes. +! driver_pbl : main driver (called from subroutine physics_driver). +! pbl_from_MPAS : initialize local arrays. +! pbl_to_MPAS : copy local arrays to MPAS arrays. +! +! WRF physics called from driver_pbl: +! ----------------------------------- +! * module_bl_ysu : YSU PBL scheme. +! +! add-ons and modifications to sourcecode: +! ---------------------------------------- +! * removed the pre-processor option "do_hydrostatic_pressure" before call to subroutine ysu. +! Laura D. Fowler (birch.ucar.edu) / 2013-05-29. +! * in call to subroutine ysu, replaced the variable g (that originally pointed to gravity) +! with gravity, for simplicity. +! Laura D. Fowler (laura@ucar.edu) / 2014-03-21. +! * throughout the sourcecode, replaced all "var_struct" defined arrays by local pointers. +! Laura D. Fowler (laura@ucar.edu) / 2014-04-22. +! * modified sourcecode to use pools. +! Laura D. Fowler (laura@ucar.edu) / 2014-05-15. +! * renamed "ysu" with "bl_ysu". +! Laura D. Fowler (laura@ucar.edu) / 2016-03-25. +! * added the implementation of the MYNN PBL scheme from WRF 3.6.1. +! Laura D. Fowler (laura@ucar.edu) / 2016-03-30. +! * corrected the initialization of sh3d for the mynn parameterization. +! Laura D. Fowler (laura@ucar.edu) / 2016-04-13. +! * for the mynn parameterization, change the definition of dx_p to match that used in other physics +! parameterizations. +! Laura D. Fowler (laura@ucar.edu) / 2016-10-18. +! * updated the call to subroutine ysu in conjunction with updating module_bl_ysu.F from WRF version 3.6.1 to +! WRF version 3.8.1 +! Laura D. Fowler (laura@ucar.edu) / 2016-10-27. +! * since we removed the local variable pbl_scheme from mpas_atmphys_vars.F, now defines pbl_scheme as a pointer +! to config_pbl_scheme. +! Laura D. Fowler (laura@ucar.edu) / 2917-02-16. +! * after updating module_bl_ysu.F to WRF version 4.0.3, corrected call to subroutine ysu to output diagnostics of +! exchange coefficients exch_h and exch_m. +! Laura D. Fowler (laura@ucar.edu) / 2019-03-12. +! * updated the call to subroutine ysu after updating the YSU PBL scheme to that in WRF 4.4.1. added the flags +! errmsg and errflg in the call to subroutine ysu for compliance with the CCPP framework. also removed local +! variable regime_p which is no longer needed in the call to subroutine ysu. +! Laura D. Fowler (laura@ucar.edu) / 2023-05-15. +! * in the call to subroutine mynn_bl_driver,renamed f_qnc to f_nc, and f_qni to f_ni. +! 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. + + + contains + + +!================================================================================================================= + subroutine allocate_pbl(configs) +!================================================================================================================= + +!input arguments: + type(mpas_pool_type),intent(in):: configs + +!local pointers: + character(len=StrKIND),pointer:: pbl_scheme + +!----------------------------------------------------------------------------------------------------------------- + + call mpas_pool_get_config(configs,'config_pbl_scheme',pbl_scheme) + + if(.not.allocated(hfx_p) ) allocate(hfx_p(ims:ime,jms:jme) ) + if(.not.allocated(qfx_p) ) allocate(qfx_p(ims:ime,jms:jme) ) + 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(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) ) + if(.not.allocated(uoce_p) ) allocate(uoce_p(ims:ime,jms:jme) ) + if(.not.allocated(voce_p) ) allocate(voce_p(ims:ime,jms:jme) ) + + !tendencies: + 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)) + if(.not.allocated(rqvblten_p)) allocate(rqvblten_p(ims:ime,kms:kme,jms:jme)) + if(.not.allocated(rqcblten_p)) allocate(rqcblten_p(ims:ime,kms:kme,jms:jme)) + if(.not.allocated(rqiblten_p)) allocate(rqiblten_p(ims:ime,kms:kme,jms:jme)) + + if(.not.allocated(rthraten_p)) allocate(rthraten_p(ims:ime,kms:kme,jms:jme)) + + !exchange coefficients: + if(.not.allocated(kzh_p)) allocate(kzh_p(ims:ime,kms:kme,jms:jme)) + if(.not.allocated(kzm_p)) allocate(kzm_p(ims:ime,kms:kme,jms:jme)) + if(.not.allocated(kzq_p)) allocate(kzq_p(ims:ime,kms:kme,jms:jme)) + + pbl_select: select case (trim(pbl_scheme)) + + case("bl_ysu") + !from surface-layer model: + if(.not.allocated(br_p) ) allocate(br_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) ) + + case("bl_mynn") + if(.not.allocated(kbl_plume_p) ) allocate(kbl_plume_p(ims:ime,jms:jme) ) + if(.not.allocated(dx_p) ) allocate(dx_p(ims:ime,jms:jme) ) + if(.not.allocated(ch_p) ) allocate(ch_p(ims:ime,jms:jme) ) + if(.not.allocated(qsfc_p) ) allocate(qsfc_p(ims:ime,jms:jme) ) + if(.not.allocated(rmol_p) ) allocate(rmol_p(ims:ime,jms:jme) ) + if(.not.allocated(tsk_p) ) allocate(tsk_p(ims:ime,jms:jme) ) + if(.not.allocated(maxwidthbl_p)) allocate(maxwidthbl_p(ims:ime,jms:jme) ) + if(.not.allocated(maxmfbl_p) ) allocate(maxmfbl_p(ims:ime,jms:jme) ) + if(.not.allocated(zbl_plume_p) ) allocate(zbl_plume_p(ims:ime,jms:jme) ) + if(.not.allocated(cov_p) ) allocate(cov_p(ims:ime,kms:kme,jms:jme) ) + if(.not.allocated(qke_p) ) allocate(qke_p(ims:ime,kms:kme,jms:jme) ) + if(.not.allocated(qsq_p) ) allocate(qsq_p(ims:ime,kms:kme,jms:jme) ) + if(.not.allocated(tsq_p) ) allocate(tsq_p(ims:ime,kms:kme,jms:jme) ) + if(.not.allocated(qkeadv_p) ) allocate(qkeadv_p(ims:ime,kms:kme,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) ) + if(.not.allocated(sh3d_p) ) allocate(sh3d_p(ims:ime,kms:kme,jms:jme) ) + if(.not.allocated(sm3d_p) ) allocate(sm3d_p(ims:ime,kms:kme,jms:jme) ) + if(.not.allocated(dqke_p) ) allocate(dqke_p(ims:ime,kms:kme,jms:jme) ) + if(.not.allocated(qbuoy_p) ) allocate(qbuoy_p(ims:ime,kms:kme,jms:jme) ) + if(.not.allocated(qdiss_p) ) allocate(qdiss_p(ims:ime,kms:kme,jms:jme) ) + if(.not.allocated(qshear_p) ) allocate(qshear_p(ims:ime,kms:kme,jms:jme) ) + if(.not.allocated(qwt_p) ) allocate(qwt_p(ims:ime,kms:kme,jms:jme) ) + if(.not.allocated(qcbl_p) ) allocate(qcbl_p(ims:ime,kms:kme,jms:jme) ) + if(.not.allocated(qibl_p) ) allocate(qibl_p(ims:ime,kms:kme,jms:jme) ) + if(.not.allocated(cldfrabl_p) ) allocate(cldfrabl_p(ims:ime,kms:kme,jms:jme) ) + if(.not.allocated(edmfa_p) ) allocate(edmfa_p(ims:ime,kms:kme,jms:jme) ) + if(.not.allocated(edmfw_p) ) allocate(edmfw_p(ims:ime,kms:kme,jms:jme) ) + if(.not.allocated(edmfqt_p) ) allocate(edmfqt_p(ims:ime,kms:kme,jms:jme) ) + if(.not.allocated(edmfthl_p) ) allocate(edmfthl_p(ims:ime,kms:kme,jms:jme) ) + if(.not.allocated(edmfent_p) ) allocate(edmfent_p(ims:ime,kms:kme,jms:jme) ) + if(.not.allocated(edmfqc_p) ) allocate(edmfqc_p(ims:ime,kms:kme,jms:jme) ) + if(.not.allocated(subthl_p) ) allocate(subthl_p(ims:ime,kms:kme,jms:jme) ) + if(.not.allocated(subqv_p) ) allocate(subqv_p(ims:ime,kms:kme,jms:jme) ) + if(.not.allocated(detthl_p) ) allocate(detthl_p(ims:ime,kms:kme,jms:jme) ) + if(.not.allocated(detqv_p) ) allocate(detqv_p(ims:ime,kms:kme,jms:jme) ) + + !additional tendencies: + if(.not.allocated(rqsblten_p) ) allocate(rqsblten_p(ims:ime,kms:kme,jms:jme) ) + if(.not.allocated(rncblten_p) ) allocate(rncblten_p(ims:ime,kms:kme,jms:jme) ) + if(.not.allocated(rniblten_p) ) allocate(rniblten_p(ims:ime,kms:kme,jms:jme) ) + if(.not.allocated(rnifablten_p)) allocate(rnifablten_p(ims:ime,kms:kme,jms:jme)) + if(.not.allocated(rnwfablten_p)) allocate(rnwfablten_p(ims:ime,kms:kme,jms:jme)) + + !allocation of additional arrays: + if(.not.allocated(pattern_spp_pbl)) allocate(pattern_spp_pbl(ims:ime,kms:kme,jms:jme)) + + case default + + end select pbl_select + + end subroutine allocate_pbl + +!================================================================================================================= + subroutine deallocate_pbl(configs) +!================================================================================================================= + +!input arguments: + type(mpas_pool_type),intent(in):: configs + +!local pointers: + character(len=StrKIND),pointer:: pbl_scheme + +!----------------------------------------------------------------------------------------------------------------- + + call mpas_pool_get_config(configs,'config_pbl_scheme',pbl_scheme) + + if(allocated(hfx_p) ) deallocate(hfx_p ) + if(allocated(qfx_p) ) deallocate(qfx_p ) + if(allocated(ust_p) ) deallocate(ust_p ) + if(allocated(wspd_p) ) deallocate(wspd_p ) + if(allocated(xland_p)) deallocate(xland_p) + if(allocated(hpbl_p) ) deallocate(hpbl_p ) + if(allocated(kpbl_p) ) deallocate(kpbl_p ) + if(allocated(znt_p) ) deallocate(znt_p ) + if(allocated(uoce_p) ) deallocate(uoce_p ) + if(allocated(voce_p) ) deallocate(voce_p ) + + !tendencies: + if(allocated(rublten_p) ) deallocate(rublten_p ) + if(allocated(rvblten_p) ) deallocate(rvblten_p ) + if(allocated(rthblten_p)) deallocate(rthblten_p) + if(allocated(rqvblten_p)) deallocate(rqvblten_p) + if(allocated(rqcblten_p)) deallocate(rqcblten_p) + if(allocated(rqiblten_p)) deallocate(rqiblten_p) + + if(allocated(rthraten_p)) deallocate(rthraten_p) + + !exchange coefficients: + if(allocated(kzh_p)) deallocate(kzh_p) + if(allocated(kzm_p)) deallocate(kzm_p) + if(allocated(kzq_p)) deallocate(kzq_p) + + pbl_select: select case (trim(pbl_scheme)) + + case("bl_ysu") + !from surface-layer model: + if(allocated(br_p) ) deallocate(br_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 ) + + case("bl_mynn") + if(allocated(kbl_plume_p) ) deallocate(kbl_plume_p ) + if(allocated(dx_p) ) deallocate(dx_p ) + if(allocated(ch_p) ) deallocate(ch_p ) + if(allocated(qsfc_p) ) deallocate(qsfc_p ) + if(allocated(rmol_p) ) deallocate(rmol_p ) + if(allocated(tsk_p) ) deallocate(tsk_p ) + if(allocated(maxwidthbl_p)) deallocate(maxwidthbl_p) + if(allocated(maxmfbl_p) ) deallocate(maxmfbl_p ) + if(allocated(zbl_plume_p) ) deallocate(zbl_plume_p ) + + if(allocated(cov_p) ) deallocate(cov_p ) + if(allocated(qke_p) ) deallocate(qke_p ) + if(allocated(qsq_p) ) deallocate(qsq_p ) + if(allocated(tsq_p) ) deallocate(tsq_p ) + if(allocated(qkeadv_p) ) deallocate(qkeadv_p ) + if(allocated(elpbl_p) ) deallocate(elpbl_p ) + if(allocated(tkepbl_p) ) deallocate(tkepbl_p ) + if(allocated(sh3d_p) ) deallocate(sh3d_p ) + if(allocated(sm3d_p) ) deallocate(sm3d_p ) + if(allocated(dqke_p) ) deallocate(dqke_p ) + if(allocated(qbuoy_p) ) deallocate(qbuoy_p ) + if(allocated(qdiss_p) ) deallocate(qdiss_p ) + if(allocated(qshear_p) ) deallocate(qshear_p ) + if(allocated(qwt_p) ) deallocate(qwt_p ) + if(allocated(qcbl_p) ) deallocate(qcbl_p ) + if(allocated(qibl_p) ) deallocate(qibl_p ) + if(allocated(cldfrabl_p) ) deallocate(cldfrabl_p ) + if(allocated(edmfa_p) ) deallocate(edmfa_p ) + if(allocated(edmfw_p) ) deallocate(edmfw_p ) + if(allocated(edmfqt_p) ) deallocate(edmfqt_p ) + if(allocated(edmfthl_p) ) deallocate(edmfthl_p ) + if(allocated(edmfent_p) ) deallocate(edmfent_p ) + if(allocated(edmfqc_p) ) deallocate(edmfqc_p ) + if(allocated(subthl_p) ) deallocate(subthl_p ) + if(allocated(subqv_p) ) deallocate(subqv_p ) + if(allocated(detthl_p) ) deallocate(detthl_p ) + if(allocated(detqv_p) ) deallocate(detqv_p ) + + !additional tendencies: + if(allocated(rqsblten_p) ) deallocate(rqsblten_p ) + if(allocated(rncblten_p) ) deallocate(rncblten_p ) + if(allocated(rniblten_p) ) deallocate(rniblten_p ) + if(allocated(rnifablten_p)) deallocate(rnifablten_p) + if(allocated(rnwfablten_p)) deallocate(rnwfablten_p) + + !deallocation of additional arrays: + if(allocated(pattern_spp_pbl)) deallocate(pattern_spp_pbl) + + case default + + end select pbl_select + + end subroutine deallocate_pbl + +!================================================================================================================= + subroutine pbl_from_MPAS(configs,mesh,sfc_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):: diag_physics + type(mpas_pool_type),intent(in):: sfc_input + type(mpas_pool_type),intent(in):: tend_physics + + integer,intent(in):: its,ite + +!local variables: + integer:: i,k,j + +!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:: 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 MYNN scheme: + real(kind=RKIND),pointer:: len_disp + real(kind=RKIND),dimension(:),pointer :: meshDensity + real(kind=RKIND),dimension(:),pointer :: ch,qsfc,rmol,skintemp + real(kind=RKIND),dimension(:,:),pointer:: cov,qke,qsq,tsq,sh3d,sm3d,tke_pbl,qke_adv,el_pbl + real(kind=RKIND),dimension(:,:),pointer:: cldfrac_bl,qc_bl,qi_bl + real(kind=RKIND),dimension(:,:),pointer:: edmf_a,edmf_ent,edmf_qc,edmf_qt,edmf_thl,edmf_w + real(kind=RKIND),dimension(:,:),pointer:: sub_thl,sub_qv,det_thl,det_qv + +!----------------------------------------------------------------------------------------------------------------- + + call mpas_pool_get_config(configs,'config_pbl_scheme',pbl_scheme) + + call mpas_pool_get_array(diag_physics,'hfx' ,hfx ) + call mpas_pool_get_array(diag_physics,'hpbl',hpbl) + call mpas_pool_get_array(diag_physics,'qfx' ,qfx ) + call mpas_pool_get_array(diag_physics,'ust' ,ust ) + call mpas_pool_get_array(diag_physics,'wspd',wspd) + call mpas_pool_get_array(diag_physics,'znt' ,znt ) + + call mpas_pool_get_array(tend_physics,'rthratenlw',rthratenlw) + call mpas_pool_get_array(tend_physics,'rthratensw',rthratensw) + + call mpas_pool_get_array(sfc_input,'xland',xland) + + do j = jts,jte + do i = its,ite + !from surface-layer model: + hfx_p(i,j) = hfx(i) + hpbl_p(i,j) = hpbl(i) + qfx_p(i,j) = qfx(i) + ust_p(i,j) = ust(i) + wspd_p(i,j) = wspd(i) + xland_p(i,j) = xland(i) + kpbl_p(i,j) = 1 + znt_p(i,j) = znt(i) + !... ocean currents are set to zero: + uoce_p(i,j) = 0._RKIND + voce_p(i,j) = 0._RKIND + enddo + do k = kts,kte + do i = its,ite + rthraten_p(i,k,j) = rthratenlw(k,i) + rthratensw(k,i) + enddo + enddo + enddo + + pbl_select: select case (trim(pbl_scheme)) + + case("bl_ysu") + call mpas_pool_get_config(configs,'config_ysu_pblmix',config_ysu_pblmix) + + 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) + + ysu_pblmix = 0 + if(config_ysu_pblmix) ysu_pblmix = 1 + + 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 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 + enddo + enddo + enddo + + case("bl_mynn") + call mpas_pool_get_config(configs,'config_len_disp',len_disp) + call mpas_pool_get_array(mesh,'meshDensity',meshDensity) + + call mpas_pool_get_array(sfc_input,'skintemp',skintemp) + call mpas_pool_get_array(diag_physics,'ch' ,ch ) + call mpas_pool_get_array(diag_physics,'qsfc' ,qsfc ) + call mpas_pool_get_array(diag_physics,'rmol' ,rmol ) + call mpas_pool_get_array(diag_physics,'el_pbl' ,el_pbl ) + call mpas_pool_get_array(diag_physics,'cov' ,cov ) + call mpas_pool_get_array(diag_physics,'qke' ,qke ) + call mpas_pool_get_array(diag_physics,'qke_adv' ,qke_adv ) + call mpas_pool_get_array(diag_physics,'qsq' ,qsq ) + call mpas_pool_get_array(diag_physics,'tsq' ,tsq ) + call mpas_pool_get_array(diag_physics,'tke_pbl' ,tke_pbl ) + call mpas_pool_get_array(diag_physics,'sh3d' ,sh3d ) + call mpas_pool_get_array(diag_physics,'sm3d' ,sm3d ) + call mpas_pool_get_array(diag_physics,'cldfrac_bl',cldfrac_bl) + call mpas_pool_get_array(diag_physics,'qc_bl' ,qc_bl ) + call mpas_pool_get_array(diag_physics,'qi_bl' ,qi_bl ) + call mpas_pool_get_array(diag_physics,'edmf_a' ,edmf_a ) + call mpas_pool_get_array(diag_physics,'edmf_ent' ,edmf_ent ) + call mpas_pool_get_array(diag_physics,'edmf_qc' ,edmf_qc ) + call mpas_pool_get_array(diag_physics,'edmf_qt' ,edmf_qt ) + call mpas_pool_get_array(diag_physics,'edmf_thl' ,edmf_thl ) + call mpas_pool_get_array(diag_physics,'edmf_w' ,edmf_w ) + call mpas_pool_get_array(diag_physics,'sub_thl' ,sub_thl ) + call mpas_pool_get_array(diag_physics,'sub_qv' ,sub_qv ) + call mpas_pool_get_array(diag_physics,'det_thl' ,det_thl ) + call mpas_pool_get_array(diag_physics,'det_qv' ,det_qv ) + + do j = jts,jte + do i = its,ite + dx_p(i,j) = len_disp / meshDensity(i)**0.25 + ch_p(i,j) = ch(i) + qsfc_p(i,j) = qsfc(i) + rmol_p(i,j) = rmol(i) + tsk_p(i,j) = skintemp(i) + enddo + enddo + + do j = jts,jte + do k = kts,kte + do i = its,ite + elpbl_p(i,k,j) = el_pbl(k,i) + cov_p(i,k,j) = cov(k,i) + qke_p(i,k,j) = qke(k,i) + qsq_p(i,k,j) = qsq(k,i) + tsq_p(i,k,j) = tsq(k,i) + tkepbl_p(i,k,j) = tke_pbl(k,i) + qkeadv_p(i,k,j) = qke_adv(k,i) + sh3d_p(i,k,j) = sh3d(k,i) + sm3d_p(i,k,j) = sm3d(k,i) + cldfrabl_p(i,k,j) = cldfrac_bl(k,i) + qcbl_p(i,k,j) = qc_bl(k,i) + qibl_p(i,k,j) = qi_bl(k,i) + edmfa_p(i,k,j) = edmf_a(k,i) + edmfent_p(i,k,j) = edmf_ent(k,i) + edmfqc_p(i,k,j) = edmf_qc(k,i) + edmfqt_p(i,k,j) = edmf_qt(k,i) + edmfthl_p(i,k,j) = edmf_thl(k,i) + edmfw_p(i,k,j) = edmf_w(k,i) + subthl_p(i,k,j) = sub_thl(k,i) + subqv_p(i,k,j) = sub_qv(k,i) + detthl_p(i,k,j) = det_thl(k,i) + detqv_p(i,k,j) = det_qv(k,i) + dqke_p(i,k,j) = 0._RKIND + qbuoy_p(i,k,j) = 0._RKIND + qdiss_p(i,k,j) = 0._RKIND + qshear_p(i,k,j) = 0._RKIND + qwt_p(i,k,j) = 0._RKIND + + rqsblten_p(i,k,j) = 0._RKIND + rncblten_p(i,k,j) = 0._RKIND + rniblten_p(i,k,j) = 0._RKIND + rnifablten_p(i,k,j) = 0._RKIND + rnwfablten_p(i,k,j) = 0._RKIND + + pattern_spp_pbl(i,k,j) = 0._RKIND + enddo + enddo + do i = its,ite + kbl_plume_p(i,j) = 0 + maxwidthbl_p(i,j) = 0._RKIND + maxmfbl_p(i,j) = 0._RKIND + zbl_plume_p(i,j) = 0 + enddo + enddo + + case default + + end select pbl_select + + do j = jts,jte + do k = kts,kte + do i = its,ite + rublten_p(i,k,j) = 0._RKIND + rvblten_p(i,k,j) = 0._RKIND + rthblten_p(i,k,j) = 0._RKIND + rqvblten_p(i,k,j) = 0._RKIND + rqcblten_p(i,k,j) = 0._RKIND + rqiblten_p(i,k,j) = 0._RKIND + + kzh_p(i,k,j) = 0._RKIND + kzm_p(i,k,j) = 0._RKIND + kzq_p(i,k,j) = 0._RKIND + enddo + enddo + enddo + + end subroutine pbl_from_MPAS + +!================================================================================================================= + subroutine pbl_to_MPAS(configs,diag_physics,tend_physics,its,ite) +!================================================================================================================= + +!input arguments: + 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 + + integer,intent(in):: its,ite + +!local variables: + integer:: i,k,j + +!local pointers: + character(len=StrKIND),pointer:: pbl_scheme + + integer,dimension(:),pointer:: kpbl + + real(kind=RKIND),dimension(:),pointer :: hpbl + real(kind=RKIND),dimension(:,:),pointer:: kzh,kzm,kzq + real(kind=RKIND),dimension(:,:),pointer:: rublten,rvblten,rthblten,rqvblten,rqcblten,rqiblten,rqsblten + real(kind=RKIND),dimension(:,:),pointer:: rncblten,rniblten,rnifablten,rnwfablten + +!local pointers for YSU scheme: + real(kind=RKIND),dimension(:,:),pointer:: exch_h + +!local pointers for MYNN scheme: + real(kind=RKIND),dimension(:),pointer :: delta,wstar + real(kind=RKIND),dimension(:,:),pointer:: cov,qke,qsq,tsq,sh3d,sm3d,tke_pbl,qke_adv,el_pbl,dqke,qbuoy, & + qdiss,qshear,qwt + real(kind=RKIND),dimension(:,:),pointer:: cldfrac_bl,qc_bl,qi_bl + real(kind=RKIND),dimension(:,:),pointer:: edmf_a,edmf_ent,edmf_qc,edmf_qt,edmf_thl,edmf_w + real(kind=RKIND),dimension(:,:),pointer:: sub_thl,sub_qv,det_thl,det_qv + +!----------------------------------------------------------------------------------------------------------------- + + call mpas_pool_get_config(configs,'config_pbl_scheme',pbl_scheme) + + call mpas_pool_get_array(diag_physics,'kpbl' ,kpbl ) + call mpas_pool_get_array(diag_physics,'hpbl' ,hpbl ) + call mpas_pool_get_array(diag_physics,'kzh' ,kzh ) + call mpas_pool_get_array(diag_physics,'kzm' ,kzm ) + call mpas_pool_get_array(diag_physics,'kzq' ,kzq ) + + 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) + call mpas_pool_get_array(tend_physics,'rqvblten',rqvblten) + call mpas_pool_get_array(tend_physics,'rqcblten',rqcblten) + call mpas_pool_get_array(tend_physics,'rqiblten',rqiblten) + + do j = jts,jte + do i = its,ite + hpbl(i) = hpbl_p(i,j) + kpbl(i) = kpbl_p(i,j) + enddo + enddo + + do j = jts,jte + do k = kts,kte + do i = its,ite + rublten(k,i) = rublten_p(i,k,j) + rvblten(k,i) = rvblten_p(i,k,j) + rthblten(k,i) = rthblten_p(i,k,j) + rqvblten(k,i) = rqvblten_p(i,k,j) + rqcblten(k,i) = rqcblten_p(i,k,j) + rqiblten(k,i) = rqiblten_p(i,k,j) + + kzh(k,i) = kzh_p(i,k,j) + kzm(k,i) = kzm_p(i,k,j) + kzq(k,i) = kzh_p(i,k,j) + enddo + enddo + enddo + + pbl_select: select case (trim(pbl_scheme)) + + case("bl_ysu") + 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) + + 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) + enddo + enddo + enddo + + case("bl_mynn") + call mpas_pool_get_array(diag_physics,'el_pbl' ,el_pbl ) + call mpas_pool_get_array(diag_physics,'cov' ,cov ) + call mpas_pool_get_array(diag_physics,'qke' ,qke ) + call mpas_pool_get_array(diag_physics,'qke_adv' ,qke_adv ) + call mpas_pool_get_array(diag_physics,'qsq' ,qsq ) + call mpas_pool_get_array(diag_physics,'tsq' ,tsq ) + call mpas_pool_get_array(diag_physics,'tke_pbl' ,tke_pbl ) + call mpas_pool_get_array(diag_physics,'sh3d' ,sh3d ) + call mpas_pool_get_array(diag_physics,'sm3d' ,sm3d ) + call mpas_pool_get_array(diag_physics,'dqke' ,dqke ) + call mpas_pool_get_array(diag_physics,'qbuoy' ,qbuoy ) + call mpas_pool_get_array(diag_physics,'qdiss' ,qdiss ) + call mpas_pool_get_array(diag_physics,'qshear' ,qshear ) + call mpas_pool_get_array(diag_physics,'qwt' ,qwt ) + call mpas_pool_get_array(diag_physics,'cldfrac_bl',cldfrac_bl) + call mpas_pool_get_array(diag_physics,'qc_bl' ,qc_bl ) + call mpas_pool_get_array(diag_physics,'qi_bl' ,qi_bl ) + call mpas_pool_get_array(diag_physics,'edmf_a' ,edmf_a ) + call mpas_pool_get_array(diag_physics,'edmf_ent' ,edmf_ent ) + call mpas_pool_get_array(diag_physics,'edmf_qc' ,edmf_qc ) + call mpas_pool_get_array(diag_physics,'edmf_qt' ,edmf_qt ) + call mpas_pool_get_array(diag_physics,'edmf_thl' ,edmf_thl ) + call mpas_pool_get_array(diag_physics,'edmf_w' ,edmf_w ) + call mpas_pool_get_array(diag_physics,'sub_thl' ,sub_thl ) + call mpas_pool_get_array(diag_physics,'sub_qv' ,sub_qv ) + call mpas_pool_get_array(diag_physics,'det_thl' ,det_thl ) + call mpas_pool_get_array(diag_physics,'det_qv' ,det_qv ) + + call mpas_pool_get_array(tend_physics,'rqsblten' ,rqsblten ) + + do j = jts,jte + do k = kts,kte + do i = its,ite + el_pbl(k,i) = elpbl_p(i,k,j) + cov(k,i) = cov_p(i,k,j) + qke(k,i) = qke_p(i,k,j) + qsq(k,i) = qsq_p(i,k,j) + tsq(k,i) = tsq_p(i,k,j) + sh3d(k,i) = sh3d_p(i,k,j) + sm3d(k,i) = sm3d_p(i,k,j) + tke_pbl(k,i) = tkepbl_p(i,k,j) + qke_adv(k,i) = qkeadv_p(i,k,j) + cldfrac_bl(k,i) = cldfrabl_p(i,k,j) + qc_bl(k,i) = qcbl_p(i,k,j) + qi_bl(k,i) = qibl_p(i,k,j) + edmf_a(k,i) = edmfa_p(i,k,j) + edmf_ent(k,i) = edmfent_p(i,k,j) + edmf_qc(k,i) = edmfqc_p(i,k,j) + edmf_qt(k,i) = edmfqt_p(i,k,j) + edmf_thl(k,i) = edmfthl_p(i,k,j) + edmf_w(k,i) = edmfw_p(i,k,j) + sub_thl(k,i) = subthl_p(i,k,j) + sub_qv(k,i) = subqv_p(i,k,j) + det_thl(k,i) = detthl_p(i,k,j) + det_qv(k,i) = detqv_p(i,k,j) + dqke(k,i) = dqke_p(i,k,j) + qbuoy(k,i) = qbuoy_p(i,k,j) + qdiss(k,i) = qdiss_p(i,k,j) + qshear(k,i) = qshear_p(i,k,j) + qwt(k,i) = qwt_p(i,k,j) + + rqsblten(k,i) = rqsblten_p(i,k,j) + enddo + enddo + enddo + + if(f_ni) then + call mpas_pool_get_array(tend_physics,'rniblten',rniblten) + do j = jts,jte + do k = kts,kte + do i = its,ite + rniblten(k,i) = rniblten_p(i,k,j) + enddo + enddo + enddo + endif + if(f_nc .and. f_nifa .and. f_nwfa) then + call mpas_pool_get_array(tend_physics,'rncblten' ,rncblten ) + call mpas_pool_get_array(tend_physics,'rnifablten',rnifablten) + call mpas_pool_get_array(tend_physics,'rnwfablten',rnwfablten) + do j = jts,jte + do k = kts,kte + do i = its,ite + rncblten(k,i) = rncblten_p(i,k,j) + rnifablten(k,i) = rnifablten_p(i,k,j) + rnwfablten(k,i) = rnwfablten_p(i,k,j) + enddo + enddo + enddo + endif + + case default + + end select pbl_select + + end subroutine pbl_to_MPAS + +!================================================================================================================= + subroutine init_pbl(configs) +!================================================================================================================= + +!input arguments: + type(mpas_pool_type),intent(in):: configs + +!local variables and pointers: + character(len=StrKIND),pointer:: pbl_scheme + character(len=StrKIND):: errmsg + integer:: errflg + +!----------------------------------------------------------------------------------------------------------------- + + call mpas_pool_get_config(configs,'config_pbl_scheme',pbl_scheme) + + pbl_select: select case (trim(pbl_scheme)) + + case("bl_mynn") +! call mpas_log_write('--- enter subroutine bl_mynn_init:') + call bl_mynn_init(cp,cpv,cice,cliq,ep_1,ep_2,gravity,karman,P0,R_d,R_v,svp1,svp2,svp3,svpt0, & + xlf,xls,xlv,errmsg,errflg) +! call mpas_log_write('--- end subroutine bl_mynn_init:') + + case default + + end select pbl_select + + end subroutine init_pbl + +!================================================================================================================= + subroutine driver_pbl(itimestep,configs,mesh,sfc_input,diag_physics,tend_physics,its,ite) +!================================================================================================================= + +!input arguments: + type(mpas_pool_type),intent(in):: configs + type(mpas_pool_type),intent(in):: mesh + + integer,intent(in):: its,ite + integer,intent(in):: itimestep + +!inout arguments: + type(mpas_pool_type),intent(inout):: sfc_input + type(mpas_pool_type),intent(inout):: diag_physics + type(mpas_pool_type),intent(inout):: tend_physics + +!local pointers: + logical,pointer:: config_do_DAcycling, & + config_do_restart, & + bl_mynn_tkeadvect + + character(len=StrKIND),pointer:: pbl_scheme + + integer,pointer:: bl_mynn_cloudpdf, & + bl_mynn_mixlength, & + bl_mynn_stfunc, & + bl_mynn_topdown, & + bl_mynn_scaleaware, & + bl_mynn_dheat_opt, & + bl_mynn_edmf, & + bl_mynn_edmf_dd, & + bl_mynn_edmf_mom, & + bl_mynn_edmf_tke, & + bl_mynn_edmf_output, & + bl_mynn_mixscalars, & + bl_mynn_cloudmix, & + bl_mynn_mixqt, & + bl_mynn_tkebudget + + real(kind=RKIND),pointer:: bl_mynn_closure + +!local variables: + integer:: initflag + integer:: i,k,j + +!CCPP-compliant flags: + character(len=StrKIND):: errmsg + integer:: errflg + +!----------------------------------------------------------------------------------------------------------------- +!call mpas_log_write('') +!call mpas_log_write('--- enter subroutine driver_pbl:') + +!initialization of CCPP-compliant flags: + errmsg = ' ' + errflg = 0 + + call mpas_pool_get_config(configs,'config_do_DAcycling',config_do_DAcycling) + call mpas_pool_get_config(configs,'config_do_restart' ,config_do_restart ) + call mpas_pool_get_config(configs,'config_pbl_scheme' ,pbl_scheme ) + +!copy MPAS arrays to local arrays: + call pbl_from_MPAS(configs,mesh,sfc_input,diag_physics,tend_physics,its,ite) + + initflag = 1 + if(config_do_restart .or. itimestep > 1) initflag = 0 + + pbl_select: select case (trim(pbl_scheme)) + + case("bl_ysu") + call mpas_timer_start('bl_ysu') + call ysu ( & + 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 , & + 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 , & + ysu_topdown_pblmix = ysu_pblmix , & + 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_ysu') + + case("bl_mynn") + call mpas_pool_get_config(configs,'config_mynn_cloudpdf' ,bl_mynn_cloudpdf ) + call mpas_pool_get_config(configs,'config_mynn_mixlength' ,bl_mynn_mixlength ) + call mpas_pool_get_config(configs,'config_mynn_stfunc' ,bl_mynn_stfunc ) + call mpas_pool_get_config(configs,'config_mynn_topdown' ,bl_mynn_topdown ) + call mpas_pool_get_config(configs,'config_mynn_scaleaware' ,bl_mynn_scaleaware ) + call mpas_pool_get_config(configs,'config_mynn_dheat_opt' ,bl_mynn_dheat_opt ) + call mpas_pool_get_config(configs,'config_mynn_edmf' ,bl_mynn_edmf ) + call mpas_pool_get_config(configs,'config_mynn_edmf_dd' ,bl_mynn_edmf_dd ) + call mpas_pool_get_config(configs,'config_mynn_edmf_mom' ,bl_mynn_edmf_mom ) + call mpas_pool_get_config(configs,'config_mynn_edmf_tke' ,bl_mynn_edmf_tke ) + call mpas_pool_get_config(configs,'config_mynn_edmf_output',bl_mynn_edmf_output) + call mpas_pool_get_config(configs,'config_mynn_closure' ,bl_mynn_closure ) + call mpas_pool_get_config(configs,'config_mynn_mixscalars' ,bl_mynn_mixscalars ) + call mpas_pool_get_config(configs,'config_mynn_mixclouds' ,bl_mynn_cloudmix ) + call mpas_pool_get_config(configs,'config_mynn_mixqt' ,bl_mynn_mixqt ) + call mpas_pool_get_config(configs,'config_mynn_tkeadvect' ,bl_mynn_tkeadvect ) + call mpas_pool_get_config(configs,'config_mynn_tkebudget' ,bl_mynn_tkebudget ) + +! call mpas_log_write(' ') +! call mpas_log_write('--- enter subroutine mynn_bl_driver:') +! call mpas_log_write('--- config_mynn_cloudpdf = $i',intArgs=(/bl_mynn_cloudpdf/)) +! call mpas_log_write('--- config_mynn_mixlength = $i',intArgs=(/bl_mynn_mixlength/)) +! call mpas_log_write('--- config_mynn_stfunc = $i',intArgs=(/bl_mynn_stfunc/)) +! call mpas_log_write('--- config_mynn_topdown = $i',intArgs=(/bl_mynn_topdown/)) +! call mpas_log_write('--- config_mynn_scaleaware = $i',intArgs=(/bl_mynn_scaleaware/)) +! call mpas_log_write('--- config_mynn_dheat_opt = $i',intArgs=(/bl_mynn_dheat_opt/)) +! call mpas_log_write('--- config_mynn_edmf = $i',intArgs=(/bl_mynn_edmf/)) +! call mpas_log_write('--- config_mynn_edmf_dd = $i',intArgs=(/bl_mynn_edmf_dd/)) +! call mpas_log_write('--- config_mynn_edmf_mom = $i',intArgs=(/bl_mynn_edmf_mom/)) +! call mpas_log_write('--- config_mynn_edmf_tke = $i',intArgs=(/bl_mynn_edmf_tke/)) +! call mpas_log_write('--- config_mynn_edmf_output = $i',intArgs=(/bl_mynn_edmf_output/)) +! call mpas_log_write('--- config_mynn_mixscalars = $i',intArgs=(/bl_mynn_mixscalars/)) +! call mpas_log_write('--- config_mynn_mixclouds = $i',intArgs=(/bl_mynn_cloudmix/)) +! call mpas_log_write('--- config_mynn_mixqt = $i',intArgs=(/bl_mynn_mixqt/)) +! call mpas_log_write('--- config_mynn_tkeadvect = $l',logicArgs=(/bl_mynn_tkeadvect/)) +! call mpas_log_write('--- config_mynn_tkebudget = $i',intArgs=(/bl_mynn_tkebudget/)) +! call mpas_log_write('--- config_mynn_closure = $r',realArgs=(/bl_mynn_closure/)) +! call mpas_log_write(' ') +! call mpas_log_write('--- f_qc = $l',logicArgs=(/f_qc/) ) +! call mpas_log_write('--- f_qi = $l',logicArgs=(/f_qi/) ) +! call mpas_log_write('--- f_qs = $l',logicArgs=(/f_qs/) ) +! call mpas_log_write('--- f_qoz = $l',logicArgs=(/f_qoz/) ) +! call mpas_log_write('--- f_nc = $l',logicArgs=(/f_nc/) ) +! call mpas_log_write('--- f_ni = $l',logicArgs=(/f_ni/) ) +! call mpas_log_write('--- f_nifa = $l',logicArgs=(/f_nifa/)) +! call mpas_log_write('--- f_nwfa = $l',logicArgs=(/f_nwfa/)) +! call mpas_log_write('--- f_nbca = $l',logicArgs=(/f_nbca/)) + + call mpas_timer_start('bl_mynn') + call mynn_bl_driver( & + f_qc = f_qc , f_qi = f_qi , f_qs = f_qs , & + f_qoz = f_qoz , f_nc = f_nc , f_ni = f_ni , & + f_nifa = f_nifa , f_nwfa = f_nwfa , f_nbca = f_nbca , & + icloud_bl = icloud_bl , delt = dt_pbl , dx = dx_p , & + xland = xland_p , ps = psfc_p , ts = tsk_p , & + qsfc = qsfc_p , ust = ust_p , ch = ch_p , & + hfx = hfx_p , qfx = qfx_p , rmol = rmol_p , & + wspd = wspd_p , znt = znt_p , uoce = uoce_p , & + voce = voce_p , dz = dz_p , u = u_p , & + v = v_p , w = w_p , th = th_p , & + tt = t_p , p = pres_hyd_p , exner = pi_p , & + rho = rho_p , qv = qv_p , qc = qc_p , & + qi = qi_p , qs = qs_p , nc = nc_p , & + ni = ni_p , nifa = nifa_p , nwfa = nwfa_p , & + rthraten = rthraten_p , pblh = hpbl_p , kpbl = kpbl_p , & + cldfra_bl = cldfrabl_p , qc_bl = qcbl_p , qi_bl = qibl_p , & + maxwidth = maxwidthbl_p , maxmf = maxmfbl_p , ktop_plume = kbl_plume_p , & + ztop_plume = zbl_plume_p , dqke = dqke_p , qke_adv = qkeadv_p , & + tsq = tsq_p , qsq = qsq_p , cov = cov_p , & + el_pbl = elpbl_p , rublten = rublten_p , rvblten = rvblten_p , & + rthblten = rthblten_p , rqvblten = rqvblten_p , rqcblten = rqcblten_p , & + rqiblten = rqiblten_p , rqsblten = rqsblten_p , rncblten = rncblten_p , & + rniblten = rniblten_p , rnifablten = rnifablten_p , rnwfablten = rnwfablten_p , & + edmf_a = edmfa_p , edmf_w = edmfw_p , edmf_qt = edmfqt_p , & + edmf_thl = edmfthl_p , edmf_ent = edmfent_p , edmf_qc = edmfqc_p , & + sub_thl = subthl_p , sub_sqv = subqv_p , det_thl = detthl_p , & + det_sqv = detqv_p , exch_h = kzh_p , exch_m = kzm_p , & + qke = qke_p , qwt = qwt_p , qshear = qshear_p , & + qbuoy = qbuoy_p , qdiss = qdiss_p , sh3d = sh3d_p , & + sm3d = sm3d_p , spp_pbl = spp_pbl , pattern_spp = pattern_spp_pbl , & + do_restart = config_do_restart , & + do_DAcycling = config_do_DAcycling , & + initflag = initflag , & + bl_mynn_tkeadvect = bl_mynn_tkeadvect , & + bl_mynn_tkebudget = bl_mynn_tkebudget , & + bl_mynn_cloudpdf = bl_mynn_cloudpdf , & + bl_mynn_mixlength = bl_mynn_mixlength , & + bl_mynn_closure = bl_mynn_closure , & + bl_mynn_stfunc = bl_mynn_stfunc , & + bl_mynn_topdown = bl_mynn_topdown , & + bl_mynn_scaleaware = bl_mynn_scaleaware , & + bl_mynn_dheat_opt = bl_mynn_dheat_opt , & + bl_mynn_edmf = bl_mynn_edmf , & + bl_mynn_edmf_dd = bl_mynn_edmf_dd , & + bl_mynn_edmf_mom = bl_mynn_edmf_mom , & + bl_mynn_edmf_tke = bl_mynn_edmf_tke , & + bl_mynn_output = bl_mynn_edmf_output , & + bl_mynn_mixscalars = bl_mynn_mixscalars , & + bl_mynn_cloudmix = bl_mynn_cloudmix , & + bl_mynn_mixqt = bl_mynn_mixqt , & + ids = ids , ide = ide , jds = jds , jde = jde , kds = kds , kde = kde , & + ims = ims , ime = ime , jms = jms , jme = jme , kms = kms , kme = kme , & + its = its , ite = ite , jts = jts , jte = jte , kts = kts , kte = kte , & + errmsg = errmsg , errflg = errflg & + ) + call mpas_timer_stop('bl_mynn') +! call mpas_log_write('--- exit subroutine mynn_bl_driver:') +! call mpas_log_write(' ') + + case default + + end select pbl_select + +!copy local arrays to MPAS grid: + call pbl_to_MPAS(configs,diag_physics,tend_physics,its,ite) + +!call mpas_log_write('--- end subroutine driver_pbl.') + + end subroutine driver_pbl + +!================================================================================================================= + end module mpas_atmphys_driver_pbl +!================================================================================================================= diff --git a/src/core_atmosphere/physics/mpas_atmphys_driver_sfclayer.F-org b/src/core_atmosphere/physics/mpas_atmphys_driver_sfclayer.F-org new file mode 100644 index 0000000000..afde4fa523 --- /dev/null +++ b/src/core_atmosphere/physics/mpas_atmphys_driver_sfclayer.F-org @@ -0,0 +1,1092 @@ +! Copyright (c) 2013, Los Alamos National Security, LLC (LANS) +! and the University Corporation for Atmospheric Research (UCAR). +! +! Unless noted otherwise source code is licensed under the BSD license. +! Additional copyright and license information can be found in the LICENSE file +! distributed with this code, or at http://mpas-dev.github.com/license.html +! +!================================================================================================================= + module mpas_atmphys_driver_sfclayer + 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 module_sf_mynn,only: sfclay_mynn + use module_sf_sfclay + use module_sf_sfclayrev,only: sfclayrev + use sf_mynn,only: sf_mynn_init + use sf_sfclayrev,only: sf_sfclayrev_init + + implicit none + private + public:: init_sfclayer, & + allocate_sfclayer, & + deallocate_sfclayer, & + driver_sfclayer + + integer,parameter,private:: isfflx = 1 !=1 for surface heat and moisture fluxes. + integer,parameter,private:: isftcflx = 0 !=0,(Charnock and Carlson-Boland). + integer,parameter,private:: iz0tlnd = 0 !=0,(Carlson-Boland). + integer,parameter,private:: scm_force_flux = 0 !SCM surface forcing by surface fluxes. + !0=no 1=yes (WRF single column model option only). + +!MPAS driver for parameterization of the surface layer. +!Laura D. Fowler (send comments to laura@ucar.edu). +!2013-05-01. +! +! subroutines in mpas_atmphys_driver_sfclayer: +! -------------------------------------------- +! allocate_sfclayer : allocate local arrays for parameterization of surface layer. +! deallocate_sfclayer : deallocate local arrays for parameterization of surface layer. +! init_sfclayer : initialization of individual surface layer schemes. +! driver_sfclayer : main driver (called from subroutine physics_driver). +! sfclayer_from_MPAS : initialize local arrays. +! sfclayer_to_MPAS : copy local arrays to MPAS arrays. +! +! WRF physics called from driver_sfclayer: +! ---------------------------------------- +! * module_sf_sfclay: Monin-Obukhov surface layer scheme. +! +! add-ons and modifications to sourcecode: +! ---------------------------------------- +! * removed the pre-processor option "do_hydrostatic_pressure" before call to the subroutine sfclay. +! Laura D. Fowler (laura@ucar.edu) / 2013-05-29. +! * updated the definition of the horizontal resolution to the actual mean distance between cell centers. +! Laura D. Fowler (laura@ucar.edu) / 2013-08-23. +! * in call to subroutine sfclay, replaced the variable g (that originally pointed to gravity) +! with gravity, for simplicity. +! Laura D. Fowler (laura@ucar.edu) / 2014-03-21. +! * in subroutine sfclayer_from_MPAS, added initialization of ustm, cd, cda, ck, and cka. in +! subroutine sfclayer_to_MPAS, filled diag_physics%ustm with ustm_p after call to subroutine sfclay. +! Laura D. Fowler (laura@ucar.edu) / 2014-04-16. +! * throughout the sourcecode, replaced all "var_struct" defined arrays by local pointers. +! Laura D. Fowler (laura@ucar.edu) / 2014-04-22. +! * modified sourcecode to use pools. +! Laura D. Fowler (laura@ucar.edu) / 2014-05-15. +! * added initialization of local logical "allowed_to read" in subroutine init_sfclayer. This logical +! is actually not used in subroutine sfclayinit. +! Laura D. Fowler (laura@ucar.edu) / 2014-09-25. +! * renamed "monin_obukhov" with "sf_monin_obukhov". +! Laura D. Fowler (laura@ucar.edu) / 2016-03-25. +! * added the implementation of the MYNN surface layer scheme from WRF 3.6.1. +! Laura D. Fowler (laura@ucar.edu) / 2016-03-30. +! * added the calculation of surface layer variables over seaice cells when config_frac_seaice is set to true. +! Laura D. Fowler (laura@ucar.edu) / 2016-10-03. +! * changed the definition of dx_p to match that used in other physics parameterizations. +! parameterizations. +! Laura D. Fowler (laura@ucar.edu) / 2016-10-18. +! * since we removed the local variable sfclayer_scheme from mpas_atmphys_vars.F, now defines sfclayer_scheme +! as a pointer to config_sfclayer_scheme. +! Laura D. Fowler (laura@ucar.edu) / 2017-02-16. +! * in subroutine driver_sfclayer, replaced the call to sfclay with a call to sfclayrev to use the revised +! version of the MONIN-OBUKHOV surface layer scheme. +! Laura D. Fowler (laura@ucar.edu) / 2023-05-15. +! * added the option sf_monin_obukhov_rev to run the revised surface layer scheme with the YSU PBL scheme. +! Laura D. Fowler (laura@ucar.edu) / 2023-05-15. +! * updated the MYNN surface layer scheme to the sourcecode available from WRF version 4.6. +! Laura D. Fowler (laura@ucar.edu) / 2024-02-14. + + + contains + + +!================================================================================================================= + subroutine allocate_sfclayer(configs) +!================================================================================================================= + +!input arguments: + type(mpas_pool_type),intent(in):: configs + +!local pointers: + logical,pointer:: config_frac_seaice + character(len=StrKIND),pointer:: sfclayer_scheme + +!----------------------------------------------------------------------------------------------------------------- + + call mpas_pool_get_config(configs,'config_frac_seaice' ,config_frac_seaice) + call mpas_pool_get_config(configs,'config_sfclayer_scheme',sfclayer_scheme ) + + if(.not.allocated(dx_p) ) allocate(dx_p(ims:ime,jms:jme) ) + if(.not.allocated(br_p) ) allocate(br_p(ims:ime,jms:jme) ) + if(.not.allocated(cd_p) ) allocate(cd_p(ims:ime,jms:jme) ) + if(.not.allocated(cda_p) ) allocate(cda_p(ims:ime,jms:jme) ) + if(.not.allocated(chs_p) ) allocate(chs_p(ims:ime,jms:jme) ) + if(.not.allocated(chs2_p) ) allocate(chs2_p(ims:ime,jms:jme) ) + if(.not.allocated(ck_p) ) allocate(ck_p(ims:ime,jms:jme) ) + if(.not.allocated(cka_p) ) allocate(cka_p(ims:ime,jms:jme) ) + if(.not.allocated(cpm_p) ) allocate(cpm_p(ims:ime,jms:jme) ) + if(.not.allocated(cqs2_p) ) allocate(cqs2_p(ims:ime,jms:jme) ) + if(.not.allocated(gz1oz0_p)) allocate(gz1oz0_p(ims:ime,jms:jme)) + if(.not.allocated(flhc_p) ) allocate(flhc_p(ims:ime,jms:jme) ) + if(.not.allocated(flqc_p) ) allocate(flqc_p(ims:ime,jms:jme) ) + if(.not.allocated(hfx_p) ) allocate(hfx_p(ims:ime,jms:jme) ) + if(.not.allocated(hpbl_p) ) allocate(hpbl_p(ims:ime,jms:jme) ) + if(.not.allocated(lh_p) ) allocate(lh_p(ims:ime,jms:jme) ) + if(.not.allocated(mavail_p)) allocate(mavail_p(ims:ime,jms:jme)) + if(.not.allocated(mol_p) ) allocate(mol_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(q2_p) ) allocate(q2_p(ims:ime,jms:jme) ) + if(.not.allocated(qfx_p) ) allocate(qfx_p(ims:ime,jms:jme) ) + if(.not.allocated(qgh_p) ) allocate(qgh_p(ims:ime,jms:jme) ) + if(.not.allocated(qsfc_p) ) allocate(qsfc_p(ims:ime,jms:jme) ) + if(.not.allocated(regime_p)) allocate(regime_p(ims:ime,jms:jme)) + if(.not.allocated(rmol_p) ) allocate(rmol_p(ims:ime,jms:jme) ) + if(.not.allocated(t2m_p) ) allocate(t2m_p(ims:ime,jms:jme) ) + if(.not.allocated(tsk_p) ) allocate(tsk_p(ims:ime,jms:jme) ) + if(.not.allocated(th2m_p) ) allocate(th2m_p(ims:ime,jms:jme) ) + if(.not.allocated(u10_p) ) allocate(u10_p(ims:ime,jms:jme) ) + if(.not.allocated(ust_p) ) allocate(ust_p(ims:ime,jms:jme) ) + if(.not.allocated(ustm_p) ) allocate(ustm_p(ims:ime,jms:jme) ) + if(.not.allocated(v10_p) ) allocate(v10_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(zol_p) ) allocate(zol_p(ims:ime,jms:jme) ) + if(.not.allocated(znt_p) ) allocate(znt_p(ims:ime,jms:jme) ) + + if(config_frac_seaice) then + if(.not.allocated(sst_p) ) allocate(sst_p(ims:ime,jms:jme) ) + if(.not.allocated(xice_p) ) allocate(xice_p(ims:ime,jms:jme) ) + + if(.not.allocated(br_sea) ) allocate(br_sea(ims:ime,jms:jme) ) + if(.not.allocated(chs_sea) ) allocate(chs_sea(ims:ime,jms:jme) ) + if(.not.allocated(chs2_sea) ) allocate(chs2_sea(ims:ime,jms:jme) ) + if(.not.allocated(cqs2_sea) ) allocate(cqs2_sea(ims:ime,jms:jme) ) + if(.not.allocated(cpm_sea) ) allocate(cpm_sea(ims:ime,jms:jme) ) + if(.not.allocated(flhc_sea) ) allocate(flhc_sea(ims:ime,jms:jme) ) + if(.not.allocated(flqc_sea) ) allocate(flqc_sea(ims:ime,jms:jme) ) + if(.not.allocated(gz1oz0_sea) ) allocate(gz1oz0_sea(ims:ime,jms:jme) ) + if(.not.allocated(hfx_sea) ) allocate(hfx_sea(ims:ime,jms:jme) ) + if(.not.allocated(qfx_sea) ) allocate(qfx_sea(ims:ime,jms:jme) ) + if(.not.allocated(mavail_sea) ) allocate(mavail_sea(ims:ime,jms:jme) ) + if(.not.allocated(mol_sea) ) allocate(mol_sea(ims:ime,jms:jme) ) + if(.not.allocated(lh_sea) ) allocate(lh_sea(ims:ime,jms:jme) ) + if(.not.allocated(psih_sea) ) allocate(psih_sea(ims:ime,jms:jme) ) + if(.not.allocated(psim_sea) ) allocate(psim_sea(ims:ime,jms:jme) ) + if(.not.allocated(qgh_sea) ) allocate(qgh_sea(ims:ime,jms:jme) ) + if(.not.allocated(qsfc_sea) ) allocate(qsfc_sea(ims:ime,jms:jme) ) + if(.not.allocated(regime_sea) ) allocate(regime_sea(ims:ime,jms:jme) ) + if(.not.allocated(rmol_sea) ) allocate(rmol_sea(ims:ime,jms:jme) ) + if(.not.allocated(tsk_sea) ) allocate(tsk_sea(ims:ime,jms:jme) ) + if(.not.allocated(ust_sea) ) allocate(ust_sea(ims:ime,jms:jme) ) + if(.not.allocated(ustm_sea) ) allocate(ustm_sea(ims:ime,jms:jme) ) + if(.not.allocated(wspd_sea) ) allocate(wspd_sea(ims:ime,jms:jme) ) + if(.not.allocated(xland_sea) ) allocate(xland_sea(ims:ime,jms:jme) ) + if(.not.allocated(zol_sea) ) allocate(zol_sea(ims:ime,jms:jme) ) + if(.not.allocated(znt_sea) ) allocate(znt_sea(ims:ime,jms:jme) ) + + if(.not.allocated(cd_sea) ) allocate(cd_sea(ims:ime,jms:jme) ) + if(.not.allocated(cda_sea) ) allocate(cda_sea(ims:ime,jms:jme) ) + if(.not.allocated(ck_sea) ) allocate(ck_sea(ims:ime,jms:jme) ) + if(.not.allocated(cka_sea) ) allocate(cka_sea(ims:ime,jms:jme) ) + if(.not.allocated(t2m_sea) ) allocate(t2m_sea(ims:ime,jms:jme) ) + if(.not.allocated(th2m_sea) ) allocate(th2m_sea(ims:ime,jms:jme) ) + if(.not.allocated(q2_sea) ) allocate(q2_sea(ims:ime,jms:jme) ) + if(.not.allocated(u10_sea) ) allocate(u10_sea(ims:ime,jms:jme) ) + if(.not.allocated(v10_sea) ) allocate(v10_sea(ims:ime,jms:jme) ) + + if(.not.allocated(regime_hold)) allocate(regime_hold(ims:ime,jms:jme)) + endif + + sfclayer_select: select case (trim(sfclayer_scheme)) + + case("sf_monin_obukhov","sf_monin_obukhov_rev") + if(.not.allocated(fh_p)) allocate(fh_p(ims:ime,jms:jme)) + if(.not.allocated(fm_p)) allocate(fm_p(ims:ime,jms:jme)) + if(config_frac_seaice) then + if(.not.allocated(fh_sea)) allocate(fh_sea(ims:ime,jms:jme)) + if(.not.allocated(fm_sea)) allocate(fm_sea(ims:ime,jms:jme)) + endif + + sfclayer2_select: select case(sfclayer_scheme) + + case("sf_monin_obukhov_rev") + if(.not.allocated(waterdepth_p)) allocate(waterdepth_p(ims:ime,jms:jme)) + if(.not.allocated(lakedepth_p) ) allocate(lakedepth_p(ims:ime,jms:jme) ) + if(.not.allocated(lakemask_p) ) allocate(lakemask_p(ims:ime,jms:jme) ) + + case default + + end select sfclayer2_select + + case("sf_mynn") + if(.not.allocated(snowh_p)) allocate(snowh_p(ims:ime,jms:jme)) + if(.not.allocated(ch_p) ) allocate(ch_p(ims:ime,jms:jme) ) + if(.not.allocated(qcg_p) ) allocate(qcg_p(ims:ime,jms:jme) ) + if(config_frac_seaice) then + if(.not.allocated(ch_sea)) allocate(ch_sea(ims:ime,jms:jme)) + endif + + case default + + end select sfclayer_select + + end subroutine allocate_sfclayer + +!================================================================================================================= + subroutine deallocate_sfclayer(configs) +!================================================================================================================= + +!input arguments: + type(mpas_pool_type),intent(in):: configs + +!local pointers: + logical,pointer:: config_frac_seaice + character(len=StrKIND),pointer:: sfclayer_scheme + +!----------------------------------------------------------------------------------------------------------------- + + call mpas_pool_get_config(configs,'config_frac_seaice' ,config_frac_seaice) + call mpas_pool_get_config(configs,'config_sfclayer_scheme',sfclayer_scheme ) + + if(allocated(dx_p) ) deallocate(dx_p ) + if(allocated(br_p) ) deallocate(br_p ) + if(allocated(cd_p) ) deallocate(cd_p ) + if(allocated(cda_p) ) deallocate(cda_p ) + if(allocated(chs_p) ) deallocate(chs_p ) + if(allocated(chs2_p) ) deallocate(chs2_p ) + if(allocated(ck_p) ) deallocate(ck_p ) + if(allocated(cka_p) ) deallocate(cka_p ) + if(allocated(cpm_p) ) deallocate(cpm_p ) + if(allocated(cqs2_p) ) deallocate(cqs2_p ) + if(allocated(gz1oz0_p)) deallocate(gz1oz0_p) + if(allocated(flhc_p) ) deallocate(flhc_p ) + if(allocated(flqc_p) ) deallocate(flqc_p ) + if(allocated(hfx_p) ) deallocate(hfx_p ) + if(allocated(hpbl_p) ) deallocate(hpbl_p ) + if(allocated(lh_p) ) deallocate(lh_p ) + if(allocated(mavail_p)) deallocate(mavail_p) + if(allocated(mol_p) ) deallocate(mol_p ) + if(allocated(psih_p) ) deallocate(psih_p ) + if(allocated(psim_p) ) deallocate(psim_p ) + if(allocated(q2_p) ) deallocate(q2_p ) + if(allocated(qfx_p) ) deallocate(qfx_p ) + if(allocated(qgh_p) ) deallocate(qgh_p ) + if(allocated(qsfc_p) ) deallocate(qsfc_p ) + if(allocated(regime_p)) deallocate(regime_p) + if(allocated(rmol_p) ) deallocate(rmol_p ) + if(allocated(t2m_p) ) deallocate(t2m_p ) + if(allocated(tsk_p) ) deallocate(tsk_p ) + if(allocated(th2m_p) ) deallocate(th2m_p ) + if(allocated(u10_p) ) deallocate(u10_p ) + if(allocated(ust_p) ) deallocate(ust_p ) + if(allocated(ustm_p) ) deallocate(ustm_p ) + if(allocated(v10_p) ) deallocate(v10_p ) + if(allocated(wspd_p) ) deallocate(wspd_p ) + if(allocated(xland_p) ) deallocate(xland_p ) + if(allocated(zol_p) ) deallocate(zol_p ) + if(allocated(znt_p) ) deallocate(znt_p ) + + if(config_frac_seaice) then + if(allocated(sst_p) ) deallocate(sst_p ) + if(allocated(xice_p) ) deallocate(xice_p ) + + if(allocated(br_sea) ) deallocate(br_sea ) + if(allocated(flhc_p) ) deallocate(flhc_sea ) + if(allocated(flqc_p) ) deallocate(flqc_sea ) + if(allocated(gz1oz0_sea) ) deallocate(gz1oz0_sea ) + if(allocated(mol_sea) ) deallocate(mol_sea ) + if(allocated(psih_sea) ) deallocate(psih_sea ) + if(allocated(psim_sea) ) deallocate(psim_sea ) + if(allocated(rmol_sea) ) deallocate(rmol_sea ) + if(allocated(ust_sea) ) deallocate(ust_sea ) + if(allocated(ustm_sea) ) deallocate(ustm_sea ) + if(allocated(wspd_sea) ) deallocate(wspd_sea ) + if(allocated(zol_sea) ) deallocate(zol_sea ) + if(allocated(cd_sea) ) deallocate(cd_sea ) + if(allocated(cda_sea) ) deallocate(cda_sea ) + if(allocated(ck_sea) ) deallocate(ck_sea ) + if(allocated(cka_sea) ) deallocate(cka_sea ) + if(allocated(t2m_sea) ) deallocate(t2m_sea ) + if(allocated(th2m_sea) ) deallocate(th2m_sea ) + if(allocated(q2_sea) ) deallocate(q2_sea ) + if(allocated(u10_sea) ) deallocate(u10_sea ) + if(allocated(v10_sea) ) deallocate(v10_sea ) + if(allocated(regime_hold)) deallocate(regime_hold) + + if(allocated(mavail_sea) ) deallocate(mavail_sea ) + if(allocated(tsk_sea) ) deallocate(tsk_sea ) + if(allocated(xland_sea) ) deallocate(xland_sea ) + if(allocated(znt_sea) ) deallocate(znt_sea ) + endif + + sfclayer_select: select case (trim(sfclayer_scheme)) + + case("sf_monin_obukhov","sf_monin_obukhov_rev") + if(allocated(fh_p)) deallocate(fh_p) + if(allocated(fm_p)) deallocate(fm_p) + if(config_frac_seaice) then + if(allocated(fh_sea)) deallocate(fh_sea) + if(allocated(fm_sea)) deallocate(fm_sea) + endif + + sfclayer2_select: select case(sfclayer_scheme) + + case("sf_monin_obukhov_rev") + if(allocated(waterdepth_p)) deallocate(waterdepth_p) + if(allocated(lakedepth_p) ) deallocate(lakedepth_p ) + if(allocated(lakemask_p) ) deallocate(lakemask_p ) + + case default + + end select sfclayer2_select + + case("sf_mynn") + if(allocated(snowh_p)) deallocate(snowh_p) + if(allocated(ch_p) ) deallocate(ch_p ) + if(allocated(qcg_p) ) deallocate(qcg_p ) + if(config_frac_seaice) then + if(allocated(ch_sea)) deallocate(ch_sea) + endif + + case default + + end select sfclayer_select + + end subroutine deallocate_sfclayer + +!================================================================================================================= + subroutine sfclayer_from_MPAS(configs,mesh,diag_physics,sfc_input,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 + type(mpas_pool_type),intent(inout):: diag_physics + + integer,intent(in):: its,ite + +!local variables: + integer:: i,j,k + +!local pointers: + logical,pointer:: config_frac_seaice + character(len=StrKIND),pointer:: sfclayer_scheme + + real(kind=RKIND),pointer:: len_disp + real(kind=RKIND),dimension(:),pointer:: meshDensity + real(kind=RKIND),dimension(:),pointer:: skintemp,sst,xice,xland + real(kind=RKIND),dimension(:),pointer:: hpbl,mavail + real(kind=RKIND),dimension(:),pointer:: br,cpm,chs,chs2,cqs2,flhc,flqc,gz1oz0,hfx,qfx, & + qgh,qsfc,lh,mol,psim,psih,regime,rmol,ust,ustm, & + wspd,znt,zol + +!local pointers specific to monin_obukhov: + real(kind=RKIND),dimension(:),pointer:: fh,fm + +!local pointers specific to mynn: + real(kind=RKIND),dimension(:),pointer:: ch,qcg,snowh + +!----------------------------------------------------------------------------------------------------------------- + +!input variables: + 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_len_disp' ,len_disp ) + call mpas_pool_get_array(mesh,'meshDensity',meshDensity) + + call mpas_pool_get_array(diag_physics,'hpbl' ,hpbl ) + call mpas_pool_get_array(diag_physics,'mavail' ,mavail ) + call mpas_pool_get_array(sfc_input ,'skintemp',skintemp) + call mpas_pool_get_array(sfc_input ,'xland' ,xland ) + +!inout variables: + call mpas_pool_get_array(diag_physics,'br' ,br ) + call mpas_pool_get_array(diag_physics,'cpm' ,cpm ) + call mpas_pool_get_array(diag_physics,'chs' ,chs ) + call mpas_pool_get_array(diag_physics,'chs2' ,chs2 ) + call mpas_pool_get_array(diag_physics,'cqs2' ,cqs2 ) + call mpas_pool_get_array(diag_physics,'flhc' ,flhc ) + call mpas_pool_get_array(diag_physics,'flqc' ,flqc ) + call mpas_pool_get_array(diag_physics,'gz1oz0' ,gz1oz0 ) + call mpas_pool_get_array(diag_physics,'hfx' ,hfx ) + call mpas_pool_get_array(diag_physics,'qfx' ,qfx ) + call mpas_pool_get_array(diag_physics,'qgh' ,qgh ) + call mpas_pool_get_array(diag_physics,'qsfc' ,qsfc ) + call mpas_pool_get_array(diag_physics,'lh' ,lh ) + call mpas_pool_get_array(diag_physics,'mol' ,mol ) + call mpas_pool_get_array(diag_physics,'psih' ,psih ) + call mpas_pool_get_array(diag_physics,'psim' ,psim ) + call mpas_pool_get_array(diag_physics,'regime' ,regime ) + call mpas_pool_get_array(diag_physics,'rmol' ,rmol ) + call mpas_pool_get_array(diag_physics,'ust' ,ust ) + call mpas_pool_get_array(diag_physics,'ustm' ,ustm ) + call mpas_pool_get_array(diag_physics,'wspd' ,wspd ) + call mpas_pool_get_array(diag_physics,'znt' ,znt ) + call mpas_pool_get_array(diag_physics,'zol' ,zol ) + + do j = jts,jte + do i = its,ite + !input variables: + dx_p(i,j) = len_disp / meshDensity(i)**0.25 + hpbl_p(i,j) = hpbl(i) + mavail_p(i,j) = mavail(i) + tsk_p(i,j) = skintemp(i) + xland_p(i,j) = xland(i) + + !inout variables: + br_p(i,j) = br(i) + cpm_p(i,j) = cpm(i) + chs_p(i,j) = chs(i) + chs2_p(i,j) = chs2(i) + cqs2_p(i,j) = cqs2(i) + flhc_p(i,j) = flhc(i) + flqc_p(i,j) = flqc(i) + gz1oz0_p(i,j) = gz1oz0(i) + hfx_p(i,j) = hfx(i) + qfx_p(i,j) = qfx(i) + qgh_p(i,j) = qgh(i) + qsfc_p(i,j) = qsfc(i) + lh_p(i,j) = lh(i) + mol_p(i,j) = mol(i) + psim_p(i,j) = psim(i) + psih_p(i,j) = psih(i) + regime_p(i,j) = regime(i) + rmol_p(i,j) = rmol(i) + ust_p(i,j) = ust(i) + wspd_p(i,j) = wspd(i) + znt_p(i,j) = znt(i) + zol_p(i,j) = zol(i) + + !output variables: + q2_p(i,j) = 0._RKIND + t2m_p(i,j) = 0._RKIND + th2m_p(i,j) = 0._RKIND + u10_p(i,j) = 0._RKIND + v10_p(i,j) = 0._RKIND + + !output variables (optional): + cd_p(i,j) = 0._RKIND + cda_p(i,j) = 0._RKIND + ck_p(i,j) = 0._RKIND + cka_p(i,j) = 0._RKIND + ustm_p(i,j) = ustm(i) + enddo + enddo + + if(config_frac_seaice) then + call mpas_pool_get_array(sfc_input,'sst' ,sst) + call mpas_pool_get_array(sfc_input,'xice',xice) + do j = jts,jte + do i = its,ite + sst_p(i,j) = sst(i) + xice_p(i,j) = xice(i) + + !input variables: + mavail_sea(i,j) = mavail(i) + tsk_sea(i,j) = skintemp(i) + xland_sea(i,j) = xland(i) + !inout variables: + br_sea(i,j) = br(i) + cpm_sea(i,j) = cpm(i) + chs_sea(i,j) = chs(i) + chs2_sea(i,j) = chs2(i) + cqs2_sea(i,j) = cqs2(i) + flhc_sea(i,j) = flhc(i) + flqc_sea(i,j) = flqc(i) + gz1oz0_sea(i,j) = gz1oz0(i) + lh_sea(i,j) = lh(i) + hfx_sea(i,j) = hfx(i) + qfx_sea(i,j) = qfx(i) + mol_sea(i,j) = mol(i) + psim_sea(i,j) = psim(i) + psih_sea(i,j) = psih(i) + qgh_sea(i,j) = qgh(i) + rmol_sea(i,j) = rmol(i) + regime_sea(i,j) = regime(i) + ust_sea(i,j) = ust(i) + ustm_sea(i,j) = ustm(i) + wspd_sea(i,j) = wspd(i) + zol_sea(i,j) = zol(i) + znt_sea(i,j) = znt(i) + regime_hold(i,j) = regime(i) + !output variables: + cd_sea(i,j) = 0._RKIND + cda_sea(i,j) = 0._RKIND + ck_sea(i,j) = 0._RKIND + cka_sea(i,j) = 0._RKIND + qsfc_sea(i,j) = 0._RKIND + q2_sea(i,j) = 0._RKIND + t2m_sea(i,j) = 0._RKIND + th2m_sea(i,j) = 0._RKIND + u10_sea(i,j) = 0._RKIND + v10_sea(i,j) = 0._RKIND + + !overwrite some local variables for sea-ice cells: + if(xice_p(i,j).ge.xice_threshold .and. xice_p(i,j).le.1._RKIND) then + xland_sea(i,j) = 2._RKIND + mavail_sea(i,j) = 1._RKIND + znt_sea(i,j) = 0.0001_RKIND + tsk_sea(i,j) = max(sst_p(i,j),271.4_RKIND) + else + xland_sea(i,j) = xland_p(i,j) + mavail_sea(i,j) = mavail_p(i,j) + znt_sea(i,j) = znt_p(i,j) + tsk_sea(i,j) = tsk_p(i,j) + endif + enddo + enddo + endif + + sfclayer_select: select case (trim(sfclayer_scheme)) + + case("sf_monin_obukhov","sf_monin_obukhov_rev") + call mpas_pool_get_array(diag_physics,'fh',fh) + call mpas_pool_get_array(diag_physics,'fm',fm) + + do j = jts,jte + do i = its,ite + fh_p(i,j) = fh(i) + fm_p(i,j) = fm(i) + if(config_frac_seaice) then + fh_sea(i,j) = fh(i) + fm_sea(i,j) = fm(i) + endif + enddo + enddo + + sfclayer2_select: select case(sfclayer_scheme) + + case("sf_monin_obukhov_rev") + + do j = jts,jte + do i = its,ite + waterdepth_p(i,j) = 0._RKIND + lakedepth_p(i,j) = 0._RKIND + lakemask_p(i,j) = 0._RKIND + enddo + enddo + + case default + + end select sfclayer2_select + + case("sf_mynn") + !input variables: + call mpas_pool_get_array(diag_physics,'qcg' ,qcg ) + call mpas_pool_get_array(sfc_input ,'snowh',snowh) + !inout variables: + call mpas_pool_get_array(diag_physics,'ch',ch) + + do j = jts,jte + do i = its,ite + !input variables: + snowh_p(i,j) = snowh(i) + qcg_p(i,j) = qcg(i) + !inout variables: + ch_p(i,j) = ch(i) + if(config_frac_seaice) then + ch_sea(i,j) = ch(i) + endif + enddo + enddo + + case default + + end select sfclayer_select + + end subroutine sfclayer_from_MPAS + +!================================================================================================================= + subroutine sfclayer_to_MPAS(configs,sfc_input,diag_physics,its,ite) +!================================================================================================================= + +!input arguments: + type(mpas_pool_type),intent(in):: configs + type(mpas_pool_type),intent(in):: sfc_input + integer,intent(in):: its,ite + +!inout arguments: + type(mpas_pool_type),intent(inout):: diag_physics + +!local variables: + integer:: i,j + +!local pointers: + logical,pointer:: config_frac_seaice + character(len=StrKIND),pointer:: sfclayer_scheme + + real(kind=RKIND),dimension(:),pointer:: br,cpm,chs,chs2,cqs2,flhc,flqc,gz1oz0,hfx,qfx, & + qgh,qsfc,lh,mol,psim,psih,regime,rmol,ust,wspd, & + znt,zol + real(kind=RKIND),dimension(:),pointer:: q2,t2m,th2m,u10,v10 + real(kind=RKIND),dimension(:),pointer:: cd,cda,ck,cka,ustm + real(kind=RKIND),dimension(:),pointer:: xice + +!local pointers specific to monin_obukhov: + real(kind=RKIND),dimension(:),pointer:: fh,fm + +!local pointers specific to mynn: + real(kind=RKIND),dimension(:),pointer:: ch,qcg + +!----------------------------------------------------------------------------------------------------------------- + + call mpas_pool_get_config(configs,'config_frac_seaice' ,config_frac_seaice) + call mpas_pool_get_config(configs,'config_sfclayer_scheme',sfclayer_scheme ) + +!inout variables: + call mpas_pool_get_array(diag_physics,'br' ,br ) + call mpas_pool_get_array(diag_physics,'cpm' ,cpm ) + call mpas_pool_get_array(diag_physics,'chs' ,chs ) + call mpas_pool_get_array(diag_physics,'chs2' ,chs2 ) + call mpas_pool_get_array(diag_physics,'cqs2' ,cqs2 ) + call mpas_pool_get_array(diag_physics,'flhc' ,flhc ) + call mpas_pool_get_array(diag_physics,'flqc' ,flqc ) + call mpas_pool_get_array(diag_physics,'gz1oz0',gz1oz0) + call mpas_pool_get_array(diag_physics,'hfx' ,hfx ) + call mpas_pool_get_array(diag_physics,'qfx' ,qfx ) + call mpas_pool_get_array(diag_physics,'qgh' ,qgh ) + call mpas_pool_get_array(diag_physics,'qsfc' ,qsfc ) + call mpas_pool_get_array(diag_physics,'lh' ,lh ) + call mpas_pool_get_array(diag_physics,'mol' ,mol ) + call mpas_pool_get_array(diag_physics,'psih' ,psih ) + call mpas_pool_get_array(diag_physics,'psim' ,psim ) + call mpas_pool_get_array(diag_physics,'regime',regime) + call mpas_pool_get_array(diag_physics,'rmol' ,rmol ) + call mpas_pool_get_array(diag_physics,'ust' ,ust ) + call mpas_pool_get_array(diag_physics,'wspd' ,wspd ) + call mpas_pool_get_array(diag_physics,'znt' ,znt ) + call mpas_pool_get_array(diag_physics,'zol' ,zol ) + +!output variables: + call mpas_pool_get_array(diag_physics,'q2' ,q2 ) + call mpas_pool_get_array(diag_physics,'t2m' ,t2m ) + call mpas_pool_get_array(diag_physics,'th2m' ,th2m ) + call mpas_pool_get_array(diag_physics,'u10' ,u10 ) + call mpas_pool_get_array(diag_physics,'v10' ,v10 ) + +!output variables (optional): + call mpas_pool_get_array(diag_physics,'cd' ,cd ) + call mpas_pool_get_array(diag_physics,'cda' ,cda ) + call mpas_pool_get_array(diag_physics,'ck' ,ck ) + call mpas_pool_get_array(diag_physics,'cka' ,cka ) + call mpas_pool_get_array(diag_physics,'ustm' ,ustm ) + +!output variables (optional): + call mpas_pool_get_array(diag_physics,'cd' ,cd ) + call mpas_pool_get_array(diag_physics,'cda' ,cda ) + call mpas_pool_get_array(diag_physics,'ck' ,ck ) + call mpas_pool_get_array(diag_physics,'cka' ,cka ) + + do j = jts,jte + do i = its,ite + !inout variables: + br(i) = br_p(i,j) + cpm(i) = cpm_p(i,j) + chs(i) = chs_p(i,j) + chs2(i) = chs2_p(i,j) + cqs2(i) = cqs2_p(i,j) + flhc(i) = flhc_p(i,j) + flqc(i) = flqc_p(i,j) + gz1oz0(i) = gz1oz0_p(i,j) + hfx(i) = hfx_p(i,j) + lh(i) = lh_p(i,j) + mol(i) = mol_p(i,j) + qfx(i) = qfx_p(i,j) + qgh(i) = qgh_p(i,j) + qsfc(i) = qsfc_p(i,j) + psim(i) = psim_p(i,j) + psih(i) = psih_p(i,j) + regime(i) = regime_p(i,j) + rmol(i) = rmol_p(i,j) + ust(i) = ust_p(i,j) + wspd(i) = wspd_p(i,j) + zol(i) = zol_p(i,j) + znt(i) = znt_p(i,j) + !output variables: + q2(i) = q2_p(i,j) + t2m(i) = t2m_p(i,j) + th2m(i) = th2m_p(i,j) + u10(i) = u10_p(i,j) + v10(i) = v10_p(i,j) + !output variables (optional): + cd(i) = cd_p(i,j) + cda(i) = cda_p(i,j) + ck(i) = ck_p(i,j) + cka(i) = cka_p(i,j) + ustm(i) = ustm_p(i,j) + enddo + enddo + + if(config_frac_seaice) then + call mpas_pool_get_array(sfc_input,'xice',xice) + do j = jts,jte + do i = its,ite + if(xice(i).ge.xice_threshold .and. xice(i).le.1._RKIND) then + br(i) = br_p(i,j)*xice(i) + (1._RKIND-xice(i))*br_sea(i,j) + flhc(i) = flhc_p(i,j)*xice(i) + (1._RKIND-xice(i))*flhc_sea(i,j) + flqc(i) = flqc_p(i,j)*xice(i) + (1._RKIND-xice(i))*flqc_sea(i,j) + gz1oz0(i) = gz1oz0_p(i,j)*xice(i) + (1._RKIND-xice(i))*gz1oz0_sea(i,j) + mol(i) = mol_p(i,j)*xice(i) + (1._RKIND-xice(i))*mol_sea(i,j) + psih(i) = psih_p(i,j)*xice(i) + (1._RKIND-xice(i))*psih_sea(i,j) + psim(i) = psim_p(i,j)*xice(i) + (1._RKIND-xice(i))*psim_sea(i,j) + rmol(i) = rmol_p(i,j)*xice(i) + (1._RKIND-xice(i))*rmol_sea(i,j) + ust(i) = ust_p(i,j)*xice(i) + (1._RKIND-xice(i))*ust_sea(i,j) + wspd(i) = wspd_p(i,j)*xice(i) + (1._RKIND-xice(i))*wspd_sea(i,j) + zol(i) = zol_p(i,j)*xice(i) + (1._RKIND-xice(i))*zol_sea(i,j) + if(xice(i) .ge. 0.5_RKIND) regime(i) = regime_hold(i,j) + !output variables: + q2(i) = q2_p(i,j)*xice(i) + (1._RKIND-xice(i))*q2_sea(i,j) + t2m(i) = t2m_p(i,j)*xice(i) + (1._RKIND-xice(i))*t2m_sea(i,j) + th2m(i) = th2m_p(i,j)*xice(i) + (1._RKIND-xice(i))*th2m_sea(i,j) + u10(i) = u10_p(i,j)*xice(i) + (1._RKIND-xice(i))*u10_sea(i,j) + v10(i) = v10_p(i,j)*xice(i) + (1._RKIND-xice(i))*v10_sea(i,j) + !output variables (optional): + cd(i) = cd_p(i,j)*xice(i) + (1._RKIND-xice(i))*cd_sea(i,j) + cda(i) = cda_p(i,j)*xice(i) + (1._RKIND-xice(i))*cda_sea(i,j) + ck(i) = ck_p(i,j)*xice(i) + (1._RKIND-xice(i))*ck_sea(i,j) + cka(i) = cka_p(i,j)*xice(i) + (1._RKIND-xice(i))*cka_sea(i,j) + ustm(i) = ustm_p(i,j)*xice(i) + (1._RKIND-xice(i))*ustm_sea(i,j) + endif + enddo + enddo + endif + + sfclayer_select: select case (trim(sfclayer_scheme)) + + case("sf_monin_obukhov","sf_monin_obukhov_rev") + call mpas_pool_get_array(diag_physics,'fh',fh) + call mpas_pool_get_array(diag_physics,'fm',fm) + + do j = jts,jte + do i = its,ite + fh(i) = fh_p(i,j) + fm(i) = fm_p(i,j) + enddo + enddo + if(config_frac_seaice) then + call mpas_pool_get_array(sfc_input,'xice',xice) + do j = jts,jte + do i = its,ite + if(xice(i).ge.xice_threshold .and. xice(i).le.1._RKIND) then + fh(i) = fh_p(i,j)*xice(i) + (1._RKIND-xice(i))*fh_sea(i,j) + fm(i) = fm_p(i,j)*xice(i) + (1._RKIND-xice(i))*fm_sea(i,j) + endif + enddo + enddo + endif + + case("sf_mynn") + call mpas_pool_get_array(diag_physics,'ch',ch) + + do j = jts,jte + do i = its,ite + ch(i) = ch_p(i,j) + enddo + enddo + if(config_frac_seaice) then + call mpas_pool_get_array(sfc_input,'xice',xice) + do j = jts,jte + do i = its,ite + if(xice(i).ge.xice_threshold .and. xice(i).le.1._RKIND) then + ch(i) = ch_p(i,j)*xice(i) + (1._RKIND-xice(i))*ch_sea(i,j) + endif + enddo + enddo + endif + + case default + + end select sfclayer_select + + end subroutine sfclayer_to_MPAS + +!================================================================================================================= + subroutine init_sfclayer(configs) +!================================================================================================================= + +!input arguments: + type(mpas_pool_type),intent(in):: configs + +!local variables and pointers: + logical, parameter:: allowed_to_read = .false. !actually not used in subroutine sfclayinit. + character(len=StrKIND),pointer:: sfclayer_scheme + +!CCPP-compliant flags: + character(len=StrKIND):: errmsg + integer:: errflg + +!----------------------------------------------------------------------------------------------------------------- + +!initialization of CCPP-compliant flags: + errmsg = ' ' + errflg = 0 + + call mpas_pool_get_config(configs,'config_sfclayer_scheme',sfclayer_scheme) + + sfclayer_select: select case (trim(sfclayer_scheme)) + + case("sf_monin_obukhov") + call sfclayinit(allowed_to_read) + + case("sf_monin_obukhov_rev") + call sf_sfclayrev_init(errmsg,errflg) + + case("sf_mynn") + call sf_mynn_init(errmsg,errflg) + + case default + + end select sfclayer_select + + end subroutine init_sfclayer + +!================================================================================================================= + subroutine driver_sfclayer(itimestep,configs,mesh,diag_physics,sfc_input,its,ite) +!================================================================================================================= + +!input and inout arguments: + type(mpas_pool_type),intent(in):: mesh + type(mpas_pool_type),intent(in):: configs + 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):: diag_physics + +!local pointers: + logical,pointer:: config_do_restart,config_frac_seaice + character(len=StrKIND),pointer:: sfclayer_scheme + real(kind=RKIND),dimension(:),pointer:: areaCell + +!local variables: + integer:: initflag + real(kind=RKIND):: dx + +!CCPP-compliant flags: + character(len=StrKIND):: errmsg + integer:: errflg + +!----------------------------------------------------------------------------------------------------------------- +!call mpas_log_write('') +!call mpas_log_write('--- enter subroutine driver_sfclayer:') + +!initialization of CCPP-compliant flags: + errmsg = ' ' + errflg = 0 + + 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_array(mesh,'areaCell',areaCell) + +!copy all MPAS arrays to rectanguler grid: + call sfclayer_from_MPAS(configs,mesh,diag_physics,sfc_input,its,ite) + + dx = sqrt(maxval(areaCell)) + + initflag = 1 + if(config_do_restart .or. itimestep > 1) initflag = 0 + + sfclayer_select: select case (trim(sfclayer_scheme)) + + case("sf_monin_obukhov") + call mpas_timer_start('sf_monin_obukhov') + call sfclay( & + p3d = pres_hyd_p , psfc = psfc_p , t3d = t_p , & + u3d = u_p , v3d = v_p , qv3d = qv_p , & + dz8w = dz_p , cp = cp , g = gravity , & + rovcp = rcp , R = R_d , xlv = xlv , & + chs = chs_p , chs2 = chs2_p , cqs2 = cqs2_p , & + cpm = cpm_p , znt = znt_p , ust = ust_p , & + pblh = hpbl_p , mavail = mavail_p , zol = zol_p , & + mol = mol_p , regime = regime_p , psim = psim_p , & + psih = psih_p , fm = fm_p , fh = fh_p , & + xland = xland_p , hfx = hfx_p , qfx = qfx_p , & + lh = lh_p , tsk = tsk_p , flhc = flhc_p , & + flqc = flqc_p , qgh = qgh_p , qsfc = qsfc_p , & + rmol = rmol_p , u10 = u10_p , v10 = v10_p , & + th2 = th2m_p , t2 = t2m_p , q2 = q2_p , & + gz1oz0 = gz1oz0_p , wspd = wspd_p , br = br_p , & + isfflx = isfflx , dx = dx_p , svp1 = svp1 , & + svp2 = svp2 , svp3 = svp3 , svpt0 = svpt0 , & + ep1 = ep_1 , ep2 = ep_2 , karman = karman , & + eomeg = eomeg , stbolt = stbolt , P1000mb = P0 , & + ustm = ustm_p , ck = ck_p , cka = cka_p , & + cd = cd_p , cda = cda_p , isftcflx = isftcflx , & + iz0tlnd = iz0tlnd , scm_force_flux = scm_force_flux , & + 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 & + ) + + if(config_frac_seaice) then + call sfclay( & + p3d = pres_hyd_p , psfc = psfc_p , t3d = t_p , & + u3d = u_p , v3d = v_p , qv3d = qv_p , & + dz8w = dz_p , cp = cp , g = gravity , & + rovcp = rcp , R = R_d , xlv = xlv , & + chs = chs_sea , chs2 = chs2_sea , cqs2 = cqs2_sea , & + cpm = cpm_sea , znt = znt_sea , ust = ust_sea , & + pblh = hpbl_p , mavail = mavail_sea , zol = zol_sea , & + mol = mol_sea , regime = regime_sea , psim = psim_sea , & + psih = psih_sea , fm = fm_sea , fh = fh_sea , & + xland = xland_sea , hfx = hfx_sea , qfx = qfx_sea , & + lh = lh_sea , tsk = tsk_sea , flhc = flhc_sea , & + flqc = flqc_sea , qgh = qgh_sea , qsfc = qsfc_sea , & + rmol = rmol_sea , u10 = u10_sea , v10 = v10_sea , & + th2 = th2m_sea , t2 = t2m_sea , q2 = q2_sea , & + gz1oz0 = gz1oz0_sea , wspd = wspd_sea , br = br_sea , & + isfflx = isfflx , dx = dx_p , svp1 = svp1 , & + svp2 = svp2 , svp3 = svp3 , svpt0 = svpt0 , & + ep1 = ep_1 , ep2 = ep_2 , karman = karman , & + eomeg = eomeg , stbolt = stbolt , P1000mb = P0 , & + ustm = ustm_sea , ck = ck_sea , cka = cka_sea , & + cd = cd_sea , cda = cda_sea , isftcflx = isftcflx , & + iz0tlnd = iz0tlnd , scm_force_flux = scm_force_flux , & + ids = ids , ide = ide , jds = jds , jde = jde , kds = kds , kde = kde , & + ims = ims , ime = ime , jms = jms , jme = jme , kms = kms , kme = kme , & + its = its , ite = ite , jts = jts , jte = jte , kts = kts , kte = kte & + ) + endif + call mpas_timer_stop('sf_monin_obukhov') + + case("sf_monin_obukhov_rev") + call mpas_timer_start('sf_monin_obukhov_rev') + call sfclayrev( & + p3d = pres_hyd_p , psfc = psfc_p , t3d = t_p , & + u3d = u_p , v3d = v_p , qv3d = qv_p , & + dz8w = dz_p , cp = cp , g = gravity , & + rovcp = rcp , R = R_d , xlv = xlv , & + chs = chs_p , chs2 = chs2_p , cqs2 = cqs2_p , & + cpm = cpm_p , znt = znt_p , ust = ust_p , & + pblh = hpbl_p , mavail = mavail_p , zol = zol_p , & + mol = mol_p , regime = regime_p , psim = psim_p , & + psih = psih_p , fm = fm_p , fh = fh_p , & + xland = xland_p , hfx = hfx_p , qfx = qfx_p , & + lh = lh_p , tsk = tsk_p , flhc = flhc_p , & + flqc = flqc_p , qgh = qgh_p , qsfc = qsfc_p , & + rmol = rmol_p , u10 = u10_p , v10 = v10_p , & + th2 = th2m_p , t2 = t2m_p , q2 = q2_p , & + gz1oz0 = gz1oz0_p , wspd = wspd_p , br = br_p , & + isfflx = isfflx , dx = dx_p , svp1 = svp1 , & + svp2 = svp2 , svp3 = svp3 , svpt0 = svpt0 , & + ep1 = ep_1 , ep2 = ep_2 , karman = karman , & + p1000mb = P0 , lakemask = lakemask_p , ustm = ustm_p , & + ck = ck_p , cka = cka_p , cd = cd_p , & + cda = cda_p , isftcflx = isftcflx , iz0tlnd = iz0tlnd , & + shalwater_z0 = shalwater_flag , water_depth = waterdepth_p , scm_force_flux = scm_force_flux , & + 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 & + ) + + if(config_frac_seaice) then + call sfclayrev( & + p3d = pres_hyd_p , psfc = psfc_p , t3d = t_p , & + u3d = u_p , v3d = v_p , qv3d = qv_p , & + dz8w = dz_p , cp = cp , g = gravity , & + rovcp = rcp , R = R_d , xlv = xlv , & + chs = chs_sea , chs2 = chs2_sea , cqs2 = cqs2_sea , & + cpm = cpm_sea , znt = znt_sea , ust = ust_sea , & + pblh = hpbl_p , mavail = mavail_sea , zol = zol_sea , & + mol = mol_sea , regime = regime_sea , psim = psim_sea , & + psih = psih_sea , fm = fm_sea , fh = fh_sea , & + xland = xland_sea , hfx = hfx_sea , qfx = qfx_sea , & + lh = lh_sea , tsk = tsk_sea , flhc = flhc_sea , & + flqc = flqc_sea , qgh = qgh_sea , qsfc = qsfc_sea , & + rmol = rmol_sea , u10 = u10_sea , v10 = v10_sea , & + th2 = th2m_sea , t2 = t2m_sea , q2 = q2_sea , & + gz1oz0 = gz1oz0_sea , wspd = wspd_sea , br = br_sea , & + isfflx = isfflx , dx = dx_p , svp1 = svp1 , & + svp2 = svp2 , svp3 = svp3 , svpt0 = svpt0 , & + ep1 = ep_1 , ep2 = ep_2 , karman = karman , & + p1000mb = P0 , lakemask = lakemask_p , ustm = ustm_sea , & + ck = ck_sea , cka = cka_sea , cd = cd_sea , & + cda = cda_sea , isftcflx = isftcflx , iz0tlnd = iz0tlnd , & + shalwater_z0 = shalwater_flag , water_depth = waterdepth_p , scm_force_flux = scm_force_flux , & + 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 & + ) + endif + call mpas_timer_stop('sf_monin_obukhov_rev') + + case("sf_mynn") + call mpas_timer_start('sf_mynn') + call sfclay_mynn( & + p3d = pres_hyd_p , pi3d = pi_p , psfcpa = psfc_p , & + th3d = th_p , t3d = t_p , u3d = u_p , & + v3d = v_p , qv3d = qv_p , qc3d = qc_p , & + rho3d = rho_p , dz8w = dz_p , cp = cp , & + g = gravity , rovcp = rcp , R = R_d , & + xlv = xlv , chs = chs_p , chs2 = chs2_p , & + cqs2 = cqs2_p , cpm = cpm_p , znt = znt_p , & + ust = ust_p , pblh = hpbl_p , mavail = mavail_p , & + zol = zol_p , mol = mol_p , regime = regime_p , & + psim = psim_p , psih = psih_p , xland = xland_p , & + hfx = hfx_p , qfx = qfx_p , lh = lh_p , & + tsk = tsk_p , flhc = flhc_p , flqc = flqc_p , & + qgh = qgh_p , qsfc = qsfc_p , rmol = rmol_p , & + u10 = u10_p , v10 = v10_p , th2 = th2m_p , & + t2 = t2m_p , q2 = q2_p , snowh = snowh_p , & + gz1oz0 = gz1oz0_p , wspd = wspd_p , br = br_p , & + isfflx = isfflx , dx = dx_p , svp1 = svp1 , & + svp2 = svp2 , svp3 = svp3 , svpt0 = svpt0 , & + ep1 = ep_1 , ep2 = ep_2 , karman = karman , & + ustm = ustm_p , ck = ck_p , cka = cka_p , & + cd = cd_p , cda = cda_p , ch = ch_p , & + qcg = qcg_p , spp_pbl = spp_pbl , isftcflx = isftcflx , & + iz0tlnd = iz0tlnd , itimestep = initflag , & + 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 & + ) + + if(config_frac_seaice) then + call sfclay_mynn( & + p3d = pres_hyd_p , pi3d = pi_p , psfcpa = psfc_p , & + th3d = th_p , t3d = t_p , u3d = u_p , & + v3d = v_p , qv3d = qv_p , qc3d = qc_p , & + rho3d = rho_p , dz8w = dz_p , cp = cp , & + g = gravity , rovcp = rcp , R = R_d , & + xlv = xlv , chs = chs_sea , chs2 = chs2_sea , & + cqs2 = cqs2_sea , cpm = cpm_sea , znt = znt_sea , & + ust = ust_sea , pblh = hpbl_p , mavail = mavail_sea , & + zol = zol_sea , mol = mol_sea , regime = regime_sea , & + psim = psim_sea , psih = psih_sea , xland = xland_sea , & + hfx = hfx_sea , qfx = qfx_sea , lh = lh_sea , & + tsk = tsk_sea , flhc = flhc_sea , flqc = flqc_sea , & + qgh = qgh_sea , qsfc = qsfc_sea , rmol = rmol_sea , & + u10 = u10_sea , v10 = v10_sea , th2 = th2m_sea , & + t2 = t2m_sea , q2 = q2_sea , snowh = snowh_p , & + gz1oz0 = gz1oz0_sea , wspd = wspd_sea , br = br_sea , & + isfflx = isfflx , dx = dx_p , svp1 = svp1 , & + svp2 = svp2 , svp3 = svp3 , svpt0 = svpt0 , & + ep1 = ep_1 , ep2 = ep_2 , karman = karman , & + ustm = ustm_sea , ck = ck_sea , cka = cka_sea , & + cd = cd_sea , cda = cda_sea , ch = ch_sea , & + qcg = qcg_p , spp_pbl = spp_pbl , isftcflx = isftcflx , & + iz0tlnd = iz0tlnd , itimestep = initflag , & + 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 & + ) + endif + call mpas_timer_stop('sf_mynn') + + case default + + end select sfclayer_select + +!copy local arrays to MPAS grid: + call sfclayer_to_MPAS(configs,sfc_input,diag_physics,its,ite) + +!call mpas_log_write('--- end subroutine driver_sfclayer.') + + end subroutine driver_sfclayer + +!================================================================================================================= + end module mpas_atmphys_driver_sfclayer +!================================================================================================================= diff --git a/src/core_atmosphere/physics/mpas_atmphys_packages.F b/src/core_atmosphere/physics/mpas_atmphys_packages.F index 5d32cb297e..9fe858d96e 100644 --- a/src/core_atmosphere/physics/mpas_atmphys_packages.F +++ b/src/core_atmosphere/physics/mpas_atmphys_packages.F @@ -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 @@ -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) @@ -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: diff --git a/src/core_atmosphere/physics/mpas_atmphys_packages.F-org b/src/core_atmosphere/physics/mpas_atmphys_packages.F-org new file mode 100644 index 0000000000..5d32cb297e --- /dev/null +++ b/src/core_atmosphere/physics/mpas_atmphys_packages.F-org @@ -0,0 +1,205 @@ +! Copyright (c) 2013, Los Alamos National Security, LLC (LANS) +! and the University Corporation for Atmospheric Research (UCAR). +! +! Unless noted otherwise source code is licensed under the BSD license. +! Additional copyright and license information can be found in the LICENSE file +! distributed with this code, or at http://mpas-dev.github.com/license.html +! +!================================================================================================================= + module mpas_atmphys_packages + use mpas_kind_types + use mpas_derived_types,only : mpas_pool_type,mpas_io_context_type,MPAS_LOG_ERR + use mpas_pool_routines,only : mpas_pool_get_config,mpas_pool_get_package + use mpas_log,only : mpas_log_write + + implicit none + private + public:: atmphys_setup_packages + +!mpas_atmphys_packages contains the definitions of all physics packages. +!Laura D. Fowler (laura@ucar.edu) / 2016-03-10. + + + contains + + +!================================================================================================================= + function atmphys_setup_packages(configs,packages,iocontext) result(ierr) +!================================================================================================================= + +!inout arguments: + type (mpas_pool_type), intent(inout) :: configs + type (mpas_pool_type), intent(inout) :: packages + type (mpas_io_context_type), intent(inout) :: iocontext + +!local variables: + character(len=StrKIND),pointer:: config_microp_scheme + character(len=StrKIND),pointer:: config_convection_scheme + character(len=StrKIND),pointer:: config_pbl_scheme + 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:: sf_noahmp_in + + integer :: ierr + +!----------------------------------------------------------------------------------------------------------------- +!call mpas_log_write('') +!call mpas_log_write('--- enter subroutine atmphys_setup_packages:') + + ierr = 0 + + call mpas_log_write('----- Setting up package variables -----') + call mpas_log_write('') + +!--- initialization of all packages for parameterizations of cloud microphysics: + + call mpas_pool_get_config(configs,'config_microp_scheme',config_microp_scheme) + + nullify(mp_kessler_in) + call mpas_pool_get_package(packages,'mp_kessler_inActive',mp_kessler_in) + + nullify(mp_thompson_in) + call mpas_pool_get_package(packages,'mp_thompson_inActive',mp_thompson_in) + + nullify(mp_thompson_aers_in) + call mpas_pool_get_package(packages,'mp_thompson_aers_inActive',mp_thompson_aers_in) + + nullify(mp_wsm6_in) + call mpas_pool_get_package(packages,'mp_wsm6_inActive',mp_wsm6_in) + + if(.not.associated(mp_kessler_in ) .or. & + .not.associated(mp_thompson_in ) .or. & + .not.associated(mp_thompson_aers_in) .or. & + .not.associated(mp_wsm6_in)) then + call mpas_log_write('====================================================================================',messageType=MPAS_LOG_ERR) + call mpas_log_write('* Error while setting up packages for cloud microphysics options in atmosphere core.',messageType=MPAS_LOG_ERR) + call mpas_log_write('====================================================================================',messageType=MPAS_LOG_ERR) + ierr = 1 + return + endif + + mp_kessler_in = .false. + mp_thompson_in = .false. + mp_thompson_aers_in = .false. + mp_wsm6_in = .false. + + if(config_microp_scheme == 'mp_kessler') then + mp_kessler_in = .true. + elseif(config_microp_scheme == 'mp_thompson') then + mp_thompson_in = .true. + elseif(config_microp_scheme == 'mp_thompson_aerosols') then + mp_thompson_aers_in = .true. + elseif(config_microp_scheme == 'mp_wsm6') then + mp_wsm6_in = .true. + endif + + call mpas_log_write(' mp_kessler_in = $l', logicArgs=(/mp_kessler_in/)) + call mpas_log_write(' mp_thompson_in = $l', logicArgs=(/mp_thompson_in/)) + call mpas_log_write(' mp_thompson_aers_in = $l', logicArgs=(/mp_thompson_aers_in/)) + call mpas_log_write(' mp_wsm6_in = $l', logicArgs=(/mp_wsm6_in/)) + +!--- initialization of all packages for parameterizations of convection: + + call mpas_pool_get_config(configs,'config_convection_scheme',config_convection_scheme) + + nullify(cu_grell_freitas_in) + call mpas_pool_get_package(packages,'cu_grell_freitas_inActive',cu_grell_freitas_in) + + nullify(cu_kain_fritsch_in) + call mpas_pool_get_package(packages,'cu_kain_fritsch_inActive',cu_kain_fritsch_in) + + nullify(cu_ntiedtke_in) + call mpas_pool_get_package(packages,'cu_ntiedtke_inActive',cu_ntiedtke_in) + + if(.not.associated(cu_grell_freitas_in) .or. & + .not.associated(cu_kain_fritsch_in) .or. & + .not.associated(cu_ntiedtke_in) ) then + call mpas_log_write('====================================================================================',messageType=MPAS_LOG_ERR) + call mpas_log_write('* Error while setting up packages for convection options in atmosphere core.', messageType=MPAS_LOG_ERR) + call mpas_log_write('====================================================================================',messageType=MPAS_LOG_ERR) + ierr = 1 + return + endif + + cu_grell_freitas_in = .false. + cu_kain_fritsch_in = .false. + cu_ntiedtke_in = .false. + + if(config_convection_scheme=='cu_grell_freitas') then + cu_grell_freitas_in = .true. + elseif(config_convection_scheme == 'cu_kain_fritsch') then + cu_kain_fritsch_in = .true. + elseif(config_convection_scheme == 'cu_tiedtke' .or. & + config_convection_scheme == 'cu_ntiedtke') then + cu_ntiedtke_in = .true. + endif + + call mpas_log_write(' cu_grell_freitas_in = $l', logicArgs=(/cu_grell_freitas_in/)) + call mpas_log_write(' cu_kain_fritsch_in = $l', logicArgs=(/cu_kain_fritsch_in/)) + call mpas_log_write(' cu_ntiedtke_in = $l', logicArgs=(/cu_ntiedtke_in/)) + +!--- initialization of all packages for parameterizations of surface layer and planetary boundary layer: + + call mpas_pool_get_config(configs,'config_pbl_scheme',config_pbl_scheme) + + nullify(bl_mynn_in) + call mpas_pool_get_package(packages,'bl_mynn_inActive',bl_mynn_in) + + nullify(bl_ysu_in) + call mpas_pool_get_package(packages,'bl_ysu_inActive',bl_ysu_in) + + if(.not.associated(bl_mynn_in) .or. & + .not.associated(bl_ysu_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) + ierr = 1 + return + endif + + bl_mynn_in = .false. + bl_ysu_in = .false. + + if(config_pbl_scheme=='bl_mynn') then + bl_mynn_in = .true. + elseif(config_pbl_scheme == 'bl_ysu') then + bl_ysu_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('') + +!--- initialization of all packages for parameterizations of land surface processes: + + call mpas_pool_get_config(configs,'config_lsm_scheme',config_lsm_scheme) + + nullify(sf_noahmp_in) + call mpas_pool_get_package(packages,'sf_noahmp_inActive',sf_noahmp_in) + + if(.not.associated(sf_noahmp_in)) then + call mpas_log_write('====================================================================================',messageType=MPAS_LOG_ERR) + call mpas_log_write('* Error while setting up packages for land surface options in atmosphere core.' , messageType=MPAS_LOG_ERR) + call mpas_log_write('====================================================================================',messageType=MPAS_LOG_ERR) + ierr = 1 + return + endif + + if(config_lsm_scheme=='sf_noahmp') then + sf_noahmp_in = .true. + endif + + call mpas_log_write(' sf_noahmp_in = $l', logicArgs=(/sf_noahmp_in/)) + call mpas_log_write('') + + + end function atmphys_setup_packages + +!================================================================================================================= + end module mpas_atmphys_packages +!================================================================================================================= + + + diff --git a/src/core_atmosphere/physics/mpas_atmphys_vars.F b/src/core_atmosphere/physics/mpas_atmphys_vars.F index 084fc9f0e0..5747847d40 100644 --- a/src/core_atmosphere/physics/mpas_atmphys_vars.F +++ b/src/core_atmosphere/physics/mpas_atmphys_vars.F @@ -374,11 +374,11 @@ module mpas_atmphys_vars !================================================================================================================= logical,parameter:: & - flag_bep = .false. !flag to use BEP/BEP+BEM for use in the YSU PBL scheme (with urban physics). since we do + flag_bep = .false. !flag to use BEP/BEP+BEM for use in the SHINHONG/YSU PBL scheme (with urban physics). since we do !not run urban physics, flag_bep is always set to false. integer,parameter:: & - idiff = 0 !BEP/BEM+BEM diffusion flag for use in the YSU PBL scheme (with urban physics). since we + idiff = 0 !BEP/BEM+BEM diffusion flag for use in the SHINHONG/YSU PBL scheme (with urban physics). since we !do not run urban physics, idiff is set to zero. integer:: ysu_pblmix @@ -394,6 +394,7 @@ module mpas_atmphys_vars hpbl_p, &!PBL height [m] delta_p, &! wstar_p, &! + fcell_p, &! uoce_p, &! voce_p ! diff --git a/src/core_atmosphere/physics/mpas_atmphys_vars.F-org b/src/core_atmosphere/physics/mpas_atmphys_vars.F-org new file mode 100644 index 0000000000..134009f537 --- /dev/null +++ b/src/core_atmosphere/physics/mpas_atmphys_vars.F-org @@ -0,0 +1,957 @@ +! Copyright (c) 2013, Los Alamos National Security, LLC (LANS) +! and the University Corporation for Atmospheric Research (UCAR). +! +! Unless noted otherwise source code is licensed under the BSD license. +! Additional copyright and license information can be found in the LICENSE file +! distributed with this code, or at http://mpas-dev.github.com/license.html +! +!================================================================================================================= + module mpas_atmphys_vars + use mpas_kind_types + + use NoahmpIOVarType + + implicit none + public + save + + +!mpas_atmphys_vars contains all local variables and arrays used in the physics parameterizations. +!Laura D. Fowler (send comments to laura@ucar.edu). +!2013-05-01. +! +! add-ons and modifications: +! -------------------------- +! * added the variables sf_surface_physics,alswvisdir_p,alswvisdif_p,alswnirdir_p,alswnirdif_p,swvisdir_p, +! swvisdif_p,swnirdir_p,and swnirdif_p to upgrade the RRTMG short wave radiation code to WRF version 3.4.1. +! see definition of each individual variables below. +! Laura D. Fowler (laura@ucar.edu) / 2013-03-11. +! * removed call to the updated Kain-Fritsch convection scheme. +! Laura D. Fowler (laura@ucar.edu) / 2013-05-29. +! * added the arrays o3clim_p for implementation of monthly-varying climatological ozone in the +! long wave and short wave RRTMG radiation codes. +! Laura D. Fowler (laura@ucar.edu) / 2013-07-08. +! * corrected definition of local variable dx_p. +! Laura D. Fowler (laura@ucar.edu) / 2013-08-23. +! * renamed local variable conv_deep_scheme to convection_scheme. +! Laura D. Fowler (laura@ucar.edu) / 2014-09-18. +! * added empty subroutine atmphys_vars_init that does not do anything, but needed for +! compiling MPAS with some compilers. +! Laura D. Fowler (laura@ucar.edu) / 2015-01-12. +! * added local variables needed for the Thompson parameterization of cloud microphysics. +! Laura D. Fowler (laura@ucar.edu) / 2016-03-28. +! * added local variables needed for the Grell-Freitas parameterization of deep and shallow convection. +! * Laura D. Fowler (laura@ucar.edu) / 2016-03-30. +! * added local arrays needed in the MYNN surface layer scheme and PBL scheme. +! Laura D. Fowler (laura@ucar.edu) / 2016-03-31. +! * added the logical ua_phys needed in the call to subroutine sfcdiags. ua_phys is set to false. +! Laura D. Fowler (laura@ucar.edu) / 2016-05-13. +! * added the integers has_reqc,has_reqi,and has_reqs. when initialized to zero, the effective radii for cloud +! water,cloud ice,and snow are calculated using the subroutines relcalc and ricalc in subroutines rrtmg_lwrad +! and rrtmg_swrad. when initialized to 1, the effective radii are calculated in the Thompson cloud microphysics +! scheme instead. has_reqc,has_reqi,and has_reqs are initialized depending on the logical config_microp_re. +! Laura D. Fowler (laura@ucar.edu) / 2016-07-08. +! * added diagnostics of the effective radii for cloud water, cloud ice, and snow used in rrtmg_lwrad. +! Laura D. Fowler (laura@ucar.edu) / 2016-07-08. +! * added the variables qvrad_p,qcrad_p,qirad_p, and qsrad_p which are the water vapor,cloud water,cloud ice, +! and snow mixing ratios local to the calculation of the cloud fraction, and used in the radiation codes. +! Laura D. Fowler (laura@ucar.edu) / 2016-07-08. +! * added the variables rqvften and rthften which are the forcing tendencies needed to run the "new" Tiedtke +! parameterization of convection. +! Laura D. Fowler (laura@ucar.edu) / 2016-09-20. +! * added local "_sea" arrays that are needed in the surface layer scheme and land surface scheme for handling +! grid cells with fractional seaice when config_frac_seaice is set to true. also added local tsk_ice variable +! needed in the land surface scheme for handling grid cells with fractional seaice when config_frac_seaice is +! set to true. +! Laura D. Fowler (laura@ucar.edu) / 2016-10-03. +! * added local variable regime_hold to save the original value of variable regime over seaice grid cells when +! config_frac_seaice is set to true. +! Laura D. Fowler (laura@ucar.edu) / 2016-10-21. +! * moved the declarations of arrays delta_p,wstar_p,uoce_p,and voce_p since they are now used in both modules +! module_bl_ysu.F and module_bl_mynn.F. +! Laura D. Fowler (laura@ucar.edu) / 2016-10-27. +! * added the variable opt_thcnd (option to treat thermal conductivity in NoahLSM). added additional options and +! arrays to run the Noah LSM scheme from WRF version 3.9.0. +! Laura D. Fowler (laura@ucar.edu) / 2017-01-27. +! * removed the initialization local variable gwdo_scheme. gwdo_scheme is no longer needed and can be replaced +! with config_gwdo_scheme. +! Laura D. Fowler (laura@ucar.edu) / 2017-02-16. +! * removed the initialization local variable lsm_scheme. lsm_scheme is no longer needed and can be replaced +! with config_lsm_scheme. +! Laura D. Fowler (laura@ucar.edu) / 2017-02-16. +! * removed the initialization local variable sfclayer_scheme. sfclayer_scheme is no longer needed and can be +! replaced with config_sfclayer_scheme. +! Laura D. Fowler (laura@ucar.edu) / 2017-02-16. +! * removed the initialization local variable pbl_scheme. pbl_scheme is no longer needed and can be replaced +! replaced with config_pbl_scheme. +! Laura D. Fowler (laura@ucar.edu) / 2017-02-16. +! * removed the initialization local variable radt_cld_scheme. radt_cld_scheme is no longer needed and can be +! replaced replaced with config_radt_cld_scheme. +! Laura D. Fowler (laura@ucar.edu) / 2017-02-16. +! * removed the initialization local variable radt_lw_scheme. radt_lw_scheme is no longer needed and can be +! replaced replaced with config_radt_lw_scheme. +! Laura D. Fowler (laura@ucar.edu) / 2017-02-16. +! * removed the initialization local variable radt_sw_scheme. radt_sw_scheme is no longer needed and can be +! replaced replaced with config_radt_sw_scheme. +! Laura D. Fowler (laura@ucar.edu) / 2017-02-16. +! * removed the initialization local variable convection_scheme. convection_scheme is no longer needed and can be +! replaced replaced with config_convection_scheme. +! Laura D. Fowler (laura@ucar.edu) / 2017-02-16. +! * removed the initialization local variable microp_scheme. microp_scheme is no longer needed and can be +! replaced replaced with config_microp_scheme. +! Laura D. Fowler (laura@ucar.edu) / 2017-02-16. +! * add variables and arrays needed to the parameterization of seaice in the updated Noah land surface scheme. +! Laura D. Fowler (laura@ucar.edu) / 2017-02-19. +! * changed the option seaice_albedo_opt from 0 to 2 so that we can initialize the surface albedo over seaice +! cells using the surface background albedo (see initialization of sfc_albedo_seaice in subroutine +! landuse_init_forMPAS). +! Laura D. Fowler (laura@ucar.edu) / 2017-03-02. +! * added local variables for the mass-weighted mean velocities for rain, cloud ice, snow, and graupel from the +! Thompson cloud microphysics scheme. +! Laura D. Fowler (laura@ucar.edu) / 2017-04-19. +! * added the local variables cosa_p and sina_p needed in call to subroutine gwdo after updating module_bl_gwdo.F +! to that of WRF version 4.0.2. +! Laura D. Fowler (laura@ucar.edu) / 2019-01-30. +! * reverted the option seaice_albedo_opt = 2 to seaic_albedo_opt = 0 since MPAS does not currently support the +! input of "observed" 2D seaice albedos. In conjunction with this update, we also change the initialization of +! albsi from albbck to seaice_albedo_default. +! Laura D. Fowler (laura@ucar.edu) / 2022-05-10. +! * added the local parameters flag_bep and idiff in the call to subroutine ysu to update the YSU PBL scheme to +! that of WRF version 4.4.1. +! * added local flags and variables needed to initialize and run the revised version of the MONIN-OBUKHOV surface +! layer scheme from the WRF version 4.4.1. +! Laura D. Fowler (laura@ucar.edu) / 2023-05-15. +! * added the local variables swddir,swddni,and swddif which are output to subroutine rrtmg_swrad and now input +! to the updated module_sf_noahdrv.F. +! Laura D. Fowler (laura@ucar.edu) / 2023-04-21. +! * removed the variable f_qv which is not used in any of the ./physics_wrf modules. +! Laura D. Fowler (laura@ucar.edu) / 2024-02-13. +! * removed the definition of f_qc,f_qr,f_qi,f_qs,f_qg,f_nc,and f_ni as parameters. these variables are now +! initialized in mpas_atmphys_init.F (see subroutine init_physics_flags). also renamed f_qnc to f_nc, and f_qni +! to f_ni. +! Laura D. Fowler (laura@ucar.edu) / 2024-02-14. +! * added the variable spp_pbl needed in the updated version of the MYNN surface layer scheme. +! Laura D. Fowler (laura@ucar.edu) / 2024-02-14. +! * added and modified variables needed to run the MYNN PBL scheme using the sourcecode from WRF version 4.6. +! Laura D. Fowler (laura@ucar.edu) / 2024-02-18. + + +!================================================================================================================= +!wrf-variables:these variables are needed to keep calls to different physics parameterizations +!as in wrf model. +!================================================================================================================= + + logical:: l_radtlw !controls call to longwave radiation parameterization. + logical:: l_radtsw !controls call to shortwave radiation parameterization. + logical:: l_conv !controls call to convective parameterization. + logical:: l_camlw !controls when to save local CAM LW abs and ems arrays. + logical:: l_diags !controls when to calculate physics diagnostics. + logical:: l_acrain !when .true., limit to accumulated rain is applied. + logical:: l_acradt !when .true., limit to lw and sw radiation is applied. + logical:: l_mp_tables !when .true., read look-up tables for Thompson cloud microphysics scheme. + + integer,public:: ids,ide,jds,jde,kds,kde + integer,public:: ims,ime,jms,jme,kms,kme + integer,public:: its,ite,jts,jte,kts,kte + integer,public:: iall + integer,public:: n_microp + + integer,public:: num_months !number of months [-] + + real(kind=RKIND),public:: dt_dyn !time-step for dynamics + real(kind=RKIND),public:: dt_microp !time-step for cloud microphysics parameterization. + real(kind=RKIND),public:: dt_radtlw !time-step for longwave radiation parameterization [mns] + real(kind=RKIND),public:: dt_radtsw !time-step for shortwave radiation parameterization [mns] + + real(kind=RKIND),public:: xice_threshold + + real(kind=RKIND),dimension(:,:),allocatable:: & + area_p !grid cell area [m2] + +!... arrays related to surface: + real(kind=RKIND),dimension(:,:),allocatable:: & + ht_p, &! + psfc_p, &!surface pressure [Pa] + ptop_p !model-top pressure [Pa] + + real(kind=RKIND),dimension(:,:,:),allocatable:: & + fzm_p, &!weight for interpolation to w points [-] + fzp_p !weight for interpolation to w points [-] + + real(kind=RKIND),dimension(:,:,:),allocatable:: & +!... arrays related to u- and v-velocities interpolated to theta points: + u_p, &!u-velocity interpolated to theta points [m/s] + v_p !v-velocity interpolated to theta points [m/s] + +!... arrays related to vertical sounding: + real(kind=RKIND),dimension(:,:,:),allocatable:: & + zz_p, &! + pres_p, &!pressure [Pa] + pi_p, &!(p_phy/p0)**(r_d/cp) [-] + z_p, &!height of layer [m] + zmid_p, &!height of middle of layer [m] + dz_p, &!layer thickness [m] + t_p, &!temperature [K] + th_p, &!potential temperature [K] + al_p, &!inverse of air density [m3/kg] + rho_p, &!air density [kg/m3] + rh_p !relative humidity [-] + + real(kind=RKIND),dimension(:,:,:),allocatable:: & + qv_p, &!water vapor mixing ratio [kg/kg] + qc_p, &!cloud water mixing ratio [kg/kg] + qr_p, &!rain mixing ratio [kg/kg] + qi_p, &!cloud ice mixing ratio [kg/kg] + qs_p, &!snow mixing ratio [kg/kg] + qg_p !graupel mixing ratio [kg/kg] + + real(kind=RKIND),dimension(:,:,:),allocatable:: & + nc_p, &!cloud water droplet number concentration [#/kg] + ni_p, &!cloud ice crystal number concentration [#/kg] + nr_p !rain drop number concentration [#/kg] + +!... arrays located at w (vertical velocity) points, or at interface between layers: + real(kind=RKIND),dimension(:,:,:),allocatable:: & + w_p, &!vertical velocity [m/s] + pres2_p, &!pressure [Pa] + t2_p !temperature [K] + +!... arrays used for calculating the hydrostatic pressure and exner function: + real(kind=RKIND),dimension(:,:),allocatable:: & + psfc_hyd_p, &!surface pressure [Pa] + psfc_hydd_p !"dry" surface pressure [Pa] + real(kind=RKIND),dimension(:,:,:),allocatable:: & + pres_hyd_p, &!pressure located at theta levels [Pa] + pres_hydd_p, &!"dry" pressure located at theta levels [Pa] + pres2_hyd_p, &!pressure located at w-velocity levels [Pa] + pres2_hydd_p, &!"dry" pressure located at w-velocity levels [Pa] + znu_hyd_p !(pres_hyd_p / P0) needed in the Tiedtke convection scheme [Pa] + +!================================================================================================================= +!... variables related to ozone climatlogy: +!================================================================================================================= + + real(kind=RKIND),dimension(:,:,:),allocatable:: & + o3clim_p !climatological ozone volume mixing ratio [???] + +!================================================================================================================= +!... variables and arrays related to parameterization of cloud microphysics: +! warm_phase: logical that determines if we want to run warm-phase cloud microphysics only. +! If set to false, cold-phase cloud microphysics is active. In MPAS, we always assume +! that the ice phase is included (except for the Kessler scheme which includes water +! clouds only. + +!================================================================================================================= + + logical,parameter:: & + warm_rain = .false.!warm-phase cloud microphysics only (used in WRF). + + logical:: & + f_qc, &!parameter set to true to include the cloud water mixing ratio. + f_qr, &!parameter set to true to include the rain mixing ratio. + f_qi, &!parameter set to true to include the cloud ice mixing ratio. + f_qs, &!parameter set to true to include the snow mixing ratio. + f_qg, &!parameter set to true to include the graupel mixing ratio. + f_qoz !parameter set to true to include the ozone mixing ratio. + + logical:: & + f_nc, &!parameter set to true to include the cloud water number concentration. + f_ni, &!parameter set to true to include the cloud ice number concentration. + f_nifa, &!parameter set to true to include the number concentration of hygroscopic aerosols. + f_nwfa, &!parameter set to true to include the number concentration of hydrophobic aerosols. + f_nbca !parameter set to true to include the number concentration of black carbon. + + real(kind=RKIND),dimension(:,:,:),allocatable:: & + f_ice, &!fraction of cloud ice (used in WRF only). + f_rain !fraction of rain (used in WRF only). + + real(kind=RKIND),dimension(:,:),allocatable:: & + rainnc_p, &! + rainncv_p, &! + snownc_p, &! + snowncv_p, &! + graupelnc_p, &! + graupelncv_p, &! + sr_p + + integer:: & + has_reqc, &! + has_reqi, &! + has_reqs + + real(kind=RKIND),dimension(:,:,:),allocatable:: & + rainprod_p, &! + evapprod_p, &! + recloud_p, &! + reice_p, &! + resnow_p ! + +!... for Thompson cloud microphysics parameterization, including aerosol-aware option: + real(kind=RKIND),dimension(:,:),allocatable:: & + ntc_p, &! + muc_p, &! + nifa2d_p, &!surface emission of "ice-friendly" aerosols [#/kg-1/s] + nwfa2d_p !surface emission of "water-friendly" aerosols [#/kg-1/s] + + real(kind=RKIND),dimension(:,:,:),allocatable:: & + nifa_p, &!"ice-friendly" number concentration [#/kg] + nwfa_p !"water-friendly" number concentration [#/kg] + +!================================================================================================================= +!... variables and arrays related to parameterization of convection: +!================================================================================================================= + integer,public:: n_cu + real(kind=RKIND),public:: dt_cu + + logical,dimension(:,:),allocatable:: & + cu_act_flag + real(kind=RKIND),dimension(:,:),allocatable:: & + rainc_p, &! + raincv_p, &! + pratec_p ! + + real(kind=RKIND),dimension(:,:,:),allocatable:: & + rthcuten_p, &! + rqvcuten_p, &! + rqccuten_p, &! + rqicuten_p ! + +!... kain fritsch specific arrays: + real(kind=RKIND),dimension(:,:),allocatable:: & + cubot_p, &!lowest convective level [-] + cutop_p, &!highest convective level [-] + nca_p !counter for cloud relaxation time [-] + real(kind=RKIND),dimension(:,:,:),allocatable:: & + w0avg_p ! + + real(kind=RKIND),dimension(:,:,:),allocatable:: & + rqrcuten_p, &! + rqscuten_p ! + +!... tiedtke specific arrays: + real(kind=RKIND),dimension(:,:,:),allocatable:: & + znu_p ! + + real(kind=RKIND),dimension(:,:,:),allocatable:: & + rucuten_p, &! + rvcuten_p ! + +!... grell-freitas specific parameters and arrays: + integer, parameter:: ishallow = 1 !shallow convection used with grell scheme. + + integer,dimension(:,:),allocatable:: & + k22_shallow_p, &! + kbcon_shallow_p, &! + ktop_shallow_p, &! + kbot_shallow_p, &! + ktop_deep_p ! + + real(kind=RKIND),dimension(:,:),allocatable:: & + xmb_total_p, &! + xmb_shallow_p ! + + real(kind=RKIND),dimension(:,:,:),allocatable:: & + rthdynten_p, &! + qccu_p, &! + qicu_p ! + + real(kind=RKIND),dimension(:,:,:),allocatable:: & + rthraten_p ! + +!... grell and tiedkte specific arrays: + real(kind=RKIND),dimension(:,:,:),allocatable:: & + rqvdynten_p, &! + rqvdynblten_p, &! + rthdynblten_p ! + +!... ntiedtke specific arrays: + real(kind=RKIND),dimension(:,:,:),allocatable:: & + rqvften_p, &! + rthften_p ! + +!================================================================================================================= +!... variables and arrays related to parameterization of pbl: +!================================================================================================================= + + logical,parameter:: & + flag_bep = .false. !flag to use BEP/BEP+BEM for use in the YSU PBL scheme (with urban physics). since we do + !not run urban physics, flag_bep is always set to false. + + integer,parameter:: & + idiff = 0 !BEP/BEM+BEM diffusion flag for use in the YSU PBL scheme (with urban physics). since we + !do not run urban physics, idiff is set to zero. + + integer:: ysu_pblmix + + integer,dimension(:,:),allocatable:: & + kpbl_p !index of PBL top [-] + + real(kind=RKIND),public:: dt_pbl + + real(kind=RKIND),dimension(:,:),allocatable:: & + ctopo_p, &!correction to topography [-] + ctopo2_p, &!correction to topography 2 [-] + hpbl_p, &!PBL height [m] + delta_p, &! + wstar_p, &! + uoce_p, &! + voce_p ! + + real(kind=RKIND),dimension(:,:,:),allocatable:: & + exch_p !exchange coefficient [-] + + real(kind=RKIND),dimension(:,:,:),allocatable:: & + rublten_p, &!tendency of zonal wind due to PBL processes. + rvblten_p, &!tendency of meridional wind due to PBL processes. + rthblten_p, &!tendency of potential temperature due to PBL processes. + rqvblten_p, &!tendency of water vapor mixing ratio due to PBL processes. + rqcblten_p, &!tendency of cloud water mixing ratio due to PBL processes. + rqiblten_p !tendency of cloud ice mixing ratio due to PBL processes. + + real(kind=RKIND),dimension(:,:,:),allocatable:: & + kzh_p, &! + kzm_p, &! + kzq_p ! + +!... MYNN PBL scheme (module_bl_mynn.F): + integer,parameter:: spp_pbl = 0 !generate array with random perturbations (0=off,1=on). + integer,parameter:: icloud_bl = 0 !no coupling of subgrid-scale clouds with radiation. + + integer,dimension(:,:),allocatable:: & + kbl_plume_p !level of highest penetrating plume. + + real(kind=RKIND),dimension(:,:),allocatable:: & + maxwidthbl_p, &!max plume width [m] + maxmfbl_p, &!maximum mass flux for PBL shallow convection. + zbl_plume_p !height of highest penetrating plume [m] + + real(kind=RKIND),dimension(:,:,:),allocatable:: & + dqke_p, &! + qbuoy_p, &! + qdiss_p, &! + qke_p, &! + qkeadv_p, &! + qshear_p, &! + qwt_p, &! + tkepbl_p ! + + real(kind=RKIND),dimension(:,:,:),allocatable:: & + edmfa_p, &! + edmfw_p, &! + edmfqt_p, &! + edmfthl_p, &! + edmfent_p, &! + edmfqc_p, &! + subthl_p, &! + subqv_p, &! + detthl_p, &! + detqv_p, &! + qcbl_p, &! + qibl_p, &! + cldfrabl_p ! + + real(kind=RKIND),dimension(:,:,:),allocatable:: & + rqsblten_p, &!tendency of snow mixing ratio due to PBL processes. + rncblten_p, &!tendency of cloud liquid water number concentration due to PBL processes. + rniblten_p, &!tendency of cloud ice number concentration due to PBL processes. + rnifablten_p, &!tendency of ice-friendly aerosol number concentration due to PBL processes. + rnwfablten_p !tendency of water-friendly aerosol number concentration due to PBL processes. + + real(kind=RKIND),dimension(:,:,:),allocatable:: & + pattern_spp_pbl !stochastic forcing for the MYMM PBL and surface layer schemes. + +!================================================================================================================= +!... variables and arrays related to parameterization of gravity wave drag over orography: +!================================================================================================================= + + real(kind=RKIND),dimension(:,:),allocatable:: & + cosa_p, &!cosine of map rotation [-] + sina_p !sine of map rotation [-] + + real(kind=RKIND),dimension(:,:),allocatable:: & + var2d_p, &!orographic variance [m2] + con_p, &!orographic convexity [m2] + oa1_p, &!orographic direction asymmetry function [-] + oa2_p, &!orographic direction asymmetry function [-] + oa3_p, &!orographic direction asymmetry function [-] + oa4_p, &!orographic direction asymmetry function [-] + ol1_p, &!orographic direction asymmetry function [-] + ol2_p, &!orographic direction asymmetry function [-] + ol3_p, &!orographic direction asymmetry function [-] + ol4_p !orographic direction asymmetry function [-] + + real(kind=RKIND),dimension(:,:),allocatable:: & + dx_p !mean distance between cell centers [m] + + real(kind=RKIND),dimension(:,:),allocatable:: & + dusfcg_p, &!vertically-integrated gwdo u-stress [Pa m s-1] + dvsfcg_p !vertically-integrated gwdo v -stress [Pa m s-1] + + real(kind=RKIND),dimension(:,:,:),allocatable:: & + dtaux3d_p, &!gravity wave drag over orography u-stress [m s-1] + dtauy3d_p !gravity wave drag over orography u-stress [m s-1] + +!... variables for UGWP orographic gravity wave drag: + + real(kind=RKIND),dimension(:,:),allocatable:: & + var2dls_p, &!orographic variance (meso-scale orographic variation) [m] + conls_p, &!orographic convexity (meso-scale orographic variation) [-] + oa1ls_p, &!orographic direction asymmetry function (meso-scale orographic variation) [-] + oa2ls_p, &!orographic direction asymmetry function (meso-scale orographic variation) [-] + oa3ls_p, &!orographic direction asymmetry function (meso-scale orographic variation) [-] + oa4ls_p, &!orographic direction asymmetry function (meso-scale orographic variation) [-] + ol1ls_p, &!orographic direction asymmetry function (meso-scale orographic variation) [-] + ol2ls_p, &!orographic direction asymmetry function (meso-scale orographic variation) [-] + ol3ls_p, &!orographic direction asymmetry function (meso-scale orographic variation) [-] + ol4ls_p, &!orographic direction asymmetry function (meso-scale orographic variation) [-] + var2dss_p, &!orographic variance (small-scale orographic variation) [m] + conss_p, &!orographic convexity (small-scale orographic variation) [-] + oa1ss_p, &!orographic direction asymmetry function (small-scale orographic variation) [-] + oa2ss_p, &!orographic direction asymmetry function (small-scale orographic variation) [-] + oa3ss_p, &!orographic direction asymmetry function (small-scale orographic variation) [-] + oa4ss_p, &!orographic direction asymmetry function (small-scale orographic variation) [-] + ol1ss_p, &!orographic direction asymmetry function (small-scale orographic variation) [-] + ol2ss_p, &!orographic direction asymmetry function (small-scale orographic variation) [-] + ol3ss_p, &!orographic direction asymmetry function (small-scale orographic variation) [-] + ol4ss_p !orographic direction asymmetry function (small-scale orographic variation) [-] + + real(kind=RKIND),dimension(:,:),allocatable:: & + dusfc_ls_p, &!vertically-integrated mesoscale orog gravity wave drag u-stress [Pa] + dvsfc_ls_p, &!vertically-integrated mesoscale orog gravity wave drag v-stress [Pa] + dusfc_bl_p, &!vertically-integrated orog blocking drag u-stress [Pa] + dvsfc_bl_p, &!vertically-integrated orog blocking drag v-stress [Pa] + dusfc_ss_p, &!vertically-integrated small-scale orog gravity wave drag u-stres [Pa] + dvsfc_ss_p, &!vertically-integrated small-scale orog gravity wave drag v-stres [Pa] + dusfc_fd_p, &!vertically-integrated turb orog form drag u-stress [Pa] + dvsfc_fd_p !vertically-integrated turb orog form drag v-stress [Pa] + + real(kind=RKIND),dimension(:,:,:),allocatable:: & + dtaux3d_ls_p, &!mesoscale orog gravity wave drag u-tendency [m s-2] + dtauy3d_ls_p, &!mesoscale orog gravity wave drag v-tendency [m s-2] + dtaux3d_bl_p, &!orog blocking drag u-tendency u-tendency [m s-2] + dtauy3d_bl_p, &!orog blocking drag u-tendency v-tendency [m s-2] + dtaux3d_ss_p, &!small-scale orog gravity wave drag u-tendency [m s-2] + dtauy3d_ss_p, &!small-scale orog gravity wave drag v-tendency [m s-2] + dtaux3d_fd_p, &!turb orog form drag u-tendency [m s-2] + dtauy3d_fd_p !turb orog form drag u-tendency [m s-2] + +!... variables for UGWP non-stationary gravity wave (NGW) drag: + + integer,dimension(:,:),allocatable:: & + jindx1_tau_p, &!lower latitude index of NGW momentum flux for interpolation [-] + jindx2_tau_p !upper latitude index of NGW momentum flux for interpolation [-] + + real(kind=RKIND),dimension(:,:),allocatable:: & + ddy_j1tau_p, &!latitude interpolation weight complement for NGW momentum flux [-] + ddy_j2tau_p !latitude interpolation weight for NGW momentum flux [-] + + real(kind=RKIND),dimension(:,:,:),allocatable:: & + dudt_ngw_p, &!u-momentum tendency due to non-stationary gravity wave drag [m s-2] + dvdt_ngw_p, &!v-momentum tendency due to non-stationary gravity wave drag [m s-2] + dtdt_ngw_p !temperature tendency due to non-stationary gravity wave drag [K s-1] + +!================================================================================================================= +!... variables and arrays related to parameterization of surface layer: +!================================================================================================================= + + real(kind=RKIND),dimension(:,:),allocatable:: & + br_p, &!bulk richardson number [-] + cd_p, &!momentum exchange coeff at 10 meters [?] + cda_p, &!momentum exchange coeff at the lowest model level [?] + cpm_p, &! + chs_p, &! + chs2_p, &! + ck_p, &!enthalpy exchange coeff at 10 meters [?] + cka_p, &!enthalpy exchange coeff at the lowest model level [?] + cqs2_p, &! + gz1oz0_p, &!log of z1 over z0 [-] + flhc_p, &!exchange coefficient for heat [-] + flqc_p, &!exchange coefficient for moisture [-] + hfx_p, &!upward heat flux at the surface [W/m2] + lh_p, &!latent heat flux at the surface [W/m2] + mavail_p, &!surface moisture availability [-] + mol_p, &!T* in similarity theory [K] + pblh_p, &!PBL height [m] + psih_p, &!similarity theory for heat [-] + psim_p, &!similarity theory for momentum [-] + q2_p, &!specific humidity at 2m [kg/kg] + qfx_p, &!upward moisture flux at the surface [kg/m2/s] + qgh_p, &! + qsfc_p, &!specific humidity at lower boundary [kg/kg] + regime_p, &!flag indicating PBL regime (stable_p,unstable_p,etc...) [-] + rmol_p, &!1 / Monin Ob length [-] + t2m_p, &!temperature at 2m [K] + th2m_p, &!potential temperature at 2m [K] + u10_p, &!u at 10 m [m/s] + ust_p, &!u* in similarity theory [m/s] + ustm_p, &!u* in similarity theory without vconv correction [m/s] + v10_p, &!v at 10 m [m/s] + wspd_p, &!wind speed [m/s] + znt_p, &!time-varying roughness length [m] + zol_p ! + +!... arrays only in monin_obukohv (module_sf_sfclay.F): + real(kind=RKIND),dimension(:,:),allocatable:: & + fh_p, &!integrated stability function for heat [-] + fm_p !integrated stability function for momentum [-] + +!... variables and arrays only in the revised version of monin_obukhov (module_sf_sfclayrev.F) to include the +! shallow water roughness scheme: + integer,parameter:: & + bathymetry_flag = 0!this flag is set to 1 if input bathymetry data is available (this option is not available + !in MPAS and therefore set to 0 by default. + integer,parameter:: & + shalwater_flag = 0!this flag is set to 1 to run the shallow water roughness scheme (this option is not + !available in MPAS and therefore set to 0 by default. + integer,parameter:: & + lakemodel_flag = 0!this flag is set to 1 to run the lake model physics (this option is not available in MPAS + !and therefore set to 0 by default. + + real(kind=RKIND),parameter:: & + shalwater_depth = 0!constant shallow water depth needed to run the shallow water roughness scheme. + + real(kind=RKIND),dimension(:,:),allocatable:: & + waterdepth_p, &!depth of water needed to run the shallow water roughness scheme. + lakedepth_p, &!depth of lakes needed to run the lake model physics. + lakemask_p !mask needed to detect the location of lakes to run the lake model physics. + +!... arrays only in mynn surface layer scheme (module_sf_mynn.F): + real(kind=RKIND),dimension(:,:),allocatable:: & + ch_p, &!surface exchange coeff for heat [m/s] + qcg_p !cloud water mixing ratio at the ground surface [kg/kg] + + real(kind=RKIND),dimension(:,:,:),allocatable:: & + cov_p, &!liquid water-liquid water potential temperature covariance [K kg/kg] + qsq_p, &!liquid water variance [(kg/kg)^2] + tsq_p, &!liquid water potential temperature variance [K^2] + sh3d_p, &!stability function for heat [-] + sm3d_p, &!stability function for moisture [-] + elpbl_p !length scale from PBL [m] + +!================================================================================================================= +!... variables and arrays related to parameterization of seaice: +!... the options set for seaice_albedo_opt, seaice_thickness_opt, and seaicesnowdepth_opt must not be changed +! since they are the only ones currently available. +!================================================================================================================= + + integer,parameter:: & + seaice_albedo_opt = 0 !option to set albedo over sea ice. + !0 = seaice albedo is constant set in seaice_albedo_default. + !1 = seaice albedo is f(Tair,Tskin,Tsnow), following Mill (2011). + !2 = seaice albedo is read in from input variable albsi. + integer,parameter:: & + seaice_thickness_opt = 0 !option for treating seaice thickness. + !0 = seaice thickness is constant set in seaice_thickness_default. + !1 = seaice_thickness is read in from input variable icedepth. + integer,parameter:: & + seaice_snowdepth_opt = 0 !option for treating snow depth on sea ice. + !0=snow depth is bounded by seaice_snowdepth_min and seaice_snowdepth_max. + + real(kind=RKIND),parameter:: & + seaice_albedo_default = 0.65 ,&!default value of seaice albedo for seaice_albedo_opt=0. + seaice_thickness_default = 3.0, &!default value of seaice thickness for seaice_thickness_opt=0 + seaice_snowdepth_max = 1.e10,&!maximum allowed accumulation of snow (m) on sea ice. + seaice_snowdepth_min = 0.001 !minimum snow depth (m) on sea ice. + + real(kind=RKIND),dimension(:,:),allocatable:: & + albsi_p, &!surface albedo over seaice [-] + snowsi_p, &!snow depth over seaice [m] + icedepth_p !seaice thickness [m] + +!================================================================================================================= +!... variables and arrays related to the calculation of the optical properties of aerosols: to date, the only kind +! of aerosols included in MPAS are the "water-friendly" and "ice-friendly" aerosols used in the Thompson cloud +! cloud microphysics scheme. +!================================================================================================================= + + integer,parameter:: taer_aod550_opt = 2!input option for nwfa, nifa optical depth at 500 nm. + integer,parameter:: taer_angexp_opt = 3!input option for nwfa, nifa aerosol Angstrom exponent. + integer,parameter:: taer_ssa_opt = 3!input option for nwfa, nifa aerosol single-scattering albedo. + integer,parameter:: taer_asy_opt = 3!input option for nwfa, nifa aerosol asymmetry factor. + + integer:: aer_opt !=[0,3] : 0 for no aerosols, 3 for "water-" and "ice-friendly" aerosols. + integer,dimension(:,:),allocatable:: & + taer_type_p !=[1,2,3]: 1 for rural, 2 is urban and 3 is maritime in WRF. In MPAS, + !aer_type is initialized as a function of landmask (=1 over land; =2 over + !oceans. + + real(kind=RKIND),parameter:: aer_aod550_val = 0.12 + real(kind=RKIND),parameter:: aer_angexp_val = 1.3 + real(kind=RKIND),parameter:: aer_ssa_val = 0.85 + real(kind=RKIND),parameter:: aer_asy_val = 0.9 + + real(kind=RKIND),dimension(:,:),allocatable :: taod5502d_p!total aerosol optical depth at 550 nm [-] + real(kind=RKIND),dimension(:,:,:),allocatable:: taod5503d_p!aerosol optical depth at 550 nm [-] + + real(kind=RKIND),dimension(:,:,:,:),allocatable:: tauaer_p !aerosol optical depth in RRTMG SW [-] + real(kind=RKIND),dimension(:,:,:,:),allocatable:: ssaaer_p !aerosol single scatterin albedo in RRTMG SW [-] + real(kind=RKIND),dimension(:,:,:,:),allocatable:: asyaer_p !aerosol asymmetry factor in RRTMG SW [-] + +!================================================================================================================= +!... variables and arrays related to parameterization of short-wave radiation: +!================================================================================================================= + + real(kind=RKIND):: & + declin, &!solar declination [-] + solcon !solar constant [W m-2] + + real(kind=RKIND),dimension(:,:),allocatable:: & + coszr_p, &!cosine of the solar zenith angle [-] + gsw_p, &!net shortwave flux at surface [W m-2] + swcf_p, &!shortwave cloud forcing at top-of-atmosphere [W m-2] + swdnb_p, &!all-sky downwelling shortwave flux at bottom-of-atmosphere [J m-2] + swdnbc_p, &!clear-sky downwelling shortwave flux at bottom-of-atmosphere [J m-2] + swdnt_p, &!all-sky downwelling shortwave flux at top-of-atmosphere [J m-2] + swdntc_p, &!clear-sky downwelling shortwave flux at top-of-atmosphere [J m-2] + swupb_p, &!all-sky upwelling shortwave flux at bottom-of-atmosphere [J m-2] + swupbc_p, &!clear-sky upwelling shortwave flux at bottom-of-atmosphere [J m-2] + swupt_p, &!all-sky upwelling shortwave flux at top-of-atmosphere [J m-2] + swuptc_p !clear-sky upwelling shortwave flux at top-of-atmosphere [J m-2] + + real(kind=RKIND),dimension(:,:),allocatable:: & + swvisdir_p, &!visible direct downward flux [W m-2] + swvisdif_p, &!visible diffuse downward flux [W m-2] + swnirdir_p, &!near-IR direct downward flux [W m-2] + swnirdif_p !near-IR diffuse downward flux [W m-2] + + real(kind=RKIND),dimension(:,:),allocatable:: & + swddir_p, &! + swddni_p, &! + swddif_p ! + + real(kind=RKIND),dimension(:,:,:),allocatable:: & + swdnflx_p, &! + swdnflxc_p, &! + swupflx_p, &! + swupflxc_p ! + + real(kind=RKIND),dimension(:,:,:),allocatable:: & + rthratensw_p !uncoupled theta tendency due to shortwave radiation [K s-1] + +!================================================================================================================= +!... variables and arrays related to parameterization of long-wave radiation: +!================================================================================================================= + + integer,dimension(:,:),allocatable:: & + nlrad_p !number of layers added above the model top [-] + real(kind=RKIND),dimension(:,:),allocatable:: & + plrad_p !pressure at model_top [Pa] + + real(kind=RKIND),dimension(:,:),allocatable:: & + glw_p, &!net longwave flux at surface [W m-2] + lwcf_p, &!longwave cloud forcing at top-of-atmosphere [W m-2] + lwdnb_p, &!all-sky downwelling longwave flux at bottom-of-atmosphere [J m-2] + lwdnbc_p, &!clear-sky downwelling longwave flux at bottom-of-atmosphere [J m-2] + lwdnt_p, &!all-sky downwelling longwave flux at top-of-atmosphere [J m-2] + lwdntc_p, &!clear-sky downwelling longwave flux at top-of-atmosphere [J m-2] + lwupb_p, &!all-sky upwelling longwave flux at bottom-of-atmosphere [J m-2] + lwupbc_p, &!clear-sky upwelling longwave flux at bottom-of-atmosphere [J m-2] + lwupt_p, &!all-sky upwelling longwave flux at top-of-atmosphere [J m-2] + lwuptc_p, &!clear-sky upwelling longwave flux at top-of-atmosphere [J m-2] + olrtoa_p !outgoing longwave radiation at top-of-the-atmosphere [W m-2] + + real(kind=RKIND),dimension(:,:,:),allocatable:: & + lwdnflx_p, &! + lwdnflxc_p, &! + lwupflx_p, &! + lwupflxc_p ! + + real(kind=RKIND),dimension(:,:,:),allocatable:: & + rthratenlw_p, &!uncoupled theta tendency due to longwave radiation [K s-1] + rrecloud_p, &!effective radius for cloud water calculated in rrtmg_lwrad [mu] + rreice_p, &!effective radius for cloud ice calculated in rrmtg_lwrad [mu] + rresnow_p !effective radius for snow calculated in rrtmg_lwrad [mu] + +!================================================================================================================= +!... variables and arrays related to parameterization of long- and short-wave radiation needed +! only by the "CAM" radiation codes: +!================================================================================================================= + + logical:: doabsems + + integer:: cam_abs_dim1 + integer:: cam_abs_dim2 + integer:: num_moist + integer:: num_aerosols + integer:: num_aerlevels + integer:: num_oznlevels + + real(kind=RKIND),dimension(:),allocatable:: & + pin_p, &!pressure levels for ozone concentration [Pa] + m_hybi_p !hybrid levels for aerosols [-] + + real(kind=RKIND),dimension(:,:),allocatable:: & + m_psn_p, &! + m_psp_p ! + + real(kind=RKIND),dimension(:,:,:,:),allocatable:: & + aerosolcn_p, &! + aerosolcp_p ! + + real(kind=RKIND),dimension(:,:,:),allocatable:: & + emstot_p, &!total emissivity [-] + cemiss_p, &!cloud emissivity for ISCCP [-] + taucldc_p, &!cloud water optical depth for ISCCP [-] + taucldi_p !cloud ice optical depth for ISCCP [-] + + real(kind=RKIND),dimension(:,:,:,:),allocatable:: & + abstot_p, &!total layer absorptivity [-] + absnxt_p, &!total nearest layer absorptivity [-] + ozmixm_p !ozone mixing ratio. + +!================================================================================================================= +!.. variables and arrays related to cloudiness: +!================================================================================================================= + + integer,parameter:: & + icloud= 1 !used in WRF only. + + real(kind=RKIND),dimension(:,:,:),allocatable:: & + cldfrac_p, &!cloud fraction [-] + qvrad_p, &!water vapor mixing ratio local to cloudiness and radiation [kg/kg] + qcrad_p, &!cloud liquid water mixing ratio local to cloudiness and radiation [kg/kg] + qirad_p, &!cloud ice mixing ratio local to cloudiness and radiation [kg/kg] + qsrad_p !snow mixing ratio local to cloudiness and radiation [kg/kg] + +!================================================================================================================= +!.. variables and arrays related to land-surface parameterization: +!================================================================================================================= + + logical,parameter:: & + ua_phys = .false. !option to activate UA Noah changes: a different snow-cover physics in the land-surface + !scheme. That option is not currently implemented in MPAS. + + integer,parameter:: & + opt_thcnd = 1 !option to treat thermal conductivity in NoahLSM (new option implemented in WRF 3.8.0). + != 1, original (default). + != 2, McCumber and Pielke for silt loam and sandy loam. + + integer,parameter:: & + fasdas = 0 !for WRF surface data assimilation system (not used in MPAS). + + integer,parameter:: & + nurb = 1 !generic dimension for all dimensions needed to run the urban physics. + + integer,public:: & + sf_surface_physics !used to define the land surface scheme by a number instead of name. It + !is only needed in module_ra_rrtmg_sw.F to define the spectral surface + !albedos as functions of the land surface scheme. + + integer,public:: & + num_soils !number of soil layers [-] + + integer,dimension(:,:),allocatable:: & + isltyp_p, &!dominant soil type category [-] + ivgtyp_p !dominant vegetation category [-] + + real(kind=RKIND),dimension(:),allocatable:: & + dzs_p !thickness of soil layers [m] + real(kind=RKIND),dimension(:,:,:),allocatable:: & + smcrel_p, &!soil moisture threshold below which transpiration starts to stress [-] + sh2o_p, &!unfrozen soil moisture content [volumetric fraction] + smois_p, &!soil moisture [volumetric fraction] + tslb_p !soil temperature [K] + + real(kind=RKIND),dimension(:,:),allocatable:: & + acsnom_p, &!accumulated melted snow [kg m-2] + acsnow_p, &!accumulated snow [kg m-2] + canwat_p, &!canopy water [kg m-2] + chklowq_p, &!surface saturation flag [-] + grdflx_p, &!ground heat flux [W m-2] + lai_p, &!leaf area index [-] + noahres_p, &!residual of the noah land-surface scheme energy budget [W m-2] + potevp_p, &!potential evaporation [W m-2] + qz0_p, &!specific humidity at znt [kg kg-1] + rainbl_p, &! + sfcrunoff_p, &!surface runoff [m s-1] + shdmin_p, &!minimum areal fractional coverage of annual green vegetation [-] + shdmax_p, &!maximum areal fractional coverage of annual green vegetation [-] + smstav_p, &!moisture availability [-] + smstot_p, &!total moisture [m3 m-3] + snopcx_p, &!snow phase change heat flux [W m-2] + snotime_p, &! + snowc_p, &!snow water equivalent [kg m-2] + snowh_p, &!physical snow depth [m] + swdown_p, &!downward shortwave flux at the surface [W m-2] + udrunoff_p, &!sub-surface runoff [m s-1] + tmn_p, &!soil temperature at lower boundary [K] + vegfra_p, &!vegetation fraction [-] + z0_p !background roughness length [m] + + real(kind=RKIND),dimension(:,:),allocatable:: & + alswvisdir_p, &!direct-beam surface albedo in visible spectrum [-] + alswvisdif_p, &!diffuse-beam surface albedo in visible spectrum [-] + alswnirdir_p, &!direct-beam surface albedo in near-IR spectrum [-] + alswnirdif_p !diffuse-beam surface albedo in near-IR spectrum [-] + +!.. arrays needed to run UA Noah changes (different snow-cover physics): + real(kind=RKIND),dimension(:,:),allocatable:: & + flxsnow_p, &!energy added to sensible heat flux when ua_phys=true [W m-2] + fvbsnow_p, &!fraction of vegetation with snow beneath when ua_phys=true [-] + fbursnow_p, &!fraction of canopy buried when ua_phys=true [-] + fgsnsnow_p !fraction of ground snow cover when ua_phys=true [-] + +!.. arrays needed in the argument list in the call to the Noah LSM urban parameterization: note that these arrays +!.. are initialized to zero since we do not run an urban model: + integer,dimension(:,:),allocatable:: & + utype_urb_p !urban type [-] + + real(kind=RKIND),dimension(:,:),allocatable:: & + frc_urb_p, &!urban fraction [-] + ust_urb_p !urban u* in similarity theory [m/s] + +!================================================================================================================= +!.. variables and arrays related to the Noahmp land-surface parameterization: +!================================================================================================================= + + type(NoahmpIO_type):: mpas_noahmp + +!================================================================================================================= +!.. variables and arrays related to surface characteristics: +!================================================================================================================= + + real(kind=RKIND),dimension(:,:),allocatable:: & + xlat_p, &!longitude, west is negative [degrees] + xlon_p !latitude, south is negative [degrees] + + real(kind=RKIND),dimension(:,:),allocatable:: & + sfc_albedo_p, &!surface albedo [-] + sfc_albbck_p, &!surface background albedo [-] + sfc_emibck_p, &!land surface background emissivity [-] + sfc_emiss_p, &!land surface emissivity [-] + snoalb_p, &!annual max snow albedo [-] + snow_p, &!snow water equivalent [kg m-2] + tsk_p, &!surface-skin temperature [K] + sst_p, &!sea-surface temperature [K] + xice_p, &!ice mask [-] + xland_p !land mask (1 for land; 2 for water) [-] + +!================================================================================================================= +!.. variables needed for the surface layer scheme and land surface scheme when config_frac_seaice +! is set to true. the arrays below have the same definition as the corresponding "_p" arrays: +!================================================================================================================= + + real(kind=RKIND),dimension(:,:),allocatable:: br_sea,ch_sea,chs_sea,chs2_sea,cpm_sea,cqs2_sea, & + flhc_sea,flqc_sea,gz1oz0_sea,hfx_sea,lh_sea,mavail_sea,mol_sea, & + psih_sea,psim_sea,fh_sea,fm_sea,qfx_sea,qgh_sea,qsfc_sea,regime_sea, & + rmol_sea,ust_sea,wspd_sea,znt_sea,zol_sea,tsk_sea,xland_sea + real(kind=RKIND),dimension(:,:),allocatable:: t2m_sea,th2m_sea,q2_sea,u10_sea,v10_sea + real(kind=RKIND),dimension(:,:),allocatable:: cd_sea,cda_sea,ck_sea,cka_sea,ustm_sea + + real(kind=RKIND),dimension(:,:),allocatable:: regime_hold + real(kind=RKIND),dimension(:,:),allocatable:: tsk_ice + + + contains + + +!================================================================================================================= + subroutine atmphys_vars_init() +!================================================================================================================= +!dummy subroutine that does not do anything. + + end subroutine atmphys_vars_init + +!================================================================================================================= + end module mpas_atmphys_vars +!================================================================================================================= diff --git a/src/core_atmosphere/physics/mpas_atmphys_vars.F-org2 b/src/core_atmosphere/physics/mpas_atmphys_vars.F-org2 new file mode 100644 index 0000000000..084fc9f0e0 --- /dev/null +++ b/src/core_atmosphere/physics/mpas_atmphys_vars.F-org2 @@ -0,0 +1,959 @@ +! Copyright (c) 2013, Los Alamos National Security, LLC (LANS) +! and the University Corporation for Atmospheric Research (UCAR). +! +! Unless noted otherwise source code is licensed under the BSD license. +! Additional copyright and license information can be found in the LICENSE file +! distributed with this code, or at http://mpas-dev.github.com/license.html +! +!================================================================================================================= + module mpas_atmphys_vars + use mpas_kind_types + + use NoahmpIOVarType + + implicit none + public + save + + +!mpas_atmphys_vars contains all local variables and arrays used in the physics parameterizations. +!Laura D. Fowler (send comments to laura@ucar.edu). +!2013-05-01. +! +! add-ons and modifications: +! -------------------------- +! * added the variables sf_surface_physics,alswvisdir_p,alswvisdif_p,alswnirdir_p,alswnirdif_p,swvisdir_p, +! swvisdif_p,swnirdir_p,and swnirdif_p to upgrade the RRTMG short wave radiation code to WRF version 3.4.1. +! see definition of each individual variables below. +! Laura D. Fowler (laura@ucar.edu) / 2013-03-11. +! * removed call to the updated Kain-Fritsch convection scheme. +! Laura D. Fowler (laura@ucar.edu) / 2013-05-29. +! * added the arrays o3clim_p for implementation of monthly-varying climatological ozone in the +! long wave and short wave RRTMG radiation codes. +! Laura D. Fowler (laura@ucar.edu) / 2013-07-08. +! * corrected definition of local variable dx_p. +! Laura D. Fowler (laura@ucar.edu) / 2013-08-23. +! * renamed local variable conv_deep_scheme to convection_scheme. +! Laura D. Fowler (laura@ucar.edu) / 2014-09-18. +! * added empty subroutine atmphys_vars_init that does not do anything, but needed for +! compiling MPAS with some compilers. +! Laura D. Fowler (laura@ucar.edu) / 2015-01-12. +! * added local variables needed for the Thompson parameterization of cloud microphysics. +! Laura D. Fowler (laura@ucar.edu) / 2016-03-28. +! * added local variables needed for the Grell-Freitas parameterization of deep and shallow convection. +! * Laura D. Fowler (laura@ucar.edu) / 2016-03-30. +! * added local arrays needed in the MYNN surface layer scheme and PBL scheme. +! Laura D. Fowler (laura@ucar.edu) / 2016-03-31. +! * added the logical ua_phys needed in the call to subroutine sfcdiags. ua_phys is set to false. +! Laura D. Fowler (laura@ucar.edu) / 2016-05-13. +! * added the integers has_reqc,has_reqi,and has_reqs. when initialized to zero, the effective radii for cloud +! water,cloud ice,and snow are calculated using the subroutines relcalc and ricalc in subroutines rrtmg_lwrad +! and rrtmg_swrad. when initialized to 1, the effective radii are calculated in the Thompson cloud microphysics +! scheme instead. has_reqc,has_reqi,and has_reqs are initialized depending on the logical config_microp_re. +! Laura D. Fowler (laura@ucar.edu) / 2016-07-08. +! * added diagnostics of the effective radii for cloud water, cloud ice, and snow used in rrtmg_lwrad. +! Laura D. Fowler (laura@ucar.edu) / 2016-07-08. +! * added the variables qvrad_p,qcrad_p,qirad_p, and qsrad_p which are the water vapor,cloud water,cloud ice, +! and snow mixing ratios local to the calculation of the cloud fraction, and used in the radiation codes. +! Laura D. Fowler (laura@ucar.edu) / 2016-07-08. +! * added the variables rqvften and rthften which are the forcing tendencies needed to run the "new" Tiedtke +! parameterization of convection. +! Laura D. Fowler (laura@ucar.edu) / 2016-09-20. +! * added local "_sea" arrays that are needed in the surface layer scheme and land surface scheme for handling +! grid cells with fractional seaice when config_frac_seaice is set to true. also added local tsk_ice variable +! needed in the land surface scheme for handling grid cells with fractional seaice when config_frac_seaice is +! set to true. +! Laura D. Fowler (laura@ucar.edu) / 2016-10-03. +! * added local variable regime_hold to save the original value of variable regime over seaice grid cells when +! config_frac_seaice is set to true. +! Laura D. Fowler (laura@ucar.edu) / 2016-10-21. +! * moved the declarations of arrays delta_p,wstar_p,uoce_p,and voce_p since they are now used in both modules +! module_bl_ysu.F and module_bl_mynn.F. +! Laura D. Fowler (laura@ucar.edu) / 2016-10-27. +! * added the variable opt_thcnd (option to treat thermal conductivity in NoahLSM). added additional options and +! arrays to run the Noah LSM scheme from WRF version 3.9.0. +! Laura D. Fowler (laura@ucar.edu) / 2017-01-27. +! * removed the initialization local variable gwdo_scheme. gwdo_scheme is no longer needed and can be replaced +! with config_gwdo_scheme. +! Laura D. Fowler (laura@ucar.edu) / 2017-02-16. +! * removed the initialization local variable lsm_scheme. lsm_scheme is no longer needed and can be replaced +! with config_lsm_scheme. +! Laura D. Fowler (laura@ucar.edu) / 2017-02-16. +! * removed the initialization local variable sfclayer_scheme. sfclayer_scheme is no longer needed and can be +! replaced with config_sfclayer_scheme. +! Laura D. Fowler (laura@ucar.edu) / 2017-02-16. +! * removed the initialization local variable pbl_scheme. pbl_scheme is no longer needed and can be replaced +! replaced with config_pbl_scheme. +! Laura D. Fowler (laura@ucar.edu) / 2017-02-16. +! * removed the initialization local variable radt_cld_scheme. radt_cld_scheme is no longer needed and can be +! replaced replaced with config_radt_cld_scheme. +! Laura D. Fowler (laura@ucar.edu) / 2017-02-16. +! * removed the initialization local variable radt_lw_scheme. radt_lw_scheme is no longer needed and can be +! replaced replaced with config_radt_lw_scheme. +! Laura D. Fowler (laura@ucar.edu) / 2017-02-16. +! * removed the initialization local variable radt_sw_scheme. radt_sw_scheme is no longer needed and can be +! replaced replaced with config_radt_sw_scheme. +! Laura D. Fowler (laura@ucar.edu) / 2017-02-16. +! * removed the initialization local variable convection_scheme. convection_scheme is no longer needed and can be +! replaced replaced with config_convection_scheme. +! Laura D. Fowler (laura@ucar.edu) / 2017-02-16. +! * removed the initialization local variable microp_scheme. microp_scheme is no longer needed and can be +! replaced replaced with config_microp_scheme. +! Laura D. Fowler (laura@ucar.edu) / 2017-02-16. +! * add variables and arrays needed to the parameterization of seaice in the updated Noah land surface scheme. +! Laura D. Fowler (laura@ucar.edu) / 2017-02-19. +! * changed the option seaice_albedo_opt from 0 to 2 so that we can initialize the surface albedo over seaice +! cells using the surface background albedo (see initialization of sfc_albedo_seaice in subroutine +! landuse_init_forMPAS). +! Laura D. Fowler (laura@ucar.edu) / 2017-03-02. +! * added local variables for the mass-weighted mean velocities for rain, cloud ice, snow, and graupel from the +! Thompson cloud microphysics scheme. +! Laura D. Fowler (laura@ucar.edu) / 2017-04-19. +! * added the local variables cosa_p and sina_p needed in call to subroutine gwdo after updating module_bl_gwdo.F +! to that of WRF version 4.0.2. +! Laura D. Fowler (laura@ucar.edu) / 2019-01-30. +! * reverted the option seaice_albedo_opt = 2 to seaic_albedo_opt = 0 since MPAS does not currently support the +! input of "observed" 2D seaice albedos. In conjunction with this update, we also change the initialization of +! albsi from albbck to seaice_albedo_default. +! Laura D. Fowler (laura@ucar.edu) / 2022-05-10. +! * added the local parameters flag_bep and idiff in the call to subroutine ysu to update the YSU PBL scheme to +! that of WRF version 4.4.1. +! * added local flags and variables needed to initialize and run the revised version of the MONIN-OBUKHOV surface +! layer scheme from the WRF version 4.4.1. +! Laura D. Fowler (laura@ucar.edu) / 2023-05-15. +! * added the local variables swddir,swddni,and swddif which are output to subroutine rrtmg_swrad and now input +! to the updated module_sf_noahdrv.F. +! Laura D. Fowler (laura@ucar.edu) / 2023-04-21. +! * removed the variable f_qv which is not used in any of the ./physics_wrf modules. +! Laura D. Fowler (laura@ucar.edu) / 2024-02-13. +! * removed the definition of f_qc,f_qr,f_qi,f_qs,f_qg,f_nc,and f_ni as parameters. these variables are now +! initialized in mpas_atmphys_init.F (see subroutine init_physics_flags). also renamed f_qnc to f_nc, and f_qni +! to f_ni. +! Laura D. Fowler (laura@ucar.edu) / 2024-02-14. +! * added the variable spp_pbl needed in the updated version of the MYNN surface layer scheme. +! Laura D. Fowler (laura@ucar.edu) / 2024-02-14. +! * added and modified variables needed to run the MYNN PBL scheme using the sourcecode from WRF version 4.6. +! Laura D. Fowler (laura@ucar.edu) / 2024-02-18. + + +!================================================================================================================= +!wrf-variables:these variables are needed to keep calls to different physics parameterizations +!as in wrf model. +!================================================================================================================= + + logical:: l_radtlw !controls call to longwave radiation parameterization. + logical:: l_radtsw !controls call to shortwave radiation parameterization. + logical:: l_conv !controls call to convective parameterization. + logical:: l_camlw !controls when to save local CAM LW abs and ems arrays. + logical:: l_diags !controls when to calculate physics diagnostics. + logical:: l_acrain !when .true., limit to accumulated rain is applied. + logical:: l_acradt !when .true., limit to lw and sw radiation is applied. + logical:: l_mp_tables !when .true., read look-up tables for Thompson cloud microphysics scheme. + + integer,public:: ids,ide,jds,jde,kds,kde + integer,public:: ims,ime,jms,jme,kms,kme + integer,public:: its,ite,jts,jte,kts,kte + integer,public:: iall + integer,public:: n_microp + + integer,public:: num_months !number of months [-] + + real(kind=RKIND),public:: dt_dyn !time-step for dynamics + real(kind=RKIND),public:: dt_microp !time-step for cloud microphysics parameterization. + real(kind=RKIND),public:: dt_radtlw !time-step for longwave radiation parameterization [mns] + real(kind=RKIND),public:: dt_radtsw !time-step for shortwave radiation parameterization [mns] + + real(kind=RKIND),public:: xice_threshold + + real(kind=RKIND),dimension(:,:),allocatable:: & + area_p !grid cell area [m2] + +!... arrays related to surface: + real(kind=RKIND),dimension(:,:),allocatable:: & + ht_p, &! + psfc_p, &!surface pressure [Pa] + ptop_p !model-top pressure [Pa] + + real(kind=RKIND),dimension(:,:,:),allocatable:: & + fzm_p, &!weight for interpolation to w points [-] + fzp_p !weight for interpolation to w points [-] + + real(kind=RKIND),dimension(:,:,:),allocatable:: & +!... arrays related to u- and v-velocities interpolated to theta points: + u_p, &!u-velocity interpolated to theta points [m/s] + v_p !v-velocity interpolated to theta points [m/s] + +!... arrays related to vertical sounding: + real(kind=RKIND),dimension(:,:,:),allocatable:: & + zz_p, &! + pres_p, &!pressure [Pa] + pi_p, &!(p_phy/p0)**(r_d/cp) [-] + z_p, &!height of layer [m] + zmid_p, &!height of middle of layer [m] + dz_p, &!layer thickness [m] + t_p, &!temperature [K] + th_p, &!potential temperature [K] + al_p, &!inverse of air density [m3/kg] + rho_p, &!air density [kg/m3] + rh_p !relative humidity [-] + + real(kind=RKIND),dimension(:,:,:),allocatable:: & + qv_p, &!water vapor mixing ratio [kg/kg] + qc_p, &!cloud water mixing ratio [kg/kg] + qr_p, &!rain mixing ratio [kg/kg] + qi_p, &!cloud ice mixing ratio [kg/kg] + qs_p, &!snow mixing ratio [kg/kg] + qg_p !graupel mixing ratio [kg/kg] + + real(kind=RKIND),dimension(:,:,:),allocatable:: & + nc_p, &!cloud water droplet number concentration [#/kg] + ni_p, &!cloud ice crystal number concentration [#/kg] + nr_p !rain drop number concentration [#/kg] + +!... arrays located at w (vertical velocity) points, or at interface between layers: + real(kind=RKIND),dimension(:,:,:),allocatable:: & + w_p, &!vertical velocity [m/s] + pres2_p, &!pressure [Pa] + t2_p !temperature [K] + +!... arrays used for calculating the hydrostatic pressure and exner function: + real(kind=RKIND),dimension(:,:),allocatable:: & + psfc_hyd_p, &!surface pressure [Pa] + psfc_hydd_p !"dry" surface pressure [Pa] + real(kind=RKIND),dimension(:,:,:),allocatable:: & + pres_hyd_p, &!pressure located at theta levels [Pa] + pres_hydd_p, &!"dry" pressure located at theta levels [Pa] + pres2_hyd_p, &!pressure located at w-velocity levels [Pa] + pres2_hydd_p, &!"dry" pressure located at w-velocity levels [Pa] + znu_hyd_p !(pres_hyd_p / P0) needed in the Tiedtke convection scheme [Pa] + +!================================================================================================================= +!... variables related to ozone climatlogy: +!================================================================================================================= + + real(kind=RKIND),dimension(:,:,:),allocatable:: & + o3clim_p !climatological ozone volume mixing ratio [???] + +!================================================================================================================= +!... variables and arrays related to parameterization of cloud microphysics: +! warm_phase: logical that determines if we want to run warm-phase cloud microphysics only. +! If set to false, cold-phase cloud microphysics is active. In MPAS, we always assume +! that the ice phase is included (except for the Kessler scheme which includes water +! clouds only. + +!================================================================================================================= + + logical,parameter:: & + warm_rain = .false.!warm-phase cloud microphysics only (used in WRF). + + logical:: & + f_qc, &!parameter set to true to include the cloud water mixing ratio. + f_qr, &!parameter set to true to include the rain mixing ratio. + f_qi, &!parameter set to true to include the cloud ice mixing ratio. + f_qs, &!parameter set to true to include the snow mixing ratio. + f_qg, &!parameter set to true to include the graupel mixing ratio. + f_qoz !parameter set to true to include the ozone mixing ratio. + + logical:: & + f_nc, &!parameter set to true to include the cloud water number concentration. + f_ni, &!parameter set to true to include the cloud ice number concentration. + f_nifa, &!parameter set to true to include the number concentration of hygroscopic aerosols. + f_nwfa, &!parameter set to true to include the number concentration of hydrophobic aerosols. + f_nbca !parameter set to true to include the number concentration of black carbon. + + real(kind=RKIND),dimension(:,:,:),allocatable:: & + f_ice, &!fraction of cloud ice (used in WRF only). + f_rain !fraction of rain (used in WRF only). + + real(kind=RKIND),dimension(:,:),allocatable:: & + rainnc_p, &! + rainncv_p, &! + snownc_p, &! + snowncv_p, &! + graupelnc_p, &! + graupelncv_p, &! + sr_p + + integer:: & + has_reqc, &! + has_reqi, &! + has_reqs + + real(kind=RKIND),dimension(:,:,:),allocatable:: & + rainprod_p, &! + evapprod_p, &! + recloud_p, &! + reice_p, &! + resnow_p ! + +!... for Thompson cloud microphysics parameterization, including aerosol-aware option: + real(kind=RKIND),dimension(:,:),allocatable:: & + ntc_p, &! + muc_p, &! + nifa2d_p, &!surface emission of "ice-friendly" aerosols [#/kg-1/s] + nwfa2d_p !surface emission of "water-friendly" aerosols [#/kg-1/s] + + real(kind=RKIND),dimension(:,:,:),allocatable:: & + nifa_p, &!"ice-friendly" number concentration [#/kg] + nwfa_p !"water-friendly" number concentration [#/kg] + +!================================================================================================================= +!... variables and arrays related to parameterization of convection: +!================================================================================================================= + integer,public:: n_cu + real(kind=RKIND),public:: dt_cu + + logical,dimension(:,:),allocatable:: & + cu_act_flag + real(kind=RKIND),dimension(:,:),allocatable:: & + rainc_p, &! + raincv_p, &! + pratec_p ! + + real(kind=RKIND),dimension(:,:,:),allocatable:: & + rthcuten_p, &! + rqvcuten_p, &! + rqccuten_p, &! + rqicuten_p ! + +!... kain fritsch specific arrays: + real(kind=RKIND),dimension(:,:),allocatable:: & + cubot_p, &!lowest convective level [-] + cutop_p, &!highest convective level [-] + nca_p !counter for cloud relaxation time [-] + real(kind=RKIND),dimension(:,:,:),allocatable:: & + w0avg_p ! + + real(kind=RKIND),dimension(:,:,:),allocatable:: & + rqrcuten_p, &! + rqscuten_p ! + +!... tiedtke specific arrays: + real(kind=RKIND),dimension(:,:,:),allocatable:: & + znu_p ! + + real(kind=RKIND),dimension(:,:,:),allocatable:: & + rucuten_p, &! + rvcuten_p ! + +!... grell-freitas specific parameters and arrays: + integer, parameter:: ishallow = 1 !shallow convection used with grell scheme. + + integer,dimension(:,:),allocatable:: & + k22_shallow_p, &! + kbcon_shallow_p, &! + ktop_shallow_p, &! + kbot_shallow_p, &! + ktop_deep_p ! + + real(kind=RKIND),dimension(:,:),allocatable:: & + xmb_total_p, &! + xmb_shallow_p ! + + real(kind=RKIND),dimension(:,:,:),allocatable:: & + rthdynten_p, &! + qccu_p, &! + qicu_p ! + + real(kind=RKIND),dimension(:,:,:),allocatable:: & + rthraten_p ! + +!... grell and tiedkte specific arrays: + real(kind=RKIND),dimension(:,:,:),allocatable:: & + rqvdynten_p, &! + rqvdynblten_p, &! + rthdynblten_p ! + +!... ntiedtke specific arrays: + real(kind=RKIND),dimension(:,:,:),allocatable:: & + rqvften_p, &! + rthften_p ! + +!================================================================================================================= +!... variables and arrays related to parameterization of pbl: +!================================================================================================================= + + logical,parameter:: & + flag_bep = .false. !flag to use BEP/BEP+BEM for use in the YSU PBL scheme (with urban physics). since we do + !not run urban physics, flag_bep is always set to false. + + integer,parameter:: & + idiff = 0 !BEP/BEM+BEM diffusion flag for use in the YSU PBL scheme (with urban physics). since we + !do not run urban physics, idiff is set to zero. + + integer:: ysu_pblmix + + integer,dimension(:,:),allocatable:: & + kpbl_p !index of PBL top [-] + + real(kind=RKIND),public:: dt_pbl + + real(kind=RKIND),dimension(:,:),allocatable:: & + ctopo_p, &!correction to topography [-] + ctopo2_p, &!correction to topography 2 [-] + hpbl_p, &!PBL height [m] + delta_p, &! + wstar_p, &! + uoce_p, &! + voce_p ! + + real(kind=RKIND),dimension(:,:,:),allocatable:: & + exch_p !exchange coefficient [-] + + real(kind=RKIND),dimension(:,:,:),allocatable:: & + rublten_p, &!tendency of zonal wind due to PBL processes. + rvblten_p, &!tendency of meridional wind due to PBL processes. + rthblten_p, &!tendency of potential temperature due to PBL processes. + rqvblten_p, &!tendency of water vapor mixing ratio due to PBL processes. + rqcblten_p, &!tendency of cloud water mixing ratio due to PBL processes. + rqiblten_p !tendency of cloud ice mixing ratio due to PBL processes. + + real(kind=RKIND),dimension(:,:,:),allocatable:: & + kzh_p, &! + kzm_p, &! + kzq_p ! + +!... MYNN PBL scheme (module_bl_mynn.F): + integer,parameter:: spp_pbl = 0 !generate array with random perturbations (0=off,1=on). + integer,parameter:: icloud_bl = 0 !no coupling of subgrid-scale clouds with radiation. + + integer,dimension(:,:),allocatable:: & + kbl_plume_p !level of highest penetrating plume. + + real(kind=RKIND),dimension(:,:),allocatable:: & + maxwidthbl_p, &!max plume width [m] + maxmfbl_p, &!maximum mass flux for PBL shallow convection. + zbl_plume_p !height of highest penetrating plume [m] + + real(kind=RKIND),dimension(:,:,:),allocatable:: & + dqke_p, &! + qbuoy_p, &! + qdiss_p, &! + qke_p, &! + qkeadv_p, &! + qshear_p, &! + qwt_p, &! + tkepbl_p ! + + real(kind=RKIND),dimension(:,:,:),allocatable:: & + edmfa_p, &! + edmfw_p, &! + edmfqt_p, &! + edmfthl_p, &! + edmfent_p, &! + edmfqc_p, &! + subthl_p, &! + subqv_p, &! + detthl_p, &! + detqv_p, &! + qcbl_p, &! + qibl_p, &! + cldfrabl_p ! + + real(kind=RKIND),dimension(:,:,:),allocatable:: & + rqsblten_p, &!tendency of snow mixing ratio due to PBL processes. + rncblten_p, &!tendency of cloud liquid water number concentration due to PBL processes. + rniblten_p, &!tendency of cloud ice number concentration due to PBL processes. + rnifablten_p, &!tendency of ice-friendly aerosol number concentration due to PBL processes. + rnwfablten_p !tendency of water-friendly aerosol number concentration due to PBL processes. + + real(kind=RKIND),dimension(:,:,:),allocatable:: & + pattern_spp_pbl !stochastic forcing for the MYMM PBL and surface layer schemes. + +!================================================================================================================= +!... variables and arrays related to parameterization of gravity wave drag over orography: +!================================================================================================================= + + real(kind=RKIND),dimension(:,:),allocatable:: & + cosa_p, &!cosine of map rotation [-] + sina_p !sine of map rotation [-] + + real(kind=RKIND),dimension(:,:),allocatable:: & + ter_p, &!orographic height [m] + var2d_p, &!orographic variance [m2] + elvmax_p, &!orographic maximum [m] + con_p, &!orographic convexity [m2] + oa1_p, &!orographic direction asymmetry function [-] + oa2_p, &!orographic direction asymmetry function [-] + oa3_p, &!orographic direction asymmetry function [-] + oa4_p, &!orographic direction asymmetry function [-] + ol1_p, &!orographic direction asymmetry function [-] + ol2_p, &!orographic direction asymmetry function [-] + ol3_p, &!orographic direction asymmetry function [-] + ol4_p !orographic direction asymmetry function [-] + + real(kind=RKIND),dimension(:,:),allocatable:: & + dx_p !mean distance between cell centers [m] + + real(kind=RKIND),dimension(:,:),allocatable:: & + dusfcg_p, &!vertically-integrated gwdo u-stress [Pa m s-1] + dvsfcg_p !vertically-integrated gwdo v -stress [Pa m s-1] + + real(kind=RKIND),dimension(:,:,:),allocatable:: & + dtaux3d_p, &!gravity wave drag over orography u-stress [m s-1] + dtauy3d_p !gravity wave drag over orography u-stress [m s-1] + +!... variables for UGWP orographic gravity wave drag: + + real(kind=RKIND),dimension(:,:),allocatable:: & + var2dls_p, &!orographic variance (meso-scale orographic variation) [m] + conls_p, &!orographic convexity (meso-scale orographic variation) [-] + oa1ls_p, &!orographic direction asymmetry function (meso-scale orographic variation) [-] + oa2ls_p, &!orographic direction asymmetry function (meso-scale orographic variation) [-] + oa3ls_p, &!orographic direction asymmetry function (meso-scale orographic variation) [-] + oa4ls_p, &!orographic direction asymmetry function (meso-scale orographic variation) [-] + ol1ls_p, &!orographic direction asymmetry function (meso-scale orographic variation) [-] + ol2ls_p, &!orographic direction asymmetry function (meso-scale orographic variation) [-] + ol3ls_p, &!orographic direction asymmetry function (meso-scale orographic variation) [-] + ol4ls_p, &!orographic direction asymmetry function (meso-scale orographic variation) [-] + var2dss_p, &!orographic variance (small-scale orographic variation) [m] + conss_p, &!orographic convexity (small-scale orographic variation) [-] + oa1ss_p, &!orographic direction asymmetry function (small-scale orographic variation) [-] + oa2ss_p, &!orographic direction asymmetry function (small-scale orographic variation) [-] + oa3ss_p, &!orographic direction asymmetry function (small-scale orographic variation) [-] + oa4ss_p, &!orographic direction asymmetry function (small-scale orographic variation) [-] + ol1ss_p, &!orographic direction asymmetry function (small-scale orographic variation) [-] + ol2ss_p, &!orographic direction asymmetry function (small-scale orographic variation) [-] + ol3ss_p, &!orographic direction asymmetry function (small-scale orographic variation) [-] + ol4ss_p !orographic direction asymmetry function (small-scale orographic variation) [-] + + real(kind=RKIND),dimension(:,:),allocatable:: & + dusfc_ls_p, &!vertically-integrated mesoscale orog gravity wave drag u-stress [Pa] + dvsfc_ls_p, &!vertically-integrated mesoscale orog gravity wave drag v-stress [Pa] + dusfc_bl_p, &!vertically-integrated orog blocking drag u-stress [Pa] + dvsfc_bl_p, &!vertically-integrated orog blocking drag v-stress [Pa] + dusfc_ss_p, &!vertically-integrated small-scale orog gravity wave drag u-stres [Pa] + dvsfc_ss_p, &!vertically-integrated small-scale orog gravity wave drag v-stres [Pa] + dusfc_fd_p, &!vertically-integrated turb orog form drag u-stress [Pa] + dvsfc_fd_p !vertically-integrated turb orog form drag v-stress [Pa] + + real(kind=RKIND),dimension(:,:,:),allocatable:: & + dtaux3d_ls_p, &!mesoscale orog gravity wave drag u-tendency [m s-2] + dtauy3d_ls_p, &!mesoscale orog gravity wave drag v-tendency [m s-2] + dtaux3d_bl_p, &!orog blocking drag u-tendency u-tendency [m s-2] + dtauy3d_bl_p, &!orog blocking drag u-tendency v-tendency [m s-2] + dtaux3d_ss_p, &!small-scale orog gravity wave drag u-tendency [m s-2] + dtauy3d_ss_p, &!small-scale orog gravity wave drag v-tendency [m s-2] + dtaux3d_fd_p, &!turb orog form drag u-tendency [m s-2] + dtauy3d_fd_p !turb orog form drag u-tendency [m s-2] + +!... variables for UGWP non-stationary gravity wave (NGW) drag: + + integer,dimension(:,:),allocatable:: & + jindx1_tau_p, &!lower latitude index of NGW momentum flux for interpolation [-] + jindx2_tau_p !upper latitude index of NGW momentum flux for interpolation [-] + + real(kind=RKIND),dimension(:,:),allocatable:: & + ddy_j1tau_p, &!latitude interpolation weight complement for NGW momentum flux [-] + ddy_j2tau_p !latitude interpolation weight for NGW momentum flux [-] + + real(kind=RKIND),dimension(:,:,:),allocatable:: & + dudt_ngw_p, &!u-momentum tendency due to non-stationary gravity wave drag [m s-2] + dvdt_ngw_p, &!v-momentum tendency due to non-stationary gravity wave drag [m s-2] + dtdt_ngw_p !temperature tendency due to non-stationary gravity wave drag [K s-1] + +!================================================================================================================= +!... variables and arrays related to parameterization of surface layer: +!================================================================================================================= + + real(kind=RKIND),dimension(:,:),allocatable:: & + br_p, &!bulk richardson number [-] + cd_p, &!momentum exchange coeff at 10 meters [?] + cda_p, &!momentum exchange coeff at the lowest model level [?] + cpm_p, &! + chs_p, &! + chs2_p, &! + ck_p, &!enthalpy exchange coeff at 10 meters [?] + cka_p, &!enthalpy exchange coeff at the lowest model level [?] + cqs2_p, &! + gz1oz0_p, &!log of z1 over z0 [-] + flhc_p, &!exchange coefficient for heat [-] + flqc_p, &!exchange coefficient for moisture [-] + hfx_p, &!upward heat flux at the surface [W/m2] + lh_p, &!latent heat flux at the surface [W/m2] + mavail_p, &!surface moisture availability [-] + mol_p, &!T* in similarity theory [K] + pblh_p, &!PBL height [m] + psih_p, &!similarity theory for heat [-] + psim_p, &!similarity theory for momentum [-] + q2_p, &!specific humidity at 2m [kg/kg] + qfx_p, &!upward moisture flux at the surface [kg/m2/s] + qgh_p, &! + qsfc_p, &!specific humidity at lower boundary [kg/kg] + regime_p, &!flag indicating PBL regime (stable_p,unstable_p,etc...) [-] + rmol_p, &!1 / Monin Ob length [-] + t2m_p, &!temperature at 2m [K] + th2m_p, &!potential temperature at 2m [K] + u10_p, &!u at 10 m [m/s] + ust_p, &!u* in similarity theory [m/s] + ustm_p, &!u* in similarity theory without vconv correction [m/s] + v10_p, &!v at 10 m [m/s] + wspd_p, &!wind speed [m/s] + znt_p, &!time-varying roughness length [m] + zol_p ! + +!... arrays only in monin_obukohv (module_sf_sfclay.F): + real(kind=RKIND),dimension(:,:),allocatable:: & + fh_p, &!integrated stability function for heat [-] + fm_p !integrated stability function for momentum [-] + +!... variables and arrays only in the revised version of monin_obukhov (module_sf_sfclayrev.F) to include the +! shallow water roughness scheme: + integer,parameter:: & + bathymetry_flag = 0!this flag is set to 1 if input bathymetry data is available (this option is not available + !in MPAS and therefore set to 0 by default. + integer,parameter:: & + shalwater_flag = 0!this flag is set to 1 to run the shallow water roughness scheme (this option is not + !available in MPAS and therefore set to 0 by default. + integer,parameter:: & + lakemodel_flag = 0!this flag is set to 1 to run the lake model physics (this option is not available in MPAS + !and therefore set to 0 by default. + + real(kind=RKIND),parameter:: & + shalwater_depth = 0!constant shallow water depth needed to run the shallow water roughness scheme. + + real(kind=RKIND),dimension(:,:),allocatable:: & + waterdepth_p, &!depth of water needed to run the shallow water roughness scheme. + lakedepth_p, &!depth of lakes needed to run the lake model physics. + lakemask_p !mask needed to detect the location of lakes to run the lake model physics. + +!... arrays only in mynn surface layer scheme (module_sf_mynn.F): + real(kind=RKIND),dimension(:,:),allocatable:: & + ch_p, &!surface exchange coeff for heat [m/s] + qcg_p !cloud water mixing ratio at the ground surface [kg/kg] + + real(kind=RKIND),dimension(:,:,:),allocatable:: & + cov_p, &!liquid water-liquid water potential temperature covariance [K kg/kg] + qsq_p, &!liquid water variance [(kg/kg)^2] + tsq_p, &!liquid water potential temperature variance [K^2] + sh3d_p, &!stability function for heat [-] + sm3d_p, &!stability function for moisture [-] + elpbl_p !length scale from PBL [m] + +!================================================================================================================= +!... variables and arrays related to parameterization of seaice: +!... the options set for seaice_albedo_opt, seaice_thickness_opt, and seaicesnowdepth_opt must not be changed +! since they are the only ones currently available. +!================================================================================================================= + + integer,parameter:: & + seaice_albedo_opt = 0 !option to set albedo over sea ice. + !0 = seaice albedo is constant set in seaice_albedo_default. + !1 = seaice albedo is f(Tair,Tskin,Tsnow), following Mill (2011). + !2 = seaice albedo is read in from input variable albsi. + integer,parameter:: & + seaice_thickness_opt = 0 !option for treating seaice thickness. + !0 = seaice thickness is constant set in seaice_thickness_default. + !1 = seaice_thickness is read in from input variable icedepth. + integer,parameter:: & + seaice_snowdepth_opt = 0 !option for treating snow depth on sea ice. + !0=snow depth is bounded by seaice_snowdepth_min and seaice_snowdepth_max. + + real(kind=RKIND),parameter:: & + seaice_albedo_default = 0.65 ,&!default value of seaice albedo for seaice_albedo_opt=0. + seaice_thickness_default = 3.0, &!default value of seaice thickness for seaice_thickness_opt=0 + seaice_snowdepth_max = 1.e10,&!maximum allowed accumulation of snow (m) on sea ice. + seaice_snowdepth_min = 0.001 !minimum snow depth (m) on sea ice. + + real(kind=RKIND),dimension(:,:),allocatable:: & + albsi_p, &!surface albedo over seaice [-] + snowsi_p, &!snow depth over seaice [m] + icedepth_p !seaice thickness [m] + +!================================================================================================================= +!... variables and arrays related to the calculation of the optical properties of aerosols: to date, the only kind +! of aerosols included in MPAS are the "water-friendly" and "ice-friendly" aerosols used in the Thompson cloud +! cloud microphysics scheme. +!================================================================================================================= + + integer,parameter:: taer_aod550_opt = 2!input option for nwfa, nifa optical depth at 500 nm. + integer,parameter:: taer_angexp_opt = 3!input option for nwfa, nifa aerosol Angstrom exponent. + integer,parameter:: taer_ssa_opt = 3!input option for nwfa, nifa aerosol single-scattering albedo. + integer,parameter:: taer_asy_opt = 3!input option for nwfa, nifa aerosol asymmetry factor. + + integer:: aer_opt !=[0,3] : 0 for no aerosols, 3 for "water-" and "ice-friendly" aerosols. + integer,dimension(:,:),allocatable:: & + taer_type_p !=[1,2,3]: 1 for rural, 2 is urban and 3 is maritime in WRF. In MPAS, + !aer_type is initialized as a function of landmask (=1 over land; =2 over + !oceans. + + real(kind=RKIND),parameter:: aer_aod550_val = 0.12 + real(kind=RKIND),parameter:: aer_angexp_val = 1.3 + real(kind=RKIND),parameter:: aer_ssa_val = 0.85 + real(kind=RKIND),parameter:: aer_asy_val = 0.9 + + real(kind=RKIND),dimension(:,:),allocatable :: taod5502d_p!total aerosol optical depth at 550 nm [-] + real(kind=RKIND),dimension(:,:,:),allocatable:: taod5503d_p!aerosol optical depth at 550 nm [-] + + real(kind=RKIND),dimension(:,:,:,:),allocatable:: tauaer_p !aerosol optical depth in RRTMG SW [-] + real(kind=RKIND),dimension(:,:,:,:),allocatable:: ssaaer_p !aerosol single scatterin albedo in RRTMG SW [-] + real(kind=RKIND),dimension(:,:,:,:),allocatable:: asyaer_p !aerosol asymmetry factor in RRTMG SW [-] + +!================================================================================================================= +!... variables and arrays related to parameterization of short-wave radiation: +!================================================================================================================= + + real(kind=RKIND):: & + declin, &!solar declination [-] + solcon !solar constant [W m-2] + + real(kind=RKIND),dimension(:,:),allocatable:: & + coszr_p, &!cosine of the solar zenith angle [-] + gsw_p, &!net shortwave flux at surface [W m-2] + swcf_p, &!shortwave cloud forcing at top-of-atmosphere [W m-2] + swdnb_p, &!all-sky downwelling shortwave flux at bottom-of-atmosphere [J m-2] + swdnbc_p, &!clear-sky downwelling shortwave flux at bottom-of-atmosphere [J m-2] + swdnt_p, &!all-sky downwelling shortwave flux at top-of-atmosphere [J m-2] + swdntc_p, &!clear-sky downwelling shortwave flux at top-of-atmosphere [J m-2] + swupb_p, &!all-sky upwelling shortwave flux at bottom-of-atmosphere [J m-2] + swupbc_p, &!clear-sky upwelling shortwave flux at bottom-of-atmosphere [J m-2] + swupt_p, &!all-sky upwelling shortwave flux at top-of-atmosphere [J m-2] + swuptc_p !clear-sky upwelling shortwave flux at top-of-atmosphere [J m-2] + + real(kind=RKIND),dimension(:,:),allocatable:: & + swvisdir_p, &!visible direct downward flux [W m-2] + swvisdif_p, &!visible diffuse downward flux [W m-2] + swnirdir_p, &!near-IR direct downward flux [W m-2] + swnirdif_p !near-IR diffuse downward flux [W m-2] + + real(kind=RKIND),dimension(:,:),allocatable:: & + swddir_p, &! + swddni_p, &! + swddif_p ! + + real(kind=RKIND),dimension(:,:,:),allocatable:: & + swdnflx_p, &! + swdnflxc_p, &! + swupflx_p, &! + swupflxc_p ! + + real(kind=RKIND),dimension(:,:,:),allocatable:: & + rthratensw_p !uncoupled theta tendency due to shortwave radiation [K s-1] + +!================================================================================================================= +!... variables and arrays related to parameterization of long-wave radiation: +!================================================================================================================= + + integer,dimension(:,:),allocatable:: & + nlrad_p !number of layers added above the model top [-] + real(kind=RKIND),dimension(:,:),allocatable:: & + plrad_p !pressure at model_top [Pa] + + real(kind=RKIND),dimension(:,:),allocatable:: & + glw_p, &!net longwave flux at surface [W m-2] + lwcf_p, &!longwave cloud forcing at top-of-atmosphere [W m-2] + lwdnb_p, &!all-sky downwelling longwave flux at bottom-of-atmosphere [J m-2] + lwdnbc_p, &!clear-sky downwelling longwave flux at bottom-of-atmosphere [J m-2] + lwdnt_p, &!all-sky downwelling longwave flux at top-of-atmosphere [J m-2] + lwdntc_p, &!clear-sky downwelling longwave flux at top-of-atmosphere [J m-2] + lwupb_p, &!all-sky upwelling longwave flux at bottom-of-atmosphere [J m-2] + lwupbc_p, &!clear-sky upwelling longwave flux at bottom-of-atmosphere [J m-2] + lwupt_p, &!all-sky upwelling longwave flux at top-of-atmosphere [J m-2] + lwuptc_p, &!clear-sky upwelling longwave flux at top-of-atmosphere [J m-2] + olrtoa_p !outgoing longwave radiation at top-of-the-atmosphere [W m-2] + + real(kind=RKIND),dimension(:,:,:),allocatable:: & + lwdnflx_p, &! + lwdnflxc_p, &! + lwupflx_p, &! + lwupflxc_p ! + + real(kind=RKIND),dimension(:,:,:),allocatable:: & + rthratenlw_p, &!uncoupled theta tendency due to longwave radiation [K s-1] + rrecloud_p, &!effective radius for cloud water calculated in rrtmg_lwrad [mu] + rreice_p, &!effective radius for cloud ice calculated in rrmtg_lwrad [mu] + rresnow_p !effective radius for snow calculated in rrtmg_lwrad [mu] + +!================================================================================================================= +!... variables and arrays related to parameterization of long- and short-wave radiation needed +! only by the "CAM" radiation codes: +!================================================================================================================= + + logical:: doabsems + + integer:: cam_abs_dim1 + integer:: cam_abs_dim2 + integer:: num_moist + integer:: num_aerosols + integer:: num_aerlevels + integer:: num_oznlevels + + real(kind=RKIND),dimension(:),allocatable:: & + pin_p, &!pressure levels for ozone concentration [Pa] + m_hybi_p !hybrid levels for aerosols [-] + + real(kind=RKIND),dimension(:,:),allocatable:: & + m_psn_p, &! + m_psp_p ! + + real(kind=RKIND),dimension(:,:,:,:),allocatable:: & + aerosolcn_p, &! + aerosolcp_p ! + + real(kind=RKIND),dimension(:,:,:),allocatable:: & + emstot_p, &!total emissivity [-] + cemiss_p, &!cloud emissivity for ISCCP [-] + taucldc_p, &!cloud water optical depth for ISCCP [-] + taucldi_p !cloud ice optical depth for ISCCP [-] + + real(kind=RKIND),dimension(:,:,:,:),allocatable:: & + abstot_p, &!total layer absorptivity [-] + absnxt_p, &!total nearest layer absorptivity [-] + ozmixm_p !ozone mixing ratio. + +!================================================================================================================= +!.. variables and arrays related to cloudiness: +!================================================================================================================= + + integer,parameter:: & + icloud= 1 !used in WRF only. + + real(kind=RKIND),dimension(:,:,:),allocatable:: & + cldfrac_p, &!cloud fraction [-] + qvrad_p, &!water vapor mixing ratio local to cloudiness and radiation [kg/kg] + qcrad_p, &!cloud liquid water mixing ratio local to cloudiness and radiation [kg/kg] + qirad_p, &!cloud ice mixing ratio local to cloudiness and radiation [kg/kg] + qsrad_p !snow mixing ratio local to cloudiness and radiation [kg/kg] + +!================================================================================================================= +!.. variables and arrays related to land-surface parameterization: +!================================================================================================================= + + logical,parameter:: & + ua_phys = .false. !option to activate UA Noah changes: a different snow-cover physics in the land-surface + !scheme. That option is not currently implemented in MPAS. + + integer,parameter:: & + opt_thcnd = 1 !option to treat thermal conductivity in NoahLSM (new option implemented in WRF 3.8.0). + != 1, original (default). + != 2, McCumber and Pielke for silt loam and sandy loam. + + integer,parameter:: & + fasdas = 0 !for WRF surface data assimilation system (not used in MPAS). + + integer,parameter:: & + nurb = 1 !generic dimension for all dimensions needed to run the urban physics. + + integer,public:: & + sf_surface_physics !used to define the land surface scheme by a number instead of name. It + !is only needed in module_ra_rrtmg_sw.F to define the spectral surface + !albedos as functions of the land surface scheme. + + integer,public:: & + num_soils !number of soil layers [-] + + integer,dimension(:,:),allocatable:: & + isltyp_p, &!dominant soil type category [-] + ivgtyp_p !dominant vegetation category [-] + + real(kind=RKIND),dimension(:),allocatable:: & + dzs_p !thickness of soil layers [m] + real(kind=RKIND),dimension(:,:,:),allocatable:: & + smcrel_p, &!soil moisture threshold below which transpiration starts to stress [-] + sh2o_p, &!unfrozen soil moisture content [volumetric fraction] + smois_p, &!soil moisture [volumetric fraction] + tslb_p !soil temperature [K] + + real(kind=RKIND),dimension(:,:),allocatable:: & + acsnom_p, &!accumulated melted snow [kg m-2] + acsnow_p, &!accumulated snow [kg m-2] + canwat_p, &!canopy water [kg m-2] + chklowq_p, &!surface saturation flag [-] + grdflx_p, &!ground heat flux [W m-2] + lai_p, &!leaf area index [-] + noahres_p, &!residual of the noah land-surface scheme energy budget [W m-2] + potevp_p, &!potential evaporation [W m-2] + qz0_p, &!specific humidity at znt [kg kg-1] + rainbl_p, &! + sfcrunoff_p, &!surface runoff [m s-1] + shdmin_p, &!minimum areal fractional coverage of annual green vegetation [-] + shdmax_p, &!maximum areal fractional coverage of annual green vegetation [-] + smstav_p, &!moisture availability [-] + smstot_p, &!total moisture [m3 m-3] + snopcx_p, &!snow phase change heat flux [W m-2] + snotime_p, &! + snowc_p, &!snow water equivalent [kg m-2] + snowh_p, &!physical snow depth [m] + swdown_p, &!downward shortwave flux at the surface [W m-2] + udrunoff_p, &!sub-surface runoff [m s-1] + tmn_p, &!soil temperature at lower boundary [K] + vegfra_p, &!vegetation fraction [-] + z0_p !background roughness length [m] + + real(kind=RKIND),dimension(:,:),allocatable:: & + alswvisdir_p, &!direct-beam surface albedo in visible spectrum [-] + alswvisdif_p, &!diffuse-beam surface albedo in visible spectrum [-] + alswnirdir_p, &!direct-beam surface albedo in near-IR spectrum [-] + alswnirdif_p !diffuse-beam surface albedo in near-IR spectrum [-] + +!.. arrays needed to run UA Noah changes (different snow-cover physics): + real(kind=RKIND),dimension(:,:),allocatable:: & + flxsnow_p, &!energy added to sensible heat flux when ua_phys=true [W m-2] + fvbsnow_p, &!fraction of vegetation with snow beneath when ua_phys=true [-] + fbursnow_p, &!fraction of canopy buried when ua_phys=true [-] + fgsnsnow_p !fraction of ground snow cover when ua_phys=true [-] + +!.. arrays needed in the argument list in the call to the Noah LSM urban parameterization: note that these arrays +!.. are initialized to zero since we do not run an urban model: + integer,dimension(:,:),allocatable:: & + utype_urb_p !urban type [-] + + real(kind=RKIND),dimension(:,:),allocatable:: & + frc_urb_p, &!urban fraction [-] + ust_urb_p !urban u* in similarity theory [m/s] + +!================================================================================================================= +!.. variables and arrays related to the Noahmp land-surface parameterization: +!================================================================================================================= + + type(NoahmpIO_type):: mpas_noahmp + +!================================================================================================================= +!.. variables and arrays related to surface characteristics: +!================================================================================================================= + + real(kind=RKIND),dimension(:,:),allocatable:: & + xlat_p, &!longitude, west is negative [degrees] + xlon_p !latitude, south is negative [degrees] + + real(kind=RKIND),dimension(:,:),allocatable:: & + sfc_albedo_p, &!surface albedo [-] + sfc_albbck_p, &!surface background albedo [-] + sfc_emibck_p, &!land surface background emissivity [-] + sfc_emiss_p, &!land surface emissivity [-] + snoalb_p, &!annual max snow albedo [-] + snow_p, &!snow water equivalent [kg m-2] + tsk_p, &!surface-skin temperature [K] + sst_p, &!sea-surface temperature [K] + xice_p, &!ice mask [-] + xland_p !land mask (1 for land; 2 for water) [-] + +!================================================================================================================= +!.. variables needed for the surface layer scheme and land surface scheme when config_frac_seaice +! is set to true. the arrays below have the same definition as the corresponding "_p" arrays: +!================================================================================================================= + + real(kind=RKIND),dimension(:,:),allocatable:: br_sea,ch_sea,chs_sea,chs2_sea,cpm_sea,cqs2_sea, & + flhc_sea,flqc_sea,gz1oz0_sea,hfx_sea,lh_sea,mavail_sea,mol_sea, & + psih_sea,psim_sea,fh_sea,fm_sea,qfx_sea,qgh_sea,qsfc_sea,regime_sea, & + rmol_sea,ust_sea,wspd_sea,znt_sea,zol_sea,tsk_sea,xland_sea + real(kind=RKIND),dimension(:,:),allocatable:: t2m_sea,th2m_sea,q2_sea,u10_sea,v10_sea + real(kind=RKIND),dimension(:,:),allocatable:: cd_sea,cda_sea,ck_sea,cka_sea,ustm_sea + + real(kind=RKIND),dimension(:,:),allocatable:: regime_hold + real(kind=RKIND),dimension(:,:),allocatable:: tsk_ice + + + contains + + +!================================================================================================================= + subroutine atmphys_vars_init() +!================================================================================================================= +!dummy subroutine that does not do anything. + + end subroutine atmphys_vars_init + +!================================================================================================================= + end module mpas_atmphys_vars +!================================================================================================================= diff --git a/src/core_atmosphere/physics/physics_wrf/Makefile b/src/core_atmosphere/physics/physics_wrf/Makefile index 4495b74960..3058e079b3 100644 --- a/src/core_atmosphere/physics/physics_wrf/Makefile +++ b/src/core_atmosphere/physics/physics_wrf/Makefile @@ -14,6 +14,7 @@ OBJS = \ module_bl_ugwp_gwdo.o \ module_bl_mynn.o \ module_bl_ysu.o \ + module_bl_shinhong.o \ module_cam_error_function.o \ module_cam_shr_kind_mod.o \ module_cam_support.o \ diff --git a/src/core_atmosphere/physics/physics_wrf/module_bl_gwdo.F-org b/src/core_atmosphere/physics/physics_wrf/module_bl_gwdo.F-org new file mode 100644 index 0000000000..ae95ed5d62 --- /dev/null +++ b/src/core_atmosphere/physics/physics_wrf/module_bl_gwdo.F-org @@ -0,0 +1,241 @@ +!================================================================================================================= + module module_bl_gwdo + use mpas_kind_types,only: kind_phys => RKIND + use bl_gwdo + + implicit none + private + public:: gwdo + + + contains + + +!================================================================================================================= + subroutine gwdo(u3d,v3d,t3d,qv3d,p3d,p3di,pi3d,z, & + rublten,rvblten, & + dtaux3d,dtauy3d,dusfcg,dvsfcg, & + var2d,oc12d,oa2d1,oa2d2,oa2d3,oa2d4,ol2d1,ol2d2,ol2d3,ol2d4, & + sina,cosa,znu,znw,p_top, & + cp,g,rd,rv,ep1,pi, & + dt,dx,kpbl2d,itimestep, & + ids,ide, jds,jde, kds,kde, & + ims,ime, jms,jme, kms,kme, & + its,ite, jts,jte, kts,kte, & + errmsg,errflg & + ) +!================================================================================================================= +! +!-- u3d 3d u-velocity interpolated to theta points (m/s) +!-- v3d 3d v-velocity interpolated to theta points (m/s) +!-- t3d temperature (k) +!-- qv3d 3d water vapor mixing ratio (kg/kg) +!-- p3d 3d pressure (pa) +!-- p3di 3d pressure (pa) at interface level +!-- pi3d 3d exner function (dimensionless) +!-- rublten u tendency due to pbl parameterization (m/s/s) +!-- rvblten v tendency due to pbl parameterization (m/s/s) +!-- sina sine rotation angle +!-- cosa cosine rotation angle +!-- znu eta values (sigma values) +!-- cp heat capacity at constant pressure for dry air (j/kg/k) +!-- g acceleration due to gravity (m/s^2) +!-- rd gas constant for dry air (j/kg/k) +!-- z height above sea level (m) +!-- rv gas constant for water vapor (j/kg/k) +!-- dt time step (s) +!-- dx model grid interval (m) +!-- ep1 constant for virtual temperature (r_v/r_d - 1) (dimensionless) +!-- ids start index for i in domain +!-- ide end index for i in domain +!-- jds start index for j in domain +!-- jde end index for j in domain +!-- kds start index for k in domain +!-- kde end index for k in domain +!-- ims start index for i in memory +!-- ime end index for i in memory +!-- jms start index for j in memory +!-- jme end index for j in memory +!-- kms start index for k in memory +!-- kme end index for k in memory +!-- its start index for i in tile +!-- ite end index for i in tile +!-- jts start index for j in tile +!-- jte end index for j in tile +!-- kts start index for k in tile +!-- kte end index for k in tile +! +!================================================================================================================= + +!--- input arguments: + integer,intent(in):: ids,ide,jds,jde,kds,kde, & + ims,ime,jms,jme,kms,kme, & + its,ite,jts,jte,kts,kte + integer,intent(in):: itimestep + + 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),optional:: p_top + + real(kind=kind_phys),intent(in),dimension(kms:kme),optional:: & + znu, & + znw + + real(kind=kind_phys),intent(in),dimension(ims:ime,jms:jme):: & + dx, & + var2d, & + oc12d, & + oa2d1,oa2d2,oa2d3,oa2d4, & + ol2d1,ol2d2,ol2d3,ol2d4, & + sina,cosa + + real(kind=kind_phys),intent(in),dimension(ims:ime,kms:kme,jms:jme):: & + qv3d, & + p3d, & + pi3d, & + t3d, & + u3d, & + v3d, & + z + + real(kind=kind_phys),intent(in),dimension(ims:ime,kms:kme,jms:jme):: & + p3di + +!--- output arguments: + character(len=*),intent(out):: errmsg + + integer,intent(out):: errflg + + real(kind=kind_phys),intent(out),dimension(ims:ime,jms:jme):: & + dusfcg, & + dvsfcg + + real(kind=kind_phys),intent(out),dimension(ims:ime,kms:kme,jms:jme ):: & + dtaux3d, & + dtauy3d + +!--- inout arguments: + real(kind=kind_phys),intent(inout),dimension(ims:ime,kms:kme,jms:jme):: & + rublten, & + rvblten + +!--- local variables and arrays: + integer:: i,j,k + + real(kind=kind_phys),dimension(its:ite):: & + var2d_hv,oc12d_hv,dx_hv,sina_hv,cosa_hv + real(kind=kind_phys),dimension(its:ite):: & + oa2d1_hv,oa2d2_hv,oa2d3_hv,oa2d4_hv,ol2d1_hv,ol2d2_hv,ol2d3_hv,ol2d4_hv + real(kind=kind_phys),dimension(its:ite):: & + dusfcg_hv,dvsfcg_hv + + real(kind=kind_phys),dimension(its:ite,kts:kte):: & + u3d_hv,v3d_hv,t3d_hv,qv3d_hv,pi3d_hv,p3d_hv,z_hv + + real(kind=kind_phys),dimension(its:ite,kts:kte):: & + rublten_hv,rvblten_hv,dtaux3d_hv,dtauy3d_hv + + real(kind=kind_phys),dimension(its:ite,kms:kme):: & + p3di_hv + +!----------------------------------------------------------------------------------------------------------------- + +! Outer j-loop. Allows consistency between WRF and MPAS in the driver. + + do j = jts,jte + + ! All variables for gwdo2d are tile-sized and have only a single + ! horizontal dimension. The _hv suffix refers to "horizontal vertical", + ! a reminder that there is a single horizontal index. Yes, we know that + ! variables that have only a horizontal index are not *really* _hv. + + ! All of the following 3d and 2d variables are declared intent(in) in the + ! gwdo2d subroutine, so there is no need to put the updated values back + ! from the temporary arrays back into the original arrays. + + ! Variables that are INTENT(IN) or INTENT(INOUT) + + ! 3d, interface levels: + do k = kts,kte+1 + do i = its,ite + p3di_hv(i,k) = p3di(i,k,j) + enddo + enddo + + ! 3d, layers: + do k = kts,kte + do i = its,ite + rublten_hv(i,k) = rublten(i,k,j) + rvblten_hv(i,k) = rvblten(i,k,j) + u3d_hv(i,k) = u3d(i,k,j) + v3d_hv(i,k) = v3d(i,k,j) + t3d_hv(i,k) = t3d(i,k,j) + qv3d_hv(i,k) = qv3d(i,k,j) + p3d_hv(i,k) = p3d(i,k,j) + pi3d_hv(i,k) = pi3d(i,k,j) + z_hv(i,k) = z(i,k,j) + enddo + enddo + + ! 2d: + do i = its,ite + dx_hv(i) = dx(i,j) + var2d_hv(i) = var2d(i,j) + oc12d_hv(i) = oc12d(i,j) + sina_hv(i) = sina(i,j) + cosa_hv(i) = cosa(i,j) + oa2d1_hv(i) = oa2d1(i,j) + oa2d2_hv(i) = oa2d2(i,j) + oa2d3_hv(i) = oa2d3(i,j) + oa2d4_hv(i) = oa2d4(i,j) + ol2d1_hv(i) = ol2d1(i,j) + ol2d2_hv(i) = ol2d2(i,j) + ol2d3_hv(i) = ol2d3(i,j) + ol2d4_hv(i) = ol2d4(i,j) + enddo + + call bl_gwdo_run(sina=sina_hv,cosa=cosa_hv & + ,rublten=rublten_hv,rvblten=rvblten_hv & + ,dtaux3d=dtaux3d_hv,dtauy3d=dtauy3d_hv & + ,dusfcg=dusfcg_hv,dvsfcg=dvsfcg_hv & + ,uproj=u3d_hv,vproj=v3d_hv & + ,t1=t3d_hv,q1=qv3d_hv & + ,prsi=p3di_hv & + ,prsl=p3d_hv,prslk=pi3d_hv & + ,zl=z_hv & + ,var=var2d_hv,oc1=oc12d_hv & + ,oa2d1=oa2d1_hv, oa2d2=oa2d2_hv & + ,oa2d3=oa2d3_hv, oa2d4=oa2d4_hv & + ,ol2d1=ol2d1_hv, ol2d2=ol2d2_hv & + ,ol2d3=ol2d3_hv, ol2d4=ol2d4_hv & + ,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 & + ,errmsg=errmsg,errflg=errflg) + + ! Variables that are INTENT(OUT) or INTENT(INOUT): + + ! 3d, layers: + do k = kts,kte + do i = its,ite + rublten(i,k,j) = rublten_hv(i,k) + rvblten(i,k,j) = rvblten_hv(i,k) + dtaux3d(i,k,j) = dtaux3d_hv(i,k) + dtauy3d(i,k,j) = dtauy3d_hv(i,k) + enddo + enddo + + ! 2d: + do i = its,ite + dusfcg(i,j) = dusfcg_hv(i) + dvsfcg(i,j) = dvsfcg_hv(i) + enddo + + enddo ! Outer J-loop + + end subroutine gwdo + +!================================================================================================================= +end module module_bl_gwdo +!================================================================================================================= diff --git a/src/core_atmosphere/physics/physics_wrf/module_bl_shinhong.F b/src/core_atmosphere/physics/physics_wrf/module_bl_shinhong.F new file mode 100644 index 0000000000..dbfe5f01f2 --- /dev/null +++ b/src/core_atmosphere/physics/physics_wrf/module_bl_shinhong.F @@ -0,0 +1,499 @@ +#define NEED_B4B_DURING_CCPP_TESTING 1 +!================================================================================================================= + module module_bl_shinhong + use mpas_kind_types,only: kind_phys => RKIND + use bl_shinhong + + + implicit none + private + public:: shinhong + + + contains + + +!================================================================================================================= + subroutine shinhong(u3d,v3d,t3d,qv3d,qc3d,qi3d,p3d,p3di,pi3d, & + rublten,rvblten,rthblten, & + rqvblten,rqcblten,rqiblten,flag_qc,flag_qi, & + cp,g,rovcp,rd,rovg,ep1,ep2,karman,xlv,rv, & + dz8w,psfc, & + znt,ust,hpbl,psim,psih, & + xland,hfx,qfx,wspd,br, & + dt,kpbl2d, & + exch_h,exch_m, & + wstar,delta, & + shinhong_nonlocal_flux, & + tke,el,corf, & + u10,v10, & + uoce,voce, & + rthraten,shinhong_scu_mixing, & + shinhong_dissi_heating, & + ctopo,ctopo2,dx, & + idiff,flag_bep,frc_urb2d, & + a_u_bep,a_v_bep,a_t_bep, & + a_q_bep, & + a_e_bep,b_u_bep,b_v_bep, & + b_t_bep,b_q_bep, & + b_e_bep,dlg_bep, & + dl_u_bep,sf_bep,vl_bep, & + ids,ide, jds,jde, kds,kde, & + ims,ime, jms,jme, kms,kme, & + its,ite, jts,jte, kts,kte, & + errmsg,errflg & + ) +!------------------------------------------------------------------------------- + implicit none +!------------------------------------------------------------------------------- +!-- u3d 3d u-velocity interpolated to theta points (m/s) +!-- v3d 3d v-velocity interpolated to theta points (m/s) +!-- th3d 3d potential temperature (k) +!-- t3d temperature (k) +!-- qv3d 3d water vapor mixing ratio (kg/kg) +!-- qc3d 3d cloud mixing ratio (kg/kg) +!-- qi3d 3d ice mixing ratio (kg/kg) +! (note: if P_QI RKIND + + use sf_sfclayrev,only: sf_sfclayrev_run + use sf_sfclayrev_pre,only: sf_sfclayrev_pre_run + + implicit none + private + public:: sfclayrev + + + contains + + +!================================================================================================================= + subroutine sfclayrev(u3d,v3d,t3d,qv3d,p3d,dz8w, & + cp,g,rovcp,r,xlv,psfc,chs,chs2,cqs2,cpm, & + znt,ust,pblh,mavail,zol,mol,regime,psim,psih, & + fm,fh, & + xland,hfx,qfx,lh,tsk,flhc,flqc,qgh,qsfc,rmol, & + u10,v10,th2,t2,q2, & + gz1oz0,wspd,br,isfflx,dx, & + svp1,svp2,svp3,svpt0,ep1,ep2, & + karman,p1000mb,lakemask, & + ids,ide,jds,jde,kds,kde, & + ims,ime,jms,jme,kms,kme, & + its,ite,jts,jte,kts,kte, & + ustm,ck,cka,cd,cda,isftcflx,iz0tlnd, & + shalwater_z0,water_depth, & + scm_force_flux,errmsg,errflg) +!================================================================================================================= + +!--- input arguments: + integer,intent(in):: ids,ide,jds,jde,kds,kde, & + ims,ime,jms,jme,kms,kme, & + its,ite,jts,jte,kts,kte + + integer,intent(in):: isfflx + integer,intent(in):: shalwater_z0 + integer,intent(in),optional:: isftcflx, iz0tlnd + integer,intent(in),optional:: scm_force_flux + + real(kind=kind_phys),intent(in):: svp1,svp2,svp3,svpt0 + 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),dimension(ims:ime,jms:jme):: & + dx, & + mavail, & + pblh, & + psfc, & + tsk, & + xland, & + lakemask, & + water_depth + + real(kind=kind_phys),intent(in),dimension(ims:ime,kms:kme,jms:jme):: & + dz8w, & + qv3d, & + p3d, & + t3d, & + u3d, & + v3d + +!--- output arguments: + character(len=*),intent(out):: errmsg + integer,intent(out):: errflg + + real(kind=kind_phys),intent(out),dimension(ims:ime,jms:jme):: & + lh, & + u10, & + v10, & + th2, & + t2, & + q2 + + real(kind=kind_phys),intent(out),dimension(ims:ime,jms:jme),optional:: & + ck, & + cka, & + cd, & + cda + +!--- inout arguments: + real(kind=kind_phys),intent(inout),dimension(ims:ime,jms:jme):: & + regime, & + hfx, & + qfx, & + qsfc, & + mol, & + rmol, & + gz1oz0, & + wspd, & + br, & + psim, & + psih, & + fm, & + fh, & + znt, & + zol, & + ust, & + cpm, & + chs2, & + cqs2, & + chs, & + flhc, & + flqc, & + qgh + + real(kind=kind_phys),intent(inout),dimension(ims:ime,jms:jme),optional:: & + ustm + +!--- local variables and arrays: + logical:: l_isfflx + logical:: l_shalwater_z0 + logical:: l_scm_force_flux + + integer:: i,j,k + real(kind=kind_phys),dimension(its:ite):: dz1d,u1d,v1d,qv1d,p1d,t1d + + real(kind=kind_phys),dimension(its:ite):: & + dx_hv,mavail_hv,pblh_hv,psfc_hv,tsk_hv,xland_hv,water_depth_hv,lakemask_hv + real(kind=kind_phys),dimension(its:ite,kts:kte):: & + dz_hv,u_hv,v_hv,qv_hv,p_hv,t_hv + + real(kind=kind_phys),dimension(its:ite):: & + lh_hv,u10_hv,v10_hv,th2_hv,t2_hv,q2_hv + real(kind=kind_phys),dimension(its:ite):: & + ck_hv,cka_hv,cd_hv,cda_hv + + real(kind=kind_phys),dimension(its:ite):: & + regime_hv,hfx_hv,qfx_hv,qsfc_hv,mol_hv,rmol_hv,gz1oz0_hv,wspd_hv, & + br_hv,psim_hv,psih_hv,fm_hv,fh_hv,znt_hv,zol_hv,ust_hv,cpm_hv, & + chs2_hv,cqs2_hv,chs_hv,flhc_hv,flqc_hv,qgh_hv + real(kind=kind_phys),dimension(its:ite):: & + ustm_hv + +!----------------------------------------------------------------------------------------------------------------- + + l_isfflx = .false. + l_shalwater_z0 = .false. + l_scm_force_flux = .false. + if(isfflx .eq. 1) l_isfflx = .true. + if(shalwater_z0 .eq. 1) l_shalwater_z0 = .true. + if(scm_force_flux .eq. 1) l_scm_force_flux = .true. + + do j = jts,jte + + do i = its,ite + !input arguments: + dx_hv(i) = dx(i,j) + mavail_hv(i) = mavail(i,j) + pblh_hv(i) = pblh(i,j) + psfc_hv(i) = psfc(i,j) + tsk_hv(i) = tsk(i,j) + xland_hv(i) = xland(i,j) + lakemask_hv(i) = lakemask(i,j) + water_depth_hv(i) = water_depth(i,j) + + do k = kts,kte + dz_hv(i,k) = dz8w(i,k,j) + u_hv(i,k) = u3d(i,k,j) + v_hv(i,k) = v3d(i,k,j) + qv_hv(i,k) = qv3d(i,k,j) + p_hv(i,k) = p3d(i,k,j) + t_hv(i,k) = t3d(i,k,j) + enddo + + !inout arguments: + regime_hv(i) = regime(i,j) + hfx_hv(i) = hfx(i,j) + qfx_hv(i) = qfx(i,j) + qsfc_hv(i) = qsfc(i,j) + mol_hv(i) = mol(i,j) + rmol_hv(i) = rmol(i,j) + gz1oz0_hv(i) = gz1oz0(i,j) + wspd_hv(i) = wspd(i,j) + br_hv(i) = br(i,j) + psim_hv(i) = psim(i,j) + psih_hv(i) = psih(i,j) + fm_hv(i) = fm(i,j) + fh_hv(i) = fh(i,j) + znt_hv(i) = znt(i,j) + zol_hv(i) = zol(i,j) + ust_hv(i) = ust(i,j) + cpm_hv(i) = cpm(i,j) + chs2_hv(i) = chs2(i,j) + cqs2_hv(i) = cqs2(i,j) + chs_hv(i) = chs(i,j) + flhc_hv(i) = flhc(i,j) + flqc_hv(i) = flqc(i,j) + qgh_hv(i) = qgh(i,j) + enddo + + if(present(ustm)) then + do i = its,ite + ustm_hv(i) = ustm(i,j) + enddo + endif + + call sf_sfclayrev_pre_run(dz2d=dz_hv,u2d=u_hv,v2d=v_hv,qv2d=qv_hv,p2d=p_hv,t2d=t_hv, & + dz1d=dz1d,u1d=u1d,v1d=v1d,qv1d=qv1d,p1d=p1d,t1d=t1d, & + its=its,ite=ite,kts=kts,kte=kte,errmsg=errmsg,errflg=errflg) + + call sf_sfclayrev_run(ux=u1d,vx=v1d,t1d=t1d,qv1d=qv1d,p1d=p1d,dz8w1d=dz1d, & + cp=cp,g=g,rovcp=rovcp,r=r,xlv=xlv,psfcpa=psfc_hv,chs=chs_hv, & + chs2=chs2_hv,cqs2=cqs2_hv,cpm=cpm_hv,pblh=pblh_hv, & + rmol=rmol_hv,znt=znt_hv,ust=ust_hv,mavail=mavail_hv, & + zol=zol_hv,mol=mol_hv,regime=regime_hv,psim=psim_hv, & + psih=psih_hv,fm=fm_hv,fh=fh_hv,xland=xland_hv,lakemask=lakemask_hv, & + hfx=hfx_hv,qfx=qfx_hv,tsk=tsk_hv,u10=u10_hv, & + v10=v10_hv,th2=th2_hv,t2=t2_hv,q2=q2_hv,flhc=flhc_hv, & + 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, & + p1000mb=p1000mb,shalwater_z0=l_shalwater_z0,water_depth=water_depth_hv, & + isftcflx=isftcflx,iz0tlnd=iz0tlnd,scm_force_flux=l_scm_force_flux, & + ustm=ustm_hv,ck=ck_hv,cka=cka_hv,cd=cd_hv,cda=cda_hv, & + its=its,ite=ite,errmsg=errmsg,errflg=errflg & + ) + + do i = its,ite + !output arguments: + lh(i,j) = lh_hv(i) + u10(i,j) = u10_hv(i) + v10(i,j) = v10_hv(i) + th2(i,j) = th2_hv(i) + t2(i,j) = t2_hv(i) + q2(i,j) = q2_hv(i) + + !inout arguments: + regime(i,j) = regime_hv(i) + hfx(i,j) = hfx_hv(i) + qfx(i,j) = qfx_hv(i) + qsfc(i,j) = qsfc_hv(i) + mol(i,j) = mol_hv(i) + rmol(i,j) = rmol_hv(i) + gz1oz0(i,j) = gz1oz0_hv(i) + wspd(i,j) = wspd_hv(i) + br(i,j) = br_hv(i) + psim(i,j) = psim_hv(i) + psih(i,j) = psih_hv(i) + fm(i,j) = fm_hv(i) + fh(i,j) = fh_hv(i) + znt(i,j) = znt_hv(i) + zol(i,j) = zol_hv(i) + ust(i,j) = ust_hv(i) + cpm(i,j) = cpm_hv(i) + chs2(i,j) = chs2_hv(i) + cqs2(i,j) = cqs2_hv(i) + chs(i,j) = chs_hv(i) + flhc(i,j) = flhc_hv(i) + flqc(i,j) = flqc_hv(i) + qgh(i,j) = qgh_hv(i) + enddo + + !optional output arguments: + if(present(ck) .and. present(cka) .and. present(cd) .and. present(cda)) then + do i = its,ite + ck(i,j) = ck_hv(i) + cka(i,j) = cka_hv(i) + cd(i,j) = cd_hv(i) + cda(i,j) = cda_hv(i) + enddo + endif + + !optional inout arguments: + if(present(ustm)) then + do i = its,ite + ustm(i,j) = ustm_hv(i) + enddo + endif + + enddo + + end subroutine sfclayrev + +!================================================================================================================= + end module module_sf_sfclayrev +!================================================================================================================= diff --git a/src/core_atmosphere/prt b/src/core_atmosphere/prt new file mode 100644 index 0000000000..cc3c50cb62 --- /dev/null +++ b/src/core_atmosphere/prt @@ -0,0 +1,300 @@ +408a409 +> +473a475 +> +523a526 +> +1437c1440 +< description="Coriolis parameter at an cell"/> +> +> +--- +> packages="bl_mynn_in;bl_ysu_in;bl_shinhong_in;cu_ntiedtke_in;mp_kessler_in;mp_thompson_in;mp_thompson_aers_in;mp_wsm6_in"/> +1647c1653 +< packages="bl_mynn_in;bl_ysu_in;cu_ntiedtke_in;mp_thompson_in;mp_thompson_aers_in;mp_wsm6_in"/> +--- +> packages="bl_mynn_in;bl_ysu_in;bl_shinhong_in;cu_ntiedtke_in;mp_thompson_in;mp_thompson_aers_in;mp_wsm6_in"/> +1990c1996 +< packages="bl_mynn_in;bl_ysu_in;cu_ntiedtke_in;mp_kessler_in;mp_thompson_in;mp_thompson_aers_in;mp_wsm6_in"/> +--- +> packages="bl_mynn_in;bl_ysu_in;bl_shinhong_in;cu_ntiedtke_in;mp_kessler_in;mp_thompson_in;mp_thompson_aers_in;mp_wsm6_in"/> +1998c2004 +< packages="bl_mynn_in;bl_ysu_in;cu_ntiedtke_in;mp_thompson_in;mp_thompson_aers_in;mp_wsm6_in"/> +--- +> packages="bl_mynn_in;bl_ysu_in;bl_shinhong_in;cu_ntiedtke_in;mp_thompson_in;mp_thompson_aers_in;mp_wsm6_in"/> +2207a2214,2228 +> units="-" +> description="logical for turning on/off top-down, radiation_driven mixing" +> possible_values=".true. to turn on top-down radiation_driven mixing; .false. otherwise"/> +> +> units="-" +> description="logical for shinhong nonlocal flux" +> possible_values=".true. to turn on shinhong nonlocal flux; .false. ysu nonlocal"/> +> +> units="-" +> description="logical for kinetic energy dissipative heating" +> possible_values=".true. to turn on dissipative heating; .false. otherwise"/> +> +2276c2297 +< possible_values="`suite',`bl_ysu',`bl_mynn',`off'"/> +--- +> possible_values="`suite',`bl_ysu',`bl_shinhong',`bl_mynn',`off'"/> +2281c2302 +< possible_values="`suite',`bl_ysu_gwdo',`bl_ugwp_gwdo',`off'"/> +--- +> possible_values="`suite',`bl_kim_gwdo',`bl_ugwp_gwdo',`off'"/> +2453a2475,2490 +> units="-" +> description="Effective grid length ratio in kim_gwdo scheme" +> possible_values="Non-negative real values"/> +> units="-" +> description="Logical index for nonhydrostatic effect in kim_gwdo scheme" +> possible_values="true. or .false."/> +> units="-" +> description="Tubulent orographic form drag (tofd) in kim_gwdo scheme" +> possible_values="true. or .false."/> +> units="-" +> description="Factor in kim_tofd scheme" +> possible_values="Non-negative real values"/> +2654c2691 +< packages="bl_mynn_in;bl_ysu_in"/> +--- +> packages="bl_mynn_in;bl_ysu_in;bl_shinhong_in"/> +2658c2695 +< packages="bl_mynn_in;bl_ysu_in"/> +--- +> packages="bl_mynn_in;bl_ysu_in;bl_shinhong_in"/> +2662c2699 +< packages="bl_mynn_in;bl_ysu_in"/> +--- +> packages="bl_mynn_in;bl_ysu_in;bl_shinhong_in"/> +2666c2703 +< packages="bl_mynn_in;bl_ysu_in"/> +--- +> packages="bl_mynn_in;bl_ysu_in;bl_shinhong_in"/> +2670c2707 +< packages="bl_mynn_in;bl_ysu_in"/> +--- +> packages="bl_mynn_in;bl_ysu_in;bl_shinhong_in"/> +2671a2709,2711 +> description="turbulent kinetic energy from PBL" +> packages="bl_mynn_in;bl_shinhong_in"/> +2673c2713,2718 +< +--- +> description="mixing length from PBL scheme" +> packages="bl_mynn_in;bl_shinhong_in"/> +> +> +> +2676c2721 +< packages="bl_ysu_in"/> +--- +> packages="bl_ysu_in;bl_shinhong_in"/> +2680c2725 +< packages="bl_ysu_in"/> +--- +> packages="bl_ysu_in;bl_shinhong_in"/> +2684c2729 +< packages="bl_ysu_in"/> +--- +> packages="bl_ysu_in;bl_shinhong_in"/> +2704,2707d2748 +< +< +2724,2727d2764 +< +< +2795c2832 +< packages="bl_mynn_in;bl_ysu_in"/> +--- +> packages="bl_mynn_in;bl_ysu_in;bl_shinhong_in"/> +2799c2836 +< packages="bl_mynn_in;bl_ysu_in"/> +--- +> packages="bl_mynn_in;bl_ysu_in;bl_shinhong_in"/> +2803c2840 +< packages="bl_mynn_in;bl_ysu_in"/> +--- +> packages="bl_mynn_in;bl_ysu_in;bl_shinhong_in"/> +2807c2844 +< packages="bl_mynn_in;bl_ysu_in"/> +--- +> packages="bl_mynn_in;bl_ysu_in;bl_shinhong_in"/> +2811c2848 +< packages="bl_mynn_in;bl_ysu_in"/> +--- +> packages="bl_mynn_in;bl_ysu_in;bl_shinhong_in"/> +2815c2852 +< packages="bl_mynn_in;bl_ysu_in"/> +--- +> packages="bl_mynn_in;bl_ysu_in;bl_shinhong_in"/> +2819c2856 +< packages="bl_mynn_in;bl_ysu_in"/> +--- +> packages="bl_mynn_in;bl_ysu_in;bl_shinhong_in"/> +2823c2860 +< packages="bl_mynn_in;bl_ysu_in"/> +--- +> packages="bl_mynn_in;bl_ysu_in;bl_shinhong_in"/> +2827c2864 +< packages="bl_mynn_in;bl_ysu_in"/> +--- +> packages="bl_mynn_in;bl_ysu_in;bl_shinhong_in"/> +2831c2868 +< packages="bl_mynn_in;bl_ysu_in"/> +--- +> packages="bl_mynn_in;bl_ysu_in;bl_shinhong_in"/> +2835c2872 +< packages="bl_mynn_in;bl_ysu_in"/> +--- +> packages="bl_mynn_in;bl_ysu_in;bl_shinhong_in"/> +2839c2876 +< packages="bl_mynn_in;bl_ysu_in"/> +--- +> packages="bl_mynn_in;bl_ysu_in;bl_shinhong_in"/> +2843c2880 +< packages="bl_mynn_in;bl_ysu_in"/> +--- +> packages="bl_mynn_in;bl_ysu_in;bl_shinhong_in"/> +2847c2884 +< packages="bl_mynn_in;bl_ysu_in"/> +--- +> packages="bl_mynn_in;bl_ysu_in;bl_shinhong_in"/> +2851c2888 +< packages="bl_mynn_in;bl_ysu_in"/> +--- +> packages="bl_mynn_in;bl_ysu_in;bl_shinhong_in"/> +2855c2892 +< packages="bl_mynn_in;bl_ysu_in"/> +--- +> packages="bl_mynn_in;bl_ysu_in;bl_shinhong_in"/> +2859c2896 +< packages="bl_mynn_in;bl_ysu_in"/> +--- +> packages="bl_mynn_in;bl_ysu_in;bl_shinhong_in"/> +2863c2900 +< packages="bl_mynn_in;bl_ysu_in"/> +--- +> packages="bl_mynn_in;bl_ysu_in;bl_shinhong_in"/> +2867c2904 +< packages="bl_mynn_in;bl_ysu_in"/> +--- +> packages="bl_mynn_in;bl_ysu_in;bl_shinhong_in"/> +2871c2908 +< packages="bl_mynn_in;bl_ysu_in"/> +--- +> packages="bl_mynn_in;bl_ysu_in;bl_shinhong_in"/> +2875c2912 +< packages="bl_mynn_in;bl_ysu_in"/> +--- +> packages="bl_mynn_in;bl_ysu_in;bl_shinhong_in"/> +2879c2916 +< packages="bl_mynn_in;bl_ysu_in"/> +--- +> packages="bl_mynn_in;bl_ysu_in;bl_shinhong_in"/> +2883c2920 +< packages="bl_mynn_in;bl_ysu_in"/> +--- +> packages="bl_mynn_in;bl_ysu_in;bl_shinhong_in"/> +2887c2924 +< packages="bl_mynn_in;bl_ysu_in"/> +--- +> packages="bl_mynn_in;bl_ysu_in;bl_shinhong_in"/> +2891c2928 +< packages="bl_mynn_in;bl_ysu_in"/> +--- +> packages="bl_mynn_in;bl_ysu_in;bl_shinhong_in"/> +2895c2932 +< packages="bl_mynn_in;bl_ysu_in"/> +--- +> packages="bl_mynn_in;bl_ysu_in;bl_shinhong_in"/> +2899c2936 +< packages="bl_mynn_in;bl_ysu_in"/> +--- +> packages="bl_mynn_in;bl_ysu_in;bl_shinhong_in"/> +2905c2942 +< packages="bl_ysu_in"/> +--- +> packages="bl_ysu_in;bl_shinhong_in"/> +2909c2946 +< packages="bl_ysu_in"/> +--- +> packages="bl_ysu_in;bl_shinhong_in"/> +2931c2968 +< +--- +> packages="bl_mynn_in;bl_ysu_in;bl_shinhong_in"/> +3556c3593 +< packages="bl_mynn_in;bl_ysu_in"/> +--- +> packages="bl_mynn_in;bl_ysu_in;bl_shinhong_in"/> +3560c3597 +< packages="bl_mynn_in;bl_ysu_in"/> +--- +> packages="bl_mynn_in;bl_ysu_in;bl_shinhong_in"/> +3564c3601 +< packages="bl_mynn_in;bl_ysu_in"/> +--- +> packages="bl_mynn_in;bl_ysu_in;bl_shinhong_in"/> +3568c3605 +< packages="bl_mynn_in;bl_ysu_in"/> +--- +> packages="bl_mynn_in;bl_ysu_in;bl_shinhong_in"/> +3572c3609 +< packages="bl_mynn_in;bl_ysu_in"/> +--- +> packages="bl_mynn_in;bl_ysu_in;bl_shinhong_in"/> +3784a3822,3823 +> description="elevation maximum over a grid cell"/> +3888c3927 +< Date: Tue, 23 Dec 2025 11:45:52 -0700 Subject: [PATCH 07/19] deleted: module_bl_gwdo.F-org --- .../physics/physics_wrf/module_bl_gwdo.F-org | 241 ------------------ 1 file changed, 241 deletions(-) delete mode 100644 src/core_atmosphere/physics/physics_wrf/module_bl_gwdo.F-org diff --git a/src/core_atmosphere/physics/physics_wrf/module_bl_gwdo.F-org b/src/core_atmosphere/physics/physics_wrf/module_bl_gwdo.F-org deleted file mode 100644 index ae95ed5d62..0000000000 --- a/src/core_atmosphere/physics/physics_wrf/module_bl_gwdo.F-org +++ /dev/null @@ -1,241 +0,0 @@ -!================================================================================================================= - module module_bl_gwdo - use mpas_kind_types,only: kind_phys => RKIND - use bl_gwdo - - implicit none - private - public:: gwdo - - - contains - - -!================================================================================================================= - subroutine gwdo(u3d,v3d,t3d,qv3d,p3d,p3di,pi3d,z, & - rublten,rvblten, & - dtaux3d,dtauy3d,dusfcg,dvsfcg, & - var2d,oc12d,oa2d1,oa2d2,oa2d3,oa2d4,ol2d1,ol2d2,ol2d3,ol2d4, & - sina,cosa,znu,znw,p_top, & - cp,g,rd,rv,ep1,pi, & - dt,dx,kpbl2d,itimestep, & - ids,ide, jds,jde, kds,kde, & - ims,ime, jms,jme, kms,kme, & - its,ite, jts,jte, kts,kte, & - errmsg,errflg & - ) -!================================================================================================================= -! -!-- u3d 3d u-velocity interpolated to theta points (m/s) -!-- v3d 3d v-velocity interpolated to theta points (m/s) -!-- t3d temperature (k) -!-- qv3d 3d water vapor mixing ratio (kg/kg) -!-- p3d 3d pressure (pa) -!-- p3di 3d pressure (pa) at interface level -!-- pi3d 3d exner function (dimensionless) -!-- rublten u tendency due to pbl parameterization (m/s/s) -!-- rvblten v tendency due to pbl parameterization (m/s/s) -!-- sina sine rotation angle -!-- cosa cosine rotation angle -!-- znu eta values (sigma values) -!-- cp heat capacity at constant pressure for dry air (j/kg/k) -!-- g acceleration due to gravity (m/s^2) -!-- rd gas constant for dry air (j/kg/k) -!-- z height above sea level (m) -!-- rv gas constant for water vapor (j/kg/k) -!-- dt time step (s) -!-- dx model grid interval (m) -!-- ep1 constant for virtual temperature (r_v/r_d - 1) (dimensionless) -!-- ids start index for i in domain -!-- ide end index for i in domain -!-- jds start index for j in domain -!-- jde end index for j in domain -!-- kds start index for k in domain -!-- kde end index for k in domain -!-- ims start index for i in memory -!-- ime end index for i in memory -!-- jms start index for j in memory -!-- jme end index for j in memory -!-- kms start index for k in memory -!-- kme end index for k in memory -!-- its start index for i in tile -!-- ite end index for i in tile -!-- jts start index for j in tile -!-- jte end index for j in tile -!-- kts start index for k in tile -!-- kte end index for k in tile -! -!================================================================================================================= - -!--- input arguments: - integer,intent(in):: ids,ide,jds,jde,kds,kde, & - ims,ime,jms,jme,kms,kme, & - its,ite,jts,jte,kts,kte - integer,intent(in):: itimestep - - 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),optional:: p_top - - real(kind=kind_phys),intent(in),dimension(kms:kme),optional:: & - znu, & - znw - - real(kind=kind_phys),intent(in),dimension(ims:ime,jms:jme):: & - dx, & - var2d, & - oc12d, & - oa2d1,oa2d2,oa2d3,oa2d4, & - ol2d1,ol2d2,ol2d3,ol2d4, & - sina,cosa - - real(kind=kind_phys),intent(in),dimension(ims:ime,kms:kme,jms:jme):: & - qv3d, & - p3d, & - pi3d, & - t3d, & - u3d, & - v3d, & - z - - real(kind=kind_phys),intent(in),dimension(ims:ime,kms:kme,jms:jme):: & - p3di - -!--- output arguments: - character(len=*),intent(out):: errmsg - - integer,intent(out):: errflg - - real(kind=kind_phys),intent(out),dimension(ims:ime,jms:jme):: & - dusfcg, & - dvsfcg - - real(kind=kind_phys),intent(out),dimension(ims:ime,kms:kme,jms:jme ):: & - dtaux3d, & - dtauy3d - -!--- inout arguments: - real(kind=kind_phys),intent(inout),dimension(ims:ime,kms:kme,jms:jme):: & - rublten, & - rvblten - -!--- local variables and arrays: - integer:: i,j,k - - real(kind=kind_phys),dimension(its:ite):: & - var2d_hv,oc12d_hv,dx_hv,sina_hv,cosa_hv - real(kind=kind_phys),dimension(its:ite):: & - oa2d1_hv,oa2d2_hv,oa2d3_hv,oa2d4_hv,ol2d1_hv,ol2d2_hv,ol2d3_hv,ol2d4_hv - real(kind=kind_phys),dimension(its:ite):: & - dusfcg_hv,dvsfcg_hv - - real(kind=kind_phys),dimension(its:ite,kts:kte):: & - u3d_hv,v3d_hv,t3d_hv,qv3d_hv,pi3d_hv,p3d_hv,z_hv - - real(kind=kind_phys),dimension(its:ite,kts:kte):: & - rublten_hv,rvblten_hv,dtaux3d_hv,dtauy3d_hv - - real(kind=kind_phys),dimension(its:ite,kms:kme):: & - p3di_hv - -!----------------------------------------------------------------------------------------------------------------- - -! Outer j-loop. Allows consistency between WRF and MPAS in the driver. - - do j = jts,jte - - ! All variables for gwdo2d are tile-sized and have only a single - ! horizontal dimension. The _hv suffix refers to "horizontal vertical", - ! a reminder that there is a single horizontal index. Yes, we know that - ! variables that have only a horizontal index are not *really* _hv. - - ! All of the following 3d and 2d variables are declared intent(in) in the - ! gwdo2d subroutine, so there is no need to put the updated values back - ! from the temporary arrays back into the original arrays. - - ! Variables that are INTENT(IN) or INTENT(INOUT) - - ! 3d, interface levels: - do k = kts,kte+1 - do i = its,ite - p3di_hv(i,k) = p3di(i,k,j) - enddo - enddo - - ! 3d, layers: - do k = kts,kte - do i = its,ite - rublten_hv(i,k) = rublten(i,k,j) - rvblten_hv(i,k) = rvblten(i,k,j) - u3d_hv(i,k) = u3d(i,k,j) - v3d_hv(i,k) = v3d(i,k,j) - t3d_hv(i,k) = t3d(i,k,j) - qv3d_hv(i,k) = qv3d(i,k,j) - p3d_hv(i,k) = p3d(i,k,j) - pi3d_hv(i,k) = pi3d(i,k,j) - z_hv(i,k) = z(i,k,j) - enddo - enddo - - ! 2d: - do i = its,ite - dx_hv(i) = dx(i,j) - var2d_hv(i) = var2d(i,j) - oc12d_hv(i) = oc12d(i,j) - sina_hv(i) = sina(i,j) - cosa_hv(i) = cosa(i,j) - oa2d1_hv(i) = oa2d1(i,j) - oa2d2_hv(i) = oa2d2(i,j) - oa2d3_hv(i) = oa2d3(i,j) - oa2d4_hv(i) = oa2d4(i,j) - ol2d1_hv(i) = ol2d1(i,j) - ol2d2_hv(i) = ol2d2(i,j) - ol2d3_hv(i) = ol2d3(i,j) - ol2d4_hv(i) = ol2d4(i,j) - enddo - - call bl_gwdo_run(sina=sina_hv,cosa=cosa_hv & - ,rublten=rublten_hv,rvblten=rvblten_hv & - ,dtaux3d=dtaux3d_hv,dtauy3d=dtauy3d_hv & - ,dusfcg=dusfcg_hv,dvsfcg=dvsfcg_hv & - ,uproj=u3d_hv,vproj=v3d_hv & - ,t1=t3d_hv,q1=qv3d_hv & - ,prsi=p3di_hv & - ,prsl=p3d_hv,prslk=pi3d_hv & - ,zl=z_hv & - ,var=var2d_hv,oc1=oc12d_hv & - ,oa2d1=oa2d1_hv, oa2d2=oa2d2_hv & - ,oa2d3=oa2d3_hv, oa2d4=oa2d4_hv & - ,ol2d1=ol2d1_hv, ol2d2=ol2d2_hv & - ,ol2d3=ol2d3_hv, ol2d4=ol2d4_hv & - ,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 & - ,errmsg=errmsg,errflg=errflg) - - ! Variables that are INTENT(OUT) or INTENT(INOUT): - - ! 3d, layers: - do k = kts,kte - do i = its,ite - rublten(i,k,j) = rublten_hv(i,k) - rvblten(i,k,j) = rvblten_hv(i,k) - dtaux3d(i,k,j) = dtaux3d_hv(i,k) - dtauy3d(i,k,j) = dtauy3d_hv(i,k) - enddo - enddo - - ! 2d: - do i = its,ite - dusfcg(i,j) = dusfcg_hv(i) - dvsfcg(i,j) = dvsfcg_hv(i) - enddo - - enddo ! Outer J-loop - - end subroutine gwdo - -!================================================================================================================= -end module module_bl_gwdo -!================================================================================================================= From cf32904455c5220aa86366f9dff35c52bcbea2e0 Mon Sep 17 00:00:00 2001 From: Songyou Hong Date: Tue, 23 Dec 2025 12:48:50 -0700 Subject: [PATCH 08/19] Delete src/core_atmosphere/physics/mpas_atmphys_control.F-org --- .../physics/mpas_atmphys_control.F-org | 538 ------------------ 1 file changed, 538 deletions(-) delete mode 100644 src/core_atmosphere/physics/mpas_atmphys_control.F-org diff --git a/src/core_atmosphere/physics/mpas_atmphys_control.F-org b/src/core_atmosphere/physics/mpas_atmphys_control.F-org deleted file mode 100644 index b3162019e5..0000000000 --- a/src/core_atmosphere/physics/mpas_atmphys_control.F-org +++ /dev/null @@ -1,538 +0,0 @@ -! Copyright (c) 2013, Los Alamos National Security, LLC (LANS) -! and the University Corporation for Atmospheric Research (UCAR). -! -! Unless noted otherwise source code is licensed under the BSD license. -! Additional copyright and license information can be found in the LICENSE file -! distributed with this code, or at http://mpas-dev.github.com/license.html -! -!================================================================================================================= - module mpas_atmphys_control - use mpas_dmpar - use mpas_kind_types - use mpas_pool_routines - - use mpas_atmphys_utilities - use mpas_atmphys_vars, only: l_mp_tables - - implicit none - private - public:: physics_namelist_check, & - physics_registry_init, & - physics_tables_init, & - physics_compatibility_check - - logical,public:: moist_physics - - -!MPAS control and initialization routines. -!Laura D. Fowler (send comments to laura@ucar.edu). -!2013-05-01. -! -! subroutines called in mpas_atmphys_control: -! ------------------------------------------- -! * physics_namelist_check: checks that physics namelist parameters are defined correctly. -! * physics_registry_init : initializes thicknesses of soil layers for NOAH land-surface scheme. -! -! add-ons and modifications to sourcecode: -! ---------------------------------------- -! * removed the namelist option config_eddy_scheme and associated sourcecode. -! * removed the namelist option config_conv_shallow_scheme and associated sourcecode. -! * removed controls to the updated Kain-Fritsch convection scheme. -! Laura D. Fowler (laura@ucar.edu) / 2013-05-29. -! * throughout the sourcecode, replaced all "var_struct" defined arrays by local pointers. -! Laura D. Fowler (laura@ucar.edu) / 2014-04-22. -! * modified sourcecode to use pools. -! Laura D. Fowler (laura@ucar.edu) / 2014-05-15. -! * removed subroutine physics_idealized_init, also available in mpas_init_atm_cases.F in core_init_atmosphere. -! Laura D. Fowler (laura@ucar.edu) / 2014-08-11. -! * renamed config_conv_deep_scheme to config_convection_scheme. -! Laura D. Fowler (laura@ucar.edu) / 2014-09-18. -! * renamed "wsm6" to "mp_wsm6" and "kessler" to "mp_kessler". -! Laura D. Fowler (laura@ucar.edu) / 2016-03-09. -! * renamed "kain_fritsch" to "cu_kain_fritsch" and "tiedtke" to "cu_tiedtke". -! Laura D. Fowler (laura@ucar.edu) / 2016-03-22. -! * renamed "ysu" to "bl_ysu", "ysu_gwdo" to "bl_gwdo_ysu", and "monin_obukhov" to "sf_monin_obukhov". -! Laura D. Fowler (laura@ucar.edu) / 2016-03-25. -! * added the option mp_thompson. -! Laura D. Fowler (laura@ucar.edu) / 2016-03-25. -! * added the option cu_grell_freitas. -! Laura D. Fowler (laura@ucar.edu) / 2016-03-31. -! * added the options sf_mynn and bl_mynn and for the MYNN parameterization from WRF version 3.6.1. -! Laura D. Fowler (laura@ucar.edu) / 2016-04-11. -! * added the option cu_ntiedtke for the "new" Tiedtke parameterization of convection from WRF version 3.8.1. -! Laura D. Fowler (laura@ucar.edu) / 2016-09-19. -! * added the physics suite "convection_scale_aware" (see below for the physics options used in the suite). -! Laura D. Fowler (laura@ucar.edu) / 2016-10-28. -! * added the subroutine physics_tables_init which checks if the files containing the lokk-up tables for the -! Thompson cloud microphysics are available or not. -! Laura D. Fowler (laura@ucar.edu) / 2016-11-01. -! * modified checking the config_gwdo_scheme option to allow bl_ysu_gwdo to be run when the MYNN pbl and surface -! layer scheme options are chosen. -! Laura D. Fowler (laura@ucar.edu) / 2016-12-22. -! * modified logic in subroutine physics_tables_init so that the Thompson microphysics tables are read in each -! MPI task. -! Laura D. Fowler (laura@ucar.edu) / 2016-12-30. -! * added the option mp_thompson_aerosols. -! Laura D. Fowler (laura@ucar.edu) / 2018-01-31. -! * added the option sf_monin_obukhov_rev to run the revised surface layer scheme with the YSU PBL scheme. -! Laura D. Fowler (laura@ucar.edu) / 2023-05-15. -! * replaced the option "noah" with "sf_noah" to run the NOAH land surface scheme. -! Laura D. Fowler (laura@ucar.edu) / 2022-02-18. -! * added the option "sf_noahmp" to run the NOAH-MP land surface scheme. -! Laura D. Fowler (laura@ucar.edu) / 2022-07-15. -! * 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. - - - contains - - -!================================================================================================================= - subroutine physics_namelist_check(configs) -!================================================================================================================= - -!input arguments: - type(mpas_pool_type),intent(in):: configs - -!local pointers: - character(len=StrKIND),pointer:: config_physics_suite, & - config_microp_scheme, & - config_convection_scheme, & - config_lsm_scheme, & - config_pbl_scheme, & - config_gwdo_scheme, & - config_radt_cld_scheme, & - config_radt_lw_scheme, & - config_radt_sw_scheme, & - config_sfclayer_scheme - -!----------------------------------------------------------------------------------------------------------------- -!call mpas_log_write('') -!call mpas_log_write('--- enter subroutine physics_namelist_check:') - - call mpas_pool_get_config(configs,'config_physics_suite' ,config_physics_suite ) - call mpas_pool_get_config(configs,'config_microp_scheme' ,config_microp_scheme ) - call mpas_pool_get_config(configs,'config_convection_scheme',config_convection_scheme) - call mpas_pool_get_config(configs,'config_lsm_scheme' ,config_lsm_scheme ) - call mpas_pool_get_config(configs,'config_pbl_scheme' ,config_pbl_scheme ) - call mpas_pool_get_config(configs,'config_gwdo_scheme' ,config_gwdo_scheme ) - call mpas_pool_get_config(configs,'config_radt_cld_scheme' ,config_radt_cld_scheme ) - call mpas_pool_get_config(configs,'config_radt_lw_scheme' ,config_radt_lw_scheme ) - call mpas_pool_get_config(configs,'config_radt_sw_scheme' ,config_radt_sw_scheme ) - call mpas_pool_get_config(configs,'config_sfclayer_scheme' ,config_sfclayer_scheme ) - - call mpas_log_write('') - call mpas_log_write('----- Setting up physics suite '''//trim(config_physics_suite)//''' -----') - - ! - !setup schemes according to the selected physics suite: - ! - if (trim(config_physics_suite) == 'mesoscale_reference') then - - 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_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' - if (trim(config_lsm_scheme) == 'suite') config_lsm_scheme = 'sf_noah' - - else if (trim(config_physics_suite) == 'convection_permitting') then - - 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_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' - if (trim(config_sfclayer_scheme) == 'suite') config_sfclayer_scheme = 'sf_mynn' - if (trim(config_lsm_scheme) == 'suite') config_lsm_scheme = 'sf_noah' - - else if (trim(config_physics_suite) == 'none') then - - if (trim(config_microp_scheme) == 'suite') config_microp_scheme = 'off' - if (trim(config_convection_scheme) == 'suite') config_convection_scheme = 'off' - if (trim(config_pbl_scheme) == 'suite') config_pbl_scheme = 'off' - if (trim(config_gwdo_scheme) == 'suite') config_gwdo_scheme = 'off' - if (trim(config_radt_lw_scheme) == 'suite') config_radt_lw_scheme = 'off' - if (trim(config_radt_sw_scheme) == 'suite') config_radt_sw_scheme = 'off' - if (trim(config_radt_cld_scheme) == 'suite') config_radt_cld_scheme = 'off' - if (trim(config_sfclayer_scheme) == 'suite') config_sfclayer_scheme = 'off' - if (trim(config_lsm_scheme) == 'suite') config_lsm_scheme = 'off' - - else - - write(mpas_err_message,'(A)') 'Unrecognized choice of physics suite: config_physics_suite = '''// & - trim(config_physics_suite)//'''' - call physics_error_fatal(mpas_err_message) - - end if - -!cloud microphysics scheme: - if(.not. (config_microp_scheme .eq. 'off' .or. & - config_microp_scheme .eq. 'mp_kessler' .or. & - config_microp_scheme .eq. 'mp_thompson' .or. & - config_microp_scheme .eq. 'mp_thompson_aerosols' .or. & - config_microp_scheme .eq. 'mp_wsm6')) then - - write(mpas_err_message,'(A,A20)') 'illegal value for config_microp_scheme:', & - trim(config_microp_scheme) - call physics_error_fatal(mpas_err_message) - - endif - -!convection scheme: - if(.not. (config_convection_scheme .eq. 'off' .or. & - config_convection_scheme .eq. 'cu_grell_freitas' .or. & - config_convection_scheme .eq. 'cu_kain_fritsch' .or. & - config_convection_scheme .eq. 'cu_tiedtke' .or. & - config_convection_scheme .eq. 'cu_ntiedtke')) then - - write(mpas_err_message,'(A,A20)') 'illegal value for config_convection_scheme: ', & - trim(config_convection_scheme) - call physics_error_fatal(mpas_err_message) - - endif - -!pbl scheme: - if(.not. (config_pbl_scheme .eq. 'off' .or. & - config_pbl_scheme .eq. 'bl_mynn' .or. & - config_pbl_scheme .eq. 'bl_ysu')) then - - write(mpas_err_message,'(A,A20)') 'illegal value for pbl_scheme: ', & - trim(config_pbl_scheme) - call physics_error_fatal(mpas_err_message) - - endif - -!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_ugwp_gwdo')) then - - write(mpas_err_message,'(A,A20)') 'illegal value for gwdo_scheme: ', & - trim(config_gwdo_scheme) - call physics_error_fatal(mpas_err_message) - - endif - -!lw radiation scheme: - if(.not. (config_radt_lw_scheme .eq. 'off' .or. & - config_radt_lw_scheme .eq. 'cam_lw' .or. & - config_radt_lw_scheme .eq. 'rrtmg_lw')) then - - write(mpas_err_message,'(A,A20)') 'illegal value for longwave radiation scheme: ', & - trim(config_radt_lw_scheme) - call physics_error_fatal(mpas_err_message) - - endif - -!sw radiation scheme: - if(.not. (config_radt_sw_scheme .eq. 'off' .or. & - config_radt_sw_scheme .eq. 'cam_sw' .or. & - config_radt_sw_scheme .eq. 'rrtmg_sw')) then - - write(mpas_err_message,'(A,A20)') 'illegal value for shortwave radiation _scheme: ', & - trim(config_radt_sw_scheme) - call physics_error_fatal(mpas_err_message) - - endif - -!cloud fraction for radiation schemes: - if(.not. (config_radt_cld_scheme .eq. 'off' .or. & - config_radt_cld_scheme .eq. 'cld_incidence' .or. & - config_radt_cld_scheme .eq. 'cld_fraction' .or. & - config_radt_cld_scheme .eq. 'cld_fraction_thompson')) then - - write(mpas_err_message,'(A,A20)') 'illegal value for calculation of cloud fraction: ', & - trim(config_radt_cld_scheme) - call physics_error_fatal(mpas_err_message) - - endif - if((config_radt_lw_scheme.ne.'off' .and. config_radt_cld_scheme.eq.'off') .or. & - (config_radt_sw_scheme.ne.'off' .and. config_radt_cld_scheme.eq.'off')) then - - call mpas_log_write('') - write(mpas_err_message,'(A,A20)') & - ' config_radt_cld_scheme is not set for radiation calculation' - call physics_message(mpas_err_message) - write(mpas_err_message,'(A,A20)') & - ' switch calculation of cloud fraction to config_radt_cld_scheme = cld_incidence' - call physics_message(mpas_err_message) - config_radt_cld_scheme = "cld_incidence" - - endif - -!surface-layer scheme: - if(.not. (config_sfclayer_scheme .eq. 'off' .or. & - config_sfclayer_scheme .eq. 'sf_mynn' .or. & - config_sfclayer_scheme .eq. 'sf_monin_obukhov' .or. & - config_sfclayer_scheme .eq. 'sf_monin_obukhov_rev')) then - - write(mpas_err_message,'(A,A20)') 'illegal value for surface layer scheme: ', & - trim(config_sfclayer_scheme) - call physics_error_fatal(mpas_err_message) - else - if(config_pbl_scheme == 'bl_mynn') then - config_sfclayer_scheme = 'sf_mynn' - elseif(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: ', & - trim(config_sfclayer_scheme) - call physics_error_fatal(mpas_err_message) - endif - endif - endif - -!land-surface scheme: note that config_sfclayer_scheme must be defined for the land-surface -!scheme to be called: - if(config_lsm_scheme .ne. 'off' .and. config_sfclayer_scheme .eq. 'off') then - - call physics_error_fatal('land surface scheme: ' // & - 'set config_sfclayer_scheme different than off') - - elseif(.not. (config_lsm_scheme .eq. 'off ' .or. & - config_lsm_scheme .eq. 'sf_noah' .or. & - config_lsm_scheme .eq. 'sf_noahmp')) then - - write(mpas_err_message,'(A,A20)') 'illegal value for land surface scheme: ', & - trim(config_lsm_scheme) - call physics_error_fatal(mpas_err_message) - - endif - -!checks if any physics process is called. if not, return: - moist_physics = .true. - - if(config_microp_scheme .eq. 'off' .and. & - config_convection_scheme .eq. 'off' .and. & - config_lsm_scheme .eq. 'off' .and. & - config_pbl_scheme .eq. 'off' .and. & - config_radt_lw_scheme .eq. 'off' .and. & - config_radt_sw_scheme .eq. 'off' .and. & - config_sfclayer_scheme .eq. 'off') moist_physics = .false. - - call mpas_log_write('') - call mpas_log_write(' config_microp_scheme = '//trim(config_microp_scheme)) - call mpas_log_write(' config_convection_scheme = '//trim(config_convection_scheme)) - call mpas_log_write(' config_pbl_scheme = '//trim(config_pbl_scheme)) - call mpas_log_write(' config_gwdo_scheme = '//trim(config_gwdo_scheme)) - call mpas_log_write(' config_radt_cld_scheme = '//trim(config_radt_cld_scheme)) - call mpas_log_write(' config_radt_lw_scheme = '//trim(config_radt_lw_scheme)) - call mpas_log_write(' config_radt_sw_scheme = '//trim(config_radt_sw_scheme)) - call mpas_log_write(' config_sfclayer_scheme = '//trim(config_sfclayer_scheme)) - call mpas_log_write(' config_lsm_scheme = '//trim(config_lsm_scheme)) - call mpas_log_write('') - - end subroutine physics_namelist_check - -!================================================================================================================= - subroutine physics_registry_init(mesh,configs,sfc_input) -!================================================================================================================= - -!input arguments: - type(mpas_pool_type),intent(in):: mesh - type(mpas_pool_type),intent(in):: configs - -!inout arguments: - type(mpas_pool_type),intent(inout):: sfc_input - -!local pointers: - logical,pointer:: config_do_restart - character(len=StrKIND),pointer:: config_lsm_scheme - integer,pointer:: nCells - integer,dimension(:),pointer:: landmask - - real(kind=RKIND),dimension(:,:),pointer:: dzs - -!local variables: - integer:: iCell - -!----------------------------------------------------------------------------------------------------------------- - - call mpas_pool_get_config(configs,'config_do_restart',config_do_restart) - call mpas_pool_get_config(configs,'config_lsm_scheme',config_lsm_scheme) - - call mpas_pool_get_dimension(mesh,'nCells',nCells) - - call mpas_pool_get_array(sfc_input,'landmask',landmask) - call mpas_pool_get_array(sfc_input,'dzs' , dzs ) - -!initialization of input variables, if needed: - - if(.not. config_do_restart) then - - lsm_select: select case(trim(config_lsm_scheme)) - - case("sf_noah","sf_noahmp") - !initialize the thickness of the soil layers for the Noah scheme: - do iCell = 1, nCells - dzs(1,iCell) = 0.10_RKIND - dzs(2,iCell) = 0.30_RKIND - dzs(3,iCell) = 0.60_RKIND - dzs(4,iCell) = 1.00_RKIND - enddo - - case default - - end select lsm_select - - endif - -!call mpas_log_write('--- enter subroutine physics_namelist_check.') -!call mpas_log_write('') - - end subroutine physics_registry_init - -!================================================================================================================= - subroutine physics_tables_init(dminfo,configs) -!================================================================================================================= - -!input arguments: - type(dm_info),intent(in):: dminfo - type(mpas_pool_type),intent(in):: configs - -!local variables: - character(len=StrKIND),pointer:: config_microp_scheme - logical:: l_qr_acr_qg,l_qr_acr_qs,l_qi_aut_qs,l_freezeH2O - -!----------------------------------------------------------------------------------------------------------------- - - l_mp_tables = .true. - - if(dminfo % my_proc_id == IO_NODE) then - - call mpas_pool_get_config(configs,'config_microp_scheme',config_microp_scheme) - if(config_microp_scheme /= "mp_thompson" .or. & - config_microp_scheme /= "mp_thompson_aerosols") return - - l_qr_acr_qg = .false. - l_qr_acr_qs = .false. - l_qi_aut_qs = .false. - l_freezeH2O = .false. - - inquire(file='MP_THOMPSON_QRacrQG_DATA.DBL' ,exist=l_qr_acr_qg) - inquire(file='MP_THOMPSON_QRacrQS_DATA.DBL' ,exist=l_qr_acr_qs) - inquire(file='MP_THOMPSON_QIautQS_DATA.DBL' ,exist=l_qi_aut_qs) - inquire(file='MP_THOMPSON_freezeH2O_DATA.DBL',exist=l_freezeH2O) - -! call mpas_log_write('') -! call mpas_log_write('--- enter subroutine physics_tables_init:') -! call mpas_log_write('l_qr_acr_qg = $l',logicArgs=(/l_qr_acr_qg/)) -! call mpas_log_write('l_qr_acr_qs = $l',logicArgs=(/l_qr_acr_qs/)) -! call mpas_log_write('l_qi_aut_qs = $l',logicArgs=(/l_qi_aut_qs/)) -! call mpas_log_write('l_freezeH2O = $l',logicArgs=(/l_freezeH2O/)) - - if(.not. (l_qr_acr_qg .and. l_qr_acr_qs .and. l_qi_aut_qs .and. l_freezeH2O)) then - write(mpas_err_message,'(A)') & - '--- tables to run the Thompson cloud microphysics scheme do not exist: run build_tables first.' - call physics_error_fatal(mpas_err_message) - endif -! call mpas_log_write('l_mp_tables = $l',logicArgs=(/l_mp_tables/)) - - endif - - end subroutine physics_tables_init - -!================================================================================================================= -! routine physics_compatibility_check() -! -!> \brief Checks physics input fields and options for compatibility -!> \author Miles Curry and Michael Duda -!> \date 25 October 2018 -!> \details -!> This routine checks the input fields and run-time options provided -!> by the user for compatibility. For example, two run-time options may -!> be mutually exclusive, or an option may require that a certain input -!> field is provided. The checks performed by this routine are only for -!> physics related fields and options. -!> -!> A value of 0 is returned if there are no incompatibilities among -!> the provided input fields and run-time options, and a non-zero value -!> otherwise. -!> - subroutine physics_compatibility_check(dminfo, blockList, streamManager, ierr) -!================================================================================================================= - - implicit none - - type (dm_info), pointer :: dminfo - type (block_type), pointer :: blockList - type (MPAS_streamManager_type), pointer :: streamManager - integer, intent(out) :: ierr - - real (kind=RKIND) :: maxvar2d_local, maxvar2d_global - real (kind=RKIND), dimension(:), pointer :: var2d - integer, pointer :: nCellsSolve - integer, pointer :: iswater_lu - integer, pointer, dimension(:) :: ivgtyp - integer :: all_water, iall_water - character (len=StrKIND), pointer :: gwdo_scheme - type (block_type), pointer :: block - type (mpas_pool_type), pointer :: meshPool - type (mpas_pool_type), pointer :: sfc_inputPool - - ierr = 0 - - call mpas_pool_get_config(blocklist % configs, 'config_gwdo_scheme', gwdo_scheme) - - if (trim(gwdo_scheme) == 'bl_ysu_gwdo') then - maxvar2d_local = -huge(maxvar2d_local) - block => blockList - do while (associated(block)) - call mpas_pool_get_subpool(block % structs, 'mesh', meshPool) - call mpas_pool_get_subpool(block % structs, 'sfc_input', sfc_inputPool) - call mpas_pool_get_dimension(meshPool, 'nCellsSolve', nCellsSolve) - call mpas_pool_get_array(sfc_inputPool, 'var2d', var2d) - - maxvar2d_local = max(maxvar2d_local, maxval(var2d(1:nCellsSolve))) - - block => block % next - end do - - call mpas_dmpar_max_real(dminfo, maxvar2d_local, maxvar2d_global) - - ! - ! The GWDO check below can fail on regional simulations that are completely above - ! water. So, check to see if the simulation is completely above water and do not - ! throw the error if it is. - ! - call mpas_pool_get_array(sfc_inputPool, 'iswater', iswater_lu) - call mpas_pool_get_array(sfc_inputPool, 'ivgtyp', ivgtyp) - if (all(ivgtyp(1:nCellsSolve) == iswater_lu)) then - all_water = 1 ! All water - else - all_water = 0 ! Land present - end if - - call mpas_dmpar_min_int(dminfo, all_water, iall_water) - - if (maxvar2d_global <= 0.0_RKIND .and. iall_water /= 1) then - call mpas_log_write('*******************************************************************************', & - messageType=MPAS_LOG_ERR) - call mpas_log_write('The YSU GWDO scheme requires valid var2d, con, oa{1,2,3,4}, and ol{1,2,3,4} fields,', & - messageType=MPAS_LOG_ERR) - call mpas_log_write('but these fields appear to be zero everywhere in the model input.', & - messageType=MPAS_LOG_ERR) - call mpas_log_write('Either set config_gwdo_scheme = ''off'' in the &physics namelist, or generate', & - messageType=MPAS_LOG_ERR) - call mpas_log_write('the GWDO static fields with the init_atmosphere core.', & - messageType=MPAS_LOG_ERR) - call mpas_log_write('*******************************************************************************', & - messageType=MPAS_LOG_ERR) - ierr = ierr + 1 - end if - - end if - - end subroutine physics_compatibility_check - -!================================================================================================================= - end module mpas_atmphys_control -!================================================================================================================= - From 388a16f666a9785951833c08f807d1164521e808 Mon Sep 17 00:00:00 2001 From: Songyou Hong Date: Tue, 23 Dec 2025 12:49:32 -0700 Subject: [PATCH 09/19] Delete src/core_atmosphere/physics/mpas_atmphys_control.F-org2 --- .../physics/mpas_atmphys_control.F-org2 | 540 ------------------ 1 file changed, 540 deletions(-) delete mode 100644 src/core_atmosphere/physics/mpas_atmphys_control.F-org2 diff --git a/src/core_atmosphere/physics/mpas_atmphys_control.F-org2 b/src/core_atmosphere/physics/mpas_atmphys_control.F-org2 deleted file mode 100644 index 1ff0417d4e..0000000000 --- a/src/core_atmosphere/physics/mpas_atmphys_control.F-org2 +++ /dev/null @@ -1,540 +0,0 @@ -! Copyright (c) 2013, Los Alamos National Security, LLC (LANS) -! and the University Corporation for Atmospheric Research (UCAR). -! -! Unless noted otherwise source code is licensed under the BSD license. -! Additional copyright and license information can be found in the LICENSE file -! distributed with this code, or at http://mpas-dev.github.com/license.html -! -!================================================================================================================= - module mpas_atmphys_control - use mpas_dmpar - use mpas_kind_types - use mpas_pool_routines - - use mpas_atmphys_utilities - use mpas_atmphys_vars, only: l_mp_tables - - implicit none - private - public:: physics_namelist_check, & - physics_registry_init, & - physics_tables_init, & - physics_compatibility_check - - logical,public:: moist_physics - - -!MPAS control and initialization routines. -!Laura D. Fowler (send comments to laura@ucar.edu). -!2013-05-01. -! -! subroutines called in mpas_atmphys_control: -! ------------------------------------------- -! * physics_namelist_check: checks that physics namelist parameters are defined correctly. -! * physics_registry_init : initializes thicknesses of soil layers for NOAH land-surface scheme. -! -! add-ons and modifications to sourcecode: -! ---------------------------------------- -! * removed the namelist option config_eddy_scheme and associated sourcecode. -! * removed the namelist option config_conv_shallow_scheme and associated sourcecode. -! * removed controls to the updated Kain-Fritsch convection scheme. -! Laura D. Fowler (laura@ucar.edu) / 2013-05-29. -! * throughout the sourcecode, replaced all "var_struct" defined arrays by local pointers. -! Laura D. Fowler (laura@ucar.edu) / 2014-04-22. -! * modified sourcecode to use pools. -! Laura D. Fowler (laura@ucar.edu) / 2014-05-15. -! * removed subroutine physics_idealized_init, also available in mpas_init_atm_cases.F in core_init_atmosphere. -! Laura D. Fowler (laura@ucar.edu) / 2014-08-11. -! * renamed config_conv_deep_scheme to config_convection_scheme. -! Laura D. Fowler (laura@ucar.edu) / 2014-09-18. -! * renamed "wsm6" to "mp_wsm6" and "kessler" to "mp_kessler". -! Laura D. Fowler (laura@ucar.edu) / 2016-03-09. -! * renamed "kain_fritsch" to "cu_kain_fritsch" and "tiedtke" to "cu_tiedtke". -! Laura D. Fowler (laura@ucar.edu) / 2016-03-22. -! * renamed "ysu" to "bl_ysu", "ysu_gwdo" to "bl_gwdo_ysu", and "monin_obukhov" to "sf_monin_obukhov". -! Laura D. Fowler (laura@ucar.edu) / 2016-03-25. -! * added the option mp_thompson. -! Laura D. Fowler (laura@ucar.edu) / 2016-03-25. -! * added the option cu_grell_freitas. -! Laura D. Fowler (laura@ucar.edu) / 2016-03-31. -! * added the options sf_mynn and bl_mynn and for the MYNN parameterization from WRF version 3.6.1. -! Laura D. Fowler (laura@ucar.edu) / 2016-04-11. -! * added the option cu_ntiedtke for the "new" Tiedtke parameterization of convection from WRF version 3.8.1. -! Laura D. Fowler (laura@ucar.edu) / 2016-09-19. -! * added the physics suite "convection_scale_aware" (see below for the physics options used in the suite). -! Laura D. Fowler (laura@ucar.edu) / 2016-10-28. -! * added the subroutine physics_tables_init which checks if the files containing the lokk-up tables for the -! Thompson cloud microphysics are available or not. -! Laura D. Fowler (laura@ucar.edu) / 2016-11-01. -! * modified checking the config_gwdo_scheme option to allow bl_ysu_gwdo to be run when the MYNN pbl and surface -! layer scheme options are chosen. -! Laura D. Fowler (laura@ucar.edu) / 2016-12-22. -! * modified logic in subroutine physics_tables_init so that the Thompson microphysics tables are read in each -! MPI task. -! Laura D. Fowler (laura@ucar.edu) / 2016-12-30. -! * added the option mp_thompson_aerosols. -! Laura D. Fowler (laura@ucar.edu) / 2018-01-31. -! * added the option sf_monin_obukhov_rev to run the revised surface layer scheme with the YSU PBL scheme. -! Laura D. Fowler (laura@ucar.edu) / 2023-05-15. -! * replaced the option "noah" with "sf_noah" to run the NOAH land surface scheme. -! Laura D. Fowler (laura@ucar.edu) / 2022-02-18. -! * added the option "sf_noahmp" to run the NOAH-MP land surface scheme. -! Laura D. Fowler (laura@ucar.edu) / 2022-07-15. -! * 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 - - -!================================================================================================================= - subroutine physics_namelist_check(configs) -!================================================================================================================= - -!input arguments: - type(mpas_pool_type),intent(in):: configs - -!local pointers: - character(len=StrKIND),pointer:: config_physics_suite, & - config_microp_scheme, & - config_convection_scheme, & - config_lsm_scheme, & - config_pbl_scheme, & - config_gwdo_scheme, & - config_radt_cld_scheme, & - config_radt_lw_scheme, & - config_radt_sw_scheme, & - config_sfclayer_scheme - -!----------------------------------------------------------------------------------------------------------------- -!call mpas_log_write('') -!call mpas_log_write('--- enter subroutine physics_namelist_check:') - - call mpas_pool_get_config(configs,'config_physics_suite' ,config_physics_suite ) - call mpas_pool_get_config(configs,'config_microp_scheme' ,config_microp_scheme ) - call mpas_pool_get_config(configs,'config_convection_scheme',config_convection_scheme) - call mpas_pool_get_config(configs,'config_lsm_scheme' ,config_lsm_scheme ) - call mpas_pool_get_config(configs,'config_pbl_scheme' ,config_pbl_scheme ) - call mpas_pool_get_config(configs,'config_gwdo_scheme' ,config_gwdo_scheme ) - call mpas_pool_get_config(configs,'config_radt_cld_scheme' ,config_radt_cld_scheme ) - call mpas_pool_get_config(configs,'config_radt_lw_scheme' ,config_radt_lw_scheme ) - call mpas_pool_get_config(configs,'config_radt_sw_scheme' ,config_radt_sw_scheme ) - call mpas_pool_get_config(configs,'config_sfclayer_scheme' ,config_sfclayer_scheme ) - - call mpas_log_write('') - call mpas_log_write('----- Setting up physics suite '''//trim(config_physics_suite)//''' -----') - - ! - !setup schemes according to the selected physics suite: - ! - if (trim(config_physics_suite) == 'mesoscale_reference') then - - 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_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' - if (trim(config_sfclayer_scheme) == 'suite') config_sfclayer_scheme = 'sf_monin_obukhov_rev' - if (trim(config_lsm_scheme) == 'suite') config_lsm_scheme = 'sf_noah' - - else if (trim(config_physics_suite) == 'convection_permitting') then - - 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_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' - if (trim(config_sfclayer_scheme) == 'suite') config_sfclayer_scheme = 'sf_mynn' - if (trim(config_lsm_scheme) == 'suite') config_lsm_scheme = 'sf_noah' - - else if (trim(config_physics_suite) == 'none') then - - if (trim(config_microp_scheme) == 'suite') config_microp_scheme = 'off' - if (trim(config_convection_scheme) == 'suite') config_convection_scheme = 'off' - if (trim(config_pbl_scheme) == 'suite') config_pbl_scheme = 'off' - if (trim(config_gwdo_scheme) == 'suite') config_gwdo_scheme = 'off' - if (trim(config_radt_lw_scheme) == 'suite') config_radt_lw_scheme = 'off' - if (trim(config_radt_sw_scheme) == 'suite') config_radt_sw_scheme = 'off' - if (trim(config_radt_cld_scheme) == 'suite') config_radt_cld_scheme = 'off' - if (trim(config_sfclayer_scheme) == 'suite') config_sfclayer_scheme = 'off' - if (trim(config_lsm_scheme) == 'suite') config_lsm_scheme = 'off' - - else - - write(mpas_err_message,'(A)') 'Unrecognized choice of physics suite: config_physics_suite = '''// & - trim(config_physics_suite)//'''' - call physics_error_fatal(mpas_err_message) - - end if - -!cloud microphysics scheme: - if(.not. (config_microp_scheme .eq. 'off' .or. & - config_microp_scheme .eq. 'mp_kessler' .or. & - config_microp_scheme .eq. 'mp_thompson' .or. & - config_microp_scheme .eq. 'mp_thompson_aerosols' .or. & - config_microp_scheme .eq. 'mp_wsm6')) then - - write(mpas_err_message,'(A,A20)') 'illegal value for config_microp_scheme:', & - trim(config_microp_scheme) - call physics_error_fatal(mpas_err_message) - - endif - -!convection scheme: - if(.not. (config_convection_scheme .eq. 'off' .or. & - config_convection_scheme .eq. 'cu_grell_freitas' .or. & - config_convection_scheme .eq. 'cu_kain_fritsch' .or. & - config_convection_scheme .eq. 'cu_tiedtke' .or. & - config_convection_scheme .eq. 'cu_ntiedtke')) then - - write(mpas_err_message,'(A,A20)') 'illegal value for config_convection_scheme: ', & - trim(config_convection_scheme) - call physics_error_fatal(mpas_err_message) - - endif - -!pbl scheme: - if(.not. (config_pbl_scheme .eq. 'off' .or. & - config_pbl_scheme .eq. 'bl_mynn' .or. & - config_pbl_scheme .eq. 'bl_ysu')) then - - write(mpas_err_message,'(A,A20)') 'illegal value for pbl_scheme: ', & - trim(config_pbl_scheme) - call physics_error_fatal(mpas_err_message) - - endif - -!gravity wave drag over orography scheme: - if(.not. (config_gwdo_scheme .eq. 'off' .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: ', & - trim(config_gwdo_scheme) - call physics_error_fatal(mpas_err_message) - - endif - -!lw radiation scheme: - if(.not. (config_radt_lw_scheme .eq. 'off' .or. & - config_radt_lw_scheme .eq. 'cam_lw' .or. & - config_radt_lw_scheme .eq. 'rrtmg_lw')) then - - write(mpas_err_message,'(A,A20)') 'illegal value for longwave radiation scheme: ', & - trim(config_radt_lw_scheme) - call physics_error_fatal(mpas_err_message) - - endif - -!sw radiation scheme: - if(.not. (config_radt_sw_scheme .eq. 'off' .or. & - config_radt_sw_scheme .eq. 'cam_sw' .or. & - config_radt_sw_scheme .eq. 'rrtmg_sw')) then - - write(mpas_err_message,'(A,A20)') 'illegal value for shortwave radiation _scheme: ', & - trim(config_radt_sw_scheme) - call physics_error_fatal(mpas_err_message) - - endif - -!cloud fraction for radiation schemes: - if(.not. (config_radt_cld_scheme .eq. 'off' .or. & - config_radt_cld_scheme .eq. 'cld_incidence' .or. & - config_radt_cld_scheme .eq. 'cld_fraction' .or. & - config_radt_cld_scheme .eq. 'cld_fraction_thompson')) then - - write(mpas_err_message,'(A,A20)') 'illegal value for calculation of cloud fraction: ', & - trim(config_radt_cld_scheme) - call physics_error_fatal(mpas_err_message) - - endif - if((config_radt_lw_scheme.ne.'off' .and. config_radt_cld_scheme.eq.'off') .or. & - (config_radt_sw_scheme.ne.'off' .and. config_radt_cld_scheme.eq.'off')) then - - call mpas_log_write('') - write(mpas_err_message,'(A,A20)') & - ' config_radt_cld_scheme is not set for radiation calculation' - call physics_message(mpas_err_message) - write(mpas_err_message,'(A,A20)') & - ' switch calculation of cloud fraction to config_radt_cld_scheme = cld_incidence' - call physics_message(mpas_err_message) - config_radt_cld_scheme = "cld_incidence" - - endif - -!surface-layer scheme: - if(.not. (config_sfclayer_scheme .eq. 'off' .or. & - config_sfclayer_scheme .eq. 'sf_mynn' .or. & - config_sfclayer_scheme .eq. 'sf_monin_obukhov' .or. & - config_sfclayer_scheme .eq. 'sf_monin_obukhov_rev')) then - - write(mpas_err_message,'(A,A20)') 'illegal value for surface layer scheme: ', & - trim(config_sfclayer_scheme) - call physics_error_fatal(mpas_err_message) - else - if(config_pbl_scheme == 'bl_mynn') then - config_sfclayer_scheme = 'sf_mynn' - elseif(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: ', & - trim(config_sfclayer_scheme) - call physics_error_fatal(mpas_err_message) - endif - endif - endif - -!land-surface scheme: note that config_sfclayer_scheme must be defined for the land-surface -!scheme to be called: - if(config_lsm_scheme .ne. 'off' .and. config_sfclayer_scheme .eq. 'off') then - - call physics_error_fatal('land surface scheme: ' // & - 'set config_sfclayer_scheme different than off') - - elseif(.not. (config_lsm_scheme .eq. 'off ' .or. & - config_lsm_scheme .eq. 'sf_noah' .or. & - config_lsm_scheme .eq. 'sf_noahmp')) then - - write(mpas_err_message,'(A,A20)') 'illegal value for land surface scheme: ', & - trim(config_lsm_scheme) - call physics_error_fatal(mpas_err_message) - - endif - -!checks if any physics process is called. if not, return: - moist_physics = .true. - - if(config_microp_scheme .eq. 'off' .and. & - config_convection_scheme .eq. 'off' .and. & - config_lsm_scheme .eq. 'off' .and. & - config_pbl_scheme .eq. 'off' .and. & - config_radt_lw_scheme .eq. 'off' .and. & - config_radt_sw_scheme .eq. 'off' .and. & - config_sfclayer_scheme .eq. 'off') moist_physics = .false. - - call mpas_log_write('') - call mpas_log_write(' config_microp_scheme = '//trim(config_microp_scheme)) - call mpas_log_write(' config_convection_scheme = '//trim(config_convection_scheme)) - call mpas_log_write(' config_pbl_scheme = '//trim(config_pbl_scheme)) - call mpas_log_write(' config_gwdo_scheme = '//trim(config_gwdo_scheme)) - call mpas_log_write(' config_radt_cld_scheme = '//trim(config_radt_cld_scheme)) - call mpas_log_write(' config_radt_lw_scheme = '//trim(config_radt_lw_scheme)) - call mpas_log_write(' config_radt_sw_scheme = '//trim(config_radt_sw_scheme)) - call mpas_log_write(' config_sfclayer_scheme = '//trim(config_sfclayer_scheme)) - call mpas_log_write(' config_lsm_scheme = '//trim(config_lsm_scheme)) - call mpas_log_write('') - - end subroutine physics_namelist_check - -!================================================================================================================= - subroutine physics_registry_init(mesh,configs,sfc_input) -!================================================================================================================= - -!input arguments: - type(mpas_pool_type),intent(in):: mesh - type(mpas_pool_type),intent(in):: configs - -!inout arguments: - type(mpas_pool_type),intent(inout):: sfc_input - -!local pointers: - logical,pointer:: config_do_restart - character(len=StrKIND),pointer:: config_lsm_scheme - integer,pointer:: nCells - integer,dimension(:),pointer:: landmask - - real(kind=RKIND),dimension(:,:),pointer:: dzs - -!local variables: - integer:: iCell - -!----------------------------------------------------------------------------------------------------------------- - - call mpas_pool_get_config(configs,'config_do_restart',config_do_restart) - call mpas_pool_get_config(configs,'config_lsm_scheme',config_lsm_scheme) - - call mpas_pool_get_dimension(mesh,'nCells',nCells) - - call mpas_pool_get_array(sfc_input,'landmask',landmask) - call mpas_pool_get_array(sfc_input,'dzs' , dzs ) - -!initialization of input variables, if needed: - - if(.not. config_do_restart) then - - lsm_select: select case(trim(config_lsm_scheme)) - - case("sf_noah","sf_noahmp") - !initialize the thickness of the soil layers for the Noah scheme: - do iCell = 1, nCells - dzs(1,iCell) = 0.10_RKIND - dzs(2,iCell) = 0.30_RKIND - dzs(3,iCell) = 0.60_RKIND - dzs(4,iCell) = 1.00_RKIND - enddo - - case default - - end select lsm_select - - endif - -!call mpas_log_write('--- enter subroutine physics_namelist_check.') -!call mpas_log_write('') - - end subroutine physics_registry_init - -!================================================================================================================= - subroutine physics_tables_init(dminfo,configs) -!================================================================================================================= - -!input arguments: - type(dm_info),intent(in):: dminfo - type(mpas_pool_type),intent(in):: configs - -!local variables: - character(len=StrKIND),pointer:: config_microp_scheme - logical:: l_qr_acr_qg,l_qr_acr_qs,l_qi_aut_qs,l_freezeH2O - -!----------------------------------------------------------------------------------------------------------------- - - l_mp_tables = .true. - - if(dminfo % my_proc_id == IO_NODE) then - - call mpas_pool_get_config(configs,'config_microp_scheme',config_microp_scheme) - if(config_microp_scheme /= "mp_thompson" .or. & - config_microp_scheme /= "mp_thompson_aerosols") return - - l_qr_acr_qg = .false. - l_qr_acr_qs = .false. - l_qi_aut_qs = .false. - l_freezeH2O = .false. - - inquire(file='MP_THOMPSON_QRacrQG_DATA.DBL' ,exist=l_qr_acr_qg) - inquire(file='MP_THOMPSON_QRacrQS_DATA.DBL' ,exist=l_qr_acr_qs) - inquire(file='MP_THOMPSON_QIautQS_DATA.DBL' ,exist=l_qi_aut_qs) - inquire(file='MP_THOMPSON_freezeH2O_DATA.DBL',exist=l_freezeH2O) - -! call mpas_log_write('') -! call mpas_log_write('--- enter subroutine physics_tables_init:') -! call mpas_log_write('l_qr_acr_qg = $l',logicArgs=(/l_qr_acr_qg/)) -! call mpas_log_write('l_qr_acr_qs = $l',logicArgs=(/l_qr_acr_qs/)) -! call mpas_log_write('l_qi_aut_qs = $l',logicArgs=(/l_qi_aut_qs/)) -! call mpas_log_write('l_freezeH2O = $l',logicArgs=(/l_freezeH2O/)) - - if(.not. (l_qr_acr_qg .and. l_qr_acr_qs .and. l_qi_aut_qs .and. l_freezeH2O)) then - write(mpas_err_message,'(A)') & - '--- tables to run the Thompson cloud microphysics scheme do not exist: run build_tables first.' - call physics_error_fatal(mpas_err_message) - endif -! call mpas_log_write('l_mp_tables = $l',logicArgs=(/l_mp_tables/)) - - endif - - end subroutine physics_tables_init - -!================================================================================================================= -! routine physics_compatibility_check() -! -!> \brief Checks physics input fields and options for compatibility -!> \author Miles Curry and Michael Duda -!> \date 25 October 2018 -!> \details -!> This routine checks the input fields and run-time options provided -!> by the user for compatibility. For example, two run-time options may -!> be mutually exclusive, or an option may require that a certain input -!> field is provided. The checks performed by this routine are only for -!> physics related fields and options. -!> -!> A value of 0 is returned if there are no incompatibilities among -!> the provided input fields and run-time options, and a non-zero value -!> otherwise. -!> - subroutine physics_compatibility_check(dminfo, blockList, streamManager, ierr) -!================================================================================================================= - - implicit none - - type (dm_info), pointer :: dminfo - type (block_type), pointer :: blockList - type (MPAS_streamManager_type), pointer :: streamManager - integer, intent(out) :: ierr - - real (kind=RKIND) :: maxvar2d_local, maxvar2d_global - real (kind=RKIND), dimension(:), pointer :: var2d - integer, pointer :: nCellsSolve - integer, pointer :: iswater_lu - integer, pointer, dimension(:) :: ivgtyp - integer :: all_water, iall_water - character (len=StrKIND), pointer :: gwdo_scheme - type (block_type), pointer :: block - type (mpas_pool_type), pointer :: meshPool - type (mpas_pool_type), pointer :: sfc_inputPool - - ierr = 0 - - call mpas_pool_get_config(blocklist % configs, 'config_gwdo_scheme', gwdo_scheme) - - if (trim(gwdo_scheme) == 'bl_kim_gwdo') then - maxvar2d_local = -huge(maxvar2d_local) - block => blockList - do while (associated(block)) - call mpas_pool_get_subpool(block % structs, 'mesh', meshPool) - call mpas_pool_get_subpool(block % structs, 'sfc_input', sfc_inputPool) - call mpas_pool_get_dimension(meshPool, 'nCellsSolve', nCellsSolve) - call mpas_pool_get_array(sfc_inputPool, 'var2d', var2d) - - maxvar2d_local = max(maxvar2d_local, maxval(var2d(1:nCellsSolve))) - - block => block % next - end do - - call mpas_dmpar_max_real(dminfo, maxvar2d_local, maxvar2d_global) - - ! - ! The GWDO check below can fail on regional simulations that are completely above - ! water. So, check to see if the simulation is completely above water and do not - ! throw the error if it is. - ! - call mpas_pool_get_array(sfc_inputPool, 'iswater', iswater_lu) - call mpas_pool_get_array(sfc_inputPool, 'ivgtyp', ivgtyp) - if (all(ivgtyp(1:nCellsSolve) == iswater_lu)) then - all_water = 1 ! All water - else - all_water = 0 ! Land present - end if - - call mpas_dmpar_min_int(dminfo, all_water, iall_water) - - if (maxvar2d_global <= 0.0_RKIND .and. iall_water /= 1) then - call mpas_log_write('*******************************************************************************', & - messageType=MPAS_LOG_ERR) - call mpas_log_write('The YSU GWDO scheme requires valid var2d, con, oa{1,2,3,4}, and ol{1,2,3,4} fields,', & - messageType=MPAS_LOG_ERR) - call mpas_log_write('but these fields appear to be zero everywhere in the model input.', & - messageType=MPAS_LOG_ERR) - call mpas_log_write('Either set config_gwdo_scheme = ''off'' in the &physics namelist, or generate', & - messageType=MPAS_LOG_ERR) - call mpas_log_write('the GWDO static fields with the init_atmosphere core.', & - messageType=MPAS_LOG_ERR) - call mpas_log_write('*******************************************************************************', & - messageType=MPAS_LOG_ERR) - ierr = ierr + 1 - end if - - end if - - end subroutine physics_compatibility_check - -!================================================================================================================= - end module mpas_atmphys_control -!================================================================================================================= - From ed694e153d24b74176e75e2efcc33abb9bec7d7a Mon Sep 17 00:00:00 2001 From: Songyou Hong Date: Tue, 23 Dec 2025 12:49:58 -0700 Subject: [PATCH 10/19] Delete src/core_atmosphere/physics/mpas_atmphys_driver_gwdo.F-org --- .../physics/mpas_atmphys_driver_gwdo.F-org | 838 ------------------ 1 file changed, 838 deletions(-) delete mode 100644 src/core_atmosphere/physics/mpas_atmphys_driver_gwdo.F-org diff --git a/src/core_atmosphere/physics/mpas_atmphys_driver_gwdo.F-org b/src/core_atmosphere/physics/mpas_atmphys_driver_gwdo.F-org deleted file mode 100644 index a96ba7bf2a..0000000000 --- a/src/core_atmosphere/physics/mpas_atmphys_driver_gwdo.F-org +++ /dev/null @@ -1,838 +0,0 @@ -! Copyright (c) 2013, Los Alamos National Security, LLC (LANS) -! and the University Corporation for Atmospheric Research (UCAR). -! -! Unless noted otherwise source code is licensed under the BSD license. -! Additional copyright and license information can be found in the LICENSE file -! distributed with this code, or at http://mpas-dev.github.com/license.html -! -!================================================================================================================= - 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. -! -! subroutines in mpas_atmphys_driver_gwdo: -! ---------------------------------------- -! allocate_gwdo : allocate local arrays for parameterization of gravity wave drag. -! deallocate_gwdo: deallocate local arrays for parameterization of gravity wave drag. -! driver_gwdo : main driver (called from subroutine physics_driver). -! gwdo_from_MPAS : initialize local arrays. -! gwdo_to_MPAS : copy local arrays to MPAS arrays. -! -! WRF physics called from driver_gwdo: -! --------------------------- -------- -! * module_bl_gwdo : parameterization of gravity wave drag over orography. -! -! add-ons and modifications to sourcecode: -! ---------------------------------------- -! * removed the pre-processor option "do_hydrostatic_pressure" before call to subroutine gwdo. -! Laura D. Fowler (birch.ucar.edu) / 2013-05-29. -! * changed the definition of dx_p to the mean distance between cell centers. -! Laura D. Fowler (laura@ucar.edu) / 2013-08-23. -! * in call to subroutine gwdo, replaced the variable g (that originally pointed to gravity) -! with gravity, for simplicity. -! Laura D. Fowler (laura@ucar.edu) / 2014-03-21. -! * throughout the sourcecode, replaced all "var_struct" defined arrays by local pointers. -! Laura D. Fowler (laura@ucar.edu) / 2014-04-22. -! * modified sourcecode to use pools. -! Laura D. Fowler (laura@ucar.edu) / 2014-05-15. -! * renamed "ysu_gwdo" to "bl_gwdo_ysu". -! Laura D. Fowler (laura@ucar.edu) / 2016-03-25. -! * change the definition of dx_p to match that used in other physics parameterizations. -! Laura D. Fowler (laura@ucar.edu) / 2016-10-18. -! * modified the call to subroutine gwdo following the update of module_gwdo.F to that -! of WRF version 4.0.2. -! Laura D. Fowler (laura@ucar.edu) / 2019-01-30. -! * added the flags errmsg and errflg in the call to subroutine gwdo for compliance with the CCPP framework. -! 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 - - - 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)) - if(.not.allocated(dvsfcg_p)) allocate(dvsfcg_p(ims:ime,jms:jme)) - if(.not.allocated(dtaux3d_p)) allocate(dtaux3d_p(ims:ime,kms:kme,jms:jme)) - if(.not.allocated(dtauy3d_p)) allocate(dtauy3d_p(ims:ime,kms:kme,jms:jme)) - 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") - 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) ) - if(.not.allocated(oa2_p) ) allocate(oa2_p(ims:ime,jms:jme) ) - if(.not.allocated(oa3_p) ) allocate(oa3_p(ims:ime,jms:jme) ) - if(.not.allocated(oa4_p) ) allocate(oa4_p(ims:ime,jms:jme) ) - if(.not.allocated(ol1_p) ) allocate(ol1_p(ims:ime,jms:jme) ) - if(.not.allocated(ol2_p) ) allocate(ol2_p(ims:ime,jms:jme) ) - if(.not.allocated(ol3_p) ) allocate(ol3_p(ims:ime,jms:jme) ) - if(.not.allocated(ol4_p) ) allocate(ol4_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) ) - if(.not.allocated(oa1ls_p) ) allocate(oa1ls_p(ims:ime,jms:jme) ) - if(.not.allocated(oa2ls_p) ) allocate(oa2ls_p(ims:ime,jms:jme) ) - if(.not.allocated(oa3ls_p) ) allocate(oa3ls_p(ims:ime,jms:jme) ) - if(.not.allocated(oa4ls_p) ) allocate(oa4ls_p(ims:ime,jms:jme) ) - if(.not.allocated(ol1ls_p) ) allocate(ol1ls_p(ims:ime,jms:jme) ) - if(.not.allocated(ol2ls_p) ) allocate(ol2ls_p(ims:ime,jms:jme) ) - if(.not.allocated(ol3ls_p) ) allocate(ol3ls_p(ims:ime,jms:jme) ) - if(.not.allocated(ol4ls_p) ) allocate(ol4ls_p(ims:ime,jms:jme) ) - if(.not.allocated(var2dss_p) ) allocate(var2dss_p(ims:ime,jms:jme) ) - if(.not.allocated(conss_p) ) allocate(conss_p(ims:ime,jms:jme) ) - if(.not.allocated(oa1ss_p) ) allocate(oa1ss_p(ims:ime,jms:jme) ) - if(.not.allocated(oa2ss_p) ) allocate(oa2ss_p(ims:ime,jms:jme) ) - if(.not.allocated(oa3ss_p) ) allocate(oa3ss_p(ims:ime,jms:jme) ) - if(.not.allocated(oa4ss_p) ) allocate(oa4ss_p(ims:ime,jms:jme) ) - if(.not.allocated(ol1ss_p) ) allocate(ol1ss_p(ims:ime,jms:jme) ) - if(.not.allocated(ol2ss_p) ) allocate(ol2ss_p(ims:ime,jms:jme) ) - if(.not.allocated(ol3ss_p) ) allocate(ol3ss_p(ims:ime,jms:jme) ) - if(.not.allocated(ol4ss_p) ) allocate(ol4ss_p(ims:ime,jms:jme) ) - if(.not.allocated(hpbl_p) ) allocate(hpbl_p(ims:ime,jms:jme) ) - if(.not.allocated(br_p) ) allocate(br_p(ims:ime,jms:jme) ) - if(.not.allocated(xland_p ) ) allocate(xland_p(ims:ime,jms:jme) ) - if (ugwp_diags) then - if(.not.allocated(dusfc_ls_p)) allocate(dusfc_ls_p(ims:ime,jms:jme)) - if(.not.allocated(dvsfc_ls_p)) allocate(dvsfc_ls_p(ims:ime,jms:jme)) - if(.not.allocated(dusfc_bl_p)) allocate(dusfc_bl_p(ims:ime,jms:jme)) - if(.not.allocated(dvsfc_bl_p)) allocate(dvsfc_bl_p(ims:ime,jms:jme)) - if(.not.allocated(dusfc_ss_p)) allocate(dusfc_ss_p(ims:ime,jms:jme)) - if(.not.allocated(dvsfc_ss_p)) allocate(dvsfc_ss_p(ims:ime,jms:jme)) - if(.not.allocated(dusfc_fd_p)) allocate(dusfc_fd_p(ims:ime,jms:jme)) - if(.not.allocated(dvsfc_fd_p)) allocate(dvsfc_fd_p(ims:ime,jms:jme)) - if(.not.allocated(dtaux3d_ls_p)) allocate(dtaux3d_ls_p(ims:ime,kms:kme,jms:jme)) - if(.not.allocated(dtauy3d_ls_p)) allocate(dtauy3d_ls_p(ims:ime,kms:kme,jms:jme)) - if(.not.allocated(dtaux3d_bl_p)) allocate(dtaux3d_bl_p(ims:ime,kms:kme,jms:jme)) - if(.not.allocated(dtauy3d_bl_p)) allocate(dtauy3d_bl_p(ims:ime,kms:kme,jms:jme)) - if(.not.allocated(dtaux3d_ss_p)) allocate(dtaux3d_ss_p(ims:ime,kms:kme,jms:jme)) - if(.not.allocated(dtauy3d_ss_p)) allocate(dtauy3d_ss_p(ims:ime,kms:kme,jms:jme)) - if(.not.allocated(dtaux3d_fd_p)) allocate(dtaux3d_fd_p(ims:ime,kms:kme,jms:jme)) - if(.not.allocated(dtauy3d_fd_p)) allocate(dtauy3d_fd_p(ims:ime,kms:kme,jms:jme)) - if (ngw_scheme) then - if(.not.allocated(dudt_ngw_p)) allocate(dudt_ngw_p(ims:ime,kms:kme,jms:jme)) - if(.not.allocated(dvdt_ngw_p)) allocate(dvdt_ngw_p(ims:ime,kms:kme,jms:jme)) - if(.not.allocated(dtdt_ngw_p)) allocate(dtdt_ngw_p(ims:ime,kms:kme,jms:jme)) - endif - endif - if (ngw_scheme) then - if(.not.allocated(xlat_p)) allocate(xlat_p(ims:ime,jms:jme)) - if(.not.allocated(raincv_p) ) allocate(raincv_p(ims:ime,jms:jme) ) - if(.not.allocated(rainncv_p) ) allocate(rainncv_p(ims:ime,jms:jme) ) - if(.not.allocated(jindx1_tau_p)) allocate(jindx1_tau_p(ims:ime,jms:jme)) - if(.not.allocated(jindx2_tau_p)) allocate(jindx2_tau_p(ims:ime,jms:jme)) - 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) - if(allocated(dvsfcg_p)) deallocate(dvsfcg_p) - if(allocated(dtaux3d_p)) deallocate(dtaux3d_p) - if(allocated(dtauy3d_p)) deallocate(dtauy3d_p) - 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") - if(allocated(var2d_p) ) deallocate(var2d_p ) - if(allocated(con_p) ) deallocate(con_p ) - if(allocated(oa1_p) ) deallocate(oa1_p ) - if(allocated(oa2_p) ) deallocate(oa2_p ) - if(allocated(oa3_p) ) deallocate(oa3_p ) - if(allocated(oa4_p) ) deallocate(oa4_p ) - if(allocated(ol1_p) ) deallocate(ol1_p ) - if(allocated(ol2_p) ) deallocate(ol2_p ) - if(allocated(ol3_p) ) deallocate(ol3_p ) - if(allocated(ol4_p) ) deallocate(ol4_p ) - - case("bl_ugwp_gwdo") - if(allocated(var2dls_p) ) deallocate(var2dls_p ) - if(allocated(conls_p) ) deallocate(conls_p ) - if(allocated(oa1ls_p) ) deallocate(oa1ls_p ) - if(allocated(oa2ls_p) ) deallocate(oa2ls_p ) - if(allocated(oa3ls_p) ) deallocate(oa3ls_p ) - if(allocated(oa4ls_p) ) deallocate(oa4ls_p ) - if(allocated(ol1ls_p) ) deallocate(ol1ls_p ) - if(allocated(ol2ls_p) ) deallocate(ol2ls_p ) - if(allocated(ol3ls_p) ) deallocate(ol3ls_p ) - if(allocated(ol4ls_p) ) deallocate(ol4ls_p ) - if(allocated(var2dss_p) ) deallocate(var2dss_p ) - if(allocated(conss_p) ) deallocate(conss_p ) - if(allocated(oa1ss_p) ) deallocate(oa1ss_p ) - if(allocated(oa2ss_p) ) deallocate(oa2ss_p ) - if(allocated(oa3ss_p) ) deallocate(oa3ss_p ) - if(allocated(oa4ss_p) ) deallocate(oa4ss_p ) - if(allocated(ol1ss_p) ) deallocate(ol1ss_p ) - if(allocated(ol2ss_p) ) deallocate(ol2ss_p ) - if(allocated(ol3ss_p) ) deallocate(ol3ss_p ) - if(allocated(ol4ss_p) ) deallocate(ol4ss_p ) - if(allocated(hpbl_p) ) deallocate(hpbl_p ) - if(allocated(br_p) ) deallocate(br_p ) - if(allocated(xland_p) ) deallocate(xland_p ) - if (ugwp_diags) then - if(allocated(dusfc_ls_p)) deallocate(dusfc_ls_p) - if(allocated(dvsfc_ls_p)) deallocate(dvsfc_ls_p) - if(allocated(dusfc_bl_p)) deallocate(dusfc_bl_p) - if(allocated(dvsfc_bl_p)) deallocate(dvsfc_bl_p) - if(allocated(dusfc_ss_p)) deallocate(dusfc_ss_p) - if(allocated(dvsfc_ss_p)) deallocate(dvsfc_ss_p) - if(allocated(dusfc_fd_p)) deallocate(dusfc_fd_p) - if(allocated(dvsfc_fd_p)) deallocate(dvsfc_fd_p) - if(allocated(dtaux3d_ls_p)) deallocate(dtaux3d_ls_p) - if(allocated(dtauy3d_ls_p)) deallocate(dtauy3d_ls_p) - if(allocated(dtaux3d_bl_p)) deallocate(dtaux3d_bl_p) - if(allocated(dtauy3d_bl_p)) deallocate(dtauy3d_bl_p) - if(allocated(dtaux3d_ss_p)) deallocate(dtaux3d_ss_p) - if(allocated(dtauy3d_ss_p)) deallocate(dtauy3d_ss_p) - if(allocated(dtaux3d_fd_p)) deallocate(dtaux3d_fd_p) - if(allocated(dtauy3d_fd_p)) deallocate(dtauy3d_fd_p) - if (ngw_scheme) then - if(allocated(dudt_ngw_p)) deallocate(dudt_ngw_p) - if(allocated(dvdt_ngw_p)) deallocate(dvdt_ngw_p) - if(allocated(dtdt_ngw_p)) deallocate(dtdt_ngw_p) - endif - endif - if (ngw_scheme) then - if(allocated(xlat_p)) deallocate(xlat_p) - if(allocated(raincv_p) ) deallocate(raincv_p) - if(allocated(rainncv_p) ) deallocate(rainncv_p) - if(allocated(jindx1_tau_p)) deallocate(jindx1_tau_p) - if(allocated(jindx2_tau_p)) deallocate(jindx2_tau_p) - 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 - type(mpas_pool_type),intent(in):: sfc_input - 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 - real(kind=RKIND),pointer:: len_disp - real(kind=RKIND),dimension(:),pointer :: meshDensity - real(kind=RKIND),dimension(:),pointer :: oa1,oa2,oa3,oa4,ol1,ol2,ol3,ol4,con,var2d - 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, & - ol3ss,ol4ss,conss,var2dss - real(kind=RKIND),dimension(:),pointer :: dusfcg,dvsfcg - real(kind=RKIND),dimension(:,:),pointer:: dtaux3d,dtauy3d,rublten,rvblten - real(kind=RKIND),dimension(:,:),pointer:: rthblten - real(kind=RKIND),dimension(:),pointer :: dusfc_ls,dvsfc_ls,dusfc_bl,dvsfc_bl, & - dusfc_ss,dvsfc_ss,dusfc_fd,dvsfc_fd - real(kind=RKIND),dimension(:),pointer :: hpbl,xland,br1 - real(kind=RKIND),dimension(:),pointer :: latCell,ddy_j1tau,ddy_j2tau,raincv,rainncv - 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) - call mpas_pool_get_config(configs,'config_ngw_scheme',ngw_scheme) - 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") - call mpas_pool_get_array(sfc_input,'var2d',var2d) - call mpas_pool_get_array(sfc_input,'con' ,con ) - call mpas_pool_get_array(sfc_input,'oa1' ,oa1 ) - call mpas_pool_get_array(sfc_input,'oa2' ,oa2 ) - call mpas_pool_get_array(sfc_input,'oa3' ,oa3 ) - call mpas_pool_get_array(sfc_input,'oa4' ,oa4 ) - call mpas_pool_get_array(sfc_input,'ol1' ,ol1 ) - call mpas_pool_get_array(sfc_input,'ol2' ,ol2 ) - call mpas_pool_get_array(sfc_input,'ol3' ,ol3 ) - call mpas_pool_get_array(sfc_input,'ol4' ,ol4 ) - do j = jts,jte - do i = its,ite - var2d_p(i,j) = var2d(i) - con_p(i,j) = con(i) - oa1_p(i,j) = oa1(i) - oa2_p(i,j) = oa2(i) - oa3_p(i,j) = oa3(i) - oa4_p(i,j) = oa4(i) - ol1_p(i,j) = ol1(i) - ol2_p(i,j) = ol2(i) - ol3_p(i,j) = ol3(i) - ol4_p(i,j) = ol4(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 ) - call mpas_pool_get_array(sfc_input,'oa1ls' ,oa1ls ) - call mpas_pool_get_array(sfc_input,'oa2ls' ,oa2ls ) - call mpas_pool_get_array(sfc_input,'oa3ls' ,oa3ls ) - call mpas_pool_get_array(sfc_input,'oa4ls' ,oa4ls ) - call mpas_pool_get_array(sfc_input,'ol1ls' ,ol1ls ) - call mpas_pool_get_array(sfc_input,'ol2ls' ,ol2ls ) - call mpas_pool_get_array(sfc_input,'ol3ls' ,ol3ls ) - call mpas_pool_get_array(sfc_input,'ol4ls' ,ol4ls ) - call mpas_pool_get_array(sfc_input,'var2dss',var2dss) - call mpas_pool_get_array(sfc_input,'conss' ,conss ) - call mpas_pool_get_array(sfc_input,'oa1ss' ,oa1ss ) - call mpas_pool_get_array(sfc_input,'oa2ss' ,oa2ss ) - call mpas_pool_get_array(sfc_input,'oa3ss' ,oa3ss ) - call mpas_pool_get_array(sfc_input,'oa4ss' ,oa4ss ) - call mpas_pool_get_array(sfc_input,'ol1ss' ,ol1ss ) - call mpas_pool_get_array(sfc_input,'ol2ss' ,ol2ss ) - call mpas_pool_get_array(sfc_input,'ol3ss' ,ol3ss ) - call mpas_pool_get_array(sfc_input,'ol4ss' ,ol4ss ) - call mpas_pool_get_array(diag_physics,'hpbl',hpbl ) - call mpas_pool_get_array(diag_physics,'br' ,br1 ) - call mpas_pool_get_array(sfc_input,'xland' ,xland ) - do j = jts,jte - do i = its,ite - var2dls_p(i,j) = var2dls(i) - conls_p(i,j) = conls(i) - oa1ls_p(i,j) = oa1ls(i) - oa2ls_p(i,j) = oa2ls(i) - oa3ls_p(i,j) = oa3ls(i) - oa4ls_p(i,j) = oa4ls(i) - ol1ls_p(i,j) = ol1ls(i) - ol2ls_p(i,j) = ol2ls(i) - ol3ls_p(i,j) = ol3ls(i) - ol4ls_p(i,j) = ol4ls(i) - var2dss_p(i,j) = var2dss(i) - conss_p(i,j) = conss(i) - oa1ss_p(i,j) = oa1ss(i) - oa2ss_p(i,j) = oa2ss(i) - oa3ss_p(i,j) = oa3ss(i) - oa4ss_p(i,j) = oa4ss(i) - ol1ss_p(i,j) = ol1ss(i) - ol2ss_p(i,j) = ol2ss(i) - ol3ss_p(i,j) = ol3ss(i) - ol4ss_p(i,j) = ol4ss(i) - hpbl_p(i,j) = hpbl(i) - br_p(i,j) = br1(i) - xland_p(i,j) = xland(i) - enddo - enddo - if (ugwp_diags) then - call mpas_pool_get_array(diag_physics,'dusfc_ls' ,dusfc_ls ) - call mpas_pool_get_array(diag_physics,'dvsfc_ls' ,dvsfc_ls ) - call mpas_pool_get_array(diag_physics,'dusfc_bl' ,dusfc_bl ) - call mpas_pool_get_array(diag_physics,'dvsfc_bl' ,dvsfc_bl ) - call mpas_pool_get_array(diag_physics,'dusfc_ss' ,dusfc_ss ) - call mpas_pool_get_array(diag_physics,'dvsfc_ss' ,dvsfc_ss ) - call mpas_pool_get_array(diag_physics,'dusfc_fd' ,dusfc_fd ) - call mpas_pool_get_array(diag_physics,'dvsfc_fd' ,dvsfc_fd ) - call mpas_pool_get_array(diag_physics,'dtaux3d_ls' ,dtaux3d_ls ) - call mpas_pool_get_array(diag_physics,'dtauy3d_ls' ,dtauy3d_ls ) - call mpas_pool_get_array(diag_physics,'dtaux3d_bl' ,dtaux3d_bl ) - call mpas_pool_get_array(diag_physics,'dtauy3d_bl' ,dtauy3d_bl ) - call mpas_pool_get_array(diag_physics,'dtaux3d_ss' ,dtaux3d_ss ) - call mpas_pool_get_array(diag_physics,'dtauy3d_ss' ,dtauy3d_ss ) - call mpas_pool_get_array(diag_physics,'dtaux3d_fd' ,dtaux3d_fd ) - call mpas_pool_get_array(diag_physics,'dtauy3d_fd' ,dtauy3d_fd ) - do j = jts,jte - do i = its,ite - dusfc_ls_p(i,j) = dusfc_ls(i) - dvsfc_ls_p(i,j) = dvsfc_ls(i) - dusfc_bl_p(i,j) = dusfc_bl(i) - dvsfc_bl_p(i,j) = dvsfc_bl(i) - dusfc_ss_p(i,j) = dusfc_ss(i) - dvsfc_ss_p(i,j) = dvsfc_ss(i) - dusfc_fd_p(i,j) = dusfc_fd(i) - dvsfc_fd_p(i,j) = dvsfc_fd(i) - enddo - enddo - do j = jts,jte - do k = kts,kte - do i = its,ite - dtaux3d_ls_p(i,k,j) = dtaux3d_ls(k,i) - dtauy3d_ls_p(i,k,j) = dtauy3d_ls(k,i) - dtaux3d_bl_p(i,k,j) = dtaux3d_bl(k,i) - dtauy3d_bl_p(i,k,j) = dtauy3d_bl(k,i) - dtaux3d_ss_p(i,k,j) = dtaux3d_ss(k,i) - dtauy3d_ss_p(i,k,j) = dtauy3d_ss(k,i) - dtaux3d_fd_p(i,k,j) = dtaux3d_fd(k,i) - dtauy3d_fd_p(i,k,j) = dtauy3d_fd(k,i) - enddo - enddo - enddo - endif - if (ugwp_diags.and.ngw_scheme) then - call mpas_pool_get_array(diag_physics,'dudt_ngw',dudt_ngw) - call mpas_pool_get_array(diag_physics,'dvdt_ngw',dvdt_ngw) - call mpas_pool_get_array(diag_physics,'dtdt_ngw',dtdt_ngw) - do j = jts,jte - do k = kts,kte - do i = its,ite - dudt_ngw_p(i,k,j) = dudt_ngw(k,i) - dvdt_ngw_p(i,k,j) = dvdt_ngw(k,i) - dtdt_ngw_p(i,k,j) = dtdt_ngw(k,i) - enddo - enddo - enddo - endif - if (ngw_scheme) then - call mpas_pool_get_array(mesh,'latCell',latCell) - if(trim(convection_scheme) /= "off") & - call mpas_pool_get_array(diag_physics,'raincv',raincv) - if(trim(microp_scheme) /= "off") & - call mpas_pool_get_array(diag_physics,'rainncv',rainncv) - call mpas_pool_get_array(ngw_input,'jindx1_tau',jindx1_tau) - call mpas_pool_get_array(ngw_input,'jindx2_tau',jindx2_tau) - call mpas_pool_get_array(ngw_input,'ddy_j1tau', ddy_j1tau) - call mpas_pool_get_array(ngw_input,'ddy_j2tau', ddy_j2tau) - do j = jts,jte - do i = its,ite - xlat_p(i,j) = latCell(i)*rad2deg ! latitude in degrees - jindx1_tau_p(i,j) = jindx1_tau(i) - jindx2_tau_p(i,j) = jindx2_tau(i) - ddy_j1tau_p(i,j) = ddy_j1tau(i) - ddy_j2tau_p(i,j) = ddy_j2tau(i) - enddo - enddo - ! Treat rain rates conditionally - if(trim(convection_scheme) == "off") then - raincv_p(:,:) = 0._RKIND - else - do j = jts,jte - do i = its,ite - raincv_p(i,j) = raincv(i) - enddo - enddo - endif - if(trim(microp_scheme) == "off") then - rainncv_p(:,:) = 0._RKIND - else - do j = jts,jte - do i = its,ite - rainncv_p(i,j) = rainncv(i) - 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 ) - call mpas_pool_get_array(diag_physics,'dtaux3d' ,dtaux3d ) - call mpas_pool_get_array(diag_physics,'dtauy3d' ,dtauy3d ) - 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 - cosa_p(i,j) = 1._RKIND - dx_p(i,j) = len_disp / meshDensity(i)**0.25 - kpbl_p(i,j) = kpbl(i) - dusfcg_p(i,j) = dusfcg(i) - dvsfcg_p(i,j) = dvsfcg(i) - enddo - enddo - - do j = jts,jte - do k = kts,kte - do i = its,ite - dtaux3d_p(i,k,j) = dtaux3d(k,i) - dtauy3d_p(i,k,j) = dtauy3d(k,i) - rublten_p(i,k,j) = rublten(k,i) - rvblten_p(i,k,j) = rvblten(k,i) - rthblten_p(i,k,j) = rthblten(k,i) - 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, & - ol3ss,ol4ss,conss,var2dss - real(kind=RKIND),dimension(:),pointer :: dusfc_ls,dvsfc_ls,dusfc_bl,dvsfc_bl, & - dusfc_ss,dvsfc_ss,dusfc_fd,dvsfc_fd - 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) - call mpas_pool_get_array(diag_physics,'dusfcg' ,dusfcg ) - call mpas_pool_get_array(diag_physics,'dvsfcg' ,dvsfcg ) - call mpas_pool_get_array(diag_physics,'dtaux3d' ,dtaux3d ) - call mpas_pool_get_array(diag_physics,'dtauy3d' ,dtauy3d ) - call mpas_pool_get_array(diag_physics,'rubldiff',rubldiff) - call mpas_pool_get_array(diag_physics,'rvbldiff',rvbldiff) - 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 ) - call mpas_pool_get_array(diag_physics,'dvsfc_ls' ,dvsfc_ls ) - call mpas_pool_get_array(diag_physics,'dusfc_bl' ,dusfc_bl ) - call mpas_pool_get_array(diag_physics,'dvsfc_bl' ,dvsfc_bl ) - call mpas_pool_get_array(diag_physics,'dusfc_ss' ,dusfc_ss ) - call mpas_pool_get_array(diag_physics,'dvsfc_ss' ,dvsfc_ss ) - call mpas_pool_get_array(diag_physics,'dusfc_fd' ,dusfc_fd ) - call mpas_pool_get_array(diag_physics,'dvsfc_fd' ,dvsfc_fd ) - call mpas_pool_get_array(diag_physics,'dtaux3d_ls' ,dtaux3d_ls ) - call mpas_pool_get_array(diag_physics,'dtauy3d_ls' ,dtauy3d_ls ) - call mpas_pool_get_array(diag_physics,'dtaux3d_bl' ,dtaux3d_bl ) - call mpas_pool_get_array(diag_physics,'dtauy3d_bl' ,dtauy3d_bl ) - call mpas_pool_get_array(diag_physics,'dtaux3d_ss' ,dtaux3d_ss ) - call mpas_pool_get_array(diag_physics,'dtauy3d_ss' ,dtauy3d_ss ) - call mpas_pool_get_array(diag_physics,'dtaux3d_fd' ,dtaux3d_fd ) - call mpas_pool_get_array(diag_physics,'dtauy3d_fd' ,dtauy3d_fd ) - do j = jts,jte - do i = its,ite - dusfc_ls(i) = dusfc_ls_p(i,j) - dvsfc_ls(i) = dvsfc_ls_p(i,j) - dusfc_bl(i) = dusfc_bl_p(i,j) - dvsfc_bl(i) = dvsfc_bl_p(i,j) - dusfc_ss(i) = dusfc_ss_p(i,j) - dvsfc_ss(i) = dvsfc_ss_p(i,j) - dusfc_fd(i) = dusfc_fd_p(i,j) - dvsfc_fd(i) = dvsfc_fd_p(i,j) - enddo - enddo - do j = jts,jte - do k = kts,kte - do i = its,ite - dtaux3d_ls(k,i) = dtaux3d_ls_p(i,k,j) - dtauy3d_ls(k,i) = dtauy3d_ls_p(i,k,j) - dtaux3d_bl(k,i) = dtaux3d_bl_p(i,k,j) - dtauy3d_bl(k,i) = dtauy3d_bl_p(i,k,j) - dtaux3d_ss(k,i) = dtaux3d_ss_p(i,k,j) - dtauy3d_ss(k,i) = dtauy3d_ss_p(i,k,j) - dtaux3d_fd(k,i) = dtaux3d_fd_p(i,k,j) - dtauy3d_fd(k,i) = dtauy3d_fd_p(i,k,j) - enddo - enddo - enddo - if (ngw_scheme) then - call mpas_pool_get_array(diag_physics,'dudt_ngw' ,dudt_ngw ) - call mpas_pool_get_array(diag_physics,'dvdt_ngw' ,dvdt_ngw ) - call mpas_pool_get_array(diag_physics,'dtdt_ngw' ,dtdt_ngw ) - do j = jts,jte - do k = kts,kte - do i = its,ite - dudt_ngw(k,i) = dudt_ngw_p(i,k,j) - dvdt_ngw(k,i) = dvdt_ngw_p(i,k,j) - dtdt_ngw(k,i) = dtdt_ngw_p(i,k,j) - enddo - enddo - 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 - dtaux3d(k,i) = dtaux3d_p(i,k,j) - dtauy3d(k,i) = dtauy3d_p(i,k,j) - rubldiff(k,i) = rublten_p(i,k,j)-rublten(k,i) - rvbldiff(k,i) = rvblten_p(i,k,j)-rvblten(k,i) - rublten(k,i) = rublten_p(i,k,j) - rvblten(k,i) = rvblten_p(i,k,j) - rthblten(k,i) = rthblten_p(i,k,j) - 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 - 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 - -!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) - call mpas_pool_get_dimension(mesh,'days',ntau_d2t_ptr) - call mpas_pool_get_array(ngw_input,'DAYS',days_limb_ptr) - call mpas_pool_get_array(ngw_input,'ABSMF',tau_limb_ptr) - ntau_d1y = ntau_d1y_ptr - ntau_d2t = ntau_d2t_ptr - if(.not.allocated(days_limb)) allocate(days_limb(ntau_d2t)) - if(.not.allocated(tau_limb) ) allocate(tau_limb (ntau_d1y,ntau_d2t)) - 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") - call mpas_timer_start('bl_gwdo') - call gwdo ( & - p3d = pres_hydd_p , p3di = pres2_hydd_p , pi3d = pi_p , & - u3d = u_p , v3d = v_p , t3d = t_p , & - qv3d = qv_p , z = zmid_p , rublten = rublten_p , & - rvblten = rvblten_p , dtaux3d = dtaux3d_p , dtauy3d = dtauy3d_p , & - dusfcg = dusfcg_p , dvsfcg = dvsfcg_p , kpbl2d = kpbl_p , & - itimestep = itimestep , dt = dt_pbl , dx = dx_p , & - cp = cp , g = gravity , rd = R_d , & - rv = R_v , ep1 = ep_1 , pi = pii , & - var2d = var2d_p , oc12d = con_p , oa2d1 = oa1_p , & - oa2d2 = oa2_p , oa2d3 = oa3_p , oa2d4 = oa4_p , & - ol2d1 = ol1_p , ol2d2 = ol2_p , ol2d3 = ol3_p , & - ol2d4 = ol4_p , sina = sina_p , cosa = cosa_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_gwdo') - - case("bl_ugwp_gwdo") - call mpas_timer_start('bl_ugwp_gwdo') - call gwdo_ugwp ( & - p3d = pres_hydd_p , p3di = pres2_hydd_p, pi3d = pi_p , & - u3d = u_p , v3d = v_p , t3d = t_p , & - qv3d = qv_p , z = zmid_p , rublten = rublten_p , & - rvblten = rvblten_p , rthblten = rthblten_p , & - dtaux3d = dtaux3d_p , dtauy3d = dtauy3d_p , & - dusfcg = dusfcg_p , dvsfcg = dvsfcg_p , kpbl2d = kpbl_p , & - itimestep = itimestep , dt = dt_pbl , dx = dx_p , & - pblh = hpbl_p , br1 = br_p , xland = xland_p , & - cp = cp , g = gravity , rd = R_d , & - rv = R_v , ep1 = ep_1 , pi = pii , & - sina = sina_p , cosa = cosa_p , dz = dz_p , & - var2dls = var2dls_p , oc12dls = conls_p , oa2d1ls = oa1ls_p , & - oa2d2ls = oa2ls_p , oa2d3ls = oa3ls_p , oa2d4ls = oa4ls_p , & - ol2d1ls = ol1ls_p , ol2d2ls = ol2ls_p , ol2d3ls = ol3ls_p , & - ol2d4ls = ol4ls_p , var2dss = var2dss_p , oc12dss = conss_p , & - oa2d1ss = oa1ss_p , oa2d2ss = oa2ss_p , oa2d3ss = oa3ss_p , & - oa2d4ss = oa4ss_p , ol2d1ss = ol1ss_p , ol2d2ss = ol2ss_p , & - ol2d3ss = ol3ss_p , ol2d4ss = ol4ss_p , zi = z_p , & - dusfc_ls = dusfc_ls_p , dvsfc_ls = dvsfc_ls_p , dusfc_bl = dusfc_bl_p, & - dvsfc_bl = dvsfc_bl_p , dusfc_ss = dusfc_ss_p , dvsfc_ss = dvsfc_ss_p, & - dusfc_fd = dusfc_fd_p , dvsfc_fd = dvsfc_fd_p , & - dtaux3d_ls = dtaux3d_ls_p, dtauy3d_ls = dtauy3d_ls_p, & - dtaux3d_bl = dtaux3d_bl_p, dtauy3d_bl = dtauy3d_bl_p, & - dtaux3d_ss = dtaux3d_ss_p, dtauy3d_ss = dtauy3d_ss_p, & - dtaux3d_fd = dtaux3d_fd_p, dtauy3d_fd = dtauy3d_fd_p, & - ugwp_diags = ugwp_diags , ngw_scheme = ngw_scheme , xlatd = xlat_p , & - jindx1_tau = jindx1_tau_p, jindx2_tau = jindx2_tau_p, & - ddy_j1tau = ddy_j1tau_p , ddy_j2tau = ddy_j2tau_p , r_DoY = curr_julday, & - raincv = raincv_p , rainncv = rainncv_p , ntau_d1y = ntau_d1y , & - ntau_d2t = ntau_d2t , days_limb = days_limb , tau_limb = tau_limb , & - dudt_ngw = dudt_ngw_p , dvdt_ngw = dvdt_ngw_p , dtdt_ngw = dtdt_ngw_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 & - ) - if (ngw_scheme) then - if(allocated(days_limb)) deallocate(days_limb) - 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 -!================================================================================================================= From cbe855698fd449104d92e9c67b5299811353240b Mon Sep 17 00:00:00 2001 From: Songyou Hong Date: Tue, 23 Dec 2025 12:50:26 -0700 Subject: [PATCH 11/19] Delete src/core_atmosphere/physics/mpas_atmphys_driver_pbl.F-org --- .../physics/mpas_atmphys_driver_pbl.F-org | 977 ------------------ 1 file changed, 977 deletions(-) delete mode 100644 src/core_atmosphere/physics/mpas_atmphys_driver_pbl.F-org diff --git a/src/core_atmosphere/physics/mpas_atmphys_driver_pbl.F-org b/src/core_atmosphere/physics/mpas_atmphys_driver_pbl.F-org deleted file mode 100644 index 72a411aeba..0000000000 --- a/src/core_atmosphere/physics/mpas_atmphys_driver_pbl.F-org +++ /dev/null @@ -1,977 +0,0 @@ -! Copyright (c) 2013, Los Alamos National Security, LLC (LANS) -! and the University Corporation for Atmospheric Research (UCAR). -! -! Unless noted otherwise source code is licensed under the BSD license. -! Additional copyright and license information can be found in the LICENSE file -! distributed with this code, or at http://mpas-dev.github.com/license.html -! -!================================================================================================================= - module mpas_atmphys_driver_pbl - 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 bl_mynn,only: bl_mynn_init - use module_bl_mynn,only: mynn_bl_driver - use module_bl_ysu - - implicit none - private - public:: allocate_pbl, & - deallocate_pbl, & - init_pbl, & - driver_pbl - -!MPAS driver for parameterization of Planetary Boundary Layer (PBL) processes. -!Laura D. Fowler (send comments to laura@ucar.edu). -!2013-05-01. -! -! subroutines in mpas_atmphys_driver_pbl: -! --------------------------------------- -! allocate_pbl : allocate local arrays for parameterization of PBL processes. -! deallocate_pbl: deallocate local arrays for parameterization of PBL processes. -! driver_pbl : main driver (called from subroutine physics_driver). -! pbl_from_MPAS : initialize local arrays. -! pbl_to_MPAS : copy local arrays to MPAS arrays. -! -! WRF physics called from driver_pbl: -! ----------------------------------- -! * module_bl_ysu : YSU PBL scheme. -! -! add-ons and modifications to sourcecode: -! ---------------------------------------- -! * removed the pre-processor option "do_hydrostatic_pressure" before call to subroutine ysu. -! Laura D. Fowler (birch.ucar.edu) / 2013-05-29. -! * in call to subroutine ysu, replaced the variable g (that originally pointed to gravity) -! with gravity, for simplicity. -! Laura D. Fowler (laura@ucar.edu) / 2014-03-21. -! * throughout the sourcecode, replaced all "var_struct" defined arrays by local pointers. -! Laura D. Fowler (laura@ucar.edu) / 2014-04-22. -! * modified sourcecode to use pools. -! Laura D. Fowler (laura@ucar.edu) / 2014-05-15. -! * renamed "ysu" with "bl_ysu". -! Laura D. Fowler (laura@ucar.edu) / 2016-03-25. -! * added the implementation of the MYNN PBL scheme from WRF 3.6.1. -! Laura D. Fowler (laura@ucar.edu) / 2016-03-30. -! * corrected the initialization of sh3d for the mynn parameterization. -! Laura D. Fowler (laura@ucar.edu) / 2016-04-13. -! * for the mynn parameterization, change the definition of dx_p to match that used in other physics -! parameterizations. -! Laura D. Fowler (laura@ucar.edu) / 2016-10-18. -! * updated the call to subroutine ysu in conjunction with updating module_bl_ysu.F from WRF version 3.6.1 to -! WRF version 3.8.1 -! Laura D. Fowler (laura@ucar.edu) / 2016-10-27. -! * since we removed the local variable pbl_scheme from mpas_atmphys_vars.F, now defines pbl_scheme as a pointer -! to config_pbl_scheme. -! Laura D. Fowler (laura@ucar.edu) / 2917-02-16. -! * after updating module_bl_ysu.F to WRF version 4.0.3, corrected call to subroutine ysu to output diagnostics of -! exchange coefficients exch_h and exch_m. -! Laura D. Fowler (laura@ucar.edu) / 2019-03-12. -! * updated the call to subroutine ysu after updating the YSU PBL scheme to that in WRF 4.4.1. added the flags -! errmsg and errflg in the call to subroutine ysu for compliance with the CCPP framework. also removed local -! variable regime_p which is no longer needed in the call to subroutine ysu. -! Laura D. Fowler (laura@ucar.edu) / 2023-05-15. -! * in the call to subroutine mynn_bl_driver,renamed f_qnc to f_nc, and f_qni to f_ni. -! 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. - - - contains - - -!================================================================================================================= - subroutine allocate_pbl(configs) -!================================================================================================================= - -!input arguments: - type(mpas_pool_type),intent(in):: configs - -!local pointers: - character(len=StrKIND),pointer:: pbl_scheme - -!----------------------------------------------------------------------------------------------------------------- - - call mpas_pool_get_config(configs,'config_pbl_scheme',pbl_scheme) - - if(.not.allocated(hfx_p) ) allocate(hfx_p(ims:ime,jms:jme) ) - if(.not.allocated(qfx_p) ) allocate(qfx_p(ims:ime,jms:jme) ) - 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(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) ) - if(.not.allocated(uoce_p) ) allocate(uoce_p(ims:ime,jms:jme) ) - if(.not.allocated(voce_p) ) allocate(voce_p(ims:ime,jms:jme) ) - - !tendencies: - 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)) - if(.not.allocated(rqvblten_p)) allocate(rqvblten_p(ims:ime,kms:kme,jms:jme)) - if(.not.allocated(rqcblten_p)) allocate(rqcblten_p(ims:ime,kms:kme,jms:jme)) - if(.not.allocated(rqiblten_p)) allocate(rqiblten_p(ims:ime,kms:kme,jms:jme)) - - if(.not.allocated(rthraten_p)) allocate(rthraten_p(ims:ime,kms:kme,jms:jme)) - - !exchange coefficients: - if(.not.allocated(kzh_p)) allocate(kzh_p(ims:ime,kms:kme,jms:jme)) - if(.not.allocated(kzm_p)) allocate(kzm_p(ims:ime,kms:kme,jms:jme)) - if(.not.allocated(kzq_p)) allocate(kzq_p(ims:ime,kms:kme,jms:jme)) - - pbl_select: select case (trim(pbl_scheme)) - - case("bl_ysu") - !from surface-layer model: - if(.not.allocated(br_p) ) allocate(br_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) ) - - case("bl_mynn") - if(.not.allocated(kbl_plume_p) ) allocate(kbl_plume_p(ims:ime,jms:jme) ) - if(.not.allocated(dx_p) ) allocate(dx_p(ims:ime,jms:jme) ) - if(.not.allocated(ch_p) ) allocate(ch_p(ims:ime,jms:jme) ) - if(.not.allocated(qsfc_p) ) allocate(qsfc_p(ims:ime,jms:jme) ) - if(.not.allocated(rmol_p) ) allocate(rmol_p(ims:ime,jms:jme) ) - if(.not.allocated(tsk_p) ) allocate(tsk_p(ims:ime,jms:jme) ) - if(.not.allocated(maxwidthbl_p)) allocate(maxwidthbl_p(ims:ime,jms:jme) ) - if(.not.allocated(maxmfbl_p) ) allocate(maxmfbl_p(ims:ime,jms:jme) ) - if(.not.allocated(zbl_plume_p) ) allocate(zbl_plume_p(ims:ime,jms:jme) ) - if(.not.allocated(cov_p) ) allocate(cov_p(ims:ime,kms:kme,jms:jme) ) - if(.not.allocated(qke_p) ) allocate(qke_p(ims:ime,kms:kme,jms:jme) ) - if(.not.allocated(qsq_p) ) allocate(qsq_p(ims:ime,kms:kme,jms:jme) ) - if(.not.allocated(tsq_p) ) allocate(tsq_p(ims:ime,kms:kme,jms:jme) ) - if(.not.allocated(qkeadv_p) ) allocate(qkeadv_p(ims:ime,kms:kme,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) ) - if(.not.allocated(sh3d_p) ) allocate(sh3d_p(ims:ime,kms:kme,jms:jme) ) - if(.not.allocated(sm3d_p) ) allocate(sm3d_p(ims:ime,kms:kme,jms:jme) ) - if(.not.allocated(dqke_p) ) allocate(dqke_p(ims:ime,kms:kme,jms:jme) ) - if(.not.allocated(qbuoy_p) ) allocate(qbuoy_p(ims:ime,kms:kme,jms:jme) ) - if(.not.allocated(qdiss_p) ) allocate(qdiss_p(ims:ime,kms:kme,jms:jme) ) - if(.not.allocated(qshear_p) ) allocate(qshear_p(ims:ime,kms:kme,jms:jme) ) - if(.not.allocated(qwt_p) ) allocate(qwt_p(ims:ime,kms:kme,jms:jme) ) - if(.not.allocated(qcbl_p) ) allocate(qcbl_p(ims:ime,kms:kme,jms:jme) ) - if(.not.allocated(qibl_p) ) allocate(qibl_p(ims:ime,kms:kme,jms:jme) ) - if(.not.allocated(cldfrabl_p) ) allocate(cldfrabl_p(ims:ime,kms:kme,jms:jme) ) - if(.not.allocated(edmfa_p) ) allocate(edmfa_p(ims:ime,kms:kme,jms:jme) ) - if(.not.allocated(edmfw_p) ) allocate(edmfw_p(ims:ime,kms:kme,jms:jme) ) - if(.not.allocated(edmfqt_p) ) allocate(edmfqt_p(ims:ime,kms:kme,jms:jme) ) - if(.not.allocated(edmfthl_p) ) allocate(edmfthl_p(ims:ime,kms:kme,jms:jme) ) - if(.not.allocated(edmfent_p) ) allocate(edmfent_p(ims:ime,kms:kme,jms:jme) ) - if(.not.allocated(edmfqc_p) ) allocate(edmfqc_p(ims:ime,kms:kme,jms:jme) ) - if(.not.allocated(subthl_p) ) allocate(subthl_p(ims:ime,kms:kme,jms:jme) ) - if(.not.allocated(subqv_p) ) allocate(subqv_p(ims:ime,kms:kme,jms:jme) ) - if(.not.allocated(detthl_p) ) allocate(detthl_p(ims:ime,kms:kme,jms:jme) ) - if(.not.allocated(detqv_p) ) allocate(detqv_p(ims:ime,kms:kme,jms:jme) ) - - !additional tendencies: - if(.not.allocated(rqsblten_p) ) allocate(rqsblten_p(ims:ime,kms:kme,jms:jme) ) - if(.not.allocated(rncblten_p) ) allocate(rncblten_p(ims:ime,kms:kme,jms:jme) ) - if(.not.allocated(rniblten_p) ) allocate(rniblten_p(ims:ime,kms:kme,jms:jme) ) - if(.not.allocated(rnifablten_p)) allocate(rnifablten_p(ims:ime,kms:kme,jms:jme)) - if(.not.allocated(rnwfablten_p)) allocate(rnwfablten_p(ims:ime,kms:kme,jms:jme)) - - !allocation of additional arrays: - if(.not.allocated(pattern_spp_pbl)) allocate(pattern_spp_pbl(ims:ime,kms:kme,jms:jme)) - - case default - - end select pbl_select - - end subroutine allocate_pbl - -!================================================================================================================= - subroutine deallocate_pbl(configs) -!================================================================================================================= - -!input arguments: - type(mpas_pool_type),intent(in):: configs - -!local pointers: - character(len=StrKIND),pointer:: pbl_scheme - -!----------------------------------------------------------------------------------------------------------------- - - call mpas_pool_get_config(configs,'config_pbl_scheme',pbl_scheme) - - if(allocated(hfx_p) ) deallocate(hfx_p ) - if(allocated(qfx_p) ) deallocate(qfx_p ) - if(allocated(ust_p) ) deallocate(ust_p ) - if(allocated(wspd_p) ) deallocate(wspd_p ) - if(allocated(xland_p)) deallocate(xland_p) - if(allocated(hpbl_p) ) deallocate(hpbl_p ) - if(allocated(kpbl_p) ) deallocate(kpbl_p ) - if(allocated(znt_p) ) deallocate(znt_p ) - if(allocated(uoce_p) ) deallocate(uoce_p ) - if(allocated(voce_p) ) deallocate(voce_p ) - - !tendencies: - if(allocated(rublten_p) ) deallocate(rublten_p ) - if(allocated(rvblten_p) ) deallocate(rvblten_p ) - if(allocated(rthblten_p)) deallocate(rthblten_p) - if(allocated(rqvblten_p)) deallocate(rqvblten_p) - if(allocated(rqcblten_p)) deallocate(rqcblten_p) - if(allocated(rqiblten_p)) deallocate(rqiblten_p) - - if(allocated(rthraten_p)) deallocate(rthraten_p) - - !exchange coefficients: - if(allocated(kzh_p)) deallocate(kzh_p) - if(allocated(kzm_p)) deallocate(kzm_p) - if(allocated(kzq_p)) deallocate(kzq_p) - - pbl_select: select case (trim(pbl_scheme)) - - case("bl_ysu") - !from surface-layer model: - if(allocated(br_p) ) deallocate(br_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 ) - - case("bl_mynn") - if(allocated(kbl_plume_p) ) deallocate(kbl_plume_p ) - if(allocated(dx_p) ) deallocate(dx_p ) - if(allocated(ch_p) ) deallocate(ch_p ) - if(allocated(qsfc_p) ) deallocate(qsfc_p ) - if(allocated(rmol_p) ) deallocate(rmol_p ) - if(allocated(tsk_p) ) deallocate(tsk_p ) - if(allocated(maxwidthbl_p)) deallocate(maxwidthbl_p) - if(allocated(maxmfbl_p) ) deallocate(maxmfbl_p ) - if(allocated(zbl_plume_p) ) deallocate(zbl_plume_p ) - - if(allocated(cov_p) ) deallocate(cov_p ) - if(allocated(qke_p) ) deallocate(qke_p ) - if(allocated(qsq_p) ) deallocate(qsq_p ) - if(allocated(tsq_p) ) deallocate(tsq_p ) - if(allocated(qkeadv_p) ) deallocate(qkeadv_p ) - if(allocated(elpbl_p) ) deallocate(elpbl_p ) - if(allocated(tkepbl_p) ) deallocate(tkepbl_p ) - if(allocated(sh3d_p) ) deallocate(sh3d_p ) - if(allocated(sm3d_p) ) deallocate(sm3d_p ) - if(allocated(dqke_p) ) deallocate(dqke_p ) - if(allocated(qbuoy_p) ) deallocate(qbuoy_p ) - if(allocated(qdiss_p) ) deallocate(qdiss_p ) - if(allocated(qshear_p) ) deallocate(qshear_p ) - if(allocated(qwt_p) ) deallocate(qwt_p ) - if(allocated(qcbl_p) ) deallocate(qcbl_p ) - if(allocated(qibl_p) ) deallocate(qibl_p ) - if(allocated(cldfrabl_p) ) deallocate(cldfrabl_p ) - if(allocated(edmfa_p) ) deallocate(edmfa_p ) - if(allocated(edmfw_p) ) deallocate(edmfw_p ) - if(allocated(edmfqt_p) ) deallocate(edmfqt_p ) - if(allocated(edmfthl_p) ) deallocate(edmfthl_p ) - if(allocated(edmfent_p) ) deallocate(edmfent_p ) - if(allocated(edmfqc_p) ) deallocate(edmfqc_p ) - if(allocated(subthl_p) ) deallocate(subthl_p ) - if(allocated(subqv_p) ) deallocate(subqv_p ) - if(allocated(detthl_p) ) deallocate(detthl_p ) - if(allocated(detqv_p) ) deallocate(detqv_p ) - - !additional tendencies: - if(allocated(rqsblten_p) ) deallocate(rqsblten_p ) - if(allocated(rncblten_p) ) deallocate(rncblten_p ) - if(allocated(rniblten_p) ) deallocate(rniblten_p ) - if(allocated(rnifablten_p)) deallocate(rnifablten_p) - if(allocated(rnwfablten_p)) deallocate(rnwfablten_p) - - !deallocation of additional arrays: - if(allocated(pattern_spp_pbl)) deallocate(pattern_spp_pbl) - - case default - - end select pbl_select - - end subroutine deallocate_pbl - -!================================================================================================================= - subroutine pbl_from_MPAS(configs,mesh,sfc_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):: diag_physics - type(mpas_pool_type),intent(in):: sfc_input - type(mpas_pool_type),intent(in):: tend_physics - - integer,intent(in):: its,ite - -!local variables: - integer:: i,k,j - -!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:: 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 MYNN scheme: - real(kind=RKIND),pointer:: len_disp - real(kind=RKIND),dimension(:),pointer :: meshDensity - real(kind=RKIND),dimension(:),pointer :: ch,qsfc,rmol,skintemp - real(kind=RKIND),dimension(:,:),pointer:: cov,qke,qsq,tsq,sh3d,sm3d,tke_pbl,qke_adv,el_pbl - real(kind=RKIND),dimension(:,:),pointer:: cldfrac_bl,qc_bl,qi_bl - real(kind=RKIND),dimension(:,:),pointer:: edmf_a,edmf_ent,edmf_qc,edmf_qt,edmf_thl,edmf_w - real(kind=RKIND),dimension(:,:),pointer:: sub_thl,sub_qv,det_thl,det_qv - -!----------------------------------------------------------------------------------------------------------------- - - call mpas_pool_get_config(configs,'config_pbl_scheme',pbl_scheme) - - call mpas_pool_get_array(diag_physics,'hfx' ,hfx ) - call mpas_pool_get_array(diag_physics,'hpbl',hpbl) - call mpas_pool_get_array(diag_physics,'qfx' ,qfx ) - call mpas_pool_get_array(diag_physics,'ust' ,ust ) - call mpas_pool_get_array(diag_physics,'wspd',wspd) - call mpas_pool_get_array(diag_physics,'znt' ,znt ) - - call mpas_pool_get_array(tend_physics,'rthratenlw',rthratenlw) - call mpas_pool_get_array(tend_physics,'rthratensw',rthratensw) - - call mpas_pool_get_array(sfc_input,'xland',xland) - - do j = jts,jte - do i = its,ite - !from surface-layer model: - hfx_p(i,j) = hfx(i) - hpbl_p(i,j) = hpbl(i) - qfx_p(i,j) = qfx(i) - ust_p(i,j) = ust(i) - wspd_p(i,j) = wspd(i) - xland_p(i,j) = xland(i) - kpbl_p(i,j) = 1 - znt_p(i,j) = znt(i) - !... ocean currents are set to zero: - uoce_p(i,j) = 0._RKIND - voce_p(i,j) = 0._RKIND - enddo - do k = kts,kte - do i = its,ite - rthraten_p(i,k,j) = rthratenlw(k,i) + rthratensw(k,i) - enddo - enddo - enddo - - pbl_select: select case (trim(pbl_scheme)) - - case("bl_ysu") - call mpas_pool_get_config(configs,'config_ysu_pblmix',config_ysu_pblmix) - - 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) - - ysu_pblmix = 0 - if(config_ysu_pblmix) ysu_pblmix = 1 - - 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 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 - enddo - enddo - enddo - - case("bl_mynn") - call mpas_pool_get_config(configs,'config_len_disp',len_disp) - call mpas_pool_get_array(mesh,'meshDensity',meshDensity) - - call mpas_pool_get_array(sfc_input,'skintemp',skintemp) - call mpas_pool_get_array(diag_physics,'ch' ,ch ) - call mpas_pool_get_array(diag_physics,'qsfc' ,qsfc ) - call mpas_pool_get_array(diag_physics,'rmol' ,rmol ) - call mpas_pool_get_array(diag_physics,'el_pbl' ,el_pbl ) - call mpas_pool_get_array(diag_physics,'cov' ,cov ) - call mpas_pool_get_array(diag_physics,'qke' ,qke ) - call mpas_pool_get_array(diag_physics,'qke_adv' ,qke_adv ) - call mpas_pool_get_array(diag_physics,'qsq' ,qsq ) - call mpas_pool_get_array(diag_physics,'tsq' ,tsq ) - call mpas_pool_get_array(diag_physics,'tke_pbl' ,tke_pbl ) - call mpas_pool_get_array(diag_physics,'sh3d' ,sh3d ) - call mpas_pool_get_array(diag_physics,'sm3d' ,sm3d ) - call mpas_pool_get_array(diag_physics,'cldfrac_bl',cldfrac_bl) - call mpas_pool_get_array(diag_physics,'qc_bl' ,qc_bl ) - call mpas_pool_get_array(diag_physics,'qi_bl' ,qi_bl ) - call mpas_pool_get_array(diag_physics,'edmf_a' ,edmf_a ) - call mpas_pool_get_array(diag_physics,'edmf_ent' ,edmf_ent ) - call mpas_pool_get_array(diag_physics,'edmf_qc' ,edmf_qc ) - call mpas_pool_get_array(diag_physics,'edmf_qt' ,edmf_qt ) - call mpas_pool_get_array(diag_physics,'edmf_thl' ,edmf_thl ) - call mpas_pool_get_array(diag_physics,'edmf_w' ,edmf_w ) - call mpas_pool_get_array(diag_physics,'sub_thl' ,sub_thl ) - call mpas_pool_get_array(diag_physics,'sub_qv' ,sub_qv ) - call mpas_pool_get_array(diag_physics,'det_thl' ,det_thl ) - call mpas_pool_get_array(diag_physics,'det_qv' ,det_qv ) - - do j = jts,jte - do i = its,ite - dx_p(i,j) = len_disp / meshDensity(i)**0.25 - ch_p(i,j) = ch(i) - qsfc_p(i,j) = qsfc(i) - rmol_p(i,j) = rmol(i) - tsk_p(i,j) = skintemp(i) - enddo - enddo - - do j = jts,jte - do k = kts,kte - do i = its,ite - elpbl_p(i,k,j) = el_pbl(k,i) - cov_p(i,k,j) = cov(k,i) - qke_p(i,k,j) = qke(k,i) - qsq_p(i,k,j) = qsq(k,i) - tsq_p(i,k,j) = tsq(k,i) - tkepbl_p(i,k,j) = tke_pbl(k,i) - qkeadv_p(i,k,j) = qke_adv(k,i) - sh3d_p(i,k,j) = sh3d(k,i) - sm3d_p(i,k,j) = sm3d(k,i) - cldfrabl_p(i,k,j) = cldfrac_bl(k,i) - qcbl_p(i,k,j) = qc_bl(k,i) - qibl_p(i,k,j) = qi_bl(k,i) - edmfa_p(i,k,j) = edmf_a(k,i) - edmfent_p(i,k,j) = edmf_ent(k,i) - edmfqc_p(i,k,j) = edmf_qc(k,i) - edmfqt_p(i,k,j) = edmf_qt(k,i) - edmfthl_p(i,k,j) = edmf_thl(k,i) - edmfw_p(i,k,j) = edmf_w(k,i) - subthl_p(i,k,j) = sub_thl(k,i) - subqv_p(i,k,j) = sub_qv(k,i) - detthl_p(i,k,j) = det_thl(k,i) - detqv_p(i,k,j) = det_qv(k,i) - dqke_p(i,k,j) = 0._RKIND - qbuoy_p(i,k,j) = 0._RKIND - qdiss_p(i,k,j) = 0._RKIND - qshear_p(i,k,j) = 0._RKIND - qwt_p(i,k,j) = 0._RKIND - - rqsblten_p(i,k,j) = 0._RKIND - rncblten_p(i,k,j) = 0._RKIND - rniblten_p(i,k,j) = 0._RKIND - rnifablten_p(i,k,j) = 0._RKIND - rnwfablten_p(i,k,j) = 0._RKIND - - pattern_spp_pbl(i,k,j) = 0._RKIND - enddo - enddo - do i = its,ite - kbl_plume_p(i,j) = 0 - maxwidthbl_p(i,j) = 0._RKIND - maxmfbl_p(i,j) = 0._RKIND - zbl_plume_p(i,j) = 0 - enddo - enddo - - case default - - end select pbl_select - - do j = jts,jte - do k = kts,kte - do i = its,ite - rublten_p(i,k,j) = 0._RKIND - rvblten_p(i,k,j) = 0._RKIND - rthblten_p(i,k,j) = 0._RKIND - rqvblten_p(i,k,j) = 0._RKIND - rqcblten_p(i,k,j) = 0._RKIND - rqiblten_p(i,k,j) = 0._RKIND - - kzh_p(i,k,j) = 0._RKIND - kzm_p(i,k,j) = 0._RKIND - kzq_p(i,k,j) = 0._RKIND - enddo - enddo - enddo - - end subroutine pbl_from_MPAS - -!================================================================================================================= - subroutine pbl_to_MPAS(configs,diag_physics,tend_physics,its,ite) -!================================================================================================================= - -!input arguments: - 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 - - integer,intent(in):: its,ite - -!local variables: - integer:: i,k,j - -!local pointers: - character(len=StrKIND),pointer:: pbl_scheme - - integer,dimension(:),pointer:: kpbl - - real(kind=RKIND),dimension(:),pointer :: hpbl - real(kind=RKIND),dimension(:,:),pointer:: kzh,kzm,kzq - real(kind=RKIND),dimension(:,:),pointer:: rublten,rvblten,rthblten,rqvblten,rqcblten,rqiblten,rqsblten - real(kind=RKIND),dimension(:,:),pointer:: rncblten,rniblten,rnifablten,rnwfablten - -!local pointers for YSU scheme: - real(kind=RKIND),dimension(:,:),pointer:: exch_h - -!local pointers for MYNN scheme: - real(kind=RKIND),dimension(:),pointer :: delta,wstar - real(kind=RKIND),dimension(:,:),pointer:: cov,qke,qsq,tsq,sh3d,sm3d,tke_pbl,qke_adv,el_pbl,dqke,qbuoy, & - qdiss,qshear,qwt - real(kind=RKIND),dimension(:,:),pointer:: cldfrac_bl,qc_bl,qi_bl - real(kind=RKIND),dimension(:,:),pointer:: edmf_a,edmf_ent,edmf_qc,edmf_qt,edmf_thl,edmf_w - real(kind=RKIND),dimension(:,:),pointer:: sub_thl,sub_qv,det_thl,det_qv - -!----------------------------------------------------------------------------------------------------------------- - - call mpas_pool_get_config(configs,'config_pbl_scheme',pbl_scheme) - - call mpas_pool_get_array(diag_physics,'kpbl' ,kpbl ) - call mpas_pool_get_array(diag_physics,'hpbl' ,hpbl ) - call mpas_pool_get_array(diag_physics,'kzh' ,kzh ) - call mpas_pool_get_array(diag_physics,'kzm' ,kzm ) - call mpas_pool_get_array(diag_physics,'kzq' ,kzq ) - - 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) - call mpas_pool_get_array(tend_physics,'rqvblten',rqvblten) - call mpas_pool_get_array(tend_physics,'rqcblten',rqcblten) - call mpas_pool_get_array(tend_physics,'rqiblten',rqiblten) - - do j = jts,jte - do i = its,ite - hpbl(i) = hpbl_p(i,j) - kpbl(i) = kpbl_p(i,j) - enddo - enddo - - do j = jts,jte - do k = kts,kte - do i = its,ite - rublten(k,i) = rublten_p(i,k,j) - rvblten(k,i) = rvblten_p(i,k,j) - rthblten(k,i) = rthblten_p(i,k,j) - rqvblten(k,i) = rqvblten_p(i,k,j) - rqcblten(k,i) = rqcblten_p(i,k,j) - rqiblten(k,i) = rqiblten_p(i,k,j) - - kzh(k,i) = kzh_p(i,k,j) - kzm(k,i) = kzm_p(i,k,j) - kzq(k,i) = kzh_p(i,k,j) - enddo - enddo - enddo - - pbl_select: select case (trim(pbl_scheme)) - - case("bl_ysu") - 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) - - 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) - enddo - enddo - enddo - - case("bl_mynn") - call mpas_pool_get_array(diag_physics,'el_pbl' ,el_pbl ) - call mpas_pool_get_array(diag_physics,'cov' ,cov ) - call mpas_pool_get_array(diag_physics,'qke' ,qke ) - call mpas_pool_get_array(diag_physics,'qke_adv' ,qke_adv ) - call mpas_pool_get_array(diag_physics,'qsq' ,qsq ) - call mpas_pool_get_array(diag_physics,'tsq' ,tsq ) - call mpas_pool_get_array(diag_physics,'tke_pbl' ,tke_pbl ) - call mpas_pool_get_array(diag_physics,'sh3d' ,sh3d ) - call mpas_pool_get_array(diag_physics,'sm3d' ,sm3d ) - call mpas_pool_get_array(diag_physics,'dqke' ,dqke ) - call mpas_pool_get_array(diag_physics,'qbuoy' ,qbuoy ) - call mpas_pool_get_array(diag_physics,'qdiss' ,qdiss ) - call mpas_pool_get_array(diag_physics,'qshear' ,qshear ) - call mpas_pool_get_array(diag_physics,'qwt' ,qwt ) - call mpas_pool_get_array(diag_physics,'cldfrac_bl',cldfrac_bl) - call mpas_pool_get_array(diag_physics,'qc_bl' ,qc_bl ) - call mpas_pool_get_array(diag_physics,'qi_bl' ,qi_bl ) - call mpas_pool_get_array(diag_physics,'edmf_a' ,edmf_a ) - call mpas_pool_get_array(diag_physics,'edmf_ent' ,edmf_ent ) - call mpas_pool_get_array(diag_physics,'edmf_qc' ,edmf_qc ) - call mpas_pool_get_array(diag_physics,'edmf_qt' ,edmf_qt ) - call mpas_pool_get_array(diag_physics,'edmf_thl' ,edmf_thl ) - call mpas_pool_get_array(diag_physics,'edmf_w' ,edmf_w ) - call mpas_pool_get_array(diag_physics,'sub_thl' ,sub_thl ) - call mpas_pool_get_array(diag_physics,'sub_qv' ,sub_qv ) - call mpas_pool_get_array(diag_physics,'det_thl' ,det_thl ) - call mpas_pool_get_array(diag_physics,'det_qv' ,det_qv ) - - call mpas_pool_get_array(tend_physics,'rqsblten' ,rqsblten ) - - do j = jts,jte - do k = kts,kte - do i = its,ite - el_pbl(k,i) = elpbl_p(i,k,j) - cov(k,i) = cov_p(i,k,j) - qke(k,i) = qke_p(i,k,j) - qsq(k,i) = qsq_p(i,k,j) - tsq(k,i) = tsq_p(i,k,j) - sh3d(k,i) = sh3d_p(i,k,j) - sm3d(k,i) = sm3d_p(i,k,j) - tke_pbl(k,i) = tkepbl_p(i,k,j) - qke_adv(k,i) = qkeadv_p(i,k,j) - cldfrac_bl(k,i) = cldfrabl_p(i,k,j) - qc_bl(k,i) = qcbl_p(i,k,j) - qi_bl(k,i) = qibl_p(i,k,j) - edmf_a(k,i) = edmfa_p(i,k,j) - edmf_ent(k,i) = edmfent_p(i,k,j) - edmf_qc(k,i) = edmfqc_p(i,k,j) - edmf_qt(k,i) = edmfqt_p(i,k,j) - edmf_thl(k,i) = edmfthl_p(i,k,j) - edmf_w(k,i) = edmfw_p(i,k,j) - sub_thl(k,i) = subthl_p(i,k,j) - sub_qv(k,i) = subqv_p(i,k,j) - det_thl(k,i) = detthl_p(i,k,j) - det_qv(k,i) = detqv_p(i,k,j) - dqke(k,i) = dqke_p(i,k,j) - qbuoy(k,i) = qbuoy_p(i,k,j) - qdiss(k,i) = qdiss_p(i,k,j) - qshear(k,i) = qshear_p(i,k,j) - qwt(k,i) = qwt_p(i,k,j) - - rqsblten(k,i) = rqsblten_p(i,k,j) - enddo - enddo - enddo - - if(f_ni) then - call mpas_pool_get_array(tend_physics,'rniblten',rniblten) - do j = jts,jte - do k = kts,kte - do i = its,ite - rniblten(k,i) = rniblten_p(i,k,j) - enddo - enddo - enddo - endif - if(f_nc .and. f_nifa .and. f_nwfa) then - call mpas_pool_get_array(tend_physics,'rncblten' ,rncblten ) - call mpas_pool_get_array(tend_physics,'rnifablten',rnifablten) - call mpas_pool_get_array(tend_physics,'rnwfablten',rnwfablten) - do j = jts,jte - do k = kts,kte - do i = its,ite - rncblten(k,i) = rncblten_p(i,k,j) - rnifablten(k,i) = rnifablten_p(i,k,j) - rnwfablten(k,i) = rnwfablten_p(i,k,j) - enddo - enddo - enddo - endif - - case default - - end select pbl_select - - end subroutine pbl_to_MPAS - -!================================================================================================================= - subroutine init_pbl(configs) -!================================================================================================================= - -!input arguments: - type(mpas_pool_type),intent(in):: configs - -!local variables and pointers: - character(len=StrKIND),pointer:: pbl_scheme - character(len=StrKIND):: errmsg - integer:: errflg - -!----------------------------------------------------------------------------------------------------------------- - - call mpas_pool_get_config(configs,'config_pbl_scheme',pbl_scheme) - - pbl_select: select case (trim(pbl_scheme)) - - case("bl_mynn") -! call mpas_log_write('--- enter subroutine bl_mynn_init:') - call bl_mynn_init(cp,cpv,cice,cliq,ep_1,ep_2,gravity,karman,P0,R_d,R_v,svp1,svp2,svp3,svpt0, & - xlf,xls,xlv,errmsg,errflg) -! call mpas_log_write('--- end subroutine bl_mynn_init:') - - case default - - end select pbl_select - - end subroutine init_pbl - -!================================================================================================================= - subroutine driver_pbl(itimestep,configs,mesh,sfc_input,diag_physics,tend_physics,its,ite) -!================================================================================================================= - -!input arguments: - type(mpas_pool_type),intent(in):: configs - type(mpas_pool_type),intent(in):: mesh - - integer,intent(in):: its,ite - integer,intent(in):: itimestep - -!inout arguments: - type(mpas_pool_type),intent(inout):: sfc_input - type(mpas_pool_type),intent(inout):: diag_physics - type(mpas_pool_type),intent(inout):: tend_physics - -!local pointers: - logical,pointer:: config_do_DAcycling, & - config_do_restart, & - bl_mynn_tkeadvect - - character(len=StrKIND),pointer:: pbl_scheme - - integer,pointer:: bl_mynn_cloudpdf, & - bl_mynn_mixlength, & - bl_mynn_stfunc, & - bl_mynn_topdown, & - bl_mynn_scaleaware, & - bl_mynn_dheat_opt, & - bl_mynn_edmf, & - bl_mynn_edmf_dd, & - bl_mynn_edmf_mom, & - bl_mynn_edmf_tke, & - bl_mynn_edmf_output, & - bl_mynn_mixscalars, & - bl_mynn_cloudmix, & - bl_mynn_mixqt, & - bl_mynn_tkebudget - - real(kind=RKIND),pointer:: bl_mynn_closure - -!local variables: - integer:: initflag - integer:: i,k,j - -!CCPP-compliant flags: - character(len=StrKIND):: errmsg - integer:: errflg - -!----------------------------------------------------------------------------------------------------------------- -!call mpas_log_write('') -!call mpas_log_write('--- enter subroutine driver_pbl:') - -!initialization of CCPP-compliant flags: - errmsg = ' ' - errflg = 0 - - call mpas_pool_get_config(configs,'config_do_DAcycling',config_do_DAcycling) - call mpas_pool_get_config(configs,'config_do_restart' ,config_do_restart ) - call mpas_pool_get_config(configs,'config_pbl_scheme' ,pbl_scheme ) - -!copy MPAS arrays to local arrays: - call pbl_from_MPAS(configs,mesh,sfc_input,diag_physics,tend_physics,its,ite) - - initflag = 1 - if(config_do_restart .or. itimestep > 1) initflag = 0 - - pbl_select: select case (trim(pbl_scheme)) - - case("bl_ysu") - call mpas_timer_start('bl_ysu') - call ysu ( & - 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 , & - 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 , & - ysu_topdown_pblmix = ysu_pblmix , & - 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_ysu') - - case("bl_mynn") - call mpas_pool_get_config(configs,'config_mynn_cloudpdf' ,bl_mynn_cloudpdf ) - call mpas_pool_get_config(configs,'config_mynn_mixlength' ,bl_mynn_mixlength ) - call mpas_pool_get_config(configs,'config_mynn_stfunc' ,bl_mynn_stfunc ) - call mpas_pool_get_config(configs,'config_mynn_topdown' ,bl_mynn_topdown ) - call mpas_pool_get_config(configs,'config_mynn_scaleaware' ,bl_mynn_scaleaware ) - call mpas_pool_get_config(configs,'config_mynn_dheat_opt' ,bl_mynn_dheat_opt ) - call mpas_pool_get_config(configs,'config_mynn_edmf' ,bl_mynn_edmf ) - call mpas_pool_get_config(configs,'config_mynn_edmf_dd' ,bl_mynn_edmf_dd ) - call mpas_pool_get_config(configs,'config_mynn_edmf_mom' ,bl_mynn_edmf_mom ) - call mpas_pool_get_config(configs,'config_mynn_edmf_tke' ,bl_mynn_edmf_tke ) - call mpas_pool_get_config(configs,'config_mynn_edmf_output',bl_mynn_edmf_output) - call mpas_pool_get_config(configs,'config_mynn_closure' ,bl_mynn_closure ) - call mpas_pool_get_config(configs,'config_mynn_mixscalars' ,bl_mynn_mixscalars ) - call mpas_pool_get_config(configs,'config_mynn_mixclouds' ,bl_mynn_cloudmix ) - call mpas_pool_get_config(configs,'config_mynn_mixqt' ,bl_mynn_mixqt ) - call mpas_pool_get_config(configs,'config_mynn_tkeadvect' ,bl_mynn_tkeadvect ) - call mpas_pool_get_config(configs,'config_mynn_tkebudget' ,bl_mynn_tkebudget ) - -! call mpas_log_write(' ') -! call mpas_log_write('--- enter subroutine mynn_bl_driver:') -! call mpas_log_write('--- config_mynn_cloudpdf = $i',intArgs=(/bl_mynn_cloudpdf/)) -! call mpas_log_write('--- config_mynn_mixlength = $i',intArgs=(/bl_mynn_mixlength/)) -! call mpas_log_write('--- config_mynn_stfunc = $i',intArgs=(/bl_mynn_stfunc/)) -! call mpas_log_write('--- config_mynn_topdown = $i',intArgs=(/bl_mynn_topdown/)) -! call mpas_log_write('--- config_mynn_scaleaware = $i',intArgs=(/bl_mynn_scaleaware/)) -! call mpas_log_write('--- config_mynn_dheat_opt = $i',intArgs=(/bl_mynn_dheat_opt/)) -! call mpas_log_write('--- config_mynn_edmf = $i',intArgs=(/bl_mynn_edmf/)) -! call mpas_log_write('--- config_mynn_edmf_dd = $i',intArgs=(/bl_mynn_edmf_dd/)) -! call mpas_log_write('--- config_mynn_edmf_mom = $i',intArgs=(/bl_mynn_edmf_mom/)) -! call mpas_log_write('--- config_mynn_edmf_tke = $i',intArgs=(/bl_mynn_edmf_tke/)) -! call mpas_log_write('--- config_mynn_edmf_output = $i',intArgs=(/bl_mynn_edmf_output/)) -! call mpas_log_write('--- config_mynn_mixscalars = $i',intArgs=(/bl_mynn_mixscalars/)) -! call mpas_log_write('--- config_mynn_mixclouds = $i',intArgs=(/bl_mynn_cloudmix/)) -! call mpas_log_write('--- config_mynn_mixqt = $i',intArgs=(/bl_mynn_mixqt/)) -! call mpas_log_write('--- config_mynn_tkeadvect = $l',logicArgs=(/bl_mynn_tkeadvect/)) -! call mpas_log_write('--- config_mynn_tkebudget = $i',intArgs=(/bl_mynn_tkebudget/)) -! call mpas_log_write('--- config_mynn_closure = $r',realArgs=(/bl_mynn_closure/)) -! call mpas_log_write(' ') -! call mpas_log_write('--- f_qc = $l',logicArgs=(/f_qc/) ) -! call mpas_log_write('--- f_qi = $l',logicArgs=(/f_qi/) ) -! call mpas_log_write('--- f_qs = $l',logicArgs=(/f_qs/) ) -! call mpas_log_write('--- f_qoz = $l',logicArgs=(/f_qoz/) ) -! call mpas_log_write('--- f_nc = $l',logicArgs=(/f_nc/) ) -! call mpas_log_write('--- f_ni = $l',logicArgs=(/f_ni/) ) -! call mpas_log_write('--- f_nifa = $l',logicArgs=(/f_nifa/)) -! call mpas_log_write('--- f_nwfa = $l',logicArgs=(/f_nwfa/)) -! call mpas_log_write('--- f_nbca = $l',logicArgs=(/f_nbca/)) - - call mpas_timer_start('bl_mynn') - call mynn_bl_driver( & - f_qc = f_qc , f_qi = f_qi , f_qs = f_qs , & - f_qoz = f_qoz , f_nc = f_nc , f_ni = f_ni , & - f_nifa = f_nifa , f_nwfa = f_nwfa , f_nbca = f_nbca , & - icloud_bl = icloud_bl , delt = dt_pbl , dx = dx_p , & - xland = xland_p , ps = psfc_p , ts = tsk_p , & - qsfc = qsfc_p , ust = ust_p , ch = ch_p , & - hfx = hfx_p , qfx = qfx_p , rmol = rmol_p , & - wspd = wspd_p , znt = znt_p , uoce = uoce_p , & - voce = voce_p , dz = dz_p , u = u_p , & - v = v_p , w = w_p , th = th_p , & - tt = t_p , p = pres_hyd_p , exner = pi_p , & - rho = rho_p , qv = qv_p , qc = qc_p , & - qi = qi_p , qs = qs_p , nc = nc_p , & - ni = ni_p , nifa = nifa_p , nwfa = nwfa_p , & - rthraten = rthraten_p , pblh = hpbl_p , kpbl = kpbl_p , & - cldfra_bl = cldfrabl_p , qc_bl = qcbl_p , qi_bl = qibl_p , & - maxwidth = maxwidthbl_p , maxmf = maxmfbl_p , ktop_plume = kbl_plume_p , & - ztop_plume = zbl_plume_p , dqke = dqke_p , qke_adv = qkeadv_p , & - tsq = tsq_p , qsq = qsq_p , cov = cov_p , & - el_pbl = elpbl_p , rublten = rublten_p , rvblten = rvblten_p , & - rthblten = rthblten_p , rqvblten = rqvblten_p , rqcblten = rqcblten_p , & - rqiblten = rqiblten_p , rqsblten = rqsblten_p , rncblten = rncblten_p , & - rniblten = rniblten_p , rnifablten = rnifablten_p , rnwfablten = rnwfablten_p , & - edmf_a = edmfa_p , edmf_w = edmfw_p , edmf_qt = edmfqt_p , & - edmf_thl = edmfthl_p , edmf_ent = edmfent_p , edmf_qc = edmfqc_p , & - sub_thl = subthl_p , sub_sqv = subqv_p , det_thl = detthl_p , & - det_sqv = detqv_p , exch_h = kzh_p , exch_m = kzm_p , & - qke = qke_p , qwt = qwt_p , qshear = qshear_p , & - qbuoy = qbuoy_p , qdiss = qdiss_p , sh3d = sh3d_p , & - sm3d = sm3d_p , spp_pbl = spp_pbl , pattern_spp = pattern_spp_pbl , & - do_restart = config_do_restart , & - do_DAcycling = config_do_DAcycling , & - initflag = initflag , & - bl_mynn_tkeadvect = bl_mynn_tkeadvect , & - bl_mynn_tkebudget = bl_mynn_tkebudget , & - bl_mynn_cloudpdf = bl_mynn_cloudpdf , & - bl_mynn_mixlength = bl_mynn_mixlength , & - bl_mynn_closure = bl_mynn_closure , & - bl_mynn_stfunc = bl_mynn_stfunc , & - bl_mynn_topdown = bl_mynn_topdown , & - bl_mynn_scaleaware = bl_mynn_scaleaware , & - bl_mynn_dheat_opt = bl_mynn_dheat_opt , & - bl_mynn_edmf = bl_mynn_edmf , & - bl_mynn_edmf_dd = bl_mynn_edmf_dd , & - bl_mynn_edmf_mom = bl_mynn_edmf_mom , & - bl_mynn_edmf_tke = bl_mynn_edmf_tke , & - bl_mynn_output = bl_mynn_edmf_output , & - bl_mynn_mixscalars = bl_mynn_mixscalars , & - bl_mynn_cloudmix = bl_mynn_cloudmix , & - bl_mynn_mixqt = bl_mynn_mixqt , & - ids = ids , ide = ide , jds = jds , jde = jde , kds = kds , kde = kde , & - ims = ims , ime = ime , jms = jms , jme = jme , kms = kms , kme = kme , & - its = its , ite = ite , jts = jts , jte = jte , kts = kts , kte = kte , & - errmsg = errmsg , errflg = errflg & - ) - call mpas_timer_stop('bl_mynn') -! call mpas_log_write('--- exit subroutine mynn_bl_driver:') -! call mpas_log_write(' ') - - case default - - end select pbl_select - -!copy local arrays to MPAS grid: - call pbl_to_MPAS(configs,diag_physics,tend_physics,its,ite) - -!call mpas_log_write('--- end subroutine driver_pbl.') - - end subroutine driver_pbl - -!================================================================================================================= - end module mpas_atmphys_driver_pbl -!================================================================================================================= From ec0ee61fbfaf0a91c35f1ba5afa9ab057c9a9748 Mon Sep 17 00:00:00 2001 From: Songyou Hong Date: Tue, 23 Dec 2025 12:51:10 -0700 Subject: [PATCH 12/19] Delete src/core_atmosphere/Registry.xml-org --- src/core_atmosphere/Registry.xml-org | 3920 -------------------------- 1 file changed, 3920 deletions(-) delete mode 100644 src/core_atmosphere/Registry.xml-org diff --git a/src/core_atmosphere/Registry.xml-org b/src/core_atmosphere/Registry.xml-org deleted file mode 100644 index 4281c40bba..0000000000 --- a/src/core_atmosphere/Registry.xml-org +++ /dev/null @@ -1,3920 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - - -#ifdef DO_PHYSICS - - - - - - - - - -#endif - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -#ifdef MPAS_CAM_DYCORE - - -#endif -#ifdef DO_PHYSICS - - - - - - - - - - - - - - - - - - - - - - - - - - -#endif - - - - - - - - - - - - - - - - - - - - - - -#ifdef DO_PHYSICS - - - - - - - - - - - - - - - - - - - - - -#endif - - - - - - - - - -#ifdef MPAS_CAM_DYCORE - - -#endif - - - - - - - - - - - - - - - - - - - - - - - - - - - -#ifdef DO_PHYSICS - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -#endif - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -#ifdef DO_PHYSICS - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -#endif - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -#ifdef DO_PHYSICS - - - - - - - - - - - - -#endif - - - - - - - - - - - - - - - - - - - - - -#ifdef DO_PHYSICS - - - - - - - -#endif - - - - -#ifdef DO_PHYSICS - - -#endif - - - - - - - - - - - - - - - - - - -#ifdef DO_PHYSICS - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -#endif - - - - - - - - - - - - - - - - - - -#ifdef DO_PHYSICS - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -#endif - - -#ifdef DO_PHYSICS - - - - - - - - - - - - - - - - - - - - - - - - - - -#endif - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -#ifdef MPAS_CAM_DYCORE - - - -#endif - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -#ifndef MPAS_CAM_DYCORE - - - - - - - - - - - - - - - - - - - - - - - -#endif - -#ifdef DO_PHYSICS - - - - - - - - - - - - - - - - - - - - - - - - - - -#endif - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -#ifndef MPAS_CAM_DYCORE - - - - - - - - - - - - - - - - - - - - - - - - -#endif - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -#ifdef DO_PHYSICS - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -#endif - - - - - - - - - - - - - - - - -#ifdef DO_PHYSICS - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -#endif - - - -#ifdef DO_PHYSICS - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -#endif - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -#include "diagnostics/Registry_diagnostics.xml" - -#ifdef DO_PHYSICS -#include "physics/Registry_noahmp.xml" -#endif - From 6ad8b1d6e07741f1fe2380766c2d5ce68b23159e Mon Sep 17 00:00:00 2001 From: Songyou Hong Date: Tue, 23 Dec 2025 12:51:53 -0700 Subject: [PATCH 13/19] Delete src/core_atmosphere/physics/mpas_atmphys_packages.F-org --- .../physics/mpas_atmphys_packages.F-org | 205 ------------------ 1 file changed, 205 deletions(-) delete mode 100644 src/core_atmosphere/physics/mpas_atmphys_packages.F-org diff --git a/src/core_atmosphere/physics/mpas_atmphys_packages.F-org b/src/core_atmosphere/physics/mpas_atmphys_packages.F-org deleted file mode 100644 index 5d32cb297e..0000000000 --- a/src/core_atmosphere/physics/mpas_atmphys_packages.F-org +++ /dev/null @@ -1,205 +0,0 @@ -! Copyright (c) 2013, Los Alamos National Security, LLC (LANS) -! and the University Corporation for Atmospheric Research (UCAR). -! -! Unless noted otherwise source code is licensed under the BSD license. -! Additional copyright and license information can be found in the LICENSE file -! distributed with this code, or at http://mpas-dev.github.com/license.html -! -!================================================================================================================= - module mpas_atmphys_packages - use mpas_kind_types - use mpas_derived_types,only : mpas_pool_type,mpas_io_context_type,MPAS_LOG_ERR - use mpas_pool_routines,only : mpas_pool_get_config,mpas_pool_get_package - use mpas_log,only : mpas_log_write - - implicit none - private - public:: atmphys_setup_packages - -!mpas_atmphys_packages contains the definitions of all physics packages. -!Laura D. Fowler (laura@ucar.edu) / 2016-03-10. - - - contains - - -!================================================================================================================= - function atmphys_setup_packages(configs,packages,iocontext) result(ierr) -!================================================================================================================= - -!inout arguments: - type (mpas_pool_type), intent(inout) :: configs - type (mpas_pool_type), intent(inout) :: packages - type (mpas_io_context_type), intent(inout) :: iocontext - -!local variables: - character(len=StrKIND),pointer:: config_microp_scheme - character(len=StrKIND),pointer:: config_convection_scheme - character(len=StrKIND),pointer:: config_pbl_scheme - 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:: sf_noahmp_in - - integer :: ierr - -!----------------------------------------------------------------------------------------------------------------- -!call mpas_log_write('') -!call mpas_log_write('--- enter subroutine atmphys_setup_packages:') - - ierr = 0 - - call mpas_log_write('----- Setting up package variables -----') - call mpas_log_write('') - -!--- initialization of all packages for parameterizations of cloud microphysics: - - call mpas_pool_get_config(configs,'config_microp_scheme',config_microp_scheme) - - nullify(mp_kessler_in) - call mpas_pool_get_package(packages,'mp_kessler_inActive',mp_kessler_in) - - nullify(mp_thompson_in) - call mpas_pool_get_package(packages,'mp_thompson_inActive',mp_thompson_in) - - nullify(mp_thompson_aers_in) - call mpas_pool_get_package(packages,'mp_thompson_aers_inActive',mp_thompson_aers_in) - - nullify(mp_wsm6_in) - call mpas_pool_get_package(packages,'mp_wsm6_inActive',mp_wsm6_in) - - if(.not.associated(mp_kessler_in ) .or. & - .not.associated(mp_thompson_in ) .or. & - .not.associated(mp_thompson_aers_in) .or. & - .not.associated(mp_wsm6_in)) then - call mpas_log_write('====================================================================================',messageType=MPAS_LOG_ERR) - call mpas_log_write('* Error while setting up packages for cloud microphysics options in atmosphere core.',messageType=MPAS_LOG_ERR) - call mpas_log_write('====================================================================================',messageType=MPAS_LOG_ERR) - ierr = 1 - return - endif - - mp_kessler_in = .false. - mp_thompson_in = .false. - mp_thompson_aers_in = .false. - mp_wsm6_in = .false. - - if(config_microp_scheme == 'mp_kessler') then - mp_kessler_in = .true. - elseif(config_microp_scheme == 'mp_thompson') then - mp_thompson_in = .true. - elseif(config_microp_scheme == 'mp_thompson_aerosols') then - mp_thompson_aers_in = .true. - elseif(config_microp_scheme == 'mp_wsm6') then - mp_wsm6_in = .true. - endif - - call mpas_log_write(' mp_kessler_in = $l', logicArgs=(/mp_kessler_in/)) - call mpas_log_write(' mp_thompson_in = $l', logicArgs=(/mp_thompson_in/)) - call mpas_log_write(' mp_thompson_aers_in = $l', logicArgs=(/mp_thompson_aers_in/)) - call mpas_log_write(' mp_wsm6_in = $l', logicArgs=(/mp_wsm6_in/)) - -!--- initialization of all packages for parameterizations of convection: - - call mpas_pool_get_config(configs,'config_convection_scheme',config_convection_scheme) - - nullify(cu_grell_freitas_in) - call mpas_pool_get_package(packages,'cu_grell_freitas_inActive',cu_grell_freitas_in) - - nullify(cu_kain_fritsch_in) - call mpas_pool_get_package(packages,'cu_kain_fritsch_inActive',cu_kain_fritsch_in) - - nullify(cu_ntiedtke_in) - call mpas_pool_get_package(packages,'cu_ntiedtke_inActive',cu_ntiedtke_in) - - if(.not.associated(cu_grell_freitas_in) .or. & - .not.associated(cu_kain_fritsch_in) .or. & - .not.associated(cu_ntiedtke_in) ) then - call mpas_log_write('====================================================================================',messageType=MPAS_LOG_ERR) - call mpas_log_write('* Error while setting up packages for convection options in atmosphere core.', messageType=MPAS_LOG_ERR) - call mpas_log_write('====================================================================================',messageType=MPAS_LOG_ERR) - ierr = 1 - return - endif - - cu_grell_freitas_in = .false. - cu_kain_fritsch_in = .false. - cu_ntiedtke_in = .false. - - if(config_convection_scheme=='cu_grell_freitas') then - cu_grell_freitas_in = .true. - elseif(config_convection_scheme == 'cu_kain_fritsch') then - cu_kain_fritsch_in = .true. - elseif(config_convection_scheme == 'cu_tiedtke' .or. & - config_convection_scheme == 'cu_ntiedtke') then - cu_ntiedtke_in = .true. - endif - - call mpas_log_write(' cu_grell_freitas_in = $l', logicArgs=(/cu_grell_freitas_in/)) - call mpas_log_write(' cu_kain_fritsch_in = $l', logicArgs=(/cu_kain_fritsch_in/)) - call mpas_log_write(' cu_ntiedtke_in = $l', logicArgs=(/cu_ntiedtke_in/)) - -!--- initialization of all packages for parameterizations of surface layer and planetary boundary layer: - - call mpas_pool_get_config(configs,'config_pbl_scheme',config_pbl_scheme) - - nullify(bl_mynn_in) - call mpas_pool_get_package(packages,'bl_mynn_inActive',bl_mynn_in) - - nullify(bl_ysu_in) - call mpas_pool_get_package(packages,'bl_ysu_inActive',bl_ysu_in) - - if(.not.associated(bl_mynn_in) .or. & - .not.associated(bl_ysu_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) - ierr = 1 - return - endif - - bl_mynn_in = .false. - bl_ysu_in = .false. - - if(config_pbl_scheme=='bl_mynn') then - bl_mynn_in = .true. - elseif(config_pbl_scheme == 'bl_ysu') then - bl_ysu_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('') - -!--- initialization of all packages for parameterizations of land surface processes: - - call mpas_pool_get_config(configs,'config_lsm_scheme',config_lsm_scheme) - - nullify(sf_noahmp_in) - call mpas_pool_get_package(packages,'sf_noahmp_inActive',sf_noahmp_in) - - if(.not.associated(sf_noahmp_in)) then - call mpas_log_write('====================================================================================',messageType=MPAS_LOG_ERR) - call mpas_log_write('* Error while setting up packages for land surface options in atmosphere core.' , messageType=MPAS_LOG_ERR) - call mpas_log_write('====================================================================================',messageType=MPAS_LOG_ERR) - ierr = 1 - return - endif - - if(config_lsm_scheme=='sf_noahmp') then - sf_noahmp_in = .true. - endif - - call mpas_log_write(' sf_noahmp_in = $l', logicArgs=(/sf_noahmp_in/)) - call mpas_log_write('') - - - end function atmphys_setup_packages - -!================================================================================================================= - end module mpas_atmphys_packages -!================================================================================================================= - - - From 1418628219acd2c7efe2d20b93cf1d9bcfd25deb Mon Sep 17 00:00:00 2001 From: Songyou Hong Date: Tue, 23 Dec 2025 12:52:20 -0700 Subject: [PATCH 14/19] Delete src/core_atmosphere/physics/mpas_atmphys_vars.F-org --- .../physics/mpas_atmphys_vars.F-org | 957 ------------------ 1 file changed, 957 deletions(-) delete mode 100644 src/core_atmosphere/physics/mpas_atmphys_vars.F-org diff --git a/src/core_atmosphere/physics/mpas_atmphys_vars.F-org b/src/core_atmosphere/physics/mpas_atmphys_vars.F-org deleted file mode 100644 index 134009f537..0000000000 --- a/src/core_atmosphere/physics/mpas_atmphys_vars.F-org +++ /dev/null @@ -1,957 +0,0 @@ -! Copyright (c) 2013, Los Alamos National Security, LLC (LANS) -! and the University Corporation for Atmospheric Research (UCAR). -! -! Unless noted otherwise source code is licensed under the BSD license. -! Additional copyright and license information can be found in the LICENSE file -! distributed with this code, or at http://mpas-dev.github.com/license.html -! -!================================================================================================================= - module mpas_atmphys_vars - use mpas_kind_types - - use NoahmpIOVarType - - implicit none - public - save - - -!mpas_atmphys_vars contains all local variables and arrays used in the physics parameterizations. -!Laura D. Fowler (send comments to laura@ucar.edu). -!2013-05-01. -! -! add-ons and modifications: -! -------------------------- -! * added the variables sf_surface_physics,alswvisdir_p,alswvisdif_p,alswnirdir_p,alswnirdif_p,swvisdir_p, -! swvisdif_p,swnirdir_p,and swnirdif_p to upgrade the RRTMG short wave radiation code to WRF version 3.4.1. -! see definition of each individual variables below. -! Laura D. Fowler (laura@ucar.edu) / 2013-03-11. -! * removed call to the updated Kain-Fritsch convection scheme. -! Laura D. Fowler (laura@ucar.edu) / 2013-05-29. -! * added the arrays o3clim_p for implementation of monthly-varying climatological ozone in the -! long wave and short wave RRTMG radiation codes. -! Laura D. Fowler (laura@ucar.edu) / 2013-07-08. -! * corrected definition of local variable dx_p. -! Laura D. Fowler (laura@ucar.edu) / 2013-08-23. -! * renamed local variable conv_deep_scheme to convection_scheme. -! Laura D. Fowler (laura@ucar.edu) / 2014-09-18. -! * added empty subroutine atmphys_vars_init that does not do anything, but needed for -! compiling MPAS with some compilers. -! Laura D. Fowler (laura@ucar.edu) / 2015-01-12. -! * added local variables needed for the Thompson parameterization of cloud microphysics. -! Laura D. Fowler (laura@ucar.edu) / 2016-03-28. -! * added local variables needed for the Grell-Freitas parameterization of deep and shallow convection. -! * Laura D. Fowler (laura@ucar.edu) / 2016-03-30. -! * added local arrays needed in the MYNN surface layer scheme and PBL scheme. -! Laura D. Fowler (laura@ucar.edu) / 2016-03-31. -! * added the logical ua_phys needed in the call to subroutine sfcdiags. ua_phys is set to false. -! Laura D. Fowler (laura@ucar.edu) / 2016-05-13. -! * added the integers has_reqc,has_reqi,and has_reqs. when initialized to zero, the effective radii for cloud -! water,cloud ice,and snow are calculated using the subroutines relcalc and ricalc in subroutines rrtmg_lwrad -! and rrtmg_swrad. when initialized to 1, the effective radii are calculated in the Thompson cloud microphysics -! scheme instead. has_reqc,has_reqi,and has_reqs are initialized depending on the logical config_microp_re. -! Laura D. Fowler (laura@ucar.edu) / 2016-07-08. -! * added diagnostics of the effective radii for cloud water, cloud ice, and snow used in rrtmg_lwrad. -! Laura D. Fowler (laura@ucar.edu) / 2016-07-08. -! * added the variables qvrad_p,qcrad_p,qirad_p, and qsrad_p which are the water vapor,cloud water,cloud ice, -! and snow mixing ratios local to the calculation of the cloud fraction, and used in the radiation codes. -! Laura D. Fowler (laura@ucar.edu) / 2016-07-08. -! * added the variables rqvften and rthften which are the forcing tendencies needed to run the "new" Tiedtke -! parameterization of convection. -! Laura D. Fowler (laura@ucar.edu) / 2016-09-20. -! * added local "_sea" arrays that are needed in the surface layer scheme and land surface scheme for handling -! grid cells with fractional seaice when config_frac_seaice is set to true. also added local tsk_ice variable -! needed in the land surface scheme for handling grid cells with fractional seaice when config_frac_seaice is -! set to true. -! Laura D. Fowler (laura@ucar.edu) / 2016-10-03. -! * added local variable regime_hold to save the original value of variable regime over seaice grid cells when -! config_frac_seaice is set to true. -! Laura D. Fowler (laura@ucar.edu) / 2016-10-21. -! * moved the declarations of arrays delta_p,wstar_p,uoce_p,and voce_p since they are now used in both modules -! module_bl_ysu.F and module_bl_mynn.F. -! Laura D. Fowler (laura@ucar.edu) / 2016-10-27. -! * added the variable opt_thcnd (option to treat thermal conductivity in NoahLSM). added additional options and -! arrays to run the Noah LSM scheme from WRF version 3.9.0. -! Laura D. Fowler (laura@ucar.edu) / 2017-01-27. -! * removed the initialization local variable gwdo_scheme. gwdo_scheme is no longer needed and can be replaced -! with config_gwdo_scheme. -! Laura D. Fowler (laura@ucar.edu) / 2017-02-16. -! * removed the initialization local variable lsm_scheme. lsm_scheme is no longer needed and can be replaced -! with config_lsm_scheme. -! Laura D. Fowler (laura@ucar.edu) / 2017-02-16. -! * removed the initialization local variable sfclayer_scheme. sfclayer_scheme is no longer needed and can be -! replaced with config_sfclayer_scheme. -! Laura D. Fowler (laura@ucar.edu) / 2017-02-16. -! * removed the initialization local variable pbl_scheme. pbl_scheme is no longer needed and can be replaced -! replaced with config_pbl_scheme. -! Laura D. Fowler (laura@ucar.edu) / 2017-02-16. -! * removed the initialization local variable radt_cld_scheme. radt_cld_scheme is no longer needed and can be -! replaced replaced with config_radt_cld_scheme. -! Laura D. Fowler (laura@ucar.edu) / 2017-02-16. -! * removed the initialization local variable radt_lw_scheme. radt_lw_scheme is no longer needed and can be -! replaced replaced with config_radt_lw_scheme. -! Laura D. Fowler (laura@ucar.edu) / 2017-02-16. -! * removed the initialization local variable radt_sw_scheme. radt_sw_scheme is no longer needed and can be -! replaced replaced with config_radt_sw_scheme. -! Laura D. Fowler (laura@ucar.edu) / 2017-02-16. -! * removed the initialization local variable convection_scheme. convection_scheme is no longer needed and can be -! replaced replaced with config_convection_scheme. -! Laura D. Fowler (laura@ucar.edu) / 2017-02-16. -! * removed the initialization local variable microp_scheme. microp_scheme is no longer needed and can be -! replaced replaced with config_microp_scheme. -! Laura D. Fowler (laura@ucar.edu) / 2017-02-16. -! * add variables and arrays needed to the parameterization of seaice in the updated Noah land surface scheme. -! Laura D. Fowler (laura@ucar.edu) / 2017-02-19. -! * changed the option seaice_albedo_opt from 0 to 2 so that we can initialize the surface albedo over seaice -! cells using the surface background albedo (see initialization of sfc_albedo_seaice in subroutine -! landuse_init_forMPAS). -! Laura D. Fowler (laura@ucar.edu) / 2017-03-02. -! * added local variables for the mass-weighted mean velocities for rain, cloud ice, snow, and graupel from the -! Thompson cloud microphysics scheme. -! Laura D. Fowler (laura@ucar.edu) / 2017-04-19. -! * added the local variables cosa_p and sina_p needed in call to subroutine gwdo after updating module_bl_gwdo.F -! to that of WRF version 4.0.2. -! Laura D. Fowler (laura@ucar.edu) / 2019-01-30. -! * reverted the option seaice_albedo_opt = 2 to seaic_albedo_opt = 0 since MPAS does not currently support the -! input of "observed" 2D seaice albedos. In conjunction with this update, we also change the initialization of -! albsi from albbck to seaice_albedo_default. -! Laura D. Fowler (laura@ucar.edu) / 2022-05-10. -! * added the local parameters flag_bep and idiff in the call to subroutine ysu to update the YSU PBL scheme to -! that of WRF version 4.4.1. -! * added local flags and variables needed to initialize and run the revised version of the MONIN-OBUKHOV surface -! layer scheme from the WRF version 4.4.1. -! Laura D. Fowler (laura@ucar.edu) / 2023-05-15. -! * added the local variables swddir,swddni,and swddif which are output to subroutine rrtmg_swrad and now input -! to the updated module_sf_noahdrv.F. -! Laura D. Fowler (laura@ucar.edu) / 2023-04-21. -! * removed the variable f_qv which is not used in any of the ./physics_wrf modules. -! Laura D. Fowler (laura@ucar.edu) / 2024-02-13. -! * removed the definition of f_qc,f_qr,f_qi,f_qs,f_qg,f_nc,and f_ni as parameters. these variables are now -! initialized in mpas_atmphys_init.F (see subroutine init_physics_flags). also renamed f_qnc to f_nc, and f_qni -! to f_ni. -! Laura D. Fowler (laura@ucar.edu) / 2024-02-14. -! * added the variable spp_pbl needed in the updated version of the MYNN surface layer scheme. -! Laura D. Fowler (laura@ucar.edu) / 2024-02-14. -! * added and modified variables needed to run the MYNN PBL scheme using the sourcecode from WRF version 4.6. -! Laura D. Fowler (laura@ucar.edu) / 2024-02-18. - - -!================================================================================================================= -!wrf-variables:these variables are needed to keep calls to different physics parameterizations -!as in wrf model. -!================================================================================================================= - - logical:: l_radtlw !controls call to longwave radiation parameterization. - logical:: l_radtsw !controls call to shortwave radiation parameterization. - logical:: l_conv !controls call to convective parameterization. - logical:: l_camlw !controls when to save local CAM LW abs and ems arrays. - logical:: l_diags !controls when to calculate physics diagnostics. - logical:: l_acrain !when .true., limit to accumulated rain is applied. - logical:: l_acradt !when .true., limit to lw and sw radiation is applied. - logical:: l_mp_tables !when .true., read look-up tables for Thompson cloud microphysics scheme. - - integer,public:: ids,ide,jds,jde,kds,kde - integer,public:: ims,ime,jms,jme,kms,kme - integer,public:: its,ite,jts,jte,kts,kte - integer,public:: iall - integer,public:: n_microp - - integer,public:: num_months !number of months [-] - - real(kind=RKIND),public:: dt_dyn !time-step for dynamics - real(kind=RKIND),public:: dt_microp !time-step for cloud microphysics parameterization. - real(kind=RKIND),public:: dt_radtlw !time-step for longwave radiation parameterization [mns] - real(kind=RKIND),public:: dt_radtsw !time-step for shortwave radiation parameterization [mns] - - real(kind=RKIND),public:: xice_threshold - - real(kind=RKIND),dimension(:,:),allocatable:: & - area_p !grid cell area [m2] - -!... arrays related to surface: - real(kind=RKIND),dimension(:,:),allocatable:: & - ht_p, &! - psfc_p, &!surface pressure [Pa] - ptop_p !model-top pressure [Pa] - - real(kind=RKIND),dimension(:,:,:),allocatable:: & - fzm_p, &!weight for interpolation to w points [-] - fzp_p !weight for interpolation to w points [-] - - real(kind=RKIND),dimension(:,:,:),allocatable:: & -!... arrays related to u- and v-velocities interpolated to theta points: - u_p, &!u-velocity interpolated to theta points [m/s] - v_p !v-velocity interpolated to theta points [m/s] - -!... arrays related to vertical sounding: - real(kind=RKIND),dimension(:,:,:),allocatable:: & - zz_p, &! - pres_p, &!pressure [Pa] - pi_p, &!(p_phy/p0)**(r_d/cp) [-] - z_p, &!height of layer [m] - zmid_p, &!height of middle of layer [m] - dz_p, &!layer thickness [m] - t_p, &!temperature [K] - th_p, &!potential temperature [K] - al_p, &!inverse of air density [m3/kg] - rho_p, &!air density [kg/m3] - rh_p !relative humidity [-] - - real(kind=RKIND),dimension(:,:,:),allocatable:: & - qv_p, &!water vapor mixing ratio [kg/kg] - qc_p, &!cloud water mixing ratio [kg/kg] - qr_p, &!rain mixing ratio [kg/kg] - qi_p, &!cloud ice mixing ratio [kg/kg] - qs_p, &!snow mixing ratio [kg/kg] - qg_p !graupel mixing ratio [kg/kg] - - real(kind=RKIND),dimension(:,:,:),allocatable:: & - nc_p, &!cloud water droplet number concentration [#/kg] - ni_p, &!cloud ice crystal number concentration [#/kg] - nr_p !rain drop number concentration [#/kg] - -!... arrays located at w (vertical velocity) points, or at interface between layers: - real(kind=RKIND),dimension(:,:,:),allocatable:: & - w_p, &!vertical velocity [m/s] - pres2_p, &!pressure [Pa] - t2_p !temperature [K] - -!... arrays used for calculating the hydrostatic pressure and exner function: - real(kind=RKIND),dimension(:,:),allocatable:: & - psfc_hyd_p, &!surface pressure [Pa] - psfc_hydd_p !"dry" surface pressure [Pa] - real(kind=RKIND),dimension(:,:,:),allocatable:: & - pres_hyd_p, &!pressure located at theta levels [Pa] - pres_hydd_p, &!"dry" pressure located at theta levels [Pa] - pres2_hyd_p, &!pressure located at w-velocity levels [Pa] - pres2_hydd_p, &!"dry" pressure located at w-velocity levels [Pa] - znu_hyd_p !(pres_hyd_p / P0) needed in the Tiedtke convection scheme [Pa] - -!================================================================================================================= -!... variables related to ozone climatlogy: -!================================================================================================================= - - real(kind=RKIND),dimension(:,:,:),allocatable:: & - o3clim_p !climatological ozone volume mixing ratio [???] - -!================================================================================================================= -!... variables and arrays related to parameterization of cloud microphysics: -! warm_phase: logical that determines if we want to run warm-phase cloud microphysics only. -! If set to false, cold-phase cloud microphysics is active. In MPAS, we always assume -! that the ice phase is included (except for the Kessler scheme which includes water -! clouds only. - -!================================================================================================================= - - logical,parameter:: & - warm_rain = .false.!warm-phase cloud microphysics only (used in WRF). - - logical:: & - f_qc, &!parameter set to true to include the cloud water mixing ratio. - f_qr, &!parameter set to true to include the rain mixing ratio. - f_qi, &!parameter set to true to include the cloud ice mixing ratio. - f_qs, &!parameter set to true to include the snow mixing ratio. - f_qg, &!parameter set to true to include the graupel mixing ratio. - f_qoz !parameter set to true to include the ozone mixing ratio. - - logical:: & - f_nc, &!parameter set to true to include the cloud water number concentration. - f_ni, &!parameter set to true to include the cloud ice number concentration. - f_nifa, &!parameter set to true to include the number concentration of hygroscopic aerosols. - f_nwfa, &!parameter set to true to include the number concentration of hydrophobic aerosols. - f_nbca !parameter set to true to include the number concentration of black carbon. - - real(kind=RKIND),dimension(:,:,:),allocatable:: & - f_ice, &!fraction of cloud ice (used in WRF only). - f_rain !fraction of rain (used in WRF only). - - real(kind=RKIND),dimension(:,:),allocatable:: & - rainnc_p, &! - rainncv_p, &! - snownc_p, &! - snowncv_p, &! - graupelnc_p, &! - graupelncv_p, &! - sr_p - - integer:: & - has_reqc, &! - has_reqi, &! - has_reqs - - real(kind=RKIND),dimension(:,:,:),allocatable:: & - rainprod_p, &! - evapprod_p, &! - recloud_p, &! - reice_p, &! - resnow_p ! - -!... for Thompson cloud microphysics parameterization, including aerosol-aware option: - real(kind=RKIND),dimension(:,:),allocatable:: & - ntc_p, &! - muc_p, &! - nifa2d_p, &!surface emission of "ice-friendly" aerosols [#/kg-1/s] - nwfa2d_p !surface emission of "water-friendly" aerosols [#/kg-1/s] - - real(kind=RKIND),dimension(:,:,:),allocatable:: & - nifa_p, &!"ice-friendly" number concentration [#/kg] - nwfa_p !"water-friendly" number concentration [#/kg] - -!================================================================================================================= -!... variables and arrays related to parameterization of convection: -!================================================================================================================= - integer,public:: n_cu - real(kind=RKIND),public:: dt_cu - - logical,dimension(:,:),allocatable:: & - cu_act_flag - real(kind=RKIND),dimension(:,:),allocatable:: & - rainc_p, &! - raincv_p, &! - pratec_p ! - - real(kind=RKIND),dimension(:,:,:),allocatable:: & - rthcuten_p, &! - rqvcuten_p, &! - rqccuten_p, &! - rqicuten_p ! - -!... kain fritsch specific arrays: - real(kind=RKIND),dimension(:,:),allocatable:: & - cubot_p, &!lowest convective level [-] - cutop_p, &!highest convective level [-] - nca_p !counter for cloud relaxation time [-] - real(kind=RKIND),dimension(:,:,:),allocatable:: & - w0avg_p ! - - real(kind=RKIND),dimension(:,:,:),allocatable:: & - rqrcuten_p, &! - rqscuten_p ! - -!... tiedtke specific arrays: - real(kind=RKIND),dimension(:,:,:),allocatable:: & - znu_p ! - - real(kind=RKIND),dimension(:,:,:),allocatable:: & - rucuten_p, &! - rvcuten_p ! - -!... grell-freitas specific parameters and arrays: - integer, parameter:: ishallow = 1 !shallow convection used with grell scheme. - - integer,dimension(:,:),allocatable:: & - k22_shallow_p, &! - kbcon_shallow_p, &! - ktop_shallow_p, &! - kbot_shallow_p, &! - ktop_deep_p ! - - real(kind=RKIND),dimension(:,:),allocatable:: & - xmb_total_p, &! - xmb_shallow_p ! - - real(kind=RKIND),dimension(:,:,:),allocatable:: & - rthdynten_p, &! - qccu_p, &! - qicu_p ! - - real(kind=RKIND),dimension(:,:,:),allocatable:: & - rthraten_p ! - -!... grell and tiedkte specific arrays: - real(kind=RKIND),dimension(:,:,:),allocatable:: & - rqvdynten_p, &! - rqvdynblten_p, &! - rthdynblten_p ! - -!... ntiedtke specific arrays: - real(kind=RKIND),dimension(:,:,:),allocatable:: & - rqvften_p, &! - rthften_p ! - -!================================================================================================================= -!... variables and arrays related to parameterization of pbl: -!================================================================================================================= - - logical,parameter:: & - flag_bep = .false. !flag to use BEP/BEP+BEM for use in the YSU PBL scheme (with urban physics). since we do - !not run urban physics, flag_bep is always set to false. - - integer,parameter:: & - idiff = 0 !BEP/BEM+BEM diffusion flag for use in the YSU PBL scheme (with urban physics). since we - !do not run urban physics, idiff is set to zero. - - integer:: ysu_pblmix - - integer,dimension(:,:),allocatable:: & - kpbl_p !index of PBL top [-] - - real(kind=RKIND),public:: dt_pbl - - real(kind=RKIND),dimension(:,:),allocatable:: & - ctopo_p, &!correction to topography [-] - ctopo2_p, &!correction to topography 2 [-] - hpbl_p, &!PBL height [m] - delta_p, &! - wstar_p, &! - uoce_p, &! - voce_p ! - - real(kind=RKIND),dimension(:,:,:),allocatable:: & - exch_p !exchange coefficient [-] - - real(kind=RKIND),dimension(:,:,:),allocatable:: & - rublten_p, &!tendency of zonal wind due to PBL processes. - rvblten_p, &!tendency of meridional wind due to PBL processes. - rthblten_p, &!tendency of potential temperature due to PBL processes. - rqvblten_p, &!tendency of water vapor mixing ratio due to PBL processes. - rqcblten_p, &!tendency of cloud water mixing ratio due to PBL processes. - rqiblten_p !tendency of cloud ice mixing ratio due to PBL processes. - - real(kind=RKIND),dimension(:,:,:),allocatable:: & - kzh_p, &! - kzm_p, &! - kzq_p ! - -!... MYNN PBL scheme (module_bl_mynn.F): - integer,parameter:: spp_pbl = 0 !generate array with random perturbations (0=off,1=on). - integer,parameter:: icloud_bl = 0 !no coupling of subgrid-scale clouds with radiation. - - integer,dimension(:,:),allocatable:: & - kbl_plume_p !level of highest penetrating plume. - - real(kind=RKIND),dimension(:,:),allocatable:: & - maxwidthbl_p, &!max plume width [m] - maxmfbl_p, &!maximum mass flux for PBL shallow convection. - zbl_plume_p !height of highest penetrating plume [m] - - real(kind=RKIND),dimension(:,:,:),allocatable:: & - dqke_p, &! - qbuoy_p, &! - qdiss_p, &! - qke_p, &! - qkeadv_p, &! - qshear_p, &! - qwt_p, &! - tkepbl_p ! - - real(kind=RKIND),dimension(:,:,:),allocatable:: & - edmfa_p, &! - edmfw_p, &! - edmfqt_p, &! - edmfthl_p, &! - edmfent_p, &! - edmfqc_p, &! - subthl_p, &! - subqv_p, &! - detthl_p, &! - detqv_p, &! - qcbl_p, &! - qibl_p, &! - cldfrabl_p ! - - real(kind=RKIND),dimension(:,:,:),allocatable:: & - rqsblten_p, &!tendency of snow mixing ratio due to PBL processes. - rncblten_p, &!tendency of cloud liquid water number concentration due to PBL processes. - rniblten_p, &!tendency of cloud ice number concentration due to PBL processes. - rnifablten_p, &!tendency of ice-friendly aerosol number concentration due to PBL processes. - rnwfablten_p !tendency of water-friendly aerosol number concentration due to PBL processes. - - real(kind=RKIND),dimension(:,:,:),allocatable:: & - pattern_spp_pbl !stochastic forcing for the MYMM PBL and surface layer schemes. - -!================================================================================================================= -!... variables and arrays related to parameterization of gravity wave drag over orography: -!================================================================================================================= - - real(kind=RKIND),dimension(:,:),allocatable:: & - cosa_p, &!cosine of map rotation [-] - sina_p !sine of map rotation [-] - - real(kind=RKIND),dimension(:,:),allocatable:: & - var2d_p, &!orographic variance [m2] - con_p, &!orographic convexity [m2] - oa1_p, &!orographic direction asymmetry function [-] - oa2_p, &!orographic direction asymmetry function [-] - oa3_p, &!orographic direction asymmetry function [-] - oa4_p, &!orographic direction asymmetry function [-] - ol1_p, &!orographic direction asymmetry function [-] - ol2_p, &!orographic direction asymmetry function [-] - ol3_p, &!orographic direction asymmetry function [-] - ol4_p !orographic direction asymmetry function [-] - - real(kind=RKIND),dimension(:,:),allocatable:: & - dx_p !mean distance between cell centers [m] - - real(kind=RKIND),dimension(:,:),allocatable:: & - dusfcg_p, &!vertically-integrated gwdo u-stress [Pa m s-1] - dvsfcg_p !vertically-integrated gwdo v -stress [Pa m s-1] - - real(kind=RKIND),dimension(:,:,:),allocatable:: & - dtaux3d_p, &!gravity wave drag over orography u-stress [m s-1] - dtauy3d_p !gravity wave drag over orography u-stress [m s-1] - -!... variables for UGWP orographic gravity wave drag: - - real(kind=RKIND),dimension(:,:),allocatable:: & - var2dls_p, &!orographic variance (meso-scale orographic variation) [m] - conls_p, &!orographic convexity (meso-scale orographic variation) [-] - oa1ls_p, &!orographic direction asymmetry function (meso-scale orographic variation) [-] - oa2ls_p, &!orographic direction asymmetry function (meso-scale orographic variation) [-] - oa3ls_p, &!orographic direction asymmetry function (meso-scale orographic variation) [-] - oa4ls_p, &!orographic direction asymmetry function (meso-scale orographic variation) [-] - ol1ls_p, &!orographic direction asymmetry function (meso-scale orographic variation) [-] - ol2ls_p, &!orographic direction asymmetry function (meso-scale orographic variation) [-] - ol3ls_p, &!orographic direction asymmetry function (meso-scale orographic variation) [-] - ol4ls_p, &!orographic direction asymmetry function (meso-scale orographic variation) [-] - var2dss_p, &!orographic variance (small-scale orographic variation) [m] - conss_p, &!orographic convexity (small-scale orographic variation) [-] - oa1ss_p, &!orographic direction asymmetry function (small-scale orographic variation) [-] - oa2ss_p, &!orographic direction asymmetry function (small-scale orographic variation) [-] - oa3ss_p, &!orographic direction asymmetry function (small-scale orographic variation) [-] - oa4ss_p, &!orographic direction asymmetry function (small-scale orographic variation) [-] - ol1ss_p, &!orographic direction asymmetry function (small-scale orographic variation) [-] - ol2ss_p, &!orographic direction asymmetry function (small-scale orographic variation) [-] - ol3ss_p, &!orographic direction asymmetry function (small-scale orographic variation) [-] - ol4ss_p !orographic direction asymmetry function (small-scale orographic variation) [-] - - real(kind=RKIND),dimension(:,:),allocatable:: & - dusfc_ls_p, &!vertically-integrated mesoscale orog gravity wave drag u-stress [Pa] - dvsfc_ls_p, &!vertically-integrated mesoscale orog gravity wave drag v-stress [Pa] - dusfc_bl_p, &!vertically-integrated orog blocking drag u-stress [Pa] - dvsfc_bl_p, &!vertically-integrated orog blocking drag v-stress [Pa] - dusfc_ss_p, &!vertically-integrated small-scale orog gravity wave drag u-stres [Pa] - dvsfc_ss_p, &!vertically-integrated small-scale orog gravity wave drag v-stres [Pa] - dusfc_fd_p, &!vertically-integrated turb orog form drag u-stress [Pa] - dvsfc_fd_p !vertically-integrated turb orog form drag v-stress [Pa] - - real(kind=RKIND),dimension(:,:,:),allocatable:: & - dtaux3d_ls_p, &!mesoscale orog gravity wave drag u-tendency [m s-2] - dtauy3d_ls_p, &!mesoscale orog gravity wave drag v-tendency [m s-2] - dtaux3d_bl_p, &!orog blocking drag u-tendency u-tendency [m s-2] - dtauy3d_bl_p, &!orog blocking drag u-tendency v-tendency [m s-2] - dtaux3d_ss_p, &!small-scale orog gravity wave drag u-tendency [m s-2] - dtauy3d_ss_p, &!small-scale orog gravity wave drag v-tendency [m s-2] - dtaux3d_fd_p, &!turb orog form drag u-tendency [m s-2] - dtauy3d_fd_p !turb orog form drag u-tendency [m s-2] - -!... variables for UGWP non-stationary gravity wave (NGW) drag: - - integer,dimension(:,:),allocatable:: & - jindx1_tau_p, &!lower latitude index of NGW momentum flux for interpolation [-] - jindx2_tau_p !upper latitude index of NGW momentum flux for interpolation [-] - - real(kind=RKIND),dimension(:,:),allocatable:: & - ddy_j1tau_p, &!latitude interpolation weight complement for NGW momentum flux [-] - ddy_j2tau_p !latitude interpolation weight for NGW momentum flux [-] - - real(kind=RKIND),dimension(:,:,:),allocatable:: & - dudt_ngw_p, &!u-momentum tendency due to non-stationary gravity wave drag [m s-2] - dvdt_ngw_p, &!v-momentum tendency due to non-stationary gravity wave drag [m s-2] - dtdt_ngw_p !temperature tendency due to non-stationary gravity wave drag [K s-1] - -!================================================================================================================= -!... variables and arrays related to parameterization of surface layer: -!================================================================================================================= - - real(kind=RKIND),dimension(:,:),allocatable:: & - br_p, &!bulk richardson number [-] - cd_p, &!momentum exchange coeff at 10 meters [?] - cda_p, &!momentum exchange coeff at the lowest model level [?] - cpm_p, &! - chs_p, &! - chs2_p, &! - ck_p, &!enthalpy exchange coeff at 10 meters [?] - cka_p, &!enthalpy exchange coeff at the lowest model level [?] - cqs2_p, &! - gz1oz0_p, &!log of z1 over z0 [-] - flhc_p, &!exchange coefficient for heat [-] - flqc_p, &!exchange coefficient for moisture [-] - hfx_p, &!upward heat flux at the surface [W/m2] - lh_p, &!latent heat flux at the surface [W/m2] - mavail_p, &!surface moisture availability [-] - mol_p, &!T* in similarity theory [K] - pblh_p, &!PBL height [m] - psih_p, &!similarity theory for heat [-] - psim_p, &!similarity theory for momentum [-] - q2_p, &!specific humidity at 2m [kg/kg] - qfx_p, &!upward moisture flux at the surface [kg/m2/s] - qgh_p, &! - qsfc_p, &!specific humidity at lower boundary [kg/kg] - regime_p, &!flag indicating PBL regime (stable_p,unstable_p,etc...) [-] - rmol_p, &!1 / Monin Ob length [-] - t2m_p, &!temperature at 2m [K] - th2m_p, &!potential temperature at 2m [K] - u10_p, &!u at 10 m [m/s] - ust_p, &!u* in similarity theory [m/s] - ustm_p, &!u* in similarity theory without vconv correction [m/s] - v10_p, &!v at 10 m [m/s] - wspd_p, &!wind speed [m/s] - znt_p, &!time-varying roughness length [m] - zol_p ! - -!... arrays only in monin_obukohv (module_sf_sfclay.F): - real(kind=RKIND),dimension(:,:),allocatable:: & - fh_p, &!integrated stability function for heat [-] - fm_p !integrated stability function for momentum [-] - -!... variables and arrays only in the revised version of monin_obukhov (module_sf_sfclayrev.F) to include the -! shallow water roughness scheme: - integer,parameter:: & - bathymetry_flag = 0!this flag is set to 1 if input bathymetry data is available (this option is not available - !in MPAS and therefore set to 0 by default. - integer,parameter:: & - shalwater_flag = 0!this flag is set to 1 to run the shallow water roughness scheme (this option is not - !available in MPAS and therefore set to 0 by default. - integer,parameter:: & - lakemodel_flag = 0!this flag is set to 1 to run the lake model physics (this option is not available in MPAS - !and therefore set to 0 by default. - - real(kind=RKIND),parameter:: & - shalwater_depth = 0!constant shallow water depth needed to run the shallow water roughness scheme. - - real(kind=RKIND),dimension(:,:),allocatable:: & - waterdepth_p, &!depth of water needed to run the shallow water roughness scheme. - lakedepth_p, &!depth of lakes needed to run the lake model physics. - lakemask_p !mask needed to detect the location of lakes to run the lake model physics. - -!... arrays only in mynn surface layer scheme (module_sf_mynn.F): - real(kind=RKIND),dimension(:,:),allocatable:: & - ch_p, &!surface exchange coeff for heat [m/s] - qcg_p !cloud water mixing ratio at the ground surface [kg/kg] - - real(kind=RKIND),dimension(:,:,:),allocatable:: & - cov_p, &!liquid water-liquid water potential temperature covariance [K kg/kg] - qsq_p, &!liquid water variance [(kg/kg)^2] - tsq_p, &!liquid water potential temperature variance [K^2] - sh3d_p, &!stability function for heat [-] - sm3d_p, &!stability function for moisture [-] - elpbl_p !length scale from PBL [m] - -!================================================================================================================= -!... variables and arrays related to parameterization of seaice: -!... the options set for seaice_albedo_opt, seaice_thickness_opt, and seaicesnowdepth_opt must not be changed -! since they are the only ones currently available. -!================================================================================================================= - - integer,parameter:: & - seaice_albedo_opt = 0 !option to set albedo over sea ice. - !0 = seaice albedo is constant set in seaice_albedo_default. - !1 = seaice albedo is f(Tair,Tskin,Tsnow), following Mill (2011). - !2 = seaice albedo is read in from input variable albsi. - integer,parameter:: & - seaice_thickness_opt = 0 !option for treating seaice thickness. - !0 = seaice thickness is constant set in seaice_thickness_default. - !1 = seaice_thickness is read in from input variable icedepth. - integer,parameter:: & - seaice_snowdepth_opt = 0 !option for treating snow depth on sea ice. - !0=snow depth is bounded by seaice_snowdepth_min and seaice_snowdepth_max. - - real(kind=RKIND),parameter:: & - seaice_albedo_default = 0.65 ,&!default value of seaice albedo for seaice_albedo_opt=0. - seaice_thickness_default = 3.0, &!default value of seaice thickness for seaice_thickness_opt=0 - seaice_snowdepth_max = 1.e10,&!maximum allowed accumulation of snow (m) on sea ice. - seaice_snowdepth_min = 0.001 !minimum snow depth (m) on sea ice. - - real(kind=RKIND),dimension(:,:),allocatable:: & - albsi_p, &!surface albedo over seaice [-] - snowsi_p, &!snow depth over seaice [m] - icedepth_p !seaice thickness [m] - -!================================================================================================================= -!... variables and arrays related to the calculation of the optical properties of aerosols: to date, the only kind -! of aerosols included in MPAS are the "water-friendly" and "ice-friendly" aerosols used in the Thompson cloud -! cloud microphysics scheme. -!================================================================================================================= - - integer,parameter:: taer_aod550_opt = 2!input option for nwfa, nifa optical depth at 500 nm. - integer,parameter:: taer_angexp_opt = 3!input option for nwfa, nifa aerosol Angstrom exponent. - integer,parameter:: taer_ssa_opt = 3!input option for nwfa, nifa aerosol single-scattering albedo. - integer,parameter:: taer_asy_opt = 3!input option for nwfa, nifa aerosol asymmetry factor. - - integer:: aer_opt !=[0,3] : 0 for no aerosols, 3 for "water-" and "ice-friendly" aerosols. - integer,dimension(:,:),allocatable:: & - taer_type_p !=[1,2,3]: 1 for rural, 2 is urban and 3 is maritime in WRF. In MPAS, - !aer_type is initialized as a function of landmask (=1 over land; =2 over - !oceans. - - real(kind=RKIND),parameter:: aer_aod550_val = 0.12 - real(kind=RKIND),parameter:: aer_angexp_val = 1.3 - real(kind=RKIND),parameter:: aer_ssa_val = 0.85 - real(kind=RKIND),parameter:: aer_asy_val = 0.9 - - real(kind=RKIND),dimension(:,:),allocatable :: taod5502d_p!total aerosol optical depth at 550 nm [-] - real(kind=RKIND),dimension(:,:,:),allocatable:: taod5503d_p!aerosol optical depth at 550 nm [-] - - real(kind=RKIND),dimension(:,:,:,:),allocatable:: tauaer_p !aerosol optical depth in RRTMG SW [-] - real(kind=RKIND),dimension(:,:,:,:),allocatable:: ssaaer_p !aerosol single scatterin albedo in RRTMG SW [-] - real(kind=RKIND),dimension(:,:,:,:),allocatable:: asyaer_p !aerosol asymmetry factor in RRTMG SW [-] - -!================================================================================================================= -!... variables and arrays related to parameterization of short-wave radiation: -!================================================================================================================= - - real(kind=RKIND):: & - declin, &!solar declination [-] - solcon !solar constant [W m-2] - - real(kind=RKIND),dimension(:,:),allocatable:: & - coszr_p, &!cosine of the solar zenith angle [-] - gsw_p, &!net shortwave flux at surface [W m-2] - swcf_p, &!shortwave cloud forcing at top-of-atmosphere [W m-2] - swdnb_p, &!all-sky downwelling shortwave flux at bottom-of-atmosphere [J m-2] - swdnbc_p, &!clear-sky downwelling shortwave flux at bottom-of-atmosphere [J m-2] - swdnt_p, &!all-sky downwelling shortwave flux at top-of-atmosphere [J m-2] - swdntc_p, &!clear-sky downwelling shortwave flux at top-of-atmosphere [J m-2] - swupb_p, &!all-sky upwelling shortwave flux at bottom-of-atmosphere [J m-2] - swupbc_p, &!clear-sky upwelling shortwave flux at bottom-of-atmosphere [J m-2] - swupt_p, &!all-sky upwelling shortwave flux at top-of-atmosphere [J m-2] - swuptc_p !clear-sky upwelling shortwave flux at top-of-atmosphere [J m-2] - - real(kind=RKIND),dimension(:,:),allocatable:: & - swvisdir_p, &!visible direct downward flux [W m-2] - swvisdif_p, &!visible diffuse downward flux [W m-2] - swnirdir_p, &!near-IR direct downward flux [W m-2] - swnirdif_p !near-IR diffuse downward flux [W m-2] - - real(kind=RKIND),dimension(:,:),allocatable:: & - swddir_p, &! - swddni_p, &! - swddif_p ! - - real(kind=RKIND),dimension(:,:,:),allocatable:: & - swdnflx_p, &! - swdnflxc_p, &! - swupflx_p, &! - swupflxc_p ! - - real(kind=RKIND),dimension(:,:,:),allocatable:: & - rthratensw_p !uncoupled theta tendency due to shortwave radiation [K s-1] - -!================================================================================================================= -!... variables and arrays related to parameterization of long-wave radiation: -!================================================================================================================= - - integer,dimension(:,:),allocatable:: & - nlrad_p !number of layers added above the model top [-] - real(kind=RKIND),dimension(:,:),allocatable:: & - plrad_p !pressure at model_top [Pa] - - real(kind=RKIND),dimension(:,:),allocatable:: & - glw_p, &!net longwave flux at surface [W m-2] - lwcf_p, &!longwave cloud forcing at top-of-atmosphere [W m-2] - lwdnb_p, &!all-sky downwelling longwave flux at bottom-of-atmosphere [J m-2] - lwdnbc_p, &!clear-sky downwelling longwave flux at bottom-of-atmosphere [J m-2] - lwdnt_p, &!all-sky downwelling longwave flux at top-of-atmosphere [J m-2] - lwdntc_p, &!clear-sky downwelling longwave flux at top-of-atmosphere [J m-2] - lwupb_p, &!all-sky upwelling longwave flux at bottom-of-atmosphere [J m-2] - lwupbc_p, &!clear-sky upwelling longwave flux at bottom-of-atmosphere [J m-2] - lwupt_p, &!all-sky upwelling longwave flux at top-of-atmosphere [J m-2] - lwuptc_p, &!clear-sky upwelling longwave flux at top-of-atmosphere [J m-2] - olrtoa_p !outgoing longwave radiation at top-of-the-atmosphere [W m-2] - - real(kind=RKIND),dimension(:,:,:),allocatable:: & - lwdnflx_p, &! - lwdnflxc_p, &! - lwupflx_p, &! - lwupflxc_p ! - - real(kind=RKIND),dimension(:,:,:),allocatable:: & - rthratenlw_p, &!uncoupled theta tendency due to longwave radiation [K s-1] - rrecloud_p, &!effective radius for cloud water calculated in rrtmg_lwrad [mu] - rreice_p, &!effective radius for cloud ice calculated in rrmtg_lwrad [mu] - rresnow_p !effective radius for snow calculated in rrtmg_lwrad [mu] - -!================================================================================================================= -!... variables and arrays related to parameterization of long- and short-wave radiation needed -! only by the "CAM" radiation codes: -!================================================================================================================= - - logical:: doabsems - - integer:: cam_abs_dim1 - integer:: cam_abs_dim2 - integer:: num_moist - integer:: num_aerosols - integer:: num_aerlevels - integer:: num_oznlevels - - real(kind=RKIND),dimension(:),allocatable:: & - pin_p, &!pressure levels for ozone concentration [Pa] - m_hybi_p !hybrid levels for aerosols [-] - - real(kind=RKIND),dimension(:,:),allocatable:: & - m_psn_p, &! - m_psp_p ! - - real(kind=RKIND),dimension(:,:,:,:),allocatable:: & - aerosolcn_p, &! - aerosolcp_p ! - - real(kind=RKIND),dimension(:,:,:),allocatable:: & - emstot_p, &!total emissivity [-] - cemiss_p, &!cloud emissivity for ISCCP [-] - taucldc_p, &!cloud water optical depth for ISCCP [-] - taucldi_p !cloud ice optical depth for ISCCP [-] - - real(kind=RKIND),dimension(:,:,:,:),allocatable:: & - abstot_p, &!total layer absorptivity [-] - absnxt_p, &!total nearest layer absorptivity [-] - ozmixm_p !ozone mixing ratio. - -!================================================================================================================= -!.. variables and arrays related to cloudiness: -!================================================================================================================= - - integer,parameter:: & - icloud= 1 !used in WRF only. - - real(kind=RKIND),dimension(:,:,:),allocatable:: & - cldfrac_p, &!cloud fraction [-] - qvrad_p, &!water vapor mixing ratio local to cloudiness and radiation [kg/kg] - qcrad_p, &!cloud liquid water mixing ratio local to cloudiness and radiation [kg/kg] - qirad_p, &!cloud ice mixing ratio local to cloudiness and radiation [kg/kg] - qsrad_p !snow mixing ratio local to cloudiness and radiation [kg/kg] - -!================================================================================================================= -!.. variables and arrays related to land-surface parameterization: -!================================================================================================================= - - logical,parameter:: & - ua_phys = .false. !option to activate UA Noah changes: a different snow-cover physics in the land-surface - !scheme. That option is not currently implemented in MPAS. - - integer,parameter:: & - opt_thcnd = 1 !option to treat thermal conductivity in NoahLSM (new option implemented in WRF 3.8.0). - != 1, original (default). - != 2, McCumber and Pielke for silt loam and sandy loam. - - integer,parameter:: & - fasdas = 0 !for WRF surface data assimilation system (not used in MPAS). - - integer,parameter:: & - nurb = 1 !generic dimension for all dimensions needed to run the urban physics. - - integer,public:: & - sf_surface_physics !used to define the land surface scheme by a number instead of name. It - !is only needed in module_ra_rrtmg_sw.F to define the spectral surface - !albedos as functions of the land surface scheme. - - integer,public:: & - num_soils !number of soil layers [-] - - integer,dimension(:,:),allocatable:: & - isltyp_p, &!dominant soil type category [-] - ivgtyp_p !dominant vegetation category [-] - - real(kind=RKIND),dimension(:),allocatable:: & - dzs_p !thickness of soil layers [m] - real(kind=RKIND),dimension(:,:,:),allocatable:: & - smcrel_p, &!soil moisture threshold below which transpiration starts to stress [-] - sh2o_p, &!unfrozen soil moisture content [volumetric fraction] - smois_p, &!soil moisture [volumetric fraction] - tslb_p !soil temperature [K] - - real(kind=RKIND),dimension(:,:),allocatable:: & - acsnom_p, &!accumulated melted snow [kg m-2] - acsnow_p, &!accumulated snow [kg m-2] - canwat_p, &!canopy water [kg m-2] - chklowq_p, &!surface saturation flag [-] - grdflx_p, &!ground heat flux [W m-2] - lai_p, &!leaf area index [-] - noahres_p, &!residual of the noah land-surface scheme energy budget [W m-2] - potevp_p, &!potential evaporation [W m-2] - qz0_p, &!specific humidity at znt [kg kg-1] - rainbl_p, &! - sfcrunoff_p, &!surface runoff [m s-1] - shdmin_p, &!minimum areal fractional coverage of annual green vegetation [-] - shdmax_p, &!maximum areal fractional coverage of annual green vegetation [-] - smstav_p, &!moisture availability [-] - smstot_p, &!total moisture [m3 m-3] - snopcx_p, &!snow phase change heat flux [W m-2] - snotime_p, &! - snowc_p, &!snow water equivalent [kg m-2] - snowh_p, &!physical snow depth [m] - swdown_p, &!downward shortwave flux at the surface [W m-2] - udrunoff_p, &!sub-surface runoff [m s-1] - tmn_p, &!soil temperature at lower boundary [K] - vegfra_p, &!vegetation fraction [-] - z0_p !background roughness length [m] - - real(kind=RKIND),dimension(:,:),allocatable:: & - alswvisdir_p, &!direct-beam surface albedo in visible spectrum [-] - alswvisdif_p, &!diffuse-beam surface albedo in visible spectrum [-] - alswnirdir_p, &!direct-beam surface albedo in near-IR spectrum [-] - alswnirdif_p !diffuse-beam surface albedo in near-IR spectrum [-] - -!.. arrays needed to run UA Noah changes (different snow-cover physics): - real(kind=RKIND),dimension(:,:),allocatable:: & - flxsnow_p, &!energy added to sensible heat flux when ua_phys=true [W m-2] - fvbsnow_p, &!fraction of vegetation with snow beneath when ua_phys=true [-] - fbursnow_p, &!fraction of canopy buried when ua_phys=true [-] - fgsnsnow_p !fraction of ground snow cover when ua_phys=true [-] - -!.. arrays needed in the argument list in the call to the Noah LSM urban parameterization: note that these arrays -!.. are initialized to zero since we do not run an urban model: - integer,dimension(:,:),allocatable:: & - utype_urb_p !urban type [-] - - real(kind=RKIND),dimension(:,:),allocatable:: & - frc_urb_p, &!urban fraction [-] - ust_urb_p !urban u* in similarity theory [m/s] - -!================================================================================================================= -!.. variables and arrays related to the Noahmp land-surface parameterization: -!================================================================================================================= - - type(NoahmpIO_type):: mpas_noahmp - -!================================================================================================================= -!.. variables and arrays related to surface characteristics: -!================================================================================================================= - - real(kind=RKIND),dimension(:,:),allocatable:: & - xlat_p, &!longitude, west is negative [degrees] - xlon_p !latitude, south is negative [degrees] - - real(kind=RKIND),dimension(:,:),allocatable:: & - sfc_albedo_p, &!surface albedo [-] - sfc_albbck_p, &!surface background albedo [-] - sfc_emibck_p, &!land surface background emissivity [-] - sfc_emiss_p, &!land surface emissivity [-] - snoalb_p, &!annual max snow albedo [-] - snow_p, &!snow water equivalent [kg m-2] - tsk_p, &!surface-skin temperature [K] - sst_p, &!sea-surface temperature [K] - xice_p, &!ice mask [-] - xland_p !land mask (1 for land; 2 for water) [-] - -!================================================================================================================= -!.. variables needed for the surface layer scheme and land surface scheme when config_frac_seaice -! is set to true. the arrays below have the same definition as the corresponding "_p" arrays: -!================================================================================================================= - - real(kind=RKIND),dimension(:,:),allocatable:: br_sea,ch_sea,chs_sea,chs2_sea,cpm_sea,cqs2_sea, & - flhc_sea,flqc_sea,gz1oz0_sea,hfx_sea,lh_sea,mavail_sea,mol_sea, & - psih_sea,psim_sea,fh_sea,fm_sea,qfx_sea,qgh_sea,qsfc_sea,regime_sea, & - rmol_sea,ust_sea,wspd_sea,znt_sea,zol_sea,tsk_sea,xland_sea - real(kind=RKIND),dimension(:,:),allocatable:: t2m_sea,th2m_sea,q2_sea,u10_sea,v10_sea - real(kind=RKIND),dimension(:,:),allocatable:: cd_sea,cda_sea,ck_sea,cka_sea,ustm_sea - - real(kind=RKIND),dimension(:,:),allocatable:: regime_hold - real(kind=RKIND),dimension(:,:),allocatable:: tsk_ice - - - contains - - -!================================================================================================================= - subroutine atmphys_vars_init() -!================================================================================================================= -!dummy subroutine that does not do anything. - - end subroutine atmphys_vars_init - -!================================================================================================================= - end module mpas_atmphys_vars -!================================================================================================================= From a05c6ab31b077ee4988296b578dcc577ddf59b75 Mon Sep 17 00:00:00 2001 From: Songyou Hong Date: Tue, 23 Dec 2025 12:52:41 -0700 Subject: [PATCH 15/19] Delete src/core_atmosphere/physics/physics_wrf/module_sf_sfclayrev.F-org --- .../physics_wrf/module_sf_sfclayrev.F-org | 281 ------------------ 1 file changed, 281 deletions(-) delete mode 100644 src/core_atmosphere/physics/physics_wrf/module_sf_sfclayrev.F-org diff --git a/src/core_atmosphere/physics/physics_wrf/module_sf_sfclayrev.F-org b/src/core_atmosphere/physics/physics_wrf/module_sf_sfclayrev.F-org deleted file mode 100644 index ac70882989..0000000000 --- a/src/core_atmosphere/physics/physics_wrf/module_sf_sfclayrev.F-org +++ /dev/null @@ -1,281 +0,0 @@ -!================================================================================================================= - module module_sf_sfclayrev - use mpas_kind_types,only: kind_phys => RKIND - - use sf_sfclayrev,only: sf_sfclayrev_run - use sf_sfclayrev_pre,only: sf_sfclayrev_pre_run - - implicit none - private - public:: sfclayrev - - - contains - - -!================================================================================================================= - subroutine sfclayrev(u3d,v3d,t3d,qv3d,p3d,dz8w, & - cp,g,rovcp,r,xlv,psfc,chs,chs2,cqs2,cpm, & - znt,ust,pblh,mavail,zol,mol,regime,psim,psih, & - fm,fh, & - xland,hfx,qfx,lh,tsk,flhc,flqc,qgh,qsfc,rmol, & - u10,v10,th2,t2,q2, & - gz1oz0,wspd,br,isfflx,dx, & - svp1,svp2,svp3,svpt0,ep1,ep2, & - karman,p1000mb,lakemask, & - ids,ide,jds,jde,kds,kde, & - ims,ime,jms,jme,kms,kme, & - its,ite,jts,jte,kts,kte, & - ustm,ck,cka,cd,cda,isftcflx,iz0tlnd, & - shalwater_z0,water_depth, & - scm_force_flux,errmsg,errflg) -!================================================================================================================= - -!--- input arguments: - integer,intent(in):: ids,ide,jds,jde,kds,kde, & - ims,ime,jms,jme,kms,kme, & - its,ite,jts,jte,kts,kte - - integer,intent(in):: isfflx - integer,intent(in):: shalwater_z0 - integer,intent(in),optional:: isftcflx, iz0tlnd - integer,intent(in),optional:: scm_force_flux - - real(kind=kind_phys),intent(in):: svp1,svp2,svp3,svpt0 - 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),dimension(ims:ime,jms:jme):: & - dx, & - mavail, & - pblh, & - psfc, & - tsk, & - xland, & - lakemask, & - water_depth - - real(kind=kind_phys),intent(in),dimension(ims:ime,kms:kme,jms:jme):: & - dz8w, & - qv3d, & - p3d, & - t3d, & - u3d, & - v3d - -!--- output arguments: - character(len=*),intent(out):: errmsg - integer,intent(out):: errflg - - real(kind=kind_phys),intent(out),dimension(ims:ime,jms:jme):: & - lh, & - u10, & - v10, & - th2, & - t2, & - q2 - - real(kind=kind_phys),intent(out),dimension(ims:ime,jms:jme),optional:: & - ck, & - cka, & - cd, & - cda - -!--- inout arguments: - real(kind=kind_phys),intent(inout),dimension(ims:ime,jms:jme):: & - regime, & - hfx, & - qfx, & - qsfc, & - mol, & - rmol, & - gz1oz0, & - wspd, & - br, & - psim, & - psih, & - fm, & - fh, & - znt, & - zol, & - ust, & - cpm, & - chs2, & - cqs2, & - chs, & - flhc, & - flqc, & - qgh - - real(kind=kind_phys),intent(inout),dimension(ims:ime,jms:jme),optional:: & - ustm - -!--- local variables and arrays: - logical:: l_isfflx - logical:: l_shalwater_z0 - logical:: l_scm_force_flux - - integer:: i,j,k - real(kind=kind_phys),dimension(its:ite):: dz1d,u1d,v1d,qv1d,p1d,t1d - - real(kind=kind_phys),dimension(its:ite):: & - dx_hv,mavail_hv,pblh_hv,psfc_hv,tsk_hv,xland_hv,water_depth_hv,lakemask_hv - real(kind=kind_phys),dimension(its:ite,kts:kte):: & - dz_hv,u_hv,v_hv,qv_hv,p_hv,t_hv - - real(kind=kind_phys),dimension(its:ite):: & - lh_hv,u10_hv,v10_hv,th2_hv,t2_hv,q2_hv - real(kind=kind_phys),dimension(its:ite):: & - ck_hv,cka_hv,cd_hv,cda_hv - - real(kind=kind_phys),dimension(its:ite):: & - regime_hv,hfx_hv,qfx_hv,qsfc_hv,mol_hv,rmol_hv,gz1oz0_hv,wspd_hv, & - br_hv,psim_hv,psih_hv,fm_hv,fh_hv,znt_hv,zol_hv,ust_hv,cpm_hv, & - chs2_hv,cqs2_hv,chs_hv,flhc_hv,flqc_hv,qgh_hv - real(kind=kind_phys),dimension(its:ite):: & - ustm_hv - -!----------------------------------------------------------------------------------------------------------------- - - l_isfflx = .false. - l_shalwater_z0 = .false. - l_scm_force_flux = .false. - if(isfflx .eq. 1) l_isfflx = .true. - if(shalwater_z0 .eq. 1) l_shalwater_z0 = .true. - if(scm_force_flux .eq. 1) l_scm_force_flux = .true. - - do j = jts,jte - - do i = its,ite - !input arguments: - dx_hv(i) = dx(i,j) - mavail_hv(i) = mavail(i,j) - pblh_hv(i) = pblh(i,j) - psfc_hv(i) = psfc(i,j) - tsk_hv(i) = tsk(i,j) - xland_hv(i) = xland(i,j) - lakemask_hv(i) = lakemask(i,j) - water_depth_hv(i) = water_depth(i,j) - - do k = kts,kte - dz_hv(i,k) = dz8w(i,k,j) - u_hv(i,k) = u3d(i,k,j) - v_hv(i,k) = v3d(i,k,j) - qv_hv(i,k) = qv3d(i,k,j) - p_hv(i,k) = p3d(i,k,j) - t_hv(i,k) = t3d(i,k,j) - enddo - - !inout arguments: - regime_hv(i) = regime(i,j) - hfx_hv(i) = hfx(i,j) - qfx_hv(i) = qfx(i,j) - qsfc_hv(i) = qsfc(i,j) - mol_hv(i) = mol(i,j) - rmol_hv(i) = rmol(i,j) - gz1oz0_hv(i) = gz1oz0(i,j) - wspd_hv(i) = wspd(i,j) - br_hv(i) = br(i,j) - psim_hv(i) = psim(i,j) - psih_hv(i) = psih(i,j) - fm_hv(i) = fm(i,j) - fh_hv(i) = fh(i,j) - znt_hv(i) = znt(i,j) - zol_hv(i) = zol(i,j) - ust_hv(i) = ust(i,j) - cpm_hv(i) = cpm(i,j) - chs2_hv(i) = chs2(i,j) - cqs2_hv(i) = cqs2(i,j) - chs_hv(i) = chs(i,j) - flhc_hv(i) = flhc(i,j) - flqc_hv(i) = flqc(i,j) - qgh_hv(i) = qgh(i,j) - enddo - - if(present(ustm)) then - do i = its,ite - ustm_hv(i) = ustm(i,j) - enddo - endif - - call sf_sfclayrev_pre_run(dz2d=dz_hv,u2d=u_hv,v2d=v_hv,qv2d=qv_hv,p2d=p_hv,t2d=t_hv, & - dz1d=dz1d,u1d=u1d,v1d=v1d,qv1d=qv1d,p1d=p1d,t1d=t1d, & - its=its,ite=ite,kts=kts,kte=kte,errmsg=errmsg,errflg=errflg) - - call sf_sfclayrev_run(ux=u1d,vx=v1d,t1d=t1d,qv1d=qv1d,p1d=p1d,dz8w1d=dz1d, & - cp=cp,g=g,rovcp=rovcp,r=r,xlv=xlv,psfcpa=psfc_hv,chs=chs_hv, & - chs2=chs2_hv,cqs2=cqs2_hv,cpm=cpm_hv,pblh=pblh_hv, & - rmol=rmol_hv,znt=znt_hv,ust=ust_hv,mavail=mavail_hv, & - zol=zol_hv,mol=mol_hv,regime=regime_hv,psim=psim_hv, & - psih=psih_hv,fm=fm_hv,fh=fh_hv,xland=xland_hv,lakemask=lakemask_hv, & - hfx=hfx_hv,qfx=qfx_hv,tsk=tsk_hv,u10=u10_hv, & - v10=v10_hv,th2=th2_hv,t2=t2_hv,q2=q2_hv,flhc=flhc_hv, & - 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, & - p1000mb=p1000mb,shalwater_z0=l_shalwater_z0,water_depth=water_depth_hv, & - isftcflx=isftcflx,iz0tlnd=iz0tlnd,scm_force_flux=l_scm_force_flux, & - ustm=ustm_hv,ck=ck_hv,cka=cka_hv,cd=cd_hv,cda=cda_hv, & - its=its,ite=ite,errmsg=errmsg,errflg=errflg & - ) - - do i = its,ite - !output arguments: - lh(i,j) = lh_hv(i) - u10(i,j) = u10_hv(i) - v10(i,j) = v10_hv(i) - th2(i,j) = th2_hv(i) - t2(i,j) = t2_hv(i) - q2(i,j) = q2_hv(i) - - !inout arguments: - regime(i,j) = regime_hv(i) - hfx(i,j) = hfx_hv(i) - qfx(i,j) = qfx_hv(i) - qsfc(i,j) = qsfc_hv(i) - mol(i,j) = mol_hv(i) - rmol(i,j) = rmol_hv(i) - gz1oz0(i,j) = gz1oz0_hv(i) - wspd(i,j) = wspd_hv(i) - br(i,j) = br_hv(i) - psim(i,j) = psim_hv(i) - psih(i,j) = psih_hv(i) - fm(i,j) = fm_hv(i) - fh(i,j) = fh_hv(i) - znt(i,j) = znt_hv(i) - zol(i,j) = zol_hv(i) - ust(i,j) = ust_hv(i) - cpm(i,j) = cpm_hv(i) - chs2(i,j) = chs2_hv(i) - cqs2(i,j) = cqs2_hv(i) - chs(i,j) = chs_hv(i) - flhc(i,j) = flhc_hv(i) - flqc(i,j) = flqc_hv(i) - qgh(i,j) = qgh_hv(i) - enddo - - !optional output arguments: - if(present(ck) .and. present(cka) .and. present(cd) .and. present(cda)) then - do i = its,ite - ck(i,j) = ck_hv(i) - cka(i,j) = cka_hv(i) - cd(i,j) = cd_hv(i) - cda(i,j) = cda_hv(i) - enddo - endif - - !optional inout arguments: - if(present(ustm)) then - do i = its,ite - ustm(i,j) = ustm_hv(i) - enddo - endif - - enddo - - end subroutine sfclayrev - -!================================================================================================================= - end module module_sf_sfclayrev -!================================================================================================================= From 94b21c283bb217f861957078ec8ee333d622b13b Mon Sep 17 00:00:00 2001 From: Songyou Hong Date: Tue, 23 Dec 2025 12:53:17 -0700 Subject: [PATCH 16/19] Delete src/core_atmosphere/prt --- src/core_atmosphere/prt | 300 ---------------------------------------- 1 file changed, 300 deletions(-) delete mode 100644 src/core_atmosphere/prt diff --git a/src/core_atmosphere/prt b/src/core_atmosphere/prt deleted file mode 100644 index cc3c50cb62..0000000000 --- a/src/core_atmosphere/prt +++ /dev/null @@ -1,300 +0,0 @@ -408a409 -> -473a475 -> -523a526 -> -1437c1440 -< description="Coriolis parameter at an cell"/> -> -> ---- -> packages="bl_mynn_in;bl_ysu_in;bl_shinhong_in;cu_ntiedtke_in;mp_kessler_in;mp_thompson_in;mp_thompson_aers_in;mp_wsm6_in"/> -1647c1653 -< packages="bl_mynn_in;bl_ysu_in;cu_ntiedtke_in;mp_thompson_in;mp_thompson_aers_in;mp_wsm6_in"/> ---- -> packages="bl_mynn_in;bl_ysu_in;bl_shinhong_in;cu_ntiedtke_in;mp_thompson_in;mp_thompson_aers_in;mp_wsm6_in"/> -1990c1996 -< packages="bl_mynn_in;bl_ysu_in;cu_ntiedtke_in;mp_kessler_in;mp_thompson_in;mp_thompson_aers_in;mp_wsm6_in"/> ---- -> packages="bl_mynn_in;bl_ysu_in;bl_shinhong_in;cu_ntiedtke_in;mp_kessler_in;mp_thompson_in;mp_thompson_aers_in;mp_wsm6_in"/> -1998c2004 -< packages="bl_mynn_in;bl_ysu_in;cu_ntiedtke_in;mp_thompson_in;mp_thompson_aers_in;mp_wsm6_in"/> ---- -> packages="bl_mynn_in;bl_ysu_in;bl_shinhong_in;cu_ntiedtke_in;mp_thompson_in;mp_thompson_aers_in;mp_wsm6_in"/> -2207a2214,2228 -> units="-" -> description="logical for turning on/off top-down, radiation_driven mixing" -> possible_values=".true. to turn on top-down radiation_driven mixing; .false. otherwise"/> -> -> units="-" -> description="logical for shinhong nonlocal flux" -> possible_values=".true. to turn on shinhong nonlocal flux; .false. ysu nonlocal"/> -> -> units="-" -> description="logical for kinetic energy dissipative heating" -> possible_values=".true. to turn on dissipative heating; .false. otherwise"/> -> -2276c2297 -< possible_values="`suite',`bl_ysu',`bl_mynn',`off'"/> ---- -> possible_values="`suite',`bl_ysu',`bl_shinhong',`bl_mynn',`off'"/> -2281c2302 -< possible_values="`suite',`bl_ysu_gwdo',`bl_ugwp_gwdo',`off'"/> ---- -> possible_values="`suite',`bl_kim_gwdo',`bl_ugwp_gwdo',`off'"/> -2453a2475,2490 -> units="-" -> description="Effective grid length ratio in kim_gwdo scheme" -> possible_values="Non-negative real values"/> -> units="-" -> description="Logical index for nonhydrostatic effect in kim_gwdo scheme" -> possible_values="true. or .false."/> -> units="-" -> description="Tubulent orographic form drag (tofd) in kim_gwdo scheme" -> possible_values="true. or .false."/> -> units="-" -> description="Factor in kim_tofd scheme" -> possible_values="Non-negative real values"/> -2654c2691 -< packages="bl_mynn_in;bl_ysu_in"/> ---- -> packages="bl_mynn_in;bl_ysu_in;bl_shinhong_in"/> -2658c2695 -< packages="bl_mynn_in;bl_ysu_in"/> ---- -> packages="bl_mynn_in;bl_ysu_in;bl_shinhong_in"/> -2662c2699 -< packages="bl_mynn_in;bl_ysu_in"/> ---- -> packages="bl_mynn_in;bl_ysu_in;bl_shinhong_in"/> -2666c2703 -< packages="bl_mynn_in;bl_ysu_in"/> ---- -> packages="bl_mynn_in;bl_ysu_in;bl_shinhong_in"/> -2670c2707 -< packages="bl_mynn_in;bl_ysu_in"/> ---- -> packages="bl_mynn_in;bl_ysu_in;bl_shinhong_in"/> -2671a2709,2711 -> description="turbulent kinetic energy from PBL" -> packages="bl_mynn_in;bl_shinhong_in"/> -2673c2713,2718 -< ---- -> description="mixing length from PBL scheme" -> packages="bl_mynn_in;bl_shinhong_in"/> -> -> -> -2676c2721 -< packages="bl_ysu_in"/> ---- -> packages="bl_ysu_in;bl_shinhong_in"/> -2680c2725 -< packages="bl_ysu_in"/> ---- -> packages="bl_ysu_in;bl_shinhong_in"/> -2684c2729 -< packages="bl_ysu_in"/> ---- -> packages="bl_ysu_in;bl_shinhong_in"/> -2704,2707d2748 -< -< -2724,2727d2764 -< -< -2795c2832 -< packages="bl_mynn_in;bl_ysu_in"/> ---- -> packages="bl_mynn_in;bl_ysu_in;bl_shinhong_in"/> -2799c2836 -< packages="bl_mynn_in;bl_ysu_in"/> ---- -> packages="bl_mynn_in;bl_ysu_in;bl_shinhong_in"/> -2803c2840 -< packages="bl_mynn_in;bl_ysu_in"/> ---- -> packages="bl_mynn_in;bl_ysu_in;bl_shinhong_in"/> -2807c2844 -< packages="bl_mynn_in;bl_ysu_in"/> ---- -> packages="bl_mynn_in;bl_ysu_in;bl_shinhong_in"/> -2811c2848 -< packages="bl_mynn_in;bl_ysu_in"/> ---- -> packages="bl_mynn_in;bl_ysu_in;bl_shinhong_in"/> -2815c2852 -< packages="bl_mynn_in;bl_ysu_in"/> ---- -> packages="bl_mynn_in;bl_ysu_in;bl_shinhong_in"/> -2819c2856 -< packages="bl_mynn_in;bl_ysu_in"/> ---- -> packages="bl_mynn_in;bl_ysu_in;bl_shinhong_in"/> -2823c2860 -< packages="bl_mynn_in;bl_ysu_in"/> ---- -> packages="bl_mynn_in;bl_ysu_in;bl_shinhong_in"/> -2827c2864 -< packages="bl_mynn_in;bl_ysu_in"/> ---- -> packages="bl_mynn_in;bl_ysu_in;bl_shinhong_in"/> -2831c2868 -< packages="bl_mynn_in;bl_ysu_in"/> ---- -> packages="bl_mynn_in;bl_ysu_in;bl_shinhong_in"/> -2835c2872 -< packages="bl_mynn_in;bl_ysu_in"/> ---- -> packages="bl_mynn_in;bl_ysu_in;bl_shinhong_in"/> -2839c2876 -< packages="bl_mynn_in;bl_ysu_in"/> ---- -> packages="bl_mynn_in;bl_ysu_in;bl_shinhong_in"/> -2843c2880 -< packages="bl_mynn_in;bl_ysu_in"/> ---- -> packages="bl_mynn_in;bl_ysu_in;bl_shinhong_in"/> -2847c2884 -< packages="bl_mynn_in;bl_ysu_in"/> ---- -> packages="bl_mynn_in;bl_ysu_in;bl_shinhong_in"/> -2851c2888 -< packages="bl_mynn_in;bl_ysu_in"/> ---- -> packages="bl_mynn_in;bl_ysu_in;bl_shinhong_in"/> -2855c2892 -< packages="bl_mynn_in;bl_ysu_in"/> ---- -> packages="bl_mynn_in;bl_ysu_in;bl_shinhong_in"/> -2859c2896 -< packages="bl_mynn_in;bl_ysu_in"/> ---- -> packages="bl_mynn_in;bl_ysu_in;bl_shinhong_in"/> -2863c2900 -< packages="bl_mynn_in;bl_ysu_in"/> ---- -> packages="bl_mynn_in;bl_ysu_in;bl_shinhong_in"/> -2867c2904 -< packages="bl_mynn_in;bl_ysu_in"/> ---- -> packages="bl_mynn_in;bl_ysu_in;bl_shinhong_in"/> -2871c2908 -< packages="bl_mynn_in;bl_ysu_in"/> ---- -> packages="bl_mynn_in;bl_ysu_in;bl_shinhong_in"/> -2875c2912 -< packages="bl_mynn_in;bl_ysu_in"/> ---- -> packages="bl_mynn_in;bl_ysu_in;bl_shinhong_in"/> -2879c2916 -< packages="bl_mynn_in;bl_ysu_in"/> ---- -> packages="bl_mynn_in;bl_ysu_in;bl_shinhong_in"/> -2883c2920 -< packages="bl_mynn_in;bl_ysu_in"/> ---- -> packages="bl_mynn_in;bl_ysu_in;bl_shinhong_in"/> -2887c2924 -< packages="bl_mynn_in;bl_ysu_in"/> ---- -> packages="bl_mynn_in;bl_ysu_in;bl_shinhong_in"/> -2891c2928 -< packages="bl_mynn_in;bl_ysu_in"/> ---- -> packages="bl_mynn_in;bl_ysu_in;bl_shinhong_in"/> -2895c2932 -< packages="bl_mynn_in;bl_ysu_in"/> ---- -> packages="bl_mynn_in;bl_ysu_in;bl_shinhong_in"/> -2899c2936 -< packages="bl_mynn_in;bl_ysu_in"/> ---- -> packages="bl_mynn_in;bl_ysu_in;bl_shinhong_in"/> -2905c2942 -< packages="bl_ysu_in"/> ---- -> packages="bl_ysu_in;bl_shinhong_in"/> -2909c2946 -< packages="bl_ysu_in"/> ---- -> packages="bl_ysu_in;bl_shinhong_in"/> -2931c2968 -< ---- -> packages="bl_mynn_in;bl_ysu_in;bl_shinhong_in"/> -3556c3593 -< packages="bl_mynn_in;bl_ysu_in"/> ---- -> packages="bl_mynn_in;bl_ysu_in;bl_shinhong_in"/> -3560c3597 -< packages="bl_mynn_in;bl_ysu_in"/> ---- -> packages="bl_mynn_in;bl_ysu_in;bl_shinhong_in"/> -3564c3601 -< packages="bl_mynn_in;bl_ysu_in"/> ---- -> packages="bl_mynn_in;bl_ysu_in;bl_shinhong_in"/> -3568c3605 -< packages="bl_mynn_in;bl_ysu_in"/> ---- -> packages="bl_mynn_in;bl_ysu_in;bl_shinhong_in"/> -3572c3609 -< packages="bl_mynn_in;bl_ysu_in"/> ---- -> packages="bl_mynn_in;bl_ysu_in;bl_shinhong_in"/> -3784a3822,3823 -> description="elevation maximum over a grid cell"/> -3888c3927 -< Date: Tue, 23 Dec 2025 12:54:01 -0700 Subject: [PATCH 17/19] Delete src/core_atmosphere/physics/mpas_atmphys_driver_sfclayer.F-org --- .../mpas_atmphys_driver_sfclayer.F-org | 1092 ----------------- 1 file changed, 1092 deletions(-) delete mode 100644 src/core_atmosphere/physics/mpas_atmphys_driver_sfclayer.F-org diff --git a/src/core_atmosphere/physics/mpas_atmphys_driver_sfclayer.F-org b/src/core_atmosphere/physics/mpas_atmphys_driver_sfclayer.F-org deleted file mode 100644 index afde4fa523..0000000000 --- a/src/core_atmosphere/physics/mpas_atmphys_driver_sfclayer.F-org +++ /dev/null @@ -1,1092 +0,0 @@ -! Copyright (c) 2013, Los Alamos National Security, LLC (LANS) -! and the University Corporation for Atmospheric Research (UCAR). -! -! Unless noted otherwise source code is licensed under the BSD license. -! Additional copyright and license information can be found in the LICENSE file -! distributed with this code, or at http://mpas-dev.github.com/license.html -! -!================================================================================================================= - module mpas_atmphys_driver_sfclayer - 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 module_sf_mynn,only: sfclay_mynn - use module_sf_sfclay - use module_sf_sfclayrev,only: sfclayrev - use sf_mynn,only: sf_mynn_init - use sf_sfclayrev,only: sf_sfclayrev_init - - implicit none - private - public:: init_sfclayer, & - allocate_sfclayer, & - deallocate_sfclayer, & - driver_sfclayer - - integer,parameter,private:: isfflx = 1 !=1 for surface heat and moisture fluxes. - integer,parameter,private:: isftcflx = 0 !=0,(Charnock and Carlson-Boland). - integer,parameter,private:: iz0tlnd = 0 !=0,(Carlson-Boland). - integer,parameter,private:: scm_force_flux = 0 !SCM surface forcing by surface fluxes. - !0=no 1=yes (WRF single column model option only). - -!MPAS driver for parameterization of the surface layer. -!Laura D. Fowler (send comments to laura@ucar.edu). -!2013-05-01. -! -! subroutines in mpas_atmphys_driver_sfclayer: -! -------------------------------------------- -! allocate_sfclayer : allocate local arrays for parameterization of surface layer. -! deallocate_sfclayer : deallocate local arrays for parameterization of surface layer. -! init_sfclayer : initialization of individual surface layer schemes. -! driver_sfclayer : main driver (called from subroutine physics_driver). -! sfclayer_from_MPAS : initialize local arrays. -! sfclayer_to_MPAS : copy local arrays to MPAS arrays. -! -! WRF physics called from driver_sfclayer: -! ---------------------------------------- -! * module_sf_sfclay: Monin-Obukhov surface layer scheme. -! -! add-ons and modifications to sourcecode: -! ---------------------------------------- -! * removed the pre-processor option "do_hydrostatic_pressure" before call to the subroutine sfclay. -! Laura D. Fowler (laura@ucar.edu) / 2013-05-29. -! * updated the definition of the horizontal resolution to the actual mean distance between cell centers. -! Laura D. Fowler (laura@ucar.edu) / 2013-08-23. -! * in call to subroutine sfclay, replaced the variable g (that originally pointed to gravity) -! with gravity, for simplicity. -! Laura D. Fowler (laura@ucar.edu) / 2014-03-21. -! * in subroutine sfclayer_from_MPAS, added initialization of ustm, cd, cda, ck, and cka. in -! subroutine sfclayer_to_MPAS, filled diag_physics%ustm with ustm_p after call to subroutine sfclay. -! Laura D. Fowler (laura@ucar.edu) / 2014-04-16. -! * throughout the sourcecode, replaced all "var_struct" defined arrays by local pointers. -! Laura D. Fowler (laura@ucar.edu) / 2014-04-22. -! * modified sourcecode to use pools. -! Laura D. Fowler (laura@ucar.edu) / 2014-05-15. -! * added initialization of local logical "allowed_to read" in subroutine init_sfclayer. This logical -! is actually not used in subroutine sfclayinit. -! Laura D. Fowler (laura@ucar.edu) / 2014-09-25. -! * renamed "monin_obukhov" with "sf_monin_obukhov". -! Laura D. Fowler (laura@ucar.edu) / 2016-03-25. -! * added the implementation of the MYNN surface layer scheme from WRF 3.6.1. -! Laura D. Fowler (laura@ucar.edu) / 2016-03-30. -! * added the calculation of surface layer variables over seaice cells when config_frac_seaice is set to true. -! Laura D. Fowler (laura@ucar.edu) / 2016-10-03. -! * changed the definition of dx_p to match that used in other physics parameterizations. -! parameterizations. -! Laura D. Fowler (laura@ucar.edu) / 2016-10-18. -! * since we removed the local variable sfclayer_scheme from mpas_atmphys_vars.F, now defines sfclayer_scheme -! as a pointer to config_sfclayer_scheme. -! Laura D. Fowler (laura@ucar.edu) / 2017-02-16. -! * in subroutine driver_sfclayer, replaced the call to sfclay with a call to sfclayrev to use the revised -! version of the MONIN-OBUKHOV surface layer scheme. -! Laura D. Fowler (laura@ucar.edu) / 2023-05-15. -! * added the option sf_monin_obukhov_rev to run the revised surface layer scheme with the YSU PBL scheme. -! Laura D. Fowler (laura@ucar.edu) / 2023-05-15. -! * updated the MYNN surface layer scheme to the sourcecode available from WRF version 4.6. -! Laura D. Fowler (laura@ucar.edu) / 2024-02-14. - - - contains - - -!================================================================================================================= - subroutine allocate_sfclayer(configs) -!================================================================================================================= - -!input arguments: - type(mpas_pool_type),intent(in):: configs - -!local pointers: - logical,pointer:: config_frac_seaice - character(len=StrKIND),pointer:: sfclayer_scheme - -!----------------------------------------------------------------------------------------------------------------- - - call mpas_pool_get_config(configs,'config_frac_seaice' ,config_frac_seaice) - call mpas_pool_get_config(configs,'config_sfclayer_scheme',sfclayer_scheme ) - - if(.not.allocated(dx_p) ) allocate(dx_p(ims:ime,jms:jme) ) - if(.not.allocated(br_p) ) allocate(br_p(ims:ime,jms:jme) ) - if(.not.allocated(cd_p) ) allocate(cd_p(ims:ime,jms:jme) ) - if(.not.allocated(cda_p) ) allocate(cda_p(ims:ime,jms:jme) ) - if(.not.allocated(chs_p) ) allocate(chs_p(ims:ime,jms:jme) ) - if(.not.allocated(chs2_p) ) allocate(chs2_p(ims:ime,jms:jme) ) - if(.not.allocated(ck_p) ) allocate(ck_p(ims:ime,jms:jme) ) - if(.not.allocated(cka_p) ) allocate(cka_p(ims:ime,jms:jme) ) - if(.not.allocated(cpm_p) ) allocate(cpm_p(ims:ime,jms:jme) ) - if(.not.allocated(cqs2_p) ) allocate(cqs2_p(ims:ime,jms:jme) ) - if(.not.allocated(gz1oz0_p)) allocate(gz1oz0_p(ims:ime,jms:jme)) - if(.not.allocated(flhc_p) ) allocate(flhc_p(ims:ime,jms:jme) ) - if(.not.allocated(flqc_p) ) allocate(flqc_p(ims:ime,jms:jme) ) - if(.not.allocated(hfx_p) ) allocate(hfx_p(ims:ime,jms:jme) ) - if(.not.allocated(hpbl_p) ) allocate(hpbl_p(ims:ime,jms:jme) ) - if(.not.allocated(lh_p) ) allocate(lh_p(ims:ime,jms:jme) ) - if(.not.allocated(mavail_p)) allocate(mavail_p(ims:ime,jms:jme)) - if(.not.allocated(mol_p) ) allocate(mol_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(q2_p) ) allocate(q2_p(ims:ime,jms:jme) ) - if(.not.allocated(qfx_p) ) allocate(qfx_p(ims:ime,jms:jme) ) - if(.not.allocated(qgh_p) ) allocate(qgh_p(ims:ime,jms:jme) ) - if(.not.allocated(qsfc_p) ) allocate(qsfc_p(ims:ime,jms:jme) ) - if(.not.allocated(regime_p)) allocate(regime_p(ims:ime,jms:jme)) - if(.not.allocated(rmol_p) ) allocate(rmol_p(ims:ime,jms:jme) ) - if(.not.allocated(t2m_p) ) allocate(t2m_p(ims:ime,jms:jme) ) - if(.not.allocated(tsk_p) ) allocate(tsk_p(ims:ime,jms:jme) ) - if(.not.allocated(th2m_p) ) allocate(th2m_p(ims:ime,jms:jme) ) - if(.not.allocated(u10_p) ) allocate(u10_p(ims:ime,jms:jme) ) - if(.not.allocated(ust_p) ) allocate(ust_p(ims:ime,jms:jme) ) - if(.not.allocated(ustm_p) ) allocate(ustm_p(ims:ime,jms:jme) ) - if(.not.allocated(v10_p) ) allocate(v10_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(zol_p) ) allocate(zol_p(ims:ime,jms:jme) ) - if(.not.allocated(znt_p) ) allocate(znt_p(ims:ime,jms:jme) ) - - if(config_frac_seaice) then - if(.not.allocated(sst_p) ) allocate(sst_p(ims:ime,jms:jme) ) - if(.not.allocated(xice_p) ) allocate(xice_p(ims:ime,jms:jme) ) - - if(.not.allocated(br_sea) ) allocate(br_sea(ims:ime,jms:jme) ) - if(.not.allocated(chs_sea) ) allocate(chs_sea(ims:ime,jms:jme) ) - if(.not.allocated(chs2_sea) ) allocate(chs2_sea(ims:ime,jms:jme) ) - if(.not.allocated(cqs2_sea) ) allocate(cqs2_sea(ims:ime,jms:jme) ) - if(.not.allocated(cpm_sea) ) allocate(cpm_sea(ims:ime,jms:jme) ) - if(.not.allocated(flhc_sea) ) allocate(flhc_sea(ims:ime,jms:jme) ) - if(.not.allocated(flqc_sea) ) allocate(flqc_sea(ims:ime,jms:jme) ) - if(.not.allocated(gz1oz0_sea) ) allocate(gz1oz0_sea(ims:ime,jms:jme) ) - if(.not.allocated(hfx_sea) ) allocate(hfx_sea(ims:ime,jms:jme) ) - if(.not.allocated(qfx_sea) ) allocate(qfx_sea(ims:ime,jms:jme) ) - if(.not.allocated(mavail_sea) ) allocate(mavail_sea(ims:ime,jms:jme) ) - if(.not.allocated(mol_sea) ) allocate(mol_sea(ims:ime,jms:jme) ) - if(.not.allocated(lh_sea) ) allocate(lh_sea(ims:ime,jms:jme) ) - if(.not.allocated(psih_sea) ) allocate(psih_sea(ims:ime,jms:jme) ) - if(.not.allocated(psim_sea) ) allocate(psim_sea(ims:ime,jms:jme) ) - if(.not.allocated(qgh_sea) ) allocate(qgh_sea(ims:ime,jms:jme) ) - if(.not.allocated(qsfc_sea) ) allocate(qsfc_sea(ims:ime,jms:jme) ) - if(.not.allocated(regime_sea) ) allocate(regime_sea(ims:ime,jms:jme) ) - if(.not.allocated(rmol_sea) ) allocate(rmol_sea(ims:ime,jms:jme) ) - if(.not.allocated(tsk_sea) ) allocate(tsk_sea(ims:ime,jms:jme) ) - if(.not.allocated(ust_sea) ) allocate(ust_sea(ims:ime,jms:jme) ) - if(.not.allocated(ustm_sea) ) allocate(ustm_sea(ims:ime,jms:jme) ) - if(.not.allocated(wspd_sea) ) allocate(wspd_sea(ims:ime,jms:jme) ) - if(.not.allocated(xland_sea) ) allocate(xland_sea(ims:ime,jms:jme) ) - if(.not.allocated(zol_sea) ) allocate(zol_sea(ims:ime,jms:jme) ) - if(.not.allocated(znt_sea) ) allocate(znt_sea(ims:ime,jms:jme) ) - - if(.not.allocated(cd_sea) ) allocate(cd_sea(ims:ime,jms:jme) ) - if(.not.allocated(cda_sea) ) allocate(cda_sea(ims:ime,jms:jme) ) - if(.not.allocated(ck_sea) ) allocate(ck_sea(ims:ime,jms:jme) ) - if(.not.allocated(cka_sea) ) allocate(cka_sea(ims:ime,jms:jme) ) - if(.not.allocated(t2m_sea) ) allocate(t2m_sea(ims:ime,jms:jme) ) - if(.not.allocated(th2m_sea) ) allocate(th2m_sea(ims:ime,jms:jme) ) - if(.not.allocated(q2_sea) ) allocate(q2_sea(ims:ime,jms:jme) ) - if(.not.allocated(u10_sea) ) allocate(u10_sea(ims:ime,jms:jme) ) - if(.not.allocated(v10_sea) ) allocate(v10_sea(ims:ime,jms:jme) ) - - if(.not.allocated(regime_hold)) allocate(regime_hold(ims:ime,jms:jme)) - endif - - sfclayer_select: select case (trim(sfclayer_scheme)) - - case("sf_monin_obukhov","sf_monin_obukhov_rev") - if(.not.allocated(fh_p)) allocate(fh_p(ims:ime,jms:jme)) - if(.not.allocated(fm_p)) allocate(fm_p(ims:ime,jms:jme)) - if(config_frac_seaice) then - if(.not.allocated(fh_sea)) allocate(fh_sea(ims:ime,jms:jme)) - if(.not.allocated(fm_sea)) allocate(fm_sea(ims:ime,jms:jme)) - endif - - sfclayer2_select: select case(sfclayer_scheme) - - case("sf_monin_obukhov_rev") - if(.not.allocated(waterdepth_p)) allocate(waterdepth_p(ims:ime,jms:jme)) - if(.not.allocated(lakedepth_p) ) allocate(lakedepth_p(ims:ime,jms:jme) ) - if(.not.allocated(lakemask_p) ) allocate(lakemask_p(ims:ime,jms:jme) ) - - case default - - end select sfclayer2_select - - case("sf_mynn") - if(.not.allocated(snowh_p)) allocate(snowh_p(ims:ime,jms:jme)) - if(.not.allocated(ch_p) ) allocate(ch_p(ims:ime,jms:jme) ) - if(.not.allocated(qcg_p) ) allocate(qcg_p(ims:ime,jms:jme) ) - if(config_frac_seaice) then - if(.not.allocated(ch_sea)) allocate(ch_sea(ims:ime,jms:jme)) - endif - - case default - - end select sfclayer_select - - end subroutine allocate_sfclayer - -!================================================================================================================= - subroutine deallocate_sfclayer(configs) -!================================================================================================================= - -!input arguments: - type(mpas_pool_type),intent(in):: configs - -!local pointers: - logical,pointer:: config_frac_seaice - character(len=StrKIND),pointer:: sfclayer_scheme - -!----------------------------------------------------------------------------------------------------------------- - - call mpas_pool_get_config(configs,'config_frac_seaice' ,config_frac_seaice) - call mpas_pool_get_config(configs,'config_sfclayer_scheme',sfclayer_scheme ) - - if(allocated(dx_p) ) deallocate(dx_p ) - if(allocated(br_p) ) deallocate(br_p ) - if(allocated(cd_p) ) deallocate(cd_p ) - if(allocated(cda_p) ) deallocate(cda_p ) - if(allocated(chs_p) ) deallocate(chs_p ) - if(allocated(chs2_p) ) deallocate(chs2_p ) - if(allocated(ck_p) ) deallocate(ck_p ) - if(allocated(cka_p) ) deallocate(cka_p ) - if(allocated(cpm_p) ) deallocate(cpm_p ) - if(allocated(cqs2_p) ) deallocate(cqs2_p ) - if(allocated(gz1oz0_p)) deallocate(gz1oz0_p) - if(allocated(flhc_p) ) deallocate(flhc_p ) - if(allocated(flqc_p) ) deallocate(flqc_p ) - if(allocated(hfx_p) ) deallocate(hfx_p ) - if(allocated(hpbl_p) ) deallocate(hpbl_p ) - if(allocated(lh_p) ) deallocate(lh_p ) - if(allocated(mavail_p)) deallocate(mavail_p) - if(allocated(mol_p) ) deallocate(mol_p ) - if(allocated(psih_p) ) deallocate(psih_p ) - if(allocated(psim_p) ) deallocate(psim_p ) - if(allocated(q2_p) ) deallocate(q2_p ) - if(allocated(qfx_p) ) deallocate(qfx_p ) - if(allocated(qgh_p) ) deallocate(qgh_p ) - if(allocated(qsfc_p) ) deallocate(qsfc_p ) - if(allocated(regime_p)) deallocate(regime_p) - if(allocated(rmol_p) ) deallocate(rmol_p ) - if(allocated(t2m_p) ) deallocate(t2m_p ) - if(allocated(tsk_p) ) deallocate(tsk_p ) - if(allocated(th2m_p) ) deallocate(th2m_p ) - if(allocated(u10_p) ) deallocate(u10_p ) - if(allocated(ust_p) ) deallocate(ust_p ) - if(allocated(ustm_p) ) deallocate(ustm_p ) - if(allocated(v10_p) ) deallocate(v10_p ) - if(allocated(wspd_p) ) deallocate(wspd_p ) - if(allocated(xland_p) ) deallocate(xland_p ) - if(allocated(zol_p) ) deallocate(zol_p ) - if(allocated(znt_p) ) deallocate(znt_p ) - - if(config_frac_seaice) then - if(allocated(sst_p) ) deallocate(sst_p ) - if(allocated(xice_p) ) deallocate(xice_p ) - - if(allocated(br_sea) ) deallocate(br_sea ) - if(allocated(flhc_p) ) deallocate(flhc_sea ) - if(allocated(flqc_p) ) deallocate(flqc_sea ) - if(allocated(gz1oz0_sea) ) deallocate(gz1oz0_sea ) - if(allocated(mol_sea) ) deallocate(mol_sea ) - if(allocated(psih_sea) ) deallocate(psih_sea ) - if(allocated(psim_sea) ) deallocate(psim_sea ) - if(allocated(rmol_sea) ) deallocate(rmol_sea ) - if(allocated(ust_sea) ) deallocate(ust_sea ) - if(allocated(ustm_sea) ) deallocate(ustm_sea ) - if(allocated(wspd_sea) ) deallocate(wspd_sea ) - if(allocated(zol_sea) ) deallocate(zol_sea ) - if(allocated(cd_sea) ) deallocate(cd_sea ) - if(allocated(cda_sea) ) deallocate(cda_sea ) - if(allocated(ck_sea) ) deallocate(ck_sea ) - if(allocated(cka_sea) ) deallocate(cka_sea ) - if(allocated(t2m_sea) ) deallocate(t2m_sea ) - if(allocated(th2m_sea) ) deallocate(th2m_sea ) - if(allocated(q2_sea) ) deallocate(q2_sea ) - if(allocated(u10_sea) ) deallocate(u10_sea ) - if(allocated(v10_sea) ) deallocate(v10_sea ) - if(allocated(regime_hold)) deallocate(regime_hold) - - if(allocated(mavail_sea) ) deallocate(mavail_sea ) - if(allocated(tsk_sea) ) deallocate(tsk_sea ) - if(allocated(xland_sea) ) deallocate(xland_sea ) - if(allocated(znt_sea) ) deallocate(znt_sea ) - endif - - sfclayer_select: select case (trim(sfclayer_scheme)) - - case("sf_monin_obukhov","sf_monin_obukhov_rev") - if(allocated(fh_p)) deallocate(fh_p) - if(allocated(fm_p)) deallocate(fm_p) - if(config_frac_seaice) then - if(allocated(fh_sea)) deallocate(fh_sea) - if(allocated(fm_sea)) deallocate(fm_sea) - endif - - sfclayer2_select: select case(sfclayer_scheme) - - case("sf_monin_obukhov_rev") - if(allocated(waterdepth_p)) deallocate(waterdepth_p) - if(allocated(lakedepth_p) ) deallocate(lakedepth_p ) - if(allocated(lakemask_p) ) deallocate(lakemask_p ) - - case default - - end select sfclayer2_select - - case("sf_mynn") - if(allocated(snowh_p)) deallocate(snowh_p) - if(allocated(ch_p) ) deallocate(ch_p ) - if(allocated(qcg_p) ) deallocate(qcg_p ) - if(config_frac_seaice) then - if(allocated(ch_sea)) deallocate(ch_sea) - endif - - case default - - end select sfclayer_select - - end subroutine deallocate_sfclayer - -!================================================================================================================= - subroutine sfclayer_from_MPAS(configs,mesh,diag_physics,sfc_input,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 - type(mpas_pool_type),intent(inout):: diag_physics - - integer,intent(in):: its,ite - -!local variables: - integer:: i,j,k - -!local pointers: - logical,pointer:: config_frac_seaice - character(len=StrKIND),pointer:: sfclayer_scheme - - real(kind=RKIND),pointer:: len_disp - real(kind=RKIND),dimension(:),pointer:: meshDensity - real(kind=RKIND),dimension(:),pointer:: skintemp,sst,xice,xland - real(kind=RKIND),dimension(:),pointer:: hpbl,mavail - real(kind=RKIND),dimension(:),pointer:: br,cpm,chs,chs2,cqs2,flhc,flqc,gz1oz0,hfx,qfx, & - qgh,qsfc,lh,mol,psim,psih,regime,rmol,ust,ustm, & - wspd,znt,zol - -!local pointers specific to monin_obukhov: - real(kind=RKIND),dimension(:),pointer:: fh,fm - -!local pointers specific to mynn: - real(kind=RKIND),dimension(:),pointer:: ch,qcg,snowh - -!----------------------------------------------------------------------------------------------------------------- - -!input variables: - 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_len_disp' ,len_disp ) - call mpas_pool_get_array(mesh,'meshDensity',meshDensity) - - call mpas_pool_get_array(diag_physics,'hpbl' ,hpbl ) - call mpas_pool_get_array(diag_physics,'mavail' ,mavail ) - call mpas_pool_get_array(sfc_input ,'skintemp',skintemp) - call mpas_pool_get_array(sfc_input ,'xland' ,xland ) - -!inout variables: - call mpas_pool_get_array(diag_physics,'br' ,br ) - call mpas_pool_get_array(diag_physics,'cpm' ,cpm ) - call mpas_pool_get_array(diag_physics,'chs' ,chs ) - call mpas_pool_get_array(diag_physics,'chs2' ,chs2 ) - call mpas_pool_get_array(diag_physics,'cqs2' ,cqs2 ) - call mpas_pool_get_array(diag_physics,'flhc' ,flhc ) - call mpas_pool_get_array(diag_physics,'flqc' ,flqc ) - call mpas_pool_get_array(diag_physics,'gz1oz0' ,gz1oz0 ) - call mpas_pool_get_array(diag_physics,'hfx' ,hfx ) - call mpas_pool_get_array(diag_physics,'qfx' ,qfx ) - call mpas_pool_get_array(diag_physics,'qgh' ,qgh ) - call mpas_pool_get_array(diag_physics,'qsfc' ,qsfc ) - call mpas_pool_get_array(diag_physics,'lh' ,lh ) - call mpas_pool_get_array(diag_physics,'mol' ,mol ) - call mpas_pool_get_array(diag_physics,'psih' ,psih ) - call mpas_pool_get_array(diag_physics,'psim' ,psim ) - call mpas_pool_get_array(diag_physics,'regime' ,regime ) - call mpas_pool_get_array(diag_physics,'rmol' ,rmol ) - call mpas_pool_get_array(diag_physics,'ust' ,ust ) - call mpas_pool_get_array(diag_physics,'ustm' ,ustm ) - call mpas_pool_get_array(diag_physics,'wspd' ,wspd ) - call mpas_pool_get_array(diag_physics,'znt' ,znt ) - call mpas_pool_get_array(diag_physics,'zol' ,zol ) - - do j = jts,jte - do i = its,ite - !input variables: - dx_p(i,j) = len_disp / meshDensity(i)**0.25 - hpbl_p(i,j) = hpbl(i) - mavail_p(i,j) = mavail(i) - tsk_p(i,j) = skintemp(i) - xland_p(i,j) = xland(i) - - !inout variables: - br_p(i,j) = br(i) - cpm_p(i,j) = cpm(i) - chs_p(i,j) = chs(i) - chs2_p(i,j) = chs2(i) - cqs2_p(i,j) = cqs2(i) - flhc_p(i,j) = flhc(i) - flqc_p(i,j) = flqc(i) - gz1oz0_p(i,j) = gz1oz0(i) - hfx_p(i,j) = hfx(i) - qfx_p(i,j) = qfx(i) - qgh_p(i,j) = qgh(i) - qsfc_p(i,j) = qsfc(i) - lh_p(i,j) = lh(i) - mol_p(i,j) = mol(i) - psim_p(i,j) = psim(i) - psih_p(i,j) = psih(i) - regime_p(i,j) = regime(i) - rmol_p(i,j) = rmol(i) - ust_p(i,j) = ust(i) - wspd_p(i,j) = wspd(i) - znt_p(i,j) = znt(i) - zol_p(i,j) = zol(i) - - !output variables: - q2_p(i,j) = 0._RKIND - t2m_p(i,j) = 0._RKIND - th2m_p(i,j) = 0._RKIND - u10_p(i,j) = 0._RKIND - v10_p(i,j) = 0._RKIND - - !output variables (optional): - cd_p(i,j) = 0._RKIND - cda_p(i,j) = 0._RKIND - ck_p(i,j) = 0._RKIND - cka_p(i,j) = 0._RKIND - ustm_p(i,j) = ustm(i) - enddo - enddo - - if(config_frac_seaice) then - call mpas_pool_get_array(sfc_input,'sst' ,sst) - call mpas_pool_get_array(sfc_input,'xice',xice) - do j = jts,jte - do i = its,ite - sst_p(i,j) = sst(i) - xice_p(i,j) = xice(i) - - !input variables: - mavail_sea(i,j) = mavail(i) - tsk_sea(i,j) = skintemp(i) - xland_sea(i,j) = xland(i) - !inout variables: - br_sea(i,j) = br(i) - cpm_sea(i,j) = cpm(i) - chs_sea(i,j) = chs(i) - chs2_sea(i,j) = chs2(i) - cqs2_sea(i,j) = cqs2(i) - flhc_sea(i,j) = flhc(i) - flqc_sea(i,j) = flqc(i) - gz1oz0_sea(i,j) = gz1oz0(i) - lh_sea(i,j) = lh(i) - hfx_sea(i,j) = hfx(i) - qfx_sea(i,j) = qfx(i) - mol_sea(i,j) = mol(i) - psim_sea(i,j) = psim(i) - psih_sea(i,j) = psih(i) - qgh_sea(i,j) = qgh(i) - rmol_sea(i,j) = rmol(i) - regime_sea(i,j) = regime(i) - ust_sea(i,j) = ust(i) - ustm_sea(i,j) = ustm(i) - wspd_sea(i,j) = wspd(i) - zol_sea(i,j) = zol(i) - znt_sea(i,j) = znt(i) - regime_hold(i,j) = regime(i) - !output variables: - cd_sea(i,j) = 0._RKIND - cda_sea(i,j) = 0._RKIND - ck_sea(i,j) = 0._RKIND - cka_sea(i,j) = 0._RKIND - qsfc_sea(i,j) = 0._RKIND - q2_sea(i,j) = 0._RKIND - t2m_sea(i,j) = 0._RKIND - th2m_sea(i,j) = 0._RKIND - u10_sea(i,j) = 0._RKIND - v10_sea(i,j) = 0._RKIND - - !overwrite some local variables for sea-ice cells: - if(xice_p(i,j).ge.xice_threshold .and. xice_p(i,j).le.1._RKIND) then - xland_sea(i,j) = 2._RKIND - mavail_sea(i,j) = 1._RKIND - znt_sea(i,j) = 0.0001_RKIND - tsk_sea(i,j) = max(sst_p(i,j),271.4_RKIND) - else - xland_sea(i,j) = xland_p(i,j) - mavail_sea(i,j) = mavail_p(i,j) - znt_sea(i,j) = znt_p(i,j) - tsk_sea(i,j) = tsk_p(i,j) - endif - enddo - enddo - endif - - sfclayer_select: select case (trim(sfclayer_scheme)) - - case("sf_monin_obukhov","sf_monin_obukhov_rev") - call mpas_pool_get_array(diag_physics,'fh',fh) - call mpas_pool_get_array(diag_physics,'fm',fm) - - do j = jts,jte - do i = its,ite - fh_p(i,j) = fh(i) - fm_p(i,j) = fm(i) - if(config_frac_seaice) then - fh_sea(i,j) = fh(i) - fm_sea(i,j) = fm(i) - endif - enddo - enddo - - sfclayer2_select: select case(sfclayer_scheme) - - case("sf_monin_obukhov_rev") - - do j = jts,jte - do i = its,ite - waterdepth_p(i,j) = 0._RKIND - lakedepth_p(i,j) = 0._RKIND - lakemask_p(i,j) = 0._RKIND - enddo - enddo - - case default - - end select sfclayer2_select - - case("sf_mynn") - !input variables: - call mpas_pool_get_array(diag_physics,'qcg' ,qcg ) - call mpas_pool_get_array(sfc_input ,'snowh',snowh) - !inout variables: - call mpas_pool_get_array(diag_physics,'ch',ch) - - do j = jts,jte - do i = its,ite - !input variables: - snowh_p(i,j) = snowh(i) - qcg_p(i,j) = qcg(i) - !inout variables: - ch_p(i,j) = ch(i) - if(config_frac_seaice) then - ch_sea(i,j) = ch(i) - endif - enddo - enddo - - case default - - end select sfclayer_select - - end subroutine sfclayer_from_MPAS - -!================================================================================================================= - subroutine sfclayer_to_MPAS(configs,sfc_input,diag_physics,its,ite) -!================================================================================================================= - -!input arguments: - type(mpas_pool_type),intent(in):: configs - type(mpas_pool_type),intent(in):: sfc_input - integer,intent(in):: its,ite - -!inout arguments: - type(mpas_pool_type),intent(inout):: diag_physics - -!local variables: - integer:: i,j - -!local pointers: - logical,pointer:: config_frac_seaice - character(len=StrKIND),pointer:: sfclayer_scheme - - real(kind=RKIND),dimension(:),pointer:: br,cpm,chs,chs2,cqs2,flhc,flqc,gz1oz0,hfx,qfx, & - qgh,qsfc,lh,mol,psim,psih,regime,rmol,ust,wspd, & - znt,zol - real(kind=RKIND),dimension(:),pointer:: q2,t2m,th2m,u10,v10 - real(kind=RKIND),dimension(:),pointer:: cd,cda,ck,cka,ustm - real(kind=RKIND),dimension(:),pointer:: xice - -!local pointers specific to monin_obukhov: - real(kind=RKIND),dimension(:),pointer:: fh,fm - -!local pointers specific to mynn: - real(kind=RKIND),dimension(:),pointer:: ch,qcg - -!----------------------------------------------------------------------------------------------------------------- - - call mpas_pool_get_config(configs,'config_frac_seaice' ,config_frac_seaice) - call mpas_pool_get_config(configs,'config_sfclayer_scheme',sfclayer_scheme ) - -!inout variables: - call mpas_pool_get_array(diag_physics,'br' ,br ) - call mpas_pool_get_array(diag_physics,'cpm' ,cpm ) - call mpas_pool_get_array(diag_physics,'chs' ,chs ) - call mpas_pool_get_array(diag_physics,'chs2' ,chs2 ) - call mpas_pool_get_array(diag_physics,'cqs2' ,cqs2 ) - call mpas_pool_get_array(diag_physics,'flhc' ,flhc ) - call mpas_pool_get_array(diag_physics,'flqc' ,flqc ) - call mpas_pool_get_array(diag_physics,'gz1oz0',gz1oz0) - call mpas_pool_get_array(diag_physics,'hfx' ,hfx ) - call mpas_pool_get_array(diag_physics,'qfx' ,qfx ) - call mpas_pool_get_array(diag_physics,'qgh' ,qgh ) - call mpas_pool_get_array(diag_physics,'qsfc' ,qsfc ) - call mpas_pool_get_array(diag_physics,'lh' ,lh ) - call mpas_pool_get_array(diag_physics,'mol' ,mol ) - call mpas_pool_get_array(diag_physics,'psih' ,psih ) - call mpas_pool_get_array(diag_physics,'psim' ,psim ) - call mpas_pool_get_array(diag_physics,'regime',regime) - call mpas_pool_get_array(diag_physics,'rmol' ,rmol ) - call mpas_pool_get_array(diag_physics,'ust' ,ust ) - call mpas_pool_get_array(diag_physics,'wspd' ,wspd ) - call mpas_pool_get_array(diag_physics,'znt' ,znt ) - call mpas_pool_get_array(diag_physics,'zol' ,zol ) - -!output variables: - call mpas_pool_get_array(diag_physics,'q2' ,q2 ) - call mpas_pool_get_array(diag_physics,'t2m' ,t2m ) - call mpas_pool_get_array(diag_physics,'th2m' ,th2m ) - call mpas_pool_get_array(diag_physics,'u10' ,u10 ) - call mpas_pool_get_array(diag_physics,'v10' ,v10 ) - -!output variables (optional): - call mpas_pool_get_array(diag_physics,'cd' ,cd ) - call mpas_pool_get_array(diag_physics,'cda' ,cda ) - call mpas_pool_get_array(diag_physics,'ck' ,ck ) - call mpas_pool_get_array(diag_physics,'cka' ,cka ) - call mpas_pool_get_array(diag_physics,'ustm' ,ustm ) - -!output variables (optional): - call mpas_pool_get_array(diag_physics,'cd' ,cd ) - call mpas_pool_get_array(diag_physics,'cda' ,cda ) - call mpas_pool_get_array(diag_physics,'ck' ,ck ) - call mpas_pool_get_array(diag_physics,'cka' ,cka ) - - do j = jts,jte - do i = its,ite - !inout variables: - br(i) = br_p(i,j) - cpm(i) = cpm_p(i,j) - chs(i) = chs_p(i,j) - chs2(i) = chs2_p(i,j) - cqs2(i) = cqs2_p(i,j) - flhc(i) = flhc_p(i,j) - flqc(i) = flqc_p(i,j) - gz1oz0(i) = gz1oz0_p(i,j) - hfx(i) = hfx_p(i,j) - lh(i) = lh_p(i,j) - mol(i) = mol_p(i,j) - qfx(i) = qfx_p(i,j) - qgh(i) = qgh_p(i,j) - qsfc(i) = qsfc_p(i,j) - psim(i) = psim_p(i,j) - psih(i) = psih_p(i,j) - regime(i) = regime_p(i,j) - rmol(i) = rmol_p(i,j) - ust(i) = ust_p(i,j) - wspd(i) = wspd_p(i,j) - zol(i) = zol_p(i,j) - znt(i) = znt_p(i,j) - !output variables: - q2(i) = q2_p(i,j) - t2m(i) = t2m_p(i,j) - th2m(i) = th2m_p(i,j) - u10(i) = u10_p(i,j) - v10(i) = v10_p(i,j) - !output variables (optional): - cd(i) = cd_p(i,j) - cda(i) = cda_p(i,j) - ck(i) = ck_p(i,j) - cka(i) = cka_p(i,j) - ustm(i) = ustm_p(i,j) - enddo - enddo - - if(config_frac_seaice) then - call mpas_pool_get_array(sfc_input,'xice',xice) - do j = jts,jte - do i = its,ite - if(xice(i).ge.xice_threshold .and. xice(i).le.1._RKIND) then - br(i) = br_p(i,j)*xice(i) + (1._RKIND-xice(i))*br_sea(i,j) - flhc(i) = flhc_p(i,j)*xice(i) + (1._RKIND-xice(i))*flhc_sea(i,j) - flqc(i) = flqc_p(i,j)*xice(i) + (1._RKIND-xice(i))*flqc_sea(i,j) - gz1oz0(i) = gz1oz0_p(i,j)*xice(i) + (1._RKIND-xice(i))*gz1oz0_sea(i,j) - mol(i) = mol_p(i,j)*xice(i) + (1._RKIND-xice(i))*mol_sea(i,j) - psih(i) = psih_p(i,j)*xice(i) + (1._RKIND-xice(i))*psih_sea(i,j) - psim(i) = psim_p(i,j)*xice(i) + (1._RKIND-xice(i))*psim_sea(i,j) - rmol(i) = rmol_p(i,j)*xice(i) + (1._RKIND-xice(i))*rmol_sea(i,j) - ust(i) = ust_p(i,j)*xice(i) + (1._RKIND-xice(i))*ust_sea(i,j) - wspd(i) = wspd_p(i,j)*xice(i) + (1._RKIND-xice(i))*wspd_sea(i,j) - zol(i) = zol_p(i,j)*xice(i) + (1._RKIND-xice(i))*zol_sea(i,j) - if(xice(i) .ge. 0.5_RKIND) regime(i) = regime_hold(i,j) - !output variables: - q2(i) = q2_p(i,j)*xice(i) + (1._RKIND-xice(i))*q2_sea(i,j) - t2m(i) = t2m_p(i,j)*xice(i) + (1._RKIND-xice(i))*t2m_sea(i,j) - th2m(i) = th2m_p(i,j)*xice(i) + (1._RKIND-xice(i))*th2m_sea(i,j) - u10(i) = u10_p(i,j)*xice(i) + (1._RKIND-xice(i))*u10_sea(i,j) - v10(i) = v10_p(i,j)*xice(i) + (1._RKIND-xice(i))*v10_sea(i,j) - !output variables (optional): - cd(i) = cd_p(i,j)*xice(i) + (1._RKIND-xice(i))*cd_sea(i,j) - cda(i) = cda_p(i,j)*xice(i) + (1._RKIND-xice(i))*cda_sea(i,j) - ck(i) = ck_p(i,j)*xice(i) + (1._RKIND-xice(i))*ck_sea(i,j) - cka(i) = cka_p(i,j)*xice(i) + (1._RKIND-xice(i))*cka_sea(i,j) - ustm(i) = ustm_p(i,j)*xice(i) + (1._RKIND-xice(i))*ustm_sea(i,j) - endif - enddo - enddo - endif - - sfclayer_select: select case (trim(sfclayer_scheme)) - - case("sf_monin_obukhov","sf_monin_obukhov_rev") - call mpas_pool_get_array(diag_physics,'fh',fh) - call mpas_pool_get_array(diag_physics,'fm',fm) - - do j = jts,jte - do i = its,ite - fh(i) = fh_p(i,j) - fm(i) = fm_p(i,j) - enddo - enddo - if(config_frac_seaice) then - call mpas_pool_get_array(sfc_input,'xice',xice) - do j = jts,jte - do i = its,ite - if(xice(i).ge.xice_threshold .and. xice(i).le.1._RKIND) then - fh(i) = fh_p(i,j)*xice(i) + (1._RKIND-xice(i))*fh_sea(i,j) - fm(i) = fm_p(i,j)*xice(i) + (1._RKIND-xice(i))*fm_sea(i,j) - endif - enddo - enddo - endif - - case("sf_mynn") - call mpas_pool_get_array(diag_physics,'ch',ch) - - do j = jts,jte - do i = its,ite - ch(i) = ch_p(i,j) - enddo - enddo - if(config_frac_seaice) then - call mpas_pool_get_array(sfc_input,'xice',xice) - do j = jts,jte - do i = its,ite - if(xice(i).ge.xice_threshold .and. xice(i).le.1._RKIND) then - ch(i) = ch_p(i,j)*xice(i) + (1._RKIND-xice(i))*ch_sea(i,j) - endif - enddo - enddo - endif - - case default - - end select sfclayer_select - - end subroutine sfclayer_to_MPAS - -!================================================================================================================= - subroutine init_sfclayer(configs) -!================================================================================================================= - -!input arguments: - type(mpas_pool_type),intent(in):: configs - -!local variables and pointers: - logical, parameter:: allowed_to_read = .false. !actually not used in subroutine sfclayinit. - character(len=StrKIND),pointer:: sfclayer_scheme - -!CCPP-compliant flags: - character(len=StrKIND):: errmsg - integer:: errflg - -!----------------------------------------------------------------------------------------------------------------- - -!initialization of CCPP-compliant flags: - errmsg = ' ' - errflg = 0 - - call mpas_pool_get_config(configs,'config_sfclayer_scheme',sfclayer_scheme) - - sfclayer_select: select case (trim(sfclayer_scheme)) - - case("sf_monin_obukhov") - call sfclayinit(allowed_to_read) - - case("sf_monin_obukhov_rev") - call sf_sfclayrev_init(errmsg,errflg) - - case("sf_mynn") - call sf_mynn_init(errmsg,errflg) - - case default - - end select sfclayer_select - - end subroutine init_sfclayer - -!================================================================================================================= - subroutine driver_sfclayer(itimestep,configs,mesh,diag_physics,sfc_input,its,ite) -!================================================================================================================= - -!input and inout arguments: - type(mpas_pool_type),intent(in):: mesh - type(mpas_pool_type),intent(in):: configs - 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):: diag_physics - -!local pointers: - logical,pointer:: config_do_restart,config_frac_seaice - character(len=StrKIND),pointer:: sfclayer_scheme - real(kind=RKIND),dimension(:),pointer:: areaCell - -!local variables: - integer:: initflag - real(kind=RKIND):: dx - -!CCPP-compliant flags: - character(len=StrKIND):: errmsg - integer:: errflg - -!----------------------------------------------------------------------------------------------------------------- -!call mpas_log_write('') -!call mpas_log_write('--- enter subroutine driver_sfclayer:') - -!initialization of CCPP-compliant flags: - errmsg = ' ' - errflg = 0 - - 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_array(mesh,'areaCell',areaCell) - -!copy all MPAS arrays to rectanguler grid: - call sfclayer_from_MPAS(configs,mesh,diag_physics,sfc_input,its,ite) - - dx = sqrt(maxval(areaCell)) - - initflag = 1 - if(config_do_restart .or. itimestep > 1) initflag = 0 - - sfclayer_select: select case (trim(sfclayer_scheme)) - - case("sf_monin_obukhov") - call mpas_timer_start('sf_monin_obukhov') - call sfclay( & - p3d = pres_hyd_p , psfc = psfc_p , t3d = t_p , & - u3d = u_p , v3d = v_p , qv3d = qv_p , & - dz8w = dz_p , cp = cp , g = gravity , & - rovcp = rcp , R = R_d , xlv = xlv , & - chs = chs_p , chs2 = chs2_p , cqs2 = cqs2_p , & - cpm = cpm_p , znt = znt_p , ust = ust_p , & - pblh = hpbl_p , mavail = mavail_p , zol = zol_p , & - mol = mol_p , regime = regime_p , psim = psim_p , & - psih = psih_p , fm = fm_p , fh = fh_p , & - xland = xland_p , hfx = hfx_p , qfx = qfx_p , & - lh = lh_p , tsk = tsk_p , flhc = flhc_p , & - flqc = flqc_p , qgh = qgh_p , qsfc = qsfc_p , & - rmol = rmol_p , u10 = u10_p , v10 = v10_p , & - th2 = th2m_p , t2 = t2m_p , q2 = q2_p , & - gz1oz0 = gz1oz0_p , wspd = wspd_p , br = br_p , & - isfflx = isfflx , dx = dx_p , svp1 = svp1 , & - svp2 = svp2 , svp3 = svp3 , svpt0 = svpt0 , & - ep1 = ep_1 , ep2 = ep_2 , karman = karman , & - eomeg = eomeg , stbolt = stbolt , P1000mb = P0 , & - ustm = ustm_p , ck = ck_p , cka = cka_p , & - cd = cd_p , cda = cda_p , isftcflx = isftcflx , & - iz0tlnd = iz0tlnd , scm_force_flux = scm_force_flux , & - 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 & - ) - - if(config_frac_seaice) then - call sfclay( & - p3d = pres_hyd_p , psfc = psfc_p , t3d = t_p , & - u3d = u_p , v3d = v_p , qv3d = qv_p , & - dz8w = dz_p , cp = cp , g = gravity , & - rovcp = rcp , R = R_d , xlv = xlv , & - chs = chs_sea , chs2 = chs2_sea , cqs2 = cqs2_sea , & - cpm = cpm_sea , znt = znt_sea , ust = ust_sea , & - pblh = hpbl_p , mavail = mavail_sea , zol = zol_sea , & - mol = mol_sea , regime = regime_sea , psim = psim_sea , & - psih = psih_sea , fm = fm_sea , fh = fh_sea , & - xland = xland_sea , hfx = hfx_sea , qfx = qfx_sea , & - lh = lh_sea , tsk = tsk_sea , flhc = flhc_sea , & - flqc = flqc_sea , qgh = qgh_sea , qsfc = qsfc_sea , & - rmol = rmol_sea , u10 = u10_sea , v10 = v10_sea , & - th2 = th2m_sea , t2 = t2m_sea , q2 = q2_sea , & - gz1oz0 = gz1oz0_sea , wspd = wspd_sea , br = br_sea , & - isfflx = isfflx , dx = dx_p , svp1 = svp1 , & - svp2 = svp2 , svp3 = svp3 , svpt0 = svpt0 , & - ep1 = ep_1 , ep2 = ep_2 , karman = karman , & - eomeg = eomeg , stbolt = stbolt , P1000mb = P0 , & - ustm = ustm_sea , ck = ck_sea , cka = cka_sea , & - cd = cd_sea , cda = cda_sea , isftcflx = isftcflx , & - iz0tlnd = iz0tlnd , scm_force_flux = scm_force_flux , & - ids = ids , ide = ide , jds = jds , jde = jde , kds = kds , kde = kde , & - ims = ims , ime = ime , jms = jms , jme = jme , kms = kms , kme = kme , & - its = its , ite = ite , jts = jts , jte = jte , kts = kts , kte = kte & - ) - endif - call mpas_timer_stop('sf_monin_obukhov') - - case("sf_monin_obukhov_rev") - call mpas_timer_start('sf_monin_obukhov_rev') - call sfclayrev( & - p3d = pres_hyd_p , psfc = psfc_p , t3d = t_p , & - u3d = u_p , v3d = v_p , qv3d = qv_p , & - dz8w = dz_p , cp = cp , g = gravity , & - rovcp = rcp , R = R_d , xlv = xlv , & - chs = chs_p , chs2 = chs2_p , cqs2 = cqs2_p , & - cpm = cpm_p , znt = znt_p , ust = ust_p , & - pblh = hpbl_p , mavail = mavail_p , zol = zol_p , & - mol = mol_p , regime = regime_p , psim = psim_p , & - psih = psih_p , fm = fm_p , fh = fh_p , & - xland = xland_p , hfx = hfx_p , qfx = qfx_p , & - lh = lh_p , tsk = tsk_p , flhc = flhc_p , & - flqc = flqc_p , qgh = qgh_p , qsfc = qsfc_p , & - rmol = rmol_p , u10 = u10_p , v10 = v10_p , & - th2 = th2m_p , t2 = t2m_p , q2 = q2_p , & - gz1oz0 = gz1oz0_p , wspd = wspd_p , br = br_p , & - isfflx = isfflx , dx = dx_p , svp1 = svp1 , & - svp2 = svp2 , svp3 = svp3 , svpt0 = svpt0 , & - ep1 = ep_1 , ep2 = ep_2 , karman = karman , & - p1000mb = P0 , lakemask = lakemask_p , ustm = ustm_p , & - ck = ck_p , cka = cka_p , cd = cd_p , & - cda = cda_p , isftcflx = isftcflx , iz0tlnd = iz0tlnd , & - shalwater_z0 = shalwater_flag , water_depth = waterdepth_p , scm_force_flux = scm_force_flux , & - 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 & - ) - - if(config_frac_seaice) then - call sfclayrev( & - p3d = pres_hyd_p , psfc = psfc_p , t3d = t_p , & - u3d = u_p , v3d = v_p , qv3d = qv_p , & - dz8w = dz_p , cp = cp , g = gravity , & - rovcp = rcp , R = R_d , xlv = xlv , & - chs = chs_sea , chs2 = chs2_sea , cqs2 = cqs2_sea , & - cpm = cpm_sea , znt = znt_sea , ust = ust_sea , & - pblh = hpbl_p , mavail = mavail_sea , zol = zol_sea , & - mol = mol_sea , regime = regime_sea , psim = psim_sea , & - psih = psih_sea , fm = fm_sea , fh = fh_sea , & - xland = xland_sea , hfx = hfx_sea , qfx = qfx_sea , & - lh = lh_sea , tsk = tsk_sea , flhc = flhc_sea , & - flqc = flqc_sea , qgh = qgh_sea , qsfc = qsfc_sea , & - rmol = rmol_sea , u10 = u10_sea , v10 = v10_sea , & - th2 = th2m_sea , t2 = t2m_sea , q2 = q2_sea , & - gz1oz0 = gz1oz0_sea , wspd = wspd_sea , br = br_sea , & - isfflx = isfflx , dx = dx_p , svp1 = svp1 , & - svp2 = svp2 , svp3 = svp3 , svpt0 = svpt0 , & - ep1 = ep_1 , ep2 = ep_2 , karman = karman , & - p1000mb = P0 , lakemask = lakemask_p , ustm = ustm_sea , & - ck = ck_sea , cka = cka_sea , cd = cd_sea , & - cda = cda_sea , isftcflx = isftcflx , iz0tlnd = iz0tlnd , & - shalwater_z0 = shalwater_flag , water_depth = waterdepth_p , scm_force_flux = scm_force_flux , & - 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 & - ) - endif - call mpas_timer_stop('sf_monin_obukhov_rev') - - case("sf_mynn") - call mpas_timer_start('sf_mynn') - call sfclay_mynn( & - p3d = pres_hyd_p , pi3d = pi_p , psfcpa = psfc_p , & - th3d = th_p , t3d = t_p , u3d = u_p , & - v3d = v_p , qv3d = qv_p , qc3d = qc_p , & - rho3d = rho_p , dz8w = dz_p , cp = cp , & - g = gravity , rovcp = rcp , R = R_d , & - xlv = xlv , chs = chs_p , chs2 = chs2_p , & - cqs2 = cqs2_p , cpm = cpm_p , znt = znt_p , & - ust = ust_p , pblh = hpbl_p , mavail = mavail_p , & - zol = zol_p , mol = mol_p , regime = regime_p , & - psim = psim_p , psih = psih_p , xland = xland_p , & - hfx = hfx_p , qfx = qfx_p , lh = lh_p , & - tsk = tsk_p , flhc = flhc_p , flqc = flqc_p , & - qgh = qgh_p , qsfc = qsfc_p , rmol = rmol_p , & - u10 = u10_p , v10 = v10_p , th2 = th2m_p , & - t2 = t2m_p , q2 = q2_p , snowh = snowh_p , & - gz1oz0 = gz1oz0_p , wspd = wspd_p , br = br_p , & - isfflx = isfflx , dx = dx_p , svp1 = svp1 , & - svp2 = svp2 , svp3 = svp3 , svpt0 = svpt0 , & - ep1 = ep_1 , ep2 = ep_2 , karman = karman , & - ustm = ustm_p , ck = ck_p , cka = cka_p , & - cd = cd_p , cda = cda_p , ch = ch_p , & - qcg = qcg_p , spp_pbl = spp_pbl , isftcflx = isftcflx , & - iz0tlnd = iz0tlnd , itimestep = initflag , & - 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 & - ) - - if(config_frac_seaice) then - call sfclay_mynn( & - p3d = pres_hyd_p , pi3d = pi_p , psfcpa = psfc_p , & - th3d = th_p , t3d = t_p , u3d = u_p , & - v3d = v_p , qv3d = qv_p , qc3d = qc_p , & - rho3d = rho_p , dz8w = dz_p , cp = cp , & - g = gravity , rovcp = rcp , R = R_d , & - xlv = xlv , chs = chs_sea , chs2 = chs2_sea , & - cqs2 = cqs2_sea , cpm = cpm_sea , znt = znt_sea , & - ust = ust_sea , pblh = hpbl_p , mavail = mavail_sea , & - zol = zol_sea , mol = mol_sea , regime = regime_sea , & - psim = psim_sea , psih = psih_sea , xland = xland_sea , & - hfx = hfx_sea , qfx = qfx_sea , lh = lh_sea , & - tsk = tsk_sea , flhc = flhc_sea , flqc = flqc_sea , & - qgh = qgh_sea , qsfc = qsfc_sea , rmol = rmol_sea , & - u10 = u10_sea , v10 = v10_sea , th2 = th2m_sea , & - t2 = t2m_sea , q2 = q2_sea , snowh = snowh_p , & - gz1oz0 = gz1oz0_sea , wspd = wspd_sea , br = br_sea , & - isfflx = isfflx , dx = dx_p , svp1 = svp1 , & - svp2 = svp2 , svp3 = svp3 , svpt0 = svpt0 , & - ep1 = ep_1 , ep2 = ep_2 , karman = karman , & - ustm = ustm_sea , ck = ck_sea , cka = cka_sea , & - cd = cd_sea , cda = cda_sea , ch = ch_sea , & - qcg = qcg_p , spp_pbl = spp_pbl , isftcflx = isftcflx , & - iz0tlnd = iz0tlnd , itimestep = initflag , & - 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 & - ) - endif - call mpas_timer_stop('sf_mynn') - - case default - - end select sfclayer_select - -!copy local arrays to MPAS grid: - call sfclayer_to_MPAS(configs,sfc_input,diag_physics,its,ite) - -!call mpas_log_write('--- end subroutine driver_sfclayer.') - - end subroutine driver_sfclayer - -!================================================================================================================= - end module mpas_atmphys_driver_sfclayer -!================================================================================================================= From 1f7856c60e43dc3925276d35093ebe5d3779f4f8 Mon Sep 17 00:00:00 2001 From: Songyou Hong Date: Tue, 23 Dec 2025 12:54:30 -0700 Subject: [PATCH 18/19] Delete src/core_atmosphere/physics/mpas_atmphys_vars.F-org2 --- .../physics/mpas_atmphys_vars.F-org2 | 959 ------------------ 1 file changed, 959 deletions(-) delete mode 100644 src/core_atmosphere/physics/mpas_atmphys_vars.F-org2 diff --git a/src/core_atmosphere/physics/mpas_atmphys_vars.F-org2 b/src/core_atmosphere/physics/mpas_atmphys_vars.F-org2 deleted file mode 100644 index 084fc9f0e0..0000000000 --- a/src/core_atmosphere/physics/mpas_atmphys_vars.F-org2 +++ /dev/null @@ -1,959 +0,0 @@ -! Copyright (c) 2013, Los Alamos National Security, LLC (LANS) -! and the University Corporation for Atmospheric Research (UCAR). -! -! Unless noted otherwise source code is licensed under the BSD license. -! Additional copyright and license information can be found in the LICENSE file -! distributed with this code, or at http://mpas-dev.github.com/license.html -! -!================================================================================================================= - module mpas_atmphys_vars - use mpas_kind_types - - use NoahmpIOVarType - - implicit none - public - save - - -!mpas_atmphys_vars contains all local variables and arrays used in the physics parameterizations. -!Laura D. Fowler (send comments to laura@ucar.edu). -!2013-05-01. -! -! add-ons and modifications: -! -------------------------- -! * added the variables sf_surface_physics,alswvisdir_p,alswvisdif_p,alswnirdir_p,alswnirdif_p,swvisdir_p, -! swvisdif_p,swnirdir_p,and swnirdif_p to upgrade the RRTMG short wave radiation code to WRF version 3.4.1. -! see definition of each individual variables below. -! Laura D. Fowler (laura@ucar.edu) / 2013-03-11. -! * removed call to the updated Kain-Fritsch convection scheme. -! Laura D. Fowler (laura@ucar.edu) / 2013-05-29. -! * added the arrays o3clim_p for implementation of monthly-varying climatological ozone in the -! long wave and short wave RRTMG radiation codes. -! Laura D. Fowler (laura@ucar.edu) / 2013-07-08. -! * corrected definition of local variable dx_p. -! Laura D. Fowler (laura@ucar.edu) / 2013-08-23. -! * renamed local variable conv_deep_scheme to convection_scheme. -! Laura D. Fowler (laura@ucar.edu) / 2014-09-18. -! * added empty subroutine atmphys_vars_init that does not do anything, but needed for -! compiling MPAS with some compilers. -! Laura D. Fowler (laura@ucar.edu) / 2015-01-12. -! * added local variables needed for the Thompson parameterization of cloud microphysics. -! Laura D. Fowler (laura@ucar.edu) / 2016-03-28. -! * added local variables needed for the Grell-Freitas parameterization of deep and shallow convection. -! * Laura D. Fowler (laura@ucar.edu) / 2016-03-30. -! * added local arrays needed in the MYNN surface layer scheme and PBL scheme. -! Laura D. Fowler (laura@ucar.edu) / 2016-03-31. -! * added the logical ua_phys needed in the call to subroutine sfcdiags. ua_phys is set to false. -! Laura D. Fowler (laura@ucar.edu) / 2016-05-13. -! * added the integers has_reqc,has_reqi,and has_reqs. when initialized to zero, the effective radii for cloud -! water,cloud ice,and snow are calculated using the subroutines relcalc and ricalc in subroutines rrtmg_lwrad -! and rrtmg_swrad. when initialized to 1, the effective radii are calculated in the Thompson cloud microphysics -! scheme instead. has_reqc,has_reqi,and has_reqs are initialized depending on the logical config_microp_re. -! Laura D. Fowler (laura@ucar.edu) / 2016-07-08. -! * added diagnostics of the effective radii for cloud water, cloud ice, and snow used in rrtmg_lwrad. -! Laura D. Fowler (laura@ucar.edu) / 2016-07-08. -! * added the variables qvrad_p,qcrad_p,qirad_p, and qsrad_p which are the water vapor,cloud water,cloud ice, -! and snow mixing ratios local to the calculation of the cloud fraction, and used in the radiation codes. -! Laura D. Fowler (laura@ucar.edu) / 2016-07-08. -! * added the variables rqvften and rthften which are the forcing tendencies needed to run the "new" Tiedtke -! parameterization of convection. -! Laura D. Fowler (laura@ucar.edu) / 2016-09-20. -! * added local "_sea" arrays that are needed in the surface layer scheme and land surface scheme for handling -! grid cells with fractional seaice when config_frac_seaice is set to true. also added local tsk_ice variable -! needed in the land surface scheme for handling grid cells with fractional seaice when config_frac_seaice is -! set to true. -! Laura D. Fowler (laura@ucar.edu) / 2016-10-03. -! * added local variable regime_hold to save the original value of variable regime over seaice grid cells when -! config_frac_seaice is set to true. -! Laura D. Fowler (laura@ucar.edu) / 2016-10-21. -! * moved the declarations of arrays delta_p,wstar_p,uoce_p,and voce_p since they are now used in both modules -! module_bl_ysu.F and module_bl_mynn.F. -! Laura D. Fowler (laura@ucar.edu) / 2016-10-27. -! * added the variable opt_thcnd (option to treat thermal conductivity in NoahLSM). added additional options and -! arrays to run the Noah LSM scheme from WRF version 3.9.0. -! Laura D. Fowler (laura@ucar.edu) / 2017-01-27. -! * removed the initialization local variable gwdo_scheme. gwdo_scheme is no longer needed and can be replaced -! with config_gwdo_scheme. -! Laura D. Fowler (laura@ucar.edu) / 2017-02-16. -! * removed the initialization local variable lsm_scheme. lsm_scheme is no longer needed and can be replaced -! with config_lsm_scheme. -! Laura D. Fowler (laura@ucar.edu) / 2017-02-16. -! * removed the initialization local variable sfclayer_scheme. sfclayer_scheme is no longer needed and can be -! replaced with config_sfclayer_scheme. -! Laura D. Fowler (laura@ucar.edu) / 2017-02-16. -! * removed the initialization local variable pbl_scheme. pbl_scheme is no longer needed and can be replaced -! replaced with config_pbl_scheme. -! Laura D. Fowler (laura@ucar.edu) / 2017-02-16. -! * removed the initialization local variable radt_cld_scheme. radt_cld_scheme is no longer needed and can be -! replaced replaced with config_radt_cld_scheme. -! Laura D. Fowler (laura@ucar.edu) / 2017-02-16. -! * removed the initialization local variable radt_lw_scheme. radt_lw_scheme is no longer needed and can be -! replaced replaced with config_radt_lw_scheme. -! Laura D. Fowler (laura@ucar.edu) / 2017-02-16. -! * removed the initialization local variable radt_sw_scheme. radt_sw_scheme is no longer needed and can be -! replaced replaced with config_radt_sw_scheme. -! Laura D. Fowler (laura@ucar.edu) / 2017-02-16. -! * removed the initialization local variable convection_scheme. convection_scheme is no longer needed and can be -! replaced replaced with config_convection_scheme. -! Laura D. Fowler (laura@ucar.edu) / 2017-02-16. -! * removed the initialization local variable microp_scheme. microp_scheme is no longer needed and can be -! replaced replaced with config_microp_scheme. -! Laura D. Fowler (laura@ucar.edu) / 2017-02-16. -! * add variables and arrays needed to the parameterization of seaice in the updated Noah land surface scheme. -! Laura D. Fowler (laura@ucar.edu) / 2017-02-19. -! * changed the option seaice_albedo_opt from 0 to 2 so that we can initialize the surface albedo over seaice -! cells using the surface background albedo (see initialization of sfc_albedo_seaice in subroutine -! landuse_init_forMPAS). -! Laura D. Fowler (laura@ucar.edu) / 2017-03-02. -! * added local variables for the mass-weighted mean velocities for rain, cloud ice, snow, and graupel from the -! Thompson cloud microphysics scheme. -! Laura D. Fowler (laura@ucar.edu) / 2017-04-19. -! * added the local variables cosa_p and sina_p needed in call to subroutine gwdo after updating module_bl_gwdo.F -! to that of WRF version 4.0.2. -! Laura D. Fowler (laura@ucar.edu) / 2019-01-30. -! * reverted the option seaice_albedo_opt = 2 to seaic_albedo_opt = 0 since MPAS does not currently support the -! input of "observed" 2D seaice albedos. In conjunction with this update, we also change the initialization of -! albsi from albbck to seaice_albedo_default. -! Laura D. Fowler (laura@ucar.edu) / 2022-05-10. -! * added the local parameters flag_bep and idiff in the call to subroutine ysu to update the YSU PBL scheme to -! that of WRF version 4.4.1. -! * added local flags and variables needed to initialize and run the revised version of the MONIN-OBUKHOV surface -! layer scheme from the WRF version 4.4.1. -! Laura D. Fowler (laura@ucar.edu) / 2023-05-15. -! * added the local variables swddir,swddni,and swddif which are output to subroutine rrtmg_swrad and now input -! to the updated module_sf_noahdrv.F. -! Laura D. Fowler (laura@ucar.edu) / 2023-04-21. -! * removed the variable f_qv which is not used in any of the ./physics_wrf modules. -! Laura D. Fowler (laura@ucar.edu) / 2024-02-13. -! * removed the definition of f_qc,f_qr,f_qi,f_qs,f_qg,f_nc,and f_ni as parameters. these variables are now -! initialized in mpas_atmphys_init.F (see subroutine init_physics_flags). also renamed f_qnc to f_nc, and f_qni -! to f_ni. -! Laura D. Fowler (laura@ucar.edu) / 2024-02-14. -! * added the variable spp_pbl needed in the updated version of the MYNN surface layer scheme. -! Laura D. Fowler (laura@ucar.edu) / 2024-02-14. -! * added and modified variables needed to run the MYNN PBL scheme using the sourcecode from WRF version 4.6. -! Laura D. Fowler (laura@ucar.edu) / 2024-02-18. - - -!================================================================================================================= -!wrf-variables:these variables are needed to keep calls to different physics parameterizations -!as in wrf model. -!================================================================================================================= - - logical:: l_radtlw !controls call to longwave radiation parameterization. - logical:: l_radtsw !controls call to shortwave radiation parameterization. - logical:: l_conv !controls call to convective parameterization. - logical:: l_camlw !controls when to save local CAM LW abs and ems arrays. - logical:: l_diags !controls when to calculate physics diagnostics. - logical:: l_acrain !when .true., limit to accumulated rain is applied. - logical:: l_acradt !when .true., limit to lw and sw radiation is applied. - logical:: l_mp_tables !when .true., read look-up tables for Thompson cloud microphysics scheme. - - integer,public:: ids,ide,jds,jde,kds,kde - integer,public:: ims,ime,jms,jme,kms,kme - integer,public:: its,ite,jts,jte,kts,kte - integer,public:: iall - integer,public:: n_microp - - integer,public:: num_months !number of months [-] - - real(kind=RKIND),public:: dt_dyn !time-step for dynamics - real(kind=RKIND),public:: dt_microp !time-step for cloud microphysics parameterization. - real(kind=RKIND),public:: dt_radtlw !time-step for longwave radiation parameterization [mns] - real(kind=RKIND),public:: dt_radtsw !time-step for shortwave radiation parameterization [mns] - - real(kind=RKIND),public:: xice_threshold - - real(kind=RKIND),dimension(:,:),allocatable:: & - area_p !grid cell area [m2] - -!... arrays related to surface: - real(kind=RKIND),dimension(:,:),allocatable:: & - ht_p, &! - psfc_p, &!surface pressure [Pa] - ptop_p !model-top pressure [Pa] - - real(kind=RKIND),dimension(:,:,:),allocatable:: & - fzm_p, &!weight for interpolation to w points [-] - fzp_p !weight for interpolation to w points [-] - - real(kind=RKIND),dimension(:,:,:),allocatable:: & -!... arrays related to u- and v-velocities interpolated to theta points: - u_p, &!u-velocity interpolated to theta points [m/s] - v_p !v-velocity interpolated to theta points [m/s] - -!... arrays related to vertical sounding: - real(kind=RKIND),dimension(:,:,:),allocatable:: & - zz_p, &! - pres_p, &!pressure [Pa] - pi_p, &!(p_phy/p0)**(r_d/cp) [-] - z_p, &!height of layer [m] - zmid_p, &!height of middle of layer [m] - dz_p, &!layer thickness [m] - t_p, &!temperature [K] - th_p, &!potential temperature [K] - al_p, &!inverse of air density [m3/kg] - rho_p, &!air density [kg/m3] - rh_p !relative humidity [-] - - real(kind=RKIND),dimension(:,:,:),allocatable:: & - qv_p, &!water vapor mixing ratio [kg/kg] - qc_p, &!cloud water mixing ratio [kg/kg] - qr_p, &!rain mixing ratio [kg/kg] - qi_p, &!cloud ice mixing ratio [kg/kg] - qs_p, &!snow mixing ratio [kg/kg] - qg_p !graupel mixing ratio [kg/kg] - - real(kind=RKIND),dimension(:,:,:),allocatable:: & - nc_p, &!cloud water droplet number concentration [#/kg] - ni_p, &!cloud ice crystal number concentration [#/kg] - nr_p !rain drop number concentration [#/kg] - -!... arrays located at w (vertical velocity) points, or at interface between layers: - real(kind=RKIND),dimension(:,:,:),allocatable:: & - w_p, &!vertical velocity [m/s] - pres2_p, &!pressure [Pa] - t2_p !temperature [K] - -!... arrays used for calculating the hydrostatic pressure and exner function: - real(kind=RKIND),dimension(:,:),allocatable:: & - psfc_hyd_p, &!surface pressure [Pa] - psfc_hydd_p !"dry" surface pressure [Pa] - real(kind=RKIND),dimension(:,:,:),allocatable:: & - pres_hyd_p, &!pressure located at theta levels [Pa] - pres_hydd_p, &!"dry" pressure located at theta levels [Pa] - pres2_hyd_p, &!pressure located at w-velocity levels [Pa] - pres2_hydd_p, &!"dry" pressure located at w-velocity levels [Pa] - znu_hyd_p !(pres_hyd_p / P0) needed in the Tiedtke convection scheme [Pa] - -!================================================================================================================= -!... variables related to ozone climatlogy: -!================================================================================================================= - - real(kind=RKIND),dimension(:,:,:),allocatable:: & - o3clim_p !climatological ozone volume mixing ratio [???] - -!================================================================================================================= -!... variables and arrays related to parameterization of cloud microphysics: -! warm_phase: logical that determines if we want to run warm-phase cloud microphysics only. -! If set to false, cold-phase cloud microphysics is active. In MPAS, we always assume -! that the ice phase is included (except for the Kessler scheme which includes water -! clouds only. - -!================================================================================================================= - - logical,parameter:: & - warm_rain = .false.!warm-phase cloud microphysics only (used in WRF). - - logical:: & - f_qc, &!parameter set to true to include the cloud water mixing ratio. - f_qr, &!parameter set to true to include the rain mixing ratio. - f_qi, &!parameter set to true to include the cloud ice mixing ratio. - f_qs, &!parameter set to true to include the snow mixing ratio. - f_qg, &!parameter set to true to include the graupel mixing ratio. - f_qoz !parameter set to true to include the ozone mixing ratio. - - logical:: & - f_nc, &!parameter set to true to include the cloud water number concentration. - f_ni, &!parameter set to true to include the cloud ice number concentration. - f_nifa, &!parameter set to true to include the number concentration of hygroscopic aerosols. - f_nwfa, &!parameter set to true to include the number concentration of hydrophobic aerosols. - f_nbca !parameter set to true to include the number concentration of black carbon. - - real(kind=RKIND),dimension(:,:,:),allocatable:: & - f_ice, &!fraction of cloud ice (used in WRF only). - f_rain !fraction of rain (used in WRF only). - - real(kind=RKIND),dimension(:,:),allocatable:: & - rainnc_p, &! - rainncv_p, &! - snownc_p, &! - snowncv_p, &! - graupelnc_p, &! - graupelncv_p, &! - sr_p - - integer:: & - has_reqc, &! - has_reqi, &! - has_reqs - - real(kind=RKIND),dimension(:,:,:),allocatable:: & - rainprod_p, &! - evapprod_p, &! - recloud_p, &! - reice_p, &! - resnow_p ! - -!... for Thompson cloud microphysics parameterization, including aerosol-aware option: - real(kind=RKIND),dimension(:,:),allocatable:: & - ntc_p, &! - muc_p, &! - nifa2d_p, &!surface emission of "ice-friendly" aerosols [#/kg-1/s] - nwfa2d_p !surface emission of "water-friendly" aerosols [#/kg-1/s] - - real(kind=RKIND),dimension(:,:,:),allocatable:: & - nifa_p, &!"ice-friendly" number concentration [#/kg] - nwfa_p !"water-friendly" number concentration [#/kg] - -!================================================================================================================= -!... variables and arrays related to parameterization of convection: -!================================================================================================================= - integer,public:: n_cu - real(kind=RKIND),public:: dt_cu - - logical,dimension(:,:),allocatable:: & - cu_act_flag - real(kind=RKIND),dimension(:,:),allocatable:: & - rainc_p, &! - raincv_p, &! - pratec_p ! - - real(kind=RKIND),dimension(:,:,:),allocatable:: & - rthcuten_p, &! - rqvcuten_p, &! - rqccuten_p, &! - rqicuten_p ! - -!... kain fritsch specific arrays: - real(kind=RKIND),dimension(:,:),allocatable:: & - cubot_p, &!lowest convective level [-] - cutop_p, &!highest convective level [-] - nca_p !counter for cloud relaxation time [-] - real(kind=RKIND),dimension(:,:,:),allocatable:: & - w0avg_p ! - - real(kind=RKIND),dimension(:,:,:),allocatable:: & - rqrcuten_p, &! - rqscuten_p ! - -!... tiedtke specific arrays: - real(kind=RKIND),dimension(:,:,:),allocatable:: & - znu_p ! - - real(kind=RKIND),dimension(:,:,:),allocatable:: & - rucuten_p, &! - rvcuten_p ! - -!... grell-freitas specific parameters and arrays: - integer, parameter:: ishallow = 1 !shallow convection used with grell scheme. - - integer,dimension(:,:),allocatable:: & - k22_shallow_p, &! - kbcon_shallow_p, &! - ktop_shallow_p, &! - kbot_shallow_p, &! - ktop_deep_p ! - - real(kind=RKIND),dimension(:,:),allocatable:: & - xmb_total_p, &! - xmb_shallow_p ! - - real(kind=RKIND),dimension(:,:,:),allocatable:: & - rthdynten_p, &! - qccu_p, &! - qicu_p ! - - real(kind=RKIND),dimension(:,:,:),allocatable:: & - rthraten_p ! - -!... grell and tiedkte specific arrays: - real(kind=RKIND),dimension(:,:,:),allocatable:: & - rqvdynten_p, &! - rqvdynblten_p, &! - rthdynblten_p ! - -!... ntiedtke specific arrays: - real(kind=RKIND),dimension(:,:,:),allocatable:: & - rqvften_p, &! - rthften_p ! - -!================================================================================================================= -!... variables and arrays related to parameterization of pbl: -!================================================================================================================= - - logical,parameter:: & - flag_bep = .false. !flag to use BEP/BEP+BEM for use in the YSU PBL scheme (with urban physics). since we do - !not run urban physics, flag_bep is always set to false. - - integer,parameter:: & - idiff = 0 !BEP/BEM+BEM diffusion flag for use in the YSU PBL scheme (with urban physics). since we - !do not run urban physics, idiff is set to zero. - - integer:: ysu_pblmix - - integer,dimension(:,:),allocatable:: & - kpbl_p !index of PBL top [-] - - real(kind=RKIND),public:: dt_pbl - - real(kind=RKIND),dimension(:,:),allocatable:: & - ctopo_p, &!correction to topography [-] - ctopo2_p, &!correction to topography 2 [-] - hpbl_p, &!PBL height [m] - delta_p, &! - wstar_p, &! - uoce_p, &! - voce_p ! - - real(kind=RKIND),dimension(:,:,:),allocatable:: & - exch_p !exchange coefficient [-] - - real(kind=RKIND),dimension(:,:,:),allocatable:: & - rublten_p, &!tendency of zonal wind due to PBL processes. - rvblten_p, &!tendency of meridional wind due to PBL processes. - rthblten_p, &!tendency of potential temperature due to PBL processes. - rqvblten_p, &!tendency of water vapor mixing ratio due to PBL processes. - rqcblten_p, &!tendency of cloud water mixing ratio due to PBL processes. - rqiblten_p !tendency of cloud ice mixing ratio due to PBL processes. - - real(kind=RKIND),dimension(:,:,:),allocatable:: & - kzh_p, &! - kzm_p, &! - kzq_p ! - -!... MYNN PBL scheme (module_bl_mynn.F): - integer,parameter:: spp_pbl = 0 !generate array with random perturbations (0=off,1=on). - integer,parameter:: icloud_bl = 0 !no coupling of subgrid-scale clouds with radiation. - - integer,dimension(:,:),allocatable:: & - kbl_plume_p !level of highest penetrating plume. - - real(kind=RKIND),dimension(:,:),allocatable:: & - maxwidthbl_p, &!max plume width [m] - maxmfbl_p, &!maximum mass flux for PBL shallow convection. - zbl_plume_p !height of highest penetrating plume [m] - - real(kind=RKIND),dimension(:,:,:),allocatable:: & - dqke_p, &! - qbuoy_p, &! - qdiss_p, &! - qke_p, &! - qkeadv_p, &! - qshear_p, &! - qwt_p, &! - tkepbl_p ! - - real(kind=RKIND),dimension(:,:,:),allocatable:: & - edmfa_p, &! - edmfw_p, &! - edmfqt_p, &! - edmfthl_p, &! - edmfent_p, &! - edmfqc_p, &! - subthl_p, &! - subqv_p, &! - detthl_p, &! - detqv_p, &! - qcbl_p, &! - qibl_p, &! - cldfrabl_p ! - - real(kind=RKIND),dimension(:,:,:),allocatable:: & - rqsblten_p, &!tendency of snow mixing ratio due to PBL processes. - rncblten_p, &!tendency of cloud liquid water number concentration due to PBL processes. - rniblten_p, &!tendency of cloud ice number concentration due to PBL processes. - rnifablten_p, &!tendency of ice-friendly aerosol number concentration due to PBL processes. - rnwfablten_p !tendency of water-friendly aerosol number concentration due to PBL processes. - - real(kind=RKIND),dimension(:,:,:),allocatable:: & - pattern_spp_pbl !stochastic forcing for the MYMM PBL and surface layer schemes. - -!================================================================================================================= -!... variables and arrays related to parameterization of gravity wave drag over orography: -!================================================================================================================= - - real(kind=RKIND),dimension(:,:),allocatable:: & - cosa_p, &!cosine of map rotation [-] - sina_p !sine of map rotation [-] - - real(kind=RKIND),dimension(:,:),allocatable:: & - ter_p, &!orographic height [m] - var2d_p, &!orographic variance [m2] - elvmax_p, &!orographic maximum [m] - con_p, &!orographic convexity [m2] - oa1_p, &!orographic direction asymmetry function [-] - oa2_p, &!orographic direction asymmetry function [-] - oa3_p, &!orographic direction asymmetry function [-] - oa4_p, &!orographic direction asymmetry function [-] - ol1_p, &!orographic direction asymmetry function [-] - ol2_p, &!orographic direction asymmetry function [-] - ol3_p, &!orographic direction asymmetry function [-] - ol4_p !orographic direction asymmetry function [-] - - real(kind=RKIND),dimension(:,:),allocatable:: & - dx_p !mean distance between cell centers [m] - - real(kind=RKIND),dimension(:,:),allocatable:: & - dusfcg_p, &!vertically-integrated gwdo u-stress [Pa m s-1] - dvsfcg_p !vertically-integrated gwdo v -stress [Pa m s-1] - - real(kind=RKIND),dimension(:,:,:),allocatable:: & - dtaux3d_p, &!gravity wave drag over orography u-stress [m s-1] - dtauy3d_p !gravity wave drag over orography u-stress [m s-1] - -!... variables for UGWP orographic gravity wave drag: - - real(kind=RKIND),dimension(:,:),allocatable:: & - var2dls_p, &!orographic variance (meso-scale orographic variation) [m] - conls_p, &!orographic convexity (meso-scale orographic variation) [-] - oa1ls_p, &!orographic direction asymmetry function (meso-scale orographic variation) [-] - oa2ls_p, &!orographic direction asymmetry function (meso-scale orographic variation) [-] - oa3ls_p, &!orographic direction asymmetry function (meso-scale orographic variation) [-] - oa4ls_p, &!orographic direction asymmetry function (meso-scale orographic variation) [-] - ol1ls_p, &!orographic direction asymmetry function (meso-scale orographic variation) [-] - ol2ls_p, &!orographic direction asymmetry function (meso-scale orographic variation) [-] - ol3ls_p, &!orographic direction asymmetry function (meso-scale orographic variation) [-] - ol4ls_p, &!orographic direction asymmetry function (meso-scale orographic variation) [-] - var2dss_p, &!orographic variance (small-scale orographic variation) [m] - conss_p, &!orographic convexity (small-scale orographic variation) [-] - oa1ss_p, &!orographic direction asymmetry function (small-scale orographic variation) [-] - oa2ss_p, &!orographic direction asymmetry function (small-scale orographic variation) [-] - oa3ss_p, &!orographic direction asymmetry function (small-scale orographic variation) [-] - oa4ss_p, &!orographic direction asymmetry function (small-scale orographic variation) [-] - ol1ss_p, &!orographic direction asymmetry function (small-scale orographic variation) [-] - ol2ss_p, &!orographic direction asymmetry function (small-scale orographic variation) [-] - ol3ss_p, &!orographic direction asymmetry function (small-scale orographic variation) [-] - ol4ss_p !orographic direction asymmetry function (small-scale orographic variation) [-] - - real(kind=RKIND),dimension(:,:),allocatable:: & - dusfc_ls_p, &!vertically-integrated mesoscale orog gravity wave drag u-stress [Pa] - dvsfc_ls_p, &!vertically-integrated mesoscale orog gravity wave drag v-stress [Pa] - dusfc_bl_p, &!vertically-integrated orog blocking drag u-stress [Pa] - dvsfc_bl_p, &!vertically-integrated orog blocking drag v-stress [Pa] - dusfc_ss_p, &!vertically-integrated small-scale orog gravity wave drag u-stres [Pa] - dvsfc_ss_p, &!vertically-integrated small-scale orog gravity wave drag v-stres [Pa] - dusfc_fd_p, &!vertically-integrated turb orog form drag u-stress [Pa] - dvsfc_fd_p !vertically-integrated turb orog form drag v-stress [Pa] - - real(kind=RKIND),dimension(:,:,:),allocatable:: & - dtaux3d_ls_p, &!mesoscale orog gravity wave drag u-tendency [m s-2] - dtauy3d_ls_p, &!mesoscale orog gravity wave drag v-tendency [m s-2] - dtaux3d_bl_p, &!orog blocking drag u-tendency u-tendency [m s-2] - dtauy3d_bl_p, &!orog blocking drag u-tendency v-tendency [m s-2] - dtaux3d_ss_p, &!small-scale orog gravity wave drag u-tendency [m s-2] - dtauy3d_ss_p, &!small-scale orog gravity wave drag v-tendency [m s-2] - dtaux3d_fd_p, &!turb orog form drag u-tendency [m s-2] - dtauy3d_fd_p !turb orog form drag u-tendency [m s-2] - -!... variables for UGWP non-stationary gravity wave (NGW) drag: - - integer,dimension(:,:),allocatable:: & - jindx1_tau_p, &!lower latitude index of NGW momentum flux for interpolation [-] - jindx2_tau_p !upper latitude index of NGW momentum flux for interpolation [-] - - real(kind=RKIND),dimension(:,:),allocatable:: & - ddy_j1tau_p, &!latitude interpolation weight complement for NGW momentum flux [-] - ddy_j2tau_p !latitude interpolation weight for NGW momentum flux [-] - - real(kind=RKIND),dimension(:,:,:),allocatable:: & - dudt_ngw_p, &!u-momentum tendency due to non-stationary gravity wave drag [m s-2] - dvdt_ngw_p, &!v-momentum tendency due to non-stationary gravity wave drag [m s-2] - dtdt_ngw_p !temperature tendency due to non-stationary gravity wave drag [K s-1] - -!================================================================================================================= -!... variables and arrays related to parameterization of surface layer: -!================================================================================================================= - - real(kind=RKIND),dimension(:,:),allocatable:: & - br_p, &!bulk richardson number [-] - cd_p, &!momentum exchange coeff at 10 meters [?] - cda_p, &!momentum exchange coeff at the lowest model level [?] - cpm_p, &! - chs_p, &! - chs2_p, &! - ck_p, &!enthalpy exchange coeff at 10 meters [?] - cka_p, &!enthalpy exchange coeff at the lowest model level [?] - cqs2_p, &! - gz1oz0_p, &!log of z1 over z0 [-] - flhc_p, &!exchange coefficient for heat [-] - flqc_p, &!exchange coefficient for moisture [-] - hfx_p, &!upward heat flux at the surface [W/m2] - lh_p, &!latent heat flux at the surface [W/m2] - mavail_p, &!surface moisture availability [-] - mol_p, &!T* in similarity theory [K] - pblh_p, &!PBL height [m] - psih_p, &!similarity theory for heat [-] - psim_p, &!similarity theory for momentum [-] - q2_p, &!specific humidity at 2m [kg/kg] - qfx_p, &!upward moisture flux at the surface [kg/m2/s] - qgh_p, &! - qsfc_p, &!specific humidity at lower boundary [kg/kg] - regime_p, &!flag indicating PBL regime (stable_p,unstable_p,etc...) [-] - rmol_p, &!1 / Monin Ob length [-] - t2m_p, &!temperature at 2m [K] - th2m_p, &!potential temperature at 2m [K] - u10_p, &!u at 10 m [m/s] - ust_p, &!u* in similarity theory [m/s] - ustm_p, &!u* in similarity theory without vconv correction [m/s] - v10_p, &!v at 10 m [m/s] - wspd_p, &!wind speed [m/s] - znt_p, &!time-varying roughness length [m] - zol_p ! - -!... arrays only in monin_obukohv (module_sf_sfclay.F): - real(kind=RKIND),dimension(:,:),allocatable:: & - fh_p, &!integrated stability function for heat [-] - fm_p !integrated stability function for momentum [-] - -!... variables and arrays only in the revised version of monin_obukhov (module_sf_sfclayrev.F) to include the -! shallow water roughness scheme: - integer,parameter:: & - bathymetry_flag = 0!this flag is set to 1 if input bathymetry data is available (this option is not available - !in MPAS and therefore set to 0 by default. - integer,parameter:: & - shalwater_flag = 0!this flag is set to 1 to run the shallow water roughness scheme (this option is not - !available in MPAS and therefore set to 0 by default. - integer,parameter:: & - lakemodel_flag = 0!this flag is set to 1 to run the lake model physics (this option is not available in MPAS - !and therefore set to 0 by default. - - real(kind=RKIND),parameter:: & - shalwater_depth = 0!constant shallow water depth needed to run the shallow water roughness scheme. - - real(kind=RKIND),dimension(:,:),allocatable:: & - waterdepth_p, &!depth of water needed to run the shallow water roughness scheme. - lakedepth_p, &!depth of lakes needed to run the lake model physics. - lakemask_p !mask needed to detect the location of lakes to run the lake model physics. - -!... arrays only in mynn surface layer scheme (module_sf_mynn.F): - real(kind=RKIND),dimension(:,:),allocatable:: & - ch_p, &!surface exchange coeff for heat [m/s] - qcg_p !cloud water mixing ratio at the ground surface [kg/kg] - - real(kind=RKIND),dimension(:,:,:),allocatable:: & - cov_p, &!liquid water-liquid water potential temperature covariance [K kg/kg] - qsq_p, &!liquid water variance [(kg/kg)^2] - tsq_p, &!liquid water potential temperature variance [K^2] - sh3d_p, &!stability function for heat [-] - sm3d_p, &!stability function for moisture [-] - elpbl_p !length scale from PBL [m] - -!================================================================================================================= -!... variables and arrays related to parameterization of seaice: -!... the options set for seaice_albedo_opt, seaice_thickness_opt, and seaicesnowdepth_opt must not be changed -! since they are the only ones currently available. -!================================================================================================================= - - integer,parameter:: & - seaice_albedo_opt = 0 !option to set albedo over sea ice. - !0 = seaice albedo is constant set in seaice_albedo_default. - !1 = seaice albedo is f(Tair,Tskin,Tsnow), following Mill (2011). - !2 = seaice albedo is read in from input variable albsi. - integer,parameter:: & - seaice_thickness_opt = 0 !option for treating seaice thickness. - !0 = seaice thickness is constant set in seaice_thickness_default. - !1 = seaice_thickness is read in from input variable icedepth. - integer,parameter:: & - seaice_snowdepth_opt = 0 !option for treating snow depth on sea ice. - !0=snow depth is bounded by seaice_snowdepth_min and seaice_snowdepth_max. - - real(kind=RKIND),parameter:: & - seaice_albedo_default = 0.65 ,&!default value of seaice albedo for seaice_albedo_opt=0. - seaice_thickness_default = 3.0, &!default value of seaice thickness for seaice_thickness_opt=0 - seaice_snowdepth_max = 1.e10,&!maximum allowed accumulation of snow (m) on sea ice. - seaice_snowdepth_min = 0.001 !minimum snow depth (m) on sea ice. - - real(kind=RKIND),dimension(:,:),allocatable:: & - albsi_p, &!surface albedo over seaice [-] - snowsi_p, &!snow depth over seaice [m] - icedepth_p !seaice thickness [m] - -!================================================================================================================= -!... variables and arrays related to the calculation of the optical properties of aerosols: to date, the only kind -! of aerosols included in MPAS are the "water-friendly" and "ice-friendly" aerosols used in the Thompson cloud -! cloud microphysics scheme. -!================================================================================================================= - - integer,parameter:: taer_aod550_opt = 2!input option for nwfa, nifa optical depth at 500 nm. - integer,parameter:: taer_angexp_opt = 3!input option for nwfa, nifa aerosol Angstrom exponent. - integer,parameter:: taer_ssa_opt = 3!input option for nwfa, nifa aerosol single-scattering albedo. - integer,parameter:: taer_asy_opt = 3!input option for nwfa, nifa aerosol asymmetry factor. - - integer:: aer_opt !=[0,3] : 0 for no aerosols, 3 for "water-" and "ice-friendly" aerosols. - integer,dimension(:,:),allocatable:: & - taer_type_p !=[1,2,3]: 1 for rural, 2 is urban and 3 is maritime in WRF. In MPAS, - !aer_type is initialized as a function of landmask (=1 over land; =2 over - !oceans. - - real(kind=RKIND),parameter:: aer_aod550_val = 0.12 - real(kind=RKIND),parameter:: aer_angexp_val = 1.3 - real(kind=RKIND),parameter:: aer_ssa_val = 0.85 - real(kind=RKIND),parameter:: aer_asy_val = 0.9 - - real(kind=RKIND),dimension(:,:),allocatable :: taod5502d_p!total aerosol optical depth at 550 nm [-] - real(kind=RKIND),dimension(:,:,:),allocatable:: taod5503d_p!aerosol optical depth at 550 nm [-] - - real(kind=RKIND),dimension(:,:,:,:),allocatable:: tauaer_p !aerosol optical depth in RRTMG SW [-] - real(kind=RKIND),dimension(:,:,:,:),allocatable:: ssaaer_p !aerosol single scatterin albedo in RRTMG SW [-] - real(kind=RKIND),dimension(:,:,:,:),allocatable:: asyaer_p !aerosol asymmetry factor in RRTMG SW [-] - -!================================================================================================================= -!... variables and arrays related to parameterization of short-wave radiation: -!================================================================================================================= - - real(kind=RKIND):: & - declin, &!solar declination [-] - solcon !solar constant [W m-2] - - real(kind=RKIND),dimension(:,:),allocatable:: & - coszr_p, &!cosine of the solar zenith angle [-] - gsw_p, &!net shortwave flux at surface [W m-2] - swcf_p, &!shortwave cloud forcing at top-of-atmosphere [W m-2] - swdnb_p, &!all-sky downwelling shortwave flux at bottom-of-atmosphere [J m-2] - swdnbc_p, &!clear-sky downwelling shortwave flux at bottom-of-atmosphere [J m-2] - swdnt_p, &!all-sky downwelling shortwave flux at top-of-atmosphere [J m-2] - swdntc_p, &!clear-sky downwelling shortwave flux at top-of-atmosphere [J m-2] - swupb_p, &!all-sky upwelling shortwave flux at bottom-of-atmosphere [J m-2] - swupbc_p, &!clear-sky upwelling shortwave flux at bottom-of-atmosphere [J m-2] - swupt_p, &!all-sky upwelling shortwave flux at top-of-atmosphere [J m-2] - swuptc_p !clear-sky upwelling shortwave flux at top-of-atmosphere [J m-2] - - real(kind=RKIND),dimension(:,:),allocatable:: & - swvisdir_p, &!visible direct downward flux [W m-2] - swvisdif_p, &!visible diffuse downward flux [W m-2] - swnirdir_p, &!near-IR direct downward flux [W m-2] - swnirdif_p !near-IR diffuse downward flux [W m-2] - - real(kind=RKIND),dimension(:,:),allocatable:: & - swddir_p, &! - swddni_p, &! - swddif_p ! - - real(kind=RKIND),dimension(:,:,:),allocatable:: & - swdnflx_p, &! - swdnflxc_p, &! - swupflx_p, &! - swupflxc_p ! - - real(kind=RKIND),dimension(:,:,:),allocatable:: & - rthratensw_p !uncoupled theta tendency due to shortwave radiation [K s-1] - -!================================================================================================================= -!... variables and arrays related to parameterization of long-wave radiation: -!================================================================================================================= - - integer,dimension(:,:),allocatable:: & - nlrad_p !number of layers added above the model top [-] - real(kind=RKIND),dimension(:,:),allocatable:: & - plrad_p !pressure at model_top [Pa] - - real(kind=RKIND),dimension(:,:),allocatable:: & - glw_p, &!net longwave flux at surface [W m-2] - lwcf_p, &!longwave cloud forcing at top-of-atmosphere [W m-2] - lwdnb_p, &!all-sky downwelling longwave flux at bottom-of-atmosphere [J m-2] - lwdnbc_p, &!clear-sky downwelling longwave flux at bottom-of-atmosphere [J m-2] - lwdnt_p, &!all-sky downwelling longwave flux at top-of-atmosphere [J m-2] - lwdntc_p, &!clear-sky downwelling longwave flux at top-of-atmosphere [J m-2] - lwupb_p, &!all-sky upwelling longwave flux at bottom-of-atmosphere [J m-2] - lwupbc_p, &!clear-sky upwelling longwave flux at bottom-of-atmosphere [J m-2] - lwupt_p, &!all-sky upwelling longwave flux at top-of-atmosphere [J m-2] - lwuptc_p, &!clear-sky upwelling longwave flux at top-of-atmosphere [J m-2] - olrtoa_p !outgoing longwave radiation at top-of-the-atmosphere [W m-2] - - real(kind=RKIND),dimension(:,:,:),allocatable:: & - lwdnflx_p, &! - lwdnflxc_p, &! - lwupflx_p, &! - lwupflxc_p ! - - real(kind=RKIND),dimension(:,:,:),allocatable:: & - rthratenlw_p, &!uncoupled theta tendency due to longwave radiation [K s-1] - rrecloud_p, &!effective radius for cloud water calculated in rrtmg_lwrad [mu] - rreice_p, &!effective radius for cloud ice calculated in rrmtg_lwrad [mu] - rresnow_p !effective radius for snow calculated in rrtmg_lwrad [mu] - -!================================================================================================================= -!... variables and arrays related to parameterization of long- and short-wave radiation needed -! only by the "CAM" radiation codes: -!================================================================================================================= - - logical:: doabsems - - integer:: cam_abs_dim1 - integer:: cam_abs_dim2 - integer:: num_moist - integer:: num_aerosols - integer:: num_aerlevels - integer:: num_oznlevels - - real(kind=RKIND),dimension(:),allocatable:: & - pin_p, &!pressure levels for ozone concentration [Pa] - m_hybi_p !hybrid levels for aerosols [-] - - real(kind=RKIND),dimension(:,:),allocatable:: & - m_psn_p, &! - m_psp_p ! - - real(kind=RKIND),dimension(:,:,:,:),allocatable:: & - aerosolcn_p, &! - aerosolcp_p ! - - real(kind=RKIND),dimension(:,:,:),allocatable:: & - emstot_p, &!total emissivity [-] - cemiss_p, &!cloud emissivity for ISCCP [-] - taucldc_p, &!cloud water optical depth for ISCCP [-] - taucldi_p !cloud ice optical depth for ISCCP [-] - - real(kind=RKIND),dimension(:,:,:,:),allocatable:: & - abstot_p, &!total layer absorptivity [-] - absnxt_p, &!total nearest layer absorptivity [-] - ozmixm_p !ozone mixing ratio. - -!================================================================================================================= -!.. variables and arrays related to cloudiness: -!================================================================================================================= - - integer,parameter:: & - icloud= 1 !used in WRF only. - - real(kind=RKIND),dimension(:,:,:),allocatable:: & - cldfrac_p, &!cloud fraction [-] - qvrad_p, &!water vapor mixing ratio local to cloudiness and radiation [kg/kg] - qcrad_p, &!cloud liquid water mixing ratio local to cloudiness and radiation [kg/kg] - qirad_p, &!cloud ice mixing ratio local to cloudiness and radiation [kg/kg] - qsrad_p !snow mixing ratio local to cloudiness and radiation [kg/kg] - -!================================================================================================================= -!.. variables and arrays related to land-surface parameterization: -!================================================================================================================= - - logical,parameter:: & - ua_phys = .false. !option to activate UA Noah changes: a different snow-cover physics in the land-surface - !scheme. That option is not currently implemented in MPAS. - - integer,parameter:: & - opt_thcnd = 1 !option to treat thermal conductivity in NoahLSM (new option implemented in WRF 3.8.0). - != 1, original (default). - != 2, McCumber and Pielke for silt loam and sandy loam. - - integer,parameter:: & - fasdas = 0 !for WRF surface data assimilation system (not used in MPAS). - - integer,parameter:: & - nurb = 1 !generic dimension for all dimensions needed to run the urban physics. - - integer,public:: & - sf_surface_physics !used to define the land surface scheme by a number instead of name. It - !is only needed in module_ra_rrtmg_sw.F to define the spectral surface - !albedos as functions of the land surface scheme. - - integer,public:: & - num_soils !number of soil layers [-] - - integer,dimension(:,:),allocatable:: & - isltyp_p, &!dominant soil type category [-] - ivgtyp_p !dominant vegetation category [-] - - real(kind=RKIND),dimension(:),allocatable:: & - dzs_p !thickness of soil layers [m] - real(kind=RKIND),dimension(:,:,:),allocatable:: & - smcrel_p, &!soil moisture threshold below which transpiration starts to stress [-] - sh2o_p, &!unfrozen soil moisture content [volumetric fraction] - smois_p, &!soil moisture [volumetric fraction] - tslb_p !soil temperature [K] - - real(kind=RKIND),dimension(:,:),allocatable:: & - acsnom_p, &!accumulated melted snow [kg m-2] - acsnow_p, &!accumulated snow [kg m-2] - canwat_p, &!canopy water [kg m-2] - chklowq_p, &!surface saturation flag [-] - grdflx_p, &!ground heat flux [W m-2] - lai_p, &!leaf area index [-] - noahres_p, &!residual of the noah land-surface scheme energy budget [W m-2] - potevp_p, &!potential evaporation [W m-2] - qz0_p, &!specific humidity at znt [kg kg-1] - rainbl_p, &! - sfcrunoff_p, &!surface runoff [m s-1] - shdmin_p, &!minimum areal fractional coverage of annual green vegetation [-] - shdmax_p, &!maximum areal fractional coverage of annual green vegetation [-] - smstav_p, &!moisture availability [-] - smstot_p, &!total moisture [m3 m-3] - snopcx_p, &!snow phase change heat flux [W m-2] - snotime_p, &! - snowc_p, &!snow water equivalent [kg m-2] - snowh_p, &!physical snow depth [m] - swdown_p, &!downward shortwave flux at the surface [W m-2] - udrunoff_p, &!sub-surface runoff [m s-1] - tmn_p, &!soil temperature at lower boundary [K] - vegfra_p, &!vegetation fraction [-] - z0_p !background roughness length [m] - - real(kind=RKIND),dimension(:,:),allocatable:: & - alswvisdir_p, &!direct-beam surface albedo in visible spectrum [-] - alswvisdif_p, &!diffuse-beam surface albedo in visible spectrum [-] - alswnirdir_p, &!direct-beam surface albedo in near-IR spectrum [-] - alswnirdif_p !diffuse-beam surface albedo in near-IR spectrum [-] - -!.. arrays needed to run UA Noah changes (different snow-cover physics): - real(kind=RKIND),dimension(:,:),allocatable:: & - flxsnow_p, &!energy added to sensible heat flux when ua_phys=true [W m-2] - fvbsnow_p, &!fraction of vegetation with snow beneath when ua_phys=true [-] - fbursnow_p, &!fraction of canopy buried when ua_phys=true [-] - fgsnsnow_p !fraction of ground snow cover when ua_phys=true [-] - -!.. arrays needed in the argument list in the call to the Noah LSM urban parameterization: note that these arrays -!.. are initialized to zero since we do not run an urban model: - integer,dimension(:,:),allocatable:: & - utype_urb_p !urban type [-] - - real(kind=RKIND),dimension(:,:),allocatable:: & - frc_urb_p, &!urban fraction [-] - ust_urb_p !urban u* in similarity theory [m/s] - -!================================================================================================================= -!.. variables and arrays related to the Noahmp land-surface parameterization: -!================================================================================================================= - - type(NoahmpIO_type):: mpas_noahmp - -!================================================================================================================= -!.. variables and arrays related to surface characteristics: -!================================================================================================================= - - real(kind=RKIND),dimension(:,:),allocatable:: & - xlat_p, &!longitude, west is negative [degrees] - xlon_p !latitude, south is negative [degrees] - - real(kind=RKIND),dimension(:,:),allocatable:: & - sfc_albedo_p, &!surface albedo [-] - sfc_albbck_p, &!surface background albedo [-] - sfc_emibck_p, &!land surface background emissivity [-] - sfc_emiss_p, &!land surface emissivity [-] - snoalb_p, &!annual max snow albedo [-] - snow_p, &!snow water equivalent [kg m-2] - tsk_p, &!surface-skin temperature [K] - sst_p, &!sea-surface temperature [K] - xice_p, &!ice mask [-] - xland_p !land mask (1 for land; 2 for water) [-] - -!================================================================================================================= -!.. variables needed for the surface layer scheme and land surface scheme when config_frac_seaice -! is set to true. the arrays below have the same definition as the corresponding "_p" arrays: -!================================================================================================================= - - real(kind=RKIND),dimension(:,:),allocatable:: br_sea,ch_sea,chs_sea,chs2_sea,cpm_sea,cqs2_sea, & - flhc_sea,flqc_sea,gz1oz0_sea,hfx_sea,lh_sea,mavail_sea,mol_sea, & - psih_sea,psim_sea,fh_sea,fm_sea,qfx_sea,qgh_sea,qsfc_sea,regime_sea, & - rmol_sea,ust_sea,wspd_sea,znt_sea,zol_sea,tsk_sea,xland_sea - real(kind=RKIND),dimension(:,:),allocatable:: t2m_sea,th2m_sea,q2_sea,u10_sea,v10_sea - real(kind=RKIND),dimension(:,:),allocatable:: cd_sea,cda_sea,ck_sea,cka_sea,ustm_sea - - real(kind=RKIND),dimension(:,:),allocatable:: regime_hold - real(kind=RKIND),dimension(:,:),allocatable:: tsk_ice - - - contains - - -!================================================================================================================= - subroutine atmphys_vars_init() -!================================================================================================================= -!dummy subroutine that does not do anything. - - end subroutine atmphys_vars_init - -!================================================================================================================= - end module mpas_atmphys_vars -!================================================================================================================= From c921068d71eb2ad106fe1a85cfdff0ec1c747ec0 Mon Sep 17 00:00:00 2001 From: Song You Hong Date: Tue, 23 Dec 2025 14:19:00 -0700 Subject: [PATCH 19/19] modified: src/core_atmosphere/Externals.cfg --- src/core_atmosphere/Externals.cfg | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/core_atmosphere/Externals.cfg b/src/core_atmosphere/Externals.cfg index 393940f5f0..9154ac7d7e 100644 --- a/src/core_atmosphere/Externals.cfg +++ b/src/core_atmosphere/Externals.cfg @@ -2,7 +2,7 @@ local_path = ./physics_mmm protocol = git repo_url = https://github.com/Songyou184/MMM-physics.git -branch=KIM_GWDO +branch=GWDO_SH required = True [GSL_UGWP]