diff --git a/physics/GFS_rrtmgp_lw.F90 b/physics/GFS_rrtmgp_lw.F90 index 1accf7377..a71a10d13 100644 --- a/physics/GFS_rrtmgp_lw.F90 +++ b/physics/GFS_rrtmgp_lw.F90 @@ -38,6 +38,7 @@ end subroutine GFS_rrtmgp_lw_init !! | kdist_cldy_lw | K_distribution_file_for_cloudy_RRTMGP_LW_scheme | DDT containing spectral information for cloudy RRTMGP LW radiation scheme | DDT | 0 | ty_cloud_optics | | in | F | !! | optical_props_clouds | longwave_optical_properties_for_cloudy_atmosphere | Fortran DDT containing RRTMGP optical properties | DDT | 0 | ty_optical_props_1scl | | out | F | !! | optical_props_aerosol | longwave_optical_properties_for_aerosols | Fortran DDT containing RRTMGP optical properties | DDT | 0 | ty_optical_props_1scl | | out | F | +!! | cldtaulw | cloud_optical_depth_layers_at_10mu_band | approx 10mu band layer cloud optical depth | none | 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 | !! @@ -45,7 +46,7 @@ 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, errmsg, errflg) + kdist_cldy_lw, optical_props_clouds, optical_props_aerosol, cldtaulw, errmsg, errflg) ! Inputs type(GFS_control_type), intent(in) :: & @@ -76,6 +77,8 @@ subroutine GFS_rrtmgp_lw_run(Model, ncol, icseed_lw, p_lay, t_lay, p_lev, cld_fr kdist_cldy_lw ! real(kind_phys), intent(in),dimension(ncol, model%levs, kdist_lw%get_nband(),3) :: & aerosols ! + real(kind_phys), dimension(ncol,Model%levs), intent(out) :: & + cldtaulw ! approx 10.mu band layer cloud optical depth ! Outputs type(ty_optical_props_1scl),intent(out) :: & @@ -172,6 +175,9 @@ subroutine GFS_rrtmgp_lw_run(Model, ncol, icseed_lw, p_lay, t_lay, p_lev, cld_fr ! Map band optical depth to each g-point using McICA call check_error_msg('GFS_rrtmgp_lw_run',draw_samples(cldfracMCICA,optical_props_cloudsByBand,optical_props_clouds)) + ! GFS_RRTMGP_POST_RUN() requires the LW optical depth ~10microns + cldtaulw = optical_props_cloudsByBand%tau(:,:,7) + end subroutine GFS_rrtmgp_lw_run subroutine GFS_rrtmgp_lw_finalize() diff --git a/physics/GFS_rrtmgp_lw_post.F90 b/physics/GFS_rrtmgp_lw_post.F90 new file mode 100644 index 000000000..f1b10da86 --- /dev/null +++ b/physics/GFS_rrtmgp_lw_post.F90 @@ -0,0 +1,213 @@ +!>\file GFS_rrtmgp_lw_post +!!This file contains +module GFS_rrtmgp_lw_post + use machine, only: kind_phys + use GFS_typedefs, only: GFS_statein_type, & + GFS_coupling_type, & + GFS_control_type, & + GFS_grid_type, & + GFS_radtend_type, & + GFS_diag_type + use module_radiation_aerosols, only: NSPC1 + use module_radlw_parameters, only: topflw_type, sfcflw_type, proflw_type + ! RRTMGP DDT's + use mo_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp + use mo_fluxes_byband, only: ty_fluxes_byband + use mo_heating_rates, only: compute_heating_rate + implicit none + + public GFS_rrtmgp_lw_post_init,GFS_rrtmgp_lw_post_run,GFS_rrtmgp_lw_post_finalize + +contains + + subroutine GFS_rrtmgp_lw_post_init() + end subroutine GFS_rrtmgp_lw_post_init + + ! PGI compiler does not accept lines longer than 264 characters, remove during pre-processing +#ifndef __PGI +!> \section arg_table_GFS_rrtmgp_lw_post_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 | +!! | Grid | GFS_grid_type_instance | Fortran DDT containing FV3-GFS grid and interpolation related data | DDT | 0 | GFS_grid_type | | in | F | +!! | Diag | GFS_diag_type_instance | Fortran DDT containing FV3-GFS diagnotics data | DDT | 0 | GFS_diag_type | | inout | F | +!! | Radtend | GFS_radtend_type_instance | Fortran DDT containing FV3-GFS radiation tendencies | DDT | 0 | GFS_radtend_type | | inout | F | +!! | Statein | GFS_statein_type_instance | Fortran DDT containing FV3-GFS prognostic state data in from dycore | DDT | 0 | GFS_statein_type | | in | F | +!! | Coupling | GFS_coupling_type_instance | Fortran DDT containing FV3-GFS fields to/from coupling with other components | DDT | 0 | GFS_coupling_type | | inout | F | +!! | im | horizontal_loop_extent | horizontal loop extent | count | 0 | integer | | 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 | +!! | 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 | +!! | 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 | +!! | 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 | +!! | flxprf_lw | lw_fluxes | lw fluxes total sky / csk and up / down at levels | W m-2 | 2 | proflw_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 | +!! | 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 | +!! +#endif + subroutine GFS_rrtmgp_lw_post_run (Model, Grid, Diag, Radtend, Statein, & + Coupling, im, p_lev, kdist_lw, & + tsfa, fluxlwUP_allsky, fluxlwDOWN_allsky, fluxlwUP_clrsky, fluxlwDOWN_clrsky, & + hlwc, topflx_lw, sfcflx_lw, flxprf_lw, hlw0, errmsg, errflg) + + ! Inputs + type(GFS_control_type), intent(in) :: & + Model ! Fortran DDT containing FV3-GFS model control parameters + type(GFS_grid_type), intent(in) :: & + Grid ! Fortran DDT containing FV3-GFS grid and interpolation related data + type(GFS_statein_type), intent(in) :: & + Statein ! Fortran DDT containing FV3-GFS prognostic state data in from dycore + type(GFS_coupling_type), intent(inout) :: & + Coupling ! Fortran DDT containing FV3-GFS fields to/from coupling with other components + type(GFS_radtend_type), intent(inout) :: & + Radtend ! Fortran DDT containing FV3-GFS radiation tendencies + type(GFS_diag_type), intent(inout) :: & + Diag ! Fortran DDT containing FV3-GFS diagnotics data + integer, intent(in) :: & + im ! Horizontal loop extent + real(kind_phys), dimension(size(Grid%xlon,1)), intent(in) :: & + tsfa ! Lowest model layer air temperature for radiation + type(ty_gas_optics_rrtmgp),intent(in) :: & + kdist_lw ! DDT containing LW 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(size(Grid%xlon,1), Model%levs+1), intent(in) :: & + 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) + type(topflw_type), dimension(size(Grid%xlon,1)), intent(inout) :: & + topflx_lw ! radiation fluxes at top, components: + ! upfxc - total sky upward flux at top (w/m2) + ! upfx0 - clear sky upward flux at top (w/m2) + type(sfcflw_type), dimension(size(Grid%xlon,1)), intent(inout) :: & + sfcflx_lw ! radiation fluxes at sfc, components: + ! upfxc - total sky upward flux at sfc (w/m2) + ! upfx0 - clear sky upward flux at sfc (w/m2) + ! dnfxc - total sky downward flux at sfc (w/m2) + ! dnfx0 - clear sky downward flux at sfc (w/m2) + + ! Outputs (optional) + real(kind_phys), dimension(size(Grid%xlon,1), Model%levs), optional, intent(inout) :: & + hlw0 ! Longwave 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) + + ! Local variables + integer :: i, j, k, iBand, iSFC, iTOA + logical :: l_clrskylw_hr, l_fluxeslw2d, top_at_1 + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + if (.not. Model%lslwr) return + + ! Are any optional outputs requested? + l_clrskylw_hr = present(hlw0) + l_fluxeslw2d = present(flxprf_lw) + + ! ####################################################################################### + ! 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 LW heating-rates. + ! ####################################################################################### + 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 + + end subroutine GFS_rrtmgp_lw_post_run + + subroutine GFS_rrtmgp_lw_post_finalize () + end subroutine GFS_rrtmgp_lw_post_finalize + + subroutine check_error_msg(routine_name, error_msg) + character(len=*), intent(in) :: & + error_msg, routine_name + + if(error_msg /= "") then + print*,"ERROR("//trim(routine_name)//"): " + print*,trim(error_msg) + return + end if + end subroutine check_error_msg +end module GFS_rrtmgp_lw_post diff --git a/physics/GFS_rrtmgp_pre.F90 b/physics/GFS_rrtmgp_pre.F90 index e981fff1b..83b8c2d3c 100644 --- a/physics/GFS_rrtmgp_pre.F90 +++ b/physics/GFS_rrtmgp_pre.F90 @@ -202,7 +202,6 @@ subroutine GFS_rrtmgp_pre_run (Model, Grid, Statein, Coupling, Radtend, Sfcprop, deltaP, o3_lay, delta_q, cnv_w, cnv_c, effr_l, effr_i, effr_r, effr_s, cldcov real(kind_phys), dimension(ncol, Model%levs, 2:Model%ntrac) :: tracer real(kind_phys), dimension(ncol, Model%levs, NF_VGAS) :: gas_vmr - real(kind_phys), dimension(ncol, Model%levs, Model%ncnd) :: cld_condensate real(kind_phys), dimension(ncol, Model%levs, NF_CLDS) :: clouds real(kind_phys), dimension(ncol, Model%levs, kdist_sw%get_nband(), NF_AESW)::faersw2 @@ -314,7 +313,7 @@ subroutine GFS_rrtmgp_pre_run (Model, Grid, Statein, Coupling, Radtend, Sfcprop, ! ####################################################################################### call cloud_microphysics(Model, Tbd, Grid, Sfcprop, ncol, tracer, p_lay, t_lay, & p_lev, tv_lay, relhum, qs_lay, q_lay, deltaZ, deltaP, & - cld_condensate, clouds, cldsa, mbota, mtopa, de_lgth) + clouds, cldsa, mbota, mtopa, de_lgth) ! Copy output cloud fields cld_frac = clouds(:,:,1) @@ -437,7 +436,7 @@ end subroutine check_error_msg ! ####################################################################################### subroutine cloud_microphysics(Model, Tbd, Grid, Sfcprop, ncol, tracer, p_lay, t_lay, & p_lev, tv_lay, relhum, qs_lay, q_lay, deltaZ, deltaP, & - cld_condensate, clouds, cldsa, mbota, mtopa, de_lgth) + clouds, cldsa, mbota, mtopa, de_lgth) ! Inputs type(GFS_control_type), intent(in) :: & Model ! Fortran DDT containing FV3-GFS model control parameters @@ -447,10 +446,10 @@ subroutine cloud_microphysics(Model, Tbd, Grid, Sfcprop, ncol, tracer, p_lay, t_ Grid ! Fortran DDT containing FV3-GFS grid and interpolation related data type(GFS_sfcprop_type), intent(in) :: & Sfcprop ! Fortran DDT containing FV3-GFS surface fields - integer, intent(in) :: & ncol ! Number of horizontal gridpoints - real(kind_phys), dimension(ncol, Model%levs, Model%ntrac) :: tracer + real(kind_phys), dimension(ncol, Model%levs, Model%ntrac) :: & + tracer ! real(kind_phys), dimension(ncol,Model%levs), intent(in) :: & p_lay, & ! t_lay, & ! @@ -464,19 +463,17 @@ subroutine cloud_microphysics(Model, Tbd, Grid, Sfcprop, ncol, tracer, p_lay, t_ p_lev ! ! Outputs - real(kind_phys), dimension(ncol, Model%levs, Model%ncnd),intent(out) :: cld_condensate real(kind_phys), dimension(ncol, Model%levs, NF_CLDS),intent(out) :: clouds integer,dimension(ncol,3), intent(out) :: mbota, mtopa real(kind_phys), dimension(ncol), intent(out) :: de_lgth real(kind_phys), dimension(ncol, 5), intent(out) :: cldsa ! Local variables - !real(kind_phys), dimension(ncol, Model%levs, Model%ncnd) :: cld_condensate + real(kind_phys), dimension(ncol, Model%levs, Model%ncnd) :: cld_condensate integer :: i,k real(kind_phys), dimension(ncol, Model%levs) :: delta_q, cnv_w, cnv_c, effr_l, effr_i, effr_r, effr_s, cldcov real(kind_phys) :: es, qs, clwmin, clwm, clwt, onemrh, value, tem1, tem2 real(kind_phys), parameter :: xrc3 = 100. - ! ####################################################################################### ! Obtain cloud information for radiation calculations @@ -524,7 +521,6 @@ subroutine cloud_microphysics(Model, Tbd, Grid, Sfcprop, ncol, tracer, p_lay, t_ enddo endif - ! Add suspended convective cloud water to grid-scale cloud water ! only for cloud fraction & radiation computation it is to enhance ! cloudiness due to suspended convec cloud water for zhao/moorthi's @@ -563,19 +559,19 @@ subroutine cloud_microphysics(Model, Tbd, Grid, Sfcprop, ncol, tracer, p_lay, t_ else do k=1,model%levs do i=1,ncol - !cldcov(i,k1) = Tbd%phy_f3d(i,k,Model%indcld) - !if (tracer1(i,k,ntcw) .gt. 0 .or. tracer1(i,k,ntiw) .gt. 0) then - ! cldcov(i,k) = 0.1 - !else - ! cldcov(i,k) = 0.0 - !endif + cldcov(i,k1) = Tbd%phy_f3d(i,k,Model%indcld) + if (tracer(i,k,model%ntcw) .gt. 0 .or. tracer(i,k,model%ntiw) .gt. 0) then + cldcov(i,k) = 0.1 + else + cldcov(i,k) = 0.0 + endif enddo enddo endif elseif (Model%imp_physics == Model%imp_physics_gfdl) then ! GFDL MP cldcov(1:NCOL,1:Model%levs) = tracer(1:NCOL,1:Model%levs,Model%ntclamt) else ! neither of the other two cases - ! cldcov = 0.0 + cldcov = 0.0 endif ! ####################################################################################### diff --git a/physics/GFS_rrtmgp_sw.F90 b/physics/GFS_rrtmgp_sw.F90 index b64d4d712..29d55bf09 100644 --- a/physics/GFS_rrtmgp_sw.F90 +++ b/physics/GFS_rrtmgp_sw.F90 @@ -36,6 +36,7 @@ end subroutine GFS_rrtmgp_sw_init !! | 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 | !! | 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 | !! | 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 | !! @@ -43,7 +44,7 @@ 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, errmsg, errflg) + optical_props_clouds, optical_props_aerosol, cldtausw, errmsg, errflg) ! Inputs type(GFS_control_type), intent(in) :: & @@ -77,6 +78,8 @@ subroutine GFS_rrtmgp_sw_run(Model, ncol, icseed_sw, p_lay, t_lay, p_lev, cld_fr type(ty_optical_props_2str),intent(out) :: & optical_props_clouds, & optical_props_aerosol + real(kind_phys), dimension(ncol,Model%levs), intent(out) :: & + cldtausw ! approx 10.mu band layer cloud optical depth integer, intent(out) :: errflg character(len=*), intent(out) :: errmsg @@ -168,7 +171,10 @@ subroutine GFS_rrtmgp_sw_run(Model, ncol, icseed_sw, p_lay, t_lay, p_lev, cld_fr ! Map band optical depth to each g-point using McICA call check_error_msg('GFS_rrtmgp_sw_run',draw_samples(cldfracMCICA,optical_props_cloudsByBand,optical_props_clouds)) - + + ! GFS_RRTMGP_POST_RUN() requires the SW optical depth ~0.55microns + cldtausw = optical_props_cloudsByBand%tau(:,:,11) + end subroutine GFS_rrtmgp_sw_run subroutine GFS_rrtmgp_sw_finalize() diff --git a/physics/GFS_rrtmgp_sw_post.F90 b/physics/GFS_rrtmgp_sw_post.F90 new file mode 100644 index 000000000..a8c2d87bc --- /dev/null +++ b/physics/GFS_rrtmgp_sw_post.F90 @@ -0,0 +1,287 @@ +!>\file GFS_rrtmgp_sw_post +!!This file contains +module GFS_rrtmgp_sw_post + use machine, only: kind_phys + use GFS_typedefs, only: GFS_statein_type, & + GFS_coupling_type, & + GFS_control_type, & + GFS_grid_type, & + GFS_radtend_type, & + GFS_diag_type + use module_radiation_aerosols, only: NSPC1 + use module_radsw_parameters, only: topfsw_type, sfcfsw_type, profsw_type, cmpfsw_type + ! RRTMGP DDT's + use mo_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp + use mo_fluxes_byband, only: ty_fluxes_byband + use mo_heating_rates, only: compute_heating_rate + implicit none + + public GFS_rrtmgp_sw_post_init,GFS_rrtmgp_sw_post_run,GFS_rrtmgp_sw_post_finalize + +contains + + subroutine GFS_rrtmgp_sw_post_init() + end subroutine GFS_rrtmgp_sw_post_init + + ! PGI compiler does not accept lines longer than 264 characters, remove during pre-processing +#ifndef __PGI +!> \section arg_table_GFS_rrtmgp_sw_post_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 | +!! | Grid | GFS_grid_type_instance | Fortran DDT containing FV3-GFS grid and interpolation related data | DDT | 0 | GFS_grid_type | | in | F | +!! | Diag | GFS_diag_type_instance | Fortran DDT containing FV3-GFS diagnotics data | DDT | 0 | GFS_diag_type | | inout | F | +!! | Radtend | GFS_radtend_type_instance | Fortran DDT containing FV3-GFS radiation tendencies | DDT | 0 | GFS_radtend_type | | inout | F | +!! | Statein | GFS_statein_type_instance | Fortran DDT containing FV3-GFS prognostic state data in from dycore | DDT | 0 | GFS_statein_type | | in | F | +!! | Coupling | GFS_coupling_type_instance | Fortran DDT containing FV3-GFS fields to/from coupling with other components | DDT | 0 | GFS_coupling_type | | inout | F | +!! | 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 | +!! | im | horizontal_loop_extent | horizontal loop extent | count | 0 | integer | | 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 | +!! | 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 | +!! | 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_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_sw | sw_fluxes | sw fluxes total sky / csk and up / down at levels | W m-2 | 2 | profsw_type | | 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 | +!! +#endif + subroutine GFS_rrtmgp_sw_post_run (Model, Grid, Diag, Radtend, Statein, Coupling, & + scmpsw, im, p_lev, kdist_sw, sfc_alb_nir_dir, sfc_alb_nir_dif, sfc_alb_uvvis_dir, & + sfc_alb_uvvis_dif, tsfa, nday, idxday, fluxswUP_allsky, fluxswDOWN_allsky, & + fluxswUP_clrsky, fluxswDOWN_clrsky, hswc, topflx_sw, sfcflx_sw, flxprf_sw, hsw0, & + errmsg, errflg) + + ! Inputs + type(GFS_control_type), intent(in) :: & + Model ! Fortran DDT containing FV3-GFS model control parameters + type(GFS_grid_type), intent(in) :: & + Grid ! Fortran DDT containing FV3-GFS grid and interpolation related data + type(GFS_statein_type), intent(in) :: & + Statein ! Fortran DDT containing FV3-GFS prognostic state data in from dycore + type(GFS_coupling_type), intent(inout) :: & + Coupling ! Fortran DDT containing FV3-GFS fields to/from coupling with other components + type(GFS_radtend_type), intent(inout) :: & + Radtend ! Fortran DDT containing FV3-GFS radiation tendencies + 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 + real(kind_phys), dimension(size(Grid%xlon,1)), intent(in) :: & + tsfa ! Lowest model layer air temperature for radiation + type(ty_gas_optics_rrtmgp),intent(in) :: & + 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) + + ! Outputs (mandatory) + character(len=*), intent(out) :: & + errmsg + integer, intent(out) :: & + errflg + real(kind_phys),dimension(size(Grid%xlon,1), Model%levs),intent(out) :: & + hswc ! Shortwave all-sky heating-rate (K/sec) + 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) :: & + hsw0 ! Shortwave clear-sky heating-rate (K/sec) + 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) + 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) + ! 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 + integer :: i, j, k, k1, itop, ibtc, iBand, iSFC, iTOA + real(kind_phys) :: tem0d, tem1, tem2 + real(kind_phys), dimension(nDay, Model%levs) :: thetaTendClrSky, thetaTendAllSky + logical :: l_clrskysw_hr, l_fluxessw2d, top_at_1, l_sfcFluxessw1D + + ! Are any optional outputs requested? + 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 + + + end subroutine GFS_rrtmgp_sw_post_run + + subroutine GFS_rrtmgp_sw_post_finalize () + end subroutine GFS_rrtmgp_sw_post_finalize + + subroutine check_error_msg(routine_name, error_msg) + character(len=*), intent(in) :: & + error_msg, routine_name + + if(error_msg /= "") then + print*,"ERROR("//trim(routine_name)//"): " + print*,trim(error_msg) + return + end if + end subroutine check_error_msg +end module GFS_rrtmgp_sw_post