Skip to content

Commit

Permalink
Added diffusivity angle adjustment to LW.
Browse files Browse the repository at this point in the history
  • Loading branch information
@dustinswales
dustinswales committed Dec 31, 2019
1 parent 28bea10 commit edcb672
Show file tree
Hide file tree
Showing 5 changed files with 120 additions and 9 deletions.
47 changes: 44 additions & 3 deletions physics/GFS_rrtmgp_pre.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -49,6 +49,8 @@ module GFS_rrtmgp_pre
use mo_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp
use mo_gas_concentrations, only: ty_gas_concs
use rrtmgp_aux, only: check_error_msg!, rrtmgp_minP, rrtmgp_minT
use mo_rrtmgp_constants, only: grav, avogad
use mo_rrtmg_lw_cloud_optics

real(kind_phys), parameter :: &
amd = 28.9644_kind_phys, & ! Molecular weight of dry-air (g/mol)
Expand Down Expand Up @@ -122,7 +124,7 @@ end subroutine GFS_rrtmgp_pre_init
!! \htmlinclude GFS_rrtmgp_pre.html
!!
subroutine GFS_rrtmgp_pre_run (Model, Grid, Statein, Coupling, Radtend, Sfcprop, Tbd, & ! IN
ncol, & ! IN
ncol, lw_gas_props, sec_diff_byband, & ! IN
raddt, p_lay, t_lay, p_lev, t_lev, tsfg, tsfa, cld_frac, cld_lwp, & ! OUT
cld_reliq, cld_iwp, cld_reice, cld_swp, cld_resnow, cld_rwp, cld_rerain, & ! OUT
tv_lay, relhum, tracer, cldsa, mtopa, mbota, de_lgth, gas_concentrations, & ! OUT
Expand All @@ -145,6 +147,8 @@ subroutine GFS_rrtmgp_pre_run (Model, Grid, Statein, Coupling, Radtend, Sfcprop,
Tbd ! DDT: FV3-GFS data not yet assigned to a defined container
integer, intent(in) :: &
ncol ! Number of horizontal grid points
type(ty_gas_optics_rrtmgp),intent(in) :: &
lw_gas_props ! RRTMGP DDT: longwave spectral information

! Outputs
real(kind_phys), dimension(ncol,Model%levs), intent(out) :: &
Expand Down Expand Up @@ -186,16 +190,19 @@ subroutine GFS_rrtmgp_pre_run (Model, Grid, Statein, Coupling, Radtend, Sfcprop,
cldsa ! Fraction of clouds for low, middle, high, total and BL
real(kind_phys), dimension(ncol), intent(out) :: &
de_lgth ! Decorrelation length
real(kind_phys), dimension(lw_gas_props%get_nband(),ncol),intent(out) :: &
sec_diff_byband

! Local variables
integer :: i, j, iCol, iBand, iSFC, iTOA, iLay
logical :: top_at_1
real(kind_phys),dimension(NCOL,Model%levs) :: vmr_o3, vmr_h2o
real(kind_phys) :: es, qs
real(kind_phys),dimension(NCOL,Model%levs) :: vmr_o3, vmr_h2o, coldry, tem0, colamt
real(kind_phys) :: es, qs, tem1, tem2
real(kind_phys), dimension(ncol, NF_ALBD) :: sfcalb
real(kind_phys), dimension(ncol, Model%levs) :: qs_lay, q_lay, deltaZ, deltaP, o3_lay
real(kind_phys), dimension(ncol, Model%levs, NF_VGAS) :: gas_vmr
real(kind_phys), dimension(ncol, Model%levs, NF_CLDS) :: clouds
real(kind_phys), dimension(ncol) :: precipitableH2o

! Initialize CCPP error handling variables
errmsg = ''
Expand Down Expand Up @@ -297,6 +304,40 @@ subroutine GFS_rrtmgp_pre_run (Model, Grid, Statein, Coupling, Radtend, Sfcprop,
call check_error_msg('GFS_rrtmgp_pre_run',gas_concentrations%set_vmr('h2o', vmr_h2o))
call check_error_msg('GFS_rrtmgp_pre_run',gas_concentrations%set_vmr('o3', vmr_o3))

! #######################################################################################
! Compute diffusivity angle adjustments for each longwave band
! *NOTE* Legacy RRTMGP code
! #######################################################################################
! Conpute diffusivity angle adjustments.
! First need to compute precipitable water in each column
tem0 = (1._kind_phys - vmr_h2o)*amd + vmr_h2o*amw
coldry = ( 1.0e-20 * 1.0e3 *avogad)*(deltap*.01) / (100.*grav*tem0*(1._kind_phys + vmr_h2o))
colamt = max(0._kind_phys, coldry*vmr_h2o)
do iCol=1,nCol
tem1 = 0._kind_phys
tem2 = 0._kind_phys
do iLay=1,Model%levs
tem1 = tem1 + coldry(iCol,iLay)+colamt(iCol,iLay)
tem2 = tem2 + colamt(iCol,iLay)
enddo
precipitableH2o(iCol) = p_lev(iCol,iSFC)*0.01*(10._kind_phys*tem2 / (amdw*tem1*grav))
enddo

! Reset diffusivity angle for Bands 2-3 and 5-9 to vary (between 1.50
! and 1.80) as a function of total column water vapor. the function
! has been defined to minimize flux and cooling rate errors in these bands
! over a wide range of precipitable water values.
do iCol=1,nCol
do iBand = 1, lw_gas_props%get_nband()
if (iBand==1 .or. iBand==4 .or. iBand==10) then
sec_diff_byband(iBand,iCol) = diffusivityB1410
else
sec_diff_byband(iBand,iCol) = min( diffusivityHigh, max(diffusivityLow, &
a0(iBand)+a1(iBand)*exp(a2(iBand)*precipitableH2o(iCol))))
endif
enddo
enddo

! #######################################################################################
! Radiation time step (output) (Is this really needed?) (Used by some diangostics)
! #######################################################################################
Expand Down
17 changes: 17 additions & 0 deletions physics/GFS_rrtmgp_pre.meta
View file
Original file line number Diff line number Diff line change
Expand Up @@ -112,6 +112,14 @@
type = integer
intent = in
optional = F
[lw_gas_props]
standard_name = coefficients_for_lw_gas_optics
long_name = DDT containing spectral information for RRTMGP LW radiation scheme
units = DDT
dimensions = ()
type = ty_gas_optics_rrtmgp
intent = in
optional = F
[raddt]
standard_name = time_step_for_radiation
long_name = radiation time step
Expand All @@ -121,6 +129,15 @@
kind = kind_phys
intent = out
optional = F
[sec_diff_byband]
standard_name = secant_of_diffusivity_angle_each_RRTMGP_LW_band
long_name = secant of diffusivity angle in each RRTMGP LW band
units = none
dimensions = (number_of_lw_bands_rrtmgp,horizontal_dimension)
type = real
kind = kind_phys
intent = out
optional = F
[p_lay]
standard_name = air_pressure_at_layer_for_RRTMGP_in_hPa
long_name = air pressure at vertical layer for radiation calculation
Expand Down
21 changes: 20 additions & 1 deletion physics/rrtmg_lw_cloud_optics.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -15,7 +15,24 @@ module mo_rrtmg_lw_cloud_optics
absrain = 0.33e-3, & ! Rain drop absorption coefficient \f$(m^{2}/g)\f$ .
abssnow0 = 1.5, & ! Snow flake absorption coefficient (micron), fu coeff
abssnow1 = 2.34e-3 ! Snow flake absorption coefficient \f$(m^{2}/g)\f$, ncar coef


! Reset diffusivity angle for Bands 2-3 and 5-9 to vary (between 1.50
! and 1.80) as a function of total column water vapor. the function
! has been defined to minimize flux and cooling rate errors in these bands
! over a wide range of precipitable water values.
! *NOTE* This is done in GFS_rrtmgp_lw_pre.F90:_run()
real (kind_phys), dimension(nbandsLW_RRTMG) :: &
a0 = (/ 1.66, 1.55, 1.58, 1.66, 1.54, 1.454, 1.89, 1.33, &
1.668, 1.66, 1.66, 1.66, 1.66, 1.66, 1.66, 1.66 /), &
a1 = (/ 0.00, 0.25, 0.22, 0.00, 0.13, 0.446, -0.10, 0.40, &
-0.006, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00 /), &
a2 = (/ 0.00, -12.0, -11.7, 0.00, -0.72, -0.243, 0.19, -0.062, &
0.414, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00 /)
real(kind_phys),parameter :: &
diffusivityLow = 1.50, & ! Minimum diffusivity angle for bands 2-3 and 5-9
diffusivityHigh = 1.80, & ! Maximum diffusivity angle for bands 2-3 and 5-9
diffusivityB1410 = 1.66 ! Diffusivity for bands 1, 4, and 10

! RRTMG LW cloud property coefficients
real(kind_phys) , dimension(58,nBandsLW_RRTMG),parameter :: &
absliq1 = reshape(source=(/ &
Expand Down Expand Up @@ -563,6 +580,8 @@ subroutine rrtmg_lw_cloud_optics(ncol, nlay, nBandsLW, cld_lwp, cld_ref_liq, cld
real(kind_phys) :: factor,fint,cld_ref_iceTemp,tau_snow, tau_rain
real(kind_phys),dimension(nBandsLW) :: tau_liq, tau_ice

tau_cld(:,:,:) = 0._kind_phys

if (ilwcliq .gt. 0) then
do ij=1,ncol
do ik=1,nlay
Expand Down
35 changes: 30 additions & 5 deletions physics/rrtmgp_lw_rte.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -28,8 +28,8 @@ end subroutine rrtmgp_lw_rte_init
!!
subroutine rrtmgp_lw_rte_run(doLWrad, nCol, nLev, p_lay, t_lay, p_lev, skt, lw_gas_props, &
sfc_emiss_byband, sources, lw_optical_props_clrsky, lw_optical_props_clouds, &
lw_optical_props_aerosol, fluxlwUP_allsky, fluxlwDOWN_allsky, fluxlwUP_clrsky, &
fluxlwDOWN_clrsky, hlw0, hlwb, errmsg, errflg)
lw_optical_props_aerosol, secdiff, fluxlwUP_allsky, fluxlwDOWN_allsky, &
fluxlwUP_clrsky, fluxlwDOWN_clrsky, hlw0, hlwb, errmsg, errflg)

! Inputs
logical, intent(in) :: &
Expand All @@ -55,7 +55,8 @@ subroutine rrtmgp_lw_rte_run(doLWrad, nCol, nLev, p_lay, t_lay, p_lev, skt, lw_g
type(ty_optical_props_1scl),intent(in) :: &
lw_optical_props_clouds, & ! RRTMGP DDT: longwave cloud radiative properties
lw_optical_props_aerosol ! RRTMGP DDT: longwave aerosol radiative properties

real(kind_phys), dimension(lw_gas_props%get_nband(),ncol),intent(in) :: &
secdiff
! Outputs
real(kind_phys), dimension(ncol,nLev+1), intent(out) :: &
fluxlwUP_allsky, & ! All-sky flux (W/m2)
Expand All @@ -74,6 +75,8 @@ subroutine rrtmgp_lw_rte_run(doLWrad, nCol, nLev, p_lay, t_lay, p_lev, skt, lw_g
hlw0 ! Clear-sky heating rate (K/sec)

! Local variables
integer :: &
iCol, iBand
type(ty_fluxes_byband) :: &
flux_allsky, flux_clrsky
real(kind_phys), dimension(ncol,nLev+1,lw_gas_props%get_nband()),target :: &
Expand All @@ -100,9 +103,20 @@ subroutine rrtmgp_lw_rte_run(doLWrad, nCol, nLev, p_lay, t_lay, p_lev, skt, lw_g
flux_clrsky%bnd_flux_up => fluxLW_up_clrsky
flux_clrsky%bnd_flux_dn => fluxLW_dn_clrsky

!
! Compute clear-sky fluxes (if requested)
! Clear-sky fluxes are gas+aerosol
!
! Add aerosol optics to gas optics
call check_error_msg('rrtmgp_lw_rte_run',lw_optical_props_aerosol%increment(lw_optical_props_clrsky))

! Apply diffusivity angle adjustment (RRTMG legacy)
do iCol=1,nCol
do iBand=1,lw_gas_props%get_nband()
lw_optical_props_clrsky%tau(iCol,1:nLev,iBand) = lw_optical_props_clrsky%tau(iCol,1:nLev,iBand)*secdiff(iBand,iCol)
enddo
enddo

! Call RTE solver
if (l_ClrSky_HR) then
call check_error_msg('rrtmgp_lw_rte_run',rte_lw( &
lw_optical_props_clrsky, & ! IN - optical-properties
Expand All @@ -115,9 +129,20 @@ subroutine rrtmgp_lw_rte_run(doLWrad, nCol, nLev, p_lay, t_lay, p_lev, skt, lw_g
fluxlwDOWN_clrsky = sum(flux_clrsky%bnd_flux_dn,dim=3)
endif

!
! All-sky fluxes
! Clear-sky fluxes are (gas+aerosol)+clouds
!

! Apply diffusivity angle adjustment (RRTMG legacy)
do iCol=1,nCol
do iBand=1,lw_gas_props%get_nband()
lw_optical_props_clrsky%tau(iCol,1:nLev,iBand) = lw_optical_props_clrsky%tau(iCol,1:nLev,iBand)*secdiff(iBand,iCol)
enddo
enddo
! Add cloud optics to clear-sky optics
call check_error_msg('rrtmgp_lw_rte_run',lw_optical_props_clouds%increment(lw_optical_props_clrsky))

! Call RTE solver
call check_error_msg('rrtmgp_lw_rte_run',rte_lw( &
lw_optical_props_clrsky, & ! IN - optical-properties
top_at_1, & ! IN - veritcal ordering flag
Expand Down
9 changes: 9 additions & 0 deletions physics/rrtmgp_lw_rte.meta
View file
Original file line number Diff line number Diff line change
Expand Up @@ -128,6 +128,15 @@
kind = kind_phys
intent = in
optional = T
[secdiff]
standard_name = secant_of_diffusivity_angle_each_RRTMGP_LW_band
long_name = secant of diffusivity angle in each RRTMGP LW band
units = none
dimensions = (number_of_lw_bands_rrtmgp,horizontal_dimension)
type = real
kind = kind_phys
intent = in
optional = F
[fluxlwUP_allsky]
standard_name = RRTMGP_lw_flux_profile_upward_allsky
long_name = RRTMGP upward longwave all-sky flux profile
Expand Down

0 comments on commit edcb672

Please sign in to comment.