Skip to content

Commit

Permalink
Merge pull request #53 from JosephMouallem/shiemom_topush
Browse files Browse the repository at this point in the history 
Allow SHiELD_physics to use the full coupler fluxes.
  • Loading branch information
@lharris4
lharris4 authored Jul 17, 2024
2 parents c8c5d30 + 0ef6494 commit c93b388
Show file tree
Hide file tree
Showing 5 changed files with 451 additions and 6 deletions.
62 changes: 61 additions & 1 deletion FV3GFS/FV3GFS_io.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -4742,6 +4742,30 @@ subroutine gfdl_diag_register(Time, Sfcprop, Gfs_diag, Model, Cldprop, Atm_block
Diag(idx)%data(nb)%var2 => Gfs_diag(nb)%v10m(:)
enddo

! KGao
idx = idx + 1
Diag(idx)%axes = 2
Diag(idx)%name = 'hflx'
Diag(idx)%desc = 'surface temp flux'
Diag(idx)%unit = 'K*m/s'
Diag(idx)%mod_name = 'gfs_phys'
allocate (Diag(idx)%data(nblks))
do nb = 1,nblks
Diag(idx)%data(nb)%var2 => Gfs_diag(nb)%hflx(:)
enddo

! KGao
idx = idx + 1
Diag(idx)%axes = 2
Diag(idx)%name = 'evap'
Diag(idx)%desc = 'surface moisture flux'
Diag(idx)%unit = 'm/s*kg/kg'
Diag(idx)%mod_name = 'gfs_phys'
allocate (Diag(idx)%data(nblks))
do nb = 1,nblks
Diag(idx)%data(nb)%var2 => Gfs_diag(nb)%evap(:)
enddo

idx = idx + 1
Diag(idx)%axes = 2
Diag(idx)%name = 'dpt2m'
Expand Down Expand Up @@ -6979,6 +7003,30 @@ subroutine gfdl_diag_register(Time, Sfcprop, Gfs_diag, Model, Cldprop, Atm_block
Diag(idx)%data(nb)%var2 => Sfcprop(nb)%uustar(:)
enddo

! KGao
idx = idx + 1
Diag(idx)%axes = 2
Diag(idx)%name = 'shflx'
Diag(idx)%desc = 'shflx from coupler'
Diag(idx)%unit = 'XXX'
Diag(idx)%mod_name = 'gfs_sfc'
allocate (Diag(idx)%data(nblks))
do nb = 1,nblks
Diag(idx)%data(nb)%var2 => Sfcprop(nb)%shflx(:)
enddo

! KGao
idx = idx + 1
Diag(idx)%axes = 2
Diag(idx)%name = 'lhflx'
Diag(idx)%desc = 'lhflx from coupler'
Diag(idx)%unit = 'XXX'
Diag(idx)%mod_name = 'gfs_sfc'
allocate (Diag(idx)%data(nblks))
do nb = 1,nblks
Diag(idx)%data(nb)%var2 => Sfcprop(nb)%lhflx(:)
enddo

idx = idx + 1
Diag(idx)%axes = 2
Diag(idx)%name = 'slope'
Expand Down Expand Up @@ -7231,12 +7279,24 @@ subroutine gfdl_diag_register(Time, Sfcprop, Gfs_diag, Model, Cldprop, Atm_block
Diag(idx)%desc = 'surface roughness [m]'
Diag(idx)%unit = 'm'
Diag(idx)%mod_name = 'gfs_sfc'
Diag(idx)%cnvfac = cn_one/cn_100
Diag(idx)%cnvfac = cn_one/cn_100
allocate (Diag(idx)%data(nblks))
do nb = 1,nblks
Diag(idx)%data(nb)%var2 => Sfcprop(nb)%zorl(:)
enddo

idx = idx + 1
Diag(idx)%axes = 2
Diag(idx)%name = 'ZTRLsfc'
Diag(idx)%desc = 'surface roughness for heat [m]'
Diag(idx)%unit = 'm'
Diag(idx)%mod_name = 'gfs_sfc'
Diag(idx)%cnvfac = cn_one/cn_100
allocate (Diag(idx)%data(nblks))
do nb = 1,nblks
Diag(idx)%data(nb)%var2 => Sfcprop(nb)%ztrl(:)
enddo

idx = idx + 1
Diag(idx)%axes = 2
Diag(idx)%name = 'VFRACsfc'
Expand Down
41 changes: 39 additions & 2 deletions GFS_layer/GFS_physics_driver.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -1179,7 +1179,23 @@ subroutine GFS_physics_driver &
!else
!!$ endif

if (Model%sfc_gfdl) then
! kgao - need a logic to ensure sfc_coupled is true when coupled with MOM6
if (Model%sfc_coupled) then
! a version of sfc_diff from coupling with MOM6 by kgao
! Sfcprop%uustar,Sfcprop%zorl,Sfcprop%ztrl are not updated over ocean points
call sfc_diff_coupled(im,Statein%pgr, Statein%ugrs, Statein%vgrs,&
Statein%tgrs, Statein%qgrs, Diag%zlvl, Sfcprop%snowd, &
Sfcprop%tsfc, Sfcprop%zorl, Sfcprop%ztrl, cd, &
cdq, rb, Statein%prsl(1,1), work3, islmsk, stress, &
Sfcprop%ffmm, Sfcprop%ffhh, Sfcprop%uustar, &
wind, Tbd%phy_f2d(1,Model%num_p2d), fm10, fh2, &
sigmaf, vegtype, Sfcprop%shdmax, Model%ivegsrc, &
tsurf, flag_iter) !, Model%redrag, Model%z0s_max, &
!Model%do_z0_moon, Model%do_z0_hwrf15, &
!Model%do_z0_hwrf17, Model%do_z0_hwrf17_hwonly, &
!Model%wind_th_hwrf)

else if (Model%sfc_gfdl) then
! a new and more flexible version of sfc_diff by kgao
call sfc_diff_gfdl(im,Statein%pgr, Statein%ugrs, Statein%vgrs,&
Statein%tgrs, Statein%qgrs, Diag%zlvl, Sfcprop%snowd, &
Expand All @@ -1192,6 +1208,7 @@ subroutine GFS_physics_driver &
Model%do_z0_moon, Model%do_z0_hwrf15, &
Model%do_z0_hwrf17, Model%do_z0_hwrf17_hwonly, &
Model%wind_th_hwrf)

else
! GFS original sfc_diff modified by kgao
call sfc_diff (im,Statein%pgr, Statein%ugrs, Statein%vgrs,&
Expand Down Expand Up @@ -1279,14 +1296,30 @@ subroutine GFS_physics_driver &

! --- ... surface energy balance over ocean

call sfc_ocean &
if (Model%sfc_coupled) then
! kgao: this version is for coupling with MOM6, which
! gets hflx and evap over ocean points
! based on shflx and lhflx from coupler
call sfc_ocean_coupled &
! --- inputs:
(im, Statein%pgr, Statein%ugrs, Statein%vgrs, Statein%tgrs, &
Statein%qgrs, Sfcprop%tsfc, cd, cdq, Statein%prsl(1,1), &
work3, islmsk, Tbd%phy_f2d(1,Model%num_p2d), flag_iter, &
! kgao: shflx and lhflx from coupler
Sfcprop%shflx, Sfcprop%lhflx, &
! --- outputs:
qss, Diag%cmm, Diag%chh, gflx, evap, hflx, ep1d)

else
call sfc_ocean &
! --- inputs:
(im, Statein%pgr, Statein%ugrs, Statein%vgrs, Statein%tgrs, &
Statein%qgrs, Sfcprop%tsfc, cd, cdq, Statein%prsl(1,1), &
work3, islmsk, Tbd%phy_f2d(1,Model%num_p2d), flag_iter, &
! --- outputs:
qss, Diag%cmm, Diag%chh, gflx, evap, hflx, ep1d)
endif

endif ! if ( nstf_name(1) > 0 ) then

! if (lprnt) write(0,*)' sfalb=',sfalb(ipr),' ipr=',ipr &
Expand Down Expand Up @@ -1451,6 +1484,10 @@ subroutine GFS_physics_driver &
Diag%u1(:) = Statein%ugrs(:,1)
Diag%v1(:) = Statein%vgrs(:,1)
Sfcprop%qsfc(:) = qss(:)

! KGao
Diag%hflx(:) = hflx(:)
Diag%evap(:) = evap(:)

if (Model%override_surface_radiative_fluxes) then
Diag%dlwsfci_override(:) = adjsfcdlw_for_coupling(:)
Expand Down
22 changes: 19 additions & 3 deletions GFS_layer/GFS_typedefs.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -229,6 +229,8 @@ module GFS_typedefs
real (kind=kind_phys), pointer :: uustar (:) => null() !< boundary layer parameter
real (kind=kind_phys), pointer :: oro (:) => null() !< orography
real (kind=kind_phys), pointer :: oro_uf (:) => null() !< unfiltered orography
real (kind=kind_phys), pointer :: shflx (:) => null() !< sen heat flux (kgao)
real (kind=kind_phys), pointer :: lhflx (:) => null() !< latent heat flux (kgao)

!--- IN/out MYJ scheme
real (kind=kind_phys), pointer :: QZ0 (:) => null() !< vapor mixing ratio at z=z0
Expand Down Expand Up @@ -653,6 +655,7 @@ module GFS_typedefs
logical :: shcnvcw !< flag for shallow convective cloud
logical :: redrag !< flag for reduced drag coeff. over sea
logical :: sfc_gfdl !< flag for using updated sfc layer scheme
logical :: sfc_coupled !< flag for using sfc layer scheme designed for coupling
real(kind=kind_phys) :: z0s_max !< a limiting value for z0 under high winds
logical :: do_z0_moon !< flag for using z0 scheme in Moon et al. 2007 (kgao)
logical :: do_z0_hwrf15 !< flag for using z0 scheme in 2015 HWRF (kgao)
Expand Down Expand Up @@ -1303,8 +1306,10 @@ module GFS_typedefs
real (kind=kind_phys), pointer :: totgrpb(:) => null() !< accumulated graupel precipitation in bucket (kg/m2)

! Output - only in physics
real (kind=kind_phys), pointer :: u10m (:) => null() !< 10 meater u/v wind speed
real (kind=kind_phys), pointer :: v10m (:) => null() !< 10 meater u/v wind speed
real (kind=kind_phys), pointer :: u10m (:) => null() !< 10 meter u/v wind speed
real (kind=kind_phys), pointer :: v10m (:) => null() !< 10 meter u/v wind speed
real (kind=kind_phys), pointer :: hflx (:) => null() !< sfc temp flux
real (kind=kind_phys), pointer :: evap (:) => null() !< sfc moisture flux
real (kind=kind_phys), pointer :: dpt2m (:) => null() !< 2 meter dew point temperature
real (kind=kind_phys), pointer :: zlvl (:) => null() !< layer 1 height (m)
real (kind=kind_phys), pointer :: psurf (:) => null() !< surface pressure (Pa)
Expand Down Expand Up @@ -1678,6 +1683,8 @@ subroutine sfcprop_create (Sfcprop, IM, Model)
allocate (Sfcprop%uustar (IM))
allocate (Sfcprop%oro (IM))
allocate (Sfcprop%oro_uf (IM))
allocate (Sfcprop%shflx (IM))
allocate (Sfcprop%lhflx (IM))

Sfcprop%slope = clear_val
Sfcprop%shdmin = clear_val
Expand All @@ -1691,6 +1698,8 @@ subroutine sfcprop_create (Sfcprop, IM, Model)
Sfcprop%uustar = clear_val
Sfcprop%oro = clear_val
Sfcprop%oro_uf = clear_val
Sfcprop%shflx = clear_val
Sfcprop%lhflx = clear_val

if (Model%myj_pbl) then
allocate (Sfcprop%QZ0 (IM))
Expand Down Expand Up @@ -2353,6 +2362,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, &
logical :: shcnvcw = .false. !< flag for shallow convective cloud
logical :: redrag = .false. !< flag for reduced drag coeff. over sea
logical :: sfc_gfdl = .false. !< flag for using new sfc layer scheme by kgao at GFDL
logical :: sfc_coupled = .false. !< flag for using sfc layer scheme designed for coupling
real(kind=kind_phys) :: z0s_max = .317e-2 !< a limiting value for z0 under high winds
logical :: do_z0_moon = .false. !< flag for using z0 scheme in Moon et al. 2007
logical :: do_z0_hwrf15 = .false. !< flag for using z0 scheme in 2015 HWRF
Expand Down Expand Up @@ -2589,7 +2599,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, &
ras, trans_trac, old_monin, cnvgwd, mstrat, moist_adj, &
cscnv, cal_pre, do_aw, do_shoc, shocaftcnv, shoc_cld, &
h2o_phys, pdfcld, shcnvcw, redrag, sfc_gfdl, z0s_max, &
do_z0_moon, do_z0_hwrf15, do_z0_hwrf17, &
sfc_coupled, do_z0_moon, do_z0_hwrf15, do_z0_hwrf17, &
do_z0_hwrf17_hwonly, wind_th_hwrf, &
hybedmf, dspheat, lheatstrg, hour_canopy, afac_canopy, &
cnvcld, no_pbl, xkzm_lim, xkzm_fac, xkgdx, &
Expand Down Expand Up @@ -2824,6 +2834,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, &
Model%shcnvcw = shcnvcw
Model%redrag = redrag
Model%sfc_gfdl = sfc_gfdl
Model%sfc_coupled = sfc_coupled
Model%z0s_max = z0s_max
Model%do_z0_moon = do_z0_moon
Model%do_z0_hwrf15 = do_z0_hwrf15
Expand Down Expand Up @@ -3529,6 +3540,7 @@ subroutine control_print(Model)
print *, ' shcnvcw : ', Model%shcnvcw
print *, ' redrag : ', Model%redrag
print *, ' sfc_gfdl : ', Model%sfc_gfdl
print *, ' sfc_coupled : ', Model%sfc_coupled
print *, ' z0s_max : ', Model%z0s_max
print *, ' do_z0_moon : ', Model%do_z0_moon
print *, ' do_z0_hwrf15 : ', Model%do_z0_hwrf15
Expand Down Expand Up @@ -4024,6 +4036,8 @@ subroutine diag_create (Diag, IM, Model)
allocate (Diag%totgrpb (IM))
allocate (Diag%u10m (IM))
allocate (Diag%v10m (IM))
allocate (Diag%hflx (IM))
allocate (Diag%evap (IM))
allocate (Diag%dpt2m (IM))
allocate (Diag%zlvl (IM))
allocate (Diag%psurf (IM))
Expand Down Expand Up @@ -4318,6 +4332,8 @@ subroutine diag_phys_zero (Diag, Model, linit, iauwindow_center)
!--- Out
Diag%u10m = zero
Diag%v10m = zero
Diag%hflx = zero
Diag%evap = zero
Diag%dpt2m = zero
Diag%zlvl = zero
Diag%psurf = zero
Expand Down
Loading

0 comments on commit c93b388

Please sign in to comment.