Skip to content

Commit

Permalink
Merge branch 'rrtmgp-dev' of https://github.com/dustinswales/ccpp-phy…
Browse files Browse the repository at this point in the history 
…sics into rrtmgp-dev
  • Loading branch information
@dustinswales
dustinswales committed Nov 5, 2019
2 parents b6cc944 + 78a8ed2 commit b7aa280
Show file tree
Hide file tree
Showing 21 changed files with 186 additions and 267 deletions.
54 changes: 28 additions & 26 deletions physics/GFS_rrtmgp_lw_post.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -29,8 +29,8 @@ end subroutine GFS_rrtmgp_lw_post_init
!!
subroutine GFS_rrtmgp_lw_post_run (Model, Grid, Radtend, Coupling, Diag, Statein, im, &
p_lev, tsfa, fluxlwUP_allsky, fluxlwDOWN_allsky, fluxlwUP_clrsky, fluxlwDOWN_clrsky,&
raddt, aerodp, cldsa, mtopa, mbota, cld_frac, cldtaulw, hlwc, topflx_lw, &
sfcflx_lw, flxprf_lw, hlw0, errmsg, errflg)
raddt, aerodp, cldsa, mtopa, mbota, cld_frac, cldtaulw, &
flxprf_lw, hlw0, errmsg, errflg)

! Inputs
type(GFS_control_type), intent(in) :: &
Expand Down Expand Up @@ -68,24 +68,26 @@ subroutine GFS_rrtmgp_lw_post_run (Model, Grid, Radtend, Coupling, Diag, Statei
real(kind_phys), dimension(im,Model%levs), intent(in) :: &
cld_frac, & ! Total cloud fraction in each layer
cldtaulw ! approx 10.mu band layer cloud optical depth
real(kind_phys),dimension(size(Grid%xlon,1), Model%levs) :: &
hlwc ! Longwave all-sky heating-rate (K/sec)

! Outputs (mandatory)
character(len=*), intent(out) :: &
errmsg
integer, intent(out) :: &
errflg
real(kind_phys),dimension(size(Grid%xlon,1), Model%levs),intent(out) :: &
hlwc ! Longwave all-sky heating-rate (K/sec)
type(topflw_type), dimension(size(Grid%xlon,1)), intent(inout) :: &
topflx_lw ! radiation fluxes at top, components:
! upfxc - total sky upward flux at top (w/m2)
! upfx0 - clear sky upward flux at top (w/m2)
type(sfcflw_type), dimension(size(Grid%xlon,1)), intent(inout) :: &
sfcflx_lw ! radiation fluxes at sfc, components:
! upfxc - total sky upward flux at sfc (w/m2)
! upfx0 - clear sky upward flux at sfc (w/m2)
! dnfxc - total sky downward flux at sfc (w/m2)
! dnfx0 - clear sky downward flux at sfc (w/m2)
! real(kind_phys),dimension(size(Grid%xlon,1), Model%levs),intent(out) :: &
! hlwc ! Longwave all-sky heating-rate (K/sec)
! type(topflw_type), dimension(size(Grid%xlon,1)), intent(inout) :: &
! topflx_lw ! radiation fluxes at top, components:
! ! upfxc - total sky upward flux at top (w/m2)
! ! upfx0 - clear sky upward flux at top (w/m2)
! type(sfcflw_type), dimension(size(Grid%xlon,1)), intent(inout) :: &
! sfcflx_lw ! radiation fluxes at sfc, components:
! ! upfxc - total sky upward flux at sfc (w/m2)
! ! upfx0 - clear sky upward flux at sfc (w/m2)
! ! dnfxc - total sky downward flux at sfc (w/m2)
! ! dnfx0 - clear sky downward flux at sfc (w/m2)

! Outputs (optional)
real(kind_phys), dimension(size(Grid%xlon,1), Model%levs), optional, intent(inout) :: &
Expand Down Expand Up @@ -145,12 +147,12 @@ subroutine GFS_rrtmgp_lw_post_run (Model, Grid, Radtend, Coupling, Diag, Statei

! Copy fluxes from RRTGMP types into model radiation types.
! Mandatory outputs
topflx_lw%upfxc = fluxlwUP_allsky(:,iTOA)
topflx_lw%upfx0 = fluxlwUP_clrsky(:,iTOA)
sfcflx_lw%upfxc = fluxlwUP_allsky(:,iSFC)
sfcflx_lw%upfx0 = fluxlwUP_clrsky(:,iSFC)
sfcflx_lw%dnfxc = fluxlwDOWN_allsky(:,iSFC)
sfcflx_lw%dnfx0 = fluxlwDOWN_clrsky(:,iSFC)
Diag%topflw(:)%upfxc = fluxlwUP_allsky(:,iTOA)
Diag%topflw(:)%upfx0 = fluxlwUP_clrsky(:,iTOA)
Radtend%sfcflw(:)%upfxc = fluxlwUP_allsky(:,iSFC)
Radtend%sfcflw(:)%upfx0 = fluxlwUP_clrsky(:,iSFC)
Radtend%sfcflw(:)%dnfxc = fluxlwDOWN_allsky(:,iSFC)
Radtend%sfcflw(:)%dnfx0 = fluxlwDOWN_clrsky(:,iSFC)

! Optional outputs
if(l_fluxeslw2d) then
Expand Down Expand Up @@ -194,13 +196,13 @@ subroutine GFS_rrtmgp_lw_post_run (Model, Grid, Radtend, Coupling, Diag, Statei
if (Model%lslwr) then
do i=1,im
! LW all-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
Diag%fluxr(i,1 ) = Diag%fluxr(i,1 ) + Model%fhlwr * fluxlwUP_allsky( i,iTOA) ! total sky top lw up
Diag%fluxr(i,19) = Diag%fluxr(i,19) + Model%fhlwr * fluxlwDOWN_allsky(i,iSFC) ! total sky sfc lw dn
Diag%fluxr(i,20) = Diag%fluxr(i,20) + Model%fhlwr * fluxlwUP_allsky( i,iSFC) ! 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
Diag%fluxr(i,28) = Diag%fluxr(i,28) + Model%fhlwr * fluxlwUP_clrsky( i,iTOA) ! clear sky top lw up
Diag%fluxr(i,30) = Diag%fluxr(i,30) + Model%fhlwr * fluxlwDOWN_clrsky(i,iSFC) ! clear sky sfc lw dn
Diag%fluxr(i,33) = Diag%fluxr(i,33) + Model%fhlwr * fluxlwUP_clrsky( i,iSFC) ! clear sky sfc lw up
enddo

do i=1,im
Expand Down
25 changes: 0 additions & 25 deletions physics/GFS_rrtmgp_lw_post.meta
View file
Original file line number Diff line number Diff line change
Expand Up @@ -172,31 +172,6 @@
kind = kind_phys
intent = in
optional = F
[hlwc]
standard_name = RRTMGP_lw_heating_rate_all_sky
long_name = RRTMGP longwave all sky heating rate
units = K s-1
dimensions = (horizontal_dimension,vertical_dimension)
type = real
kind = kind_phys
intent = out
optional = F
[topflx_lw]
standard_name = lw_fluxes_top_atmosphere
long_name = longwave total sky fluxes at the top of the atm
units = W m-2
dimensions = (horizontal_dimension)
type = topflw_type
intent = inout
optional = F
[sfcflx_lw]
standard_name = lw_fluxes_sfc
long_name = longwave total sky fluxes at the Earth surface
units = W m-2
dimensions = (horizontal_dimension)
type = sfcflw_type
intent = inout
optional = F
[flxprf_lw]
standard_name = RRTMGP_lw_fluxes
long_name = lw fluxes total sky / csk and up / down at levels
Expand Down
9 changes: 6 additions & 3 deletions physics/GFS_rrtmgp_lw_pre.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -9,6 +9,7 @@ module GFS_rrtmgp_lw_pre
GFS_sfcprop_type, & ! Surface fields
GFS_grid_type, & ! Grid and interpolation related data
GFS_statein_type, & !
GFS_Interstitial_type, & !
GFS_radtend_type ! Radiation tendencies needed in physics
use module_radiation_surface, only: &
setemis ! Routine to compute surface-emissivity
Expand All @@ -31,7 +32,7 @@ end subroutine GFS_rrtmgp_lw_pre_init
!! \htmlinclude GFS_rrtmgp_lw_pre.html
!!
subroutine GFS_rrtmgp_lw_pre_run (Model, Grid, Sfcprop, Statein, ncol, p_lay, p_lev, &
tv_lay, relhum, tracer, lw_gas_props, Radtend, aerosolslw, aerodp, errmsg, errflg)
tv_lay, relhum, tracer, lw_gas_props, Radtend, Interstitial, aerosolslw, aerodp, errmsg, errflg)

! Inputs
type(GFS_control_type), intent(in) :: &
Expand All @@ -58,6 +59,8 @@ subroutine GFS_rrtmgp_lw_pre_run (Model, Grid, Sfcprop, Statein, ncol, p_lay,
! Outputs
type(GFS_radtend_type), intent(inout) :: &
Radtend ! Fortran DDT containing FV3-GFS radiation tendencies
type(GFS_interstitial_type), intent(inout) :: &
Interstitial
real(kind_phys), dimension(ncol,Model%levs,lw_gas_props%get_nband(),NF_AELW), intent(out) ::&
aerosolslw ! Aerosol radiative properties in each SW band.
real(kind_phys), dimension(ncol,NSPC1), intent(inout) :: &
Expand Down Expand Up @@ -97,15 +100,15 @@ subroutine GFS_rrtmgp_lw_pre_run (Model, Grid, Sfcprop, Statein, ncol, p_lay,
Sfcprop%zorl, Sfcprop%tsfc,Sfcprop%tsfc, Sfcprop%hprime(:,1), NCOL, &
Radtend%semis)
do iBand=1,lw_gas_props%get_nband()
Radtend%sfc_emiss_byband(iBand,1:NCOL) = Radtend%semis(1:NCOL)
Interstitial%sfc_emiss_byband(iBand,1:NCOL) = Radtend%semis(1:NCOL)
enddo

! #######################################################################################
! Call module_radiation_aerosols::setaer(),to setup aerosols property profile
! #######################################################################################
call setaer(p_lev, p_lay, Statein%prslk(1:NCOL,iSFC:iTOA), tv_lay, relhum, &
Sfcprop%slmsk, tracer, Grid%xlon, Grid%xlat, ncol, Model%levs, Model%levs+1, &
.false., Model%lslwr, aerosolssw2, aerosolslw, aerodp)
.true., Model%lslwr, aerosolssw2, aerosolslw, aerodp)


end subroutine GFS_rrtmgp_lw_pre_run
Expand Down
8 changes: 8 additions & 0 deletions physics/GFS_rrtmgp_lw_pre.meta
View file
Original file line number Diff line number Diff line change
Expand Up @@ -9,6 +9,14 @@
type = GFS_control_type
intent = in
optional = F
[Interstitial]
standard_name = GFS_interstitial_type_instance
long_name = derived type GFS_interstitial_type in FV3
units = DDT
dimensions = ()
type = GFS_interstitial_type
intent = inout
optional = F
[Grid]
standard_name = GFS_grid_type_instance
long_name = instance of derived type GFS_grid_type
Expand Down
7 changes: 4 additions & 3 deletions physics/GFS_rrtmgp_pre.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -232,15 +232,16 @@ subroutine GFS_rrtmgp_pre_run (Model, Grid, Statein, Coupling, Radtend, Sfcprop,
do iLay=iSFC+1,iTOA
t_lev(iCol,iLay) = (t_lay(iCol,iLay)+t_lay(iCol,iLay-1))/2._kind_phys
enddo
t_lev(iCol,iTOA+1) = t_lev(iCol,iTOA) + (p_lev(iCol,iTOA+1)-p_lev(iCOL,iTOA))*&
(t_lev(iCol,iTOA)-t_lay(iCOL,iTOA))/(p_lev(iCol,iTOA)-p_lay(iCOL,iTOA))
t_lev(iCol,iTOA+1) = t_lay(iCol,iTOA)
!t_lev(iCol,iTOA+1) = t_lev(iCol,iTOA) + (p_lev(iCol,iTOA+1)-p_lev(iCOL,iTOA))*&
! (t_lev(iCol,iTOA)-t_lay(iCOL,iTOA))/(p_lev(iCol,iTOA)-p_lay(iCOL,iTOA))
enddo

! Guard against case when model uppermost model layer higher than rrtmgp allows.
where(p_lev(1:nCol,iTOA+1) .lt. rrtmgp_minP)
! Set to RRTMGP min(pressure/temperature)
p_lev(1:nCol,iTOA+1) = spread(rrtmgp_minP, dim=1,ncopies=ncol)
t_lev(1:nCol,iTOA+1) = spread(rrtmgp_minT, dim=1,ncopies=ncol)
! t_lev(1:nCol,iTOA+1) = spread(rrtmgp_minT, dim=1,ncopies=ncol)
! Recompute layer pressure/temperature.
p_lay(1:NCOL,iTOA) = 0.5_kind_phys*(p_lev(1:NCOL,iTOA) + p_lev(1:NCOL,iTOA+1))
t_lay(1:NCOL,iTOA) = 0.5_kind_phys*(t_lev(1:NCOL,iTOA) + t_lev(1:NCOL,iTOA+1))
Expand Down
Loading

0 comments on commit b7aa280

Please sign in to comment.