Skip to content
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
28 commits
Select commit Hold shift + click to select a range
dc8feed
remove dependency on GFS_typedefs for rrtmg_sw_pre
grantfirl Jan 17, 2020
fda501e
remove dependency on GFS_typedefs.F90 for rrtmg_sw_post scheme
grantfirl Jan 21, 2020
2d353c0
remove dependency on GFS_typedefs.F90 for rrtmg_lw_pre scheme
grantfirl Jan 21, 2020
eeaa98b
remove dependency on GFS_typedefs.F90 for rrtmg_lw_post scheme
grantfirl Jan 21, 2020
c7dbbce
remove dependency on GFS_typedefs for GFS_phys_time_vary_init for the…
grantfirl Jan 23, 2020
3f95c12
Merge branch 'interstitial_cleanup' into GFS_DDT_removal
grantfirl Aug 21, 2020
4a2ea3f
swap aero_in for iaerclm in GFS_phys_time_vary.scm
grantfirl Aug 21, 2020
b76bb2c
revert some changes in meta files accidentally merged in
grantfirl Aug 22, 2020
eea20ed
remove DDTs from GFS_phys_time_vary_init (SCM), GFS_rad_time_vary (SC…
grantfirl Aug 25, 2020
b1e393d
cleanup GFS_phys_time_vary.scm
grantfirl Aug 26, 2020
cd06bbd
clean up GFS_rrtmg_post
grantfirl Aug 26, 2020
f7e6770
clean upu rrtmg_lw_post
grantfirl Aug 26, 2020
5fe8234
cleanup rrtmg_[sw,lw]_[pre,post]
grantfirl Aug 26, 2020
7349ae5
remove GFS DDTs and physcons from GFS_rrtmg_pre
grantfirl Aug 27, 2020
d4d823e
add fluxr and uncomment radiation diagnostics for rrtmgp_[sw,lw]_post
grantfirl Aug 27, 2020
6e1d848
switch to horizontal_loop_extent in radiation interstitials that were…
grantfirl Aug 27, 2020
b378619
revert changes to time_vary.scm files
grantfirl Aug 27, 2020
ef4d4f0
Merge branch 'master' into GFS_DDT_removal
grantfirl Aug 31, 2020
915f71a
remove do_sfcperts and pertabl from GFS_rrtmg_pre
grantfirl Aug 31, 2020
04af628
Merge branch 'master' into GFS_DDT_removal
grantfirl Sep 3, 2020
28f96f9
initialize correct_unit branch
mzhangw Sep 10, 2020
b38a49a
unit fix
mzhangw Sep 14, 2020
862b464
unit fix
mzhangw Sep 16, 2020
423c6bd
revert some changes per Doms comments
mzhangw Oct 1, 2020
474144f
Merge branch 'GFS_DDT_removal' of https://github.com/grantfirl/ccpp-p…
climbfuji Oct 6, 2020
5aaa8db
Add missing arguments to physics/GFS_rrtmg_pre.* after merge
climbfuji Oct 6, 2020
e6e8ef1
Merge branch 'correct_unit' of https://github.com/mzhangw/ccpp-physic…
climbfuji Oct 6, 2020
8ee53cc
Bugfixes in physics/GFS_rrtmg_pre.meta that creeped in during the merge
climbfuji Oct 6, 2020
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
6 changes: 3 additions & 3 deletions physics/GFS_DCNV_generic.meta
Original file line number Diff line number Diff line change
Expand Up @@ -445,7 +445,7 @@
[upd_mf]
standard_name = cumulative_atmosphere_updraft_convective_mass_flux
long_name = cumulative updraft mass flux
units = Pa
units = kg m-1 s-2
dimensions = (horizontal_loop_extent,vertical_dimension)
type = real
kind = kind_phys
Expand All @@ -454,7 +454,7 @@
[dwn_mf]
standard_name = cumulative_atmosphere_downdraft_convective_mass_flux
long_name = cumulative downdraft mass flux
units = Pa
units = kg m-1 s-2
dimensions = (horizontal_loop_extent,vertical_dimension)
type = real
kind = kind_phys
Expand All @@ -463,7 +463,7 @@
[det_mf]
standard_name = cumulative_atmosphere_detrainment_convective_mass_flux
long_name = cumulative detrainment mass flux
units = Pa
units = kg m-1 s-2
dimensions = (horizontal_loop_extent,vertical_dimension)
type = real
kind = kind_phys
Expand Down
159 changes: 80 additions & 79 deletions physics/GFS_rrtmg_post.F90
Original file line number Diff line number Diff line change
Expand Up @@ -11,43 +11,44 @@ end subroutine GFS_rrtmg_post_init
!> \section arg_table_GFS_rrtmg_post_run Argument Table
!! \htmlinclude GFS_rrtmg_post_run.html
!!
subroutine GFS_rrtmg_post_run (Model, Grid, Diag, Radtend, Statein, &
Coupling, scmpsw, im, lm, ltp, kt, kb, kd, raddt, aerodp, &
cldsa, mtopa, mbota, clouds1, cldtaulw, cldtausw, nday, &
errmsg, errflg)
subroutine GFS_rrtmg_post_run (im, km, kmp1, lm, ltp, kt, kb, kd, nspc1, &
nfxr, nday, lsswr, lslwr, lssav, fhlwr, fhswr, raddt, coszen, &
coszdg, prsi, tgrs, aerodp, cldsa, mtopa, mbota, clouds1, &
cldtaulw, cldtausw, sfcflw, sfcfsw, topflw, topfsw, scmpsw, &
fluxr, errmsg, errflg)

use machine, only: kind_phys
use GFS_typedefs, only: GFS_statein_type, &
GFS_coupling_type, &
GFS_control_type, &
GFS_grid_type, &
GFS_radtend_type, &
GFS_diag_type
use module_radiation_aerosols, only: NSPC1
use module_radsw_parameters, only: cmpfsw_type
use module_radsw_parameters, only: topfsw_type, sfcfsw_type, &
cmpfsw_type
use module_radlw_parameters, only: topflw_type, sfcflw_type
use module_radsw_parameters, only: topfsw_type, sfcfsw_type

implicit none

! Interface variables
type(GFS_control_type), intent(in) :: Model
type(GFS_grid_type), intent(in) :: Grid
type(GFS_statein_type), intent(in) :: Statein
type(GFS_coupling_type), intent(inout) :: Coupling
type(GFS_radtend_type), intent(in) :: Radtend
type(GFS_diag_type), intent(inout) :: Diag
type(cmpfsw_type), dimension(size(Grid%xlon,1)), intent(in) :: scmpsw

integer, intent(in) :: im, lm, ltp, kt, kb, kd, nday
real(kind=kind_phys), intent(in) :: raddt

real(kind=kind_phys), dimension(size(Grid%xlon,1),NSPC1), intent(in) :: aerodp
real(kind=kind_phys), dimension(size(Grid%xlon,1),5), intent(in) :: cldsa
integer, dimension(size(Grid%xlon,1),3), intent(in) :: mbota, mtopa
real(kind=kind_phys), dimension(size(Grid%xlon,1),lm+LTP), intent(in) :: clouds1
real(kind=kind_phys), dimension(size(Grid%xlon,1),lm+LTP), intent(in) :: cldtausw
real(kind=kind_phys), dimension(size(Grid%xlon,1),lm+LTP), intent(in) :: cldtaulw
integer, intent(in) :: im, km, kmp1, lm, ltp, kt, kb, kd, &
nspc1, nfxr, nday
logical, intent(in) :: lsswr, lslwr, lssav
real(kind=kind_phys), intent(in) :: raddt, fhlwr, fhswr

real(kind=kind_phys), dimension(im), intent(in) :: coszen, coszdg

real(kind=kind_phys), dimension(im,kmp1), intent(in) :: prsi
real(kind=kind_phys), dimension(im,km), intent(in) :: tgrs

real(kind=kind_phys), dimension(im,NSPC1), intent(in) :: aerodp
real(kind=kind_phys), dimension(im,5), intent(in) :: cldsa
integer, dimension(im,3), intent(in) :: mbota, mtopa
real(kind=kind_phys), dimension(im,lm+LTP), intent(in) :: clouds1
real(kind=kind_phys), dimension(im,lm+LTP), intent(in) :: cldtausw
real(kind=kind_phys), dimension(im,lm+LTP), intent(in) :: cldtaulw

type(sfcflw_type), dimension(im), intent(in) :: sfcflw
type(sfcfsw_type), dimension(im), intent(in) :: sfcfsw
type(cmpfsw_type), dimension(im), intent(in) :: scmpsw
type(topflw_type), dimension(im), intent(in) :: topflw
type(topfsw_type), dimension(im), intent(in) :: topfsw

real(kind=kind_phys), dimension(im,nfxr), intent(inout) :: fluxr

character(len=*), intent(out) :: errmsg
integer, intent(out) :: errflg
Expand All @@ -60,7 +61,7 @@ subroutine GFS_rrtmg_post_run (Model, Grid, Diag, Radtend, Statein, &
errmsg = ''
errflg = 0

if (.not. (Model%lsswr .or. Model%lslwr)) return
if (.not. (lsswr .or. lslwr)) return

!> - For time averaged output quantities (including total-sky and
!! clear-sky SW and LW fluxes at TOA and surface; conventional
Expand All @@ -70,77 +71,77 @@ subroutine GFS_rrtmg_post_run (Model, Grid, Diag, Radtend, Statein, &

! --- ... collect the fluxr data for wrtsfc

if (Model%lssav) then
if (Model%lsswr) then
if (lssav) then
if (lsswr) then
do i=1,im
! Diag%fluxr(i,34) = Diag%fluxr(i,34) + Model%fhswr*aerodp(i,1) ! total aod at 550nm
! Diag%fluxr(i,35) = Diag%fluxr(i,35) + Model%fhswr*aerodp(i,2) ! DU aod at 550nm
! Diag%fluxr(i,36) = Diag%fluxr(i,36) + Model%fhswr*aerodp(i,3) ! BC aod at 550nm
! Diag%fluxr(i,37) = Diag%fluxr(i,37) + Model%fhswr*aerodp(i,4) ! OC aod at 550nm
! Diag%fluxr(i,38) = Diag%fluxr(i,38) + Model%fhswr*aerodp(i,5) ! SU aod at 550nm
! Diag%fluxr(i,39) = Diag%fluxr(i,39) + Model%fhswr*aerodp(i,6) ! SS aod at 550nm
Diag%fluxr(i,34) = aerodp(i,1) ! total aod at 550nm
Diag%fluxr(i,35) = aerodp(i,2) ! DU aod at 550nm
Diag%fluxr(i,36) = aerodp(i,3) ! BC aod at 550nm
Diag%fluxr(i,37) = aerodp(i,4) ! OC aod at 550nm
Diag%fluxr(i,38) = aerodp(i,5) ! SU aod at 550nm
Diag%fluxr(i,39) = aerodp(i,6) ! SS aod at 550nm
! fluxr(i,34) = fluxr(i,34) + fhswr*aerodp(i,1) ! total aod at 550nm
! fluxr(i,35) = fluxr(i,35) + fhswr*aerodp(i,2) ! DU aod at 550nm
! fluxr(i,36) = fluxr(i,36) + fhswr*aerodp(i,3) ! BC aod at 550nm
! fluxr(i,37) = fluxr(i,37) + fhswr*aerodp(i,4) ! OC aod at 550nm
! fluxr(i,38) = fluxr(i,38) + fhswr*aerodp(i,5) ! SU aod at 550nm
! fluxr(i,39) = fluxr(i,39) + fhswr*aerodp(i,6) ! SS aod at 550nm
fluxr(i,34) = aerodp(i,1) ! total aod at 550nm
fluxr(i,35) = aerodp(i,2) ! DU aod at 550nm
fluxr(i,36) = aerodp(i,3) ! BC aod at 550nm
fluxr(i,37) = aerodp(i,4) ! OC aod at 550nm
fluxr(i,38) = aerodp(i,5) ! SU aod at 550nm
fluxr(i,39) = aerodp(i,6) ! SS aod at 550nm
enddo
endif

! --- save lw toa and sfc fluxes
if (Model%lslwr) then
if (lslwr) then
do i=1,im
! --- lw total-sky fluxes
Diag%fluxr(i,1 ) = Diag%fluxr(i,1 ) + Model%fhlwr * Diag%topflw(i)%upfxc ! total sky top lw up
Diag%fluxr(i,19) = Diag%fluxr(i,19) + Model%fhlwr * Radtend%sfcflw(i)%dnfxc ! total sky sfc lw dn
Diag%fluxr(i,20) = Diag%fluxr(i,20) + Model%fhlwr * Radtend%sfcflw(i)%upfxc ! total sky sfc lw up
fluxr(i,1 ) = fluxr(i,1 ) + fhlwr * topflw(i)%upfxc ! total sky top lw up
fluxr(i,19) = fluxr(i,19) + fhlwr * sfcflw(i)%dnfxc ! total sky sfc lw dn
fluxr(i,20) = fluxr(i,20) + fhlwr * sfcflw(i)%upfxc ! total sky sfc lw up
! --- lw clear-sky fluxes
Diag%fluxr(i,28) = Diag%fluxr(i,28) + Model%fhlwr * Diag%topflw(i)%upfx0 ! clear sky top lw up
Diag%fluxr(i,30) = Diag%fluxr(i,30) + Model%fhlwr * Radtend%sfcflw(i)%dnfx0 ! clear sky sfc lw dn
Diag%fluxr(i,33) = Diag%fluxr(i,33) + Model%fhlwr * Radtend%sfcflw(i)%upfx0 ! clear sky sfc lw up
fluxr(i,28) = fluxr(i,28) + fhlwr * topflw(i)%upfx0 ! clear sky top lw up
fluxr(i,30) = fluxr(i,30) + fhlwr * sfcflw(i)%dnfx0 ! clear sky sfc lw dn
fluxr(i,33) = fluxr(i,33) + fhlwr * sfcflw(i)%upfx0 ! clear sky sfc lw up
enddo
endif

! --- save sw toa and sfc fluxes with proper diurnal sw wgt. coszen=mean cosz over daylight
! part of sw calling interval, while coszdg= mean cosz over entire interval
if (Model%lsswr) then
if (lsswr) then
do i = 1, IM
if (Radtend%coszen(i) > 0.) then
if (coszen(i) > 0.) then
! --- sw total-sky fluxes
! -------------------
tem0d = Model%fhswr * Radtend%coszdg(i) / Radtend%coszen(i)
Diag%fluxr(i,2 ) = Diag%fluxr(i,2) + Diag%topfsw(i)%upfxc * tem0d ! total sky top sw up
Diag%fluxr(i,3 ) = Diag%fluxr(i,3) + Radtend%sfcfsw(i)%upfxc * tem0d ! total sky sfc sw up
Diag%fluxr(i,4 ) = Diag%fluxr(i,4) + Radtend%sfcfsw(i)%dnfxc * tem0d ! total sky sfc sw dn
tem0d = fhswr * coszdg(i) / coszen(i)
fluxr(i,2 ) = fluxr(i,2) + topfsw(i)%upfxc * tem0d ! total sky top sw up
fluxr(i,3 ) = fluxr(i,3) + sfcfsw(i)%upfxc * tem0d ! total sky sfc sw up
fluxr(i,4 ) = fluxr(i,4) + sfcfsw(i)%dnfxc * tem0d ! total sky sfc sw dn
! --- sw uv-b fluxes
! --------------
Diag%fluxr(i,21) = Diag%fluxr(i,21) + scmpsw(i)%uvbfc * tem0d ! total sky uv-b sw dn
Diag%fluxr(i,22) = Diag%fluxr(i,22) + scmpsw(i)%uvbf0 * tem0d ! clear sky uv-b sw dn
fluxr(i,21) = fluxr(i,21) + scmpsw(i)%uvbfc * tem0d ! total sky uv-b sw dn
fluxr(i,22) = fluxr(i,22) + scmpsw(i)%uvbf0 * tem0d ! clear sky uv-b sw dn
! --- sw toa incoming fluxes
! ----------------------
Diag%fluxr(i,23) = Diag%fluxr(i,23) + Diag%topfsw(i)%dnfxc * tem0d ! top sw dn
fluxr(i,23) = fluxr(i,23) + topfsw(i)%dnfxc * tem0d ! top sw dn
! --- sw sfc flux components
! ----------------------
Diag%fluxr(i,24) = Diag%fluxr(i,24) + scmpsw(i)%visbm * tem0d ! uv/vis beam sw dn
Diag%fluxr(i,25) = Diag%fluxr(i,25) + scmpsw(i)%visdf * tem0d ! uv/vis diff sw dn
Diag%fluxr(i,26) = Diag%fluxr(i,26) + scmpsw(i)%nirbm * tem0d ! nir beam sw dn
Diag%fluxr(i,27) = Diag%fluxr(i,27) + scmpsw(i)%nirdf * tem0d ! nir diff sw dn
fluxr(i,24) = fluxr(i,24) + scmpsw(i)%visbm * tem0d ! uv/vis beam sw dn
fluxr(i,25) = fluxr(i,25) + scmpsw(i)%visdf * tem0d ! uv/vis diff sw dn
fluxr(i,26) = fluxr(i,26) + scmpsw(i)%nirbm * tem0d ! nir beam sw dn
fluxr(i,27) = fluxr(i,27) + scmpsw(i)%nirdf * tem0d ! nir diff sw dn
! --- sw clear-sky fluxes
! -------------------
Diag%fluxr(i,29) = Diag%fluxr(i,29) + Diag%topfsw(i)%upfx0 * tem0d ! clear sky top sw up
Diag%fluxr(i,31) = Diag%fluxr(i,31) + Radtend%sfcfsw(i)%upfx0 * tem0d ! clear sky sfc sw up
Diag%fluxr(i,32) = Diag%fluxr(i,32) + Radtend%sfcfsw(i)%dnfx0 * tem0d ! clear sky sfc sw dn
fluxr(i,29) = fluxr(i,29) + topfsw(i)%upfx0 * tem0d ! clear sky top sw up
fluxr(i,31) = fluxr(i,31) + sfcfsw(i)%upfx0 * tem0d ! clear sky sfc sw up
fluxr(i,32) = fluxr(i,32) + sfcfsw(i)%dnfx0 * tem0d ! clear sky sfc sw dn
endif
enddo
endif

! --- save total and boundary layer clouds

if (Model%lsswr .or. Model%lslwr) then
if (lsswr .or. lslwr) then
do i=1,im
Diag%fluxr(i,17) = Diag%fluxr(i,17) + raddt * cldsa(i,4)
Diag%fluxr(i,18) = Diag%fluxr(i,18) + raddt * cldsa(i,5)
fluxr(i,17) = fluxr(i,17) + raddt * cldsa(i,4)
fluxr(i,18) = fluxr(i,18) + raddt * cldsa(i,5)
enddo

! --- save cld frac,toplyr,botlyr and top temp, note that the order
Expand All @@ -152,15 +153,15 @@ subroutine GFS_rrtmg_post_run (Model, Grid, Diag, Radtend, Statein, &
tem0d = raddt * cldsa(i,j)
itop = mtopa(i,j) - kd
ibtc = mbota(i,j) - kd
Diag%fluxr(i, 8-j) = Diag%fluxr(i, 8-j) + tem0d
Diag%fluxr(i,11-j) = Diag%fluxr(i,11-j) + tem0d * Statein%prsi(i,itop+kt)
Diag%fluxr(i,14-j) = Diag%fluxr(i,14-j) + tem0d * Statein%prsi(i,ibtc+kb)
Diag%fluxr(i,17-j) = Diag%fluxr(i,17-j) + tem0d * Statein%tgrs(i,itop)
fluxr(i, 8-j) = fluxr(i, 8-j) + tem0d
fluxr(i,11-j) = fluxr(i,11-j) + tem0d * prsi(i,itop+kt)
fluxr(i,14-j) = fluxr(i,14-j) + tem0d * prsi(i,ibtc+kb)
fluxr(i,17-j) = fluxr(i,17-j) + tem0d * tgrs(i,itop)
enddo
enddo

! Anning adds optical depth and emissivity output
if (Model%lsswr .and. (nday > 0)) then
if (lsswr .and. (nday > 0)) then
do j = 1, 3
do i = 1, IM
tem0d = raddt * cldsa(i,j)
Expand All @@ -170,12 +171,12 @@ subroutine GFS_rrtmg_post_run (Model, Grid, Diag, Radtend, Statein, &
do k=ibtc,itop
tem1 = tem1 + cldtausw(i,k) ! approx .55 um channel
enddo
Diag%fluxr(i,43-j) = Diag%fluxr(i,43-j) + tem0d * tem1
fluxr(i,43-j) = fluxr(i,43-j) + tem0d * tem1
enddo
enddo
endif

if (Model%lslwr) then
if (lslwr) then
do j = 1, 3
do i = 1, IM
tem0d = raddt * cldsa(i,j)
Expand All @@ -185,7 +186,7 @@ subroutine GFS_rrtmg_post_run (Model, Grid, Diag, Radtend, Statein, &
do k=ibtc,itop
tem2 = tem2 + cldtaulw(i,k) ! approx 10. um channel
enddo
Diag%fluxr(i,46-j) = Diag%fluxr(i,46-j) + tem0d * (1.0-exp(-tem2))
fluxr(i,46-j) = fluxr(i,46-j) + tem0d * (1.0-exp(-tem2))
enddo
enddo
endif
Expand Down
Loading