Skip to content

Commit

Permalink
Merge pull request #782 from dustinswales/cleanup_p8ORTs
Browse files Browse the repository at this point in the history 
RRTMGP cleanup from ORTs
  • Loading branch information
@climbfuji
climbfuji authored Dec 9, 2021
2 parents 623feaa + d2018d2 commit cbc7e36
Show file tree
Hide file tree
Showing 33 changed files with 401 additions and 517 deletions.
48 changes: 19 additions & 29 deletions physics/GFS_rrtmgp_cloud_overlap_pre.F90
View file
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
View file
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
View file
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
View file
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
View file
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

0 comments on commit cbc7e36

Please sign in to comment.