Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

remove the iteration loop for Noah MP and implement a new coupling in… #10

Merged
merged 1 commit into from
Sep 8, 2021
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
15 changes: 10 additions & 5 deletions physics/GFS_surface_loop_control.F90
Original file line number Diff line number Diff line change
Expand Up @@ -22,7 +22,8 @@ end subroutine GFS_surface_loop_control_part1_finalize
!! \section detailed Detailed Algorithm
!! @{

subroutine GFS_surface_loop_control_part1_run (im, iter, wind, flag_guess, errmsg, errflg)
subroutine GFS_surface_loop_control_part1_run (im, lsm,lsm_noahmp, iter, &
wind, flag_guess, errmsg, errflg)

use machine, only: kind_phys

Expand All @@ -31,6 +32,8 @@ subroutine GFS_surface_loop_control_part1_run (im, iter, wind, flag_guess, errms
! Interface variables
integer, intent(in) :: im
integer, intent(in) :: iter
integer, intent(in) :: lsm
integer, intent(in) :: lsm_noahmp
real(kind=kind_phys), dimension(:), intent(in) :: wind
logical, dimension(:), intent(inout) :: flag_guess

Expand All @@ -45,7 +48,7 @@ subroutine GFS_surface_loop_control_part1_run (im, iter, wind, flag_guess, errms
errflg = 0

do i=1,im
if (iter == 1 .and. wind(i) < 2.0d0) then
if (iter == 1 .and. wind(i) < 2.0d0 .and. lsm /= lsm_noahmp) then
flag_guess(i) = .true.
endif
enddo
Expand Down Expand Up @@ -78,8 +81,8 @@ end subroutine GFS_surface_loop_control_part2_finalize
!! \section detailed Detailed Algorithm
!! @{

subroutine GFS_surface_loop_control_part2_run (im, iter, wind, &
flag_guess, flag_iter, dry, wet, icy, nstf_name1, errmsg, errflg)
subroutine GFS_surface_loop_control_part2_run (im,lsm,lsm_noahmp, iter,&
wind, flag_guess, flag_iter, dry, wet, icy, nstf_name1, errmsg, errflg)

use machine, only: kind_phys

Expand All @@ -88,6 +91,8 @@ subroutine GFS_surface_loop_control_part2_run (im, iter, wind, &
! Interface variables
integer, intent(in) :: im
integer, intent(in) :: iter
integer, intent(in) :: lsm
integer, intent(in) :: lsm_noahmp
real(kind=kind_phys), dimension(:), intent(in) :: wind
logical, dimension(:), intent(inout) :: flag_guess
logical, dimension(:), intent(inout) :: flag_iter
Expand All @@ -110,7 +115,7 @@ subroutine GFS_surface_loop_control_part2_run (im, iter, wind, &

if (iter == 1 .and. wind(i) < 2.0d0) then
!if (dry(i) .or. (wet(i) .and. .not.icy(i) .and. nstf_name1 > 0)) then
if (dry(i) .or. (wet(i) .and. nstf_name1 > 0)) then
if((dry(i).and.lsm /= lsm_noahmp) .or. (wet(i) .and. nstf_name1 > 0)) then
flag_iter(i) = .true.
endif
endif
Expand Down
32 changes: 32 additions & 0 deletions physics/GFS_surface_loop_control.meta
Original file line number Diff line number Diff line change
Expand Up @@ -15,6 +15,22 @@
type = integer
intent = in
optional = F
[lsm]
standard_name = control_for_land_surface_scheme
long_name = flag for land surface model
units = flag
dimensions = ()
type = integer
intent = in
optional = F
[lsm_noahmp]
standard_name = identifier_for_noahmp_land_surface_scheme
long_name = flag for NOAH MP land surface model
units = flag
dimensions = ()
type = integer
intent = in
optional = F
[iter]
standard_name = ccpp_loop_counter
long_name = loop counter for subcycling loops in CCPP
Expand Down Expand Up @@ -76,6 +92,22 @@
type = integer
intent = in
optional = F
[lsm]
standard_name = control_for_land_surface_scheme
long_name = flag for land surface model
units = flag
dimensions = ()
type = integer
intent = in
optional = F
[lsm_noahmp]
standard_name = identifier_for_noahmp_land_surface_scheme
long_name = flag for NOAH MP land surface model
units = flag
dimensions = ()
type = integer
intent = in
optional = F
[iter]
standard_name = ccpp_loop_counter
long_name = loop counter for subcycling loops in CCPP
Expand Down
28 changes: 21 additions & 7 deletions physics/module_sf_noahmp_glacier.f90
Original file line number Diff line number Diff line change
Expand Up @@ -119,10 +119,10 @@ subroutine noahmp_glacier (&
prcp ,lwdn ,tbot ,zlvl ,ficeold ,zsoil , & ! in : forcing
qsnow ,sneqvo ,albold ,cm ,ch ,isnow , & ! in/out :
sneqv ,smc ,zsnso ,snowh ,snice ,snliq , & ! in/out :
tg ,stc ,sh2o ,tauss ,qsfc , & ! in/out :
tg ,stc ,sh2o ,tauss ,qsfc , & ! in/out :
fsa ,fsr ,fira ,fsh ,fgev ,ssoil , & ! out :
trad ,edir ,runsrf ,runsub ,sag ,albedo , & ! out :
qsnbot ,ponding ,ponding1,ponding2,t2m ,q2e , & ! out :
qsnbot ,ponding ,ponding1,ponding2,t2m,q2e,z0h_total , & ! out :
#ifdef CCPP
emissi, fpice ,ch2b , esnow, albsnd, albsni , &
errmsg, errflg)
Expand Down Expand Up @@ -198,6 +198,7 @@ subroutine noahmp_glacier (&
real (kind=kind_phys) , intent(out) :: ponding2!< surface ponding [mm]
real (kind=kind_phys) , intent(out) :: t2m !< 2-m air temperature over bare ground part [k]
real (kind=kind_phys) , intent(out) :: q2e
real (kind=kind_phys) , intent(out) :: z0h_total !< roughness length for heat
real (kind=kind_phys) , intent(out) :: emissi
real (kind=kind_phys) , intent(out) :: fpice
real (kind=kind_phys) , intent(out) :: ch2b
Expand Down Expand Up @@ -269,7 +270,7 @@ subroutine noahmp_glacier (&
imelt ,snicev ,snliqv ,epore ,qmelt ,ponding, & !out
sag ,fsa ,fsr ,fira ,fsh ,fgev , & !out
trad ,t2m ,ssoil ,lathea ,q2e ,emissi, & !out
ch2b ,albsnd ,albsni ) !out
ch2b ,albsnd ,albsni ,z0h_total ) !out

#ifdef CCPP
if (errflg /= 0) return
Expand Down Expand Up @@ -399,7 +400,7 @@ subroutine energy_glacier (nsnow ,nsoil ,isnow ,dt ,qsnow ,rhoair , & !i
imelt ,snicev ,snliqv ,epore ,qmelt ,ponding, & !out
sag ,fsa ,fsr ,fira ,fsh ,fgev , & !out
trad ,t2m ,ssoil ,lathea ,q2e ,emissi, & !out
ch2b ,albsnd ,albsni ) !out
ch2b ,albsnd ,albsni ,z0h_total ) !out

! --------------------------------------------------------------------------------------------------
! --------------------------------------------------------------------------------------------------
Expand Down Expand Up @@ -474,6 +475,7 @@ subroutine energy_glacier (nsnow ,nsoil ,isnow ,dt ,qsnow ,rhoair , & !i
real (kind=kind_phys) , intent(out) :: ch2b !< sensible heat conductance, canopy air to zlvl air (m/s)
real (kind=kind_phys), dimension(1:2) , intent(out) :: albsnd !< snow albedo (direct)
real (kind=kind_phys), dimension(1:2) , intent(out) :: albsni !< snow albedo (diffuse)
real (kind=kind_phys) , intent(out) :: z0h_total !< roughness length for heat


! local
Expand Down Expand Up @@ -543,7 +545,7 @@ subroutine energy_glacier (nsnow ,nsoil ,isnow ,dt ,qsnow ,rhoair , & !i
cm ,ch ,tg ,qsfc , & !inout
#endif
fira ,fsh ,fgev ,ssoil , & !out
t2m ,q2e ,ch2b) !out
t2m ,q2e ,ch2b ,z0h_total) !out

!energy balance at surface: sag=(irb+shb+evb+ghb)

Expand Down Expand Up @@ -978,7 +980,7 @@ subroutine glacier_flux (nsoil ,nsnow ,emg ,isnow ,df ,dzsnso ,z
cm ,ch ,tgb ,qsfc , & !inout
#endif
irb ,shb ,evb ,ghb , & !out
t2mb ,q2b ,ehb2) !out
t2mb ,q2b ,ehb2 ,z0h_total) !out

! --------------------------------------------------------------------------------------------------
! use newton-raphson iteration to solve ground (tg) temperature
Expand Down Expand Up @@ -1038,6 +1040,7 @@ subroutine glacier_flux (nsoil ,nsnow ,emg ,isnow ,df ,dzsnso ,z
real (kind=kind_phys), intent(out) :: t2mb !< 2 m height air temperature (k)
real (kind=kind_phys), intent(out) :: q2b !< bare ground heat conductance
real (kind=kind_phys), intent(out) :: ehb2 !< sensible heat conductance for diagnostics
real (kind=kind_phys), intent(out) :: z0h_total !< roughness length for heat


! local variables
Expand All @@ -1058,6 +1061,7 @@ subroutine glacier_flux (nsoil ,nsnow ,emg ,isnow ,df ,dzsnso ,z
real (kind=kind_phys) :: cq2b !<
integer :: iter !< iteration index
real (kind=kind_phys) :: z0h !< roughness length, sensible heat, ground (m)
real (kind=kind_phys) :: reyni !< Roughness Reynolds # over ice
real (kind=kind_phys) :: moz !< monin-obukhov stability parameter
real (kind=kind_phys) :: fm !< momentum stability correction, weighted by prior iters
real (kind=kind_phys) :: fh !< sen heat stability correction, weighted by prior iters
Expand Down Expand Up @@ -1090,13 +1094,23 @@ subroutine glacier_flux (nsoil ,nsnow ,emg ,isnow ,df ,dzsnso ,z
h = 0.
fv = 0.1

reyni = fv*z0m/(1.5e-05) !introduction of fv dependent z0h for the iter

if (reyni .gt. 2.0) then
z0h = z0m/exp(2.46*(reyni)**0.25 - log(7.4)) !Brutsaert 1982
else
z0h = z0m/exp(-log(0.397)) !Brusaert 1982, table 4
endif

z0h_total = z0h

cir = emg*sb
cgh = 2.*df(isnow+1)/dzsnso(isnow+1)

! -----------------------------------------------------------------
loop3: do iter = 1, niterb ! begin stability iteration

z0h = z0m
! z0h = z0m

! for now, only allow sfcdif1 until others can be fixed

Expand Down
Loading