Skip to content

Wrapper for #588 (Updated sfc_nst.f, sfc_nst.meta, module_nst_water_prop.f90 and flake_driver.F90) #629

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.

Sign up for GitHub

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

Merged
climbfuji merged 26 commits into from
Apr 19, 2021
Merged

Wrapper for #588 (Updated sfc_nst.f, sfc_nst.meta, module_nst_water_prop.f90 and flake_driver.F90) #629

Show file tree
Hide file tree
Changes from 21 commits
Commits
Show all changes
26 commits
Select commit Hold shift + click to select a range
55d395f
Updated sfc_nst.f, sfc_nst.meta, module_nst_water_prop.f90 and flake_…
YihuaWu-NOAA Mar 8, 2021
26340ba
Updated sfc_nst.f & sfc_nst.meta
YihuaWu-NOAA Mar 18, 2021
17ccdcf
Updated sfc_nst.f to remove unnecessary statements
YihuaWu-NOAA Mar 18, 2021
0ee9504
Merge remote-tracking branch 'upstream/master' into flake
YihuaWu-NOAA Apr 1, 2021
465167f
Removed a line not needed
YihuaWu-NOAA Apr 1, 2021
8f78249
Added comments to briefily describe some temporary variables in the code
YihuaWu-NOAA Apr 1, 2021
334e245
Updating to head of upstream
YihuaWu-NOAA Apr 12, 2021
7adb61f
Fixed conflicts
YihuaWu-NOAA Apr 12, 2021
e1f6417
Fixed errors created during merge processes
YihuaWu-NOAA Apr 13, 2021
6a08c3a
Fixed some code errors caused during merging processes
YihuaWu-NOAA Apr 13, 2021
dfeb51c
Merge branch 'flake' of https://github.com/YihuaWu-NOAA/ccpp-physics …
YihuaWu-NOAA Apr 13, 2021
a81cdb9
Corrected merge error
YihuaWu-NOAA Apr 13, 2021
2742ece
Merge branch 'flake' of https://github.com/YihuaWu-NOAA/ccpp-physics …
YihuaWu-NOAA Apr 13, 2021
5411d4d
Fixed some issues
YihuaWu-NOAA Apr 13, 2021
8cd133d
Modified code based on Moorthi's commits: recoded the polynomial equ…
YihuaWu-NOAA Apr 14, 2021
80ae761
Recoded the polynomial equation and redefined lake as use_flake
YihuaWu-NOAA Apr 14, 2021
bc75cd5
Merge branch 'flake' of https://github.com/YihuaWu-NOAA/ccpp-physics …
YihuaWu-NOAA Apr 14, 2021
e20ad29
Corrected the orders of three parameters
YihuaWu-NOAA Apr 15, 2021
aa73104
Updated to head of upstream
YihuaWu-NOAA Apr 15, 2021
3163fbc
Merge branch 'flake' of https://github.com/YihuaWu-NOAA/ccpp-physics …
YihuaWu-NOAA Apr 15, 2021
59ab0cd
Updated flake physics
YihuaWu-NOAA Apr 15, 2021
b53829d
Updated flake physics
YihuaWu-NOAA Apr 16, 2021
b657923
Merge branch 'flake' of https://github.com/YihuaWu-NOAA/ccpp-physics …
YihuaWu-NOAA Apr 16, 2021
2d3b3c4
Reserved a part of the code
YihuaWu-NOAA Apr 16, 2021
b80f88f
Fix formatting/revert unnecessary formatting changes
climbfuji Apr 16, 2021
67ddd4f
Fix compile errors in sfc_nst.f and sfc_nst.meta
climbfuji Apr 16, 2021
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
12 changes: 6 additions & 6 deletions physics/GFS_surface_composites.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -27,7 +27,7 @@ end subroutine GFS_surface_composites_pre_finalize
!! \htmlinclude GFS_surface_composites_pre_run.html
!!
subroutine GFS_surface_composites_pre_run (im, lkm, frac_grid, flag_cice, cplflx, cplwav2atm, &
landfrac, lakefrac, lakedepth, oceanfrac, frland, dry, icy, lake, ocean, wet, &
landfrac, lakefrac, lakedepth, oceanfrac, frland, dry, icy, use_flake, ocean, wet, &
hice, cice, snowd, snowd_wat, snowd_lnd, snowd_ice, tprcp, tprcp_wat, &
tprcp_lnd, tprcp_ice, uustar, uustar_wat, uustar_lnd, uustar_ice, &
weasd, weasd_wat, weasd_lnd, weasd_ice, ep1d_ice, tsfc, tsfco, tsfcl, tsfc_wat, &
Expand All @@ -44,7 +44,7 @@ subroutine GFS_surface_composites_pre_run (im, lkm, frac_grid, flag_cice, cplflx
integer, intent(in ) :: im, lkm
logical, intent(in ) :: frac_grid, cplflx, cplwav2atm
logical, dimension(im), intent(inout) :: flag_cice
logical, dimension(im), intent(inout) :: dry, icy, lake, ocean, wet
logical, dimension(im), intent(inout) :: dry, icy, use_flake, ocean, wet
real(kind=kind_phys), dimension(im), intent(in ) :: landfrac, lakefrac, lakedepth, oceanfrac
real(kind=kind_phys), dimension(im), intent(inout) :: cice, hice
real(kind=kind_phys), dimension(im), intent( out) :: frland
Expand Down Expand Up @@ -229,14 +229,14 @@ subroutine GFS_surface_composites_pre_run (im, lkm, frac_grid, flag_cice, cplflx

! to prepare to separate lake from ocean under water category
do i = 1, im
if(lkm == 1) then
if(wet(i) .and. lkm == 1) then
if(lakefrac(i) >= 0.15 .and. lakedepth(i) > one) then
lake(i) = .true.
use_flake(i) = .true.
else
lake(i) = .false.
use_flake(i) = .false.
endif
else
lake(i) = .false.
use_flake(i) = .false.
endif
enddo

Expand Down
2 changes: 1 addition & 1 deletion physics/GFS_surface_composites.meta
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -116,7 +116,7 @@
type = logical
intent = inout
optional = F
[lake]
[use_flake]
standard_name = flag_nonzero_lake_surface_fraction
long_name = flag indicating presence of some lake surface area fraction
units = flag
Expand Down
33 changes: 26 additions & 7 deletions physics/flake_driver.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -51,7 +51,7 @@ SUBROUTINE flake_driver_run ( &
! ---- Inputs
im, ps, t1, q1, wind, &
dlwflx, dswsfc, weasd, lakedepth, &
lake, xlat, delt, zlvl, elev, &
use_flake, xlat, delt, zlvl, elev, &
wet, flag_iter, yearlen, julian, imon, &
! ---- in/outs
snwdph, hice, tsurf, fice, T_sfc, hflx, evap, &
Expand Down Expand Up @@ -95,7 +95,7 @@ SUBROUTINE flake_driver_run ( &

real (kind=kind_phys), intent(in) :: julian

logical, dimension(im), intent(in) :: flag_iter, wet, lake
logical, dimension(im), intent(in) :: flag_iter, wet, use_flake

character(len=*), intent(out) :: errmsg
integer, intent(out) :: errflg
Expand Down Expand Up @@ -187,6 +187,10 @@ SUBROUTINE flake_driver_run ( &
REAL (KIND = kind_phys) :: &
lake_depth_max, T_bot_2_in, T_bot_2_out, dxlat,tb,tr,tt,temp,Kbar, DelK


REAL (KIND = kind_phys) :: x, y !temperarory variables used for Tbot and Tsfc
!initilizations

INTEGER :: i,ipr,iter

LOGICAL :: lflk_botsed_use
Expand All @@ -212,7 +216,7 @@ SUBROUTINE flake_driver_run ( &

do i = 1, im
if (flag(i)) then
if( lake(i) ) then
if( use_flake(i) ) then
T_ice(i) = 273.15
T_snow(i) = 273.15
fetch(i) = 2.0E+03
Expand All @@ -237,9 +241,23 @@ SUBROUTINE flake_driver_run ( &
! else
! T_sfc(i) = tsurf(i)
! endif
T_sfc(i) = 0.2*tt + 0.8* tsurf(i)
T_sfc(i) = 0.1*tt + 0.9* tsurf(i)
endif
!
! Add empirical climatology of lake Tsfc and Tbot to the current Tsfc and Tbot
! to make sure Tsfc and Tbot are warmer than Tair in Winter or colder than Tair
! in Summer

x = 0.03279*julian
if(xlat(i) .ge. 0.0) then
y = ((((0.0034*x-0.1241)*x+1.6231)*x-8.8666)*x+17.206)*x-4.2929
T_sfc(i) = T_sfc(i) + 0.3*y
tb = tb + 0.05*y
else
y = ((((0.0034*x-0.1241)*x+1.6231)*x-8.8666)*x+17.206)*x-4.2929
T_sfc(i) = T_sfc(i) - 0.3*y
tb = tb - 0.05*y
endif

T_bot(i) = tb
T_B1(i) = tb

Expand Down Expand Up @@ -275,7 +293,7 @@ SUBROUTINE flake_driver_run ( &
! print*,'inside flake driver'
! print*, julian,xlat(i),w_albedo(I),w_extinc(i),lakedepth(i),elev(i),tb,tt,tsurf(i),T_sfc(i)

endif !lake fraction and depth
endif !lake
endif !flag
enddo
1001 format ( 'At icount=', i5, ' x = ', f5.2,5x, 'y = ', &
Expand All @@ -288,7 +306,7 @@ SUBROUTINE flake_driver_run ( &
! call lake interface
do i=1,im
if (flag(i)) then
if( lake(i) ) then
if( use_flake(i) ) then
dMsnowdt_in = weasd(i)/delt
I_atm_in = dswsfc(i)
Q_atm_lw_in = dlwflx(i)
Expand Down Expand Up @@ -391,3 +409,4 @@ END SUBROUTINE flake_driver_run

!---------------------------------
end module flake_driver
2 changes: 1 addition & 1 deletion physics/flake_driver.meta
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -131,7 +131,7 @@
kind = kind_phys
intent = in
optional = F
[lake]
[use_flake]
standard_name = flag_nonzero_lake_surface_fraction
long_name = flag indicating presence of some lake surface area fraction
units = flag
Expand Down
2 changes: 1 addition & 1 deletion physics/module_nst_water_prop.f90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -713,7 +713,7 @@ subroutine get_dtzm_2d(xt,xz,dt_cool,zc,wet,z1,z2,nx,ny,nth,dtm)

dtm(i,j) = zero ! initialize dtm

if ( wet(i,j) ) then
if ( wet(i,j)) then
!
! get the mean warming in the range of z=z1 to z=z2
!
Expand Down
53 changes: 29 additions & 24 deletions physics/sfc_nst.f
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -27,8 +27,8 @@ end subroutine sfc_nst_finalize
!> @{
subroutine sfc_nst_run &
& ( im, hvap, cp, hfus, jcal, eps, epsm1, rvrdm1, rd, rhw0, & ! --- inputs:
& pi, tgice, sbc, ps, u1, v1, t1, q1, tref, cm, ch, &
& prsl1, prslki, prsik1, prslk1, wet, xlon, sinlat, &
& pi, tgice, sbc, ps, u1, v1, t1, q1, tref, cm, ch, &
& prsl1, prslki, prsik1, prslk1, wet,use_flake, xlon, sinlat,&
& stress, &
& sfcemis, dlwflx, sfcnsw, rain, timestep, kdt, solhr,xcosz, &
& wind, flag_iter, flag_guess, nstf_name1, nstf_name4, &
Expand All @@ -47,7 +47,7 @@ subroutine sfc_nst_run &
! call sfc_nst !
! inputs: !
! ( im, ps, u1, v1, t1, q1, tref, cm, ch, !
! prsl1, prslki, wet, xlon, sinlat, stress, !
! prsl1, prslki, wet, use_flake, xlon, sinlat, stress, !
! sfcemis, dlwflx, sfcnsw, rain, timestep, kdt,solhr,xcosz, !
! wind, flag_iter, flag_guess, nstf_name1, nstf_name4, !
! nstf_name5, lprnt, ipr, !
Expand Down Expand Up @@ -94,6 +94,7 @@ subroutine sfc_nst_run &
! prsik1 - real, im !
! prslk1 - real, im !
! wet - logical, =T if any ocn/lake water (F otherwise) im !
! use_flake - logical, =T if any lake otherwise ocn
! icy - logical, =T if any ice im !
! xlon - real, longitude (radians) im !
! sinlat - real, sin of latitude im !
Expand Down Expand Up @@ -194,7 +195,8 @@ subroutine sfc_nst_run &
real (kind=kind_phys), intent(in) :: timestep
real (kind=kind_phys), intent(in) :: solhr

logical, dimension(im), intent(in) :: flag_iter, flag_guess, wet
logical, dimension(im), intent(in) :: flag_iter, flag_guess, wet, &
& use_flake
! &, icy
logical, intent(in) :: lprnt

Expand Down Expand Up @@ -259,14 +261,14 @@ subroutine sfc_nst_run &
!
do i = 1, im
! flag(i) = wet(i) .and. .not.icy(i) .and. flag_iter(i)
flag(i) = wet(i) .and. flag_iter(i)
flag(i) = wet(i) .and. flag_iter(i) .and. .not. use_flake(i)
enddo
!
! save nst-related prognostic fields for guess run
!
do i=1, im
! if(wet(i) .and. .not.icy(i) .and. flag_guess(i)) then
if(wet(i) .and. flag_guess(i)) then
if(wet(i) .and. flag_guess(i) .and. .not. use_flake(i)) then
xt_old(i) = xt(i)
xs_old(i) = xs(i)
xu_old(i) = xu(i)
Expand Down Expand Up @@ -582,7 +584,7 @@ subroutine sfc_nst_run &
! restore nst-related prognostic fields for guess run
do i=1, im
! if (wet(i) .and. .not.icy(i)) then
if (wet(i)) then
if (wet(i) .and. .not. use_flake(i)) then
if (flag_guess(i)) then ! when it is guess of
xt(i) = xt_old(i)
xs(i) = xs_old(i)
Expand Down Expand Up @@ -668,8 +670,9 @@ end subroutine sfc_nst_pre_finalize
!> \section NSST_general_pre_algorithm General Algorithm
!! @{
subroutine sfc_nst_pre_run
& (im,wet,tgice,tsfco,tsfc_wat,tsurf_wat,tseal,xt,xz,dt_cool,
& z_c, tref, cplflx, oceanfrac, nthreads, errmsg, errflg)
& (im, wet, use_flake, tgice, tsfco, tsfc_wat, tsurf_wat,
& tseal, xt, xz, dt_cool, z_c, tref, cplflx,
& oceanfrac, nthreads, errmsg, errflg)

use machine , only : kind_phys
use module_nst_water_prop, only: get_dtzm_2d
Expand All @@ -680,10 +683,11 @@ subroutine sfc_nst_pre_run

! --- inputs:
integer, intent(in) :: im, nthreads
logical, dimension(im), intent(in) :: wet
logical, dimension(im), intent(in) :: wet, use_flake
real (kind=kind_phys), intent(in) :: tgice
real (kind=kind_phys), dimension(im), intent(in) ::
& tsfco, tsfc_wat, xt, xz, dt_cool, z_c, oceanfrac
& tsfc_wat, xt, xz, dt_cool, z_c, oceanfrac,
& tsfco
logical, intent(in) :: cplflx

! --- input/outputs:
Expand All @@ -701,14 +705,14 @@ subroutine sfc_nst_pre_run
& half = 0.5_kp,
& omz1 = 2.0_kp
real(kind=kind_phys) :: tem1, tem2, dnsst
real(kind=kind_phys), dimension(im) :: dtzm,z_c_0
real(kind=kind_phys), dimension(im) :: dtzm, z_c_0

! Initialize CCPP error handling variables
errmsg = ''
errflg = 0

do i=1,im
if (wet(i)) then
if (wet(i) .and. .not. use_flake(i)) then
! tem = (oro(i)-oro_uf(i)) * rlapse
! DH* 20190927 simplyfing this code because tem is zero
!tem = zero
Expand All @@ -724,13 +728,13 @@ subroutine sfc_nst_pre_run
!
if (cplflx) then
z_c_0 = 0.0
call get_dtzm_2d (xt, xz, dt_cool, &
& z_c_0, wet, zero, omz1, im, 1, nthreads, dtzm)
call get_dtzm_2d (xt, xz, dt_cool, z_c, wet, &

@junwang-noaa junwang-noaa Apr 16, 2021

Copy link
Copy Markdown
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

@YihuaWu-NOAA the original code has "z_c_0", why is it changed to "z_c"?

& zero, omz1, im, 1, nthreads, dtzm)
do i=1,im
if (wet(i) .and. oceanfrac(i) > zero) then
! dnsst = tsfc_wat(i) - tref(i) ! retrive/get difference of Ts and Tf
tref(i) = max(tgice, tsfco(i) - dtzm(i)) ! update Tf with T1 and NSST T-Profile
! tsfc_wat(i) = max(271.2,tref(i) + dnsst) ! get Ts updated due to Tf update
if (wet(i).and.oceanfrac(i)>zero.and..not.use_flake(i)) then
! dnsst = tsfc_wat(i) - tref(i) ! retrive/get difference of Ts and Tf
tref(i) = max(tgice, tsfco(i) - dtzm(i)) ! update Tf with T1 and NSST T-Profile
! tsfc_wat(i) = max(271.2,tref(i) + dnsst) ! get Ts updated due to Tf update
! tseal(i) = tsfc_wat(i)
if (abs(xz(i)) > zero) then
tem2 = one / xz(i)
Expand Down Expand Up @@ -775,7 +779,8 @@ end subroutine sfc_nst_post_finalize
! \section NSST_detailed_post_algorithm Detailed Algorithm
! @{
subroutine sfc_nst_post_run &
& ( im, kdt, rlapse, tgice, wet, icy, oro, oro_uf, nstf_name1, &
& ( im, kdt, rlapse, tgice, wet, use_flake,icy, oro, oro_uf, &
& nstf_name1, &
& nstf_name4, nstf_name5, xt, xz, dt_cool, z_c, tref, xlon, &
& tsurf_wat, tsfc_wat, nthreads, dtzm, errmsg, errflg &
& )
Expand All @@ -789,7 +794,7 @@ subroutine sfc_nst_post_run &

! --- inputs:
integer, intent(in) :: im, kdt, nthreads
logical, dimension(im), intent(in) :: wet, icy
logical, dimension(im), intent(in) :: wet, icy, use_flake
real (kind=kind_phys), intent(in) :: rlapse, tgice
real (kind=kind_phys), dimension(im), intent(in) :: oro, oro_uf
integer, intent(in) :: nstf_name1, nstf_name4, nstf_name5
Expand Down Expand Up @@ -830,12 +835,12 @@ subroutine sfc_nst_post_run &
if (nstf_name1 > 1) then
zsea1 = 0.001_kp*real(nstf_name4)
zsea2 = 0.001_kp*real(nstf_name5)
call get_dtzm_2d (xt, xz, dt_cool, z_c, wet, zsea1, zsea2, &
& im, 1, nthreads, dtzm)
call get_dtzm_2d (xt, xz, dt_cool, z_c, wet, &
& zsea1, zsea2, im, 1, nthreads, dtzm)
do i = 1, im
! if (wet(i) .and. .not.icy(i)) then
! if (wet(i) .and. (frac_grid .or. .not. icy(i))) then
if (wet(i)) then
if (wet(i) .and. .not. use_flake(i)) then
tsfc_wat(i) = max(tgice, tref(i) + dtzm(i))
! tsfc_wat(i) = max(271.2, tref(i) + dtzm(i)) - &
! (oro(i)-oro_uf(i))*rlapse
Expand Down
Loading