diff --git a/physics/GFS_rrtmgp_pre.F90 b/physics/GFS_rrtmgp_pre.F90 index 69b1eb5ce..1b37044b5 100644 --- a/physics/GFS_rrtmgp_pre.F90 +++ b/physics/GFS_rrtmgp_pre.F90 @@ -283,7 +283,7 @@ subroutine GFS_rrtmgp_pre_run (Model, Grid, Statein, Coupling, Radtend, Sfcprop, vmr_h2o = merge((q_lay/(1-q_lay))*amdw, 0., q_lay .ne. 1.) vmr_o3 = merge(o3_lay*amdo3, 0., o3_lay .gt. 0.) ! - call gas_concentrations%reset() + !call gas_concentrations%reset() call check_error_msg('GFS_rrtmgp_pre_run',gas_concentrations%set_vmr('o2', gas_vmr(:,:,4))) call check_error_msg('GFS_rrtmgp_pre_run',gas_concentrations%set_vmr('co2', gas_vmr(:,:,1))) call check_error_msg('GFS_rrtmgp_pre_run',gas_concentrations%set_vmr('ch4', gas_vmr(:,:,3))) diff --git a/physics/rrtmgp_lw.F90 b/physics/rrtmgp_lw.F90 index 9c27d6fa9..5abd2f702 100644 --- a/physics/rrtmgp_lw.F90 +++ b/physics/rrtmgp_lw.F90 @@ -2,14 +2,14 @@ ! ########################################################################################### module rrtmgp_lw use machine, only: kind_phys - use GFS_typedefs, only: GFS_control_type, GFS_radtend_type + use GFS_typedefs, only: GFS_control_type, GFS_radtend_type, GFS_statein_type use mo_rte_kind, only: wl 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 - use mo_rrtmgp_clr_all_sky, only: rte_lw - use mo_gas_concentrations, only: ty_gas_concs + use mo_rte_lw, only: rte_lw use mo_fluxes_byband, only: ty_fluxes_byband + use mo_source_functions, only: ty_source_func_lw use rrtmgp_aux, only: check_error_msg public rrtmgp_lw_init, rrtmgp_lw_run, rrtmgp_lw_finalize @@ -25,38 +25,42 @@ end subroutine rrtmgp_lw_init ! SUBROUTINE rrtmgp_lw_run ! ######################################################################################### !! \section arg_table_rrtmgp_lw_run Argument Table -!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | -!! |-------------------------|-----------------------------------------------------------------------------------------------|--------------------------------------------------------------------|-------|------|-----------------------|-----------|--------|----------| -!! | Model | GFS_control_type_instance | Fortran DDT containing FV3-GFS model control parameters | DDT | 0 | GFS_control_type | | in | F | -!! | Radtend | GFS_radtend_type_instance | Fortran DDT containing FV3-GFS radiation tendencies | DDT | 0 | GFS_radtend_type | | in | F | -!! | ncol | horizontal_loop_extent | horizontal dimension | count | 0 | integer | | in | F | -!! | p_lay | air_pressure_at_layer_for_RRTMGP_in_hPa | air pressure layer | hPa | 2 | 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 | -!! | t_lay | air_temperature_at_layer_for_RRTMGP | air temperature layer | K | 2 | real | kind_phys | in | F | -!! | skt | surface_ground_temperature_for_radiation | surface ground temperature for radiation | K | 1 | real | kind_phys | in | F | -!! | lw_gas_props | coefficients_for_lw_gas_optics | 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 | 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 | -!! | 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 | +!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | +!! |-----------------------|-----------------------------------------------------------------------------------------------|---------------------------------------------------------------------|-------|------|-----------------------|-----------|--------|----------| +!! | Model | GFS_control_type_instance | Fortran DDT containing FV3-GFS model control parameters | DDT | 0 | GFS_control_type | | in | F | +!! | Radtend | GFS_radtend_type_instance | Fortran DDT containing FV3-GFS radiation tendencies | DDT | 0 | GFS_radtend_type | | in | F | +!! | Statein | GFS_statein_type_instance | Fortran DDT containing FV3-GFS prognostic state data in from dycore | DDT | 0 | GFS_statein_type | | in | F | +!! | ncol | horizontal_loop_extent | horizontal dimension | count | 0 | integer | | in | F | +!! | p_lay | air_pressure_at_layer_for_RRTMGP_in_hPa | air pressure layer | hPa | 2 | 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 | +!! | t_lay | air_temperature_at_layer_for_RRTMGP | air temperature layer | K | 2 | real | kind_phys | in | F | +!! | skt | surface_ground_temperature_for_radiation | surface ground temperature for radiation | K | 1 | real | kind_phys | in | F | +!! | lw_gas_props | coefficients_for_lw_gas_optics | DDT containing spectral information for RRTMGP LW radiation scheme | DDT | 0 | ty_gas_optics_rrtmgp | | in | F | +!! | optical_props_clrsky | longwave_optical_properties_for_clear_sky | Fortran DDT containing RRTMGP optical properties | DDT | 0 | ty_optical_props_1scl | | inout | F | +!! | optical_props_cloud | longwave_optical_properties_for_cloudy_atmosphere | Fortran DDT containing RRTMGP optical properties | DDT | 0 | ty_optical_props_1scl | | in | F | +!! | optical_props_aerosol | longwave_optical_properties_for_aerosols | Fortran DDT containing RRTMGP optical properties | DDT | 0 | ty_optical_props_1scl | | in | F | +!! | sources | longwave_source_function | Fortran DDT containing RRTMGP source functions | DDT | 0 | ty_source_func_lw | | in | F | +!! | lslwr | flag_to_calc_lw | flag to calculate LW irradiances | flag | 0 | logical | | in | 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(Model, Radtend, ncol, lw_gas_props, p_lay, t_lay, p_lev, skt, & - gas_concentrations, optical_propsLW_clds, optical_propsLW_aerosol,& - lslwr, fluxUP_allsky, fluxDOWN_allsky, fluxUP_clrsky, fluxDOWN_clrsky, hlw0, hlwb, errmsg, errflg) + subroutine rrtmgp_lw_run(Model, Statein, Radtend, ncol, lw_gas_props, p_lay, t_lay, p_lev, & + skt, sources, optical_props_clrsky, optical_props_cloud, optical_props_aerosol, lslwr,& + fluxUP_allsky, fluxDOWN_allsky, fluxUP_clrsky, fluxDOWN_clrsky, hlw0, hlwb, errmsg, errflg) ! Inputs - type(GFS_control_type), intent(in) :: & - Model + type(GFS_control_type), intent(in) :: & + Model ! Fortran DDT containing FV3-GFS model control parameters type(GFS_radtend_type), intent(in) :: & Radtend ! Fortran DDT containing FV3-GFS radiation tendencies + type(GFS_statein_type), intent(in) :: & + Statein ! Fortran DDT containing FV3-GFS prognostic state data in from dycore integer, intent(in) :: & ncol ! Number of horizontal gridpoints real(kind_phys), dimension(ncol,model%levs), intent(in) :: & @@ -67,45 +71,52 @@ subroutine rrtmgp_lw_run(Model, Radtend, ncol, lw_gas_props, p_lay, t_lay, p_lev real(kind_phys), dimension(ncol), intent(in) :: & skt ! Surface(skin) temperature (K) type(ty_gas_optics_rrtmgp),intent(in) :: & - lw_gas_props ! DDT containing LW spectral information + lw_gas_props ! DDT containing LW spectral information + type(ty_optical_props_1scl),intent(inout) :: & + optical_props_clrsky ! RRTMGP DDT: longwave clear-sky radiative properties type(ty_optical_props_1scl),intent(in) :: & - optical_propsLW_clds, & ! RRTMGP DDT: longwave cloud radiative properties - optical_propsLW_aerosol ! RRTMGP DDT: longwave aerosol radiative properties - type(ty_gas_concs),intent(in) :: & - gas_concentrations ! RRTMGP DDT: trace gas concentrations (vmr) + optical_props_cloud, & ! RRTMGP DDT: longwave cloud radiative properties + optical_props_aerosol ! RRTMGP DDT: longwave aerosol radiative properties + type(ty_source_func_lw),intent(in) :: & + sources logical, intent(in) :: & lslwr ! Flag to calculate LW irradiances ! Outputs - character(len=*), intent(out) :: errmsg - integer, intent(out) :: errflg + character(len=*), intent(out) :: & + errmsg ! CCPP error message + integer, intent(out) :: & + errflg ! CCPP error flag real(kind_phys), dimension(ncol,model%levs), 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) + 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,model%levs,lw_gas_props%get_nband()), optional, intent(inout) :: & - hlwb ! All-sky heating rate, by band (K/sec) + hlwb ! All-sky heating rate, by band (K/sec) real(kind_phys), dimension(ncol,model%levs), optional, intent(inout) :: & - hlw0 ! Clear-sky heating rate (K/sec) + 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) + flux_allsky, flux_clrsky real(kind_phys), dimension(ncol,model%levs+1),target :: & fluxLW_up_allsky, fluxLW_up_clrsky, fluxLW_dn_allsky, fluxLW_dn_clrsky real(kind_phys), dimension(ncol,model%levs+1,lw_gas_props%get_nband()),target :: & fluxLWBB_up_allsky, fluxLWBB_dn_allsky - logical :: l_ClrSky_HR, l_AllSky_HR_byband + logical :: & + l_ClrSky_HR, l_AllSky_HR_byband, top_at_1 ! Initialize CCPP error handling variables errmsg = '' errflg = 0 if (.not. lslwr) return - + + ! Vertical ordering? + top_at_1 = (Statein%prsi(1,1) .lt. Statein%prsi(1, Model%levs)) + ! Are any optional outputs requested? Need to know now to compute correct fluxes. l_ClrSky_HR = present(hlw0) l_AllSky_HR_byband = present(hlwb) @@ -121,23 +132,33 @@ subroutine rrtmgp_lw_run(Model, Radtend, ncol, lw_gas_props, p_lay, t_lay, p_lev flux_allsky%bnd_flux_dn => fluxLWBB_dn_allsky endif - ! Call RRTMGP LW scheme + ! Compute clear-sky fluxes (if requested) + ! Clear-sky fluxes are gas+aerosol + call check_error_msg('rrtmgp_lw_run',optical_props_aerosol%increment(optical_props_clrsky)) + if (l_ClrSky_HR) then + call check_error_msg('rrtmgp_lw_run',rte_lw( & + optical_props_clrsky, & ! IN - optical-properties + top_at_1, & ! IN - veritcal ordering flag + sources, & ! IN - source function + Radtend%sfc_emiss_byband, & ! IN - surface emissivity in each LW band + flux_clrsky)) + ! Store fluxes + fluxUP_clrsky = flux_clrsky%flux_up + fluxDOWN_clrsky = flux_clrsky%flux_dn + endif + + ! All-sky fluxes + ! Clear-sky fluxes are (gas+aerosol)+clouds + call check_error_msg('rrtmgp_lw_run',optical_props_cloud%increment(optical_props_clrsky)) call check_error_msg('rrtmgp_lw_run',rte_lw( & - lw_gas_props, & ! IN - spectral information - gas_concentrations, & ! IN - gas concentrations (vmr) - p_lay, & ! IN - pressure at layer interfaces (Pa) - t_lay, & ! IN - temperature at layer interfaes (K) - p_lev, & ! IN - pressure at layer centers (Pa) - skt, & ! IN - skin temperature (K) + optical_props_clrsky, & ! IN - optical-properties + top_at_1, & ! IN - veritcal ordering flag + sources, & ! IN - source function Radtend%sfc_emiss_byband, & ! IN - surface emissivity in each LW band - optical_propsLW_clds, & ! IN - DDT containing cloud optical information - flux_allsky, & ! OUT - Fluxes, all-sky, 3D (nCol,model%levs,nBand) - flux_clrsky, & ! OUT - Fluxes, clear-sky, 3D (nCol,model%levs,nBand) - aer_props = optical_propsLW_aerosol)) ! IN(optional) - DDT containing aerosol optical information + flux_allsky)) + ! Store fluxes 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 diff --git a/physics/rrtmgp_lw_clrallsky_driver.F90 b/physics/rrtmgp_lw_clrallsky_driver.F90 new file mode 100644 index 000000000..e1d360dce --- /dev/null +++ b/physics/rrtmgp_lw_clrallsky_driver.F90 @@ -0,0 +1,151 @@ +! ########################################################################################### +! ########################################################################################### +module rrtmgp_lw_clrallsky_driver + use machine, only: kind_phys + use GFS_typedefs, only: GFS_control_type, GFS_radtend_type + use mo_rte_kind, only: wl + 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 + 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_aux, only: check_error_msg + + public rrtmgp_lw_clrallsky_driver_init, rrtmgp_lw_clrallsky_driver_run, rrtmgp_lw_clrallsky_driver_finalize +contains + + ! ######################################################################################### + ! SUBROUTINE rrtmgp_lw_clrallsky_driver_init + ! ######################################################################################### + subroutine rrtmgp_lw_clrallsky_driver_init() + end subroutine rrtmgp_lw_clrallsky_driver_init + + ! ######################################################################################### + ! SUBROUTINE rrtmgp_lw_clrallsky_driver_run + ! ######################################################################################### +!! \section arg_table_rrtmgp_lw_clrallsky_driver_run Argument Table +!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | +!! |-------------------------|-----------------------------------------------------------------------------------------------|--------------------------------------------------------------------|-------|------|-----------------------|-----------|--------|----------| +!! | Model | GFS_control_type_instance | Fortran DDT containing FV3-GFS model control parameters | DDT | 0 | GFS_control_type | | in | F | +!! | Radtend | GFS_radtend_type_instance | Fortran DDT containing FV3-GFS radiation tendencies | DDT | 0 | GFS_radtend_type | | in | F | +!! | ncol | horizontal_loop_extent | horizontal dimension | count | 0 | integer | | in | F | +!! | p_lay | air_pressure_at_layer_for_RRTMGP_in_hPa | air pressure layer | hPa | 2 | 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 | +!! | t_lay | air_temperature_at_layer_for_RRTMGP | air temperature layer | K | 2 | real | kind_phys | in | F | +!! | skt | surface_ground_temperature_for_radiation | surface ground temperature for radiation | K | 1 | real | kind_phys | in | F | +!! | lw_gas_props | coefficients_for_lw_gas_optics | 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 | 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 | +!! | 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_clrallsky_driver_run(Model, Radtend, ncol, lw_gas_props, p_lay, t_lay, p_lev, skt, & + gas_concentrations, optical_propsLW_clds, optical_propsLW_aerosol,& + lslwr, fluxUP_allsky, fluxDOWN_allsky, fluxUP_clrsky, fluxDOWN_clrsky, hlw0, hlwb, errmsg, errflg) + + ! Inputs + type(GFS_control_type), intent(in) :: & + Model + type(GFS_radtend_type), intent(in) :: & + Radtend ! Fortran DDT containing FV3-GFS radiation tendencies + integer, intent(in) :: & + ncol ! Number of horizontal gridpoints + real(kind_phys), dimension(ncol,model%levs), intent(in) :: & + p_lay, & ! Pressure @ model layer-centers (hPa) + t_lay ! Temperature (K) + real(kind_phys), dimension(ncol,model%levs+1), intent(in) :: & + p_lev ! Pressure @ model layer-interfaces (hPa) + real(kind_phys), dimension(ncol), intent(in) :: & + skt ! Surface(skin) temperature (K) + type(ty_gas_optics_rrtmgp),intent(in) :: & + lw_gas_props ! DDT containing LW spectral information + type(ty_optical_props_1scl),intent(in) :: & + optical_propsLW_clds, & ! RRTMGP DDT: longwave cloud radiative properties + optical_propsLW_aerosol ! RRTMGP DDT: longwave aerosol radiative properties + type(ty_gas_concs),intent(in) :: & + 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 + real(kind_phys), dimension(ncol,model%levs), 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,model%levs,lw_gas_props%get_nband()), optional, intent(inout) :: & + hlwb ! All-sky heating rate, by band (K/sec) + real(kind_phys), dimension(ncol,model%levs), 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,model%levs+1),target :: & + fluxLW_up_allsky, fluxLW_up_clrsky, fluxLW_dn_allsky, fluxLW_dn_clrsky + real(kind_phys), dimension(ncol,model%levs+1,lw_gas_props%get_nband()),target :: & + fluxLWBB_up_allsky, fluxLWBB_dn_allsky + logical :: l_ClrSky_HR, l_AllSky_HR_byband + + ! 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 + 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 + 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_clrallsky_driver_run',rte_lw( & + lw_gas_props, & ! IN - spectral information + gas_concentrations, & ! IN - gas concentrations (vmr) + p_lay, & ! IN - pressure at layer interfaces (Pa) + t_lay, & ! IN - temperature at layer interfaes (K) + p_lev, & ! IN - pressure at layer centers (Pa) + skt, & ! IN - skin temperature (K) + Radtend%sfc_emiss_byband, & ! IN - surface emissivity in each LW band + optical_propsLW_clds, & ! IN - DDT containing cloud optical information + flux_allsky, & ! OUT - Fluxes, all-sky, 3D (nCol,model%levs,nBand) + flux_clrsky, & ! OUT - Fluxes, clear-sky, 3D (nCol,model%levs,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_clrallsky_driver_run + + ! ######################################################################################### + ! SUBROUTINE rrtmgp_lw_clrallsky_driver_finalize + ! ######################################################################################### + subroutine rrtmgp_lw_clrallsky_driver_finalize() + end subroutine rrtmgp_lw_clrallsky_driver_finalize + + +end module rrtmgp_lw_clrallsky_driver diff --git a/physics/rrtmgp_lw_gas_optics.F90 b/physics/rrtmgp_lw_gas_optics.F90 index cc0e848c8..29e5d203b 100644 --- a/physics/rrtmgp_lw_gas_optics.F90 +++ b/physics/rrtmgp_lw_gas_optics.F90 @@ -4,6 +4,8 @@ module rrtmgp_lw_gas_optics use mo_rte_kind, only: wl use mo_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp use mo_gas_concentrations, only: ty_gas_concs + use mo_source_functions, only: ty_source_func_lw + use mo_optical_props, only: ty_optical_props_1scl use rrtmgp_aux, only: check_error_msg use netcdf @@ -419,7 +421,84 @@ end subroutine rrtmgp_lw_gas_optics_init ! If calling rte/mo_rte_sw.F90:rte_sw() directly, place calls to compute source ! function and gas_optics() here. ! ######################################################################################### - subroutine rrtmgp_lw_gas_optics_run() +!! \section arg_table_rrtmgp_lw_gas_optics_run Argument Table +!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | +!! |----------------------|----------------------------------------------|--------------------------------------------------------------------|-------|------|-----------------------|-----------|--------|----------| +!! | Model | GFS_control_type_instance | Fortran DDT containing FV3-GFS model control parameters | DDT | 0 | GFS_control_type | | in | F | +!! | Radtend | GFS_radtend_type_instance | Fortran DDT containing FV3-GFS radiation tendencies | DDT | 0 | GFS_radtend_type | | in | F | +!! | lw_gas_props | coefficients_for_lw_gas_optics | DDT containing spectral information for RRTMGP LW radiation scheme | DDT | 0 | ty_gas_optics_rrtmgp | | in | F | +!! | ncol | horizontal_loop_extent | horizontal dimension | count | 0 | integer | | in | F | +!! | p_lay | air_pressure_at_layer_for_RRTMGP_in_hPa | air pressure layer | hPa | 2 | 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 | +!! | t_lay | air_temperature_at_layer_for_RRTMGP | air temperature layer | K | 2 | real | kind_phys | in | F | +!! | t_lev | air_temperature_at_interface_for_RRTMGP | air temperature level | K | 2 | real | kind_phys | in | F | +!! | skt | surface_ground_temperature_for_radiation | surface ground temperature for radiation | K | 1 | 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 | +!! | lslwr | flag_to_calc_lw | flag to calculate LW irradiances | flag | 0 | logical | | in | 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 | +!! | optical_props_clrsky | longwave_optical_properties_for_clear_sky | Fortran DDT containing RRTMGP optical properties | DDT | 0 | ty_optical_props_1scl | | out | F | +!! | sources_LW | longwave_source_function | Fortran DDT containing RRTMGP source functions | DDT | 0 | ty_source_func_lw | | out | F | +!! + subroutine rrtmgp_lw_gas_optics_run(Model, Radtend, lw_gas_props, ncol, p_lay, p_lev, t_lay, t_lev, skt, & + gas_concentrations, lslwr, optical_props_clrsky, sources_LW, errmsg, errflg) + + ! Inputs + type(GFS_control_type), intent(in) :: & + Model ! DDT containing model control parameters + type(GFS_radtend_type), intent(in) :: & + Radtend + + type(ty_gas_optics_rrtmgp),intent(in) :: & + lw_gas_props ! DDT containing spectral information for RRTMGP LW radiation scheme + integer,intent(in) :: & + ncol ! Number of horizontal points + real(kind_phys), dimension(ncol,model%levs), intent(in) :: & + p_lay, & ! Pressure @ model layer-centers (hPa) + t_lay ! Temperature (K) + real(kind_phys), dimension(ncol,model%levs+1), intent(in) :: & + p_lev, & ! Pressure @ model layer-interfaces (hPa) + t_lev ! Temperature @ model levels + real(kind_phys), dimension(ncol), intent(in) :: & + skt ! Surface(skin) temperature (K) + type(ty_gas_concs),intent(in) :: & + gas_concentrations ! RRTMGP DDT: trace gas concentrations (vmr) + logical, intent(in) :: & + lslwr ! Flag to calculate LW irradiances + + ! Output + character(len=*), intent(out) :: & + errmsg ! Error message + integer, intent(out) :: & + errflg ! Error code + type(ty_optical_props_1scl),intent(out) :: & + optical_props_clrsky ! + type(ty_source_func_lw),intent(out) :: & + sources_LW + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + if (.not. Model%lslwr) return + + ! Allocate space + call check_error_msg('rrtmgp_lw_gas_optics_run',optical_props_clrsky%alloc_1scl(ncol, model%levs, lw_gas_props)) + call check_error_msg('rrtmgp_lw_gas_optics_run',sources_LW%init(lw_gas_props)) + call check_error_msg('rrtmgp_lw_gas_optics_run',sources_LW%alloc(ncol, Model%levs)) + + ! Gas-optics (djs asks pincus: I think it makes sense to have a generic gas_optics interface in + ! ty_gas_optics_rrtmgp, just as in ty_gas_optics. + call check_error_msg('rrtmgp_lw_gas_optics_run',lw_gas_props%gas_optics_int(& + p_lay, & ! + p_lev, & ! + t_lay, & ! + skt, & ! + gas_concentrations, & ! + optical_props_clrsky, & ! + sources_LW, & ! + tlev=t_lev)) ! + end subroutine rrtmgp_lw_gas_optics_run ! ######################################################################################### diff --git a/physics/rrtmgp_sw.F90 b/physics/rrtmgp_sw.F90 index 7e62dc708..c653fcb3e 100644 --- a/physics/rrtmgp_sw.F90 +++ b/physics/rrtmgp_sw.F90 @@ -2,12 +2,12 @@ ! ########################################################################################### module rrtmgp_sw use machine, only: kind_phys - use GFS_typedefs, only: GFS_control_type, GFS_radtend_type + use GFS_typedefs, only: GFS_control_type, GFS_radtend_type, GFS_statein_type use mo_rte_kind, only: wl 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_rrtmgp_clr_all_sky, only: rte_sw + use mo_rte_sw, only: rte_sw use mo_gas_concentrations, only: ty_gas_concs use mo_fluxes_byband, only: ty_fluxes_byband use module_radsw_parameters, only: cmpfsw_type @@ -31,17 +31,20 @@ end subroutine rrtmgp_sw_init !! |-------------------------|------------------------------------------------------------------------------------------------|--------------------------------------------------------------------------|-------|------|-----------------------|-----------|--------|----------| !! | Model | GFS_control_type_instance | Fortran DDT containing FV3-GFS model control parameters | DDT | 0 | GFS_control_type | | in | F | !! | Radtend | GFS_radtend_type_instance | Fortran DDT containing FV3-GFS radiation tendencies | DDT | 0 | GFS_radtend_type | | in | F | +!! | Statein | GFS_statein_type_instance | Fortran DDT containing FV3-GFS prognostic state data in from dycore | DDT | 0 | GFS_statein_type | | in | F | !! | ncol | horizontal_loop_extent | horizontal dimension | count | 0 | integer | | in | F | !! | p_lay | air_pressure_at_layer_for_RRTMGP_in_hPa | air pressure layer | hPa | 2 | 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 | !! | t_lay | air_temperature_at_layer_for_RRTMGP | air temperature layer | K | 2 | real | kind_phys | in | F | !! | sw_gas_props | coefficients_for_sw_gas_optics | DDT containing spectral information for RRTMGP SW radiation scheme | DDT | 0 | ty_gas_optics_rrtmgp | | in | F | -!! | optical_props_clds | shortwave_optical_properties_for_cloudy_atmosphere | Fortran DDT containing RRTMGP optical properties | DDT | 0 | ty_optical_props_2str | | in | F | +!! | optical_props_clrsky | shortwave_optical_properties_for_clear_sky | Fortran DDT containing RRTMGP optical properties | DDT | 0 | ty_optical_props_2str | | in | F | +!! | optical_props_cloud | shortwave_optical_properties_for_cloudy_atmosphere | Fortran DDT containing RRTMGP optical properties | DDT | 0 | ty_optical_props_2str | | in | F | !! | optical_props_aerosol | shortwave_optical_properties_for_aerosols | Fortran DDT containing RRTMGP optical properties | DDT | 0 | ty_optical_props_2str | | in | F | !! | gas_concentrations | Gas_concentrations_for_RRTMGP_suite | DDT containing gas concentrations for RRTMGP radiation scheme | DDT | 0 | ty_gas_concs | | in | F | !! | lsswr | flag_to_calc_sw | flag to calculate SW irradiances | flag | 0 | logical | | in | F | !! | nday | daytime_points_dimension | daytime points dimension | count | 0 | integer | | in | F | !! | idxday | daytime_points | daytime points | index | 1 | integer | | in | F | +!! | toa_src | Incoming_solar_irradiance_by_spectral_point | top of atmosphere incident solar flux in each spectral point | | 2 | real | kind_phys | in | F | !! | 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 | !! | hswb | sw_heating_rate_spectral | shortwave total sky heating rate (spectral) | K s-1 | 3 | real | kind_phys | inout | T | !! | scmpsw | components_of_surface_downward_shortwave_fluxes | derived type for special components of surface downward shortwave fluxes | W m-2 | 1 | cmpfsw_type | | inout | T | @@ -52,14 +55,18 @@ end subroutine rrtmgp_sw_init !! | 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_sw_run(Model, Radtend, ncol, sw_gas_props, p_lay, t_lay, p_lev, gas_concentrations, & - optical_props_clds, optical_props_aerosol, & - lsswr, nday, idxday, hsw0, hswb, scmpsw, & + subroutine rrtmgp_sw_run(Model, Radtend, Statein, ncol, sw_gas_props, p_lay, t_lay, p_lev, gas_concentrations, & + optical_props_clrsky, optical_props_cloud, optical_props_aerosol, & + lsswr, nday, idxday, toa_src, hsw0, hswb, scmpsw, & fluxUP_allsky, fluxDOWN_allsky, fluxUP_clrsky, fluxDOWN_clrsky, errmsg, errflg) ! Inputs - type(GFS_control_type), intent(in) :: Model - type(GFS_radtend_type), intent(in) :: Radtend + type(GFS_control_type), intent(in) :: & + Model + type(GFS_radtend_type), intent(in) :: & + Radtend + type(GFS_statein_type), intent(in) :: & + Statein ! Fortran DDT containing FV3-GFS prognostic state data in from dycore integer, intent(in) :: & ncol, & ! Number of horizontal gridpoints nday ! Number of daytime points @@ -73,13 +80,16 @@ subroutine rrtmgp_sw_run(Model, Radtend, ncol, sw_gas_props, p_lay, t_lay, p_lev type(ty_gas_optics_rrtmgp),intent(in) :: & sw_gas_props ! DDT containing SW spectral information type(ty_optical_props_2str),intent(in) :: & - optical_props_clds, & ! RRTMGP DDT: longwave cloud radiative properties + optical_props_clrsky, & ! RRTMGP DDT: longwave clear-sky radiative properties + optical_props_cloud, & ! RRTMGP DDT: longwave cloud radiative properties optical_props_aerosol ! RRTMGP DDT: longwave aerosol radiative properties type(ty_gas_concs),intent(in) :: & gas_concentrations ! RRTMGP DDT: trace gas concentrations (vmr) logical, intent(in) :: & lsswr ! Flag to calculate SW irradiances + real(kind_phys),dimension(ncol,sw_gas_props%get_ngpt()),intent(in) :: & + toa_src ! Outputs character(len=*), intent(out) :: errmsg @@ -114,11 +124,12 @@ subroutine rrtmgp_sw_run(Model, Radtend, ncol, sw_gas_props, p_lay, t_lay, p_lev real(kind_phys), dimension(nday,Model%levs+1,sw_gas_props%get_nband()),target :: & fluxSWBB_up_allsky, fluxSWBB_dn_allsky real(kind_phys), dimension(ncol,Model%levs) :: vmrTemp - logical :: l_ClrSky_HR=.false., l_AllSky_HR_byband=.false., l_scmpsw=.false. + logical :: l_ClrSky_HR=.false., l_AllSky_HR_byband=.false., l_scmpsw=.false., top_at_1 integer :: iGas type(ty_optical_props_2str) :: & - optical_props_clds_daylit, & ! RRTMGP DDT: longwave cloud radiative properties - optical_props_aerosol_daylit ! RRTMGP DDT: longwave aerosol radiative properties + optical_props_cloud_daylit, & ! RRTMGP DDT: longwave cloud radiative properties + optical_props_clrsky_daylit, & ! RRTMGP DDT: longwave clear-sky radiative properties + optical_props_aerosol_daylit ! RRTMGP DDT: longwave aerosol radiative properties type(ty_gas_concs) :: & gas_concentrations_daylit ! RRTMGP DDT: trace gas concentrations (vmr) @@ -128,6 +139,9 @@ subroutine rrtmgp_sw_run(Model, Radtend, ncol, sw_gas_props, p_lay, t_lay, p_lev if (.not. lsswr) return + ! Vertical ordering? + top_at_1 = (Statein%prsi(1,1) .lt. Statein%prsi(1, Model%levs)) + ! Are any optional outputs requested? Need to know now to compute correct fluxes. l_ClrSky_HR = present(hsw0) l_AllSky_HR_byband = present(hswb) @@ -143,16 +157,21 @@ subroutine rrtmgp_sw_run(Model, Radtend, ncol, sw_gas_props, p_lay, t_lay, p_lev if (nDay .gt. 0) then ! Subset the cloud and aerosol radiative properties over daylit points. - ! Cloud optics [nDay,Model%levs,nBands] - call check_error_msg('rrtmgp_sw_run',optical_props_clds_daylit%alloc_2str(nday, Model%levs, sw_gas_props)) - optical_props_clds_daylit%tau = optical_props_clds%tau(idxday,:,:) - optical_props_clds_daylit%ssa = optical_props_clds%ssa(idxday,:,:) - optical_props_clds_daylit%g = optical_props_clds%g(idxday,:,:) + ! Cloud optics [nDay,Model%levs,nGpts] + call check_error_msg('rrtmgp_sw_run',optical_props_cloud_daylit%alloc_2str(nday, Model%levs, sw_gas_props)) + optical_props_cloud_daylit%tau = optical_props_cloud%tau(idxday,:,:) + optical_props_cloud_daylit%ssa = optical_props_cloud%ssa(idxday,:,:) + optical_props_cloud_daylit%g = optical_props_cloud%g(idxday,:,:) ! Aerosol optics [nDay,Model%levs,nBands] call check_error_msg('rrtmgp_sw_run',optical_props_aerosol_daylit%alloc_2str(nday, Model%levs, sw_gas_props%get_band_lims_wavenumber())) optical_props_aerosol_daylit%tau = optical_props_aerosol%tau(idxday,:,:) optical_props_aerosol_daylit%ssa = optical_props_aerosol%ssa(idxday,:,:) optical_props_aerosol_daylit%g = optical_props_aerosol%g(idxday,:,:) + ! Clear-sky optics [nDay,Model%levs,nGpts] + call check_error_msg('rrtmgp_sw_run',optical_props_clrsky_daylit%alloc_2str(nday, Model%levs, sw_gas_props)) + optical_props_clrsky_daylit%tau = optical_props_clrsky%tau(idxday,:,:) + optical_props_clrsky_daylit%ssa = optical_props_clrsky%ssa(idxday,:,:) + optical_props_clrsky_daylit%g = optical_props_clrsky%g(idxday,:,:) ! Similarly, subset the gas concentrations. do iGas=1,Model%nGases @@ -170,25 +189,38 @@ subroutine rrtmgp_sw_run(Model, Radtend, ncol, sw_gas_props, p_lay, t_lay, p_lev flux_allsky%bnd_flux_up => fluxSWBB_up_allsky flux_allsky%bnd_flux_dn => fluxSWBB_dn_allsky endif - - ! Call RRTMGP SW scheme + + ! Compute clear-sky fluxes (if requested) + ! Clear-sky fluxes are gas+aerosol + call check_error_msg('rrtmgp_sw_run',optical_props_aerosol_daylit%increment(optical_props_clrsky_daylit)) + if (l_ClrSky_HR) then + call check_error_msg('rrtmgp_sw_run',rte_sw( & + optical_props_clrsky_daylit, & ! IN - optical-properties + top_at_1, & ! IN - veritcal ordering flag + Radtend%coszen(idxday), & ! IN - Cosine of solar zenith angle + toa_src(idxday,:), & ! IN - incident solar flux at TOA + Radtend%sfc_alb_nir_dir(:,idxday), & ! IN - Shortwave surface albedo (direct) + Radtend%sfc_alb_nir_dif(:,idxday), & ! IN - Shortwave surface albedo (diffuse) + flux_clrsky)) ! OUT - Fluxes, clear-sky, 3D (nCol,Model%levs,nBand) + ! Store fluxes + fluxUP_clrsky(idxday,:) = flux_clrsky%flux_up + fluxDOWN_clrsky(idxday,:) = flux_clrsky%flux_dn + endif + + ! Compute all-sky fluxes + call check_error_msg('rrtmgp_sw_run',optical_props_cloud_daylit%increment(optical_props_clrsky_daylit)) call check_error_msg('rrtmgp_sw_run',rte_sw( & - sw_gas_props, & ! IN - spectral information - gas_concentrations_daylit, & ! IN - gas concentrations (vmr) - p_lay(idxday,1:Model%levs), & ! IN - pressure at layer interfaces (Pa) - t_lay(idxday,1:Model%levs), & ! IN - temperature at layer interfaes (K) - p_lev(idxday,1:Model%levs+1), & ! IN - pressure at layer centers (Pa) - Radtend%coszen(idxday), & ! IN - Cosine of solar zenith angle - Radtend%sfc_alb_nir_dir(:,idxday), & ! IN - Shortwave surface albedo (direct) - Radtend%sfc_alb_nir_dif(:,idxday), & ! IN - Shortwave surface albedo (diffuse) - optical_props_clds_daylit, & ! IN - DDT containing cloud optical information - flux_allsky, & ! OUT - Fluxes, all-sky, 3D (nCol,Model%levs,nBand) - flux_clrsky, & ! OUT - Fluxes, clear-sky, 3D (nCol,Model%levs,nBand) - aer_props = optical_props_aerosol_daylit)) ! IN(optional) - DDT containing aerosol optical information + optical_props_clrsky_daylit, & ! IN - optical-properties + top_at_1, & ! IN - veritcal ordering flag + Radtend%coszen(idxday), & ! IN - Cosine of solar zenith angle + toa_src(idxday,:), & ! IN - incident solar flux at TOA + Radtend%sfc_alb_nir_dir(:,idxday), & ! IN - Shortwave surface albedo (direct) + Radtend%sfc_alb_nir_dif(:,idxday), & ! IN - Shortwave surface albedo (diffuse) + flux_allsky)) ! OUT - Fluxes, clear-sky, 3D (nCol,Model%levs,nBand) + ! Store fluxes fluxUP_allsky(idxday,:) = flux_allsky%flux_up - fluxDOWN_allsky(idxday,:) = flux_allsky%flux_dn - fluxUP_clrsky(idxday,:) = flux_clrsky%flux_up - fluxDOWN_clrsky(idxday,:) = flux_clrsky%flux_dn + fluxDOWN_allsky(idxday,:) = flux_allsky%flux_dn + endif end subroutine rrtmgp_sw_run diff --git a/physics/rrtmgp_sw_clrallsky_driver.F90 b/physics/rrtmgp_sw_clrallsky_driver.F90 new file mode 100644 index 000000000..baa6c1fad --- /dev/null +++ b/physics/rrtmgp_sw_clrallsky_driver.F90 @@ -0,0 +1,201 @@ +! ########################################################################################### +! ########################################################################################### +module rrtmgp_sw_clrallsky_driver + use machine, only: kind_phys + use GFS_typedefs, only: GFS_control_type, GFS_radtend_type + use mo_rte_kind, only: wl + 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_rrtmgp_clr_all_sky, only: rte_sw + use mo_gas_concentrations, only: ty_gas_concs + use mo_fluxes_byband, only: ty_fluxes_byband + use module_radsw_parameters, only: cmpfsw_type + use rrtmgp_aux, only: check_error_msg + + public rrtmgp_sw_clrallsky_driver_init, rrtmgp_sw_clrallsky_driver_run, rrtmgp_sw_clrallsky_driver_finalize + +contains + + ! ######################################################################################### + ! SUBROUTINE rrtmgp_sw_clrallsky_driver_init + ! ######################################################################################### + subroutine rrtmgp_sw_clrallsky_driver_init() + end subroutine rrtmgp_sw_clrallsky_driver_init + + ! ######################################################################################### + ! SUBROUTINE rrtmgp_sw_clrallsky_driver_run + ! ######################################################################################### +!! \section arg_table_rrtmgp_sw_clrallsky_driver_run Argument Table +!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | +!! |-------------------------|------------------------------------------------------------------------------------------------|--------------------------------------------------------------------------|-------|------|-----------------------|-----------|--------|----------| +!! | Model | GFS_control_type_instance | Fortran DDT containing FV3-GFS model control parameters | DDT | 0 | GFS_control_type | | in | F | +!! | Radtend | GFS_radtend_type_instance | Fortran DDT containing FV3-GFS radiation tendencies | DDT | 0 | GFS_radtend_type | | in | F | +!! | ncol | horizontal_loop_extent | horizontal dimension | count | 0 | integer | | in | F | +!! | p_lay | air_pressure_at_layer_for_RRTMGP_in_hPa | air pressure layer | hPa | 2 | 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 | +!! | t_lay | air_temperature_at_layer_for_RRTMGP | air temperature layer | K | 2 | real | kind_phys | in | F | +!! | sw_gas_props | coefficients_for_sw_gas_optics | DDT containing spectral information for RRTMGP SW radiation scheme | DDT | 0 | ty_gas_optics_rrtmgp | | in | F | +!! | optical_props_clds | shortwave_optical_properties_for_cloudy_atmosphere | Fortran DDT containing RRTMGP optical properties | DDT | 0 | ty_optical_props_2str | | in | F | +!! | optical_props_aerosol | shortwave_optical_properties_for_aerosols | Fortran DDT containing RRTMGP optical properties | DDT | 0 | ty_optical_props_2str | | in | F | +!! | gas_concentrations | Gas_concentrations_for_RRTMGP_suite | DDT containing gas concentrations for RRTMGP radiation scheme | DDT | 0 | ty_gas_concs | | in | F | +!! | lsswr | flag_to_calc_sw | flag to calculate SW irradiances | flag | 0 | logical | | in | F | +!! | nday | daytime_points_dimension | daytime points dimension | count | 0 | integer | | in | F | +!! | idxday | daytime_points | daytime points | index | 1 | integer | | in | F | +!! | 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 | +!! | hswb | sw_heating_rate_spectral | shortwave total sky heating rate (spectral) | K s-1 | 3 | real | kind_phys | inout | T | +!! | scmpsw | components_of_surface_downward_shortwave_fluxes | derived type for special components of surface downward shortwave fluxes | W m-2 | 1 | cmpfsw_type | | inout | T | +!! | fluxUP_allsky | sw_flux_profile_upward_allsky | RRTMGP upward shortwave all-sky flux profile | W m-2 | 2 | real | kind_phys | out | F | +!! | fluxDOWN_allsky | sw_flux_profile_downward_allsky | RRTMGP downward shortwave all-sky flux profile | W m-2 | 2 | real | kind_phys | out | F | +!! | fluxUP_clrsky | sw_flux_profile_upward_clrsky | RRTMGP upward shortwave clr-sky flux profile | W m-2 | 2 | real | kind_phys | out | F | +!! | fluxDOWN_clrsky | sw_flux_profile_downward_clrsky | RRTMGP downward shortwave 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_sw_clrallsky_driver_run(Model, Radtend, ncol, sw_gas_props, p_lay, t_lay, p_lev, gas_concentrations, & + optical_props_clds, optical_props_aerosol, & + lsswr, nday, idxday, hsw0, hswb, scmpsw, & + fluxUP_allsky, fluxDOWN_allsky, fluxUP_clrsky, fluxDOWN_clrsky, errmsg, errflg) + + ! Inputs + type(GFS_control_type), intent(in) :: Model + type(GFS_radtend_type), intent(in) :: Radtend + integer, intent(in) :: & + ncol, & ! Number of horizontal gridpoints + nday ! Number of daytime points + integer, intent(in), dimension(nday) :: & + idxday ! Index array for daytime points + real(kind_phys), dimension(ncol,Model%levs), intent(in) :: & + p_lay, & ! Pressure @ model layer-centers (hPa) + t_lay ! Temperature (K) + real(kind_phys), dimension(ncol,Model%levs+1), intent(in) :: & + p_lev ! Pressure @ model layer-interfaces (hPa) + type(ty_gas_optics_rrtmgp),intent(in) :: & + sw_gas_props ! DDT containing SW spectral information + type(ty_optical_props_2str),intent(in) :: & + optical_props_clds, & ! RRTMGP DDT: longwave cloud radiative properties + optical_props_aerosol ! RRTMGP DDT: longwave aerosol radiative properties + + type(ty_gas_concs),intent(in) :: & + gas_concentrations ! RRTMGP DDT: trace gas concentrations (vmr) + logical, intent(in) :: & + lsswr ! Flag to calculate SW irradiances + + ! Outputs + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + real(kind_phys), dimension(ncol,Model%levs), 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) + + ! Inputs (optional) (NOTE. We only need the optional arguments to know what fluxes to output, HR's are computed later) + real(kind_phys), dimension(ncol,Model%levs), optional, intent(inout) :: & + hsw0 ! Clear-sky heating rate (K/sec) + real(kind_phys), dimension(ncol,Model%levs,sw_gas_props%get_nband()), intent(inout), optional :: & + hswb ! All-sky heating rate, by band (K/sec) + ! Outputs (optional) + type(cmpfsw_type), dimension(ncol), intent(inout),optional :: & + scmpsw ! 2D surface fluxes, components: + ! uvbfc - total sky downward uv-b flux at (W/m2) + ! uvbf0 - clear sky downward uv-b flux at (W/m2) + ! nirbm - downward nir direct beam flux (W/m2) + ! nirdf - downward nir diffused flux (W/m2) + ! visbm - downward uv+vis direct beam flux (W/m2) + ! visdf - downward uv+vis diffused flux (W/m2) + + ! Local variables + type(ty_fluxes_byband) :: & + flux_allsky, & ! All-sky flux (W/m2) + flux_clrsky ! Clear-sky flux (W/m2) + real(kind_phys), dimension(nday,Model%levs+1),target :: & + fluxSW_up_allsky, fluxSW_up_clrsky, fluxSW_dn_allsky, fluxSW_dn_clrsky + real(kind_phys), dimension(nday,Model%levs+1,sw_gas_props%get_nband()),target :: & + fluxSWBB_up_allsky, fluxSWBB_dn_allsky + real(kind_phys), dimension(ncol,Model%levs) :: vmrTemp + logical :: l_ClrSky_HR=.false., l_AllSky_HR_byband=.false., l_scmpsw=.false. + integer :: iGas + type(ty_optical_props_2str) :: & + optical_props_clds_daylit, & ! RRTMGP DDT: longwave cloud radiative properties + optical_props_aerosol_daylit ! RRTMGP DDT: longwave aerosol radiative properties + type(ty_gas_concs) :: & + gas_concentrations_daylit ! RRTMGP DDT: trace gas concentrations (vmr) + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + if (.not. lsswr) return + + ! Are any optional outputs requested? Need to know now to compute correct fluxes. + l_ClrSky_HR = present(hsw0) + l_AllSky_HR_byband = present(hswb) + l_scmpsw = present(scmpsw) + if ( l_scmpsw ) then + scmpsw = cmpfsw_type (0., 0., 0., 0., 0., 0.) + endif + fluxUP_allsky(:,:) = 0._kind_phys + fluxDOWN_allsky(:,:) = 0._kind_phys + fluxUP_clrsky(:,:) = 0._kind_phys + fluxDOWN_clrsky(:,:) = 0._kind_phys + + if (nDay .gt. 0) then + + ! Subset the cloud and aerosol radiative properties over daylit points. + ! Cloud optics [nDay,Model%levs,nBands] + call check_error_msg('rrtmgp_sw_clrallsky_driver_run',optical_props_clds_daylit%alloc_2str(nday, Model%levs, sw_gas_props)) + optical_props_clds_daylit%tau = optical_props_clds%tau(idxday,:,:) + optical_props_clds_daylit%ssa = optical_props_clds%ssa(idxday,:,:) + optical_props_clds_daylit%g = optical_props_clds%g(idxday,:,:) + ! Aerosol optics [nDay,Model%levs,nBands] + call check_error_msg('rrtmgp_sw_clrallsky_driver_run',optical_props_aerosol_daylit%alloc_2str(nday, Model%levs, sw_gas_props%get_band_lims_wavenumber())) + optical_props_aerosol_daylit%tau = optical_props_aerosol%tau(idxday,:,:) + optical_props_aerosol_daylit%ssa = optical_props_aerosol%ssa(idxday,:,:) + optical_props_aerosol_daylit%g = optical_props_aerosol%g(idxday,:,:) + + ! Similarly, subset the gas concentrations. + do iGas=1,Model%nGases + call check_error_msg('rrtmgp_sw_clrallsky_driver_run',gas_concentrations%get_vmr(trim(Radtend%active_gases(iGas,1)),vmrTemp)) + call check_error_msg('rrtmgp_sw_clrallsky_driver_run',gas_concentrations_daylit%set_vmr(trim(Radtend%active_gases(iGas,1)),vmrTemp(idxday,:))) + enddo + + ! Initialize RRTMGP DDT containing 2D(3D) fluxes + flux_allsky%flux_up => fluxSW_up_allsky + flux_allsky%flux_dn => fluxSW_dn_allsky + flux_clrsky%flux_up => fluxSW_up_clrsky + flux_clrsky%flux_dn => fluxSW_dn_clrsky + ! Only calculate fluxes by-band, only when heating-rate profiles by band are requested. + if (l_AllSky_HR_byband) then + flux_allsky%bnd_flux_up => fluxSWBB_up_allsky + flux_allsky%bnd_flux_dn => fluxSWBB_dn_allsky + endif + + ! Call RRTMGP SW scheme + call check_error_msg('rrtmgp_sw_clrallsky_driver_run',rte_sw( & + sw_gas_props, & ! IN - spectral information + gas_concentrations_daylit, & ! IN - gas concentrations (vmr) + p_lay(idxday,1:Model%levs), & ! IN - pressure at layer interfaces (Pa) + t_lay(idxday,1:Model%levs), & ! IN - temperature at layer interfaes (K) + p_lev(idxday,1:Model%levs+1), & ! IN - pressure at layer centers (Pa) + Radtend%coszen(idxday), & ! IN - Cosine of solar zenith angle + Radtend%sfc_alb_nir_dir(:,idxday), & ! IN - Shortwave surface albedo (direct) + Radtend%sfc_alb_nir_dif(:,idxday), & ! IN - Shortwave surface albedo (diffuse) + optical_props_clds_daylit, & ! IN - DDT containing cloud optical information + flux_allsky, & ! OUT - Fluxes, all-sky, 3D (nCol,Model%levs,nBand) + flux_clrsky, & ! OUT - Fluxes, clear-sky, 3D (nCol,Model%levs,nBand) + aer_props = optical_props_aerosol_daylit)) ! IN(optional) - DDT containing aerosol optical information + fluxUP_allsky(idxday,:) = flux_allsky%flux_up + fluxDOWN_allsky(idxday,:) = flux_allsky%flux_dn + fluxUP_clrsky(idxday,:) = flux_clrsky%flux_up + fluxDOWN_clrsky(idxday,:) = flux_clrsky%flux_dn + endif + end subroutine rrtmgp_sw_clrallsky_driver_run + + ! ######################################################################################### + ! SUBROUTINE rrtmgp_sw_clrallsky_driver_finalize + ! ######################################################################################### + subroutine rrtmgp_sw_clrallsky_driver_finalize() + end subroutine rrtmgp_sw_clrallsky_driver_finalize + +end module rrtmgp_sw_clrallsky_driver diff --git a/physics/rrtmgp_sw_gas_optics.F90 b/physics/rrtmgp_sw_gas_optics.F90 index f0dc2e2d9..20ef531b2 100644 --- a/physics/rrtmgp_sw_gas_optics.F90 +++ b/physics/rrtmgp_sw_gas_optics.F90 @@ -5,6 +5,7 @@ module rrtmgp_sw_gas_optics use mo_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp use mo_gas_concentrations, only: ty_gas_concs use rrtmgp_aux, only: check_error_msg + use mo_optical_props, only: ty_optical_props_2str use netcdf contains @@ -417,8 +418,79 @@ end subroutine rrtmgp_sw_gas_optics_init ! If calling rte/mo_rte_sw.F90:rte_sw() directly, place calls to compute source ! function and gas_optics() here. ! ######################################################################################### - subroutine rrtmgp_sw_gas_optics_run() - end subroutine rrtmgp_sw_gas_optics_run +!! \section arg_table_rrtmgp_sw_gas_optics_run Argument Table +!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | +!! |----------------------|----------------------------------------------|--------------------------------------------------------------------|-------|------|-----------------------|-----------|--------|----------| +!! | Model | GFS_control_type_instance | Fortran DDT containing FV3-GFS model control parameters | DDT | 0 | GFS_control_type | | in | F | +!! | Radtend | GFS_radtend_type_instance | Fortran DDT containing FV3-GFS radiation tendencies | DDT | 0 | GFS_radtend_type | | in | F | +!! | sw_gas_props | coefficients_for_sw_gas_optics | DDT containing spectral information for RRTMGP SW radiation scheme | DDT | 0 | ty_gas_optics_rrtmgp | | in | F | +!! | ncol | horizontal_loop_extent | horizontal dimension | count | 0 | integer | | in | F | +!! | p_lay | air_pressure_at_layer_for_RRTMGP_in_hPa | air pressure layer | hPa | 2 | 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 | +!! | t_lay | air_temperature_at_layer_for_RRTMGP | air temperature layer | K | 2 | real | kind_phys | in | F | +!! | t_lev | air_temperature_at_interface_for_RRTMGP | air temperature level | K | 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 | +!! | lsswr | flag_to_calc_sw | flag to calculate SW irradiances | flag | 0 | logical | | in | 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 | +!! | optical_props_clrsky | shortwave_optical_properties_for_clear_sky | Fortran DDT containing RRTMGP optical properties | DDT | 0 | ty_optical_props_2str | | out | F | +!! | toa_src | Incoming_solar_irradiance_by_spectral_point | top of atmosphere incident solar flux in each spectral point | | 2 | real | kind_phys | out | F | +!! + subroutine rrtmgp_sw_gas_optics_run(Model, Radtend, sw_gas_props, ncol, p_lay, p_lev, t_lay, t_lev, & + gas_concentrations, lsswr, optical_props_clrsky, toa_src, errmsg, errflg) + + ! Inputs + type(GFS_control_type), intent(in) :: & + Model ! DDT containing model control parameters + type(GFS_radtend_type), intent(in) :: & + Radtend + + type(ty_gas_optics_rrtmgp),intent(in) :: & + sw_gas_props ! DDT containing spectral information for RRTMGP SW radiation scheme + integer,intent(in) :: & + ncol ! Number of horizontal points + real(kind_phys), dimension(ncol,model%levs), intent(in) :: & + p_lay, & ! Pressure @ model layer-centers (hPa) + t_lay ! Temperature (K) + real(kind_phys), dimension(ncol,model%levs+1), intent(in) :: & + p_lev, & ! Pressure @ model layer-interfaces (hPa) + t_lev ! Temperature @ model levels + type(ty_gas_concs),intent(in) :: & + gas_concentrations ! RRTMGP DDT: trace gas concentrations (vmr) + logical, intent(in) :: & + lsswr ! Flag to calculate SW irradiances + + ! Output + character(len=*), intent(out) :: & + errmsg ! Error message + integer, intent(out) :: & + errflg ! Error code + type(ty_optical_props_2str),intent(out) :: & + optical_props_clrsky ! + real(kind_phys),dimension(ncol,sw_gas_props%get_ngpt()),intent(out) :: & + toa_src + + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + if (.not. Model%lsswr) return + + ! Allocate space + call check_error_msg('rrtmgp_sw_gas_optics_run',optical_props_clrsky%alloc_2str(ncol, model%levs, sw_gas_props)) + + ! Gas-optics (djs asks pincus: I think it makes sense to have a generic gas_optics interface in + ! ty_gas_optics_rrtmgp, just as in ty_gas_optics. + call check_error_msg('rrtmgp_sw_gas_optics_run',sw_gas_props%gas_optics_ext(& + p_lay, & ! + p_lev, & ! + t_lay, & ! + gas_concentrations, & ! + optical_props_clrsky, & ! + toa_src)) ! + + end subroutine rrtmgp_sw_gas_optics_run ! ######################################################################################### ! SUBROUTINE rrtmgp_sw_gas_optics_finalize diff --git a/physics/rte-rrtmgp b/physics/rte-rrtmgp index 8c3dac82c..913ee2881 160000 --- a/physics/rte-rrtmgp +++ b/physics/rte-rrtmgp @@ -1 +1 @@ -Subproject commit 8c3dac82c8de6c1575d3d89abd9314cef6edb95e +Subproject commit 913ee2881f9e589776437e61031143874e6fa916