Skip to content

Commit

Permalink
More organizational changes to RRTMGP.
Browse files Browse the repository at this point in the history
  • Loading branch information
@dustinswales
dustinswales committed May 29, 2019
1 parent 129b829 commit 1386e58
Show file tree
Hide file tree
Showing 7 changed files with 446 additions and 672 deletions.
230 changes: 124 additions & 106 deletions physics/GFS_rrtmgp_post.F90
View file

Large diffs are not rendered by default.

381 changes: 89 additions & 292 deletions physics/GFS_rrtmgp_pre.F90
View file

Large diffs are not rendered by default.

63 changes: 41 additions & 22 deletions physics/rrtmgp_lw.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -10,8 +10,6 @@ module rrtmgp_lw
use mo_rrtmgp_clr_all_sky, only: rte_lw
use mo_gas_concentrations, only: ty_gas_concs
use mo_fluxes_byband, only: ty_fluxes_byband
use rrtmgp_sw, only: check_error_msg


! Parameters
integer,parameter :: nGases = 6
Expand Down Expand Up @@ -674,18 +672,20 @@ end subroutine rrtmgp_lw_init
!! | kdist_lw | K_distribution_file_for_RRTMGP_LW_scheme | DDT containing spectral information for RRTMGP LW radiation scheme | DDT | 0 | ty_gas_optics_rrtmgp | | in | F |
!! | optical_propsLW_clds | longwave_optical_properties_for_cloudy_atmosphere | Fortran DDT containing RRTMGP optical properties | DDT | 0 | ty_optical_props_1scl | | in | F |
!! | optical_propsLW_aerosol | longwave_optical_properties_for_aerosols | Fortran DDT containing RRTMGP optical properties | DDT | 0 | ty_optical_props_1scl | | in | F |
!! | gas_concentrations | Gas_concentrations_for_RRTMGP_suite_lw | DDT containing gas concentrations for RRTMGP radiation scheme | DDT | 0 | ty_gas_concs | | in | F |
!! | gas_concentrations | Gas_concentrations_for_RRTMGP_suite | DDT containing gas concentrations for RRTMGP radiation scheme | DDT | 0 | ty_gas_concs | | in | F |
!! | lslwr | flag_to_calc_lw | flag to calculate LW irradiances | flag | 0 | logical | | in | F |
!! | fluxLW_allsky | lw_flux_profiles_byband_allsky | Fortran DDT containing RRTMGP 3D fluxes | DDT | 0 | ty_fluxes_byband | | out | F |
!! | fluxLW_clrsky | lw_flux_profiles_byband_clrsky | Fortran DDT containing RRTMGP 3D fluxes | DDT | 0 | ty_fluxes_byband | | out | F |
!! | hlw0 | tendency_of_air_temperature_due_to_longwave_heating_assuming_clear_sky_on_radiation_time_step | longwave clear sky heating rate | K s-1 | 2 | real | kind_phys | in | T |
!! | hlwb | lw_heating_rate_spectral | longwave total sky heating rate (spectral) | K s-1 | 3 | real | kind_phys | in | T |
!! | fluxUP_allsky | lw_flux_profile_upward_allsky | RRTMGP upward longwave all-sky flux profile | W m-2 | 2 | real | kind_phys | out | F |
!! | fluxDOWN_allsky | lw_flux_profile_downward_allsky | RRTMGP downward longwave all-sky flux profile | W m-2 | 2 | real | kind_phys | out | F |
!! | fluxUP_clrsky | lw_flux_profile_upward_clrsky | RRTMGP upward longwave clr-sky flux profile | W m-2 | 2 | real | kind_phys | out | F |
!! | fluxDOWN_clrsky | lw_flux_profile_downward_clrsky | RRTMGP downward longwave clr-sky flux profile | W m-2 | 2 | real | kind_phys | out | F |
!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F |
!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F |
!!
subroutine rrtmgp_lw_run(ncol, nlay, kdist_lw, p_lay, t_lay, p_lev, skt, &
sfc_emiss, gas_concentrations, optical_propsLW_clds, optical_propsLW_aerosol,&
lslwr, fluxLW_allsky, fluxLW_clrsky, hlw0, hlwb, errmsg, errflg)
lslwr, fluxUP_allsky, fluxDOWN_allsky, fluxUP_clrsky, fluxDOWN_clrsky, hlw0, hlwb, errmsg, errflg)

! Inputs
integer, intent(in) :: &
Expand All @@ -709,47 +709,53 @@ subroutine rrtmgp_lw_run(ncol, nlay, kdist_lw, p_lay, t_lay, p_lev, skt, &
gas_concentrations ! RRTMGP DDT: trace gas concentrations (vmr)
logical, intent(in) :: &
lslwr ! Flag to calculate LW irradiances

! Outputs
character(len=*), intent(out) :: errmsg
integer, intent(out) :: errflg
type(ty_fluxes_byband),intent(out) :: &
fluxLW_allsky, & ! All-sky flux (W/m2)
fluxLW_clrsky ! Clear-sky flux (W/m2)

real(kind_phys), dimension(ncol,nlay), intent(out) :: &
fluxUP_allsky, & ! All-sky flux (W/m2)
fluxDOWN_allsky, & ! All-sky flux (W/m2)
fluxUP_clrsky, & ! Clear-sky flux (W/m2)
fluxDOWN_clrsky ! All-sky flux (W/m2)

! Outputs (optional)
real(kind_phys), dimension(ncol,nlay,kdist_lw%get_nband()), optional, intent(inout) :: &
hlwb ! All-sky heating rate, by band (K/sec)
real(kind_phys), dimension(ncol,nlay), optional, intent(inout) :: &
hlw0 ! Clear-sky heating rate (K/sec)

! Local variables
type(ty_fluxes_byband) :: &
flux_allsky, & ! All-sky flux (W/m2)
flux_clrsky ! Clear-sky flux (W/m2)
real(kind_phys), dimension(ncol,nlay+1),target :: &
fluxLW_up_allsky, fluxLW_up_clrsky, fluxLW_dn_allsky, fluxLW_dn_clrsky
real(kind_phys), dimension(ncol,nlay+1,kdist_lw%get_nband()),target :: &
fluxLWBB_up_allsky, fluxLWBB_dn_allsky
logical :: l_ClrSky_HR, l_AllSky_HR_byband
integer :: k

! Initialize CCPP error handling variables
errmsg = ''
errflg = 0
if (.not. lslwr) return

! Are any optional outputs requested? Need to know now to compute correct fluxes.
l_ClrSky_HR = present(hlw0)
l_AllSky_HR_byband = present(hlwb)

! Initialize RRTMGP DDT containing 2D(3D) fluxes
fluxLW_allsky%flux_up => fluxLW_up_allsky
fluxLW_allsky%flux_dn => fluxLW_dn_allsky
fluxLW_clrsky%flux_up => fluxLW_up_clrsky
fluxLW_clrsky%flux_dn => fluxLW_dn_clrsky
flux_allsky%flux_up => fluxLW_up_allsky
flux_allsky%flux_dn => fluxLW_dn_allsky
flux_clrsky%flux_up => fluxLW_up_clrsky
flux_clrsky%flux_dn => fluxLW_dn_clrsky
! Only calculate fluxes by-band, only when heating-rate profiles by band are requested.
if (l_AllSky_HR_byband) then
fluxLW_allsky%bnd_flux_up => fluxLWBB_up_allsky
fluxLW_allsky%bnd_flux_dn => fluxLWBB_dn_allsky
flux_allsky%bnd_flux_up => fluxLWBB_up_allsky
flux_allsky%bnd_flux_dn => fluxLWBB_dn_allsky
endif

! Call RRTMGP LW scheme
call check_error_msg('rrtmgp_lw_run',rte_lw( &
kdist_lw, & ! IN - spectral information
Expand All @@ -760,13 +766,26 @@ subroutine rrtmgp_lw_run(ncol, nlay, kdist_lw, p_lay, t_lay, p_lev, skt, &
skt, & ! IN - skin temperature (K)
sfc_emiss, & ! IN - surface emissivity in each LW band
optical_propsLW_clds, & ! IN - DDT containing cloud optical information
fluxLW_allsky, & ! OUT - Fluxes, all-sky, 3D (nCol,nLay,nBand)
fluxLW_clrsky, & ! OUT - Fluxes, clear-sky, 3D (nCol,nLay,nBand)
flux_allsky, & ! OUT - Fluxes, all-sky, 3D (nCol,nLay,nBand)
flux_clrsky, & ! OUT - Fluxes, clear-sky, 3D (nCol,nLay,nBand)
aer_props = optical_propsLW_aerosol)) ! IN(optional) - DDT containing aerosol optical information
fluxUP_allsky = flux_allsky%flux_up
fluxDOWN_allsky = flux_allsky%flux_dn
fluxUP_clrsky = flux_clrsky%flux_up
fluxDOWN_clrsky = flux_clrsky%flux_dn

end subroutine rrtmgp_lw_run

subroutine rrtmgp_lw_finalize()
end subroutine rrtmgp_lw_finalize

subroutine check_error_msg(routine_name, error_msg)
character(len=*), intent(in) :: &
error_msg, routine_name

if(error_msg /= "") then
print*,"ERROR("//trim(routine_name)//"): "
print*,trim(error_msg)
return
end if
end subroutine check_error_msg
end module rrtmgp_lw
97 changes: 0 additions & 97 deletions physics/rrtmgp_lw_main.F90
View file

This file was deleted.

Loading

0 comments on commit 1386e58

Please sign in to comment.