Skip to content

Commit

Permalink
Merge pull request #1 from NCAR/master
Browse files Browse the repository at this point in the history 
pulling latest master into local ltp-bugfix
  • Loading branch information
@matusmartini
matusmartini authored Apr 19, 2021
2 parents 26aa3d6 + 045785a commit 76d879b
Show file tree
Hide file tree
Showing 8 changed files with 93 additions and 46 deletions.
12 changes: 6 additions & 6 deletions physics/GFS_surface_composites.F90
View file
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
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
32 changes: 25 additions & 7 deletions physics/flake_driver.F90
View file
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
2 changes: 1 addition & 1 deletion physics/flake_driver.meta
View file
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
39 changes: 22 additions & 17 deletions physics/sfc_nst.f
View file
Original file line number Diff line number Diff line change
Expand Up @@ -27,9 +27,9 @@ 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, &
& stress, &
& 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, &
& nstf_name5, lprnt, ipr, &
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 @@ -708,7 +712,7 @@ subroutine sfc_nst_pre_run
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 @@ -727,7 +731,7 @@ subroutine sfc_nst_pre_run
call get_dtzm_2d (xt, xz, dt_cool, &
& z_c_0, wet, zero, omz1, im, 1, nthreads, dtzm)
do i=1,im
if (wet(i) .and. oceanfrac(i) > zero) then
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
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 @@ -835,7 +840,7 @@ subroutine sfc_nst_post_run &
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
42 changes: 33 additions & 9 deletions physics/sfc_nst.meta
View file
Original file line number Diff line number Diff line change
Expand Up @@ -96,15 +96,6 @@
kind = kind_phys
intent = in
optional = F
[sbc]
standard_name = stefan_boltzmann_constant
long_name = Stefan-Boltzmann constant
units = W m-2 K-4
dimensions = ()
type = real
kind = kind_phys
intent = in
optional = F
[pi]
standard_name = pi
long_name = ratio of a circle's circumference to its diameter
Expand All @@ -123,6 +114,15 @@
kind = kind_phys
intent = in
optional = F
[sbc]
standard_name = stefan_boltzmann_constant
long_name = Stefan-Boltzmann constant
units = W m-2 K-4
dimensions = ()
type = real
kind = kind_phys
intent = in
optional = F
[ps]
standard_name = surface_air_pressure
long_name = surface pressure
Expand Down Expand Up @@ -239,6 +239,14 @@
type = logical
intent = in
optional = F
[use_flake]
standard_name = flag_nonzero_lake_surface_fraction
long_name = flag indicating presence of some lake surface area fraction
units = flag
dimensions = (horizontal_loop_extent)
type = logical
intent = in
optional = F
[xlon]
standard_name = longitude
long_name = longitude
Expand Down Expand Up @@ -680,6 +688,14 @@
type = logical
intent = in
optional = F
[use_flake]
standard_name = flag_nonzero_lake_surface_fraction
long_name = flag indicating presence of some lake surface area fraction
units = flag
dimensions = (horizontal_loop_extent)
type = logical
intent = in
optional = F
[tgice]
standard_name = freezing_point_temperature_of_seawater
long_name = freezing point temperature of seawater
Expand Down Expand Up @@ -865,6 +881,14 @@
type = logical
intent = in
optional = F
[use_flake]
standard_name = flag_nonzero_lake_surface_fraction
long_name = flag indicating presence of some lake surface area fraction
units = flag
dimensions = (horizontal_loop_extent)
type = logical
intent = in
optional = F
[icy]
standard_name = flag_nonzero_sea_ice_surface_fraction
long_name = flag indicating presence of some sea ice surface area fraction
Expand Down
8 changes: 4 additions & 4 deletions physics/sfc_ocean.F
View file
Original file line number Diff line number Diff line change
Expand Up @@ -27,7 +27,7 @@ subroutine sfc_ocean_run &
!...................................
! --- inputs:
& ( im, rd, eps, epsm1, rvrdm1, ps, t1, q1, &
& tskin, cm, ch, prsl1, prslki, wet, lake, wind, &, ! --- inputs
& tskin, cm, ch, prsl1, prslki, wet, use_flake, wind, &, ! --- inputs
& flag_iter, &
& qsurf, cmm, chh, gflux, evap, hflx, ep, & ! --- outputs
& errmsg, errflg &
Expand All @@ -42,7 +42,7 @@ subroutine sfc_ocean_run &
! inputs: !
! ( im, ps, t1, q1, tskin, cm, ch, !
!! ( im, ps, u1, v1, t1, q1, tskin, cm, ch, !
! prsl1, prslki, wet, lake, wind, flag_iter, !
! prsl1, prslki, wet, use_flake, wind, flag_iter, !
! outputs: !
! qsurf, cmm, chh, gflux, evap, hflx, ep ) !
! !
Expand Down Expand Up @@ -102,7 +102,7 @@ subroutine sfc_ocean_run &
real (kind=kind_phys), dimension(im), intent(in) :: ps, &
& t1, q1, tskin, cm, ch, prsl1, prslki, wind

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

! --- outputs:
real (kind=kind_phys), dimension(im), intent(inout) :: qsurf, &
Expand Down Expand Up @@ -130,7 +130,7 @@ subroutine sfc_ocean_run &
! ps is in pascals, wind is wind speed,
! rho is density, qss is sat. hum. at surface

if (wet(i) .and. flag_iter(i) .and. .not. lake(i)) then
if (wet(i) .and. flag_iter(i) .and. .not. use_flake(i)) then
q0 = max( q1(i), qmin )
rho = prsl1(i) / (rd*t1(i)*(one + rvrdm1*q0))

Expand Down
2 changes: 1 addition & 1 deletion physics/sfc_ocean.meta
View file
Original file line number Diff line number Diff line change
Expand Up @@ -131,7 +131,7 @@
type = logical
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

0 comments on commit 76d879b

Please sign in to comment.