Skip to content

Commit

Permalink
Merge pull request #5 from climbfuji/constants_update_dom_20210810
Browse files Browse the repository at this point in the history 
Constants update from main 2021/08/10
  • Loading branch information
@XiaSun-Atmos
XiaSun-Atmos authored Aug 10, 2021
2 parents 0ce2100 + 21f33f1 commit ba50531
Show file tree
Hide file tree
Showing 8 changed files with 187 additions and 127 deletions.
22 changes: 12 additions & 10 deletions physics/GFS_radiation_surface.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -62,7 +62,7 @@ subroutine GFS_radiation_surface_run ( &
sncovr_ice, fice, zorl, hprime, tsfg, tsfa, tisfc, coszen, &
min_seaice, min_lakeice, lakefrac, &
alvsf, alnsf, alvwf, alnwf, facsf, facwf, &
semis_lnd, semis_ice, snoalb, &
semis_lnd, semis_ice, snoalb, use_cice_alb, &
albdvis_lnd, albdnir_lnd, albivis_lnd, albinir_lnd, &
albdvis_ice, albdnir_ice, albivis_ice, albinir_ice, &
semisbase, semis, sfcalb, sfc_alb_dif, errmsg, errflg)
Expand All @@ -74,7 +74,7 @@ subroutine GFS_radiation_surface_run ( &
implicit none

integer, intent(in) :: im
logical, intent(in) :: frac_grid, lslwr, lsswr
logical, intent(in) :: frac_grid, lslwr, lsswr, use_cice_alb
integer, intent(in) :: lsm, lsm_noahmp, lsm_ruc, lndp_type, n_var_lndp
real(kind=kind_phys), intent(in) :: min_seaice, min_lakeice

Expand Down Expand Up @@ -160,7 +160,8 @@ subroutine GFS_radiation_surface_run ( &
!> - Call module_radiation_surface::setemis(),to set up surface
!! emissivity for LW radiation.
call setemis (lsm, lsm_noahmp, lsm_ruc, vtype, &
frac_grid, min_seaice, xlon, xlat, slmsk, &
frac_grid, xlon, xlat, slmsk, &
! frac_grid, min_seaice, xlon, xlat, slmsk, &
snowd, sncovr, sncovr_ice, zorl, tsfg, tsfa, &
hprime, semis_lnd, semis_ice, im, &
fracl, fraco, fraci, icy, & ! --- inputs
Expand All @@ -181,13 +182,14 @@ subroutine GFS_radiation_surface_run ( &
!> - Call module_radiation_surface::setalb(),to set up surface
!! albedor for SW radiation.

call setalb (slmsk, lsm, lsm_noahmp, lsm_ruc, snowd, sncovr, sncovr_ice, snoalb, &
zorl, coszen, tsfg, tsfa, hprime, frac_grid, min_seaice, &
alvsf, alnsf, alvwf, alnwf, facsf, facwf, fice, tisfc, &
albdvis_lnd, albdnir_lnd, albivis_lnd, albinir_lnd, &
albdvis_ice, albdnir_ice, albivis_ice, albinir_ice, &
IM, sfc_alb_pert, lndp_alb, fracl, fraco, fraci, icy, & ! --- inputs
sfcalb ) ! --- outputs
call setalb (slmsk, lsm, lsm_noahmp, lsm_ruc, use_cice_alb, snowd, sncovr, sncovr_ice, &
snoalb, zorl, coszen, tsfg, tsfa, hprime, frac_grid, lakefrac, &
! snoalb, zorl, coszen, tsfg, tsfa, hprime, frac_grid, min_seaice, &
alvsf, alnsf, alvwf, alnwf, facsf, facwf, fice, tisfc, &
albdvis_lnd, albdnir_lnd, albivis_lnd, albinir_lnd, &
albdvis_ice, albdnir_ice, albivis_ice, albinir_ice, &
IM, sfc_alb_pert, lndp_alb, fracl, fraco, fraci, icy, & ! --- inputs
sfcalb ) ! --- outputs

!> -# Approximate mean surface albedo from vis- and nir- diffuse values.
sfc_alb_dif(:) = max(0.01, 0.5 * (sfcalb(:,2) + sfcalb(:,4)))
Expand Down
8 changes: 8 additions & 0 deletions physics/GFS_radiation_surface.meta
View file
Original file line number Diff line number Diff line change
Expand Up @@ -404,6 +404,14 @@
kind = kind_phys
intent = in
optional = F
[use_cice_alb]
standard_name = flag_for_cice_albedo
long_name = flag for using ice albedos form CICE when coupled (default on)
units = flag
dimensions = ()
type = logical
intent = in
optional = F
[albdvis_lnd]
standard_name = surface_albedo_direct_visible_over_land
long_name = direct surface albedo visible band over land
Expand Down
14 changes: 7 additions & 7 deletions physics/GFS_surface_composites.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -29,7 +29,7 @@ end subroutine GFS_surface_composites_pre_finalize
!!
subroutine GFS_surface_composites_pre_run (im, flag_init, flag_restart, lkm, lsm, lsm_noahmp, lsm_ruc, frac_grid, &
flag_cice, cplflx, cplice, cplwav2atm, landfrac, lakefrac, lakedepth, oceanfrac, frland, &
dry, icy, lake, use_flake, ocean, wet, hice, cice, zorlo, zorll, zorli, &
dry, icy, lake, use_flake, wet, hice, cice, zorlo, zorll, zorli, &
snowd, snowd_lnd, snowd_ice, tprcp, tprcp_wat, &
tprcp_lnd, tprcp_ice, uustar, uustar_wat, uustar_lnd, uustar_ice, &
weasd, weasd_lnd, weasd_ice, ep1d_ice, tsfc, tsfco, tsfcl, tsfc_wat, &
Expand All @@ -45,7 +45,7 @@ subroutine GFS_surface_composites_pre_run (im, flag_init, flag_restart, lkm, lsm
integer, intent(in ) :: lsm, lsm_noahmp, lsm_ruc
logical, intent(in ) :: flag_init, flag_restart, frac_grid, cplflx, cplice, cplwav2atm
logical, dimension(:), intent(inout) :: flag_cice
logical, dimension(:), intent(inout) :: dry, icy, lake, use_flake, ocean, wet
logical, dimension(:), intent(inout) :: dry, icy, lake, use_flake, wet
real(kind=kind_phys), dimension(:), intent(in ) :: landfrac, lakefrac, lakedepth, oceanfrac
real(kind=kind_phys), dimension(:), intent(inout) :: cice, hice
real(kind=kind_phys), dimension(:), intent( out) :: frland
Expand All @@ -62,7 +62,7 @@ subroutine GFS_surface_composites_pre_run (im, flag_init, flag_restart, lkm, lsm
real(kind=kind_phys), dimension(:), intent(in ) :: semis_rad
real(kind=kind_phys), dimension(:), intent(inout) :: semis_wat, semis_lnd, semis_ice, slmsk
real(kind=kind_phys), dimension(:), intent(inout) :: emis_lnd, emis_ice
real(kind=kind_phys), intent(in ) :: min_lakeice, min_seaice
real(kind=kind_phys), intent(in ) :: min_lakeice, min_seaice
!
real(kind=kind_phys), dimension(:), intent(inout) :: zorlo, zorll, zorli
!
Expand Down Expand Up @@ -129,21 +129,21 @@ subroutine GFS_surface_composites_pre_run (im, flag_init, flag_restart, lkm, lsm
endif
endif
else ! all land
cice(i) = zero
hice(i) = zero
cice(i) = zero
hice(i) = zero
islmsk_cice(i) = 1
islmsk(i) = 1
wet(i) = .false.
icy(i) = .false.
flag_cice(i) = .false.
endif
enddo
enddo

else

do i = 1, IM
if (islmsk(i) == 1) then
! tsfcl(i) = tsfc(i)
! tsfcl(i) = tsfc(i)
dry(i) = .true.
frland(i) = one
cice(i) = zero
Expand Down
8 changes: 0 additions & 8 deletions physics/GFS_surface_composites.meta
View file
Original file line number Diff line number Diff line change
Expand Up @@ -180,14 +180,6 @@
type = logical
intent = inout
optional = F
[ocean]
standard_name = flag_nonzero_ocean_surface_fraction
long_name = flag indicating presence of some ocean surface area fraction
units = flag
dimensions = (horizontal_loop_extent)
type = logical
intent = inout
optional = F
[wet]
standard_name = flag_nonzero_wet_surface_fraction
long_name = flag indicating presence of some ocean or lake surface area fraction
Expand Down
1 change: 0 additions & 1 deletion physics/GFS_surface_generic.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -149,7 +149,6 @@ subroutine GFS_surface_generic_pre_run (im, levs, vfrac, islmsk, isot, ivegsrc,
soiltyp(i) = int( stype(i)+0.5_kind_phys )
vegtype(i) = int( vtype(i)+0.5_kind_phys )
slopetyp(i) = int( slope(i)+0.5_kind_phys ) !! clu: slope -> slopetyp
if (soiltyp(i) < 1) soiltyp(i) = 14
if (vegtype(i) < 1) vegtype(i) = 17
if (slopetyp(i) < 1) slopetyp(i) = 1
endif
Expand Down
7 changes: 4 additions & 3 deletions physics/gcycle.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -124,9 +124,10 @@ subroutine gcycle (me, nthrds, nx, ny, isc, jsc, nsst, tile_num, nlunit,
!
if (frac_grid) then
do ix=1,npts
if (landfrac(ix) > -1.0e-8_kind_phys) then
slmskl(ix) = ceiling(landfrac(ix)-1.0e-8_kind_phys)
slmskw(ix) = floor(landfrac(ix)+1.0e-8_kind_phys)
! if (landfrac(ix) > -1.0e-8_kind_phys) then
if (landfrac(ix) > 0.0_kind_phys) then
slmskl(ix) = ceiling(landfrac(ix)-1.0e-6_kind_phys)
slmskw(ix) = floor(landfrac(ix)+1.0e-6_kind_phys)
else
if (nint(slmsk(ix)) == 1) then
slmskl(ix) = 1.0_kind_phys
Expand Down
118 changes: 70 additions & 48 deletions physics/radiation_surface.f
View file
Original file line number Diff line number Diff line change
Expand Up @@ -332,9 +332,10 @@ end subroutine sfc_init
!! @{
!-----------------------------------
subroutine setalb &
& ( slmsk,lsm,lsm_noahmp,lsm_ruc,snowf, & ! --- inputs:
& ( slmsk,lsm,lsm_noahmp,lsm_ruc,use_cice_alb,snowf, & ! --- inputs:
& sncovr,sncovr_ice,snoalb,zorlf,coszf, &
& tsknf,tairf,hprif,frac_grid,min_seaice, &
& tsknf,tairf,hprif,frac_grid, lakefrac, &
! & tsknf,tairf,hprif,frac_grid,min_seaice, &
& alvsf,alnsf,alvwf,alnwf,facsf,facwf,fice,tisfc, &
& lsmalbdvis, lsmalbdnir, lsmalbivis, lsmalbinir, &
& icealbdvis, icealbdnir, icealbivis, icealbinir, &
Expand Down Expand Up @@ -406,15 +407,16 @@ subroutine setalb &
! --- inputs
integer, intent(in) :: IMAX
integer, intent(in) :: lsm, lsm_noahmp, lsm_ruc
logical, intent(in) :: frac_grid
logical, intent(in) :: use_cice_alb, frac_grid

real (kind=kind_phys), dimension(:), intent(in) :: &
& lakefrac, &
& slmsk, snowf, zorlf, coszf, tsknf, tairf, hprif, &
& alvsf, alnsf, alvwf, alnwf, facsf, facwf, fice, tisfc, &
& icealbdvis, icealbdnir, icealbivis, icealbinir, &
& sncovr, sncovr_ice, snoalb, albPpert ! sfc-perts, mgehne
real (kind=kind_phys), intent(in) :: pertalb ! sfc-perts, mgehne
real (kind=kind_phys), intent(in) :: min_seaice
! real (kind=kind_phys), intent(in) :: min_seaice
real (kind=kind_phys), dimension(:), intent(in) :: &
& fracl, fraco, fraci
real (kind=kind_phys), dimension(:),intent(inout) :: &
Expand All @@ -438,7 +440,8 @@ subroutine setalb &

real (kind=kind_phys) :: alndnb, alndnd, alndvb, alndvd

real (kind=kind_phys) ffw, dtgd
real (kind=kind_phys) ffw, dtgd, icealb
real (kind=kind_phys), parameter :: epsln=1.0e-8_kind_phys

integer :: i, k, kk, iflag

Expand All @@ -464,49 +467,59 @@ subroutine setalb &
asenb_wat = asevb_wat
endif

if (icy(i)) then
!-- Computation of ice albedo
asnow = 0.02*snowf(i)
argh = min(0.50, max(.025, 0.01*zorlf(i)))
hrgh = min(f_one,max(0.20,1.0577-1.1538e-3*hprif(i)))
fsno0 = asnow / (argh + asnow) * hrgh ! snow fraction on ice
! diffused
if (tsknf(i) > 271.1 .and. tsknf(i) < 271.5) then
!tgs: looks like albedo reduction from puddles on ice
a1 = (tsknf(i) - 271.1)**2
asevd_ice = 0.7 - 4.0*a1
asend_ice = 0.65 - 3.6875*a1
if (icy(i)) then !-- Computation of ice albedo

if (use_cice_alb .and. lakefrac(i) < epsln) then
icealb = icealbivis(i)
else
asevd_ice = 0.70
asend_ice = 0.65
icealb = f_zero
endif
! direct
asevb_ice = asevd_ice
asenb_ice = asend_ice

if (fsno0 > f_zero) then
! Snow on ice
dtgd = max(f_zero, min(5.0, (con_ttp-tisfc(i)) ))
b1 = 0.03 * dtgd
asnvd = (asevd_ice + b1) ! diffused snow albedo
asnnd = (asend_ice + b1)
if (coszf(i) > 0.0001 .and. coszf(i) < 0.5) then ! direct snow albedo
csnow = 0.5 * (3.0 / (f_one+4.0*coszf(i)) - f_one)
asnvb = min( 0.98, asnvd+(f_one-asnvd)*csnow )
asnnb = min( 0.98, asnnd+(f_one-asnnd)*csnow )
if (icealb > epsln) then !-- use ice albedo from CICE for sea-ice
asevd_ice = icealbivis(i)
asend_ice = icealbinir(i)
asevb_ice = icealbdvis(i)
asenb_ice = icealbdnir(i)
else
asnow = 0.02*snowf(i)
argh = min(0.50, max(.025, 0.01*zorlf(i)))
hrgh = min(f_one,max(0.20,1.0577-1.1538e-3*hprif(i)))
fsno0 = asnow / (argh + asnow) * hrgh ! snow fraction on ice
! diffused
if (tsknf(i) > 271.1 .and. tsknf(i) < 271.5) then
!tgs: looks like albedo reduction from puddles on ice
a1 = (tsknf(i) - 271.1)**2
asevd_ice = 0.7 - 4.0*a1
asend_ice = 0.65 - 3.6875*a1
else
asnvb = asnvd
asnnb = asnnd
asevd_ice = 0.70
asend_ice = 0.65
endif
! direct
asevb_ice = asevd_ice
asenb_ice = asend_ice

! composite ice and snow albedos
asevd_ice = asevd_ice * (1. - fsno0) + asnvd * fsno0
asend_ice = asend_ice * (1. - fsno0) + asnnd * fsno0
asevb_ice = asevb_ice * (1. - fsno0) + asnvb * fsno0
asenb_ice = asenb_ice * (1. - fsno0) + asnnb * fsno0
endif ! snow
else
! icy = false, fill in values
if (fsno0 > f_zero) then ! Snow on ice
dtgd = max(f_zero, min(5.0, (con_ttp-tisfc(i)) ))
b1 = 0.03 * dtgd
asnvd = (asevd_ice + b1) ! diffused snow albedo
asnnd = (asend_ice + b1)
if (coszf(i) > 0.0001 .and. coszf(i) < 0.5) then ! direct snow albedo
csnow = 0.5 * (3.0 / (f_one+4.0*coszf(i)) - f_one)
asnvb = min( 0.98, asnvd+(f_one-asnvd)*csnow )
asnnb = min( 0.98, asnnd+(f_one-asnnd)*csnow )
else
asnvb = asnvd
asnnb = asnnd
endif

! composite ice and snow albedos
asevd_ice = asevd_ice * (1. - fsno0) + asnvd * fsno0
asend_ice = asend_ice * (1. - fsno0) + asnnd * fsno0
asevb_ice = asevb_ice * (1. - fsno0) + asnvb * fsno0
asenb_ice = asenb_ice * (1. - fsno0) + asnnb * fsno0
endif ! snow
endif ! if (use_cice_alb .and. lakefrac < epsln)
else ! icy = false, fill in values
asevd_ice = 0.70
asend_ice = 0.65
asevb_ice = 0.70
Expand Down Expand Up @@ -586,9 +599,17 @@ subroutine setalb &
!tgs: this part of the code needs the input from the ice
! model. Otherwise it uses the backup albedo computation
! from ialbflg = 1.
if (icy(i)) then
if(lsm == lsm_ruc ) then
!-- use ice albedo from the RUC ice model
if (icy(i)) then !-- Computation of ice albedo
if (use_cice_alb .and. lakefrac(i) < epsln) then
icealb = icealbivis(i)
else
icealb = f_zero
endif
if (lsm == lsm_ruc .or. icealb > epsln) then !-- use ice albedo from the RUC ice model or
!-- use ice albedo from CICE for sea-ice
asevd_ice = icealbivis(i)
asend_ice = icealbinir(i)
asevb_ice = icealbdvis(i)
Expand Down Expand Up @@ -706,7 +727,8 @@ end subroutine setalb
!-----------------------------------
subroutine setemis &
& ( lsm,lsm_noahmp,lsm_ruc,vtype,frac_grid, & ! --- inputs:
& min_seaice,xlon,xlat,slmsk,snowf,sncovr,sncovr_ice, &
& xlon,xlat,slmsk,snowf,sncovr,sncovr_ice, &
! & min_seaice,xlon,xlat,slmsk,snowf,sncovr,sncovr_ice, &
& zorlf,tsknf,tairf,hprif, &
& semis_lnd,semis_ice,IMAX,fracl,fraco,fraci,icy, &
& semisbase, sfcemis & ! --- outputs:
Expand Down Expand Up @@ -763,7 +785,7 @@ subroutine setemis &
integer, intent(in) :: lsm, lsm_noahmp, lsm_ruc
logical, intent(in) :: frac_grid
real (kind=kind_phys), dimension(:), intent(in) :: vtype
real (kind=kind_phys), intent(in) :: min_seaice
! real (kind=kind_phys), intent(in) :: min_seaice
real (kind=kind_phys), dimension(:), intent(in) :: &
& xlon,xlat, slmsk, snowf,sncovr, sncovr_ice, &
Expand Down
Loading

0 comments on commit ba50531

Please sign in to comment.