Skip to content

Commit

Permalink
Merge pull request #524 from shansun6/bugfix_gfdl_SM_2mod_20201130
Browse files Browse the repository at this point in the history 
Bug fix in GFS_surface_composites.F90 from Moorthi
  • Loading branch information
@climbfuji
climbfuji committed Dec 2, 2020
2 parents 4e39b50 + bc4fcb0 commit d076cc2
Show file tree
Hide file tree
Showing 2 changed files with 121 additions and 73 deletions.
157 changes: 94 additions & 63 deletions physics/GFS_surface_composites.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -24,15 +24,15 @@ end subroutine GFS_surface_composites_pre_finalize
!> \section arg_table_GFS_surface_composites_pre_run Argument Table
!! \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, cice, cimin, zorl, zorlo, zorll, zorli, zorl_wat, &
zorl_lnd, zorl_ice, 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,&
tsfc_lnd, tsfc_ice, tisfc, tice, tsurf, tsurf_wat, tsurf_lnd, tsurf_ice, &
gflx_ice, tgice, islmsk, semis_rad, semis_wat, semis_lnd, semis_ice, &
qss, qss_wat, qss_lnd, qss_ice, hflx, hflx_wat, hflx_lnd, hflx_ice, &
subroutine GFS_surface_composites_pre_run (im, lkm, frac_grid, flag_cice, cplflx, cplwav2atm, &
landfrac, lakefrac, lakedepth, oceanfrac, frland, &
dry, icy, lake, ocean, wet, hice, cice, zorl, zorlo, zorll, zorli, zorl_wat, &
zorl_lnd, zorl_ice, 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, &
tsfc_lnd, tsfc_ice, tisfc, tice, tsurf, tsurf_wat, tsurf_lnd, tsurf_ice, &
gflx_ice, tgice, islmsk, islmsk_cice, slmsk, semis_rad, semis_wat, semis_lnd, semis_ice, &
qss, qss_wat, qss_lnd, qss_ice, hflx, hflx_wat, hflx_lnd, hflx_ice, &
min_lakeice, min_seaice, errmsg, errflg)

implicit none
Expand All @@ -42,9 +42,8 @@ subroutine GFS_surface_composites_pre_run (im, lkm, frac_grid, flag_cice, cplflx
logical, intent(in ) :: frac_grid, cplflx, cplwav2atm
logical, dimension(im), intent(inout) :: flag_cice
logical, dimension(im), intent(inout) :: dry, icy, lake, ocean, wet
real(kind=kind_phys), intent(in ) :: cimin
real(kind=kind_phys), dimension(im), intent(in ) :: landfrac, lakefrac, lakedepth, oceanfrac
real(kind=kind_phys), dimension(im), intent(inout) :: cice
real(kind=kind_phys), dimension(im), intent(inout) :: cice, hice
real(kind=kind_phys), dimension(im), intent( out) :: frland
real(kind=kind_phys), dimension(im), intent(in ) :: zorl, snowd, tprcp, uustar, weasd, qss, hflx

Expand All @@ -55,11 +54,13 @@ subroutine GFS_surface_composites_pre_run (im, lkm, frac_grid, flag_cice, cplflx
qss_wat, qss_lnd, qss_ice, hflx_wat, hflx_lnd, hflx_ice, ep1d_ice, gflx_ice
real(kind=kind_phys), dimension(im), intent( out) :: tice
real(kind=kind_phys), intent(in ) :: tgice
integer, dimension(im), intent(inout) :: islmsk
integer, dimension(im), intent(inout) :: islmsk, islmsk_cice
real(kind=kind_phys), dimension(im), intent(in ) :: semis_rad
real(kind=kind_phys), dimension(im), intent(inout) :: semis_wat, semis_lnd, semis_ice
real(kind=kind_phys), dimension(im), intent(inout) :: semis_wat, semis_lnd, semis_ice, slmsk
real(kind=kind_phys), intent(in ) :: min_lakeice, min_seaice

real(kind=kind_phys), parameter :: timin = 173.0_kind_phys ! minimum temperature allowed for snow/ice

! CCPP error handling
character(len=*), intent(out) :: errmsg
integer, intent(out) :: errflg
Expand All @@ -76,37 +77,49 @@ subroutine GFS_surface_composites_pre_run (im, lkm, frac_grid, flag_cice, cplflx
frland(i) = landfrac(i)
if (frland(i) > zero) dry(i) = .true.
if (frland(i) < one) then
if (flag_cice(i)) then
if (oceanfrac(i) > zero) then
if (cice(i) >= min_seaice) then
icy(i) = .true.
if (cice(i) < one) wet(i) = .true. ! some open ocean/lake water exists
tisfc(i) = max(timin, min(tisfc(i), tgice))
if (cplflx) then
islmsk_cice(i) = 4
flag_cice(i) = .true.
else
islmsk_cice(i) = 2
endif
islmsk(i) = 2
else
cice(i) = zero
hice(i) = zero
flag_cice(i) = .false.
! islmsk_cice(i) = 0
! islmsk(i) = 0
wet(i) = .true. ! some open ocean/lake water exists
islmsk_cice(i) = 0
islmsk(i) = 0
endif
if (cice(i) < one) then
wet(i) = .true. ! some open ocean
if (.not. cplflx .and. icy(i)) tsfco(i) = max(tisfc(i), tgice)
endif
else
if (cice(i) >= min_lakeice) then
icy(i) = .true.
if (cice(i) < one) wet(i) = .true. ! some open ocean/lake water exists
islmsk(i) = 2
tisfc(i) = max(timin, min(tisfc(i), tgice))
else
cice(i) = zero
! islmsk(i) = 0
wet(i) = .true. ! some open ocean/lake water exists
hice(i) = zero
islmsk(i) = 0
endif
endif
if (wet(i) .and. .not. cplflx) then
if (oceanfrac(i) > zero) then
tsfco(i) = max(tsfco(i), tisfc(i), tgice)
elseif (icy(i)) then
tsfco(i) = max(tisfc(i), tgice)
islmsk_cice(i) = islmsk(i)
if (cice(i) < one) then
wet(i) = .true. ! some open lake
if (icy(i)) tsfco(i) = max(tisfc(i), tgice)
endif
endif
else
else ! all land
cice(i) = zero
hice(i) = zero
islmsk_cice(i) = 1
islmsk(i) = 1
endif
enddo

Expand All @@ -118,27 +131,39 @@ subroutine GFS_surface_composites_pre_run (im, lkm, frac_grid, flag_cice, cplflx
dry(i) = .true.
frland(i) = one
cice(i) = zero
hice(i) = zero
else
frland(i) = zero
if (flag_cice(i)) then
if (cice(i) > min_seaice) then
icy(i) = .true.
if (oceanfrac(i) > zero) then
if (cice(i) >= min_seaice) then
icy(i) = .true.
tisfc(i) = max(timin, min(tisfc(i), tgice))
else
cice(i) = zero
hice(i) = zero
flag_cice(i) = .false.
islmsk(i) = 0
islmsk_cice(i) = 0
endif
if (cice(i) < one) then
wet(i) = .true. ! some open ocean
if (.not. cplflx .and. icy(i)) tsfco(i) = max(tisfc(i), tgice)
endif
else
if (cice(i) > min_lakeice) then
if (cice(i) >= min_lakeice) then
icy(i) = .true.
tisfc(i) = max(timin, min(tisfc(i), tgice))
else
cice(i) = zero
hice(i) = zero
flag_cice(i) = .false.
islmsk(i) = 0
endif
endif
if (cice(i) < one) then
wet(i) = .true. ! some open ocean/lake water exists
if (.not. cplflx .and. icy(i)) tsfco(i) = max(tisfc(i), tgice)
islmsk_cice(i) = islmsk(i)
if (cice(i) < one) then
wet(i) = .true. ! some open lake
if (icy(i)) tsfco(i) = max(tisfc(i), tgice)
endif
endif
endif
enddo
Expand Down Expand Up @@ -170,7 +195,7 @@ subroutine GFS_surface_composites_pre_run (im, lkm, frac_grid, flag_cice, cplflx
! snowd_wat(i) = snowd(i)
weasd_wat(i) = zero
snowd_wat(i) = zero
semis_wat(i) = 0.984d0
semis_wat(i) = 0.984_kind_phys
qss_wat(i) = qss(i)
hflx_wat(i) = hflx(i)
endif
Expand Down Expand Up @@ -198,6 +223,7 @@ subroutine GFS_surface_composites_pre_run (im, lkm, frac_grid, flag_cice, cplflx
qss_ice(i) = qss(i)
hflx_ice(i) = hflx(i)
endif
if (nint(slmsk(i)) /= 1) slmsk(i) = islmsk(i)
enddo

! to prepare to separate lake from ocean under water category
Expand Down Expand Up @@ -364,7 +390,7 @@ subroutine GFS_surface_composites_post_run (

! Local variables
integer :: i, k
real(kind=kind_phys) :: txl, txi, txo, tem
real(kind=kind_phys) :: txl, txi, txo, wfrac

! Initialize CCPP error handling variables
errmsg = ''
Expand All @@ -377,9 +403,10 @@ subroutine GFS_surface_composites_post_run (
do i=1, im

! Three-way composites (fields from sfc_diff)
txl = landfrac(i)
txi = cice(i)*(one - txl) ! txi = ice fraction wrt whole cell
txo = max(zero, one - txl - txi)
txl = landfrac(i) ! land fraction
wfrac = one - txl ! ocean fraction
txi = cice(i) * wfrac ! txi = ice fraction wrt whole cell
txo = max(zero, wfrac-txi) ! txo = open water fraction

zorl(i) = txl*zorl_lnd(i) + txi*zorl_ice(i) + txo*zorl_wat(i)
cd(i) = txl*cd_lnd(i) + txi*cd_ice(i) + txo*cd_wat(i)
Expand All @@ -404,11 +431,10 @@ subroutine GFS_surface_composites_post_run (
!tprcp(i) = txl*tprcp_lnd(i) + txi*tprcp_ice(i) + txo*tprcp_wat(i)

if (.not. flag_cice(i) .and. islmsk(i) == 2) then
tem = one - txl
evap(i) = txl*evap_lnd(i) + tem*evap_ice(i)
hflx(i) = txl*hflx_lnd(i) + tem*hflx_ice(i)
qss(i) = txl*qss_lnd(i) + tem*qss_ice(i)
gflx(i) = txl*gflx_lnd(i) + tem*gflx_ice(i)
evap(i) = txl*evap_lnd(i) + wfrac*evap_ice(i)
hflx(i) = txl*hflx_lnd(i) + wfrac*hflx_ice(i)
qss(i) = txl*qss_lnd(i) + wfrac*qss_ice(i)
gflx(i) = txl*gflx_lnd(i) + wfrac*gflx_ice(i)
else
evap(i) = txl*evap_lnd(i) + txi*evap_ice(i) + txo*evap_wat(i)
hflx(i) = txl*hflx_lnd(i) + txi*hflx_ice(i) + txo*hflx_wat(i)
Expand Down Expand Up @@ -451,14 +477,18 @@ subroutine GFS_surface_composites_post_run (
! tisfc(i) = tsfc_ice(i) ! over ice when uncoupled
! endif

if (.not. flag_cice(i)) then
if (islmsk(i) == 2) then ! return updated lake ice thickness & concentration to global array
tisfc(i) = tice(i)
else ! this would be over open ocean or land (no ice fraction)
hice(i) = zero
cice(i) = zero
tisfc(i) = tsfc(i)
endif
! if (.not. flag_cice(i)) then
! if (islmsk(i) == 2) then ! return updated lake ice thickness & concentration to global array
! tisfc(i) = tice(i)
! else ! this would be over open ocean or land (no ice fraction)
! hice(i) = zero
! cice(i) = zero
! tisfc(i) = tsfc(i)
! endif
! endif
if (.not. icy(i)) then
hice(i) = zero
cice(i) = zero
endif
enddo

Expand All @@ -478,6 +508,9 @@ subroutine GFS_surface_composites_post_run (
fh2(i) = fh2_lnd(i)
!tsurf(i) = tsurf_lnd(i)
tsfcl(i) = tsfc_lnd(i) ! over land
tsfc(i) = tsfcl(i)
tsfco(i) = tsfc(i)
tisfc(i) = tsfc(i)
cmm(i) = cmm_lnd(i)
chh(i) = chh_lnd(i)
gflx(i) = gflx_lnd(i)
Expand All @@ -488,11 +521,8 @@ subroutine GFS_surface_composites_post_run (
evap(i) = evap_lnd(i)
hflx(i) = hflx_lnd(i)
qss(i) = qss_lnd(i)
tsfc(i) = tsfc_lnd(i)
hice(i) = zero
cice(i) = zero
tisfc(i) = tsfc(i)
tsfco(i) = tsfc(i)
elseif (islmsk(i) == 0) then
zorl(i) = zorl_wat(i)
cd(i) = cd_wat(i)
Expand All @@ -506,7 +536,9 @@ subroutine GFS_surface_composites_post_run (
fh2(i) = fh2_wat(i)
!tsurf(i) = tsurf_wat(i)
tsfco(i) = tsfc_wat(i) ! over lake (and ocean when uncoupled)
tsfc(i) = tsfco(i)
tsfcl(i) = tsfc(i)
tisfc(i) = tsfc(i)
cmm(i) = cmm_wat(i)
chh(i) = chh_wat(i)
gflx(i) = gflx_wat(i)
Expand All @@ -517,10 +549,8 @@ subroutine GFS_surface_composites_post_run (
evap(i) = evap_wat(i)
hflx(i) = hflx_wat(i)
qss(i) = qss_wat(i)
tsfc(i) = tsfc_wat(i)
hice(i) = zero
cice(i) = zero
tisfc(i) = tsfc(i)
else ! islmsk(i) == 2
zorl(i) = zorl_ice(i)
cd(i) = cd_ice(i)
Expand All @@ -544,12 +574,13 @@ subroutine GFS_surface_composites_post_run (
evap(i) = evap_ice(i)
hflx(i) = hflx_ice(i)
qss(i) = qss_ice(i)
tisfc(i) = tice(i)
if (.not. flag_cice(i)) then
tisfc(i) = tice(i) ! over lake ice (and sea ice when uncoupled)
! tisfc(i) = tice(i) ! over lake ice (and sea ice when uncoupled)
zorl(i) = cice(i) * zorl_ice(i) + (one - cice(i)) * zorl_wat(i)
tsfc(i) = tsfc_ice(i)
tsfc(i) = tsfc_ice(i) ! over lake (and ocean when uncoupled)
elseif (wet(i)) then
if (cice(i) > min_seaice) then ! this was already done for lake ice in sfc_sice
if (cice(i) >= min_seaice) then ! this was already done for lake ice in sfc_sice
txi = cice(i)
txo = one - txi
evap(i) = txi * evap_ice(i) + txo * evap_wat(i)
Expand All @@ -576,7 +607,7 @@ subroutine GFS_surface_composites_post_run (
endif
tsfcl(i) = tsfc(i)
do k=1,kice ! store tiice in stc to reduce output in the nonfrac grid case
stc(i,k)=tiice(i,k)
stc(i,k) = tiice(i,k)
end do
endif

Expand Down
37 changes: 27 additions & 10 deletions physics/GFS_surface_composites.meta
View file
Original file line number Diff line number Diff line change
Expand Up @@ -140,23 +140,23 @@
type = logical
intent = inout
optional = F
[cice]
standard_name = sea_ice_concentration
long_name = ice fraction over open water
units = frac
[hice]
standard_name = sea_ice_thickness
long_name = sea ice thickness
units = m
dimensions = (horizontal_loop_extent)
type = real
kind = kind_phys
intent = inout
optional = F
[cimin]
standard_name = minimum_sea_ice_concentration
long_name = minimum sea ice concentration
[cice]
standard_name = sea_ice_concentration
long_name = ice fraction over open water
units = frac
dimensions = ()
dimensions = (horizontal_loop_extent)
type = real
kind = kind_phys
intent = in
intent = inout
optional = F
[zorl]
standard_name = surface_roughness_length
Expand Down Expand Up @@ -506,7 +506,24 @@
units = flag
dimensions = (horizontal_loop_extent)
type = integer
intent = in
intent = inout
optional = F
[islmsk_cice]
standard_name = sea_land_ice_mask_cice
long_name = sea/land/ice mask cice (=0/1/2)
units = flag
dimensions = (horizontal_loop_extent)
type = integer
intent = inout
optional = F
[slmsk]
standard_name = sea_land_ice_mask_real
long_name = landmask: sea/land/ice=0/1/2
units = flag
dimensions = (horizontal_loop_extent)
type = real
kind = kind_phys
intent = inout
optional = F
[semis_rad]
standard_name = surface_longwave_emissivity
Expand Down

0 comments on commit d076cc2

Please sign in to comment.