diff --git a/physics/GFS_rrtmgp_pre.F90 b/physics/GFS_rrtmgp_pre.F90 index a15158b86..4d076706c 100644 --- a/physics/GFS_rrtmgp_pre.F90 +++ b/physics/GFS_rrtmgp_pre.F90 @@ -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) @@ -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 @@ -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) :: & @@ -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 = '' @@ -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) ! ####################################################################################### diff --git a/physics/GFS_rrtmgp_pre.meta b/physics/GFS_rrtmgp_pre.meta index 87934aa24..35f455447 100644 --- a/physics/GFS_rrtmgp_pre.meta +++ b/physics/GFS_rrtmgp_pre.meta @@ -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 @@ -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 diff --git a/physics/rrtmg_lw_cloud_optics.F90 b/physics/rrtmg_lw_cloud_optics.F90 index 217b3fa4d..31551d797 100644 --- a/physics/rrtmg_lw_cloud_optics.F90 +++ b/physics/rrtmg_lw_cloud_optics.F90 @@ -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=(/ & @@ -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 diff --git a/physics/rrtmgp_lw_rte.F90 b/physics/rrtmgp_lw_rte.F90 index 9a300df4f..6d5b1f6ef 100644 --- a/physics/rrtmgp_lw_rte.F90 +++ b/physics/rrtmgp_lw_rte.F90 @@ -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) :: & @@ -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) @@ -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 :: & @@ -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 @@ -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 diff --git a/physics/rrtmgp_lw_rte.meta b/physics/rrtmgp_lw_rte.meta index 47168c75b..7083586cf 100644 --- a/physics/rrtmgp_lw_rte.meta +++ b/physics/rrtmgp_lw_rte.meta @@ -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