From 4e0cfc85d8629d0130d22913e6c03030010114de Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Fri, 31 May 2019 15:27:09 -0600 Subject: [PATCH] Added back option to call RRTMG cloud_optics(). --- physics/GFS_rrtmgp_lw.F90 | 78 +++++---- physics/GFS_rrtmgp_post.F90 | 312 ++---------------------------------- physics/GFS_rrtmgp_pre.F90 | 30 ++-- physics/GFS_rrtmgp_sw.F90 | 93 +++++++---- 4 files changed, 147 insertions(+), 366 deletions(-) diff --git a/physics/GFS_rrtmgp_lw.F90 b/physics/GFS_rrtmgp_lw.F90 index a71a10d13..d46f5c74a 100644 --- a/physics/GFS_rrtmgp_lw.F90 +++ b/physics/GFS_rrtmgp_lw.F90 @@ -1,15 +1,15 @@ module GFS_rrtmgp_lw - use GFS_typedefs, only: GFS_control_type - use machine, only: kind_phys - use physparam, only: isubclw, iovrlw - use rrtmgp_lw, only: nrghice_lw => nrghice, ipsdlw0 - use mo_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp - use mo_cloud_optics, only: ty_cloud_optics - use mo_optical_props, only: ty_optical_props_1scl, ty_optical_props_2str - use mo_cloud_sampling, only: sampled_mask_max_ran, sampled_mask_exp_ran, draw_samples - use mo_gas_concentrations, only: ty_gas_concs - use mersenne_twister, only: random_setseed, random_number, random_stat - + use GFS_typedefs, only: GFS_control_type + use machine, only: kind_phys + use physparam, only: isubclw, iovrlw + use rrtmgp_lw, only: nrghice_lw => nrghice, ipsdlw0 + use mo_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp + use mo_cloud_optics, only: ty_cloud_optics + use mo_optical_props, only: ty_optical_props_1scl, ty_optical_props_2str + use mo_cloud_sampling, only: sampled_mask_max_ran, sampled_mask_exp_ran, draw_samples + use mo_gas_concentrations, only: ty_gas_concs + use mersenne_twister, only: random_setseed, random_number, random_stat + use mo_rrtmgp_lw_cloud_optics, only: rrtmgp_lw_cloud_optics public GFS_rrtmgp_lw_run,GFS_rrtmgp_lw_init,GFS_rrtmgp_lw_finalize contains @@ -31,6 +31,10 @@ end subroutine GFS_rrtmgp_lw_init !! | cld_reliq | mean_effective_radius_for_liquid_cloud | mean effective radius for liquid cloud | micron | 2 | real | kind_phys | in | F | !! | cld_iwp | cloud_ice_water_path | layer cloud ice water path | g m-2 | 2 | real | kind_phys | in | F | !! | cld_reice | mean_effective_radius_for_ice_cloud | mean effective radius for ice cloud | micron | 2 | real | kind_phys | in | F | +!! | cld_swp | cloud_snow_water_path | layer cloud snow water path | g m-2 | 2 | real | kind_phys | in | F | +!! | cld_resnow | mean_effective_radius_for_snow_flake | mean effective radius for snow cloud | micron | 2 | real | kind_phys | in | F | +!! | cld_rwp | cloud_rain_water_path | layer cloud rain water path | g m-2 | 2 | real | kind_phys | in | F | +!! | cld_rerain | mean_effective_radius_for_rain_drop | mean effective radius for rain cloud | micron | 2 | real | kind_phys | in | F | !! | gas_concentrations | Gas_concentrations_for_RRTMGP_suite | DDT containing gas concentrations for RRTMGP radiation scheme | DDT | 0 | ty_gas_concs | | in | F | !! | icseed_lw | seed_random_numbers_sw | seed for random number generation for shortwave radiation | none | 1 | integer | | in | F | !! | 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 | @@ -45,8 +49,9 @@ end subroutine GFS_rrtmgp_lw_init ! ######################################################################################### ! ######################################################################################### subroutine GFS_rrtmgp_lw_run(Model, ncol, icseed_lw, p_lay, t_lay, p_lev, cld_frac, & - cld_lwp, cld_reliq, cld_iwp, cld_reice, gas_concentrations, kdist_lw, aerosols, & - kdist_cldy_lw, optical_props_clouds, optical_props_aerosol, cldtaulw, errmsg, errflg) + cld_lwp, cld_reliq, cld_iwp, cld_reice, cld_swp, cld_resnow, cld_rwp, cld_rerain, & + gas_concentrations, kdist_lw, aerosols, kdist_cldy_lw, & + optical_props_clouds, optical_props_aerosol, cldtaulw, errmsg, errflg) ! Inputs type(GFS_control_type), intent(in) :: & @@ -68,7 +73,11 @@ subroutine GFS_rrtmgp_lw_run(Model, ncol, icseed_lw, p_lay, t_lay, p_lev, cld_fr cld_lwp, & ! Cloud liquid water path cld_reliq, & ! Cloud liquid effective radius cld_iwp, & ! Cloud ice water path - cld_reice ! Cloud ice effective radius + cld_reice, & ! Cloud ice effective radius + cld_swp, & ! Cloud snow water path + cld_resnow, & ! Cloud snow effective radius + cld_rwp, & ! Cloud rain water path + cld_rerain ! Cloud rain effective radius type(ty_gas_concs),intent(in) :: & gas_concentrations ! type(ty_gas_optics_rrtmgp),intent(in) :: & @@ -96,6 +105,8 @@ subroutine GFS_rrtmgp_lw_run(Model, ncol, icseed_lw, p_lay, t_lay, p_lev, cld_fr real(kind_phys), dimension(kdist_lw%get_ngpt(),model%levs,ncol) :: rng3D real(kind_phys), dimension(kdist_lw%get_ngpt()*model%levs) :: rng1D logical, dimension(ncol,model%levs,kdist_lw%get_ngpt()) :: cldfracMCICA + real(kind_phys), dimension(ncol,model%levs,kdist_lw%get_nband()) :: & + tau_cld ! Initialize CCPP error handling variables errmsg = '' @@ -140,20 +151,31 @@ subroutine GFS_rrtmgp_lw_run(Model, ncol, icseed_lw, p_lay, t_lay, p_lev, cld_fr ! ####################################################################################### ! Compute cloud-optics for RTE. ! ####################################################################################### - call check_error_msg('GFS_rrtmgp_lw_run',kdist_cldy_lw%cloud_optics(& - ncol, & ! IN - Number of horizontal gridpoints - model%levs, & ! IN - Number of vertical layers - kdist_lw%get_nband(), & ! IN - Number of LW bands - nrghice_lw, & ! IN - Number of ice-roughness categories - liqmask, & ! IN - Liquid-cloud mask - icemask, & ! IN - Ice-cloud mask - cld_lwp, & ! IN - Cloud liquid water path - cld_iwp, & ! IN - Cloud ice water path - cld_reliq, & ! IN - Cloud liquid effective radius - cld_reice, & ! IN - Cloud ice effective radius - optical_props_cloudsByBand)) ! OUT - RRTMGP DDT containing cloud radiative properties - ! in each band - + if (Model%rrtmgp_cld_phys .gt. 0) then + ! i) RRTMGP cloud-optics. + call check_error_msg('GFS_rrtmgp_lw_run',kdist_cldy_lw%cloud_optics(& + ncol, & ! IN - Number of horizontal gridpoints + model%levs, & ! IN - Number of vertical layers + kdist_lw%get_nband(), & ! IN - Number of LW bands + nrghice_lw, & ! IN - Number of ice-roughness categories + liqmask, & ! IN - Liquid-cloud mask + icemask, & ! IN - Ice-cloud mask + cld_lwp, & ! IN - Cloud liquid water path + cld_iwp, & ! IN - Cloud ice water path + cld_reliq, & ! IN - Cloud liquid effective radius + cld_reice, & ! IN - Cloud ice effective radius + optical_props_cloudsByBand)) ! OUT - RRTMGP DDT containing cloud radiative properties + ! in each band + else + ! ii) RRTMG cloud-optics. + if (any(cld_frac .gt. 0)) then + call rrtmgp_lw_cloud_optics(ncol, model%levs, kdist_lw%get_nband(), cld_lwp, & + cld_reliq, cld_iwp, cld_reice, cld_rwp, cld_rerain, cld_swp, cld_resnow, & + cld_frac, tau_cld) + optical_props_cloudsByBand%tau = tau_cld + endif + endif + ! ####################################################################################### ! Call McICA to generate subcolumns. ! ####################################################################################### diff --git a/physics/GFS_rrtmgp_post.F90 b/physics/GFS_rrtmgp_post.F90 index 3fc71dfb8..020f37c86 100644 --- a/physics/GFS_rrtmgp_post.F90 +++ b/physics/GFS_rrtmgp_post.F90 @@ -45,45 +45,12 @@ end subroutine GFS_rrtmgp_post_init !! | cloud_fraction | total_cloud_fraction | layer total cloud fraction | frac | 2 | real | kind_phys | in | F | !! | cldtaulw | cloud_optical_depth_layers_at_10mu_band | approx 10mu band layer cloud optical depth | none | 2 | real | kind_phys | in | F | !! | cldtausw | cloud_optical_depth_layers_at_0.55mu_band | approx .55mu band layer cloud optical depth | none | 2 | real | kind_phys | in | F | -!! | tsfa | surface_air_temperature_for_radiation | lowest model layer air temperature for radiation | K | 1 | real | kind_phys | in | F | -!! | p_lev | air_pressure_at_interface_for_RRTMGP_in_hPa | air pressure level | hPa | 2 | real | kind_phys | in | F | -!! | nday | daytime_points_dimension | daytime points dimension | count | 0 | integer | | in | F | -!! | idxday | daytime_points | daytime points | index | 1 | integer | | in | F | -!! | fluxswUP_allsky | sw_flux_profile_upward_allsky | RRTMGP upward shortwave all-sky flux profile | W m-2 | 2 | real | kind_phys | in | F | -!! | fluxswDOWN_allsky | sw_flux_profile_downward_allsky | RRTMGP downward shortwave all-sky flux profile | W m-2 | 2 | real | kind_phys | in | F | -!! | fluxswUP_clrsky | sw_flux_profile_upward_clrsky | RRTMGP upward shortwave clr-sky flux profile | W m-2 | 2 | real | kind_phys | in | F | -!! | fluxswDOWN_clrsky | sw_flux_profile_downward_clrsky | RRTMGP downward shortwave clr-sky flux profile | W m-2 | 2 | real | kind_phys | in | F | -!! | fluxlwUP_allsky | lw_flux_profile_upward_allsky | RRTMGP upward longwave all-sky flux profile | W m-2 | 2 | real | kind_phys | in | F | -!! | fluxlwDOWN_allsky | lw_flux_profile_downward_allsky | RRTMGP downward longwave all-sky flux profile | W m-2 | 2 | real | kind_phys | in | F | -!! | fluxlwUP_clrsky | lw_flux_profile_upward_clrsky | RRTMGP upward longwave clr-sky flux profile | W m-2 | 2 | real | kind_phys | in | F | -!! | fluxlwDOWN_clrsky | lw_flux_profile_downward_clrsky | RRTMGP downward longwave clr-sky flux profile | W m-2 | 2 | real | kind_phys | in | F | -!! | 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 | -!! | kdist_sw | K_distribution_file_for_RRTMGP_SW_scheme | DDT containing spectral information for RRTMGP SW radiation scheme | DDT | 0 | ty_gas_optics_rrtmgp | | in | F | -!! | sfc_alb_nir_dir | surface_shortwave_albedo_near_infrared_direct_in_each_band | surface sw near-infrared direct albedo in each SW band | frac | 2 | real | kind_phys | in | F | -!! | sfc_alb_nir_dif | surface_shortwave_albedo_near_infrared_diffuse_in_each_band | surface sw near-infrared diffuse albedo in each SW band | frac | 2 | real | kind_phys | in | F | -!! | sfc_alb_uvvis_dir | surface_shortwave_albedo_uv_visible_direct_in_each_band | surface sw uv-visible direct albedo in each SW band | frac | 2 | real | kind_phys | in | F | -!! | sfc_alb_uvvis_dif | surface_shortwave_albedo_uv_visible_diffuse_in_each_band | surface sw uv-visible diffuse albedo in each SW band | frac | 2 | real | kind_phys | in | F | -!! | hlwc | tendency_of_air_temperature_due_to_longwave_heating_on_radiation_time_step | longwave total sky heating rate | K s-1 | 2 | real | kind_phys | out | F | -!! | hswc | tendency_of_air_temperature_due_to_shortwave_heating_on_radiation_time_step | shortwave total sky heating rate | K s-1 | 2 | real | kind_phys | out | F | -!! | topflx_lw | lw_fluxes_top_atmosphere | longwave total sky fluxes at the top of the atm | W m-2 | 1 | topflw_type | | inout | F | -!! | sfcflx_lw | lw_fluxes_sfc | longwave total sky fluxes at the Earth surface | W m-2 | 1 | sfcflw_type | | inout | F | -!! | topflx_sw | sw_fluxes_top_atmosphere | shortwave total sky fluxes at the top of the atm | W m-2 | 1 | topfsw_type | | inout | F | -!! | sfcflx_sw | sw_fluxes_sfc | shortwave total sky fluxes at the Earth surface | W m-2 | 1 | sfcfsw_type | | inout | F | -!! | flxprf_lw | lw_fluxes | lw fluxes total sky / csk and up / down at levels | W m-2 | 2 | proflw_type | | inout | T | -!! | flxprf_sw | sw_fluxes | sw fluxes total sky / csk and up / down at levels | W m-2 | 2 | profsw_type | | inout | T | -!! | 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 | inout | T | -!! | hsw0 | tendency_of_air_temperature_due_to_shortwave_heating_assuming_clear_sky_on_radiation_time_step | shortwave clear sky heating rate | K s-1 | 2 | real | kind_phys | inout | T | !! | 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 GFS_rrtmgp_post_run (Model, Grid, Diag, Radtend, Statein, & Coupling, scmpsw, im, raddt, aerodp, & - cldsa, mtopa, mbota, cloud_fraction, cldtaulw, cldtausw, p_lev, kdist_lw, kdist_sw, & - sfc_alb_nir_dir, sfc_alb_nir_dif, sfc_alb_uvvis_dir, & - sfc_alb_uvvis_dif, & - tsfa, nday, idxday, fluxlwUP_allsky, fluxlwDOWN_allsky, fluxlwUP_clrsky, fluxlwDOWN_clrsky, & - fluxswUP_allsky, fluxswDOWN_allsky, fluxswUP_clrsky, fluxswDOWN_clrsky, & - hlwc, hswc, topflx_sw, sfcflx_sw, flxprf_sw, topflx_lw, sfcflx_lw, flxprf_lw, hlw0, hsw0, errmsg, errflg) + cldsa, mtopa, mbota, cloud_fraction, cldtaulw, cldtausw, errmsg, errflg) ! Inputs type(GFS_control_type), intent(in) :: & @@ -99,14 +66,9 @@ subroutine GFS_rrtmgp_post_run (Model, Grid, Diag, Radtend, Statein, & type(GFS_diag_type), intent(inout) :: & Diag ! Fortran DDT containing FV3-GFS diagnotics data integer, intent(in) :: & - im, & ! Horizontal loop extent - nDay ! Number of daylit columns - integer, intent(in), dimension(nday) :: & - idxday ! Index array for daytime points + im ! Horizontal loop extent real(kind_phys), intent(in) :: & raddt ! Radiation time step - real(kind_phys), dimension(size(Grid%xlon,1)), intent(in) :: & - tsfa ! Lowest model layer air temperature for radiation real(kind_phys), dimension(size(Grid%xlon,1),NSPC1), intent(in) :: & aerodp ! Vertical integrated optical depth for various aerosol species real(kind_phys), dimension(size(Grid%xlon,1),5), intent(in) :: & @@ -117,72 +79,8 @@ subroutine GFS_rrtmgp_post_run (Model, Grid, Diag, Radtend, Statein, & real(kind_phys), dimension(size(Grid%xlon,1),Model%levs), intent(in) :: & cloud_fraction, & ! Total cloud fraction in each layer cldtausw, & ! approx .55mu band layer cloud optical depth - cldtaulw ! approx 10mu band layer cloud optical depth - type(ty_gas_optics_rrtmgp),intent(in) :: & - kdist_lw, & ! DDT containing LW spectral information - kdist_sw ! DDT containing SW spectral information - real(kind_phys), dimension(size(Grid%xlon,1), Model%levs+1), intent(in) :: & - p_lev ! Pressure @ model layer-interfaces (hPa) - real(kind_phys),dimension(kdist_sw%get_nband(),size(Grid%xlon,1)),intent(in) :: & - sfc_alb_nir_dir, & ! Shortwave surface albedo (nIR-direct) - sfc_alb_nir_dif, & ! Shortwave surface albedo (nIR-diffuse) - sfc_alb_uvvis_dir, & ! Shortwave surface albedo (uvvis-direct) - sfc_alb_uvvis_dif ! Shortwave surface albedo (uvvis-diffuse) - real(kind_phys), dimension(size(Grid%xlon,1), Model%levs+1), intent(in) :: & - fluxswUP_allsky, & ! SW All-sky flux (W/m2) - fluxswDOWN_allsky, & ! SW All-sky flux (W/m2) - fluxswUP_clrsky, & ! SW Clear-sky flux (W/m2) - fluxswDOWN_clrsky, & ! SW All-sky flux (W/m2) - fluxlwUP_allsky, & ! LW All-sky flux (W/m2) - fluxlwDOWN_allsky, & ! LW All-sky flux (W/m2) - fluxlwUP_clrsky, & ! LW Clear-sky flux (W/m2) - fluxlwDOWN_clrsky ! LW All-sky flux (W/m2) - - ! 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) - hswc ! Shortwave 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) - type(topfsw_type), dimension(size(Grid%xlon,1)), intent(inout) :: & - topflx_sw ! radiation fluxes at top, components: - ! upfxc - total sky upward flux at top (w/m2) - ! upfx0 - clear sky upward flux at top (w/m2) - type(sfcfsw_type), dimension(size(Grid%xlon,1)), intent(inout) :: & - sfcflx_sw ! 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) :: & - hlw0, & ! Longwave clear-sky heating rate (K/sec) - hsw0 ! Shortwave clear-sky heating-rate (K/sec) - type(proflw_type), dimension(size(Grid%xlon,1), Model%levs+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) - type(profsw_type), dimension(size(Grid%xlon,1), Model%levs+1), intent(inout), optional :: & - flxprf_sw ! 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) + cldtaulw ! approx 10.mu band layer cloud optical depth + ! Inputs (optional) type(cmpfsw_type), dimension(size(Grid%xlon,1)), intent(inout), optional :: & scmpsw ! 2D surface fluxes, components: ! uvbfc - total sky downward uv-b flux at (W/m2) @@ -191,11 +89,16 @@ subroutine GFS_rrtmgp_post_run (Model, Grid, Diag, Radtend, Statein, & ! nirdf - downward nir diffused flux (W/m2) ! visbm - downward uv+vis direct beam flux (W/m2) ! visdf - downward uv+vis diffused flux (W/m2) + + ! Outputs (mandatory) + character(len=*), intent(out) :: & + errmsg + integer, intent(out) :: & + errflg + ! Local variables - integer :: i, j, k, k1, itop, ibtc, iBand, iSFC, iTOA + integer :: i, j, k, k1, itop, ibtc real(kind_phys) :: tem0d, tem1, tem2 - real(kind_phys), dimension(nDay, Model%levs) :: thetaTendClrSky, thetaTendAllSky - logical :: l_clrskylw_hr,l_clrskysw_hr, l_fluxeslw2d, l_fluxessw2d, top_at_1, l_sfcFluxessw1D ! Initialize CCPP error handling variables errmsg = '' @@ -203,197 +106,6 @@ subroutine GFS_rrtmgp_post_run (Model, Grid, Diag, Radtend, Statein, & if (.not. (Model%lsswr .or. Model%lslwr)) return - ! Are any optional outputs requested? - l_clrskylw_hr = present(hlw0) - l_fluxeslw2d = present(flxprf_lw) - l_clrskysw_hr = present(hsw0) - l_fluxessw2d = present(flxprf_sw) - l_sfcfluxessw1D = present(scmpsw) - - ! ####################################################################################### - ! What is vertical ordering? - ! ####################################################################################### - top_at_1 = (p_lev(1,1) .lt. p_lev(1, Model%levs)) - if (top_at_1) then - iSFC = Model%levs - iTOA = 1 - else - iSFC = 1 - iTOA = Model%levs - endif - - ! ####################################################################################### - ! Compute SW heating-rates - ! ####################################################################################### - ! Initialize outputs - hswc(:,:) = 0. - topflx_sw = topfsw_type ( 0., 0., 0. ) - sfcflx_sw = sfcfsw_type ( 0., 0., 0., 0. ) - if (l_clrskysw_hr) then - hsw0(:,:) = 0. - endif - if (l_fluxessw2D) then - flxprf_sw = profsw_type ( 0., 0., 0., 0. ) - endif - if (l_sfcfluxessw1D) then - scmpsw = cmpfsw_type (0.,0.,0.,0.,0.,0.) - endif - - if (Model%lsswr .and. nDay .gt. 0) then - ! Clear-sky heating-rate (optional) - if (l_clrskysw_HR) then - call check_error_msg('GFS_rrtmgp_post',compute_heating_rate( & - fluxswUP_clrsky, & - fluxswDOWN_clrsky, & - p_lev(idxday,1:Model%levs+1), & - thetaTendClrSky)) - hsw0(idxday,:)=thetaTendClrSky - endif - ! All-sky heating-rate (mandatory) - call check_error_msg('GFS_rrtmgp_post',compute_heating_rate( & - fluxswUP_allsky, & - fluxswDOWN_allsky, & - p_lev(idxday,1:Model%levs+1), & - thetaTendAllSky)) - hswc(idxday,:) = thetaTendAllSky - - ! Copy fluxes from RRTGMP types into model radiation types. - ! Mandatory outputs - topflx_sw%upfxc = fluxswUP_allsky(:,iTOA) - topflx_sw%upfx0 = fluxswUP_clrsky(:,iTOA) - sfcflx_sw%upfxc = fluxswUP_allsky(:,iSFC) - sfcflx_sw%upfx0 = fluxswUP_clrsky(:,iSFC) - sfcflx_sw%dnfxc = fluxswDOWN_allsky(:,iSFC) - sfcflx_sw%dnfx0 = fluxswDOWN_clrsky(:,iSFC) - - ! Optional output - if(l_fluxessw2D) then - flxprf_sw%upfxc = fluxswUP_allsky - flxprf_sw%dnfxc = fluxswDOWN_allsky - flxprf_sw%upfx0 = fluxswUP_clrsky - flxprf_sw%dnfx0 = fluxswDOWN_clrsky - endif - endif - - ! ####################################################################################### - ! Save SW outputs - ! ####################################################################################### - if (Model%lsswr) then - if (nday > 0) then - ! All-sky heating rate - do k = 1, Model%levs - Radtend%htrsw(1:im,k) = hswc(1:im,k) - enddo - ! Clear-sk heating rate - if (Model%swhtr) then - do k = 1, Model%levs - Radtend%swhc(1:im,k) = hsw0(1:im,k) - enddo - endif - - ! Surface down and up spectral component fluxes - ! - Save two spectral bands' surface downward and upward fluxes for output. - do i=1,im - Coupling%nirbmdi(i) = scmpsw(i)%nirbm - Coupling%nirdfdi(i) = scmpsw(i)%nirdf - Coupling%visbmdi(i) = scmpsw(i)%visbm - Coupling%visdfdi(i) = scmpsw(i)%visdf - - Coupling%nirbmui(i) = scmpsw(i)%nirbm * sfc_alb_nir_dir(1,i) - Coupling%nirdfui(i) = scmpsw(i)%nirdf * sfc_alb_nir_dif(1,i) - Coupling%visbmui(i) = scmpsw(i)%visbm * sfc_alb_uvvis_dir(1,i) - Coupling%visdfui(i) = scmpsw(i)%visdf * sfc_alb_uvvis_dif(1,i) - enddo - else ! if_nday_block - Radtend%htrsw(:,:) = 0.0 - Radtend%sfcfsw = sfcfsw_type( 0.0, 0.0, 0.0, 0.0 ) - Diag%topfsw = topfsw_type( 0.0, 0.0, 0.0 ) - scmpsw = cmpfsw_type( 0.0, 0.0, 0.0, 0.0, 0.0, 0.0 ) - - do i=1,im - Coupling%nirbmdi(i) = 0.0 - Coupling%nirdfdi(i) = 0.0 - Coupling%visbmdi(i) = 0.0 - Coupling%visdfdi(i) = 0.0 - - Coupling%nirbmui(i) = 0.0 - Coupling%nirdfui(i) = 0.0 - Coupling%visbmui(i) = 0.0 - Coupling%visdfui(i) = 0.0 - enddo - - if (Model%swhtr) then - Radtend%swhc(:,:) = 0 - endif - endif ! end_if_nday - - ! Radiation fluxes for other physics processes - do i=1,im - Coupling%sfcnsw(i) = Radtend%sfcfsw(i)%dnfxc - Radtend%sfcfsw(i)%upfxc - Coupling%sfcdsw(i) = Radtend%sfcfsw(i)%dnfxc - enddo - endif ! end_if_lsswr - - - ! ####################################################################################### - ! Compute LW heating-rates. (Note. This piece was originally in rrtmg_lw.F90:_run()) - ! ####################################################################################### - if (Model%lslwr) then - ! Clear-sky heating-rate (optional) - if (l_clrskylw_hr) then - call check_error_msg('GFS_rrtmgp_post',compute_heating_rate( & - fluxlwUP_clrsky, & - fluxlwDOWN_clrsky, & - p_lev, & - hlw0)) - endif - ! All-sky heating-rate (mandatory) - call check_error_msg('GFS_rrtmgp_post',compute_heating_rate( & - fluxlwUP_allsky, & - fluxlwDOWN_allsky, & - p_lev, & - hlwc)) - - ! 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) - - ! 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 - endif - - ! ####################################################################################### - ! Save LW outputs. - ! ####################################################################################### - if (Model%lslwr) then - ! Save surface air temp for diurnal adjustment at model t-steps - Radtend%tsflw (:) = tsfa(:) - - ! All-sky heating rate profile - do k = 1, model%levs - Radtend%htrlw(1:im,k) = hlwc(1:im,k) - enddo - if (Model%lwhtr) then - do k = 1, model%levs - Radtend%lwhc(1:im,k) = hlw0(1:im,k) - enddo - endif - - ! Radiation fluxes for other physics processes - Coupling%sfcdlw(:) = Radtend%sfcflw(:)%dnfxc - endif - - ! ####################################################################################### ! ####################################################################################### !> - For time averaged output quantities (including total-sky and diff --git a/physics/GFS_rrtmgp_pre.F90 b/physics/GFS_rrtmgp_pre.F90 index 83b8c2d3c..613c9ad15 100644 --- a/physics/GFS_rrtmgp_pre.F90 +++ b/physics/GFS_rrtmgp_pre.F90 @@ -98,6 +98,10 @@ end subroutine GFS_rrtmgp_pre_init !! | cld_reliq | mean_effective_radius_for_liquid_cloud | mean effective radius for liquid cloud | micron | 2 | real | kind_phys | out | F | !! | cld_iwp | cloud_ice_water_path | layer cloud ice water path | g m-2 | 2 | real | kind_phys | out | F | !! | cld_reice | mean_effective_radius_for_ice_cloud | mean effective radius for ice cloud | micron | 2 | real | kind_phys | out | F | +!! | cld_swp | cloud_snow_water_path | layer cloud snow water path | g m-2 | 2 | real | kind_phys | out | F | +!! | cld_resnow | mean_effective_radius_for_snow_flake | mean effective radius for snow cloud | micron | 2 | real | kind_phys | out | F | +!! | cld_rwp | cloud_rain_water_path | layer cloud rain water path | g m-2 | 2 | real | kind_phys | out | F | +!! | cld_rerain | mean_effective_radius_for_rain_drop | mean effective radius for rain cloud | micron | 2 | real | kind_phys | out | F | !! | faerlw | aerosol_optical_properties_for_longwave_bands_01-16 | aerosol optical properties for longwave bands 01-16 | various | 4 | real | kind_phys | out | F | !! | faersw | aerosol_optical_properties_for_shortwave_bands_01-16 | aerosol optical properties for shortwave bands 01-16 | various | 4 | real | kind_phys | out | F | !! | alb1d | surface_albedo_perturbation | surface albedo perturbation | frac | 1 | real | kind_phys | out | F | @@ -117,9 +121,9 @@ end subroutine GFS_rrtmgp_pre_init subroutine GFS_rrtmgp_pre_run (Model, Grid, Statein, Coupling, Radtend, Sfcprop, Tbd, & ! IN ncol, kdist_lw, kdist_sw, & ! IN raddt, p_lay, t_lay, p_lev, t_lev, tsfg, tsfa, alb1d, cld_frac, cld_lwp, & ! OUT - cld_reliq, cld_iwp, cld_reice, faerlw, faersw, sfc_emiss_byband, nday, idxday, & ! OUT - gas_concentrations, sfc_alb_nir_dir, sfc_alb_nir_dif, sfc_alb_uvvis_dir, & ! OUT - sfc_alb_uvvis_dif, errmsg, errflg) ! OUT + cld_reliq, cld_iwp, cld_reice, cld_swp, cld_resnow, cld_rwp, cld_rerain, faerlw, & ! OUT + faersw, sfc_emiss_byband, nday, idxday, gas_concentrations, sfc_alb_nir_dir, & ! OUT + sfc_alb_nir_dif, sfc_alb_uvvis_dir, sfc_alb_uvvis_dif, errmsg, errflg) ! OUT ! Inputs type(GFS_control_type), intent(in) :: & @@ -178,7 +182,11 @@ subroutine GFS_rrtmgp_pre_run (Model, Grid, Statein, Coupling, Radtend, Sfcprop, cld_lwp, & ! Cloud liquid water path cld_reliq, & ! Cloud liquid effective radius cld_iwp, & ! Cloud ice water path - cld_reice ! Cloud ice effecive radius + cld_reice, & ! Cloud ice effecive radius + cld_swp, & ! Cloud snow water path + cld_resnow, & ! Cloud snow effective radius + cld_rwp, & ! Cloud rain water path + cld_rerain ! Cloud rain effective radius real(kind_phys), dimension(ncol,Model%levs,kdist_sw%get_nband(),NF_AESW), intent(out) ::& faersw ! Aerosol radiative properties in each SW band. real(kind_phys), dimension(ncol,Model%levs,kdist_lw%get_nband(),NF_AELW), intent(out) ::& @@ -316,11 +324,15 @@ subroutine GFS_rrtmgp_pre_run (Model, Grid, Statein, Coupling, Radtend, Sfcprop, clouds, cldsa, mbota, mtopa, de_lgth) ! Copy output cloud fields - cld_frac = clouds(:,:,1) - cld_lwp = clouds(:,:,2) - cld_reliq = clouds(:,:,3) - cld_iwp = clouds(:,:,4) - cld_reice = clouds(:,:,5) + cld_frac = clouds(:,:,1) + cld_lwp = clouds(:,:,2) + cld_reliq = clouds(:,:,3) + cld_iwp = clouds(:,:,4) + cld_reice = clouds(:,:,5) + cld_rwp = clouds(:,:,6) + cld_rerain = clouds(:,:,7) + cld_swp = clouds(:,:,8) + cld_resnow = clouds(:,:,9) ! ####################################################################################### ! mg, sfc-perts diff --git a/physics/GFS_rrtmgp_sw.F90 b/physics/GFS_rrtmgp_sw.F90 index 29d55bf09..aa69982dc 100644 --- a/physics/GFS_rrtmgp_sw.F90 +++ b/physics/GFS_rrtmgp_sw.F90 @@ -1,22 +1,24 @@ module GFS_rrtmgp_sw - use GFS_typedefs, only: GFS_control_type - use machine, only: kind_phys - use physparam, only: isubcsw, iovrsw - use rrtmgp_sw, only: nrghice_sw => nrghice, ipsdsw0 - use mo_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp - use mo_cloud_optics, only: ty_cloud_optics - use mo_optical_props, only: ty_optical_props_2str - use mo_cloud_sampling, only: sampled_mask_max_ran, sampled_mask_exp_ran, draw_samples - use mersenne_twister, only: random_setseed, random_number, random_stat + use GFS_typedefs, only: GFS_control_type + use machine, only: kind_phys + use physparam, only: isubcsw, iovrsw + use rrtmgp_sw, only: nrghice_sw => nrghice, ipsdsw0 + use mo_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp + use mo_cloud_optics, only: ty_cloud_optics + use mo_optical_props, only: ty_optical_props_2str + use mo_cloud_sampling, only: sampled_mask_max_ran, sampled_mask_exp_ran, draw_samples + use mersenne_twister, only: random_setseed, random_number, random_stat + use mo_rrtmgp_sw_cloud_optics, only: rrtmgp_sw_cloud_optics public GFS_rrtmgp_sw_run,GFS_rrtmgp_sw_init,GFS_rrtmgp_sw_finalize contains - subroutine GFS_rrtmgp_sw_init() - end subroutine GFS_rrtmgp_sw_init ! ######################################################################################### ! ######################################################################################### + subroutine GFS_rrtmgp_sw_init() + end subroutine GFS_rrtmgp_sw_init + !! \section arg_table_GFS_rrtmgp_sw_run Argument Table !! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | !! |-----------------------|------------------------------------------------------|------------------------------------------------------------------------------|---------|------|-----------------------|-----------|--------|----------| @@ -30,10 +32,16 @@ end subroutine GFS_rrtmgp_sw_init !! | cld_reliq | mean_effective_radius_for_liquid_cloud | mean effective radius for liquid cloud | micron | 2 | real | kind_phys | in | F | !! | cld_iwp | cloud_ice_water_path | layer cloud ice water path | g m-2 | 2 | real | kind_phys | in | F | !! | cld_reice | mean_effective_radius_for_ice_cloud | mean effective radius for ice cloud | micron | 2 | real | kind_phys | in | F | +!! | cld_swp | cloud_snow_water_path | layer cloud snow water path | g m-2 | 2 | real | kind_phys | in | F | +!! | cld_resnow | mean_effective_radius_for_snow_flake | mean effective radius for snow cloud | micron | 2 | real | kind_phys | in | F | +!! | cld_rwp | cloud_rain_water_path | layer cloud rain water path | g m-2 | 2 | real | kind_phys | in | F | +!! | cld_rerain | mean_effective_radius_for_rain_drop | mean effective radius for rain cloud | micron | 2 | real | kind_phys | in | F | !! | icseed_sw | seed_random_numbers_sw | seed for random number generation for shortwave radiation | none | 1 | integer | | in | F | !! | kdist_sw | K_distribution_file_for_RRTMGP_SW_scheme | DDT containing spectral information for RRTMGP SW radiation scheme | DDT | 0 | ty_gas_optics_rrtmgp | | in | F | !! | aerosols | aerosol_optical_properties_for_shortwave_bands_01-16 | aerosol optical properties for shortwave bands 01-16 | various | 4 | real | kind_phys | in | F | !! | kdist_cldy_sw | K_distribution_file_for_cloudy_RRTMGP_SW_scheme | DDT containing spectral information for cloudy RRTMGP SW radiation scheme | DDT | 0 | ty_cloud_optics | | in | F | +!! | nday | daytime_points_dimension | daytime points dimension | count | 0 | integer | | in | F | +!! | idxday | daytime_points | daytime points | index | 1 | integer | | in | F | !! | optical_props_clouds | shortwave_optical_properties_for_cloudy_atmosphere | Fortran DDT containing RRTMGP optical properties | DDT | 0 | ty_optical_props_2str | | out | F | !! | optical_props_aerosol | shortwave_optical_properties_for_aerosols | Fortran DDT containing RRTMGP optical properties | DDT | 0 | ty_optical_props_2str | | out | F | !! | cldtausw | cloud_optical_depth_layers_at_0.55mu_band | approx .55mu band layer cloud optical depth | none | 2 | real | kind_phys | out | F | @@ -42,15 +50,19 @@ end subroutine GFS_rrtmgp_sw_init !! ! ######################################################################################### ! ######################################################################################### - subroutine GFS_rrtmgp_sw_run(Model, ncol, icseed_sw, p_lay, t_lay, p_lev, cld_frac, & - cld_lwp, cld_reliq, cld_iwp, cld_reice, kdist_sw, aerosols, kdist_cldy_sw, & - optical_props_clouds, optical_props_aerosol, cldtausw, errmsg, errflg) + subroutine GFS_rrtmgp_sw_run(Model, ncol, icseed_sw, p_lay, t_lay, p_lev, cld_frac, & ! IN + cld_lwp, cld_reliq, cld_iwp, cld_reice, cld_swp, cld_resnow, cld_rwp, cld_rerain, & ! IN + kdist_sw, aerosols, kdist_cldy_sw, nday, idxday, & ! IN + optical_props_clouds, optical_props_aerosol, cldtausw, errmsg, errflg) ! OUT ! Inputs type(GFS_control_type), intent(in) :: & Model integer, intent(in) :: & - ncol ! Number of horizontal gridpoints + ncol, & ! Number of horizontal gridpoints + nday ! Number of daylit points. + integer,intent(in),dimension(nday) :: & + idxday ! Indices for daylit points. integer,intent(in),dimension(ncol) :: & icseed_sw ! auxiliary special cloud related array when module ! variable isubcsw=2, it provides permutation seed @@ -66,7 +78,11 @@ subroutine GFS_rrtmgp_sw_run(Model, ncol, icseed_sw, p_lay, t_lay, p_lev, cld_fr cld_lwp, & ! Cloud liquid water path cld_reliq, & ! Cloud liquid effective radius cld_iwp, & ! Cloud ice water path - cld_reice ! Cloud ice effective radius + cld_reice, & ! Cloud ice effective radius + cld_swp, & ! Cloud snow water path + cld_resnow, & ! Cloud snow effective radius + cld_rwp, & ! Cloud rain water path + cld_rerain ! Cloud rain effective radius type(ty_gas_optics_rrtmgp),intent(in) :: & kdist_sw ! RRTMGP DDT containing spectral information for SW calculation type(ty_cloud_optics),intent(in) :: & @@ -92,6 +108,8 @@ subroutine GFS_rrtmgp_sw_run(Model, ncol, icseed_sw, p_lay, t_lay, p_lev, cld_fr real(kind_phys), dimension(kdist_sw%get_ngpt(),model%levs,ncol) :: rng3D real(kind_phys), dimension(kdist_sw%get_ngpt()*model%levs) :: rng1D logical, dimension(ncol,model%levs,kdist_sw%get_ngpt()) :: cldfracMCICA + real(kind_phys), dimension(nday,model%levs,kdist_sw%get_nband()) :: & + tau_cld, ssa_cld, asy_cld ! Initialize CCPP error handling variables errmsg = '' @@ -138,19 +156,36 @@ subroutine GFS_rrtmgp_sw_run(Model, ncol, icseed_sw, p_lay, t_lay, p_lev, cld_fr ! ####################################################################################### ! Compute cloud-optics for RTE. ! ####################################################################################### - call check_error_msg('GFS_rrtmgp_sw_run',kdist_cldy_sw%cloud_optics(& - ncol, & ! IN - Number of daylit gridpoints - model%levs, & ! IN - Number of vertical layers - kdist_sw%get_nband(), & ! IN - Number of SW bands - nrghice_sw, & ! IN - Number of ice-roughness categories - liqmask, & ! IN - Liquid-cloud mask - icemask, & ! IN - Ice-cloud mask - cld_lwp, & ! IN - Cloud liquid water path - cld_iwp, & ! IN - Cloud ice water path - cld_reliq, & ! IN - Cloud liquid effective radius - cld_reice, & ! IN - Cloud ice effective radius - optical_props_cloudsByBand)) ! OUT - RRTMGP DDT containing cloud radiative properties - ! in each band + if (Model%rrtmgp_cld_phys .gt. 0) then + ! RRTMGP cloud-optics. + call check_error_msg('GFS_rrtmgp_sw_run',kdist_cldy_sw%cloud_optics(& + ncol, & ! IN - Number of daylit gridpoints + model%levs, & ! IN - Number of vertical layers + kdist_sw%get_nband(), & ! IN - Number of SW bands + nrghice_sw, & ! IN - Number of ice-roughness categories + liqmask, & ! IN - Liquid-cloud mask + icemask, & ! IN - Ice-cloud mask + cld_lwp, & ! IN - Cloud liquid water path + cld_iwp, & ! IN - Cloud ice water path + cld_reliq, & ! IN - Cloud liquid effective radius + cld_reice, & ! IN - Cloud ice effective radius + optical_props_cloudsByBand)) ! OUT - RRTMGP DDT containing cloud radiative properties + ! in each band + else + ! RRTMG cloud-optics + if (any(cld_frac .gt. 0)) then + optical_props_cloudsByBand%tau(:,:,:) = 0._kind_phys + optical_props_cloudsByBand%ssa(:,:,:) = 0._kind_phys + optical_props_cloudsByBand%g(:,:,:) = 0._kind_phys + call rrtmgp_sw_cloud_optics(nday, model%levs, kdist_sw%get_nband(), cld_lwp(idxday,:), & + cld_reliq(idxday,:), cld_iwp(idxday,:), cld_reice(idxday,:), cld_rwp(idxday,:), & + cld_rerain(idxday,:), cld_swp(idxday,:), cld_resnow(idxday,:), cld_frac(idxday,:),& + tau_cld, ssa_cld, asy_cld) + optical_props_cloudsByBand%tau(idxday,:,:) = tau_cld + optical_props_cloudsByBand%ssa(idxday,:,:) = ssa_cld + optical_props_cloudsByBand%g(idxday,:,:) = asy_cld + endif + endif ! ####################################################################################### ! Call McICA to generate subcolumns. ! #######################################################################################