Skip to content

Commit

Permalink
Clear sky 3D radiative heat tendencies added as output variables with…
Browse files Browse the repository at this point in the history 
… CAM and all RRTMG radiation schemes (wrf-model#1258)

TYPE: enhancement

KEYWORDS: radiation, clear-sky heating, CAM, RRTM, RRTMG, RRTMG-fast, RRTMG-K

SOURCE: James Ruppert (Penn State University)

DESCRIPTION OF CHANGES: 
Three-dimensional clear sky radiative heat tendencies are made available as output variables when using the following 
radiation schemes: 
   * RRTM longwave (ra_lw_phys=1)
   * CAM shortwave and longwave (ra_sw_phys, ra_lw_phys=3)
   * RRTMG shortwave and longwave (ra_sw_phys, ra_lw_phys=4)
   * RRTMG-fast version shortwave and longwave (ra_sw_phys, ra_lw_phys=24)
   * RRTMG-K shortwave and longwave (ra_sw_phys, ra_lw_phys=14). 

Two new variables are added only to the restart stream in Registry.EM_COMMON, defined as 
"UNCOUPLED THETA TEND DUE TO CLEAR SKY LONG [or SHORT] WAVE RAD", and with the units "K s-1". 
   * RTHRATENLWC ("RTHRATLWC" in history files)
   * RTHRATENSWC ("RTHRATSWC")

In the case of the three RRTMG schemes, the clear sky tendencies were already calculated, and hence just needed to 
be passed up to the main radiation driver (module_radiation_driver.F) and RK driver (module_first_rk_step_part1.F). 

For CAM, the clear-sky fluxes were calculated but not the corresponding heating rates. The appropriate code was added 
to do so, mimicking the calculations for all-sky but invoking only clear-sky fluxes.

LIST OF MODIFIED FILES:
M       Registry/Registry.EM_COMMON
M       dyn_em/module_first_rk_step_part1.F
M       dyn_nmm/module_PHYSICS_CALLS.F
M       phys/module_ra_cam.F
M       phys/module_ra_rrtm.F
M       phys/module_ra_rrtmg_lw.F
M       phys/module_ra_rrtmg_lwf.F
M       phys/module_ra_rrtmg_sw.F
M       phys/module_ra_rrtmg_swf.F
M       phys/module_ra_rrtmg_swk.F
M       phys/module_radiation_driver.F

TESTS CONDUCTED: 
1. Compiled okay with Intel. Verified that the clear-sky radiative heat tendencies are nearly identical to corresponding all-sky tendencies on the large scale, with much less variance at the cloud scales. All-sky total radiative heat tendency (RTHRATEN) is unchanged, as are the uncoupled longwave and shortwave tendencies (RTHRATENLW, RTHRATENSW).
2. Jenkins testing OK

RELEASE NOTE: Three-dimensional clear sky radiative heat tendencies are now available as output variables when using the following radiation schemes: RRTM longwave (ra_lw_phys=1), CAM shortwave and longwave (ra_sw_phys, ra_lw_phys=3), RRTMG shortwave and longwave (ra_sw_phys, ra_lw_phys=4), RRTMG-fast version shortwave and longwave (ra_sw_phys, ra_lw_phys=24), and RRTMG-K shortwave and longwave (ra_sw_phys, ra_lw_phys=14). Similar to the all-sky longwave and shortwave radiative heat tendencies (RTHRATLW and RTHRATSW), the clear-sky tendencies are not included in the default history output stream, but can now be added to it. They can be found in Registry.EM_COMMON as RTHRATLWC for longwave clear-sky heating rate and RTHRATSWC for shortwave clear-sky heating rate.
  • Loading branch information
@jhruppert @vlakshmanan-scala
jhruppert authored and vlakshmanan-scala committed Apr 4, 2024
1 parent 629a6fb commit 614c320
Show file tree
Hide file tree
Showing 11 changed files with 115 additions and 32 deletions.
2 changes: 2 additions & 0 deletions Registry/Registry.EM_COMMON
View file
Original file line number Diff line number Diff line change
Expand Up @@ -1619,7 +1619,9 @@ state integer STEPCU - misc 1 - r "S

state real RTHRATEN ikj misc 1 - rd "RTHRATEN" "THETA TENDENCY DUE TO RADIATION" "K s-1"
state real RTHRATENLW ikj misc 1 - r "RTHRATLW" "UNCOUPLED THETA TENDENCY DUE TO LONG WAVE RADIATION" "K s-1"
state real RTHRATENLWC ikj misc 1 - r "RTHRATLWC" "UNCOUPLED THETA TEND DUE TO CLEAR SKY LONG WAVE RAD" "K s-1"
state real RTHRATENSW ikj misc 1 - r "RTHRATSW" "UNCOUPLED THETA TENDENCY DUE TO SHORT WAVE RADIATION" "K s-1"
state real RTHRATENSWC ikj misc 1 - r "RTHRATSWC" "UNCOUPLED THETA TEND DUE TO CLEAR SKY SHORT WAVE RAD" "K s-1"
state real CLDFRA ikj misc 1 - i0rh "CLDFRA" "CLOUD FRACTION" ""
state real CONVCLD ij misc 1 - r "CONVCLD" "BMJ CONVECTIVE CLOUD" "kg m-2"
state real CCLDFRA ikj misc 1 - r "CCLDFRA" "CONVECTIVE CLOUD FRACTION" ""
Expand Down
1 change: 1 addition & 0 deletions dyn_em/module_first_rk_step_part1.F
View file
Original file line number Diff line number Diff line change
Expand Up @@ -273,6 +273,7 @@ SUBROUTINE first_rk_step_part1 ( grid , config_flags &
& ,RHO=grid%rho ,RLWTOA=grid%rlwtoa &
& ,RSWTOA=grid%rswtoa ,RTHRATEN=grid%rthraten &
& ,RTHRATENLW=grid%rthratenlw ,RTHRATENSW=grid%rthratensw &
& ,RTHRATENLWC=grid%rthratenlwc ,RTHRATENSWC=grid%rthratenswc &
& ,SNOW=grid%snow ,STEPRA=grid%stepra ,SWDOWN=grid%swdown &
& ,SWDOWNC=grid%swdownc ,SW_PHYSICS=config_flags%ra_sw_physics &
& ,T8W=t8w ,T=grid%t_phy ,TAUCLDC=grid%taucldc &
Expand Down
7 changes: 5 additions & 2 deletions dyn_nmm/module_PHYSICS_CALLS.F
View file
Original file line number Diff line number Diff line change
Expand Up @@ -196,7 +196,6 @@ SUBROUTINE RADIATION(NTSD,DT,JULDAY,JULYR,XTIME,JULIAN &
SWVISDIF, &
SWNIRDIR, &
SWNIRDIF

!
!..Additions for coupling cloud physics effective radii and radiation. G. Thompson
REAL,DIMENSION(IMS:IME,JMS:JME,KMS:KME),INTENT(INOUT):: re_cloud, re_ice, re_snow
Expand Down Expand Up @@ -235,7 +234,8 @@ SUBROUTINE RADIATION(NTSD,DT,JULDAY,JULYR,XTIME,JULIAN &
& ,P8W,P_PHY,PI_PHY &
& ,RR,T8W &
& ,THRATENLW,THRATENSW &
& ,TH_PHY,T_PHY,Z_PHY
& ,TH_PHY,T_PHY,Z_PHY &
& ,RTHRATENLWC,RTHRATENSWC
!
REAL,DIMENSION(:,:,:,:),ALLOCATABLE :: MOIST_TRANS
!
Expand Down Expand Up @@ -313,6 +313,8 @@ SUBROUTINE RADIATION(NTSD,DT,JULDAY,JULYR,XTIME,JULIAN &
& /(P_PHY(I,K,J)*G)
!
RTHRATEN(I,K,J)=0.
RTHRATENLWC(I,K,J)=0.
RTHRATENSWC(I,K,J)=0.
THRATENLW(I,K,J)=0.
THRATENSW(I,K,J)=0.
! PM2_5_DRY(I,K,J)=0.
Expand Down Expand Up @@ -424,6 +426,7 @@ SUBROUTINE RADIATION(NTSD,DT,JULDAY,JULYR,XTIME,JULIAN &
& ,aer_ssa_opt=config_flags%aer_ssa_opt,aer_ssa_val=config_flags%aer_ssa_val &
& ,aer_asy_opt=config_flags%aer_asy_opt,aer_asy_val=config_flags%aer_asy_val &
& ,RTHRATENLW=THRATENLW,RTHRATENSW=THRATENSW &
& ,RTHRATENLWC=RTHRATENLWC,RTHRATENSWC=RTHRATENSWC &
& ,RTHRATEN=RTHRATEN &
& ,CEN_LAT=grid%cen_lat &
& ,GLW=TOTLWDN,GSW=SWNETDN,SWDOWN=TOTSWDN &
Expand Down
52 changes: 41 additions & 11 deletions phys/module_ra_cam.F
View file
Original file line number Diff line number Diff line change
Expand Up @@ -195,7 +195,7 @@ MODULE module_ra_cam
data amo / 48.0000 /
contains
subroutine camrad(RTHRATENLW,RTHRATENSW, &
subroutine camrad(RTHRATENLW,RTHRATENSW,RTHRATENLWC,RTHRATENSWC, &
dolw,dosw, &
SWUPT,SWUPTC,SWDNT,SWDNTC, &
LWUPT,LWUPTC,LWDNT,LWDNTC, &
Expand Down Expand Up @@ -276,7 +276,9 @@ subroutine camrad(RTHRATENLW,RTHRATENSW, &
REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), &
INTENT(INOUT) :: RTHRATENLW, &
RTHRATENSW
RTHRATENLWC, &
RTHRATENSW, &
RTHRATENSWC
!
REAL, DIMENSION( ims:ime, jms:jme ), &
INTENT(IN ) :: XLAT, &
Expand Down Expand Up @@ -421,10 +423,12 @@ subroutine camrad(RTHRATENLW,RTHRATENSW, &
real(r8), dimension( 1:ite-its+1 ) :: solsd ! Downward solar rad onto surface (sw diffuse)
real(r8), dimension( 1:ite-its+1 ) :: solld ! Downward solar rad onto surface (lw diffuse)
real(r8), dimension( 1:ite-its+1, 1:kte-kts+1 ) :: qrs ! Solar heating rate
real(r8), dimension( 1:ite-its+1, 1:kte-kts+1 ) :: qrscs ! Clear sky solar heating rate
real(r8), dimension( 1:ite-its+1 ) :: fsds ! Flux Shortwave Downwelling Surface
real(r8), dimension( 1:ite-its+1 ) :: fsdsdir ! Flux Shortwave Direct Downwelling Surface
real(r8), dimension( 1:ite-its+1 ) :: fsdsdif ! Flux Shortwave Diffuse Downwelling Surface
real(r8), dimension( 1:ite-its+1, 1:kte-kts+1 ) :: qrl ! Longwave cooling rate
real(r8), dimension( 1:ite-its+1, 1:kte-kts+1 ) :: qrlcs ! Clear sky longwave cooling rate
real(r8), dimension( 1:ite-its+1 ) :: flwds ! Surface down longwave flux
real(r8), dimension( 1:ite-its+1, levsiz, num_months ) :: ozmixmj ! monthly ozone mixing ratio
real(r8), dimension( 1:ite-its+1, levsiz ) :: ozmix ! ozone mixing ratio (time interpolated)
Expand Down Expand Up @@ -770,7 +774,7 @@ subroutine camrad(RTHRATENLW,RTHRATENSW, &
fsdndir ,fsdncdir,fsdndif ,fsdncdif, & ! amontornes-bcodina (2014-04-20) Dir/Dif fluxes
flup, flupc, fldn, fldnc, swcftoa, lwcftoa, olrtoa, &
fsns, fsnt ,flns ,flnt , &
qrs, qrl, flwds, rel, rei, &
qrs, qrscs, qrl, qrlcs, flwds, rel, rei, &
sols, soll, solsd, solld, &
!ccc
#ifdef CLWRFGHG
Expand All @@ -786,6 +790,8 @@ subroutine camrad(RTHRATENLW,RTHRATENSW, &
ii = i - its + 1
if(dolw)RTHRATENLW(I,K,J) = 1.e4*qrl(ii,kk)/(cpair*pi_phy(i,k,j))
if(dosw)RTHRATENSW(I,K,J) = 1.e4*qrs(ii,kk)/(cpair*pi_phy(i,k,j))
if(dolw)RTHRATENLWC(I,K,J) = 1.e4*qrlcs(ii,kk)/(cpair*pi_phy(i,k,j))
if(dosw)RTHRATENSWC(I,K,J) = 1.e4*qrscs(ii,kk)/(cpair*pi_phy(i,k,j))
cemiss(i,k,j) = emis(ii,kk)
taucldc(i,k,j) = tauxcl(ii,kk)
taucldi(i,k,j) = tauxci(ii,kk)
Expand Down Expand Up @@ -1578,7 +1584,7 @@ subroutine radctl(j, lchnk ,ncol , pcols, pver, pverp, pverr, pverrp, ppcns
flup ,flupc ,fldn ,fldnc , &
swcf ,lwcf ,flut , &
fsns ,fsnt ,flns ,flnt , &
qrs ,qrl ,flwds ,rel ,rei , &
qrs ,qrscs ,qrl ,qrlcs ,flwds ,rel ,rei , &
sols ,soll ,solsd ,solld , &
!ccc
#ifdef CLWRFGHG
Expand Down Expand Up @@ -1694,6 +1700,7 @@ subroutine radctl(j, lchnk ,ncol , pcols, pver, pverp, pverr, pverrp, ppcns
real(r8), intent(out) :: solsd(pcols) ! Downward solar rad onto surface (sw diffuse)
real(r8), intent(out) :: solld(pcols) ! Downward solar rad onto surface (lw diffuse)
real(r8), intent(out) :: qrs(pcols,pver) ! Solar heating rate
real(r8), intent(out) :: qrscs(pcols,pver) ! Clear sky solar heating rate
real(r8), intent(out) :: fsds(pcols) ! Flux Shortwave Downwelling Surface
real(r8), intent(out) :: fsdsdir(pcols) ! Flux Shortwave Direct Downwelling Surface (amontornes-bcodina 2014-04-20)
real(r8), intent(out) :: fsdsdif(pcols) ! Flux Shortwave Diffuse Downwelling Surface (amontornes-bcodina 2014-04-20)
Expand All @@ -1717,6 +1724,7 @@ subroutine radctl(j, lchnk ,ncol , pcols, pver, pverp, pverr, pverrp, ppcns
! Output longwave arguments
!
real(r8), intent(out) :: qrl(pcols,pver) ! Longwave cooling rate
real(r8), intent(out) :: qrlcs(pcols,pver) ! Clear sky longwave cooling rate
real(r8), intent(out) :: flwds(pcols) ! Surface down longwave flux

real(r8), intent(inout) :: abstot(pcols,pverp,pverp) ! Total absorptivity
Expand Down Expand Up @@ -1846,7 +1854,7 @@ subroutine radctl(j, lchnk ,ncol , pcols, pver, pverp, pverr, pverrp, ppcns
! rei ,eccf ,coszrs ,scon ,solin ,solcon , &
rei ,tauxcl ,tauxci ,eccf ,coszrs ,scon ,solin ,solcon , &
asdir ,asdif ,aldir ,aldif ,nmxrgnrf, &
pmxrgnrf,qrs ,fsnt ,fsntc ,fsntoa , &
pmxrgnrf,qrs ,qrscs ,fsnt ,fsntc ,fsntoa , &
fsntoac ,fsnirt ,fsnrtc ,fsnirtsq,fsns , &
fsnsc ,fsdsc ,fsds ,sols ,soll , &
solsd ,solld ,frc_day , &
Expand Down Expand Up @@ -1896,7 +1904,7 @@ subroutine radctl(j, lchnk ,ncol , pcols, pver, pverp, pverr, pverrp, ppcns
! rei ,eccf ,coszrs ,scon ,solin ,solcon , &
rei ,tauxcl ,tauxci ,eccf ,coszrs ,scon ,solin ,solcon , &
asdir ,asdif ,aldir ,aldif ,nmxrgn , &
pmxrgn ,qrs ,fsnt ,fsntc ,fsntoa , &
pmxrgn ,qrs ,qrscs ,fsnt ,fsntc ,fsntoa , &
fsntoac ,fsnirt ,fsnrtc ,fsnirtsq,fsns , &
fsnsc ,fsdsc ,fsds ,sols ,soll , &
solsd ,solld ,frc_day , &
Expand Down Expand Up @@ -2014,8 +2022,9 @@ subroutine radctl(j, lchnk ,ncol , pcols, pver, pverp, pverr, pverrp, ppcns
pbr ,pnm ,pmln ,piln , &
qm1(1,1,in2o) ,qm1(1,1,ich4) , &
qm1(1,1,if11) ,qm1(1,1,if12) , &
cld ,emis ,pmxrgn ,nmxrgn ,qrl , &
doabsems, abstot, absnxt, emstot, &
cld ,emis ,pmxrgn ,nmxrgn , &
qrl ,qrlcs , &
doabsems,abstot ,absnxt ,emstot , &
flns ,flnt ,flnsc ,flntc ,flwds , &
flut ,flutc , &
flup ,flupc ,fldn ,fldnc , &
Expand Down Expand Up @@ -2049,7 +2058,7 @@ subroutine radctl(j, lchnk ,ncol , pcols, pver, pverp, pverr, pverrp, ppcns
pbr ,pnm ,pmln ,piln , &
n2o ,ch4 ,cfc11 ,cfc12 , &
cld ,emis ,pmxrgn ,nmxrgn ,qrl , &
doabsems, abstot, absnxt, emstot, &
qrlcs, doabsems, abstot, absnxt, emstot, &
flns ,flnt ,flnsc ,flntc ,flwds , &
flut ,flutc , &
flup ,flupc ,fldn ,fldnc , &
Expand Down Expand Up @@ -4756,7 +4765,7 @@ subroutine radclwmx(lchnk ,ncol ,pcols, pver, pverp, &
pmid ,pint ,pmln ,piln , &
n2o ,ch4 ,cfc11 ,cfc12 , &
cld ,emis ,pmxrgn ,nmxrgn ,qrl , &
doabsems, abstot, absnxt, emstot, &
qrlcs, doabsems, abstot, absnxt, emstot, &
flns ,flnt ,flnsc ,flntc ,flwds , &
flut ,flutc , &
flup ,flupc ,fldn ,fldnc , &
Expand Down Expand Up @@ -4834,6 +4843,7 @@ subroutine radclwmx(lchnk ,ncol ,pcols, pver, pverp, &
! Output arguments
!
real(r8), intent(out) :: qrl(pcols,pver) ! Longwave heating rate
real(r8), intent(out) :: qrlcs(pcols,pver) ! Clear sky longwave heating rate
real(r8), intent(out) :: flns(pcols) ! Surface cooling flux
real(r8), intent(out) :: flnt(pcols) ! Net outgoing flux
real(r8), intent(out) :: flut(pcols) ! Upward flux at top of model
Expand Down Expand Up @@ -5674,9 +5684,17 @@ subroutine radclwmx(lchnk ,ncol ,pcols, pver, pverp, &
1.E-4*gravit/((pint(i,k) - pint(i,k+1)))
end do
end do
! Repeat for clear sky
do k=ntoplw,pver
do i=1,ncol
qrlcs(i,k) = (fsul(i,k) - fsdl(i,k) - fsul(i,k+1) + fsdl(i,k+1))* &
1.E-4*gravit/((pint(i,k) - pint(i,k+1)))
end do
end do
! Return 0 above solution domain
if ( ntoplw > 1 )then
qrl(:ncol,:ntoplw-1) = 0.
qrlcs(:ncol,:ntoplw-1) = 0.
end if

! Added downward/upward total and clear sky fluxes
Expand Down Expand Up @@ -5706,7 +5724,7 @@ subroutine radcswmx(jj, lchnk ,ncol ,pcols, pver, pverp, &
! rei ,eccf ,coszrs ,scon ,solin ,solcon, &
rei ,tauxcl ,tauxci ,eccf ,coszrs ,scon ,solin ,solcon, &
asdir ,asdif ,aldir ,aldif ,nmxrgn , &
pmxrgn ,qrs ,fsnt ,fsntc ,fsntoa , &
pmxrgn ,qrs ,qrscs ,fsnt ,fsntc ,fsntoa , &
fsntoac ,fsnirtoa,fsnrtoac,fsnrtoaq,fsns , &
fsnsc ,fsdsc ,fsds ,sols ,soll , &
solsd ,solld ,frc_day , &
Expand Down Expand Up @@ -5882,6 +5900,7 @@ subroutine radcswmx(jj, lchnk ,ncol ,pcols, pver, pverp, &

real(r8), intent(out) :: solin(pcols) ! Incident solar flux
real(r8), intent(out) :: qrs(pcols,pver) ! Solar heating rate
real(r8), intent(out) :: qrscs(pcols,pver)! Clear sky solar heating rate
real(r8), intent(out) :: fsns(pcols) ! Surface absorbed solar flux
real(r8), intent(out) :: fsnt(pcols) ! Total column absorbed solar flux
real(r8), intent(out) :: fsntoa(pcols) ! Net solar flux at TOA
Expand Down Expand Up @@ -6072,6 +6091,7 @@ subroutine radcswmx(jj, lchnk ,ncol ,pcols, pver, pverp, &
real(r8) solflx ! Solar flux in current interval
real(r8) sfltot ! Spectrally summed total solar flux
real(r8) totfld(0:pver) ! Spectrally summed flux divergence
real(r8) totfldc(0:pver) ! Spectrally summed clear sky flux divergence
real(r8) fswup(0:pverp) ! Spectrally summed up flux
real(r8) fswdn(0:pverp) ! Spectrally summed down flux
real(r8) fswupc(0:pverp) ! Spectrally summed up clear sky flux
Expand Down Expand Up @@ -6345,6 +6365,7 @@ subroutine radcswmx(jj, lchnk ,ncol ,pcols, pver, pverp, &

do k=1, pver
qrs(i,k) = 0.0_r8
qrscs(i,k) = 0.0_r8
end do

! initialize aerosol diagnostic fields to 0.0
Expand Down Expand Up @@ -7181,6 +7202,7 @@ subroutine radcswmx(jj, lchnk ,ncol ,pcols, pver, pverp, &
!
do k=0,pver
totfld(k) = 0.0_r8
totfldc(k) = 0.0_r8
fswup (k) = 0.0_r8
fswdn (k) = 0.0_r8
fswupc (k) = 0.0_r8
Expand Down Expand Up @@ -7514,6 +7536,13 @@ subroutine radcswmx(jj, lchnk ,ncol ,pcols, pver, pverp, &
fswdncdir(k) = fswdncdir(k) + solflx*exptdnc(k) ! Beer's Law amontornes-bcodina (2014-04-20)
end do
! For clear sky heating rate
do k=0,pver
kp1 = k+1
flxdiv = (fluxdn(k ) - fluxdn(kp1)) + (fluxup(kp1) - fluxup(k))
totfldc(k) = totfldc(k) + solflx*flxdiv
end do
fsntc(i) = fsntc(i)+solflx*(fluxdn(1)-fluxup(1))
fsntoac(i) = fsntoac(i)+solflx*(fluxdn(0)-fluxup(0))
fsnsc(i) = fsnsc(i)+solflx*(fluxdn(pverp)-fluxup(pverp))
Expand All @@ -7532,6 +7561,7 @@ subroutine radcswmx(jj, lchnk ,ncol ,pcols, pver, pverp, &
!
do k=1,pver
qrs(i,k) = -1.E-4*gravit*totfld(k)/(pint(i,k) - pint(i,k+1))
qrscs(i,k) = -1.E-4*gravit*totfldc(k)/(pint(i,k) - pint(i,k+1))
end do
! Added downward/upward total and clear sky fluxes
Expand Down
Loading

0 comments on commit 614c320

Please sign in to comment.