Skip to content

Commit

Permalink
Merge pull request #824 from SMoorthi-emc/SM_Nov222021
Browse files Browse the repository at this point in the history 
Sm nov222021
  • Loading branch information
@grantfirl
grantfirl authored Jan 10, 2022
2 parents 9880f44 + 8d97f46 commit fc331b8
Show file tree
Hide file tree
Showing 6 changed files with 236 additions and 232 deletions.
34 changes: 17 additions & 17 deletions physics/GFS_rrtmgp_lw_post.F90
View file
Original file line number Diff line number Diff line change
@@ -1,10 +1,10 @@
module GFS_rrtmgp_lw_post
module GFS_rrtmgp_lw_post
use machine, only: kind_phys
use module_radlw_parameters, only: topflw_type, sfcflw_type
use mo_heating_rates, only: compute_heating_rate
use radiation_tools, only: check_error_msg
implicit none

public GFS_rrtmgp_lw_post_init,GFS_rrtmgp_lw_post_run,GFS_rrtmgp_lw_post_finalize

contains
Expand All @@ -25,18 +25,18 @@ subroutine GFS_rrtmgp_lw_post_run (nCol, nLev, lslwr, do_lw_clrsky_hr, save_diag
fluxlwDOWN_clrsky, raddt, cldsa, mtopa, mbota, cld_frac, cldtaulw, fluxr, sfcdlw, &
sfculw, sfcflw, tsflw, htrlw, htrlwu, topflw, htrlwc, errmsg, errflg)

! Inputs
integer, intent(in) :: &
! Inputs
integer, intent(in) :: &
nCol, & ! Horizontal loop extent
nLev, & ! Number of vertical layers
iSFC, & ! Vertical index for surface level
iTOA ! Vertical index for TOA level
logical, intent(in) :: &
lslwr, & ! Logical flags for lw radiation calls
do_lw_clrsky_hr, & ! Output clear-sky SW heating-rate?
save_diag ! Output radiation diagnostics?
do_lw_clrsky_hr, & ! Output clear-sky SW heating-rate?
save_diag ! Output radiation diagnostics?
real(kind_phys), intent(in) :: &
fhlwr ! Frequency for SW radiation
fhlwr ! Frequency for SW radiation
real(kind_phys), dimension(nCol), intent(in) :: &
tsfa ! Lowest model layer air temperature for radiation (K)
real(kind_phys), dimension(nCol, nLev), intent(in) :: &
Expand All @@ -50,23 +50,23 @@ subroutine GFS_rrtmgp_lw_post_run (nCol, nLev, lslwr, do_lw_clrsky_hr, save_diag
real(kind_phys), intent(in) :: &
raddt ! Radiation time step
real(kind_phys), dimension(nCol,5), intent(in) :: &
cldsa ! Fraction of clouds for low, middle, high, total and BL
cldsa ! Fraction of clouds for low, middle, high, total and BL
integer, dimension(nCol,3), intent(in) ::&
mbota, & ! vertical indices for low, middle and high cloud tops
mtopa ! vertical indices for low, middle and high cloud bases
real(kind_phys), dimension(nCol,nLev), intent(in) :: &
cld_frac, & ! Total cloud fraction in each layer
cldtaulw ! approx 10.mu band layer cloud optical depth
cldtaulw ! approx 10.mu band layer cloud optical depth

real(kind=kind_phys), dimension(:,:), intent(inout) :: fluxr

! Outputs (mandatory)
real(kind_phys), dimension(nCol), intent(inout) :: &
sfcdlw, & ! Total sky sfc downward lw flux (W/m2)
sfculw, & ! Total sky sfc upward lw flux (W/m2)
tsflw ! surface air temp during lw calculation (K)
type(sfcflw_type), dimension(nCol), intent(inout) :: &
sfcflw ! LW radiation fluxes at sfc
sfcflw ! LW radiation fluxes at sfc
real(kind_phys), dimension(nCol,nLev), intent(inout) :: &
htrlw, & ! LW all-sky heating rate
htrlwu ! Heating-rate updated in-between radiation calls.
Expand All @@ -80,7 +80,7 @@ subroutine GFS_rrtmgp_lw_post_run (nCol, nLev, lslwr, do_lw_clrsky_hr, save_diag
! Outputs (optional)
real(kind_phys),dimension(nCol, nLev),intent(inout),optional :: &
htrlwc ! Longwave clear-sky heating-rate (K/sec)

! Local variables
integer :: i, j, k, itop, ibtc
real(kind_phys) :: tem0d, tem1, tem2
Expand All @@ -92,7 +92,7 @@ subroutine GFS_rrtmgp_lw_post_run (nCol, nLev, lslwr, do_lw_clrsky_hr, save_diag

if (.not. lslwr) return
! #######################################################################################
! Compute LW heating-rates.
! Compute LW heating-rates.
! #######################################################################################
! Clear-sky heating-rate (optional)
if (do_lw_clrsky_hr) then
Expand All @@ -102,7 +102,7 @@ subroutine GFS_rrtmgp_lw_post_run (nCol, nLev, lslwr, do_lw_clrsky_hr, save_diag
p_lev, & ! IN - Pressure @ layer-interfaces (Pa)
htrlwc)) ! OUT - Longwave clear-sky heating rate (K/sec)
endif

! All-sky heating-rate (mandatory)
call check_error_msg('GFS_rrtmgp_post',compute_heating_rate( &
fluxlwUP_allsky, & ! IN - RRTMGP upward longwave all-sky flux profiles (W/m2)
Expand Down Expand Up @@ -136,8 +136,8 @@ subroutine GFS_rrtmgp_lw_post_run (nCol, nLev, lslwr, do_lw_clrsky_hr, save_diag

! #######################################################################################
! Save LW diagnostics
! - For time averaged output quantities (including total-sky and clear-sky SW and LW
! fluxes at TOA and surface; conventional 3-domain cloud amount, cloud top and base
! - For time averaged output quantities (including total-sky and clear-sky SW and LW
! fluxes at TOA and surface; conventional 3-domain cloud amount, cloud top and base
! pressure, and cloud top temperature; aerosols AOD, etc.), store computed results in
! corresponding slots of array fluxr with appropriate time weights.
! - Collect the fluxr data for wrtsfc
Expand Down
58 changes: 30 additions & 28 deletions physics/GFS_rrtmgp_sw_post.F90
View file
Original file line number Diff line number Diff line change
@@ -1,12 +1,12 @@
module GFS_rrtmgp_sw_post
module GFS_rrtmgp_sw_post
use machine, only: kind_phys
use module_radiation_aerosols, only: NSPC1
use module_radsw_parameters, only: topfsw_type, sfcfsw_type, cmpfsw_type
use mo_heating_rates, only: compute_heating_rate
use radiation_tools, only: check_error_msg
use rrtmgp_sw_gas_optics, only: sw_gas_props
implicit none

public GFS_rrtmgp_sw_post_init,GFS_rrtmgp_sw_post_run,GFS_rrtmgp_sw_post_finalize

contains
Expand All @@ -31,25 +31,25 @@ subroutine GFS_rrtmgp_sw_post_run (nCol, nLev, nDay, idxday, lsswr, do_sw_clrsky
nirbmdi, nirdfdi, visbmdi, visdfdi, nirbmui, nirdfui, visbmui, visdfui, sfcnsw, &
sfcdsw, htrsw, sfcfsw, topfsw, htrswc, scmpsw, errmsg, errflg)

! Inputs
integer, intent(in) :: &
nCol, & ! Horizontal loop extent
! Inputs
integer, intent(in) :: &
nCol, & ! Horizontal loop extent
nLev, & ! Number of vertical layers
nDay, & ! Number of daylit columns
iSFC, & ! Vertical index for surface level
iTOA ! Vertical index for TOA level
integer, intent(in), dimension(nday) :: &
idxday ! Index array for daytime points
logical, intent(in) :: &
lsswr, & ! Call SW radiation?
do_sw_clrsky_hr, & ! Output clear-sky SW heating-rate?
save_diag ! Output radiation diagnostics?
logical, intent(in) :: &
lsswr, & ! Call SW radiation?
do_sw_clrsky_hr, & ! Output clear-sky SW heating-rate?
save_diag ! Output radiation diagnostics?
real(kind_phys), intent(in) :: &
fhswr ! Frequency for SW radiation
real(kind_phys), dimension(nCol), intent(in) :: &
t_lay, & ! Temperature at model layer centers (K)
coszen, & ! Cosine(SZA)
coszdg ! Cosine(SZA), daytime
coszen, & ! Cosine(SZA)
coszdg ! Cosine(SZA), daytime
real(kind_phys), dimension(nCol, nLev+1), intent(in) :: &
p_lev ! Pressure @ model layer-interfaces (Pa)
real(kind_phys), dimension(sw_gas_props%get_nband(),ncol), intent(in) :: &
Expand All @@ -65,9 +65,9 @@ subroutine GFS_rrtmgp_sw_post_run (nCol, nLev, nDay, idxday, lsswr, do_sw_clrsky
real(kind_phys), intent(in) :: &
raddt ! Radiation time step
real(kind_phys), dimension(nCol,NSPC1), intent(in) :: &
aerodp ! Vertical integrated optical depth for various aerosol species
aerodp ! Vertical integrated optical depth for various aerosol species
real(kind_phys), dimension(nCol,5), intent(in) :: &
cldsa ! Fraction of clouds for low, middle, high, total and BL
cldsa ! Fraction of clouds for low, middle, high, total and BL
integer, dimension(nCol,3), intent(in) ::&
mbota, & ! vertical indices for low, middle and high cloud tops
mtopa ! vertical indices for low, middle and high cloud bases
Expand All @@ -81,10 +81,10 @@ subroutine GFS_rrtmgp_sw_post_run (nCol, nLev, nDay, idxday, lsswr, do_sw_clrsky
! nirbm - downward nir direct beam flux (W/m2)
! nirdf - downward nir diffused flux (W/m2)
! visbm - downward uv+vis direct beam flux (W/m2)
! visdf - downward uv+vis diffused flux (W/m2)
! visdf - downward uv+vis diffused flux (W/m2)

real(kind=kind_phys), dimension(:,:), intent(inout) :: fluxr

! Outputs (mandatory)
real(kind_phys), dimension(nCol), intent(inout) :: &
nirbmdi, & ! sfc nir beam sw downward flux (W/m2)
Expand All @@ -94,7 +94,7 @@ subroutine GFS_rrtmgp_sw_post_run (nCol, nLev, nDay, idxday, lsswr, do_sw_clrsky
nirbmui, & ! sfc nir beam sw upward flux (W/m2)
nirdfui, & ! sfc nir diff sw upward flux (W/m2)
visbmui, & ! sfc uv+vis beam sw upward flux (W/m2)
visdfui, & ! sfc uv+vis diff sw upward flux (W/m2)
visdfui, & ! sfc uv+vis diff sw upward flux (W/m2)
sfcnsw, & ! total sky sfc netsw flx into ground
sfcdsw !
real(kind_phys), dimension(nCol,nLev), intent(inout) :: &
Expand All @@ -111,7 +111,7 @@ subroutine GFS_rrtmgp_sw_post_run (nCol, nLev, nDay, idxday, lsswr, do_sw_clrsky
! Outputs (optional)
real(kind_phys),dimension(nCol, nLev),intent(inout),optional :: &
htrswc ! Clear-sky heating rate (K/s)

! Local variables
integer :: i, j, k, itop, ibtc
real(kind_phys) :: tem0d, tem1, tem2
Expand Down Expand Up @@ -182,15 +182,17 @@ subroutine GFS_rrtmgp_sw_post_run (nCol, nLev, nDay, idxday, lsswr, do_sw_clrsky
htrsw(:,:) = 0.0
sfcfsw = sfcfsw_type( 0.0, 0.0, 0.0, 0.0 )
topfsw = topfsw_type( 0.0, 0.0, 0.0 )
nirbmdi(:) = 0.0
nirdfdi(:) = 0.0
visbmdi(:) = 0.0
visdfdi(:) = 0.0
nirbmui(:) = 0.0
nirdfui(:) = 0.0
visbmui(:) = 0.0
visdfui(:) = 0.0

do i=1,nCol
nirbmdi(i) = 0.0
nirdfdi(i) = 0.0
visbmdi(i) = 0.0
visdfdi(i) = 0.0
nirbmui(i) = 0.0
nirdfui(i) = 0.0
visbmui(i) = 0.0
visdfui(i) = 0.0
enddo

if (do_sw_clrsky_hr) then
htrswc(:,:) = 0
endif
Expand Down Expand Up @@ -236,7 +238,7 @@ subroutine GFS_rrtmgp_sw_post_run (nCol, nLev, nDay, idxday, lsswr, do_sw_clrsky
fluxr(i,27) = fluxr(i,27) + nirdfdi(i) * tem0d ! nir diff sw dn
! SW clear-sky fluxes
fluxr(i,29) = fluxr(i,29) + topfsw(i)%upfx0 * tem0d
fluxr(i,31) = fluxr(i,31) + sfcfsw(i)%upfx0 * tem0d
fluxr(i,31) = fluxr(i,31) + sfcfsw(i)%upfx0 * tem0d
fluxr(i,32) = fluxr(i,32) + sfcfsw(i)%dnfx0 * tem0d
endif
enddo
Expand Down
35 changes: 18 additions & 17 deletions physics/GFS_surface_composites.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -211,6 +211,7 @@ subroutine GFS_surface_composites_pre_run (im, flag_init, flag_restart, lkm, fra
uustar_wat(i) = uustar(i)
tsfc_wat(i) = tsfco(i)
tsurf_wat(i) = tsfco(i)
zorlo(i) = max(1.0e-5, min(one, zorlo(i)))
! DH*
else
zorlo(i) = huge
Expand All @@ -233,6 +234,7 @@ subroutine GFS_surface_composites_pre_run (im, flag_init, flag_restart, lkm, fra
tsurf_ice(i) = tisfc(i)
ep1d_ice(i) = zero
gflx_ice(i) = zero
zorli(i) = max(1.0e-5, min(one, zorli(i)))
! DH*
else
zorli(i) = huge
Expand All @@ -256,39 +258,38 @@ subroutine GFS_surface_composites_pre_run (im, flag_init, flag_restart, lkm, fra
endif
enddo
!
if (.not. cplflx .or. kdt == 1) then
if (frac_grid) then
do i=1,im
if (dry(i)) then
if (icy(i)) then
if (frac_grid) then
do i=1,im
if (dry(i)) then
if (icy(i)) then
if (kdt == 1 .or. (.not. cplflx .or. lakefrac(i) > zero)) then
tem = one / (cice(i)*(one-frland(i)))
snowd_ice(i) = max(zero, (snowd(i) - snowd_lnd(i)*frland(i)) * tem)
weasd_ice(i) = max(zero, (weasd(i) - weasd_lnd(i)*frland(i)) * tem)
endif
elseif (icy(i)) then
endif
elseif (icy(i)) then
if (kdt == 1 .or. (.not. cplflx .or. lakefrac(i) > zero)) then
tem = one / cice(i)
snowd_lnd(i) = zero
snowd_ice(i) = snowd(i) * tem
weasd_lnd(i) = zero
weasd_ice(i) = weasd(i) * tem
endif
enddo
else
do i=1,im
if (dry(i)) then
snowd_lnd(i) = snowd(i)
weasd_lnd(i) = weasd(i)
snowd_ice(i) = zero
weasd_ice(i) = zero
elseif (icy(i)) then
endif
enddo
else
do i=1,im
if (icy(i)) then
if (kdt == 1 .or. (.not. cplflx .or. lakefrac(i) > zero)) then
snowd_lnd(i) = zero
weasd_lnd(i) = zero
tem = one / cice(i)
snowd_ice(i) = snowd(i) * tem
weasd_ice(i) = weasd(i) * tem
endif
enddo
endif
endif
enddo
endif

! write(0,*)' minmax of ice snow=',minval(snowd_ice),maxval(snowd_ice)
Expand Down
Loading

0 comments on commit fc331b8

Please sign in to comment.