Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

RRTMGP cleanup from ORTs #782

Merged
merged 16 commits into from
Dec 9, 2021
Merged
Show file tree
Hide file tree
Changes from 13 commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
48 changes: 19 additions & 29 deletions physics/GFS_rrtmgp_cloud_overlap_pre.F90
Original file line number Diff line number Diff line change
Expand Up @@ -22,7 +22,7 @@ end subroutine GFS_rrtmgp_cloud_overlap_pre_init
subroutine GFS_rrtmgp_cloud_overlap_pre_run(nCol, nLev, yearlen, doSWrad, doLWrad, &
julian, lat, p_lev, p_lay, tv_lay, con_pi, con_g, con_rd, con_epsq, dcorr_con, &
idcor, iovr, iovr_dcorr, iovr_exp, iovr_exprand, idcor_con, idcor_hogan, &
idcor_oreopoulos, cld_frac, &
idcor_oreopoulos, cld_frac, top_at_1, &
de_lgth, cloud_overlap_param, precip_overlap_param, deltaZc, errmsg, errflg)
implicit none

Expand All @@ -40,6 +40,7 @@ subroutine GFS_rrtmgp_cloud_overlap_pre_run(nCol, nLev, yearlen, doSWrad, doLWra
idcor_hogan, & ! Flag for decorrelation-length. (https://rmets.onlinelibrary.wiley.com/doi/full/10.1002/qj.647)
idcor_oreopoulos ! Flag for decorrelation-length. (10.5194/acp-12-9097-2012)
logical, intent(in) :: &
top_at_1, & ! Vertical ordering flag
doSWrad, & ! Call SW radiation?
doLWrad ! Call LW radiation
real(kind_phys), intent(in) :: &
Expand Down Expand Up @@ -74,47 +75,36 @@ subroutine GFS_rrtmgp_cloud_overlap_pre_run(nCol, nLev, yearlen, doSWrad, doLWra
real(kind_phys) :: tem1,pfac
real(kind_phys), dimension(nLev+1) :: hgtb
real(kind_phys), dimension(nLev) :: hgtc
integer :: iCol,iLay,l,iSFC,iTOA
integer :: iCol,iLay,l
real(kind_phys), dimension(nCol,nLev) :: deltaZ
logical :: top_at_1

! Initialize CCPP error handling variables
errmsg = ''
errflg = 0

if (.not. (doSWrad .or. doLWrad)) return

! What is vertical ordering?
top_at_1 = (p_lev(1,1) .lt. p_lev(1, nLev))
if (top_at_1) then
iSFC = nLev
iTOA = 1
else
iSFC = 1
iTOA = nLev
endif

!
! Compute layer-thickness between layer boundaries (deltaZ) and layer centers (deltaZc)
!
!
! Compute layer-thickness between layer boundaries (deltaZ) and layer centers (deltaZc)
!
do iCol=1,nCol
if (top_at_1) then
! Layer thickness (km)
! Layer thickness (km)
do iLay=1,nLev
deltaZ(iCol,iLay) = ((con_rd/con_g)*0.001) * abs(log(p_lev(iCol,iLay+1)) - log(p_lev(iCol,iLay))) * tv_lay(iCol,iLay)
enddo
! Height at layer boundaries
! Height at layer boundaries
hgtb(nLev+1) = 0._kind_phys
do iLay=nLev,1,-1
hgtb(iLay)= hgtb(iLay+1) + deltaZ(iCol,iLay)
enddo
! Height at layer centers
! Height at layer centers
do iLay = nLev, 1, -1
pfac = abs(log(p_lev(iCol,iLay+1)) - log(p_lay(iCol,iLay))) / &
abs(log(p_lev(iCol,iLay+1)) - log(p_lev(iCol,iLay)))
hgtc(iLay) = hgtb(iLay+1) + pfac * (hgtb(iLay) - hgtb(iLay+1))
enddo
! Layer thickness between centers
! Layer thickness between centers
do iLay = nLev-1, 1, -1
deltaZc(iCol,iLay) = hgtc(iLay) - hgtc(iLay+1)
enddo
Expand All @@ -123,28 +113,28 @@ subroutine GFS_rrtmgp_cloud_overlap_pre_run(nCol, nLev, yearlen, doSWrad, doLWra
do iLay=nLev,1,-1
deltaZ(iCol,iLay) = ((con_rd/con_g)*0.001) * abs(log(p_lev(iCol,iLay)) - log(p_lev(iCol,iLay+1))) * tv_lay(iCol,iLay)
enddo
! Height at layer boundaries
! Height at layer boundaries
hgtb(1) = 0._kind_phys
do iLay=1,nLev
hgtb(iLay+1)= hgtb(iLay) + deltaZ(iCol,iLay)
enddo
! Height at layer centers
! Height at layer centers
do iLay = 1, nLev
pfac = abs(log(p_lev(iCol,iLay)) - log(p_lay(iCol,iLay) )) / &
abs(log(p_lev(iCol,iLay)) - log(p_lev(iCol,iLay+1)))
hgtc(iLay) = hgtb(iLay) + pfac * (hgtb(iLay+1) - hgtb(iLay))
enddo
! Layer thickness between centers
! Layer thickness between centers
do iLay = 2, nLev
deltaZc(iCol,iLay) = hgtc(iLay) - hgtc(iLay-1)
enddo
deltaZc(iCol,1) = hgtc(1) - hgtb(1)
endif
enddo

!
! Cloud decorrelation length
!
!
! Cloud decorrelation length
!
if (idcor == idcor_hogan) then
call cmp_dcorr_lgth(nCol, lat, con_pi, de_lgth)
endif
Expand All @@ -165,9 +155,9 @@ subroutine GFS_rrtmgp_cloud_overlap_pre_run(nCol, nLev, yearlen, doSWrad, doLWra
cloud_overlap_param(:,:) = 0.
endif

! For exponential random overlap...
! Decorrelate layers when a clear layer follows a cloudy layer to enforce
! random correlation between non-adjacent blocks of cloudy layers
! For exponential random overlap...
! Decorrelate layers when a clear layer follows a cloudy layer to enforce
! random correlation between non-adjacent blocks of cloudy layers
if (iovr == iovr_exprand) then
do iLay = 1, nLev
do iCol = 1, nCol
Expand Down
7 changes: 7 additions & 0 deletions physics/GFS_rrtmgp_cloud_overlap_pre.meta
Original file line number Diff line number Diff line change
Expand Up @@ -186,6 +186,13 @@
type = real
kind = kind_phys
intent = in
[top_at_1]
standard_name = flag_for_vertical_ordering_in_RRTMGP
long_name = flag for vertical ordering in RRTMGP
units = flag
dimensions = ()
type = logical
intent = in
[de_lgth]
standard_name = cloud_decorrelation_length
long_name = cloud decorrelation length
Expand Down
1 change: 0 additions & 1 deletion physics/GFS_rrtmgp_gfdlmp_pre.F90
Original file line number Diff line number Diff line change
Expand Up @@ -98,7 +98,6 @@ subroutine GFS_rrtmgp_gfdlmp_pre_run(nCol, nLev, nTracers, ncnd, i_cldliq, i_cld
real(kind_phys), dimension(nCol, nLev, min(4,ncnd)) :: cld_condensate
integer :: iCol,iLay,l,ncndl
real(kind_phys), dimension(nCol,nLev) :: deltaP,deltaZ
logical :: top_at_1

if (.not. (doSWrad .or. doLWrad)) return

Expand Down
69 changes: 20 additions & 49 deletions physics/GFS_rrtmgp_lw_post.F90
Original file line number Diff line number Diff line change
@@ -1,12 +1,8 @@
module GFS_rrtmgp_lw_post
use machine, only: kind_phys
use module_radiation_aerosols, only: NSPC1
use module_radlw_parameters, only: topflw_type, sfcflw_type, proflw_type
! RRTMGP DDT's
use mo_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp
use mo_fluxes_byband, only: ty_fluxes_byband
use module_radlw_parameters, only: topflw_type, sfcflw_type
use mo_heating_rates, only: compute_heating_rate
use radiation_tools, only: check_error_msg
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
Expand All @@ -25,14 +21,16 @@ end subroutine GFS_rrtmgp_lw_post_init
!! \htmlinclude GFS_rrtmgp_lw_post.html
!!
subroutine GFS_rrtmgp_lw_post_run (nCol, nLev, lslwr, do_lw_clrsky_hr, save_diag, fhlwr, &
p_lev, t_lay, tsfa, fluxlwUP_allsky, fluxlwDOWN_allsky, fluxlwUP_clrsky, &
fluxlwDOWN_clrsky, raddt, aerodp, cldsa, mtopa, mbota, cld_frac, cldtaulw, fluxr, &
sfcdlw, sfculw, sfcflw, tsflw, htrlw, topflw, flxprf_lw, htrlwc, errmsg, errflg)
p_lev, t_lay, tsfa, fluxlwUP_allsky, fluxlwDOWN_allsky, fluxlwUP_clrsky, iSFC, iTOA,&
fluxlwDOWN_clrsky, raddt, cldsa, mtopa, mbota, cld_frac, cldtaulw, fluxr, sfcdlw, &
sfculw, sfcflw, tsflw, htrlw, htrlwu, topflw, htrlwc, errmsg, errflg)

! Inputs
integer, intent(in) :: &
nCol, & ! Horizontal loop extent
nLev ! Number of vertical layers
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?
Expand All @@ -51,8 +49,6 @@ subroutine GFS_rrtmgp_lw_post_run (nCol, nLev, lslwr, do_lw_clrsky_hr, save_diag
fluxlwDOWN_clrsky ! RRTMGP longwave clear-sky flux (W/m2)
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
real(kind_phys), dimension(nCol,5), intent(in) :: &
cldsa ! Fraction of clouds for low, middle, high, total and BL
integer, dimension(nCol,3), intent(in) ::&
Expand All @@ -72,27 +68,21 @@ subroutine GFS_rrtmgp_lw_post_run (nCol, nLev, lslwr, do_lw_clrsky_hr, save_diag
type(sfcflw_type), dimension(nCol), intent(inout) :: &
sfcflw ! LW radiation fluxes at sfc
real(kind_phys), dimension(nCol,nLev), intent(inout) :: &
htrlw ! LW all-sky heating rate
htrlw, & ! LW all-sky heating rate
htrlwu ! Heating-rate updated in-between radiation calls.
type(topflw_type), dimension(nCol), intent(out) :: &
topflw ! lw_fluxes_top_atmosphere
character(len=*), intent(out) :: &
errmsg
integer, intent(out) :: &
errflg

! Outputs (optional)
type(proflw_type), dimension(nCol, nLev+1), optional, intent(inout) :: &
flxprf_lw ! 2D radiative fluxes, components:
! upfxc - total sky upward flux (W/m2)
! dnfxc - total sky dnward flux (W/m2)
! upfx0 - clear sky upward flux (W/m2)
! dnfx0 - clear sky dnward flux (W/m2)
real(kind_phys),dimension(nCol, nLev),intent(inout),optional :: &
htrlwc ! Longwave clear-sky heating-rate (K/sec)

! Local variables
integer :: i, j, k, iSFC, iTOA, itop, ibtc
logical :: l_fluxeslw2d, top_at_1
integer :: i, j, k, itop, ibtc
real(kind_phys) :: tem0d, tem1, tem2
real(kind_phys),dimension(nCol,nLev) :: hlwc

Expand All @@ -101,22 +91,6 @@ subroutine GFS_rrtmgp_lw_post_run (nCol, nLev, lslwr, do_lw_clrsky_hr, save_diag
errflg = 0

if (.not. lslwr) return

! Are any optional outputs requested?
l_fluxeslw2d = present(flxprf_lw)

! #######################################################################################
! What is vertical ordering?
! #######################################################################################
top_at_1 = (p_lev(1,1) .lt. p_lev(1, nLev))
if (top_at_1) then
iSFC = nLev+1
iTOA = 1
else
iSFC = 1
iTOA = nLev+1
endif

! #######################################################################################
! Compute LW heating-rates.
! #######################################################################################
Expand All @@ -138,31 +112,28 @@ subroutine GFS_rrtmgp_lw_post_run (nCol, nLev, lslwr, do_lw_clrsky_hr, save_diag

! #######################################################################################
! Save LW outputs.
! (Copy fluxes from RRTMGP types into model radiation types.)
! #######################################################################################
! Copy fluxes from RRTGMP types into model radiation types.
! Mandatory outputs
! TOA fluxes
topflw(:)%upfxc = fluxlwUP_allsky(:,iTOA)
topflw(:)%upfx0 = fluxlwUP_clrsky(:,iTOA)

! Surface fluxes
sfcflw(:)%upfxc = fluxlwUP_allsky(:,iSFC)
sfcflw(:)%upfx0 = fluxlwUP_clrsky(:,iSFC)
sfcflw(:)%dnfxc = fluxlwDOWN_allsky(:,iSFC)
sfcflw(:)%dnfx0 = fluxlwDOWN_clrsky(:,iSFC)

! Optional outputs
if(l_fluxeslw2d) then
flxprf_lw%upfxc = fluxlwUP_allsky
flxprf_lw%dnfxc = fluxlwDOWN_allsky
flxprf_lw%upfx0 = fluxlwUP_clrsky
flxprf_lw%dnfx0 = fluxlwDOWN_clrsky
endif


! Save surface air temp for diurnal adjustment at model t-steps
tsflw (:) = tsfa(:)

! Radiation fluxes for other physics processes
sfcdlw(:) = sfcflw(:)%dnfxc
sfculw(:) = sfcflw(:)%upfxc

! Heating-rate at radiation timestep, used for adjustment between radiation calls.
htrlwu = htrlw

! #######################################################################################
! Save LW diagnostics
! - For time averaged output quantities (including total-sky and clear-sky SW and LW
Expand Down
32 changes: 23 additions & 9 deletions physics/GFS_rrtmgp_lw_post.meta
Original file line number Diff line number Diff line change
@@ -1,7 +1,7 @@
[ccpp-table-properties]
name = GFS_rrtmgp_lw_post
type = scheme
dependencies = iounitdef.f,machine.F,radiation_aerosols.f,radlw_param.f,rte-rrtmgp/extensions/mo_fluxes_byband.F90,rte-rrtmgp/extensions/mo_fluxes_byband_kernels.F90,radiation_tools.F90,rte-rrtmgp/rte/mo_fluxes.F90,rte-rrtmgp/rte/kernels/mo_fluxes_broadband_kernels.F90,rte-rrtmgp/extensions/mo_heating_rates.F90
dependencies = iounitdef.f,machine.F,radiation_aerosols.f,radlw_param.f,rte-rrtmgp/extensions/mo_fluxes_byband.F90,radiation_tools.F90,rte-rrtmgp/rte/mo_fluxes.F90,rte-rrtmgp/rte/kernels/mo_fluxes_broadband_kernels.F90,rte-rrtmgp/extensions/mo_heating_rates.F90

########################################################################
[ccpp-arg-table]
Expand All @@ -21,6 +21,20 @@
dimensions = ()
type = integer
intent = in
[iSFC]
standard_name = vertical_index_for_surface_in_RRTMGP
long_name = index for surface layer in RRTMGP
units = flag
dimensions = ()
type = integer
intent = in
[iTOA]
standard_name = vertical_index_for_TOA_in_RRTMGP
long_name = index for TOA layer in RRTMGP
units = flag
dimensions = ()
type = integer
intent = in
[lslwr]
standard_name = flag_for_calling_longwave_radiation
long_name = logical flags for lw radiation calls
Expand Down Expand Up @@ -114,14 +128,6 @@
type = real
kind = kind_phys
intent = in
[aerodp]
standard_name = atmosphere_optical_thickness_due_to_ambient_aerosol_particles
long_name = vertical integrated optical depth for various aerosol species
units = none
dimensions = (horizontal_loop_extent,number_of_species_for_aerosol_optical_depth)
type = real
kind = kind_phys
intent = in
[cldsa]
standard_name = cloud_area_fraction_for_radiation
long_name = fraction of clouds for low, middle, high, total and BL
Expand Down Expand Up @@ -207,6 +213,14 @@
type = real
kind = kind_phys
intent = inout
[htrlwu]
standard_name = updated_tendency_of_air_temperature_due_to_longwave_heating_on_physics_timestep
long_name = total sky longwave heating rate on physics time step
units = K s-1
dimensions = (horizontal_loop_extent,vertical_layer_dimension)
type = real
kind = kind_phys
intent = inout
[topflw]
standard_name = lw_fluxes_top_atmosphere
long_name = lw radiation fluxes at top
Expand Down
Loading