From 1386e5816e5e1602ce3c1490bb49ac6d86412ea7 Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Wed, 29 May 2019 17:05:59 -0600 Subject: [PATCH] More organizational changes to RRTMGP. --- physics/GFS_rrtmgp_post.F90 | 230 ++++++++++++---------- physics/GFS_rrtmgp_pre.F90 | 381 +++++++++--------------------------- physics/rrtmgp_lw.F90 | 63 +++--- physics/rrtmgp_lw_main.F90 | 97 --------- physics/rrtmgp_sw.F90 | 128 +++++++----- physics/rrtmgp_sw_pre.F90 | 217 ++++++++++---------- physics/rte-rrtmgp | 2 +- 7 files changed, 446 insertions(+), 672 deletions(-) delete mode 100644 physics/rrtmgp_lw_main.F90 diff --git a/physics/GFS_rrtmgp_post.F90 b/physics/GFS_rrtmgp_post.F90 index 150970c8b..b85852c60 100644 --- a/physics/GFS_rrtmgp_post.F90 +++ b/physics/GFS_rrtmgp_post.F90 @@ -15,7 +15,6 @@ module GFS_rrtmgp_post 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 - use rrtmgp_sw, only: check_error_msg implicit none contains @@ -55,10 +54,14 @@ end subroutine GFS_rrtmgp_post_init !! | p_lev | air_pressure_at_interface_for_radiation_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 | -!! | fluxLW_allsky | lw_flux_profiles_byband_allsky | Fortran DDT containing RRTMGP 3D fluxes | DDT | 0 | ty_fluxes_byband | | in | F | -!! | fluxLW_clrsky | lw_flux_profiles_byband_clrsky | Fortran DDT containing RRTMGP 3D fluxes | DDT | 0 | ty_fluxes_byband | | in | F | -!! | fluxSW_allsky | sw_flux_profiles_byband_allsky | Fortran DDT containing RRTMGP 3D fluxes | DDT | 0 | ty_fluxes_byband | | in | F | -!! | fluxSW_clrsky | sw_flux_profiles_byband_clrsky | Fortran DDT containing RRTMGP 3D fluxes | DDT | 0 | ty_fluxes_byband | | 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 | @@ -83,7 +86,8 @@ subroutine GFS_rrtmgp_post_run (Model, Grid, Diag, Radtend, Statein, & 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, fluxSW_allsky, fluxSW_clrsky,fluxLW_allsky, fluxLW_clrsky,& + 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) ! Inputs @@ -130,16 +134,20 @@ subroutine GFS_rrtmgp_post_run (Model, Grid, Diag, Radtend, Statein, & kdist_sw ! DDT containing SW spectral information real(kind_phys), dimension(size(Grid%xlon,1), Model%levr+LTP+1), intent(in) :: & p_lev ! Pressure @ model layer-interfaces (hPa) - type(ty_fluxes_byband),intent(in) :: & - fluxLW_allsky, & ! Longwave all-sky flux (W/m2) - fluxLW_clrsky, & ! Longwave clear-sky flux (W/m2) - fluxSW_allsky, & ! Shortwave all-sky flux (W/m2) - fluxSW_clrsky ! Shortwave clear-sky flux (W/m2) 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%levr+LTP+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) :: & @@ -203,9 +211,9 @@ subroutine GFS_rrtmgp_post_run (Model, Grid, Diag, Radtend, Statein, & ! Initialize CCPP error handling variables errmsg = '' errflg = 0 - + if (.not. (Model%lsswr .or. Model%lslwr)) return - + ! Are any optional outputs requested? l_clrskylw_hr = present(hlw0) l_fluxeslw2d = present(flxprf_lw) @@ -223,80 +231,7 @@ subroutine GFS_rrtmgp_post_run (Model, Grid, Diag, Radtend, Statein, & iSFC = 1 iTOA = Model%levr+LTP+1 endif - - ! ####################################################################################### - ! 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( & - fluxLW_clrsky%flux_up, & - fluxLW_clrsky%flux_dn, & - p_lev, & - hlw0)) - endif - ! All-sky heating-rate (mandatory) - call check_error_msg('GFS_rrtmgp_post',compute_heating_rate( & - fluxLW_allsky%flux_up, & - fluxLW_allsky%flux_dn, & - p_lev, & - hlwc)) - - ! Copy fluxes from RRTGMP types into model radiation types. - ! Mandatory outputs - topflx_lw%upfxc = fluxLW_allsky%flux_up(:,iTOA) - topflx_lw%upfx0 = fluxLW_clrsky%flux_up(:,iTOA) - sfcflx_lw%upfxc = fluxLW_allsky%flux_up(:,iSFC) - sfcflx_lw%upfx0 = fluxLW_clrsky%flux_up(:,iSFC) - sfcflx_lw%dnfxc = fluxLW_allsky%flux_dn(:,iSFC) - sfcflx_lw%dnfx0 = fluxLW_clrsky%flux_dn(:,iSFC) - - ! Optional outputs - if(l_fluxeslw2d) then - flxprf_lw%upfxc = fluxLW_allsky%flux_up - flxprf_lw%dnfxc = fluxLW_allsky%flux_dn - flxprf_lw%upfx0 = fluxLW_clrsky%flux_up - flxprf_lw%dnfx0 = fluxLW_clrsky%flux_dn - endif - endif - - ! ####################################################################################### - ! Save LW outputs (Note. This piece was originally in rrtmg_lw_post.F90:_run()) - ! ####################################################################################### - if (Model%lslwr) then - ! Save surface air temp for diurnal adjustment at model t-steps - Radtend%tsflw (:) = tsfa(:) - - do k = 1, LM - k1 = k + kd - Radtend%htrlw(1:im,k) = hlwc(1:im,k1) - enddo - ! Repopulate the points above levr - if (lm < Model%levs) then - do k = lm,Model%levs - Radtend%htrlw (1:im,k) = Radtend%htrlw (1:im,LM) - enddo - endif - - if (Model%lwhtr) then - do k = 1, lm - k1 = k + kd - Radtend%lwhc(1:im,k) = hlw0(1:im,k1) - enddo - ! Repopulate the points above levr - if (lm < Model%levs) then - do k = lm,Model%levs - Radtend%lwhc(1:im,k) = Radtend%lwhc(1:im,LM) - enddo - endif - endif - - ! Radiation fluxes for other physics processes - Coupling%sfcdlw(:) = Radtend%sfcflw(:)%dnfxc - - endif - + ! ####################################################################################### ! Compute SW heating-rates ! ####################################################################################### @@ -318,36 +253,35 @@ subroutine GFS_rrtmgp_post_run (Model, Grid, Diag, Radtend, Statein, & ! Clear-sky heating-rate (optional) if (l_clrskysw_HR) then call check_error_msg('GFS_rrtmgp_post',compute_heating_rate( & - fluxSW_clrsky%flux_up, & - fluxSW_clrsky%flux_dn, & + fluxswUP_clrsky, & + fluxswDOWN_clrsky, & p_lev(idxday,1:Model%levr+LTP+1), & thetaTendClrSky)) hsw0(idxday,:)=thetaTendClrSky endif ! All-sky heating-rate (mandatory) call check_error_msg('GFS_rrtmgp_post',compute_heating_rate( & - fluxSW_allsky%flux_up, & - fluxSW_allsky%flux_dn, & + fluxswUP_allsky, & + fluxswDOWN_allsky, & p_lev(idxday,1:Model%levr+LTP+1), & thetaTendAllSky)) hswc(idxday,:) = thetaTendAllSky - print*,'IN POST: ',fluxSW_allsky%flux_up - print*,'IN POSTT: ',fluxSW_allsky%flux_dn + ! Copy fluxes from RRTGMP types into model radiation types. ! Mandatory outputs - topflx_sw(idxday)%upfxc = fluxSW_allsky%flux_up(:,iTOA) - topflx_sw(idxday)%upfx0 = fluxSW_clrsky%flux_up(:,iTOA) - sfcflx_sw(idxday)%upfxc = fluxSW_allsky%flux_up(:,iSFC) - sfcflx_sw(idxday)%upfx0 = fluxSW_clrsky%flux_up(:,iSFC) - sfcflx_sw(idxday)%dnfxc = fluxSW_allsky%flux_dn(:,iSFC) - sfcflx_sw(idxday)%dnfx0 = fluxSW_clrsky%flux_dn(:,iSFC) + 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(idxday,:)%upfxc = fluxSW_allsky%flux_up - flxprf_sw(idxday,:)%dnfxc = fluxSW_allsky%flux_dn - flxprf_sw(idxday,:)%upfx0 = fluxSW_clrsky%flux_up - flxprf_sw(idxday,:)%dnfx0 = fluxSW_clrsky%flux_dn + flxprf_sw%upfxc = fluxswUP_allsky + flxprf_sw%dnfxc = fluxswDOWN_allsky + flxprf_sw%upfx0 = fluxswUP_clrsky + flxprf_sw%dnfx0 = fluxswDOWN_clrsky endif endif @@ -394,7 +328,7 @@ subroutine GFS_rrtmgp_post_run (Model, Grid, Diag, Radtend, Statein, & Coupling%visdfui(i) = scmpsw(i)%visdf * sfc_alb_uvvis_dif(1,i) enddo else ! if_nday_block - Radtend%htrsw(:,:) = 0.0 + 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 ) @@ -423,6 +357,81 @@ subroutine GFS_rrtmgp_post_run (Model, Grid, Diag, Radtend, Statein, & 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 (Note. This piece was originally in rrtmg_lw_post.F90:_run()) + ! ####################################################################################### + if (Model%lslwr) then + ! Save surface air temp for diurnal adjustment at model t-steps + Radtend%tsflw (:) = tsfa(:) + + do k = 1, LM + k1 = k + kd + Radtend%htrlw(1:im,k) = hlwc(1:im,k1) + enddo + ! Repopulate the points above levr + if (lm < Model%levs) then + do k = lm,Model%levs + Radtend%htrlw (1:im,k) = Radtend%htrlw (1:im,LM) + enddo + endif + + if (Model%lwhtr) then + do k = 1, lm + k1 = k + kd + Radtend%lwhc(1:im,k) = hlw0(1:im,k1) + enddo + ! Repopulate the points above levr + if (lm < Model%levs) then + do k = lm,Model%levs + Radtend%lwhc(1:im,k) = Radtend%lwhc(1:im,LM) + enddo + endif + endif + + ! Radiation fluxes for other physics processes + Coupling%sfcdlw(:) = Radtend%sfcflw(:)%dnfxc + + endif + + ! ####################################################################################### ! ####################################################################################### !> - For time averaged output quantities (including total-sky and @@ -537,7 +546,16 @@ end subroutine GFS_rrtmgp_post_run !> \section arg_table_GFS_rrtmgp_post_finalize Argument Table !! subroutine GFS_rrtmgp_post_finalize () - end subroutine GFS_rrtmgp_post_finalize -!! @} + end subroutine GFS_rrtmgp_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_post diff --git a/physics/GFS_rrtmgp_pre.F90 b/physics/GFS_rrtmgp_pre.F90 index fcb0e0fb0..b25e02fb3 100644 --- a/physics/GFS_rrtmgp_pre.F90 +++ b/physics/GFS_rrtmgp_pre.F90 @@ -51,18 +51,12 @@ module GFS_rrtmgp_pre setemis, & ! Routine to compute surface-emissivity NF_ALBD, & ! Number of surface albedo categories (4; nir-direct, nir-diffuse, uvvis-direct, uvvis-diffuse) setalb ! Routine to compute surface albedo - - use rrtmgp_lw, only: nrghice_lw => nrghice, ipsdlw0 - use rrtmgp_sw, only: nrghice_sw => nrghice, ipsdsw0, check_error_msg use mersenne_twister, only: & random_setseed, & random_number, & random_stat ! RRTMGP types 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 real(kind_phys), parameter :: & @@ -101,8 +95,6 @@ end subroutine GFS_rrtmgp_pre_init !! | kt | vertical_index_difference_between_layer_and_upper_bound | vertical index difference between layer and upper bound | index | 0 | integer | | out | F | !! | kb | vertical_index_difference_between_layer_and_lower_bound | vertical index difference between layer and lower bound | index | 0 | integer | | out | F | !! | raddt | time_step_for_radiation | radiation time step | s | 0 | real | kind_phys | out | F | -!! | delp | layer_pressure_thickness_for_radiation | layer pressure thickness on radiation levels | hPa | 2 | real | kind_phys | out | F | -!! | dz | layer_thickness_for_radiation | layer thickness on radiation levels | km | 2 | real | kind_phys | out | F | !! | plvl | air_pressure_at_interface_for_radiation_in_hPa | air pressure at vertical interface for radiation calculation | hPa | 2 | real | kind_phys | out | F | !! | plyr | air_pressure_at_layer_for_radiation_in_hPa | air pressure at vertical layer for radiation calculation | hPa | 2 | real | kind_phys | out | F | !! | tlvl | air_temperature_at_interface_for_radiation | air temperature at vertical interface for radiation calculation | K | 2 | real | kind_phys | out | F | @@ -111,45 +103,31 @@ end subroutine GFS_rrtmgp_pre_init !! | tsfa | surface_air_temperature_for_radiation | lowest model layer air temperature for radiation | K | 1 | real | kind_phys | out | F | !! | qlyr | water_vapor_specific_humidity_at_layer_for_radiation | water vapor specific humidity at vertical layer for radiation calculation | kg kg-1 | 2 | real | kind_phys | out | F | !! | olyr | ozone_concentration_at_layer_for_radiation | ozone concentration | kg kg-1 | 2 | real | kind_phys | out | F | -!! | icseed | seed_random_numbers_lw | seed for random number generation for longwave radiation | none | 1 | integer | | in | F | +!! | cld_frac | total_cloud_fraction | layer total cloud fraction | frac | 2 | real | kind_phys | out | F | +!! | cld_lwp | cloud_liquid_water_path | layer cloud liquid water path | g m-2 | 2 | real | kind_phys | out | F | +!! | 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 | +!! | icseed_sw | seed_random_numbers_sw | seed for random number generation for shortwave radiation | none | 1 | integer | | in | F | +!! | icseed_lw | seed_random_numbers_lw | seed for random number generation for longwave radiation | none | 1 | integer | | in | 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 | !! | aerodp | atmosphere_optical_thickness_due_to_ambient_aerosol_particles | vertical integrated optical depth for various aerosol species | none | 2 | real | kind_phys | out | F | -!! | cldsa | cloud_area_fraction_for_radiation | fraction of clouds for low, middle,high, total and BL | frac | 2 | real | kind_phys | out | F | -!! | mtopa | model_layer_number_at_cloud_top | vertical indices for low, middle and high cloud tops | index | 2 | integer | | out | F | -!! | mbota | model_layer_number_at_cloud_base | vertical indices for low, middle and high cloud bases | index | 2 | integer | | out | F | -!! | de_lgth | cloud_decorrelation_length | cloud decorrelation length | km | 1 | real | kind_phys | out | F | !! | alb1d | surface_albedo_perturbation | surface albedo perturbation | frac | 1 | 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 | !! | 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 | -!! | 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 | -!! | 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_propsLW_clouds | longwave_optical_properties_for_cloudy_atmosphere | Fortran DDT containing RRTMGP optical properties | DDT | 0 | ty_optical_props_1scl | | out | F | -!! | optical_propsLW_aerosol | longwave_optical_properties_for_aerosols | Fortran DDT containing RRTMGP optical properties | DDT | 0 | ty_optical_props_1scl | | out | F | -!! | optical_propsSW_clouds | shortwave_optical_properties_for_cloudy_atmosphere | Fortran DDT containing RRTMGP optical properties | DDT | 0 | ty_optical_props_2str | | out | F | -!! | optical_propsSW_aerosol | shortwave_optical_properties_for_aerosols | Fortran DDT containing RRTMGP optical properties | DDT | 0 | ty_optical_props_2str | | out | F | -!! | gas_concentrations_lw | Gas_concentrations_for_RRTMGP_suite_lw | DDT containing gas concentrations for RRTMGP radiation scheme | DDT | 0 | ty_gas_concs | | out | F | -!! | gas_concentrations_sw | Gas_concentrations_for_RRTMGP_suite_sw | DDT containing gas concentrations for RRTMGP radiation scheme | DDT | 0 | ty_gas_concs | | out | F | +!! | gas_concentrations | Gas_concentrations_for_RRTMGP_suite | DDT containing gas concentrations for RRTMGP radiation scheme | DDT | 0 | ty_gas_concs | | out | F | !! | sfc_emiss_byband | surface_longwave_emissivity_in_each_band | surface lw emissivity in fraction in each LW band | frac | 2 | real | kind_phys | out | 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 | out | 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 | out | 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 | out | 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 | out | F | -!! | nday | daytime_points_dimension | daytime points dimension | count | 0 | integer | | out | F | -!! | idxday | daytime_points | daytime points | index | 1 | integer | | 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 | !! ! Attention - the output arguments lm, im, lmk, lmp must not be set ! in the CCPP version - they are defined in the interstitial_create routine - ! ######################################################################################### - subroutine GFS_rrtmgp_pre_run (Model, Grid, Sfcprop, Statein, Tbd, Coupling, & ! IN - Radtend, & ! INOUT - lm, im, lmk, lmp, kdist_lw, kdist_sw, kdist_cldy_lw, kdist_cldy_sw, & ! IN - kd, kt, kb, raddt, delp, dz, plvl, plyr, tlvl, tlyr, tsfg, tsfa, qlyr, olyr, icseed, & ! OUT - aerodp, cldsa, mtopa, mbota, de_lgth, alb1d, & ! OUT - optical_propsLW_clouds, optical_propsLW_aerosol, optical_propsSW_clouds, & ! OUT - optical_propsSW_aerosol, gas_concentrations_lw, gas_concentrations_sw, & - sfc_emiss_byband, sfc_alb_nir_dir, sfc_alb_nir_dif, sfc_alb_uvvis_dir, & - sfc_alb_uvvis_dif, nday, idxday, errmsg, errflg) + subroutine GFS_rrtmgp_pre_run (Model, Grid, Sfcprop, Statein, Tbd, Coupling, & + Radtend,lm, im, lmk, lmp, kdist_lw, kdist_sw, kd, kt, kb, raddt, plvl, plyr, & + tlvl, tlyr, tsfg, tsfa, qlyr, olyr, icseed_lw, icseed_sw, aerodp, alb1d, & + cld_frac, cld_lwp, cld_reliq, cld_iwp, cld_reice, faerlw, faersw, & + gas_concentrations, sfc_emiss_byband, errmsg, errflg) ! Inputs type(GFS_control_type), intent(in) :: Model @@ -163,14 +141,11 @@ subroutine GFS_rrtmgp_pre_run (Model, Grid, Sfcprop, Statein, Tbd, Coupling, type(ty_gas_optics_rrtmgp),intent(in) :: & kdist_lw, & ! RRTMGP DDT containing spectral information for LW calculation kdist_sw ! RRTMGP DDT containing spectral information for SW calculation - type(ty_cloud_optics),intent(in) :: & - kdist_cldy_lw, & - kdist_cldy_sw type(ty_gas_concs),intent(out) :: & - gas_concentrations_lw,gas_concentrations_sw + gas_concentrations integer,intent(in),dimension(IM) :: & - icseed ! auxiliary special cloud related array when module - ! variable isubclw=2, it provides permutation seed + icseed_sw, & ! auxiliary special cloud related array when module + icseed_lw ! variable isubclw=2, it provides permutation seed ! for each column profile that are used for generating ! random numbers. when isubclw /=2, it will not be used. @@ -179,69 +154,64 @@ subroutine GFS_rrtmgp_pre_run (Model, Grid, Sfcprop, Statein, Tbd, Coupling, real(kind_phys), intent(out) :: raddt real(kind_phys), dimension(size(Grid%xlon,1)), intent(out) :: & tsfg, tsfa - real(kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP), intent(out) :: & - delp, dz, plyr, tlyr, qlyr, olyr - real(kind_phys), dimension(size(Grid%xlon,1),Model%levr+1+LTP), intent(out) :: & + real(kind_phys), dimension(size(Grid%xlon,1),LMK), intent(out) :: & + plyr, tlyr, qlyr, olyr + real(kind_phys), dimension(size(Grid%xlon,1),LMP), intent(out) :: & plvl, tlvl real(kind_phys), dimension(size(Grid%xlon,1),NSPC1), intent(out) :: & aerodp - real(kind_phys), dimension(size(Grid%xlon,1),5), intent(out) :: cldsa - integer, dimension(size(Grid%xlon,1),3), intent(out) :: mbota,mtopa - real(kind_phys), dimension(size(Grid%xlon,1)), intent(out) :: de_lgth,alb1d + real(kind_phys), dimension(size(Grid%xlon,1),5) :: cldsa + integer, dimension(size(Grid%xlon,1),3) :: mbota,mtopa + real(kind_phys), dimension(size(Grid%xlon,1)), intent(out) :: alb1d + real(kind_phys), dimension(size(Grid%xlon,1)) :: de_lgth character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg - type(ty_optical_props_1scl),intent(out) :: & - optical_propsLW_clouds, & - optical_propsLW_aerosol - type(ty_optical_props_2str),intent(out) :: & - optical_propsSW_clouds, & - optical_propsSW_aerosol - real(kind_phys),dimension(kdist_sw%get_nband(),size(Grid%xlon,1)),intent(out) :: & - sfc_emiss_byband, & ! Longwave surface emissivity in each band - 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) - - integer, intent(out) :: nday - integer, dimension(size(Grid%xlon,1)), intent(out) :: idxday + real(kind_phys),dimension(kdist_sw%get_nband(),IM),intent(out) :: & + sfc_emiss_byband ! Longwave surface emissivity in each band + real(kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP),intent(out) :: & + cld_frac, & ! + cld_lwp, & ! + cld_reliq, & ! + cld_iwp, & ! + cld_reice ! + real(kind_phys), dimension(size(Grid%xlon,1),LMK,kdist_sw%get_nband(),NF_AESW), intent(out) ::& + faersw + real(kind_phys), dimension(size(Grid%xlon,1),LMK,kdist_lw%get_nband(),NF_AELW), intent(out) ::& + faerlw ! Local variables integer :: me, nfxr, ntrac, ntcw, ntiw, ncld, ntrw, ntsw, ntgl,i, j, k, k1, k2, lsk, & LP1, lla, llb, lya, lyb, iCol, iBand integer,dimension(IM) :: ipseed_lw,ipseed_sw - logical,dimension(IM,Model%levr+LTP) :: & + logical,dimension(IM,LMK) :: & liqmask,icemask - real(kind_phys),dimension(IM,Model%levr+LTP) :: & + real(kind_phys),dimension(IM,LMK) :: & vmr_o3, vmr_h2o real(kind_phys) :: es, qs, tem0d real(kind_phys), dimension(size(Grid%xlon,1)) :: tem1d, tskn - real(kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP) :: & - rhly, tvly, qstl, prslk1, & + real(kind_phys), dimension(size(Grid%xlon,1),LMK) :: & + rhly, tvly, qstl, prslk1, delp, dz, & tem2da, cldcov, deltaq, cnvc, cnvw, effrl, effri, effrr, effrs real (kind_phys) :: clwmin, clwm, clwt, onemrh, value, tem1, tem2 real (kind_phys), parameter :: xrc3 = 100. - real(kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP+1) :: tem2db - real(kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP,Model%ncnd) :: ccnd - real(kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP,2:Model%ntrac) :: tracer1 - real(kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP,NF_CLDS) :: clouds - real(kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP,NF_VGAS) :: gasvmr - real(kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP,kdist_sw%get_nband(),NF_AESW)::faersw,faersw2 - real(kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP,kdist_lw%get_nband(),NF_AELW)::faerlw - type(ty_optical_props_1scl) :: optical_propsLW_cloudsByBand - type(ty_optical_props_2str) :: optical_propsSW_cloudsByBand - real(kind_phys), dimension(kdist_lw%get_ngpt(),Model%levr+LTP,IM) :: & + real(kind_phys), dimension(size(Grid%xlon,1),LMP) :: tem2db + real(kind_phys), dimension(size(Grid%xlon,1),LMK,Model%ncnd) :: ccnd + real(kind_phys), dimension(size(Grid%xlon,1),LMK,2:Model%ntrac) :: tracer1 + real(kind_phys), dimension(size(Grid%xlon,1),LMK,NF_CLDS) :: clouds + real(kind_phys), dimension(size(Grid%xlon,1),LMK,NF_VGAS) :: gasvmr + real(kind_phys), dimension(size(Grid%xlon,1),LMK,kdist_sw%get_nband(),NF_AESW)::faersw2 + real(kind_phys), dimension(kdist_lw%get_ngpt(),LMK,IM) :: & rng3D_lw - real(kind_phys), dimension(kdist_lw%get_ngpt()*(Model%levr+LTP)) :: & + real(kind_phys), dimension(kdist_lw%get_ngpt()*LMK) :: & rng1D_lw - logical, dimension(IM,Model%levr+LTP,kdist_lw%get_ngpt()) :: & + logical, dimension(IM,LMK,kdist_lw%get_ngpt()) :: & cldfracMCICA_lw - real(kind_phys), dimension(kdist_sw%get_ngpt(),Model%levr+LTP,IM) :: & + real(kind_phys), dimension(kdist_sw%get_ngpt(),LMK,IM) :: & rng3D_sw - real(kind_phys), dimension(kdist_sw%get_ngpt()*(Model%levr+LTP)) :: & + real(kind_phys), dimension(kdist_sw%get_ngpt()*LMK) :: & rng1D_sw - logical, dimension(IM,Model%levr+LTP,kdist_sw%get_ngpt()) :: & + logical, dimension(IM,LMK,kdist_sw%get_ngpt()) :: & cldfracMCICA_sw type(random_stat) :: rng_stat real(kind_phys), dimension(size(Grid%xlon,1),NF_ALBD) :: sfcalb @@ -685,7 +655,13 @@ subroutine GFS_rrtmgp_pre_run (Model, Grid, Sfcprop, Statein, Tbd, Coupling, clouds,cldsa,mtopa,mbota, de_lgth) ! OUT endif ! end if_imp_physics - + cld_frac = clouds(:,:,1) + cld_lwp = clouds(:,:,2) + cld_reliq = clouds(:,:,3) + cld_iwp = clouds(:,:,4) + cld_reice = clouds(:,:,5) + + ! mg, sfc-perts ! --- scale random patterns for surface perturbations with ! perturbation size @@ -706,18 +682,18 @@ subroutine GFS_rrtmgp_pre_run (Model, Grid, Sfcprop, Statein, Tbd, Coupling, ! LW and SW radiation. ! ####################################################################################### call setaer (plvl, plyr, prslk1, tvly, rhly, Sfcprop%slmsk, tracer1, Grid%xlon, & - Grid%xlat, IM, LMK, LMP, Model%lsswr, Model%lslwr, faersw, faerlw, aerodp) + Grid%xlat, IM, LMK, LMP, Model%lsswr, Model%lslwr, faersw2, faerlw, aerodp) ! Store aerosol optical properties ! SW. ! For RRTMGP SW the bands are now ordered from [IR(band) -> nIR -> UV], in RRTMG the ! band ordering was [nIR -> UV -> IR(band)] - faersw2(1:IM,1:LMK,1,1) = faersw(1:IM,1:LMK,kdist_sw%get_nband(),1) - faersw2(1:IM,1:LMK,1,2) = faersw(1:IM,1:LMK,kdist_sw%get_nband(),2) - faersw2(1:IM,1:LMK,1,3) = faersw(1:IM,1:LMK,kdist_sw%get_nband(),3) - faersw2(1:IM,1:LMK,2:kdist_sw%get_nband(),1) = faersw(1:IM,1:LMK,1:kdist_sw%get_nband()-1,1) - faersw2(1:IM,1:LMK,2:kdist_sw%get_nband(),2) = faersw(1:IM,1:LMK,1:kdist_sw%get_nband()-1,2) - faersw2(1:IM,1:LMK,2:kdist_sw%get_nband(),3) = faersw(1:IM,1:LMK,1:kdist_sw%get_nband()-1,3) + faersw(1:IM,1:LMK,1,1) = faersw2(1:IM,1:LMK,kdist_sw%get_nband(),1) + faersw(1:IM,1:LMK,1,2) = faersw2(1:IM,1:LMK,kdist_sw%get_nband(),2) + faersw(1:IM,1:LMK,1,3) = faersw2(1:IM,1:LMK,kdist_sw%get_nband(),3) + faersw(1:IM,1:LMK,2:kdist_sw%get_nband(),1) = faersw2(1:IM,1:LMK,1:kdist_sw%get_nband()-1,1) + faersw(1:IM,1:LMK,2:kdist_sw%get_nband(),2) = faersw2(1:IM,1:LMK,1:kdist_sw%get_nband()-1,2) + faersw(1:IM,1:LMK,2:kdist_sw%get_nband(),3) = faersw2(1:IM,1:LMK,1:kdist_sw%get_nband()-1,3) ! ####################################################################################### ! Call module_radiation_surface::setemis(),to setup surface emissivity for LW radiation. @@ -731,214 +707,35 @@ subroutine GFS_rrtmgp_pre_run (Model, Grid, Sfcprop, Statein, Tbd, Coupling, endif ! ####################################################################################### - ! Check for daytime points for SW radiation. - ! ####################################################################################### - if (Model%lsswr) then - nday = 0 - idxday = 0 - do iCol = 1, IM - if (Radtend%coszen(iCol) >= 0.0001) then - nday = nday + 1 - idxday(nday) = iCol - endif - enddo - else - nday = 0 - idxday = 0 - endif - - ! ####################################################################################### - ! Call module_radiation_surface::setalb() to setup surface albedo for SW radiation. + ! Set gas concentrations for RRTMGP ! ####################################################################################### - if (Model%lsswr) then - call setalb (Sfcprop%slmsk, Sfcprop%snowd, Sfcprop%sncovr, Sfcprop%snoalb, & - Sfcprop%zorl, Radtend%coszen, tsfg, tsfa, Sfcprop%hprim, Sfcprop%alvsf, & - Sfcprop%alnsf, Sfcprop%alvwf, Sfcprop%alnwf, Sfcprop%facsf, & - Sfcprop%facwf, Sfcprop%fice, Sfcprop%tisfc, IM, alb1d, Model%pertalb, & - sfcalb) - - ! Approximate mean surface albedo from vis- and nir- diffuse values. - Radtend%sfalb(:) = max(0.01, 0.5 * (sfcalb(:,2) + sfcalb(:,4))) - - ! Spread across all SW bands - do iBand=1,kdist_sw%get_nband() - sfc_alb_nir_dir(iBand,1:IM) = sfcalb(:,1) - sfc_alb_nir_dif(iBand,1:IM) = sfcalb(:,2) - sfc_alb_uvvis_dir(iBand,1:IM) = sfcalb(:,3) - sfc_alb_uvvis_dif(iBand,1:IM) = sfcalb(:,4) - enddo - else - sfc_alb_nir_dir(:,:) = 0._kind_phys - sfc_alb_nir_dif(:,:) = 0._kind_phys - sfc_alb_uvvis_dir(:,:) = 0._kind_phys - sfc_alb_uvvis_dif(:,:) = 0._kind_phys - endif - - ! ####################################################################################### - ! Compute radiative properties needed for RRTMGP - ! ####################################################################################### - - ! Change random number seed value for each radiation invocation (isubclw =1 or 2). - if(isubclw == 1) then ! advance prescribed permutation seed - do iCol = 1, IM - ipseed_lw(iCol) = ipsdlw0 + iCol - enddo - elseif (isubclw == 2) then ! use input array of permutaion seeds - do iCol = 1, IM - ipseed_lw(iCol) = icseed(iCol) - enddo - endif - ! Change random number seed value for each radiation invocation (isubcsw =1 or 2). - if(isubcsw == 1) then ! advance prescribed permutation seed - do iCol = 1, ncol - ipseed_sw(iCol) = ipsdsw0 + iCol - enddo - elseif (isubcsw == 2) then ! use input array of permutaion seeds - do iCol = 1, ncol - ipseed_sw(iCol) = icseed(iCol) - enddo - endif - ! Compute volume mixing-ratios for ozone (mmr) and specific-humidity. vmr_h2o = merge((qlyr/(1-qlyr))*amdw, 0., qlyr .ne. 1.) vmr_o3 = merge(olyr*amdo3, 0., olyr .gt. 0.) - - ! Compute ice/liquid cloud masks, needed by rrtmgp_cloud_optics - liqmask = (clouds(:,:,1) .gt. 0 .and. clouds(:,:,2) .gt. 0) - icemask = (clouds(:,:,1) .gt. 0 .and. clouds(:,:,4) .gt. 0) - - ! ####################################################################################### - ! Allocate space for gas optical properties [ncol,nlay,ngpts] - ! ####################################################################################### - ! Longwave - if (Model%lslwr) then - ! Cloud optics [nCol,nLay,nBands] - call check_error_msg('GFS_rrtmgp_pre_run',optical_propsLW_cloudsByBand%init(kdist_lw%get_band_lims_wavenumber())) - call check_error_msg('GFS_rrtmgp_pre_run',optical_propsLW_cloudsByBand%alloc_1scl(IM, LMK)) - ! Aerosol optics [Ccol,nLay,nBands] - call check_error_msg('GFS_rrtmgp_pre_run',optical_propsLW_aerosol%init(kdist_lw%get_band_lims_wavenumber())) - call check_error_msg('GFS_rrtmgp_pre_run',optical_propsLW_aerosol%alloc_1scl(IM, LMK)) - ! Cloud optics [nCol,nLay,nGpts] - call check_error_msg('GFS_rrtmgp_pre_run',optical_propsLW_clouds%alloc_1scl(IM, LMK, kdist_lw)) - endif - ! Shortwave - if (Model%lsswr .and. nday .gt. 0) then - ! Cloud optics [nCol,nLay,nBands] - call check_error_msg('GFS_rrtmgp_pre_run',optical_propsSW_cloudsByBand%init(kdist_sw%get_band_lims_wavenumber())) - call check_error_msg('GFS_rrtmgp_pre_run',optical_propsSW_cloudsByBand%alloc_2str(nDay, LMK)) - ! Aerosol optics [Ccol,nLay,nBands] - call check_error_msg('GFS_rrtmgp_pre_run',optical_propsSW_aerosol%init(kdist_sw%get_band_lims_wavenumber())) - call check_error_msg('GFS_rrtmgp_pre_run',optical_propsSW_aerosol%alloc_2str(nDay, LMK)) - ! Cloud optics [nCol,nLay,nGpts] - call check_error_msg('GFS_rrtmgp_pre_run',optical_propsSW_clouds%alloc_2str(nDay, LMK, kdist_sw)) - endif + ! + call gas_concentrations%reset() + call check_error_msg('GFS_rrtmgp_pre_run',gas_concentrations%set_vmr('o2', gasvmr(:,:,4))) + call check_error_msg('GFS_rrtmgp_pre_run',gas_concentrations%set_vmr('co2', gasvmr(:,:,1))) + call check_error_msg('GFS_rrtmgp_pre_run',gas_concentrations%set_vmr('ch4', gasvmr(:,:,3))) + call check_error_msg('GFS_rrtmgp_pre_run',gas_concentrations%set_vmr('n2o', gasvmr(:,:,2))) + call check_error_msg('GFS_rrtmgp_pre_run',gas_concentrations%set_vmr('h2o', vmr_h2o)) + call check_error_msg('GFS_rrtmgp_pre_run',gas_concentrations%set_vmr('o3', vmr_o3)) - ! ####################################################################################### - ! Set gas concentrations - ! ####################################################################################### - !if (Model%lslwr) then - call gas_concentrations_lw%reset() - call check_error_msg('GFS_rrtmgp_pre_run',gas_concentrations_lw%set_vmr('o2', gasvmr(:,:,4))) - call check_error_msg('GFS_rrtmgp_pre_run',gas_concentrations_lw%set_vmr('co2', gasvmr(:,:,1))) - call check_error_msg('GFS_rrtmgp_pre_run',gas_concentrations_lw%set_vmr('ch4', gasvmr(:,:,3))) - call check_error_msg('GFS_rrtmgp_pre_run',gas_concentrations_lw%set_vmr('n2o', gasvmr(:,:,2))) - call check_error_msg('GFS_rrtmgp_pre_run',gas_concentrations_lw%set_vmr('h2o', vmr_h2o)) - call check_error_msg('GFS_rrtmgp_pre_run',gas_concentrations_lw%set_vmr('o3', vmr_o3)) - !endif - !if (Model%lsswr .and. nday .gt. 0) then - call gas_concentrations_sw%reset() - call check_error_msg('GFS_rrtmgp_pre_run',gas_concentrations_sw%set_vmr('o2', gasvmr(idxday,:,4))) - call check_error_msg('GFS_rrtmgp_pre_run',gas_concentrations_sw%set_vmr('co2', gasvmr(idxday,:,1))) - call check_error_msg('GFS_rrtmgp_pre_run',gas_concentrations_sw%set_vmr('ch4', gasvmr(idxday,:,3))) - call check_error_msg('GFS_rrtmgp_pre_run',gas_concentrations_sw%set_vmr('n2o', gasvmr(idxday,:,2))) - call check_error_msg('GFS_rrtmgp_pre_run',gas_concentrations_sw%set_vmr('h2o', vmr_h2o(idxday,:))) - call check_error_msg('GFS_rrtmgp_pre_run',gas_concentrations_sw%set_vmr('o3', vmr_o3(idxday,:))) - !endif - - ! ####################################################################################### - ! Copy aerosol to RRTMGP DDT - ! ####################################################################################### - ! LW - if (Model%lslwr) then - optical_propsLW_aerosol%tau = faerlw(:,:,:,1) * (1. - faerlw(:,:,:,2)) - endif - ! SW - if (Model%lsswr .and. nday .gt. 0) then - optical_propsSW_aerosol%tau = faersw2(idxday,:,:,1) - optical_propsSW_aerosol%ssa = faersw2(idxday,:,:,2) - optical_propsSW_aerosol%g = faersw2(idxday,:,:,3) - endif - - ! ####################################################################################### - ! Compute cloud-optics for RTE. - ! ####################################################################################### - ! Longwave - if (Model%lslwr) then - call check_error_msg('GFS_rrtmgp_pre_run',kdist_cldy_lw%cloud_optics(IM, LMK, kdist_lw%get_nband(), & - nrghice_lw, liqmask, icemask, clouds(:,:,2), clouds(:,:,4), clouds(:,:,3), & - clouds(:,:,5), optical_propsLW_cloudsByBand)) - endif - ! Shortwave - if (Model%lsswr .and. nday .gt. 0) then - call check_error_msg('GFS_rrtmgp_pre_run',kdist_cldy_sw%cloud_optics(nDay, LMK, kdist_sw%get_nband(), & - nrghice_sw, liqmask(idxday,:), icemask(idxday,:), clouds(idxday,:,2), & - clouds(idxday,:,4), clouds(idxday,:,3), clouds(idxday,:,5), & - optical_propsSW_cloudsByBand)) - endif - - ! ####################################################################################### - ! Call McICA to generate subcolumns. - ! ####################################################################################### - ! Longwave - if (Model%lslwr .and. isubclw .gt. 0) then - - ! Call RNG. Mersennse Twister accepts 1D array, so loop over columns and collapse along G-points - ! and layers. ([nGpts,nLayer,nColumn]-> [nGpts*nLayer]*nColumn) - do iCol=1,IM - call random_setseed(ipseed_lw(icol),rng_stat) - call random_number(rng1D_lw,rng_stat) - rng3D_lw(:,:,iCol) = reshape(source = rng1D_lw,shape=[kdist_lw%get_ngpt(),LMK]) - enddo - - ! Call McICA - select case ( iovrlw ) - ! Maximumn-random - case(1) - call check_error_msg('GFS_rrtmgp_pre_run',sampled_mask_max_ran(rng3D_lw,clouds(:,:,1),cldfracMCICA_lw)) - end select - - ! Map band optical depth to each g-point using McICA - call check_error_msg('GFS_rrtmgp_pre_run',draw_samples(cldfracMCICA_lw,optical_propsLW_cloudsByBand,optical_propsLW_clouds)) - endif - - ! Shortwave - if (Model%lsswr .and. nday .gt. 0 .and. isubcsw .gt. 0) then - - ! Call RNG. Mersennse Twister accepts 1D array, so loop over columns and collapse along G-points - ! and layers. ([nGpts,nLayer,nColumn]-> [nGpts*nLayer]*nColumn) - do iCol=1,IM - call random_setseed(ipseed_sw(icol),rng_stat) - call random_number(rng1D_sw,rng_stat) - rng3D_sw(:,:,iCol) = reshape(source = rng1D_sw,shape=[kdist_sw%get_ngpt(),LMK]) - enddo - - ! Call McICA - select case ( iovrsw ) - ! Maximumn-random - case(1) - call check_error_msg('GFS_rrtmgp_pre_run',sampled_mask_max_ran(rng3D_sw,clouds(:,:,1),cldfracMCICA_sw)) - end select - - ! Map band optical depth to each g-point using McICA - call check_error_msg('GFS_rrtmgp_pre_run',draw_samples(cldfracMCICA_sw,optical_propsSW_cloudsByBand,optical_propsSW_clouds)) - endif - end subroutine GFS_rrtmgp_pre_run !> \section arg_table_GFS_rrtmgp_pre_finalize Argument Table !! subroutine GFS_rrtmgp_pre_finalize () end subroutine GFS_rrtmgp_pre_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_pre diff --git a/physics/rrtmgp_lw.F90 b/physics/rrtmgp_lw.F90 index 3007146d7..1bf2fef70 100644 --- a/physics/rrtmgp_lw.F90 +++ b/physics/rrtmgp_lw.F90 @@ -10,8 +10,6 @@ module rrtmgp_lw use mo_rrtmgp_clr_all_sky, only: rte_lw use mo_gas_concentrations, only: ty_gas_concs use mo_fluxes_byband, only: ty_fluxes_byband - use rrtmgp_sw, only: check_error_msg - ! Parameters integer,parameter :: nGases = 6 @@ -674,18 +672,20 @@ end subroutine rrtmgp_lw_init !! | kdist_lw | K_distribution_file_for_RRTMGP_LW_scheme | DDT containing spectral information for RRTMGP LW radiation scheme | DDT | 0 | ty_gas_optics_rrtmgp | | in | F | !! | optical_propsLW_clds | longwave_optical_properties_for_cloudy_atmosphere | Fortran DDT containing RRTMGP optical properties | DDT | 0 | ty_optical_props_1scl | | in | F | !! | optical_propsLW_aerosol | longwave_optical_properties_for_aerosols | Fortran DDT containing RRTMGP optical properties | DDT | 0 | ty_optical_props_1scl | | in | F | -!! | gas_concentrations | Gas_concentrations_for_RRTMGP_suite_lw | DDT containing gas concentrations for RRTMGP radiation scheme | DDT | 0 | ty_gas_concs | | in | F | +!! | gas_concentrations | Gas_concentrations_for_RRTMGP_suite | DDT containing gas concentrations for RRTMGP radiation scheme | DDT | 0 | ty_gas_concs | | in | F | !! | lslwr | flag_to_calc_lw | flag to calculate LW irradiances | flag | 0 | logical | | in | F | -!! | fluxLW_allsky | lw_flux_profiles_byband_allsky | Fortran DDT containing RRTMGP 3D fluxes | DDT | 0 | ty_fluxes_byband | | out | F | -!! | fluxLW_clrsky | lw_flux_profiles_byband_clrsky | Fortran DDT containing RRTMGP 3D fluxes | DDT | 0 | ty_fluxes_byband | | out | F | !! | hlw0 | tendency_of_air_temperature_due_to_longwave_heating_assuming_clear_sky_on_radiation_time_step | longwave clear sky heating rate | K s-1 | 2 | real | kind_phys | in | T | !! | hlwb | lw_heating_rate_spectral | longwave total sky heating rate (spectral) | K s-1 | 3 | real | kind_phys | in | T | +!! | fluxUP_allsky | lw_flux_profile_upward_allsky | RRTMGP upward longwave all-sky flux profile | W m-2 | 2 | real | kind_phys | out | F | +!! | fluxDOWN_allsky | lw_flux_profile_downward_allsky | RRTMGP downward longwave all-sky flux profile | W m-2 | 2 | real | kind_phys | out | F | +!! | fluxUP_clrsky | lw_flux_profile_upward_clrsky | RRTMGP upward longwave clr-sky flux profile | W m-2 | 2 | real | kind_phys | out | F | +!! | fluxDOWN_clrsky | lw_flux_profile_downward_clrsky | RRTMGP downward longwave clr-sky flux profile | W m-2 | 2 | real | kind_phys | out | F | !! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | !! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | !! subroutine rrtmgp_lw_run(ncol, nlay, kdist_lw, p_lay, t_lay, p_lev, skt, & sfc_emiss, gas_concentrations, optical_propsLW_clds, optical_propsLW_aerosol,& - lslwr, fluxLW_allsky, fluxLW_clrsky, hlw0, hlwb, errmsg, errflg) + lslwr, fluxUP_allsky, fluxDOWN_allsky, fluxUP_clrsky, fluxDOWN_clrsky, hlw0, hlwb, errmsg, errflg) ! Inputs integer, intent(in) :: & @@ -709,14 +709,16 @@ subroutine rrtmgp_lw_run(ncol, nlay, kdist_lw, p_lay, t_lay, p_lev, skt, & gas_concentrations ! RRTMGP DDT: trace gas concentrations (vmr) logical, intent(in) :: & lslwr ! Flag to calculate LW irradiances - + ! Outputs character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg - type(ty_fluxes_byband),intent(out) :: & - fluxLW_allsky, & ! All-sky flux (W/m2) - fluxLW_clrsky ! Clear-sky flux (W/m2) - + real(kind_phys), dimension(ncol,nlay), intent(out) :: & + fluxUP_allsky, & ! All-sky flux (W/m2) + fluxDOWN_allsky, & ! All-sky flux (W/m2) + fluxUP_clrsky, & ! Clear-sky flux (W/m2) + fluxDOWN_clrsky ! All-sky flux (W/m2) + ! Outputs (optional) real(kind_phys), dimension(ncol,nlay,kdist_lw%get_nband()), optional, intent(inout) :: & hlwb ! All-sky heating rate, by band (K/sec) @@ -724,32 +726,36 @@ subroutine rrtmgp_lw_run(ncol, nlay, kdist_lw, p_lay, t_lay, p_lev, skt, & hlw0 ! Clear-sky heating rate (K/sec) ! Local variables + type(ty_fluxes_byband) :: & + flux_allsky, & ! All-sky flux (W/m2) + flux_clrsky ! Clear-sky flux (W/m2) real(kind_phys), dimension(ncol,nlay+1),target :: & fluxLW_up_allsky, fluxLW_up_clrsky, fluxLW_dn_allsky, fluxLW_dn_clrsky real(kind_phys), dimension(ncol,nlay+1,kdist_lw%get_nband()),target :: & fluxLWBB_up_allsky, fluxLWBB_dn_allsky logical :: l_ClrSky_HR, l_AllSky_HR_byband + integer :: k ! Initialize CCPP error handling variables errmsg = '' errflg = 0 if (.not. lslwr) return - + ! Are any optional outputs requested? Need to know now to compute correct fluxes. l_ClrSky_HR = present(hlw0) l_AllSky_HR_byband = present(hlwb) ! Initialize RRTMGP DDT containing 2D(3D) fluxes - fluxLW_allsky%flux_up => fluxLW_up_allsky - fluxLW_allsky%flux_dn => fluxLW_dn_allsky - fluxLW_clrsky%flux_up => fluxLW_up_clrsky - fluxLW_clrsky%flux_dn => fluxLW_dn_clrsky + flux_allsky%flux_up => fluxLW_up_allsky + flux_allsky%flux_dn => fluxLW_dn_allsky + flux_clrsky%flux_up => fluxLW_up_clrsky + flux_clrsky%flux_dn => fluxLW_dn_clrsky ! Only calculate fluxes by-band, only when heating-rate profiles by band are requested. if (l_AllSky_HR_byband) then - fluxLW_allsky%bnd_flux_up => fluxLWBB_up_allsky - fluxLW_allsky%bnd_flux_dn => fluxLWBB_dn_allsky + flux_allsky%bnd_flux_up => fluxLWBB_up_allsky + flux_allsky%bnd_flux_dn => fluxLWBB_dn_allsky endif - + ! Call RRTMGP LW scheme call check_error_msg('rrtmgp_lw_run',rte_lw( & kdist_lw, & ! IN - spectral information @@ -760,13 +766,26 @@ subroutine rrtmgp_lw_run(ncol, nlay, kdist_lw, p_lay, t_lay, p_lev, skt, & skt, & ! IN - skin temperature (K) sfc_emiss, & ! IN - surface emissivity in each LW band optical_propsLW_clds, & ! IN - DDT containing cloud optical information - fluxLW_allsky, & ! OUT - Fluxes, all-sky, 3D (nCol,nLay,nBand) - fluxLW_clrsky, & ! OUT - Fluxes, clear-sky, 3D (nCol,nLay,nBand) + flux_allsky, & ! OUT - Fluxes, all-sky, 3D (nCol,nLay,nBand) + flux_clrsky, & ! OUT - Fluxes, clear-sky, 3D (nCol,nLay,nBand) aer_props = optical_propsLW_aerosol)) ! IN(optional) - DDT containing aerosol optical information + fluxUP_allsky = flux_allsky%flux_up + fluxDOWN_allsky = flux_allsky%flux_dn + fluxUP_clrsky = flux_clrsky%flux_up + fluxDOWN_clrsky = flux_clrsky%flux_dn end subroutine rrtmgp_lw_run subroutine rrtmgp_lw_finalize() end subroutine rrtmgp_lw_finalize - + subroutine check_error_msg(routine_name, error_msg) + character(len=*), intent(in) :: & + error_msg, routine_name + + if(error_msg /= "") then + print*,"ERROR("//trim(routine_name)//"): " + print*,trim(error_msg) + return + end if + end subroutine check_error_msg end module rrtmgp_lw diff --git a/physics/rrtmgp_lw_main.F90 b/physics/rrtmgp_lw_main.F90 deleted file mode 100644 index f0e688f98..000000000 --- a/physics/rrtmgp_lw_main.F90 +++ /dev/null @@ -1,97 +0,0 @@ -! ########################################################################################### -! ########################################################################################### -module rrtmgp_lw_main - use machine, only: kind_phys - 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 GFS_rrtmgp_lw, only: check_error_msg - - public rrtmgp_lw_main_init, rrtmgp_lw_main_run, rrtmgp_lw_main_finalize -contains - - subroutine rrtmgp_lw_main_init() - end subroutine rrtmgp_lw_main_init - - ! ######################################################################################### - ! ######################################################################################### -!! \section arg_table_rrtmgp_lw_main_run Argument Table -!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | -!! |-----------------------|-------------------------------------------------|--------------------------------------------------------------------|-------|------|-----------------------|-----------|--------|----------| -!! | ncol | horizontal_loop_extent | horizontal dimension | count | 0 | integer | | in | F | -!! | nlay | adjusted_vertical_layer_dimension_for_radiation | number of vertical layers for radiation | count | 0 | integer | | in | F | -!! | p_lay | air_pressure_at_layer_for_radiation_in_hPa | air pressure layer | hPa | 2 | real | kind_phys | in | F | -!! | p_lev | air_pressure_at_interface_for_radiation_in_hPa | air pressure level | hPa | 2 | real | kind_phys | in | F | -!! | t_lay | air_temperature_at_layer_for_radiation | 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 | -!! | sfc_emiss | surface_longwave_emissivity_in_each_band | surface lw emissivity in fraction in each LW band | frac | 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 | -!! | optical_props_clds | optical_properties_for_cloudy_atmosphere | Fortran DDT containing RRTMGP optical properties | DDT | 0 | ty_optical_props_1scl | | in | F | -!! | optical_props_aerosol | 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 | -!! | fluxLW_allsky | lw_flux_profiles_byband_allsky | Fortran DDT containing RRTMGP 3D fluxes | DDT | 0 | ty_fluxes_byband | | out | F | -!! | fluxLW_clrsky | lw_flux_profiles_byband_clrsky | Fortran DDT containing RRTMGP 3D fluxes | DDT | 0 | ty_fluxes_byband | | out | F | -!! | 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_main_run(ncol, nlay, kdist_lw, p_lay, t_lay, p_lev, skt, & - sfc_emiss, gas_concentrations, optical_props_clds, optical_props_aerosol,& - fluxLW_allsky, fluxLW_clrsky, errmsg, errflg) - - ! Inputs - integer, intent(in) :: & - ncol, & ! Number of horizontal gridpoints - nlay ! Number of vertical layers - real(kind_phys), dimension(ncol,nlay), intent(in) :: & - p_lay, & ! Pressure @ model layer-centers (hPa) - t_lay ! Temperature (K) - real(kind_phys), dimension(ncol,nlay+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) :: & - kdist_lw ! DDT containing LW spectral information - real(kind_phys), dimension(kdist_lw%get_nband(),ncol) :: & - sfc_emiss ! Surface emissivity (1) - type(ty_optical_props_1scl),intent(in) :: & - optical_props_clds, & - optical_props_aerosol - type(ty_gas_concs),intent(in) :: & - gas_concentrations - type(ty_fluxes_byband) :: & - fluxLW_allsky, & ! All-sky flux (W/m2) - fluxLW_clrsky ! Clear-sky flux (W/m2) - - ! Outputs - character(len=*), intent(out) :: errmsg - integer, intent(out) :: errflg - - ! Initialize CCPP error handling variables - errmsg = '' - errflg = 0 - - ! Call RRTMGP LW scheme - call check_error_msg(rte_lw( & - kdist_lw, & ! 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) - sfc_emiss, & ! IN - surface emissivity in each LW band - optical_props_clds, & ! IN - DDT containing cloud optical information - fluxLW_allsky, & ! OUT - Fluxes, all-sky, 3D (nCol,nLay,nBand) - fluxLW_clrsky, & ! OUT - Fluxes, clear-sky, 3D (nCol,nLay,nBand) - aer_props = optical_props_aerosol)) ! IN(optional) - DDT containing aerosol optical information - - end subroutine rrtmgp_lw_main_run - - subroutine rrtmgp_lw_main_finalize() - end subroutine rrtmgp_lw_main_finalize - - - -end module rrtmgp_lw_main diff --git a/physics/rrtmgp_sw.F90 b/physics/rrtmgp_sw.F90 index 0961a0086..3a5440bae 100644 --- a/physics/rrtmgp_sw.F90 +++ b/physics/rrtmgp_sw.F90 @@ -675,26 +675,29 @@ end subroutine rrtmgp_sw_init !! | p_lev | air_pressure_at_interface_for_radiation_in_hPa | air pressure level | hPa | 2 | real | kind_phys | in | F | !! | t_lay | air_temperature_at_layer_for_radiation | air temperature layer | K | 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 | -!! | optical_propsSW_clds | shortwave_optical_properties_for_cloudy_atmosphere | Fortran DDT containing RRTMGP optical properties | DDT | 0 | ty_optical_props_2str | | in | F | -!! | optical_propsSW_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_sw | DDT containing gas concentrations for RRTMGP radiation scheme | DDT | 0 | ty_gas_concs | | 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 | -!! | sfcalb_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 | out | F | -!! | sfcalb_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 | out | F | +!! | sfcalb_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 | +!! | sfcalb_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 | !! | cossza | cosine_of_zenith_angle | cosine of the solar zenit angle | none | 1 | 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 | -!! | fluxSW_allsky | sw_flux_profiles_byband_allsky | Fortran DDT containing RRTMGP 3D fluxes | DDT | 0 | ty_fluxes_byband | | out | F | -!! | fluxSW_clrsky | sw_flux_profiles_byband_clrsky | Fortran DDT containing RRTMGP 3D fluxes | DDT | 0 | ty_fluxes_byband | | out | 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 | in | T | -!! | hswb | sw_heating_rate_spectral | shortwave total sky heating rate (spectral) | K s-1 | 3 | real | kind_phys | in | 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 | 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_run(ncol, nlay, kdist_sw, p_lay, t_lay, p_lev, gas_concentrations, & - optical_propsSW_clds, optical_propsSW_aerosol,& - lsswr, sfcalb_nir_dir, sfcalb_nir_dif, cossza, nday, idxday, fluxSW_allsky, fluxSW_clrsky, hsw0, hswb, scmpsw, errmsg, errflg) + optical_props_clds, optical_props_aerosol,& + lsswr, sfcalb_nir_dir, sfcalb_nir_dif, cossza, nday, idxday, hsw0, hswb, scmpsw, & + fluxUP_allsky, fluxDOWN_allsky, fluxUP_clrsky, fluxDOWN_clrsky, errmsg, errflg) ! Inputs integer, intent(in) :: & @@ -716,8 +719,8 @@ subroutine rrtmgp_sw_run(ncol, nlay, kdist_sw, p_lay, t_lay, p_lev, gas_concentr real(kind_phys), dimension(ncol), intent(in) :: & cossza ! Cosine of solar zenith angle (1) type(ty_optical_props_2str),intent(in) :: & - optical_propsSW_clds, & ! RRTMGP DDT: longwave cloud radiative properties - optical_propsSW_aerosol ! RRTMGP DDT: longwave aerosol radiative properties + 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) @@ -727,17 +730,19 @@ subroutine rrtmgp_sw_run(ncol, nlay, kdist_sw, p_lay, t_lay, p_lev, gas_concentr ! Outputs character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg - type(ty_fluxes_byband),intent(out) :: & - fluxSW_allsky, & ! All-sky flux (W/m2) - fluxSW_clrsky ! Clear-sky flux (W/m2) + real(kind_phys), dimension(ncol,nlay), intent(out) :: & + fluxUP_allsky, & ! All-sky flux (W/m2) + fluxDOWN_allsky, & ! All-sky flux (W/m2) + fluxUP_clrsky, & ! Clear-sky flux (W/m2) + fluxDOWN_clrsky ! All-sky flux (W/m2) ! 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,nlay), optional, intent(in) :: & + real(kind_phys), dimension(ncol,nlay), optional, intent(inout) :: & hsw0 ! Clear-sky heating rate (K/sec) - real(kind_phys), dimension(ncol,nlay,kdist_sw%get_nband()), intent(in), optional :: & + real(kind_phys), dimension(ncol,nlay,kdist_sw%get_nband()), intent(inout), optional :: & hswb ! All-sky heating rate, by band (K/sec) ! Outputs (optional) - type(cmpfsw_type), dimension(ncol), intent(out),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) @@ -746,17 +751,27 @@ subroutine rrtmgp_sw_run(ncol, nlay, kdist_sw, p_lay, t_lay, p_lev, gas_concentr ! 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,nlay+1),target :: & fluxSW_up_allsky, fluxSW_up_clrsky, fluxSW_dn_allsky, fluxSW_dn_clrsky real(kind_phys), dimension(nday,nlay+1,kdist_sw%get_nband()),target :: & fluxSWBB_up_allsky, fluxSWBB_dn_allsky + real(kind_phys), dimension(ncol,nlay) :: vmrTemp logical :: l_ClrSky_HR=.false., l_AllSky_HR_byband=.false., l_scmpsw=.false. + integer :: k, 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 + errflg = 0 + if (.not. lsswr) return ! Are any optional outputs requested? Need to know now to compute correct fluxes. @@ -766,39 +781,66 @@ subroutine rrtmgp_sw_run(ncol, nlay, kdist_sw, p_lay, t_lay, p_lev, gas_concentr 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,nLay,nBands] + call check_error_msg('rrtmgp_sw_run',optical_props_clds_daylit%alloc_2str(nday, nlay, kdist_sw)) + 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,nLay,nBands] + call check_error_msg('rrtmgp_sw_run',optical_props_aerosol_daylit%alloc_2str(nday, nlay, kdist_sw%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,nGases + call check_error_msg('rrtmgp_sw_run',gas_concentrations%get_vmr(trim(active_gases(iGas)),vmrTemp)) + call check_error_msg('rrtmgp_sw_run',gas_concentrations_daylit%set_vmr(active_gases(iGas),vmrTemp(idxday,:))) + enddo + ! Initialize RRTMGP DDT containing 2D(3D) fluxes - fluxSW_allsky%flux_up => fluxSW_up_allsky - fluxSW_allsky%flux_dn => fluxSW_dn_allsky - fluxSW_clrsky%flux_up => fluxSW_up_clrsky - fluxSW_clrsky%flux_dn => fluxSW_dn_clrsky + 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 - fluxSW_allsky%bnd_flux_up => fluxSWBB_up_allsky - fluxSW_allsky%bnd_flux_dn => fluxSWBB_dn_allsky + 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_run',rte_sw( & - kdist_sw, & ! IN - spectral information - gas_concentrations, & ! IN - gas concentrations (vmr) - p_lay(idxday,1:nlay), & ! IN - pressure at layer interfaces (Pa) - t_lay(idxday,1:nlay), & ! IN - temperature at layer interfaes (K) - p_lev(idxday,1:nlay+1), & ! IN - pressure at layer centers (Pa) - cossza(idxday), & ! IN - Cosine of solar zenith angle - sfcalb_nir_dir(:,idxday), & ! IN - Shortwave surface albedo (direct) - sfcalb_nir_dif(:,idxday), & ! IN - Shortwave surface albedo (diffuse) - optical_propsSW_clds, & ! IN - DDT containing cloud optical information - fluxSW_allsky, & ! OUT - Fluxes, all-sky, 3D (nCol,nLay,nBand) - fluxSW_clrsky, & ! OUT - Fluxes, clear-sky, 3D (nCol,nLay,nBand) - aer_props = optical_propsSW_aerosol)) ! IN(optional) - DDT containing aerosol optical information + kdist_sw, & ! IN - spectral information + gas_concentrations_daylit, & ! IN - gas concentrations (vmr) + p_lay(idxday,1:nlay), & ! IN - pressure at layer interfaces (Pa) + t_lay(idxday,1:nlay), & ! IN - temperature at layer interfaes (K) + p_lev(idxday,1:nlay+1), & ! IN - pressure at layer centers (Pa) + cossza(idxday), & ! IN - Cosine of solar zenith angle + sfcalb_nir_dir(:,idxday), & ! IN - Shortwave surface albedo (direct) + sfcalb_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,nLay,nBand) + flux_clrsky, & ! OUT - Fluxes, clear-sky, 3D (nCol,nLay,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_run subroutine rrtmgp_sw_finalize() end subroutine rrtmgp_sw_finalize + subroutine check_error_msg(routine_name, error_msg) character(len=*), intent(in) :: & error_msg, routine_name @@ -808,7 +850,5 @@ subroutine check_error_msg(routine_name, error_msg) print*,trim(error_msg) return end if - end subroutine check_error_msg - - + end subroutine check_error_msg end module rrtmgp_sw diff --git a/physics/rrtmgp_sw_pre.F90 b/physics/rrtmgp_sw_pre.F90 index ba9b1d054..4f3fefa5f 100644 --- a/physics/rrtmgp_sw_pre.F90 +++ b/physics/rrtmgp_sw_pre.F90 @@ -1,118 +1,115 @@ !>\file rrtmgp_sw_pre.f90 !! This file contains a subroutine to module_radiation_surface::setalb() to !! setup surface albedo for SW radiation. - module rrtmgp_sw_pre - contains - -!>\defgroup rrtmgp_sw_pre GFS RRTMGP scheme Pre -!! @{ -!> \section arg_table_rrtmgp_sw_pre_init Argument Table -!! - subroutine rrtmgp_sw_pre_init () - end subroutine rrtmgp_sw_pre_init +module rrtmgp_sw_pre + use machine, only: kind_phys + use GFS_typedefs, only: GFS_control_type, & + GFS_grid_type, & + GFS_radtend_type, & + GFS_sfcprop_type + use module_radiation_surface, only: NF_ALBD, setalb + use mo_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp + implicit none +contains + + subroutine rrtmgp_sw_pre_init () + end subroutine rrtmgp_sw_pre_init !> \section arg_table_rrtmgp_sw_pre_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 | -!! | Sfcprop | GFS_sfcprop_type_instance | Fortran DDT containing FV3-GFS surface fields | DDT | 0 | GFS_sfcprop_type | | in | F | -!! | Radtend | GFS_radtend_type_instance | Fortran DDT containing FV3-GFS radiation tendencies | DDT | 0 | GFS_radtend_type | | inout | F | -!! | im | horizontal_loop_extent | horizontal loop extent | count | 0 | integer | | in | F | -!! | nday | daytime_points_dimension | daytime points dimension | count | 0 | integer | | out | F | -!! | idxday | daytime_points | daytime points | index | 1 | integer | | out | F | -!! | tsfg | surface_ground_temperature_for_radiation | surface ground temperature for radiation | K | 1 | 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 | -!! | sfcalb1 | surface_albedo_due_to_near_IR_direct | surface albedo due to near IR direct beam | frac | 1 | real | kind_phys | out | F | -!! | sfcalb2 | surface_albedo_due_to_near_IR_diffused | surface albedo due to near IR diffused beam | frac | 1 | real | kind_phys | out | F | -!! | sfcalb3 | surface_albedo_due_to_UV_and_VIS_direct | surface albedo due to UV+VIS direct beam | frac | 1 | real | kind_phys | out | F | -!! | sfcalb4 | surface_albedo_due_to_UV_and_VIS_diffused | surface albedo due to UV+VIS diffused beam | frac | 1 | real | kind_phys | out | F | -!! | alb1d | surface_albedo_perturbation | surface albedo perturbation | frac | 1 | real | kind_phys | 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 | +!! | 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 | +!! | Sfcprop | GFS_sfcprop_type_instance | Fortran DDT containing FV3-GFS surface fields | DDT | 0 | GFS_sfcprop_type | | in | F | +!! | Radtend | GFS_radtend_type_instance | Fortran DDT containing FV3-GFS radiation tendencies | DDT | 0 | GFS_radtend_type | | inout | F | +!! | im | horizontal_loop_extent | horizontal loop extent | count | 0 | integer | | in | F | +!! | nday | daytime_points_dimension | daytime points dimension | count | 0 | integer | | out | F | +!! | idxday | daytime_points | daytime points | index | 1 | integer | | out | F | +!! | tsfg | surface_ground_temperature_for_radiation | surface ground temperature for radiation | K | 1 | 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 | +!! | 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 | out | 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 | out | 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 | out | 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 | out | F | +!! | alb1d | surface_albedo_perturbation | surface albedo perturbation | frac | 1 | real | kind_phys | 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 | !! - subroutine rrtmgp_sw_pre_run (Model, Grid, Sfcprop, Radtend, im, & - nday, idxday, tsfg, tsfa, sfcalb1, sfcalb2, sfcalb3, sfcalb4, & - alb1d, errmsg, errflg) - - use machine, only: kind_phys - - use GFS_typedefs, only: GFS_control_type, & - GFS_grid_type, & - GFS_radtend_type, & - GFS_sfcprop_type - use module_radiation_surface, only: NF_ALBD, setalb - - implicit none - - type(GFS_control_type), intent(in) :: Model - type(GFS_radtend_type), intent(inout) :: Radtend - type(GFS_sfcprop_type), intent(in) :: Sfcprop - type(GFS_grid_type), intent(in) :: Grid - integer, intent(in) :: im - integer, intent(out) :: nday - integer, dimension(size(Grid%xlon,1)), intent(out) :: idxday - real(kind=kind_phys), dimension(size(Grid%xlon,1)), intent(in) :: tsfa, tsfg - real(kind=kind_phys), dimension(size(Grid%xlon,1)), intent(out) :: sfcalb1, sfcalb2, sfcalb3, sfcalb4 - real(kind=kind_phys), dimension(size(Grid%xlon,1)), intent(in) :: alb1d - character(len=*), intent(out) :: errmsg - integer, intent(out) :: errflg - ! Local variables - integer :: i - real(kind=kind_phys), dimension(size(Grid%xlon,1),NF_ALBD) :: sfcalb - - ! Initialize CCPP error handling variables - errmsg = '' - errflg = 0 - -! --- ... start radiation calculations -! remember to set heating rate unit to k/sec! -!> -# Start SW radiation calculations - if (Model%lsswr) then - -!> - Check for daytime points for SW radiation. - nday = 0 - idxday = 0 - do i = 1, IM + subroutine rrtmgp_sw_pre_run (Model, Grid, Sfcprop, Radtend, im, kdist_sw, & + nday, idxday, tsfg, tsfa, sfc_alb_nir_dir, sfc_alb_nir_dif, sfc_alb_uvvis_dir, & + sfc_alb_uvvis_dif, alb1d, errmsg, errflg) + + ! Inputs + type(ty_gas_optics_rrtmgp),intent(in) :: & + kdist_sw ! RRTMGP DDT containing spectral information for SW calculation + type(GFS_control_type), intent(in) :: Model + type(GFS_radtend_type), intent(inout) :: Radtend + type(GFS_sfcprop_type), intent(in) :: Sfcprop + type(GFS_grid_type), intent(in) :: Grid + integer, intent(in) :: im + integer, intent(out) :: nday + integer, dimension(size(Grid%xlon,1)), intent(out) :: idxday + real(kind=kind_phys), dimension(size(Grid%xlon,1)), intent(in) :: tsfa, tsfg + real(kind=kind_phys), dimension(size(Grid%xlon,1)), intent(in) :: alb1d + + ! Outputs + real(kind_phys),dimension(kdist_sw%get_nband(),IM),intent(out) :: & + 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) + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! Local variables + integer :: i, iBand + real(kind=kind_phys), dimension(size(Grid%xlon,1),NF_ALBD) :: sfcalb + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + if (Model%lsswr) then + ! Check for daytime points for SW radiation. + nday = 0 + idxday = 0 + do i = 1, IM if (Radtend%coszen(i) >= 0.0001) then - nday = nday + 1 - idxday(nday) = i + nday = nday + 1 + idxday(nday) = i endif - enddo - -!> - Call module_radiation_surface::setalb() to setup surface albedo. -!! for SW radiation. - - call setalb (Sfcprop%slmsk, Sfcprop%snowd, Sfcprop%sncovr,& ! --- inputs: - Sfcprop%snoalb, Sfcprop%zorl, Radtend%coszen,& - tsfg, tsfa, Sfcprop%hprim, Sfcprop%alvsf, & - Sfcprop%alnsf, Sfcprop%alvwf, Sfcprop%alnwf, & - Sfcprop%facsf, Sfcprop%facwf, Sfcprop%fice, & - Sfcprop%tisfc, IM, & - alb1d, Model%pertalb, & ! mg, sfc-perts - sfcalb) ! --- outputs - -!> -# Approximate mean surface albedo from vis- and nir- diffuse values. - Radtend%sfalb(:) = max(0.01, 0.5 * (sfcalb(:,2) + sfcalb(:,4))) - else - nday = 0 - idxday = 0 - sfcalb = 0.0 - endif - - do i = 1, im - sfcalb1(i) = sfcalb(i,1) - sfcalb2(i) = sfcalb(i,2) - sfcalb3(i) = sfcalb(i,3) - sfcalb4(i) = sfcalb(i,4) - enddo - - end subroutine rrtmgp_sw_pre_run - -!> \section arg_table_rrtmgp_sw_pre_finalize Argument Table -!! - subroutine rrtmgp_sw_pre_finalize () - end subroutine rrtmgp_sw_pre_finalize - -!! @} - end module rrtmgp_sw_pre + enddo + + ! Call module_radiation_surface::setalb() to setup surface albedo. + call setalb (Sfcprop%slmsk, Sfcprop%snowd, Sfcprop%sncovr,& ! --- inputs: + Sfcprop%snoalb, Sfcprop%zorl, Radtend%coszen,& + tsfg, tsfa, Sfcprop%hprim, Sfcprop%alvsf, & + Sfcprop%alnsf, Sfcprop%alvwf, Sfcprop%alnwf, & + Sfcprop%facsf, Sfcprop%facwf, Sfcprop%fice, & + Sfcprop%tisfc, IM, & + alb1d, Model%pertalb, & ! mg, sfc-perts + sfcalb) ! --- outputs + + ! Approximate mean surface albedo from vis- and nir- diffuse values. + Radtend%sfalb(:) = max(0.01, 0.5 * (sfcalb(:,2) + sfcalb(:,4))) + else + nday = 0 + idxday = 0 + sfcalb = 0.0 + endif + + ! Spread across all SW bands + do iBand=1,kdist_sw%get_nband() + sfc_alb_nir_dir(iBand,1:IM) = sfcalb(1:IM,1) + sfc_alb_nir_dif(iBand,1:IM) = sfcalb(1:IM,2) + sfc_alb_uvvis_dir(iBand,1:IM) = sfcalb(1:IM,3) + sfc_alb_uvvis_dif(iBand,1:IM) = sfcalb(1:IM,4) + enddo + + end subroutine rrtmgp_sw_pre_run + + subroutine rrtmgp_sw_pre_finalize () + end subroutine rrtmgp_sw_pre_finalize + +end module rrtmgp_sw_pre diff --git a/physics/rte-rrtmgp b/physics/rte-rrtmgp index 929bf9df4..8c3dac82c 160000 --- a/physics/rte-rrtmgp +++ b/physics/rte-rrtmgp @@ -1 +1 @@ -Subproject commit 929bf9df4983d1721270826a9b32b123ead1f48c +Subproject commit 8c3dac82c8de6c1575d3d89abd9314cef6edb95e