From c984e907306502fa109d514b64031102102ae512 Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Fri, 14 Feb 2020 16:54:38 -0700 Subject: [PATCH] Cleaned up a tad. --- physics/GFS_rrtmgp_lw_pre.F90 | 92 --------- physics/GFS_rrtmgp_lw_pre.meta | 135 ------------- physics/GFS_rrtmgp_sw_pre.F90 | 101 ++++++---- physics/GFS_rrtmgp_sw_pre.meta | 296 +++++++++++++++++++++++++---- physics/rrtmgp_sw_cloud_optics.F90 | 15 +- physics/rrtmgp_sw_rte.F90 | 34 +--- physics/rrtmgp_sw_rte.meta | 8 - 7 files changed, 334 insertions(+), 347 deletions(-) delete mode 100644 physics/GFS_rrtmgp_lw_pre.F90 delete mode 100644 physics/GFS_rrtmgp_lw_pre.meta diff --git a/physics/GFS_rrtmgp_lw_pre.F90 b/physics/GFS_rrtmgp_lw_pre.F90 deleted file mode 100644 index 34f9e5b53..000000000 --- a/physics/GFS_rrtmgp_lw_pre.F90 +++ /dev/null @@ -1,92 +0,0 @@ -module GFS_rrtmgp_lw_pre - use physparam - use machine, only: & - kind_phys ! Working type - use GFS_typedefs, only: & - GFS_control_type, & ! - GFS_sfcprop_type, & ! Surface fields - GFS_grid_type, & ! Grid and interpolation related data - GFS_statein_type, & ! - GFS_radtend_type ! Radiation tendencies needed in physics - use module_radiation_surface, only: & - setemis ! Routine to compute surface-emissivity - use mo_gas_optics_rrtmgp, only: & - ty_gas_optics_rrtmgp - - public GFS_rrtmgp_lw_pre_run,GFS_rrtmgp_lw_pre_init,GFS_rrtmgp_lw_pre_finalize - -contains - - ! ######################################################################################### - ! SUBROUTINE GFS_rrtmgp_lw_pre_init - ! ######################################################################################### - subroutine GFS_rrtmgp_lw_pre_init () - end subroutine GFS_rrtmgp_lw_pre_init - - ! ######################################################################################### - ! SUBROUTINE GFS_rrtmgp_lw_pre_run - ! ######################################################################################### -!> \section arg_table_GFS_rrtmgp_lw_pre_run -!! \htmlinclude GFS_rrtmgp_lw_pre.html -!! - subroutine GFS_rrtmgp_lw_pre_run (Model, Grid, Sfcprop, Statein, ncol, p_lay, p_lev, & - tv_lay, relhum, tracer, lw_gas_props, Radtend, sfc_emiss_byband, errmsg, errflg) - - ! Inputs - type(GFS_control_type), intent(in) :: & - Model ! DDT: FV3-GFS model control parameters - type(GFS_grid_type), intent(in) :: & - Grid ! DDT: FV3-GFS grid and interpolation related data - type(GFS_sfcprop_type), intent(in) :: & - Sfcprop ! DDT: FV3-GFS surface fields - type(GFS_statein_type), intent(in) :: & - Statein ! DDT: FV3-GFS prognostic state data in from dycore - integer, intent(in) :: & - ncol ! Number of horizontal grid points - real(kind_phys), dimension(ncol,Model%levs),intent(in) :: & - p_lay, & ! Layer pressure - tv_lay, & ! Layer virtual-temperature - relhum ! Layer relative-humidity - real(kind_phys), dimension(ncol, Model%levs, 2:Model%ntrac),intent(in) :: & - tracer ! trace gas concentrations - real(kind_phys), dimension(ncol,Model%levs+1),intent(in) :: & - p_lev ! Interface (level) pressure - type(ty_gas_optics_rrtmgp),intent(in) :: & - lw_gas_props ! RRTMGP DDT: spectral information for LW calculation - - ! Outputs - type(GFS_radtend_type), intent(inout) :: & - Radtend ! DDT: FV3-GFS radiation tendencies - real(kind_phys), dimension(lw_gas_props%get_nband(),ncol), intent(out) :: & - sfc_emiss_byband ! Surface emissivity in each band - character(len=*), intent(out) :: & - errmsg ! Error message - integer, intent(out) :: & - errflg ! Error flag - - ! Initialize CCPP error handling variables - errmsg = '' - errflg = 0 - - if (.not. Model%lslwr) return - - ! ####################################################################################### - ! Call module_radiation_surface::setemis(),to setup surface emissivity for LW radiation. - ! ####################################################################################### - call setemis (Grid%xlon, Grid%xlat, Sfcprop%slmsk, Sfcprop%snowd, Sfcprop%sncovr, & - Sfcprop%zorl, Sfcprop%tsfc,Sfcprop%tsfc, Sfcprop%hprime(:,1), NCOL, Radtend%semis) - - ! Assign same emissivity to all bands - do iBand=1,lw_gas_props%get_nband() - sfc_emiss_byband(iBand,1:NCOL) = Radtend%semis(1:NCOL) - enddo - - end subroutine GFS_rrtmgp_lw_pre_run - - ! ######################################################################################### - ! SUBROUTINE GFS_rrtmgp_lw_pre_finalize - ! ######################################################################################### - subroutine GFS_rrtmgp_lw_pre_finalize () - end subroutine GFS_rrtmgp_lw_pre_finalize - -end module GFS_rrtmgp_lw_pre diff --git a/physics/GFS_rrtmgp_lw_pre.meta b/physics/GFS_rrtmgp_lw_pre.meta deleted file mode 100644 index 78cdfa2d4..000000000 --- a/physics/GFS_rrtmgp_lw_pre.meta +++ /dev/null @@ -1,135 +0,0 @@ -[ccpp-arg-table] - name = GFS_rrtmgp_lw_pre_run - type = scheme -[Model] - standard_name = GFS_control_type_instance - long_name = instance of derived type GFS_control_type - units = DDT - dimensions = () - type = GFS_control_type - intent = in - optional = F -[Grid] - standard_name = GFS_grid_type_instance - long_name = instance of derived type GFS_grid_type - units = DDT - dimensions = () - type = GFS_grid_type - intent = in - optional = F -[Sfcprop] - standard_name = GFS_sfcprop_type_instance - long_name = instance of derived type GFS_sfcprop_type - units = DDT - dimensions = () - type = GFS_sfcprop_type - intent = in - optional = F -[Statein] - standard_name = GFS_statein_type_instance - long_name = instance of derived type GFS_statein_type - units = DDT - dimensions = () - type = GFS_statein_type - intent = in - optional = F -[Radtend] - standard_name = GFS_radtend_type_instance - long_name = instance of derived type GFS_radtend_type - units = DDT - dimensions = () - type = GFS_radtend_type - intent = inout - optional = F -[ncol] - standard_name = horizontal_loop_extent - long_name = horizontal loop extent - units = count - dimensions = () - type = integer - intent = in - optional = F -[tv_lay] - standard_name = virtual_temperature - long_name = layer virtual temperature - units = K - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = in - optional = F -[relhum] - standard_name = relative_humidity - long_name = layer relative humidity - units = frac - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = in - optional = F -[p_lay] - standard_name = air_pressure_at_layer_for_RRTMGP_in_hPa - long_name = air pressure at vertical layer for radiation calculation - units = hPa - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = in - optional = F -[p_lev] - standard_name = air_pressure_at_interface_for_RRTMGP_in_hPa - long_name = air pressure at vertical interface for radiation calculation - units = hPa - dimensions = (horizontal_dimension,vertical_dimension_plus_one) - type = real - kind = kind_phys - intent = in - optional = F -[tracer] - standard_name = chemical_tracers - long_name = chemical tracers - units = g g-1 - dimensions = (horizontal_dimension,vertical_dimension,number_of_tracers) - type = real - kind = kind_phys - intent = in - optional = F -[lw_gas_props] - standard_name = coefficients_for_lw_gas_optics - long_name = DDT containing spectral information for RRTMGP LW radiation scheme - units = DDT - dimensions = () - type = ty_gas_optics_rrtmgp - intent = in - optional = F -[sfc_emiss_byband] - standard_name = surface_emissivity_in_each_RRTMGP_LW_band - long_name = surface emissivity in each RRTMGP LW band - units = none - dimensions = (number_of_lw_bands_rrtmgp,horizontal_dimension) - type = real - kind = kind_phys - intent = out - optional = F -[errmsg] - standard_name = ccpp_error_message - long_name = error message for error handling in CCPP - units = none - dimensions = () - type = character - kind = len=* - intent = out - optional = F -[errflg] - standard_name = ccpp_error_flag - long_name = error flag for error handling in CCPP - units = flag - dimensions = () - type = integer - intent = out - optional = F - -######################################################################## -[ccpp-arg-table] - name = GFS_rrtmgp_pre_lw_finalize - type = scheme diff --git a/physics/GFS_rrtmgp_sw_pre.F90 b/physics/GFS_rrtmgp_sw_pre.F90 index 6987c3e4a..0900b0004 100644 --- a/physics/GFS_rrtmgp_sw_pre.F90 +++ b/physics/GFS_rrtmgp_sw_pre.F90 @@ -2,14 +2,6 @@ module GFS_rrtmgp_sw_pre use physparam use machine, only: & kind_phys ! Working type - use GFS_typedefs, only: & - GFS_sfcprop_type, & ! Surface fields - GFS_control_type, & ! Model control parameters - GFS_grid_type, & ! Grid and interpolation related data - GFS_coupling_type, & ! - GFS_statein_type, & ! - GFS_radtend_type, & ! Radiation tendencies needed in physics - GFS_interstitial_type use module_radiation_astronomy,only: & coszmn ! Function to compute cos(SZA) use module_radiation_surface, only: & @@ -35,29 +27,57 @@ end subroutine GFS_rrtmgp_sw_pre_init !> \section arg_table_GFS_rrtmgp_sw_pre_run !! \htmlinclude GFS_rrtmgp_sw_pre.html !! - subroutine GFS_rrtmgp_sw_pre_run(Model, Grid, Sfcprop, Statein, ncol, p_lay, p_lev, & - tv_lay, relhum, tracer, sw_gas_props, nday, idxday, alb1d, sfc_alb_nir_dir, & - sfc_alb_nir_dif, sfc_alb_uvvis_dir, sfc_alb_uvvis_dif, RadTend, Coupling, & - errmsg, errflg) + subroutine GFS_rrtmgp_sw_pre_run(doLWrad, do_sfcperts, ncol, nlev, ntrac, nsfcpert, nmtvr,mpi_rank, solhr, & + pertalb, sfc_wts, xlon, coslat, sinlat, slmsk, snowd, sncovr, snoalb, zorl, coszen, coszdg, tsfc,& + hprime, alvsf, alnsf, alvwf, alnwf, facsf, facwf, fice, tisfc, p_lay, p_lev, tv_lay, & + relhum, tracer, sw_gas_props, nday, idxday, alb1d, sfalb, sfc_alb_nir_dir, sfc_alb_nir_dif, & + sfc_alb_uvvis_dir, sfc_alb_uvvis_dif, errmsg, errflg) ! Inputs - type(GFS_control_type), intent(in) :: & - Model ! DDT: FV3-GFS model control parameters - type(GFS_grid_type), intent(in) :: & - Grid ! DDT: FV3-GFS grid and interpolation related data - type(GFS_sfcprop_type), intent(in) :: & - Sfcprop ! DDT: FV3-GFS surface fields - type(GFS_statein_type), intent(in) :: & - Statein ! DDT: FV3-GFS prognostic state data in from dycore + logical, intent(in) :: & + doLWrad , & ! Flag for longwave radiation call + do_sfcperts ! Flag for stochastic surface perturbations option + integer, intent(in) :: & - ncol ! Number of horizontal grid points - real(kind_phys), dimension(ncol,Model%levs),intent(in) :: & + ncol, & ! Number of horizontal grid points + nlev, & ! Number of vertical levels + ntrac, & ! Number of tracers + nsfcpert, & ! number of surface perturbations + nmtvr, & ! number of topographic variables in GWD + mpi_rank ! Current MPI-rank + real(kind_phys), intent(in) :: & + solhr ! Time after 00z at the current timestep (hours) + real(kind_phys), dimension(nsfcpert), intent(in) :: & + pertalb ! Magnitude of surface albedo perturbation + real(kind_phys), dimension(ncol,nsfcpert), intent(in) :: & + sfc_wts ! Magnitude of surface albedo perturbation + real(kind_phys), dimension(ncol), intent(in) :: & + xlon, & ! Longitude + coslat, & ! Cosine of latitude + sinlat, & ! Sine of latitude + slmsk, & ! Lank/sea mask + snowd, & ! Water equivalent snow depth (mm) + sncovr, & ! Surface snow area fraction + snoalb, & ! Maximum snow albedo + zorl, & ! Surface roughness length + tsfc, & ! Surface skin temperature (K) + alvsf, & ! Mean vis albedo with strong cosz dependency + alnsf, & ! Mean nIR albedo with strong cosz dependency + alvwf, & ! Mean vis albedo with weak cosz dependency + alnwf, & ! Mean nIR albedo with weak cosz dependency + facsf, & ! Fractional coverage with strong cosz dependency + facwf, & ! Fractional coverage with weak cosz dependency + fice, & ! Ice fraction over open water + tisfc ! Sea ice surface skin temperature + real(kind_phys), dimension(ncol,nmtvr), intent(in) :: & + hprime ! orographic metrics + real(kind_phys), dimension(ncol,nlev),intent(in) :: & p_lay, & ! Layer pressure tv_lay, & ! Layer virtual-temperature relhum ! Layer relative-humidity - real(kind_phys), dimension(ncol, Model%levs, 2:Model%ntrac),intent(in) :: & - tracer - real(kind_phys), dimension(ncol,Model%levs+1),intent(in) :: & + real(kind_phys), dimension(ncol, nlev, 2:ntrac),intent(in) :: & + tracer ! Chemical tracers (g/g) + real(kind_phys), dimension(ncol,nlev+1),intent(in) :: & p_lev ! Pressure @ layer interfaces (Pa) type(ty_gas_optics_rrtmgp),intent(in) :: & sw_gas_props ! RRTMGP DDT: spectral information for SW calculation @@ -68,16 +88,15 @@ subroutine GFS_rrtmgp_sw_pre_run(Model, Grid, Sfcprop, Statein, ncol, p_lay, p_ integer, dimension(ncol), intent(out) :: & idxday ! Indices for daylit points real(kind_phys), dimension(ncol), intent(out) :: & - alb1d ! Surface albedo pertubation + coszen, & ! mean cos of zenith angle over rad call period + coszdg, & ! daytime mean cosz over rad call period + sfalb, & ! mean surface diffused SW albedo + alb1d ! Surface albedo pertubation real(kind_phys), dimension(sw_gas_props%get_nband(),ncol), intent(out) :: & sfc_alb_nir_dir, & ! Surface albedo (direct) sfc_alb_nir_dif, & ! Surface albedo (diffuse) sfc_alb_uvvis_dir, & ! Surface albedo (direct) sfc_alb_uvvis_dif ! Surface albedo (diffuse) - type(GFS_radtend_type), intent(inout) :: & - Radtend ! DDT: FV3-GFS radiation tendencies - type(GFS_coupling_type), intent(inout) :: & - Coupling ! DDT: FV3-GFS coupling arrays character(len=*), intent(out) :: & errmsg ! Error message integer, intent(out) :: & @@ -91,13 +110,13 @@ subroutine GFS_rrtmgp_sw_pre_run(Model, Grid, Sfcprop, Statein, ncol, p_lay, p_ errmsg = '' errflg = 0 - if (.not. Model%lsswr) return + if (.not. doLWrad) return ! ####################################################################################### ! Compute cosine of zenith angle (only when SW is called) ! ####################################################################################### - call coszmn (Grid%xlon, Grid%sinlat, Grid%coslat, Model%solhr, NCOL, Model%me, & - Radtend%coszen, Radtend%coszdg) + call coszmn (xlon, sinlat, coslat, solhr, NCOL, mpi_rank, & + coszen, coszdg) ! ####################################################################################### ! For SW gather daylit points @@ -105,7 +124,7 @@ subroutine GFS_rrtmgp_sw_pre_run(Model, Grid, Sfcprop, Statein, ncol, p_lay, p_ nday = 0 idxday = 0 do i = 1, NCOL - if (Radtend%coszen(i) >= 0.0001) then + if (coszen(i) >= 0.0001) then nday = nday + 1 idxday(nday) = i endif @@ -117,10 +136,10 @@ subroutine GFS_rrtmgp_sw_pre_run(Model, Grid, Sfcprop, Statein, ncol, p_lay, p_ ! --- turn vegetation fraction pattern into percentile pattern ! ####################################################################################### alb1d(:) = 0. - if (Model%do_sfcperts) then - if (Model%pertalb(1) > 0.) then + if (do_sfcperts) then + if (pertalb(1) > 0.) then do i=1,ncol - call cdfnor(Coupling%sfc_wts(i,5),alb1d(i)) + call cdfnor(sfc_wts(i,5),alb1d(i)) enddo endif endif @@ -128,13 +147,11 @@ subroutine GFS_rrtmgp_sw_pre_run(Model, Grid, Sfcprop, Statein, ncol, p_lay, p_ ! ####################################################################################### ! Call module_radiation_surface::setalb() to setup surface albedo. ! ####################################################################################### - call setalb (Sfcprop%slmsk, Sfcprop%snowd, Sfcprop%sncovr, Sfcprop%snoalb, Sfcprop%zorl, & - Radtend%coszen, Sfcprop%tsfc, Sfcprop%tsfc, Sfcprop%hprime(:,1), Sfcprop%alvsf, & - Sfcprop%alnsf, Sfcprop%alvwf, Sfcprop%alnwf, Sfcprop%facsf, Sfcprop%facwf, & - Sfcprop%fice, Sfcprop%tisfc, NCOL, alb1d, Model%pertalb, sfcalb) + call setalb (slmsk, snowd, sncovr, snoalb, zorl, coszen, tsfc, tsfc, hprime(:,1), alvsf, & + alnsf, alvwf, alnwf, facsf, facwf, fice, tisfc, NCOL, alb1d, pertalb, sfcalb) ! Approximate mean surface albedo from vis- and nir- diffuse values. - Radtend%sfalb(:) = max(0.01, 0.5 * (sfcalb(:,2) + sfcalb(:,4))) + sfalb(:) = max(0.01, 0.5 * (sfcalb(:,2) + sfcalb(:,4))) ! Spread across all SW bands do iBand=1,sw_gas_props%get_nband() diff --git a/physics/GFS_rrtmgp_sw_pre.meta b/physics/GFS_rrtmgp_sw_pre.meta index 73df740e1..e4b1944d1 100644 --- a/physics/GFS_rrtmgp_sw_pre.meta +++ b/physics/GFS_rrtmgp_sw_pre.meta @@ -1,62 +1,259 @@ [ccpp-arg-table] name = GFS_rrtmgp_sw_pre_run type = scheme -[Model] - standard_name = GFS_control_type_instance - long_name = instance of derived type GFS_control_type - units = DDT +[xlon] + standard_name = longitude + long_name = longitude + units = radians + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[coslat] + standard_name = cosine_of_latitude + long_name = cosine of latitude + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[sinlat] + standard_name = sine_of_latitude + long_name = sine of latitude + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[ntrac] + standard_name = number_of_tracers + long_name = number of tracers + units = count dimensions = () - type = GFS_control_type + type = integer intent = in optional = F -[Grid] - standard_name = GFS_grid_type_instance - long_name = instance of derived type GFS_grid_type - units = DDT +[nlev] + standard_name = vertical_dimension + long_name = number of vertical levels + units = count dimensions = () - type = GFS_grid_type + type = integer intent = in optional = F -[Sfcprop] - standard_name = GFS_sfcprop_type_instance - long_name = instance of derived type GFS_sfcprop_type - units = DDT +[ncol] + standard_name = horizontal_loop_extent + long_name = horizontal loop extent + units = count dimensions = () - type = GFS_sfcprop_type + type = integer intent = in optional = F -[Statein] - standard_name = GFS_statein_type_instance - long_name = instance of derived type GFS_statein_type - units = DDT +[nsfcpert] + standard_name = number_of_surface_perturbations + long_name = number of surface perturbations + units = count dimensions = () - type = GFS_statein_type + type = integer intent = in optional = F -[Radtend] - standard_name = GFS_radtend_type_instance - long_name = instance of derived type GFS_radtend_type - units = DDT +[nmtvr] + standard_name = number_of_statistical_measures_of_subgrid_orography + long_name = number of topographic variables in GWD + units = count dimensions = () - type = GFS_radtend_type - intent = inout + type = integer + intent = in optional = F -[Coupling] - standard_name = GFS_coupling_type_instance - long_name = Fortran DDT containing FV3-GFS fields to/from coupling with other components - units = DDT +[doLWrad] + standard_name = flag_to_calc_sw + long_name = logical flags for sw radiation calls + units = flag dimensions = () - type = GFS_coupling_type - intent = inout + type = logical + intent = in optional = F -[ncol] - standard_name = horizontal_loop_extent - long_name = horizontal loop extent - units = count +[solhr] + standard_name = forecast_hour_of_the_day + long_name = time in hours after 00z at the current timestep + units = h + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[mpi_rank] + standard_name = mpi_rank + long_name = current MPI-rank + units = index dimensions = () type = integer intent = in optional = F +[do_sfcperts] + standard_name = flag_for_stochastic_surface_perturbations + long_name = flag for stochastic surface perturbations option + units = flag + dimensions = () + type = logical + intent = in + optional = F +[pertalb] + standard_name = magnitude_of_surface_albedo_perturbation + long_name = magnitude of surface albedo perturbation + units = frac + dimensions = (5) + type = real + kind = kind_phys + intent = in + optional = F +[slmsk] + standard_name = sea_land_ice_mask_real + long_name = landmask: sea/land/ice=0/1/2 + units = flag + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[snowd] + standard_name = surface_snow_thickness_water_equivalent + long_name = water equivalent snow depth + units = mm + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[sncovr] + standard_name = surface_snow_area_fraction_over_land + long_name = surface snow area fraction + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[snoalb] + standard_name = upper_bound_on_max_albedo_over_deep_snow + long_name = maximum snow albedo + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[zorl] + standard_name = surface_roughness_length + long_name = surface roughness length + units = cm + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[tsfc] + standard_name = surface_skin_temperature + long_name = surface skin temperature + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[hprime] + standard_name = statistical_measures_of_subgrid_orography + long_name = orographic metrics + units = various + dimensions = (horizontal_dimension,number_of_statistical_measures_of_subgrid_orography) + type = real + kind = kind_phys + intent = in + optional = F +[alvwf] + standard_name = mean_vis_albedo_with_weak_cosz_dependency + long_name = mean vis albedo with weak cosz dependency + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[alnwf] + standard_name = mean_nir_albedo_with_weak_cosz_dependency + long_name = mean nir albedo with weak cosz dependency + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[alvsf] + standard_name = mean_vis_albedo_with_strong_cosz_dependency + long_name = mean vis albedo with strong cosz dependency + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[alnsf] + standard_name = mean_nir_albedo_with_strong_cosz_dependency + long_name = mean nir albedo with strong cosz dependency + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[facsf] + standard_name =fractional_coverage_with_strong_cosz_dependency + long_name = fractional coverage with strong cosz dependency + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[facwf] + standard_name = fractional_coverage_with_weak_cosz_dependency + long_name = fractional coverage with weak cosz dependency + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[fice] + standard_name = sea_ice_concentration + long_name = ice fraction over open water + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[tisfc] + standard_name = sea_ice_temperature + long_name = sea ice surface skin temperature + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[sfc_wts] + standard_name = weights_for_stochastic_surface_physics_perturbation + long_name = weights for stochastic surface physics perturbation + units = none + dimensions = (horizontal_dimension,number_of_surface_perturbations) + type = real + kind = kind_phys + intent = in + optional = F [tv_lay] standard_name = virtual_temperature long_name = layer virtual temperature @@ -119,6 +316,15 @@ kind = kind_phys intent = out optional = F +[sfalb] + standard_name = surface_diffused_shortwave_albedo + long_name = mean surface diffused sw albedo + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F [sfc_alb_nir_dir] standard_name = surface_albedo_nearIR_direct long_name = near-IR (direct) surface albedo (sfc_alb_nir_dir) @@ -155,6 +361,24 @@ kind = kind_phys intent = out optional = F +[coszen] + standard_name = cosine_of_zenith_angle + long_name = mean cos of zenith angle over rad call period + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[coszdg] + standard_name = daytime_mean_cosz_over_rad_call_period + long_name = daytime mean cosz over rad call period + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F [nday] standard_name = daytime_points_dimension long_name = daytime points dimension diff --git a/physics/rrtmgp_sw_cloud_optics.F90 b/physics/rrtmgp_sw_cloud_optics.F90 index c0f8134e8..b23819680 100644 --- a/physics/rrtmgp_sw_cloud_optics.F90 +++ b/physics/rrtmgp_sw_cloud_optics.F90 @@ -392,12 +392,6 @@ subroutine rrtmgp_sw_cloud_optics_run(doSWrad, nCol, nLev, nDay, idxday, nrghice if (cld_optics_scheme .gt. 0) then ! RRTMGP cloud-optics. call check_error_msg('rrtmgp_sw_cloud_optics_run',sw_cloud_props%cloud_optics(& - !nday, & ! IN - Number of daylit gridpoints - !nLev, & ! IN - Number of vertical layers - !sw_cloud_props%get_nband(), & ! IN - Number of SW bands - !nrghice, & ! IN - Number of ice-roughness categories - !liqmask, & ! IN - Liquid-cloud mask - !icemask, & ! IN - Ice-cloud mask cld_lwp(idxday(1:nday),:), & ! IN - Cloud liquid water path cld_iwp(idxday(1:nday),:), & ! IN - Cloud ice water path cld_reliq(idxday(1:nday),:), & ! IN - Cloud liquid effective radius @@ -406,6 +400,9 @@ subroutine rrtmgp_sw_cloud_optics_run(doSWrad, nCol, nLev, nDay, idxday, nrghice ! in each band (tau,ssa,g) else ! RRTMG cloud-optics + tau_cld(:,:,:) = 0._kind_phys + ssa_cld(:,:,:) = 0._kind_phys + asy_cld(:,:,:) = 0._kind_phys if (any(cld_frac .gt. 0)) then call rrtmg_sw_cloud_optics(nday, nLev, sw_gas_props%get_nband(), & cld_lwp(idxday(1:nday),:), cld_reliq(idxday(1:nday),:), & @@ -413,10 +410,10 @@ subroutine rrtmgp_sw_cloud_optics_run(doSWrad, nCol, nLev, nDay, idxday, nrghice cld_rwp(idxday(1:nday),:), cld_rerain(idxday(1:nday),:), & cld_swp(idxday(1:nday),:), cld_resnow(idxday(1:nday),:), & cld_frac(idxday(1:nday),:), tau_cld, ssa_cld, asy_cld) - sw_optical_props_cloudsByBand%tau(:,:,:) = tau_cld - sw_optical_props_cloudsByBand%ssa(:,:,:) = ssa_cld - sw_optical_props_cloudsByBand%g(:,:,:) = asy_cld endif + sw_optical_props_cloudsByBand%tau(:,:,:) = tau_cld + sw_optical_props_cloudsByBand%ssa(:,:,:) = ssa_cld + sw_optical_props_cloudsByBand%g(:,:,:) = asy_cld endif ! All-sky SW optical depth ~0.55microns diff --git a/physics/rrtmgp_sw_rte.F90 b/physics/rrtmgp_sw_rte.F90 index de31a10f9..96bfa94ea 100644 --- a/physics/rrtmgp_sw_rte.F90 +++ b/physics/rrtmgp_sw_rte.F90 @@ -27,11 +27,10 @@ end subroutine rrtmgp_sw_rte_init !! \htmlinclude rrtmgp_sw_rte.html !! subroutine rrtmgp_sw_rte_run(doSWrad, nCol, nLev, nDay, idxday, coszen, p_lay, t_lay, & - p_lev, sw_gas_props, gas_concentrations, sw_optical_props_clrsky, sfc_alb_nir_dir, & - sfc_alb_nir_dif, sfc_alb_uvvis_dir, sfc_alb_uvvis_dif, toa_src_sw, & - sw_optical_props_clouds, sw_optical_props_aerosol, rrtmgp_nGases, active_gases_array, & - scmpsw, fluxswUP_allsky, fluxswDOWN_allsky, fluxswUP_clrsky, fluxswDOWN_clrsky, & - hsw0, hswb, errmsg, errflg) + p_lev, sw_gas_props, sw_optical_props_clrsky, sfc_alb_nir_dir, sfc_alb_nir_dif, & + sfc_alb_uvvis_dir, sfc_alb_uvvis_dif, toa_src_sw, sw_optical_props_clouds, & + sw_optical_props_aerosol, rrtmgp_nGases, active_gases_array, scmpsw, fluxswUP_allsky, & + fluxswDOWN_allsky, fluxswUP_clrsky, fluxswDOWN_clrsky, hsw0, hswb, errmsg, errflg) ! Inputs logical, intent(in) :: & @@ -51,10 +50,9 @@ subroutine rrtmgp_sw_rte_run(doSWrad, nCol, nLev, nDay, idxday, coszen, p_lay, t p_lev ! Pressure @ model layer-interfaces (Pa) type(ty_gas_optics_rrtmgp),intent(in) :: & sw_gas_props ! RRTMGP DDT: SW spectral information - type(ty_gas_concs),intent(in) :: & - gas_concentrations ! RRTMGP DDT: trace gas concentrations (vmr) type(ty_optical_props_2str),intent(inout) :: & - sw_optical_props_clrsky, & ! RRTMGP DDT: shortwave clear-sky radiative properties + sw_optical_props_clrsky ! RRTMGP DDT: shortwave clear-sky radiative properties + type(ty_optical_props_2str),intent(in) :: & sw_optical_props_clouds, & ! RRTMGP DDT: shortwave cloud radiative properties sw_optical_props_aerosol ! RRTMGP DDT: shortwave aerosol radiative properties real(kind_phys), dimension(sw_gas_props%get_nband(),ncol), intent(in) :: & @@ -107,24 +105,19 @@ subroutine rrtmgp_sw_rte_run(doSWrad, nCol, nLev, nDay, idxday, coszen, p_lay, t real(kind_phys), dimension(ncol,NLev) :: vmrTemp logical :: l_ClrSky_HR=.false., l_AllSky_HR_byband=.false., l_scmpsw=.false., top_at_1 integer :: iGas,iSFC,iTOA,iBand - type(ty_optical_props_2str) :: & - sw_optical_props_clouds_daylit, & ! RRTMGP DDT: longwave cloud radiative properties - sw_optical_props_clrsky_daylit, & ! RRTMGP DDT: longwave clear-sky radiative properties - sw_optical_props_aerosol_daylit ! RRTMGP DDT: longwave aerosol radiative properties - type(ty_gas_concs) :: & - gas_concentrations_daylit ! RRTMGP DDT: trace gas concentrations (vmr) ! Initialize CCPP error handling variables errmsg = '' errflg = 0 + if (.not. doSWrad) return + ! Initialize output fluxes fluxswUP_allsky(:,:) = 0._kind_phys fluxswDOWN_allsky(:,:) = 0._kind_phys fluxswUP_clrsky(:,:) = 0._kind_phys fluxswDOWN_clrsky(:,:) = 0._kind_phys - if (.not. doSWrad) return if (nDay .gt. 0) then ! Vertical ordering? @@ -145,15 +138,6 @@ subroutine rrtmgp_sw_rte_run(doSWrad, nCol, nLev, nDay, idxday, coszen, p_lay, t scmpsw = cmpfsw_type (0., 0., 0., 0., 0., 0.) endif - ! Subset the gas concentrations, only need daylit points. - call check_error_msg('rrtmgp_sw_rte_run',gas_concentrations_daylit%init(active_gases_array)) - do iGas=1,rrtmgp_nGases - call check_error_msg('rrtmgp_sw_rte_run',& - gas_concentrations%get_vmr(trim(active_gases_array(iGas)),vmrTemp)) - call check_error_msg('rrtmgp_sw_rte_run',& - gas_concentrations_daylit%set_vmr(trim(active_gases_array(iGas)),vmrTemp(idxday(1:nday),:))) - enddo - ! Initialize RRTMGP DDT containing 2D(3D) fluxes fluxSW_up_allsky(:,:,:) = 0._kind_phys fluxSW_dn_allsky(:,:,:) = 0._kind_phys @@ -205,7 +189,7 @@ subroutine rrtmgp_sw_rte_run(doSWrad, nCol, nLev, nDay, idxday, coszen, p_lay, t ! All-sky fluxes (clear-sky + clouds) call check_error_msg('rrtmgp_sw_rte_run',sw_optical_props_clouds%increment(sw_optical_props_clrsky)) ! Delta-scale optical properties - call check_error_msg('rrtmgp_sw_rte_run',sw_optical_props_clouds%delta_scale()) + call check_error_msg('rrtmgp_sw_rte_run',sw_optical_props_clrsky%delta_scale()) call check_error_msg('rrtmgp_sw_rte_run',rte_sw( & sw_optical_props_clrsky, & ! IN - optical-properties top_at_1, & ! IN - veritcal ordering flag diff --git a/physics/rrtmgp_sw_rte.meta b/physics/rrtmgp_sw_rte.meta index eaf4eab11..8ae7421c3 100644 --- a/physics/rrtmgp_sw_rte.meta +++ b/physics/rrtmgp_sw_rte.meta @@ -109,14 +109,6 @@ type = ty_optical_props_2str intent = in optional = F -[gas_concentrations] - standard_name = Gas_concentrations_for_RRTMGP_suite - long_name = DDT containing gas concentrations for RRTMGP radiation scheme - units = DDT - dimensions = () - type = ty_gas_concs - intent = in - optional = F [sfc_alb_nir_dir] standard_name = surface_albedo_nearIR_direct long_name = near-IR (direct) surface albedo (sfc_alb_nir_dir)