diff --git a/.gitmodules b/.gitmodules index 75e5ea836..8758980ec 100644 --- a/.gitmodules +++ b/.gitmodules @@ -1,4 +1,4 @@ [submodule "physics/rte-rrtmgp"] path = physics/rte-rrtmgp url = https://github.com/earth-system-radiation/rte-rrtmgp - branch = dtc/ccpp + branch = main diff --git a/CMakeLists.txt b/CMakeLists.txt index d14778b06..482081614 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -81,14 +81,10 @@ get_filename_component(LOCAL_CURRENT_SOURCE_DIR ${FULL_PATH_TO_CMAKELISTS} DIREC # List of files that need to be compiled without OpenMP set(SCHEMES_OPENMP_OFF ${LOCAL_CURRENT_SOURCE_DIR}/physics/rte-rrtmgp/rrtmgp/mo_gas_optics.F90 ${LOCAL_CURRENT_SOURCE_DIR}/physics/rte-rrtmgp/rrtmgp/mo_rrtmgp_constants.F90 - ${LOCAL_CURRENT_SOURCE_DIR}/physics/rte-rrtmgp/rrtmgp/mo_rrtmgp_util_reorder.F90 ${LOCAL_CURRENT_SOURCE_DIR}/physics/rte-rrtmgp/rrtmgp/mo_gas_concentrations.F90 ${LOCAL_CURRENT_SOURCE_DIR}/physics/rte-rrtmgp/rrtmgp/mo_rrtmgp_util_string.F90 ${LOCAL_CURRENT_SOURCE_DIR}/physics/rte-rrtmgp/rrtmgp/kernels/mo_gas_optics_kernels.F90 - ${LOCAL_CURRENT_SOURCE_DIR}/physics/rte-rrtmgp/rrtmgp/kernels/mo_rrtmgp_util_reorder_kernels.F90 ${LOCAL_CURRENT_SOURCE_DIR}/physics/rte-rrtmgp/rrtmgp/mo_gas_optics_rrtmgp.F90 - ${LOCAL_CURRENT_SOURCE_DIR}/physics/rte-rrtmgp/tests/mo_testing_io.F90 - ${LOCAL_CURRENT_SOURCE_DIR}/physics/rte-rrtmgp/tests/clear_sky_regression.F90 ${LOCAL_CURRENT_SOURCE_DIR}/physics/rte-rrtmgp/extensions/mo_rrtmgp_clr_all_sky.F90 ${LOCAL_CURRENT_SOURCE_DIR}/physics/rte-rrtmgp/extensions/mo_fluxes_byband.F90 ${LOCAL_CURRENT_SOURCE_DIR}/physics/rte-rrtmgp/extensions/solar_variability/mo_solar_variability.F90 @@ -97,14 +93,6 @@ set(SCHEMES_OPENMP_OFF ${LOCAL_CURRENT_SOURCE_DIR}/physics/rte-rrtmgp/rrtmgp/mo_ ${LOCAL_CURRENT_SOURCE_DIR}/physics/rte-rrtmgp/extensions/mo_compute_bc.F90 ${LOCAL_CURRENT_SOURCE_DIR}/physics/rte-rrtmgp/extensions/cloud_optics/mo_cloud_sampling.F90 ${LOCAL_CURRENT_SOURCE_DIR}/physics/rte-rrtmgp/extensions/cloud_optics/mo_cloud_optics.F90 - ${LOCAL_CURRENT_SOURCE_DIR}/physics/rte-rrtmgp/examples/mo_load_coefficients.F90 - ${LOCAL_CURRENT_SOURCE_DIR}/physics/rte-rrtmgp/examples/rfmip-clear-sky/rrtmgp_rfmip_sw.F90 - ${LOCAL_CURRENT_SOURCE_DIR}/physics/rte-rrtmgp/examples/rfmip-clear-sky/mo_rfmip_io.F90 - ${LOCAL_CURRENT_SOURCE_DIR}/physics/rte-rrtmgp/examples/rfmip-clear-sky/rrtmgp_rfmip_lw.F90 - ${LOCAL_CURRENT_SOURCE_DIR}/physics/rte-rrtmgp/examples/mo_simple_netcdf.F90 - ${LOCAL_CURRENT_SOURCE_DIR}/physics/rte-rrtmgp/examples/all-sky/rrtmgp_allsky.F90 - ${LOCAL_CURRENT_SOURCE_DIR}/physics/rte-rrtmgp/examples/all-sky/mo_load_cloud_coefficients.F90 - ${LOCAL_CURRENT_SOURCE_DIR}/physics/rte-rrtmgp/examples/all-sky/mo_garand_atmos_io.F90 ${LOCAL_CURRENT_SOURCE_DIR}/physics/rte-rrtmgp/rte/mo_rte_config.F90 ${LOCAL_CURRENT_SOURCE_DIR}/physics/rte-rrtmgp/rte/mo_source_functions.F90 ${LOCAL_CURRENT_SOURCE_DIR}/physics/rte-rrtmgp/rte/mo_rte_sw.F90 diff --git a/physics/GFS_rrtmgp_cloud_mp.F90 b/physics/GFS_rrtmgp_cloud_mp.F90 index 9ca340763..32104b7f8 100644 --- a/physics/GFS_rrtmgp_cloud_mp.F90 +++ b/physics/GFS_rrtmgp_cloud_mp.F90 @@ -27,7 +27,7 @@ module GFS_rrtmgp_cloud_mp reice_min = 10.0, & ! Minimum ice size allowed by GFDL MP scheme reice_max = 150.0 ! Maximum ice size allowed by GFDL MP scheme - public GFS_rrtmgp_cloud_mp_run + public GFS_rrtmgp_cloud_mp_init, GFS_rrtmgp_cloud_mp_run, GFS_rrtmgp_cloud_mp_finalize contains @@ -45,7 +45,7 @@ module GFS_rrtmgp_cloud_mp subroutine GFS_rrtmgp_cloud_mp_run(nCol, nLev, nTracers, ncnd, i_cldliq, i_cldice, & i_cldrain, i_cldsnow, i_cldgrpl, i_cldtot, i_cldliq_nc, i_cldice_nc, i_twa, kdt, & imfdeepcnv, imfdeepcnv_gf, imfdeepcnv_samf, doSWrad, doLWrad, effr_in, lmfshal, & - ltaerosol,mraerosol, icloud, imp_physics, imp_physics_thompson, imp_physics_gfdl, & + ltaerosol,mraerosol, icloud, imp_physics, imp_physics_thompson, imp_physics_gfdl, & lgfdlmprad, do_mynnedmf, uni_cld, lmfdeep2, p_lev, p_lay, t_lay, qs_lay, q_lay, & relhum, lsmask, xlon, xlat, dx, tv_lay, effrin_cldliq, effrin_cldice, & effrin_cldrain, effrin_cldsnow, tracer, cnv_mixratio, cld_cnv_frac, qci_conv, & @@ -462,6 +462,7 @@ subroutine cloud_mp_MYNN(nCol, nLev, lsmask, t_lay, p_lev, p_lay, qs_lay, relhum enddo end subroutine cloud_mp_MYNN + !> \ingroup GFS_rrtmgp_cloud_mp !! Compute cloud radiative properties for SAMF convective cloud scheme. !! @@ -484,47 +485,48 @@ subroutine cloud_mp_SAMF(nCol, nLev, t_lay, p_lev, p_lay, qs_lay, relhum, nCol, & ! Number of horizontal grid points nLev ! Number of vertical layers real(kind_phys), intent(in) :: & - con_g, & ! Physical constant: gravitational constant - con_ttp, & ! Triple point temperature of water (K) + con_g, & ! Physical constant: gravity (m s-2) + con_ttp, & ! Triple point temperature of water (K) alpha0 ! real(kind_phys), dimension(:,:),intent(in) :: & - t_lay, & ! Temperature at layer centers (K) - p_lev, & ! Pressure at layer interfaces (Pa) - p_lay, & ! - qs_lay, & ! - relhum, & ! - cnv_mixratio ! Convective cloud mixing-ratio (kg/kg) + t_lay, & ! Temperature at layer-centers (K) + p_lev, & ! Pressure at layer-interfaces (Pa) + p_lay, & ! Presure at layer-centers (Pa) + qs_lay, & ! Specific-humidity at layer-centers (kg/kg) + relhum, & ! Relative-humidity (1) + cnv_mixratio ! Convective cloud mixing-ratio (kg/kg) ! Outputs real(kind_phys), dimension(:,:),intent(inout) :: & cld_cnv_lwp, & ! Convective cloud liquid water path cld_cnv_reliq, & ! Convective cloud liquid effective radius cld_cnv_iwp, & ! Convective cloud ice water path cld_cnv_reice, & ! Convective cloud ice effecive radius - cld_cnv_frac ! Convective cloud-fraction (1) + cld_cnv_frac ! Convective cloud-fraction ! Local integer :: iCol, iLay - real(kind_phys) :: tem1, deltaP, clwc + real(kind_phys) :: tem0, tem1, deltaP, clwc + tem0 = 1.0e5/con_g do iLay = 1, nLev do iCol = 1, nCol if (cnv_mixratio(iCol,iLay) > 0._kind_phys) then tem1 = min(1.0, max(0.0, (con_ttp-t_lay(iCol,iLay))*0.05)) deltaP = abs(p_lev(iCol,iLay+1)-p_lev(iCol,iLay))*0.01 - clwc = max(0.0, cnv_mixratio(iCol,iLay)) * con_g * deltaP - cld_cnv_iwp(iCol,iLay) = clwc * tem1 - cld_cnv_lwp(iCol,iLay) = clwc - cld_cnv_iwp(iCol,iLay) + clwc = max(0.0, cnv_mixratio(iCol,iLay)) * tem0 * deltaP + cld_cnv_iwp(iCol,iLay) = clwc * tem1 + cld_cnv_lwp(iCol,iLay) = clwc - cld_cnv_iwp(iCol,iLay) cld_cnv_reliq(iCol,iLay) = reliq_def cld_cnv_reice(iCol,iLay) = reice_def ! Xu-Randall (1996) cloud-fraction. - cld_cnv_frac(iCol,iLay) = cld_frac_XuRandall(p_lay(iCol,iLay), & + cld_cnv_frac(iCol,iLay) = cld_frac_XuRandall(p_lay(iCol,iLay), & qs_lay(iCol,iLay), relhum(iCol,iLay), cnv_mixratio(iCol,iLay), alpha0) endif enddo enddo end subroutine cloud_mp_SAMF - + !> \ingroup GFS_rrtmgp_cloud_mp !! This routine computes the cloud radiative properties for a "unified cloud". !! - "unified cloud" implies that the cloud-fraction is PROVIDED. @@ -656,7 +658,6 @@ subroutine cloud_mp_uni(nCol, nLev, nTracers, ncnd, i_cldliq, i_cldice, i_cldrai enddo ! nLev end subroutine cloud_mp_uni - !> \ingroup GFS_rrtmgp_cloud_mp !! This routine computes the cloud radiative properties for the Thompson cloud micro- !! physics scheme. @@ -834,11 +835,11 @@ function cld_frac_XuRandall(p_lay, qs_lay, relhum, cld_mr, alpha) return end function -!> \ingroup GFS_rrtmgp_cloud_mp -!! This routine is a wrapper to update the Thompson effective particle sizes used by the -!! RRTMGP radiation scheme. -!! -!! \section cmp_reff_Thompson_gen General Algorithm + ! ###################################################################################### + ! This routine is a wrapper to update the Thompson effective particle sizes used by the + ! RRTMGP radiation scheme. + ! + ! ###################################################################################### subroutine cmp_reff_Thompson(nLev, nCol, i_cldliq, i_cldice, i_cldsnow, i_cldice_nc, & i_cldliq_nc, i_twa, q_lay, p_lay, t_lay, tracer, con_eps, con_rd, ltaerosol, & mraerosol, lsmask, effrin_cldliq, effrin_cldice, effrin_cldsnow) @@ -922,4 +923,5 @@ subroutine cmp_reff_Thompson(nLev, nCol, i_cldliq, i_cldice, i_cldsnow, i_cldice enddo end subroutine cmp_reff_Thompson + end module GFS_rrtmgp_cloud_mp diff --git a/physics/GFS_rrtmgp_cloud_mp.meta b/physics/GFS_rrtmgp_cloud_mp.meta index 1eb870da8..b782e73b4 100644 --- a/physics/GFS_rrtmgp_cloud_mp.meta +++ b/physics/GFS_rrtmgp_cloud_mp.meta @@ -345,9 +345,9 @@ kind = kind_phys intent = inout [tracer] - standard_name = chemical_tracers - long_name = chemical tracers - units = g g-1 + standard_name = tracer_concentration + long_name = model layer mean tracer concentration + units = kg kg-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_tracers) type = real kind = kind_phys diff --git a/physics/GFS_rrtmgp_lw_post.F90 b/physics/GFS_rrtmgp_lw_post.F90 deleted file mode 100644 index afd56dcf1..000000000 --- a/physics/GFS_rrtmgp_lw_post.F90 +++ /dev/null @@ -1,188 +0,0 @@ -!> \file GFS_rrtmgp_lw_post.F90 -!! -!> \defgroup GFS_rrtmgp_lw_post GFS_rrtmgp_lw_post.F90 -!! -!! \brief RRTMGP Longwave post-processing routine. -!! -module GFS_rrtmgp_lw_post - use machine, only: kind_phys - use module_radlw_parameters, only: topflw_type, sfcflw_type - use mo_heating_rates, only: compute_heating_rate - use radiation_tools, only: check_error_msg - implicit none - - public GFS_rrtmgp_lw_post_run - -contains - -!>\defgroup gfs_rrtmgp_lw_post_mod GFS RRTMGP-LW Post Module -!> \section arg_table_GFS_rrtmgp_lw_post_run -!! \htmlinclude GFS_rrtmgp_lw_post.html -!! -!! \ingroup GFS_rrtmgp_lw_post -!! -!! \brief The all-sky longwave radiation tendency is computed, the clear-sky tendency is computed -!! if requested. -!! -!! RRTMGP surface and TOA fluxes are copied to fields that persist between radiation/physics -!! calls. -!! -!! (optional) Save additional diagnostics. -!! -!! \section GFS_rrtmgp_lw_post_run - ! ######################################################################################## - subroutine GFS_rrtmgp_lw_post_run (nCol, nLev, lslwr, do_lw_clrsky_hr, save_diag, fhlwr, & - p_lev, t_lay, tsfa, fluxlwUP_allsky, fluxlwDOWN_allsky, fluxlwUP_clrsky, iSFC, iTOA,& - fluxlwDOWN_clrsky, raddt, cldsa, mtopa, mbota, cld_frac, cldtaulw, fluxr, sfcdlw, & - sfculw, sfcflw, tsflw, htrlw, htrlwu, topflw, htrlwc, errmsg, errflg) - - ! Inputs - integer, intent(in) :: & - nCol, & ! Horizontal loop extent - nLev, & ! Number of vertical layers - iSFC, & ! Vertical index for surface level - iTOA ! Vertical index for TOA level - logical, intent(in) :: & - lslwr, & ! Logical flags for lw radiation calls - do_lw_clrsky_hr, & ! Output clear-sky SW heating-rate? - save_diag ! Output radiation diagnostics? - real(kind_phys), intent(in) :: & - fhlwr ! Frequency for SW radiation - real(kind_phys), dimension(nCol), intent(in) :: & - tsfa ! Lowest model layer air temperature for radiation (K) - real(kind_phys), dimension(nCol, nLev), intent(in) :: & - t_lay ! Temperature @ model layer centers (K) - real(kind_phys), dimension(nCol, nLev+1), intent(in) :: & - p_lev, & ! Pressure @ model layer-interfaces (Pa) - fluxlwUP_allsky, & ! RRTMGP longwave all-sky flux (W/m2) - fluxlwDOWN_allsky, & ! RRTMGP longwave all-sky flux (W/m2) - fluxlwUP_clrsky, & ! RRTMGP longwave clear-sky flux (W/m2) - fluxlwDOWN_clrsky ! RRTMGP longwave clear-sky flux (W/m2) - real(kind_phys), intent(in) :: & - raddt ! Radiation time step - real(kind_phys), dimension(nCol,5), intent(in) :: & - cldsa ! Fraction of clouds for low, middle, high, total and BL - integer, dimension(nCol,3), intent(in) ::& - mbota, & ! vertical indices for low, middle and high cloud tops - mtopa ! vertical indices for low, middle and high cloud bases - real(kind_phys), dimension(nCol,nLev), intent(in) :: & - cld_frac, & ! Total cloud fraction in each layer - cldtaulw ! approx 10.mu band layer cloud optical depth - - real(kind=kind_phys), dimension(:,:), intent(inout) :: fluxr - - ! Outputs (mandatory) - real(kind_phys), dimension(nCol), intent(inout) :: & - sfcdlw, & ! Total sky sfc downward lw flux (W/m2) - sfculw, & ! Total sky sfc upward lw flux (W/m2) - tsflw ! surface air temp during lw calculation (K) - type(sfcflw_type), dimension(nCol), intent(inout) :: & - sfcflw ! LW radiation fluxes at sfc - real(kind_phys), dimension(nCol,nLev), intent(inout) :: & - htrlw, & ! LW all-sky heating rate - htrlwu ! Heating-rate updated in-between radiation calls. - type(topflw_type), dimension(nCol), intent(out) :: & - topflw ! lw_fluxes_top_atmosphere - character(len=*), intent(out) :: & - errmsg - integer, intent(out) :: & - errflg - - ! Outputs (optional) - real(kind_phys),dimension(nCol, nLev),intent(inout),optional :: & - htrlwc ! Longwave clear-sky heating-rate (K/sec) - - ! Local variables - integer :: i, j, k, itop, ibtc - real(kind_phys) :: tem0d, tem1, tem2 - real(kind_phys),dimension(nCol,nLev) :: hlwc - - ! Initialize CCPP error handling variables - errmsg = '' - errflg = 0 - - if (.not. lslwr) return - ! ####################################################################################### - ! Compute LW heating-rates. - ! ####################################################################################### - ! Clear-sky heating-rate (optional) - if (do_lw_clrsky_hr) then - call check_error_msg('GFS_rrtmgp_post',compute_heating_rate( & - fluxlwUP_clrsky, & ! IN - RRTMGP upward longwave clear-sky flux profiles (W/m2) - fluxlwDOWN_clrsky, & ! IN - RRTMGP downward longwave clear-sky flux profiles (W/m2) - p_lev, & ! IN - Pressure @ layer-interfaces (Pa) - htrlwc)) ! OUT - Longwave clear-sky heating rate (K/sec) - endif - - ! All-sky heating-rate (mandatory) - call check_error_msg('GFS_rrtmgp_post',compute_heating_rate( & - fluxlwUP_allsky, & ! IN - RRTMGP upward longwave all-sky flux profiles (W/m2) - fluxlwDOWN_allsky, & ! IN - RRTMGP downward longwave all-sky flux profiles (W/m2) - p_lev, & ! IN - Pressure @ layer-interfaces (Pa) - htrlw)) ! OUT - Longwave all-sky heating rate (K/sec) - - ! ####################################################################################### - ! Save LW outputs. - ! (Copy fluxes from RRTMGP types into model radiation types.) - ! ####################################################################################### - ! TOA fluxes - topflw(:)%upfxc = fluxlwUP_allsky(:,iTOA) - topflw(:)%upfx0 = fluxlwUP_clrsky(:,iTOA) - - ! Surface fluxes - sfcflw(:)%upfxc = fluxlwUP_allsky(:,iSFC) - sfcflw(:)%upfx0 = fluxlwUP_clrsky(:,iSFC) - sfcflw(:)%dnfxc = fluxlwDOWN_allsky(:,iSFC) - sfcflw(:)%dnfx0 = fluxlwDOWN_clrsky(:,iSFC) - - ! Save surface air temp for diurnal adjustment at model t-steps - tsflw (:) = tsfa(:) - - ! Radiation fluxes for other physics processes - sfcdlw(:) = sfcflw(:)%dnfxc - sfculw(:) = sfcflw(:)%upfxc - - ! Heating-rate at radiation timestep, used for adjustment between radiation calls. - htrlwu = htrlw - - ! ####################################################################################### - ! Save LW diagnostics - ! - For time averaged output quantities (including total-sky and clear-sky SW and LW - ! fluxes at TOA and surface; conventional 3-domain cloud amount, cloud top and base - ! pressure, and cloud top temperature; aerosols AOD, etc.), store computed results in - ! corresponding slots of array fluxr with appropriate time weights. - ! - Collect the fluxr data for wrtsfc - ! ####################################################################################### - if (save_diag) then - do i=1,nCol - ! LW all-sky fluxes - fluxr(i,1 ) = fluxr(i,1 ) + fhlwr * fluxlwUP_allsky( i,iTOA) ! total sky top lw up - fluxr(i,19) = fluxr(i,19) + fhlwr * fluxlwDOWN_allsky(i,iSFC) ! total sky sfc lw dn - fluxr(i,20) = fluxr(i,20) + fhlwr * fluxlwUP_allsky( i,iSFC) ! total sky sfc lw up - ! LW clear-sky fluxes - fluxr(i,28) = fluxr(i,28) + fhlwr * fluxlwUP_clrsky( i,iTOA) ! clear sky top lw up - fluxr(i,30) = fluxr(i,30) + fhlwr * fluxlwDOWN_clrsky(i,iSFC) ! clear sky sfc lw dn - fluxr(i,33) = fluxr(i,33) + fhlwr * fluxlwUP_clrsky( i,iSFC) ! clear sky sfc lw up - enddo - - ! Save cld frac,toplyr,botlyr and top temp, note that the order of h,m,l cloud is reversed for - ! the fluxr output. save interface pressure (pa) of top/bot - do j = 1, 3 - do i = 1, nCol - tem0d = raddt * cldsa(i,j) - itop = mtopa(i,j) - ibtc = mbota(i,j) - - ! Add optical depth and emissivity output - tem2 = 0. - do k=ibtc,itop - tem2 = tem2 + cldtaulw(i,k) ! approx 10. mu channel - enddo - fluxr(i,46-j) = fluxr(i,46-j) + tem0d * (1.0-exp(-tem2)) - enddo - enddo - endif - - end subroutine GFS_rrtmgp_lw_post_run - -end module GFS_rrtmgp_lw_post diff --git a/physics/GFS_rrtmgp_lw_post.meta b/physics/GFS_rrtmgp_lw_post.meta deleted file mode 100644 index d458b25f3..000000000 --- a/physics/GFS_rrtmgp_lw_post.meta +++ /dev/null @@ -1,253 +0,0 @@ -[ccpp-table-properties] - name = GFS_rrtmgp_lw_post - type = scheme - dependencies = iounitdef.f,machine.F,radiation_aerosols.f,radlw_param.f,rte-rrtmgp/extensions/mo_fluxes_byband.F90,radiation_tools.F90,rte-rrtmgp/rte/mo_fluxes.F90,rte-rrtmgp/rte/kernels/mo_fluxes_broadband_kernels.F90,rte-rrtmgp/extensions/mo_heating_rates.F90 - -######################################################################## -[ccpp-arg-table] - name = GFS_rrtmgp_lw_post_run - type = scheme -[nCol] - standard_name = horizontal_loop_extent - long_name = horizontal loop extent - units = count - dimensions = () - type = integer - intent = in -[nLev] - standard_name = vertical_layer_dimension - long_name = number of vertical levels - units = count - dimensions = () - type = integer - intent = in -[iSFC] - standard_name = vertical_index_for_surface_in_RRTMGP - long_name = index for surface layer in RRTMGP - units = flag - dimensions = () - type = integer - intent = in -[iTOA] - standard_name = vertical_index_for_TOA_in_RRTMGP - long_name = index for TOA layer in RRTMGP - units = flag - dimensions = () - type = integer - intent = in -[lslwr] - standard_name = flag_for_calling_longwave_radiation - long_name = logical flags for lw radiation calls - units = flag - dimensions = () - type = logical - intent = in -[do_lw_clrsky_hr] - standard_name = flag_for_output_of_tendency_of_air_temperature_due_to_longwave_heating_on_radiation_timestep_assuming_clear_sky - long_name = flag to output lw heating rate - units = flag - dimensions = () - type = logical - intent = in -[save_diag] - standard_name = flag_for_diagnostics - long_name = logical flag for storing diagnostics - units = flag - dimensions = () - type = logical - intent = in -[fhlwr] - standard_name = period_of_longwave_radiation_calls - long_name = frequency for longwave radiation - units = s - dimensions = () - type = real - kind = kind_phys - intent = in -[tsfa] - standard_name = surface_air_temperature_for_radiation - long_name = lowest model layer air temperature for radiation - units = K - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in -[t_lay] - standard_name = air_temperature_at_layer_for_RRTMGP - long_name = air temperature at vertical layer for radiation calculation - units = K - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = in -[p_lev] - standard_name = air_pressure_at_interface_for_RRTMGP - long_name = air pressure level - units = Pa - dimensions = (horizontal_loop_extent,vertical_interface_dimension) - type = real - kind = kind_phys - intent = in -[fluxlwUP_allsky] - standard_name = RRTMGP_lw_flux_profile_upward_allsky - long_name = RRTMGP upward longwave all-sky flux profile - units = W m-2 - dimensions = (horizontal_loop_extent,vertical_interface_dimension) - type = real - kind = kind_phys - intent = in -[fluxlwDOWN_allsky] - standard_name = RRTMGP_lw_flux_profile_downward_allsky - long_name = RRTMGP downward longwave all-sky flux profile - units = W m-2 - dimensions = (horizontal_loop_extent,vertical_interface_dimension) - type = real - kind = kind_phys - intent = in -[fluxlwUP_clrsky] - standard_name = RRTMGP_lw_flux_profile_upward_clrsky - long_name = RRTMGP upward longwave clr-sky flux profile - units = W m-2 - dimensions = (horizontal_loop_extent,vertical_interface_dimension) - type = real - kind = kind_phys - intent = in -[fluxlwDOWN_clrsky] - standard_name = RRTMGP_lw_flux_profile_downward_clrsky - long_name = RRTMGP downward longwave clr-sky flux profile - units = W m-2 - dimensions = (horizontal_loop_extent,vertical_interface_dimension) - type = real - kind = kind_phys - intent = in -[raddt] - standard_name = time_step_for_radiation - long_name = radiation time step - units = s - dimensions = () - type = real - kind = kind_phys - intent = in -[cldsa] - standard_name = cloud_area_fraction_for_radiation - long_name = fraction of clouds for low, middle, high, total and BL - units = frac - dimensions = (horizontal_loop_extent,5) - type = real - kind = kind_phys - intent = in -[mtopa] - standard_name = model_layer_number_at_cloud_top - long_name = vertical indices for low, middle and high cloud tops - units = index - dimensions = (horizontal_loop_extent,3) - type = integer - intent = in -[mbota] - standard_name = model_layer_number_at_cloud_base - long_name = vertical indices for low, middle and high cloud bases - units = index - dimensions = (horizontal_loop_extent,3) - type = integer - intent = in -[cld_frac] - standard_name = total_cloud_fraction - long_name = layer total cloud fraction - units = frac - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = in -[cldtaulw] - standard_name = cloud_optical_depth_layers_at_10mu_band - long_name = approx 10mu band layer cloud optical depth - units = none - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = in -[fluxr] - standard_name = cumulative_radiation_diagnostic - long_name = time-accumulated 2D radiation-related diagnostic fields - units = mixed - dimensions = (horizontal_loop_extent,number_of_diagnostics_variables_for_radiation) - type = real - kind = kind_phys - intent = inout -[sfcdlw] - standard_name = surface_downwelling_longwave_flux_on_radiation_timestep - long_name = total sky sfc downward lw flux - units = W m-2 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = inout -[sfculw] - standard_name = surface_upwelling_longwave_flux_on_radiation_timestep - long_name = total sky sfc upward lw flux - units = W m-2 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = inout -[sfcflw] - standard_name = surface_lw_fluxes_assuming_total_and_clear_sky_on_radiation_timestep - long_name = lw radiation fluxes at sfc - units = W m-2 - dimensions = (horizontal_loop_extent) - type = sfcflw_type - intent = inout -[tsflw] - standard_name = air_temperature_at_surface_adjacent_layer_on_radiation_timestep - long_name = surface air temp during lw calculation - units = K - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = inout -[htrlw] - standard_name = tendency_of_air_temperature_due_to_longwave_heating_on_radiation_timestep - long_name = total sky lw heating rate - units = K s-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = inout -[htrlwu] - standard_name = updated_tendency_of_air_temperature_due_to_longwave_heating_on_physics_timestep - long_name = total sky longwave heating rate on physics time step - units = K s-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = inout -[topflw] - standard_name = lw_fluxes_top_atmosphere - long_name = lw radiation fluxes at top - units = W m-2 - dimensions = (horizontal_loop_extent) - type = topflw_type - intent = out -[htrlwc] - standard_name = tendency_of_air_temperature_due_to_longwave_heating_assuming_clear_sky_on_radiation_timestep - long_name = longwave clear sky heating rate - units = K s-1 - dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) - type = real - kind = kind_phys - intent = inout -[errmsg] - standard_name = ccpp_error_message - long_name = error message for error handling in CCPP - units = none - dimensions = () - type = character - kind = len=* - intent = out -[errflg] - standard_name = ccpp_error_code - long_name = error code for error handling in CCPP - units = 1 - dimensions = () - type = integer - intent = out diff --git a/physics/GFS_rrtmgp_post.F90 b/physics/GFS_rrtmgp_post.F90 new file mode 100644 index 000000000..22fe2fc21 --- /dev/null +++ b/physics/GFS_rrtmgp_post.F90 @@ -0,0 +1,394 @@ +!> \file GFS_rrtmgp_post.F90 +!! +!> \defgroup GFS_rrtmgp_post GFS_rrtmgp_post.F90 +!! +!! \brief RRTMGP post-processing routine. +!! +module GFS_rrtmgp_post + use machine, only: kind_phys + use module_radlw_parameters, only: topflw_type, sfcflw_type + use module_radsw_parameters, only: topfsw_type, sfcfsw_type, cmpfsw_type + use mo_heating_rates, only: compute_heating_rate + use radiation_tools, only: check_error_msg + implicit none + + public GFS_rrtmgp_post_run + +contains + ! ######################################################################################## +!>\defgroup gfs_rrtmgp_post_mod GFS RRTMGP Post Module +!> \section arg_table_GFS_rrtmgp_post_run +!! \htmlinclude GFS_rrtmgp_post.html +!! +!! \ingroup GFS_rrtmgp_post +!! +!! \brief The all-sky radiation tendency is computed, the clear-sky tendency is computed +!! if requested. +!! +!! RRTMGP surface and TOA fluxes are copied to fields that persist between radiation/physics +!! calls. +!! +!! (optional) Save additional diagnostics. +!! +!! \section GFS_rrtmgp_post_run + ! ######################################################################################## + subroutine GFS_rrtmgp_post_run (nCol, nLev, nDay, iSFC, iTOA, idxday, doLWrad, doSWrad, & + do_lw_clrsky_hr, do_sw_clrsky_hr, save_diag, fhlwr, fhswr, sfc_alb_nir_dir, & + sfc_alb_nir_dif, sfc_alb_uvvis_dir, sfc_alb_uvvis_dif, p_lev, tsfa, coszen, coszdg, & + fluxlwDOWN_clrsky, fluxlwUP_allsky, fluxlwDOWN_allsky, fluxlwUP_clrsky, & + fluxswDOWN_clrsky, fluxswUP_allsky, fluxswDOWN_allsky, fluxswUP_clrsky, & + raddt, aerodp, cldsa, mtopa, mbota, cld_frac, cldtaulw, cldtausw, scmpsw, fluxr, & + sfcdlw, sfculw, sfcflw, tsflw, htrlw, htrlwu, topflw, nirbmdi, nirdfdi, visbmdi, & + visdfdi, nirbmui, nirdfui, visbmui, visdfui, sfcnsw, sfcdsw, htrsw, sfcfsw, topfsw, & + htrswc, htrlwc, errmsg, errflg) + + ! Inputs + integer, intent(in) :: & + nCol, & ! Horizontal loop extent + nLev, & ! Number of vertical layers + nDay, & ! Number of daylit columns + iSFC, & ! Vertical index for surface level + iTOA ! Vertical index for TOA level + integer, intent(in), dimension(:) :: & + idxday ! Index array for daytime points + integer, intent(in), dimension(:,:) :: & + mbota, & ! Vertical indices for low, middle and high cloud tops + mtopa ! ertical indices for low, middle and high cloud bases + logical, intent(in) :: & + doLWrad, & ! Logical flags for lw radiation calls + doSWrad, & ! Logical flags for sw radiation calls + do_lw_clrsky_hr, & ! Output clear-sky LW heating-rate? + do_sw_clrsky_hr, & ! Output clear-sky SW heating-rate? + save_diag ! Output radiation diagnostics? + real(kind_phys), intent(in) :: & + fhlwr, & ! Frequency for LW radiation calls + fhswr ! Frequency for SW radiation calls + real(kind_phys), dimension(:), intent(in) :: & + tsfa, & ! Lowest model layer air temperature for radiation (K) + coszen, & ! Cosine(SZA) + coszdg, & ! Cosine(SZA), daytime + 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) + real(kind_phys), dimension(:,:), intent(in) :: & + p_lev, & ! Pressure @ model layer-interfaces (Pa) + fluxlwUP_allsky, & ! RRTMGP longwave all-sky flux (W/m2) + fluxlwDOWN_allsky, & ! RRTMGP longwave all-sky flux (W/m2) + fluxlwUP_clrsky, & ! RRTMGP longwave clear-sky flux (W/m2) + fluxlwDOWN_clrsky, & ! RRTMGP longwave clear-sky flux (W/m2) + fluxswUP_allsky, & ! RRTMGP shortwave all-sky flux (W/m2) + fluxswDOWN_allsky, & ! RRTMGP shortwave all-sky flux (W/m2) + fluxswUP_clrsky, & ! RRTMGP shortwave clear-sky flux (W/m2) + fluxswDOWN_clrsky ! RRTMGP shortwave clear-sky flux (W/m2) + real(kind_phys), intent(in) :: & + raddt ! Radiation time step + real(kind_phys), dimension(:,:), intent(in) :: & + aerodp, & ! Vertical integrated optical depth for various aerosol species + cldsa, & ! Fraction of clouds for low, middle, high, total and BL + cld_frac, & ! Total cloud fraction in each layer + cldtaulw, & ! approx 10.mu band layer cloud optical depth + cldtausw ! approx .55mu band layer cloud optical depth + type(cmpfsw_type), dimension(:), intent(in) :: & + scmpsw ! 2D surface fluxes, components: + ! uvbfc - total sky downward uv-b flux at (W/m2) + ! uvbf0 - clear sky downward uv-b flux at (W/m2) + ! nirbm - downward nir direct beam flux (W/m2) + ! nirdf - downward nir diffused flux (W/m2) + ! visbm - downward uv+vis direct beam flux (W/m2) + ! visdf - downward uv+vis diffused flux (W/m2) + + + real(kind=kind_phys), dimension(:,:), intent(inout) :: fluxr + + ! Outputs (mandatory) + real(kind_phys), dimension(:), intent(inout) :: & + tsflw, & ! LW sfc air temp during calculation (K) + sfcdlw, & ! LW sfc all-sky downward flux (W/m2) + sfculw, & ! LW sfc all-sky upward flux (W/m2) + nirbmdi, & ! SW sfc nir beam downward flux (W/m2) + nirdfdi, & ! SW sfc nir diff downward flux (W/m2) + visbmdi, & ! SW sfc uv+vis beam downward flux (W/m2) + visdfdi, & ! SW sfc uv+vis diff downward flux (W/m2) + nirbmui, & ! SW sfc nir beam upward flux (W/m2) + nirdfui, & ! SW sfc nir diff upward flux (W/m2) + visbmui, & ! SW sfc uv+vis beam upward flux (W/m2) + visdfui, & ! SW sfc uv+vis diff upward flux (W/m2) + sfcnsw, & ! SW sfc all-sky net flux (W/m2) flux into ground + sfcdsw ! SW sfc all-sky downward flux (W/m2) + real(kind_phys), dimension(:,:), intent(inout) :: & + htrlw, & ! LW all-sky heating rate (K/s) + htrsw, & ! SW all-sky heating rate (K/s) + htrlwu ! LW all-sky heating-rate updated in-between radiation calls. + type(sfcflw_type), dimension(:), intent(inout) :: & + sfcflw ! LW radiation fluxes at sfc + type(sfcfsw_type), dimension(:), intent(inout) :: & + sfcfsw ! SW radiation fluxes at sfc + type(topfsw_type), dimension(:), intent(inout) :: & + topfsw ! SW fluxes at top atmosphere + type(topflw_type), dimension(:), intent(inout) :: & + topflw ! LW fluxes at top atmosphere + character(len=*), intent(out) :: & + errmsg ! CCPP error message + integer, intent(out) :: & + errflg ! CCPP error code + + ! Outputs (optional) + real(kind_phys),dimension(:,:),intent(inout),optional :: & + htrlwc, & ! LW clear-sky heating-rate (K/s) + htrswc ! SW clear-sky heating rate (K/s) + + ! Local variables + integer :: i, j, k, itop, ibtc + real(kind_phys) :: tem0d, tem1, tem2 + real(kind_phys), dimension(nDay, nLev) :: thetaTendClrSky, thetaTendAllSky + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + if (.not. (doLWrad .or. doSWrad)) return + + if (doLWRad) then + ! ####################################################################################### + ! Compute LW heating-rates. + ! ####################################################################################### + + ! Clear-sky heating-rate (optional) + if (do_lw_clrsky_hr) then + call check_error_msg('GFS_rrtmgp_post',compute_heating_rate( & + fluxlwUP_clrsky, & ! IN - RRTMGP upward longwave clear-sky flux profiles (W/m2) + fluxlwDOWN_clrsky, & ! IN - RRTMGP downward longwave clear-sky flux profiles (W/m2) + p_lev, & ! IN - Pressure @ layer-interfaces (Pa) + htrlwc)) ! OUT - Longwave clear-sky heating rate (K/sec) + endif + + ! All-sky heating-rate (mandatory) + call check_error_msg('GFS_rrtmgp_post',compute_heating_rate( & + fluxlwUP_allsky, & ! IN - RRTMGP upward longwave all-sky flux profiles (W/m2) + fluxlwDOWN_allsky, & ! IN - RRTMGP downward longwave all-sky flux profiles (W/m2) + p_lev, & ! IN - Pressure @ layer-interfaces (Pa) + htrlw)) ! OUT - Longwave all-sky heating rate (K/sec) + + ! ####################################################################################### + ! Save LW outputs. + ! (Copy fluxes from RRTMGP types into model radiation types.) + ! ####################################################################################### + ! TOA fluxes + + topflw(:)%upfxc = fluxlwUP_allsky(:,iTOA) + topflw(:)%upfx0 = fluxlwUP_clrsky(:,iTOA) + + ! Surface fluxes + sfcflw(:)%upfxc = fluxlwUP_allsky(:,iSFC) + sfcflw(:)%upfx0 = fluxlwUP_clrsky(:,iSFC) + sfcflw(:)%dnfxc = fluxlwDOWN_allsky(:,iSFC) + sfcflw(:)%dnfx0 = fluxlwDOWN_clrsky(:,iSFC) + + ! Save surface air temp for diurnal adjustment at model t-steps + tsflw (:) = tsfa(:) + + ! Radiation fluxes for other physics processes + sfcdlw(:) = sfcflw(:)%dnfxc + sfculw(:) = sfcflw(:)%upfxc + + ! Heating-rate at radiation timestep, used for adjustment between radiation calls. + htrlwu = htrlw + + ! ####################################################################################### + ! Save LW diagnostics + ! - For time averaged output quantities (including total-sky and clear-sky SW and LW + ! fluxes at TOA and surface; conventional 3-domain cloud amount, cloud top and base + ! pressure, and cloud top temperature; aerosols AOD, etc.), store computed results in + ! corresponding slots of array fluxr with appropriate time weights. + ! - Collect the fluxr data for wrtsfc + ! ####################################################################################### + if (save_diag) then + do i=1,nCol + ! LW all-sky fluxes + fluxr(i,1 ) = fluxr(i,1 ) + fhlwr * fluxlwUP_allsky( i,iTOA) ! total sky top lw up + fluxr(i,19) = fluxr(i,19) + fhlwr * fluxlwDOWN_allsky(i,iSFC) ! total sky sfc lw dn + fluxr(i,20) = fluxr(i,20) + fhlwr * fluxlwUP_allsky( i,iSFC) ! total sky sfc lw up + ! LW clear-sky fluxes + fluxr(i,28) = fluxr(i,28) + fhlwr * fluxlwUP_clrsky( i,iTOA) ! clear sky top lw up + fluxr(i,30) = fluxr(i,30) + fhlwr * fluxlwDOWN_clrsky(i,iSFC) ! clear sky sfc lw dn + fluxr(i,33) = fluxr(i,33) + fhlwr * fluxlwUP_clrsky( i,iSFC) ! clear sky sfc lw up + enddo + + ! Save cld frac,toplyr,botlyr and top temp, note that the order of h,m,l cloud is reversed for + ! the fluxr output. save interface pressure (pa) of top/bot + do j = 1, 3 + do i = 1, nCol + tem0d = raddt * cldsa(i,j) + itop = mtopa(i,j) + ibtc = mbota(i,j) + + ! Add optical depth and emissivity output + tem2 = 0. + do k=ibtc,itop + tem2 = tem2 + cldtaulw(i,k) ! approx 10. mu channel + enddo + fluxr(i,46-j) = fluxr(i,46-j) + tem0d * (1.0-exp(-tem2)) + enddo + enddo + endif + endif + ! ####################################################################################### + ! ####################################################################################### + ! ####################################################################################### + ! ####################################################################################### + ! ####################################################################################### + ! ####################################################################################### + if (doSWRad) then + if (nDay .gt. 0) then + ! ################################################################################# + ! Compute SW heating-rates + ! ################################################################################# + + ! Clear-sky heating-rate (optional) + if (do_sw_clrsky_hr) then + htrswc(:,:) = 0._kind_phys + call check_error_msg('GFS_rrtmgp_post',compute_heating_rate( & + fluxswUP_clrsky(idxday(1:nDay),:), & ! IN - Shortwave upward clear-sky flux profiles (W/m2) + fluxswDOWN_clrsky(idxday(1:nDay),:), & ! IN - Shortwave downward clear-sky flux profiles (W/m2) + p_lev(idxday(1:nDay),:), & ! IN - Pressure at model-interface (Pa) + thetaTendClrSky)) ! OUT - Clear-sky heating-rate (K/sec) + htrswc(idxday(1:nDay),:)=thetaTendClrSky !**NOTE** GP doesn't use radiation levels, it uses the model fields. Not sure if this is necessary + endif + + ! All-sky heating-rate (mandatory) + htrsw(:,:) = 0._kind_phys + call check_error_msg('GFS_rrtmgp_post',compute_heating_rate( & + fluxswUP_allsky(idxday(1:nDay),:), & ! IN - Shortwave upward all-sky flux profiles (W/m2) + fluxswDOWN_allsky(idxday(1:nDay),:), & ! IN - Shortwave downward all-sky flux profiles (W/m2) + p_lev(idxday(1:nDay),:), & ! IN - Pressure at model-interface (Pa) + thetaTendAllSky)) ! OUT - All-sky heating-rate (K/sec) + htrsw(idxday(1:nDay),:) = thetaTendAllSky + + ! ################################################################################# + ! Save SW outputs + ! (Copy fluxes from RRTMGP types into model radiation types.) + ! ################################################################################# + + ! TOA fluxes + topfsw(:)%upfxc = fluxswUP_allsky(:,iTOA) + topfsw(:)%upfx0 = fluxswUP_clrsky(:,iTOA) + topfsw(:)%dnfxc = fluxswDOWN_allsky(:,iTOA) + + ! Surface fluxes + sfcfsw(:)%upfxc = fluxswUP_allsky(:,iSFC) + sfcfsw(:)%upfx0 = fluxswUP_clrsky(:,iSFC) + sfcfsw(:)%dnfxc = fluxswDOWN_allsky(:,iSFC) + sfcfsw(:)%dnfx0 = fluxswDOWN_clrsky(:,iSFC) + + ! Surface down and up spectral component fluxes + ! - Save two spectral bands' surface downward and upward fluxes for output. + do i=1,nCol + nirbmdi(i) = scmpsw(i)%nirbm + nirdfdi(i) = scmpsw(i)%nirdf + visbmdi(i) = scmpsw(i)%visbm + visdfdi(i) = scmpsw(i)%visdf + nirbmui(i) = scmpsw(i)%nirbm * sfc_alb_nir_dir(i) + nirdfui(i) = scmpsw(i)%nirdf * sfc_alb_nir_dif(i) + visbmui(i) = scmpsw(i)%visbm * sfc_alb_uvvis_dir(i) + visdfui(i) = scmpsw(i)%visdf * sfc_alb_uvvis_dif(i) + enddo + else ! if_nday_block + ! ################################################################################# + ! Dark everywhere + ! ################################################################################# + htrsw(:,:) = 0.0 + sfcfsw = sfcfsw_type( 0.0, 0.0, 0.0, 0.0 ) + topfsw = topfsw_type( 0.0, 0.0, 0.0 ) + do i=1,nCol + nirbmdi(i) = 0.0 + nirdfdi(i) = 0.0 + visbmdi(i) = 0.0 + visdfdi(i) = 0.0 + nirbmui(i) = 0.0 + nirdfui(i) = 0.0 + visbmui(i) = 0.0 + visdfui(i) = 0.0 + enddo + + if (do_sw_clrsky_hr) then + htrswc(:,:) = 0 + endif + endif ! end_if_nday + + ! Radiation fluxes for other physics processes + do i=1,nCol + sfcnsw(i) = sfcfsw(i)%dnfxc - sfcfsw(i)%upfxc + sfcdsw(i) = sfcfsw(i)%dnfxc + enddo + + ! ################################################################################# + ! Save SW diagnostics + ! - For time averaged output quantities (including total-sky and clear-sky SW and LW + ! fluxes at TOA and surface; conventional 3-domain cloud amount, cloud top and base + ! pressure, and cloud top temperature; aerosols AOD, etc.), store computed results in + ! corresponding slots of array fluxr with appropriate time weights. + ! - Collect the fluxr data for wrtsfc + ! ################################################################################# + if (save_diag) then + do i=1,nCol + fluxr(i,34) = aerodp(i,1) ! total aod at 550nm + fluxr(i,35) = aerodp(i,2) ! DU aod at 550nm + fluxr(i,36) = aerodp(i,3) ! BC aod at 550nm + fluxr(i,37) = aerodp(i,4) ! OC aod at 550nm + fluxr(i,38) = aerodp(i,5) ! SU aod at 550nm + fluxr(i,39) = aerodp(i,6) ! SS aod at 550nm + if (coszen(i) > 0.) then + ! SW all-sky fluxes + tem0d = fhswr * coszdg(i) / coszen(i) + fluxr(i,2 ) = fluxr(i,2) + topfsw(i)%upfxc * tem0d ! total sky top sw up + fluxr(i,3 ) = fluxr(i,3) + sfcfsw(i)%upfxc * tem0d + fluxr(i,4 ) = fluxr(i,4) + sfcfsw(i)%dnfxc * tem0d ! total sky sfc sw dn + ! SW uv-b fluxes + fluxr(i,21) = fluxr(i,21) + scmpsw(i)%uvbfc * tem0d ! total sky uv-b sw dn + fluxr(i,22) = fluxr(i,22) + scmpsw(i)%uvbf0 * tem0d ! clear sky uv-b sw dn + ! SW TOA incoming fluxes + fluxr(i,23) = fluxr(i,23) + topfsw(i)%dnfxc * tem0d ! top sw dn + ! SW SFC flux components + fluxr(i,24) = fluxr(i,24) + visbmdi(i) * tem0d ! uv/vis beam sw dn + fluxr(i,25) = fluxr(i,25) + visdfdi(i) * tem0d ! uv/vis diff sw dn + fluxr(i,26) = fluxr(i,26) + nirbmdi(i) * tem0d ! nir beam sw dn + fluxr(i,27) = fluxr(i,27) + nirdfdi(i) * tem0d ! nir diff sw dn + ! SW clear-sky fluxes + fluxr(i,29) = fluxr(i,29) + topfsw(i)%upfx0 * tem0d + fluxr(i,31) = fluxr(i,31) + sfcfsw(i)%upfx0 * tem0d + fluxr(i,32) = fluxr(i,32) + sfcfsw(i)%dnfx0 * tem0d + endif + enddo + + ! Save total and boundary-layer clouds + do i=1,nCol + fluxr(i,17) = fluxr(i,17) + raddt * cldsa(i,4) + fluxr(i,18) = fluxr(i,18) + raddt * cldsa(i,5) + enddo + + ! Save cld frac,toplyr,botlyr and top temp, note that the order of h,m,l cloud + ! is reversed for the fluxr output. save interface pressure (pa) of top/bot + do j = 1, 3 + do i = 1, nCol + tem0d = raddt * cldsa(i,j) + itop = mtopa(i,j) + ibtc = mbota(i,j) + fluxr(i, 8-j) = fluxr(i, 8-j) + tem0d + fluxr(i,11-j) = fluxr(i,11-j) + tem0d * p_lev(i,itop) + fluxr(i,14-j) = fluxr(i,14-j) + tem0d * p_lev(i,ibtc) + fluxr(i,17-j) = fluxr(i,17-j) + tem0d * p_lev(i,itop) + + ! Add optical depth and emissivity output + tem1 = 0. + do k=ibtc,itop + tem1 = tem1 + cldtausw(i,k) ! approx .55 mu channel + enddo + fluxr(i,43-j) = fluxr(i,43-j) + tem0d * tem1 + enddo + enddo + endif + endif + + end subroutine GFS_rrtmgp_post_run +end module GFS_rrtmgp_post diff --git a/physics/GFS_rrtmgp_sw_post.meta b/physics/GFS_rrtmgp_post.meta similarity index 71% rename from physics/GFS_rrtmgp_sw_post.meta rename to physics/GFS_rrtmgp_post.meta index 7da3b10b0..e4bc3e5dc 100644 --- a/physics/GFS_rrtmgp_sw_post.meta +++ b/physics/GFS_rrtmgp_post.meta @@ -1,14 +1,13 @@ [ccpp-table-properties] - name = GFS_rrtmgp_sw_post + name = GFS_rrtmgp_post type = scheme - dependencies = iounitdef.f,machine.F,radiation_aerosols.f,radsw_param.f,rte-rrtmgp/extensions/mo_fluxes_byband.F90 - dependencies = rte-rrtmgp/rte/mo_fluxes.F90,rte-rrtmgp/rte/kernels/mo_fluxes_broadband_kernels.F90,rte-rrtmgp/extensions/mo_heating_rates.F90,radiation_tools.F90 + dependencies = iounitdef.f,machine.F,radiation_aerosols.f,radlw_param.f,radiation_tools.F90,rte-rrtmgp/extensions/mo_heating_rates.F90 ######################################################################## [ccpp-arg-table] - name = GFS_rrtmgp_sw_post_run + name = GFS_rrtmgp_post_run type = scheme -[ncol] +[nCol] standard_name = horizontal_loop_extent long_name = horizontal loop extent units = count @@ -50,7 +49,7 @@ dimensions = (horizontal_loop_extent) type = integer intent = in -[lsswr] +[doSWrad] standard_name = flag_for_calling_shortwave_radiation long_name = logical flags for sw radiation calls units = flag @@ -64,6 +63,20 @@ dimensions = () type = logical intent = in +[doLWrad] + standard_name = flag_for_calling_longwave_radiation + long_name = logical flags for lw radiation calls + units = flag + dimensions = () + type = logical + intent = in +[do_lw_clrsky_hr] + standard_name = flag_for_output_of_tendency_of_air_temperature_due_to_longwave_heating_on_radiation_timestep_assuming_clear_sky + long_name = flag to output lw heating rate + units = flag + dimensions = () + type = logical + intent = in [save_diag] standard_name = flag_for_diagnostics long_name = logical flag for storing diagnostics @@ -71,6 +84,14 @@ dimensions = () type = logical intent = in +[fhlwr] + standard_name = period_of_longwave_radiation_calls + long_name = frequency for longwave radiation + units = s + dimensions = () + type = real + kind = kind_phys + intent = in [fhswr] standard_name = period_of_shortwave_radiation_calls long_name = frequency for shortwave radiation @@ -95,22 +116,6 @@ type = real kind = kind_phys intent = in -[t_lay] - standard_name = air_temperature_at_layer_for_RRTMGP - long_name = air temperature at vertical layer for radiation calculation - units = K - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = in -[p_lev] - standard_name = air_pressure_at_interface_for_RRTMGP - long_name = air pressure level - units = Pa - dimensions = (horizontal_loop_extent,vertical_interface_dimension) - type = real - kind = kind_phys - intent = in [sfc_alb_nir_dir] standard_name = surface_albedo_due_to_near_IR_direct long_name = surface albedo due to near IR direct beam @@ -143,6 +148,54 @@ type = real kind = kind_phys intent = in +[tsfa] + standard_name = surface_air_temperature_for_radiation + long_name = lowest model layer air temperature for radiation + units = K + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in +[p_lev] + standard_name = air_pressure_at_interface_for_RRTMGP + long_name = air pressure level + units = Pa + dimensions = (horizontal_loop_extent,vertical_interface_dimension) + type = real + kind = kind_phys + intent = in +[fluxlwUP_allsky] + standard_name = RRTMGP_lw_flux_profile_upward_allsky + long_name = RRTMGP upward longwave all-sky flux profile + units = W m-2 + dimensions = (horizontal_loop_extent,vertical_interface_dimension) + type = real + kind = kind_phys + intent = in +[fluxlwDOWN_allsky] + standard_name = RRTMGP_lw_flux_profile_downward_allsky + long_name = RRTMGP downward longwave all-sky flux profile + units = W m-2 + dimensions = (horizontal_loop_extent,vertical_interface_dimension) + type = real + kind = kind_phys + intent = in +[fluxlwUP_clrsky] + standard_name = RRTMGP_lw_flux_profile_upward_clrsky + long_name = RRTMGP upward longwave clr-sky flux profile + units = W m-2 + dimensions = (horizontal_loop_extent,vertical_interface_dimension) + type = real + kind = kind_phys + intent = in +[fluxlwDOWN_clrsky] + standard_name = RRTMGP_lw_flux_profile_downward_clrsky + long_name = RRTMGP downward longwave clr-sky flux profile + units = W m-2 + dimensions = (horizontal_loop_extent,vertical_interface_dimension) + type = real + kind = kind_phys + intent = in [fluxswUP_allsky] standard_name = RRTMGP_sw_flux_profile_upward_allsky long_name = RRTMGP upward shortwave all-sky flux profile @@ -199,16 +252,16 @@ type = real kind = kind_phys intent = in -[mbota] - standard_name = model_layer_number_at_cloud_base - long_name = vertical indices for low, middle and high cloud bases +[mtopa] + standard_name = model_layer_number_at_cloud_top + long_name = vertical indices for low, middle and high cloud tops units = index dimensions = (horizontal_loop_extent,3) type = integer intent = in -[mtopa] - standard_name = model_layer_number_at_cloud_top - long_name = vertical indices for low, middle and high cloud tops +[mbota] + standard_name = model_layer_number_at_cloud_base + long_name = vertical indices for low, middle and high cloud bases units = index dimensions = (horizontal_loop_extent,3) type = integer @@ -221,6 +274,14 @@ type = real kind = kind_phys intent = in +[cldtaulw] + standard_name = cloud_optical_depth_layers_at_10mu_band + long_name = approx 10mu band layer cloud optical depth + units = none + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = in [cldtausw] standard_name = cloud_optical_depth_layers_at_0p55mu_band long_name = approx .55mu band layer cloud optical depth @@ -229,6 +290,13 @@ type = real kind = kind_phys intent = in +[scmpsw] + standard_name = components_of_surface_downward_shortwave_fluxes + long_name = derived type for special components of surface downward shortwave fluxes + units = W m-2 + dimensions = (horizontal_loop_extent) + type = cmpfsw_type + intent = in [fluxr] standard_name = cumulative_radiation_diagnostic long_name = time-accumulated 2D radiation-related diagnostic fields @@ -237,6 +305,60 @@ type = real kind = kind_phys intent = inout +[sfcdlw] + standard_name = surface_downwelling_longwave_flux_on_radiation_timestep + long_name = total sky sfc downward lw flux + units = W m-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout +[sfculw] + standard_name = surface_upwelling_longwave_flux_on_radiation_timestep + long_name = total sky sfc upward lw flux + units = W m-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout +[sfcflw] + standard_name = surface_lw_fluxes_assuming_total_and_clear_sky_on_radiation_timestep + long_name = lw radiation fluxes at sfc + units = W m-2 + dimensions = (horizontal_loop_extent) + type = sfcflw_type + intent = inout +[tsflw] + standard_name = air_temperature_at_surface_adjacent_layer_on_radiation_timestep + long_name = surface air temp during lw calculation + units = K + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout +[htrlw] + standard_name = tendency_of_air_temperature_due_to_longwave_heating_on_radiation_timestep + long_name = total sky lw heating rate + units = K s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout +[htrlwu] + standard_name = updated_tendency_of_air_temperature_due_to_longwave_heating_on_physics_timestep + long_name = total sky longwave heating rate on physics time step + units = K s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout +[topflw] + standard_name = lw_fluxes_top_atmosphere + long_name = lw radiation fluxes at top + units = W m-2 + dimensions = (horizontal_loop_extent) + type = topflw_type + intent = inout [nirbmdi] standard_name = surface_downwelling_direct_nir_shortwave_flux_on_radiation_timestep long_name = sfc nir beam sw downward flux @@ -347,12 +469,13 @@ type = real kind = kind_phys intent = inout -[scmpsw] - standard_name = components_of_surface_downward_shortwave_fluxes - long_name = derived type for special components of surface downward shortwave fluxes - units = W m-2 - dimensions = (horizontal_loop_extent) - type = cmpfsw_type +[htrlwc] + standard_name = tendency_of_air_temperature_due_to_longwave_heating_assuming_clear_sky_on_radiation_timestep + long_name = longwave clear sky heating rate + units = K s-1 + dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) + type = real + kind = kind_phys intent = inout [errmsg] standard_name = ccpp_error_message diff --git a/physics/GFS_rrtmgp_pre.F90 b/physics/GFS_rrtmgp_pre.F90 index f68cdf000..009eb8c38 100644 --- a/physics/GFS_rrtmgp_pre.F90 +++ b/physics/GFS_rrtmgp_pre.F90 @@ -11,6 +11,7 @@ module GFS_rrtmgp_pre use module_radiation_gases, only: NF_VGAS, getgases, getozn use mo_gas_concentrations, only: ty_gas_concs use radiation_tools, only: check_error_msg,cmp_tlev + use rrtmgp_lw_gas_optics, only: lw_gas_props implicit none @@ -20,6 +21,9 @@ module GFS_rrtmgp_pre amo3 = 47.9982_kind_phys, & !< Modelular weight of ozone (g/mol) amdw = amd/amw, & !< Molecular weight of dry air / water vapor amdo3 = amd/amo3 !< Molecular weight of dry air / ozone + real(kind_phys), parameter :: eps = 1.0e-6_kind_phys + real(kind_phys), parameter :: oneminus = 1.0_kind_phys - eps + real(kind_phys), parameter :: ftiny = 1.0e-12_kind_phys ! Save trace gas indices. integer :: iStr_h2o, iStr_co2, iStr_o3, iStr_n2o, iStr_ch4, iStr_o2, iStr_ccl4, & @@ -106,32 +110,26 @@ end subroutine GFS_rrtmgp_pre_init !! !! \section GFS_rrtmgp_pre_run ! ######################################################################################### - subroutine GFS_rrtmgp_pre_run(me, nCol, nLev, nTracers, i_o3, lsswr, lslwr, fhswr, fhlwr, & + subroutine GFS_rrtmgp_pre_run(me, nCol, nLev, i_o3, doSWrad, doLWrad, fhswr, fhlwr, & xlat, xlon, prsl, tgrs, prslk, prsi, qgrs, tsfc, coslat, sinlat, con_g, con_rd, & - con_eps, con_epsm1, con_fvirt, con_epsqs, solhr, minGPpres, maxGPpres, minGPtemp, & - maxGPtemp, raddt, p_lay, t_lay, p_lev, t_lev, tsfg, tsfa, qs_lay, q_lay, tv_lay, & - relhum, tracer, deltaZ, deltaZc, deltaP, active_gases_array, gas_concentrations, & - tsfc_radtime, coszen, coszdg, top_at_1, iSFC, iTOA, ico2, con_pi, errmsg, errflg) + con_eps, con_epsm1, con_fvirt, con_epsqs, solhr, raddt, p_lay, t_lay, p_lev, t_lev, & + vmr_o2, vmr_h2o, vmr_o3, vmr_ch4, & + vmr_n2o, vmr_co2, tsfg, tsfa, qs_lay, q_lay, tv_lay, & + relhum, deltaZ, deltaZc, deltaP, active_gases_array, & + tsfc_radtime, coszen, coszdg, top_at_1, iSFC, iTOA, nDay, idxday, semis, & + sfc_emiss_byband, ico2, con_pi, errmsg, errflg) ! Inputs integer, intent(in) :: & - me, & ! Current MPI rank + me, & ! MPI rank nCol, & ! Number of horizontal grid points nLev, & ! Number of vertical layers - nTracers, & ! Number of tracers from model. - i_o3, & ! Index into tracer array for ozone - ico2, & ! Flag for co2 radiation scheme - iSFC, & ! Vertical index for surface - iTOA ! Vertical index for TOA + ico2, & ! Flag for co2 radiation scheme + i_o3 ! Index into tracer array for ozone logical, intent(in) :: & - top_at_1, & ! Vertical ordering flag - lsswr, & ! Call SW radiation? - lslwr ! Call LW radiation + doSWrad, & ! Call SW radiation? + doLWrad ! Call LW radiation real(kind_phys), intent(in) :: & - minGPtemp, & ! Minimum temperature allowed in RRTMGP. - maxGPtemp, & ! Maximum ... - minGPpres, & ! Minimum pressure allowed in RRTMGP. - maxGPpres, & ! Maximum pressure allowed in RRTMGP. fhswr, & ! Frequency of SW radiation call. fhlwr ! Frequency of LW radiation call. real(kind_phys), intent(in) :: & @@ -148,7 +146,8 @@ subroutine GFS_rrtmgp_pre_run(me, nCol, nLev, nTracers, i_o3, lsswr, lslwr, fhsw xlat, & ! Latitude tsfc, & ! Surface skin temperature (K) coslat, & ! Cosine(latitude) - sinlat ! Sine(latitude) + sinlat, & ! Sine(latitude) + semis real(kind_phys), dimension(:,:), intent(in) :: & prsl, & ! Pressure at model-layer centers (Pa) tgrs, & ! Temperature at model-layer centers (K) @@ -163,7 +162,13 @@ subroutine GFS_rrtmgp_pre_run(me, nCol, nLev, nTracers, i_o3, lsswr, lslwr, fhsw character(len=*), intent(out) :: & errmsg ! Error message integer, intent(out) :: & - errflg ! Error flag + errflg, & ! Error flag + nDay + integer, intent(inout) :: & + iSFC, & ! Vertical index for surface + iTOA ! Vertical index for TOA + logical, intent(inout) :: & + top_at_1 ! Vertical ordering flag real(kind_phys), intent(inout) :: & raddt ! Radiation time-step real(kind_phys), dimension(:), intent(inout) :: & @@ -172,6 +177,8 @@ subroutine GFS_rrtmgp_pre_run(me, nCol, nLev, nTracers, i_o3, lsswr, lslwr, fhsw tsfc_radtime, & ! Surface temperature at radiation timestep coszen, & ! Cosine of SZA coszdg ! Cosine of SZA, daytime + integer, dimension(:), intent(inout) :: & + idxday ! Indices for daylit points real(kind_phys), dimension(:,:), intent(inout) :: & p_lay, & ! Pressure at model-layer t_lay, & ! Temperature at model layer @@ -183,15 +190,12 @@ subroutine GFS_rrtmgp_pre_run(me, nCol, nLev, nTracers, i_o3, lsswr, lslwr, fhsw deltaZc, & ! Layer thickness (m) (between layer centers) deltaP, & ! Layer thickness (Pa) p_lev, & ! Pressure at model-interface - t_lev ! Temperature at model-interface - real(kind_phys), dimension(:,:,:),intent(inout) :: & - tracer ! Array containing trace gases - type(ty_gas_concs), intent(inout) :: & - gas_concentrations ! RRTMGP DDT: gas volumne mixing ratios + sfc_emiss_byband, & ! + t_lev, & ! Temperature at model-interface + vmr_o2, vmr_h2o, vmr_o3, vmr_ch4, vmr_n2o, vmr_co2 ! Local variables integer :: i, j, iCol, iBand, iLay, iLev, iSFC_ilev - real(kind_phys),dimension(nCol,nLev) :: vmr_o3, vmr_h2o real(kind_phys) :: es, tem1, tem2, pfac real(kind_phys), dimension(nLev+1) :: hgtb real(kind_phys), dimension(nLev) :: hgtc @@ -202,8 +206,24 @@ subroutine GFS_rrtmgp_pre_run(me, nCol, nLev, nTracers, i_o3, lsswr, lslwr, fhsw ! Initialize CCPP error handling variables errmsg = '' errflg = 0 - - if (.not. (lsswr .or. lslwr)) return + + nday = 0 + idxday = 0 + if (.not. (doSWrad .or. doLWrad)) return + + ! ####################################################################################### + ! What is vertical ordering? + ! ####################################################################################### + top_at_1 = (prsi(1,1) .lt. prsi(1, nLev)) + if (top_at_1) then + iSFC = nLev + iTOA = 1 + iSFC_ilev = iSFC + 1 + else + iSFC = 1 + iTOA = nLev + iSFC_ilev = 1 + endif ! ####################################################################################### ! Compute some fields needed by RRTMGP @@ -225,27 +245,29 @@ subroutine GFS_rrtmgp_pre_run(me, nCol, nLev, nTracers, i_o3, lsswr, lslwr, fhsw ! Bound temperature/pressure at layer centers. do iLay=1,nLev do iCol=1,NCOL - if (t_lay(iCol,iLay) .le. minGPtemp) then - t_lay(iCol,iLay) = minGPtemp + epsilon(minGPtemp) + if (t_lay(iCol,iLay) .le. lw_gas_props%get_temp_min()) then + t_lay(iCol,iLay) = lw_gas_props%get_temp_min() + epsilon(lw_gas_props%get_temp_min()) endif - if (p_lay(iCol,iLay) .le. minGPpres) then - p_lay(iCol,iLay) = minGPpres + epsilon(minGPpres) + if (p_lay(iCol,iLay) .le. lw_gas_props%get_press_min()) then + p_lay(iCol,iLay) = lw_gas_props%get_press_min() + epsilon(lw_gas_props%get_press_min()) endif - if (t_lay(iCol,iLay) .ge. maxGPtemp) then - t_lay(iCol,iLay) = maxGPtemp - epsilon(maxGPtemp) + if (t_lay(iCol,iLay) .ge. lw_gas_props%get_temp_max()) then + t_lay(iCol,iLay) = lw_gas_props%get_temp_max() - epsilon(lw_gas_props%get_temp_max()) endif - if (p_lay(iCol,iLay) .ge. maxGPpres) then - p_lay(iCol,iLay) = maxGPpres - epsilon(maxGPpres) + if (p_lay(iCol,iLay) .ge. lw_gas_props%get_press_max()) then + p_lay(iCol,iLay) = lw_gas_props%get_press_max() - epsilon(lw_gas_props%get_press_max()) endif enddo enddo ! Temperature at layer-interfaces - call cmp_tlev(nCol,nLev,minGPpres,p_lay,t_lay,p_lev,tsfc,t_lev) + call cmp_tlev(nCol,nLev,lw_gas_props%get_press_min(),p_lay,t_lay,p_lev,tsfc,t_lev) do iLev=1,nLev+1 do iCol=1,nCol - if (t_lev(iCol,iLev) .le. minGPtemp) t_lev(iCol,iLev) = minGPtemp + epsilon(minGPtemp) - if (t_lev(iCol,iLev) .ge. maxGPtemp) t_lev(iCol,iLev) = maxGPtemp - epsilon(maxGPtemp) + if (t_lev(iCol,iLev) .le. lw_gas_props%get_temp_min()) t_lev(iCol,iLev) = & + lw_gas_props%get_temp_min() + epsilon(lw_gas_props%get_temp_min()) + if (t_lev(iCol,iLev) .ge. lw_gas_props%get_temp_max()) t_lev(iCol,iLev) = & + lw_gas_props%get_temp_max() - epsilon(lw_gas_props%get_temp_max()) enddo enddo @@ -319,16 +341,11 @@ subroutine GFS_rrtmgp_pre_run(me, nCol, nLev, nTracers, i_o3, lsswr, lslwr, fhsw ! ####################################################################################### ! Get layer ozone mass mixing ratio ! ####################################################################################### - ! First recast remaining all tracers (except sphum) forcing them all to be positive - do j = 2, nTracers - tracer(1:NCOL,:,j) = qgrs(1:NCOL,:,j) - where(tracer(:,:,j) .lt. 0.0) tracer(:,:,j) = 0._kind_phys - enddo if (i_o3 > 0) then do iLay=1,nlev do iCol=1,NCOL - o3_lay(iCol,iLay) = max( con_epsqs, tracer(iCol,iLay,i_o3) ) + o3_lay(iCol,iLay) = max( con_epsqs, qgrs(iCol,iLay,i_o3) ) enddo enddo ! OR Use climatological ozone data @@ -341,21 +358,14 @@ subroutine GFS_rrtmgp_pre_run(me, nCol, nLev, nTracers, i_o3, lsswr, lslwr, fhsw ! ####################################################################################### ! Call getgases(), to set up non-prognostic gas volume mixing ratios (gas_vmr). call getgases (p_lev/100., xlon, xlat, nCol, nLev, ico2, top_at_1, con_pi, gas_vmr) + vmr_o2 = gas_vmr(:,:,4) + vmr_ch4 = gas_vmr(:,:,3) + vmr_n2o = gas_vmr(:,:,2) + vmr_co2 = gas_vmr(:,:,1) ! Compute volume mixing-ratios for ozone (mmr) and specific-humidity. vmr_h2o = merge((q_lay/(1-q_lay))*amdw, 0., q_lay .ne. 1.) vmr_o3 = merge(o3_lay*amdo3, 0., o3_lay .gt. 0.) - - ! Populate RRTMGP DDT w/ gas-concentrations - gas_concentrations%ncol = nCol - gas_concentrations%nlay = nLev - gas_concentrations%gas_name(:) = active_gases_array(:) - gas_concentrations%concs(istr_o2)%conc(:,:) = gas_vmr(:,:,4) - gas_concentrations%concs(istr_co2)%conc(:,:) = gas_vmr(:,:,1) - gas_concentrations%concs(istr_ch4)%conc(:,:) = gas_vmr(:,:,3) - gas_concentrations%concs(istr_n2o)%conc(:,:) = gas_vmr(:,:,2) - gas_concentrations%concs(istr_h2o)%conc(:,:) = vmr_h2o(:,:) - gas_concentrations%concs(istr_o3)%conc(:,:) = vmr_o3(:,:) ! ####################################################################################### ! Radiation time step (output) (Is this really needed?) (Used by some diagnostics) @@ -374,10 +384,29 @@ subroutine GFS_rrtmgp_pre_run(me, nCol, nLev, nTracers, i_o3, lsswr, lslwr, fhsw ! ####################################################################################### ! Compute cosine of zenith angle (only when SW is called) ! ####################################################################################### - if (lsswr) then + if (doSWrad) then call coszmn (xlon, sinlat, coslat, solhr, nCol, me, coszen, coszdg) + ! For SW gather daylit points + nday = 0 + idxday = 0 + do iCol = 1, nCol + if (coszen(iCol) >= 0.0001) then + nday = nday + 1 + idxday(nday) = iCol + endif + enddo + else + nday = 0 + idxday = 0 endif + ! ####################################################################################### + ! Surface emissivity + ! ####################################################################################### + do iBand=1,lw_gas_props%get_nband() + sfc_emiss_byband(iBand,:) = semis + enddo + end subroutine GFS_rrtmgp_pre_run end module GFS_rrtmgp_pre diff --git a/physics/GFS_rrtmgp_pre.meta b/physics/GFS_rrtmgp_pre.meta index 1c269af0f..abb07b825 100644 --- a/physics/GFS_rrtmgp_pre.meta +++ b/physics/GFS_rrtmgp_pre.meta @@ -72,21 +72,14 @@ dimensions = () type = integer intent = in -[nTracers] - standard_name = number_of_tracers - long_name = number of tracers - units = count - dimensions = () - type = integer - intent = in -[lsswr] +[doSWrad] standard_name = flag_for_calling_shortwave_radiation long_name = logical flags for sw radiation calls units = flag dimensions = () type = logical intent = in -[lslwr] +[doLWrad] standard_name = flag_for_calling_longwave_radiation long_name = logical flags for lw radiation calls units = flag @@ -260,38 +253,6 @@ type = real kind = kind_phys intent = in -[minGPpres] - standard_name = minimum_pressure_in_RRTMGP - long_name = minimum pressure allowed in RRTMGP - units = Pa - dimensions = () - type = real - kind = kind_phys - intent = in -[maxGPpres] - standard_name = maximum_pressure_in_RRTMGP - long_name = maximum pressure allowed in RRTMGP - units = Pa - dimensions = () - type = real - kind = kind_phys - intent = in -[minGPtemp] - standard_name = minimum_temperature_in_RRTMGP - long_name = minimum temperature allowed in RRTMGP - units = K - dimensions = () - type = real - kind = kind_phys - intent = in -[maxGPtemp] - standard_name = maximum_temperature_in_RRTMGP - long_name = maximum temperature allowed in RRTMGP - units = K - dimensions = () - type = real - kind = kind_phys - intent = in [ico2] standard_name = control_for_co2 long_name = prescribed global mean value (old opernl) @@ -369,21 +330,21 @@ units = flag dimensions = () type = logical - intent = in + intent = inout [iSFC] standard_name = vertical_index_for_surface_in_RRTMGP long_name = index for surface layer in RRTMGP units = flag dimensions = () type = integer - intent = in + intent = inout [iTOA] standard_name = vertical_index_for_TOA_in_RRTMGP long_name = index for TOA layer in RRTMGP units = flag dimensions = () type = integer - intent = in + intent = inout [tsfc_radtime] standard_name = surface_skin_temperature_on_radiation_timestep long_name = surface skin temperature on radiation timestep @@ -440,11 +401,51 @@ type = real kind = kind_phys intent = inout -[tracer] - standard_name = chemical_tracers - long_name = chemical tracers - units = g g-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_tracers) +[vmr_o2] + standard_name = volume_mixing_ratio_for_o2 + long_name = molar mixing ratio of o2 in with respect to dry air + units = 1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout +[vmr_h2o] + standard_name = volume_mixing_ratio_for_h2o + long_name = molar mixing ratio of h2o in with respect to dry air + units = 1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout +[vmr_o3] + standard_name = volume_mixing_ratio_for_o3 + long_name = molar mixing ratio of o3 in with respect to dry air + units = 1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout +[vmr_ch4] + standard_name = volume_mixing_ratio_for_ch4 + long_name = molar mixing ratio of ch4 in with respect to dry air + units = 1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout +[vmr_n2o] + standard_name = volume_mixing_ratio_for_n2o + long_name = molar mixing ratio of n2o in with respect to dry air + units = 1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout +[vmr_co2] + standard_name = volume_mixing_ratio_for_co2 + long_name = molar mixing ratio of co2 in with respect to dry air + units = 1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys intent = inout @@ -456,13 +457,6 @@ type = character kind = len=* intent = in -[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 = inout [coszdg] standard_name = cosine_of_solar_zenith_angle_on_radiation_timestep long_name = daytime mean cosz over rad call period @@ -479,6 +473,36 @@ type = real kind = kind_phys intent = inout +[semis] + standard_name = surface_longwave_emissivity + long_name = surface lw emissivity in fraction + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in +[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_longwave_bands,horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout +[nday] + standard_name = daytime_points_dimension + long_name = daytime points dimension + units = count + dimensions = () + type = integer + intent = inout +[idxday] + standard_name = daytime_points + long_name = daytime points + units = index + dimensions = (horizontal_loop_extent) + type = integer + intent = inout [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/GFS_rrtmgp_setup.F90 b/physics/GFS_rrtmgp_setup.F90 index ad1d05cf8..76db14279 100644 --- a/physics/GFS_rrtmgp_setup.F90 +++ b/physics/GFS_rrtmgp_setup.F90 @@ -146,7 +146,7 @@ end subroutine GFS_rrtmgp_setup_init !> \section arg_table_GFS_rrtmgp_setup_timestep_init !! \htmlinclude GFS_rrtmgp_setup_timestep_init.html !! - subroutine GFS_rrtmgp_setup_timestep_init (idate, jdate, deltsw, deltim, lsswr, me, & + subroutine GFS_rrtmgp_setup_timestep_init (idate, jdate, deltsw, deltim, doSWrad, me, & iaermdl, aeros_file, isol, slag, sdec, cdec, solcon, con_pi, co2dat_file, & co2gbl_file, ictm, ico2, ntoz, errmsg, errflg) @@ -155,8 +155,8 @@ subroutine GFS_rrtmgp_setup_timestep_init (idate, jdate, deltsw, deltim, lsswr, integer, intent(in) :: jdate(:) real(kind_phys), intent(in) :: deltsw real(kind_phys), intent(in) :: deltim + logical, intent(in) :: doSWrad real(kind_phys), intent(in) :: con_pi - logical, intent(in) :: lsswr integer, intent(in) :: me integer, intent(in) :: iaermdl,isol,ictm,ico2,ntoz character(len=26), intent(in) :: aeros_file,co2dat_file,co2gbl_file @@ -216,7 +216,7 @@ subroutine GFS_rrtmgp_setup_timestep_init (idate, jdate, deltsw, deltim, lsswr, endif ! Update solar forcing... - if (lsswr) then + if (doSWrad) then if ( isol == 0 .or. isol == 10 ) then lsol_chg = .false. elseif ( iyear0 /= iyear ) then diff --git a/physics/GFS_rrtmgp_setup.meta b/physics/GFS_rrtmgp_setup.meta index 2bba14506..c4f7cfaa5 100644 --- a/physics/GFS_rrtmgp_setup.meta +++ b/physics/GFS_rrtmgp_setup.meta @@ -330,7 +330,7 @@ type = real kind = kind_phys intent = in -[lsswr] +[doSWrad] standard_name = flag_for_calling_shortwave_radiation long_name = logical flags for sw radiation calls units = flag diff --git a/physics/GFS_rrtmgp_sw_post.F90 b/physics/GFS_rrtmgp_sw_post.F90 deleted file mode 100644 index 87ddc719b..000000000 --- a/physics/GFS_rrtmgp_sw_post.F90 +++ /dev/null @@ -1,286 +0,0 @@ -!> \file GFS_rrtmgp_sw_post.F90 -!! -!> \defgroup GFS_rrtmgp_sw_post GFS_rrtmgp_sw_post.F90 -!! -!! \brief RRTMGP Shortwave post-processing routine. -!! -module GFS_rrtmgp_sw_post - use machine, only: kind_phys - use module_radiation_aerosols, only: NSPC1 - use module_radsw_parameters, only: topfsw_type, sfcfsw_type, cmpfsw_type - use mo_heating_rates, only: compute_heating_rate - use radiation_tools, only: check_error_msg - use rrtmgp_sw_gas_optics, only: sw_gas_props - implicit none - - public GFS_rrtmgp_sw_post_run - -contains - -!>\defgroup gfs_rrtmgp_sw_post_mod GFS RRTMGP-SW Post Module -!> \section arg_table_GFS_rrtmgp_sw_post_run -!! \htmlinclude GFS_rrtmgp_sw_post_run.html -!! -!> \ingroup GFS_rrtmgp_sw_post -!! RRTMGP Shortwave post-processing routine. -!! -!! \brief The all-sky shortwave radiation tendency is computed, the clear-sky tendency is -!! computed if requested. -!! -!! RRTMGP surface and TOA fluxes are copied to fields that persist between radiation/physics -!! calls. -!! -!! (optional) Save additional diagnostics. -!! -!! \section GFS_rrtmgp_sw_post_run - ! ######################################################################################### - subroutine GFS_rrtmgp_sw_post_run (nCol, nLev, nDay, idxday, lsswr, do_sw_clrsky_hr, & - save_diag, fhswr, coszen, coszdg, t_lay, p_lev, sfc_alb_nir_dir, sfc_alb_nir_dif, & - sfc_alb_uvvis_dir, sfc_alb_uvvis_dif, fluxswUP_allsky, & - fluxswDOWN_allsky, fluxswUP_clrsky, fluxswDOWN_clrsky, raddt, aerodp, cldsa, mbota, & - mtopa, cld_frac, cldtausw, fluxr, iSFC, iTOA, & - nirbmdi, nirdfdi, visbmdi, visdfdi, nirbmui, nirdfui, visbmui, visdfui, sfcnsw, & - sfcdsw, htrsw, sfcfsw, topfsw, htrswc, scmpsw, errmsg, errflg) - - ! Inputs - integer, intent(in) :: & - nCol, & ! Horizontal loop extent - nLev, & ! Number of vertical layers - nDay, & ! Number of daylit columns - iSFC, & ! Vertical index for surface level - iTOA ! Vertical index for TOA level - integer, intent(in), dimension(nday) :: & - idxday ! Index array for daytime points - logical, intent(in) :: & - lsswr, & ! Call SW radiation? - do_sw_clrsky_hr, & ! Output clear-sky SW heating-rate? - save_diag ! Output radiation diagnostics? - real(kind_phys), intent(in) :: & - fhswr ! Frequency for SW radiation - real(kind_phys), dimension(nCol), intent(in) :: & - t_lay, & ! Temperature at model layer centers (K) - coszen, & ! Cosine(SZA) - coszdg ! Cosine(SZA), daytime - real(kind_phys), dimension(nCol, nLev+1), intent(in) :: & - p_lev ! Pressure @ model layer-interfaces (Pa) - real(kind_phys), dimension(ncol), intent(in) :: & - 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) - real(kind_phys), dimension(nCol, nLev+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) - real(kind_phys), intent(in) :: & - raddt ! Radiation time step - real(kind_phys), dimension(nCol,NSPC1), intent(in) :: & - aerodp ! Vertical integrated optical depth for various aerosol species - real(kind_phys), dimension(nCol,5), intent(in) :: & - cldsa ! Fraction of clouds for low, middle, high, total and BL - integer, dimension(nCol,3), intent(in) ::& - mbota, & ! vertical indices for low, middle and high cloud tops - mtopa ! vertical indices for low, middle and high cloud bases - real(kind_phys), dimension(nCol,nLev), intent(in) :: & - cld_frac, & ! Total cloud fraction in each layer - cldtausw ! approx .55mu band layer cloud optical depth - type(cmpfsw_type), dimension(nCol), intent(in) :: & - scmpsw ! 2D surface fluxes, components: - ! uvbfc - total sky downward uv-b flux at (W/m2) - ! uvbf0 - clear sky downward uv-b flux at (W/m2) - ! nirbm - downward nir direct beam flux (W/m2) - ! nirdf - downward nir diffused flux (W/m2) - ! visbm - downward uv+vis direct beam flux (W/m2) - ! visdf - downward uv+vis diffused flux (W/m2) - - real(kind=kind_phys), dimension(:,:), intent(inout) :: fluxr - - ! Outputs (mandatory) - real(kind_phys), dimension(nCol), intent(inout) :: & - nirbmdi, & ! sfc nir beam sw downward flux (W/m2) - nirdfdi, & ! sfc nir diff sw downward flux (W/m2) - visbmdi, & ! sfc uv+vis beam sw downward flux (W/m2) - visdfdi, & ! sfc uv+vis diff sw downward flux (W/m2) - nirbmui, & ! sfc nir beam sw upward flux (W/m2) - nirdfui, & ! sfc nir diff sw upward flux (W/m2) - visbmui, & ! sfc uv+vis beam sw upward flux (W/m2) - visdfui, & ! sfc uv+vis diff sw upward flux (W/m2) - sfcnsw, & ! total sky sfc netsw flx into ground - sfcdsw ! - real(kind_phys), dimension(nCol,nLev), intent(inout) :: & - htrsw ! SW all-sky heating rate - type(sfcfsw_type), dimension(nCol), intent(inout) :: & - sfcfsw ! sw radiation fluxes at sfc - type(topfsw_type), dimension(nCol), intent(inout) :: & - topfsw ! sw_fluxes_top_atmosphere - character(len=*), intent(out) :: & - errmsg - integer, intent(out) :: & - errflg - - ! Outputs (optional) - real(kind_phys),dimension(nCol, nLev),intent(inout),optional :: & - htrswc ! Clear-sky heating rate (K/s) - - ! Local variables - integer :: i, j, k, itop, ibtc - real(kind_phys) :: tem0d, tem1, tem2 - real(kind_phys), dimension(nDay, nLev) :: thetaTendClrSky, thetaTendAllSky - - ! Initialize CCPP error handling variables - errmsg = '' - errflg = 0 - - if (.not. lsswr) return - if (nDay .gt. 0) then - - ! ####################################################################################### - ! Compute SW heating-rates - ! ####################################################################################### - ! Clear-sky heating-rate (optional) - if (do_sw_clrsky_hr) then - htrswc(:,:) = 0._kind_phys - call check_error_msg('GFS_rrtmgp_post',compute_heating_rate( & - fluxswUP_clrsky(idxday(1:nDay),:), & ! IN - Shortwave upward clear-sky flux profiles (W/m2) - fluxswDOWN_clrsky(idxday(1:nDay),:), & ! IN - Shortwave downward clear-sky flux profiles (W/m2) - p_lev(idxday(1:nDay),:), & ! IN - Pressure at model-interface (Pa) - thetaTendClrSky)) ! OUT - Clear-sky heating-rate (K/sec) - htrswc(idxday(1:nDay),:)=thetaTendClrSky !**NOTE** GP doesn't use radiation levels, it uses the model fields. Not sure if this is necessary - endif - - ! All-sky heating-rate (mandatory) - htrsw(:,:) = 0._kind_phys - call check_error_msg('GFS_rrtmgp_post',compute_heating_rate( & - fluxswUP_allsky(idxday(1:nDay),:), & ! IN - Shortwave upward all-sky flux profiles (W/m2) - fluxswDOWN_allsky(idxday(1:nDay),:), & ! IN - Shortwave downward all-sky flux profiles (W/m2) - p_lev(idxday(1:nDay),:), & ! IN - Pressure at model-interface (Pa) - thetaTendAllSky)) ! OUT - All-sky heating-rate (K/sec) - htrsw(idxday(1:nDay),:) = thetaTendAllSky - - ! ####################################################################################### - ! Save SW outputs - ! (Copy fluxes from RRTMGP types into model radiation types.) - ! ####################################################################################### - - ! TOA fluxes - topfsw(:)%upfxc = fluxswUP_allsky(:,iTOA) - topfsw(:)%upfx0 = fluxswUP_clrsky(:,iTOA) - topfsw(:)%dnfxc = fluxswDOWN_allsky(:,iTOA) - - ! Surface fluxes - sfcfsw(:)%upfxc = fluxswUP_allsky(:,iSFC) - sfcfsw(:)%upfx0 = fluxswUP_clrsky(:,iSFC) - sfcfsw(:)%dnfxc = fluxswDOWN_allsky(:,iSFC) - sfcfsw(:)%dnfx0 = fluxswDOWN_clrsky(:,iSFC) - - ! Surface down and up spectral component fluxes - ! - Save two spectral bands' surface downward and upward fluxes for output. - do i=1,nCol - nirbmdi(i) = scmpsw(i)%nirbm - nirdfdi(i) = scmpsw(i)%nirdf - visbmdi(i) = scmpsw(i)%visbm - visdfdi(i) = scmpsw(i)%visdf - nirbmui(i) = scmpsw(i)%nirbm * sfc_alb_nir_dir(i) - nirdfui(i) = scmpsw(i)%nirdf * sfc_alb_nir_dif(i) - visbmui(i) = scmpsw(i)%visbm * sfc_alb_uvvis_dir(i) - visdfui(i) = scmpsw(i)%visdf * sfc_alb_uvvis_dif(i) - enddo - else ! if_nday_block - ! ####################################################################################### - ! Dark everywhere - ! ####################################################################################### - htrsw(:,:) = 0.0 - sfcfsw = sfcfsw_type( 0.0, 0.0, 0.0, 0.0 ) - topfsw = topfsw_type( 0.0, 0.0, 0.0 ) - do i=1,nCol - nirbmdi(i) = 0.0 - nirdfdi(i) = 0.0 - visbmdi(i) = 0.0 - visdfdi(i) = 0.0 - nirbmui(i) = 0.0 - nirdfui(i) = 0.0 - visbmui(i) = 0.0 - visdfui(i) = 0.0 - enddo - - if (do_sw_clrsky_hr) then - htrswc(:,:) = 0 - endif - endif ! end_if_nday - - ! Radiation fluxes for other physics processes - do i=1,nCol - sfcnsw(i) = sfcfsw(i)%dnfxc - sfcfsw(i)%upfxc - sfcdsw(i) = sfcfsw(i)%dnfxc - enddo - - ! ####################################################################################### - ! Save SW diagnostics - ! - For time averaged output quantities (including total-sky and clear-sky SW and LW - ! fluxes at TOA and surface; conventional 3-domain cloud amount, cloud top and base - ! pressure, and cloud top temperature; aerosols AOD, etc.), store computed results in - ! corresponding slots of array fluxr with appropriate time weights. - ! - Collect the fluxr data for wrtsfc - ! ####################################################################################### - if (save_diag) then - do i=1,nCol - fluxr(i,34) = aerodp(i,1) ! total aod at 550nm - fluxr(i,35) = aerodp(i,2) ! DU aod at 550nm - fluxr(i,36) = aerodp(i,3) ! BC aod at 550nm - fluxr(i,37) = aerodp(i,4) ! OC aod at 550nm - fluxr(i,38) = aerodp(i,5) ! SU aod at 550nm - fluxr(i,39) = aerodp(i,6) ! SS aod at 550nm - if (coszen(i) > 0.) then - ! SW all-sky fluxes - tem0d = fhswr * coszdg(i) / coszen(i) - fluxr(i,2 ) = fluxr(i,2) + topfsw(i)%upfxc * tem0d ! total sky top sw up - fluxr(i,3 ) = fluxr(i,3) + sfcfsw(i)%upfxc * tem0d - fluxr(i,4 ) = fluxr(i,4) + sfcfsw(i)%dnfxc * tem0d ! total sky sfc sw dn - ! SW uv-b fluxes - fluxr(i,21) = fluxr(i,21) + scmpsw(i)%uvbfc * tem0d ! total sky uv-b sw dn - fluxr(i,22) = fluxr(i,22) + scmpsw(i)%uvbf0 * tem0d ! clear sky uv-b sw dn - ! SW TOA incoming fluxes - fluxr(i,23) = fluxr(i,23) + topfsw(i)%dnfxc * tem0d ! top sw dn - ! SW SFC flux components - fluxr(i,24) = fluxr(i,24) + visbmdi(i) * tem0d ! uv/vis beam sw dn - fluxr(i,25) = fluxr(i,25) + visdfdi(i) * tem0d ! uv/vis diff sw dn - fluxr(i,26) = fluxr(i,26) + nirbmdi(i) * tem0d ! nir beam sw dn - fluxr(i,27) = fluxr(i,27) + nirdfdi(i) * tem0d ! nir diff sw dn - ! SW clear-sky fluxes - fluxr(i,29) = fluxr(i,29) + topfsw(i)%upfx0 * tem0d - fluxr(i,31) = fluxr(i,31) + sfcfsw(i)%upfx0 * tem0d - fluxr(i,32) = fluxr(i,32) + sfcfsw(i)%dnfx0 * tem0d - endif - enddo - - ! Save total and boundary-layer clouds - do i=1,nCol - fluxr(i,17) = fluxr(i,17) + raddt * cldsa(i,4) - fluxr(i,18) = fluxr(i,18) + raddt * cldsa(i,5) - enddo - - ! Save cld frac,toplyr,botlyr and top temp, note that the order of h,m,l cloud - ! is reversed for the fluxr output. save interface pressure (pa) of top/bot - do j = 1, 3 - do i = 1, nCol - tem0d = raddt * cldsa(i,j) - itop = mtopa(i,j) - ibtc = mbota(i,j) - fluxr(i, 8-j) = fluxr(i, 8-j) + tem0d - fluxr(i,11-j) = fluxr(i,11-j) + tem0d * p_lev(i,itop) - fluxr(i,14-j) = fluxr(i,14-j) + tem0d * p_lev(i,ibtc) - fluxr(i,17-j) = fluxr(i,17-j) + tem0d * p_lev(i,itop) - - ! Add optical depth and emissivity output - tem1 = 0. - do k=ibtc,itop - tem1 = tem1 + cldtausw(i,k) ! approx .55 mu channel - enddo - fluxr(i,43-j) = fluxr(i,43-j) + tem0d * tem1 - enddo - enddo - endif - end subroutine GFS_rrtmgp_sw_post_run - -end module GFS_rrtmgp_sw_post diff --git a/physics/GFS_rrtmgp_sw_pre.F90 b/physics/GFS_rrtmgp_sw_pre.F90 deleted file mode 100644 index 87d0f9ad1..000000000 --- a/physics/GFS_rrtmgp_sw_pre.F90 +++ /dev/null @@ -1,95 +0,0 @@ -!> \file GFS_rrtmgp_sw_pre.F90 -!! This file contains code to gather the sunlit points for the RRTMGP shortwave scheme. -!! -!> \defgroup GFS_rrtmgp_sw_pre RRTMGP Shortwave pre -!! -!! \brief *TODO* Combine with rrtmg_sw_pre.F90, maybe call sw_rad_pre.F90, use by both. -!! -module GFS_rrtmgp_sw_pre - use machine, only: kind_phys - use mo_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp - use rrtmgp_sw_gas_optics, only: sw_gas_props - public GFS_rrtmgp_sw_pre_run -contains - -!> \section arg_table_GFS_rrtmgp_sw_pre_run -!! \htmlinclude GFS_rrtmgp_sw_pre.html -!! -!! \section GFS_rrtmgp_sw_pre RRTMGP shortwave pre routine -!! @{ -!! -!! Gather the sunlit points for shortwave radiation. -!! - ! ######################################################################################### - subroutine GFS_rrtmgp_sw_pre_run(nCol, doSWrad, coszen, nday, idxday, sfc_alb_nir_dir, & - sfc_alb_nir_dif, sfc_alb_uvvis_dir, sfc_alb_uvvis_dif, sfc_alb_nir_dir_byband, & - sfc_alb_nir_dif_byband, sfc_alb_uvvis_dir_byband, sfc_alb_uvvis_dif_byband, errmsg, & - errflg) - - ! Input - integer, intent(in) :: & - nCol ! Number of horizontal grid points - logical,intent(in) :: & - doSWrad ! Call RRTMGP SW radiation? - real(kind_phys), dimension(:), intent(in) :: & - coszen - real(kind_phys), dimension(:), intent(in) :: & - sfc_alb_nir_dir, & ! - sfc_alb_nir_dif, & ! - sfc_alb_uvvis_dir, & ! - sfc_alb_uvvis_dif ! - - ! Outputs - integer, intent(out) :: & - nday ! Number of daylit points - integer, dimension(:), intent(out) :: & - idxday ! Indices for daylit points - real(kind_phys), dimension(:,:), intent(out) :: & - sfc_alb_nir_dir_byband, & ! Surface albedo (direct) - sfc_alb_nir_dif_byband, & ! Surface albedo (diffuse) - sfc_alb_uvvis_dir_byband, & ! Surface albedo (direct) - sfc_alb_uvvis_dif_byband ! Surface albedo (diffuse) - character(len=*), intent(out) :: & - errmsg ! Error message - integer, intent(out) :: & - errflg ! Error flag - - ! Local variables - integer :: i, iBand - - ! Initialize CCPP error handling variables - errmsg = '' - errflg = 0 - - if (doSWrad) then - ! #################################################################################### - ! For SW gather daylit points - ! #################################################################################### - nday = 0 - idxday = 0 - do i = 1, nCol - if (coszen(i) >= 0.0001) then - nday = nday + 1 - idxday(nday) = i - endif - enddo - - ! Spread across all SW bands - do iBand=1,sw_gas_props%get_nband() - sfc_alb_nir_dir_byband(iBand,1:nCol) = sfc_alb_nir_dir(1:nCol) - sfc_alb_nir_dif_byband(iBand,1:nCol) = sfc_alb_nir_dif(1:nCol) - sfc_alb_uvvis_dir_byband(iBand,1:nCol) = sfc_alb_uvvis_dir(1:nCol) - sfc_alb_uvvis_dif_byband(iBand,1:nCol) = sfc_alb_uvvis_dif(1:nCol) - enddo - else - nday = 0 - idxday = 0 - sfc_alb_nir_dir_byband(:,1:nCol) = 0. - sfc_alb_nir_dif_byband(:,1:nCol) = 0. - sfc_alb_uvvis_dir_byband(:,1:nCol) = 0. - sfc_alb_uvvis_dif_byband(:,1:nCol) = 0. - endif - - end subroutine GFS_rrtmgp_sw_pre_run -!> @} -end module GFS_rrtmgp_sw_pre diff --git a/physics/GFS_rrtmgp_sw_pre.meta b/physics/GFS_rrtmgp_sw_pre.meta deleted file mode 100644 index 462ab5f18..000000000 --- a/physics/GFS_rrtmgp_sw_pre.meta +++ /dev/null @@ -1,124 +0,0 @@ -[ccpp-table-properties] - name = GFS_rrtmgp_sw_pre - type = scheme - dependencies = machine.F,radiation_astronomy.f,rrtmgp_sw_gas_optics.F90,rte-rrtmgp/rrtmgp/mo_gas_optics_rrtmgp.F90, - -######################################################################## -[ccpp-arg-table] - name = GFS_rrtmgp_sw_pre_run - type = scheme -[ncol] - standard_name = horizontal_loop_extent - long_name = horizontal loop extent - units = count - dimensions = () - type = integer - intent = in -[doSWrad] - standard_name = flag_for_calling_shortwave_radiation - long_name = logical flags for sw radiation calls - units = flag - dimensions = () - type = logical - intent = in -[nday] - standard_name = daytime_points_dimension - long_name = daytime points dimension - units = count - dimensions = () - type = integer - intent = out -[idxday] - standard_name = daytime_points - long_name = daytime points - units = index - dimensions = (horizontal_loop_extent) - type = integer - intent = out -[coszen] - standard_name = cosine_of_solar_zenith_angle_for_daytime_points_on_radiation_timestep - long_name = mean cos of zenith angle over rad call period - units = none - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in -[sfc_alb_nir_dir] - standard_name = surface_albedo_due_to_near_IR_direct - long_name = surface albedo due to near IR direct beam - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in -[sfc_alb_nir_dif] - standard_name = surface_albedo_due_to_near_IR_diffused - long_name = surface albedo due to near IR diffused beam - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in -[sfc_alb_uvvis_dir] - standard_name = surface_albedo_due_to_UV_and_VIS_direct - long_name = surface albedo due to UV+VIS direct beam - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in -[sfc_alb_uvvis_dif] - standard_name = surface_albedo_due_to_UV_and_VIS_diffused - long_name = surface albedo due to UV+VIS diffused beam - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in -[sfc_alb_nir_dir_byband] - standard_name = surface_albedo_nearIR_direct - long_name = near-IR (direct) surface albedo (sfc_alb_nir_dir) - units = none - dimensions = (number_of_shortwave_bands,horizontal_loop_extent) - type = real - kind = kind_phys - intent = out -[sfc_alb_nir_dif_byband] - standard_name = surface_albedo_nearIR_diffuse - long_name = near-IR (diffuse) surface albedo (sfc_alb_nir_dif) - units = none - dimensions = (number_of_shortwave_bands,horizontal_loop_extent) - type = real - kind = kind_phys - intent = out -[sfc_alb_uvvis_dir_byband] - standard_name = surface_albedo_uvvis_direct - long_name = UVVIS (direct) surface albedo (sfc_alb_uvvis_dir) - units = none - dimensions = (number_of_shortwave_bands,horizontal_loop_extent) - type = real - kind = kind_phys - intent = out -[sfc_alb_uvvis_dif_byband] - standard_name = surface_albedo_uvvis_diffuse - long_name = UVVIS (diffuse) surface albedo (sfc_alb_uvvis_dif) - units = none - dimensions = (number_of_shortwave_bands,horizontal_loop_extent) - type = real - kind = kind_phys - intent = out -[errmsg] - standard_name = ccpp_error_message - long_name = error message for error handling in CCPP - units = none - dimensions = () - type = character - kind = len=* - intent = out -[errflg] - standard_name = ccpp_error_code - long_name = error code for error handling in CCPP - units = 1 - dimensions = () - type = integer - intent = out diff --git a/physics/rrtmgp_aerosol_optics.F90 b/physics/rrtmgp_aerosol_optics.F90 index 3af87cd00..ce0fa8ea9 100644 --- a/physics/rrtmgp_aerosol_optics.F90 +++ b/physics/rrtmgp_aerosol_optics.F90 @@ -3,16 +3,10 @@ module rrtmgp_aerosol_optics use machine, only: kind_phys - use mo_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp - use mo_optical_props, only: ty_optical_props_2str, ty_optical_props_1scl use radiation_tools, only: check_error_msg use rrtmgp_sw_gas_optics, only: sw_gas_props use rrtmgp_lw_gas_optics, only: lw_gas_props - use module_radiation_aerosols, only: & - NF_AESW, & ! Number of optical-fields in SW output (3=tau+g+omega) - NF_AELW, & ! Number of optical-fields in LW output (3=tau+g+omega) - setaer, & ! Routine to compute aerosol radiative properties (tau,g,omega) - NSPC1 ! Number of species for vertically integrated aerosol optical-depth + use module_radiation_aerosols, only: setaer use netcdf implicit none @@ -30,10 +24,10 @@ module rrtmgp_aerosol_optics !! \section arg_table_rrtmgp_aerosol_optics_run !! \htmlinclude rrtmgp_aerosol_optics_run.html !! - subroutine rrtmgp_aerosol_optics_run(doSWrad, doLWrad, nCol, nLev, nTracer, nTracerAer, & - nDay, idxday, p_lev, p_lay, p_lk, tv_lay, relhum, lsmask, tracer, aerfld, lon, lat, & - iaermdl, iaerflg, top_at_1, con_pi, con_rd, con_g, aerodp, sw_optical_props_aerosol, & - lw_optical_props_aerosol, errmsg, errflg ) + subroutine rrtmgp_aerosol_optics_run(doSWrad, doLWrad, nCol, nLev, nDay, idxday, p_lev, & + p_lay, p_lk, tv_lay, relhum, lsmask, tracer, aerfld, lon, lat, iaermdl, iaerflg, & + top_at_1, con_pi, con_rd, con_g, aerodp, aerlw_tau, aerlw_ssa, aerlw_g, aersw_tau, & + aersw_ssa, aersw_g, errmsg, errflg ) ! Inputs logical, intent(in) :: & @@ -44,8 +38,6 @@ subroutine rrtmgp_aerosol_optics_run(doSWrad, doLWrad, nCol, nLev, nTracer, nTra nCol, & ! Number of horizontal grid points nDay, & ! Number of daylit points nLev, & ! Number of vertical layers - nTracer, & ! Number of tracers - nTracerAer, & ! Number of aerosol tracers iaermdl, & ! Aerosol model scheme flag iaerflg ! Aerosol effects to include integer,intent(in),dimension(:) :: & @@ -73,19 +65,22 @@ subroutine rrtmgp_aerosol_optics_run(doSWrad, doLWrad, nCol, nLev, nTracer, nTra ! Outputs real(kind_phys), dimension(:,:), intent(out) :: & aerodp ! Vertical integrated optical depth for various aerosol species - type(ty_optical_props_2str),intent(out) :: & - sw_optical_props_aerosol ! RRTMGP DDT: Longwave aerosol optical properties (tau) - type(ty_optical_props_1scl),intent(inout) :: & - lw_optical_props_aerosol ! RRTMGP DDT: Longwave aerosol optical properties (tau) + real(kind_phys), dimension(:,:,:), intent(out) :: & + aerlw_tau, & ! Longwave aerosol optical depth + aerlw_ssa, & ! Longwave aerosol single scattering albedo + aerlw_g, & ! Longwave aerosol asymmetry parameter + aersw_tau, & ! Shortwave aerosol optical depth + aersw_ssa, & ! Shortwave aerosol single scattering albedo + aersw_g ! Shortwave aerosol asymmetry parameter integer, intent(out) :: & errflg ! CCPP error flag character(len=*), intent(out) :: & errmsg ! CCPP error message ! Local variables - real(kind_phys), dimension(nCol, nLev, lw_gas_props%get_nband(), NF_AELW) :: & + real(kind_phys), dimension(nCol, nLev, lw_gas_props%get_nband(), 3) :: & aerosolslw ! - real(kind_phys), dimension(nCol, nLev, sw_gas_props%get_nband(), NF_AESW) :: & + real(kind_phys), dimension(nCol, nLev, sw_gas_props%get_nband(), 3) :: & aerosolssw, aerosolssw2 integer :: iBand @@ -93,14 +88,14 @@ subroutine rrtmgp_aerosol_optics_run(doSWrad, doLWrad, nCol, nLev, nTracer, nTra errmsg = '' errflg = 0 - if (.not. doSWrad) return + if (.not. (doSWrad .or. doLWrad)) return ! Call module_radiation_aerosols::setaer(),to setup aerosols property profile call setaer(p_lev*0.01, p_lay*0.01, p_lk, tv_lay, relhum, lsmask, tracer, aerfld, lon, lat, nCol, nLev, & nLev+1, .true., .true., iaermdl, iaerflg, top_at_1, con_pi, con_rd, con_g, aerosolssw2, aerosolslw, aerodp, errflg, errmsg) ! Shortwave - if (nDay .gt. 0) then + if (doSWrad .and. (nDay .gt. 0)) then ! Store aerosol optical properties ! SW. ! For RRTMGP SW the bands are now ordered from [IR(band) -> nIR -> UV], in RRTMG the @@ -111,26 +106,19 @@ subroutine rrtmgp_aerosol_optics_run(doSWrad, doLWrad, nCol, nLev, nTracer, nTra aerosolssw(1:nCol,:,2:sw_gas_props%get_nband(),1) = aerosolssw2(1:nCol,:,1:sw_gas_props%get_nband()-1,1) aerosolssw(1:nCol,:,2:sw_gas_props%get_nband(),2) = aerosolssw2(1:nCol,:,1:sw_gas_props%get_nband()-1,2) aerosolssw(1:nCol,:,2:sw_gas_props%get_nband(),3) = aerosolssw2(1:nCol,:,1:sw_gas_props%get_nband()-1,3) - - ! Allocate RRTMGP DDT: Aerosol optics [nCol,nlev,nBands] - call check_error_msg('rrtmgp_aerosol_optics_run',sw_optical_props_aerosol%alloc_2str( & - nDay, nlev, sw_gas_props%get_band_lims_wavenumber())) - - ! Copy aerosol optical information to RRTMGP DDT - sw_optical_props_aerosol%tau = aerosolssw(idxday(1:nday),:,:,1) - sw_optical_props_aerosol%ssa = aerosolssw(idxday(1:nday),:,:,2) - sw_optical_props_aerosol%g = aerosolssw(idxday(1:nday),:,:,3) + + ! Copy aerosol optical information/ + aersw_tau = aerosolssw(:,:,:,1) + aersw_ssa = aerosolssw(:,:,:,2) + aersw_g = aerosolssw(:,:,:,3) endif ! Longwave - if (.not. doLWrad) return - lw_optical_props_aerosol%tau = aerosolslw(:,:,:,1) * (1. - aerosolslw(:,:,:,2)) - - lw_optical_props_aerosol%band_lims_wvn = lw_gas_props%get_band_lims_wavenumber() - do iBand=1,lw_gas_props%get_nband() - lw_optical_props_aerosol%band2gpt(1:2,iBand) = iBand - lw_optical_props_aerosol%gpt2band(iBand) = iBand - end do + if (doLWrad) then + aerlw_tau = aerosolslw(:,:,:,1) + aerlw_ssa = aerosolslw(:,:,:,2) + aerlw_g = aerosolslw(:,:,:,3) + endif end subroutine rrtmgp_aerosol_optics_run !> @} diff --git a/physics/rrtmgp_aerosol_optics.meta b/physics/rrtmgp_aerosol_optics.meta index 74c0f4f70..e2b81b192 100644 --- a/physics/rrtmgp_aerosol_optics.meta +++ b/physics/rrtmgp_aerosol_optics.meta @@ -66,20 +66,6 @@ dimensions = () type = integer intent = in -[nTracer] - standard_name = number_of_tracers - long_name = number of tracers - units = count - dimensions = () - type = integer - intent = in -[nTracerAer] - standard_name = number_of_aerosol_tracers_MG - long_name = number of aerosol tracers for Morrison Gettelman MP - units = count - dimensions = () - type = integer - intent = in [nday] standard_name = daytime_points_dimension long_name = daytime points dimension @@ -143,9 +129,9 @@ kind = kind_phys intent = in [tracer] - standard_name = chemical_tracers - long_name = chemical tracers - units = g g-1 + standard_name = tracer_concentration + long_name = model layer mean tracer concentration + units = kg kg-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_tracers) type = real kind = kind_phys @@ -196,20 +182,54 @@ type = real kind = kind_phys intent = out -[sw_optical_props_aerosol] - standard_name = shortwave_optical_properties_for_aerosols - long_name = Fortran DDT containing RRTMGP optical properties - units = DDT - dimensions = () - type = ty_optical_props_2str +[aersw_tau] + standard_name = aerosol_optical_depth_for_shortwave_bands_01_16 + long_name = aerosol optical depth for shortwave bands 01-16 + units = none + dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_aerosol_bands_for_shortwave_radiation) + type = real + kind = kind_phys + intent = out +[aersw_ssa] + standard_name = aerosol_single_scattering_albedo_for_shortwave_bands_01_16 + long_name = aerosol single scattering albedo for shortwave bands 01-16 + units = frac + dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_aerosol_bands_for_shortwave_radiation) + type = real + kind = kind_phys + intent = out +[aersw_g] + standard_name = aerosol_asymmetry_parameter_for_shortwave_bands_01_16 + long_name = aerosol asymmetry parameter for shortwave bands 01-16 + units = none + dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_aerosol_bands_for_shortwave_radiation) + type = real + kind = kind_phys + intent = out +[aerlw_tau] + standard_name = aerosol_optical_depth_for_longwave_bands_01_16 + long_name = aerosol optical depth for longwave bands 01-16 + units = none + dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_aerosol_bands_for_longwave_radiation) + type = real + kind = kind_phys + intent = out +[aerlw_ssa] + standard_name = aerosol_single_scattering_albedo_for_longwave_bands_01_16 + long_name = aerosol single scattering albedo for longwave bands 01-16 + units = frac + dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_aerosol_bands_for_longwave_radiation) + type = real + kind = kind_phys + intent = out +[aerlw_g] + standard_name = aerosol_asymmetry_parameter_for_longwave_bands_01_16 + long_name = aerosol asymmetry parameter for longwave bands 01-16 + units = none + dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_aerosol_bands_for_longwave_radiation) + type = real + kind = kind_phys intent = out -[lw_optical_props_aerosol] - standard_name = longwave_optical_properties_for_aerosols - long_name = Fortran DDT containing RRTMGP optical properties - units = DDT - dimensions = () - type = ty_optical_props_1scl - intent = inout [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/rrtmgp_lw_cloud_optics.F90 b/physics/rrtmgp_lw_cloud_optics.F90 index 8bdd71696..9915c0040 100644 --- a/physics/rrtmgp_lw_cloud_optics.F90 +++ b/physics/rrtmgp_lw_cloud_optics.F90 @@ -12,8 +12,6 @@ module rrtmgp_lw_cloud_optics use machine, only: kind_phys use mo_rte_kind, only: wl use mo_cloud_optics, only: ty_cloud_optics - use mo_optical_props, only: ty_optical_props_1scl, ty_optical_props_2str - use mo_rrtmg_lw_cloud_optics, only: rrtmg_lw_cloud_optics use rrtmgp_lw_gas_optics, only: lw_gas_props use radiation_tools, only: check_error_msg use netcdf @@ -74,55 +72,42 @@ module rrtmgp_lw_cloud_optics contains -!>\defgroup rrtmgp_lw_cloud_optics_mod GFS RRTMGP-LW Cloud Optics Module -!> \section arg_table_rrtmgp_lw_cloud_optics_init -!! \htmlinclude rrtmgp_lw_cloud_optics.html -!! -!> \ingroup rrtmgp_lw_cloud_optics -!! -!! RRTMGP relies heavily on derived-data-types, which contain type-bound procedures -!! that are referenced frequently throughout the RRTMGP longwave scheme. The data needed -!! to compute the shortwave cloud optical properties are initialized here and loaded into -!! the RRTMGP DDT, ty_cloud_optics. -!! -!! \section rrtmgp_sw_cloud_optics_init - subroutine rrtmgp_lw_cloud_optics_init(nrghice, mpicomm, mpirank, mpiroot, & - doG_cldoptics, doGP_cldoptics_PADE, doGP_cldoptics_LUT, rrtmgp_root_dir, & - rrtmgp_lw_file_clouds, errmsg, errflg) + ! ###################################################################################### + ! SUBROUTINE rrtmgp_lw_cloud_optics_init() + ! ###################################################################################### + subroutine rrtmgp_lw_cloud_optics_init(rrtmgp_root_dir, rrtmgp_lw_file_clouds, & + doGP_cldoptics_PADE, doGP_cldoptics_LUT, nrghice, mpicomm, mpirank, mpiroot, & + errmsg, errflg) ! Inputs + character(len=128),intent(in) :: & + rrtmgp_root_dir, & ! RTE-RRTMGP root directory + rrtmgp_lw_file_clouds ! RRTMGP file containing clouds optics data + logical, intent(in) :: & - doG_cldoptics, & ! Use legacy RRTMG cloud-optics? - doGP_cldoptics_PADE, & ! Use RRTMGP cloud-optics: PADE approximation? - doGP_cldoptics_LUT ! Use RRTMGP cloud-optics: LUTs? + doGP_cldoptics_PADE,& ! Use RRTMGP cloud-optics: PADE approximation? + doGP_cldoptics_LUT ! Use RRTMGP cloud-optics: LUTs? integer, intent(inout) :: & - nrghice ! Number of ice-roughness categories + nrghice ! Number of ice-roughness categories integer, intent(in) :: & - mpicomm, & ! MPI communicator - mpirank, & ! Current MPI rank - mpiroot ! Master MPI rank - character(len=128),intent(in) :: & - rrtmgp_root_dir, & ! RTE-RRTMGP root directory - rrtmgp_lw_file_clouds ! RRTMGP file containing coefficients used to compute clouds optical properties + mpicomm, & ! MPI communicator + mpirank, & ! Current MPI rank + mpiroot ! Master MPI rank ! Outputs character(len=*), intent(out) :: & - errmsg ! Error message + errmsg ! Error message integer, intent(out) :: & - errflg ! Error code + errflg ! Error code ! Local variables integer :: dimID,varID,status,ncid,mpierr character(len=264) :: lw_cloud_props_file - integer,parameter :: max_strlen=256, nrghice_default=2 ! Initialize errmsg = '' errflg = 0 - ! If not using RRTMGP cloud optics, return. - if (doG_cldoptics) return - ! Filenames are set in the physics_nml lw_cloud_props_file = trim(rrtmgp_root_dir)//trim(rrtmgp_lw_file_clouds) @@ -391,171 +376,4 @@ subroutine rrtmgp_lw_cloud_optics_init(nrghice, mpicomm, mpirank, mpiroot, call check_error_msg('lw_cloud_optics_init',lw_cloud_props%set_ice_roughness(nrghice)) end subroutine rrtmgp_lw_cloud_optics_init - ! ###################################################################################### -!> \section arg_table_rrtmgp_lw_cloud_optics_run -!! \htmlinclude rrtmgp_lw_cloud_optics.html -!! -!> \ingroup rrtmgp_lw_cloud_optics -!! -!! Compute longwave optical prperties (optical-depth) for ALL cloud types visible to RRTMGP. -!! -!! \section rrtmgp_lw_gas_optics_run - subroutine rrtmgp_lw_cloud_optics_run(doLWrad, doG_cldoptics, icliq_lw, icice_lw, & - doGP_cldoptics_PADE, doGP_cldoptics_LUT, doGP_lwscat, do_mynnedmf, imfdeepcnv, & - imfdeepcnv_gf, imfdeepcnv_samf, nCol, nLev, nbndsGPlw , p_lay, cld_frac, cld_lwp, & - cld_reliq, cld_iwp, cld_reice, cld_swp, cld_resnow, cld_rwp, cld_rerain, & - precip_frac, cld_cnv_lwp, cld_cnv_reliq, cld_cnv_iwp, cld_cnv_reice, cld_pbl_lwp, & - cld_pbl_reliq, cld_pbl_iwp, cld_pbl_reice, lon, lat, cldtaulw, & - lw_optical_props_cloudsByBand, lw_optical_props_cnvcloudsByBand, & - lw_optical_props_MYNNcloudsByBand, lw_optical_props_precipByBand, errmsg, errflg) - - ! Inputs - logical, intent(in) :: & - doLWrad, & ! Logical flag for longwave radiation call - doG_cldoptics, & ! Use legacy RRTMG cloud-optics? - doGP_cldoptics_PADE, & ! Use RRTMGP cloud-optics: PADE approximation? - doGP_cldoptics_LUT, & ! Use RRTMGP cloud-optics: LUTs? - doGP_lwscat, & ! Include scattering in LW cloud-optics? - do_mynnedmf ! - integer, intent(in) :: & - nbndsGPlw, & ! - nCol, & ! Number of horizontal gridpoints - nLev, & ! Number of vertical levels - icliq_lw, & ! Choice of treatment of liquid cloud optical properties (RRTMG legacy) - icice_lw, & ! Choice of treatment of ice cloud optical properties (RRTMG legacy) - imfdeepcnv, & ! - imfdeepcnv_gf, & ! - imfdeepcnv_samf ! - real(kind_phys), dimension(:), intent(in) :: & - lon, & ! Longitude - lat ! Latitude - real(kind_phys), dimension(:,:),intent(in) :: & - p_lay, & ! Layer pressure (Pa) - cld_frac, & ! Total cloud fraction by layer - cld_lwp, & ! Cloud liquid water path - cld_reliq, & ! Cloud liquid effective radius - cld_iwp, & ! Cloud ice water path - cld_reice, & ! Cloud ice effective radius - cld_swp, & ! Cloud snow water path - cld_resnow, & ! Cloud snow effective radius - cld_rwp, & ! Cloud rain water path - cld_rerain, & ! Cloud rain effective radius - precip_frac, & ! Precipitation fraction by layer. - cld_cnv_lwp, & ! Water path for convective liquid cloud-particles (microns) - cld_cnv_reliq, & ! Effective radius for convective liquid cloud-particles (microns) - cld_cnv_iwp, & ! Water path for convective ice cloud-particles (microns) - cld_cnv_reice, & ! Effective radius for convective ice cloud-particles (microns) - cld_pbl_lwp, & ! Water path for SGS PBL liquid cloud-particles - cld_pbl_reliq, & ! Effective radius for SGS PBL liquid cloud-particles - cld_pbl_iwp, & ! Water path for SGS PBL ice cloud-particles - cld_pbl_reice ! Effective radius for SGS PBL ice cloud-particles - - ! Outputs - character(len=*), intent(out) :: & - errmsg ! CCPP error message - integer, intent(out) :: & - errflg ! CCPP error flag - type(ty_optical_props_2str),intent(inout) :: & - lw_optical_props_cloudsByBand, & ! RRTMGP DDT: Longwave optical properties in each band (clouds) - lw_optical_props_cnvcloudsByBand, & ! RRTMGP DDT: Longwave optical properties in each band (convective cloud) - lw_optical_props_MYNNcloudsByBand, & ! RRTMGP DDT: Longwave optical properties in each band (MYNN-PBL cloud) - lw_optical_props_precipByBand ! RRTMGP DDT: Longwave optical properties in each band (precipitation) - real(kind_phys), dimension(:,:), intent(inout) :: & - cldtaulw ! Approx 10.mu band layer cloud optical depth - - ! Local variables - real(kind_phys) :: tau_rain, tau_snow - real(kind_phys), dimension(ncol,nLev,nbndsGPlw) :: & - tau_cld, tau_precip - integer :: iCol, iLay, iBand - - ! Initialize CCPP error handling variables - errmsg = '' - errflg = 0 - - ! Initialize locals - tau_cld = 0._kind_phys - tau_precip = 0._kind_phys - - if (.not. doLWrad) return - - ! Compute cloud-optics for RTE. - if (doGP_cldoptics_PADE .or. doGP_cldoptics_LUT) then - - ! i) Cloud-optics. - lw_optical_props_cloudsByBand%band_lims_wvn = lw_gas_props%get_band_lims_wavenumber() - do iBand=1,lw_gas_props%get_nband() - lw_optical_props_cloudsByBand%band2gpt(1:2,iBand) = iBand - lw_optical_props_cloudsByBand%gpt2band(iBand) = iBand - end do - call check_error_msg('rrtmgp_lw_cloud_optics_run - clouds',lw_cloud_props%cloud_optics(& - cld_lwp, & ! IN - Cloud liquid water path (g/m2) - cld_iwp, & ! IN - Cloud ice water path (g/m2) - cld_reliq, & ! IN - Cloud liquid effective radius (microns) - cld_reice, & ! IN - Cloud ice effective radius (microns) - lw_optical_props_cloudsByBand)) ! OUT - RRTMGP DDT containing cloud radiative properties - ! in each band - ! ii) Convective cloud-optics - if (imfdeepcnv == imfdeepcnv_samf .or. imfdeepcnv == imfdeepcnv_gf) then - lw_optical_props_cnvcloudsByBand%band_lims_wvn = lw_gas_props%get_band_lims_wavenumber() - do iBand=1,lw_gas_props%get_nband() - lw_optical_props_cnvcloudsByBand%band2gpt(1:2,iBand) = iBand - lw_optical_props_cnvcloudsByBand%gpt2band(iBand) = iBand - end do - call check_error_msg('rrtmgp_lw_cnvcloud_optics_run - convective cloud',lw_cloud_props%cloud_optics(& - cld_cnv_lwp, & ! IN - Convective cloud liquid water path (g/m2) - cld_cnv_iwp, & ! IN - Convective cloud ice water path (g/m2) - cld_cnv_reliq, & ! IN - Convective cloud liquid effective radius (microns) - cld_cnv_reice, & ! IN - Convective cloud ice effective radius (microns) - lw_optical_props_cnvcloudsByBand)) ! OUT - RRTMGP DDT containing convective cloud radiative properties - ! in each band - endif - - ! iii) MYNN cloud-optics - if (do_mynnedmf) then - lw_optical_props_MYNNcloudsByBand%band_lims_wvn = lw_gas_props%get_band_lims_wavenumber() - do iBand=1,lw_gas_props%get_nband() - lw_optical_props_MYNNcloudsByBand%band2gpt(1:2,iBand) = iBand - lw_optical_props_MYNNcloudsByBand%gpt2band(iBand) = iBand - end do - call check_error_msg('rrtmgp_lw_MYNNcloud_optics_run - MYNN-EDMF cloud',lw_cloud_props%cloud_optics(& - cld_pbl_lwp, & ! IN - MYNN-EDMF PBL cloud liquid water path (g/m2) - cld_pbl_iwp, & ! IN - MYNN-EDMF PBL cloud ice water path (g/m2) - cld_pbl_reliq, & ! IN - MYNN-EDMF PBL cloud liquid effective radius (microns) - cld_pbl_reice, & ! IN - MYNN-EDMF PBL cloud ice effective radius (microns) - lw_optical_props_MYNNcloudsByBand)) ! OUT - RRTMGP DDT containing MYNN-EDMF PBL cloud radiative properties - ! in each band - endif - - ! iv) Cloud precipitation optics: rain and snow(+groupel) - lw_optical_props_precipByBand%band_lims_wvn = lw_gas_props%get_band_lims_wavenumber() - do iBand=1,lw_gas_props%get_nband() - lw_optical_props_precipByBand%band2gpt(1:2,iBand) = iBand - lw_optical_props_precipByBand%gpt2band(iBand) = iBand - end do - do iCol=1,nCol - do iLay=1,nLev - if (cld_frac(iCol,iLay) .gt. 0.) then - ! Rain optical-depth (No band dependence) - tau_rain = absrain*cld_rwp(iCol,iLay) - - ! Snow (+groupel) optical-depth (No band dependence) - if (cld_swp(iCol,iLay) .gt. 0. .and. cld_resnow(iCol,iLay) .gt. 10._kind_phys) then - tau_snow = abssnow0*1.05756*cld_swp(iCol,iLay)/cld_resnow(iCol,iLay) - else - tau_snow = 0.0 - endif - do iBand=1,nbndsGPlw - lw_optical_props_precipByBand%tau(iCol,iLay,iBand) = tau_rain + tau_snow - enddo - endif - enddo - enddo - endif - - ! All-sky LW optical depth ~10microns (DJS asks: Same as SW, move to cloud-diagnostics?) - cldtaulw = lw_optical_props_cloudsByBand%tau(:,:,7) - - end subroutine rrtmgp_lw_cloud_optics_run - end module rrtmgp_lw_cloud_optics diff --git a/physics/rrtmgp_lw_cloud_optics.meta b/physics/rrtmgp_lw_cloud_optics.meta deleted file mode 100644 index c58496dc5..000000000 --- a/physics/rrtmgp_lw_cloud_optics.meta +++ /dev/null @@ -1,412 +0,0 @@ -[ccpp-table-properties] - name = rrtmgp_lw_cloud_optics - type = scheme - dependencies = machine.F,rrtmg_lw_cloud_optics.F90,radiation_tools.F90 - -######################################################################## -[ccpp-arg-table] - name = rrtmgp_lw_cloud_optics_init - type = scheme -[doG_cldoptics] - standard_name = flag_to_calc_lw_cld_optics_using_RRTMG - long_name = logical flag to control cloud optics scheme. - units = flag - dimensions = () - type = logical - intent = in -[doGP_cldoptics_PADE] - standard_name = flag_to_calc_lw_cld_optics_using_RRTMGP_PADE - long_name = logical flag to control cloud optics scheme. - units = flag - dimensions = () - type = logical - intent = in -[doGP_cldoptics_LUT] - standard_name = flag_to_calc_lw_cld_optics_using_RRTMGP_LUT - long_name = logical flag to control cloud optics scheme. - units = flag - dimensions = () - type = logical - intent = in -[nrghice] - standard_name = number_of_ice_roughness_categories - long_name = number of ice-roughness categories in RRTMGP calculation - units = count - dimensions = () - type = integer - intent = inout -[rrtmgp_root_dir] - standard_name = directory_for_rte_rrtmgp_source_code - long_name = directory for rte+rrtmgp source code - units = none - dimensions = () - type = character - intent = in - kind = len=128 -[rrtmgp_lw_file_clouds] - standard_name = filename_of_rrtmgp_longwave_cloud_optics_coefficients - long_name = file containing coefficients for RRTMGP LW cloud optics - units = none - dimensions = () - type = character - intent = in - kind = len=128 -[mpirank] - standard_name = mpi_rank - long_name = current MPI rank - units = index - dimensions = () - type = integer - intent = in -[mpiroot] - standard_name = mpi_root - long_name = master MPI rank - units = index - dimensions = () - type = integer - intent = in -[mpicomm] - standard_name = mpi_communicator - long_name = MPI communicator - units = index - dimensions = () - type = integer - intent = in -[errmsg] - standard_name = ccpp_error_message - long_name = error message for error handling in CCPP - units = none - dimensions = () - type = character - kind = len=* - intent = out -[errflg] - standard_name = ccpp_error_code - long_name = error code for error handling in CCPP - units = 1 - dimensions = () - type = integer - intent = out - -######################################################################## -[ccpp-arg-table] - name = rrtmgp_lw_cloud_optics_run - type = scheme -[doLWrad] - standard_name = flag_for_calling_longwave_radiation - long_name = logical flags for lw radiation calls - units = flag - dimensions = () - type = logical - intent = in -[doG_cldoptics] - standard_name = flag_to_calc_lw_cld_optics_using_RRTMG - long_name = logical flag to control cloud optics scheme. - units = flag - dimensions = () - type = logical - intent = in -[icliq_lw] - standard_name = flag_for_optical_property_for_liquid_clouds_for_longwave_radiation - long_name = lw optical property for liquid clouds - units = flag - dimensions = () - type = integer - intent = in -[icice_lw] - standard_name = flag_for_optical_property_for_ice_clouds_for_longwave_radiation - long_name = lw optical property for ice clouds - units = flag - dimensions = () - type = integer - intent = in -[doGP_cldoptics_PADE] - standard_name = flag_to_calc_lw_cld_optics_using_RRTMGP_PADE - long_name = logical flag to control cloud optics scheme. - units = flag - dimensions = () - type = logical - intent = in -[doGP_cldoptics_LUT] - standard_name = flag_to_calc_lw_cld_optics_using_RRTMGP_LUT - long_name = logical flag to control cloud optics scheme. - units = flag - dimensions = () - type = logical - intent = in -[doGP_lwscat] - standard_name = flag_to_include_longwave_scattering_in_cloud_optics - long_name = logical flag to control the addition of LW scattering in RRTMGP - units = flag - dimensions = () - type = logical - intent = in -[do_mynnedmf] - standard_name = flag_for_mellor_yamada_nakanishi_niino_pbl_scheme - long_name = flag to activate MYNN-EDMF - units = flag - dimensions = () - type = logical - intent = in -[imfdeepcnv] - standard_name = control_for_deep_convection_scheme - long_name = flag for mass-flux deep convection scheme - units = flag - dimensions = () - type = integer - intent = in -[imfdeepcnv_gf] - standard_name = identifier_for_grell_freitas_deep_convection - long_name = flag for Grell-Freitas deep convection scheme - units = flag - dimensions = () - type = integer - intent = in -[imfdeepcnv_samf] - standard_name = identifer_for_scale_aware_mass_flux_deep_convection - long_name = flag for SAMF deep convection scheme - units = flag - dimensions = () - type = integer - intent = in -[ncol] - standard_name = horizontal_loop_extent - long_name = horizontal dimension - units = count - dimensions = () - type = integer - intent = in -[nLev] - standard_name = vertical_layer_dimension - long_name = number of vertical levels - units = count - dimensions = () - type = integer - intent = in -[cld_frac] - standard_name = total_cloud_fraction - long_name = layer total cloud fraction - units = frac - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - intent = in - kind = kind_phys -[cld_lwp] - standard_name = cloud_liquid_water_path - long_name = layer cloud liquid water path - units = g m-2 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - intent = in - kind = kind_phys -[cld_reliq] - standard_name = mean_effective_radius_for_liquid_cloud - long_name = mean effective radius for liquid cloud - units = um - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - intent = in - kind = kind_phys -[cld_iwp] - standard_name = cloud_ice_water_path - long_name = layer cloud ice water path - units = g m-2 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - intent = in - kind = kind_phys -[cld_reice] - standard_name = mean_effective_radius_for_ice_cloud - long_name = mean effective radius for ice cloud - units = um - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - intent = in - kind = kind_phys -[cld_swp] - standard_name = cloud_snow_water_path - long_name = cloud snow water path - units = g m-2 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - intent = in - kind = kind_phys -[cld_resnow] - standard_name = mean_effective_radius_for_snow_flake - long_name = mean effective radius for snow flake - units = um - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - intent = in - kind = kind_phys -[cld_rwp] - standard_name = cloud_rain_water_path - long_name = cloud rain water path - units = g m-2 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - intent = in - kind = kind_phys -[cld_rerain] - standard_name = mean_effective_radius_for_rain_drop - long_name = mean effective radius for rain drop - units = um - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - intent = in - kind = kind_phys -[precip_frac] - standard_name = precipitation_fraction_by_layer - long_name = precipitation fraction in each layer - units = frac - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = in -[cld_cnv_lwp] - standard_name = convective_cloud_liquid_water_path - long_name = layer convective cloud liquid water path - units = g m-2 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = in -[cld_cnv_iwp] - standard_name = convective_cloud_ice_water_path - long_name = layer convective cloud ice water path - units = g m-2 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = in -[cld_cnv_reliq] - standard_name = mean_effective_radius_for_liquid_convective_cloud - long_name = mean effective radius for liquid convective cloud - units = um - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = in -[cld_cnv_reice] - standard_name = mean_effective_radius_for_ice_convective_cloud - long_name = mean effective radius for ice convective cloud - units = um - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = in -[cld_pbl_lwp] - standard_name = MYNN_SGS_cloud_liquid_water_path - long_name = layer convective cloud liquid water path - units = g m-2 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = in -[cld_pbl_iwp] - standard_name = MYNN_SGS_cloud_ice_water_path - long_name = layer convective cloud ice water path - units = g m-2 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = in -[cld_pbl_reliq] - standard_name = mean_effective_radius_for_liquid_MYNN_SGS_cloud - long_name = mean effective radius for liquid MYNN_SGS cloud - units = um - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = in -[cld_pbl_reice] - standard_name = mean_effective_radius_for_ice_MYNN_SGS_cloud - long_name = mean effective radius for ice MYNN_SGS cloud - units = um - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = in -[p_lay] - standard_name = air_pressure_at_layer_for_RRTMGP - long_name = air pressure layer - units = Pa - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = in -[nbndsGPlw] - standard_name = number_of_longwave_bands - long_name = number of lw bands used in RRTMGP - units = count - dimensions = () - type = integer - intent = in -[lon] - standard_name = longitude - long_name = longitude - units = radian - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in -[lat] - standard_name = latitude - long_name = latitude - units = radian - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in -[cldtaulw] - standard_name = cloud_optical_depth_layers_at_10mu_band - long_name = approx 10mu band layer cloud optical depth - units = none - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = inout -[lw_optical_props_cloudsByBand] - standard_name = longwave_optical_properties_for_cloudy_atmosphere_by_band - long_name = Fortran DDT containing RRTMGP optical properties - units = DDT - dimensions = () - type = ty_optical_props_2str - intent = inout -[lw_optical_props_cnvcloudsByBand] - standard_name = longwave_optical_properties_for_convective_cloudy_atmosphere_by_band - long_name = Fortran DDT containing RRTMGP optical properties - units = DDT - dimensions = () - type = ty_optical_props_2str - intent = inout -[lw_optical_props_MYNNcloudsByBand] - standard_name = longwave_optical_properties_for_MYNN_EDMF_PBL_cloudy_atmosphere_by_band - long_name = Fortran DDT containing RRTMGP optical properties - units = DDT - dimensions = () - type = ty_optical_props_2str - intent = inout -[lw_optical_props_precipByBand] - standard_name = longwave_optical_properties_for_precipitation_by_band - long_name = Fortran DDT containing RRTMGP optical properties - units = DDT - dimensions = () - type = ty_optical_props_2str - intent = inout -[errmsg] - standard_name = ccpp_error_message - long_name = error message for error handling in CCPP - units = none - dimensions = () - type = character - kind = len=* - intent = out -[errflg] - standard_name = ccpp_error_code - long_name = error code for error handling in CCPP - units = 1 - dimensions = () - type = integer - intent = out - diff --git a/physics/rrtmgp_lw_cloud_sampling.F90 b/physics/rrtmgp_lw_cloud_sampling.F90 deleted file mode 100644 index 80fd3444a..000000000 --- a/physics/rrtmgp_lw_cloud_sampling.F90 +++ /dev/null @@ -1,170 +0,0 @@ -!> \file rrtmgp_lw_cloud_sampling.F90 -!! -!> \defgroup rrtmgp_lw_cloud_sampling rrtmgp_lw_cloud_sampling.F90 -!! -!! \brief -!! -module rrtmgp_lw_cloud_sampling - use machine, only: kind_phys, kind_dbl_prec - use mo_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp - use mo_optical_props, only: ty_optical_props_2str - use rrtmgp_sampling, only: sampled_mask, draw_samples - use mersenne_twister, only: random_setseed, random_number, random_stat - use radiation_tools, only: check_error_msg - use rrtmgp_lw_gas_optics, only: lw_gas_props - use netcdf - - implicit none - -contains - -!>\defgroup rrtmgp_lw_cloud_sampling_mod GFS RRTMGP-LW Cloud Sampling Module -!> \section arg_table_rrtmgp_lw_cloud_sampling_run -!! \htmlinclude rrtmgp_lw_cloud_sampling_run.html -!! -!> \ingroup rrtmgp_lw_cloud_sampling -!! -!! \brief This routine performs the McICA cloud-sampling and maps the shortwave cloud- -!! optical properties, defined for each spectral band, to each spectral point (g-point). -!! -!! \section rrtmgp_lw_cloud_sampling_run - subroutine rrtmgp_lw_cloud_sampling_run(doLWrad, nCol, nLev, icseed_lw, iovr,iovr_convcld,& - iovr_max, iovr_maxrand, iovr_rand, iovr_dcorr, iovr_exp, iovr_exprand, isubc_lw, & - cld_frac, precip_frac, cloud_overlap_param, precip_overlap_param, cld_cnv_frac, & - cnv_cloud_overlap_param, imfdeepcnv, imfdeepcnv_gf, imfdeepcnv_samf, & - lw_optical_props_cloudsByBand, lw_optical_props_cnvcloudsByBand, & - lw_optical_props_precipByBand, lw_optical_props_clouds, lw_optical_props_cnvclouds, & - lw_optical_props_precip, errmsg, errflg) - - ! Inputs - logical, intent(in) :: & - doLWrad ! Logical flag for shortwave radiation call - integer, intent(in) :: & - nCol, & ! Number of horizontal gridpoints - nLev, & ! Number of vertical layers - imfdeepcnv, & ! - imfdeepcnv_gf, & ! - imfdeepcnv_samf, & ! - iovr, & ! Choice of cloud-overlap method - iovr_convcld, & ! Choice of convective cloud-overlap - iovr_max, & ! Flag for maximum cloud overlap method - iovr_maxrand, & ! Flag for maximum-random cloud overlap method - iovr_rand, & ! Flag for random cloud overlap method - iovr_dcorr, & ! Flag for decorrelation-length cloud overlap method - iovr_exp, & ! Flag for exponential cloud overlap method - iovr_exprand, & ! Flag for exponential-random cloud overlap method - isubc_lw - integer,intent(in),dimension(:) :: & - icseed_lw ! auxiliary special cloud related array when module - ! variable isubc_lw=2, it provides permutation seed - ! for each column profile that are used for generating - ! random numbers. when isubc_lw /=2, it will not be used. - real(kind_phys), dimension(:,:),intent(in) :: & - cld_frac, & ! Total cloud fraction by layer - cld_cnv_frac, & ! Convective cloud fraction by layer - precip_frac, & ! Precipitation fraction by layer - cloud_overlap_param, & ! Cloud overlap parameter - cnv_cloud_overlap_param, & ! Convective cloud overlap parameter - precip_overlap_param ! Precipitation overlap parameter - type(ty_optical_props_2str),intent(in) :: & - lw_optical_props_cloudsByBand, & ! RRTMGP DDT: Longwave optical properties in each band (clouds) - lw_optical_props_cnvcloudsByBand, & ! RRTMGP DDT: Longwave optical properties in each band (convective cloud) - lw_optical_props_precipByBand ! RRTMGP DDT: Longwave optical properties in each band (precipitation) - - ! Outputs - character(len=*), intent(out) :: & - errmsg ! CCPP error message - integer, intent(out) :: & - errflg ! CCPP error code - type(ty_optical_props_2str),intent(inout) :: & - lw_optical_props_clouds, & ! RRTMGP DDT: Shortwave optical properties by spectral point (clouds) - lw_optical_props_cnvclouds, & ! RRTMGP DDT: Shortwave optical properties by spectral point (convective cloud) - lw_optical_props_precip ! RRTMGP DDT: Shortwave optical properties by spectral point (precipitation) - - ! Local variables - integer :: iCol, iLay, iBand - integer,dimension(ncol) :: ipseed_lw - type(random_stat) :: rng_stat - real(kind_dbl_prec), dimension(lw_gas_props%get_ngpt(),nLev,ncol) :: rng3D,rng3D2 - real(kind_dbl_prec), dimension(lw_gas_props%get_ngpt()*nLev) :: rng2D - real(kind_dbl_prec), dimension(lw_gas_props%get_ngpt()) :: rng1D - logical, dimension(ncol,nLev,lw_gas_props%get_ngpt()) :: maskMCICA - - ! Initialize CCPP error handling variables - errmsg = '' - errflg = 0 - - if (.not. doLWrad) return - - ! #################################################################################### - ! First sample the clouds... - ! #################################################################################### - lw_optical_props_clouds%band2gpt = lw_gas_props%get_band_lims_gpoint() - lw_optical_props_clouds%band_lims_wvn = lw_gas_props%get_band_lims_wavenumber() - do iBand=1,lw_gas_props%get_nband() - lw_optical_props_clouds%gpt2band(lw_optical_props_clouds%band2gpt(1,iBand):lw_optical_props_clouds%band2gpt(2,iBand)) = iBand - end do - - ! Change random number seed value for each radiation invocation (isubc_lw =1 or 2). - if(isubc_lw == 1) then ! advance prescribed permutation seed - do iCol = 1, ncol - ipseed_lw(iCol) = lw_gas_props%get_ngpt() + iCol - enddo - elseif (isubc_lw == 2) then ! use input array of permutaion seeds - do iCol = 1, ncol - ipseed_lw(iCol) = icseed_lw(iCol) - enddo - endif - - ! Call RNG. Mersennse Twister accepts 1D array, so loop over columns and collapse along G-points - ! and layers. ([nGpts,nLev,nColumn]-> [nGpts*nLev]*nColumn) - do iCol=1,ncol - call random_setseed(ipseed_lw(icol),rng_stat) - ! Use same rng for each layer - if (iovr == iovr_max) then - call random_number(rng1D,rng_stat) - do iLay=1,nLev - rng3D(:,iLay,iCol) = rng1D - enddo - else - do iLay=1,nLev - call random_number(rng1D,rng_stat) - rng3D(:,iLay,iCol) = rng1D - enddo - endif - enddo - - ! Cloud-overlap. - ! Maximum-random, random or maximum. - if (iovr == iovr_maxrand .or. iovr == iovr_rand .or. iovr == iovr_max) then - call sampled_mask(real(rng3D, kind=kind_phys), cld_frac, maskMCICA) - endif - ! Exponential decorrelation length overlap - if (iovr == iovr_dcorr) then - ! Generate second RNG - do iCol=1,ncol - call random_setseed(ipseed_lw(icol),rng_stat) - call random_number(rng2D,rng_stat) - rng3D2(:,:,iCol) = reshape(source = rng2D,shape=[lw_gas_props%get_ngpt(),nLev]) - enddo - call sampled_mask(real(rng3D, kind=kind_phys), cld_frac, maskMCICA, & - overlap_param = cloud_overlap_param(:,1:nLev-1), & - randoms2 = real(rng3D2, kind=kind_phys)) - endif - ! Exponential or Exponential-random - if (iovr == iovr_exp .or. iovr == iovr_exprand) then - call sampled_mask(real(rng3D, kind=kind_phys), cld_frac, maskMCICA, & - overlap_param = cloud_overlap_param(:,1:nLev-1)) - endif - - ! - ! Sampling. Map band optical depth to each g-point using McICA - ! - call check_error_msg('rrtmgp_lw_cloud_sampling_run_draw_samples',& - draw_samples(maskMCICA, .true., & - lw_optical_props_cloudsByBand, & - lw_optical_props_clouds)) - - end subroutine rrtmgp_lw_cloud_sampling_run - -end module rrtmgp_lw_cloud_sampling diff --git a/physics/rrtmgp_lw_cloud_sampling.meta b/physics/rrtmgp_lw_cloud_sampling.meta deleted file mode 100644 index c1ae9d139..000000000 --- a/physics/rrtmgp_lw_cloud_sampling.meta +++ /dev/null @@ -1,226 +0,0 @@ -[ccpp-table-properties] - name = rrtmgp_lw_cloud_sampling - type = scheme - dependencies = machine.F,mersenne_twister.f,rrtmgp_sampling.F90,radiation_tools.F90 - -###################################################### -[ccpp-arg-table] - name = rrtmgp_lw_cloud_sampling_run - type = scheme -[doLWrad] - standard_name = flag_for_calling_longwave_radiation - long_name = logical flags for lw radiation calls - units = flag - dimensions = () - type = logical - intent = in -[imfdeepcnv] - standard_name = control_for_deep_convection_scheme - long_name = flag for mass-flux deep convection scheme - units = flag - dimensions = () - type = integer - intent = in -[imfdeepcnv_gf] - standard_name = identifier_for_grell_freitas_deep_convection - long_name = flag for Grell-Freitas deep convection scheme - units = flag - dimensions = () - type = integer - intent = in -[imfdeepcnv_samf] - standard_name = identifer_for_scale_aware_mass_flux_deep_convection - long_name = flag for SAMF deep convection scheme - units = flag - dimensions = () - type = integer - intent = in -[iovr_convcld] - standard_name = flag_for_convective_cloud_overlap_method_for_radiation - long_name = flag for convective cloud overlap method - units = flag - dimensions = () - type = integer - intent = in -[ncol] - standard_name = horizontal_loop_extent - long_name = horizontal dimension - units = count - dimensions = () - type = integer - intent = in -[nLev] - standard_name = vertical_layer_dimension - long_name = number of vertical levels - units = count - dimensions = () - type = integer - intent = in -[isubc_lw] - standard_name = flag_for_lw_clouds_sub_grid_approximation - long_name = flag for lw clouds sub-grid approximation - units = flag - dimensions = () - type = integer - intent = in -[iovr] - standard_name = flag_for_cloud_overlap_method_for_radiation - long_name = max-random overlap clouds - units = flag - dimensions = () - type = integer - intent = in -[iovr_maxrand] - standard_name = flag_for_maximum_random_cloud_overlap_method - long_name = choice of maximum-random cloud overlap method - units = flag - dimensions = () - type = integer - intent = in -[iovr_dcorr] - standard_name = flag_for_decorrelation_length_cloud_overlap_method - long_name = choice of decorrelation-length cloud overlap method - units = flag - dimensions = () - type = integer - intent = in -[iovr_exp] - standard_name = flag_for_exponential_cloud_overlap_method - long_name = choice of exponential cloud overlap method - units = flag - dimensions = () - type = integer - intent = in -[iovr_exprand] - standard_name = flag_for_exponential_random_cloud_overlap_method - long_name = choice of exponential-random cloud overlap method - units = flag - dimensions = () - type = integer - intent = in -[iovr_rand] - standard_name = flag_for_random_cloud_overlap_method - long_name = choice of random cloud overlap method - units = flag - dimensions = () - type = integer - intent = in -[iovr_max] - standard_name = flag_for_maximum_cloud_overlap_method - long_name = choice of maximum cloud overlap method - units = flag - dimensions = () - type = integer - intent = in -[icseed_lw] - standard_name = random_number_seed_for_mcica_longwave - long_name = seed for random number generation for longwave radiation - units = none - dimensions = (horizontal_loop_extent) - type = integer - intent = in -[cld_frac] - standard_name = total_cloud_fraction - long_name = layer total cloud fraction - units = frac - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = in -[cld_cnv_frac] - standard_name = convective_cloud_fraction_for_RRTMGP - long_name = layer convective cloud fraction - units = frac - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = in -[precip_frac] - standard_name = precipitation_fraction_by_layer - long_name = precipitation fraction in each layer - units = frac - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = in -[cloud_overlap_param] - standard_name = cloud_overlap_param - long_name = cloud overlap parameter - units = km - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = in -[cnv_cloud_overlap_param] - standard_name = convective_cloud_overlap_param - long_name = convective cloud overlap parameter - units = km - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = in -[precip_overlap_param] - standard_name = precip_overlap_param - long_name = precipitation overlap parameter - units = km - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = in -[lw_optical_props_cloudsByBand] - standard_name = longwave_optical_properties_for_cloudy_atmosphere_by_band - long_name = Fortran DDT containing RRTMGP optical properties - units = DDT - dimensions = () - type = ty_optical_props_2str - intent = in -[lw_optical_props_cnvcloudsByBand] - standard_name = longwave_optical_properties_for_convective_cloudy_atmosphere_by_band - long_name = Fortran DDT containing RRTMGP optical properties - units = DDT - dimensions = () - type = ty_optical_props_2str - intent = in -[lw_optical_props_precipByBand] - standard_name = longwave_optical_properties_for_precipitation_by_band - long_name = Fortran DDT containing RRTMGP optical properties - units = DDT - dimensions = () - type = ty_optical_props_2str - intent = in -[lw_optical_props_clouds] - standard_name = longwave_optical_properties_for_cloudy_atmosphere - long_name = Fortran DDT containing RRTMGP optical properties - units = DDT - dimensions = () - type = ty_optical_props_2str - intent = inout -[lw_optical_props_precip] - standard_name = longwave_optical_properties_for_precipitation - long_name = Fortran DDT containing RRTMGP optical properties - units = DDT - dimensions = () - type = ty_optical_props_2str - intent = inout -[lw_optical_props_cnvclouds] - standard_name = longwave_optical_properties_for_convective_cloudy_atmosphere - long_name = Fortran DDT containing RRTMGP optical properties - units = DDT - dimensions = () - type = ty_optical_props_2str - intent = inout -[errmsg] - standard_name = ccpp_error_message - long_name = error message for error handling in CCPP - units = none - dimensions = () - type = character - kind = len=* - intent = out -[errflg] - standard_name = ccpp_error_code - long_name = error code for error handling in CCPP - units = 1 - dimensions = () - type = integer - intent = out diff --git a/physics/rrtmgp_lw_gas_optics.F90 b/physics/rrtmgp_lw_gas_optics.F90 index fad01a336..8cd38f210 100644 --- a/physics/rrtmgp_lw_gas_optics.F90 +++ b/physics/rrtmgp_lw_gas_optics.F90 @@ -12,8 +12,6 @@ module rrtmgp_lw_gas_optics use mo_rte_kind, only: wl use mo_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp use mo_gas_concentrations, only: ty_gas_concs - use mo_source_functions, only: ty_source_func_lw - use mo_optical_props, only: ty_optical_props_1scl use radiation_tools, only: check_error_msg use netcdf #ifdef MPI @@ -77,28 +75,18 @@ module rrtmgp_lw_gas_optics contains -!>\defgroup rrtmgp_lw_gas_optics_mod GFS RRTMGP-LW Gas Optics Module -!! \section arg_table_rrtmgp_lw_gas_optics_init -!! \htmlinclude rrtmgp_lw_gas_optics.html -!! -!> \ingroup rrtmgp_lw_gas_optics -!! -!! RRTMGP relies heavility on derived-data-types, which contain type-bound procedures -!! that are referenced frequently throughout the RRTMGP longwave scheme. The data needed -!! for the correlated k-distribution is also contained within this type. Within this module, -!! the full k-distribution data is read in, reduced by the "active gases" provided, and -!! loaded into the RRTMGP DDT, ty_gas_optics_rrtmgp. -!! -!! \section rrtmgp_lw_gas_optics_init - ! ###################################################################################### - subroutine rrtmgp_lw_gas_optics_init(rrtmgp_root_dir, rrtmgp_lw_file_gas, mpicomm, & - mpirank, mpiroot, minGPpres, maxGPpres, minGPtemp, maxGPtemp, active_gases_array, & - errmsg, errflg) + ! ######################################################################################### + ! SUBROUTINE rrtmgp_lw_gas_optics_init + ! ######################################################################################### + subroutine rrtmgp_lw_gas_optics_init(rrtmgp_root_dir, rrtmgp_lw_file_gas, & + active_gases_array, mpicomm, mpirank, mpiroot, errmsg, errflg) ! Inputs character(len=128),intent(in) :: & rrtmgp_root_dir, & ! RTE-RRTMGP root directory - rrtmgp_lw_file_gas ! RRTMGP file containing coefficients used to compute gaseous optical properties + rrtmgp_lw_file_gas ! RRTMGP file containing K-distribution data + character(len=*), dimension(:), intent(in) :: & + active_gases_array ! List of active gases from namelist as array integer,intent(in) :: & mpicomm, & ! MPI communicator mpirank, & ! Current MPI rank @@ -109,20 +97,12 @@ subroutine rrtmgp_lw_gas_optics_init(rrtmgp_root_dir, rrtmgp_lw_file_gas, mpicom errmsg ! CCPP error message integer, intent(out) :: & errflg ! CCPP error code - real(kind_phys), intent(out) :: & - minGPtemp, & ! Minimum temperature allowed by RRTMGP. - maxGPtemp, & ! Maximum ... - minGPpres, & ! Minimum pressure allowed by RRTMGP. - maxGPpres ! Maximum pressure allowed by RRTMGP. - character(len=*), dimension(:), intent(in) :: & - active_gases_array ! List of active gases from namelist as array ! Local variables - integer :: ncid, dimID, varID, status, iGas, ierr, ii, mpierr, iChar - integer,dimension(:),allocatable :: temp1, temp2, temp3, temp4, & - temp_log_array1, temp_log_array2, temp_log_array3, temp_log_array4 + integer :: ncid, dimID, varID, status, ii, mpierr, iChar + integer,dimension(:),allocatable :: temp1, temp2, temp3, temp4 character(len=264) :: lw_gas_props_file - type(ty_gas_concs) :: gas_concentrations ! RRTMGP DDT: trace gas concentrations (vmr) + type(ty_gas_concs) :: gas_concs ! RRTMGP DDT: trace gas concentrations (vmr) ! Initialize errmsg = '' @@ -455,9 +435,8 @@ subroutine rrtmgp_lw_gas_optics_init(rrtmgp_root_dir, rrtmgp_lw_file_gas, mpicom ! Initialize RRTMGP DDT's... ! ! ####################################################################################### - allocate(gas_concentrations%gas_name(1:size(active_gases_array))) - gas_concentrations%gas_name(:) = active_gases_array(:) - call check_error_msg('rrtmgp_lw_gas_optics_init',lw_gas_props%load(gas_concentrations, & + call check_error_msg('rrtmgp_lw_gas_optics_init_gas_concs',gas_concs%init(active_gases_array)) + call check_error_msg('rrtmgp_lw_gas_optics_init_load',lw_gas_props%load(gas_concs, & gas_namesLW, key_speciesLW, band2gptLW, band_limsLW, press_refLW, press_ref_tropLW,& temp_refLW, temp_ref_pLW, temp_ref_tLW, vmr_refLW, kmajorLW, kminor_lowerLW, & kminor_upperLW, gas_minorLW, identifier_minorLW, minor_gases_lowerLW, & @@ -467,80 +446,6 @@ subroutine rrtmgp_lw_gas_optics_init(rrtmgp_root_dir, rrtmgp_lw_file_gas, mpicom scale_by_complement_upperLW, kminor_start_lowerLW, kminor_start_upperLW, totplnkLW,& planck_fracLW, rayl_lowerLW, rayl_upperLW, optimal_angle_fitLW)) - ! The minimum pressure allowed in GP RTE calculations. Used to bound uppermost layer - ! temperature (GFS_rrtmgp_pre.F90) - minGPpres = lw_gas_props%get_press_min() - maxGPpres = lw_gas_props%get_press_max() - minGPtemp = lw_gas_props%get_temp_min() - maxGPtemp = lw_gas_props%get_temp_max() - end subroutine rrtmgp_lw_gas_optics_init -!> \section arg_table_rrtmgp_lw_gas_optics_run -!! \htmlinclude rrtmgp_lw_gas_optics_run.html -!! -!! Compute longwave optical prperties (optical-depth) for clear-sky conditions. -!! \section rrtmgp_lw_gas_optics_run - subroutine rrtmgp_lw_gas_optics_run(doLWrad, nCol, nLev, p_lay, p_lev, t_lay, t_lev, tsfg, & - gas_concentrations, lw_optical_props_clrsky, sources, errmsg, errflg) - - ! Inputs - logical, intent(in) :: & - doLWrad ! Flag to calculate LW irradiances - integer,intent(in) :: & - ncol, & ! Number of horizontal points - nLev ! Number of vertical levels - real(kind_phys), dimension(ncol,nLev), intent(in) :: & - p_lay, & ! Pressure @ model layer-centers (Pa) - t_lay ! Temperature (K) - real(kind_phys), dimension(ncol,nLev+1), intent(in) :: & - p_lev, & ! Pressure @ model layer-interfaces (Pa) - t_lev ! Temperature @ model levels - real(kind_phys), dimension(ncol), intent(in) :: & - tsfg ! Surface ground temperature (K) - type(ty_gas_concs),intent(in) :: & - gas_concentrations ! RRTMGP DDT: trace gas concentrations (vmr) - - ! Output - character(len=*), intent(out) :: & - errmsg ! CCPP error message - integer, intent(out) :: & - errflg ! CCPP error code - type(ty_optical_props_1scl),intent(inout) :: & - lw_optical_props_clrsky ! RRTMGP DDT: longwave clear-sky radiative properties - type(ty_source_func_lw),intent(inout) :: & - sources ! RRTMGP DDT: longwave source functions - - ! Local - integer :: ii - - ! Initialize CCPP error handling variables - errmsg = '' - errflg = 0 - - if (.not. doLWrad) return - - ! Copy spectral information into GP DDTs. - lw_optical_props_clrsky%band2gpt = lw_gas_props%get_band_lims_gpoint() - sources%band2gpt = lw_gas_props%get_band_lims_gpoint() - sources%band_lims_wvn = lw_gas_props%get_band_lims_wavenumber() - lw_optical_props_clrsky%band_lims_wvn = lw_gas_props%get_band_lims_wavenumber() - do ii=1,nbndsLW - lw_optical_props_clrsky%gpt2band(band2gptLW(1,ii):band2gptLW(2,ii)) = ii - sources%gpt2band(band2gptLW(1,ii):band2gptLW(2,ii)) = ii - end do - - ! Gas-optics - call check_error_msg('rrtmgp_lw_gas_optics_run',lw_gas_props%gas_optics(& - p_lay, & ! IN - Pressure @ layer-centers (Pa) - p_lev, & ! IN - Pressure @ layer-interfaces (Pa) - t_lay, & ! IN - Temperature @ layer-centers (K) - tsfg, & ! IN - Skin-temperature (K) - gas_concentrations, & ! IN - RRTMGP DDT: trace gas volumne mixing-ratios - lw_optical_props_clrsky, & ! OUT - RRTMGP DDT: longwave optical properties - sources, & ! OUT - RRTMGP DDT: source functions - tlev=t_lev)) ! IN - Temperature @ layer-interfaces (K) (optional) - - end subroutine rrtmgp_lw_gas_optics_run - end module rrtmgp_lw_gas_optics diff --git a/physics/rrtmgp_lw_gas_optics.meta b/physics/rrtmgp_lw_gas_optics.meta deleted file mode 100644 index 0b484b6ac..000000000 --- a/physics/rrtmgp_lw_gas_optics.meta +++ /dev/null @@ -1,203 +0,0 @@ -[ccpp-table-properties] - name = rrtmgp_lw_gas_optics - type = scheme - dependencies = machine.F,radiation_tools.F90,GFS_rrtmgp_pre.F90,rte-rrtmgp/rrtmgp/mo_gas_optics_rrtmgp.F90,rte-rrtmgp/rte/mo_rte_kind.F90,rte-rrtmgp/rrtmgp/mo_gas_concentrations.F90,rte-rrtmgp/rte/mo_optical_props.F90,rte-rrtmgp/rte/mo_source_functions.F90 - -######################################################################## -[ccpp-arg-table] - name = rrtmgp_lw_gas_optics_init - type = scheme -[rrtmgp_root_dir] - standard_name = directory_for_rte_rrtmgp_source_code - long_name = directory for rte+rrtmgp source code - units = none - dimensions = () - type = character - intent = in - kind = len=128 -[rrtmgp_lw_file_gas] - standard_name = filename_of_rrtmgp_longwave_k_distribution - long_name = file containing RRTMGP LW k-distribution - units = none - dimensions = () - type = character - intent = in - kind = len=128 -[mpirank] - standard_name = mpi_rank - long_name = current MPI rank - units = index - dimensions = () - type = integer - intent = in -[mpiroot] - standard_name = mpi_root - long_name = master MPI rank - units = index - dimensions = () - type = integer - intent = in -[mpicomm] - standard_name = mpi_communicator - long_name = MPI communicator - units = index - dimensions = () - type = integer - intent = in -[minGPpres] - standard_name = minimum_pressure_in_RRTMGP - long_name = minimum pressure allowed in RRTMGP - units = Pa - dimensions = () - type = real - kind = kind_phys - intent = out -[maxGPpres] - standard_name = maximum_pressure_in_RRTMGP - long_name = maximum pressure allowed in RRTMGP - units = Pa - dimensions = () - type = real - kind = kind_phys - intent = out -[minGPtemp] - standard_name = minimum_temperature_in_RRTMGP - long_name = minimum temperature allowed in RRTMGP - units = K - dimensions = () - type = real - kind = kind_phys - intent = out -[maxGPtemp] - standard_name = maximum_temperature_in_RRTMGP - long_name = maximum temperature allowed in RRTMGP - units = K - dimensions = () - type = real - kind = kind_phys - intent = out -[active_gases_array] - standard_name = list_of_active_gases_used_by_RRTMGP - long_name = list of active gases used by RRTMGP - units = none - dimensions = (number_of_active_gases_used_by_RRTMGP) - type = character - kind = len=* - intent = in -[errmsg] - standard_name = ccpp_error_message - long_name = error message for error handling in CCPP - units = none - dimensions = () - type = character - kind = len=* - intent = out -[errflg] - standard_name = ccpp_error_code - long_name = error code for error handling in CCPP - units = 1 - dimensions = () - type = integer - intent = out - -######################################################################## -[ccpp-arg-table] - name = rrtmgp_lw_gas_optics_run - type = scheme -[doLWrad] - standard_name = flag_for_calling_longwave_radiation - long_name = flag to calculate LW irradiances - units = flag - dimensions = () - type = logical - intent = in -[ncol] - standard_name = horizontal_loop_extent - long_name = horizontal dimension - units = count - dimensions = () - type = integer - intent = in -[nLev] - standard_name = vertical_layer_dimension - long_name = number of vertical levels - units = count - dimensions = () - type = integer - intent = in -[p_lay] - standard_name = air_pressure_at_layer_for_RRTMGP - long_name = air pressure layer - units = Pa - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = in -[p_lev] - standard_name = air_pressure_at_interface_for_RRTMGP - long_name = air pressure level - units = Pa - dimensions = (horizontal_loop_extent,vertical_interface_dimension) - type = real - kind = kind_phys - intent = in -[t_lay] - standard_name = air_temperature_at_layer_for_RRTMGP - long_name = air temperature layer - units = K - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = in -[t_lev] - standard_name = air_temperature_at_interface_for_RRTMGP - long_name = air temperature level - units = K - dimensions = (horizontal_loop_extent,vertical_interface_dimension) - type = real - kind = kind_phys - intent = in -[tsfg] - standard_name = surface_ground_temperature_for_radiation - long_name = surface ground temperature for radiation - units = K - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in -[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 -[lw_optical_props_clrsky] - standard_name = longwave_optical_properties_for_clear_sky - long_name = Fortran DDT containing RRTMGP optical properties - units = DDT - dimensions = () - type = ty_optical_props_1scl - intent = inout -[sources] - standard_name = longwave_source_function - long_name = Fortran DDT containing RRTMGP source functions - units = DDT - dimensions = () - type = ty_source_func_lw - intent = inout -[errmsg] - standard_name = ccpp_error_message - long_name = error message for error handling in CCPP - units = none - dimensions = () - type = character - kind = len=* - intent = out -[errflg] - standard_name = ccpp_error_code - long_name = error code for error handling in CCPP - units = 1 - dimensions = () - type = integer - intent = out diff --git a/physics/rrtmgp_lw_main.F90 b/physics/rrtmgp_lw_main.F90 new file mode 100644 index 000000000..c0bc99d35 --- /dev/null +++ b/physics/rrtmgp_lw_main.F90 @@ -0,0 +1,611 @@ +! ########################################################################################### +!> \file rrtmgp_lw_main.F90 +!! +!> \defgroup rrtmgp_lw_main rrtmgp_lw_main.F90 +!! +!! \brief This module contains the longwave RRTMGP radiation scheme. +!! +! ########################################################################################### +module rrtmgp_lw_main + use machine, only: kind_phys, kind_dbl_prec + use mo_optical_props, only: ty_optical_props_1scl, ty_optical_props_2str + use mo_cloud_optics, only: ty_cloud_optics + use mo_rte_lw, only: rte_lw + use mo_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp + use mo_gas_concentrations, only: ty_gas_concs + use mo_fluxes_byband, only: ty_fluxes_byband + use mo_source_functions, only: ty_source_func_lw + use radiation_tools, only: check_error_msg + use rrtmgp_lw_gas_optics, only: lw_gas_props,rrtmgp_lw_gas_optics_init + use rrtmgp_lw_cloud_optics, only: lw_cloud_props, rrtmgp_lw_cloud_optics_init, abssnow0, & + abssnow1, absrain + use module_radiation_gases, only: NF_VGAS, getgases, getozn + use GFS_rrtmgp_pre, only: iStr_h2o, iStr_co2, iStr_o3, iStr_n2o, iStr_ch4, & + iStr_o2, iStr_ccl4, iStr_cfc11, iStr_cfc12, iStr_cfc22, & + eps, oneminus, ftiny + use mersenne_twister, only: random_setseed, random_number, random_stat + use rrtmgp_sampling, only: sampled_mask, draw_samples + implicit none + + type(ty_gas_concs) :: gas_concs + type(ty_optical_props_1scl) :: lw_optical_props_clrsky, lw_optical_props_aerosol_local + type(ty_optical_props_2str) :: lw_optical_props_clouds, lw_optical_props_cloudsByBand, & + lw_optical_props_cnvcloudsByBand, lw_optical_props_pblcloudsByBand, & + lw_optical_props_precipByBand + type(ty_source_func_lw) :: sources + + public rrtmgp_lw_main_init, rrtmgp_lw_main_run +contains + ! ######################################################################################### +!! \section arg_table_rrtmgp_lw_main_init +!! \htmlinclude rrtmgp_lw_main_int.html +!! +!> \ingroup rrtmgp_lw_main +!! +!! \brief +!! +!! \section rrtmgp_lw_main_init +!> @{ + ! ######################################################################################### + subroutine rrtmgp_lw_main_init(rrtmgp_root_dir, rrtmgp_lw_file_gas, rrtmgp_lw_file_clouds,& + active_gases_array, doGP_cldoptics_PADE, doGP_cldoptics_LUT, doGP_sgs_pbl, & + doGP_sgs_cnv, nrghice, mpicomm, mpirank, mpiroot, nLay, rrtmgp_phys_blksz, & + errmsg, errflg) + + ! Inputs + character(len=128),intent(in) :: & + rrtmgp_root_dir, & ! RTE-RRTMGP root directory + rrtmgp_lw_file_clouds, & ! RRTMGP file containing coefficients used to compute + ! clouds optical properties + rrtmgp_lw_file_gas ! RRTMGP file containing coefficients used to compute + ! gaseous optical properties + character(len=*), dimension(:), intent(in) :: & + active_gases_array ! List of active gases from namelist as array) + logical, intent(in) :: & + doGP_cldoptics_PADE, & ! Use RRTMGP cloud-optics: PADE approximation? + doGP_cldoptics_LUT, & ! Use RRTMGP cloud-optics: LUTs? + doGP_sgs_pbl, & ! Flag to include sgs PBL clouds + doGP_sgs_cnv ! Flag to include sgs convective clouds + integer, intent(inout) :: & + nrghice ! Number of ice-roughness categories + integer,intent(in) :: & + mpicomm, & ! MPI communicator + mpirank, & ! Current MPI rank + mpiroot, & ! Master MPI rank + rrtmgp_phys_blksz, & ! Number of horizontal points to process at once. + nLay + + ! Outputs + character(len=*), intent(out) :: & + errmsg ! CCPP error message + integer, intent(out) :: & + errflg ! CCPP error code + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + ! RRTMGP longwave gas-optics (k-distribution) initialization + call rrtmgp_lw_gas_optics_init(rrtmgp_root_dir, rrtmgp_lw_file_gas, & + active_gases_array, mpicomm, mpirank, mpiroot, errmsg, errflg) + + ! RRTMGP longwave cloud-optics initialization + call rrtmgp_lw_cloud_optics_init(rrtmgp_root_dir, rrtmgp_lw_file_clouds, & + doGP_cldoptics_PADE, doGP_cldoptics_LUT, nrghice, mpicomm, mpirank, mpiroot, & + errmsg, errflg) + + ! DDTs + + ! ty_gas_concs + call check_error_msg('rrtmgp_lw_main_gas_concs_init',gas_concs%init(active_gases_array)) + + ! ty_optical_props + call check_error_msg('rrtmgp_lw_main_gas_optics_init',& + lw_optical_props_clrsky%alloc_1scl(rrtmgp_phys_blksz, nLay, lw_gas_props)) + call check_error_msg('rrtmgp_lw_main_sources_init',& + sources%alloc(rrtmgp_phys_blksz, nLay, lw_gas_props)) + call check_error_msg('rrtmgp_lw_main_cloud_optics_init',& + lw_optical_props_cloudsByBand%alloc_2str(rrtmgp_phys_blksz, nLay, lw_gas_props%get_band_lims_wavenumber())) + call check_error_msg('rrtmgp_lw_main_precip_optics_init',& + lw_optical_props_precipByBand%alloc_2str(rrtmgp_phys_blksz, nLay, lw_gas_props%get_band_lims_wavenumber())) + call check_error_msg('rrtmgp_lw_mian_cloud_sampling_init', & + lw_optical_props_clouds%alloc_2str(rrtmgp_phys_blksz, nLay, lw_gas_props)) + call check_error_msg('rrtmgp_lw_main_aerosol_optics_init',& + lw_optical_props_aerosol_local%alloc_1scl(rrtmgp_phys_blksz, nLay, lw_gas_props%get_band_lims_wavenumber())) + if (doGP_sgs_cnv) then + call check_error_msg('rrtmgp_lw_main_cnv_cloud_optics_init',& + lw_optical_props_cnvcloudsByBand%alloc_2str(rrtmgp_phys_blksz, nLay, lw_gas_props%get_band_lims_wavenumber())) + endif + if (doGP_sgs_pbl) then + call check_error_msg('rrtmgp_lw_main_pbl_cloud_optics_init',& + lw_optical_props_pblcloudsByBand%alloc_2str(rrtmgp_phys_blksz, nLay, lw_gas_props%get_band_lims_wavenumber())) + endif + + end subroutine rrtmgp_lw_main_init +!> @} + ! ###################################################################################### +!! \section arg_table_rrtmgp_lw_main_run +!! \htmlinclude rrtmgp_lw_main_run.html +!! +!> \ingroup rrtmgp_lw_main +!! +!! \brief +!! +!! \section rrtmgp_lw_main_run +!> @{ + ! ###################################################################################### + subroutine rrtmgp_lw_main_run(doLWrad, doLWclrsky, top_at_1, doGP_lwscat, & + use_LW_jacobian, doGP_sgs_cnv, doGP_sgs_pbl, nCol, nLay, nGases,rrtmgp_phys_blksz,& + nGauss_angles, icseed_lw, iovr, iovr_convcld, iovr_max, iovr_maxrand, iovr_rand, & + iovr_dcorr, iovr_exp, iovr_exprand, isubc_lw, semis, tsfg, p_lay, p_lev, t_lay, & + t_lev, vmr_o2, vmr_h2o, vmr_o3, vmr_ch4, vmr_n2o, vmr_co2, & + cld_frac, cld_lwp, cld_reliq, cld_iwp, cld_reice, cld_swp, cld_resnow, & + cld_rwp, cld_rerain, precip_frac, cld_cnv_lwp, cld_cnv_reliq, cld_cnv_iwp, & + cld_cnv_reice, cld_pbl_lwp, cld_pbl_reliq, cld_pbl_iwp, cld_pbl_reice, & + cloud_overlap_param, active_gases_array, aerlw_tau, aerlw_ssa, aerlw_g, & + fluxlwUP_allsky, fluxlwDOWN_allsky, fluxlwUP_clrsky, fluxlwDOWN_clrsky, & + fluxlwUP_jac, fluxlwUP_radtime, fluxlwDOWN_radtime, errmsg, errflg) + + ! Inputs + logical, intent(in) :: & + doLWrad, & ! Flag to perform longwave calculation + doLWclrsky, & ! Flag to compute clear-sky fluxes + top_at_1, & ! Flag for vertical ordering convention + use_LW_jacobian, & ! Flag to compute Jacobian of longwave surface flux + doGP_sgs_pbl, & ! Flag to include sgs PBL clouds + doGP_sgs_cnv, & ! Flag to include sgs convective clouds + doGP_lwscat ! Flag to include scattering in clouds + integer,intent(in) :: & + nCol, & ! Number of horizontal points + nLay, & ! Number of vertical grid points. + nGases, & ! Number of active gases + rrtmgp_phys_blksz, & ! Number of horizontal points to process at once. + nGauss_angles, & ! Number of gaussian quadrature angles used + iovr, & ! Choice of cloud-overlap method + iovr_convcld, & ! Choice of convective cloud-overlap + iovr_max, & ! Flag for maximum cloud overlap method + iovr_maxrand, & ! Flag for maximum-random cloud overlap method + iovr_rand, & ! Flag for random cloud overlap method + iovr_dcorr, & ! Flag for decorrelation-length cloud overlap method + iovr_exp, & ! Flag for exponential cloud overlap method + iovr_exprand, & ! Flag for exponential-random cloud overlap method + isubc_lw ! Flag for cloud-seeding (rng) for cloud-sampling + integer,intent(in),dimension(:) :: & + icseed_lw ! Seed for random number generation for longwave radiation + real(kind_phys), dimension(:), intent(in) :: & + semis, & ! Surface-emissivity (1) + tsfg ! Skin temperature (K) + real(kind_phys), dimension(:,:), intent(in) :: & + p_lay, & ! Pressure @ model layer-centers (Pa) + t_lay, & ! Temperature (K) + p_lev, & ! Pressure @ model layer-interfaces (Pa) + t_lev, & ! Temperature @ model levels (K) + vmr_o2, & ! Molar-mixing ratio oxygen + vmr_h2o, & ! Molar-mixing ratio water vapor + vmr_o3, & ! Molar-mixing ratio ozone + vmr_ch4, & ! Molar-mixing ratio methane + vmr_n2o, & ! Molar-mixing ratio nitrous oxide + vmr_co2, & ! Molar-mixing ratio carbon dioxide + cld_frac, & ! Cloud-fraction for stratiform clouds + cld_lwp, & ! Water path for stratiform liquid cloud-particles + cld_reliq, & ! Effective radius for stratiform liquid cloud-particles + cld_iwp, & ! Water path for stratiform ice cloud-particles + cld_reice, & ! Effective radius for stratiform ice cloud-particles + cld_swp, & ! Water path for snow hydrometeors + cld_resnow, & ! Effective radius for snow hydrometeors + cld_rwp, & ! Water path for rain hydrometeors + cld_rerain, & ! Effective radius for rain hydrometeors + precip_frac, & ! Precipitation fraction (not active, currently precipitation optics uses cloud-fraction) + cld_cnv_lwp, & ! Water path for convective liquid cloud-particles + cld_cnv_reliq, & ! Effective radius for convective liquid cloud-particles + cld_cnv_iwp, & ! Water path for convective ice cloud-particles + cld_cnv_reice, & ! Effective radius for convective ice cloud-particles + cld_pbl_lwp, & ! Water path for PBL liquid cloud-particles + cld_pbl_reliq, & ! Effective radius for PBL liquid cloud-particles + cld_pbl_iwp, & ! Water path for PBL ice cloud-particles + cld_pbl_reice, & ! Effective radius for PBL ice cloud-particles + cloud_overlap_param ! Cloud overlap parameter + real(kind_phys), dimension(:,:,:), intent(in) :: & + aerlw_tau, & ! Aerosol optical depth + aerlw_ssa, & ! Aerosol single scattering albedo + aerlw_g ! Aerosol asymmetry paramter + character(len=*), dimension(:), intent(in) :: & + active_gases_array ! List of active gases from namelist as array + + ! Outputs + real(kind_phys), dimension(:,:), intent(inout) :: & + fluxlwUP_jac, & ! Jacobian of upwelling LW surface radiation (W/m2/K) + fluxlwUP_allsky, & ! All-sky flux (W/m2) + fluxlwDOWN_allsky, & ! All-sky flux (W/m2) + fluxlwUP_clrsky, & ! Clear-sky flux (W/m2) + fluxlwDOWN_clrsky, & ! All-sky flux (W/m2) + fluxlwUP_radtime, & ! Copy of fluxes (Used for coupling) + fluxlwDOWN_radtime ! + character(len=*), intent(out) :: & + errmsg ! CCPP error message + integer, intent(out) :: & + errflg ! CCPP error flag + + ! Local variables + type(ty_fluxes_byband) :: flux_allsky, flux_clrsky + integer :: iCol, iLay, iGas, iBand, iCol2, ix, iblck + integer, dimension(rrtmgp_phys_blksz) :: ipseed_lw + type(random_stat) :: rng_stat + real(kind_phys), dimension(rrtmgp_phys_blksz) :: zcf0, zcf1 + logical, dimension(rrtmgp_phys_blksz,nLay,lw_gas_props%get_ngpt()) :: maskMCICA + real(kind_phys), dimension(rrtmgp_phys_blksz) :: tau_rain, tau_snow + real(kind_dbl_prec), dimension(lw_gas_props%get_ngpt()) :: rng1D + real(kind_dbl_prec), dimension(lw_gas_props%get_ngpt(),nLay,rrtmgp_phys_blksz) :: rng3D,rng3D2 + real(kind_dbl_prec), dimension(lw_gas_props%get_ngpt()*nLay) :: rng2D + real(kind_phys), dimension(rrtmgp_phys_blksz,nLay+1,lw_gas_props%get_nband()),target :: & + fluxLW_up_allsky, fluxLW_up_clrsky, fluxLW_dn_allsky, fluxLW_dn_clrsky + real(kind_phys), dimension(rrtmgp_phys_blksz,lw_gas_props%get_ngpt()) :: lw_Ds + real(kind_phys), dimension(lw_gas_props%get_nband(),rrtmgp_phys_blksz) :: sfc_emiss_byband + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + if (.not. doLWrad) return + + ! ###################################################################################### + ! + ! Loop over all columns... + ! + ! ###################################################################################### + do iCol=1,nCol,rrtmgp_phys_blksz + iCol2 = iCol + rrtmgp_phys_blksz - 1 + + ! Initialize/reset + + ! ty_optical_props + lw_optical_props_clrsky%tau = 0._kind_phys + lw_optical_props_precipByBand%tau = 0._kind_phys + lw_optical_props_precipByBand%ssa = 0._kind_phys + lw_optical_props_precipByBand%g = 0._kind_phys + lw_optical_props_cloudsByBand%tau = 0._kind_phys + lw_optical_props_cloudsByBand%ssa = 0._kind_phys + lw_optical_props_cloudsByBand%g = 0._kind_phys + lw_optical_props_clouds%tau = 0._kind_phys + lw_optical_props_clouds%ssa = 0._kind_phys + lw_optical_props_clouds%g = 0._kind_phys + sources%sfc_source = 0._kind_phys + sources%lay_source = 0._kind_phys + sources%lev_source_inc = 0._kind_phys + sources%lev_source_dec = 0._kind_phys + sources%sfc_source_Jac = 0._kind_phys + fluxLW_up_allsky = 0._kind_phys + fluxLW_dn_allsky = 0._kind_phys + fluxLW_up_clrsky = 0._kind_phys + fluxLW_dn_clrsky = 0._kind_phys + if (doGP_sgs_cnv) lw_optical_props_cnvcloudsByBand%tau = 0._kind_phys + if (doGP_sgs_pbl) lw_optical_props_pblcloudsByBand%tau = 0._kind_phys + + ! ty_fluxes_byband + fluxLW_up_allsky = 0._kind_phys + fluxLW_dn_allsky = 0._kind_phys + fluxLW_up_clrsky = 0._kind_phys + fluxLW_dn_clrsky = 0._kind_phys + flux_allsky%bnd_flux_up => fluxLW_up_allsky + flux_allsky%bnd_flux_dn => fluxLW_dn_allsky + flux_clrsky%bnd_flux_up => fluxLW_up_clrsky + flux_clrsky%bnd_flux_dn => fluxLW_dn_clrsky + + ! ################################################################################### + ! + ! Set gas-concentrations + ! + ! ################################################################################### + call check_error_msg('rrtmgp_lw_main_set_vmr_o2', & + gas_concs%set_vmr(trim(active_gases_array(istr_o2)), vmr_o2(iCol:iCol2,:))) + call check_error_msg('rrtmgp_lw_main_set_vmr_co2', & + gas_concs%set_vmr(trim(active_gases_array(istr_co2)),vmr_co2(iCol:iCol2,:))) + call check_error_msg('rrtmgp_lw_main_set_vmr_ch4', & + gas_concs%set_vmr(trim(active_gases_array(istr_ch4)),vmr_ch4(iCol:iCol2,:))) + call check_error_msg('rrtmgp_lw_main_set_vmr_n2o', & + gas_concs%set_vmr(trim(active_gases_array(istr_n2o)),vmr_n2o(iCol:iCol2,:))) + call check_error_msg('rrtmgp_lw_main_set_vmr_h2o', & + gas_concs%set_vmr(trim(active_gases_array(istr_h2o)),vmr_h2o(iCol:iCol2,:))) + call check_error_msg('rrtmgp_lw_main_set_vmr_o3', & + gas_concs%set_vmr(trim(active_gases_array(istr_o3)), vmr_o3(iCol:iCol2,:))) + + ! ################################################################################### + ! + ! Surface emissity in each band + ! + ! ################################################################################### + ! Assign same emissivity to all band + do iblck=1,rrtmgp_phys_blksz + if (semis(iCol+iblck-1) > eps .and. semis(iCol+iblck-1) <= 1._kind_phys) then + do iBand=1,lw_gas_props%get_nband() + sfc_emiss_byband(iBand,iblck) = semis(iCol+iblck-1) + enddo + else + sfc_emiss_byband(1:lw_gas_props%get_nband(),iblck) = 1.0 + endif + enddo + + ! ################################################################################### + ! + ! Compute gas-optics... + ! + ! ################################################################################### + call check_error_msg('rrtmgp_lw_main_gas_optics',lw_gas_props%gas_optics(& + p_lay(iCol:iCol2,:), & ! IN - Pressure @ layer-centers (Pa) + p_lev(iCol:iCol2,:), & ! IN - Pressure @ layer-interfaces (Pa) + t_lay(iCol:iCol2,:), & ! IN - Temperature @ layer-centers (K) + tsfg(iCol:iCol2), & ! IN - Skin-temperature (K) + gas_concs, & ! IN - RRTMGP DDT: trace gas volumne mixing-ratios + lw_optical_props_clrsky, & ! OUT - RRTMGP DDT: longwave optical properties + sources, & ! OUT - RRTMGP DDT: source functions + tlev=t_lev(iCol:iCol2,:))) ! IN - Temperature @ layer-interfaces (K) (optional) + + ! ################################################################################### + ! + ! Compute cloud-optics... + ! + ! ################################################################################### + ! Create clear/cloudy indicator + zcf0(:) = 1._kind_phys + zcf1(:) = 1._kind_phys + do iblck = 1, rrtmgp_phys_blksz + do iLay=1,nLay + zcf0(iblck) = min(zcf0(iblck), 1._kind_phys - cld_frac(iCol+iblck-1,iLay)) + enddo + if (zcf0(iblck) <= ftiny) zcf0(iblck) = 0._kind_phys + if (zcf0(iblck) > oneminus) zcf0(iblck) = 1._kind_phys + zcf1(iblck) = 1._kind_phys - zcf0(iblck) + enddo + + if (any(zcf1 .gt. eps)) then + ! Microphysical (gridmean) cloud optics + call check_error_msg('rrtmgp_lw_main_cloud_optics',lw_cloud_props%cloud_optics(& + cld_lwp(iCol:iCol2,:), & ! IN - Cloud liquid water path (g/m2) + cld_iwp(iCol:iCol2,:), & ! IN - Cloud ice water path (g/m2) + cld_reliq(iCol:iCol2,:), & ! IN - Cloud liquid effective radius (microns) + cld_reice(iCol:iCol2,:), & ! IN - Cloud ice effective radius (microns) + lw_optical_props_cloudsByBand)) ! OUT - RRTMGP DDT containing cloud radiative properties + ! in each band + ! Include convective (subgrid scale) clouds? + if (doGP_sgs_cnv) then + ! Compute + call check_error_msg('rrtmgp_lw_main_cnv_cloud_optics',lw_cloud_props%cloud_optics(& + cld_cnv_lwp(iCol:iCol2,:), & ! IN - Convective cloud liquid water path (g/m2) + cld_cnv_iwp(iCol:iCol2,:), & ! IN - Convective cloud ice water path (g/m2) + cld_cnv_reliq(iCol:iCol2,:), & ! IN - Convective cloud liquid effective radius (microns) + cld_cnv_reice(iCol:iCol2,:), & ! IN - Convective cloud ice effective radius (microns) + lw_optical_props_cnvcloudsByBand)) ! OUT - RRTMGP DDT containing convective cloud radiative properties + ! in each band + ! Increment + call check_error_msg('rrtmgp_lw_main_increment_cnvclouds_to_clouds',& + lw_optical_props_cnvcloudsByBand%increment(lw_optical_props_cloudsByBand)) + endif + + ! Include PBL (subgrid scale) clouds? + if (doGP_sgs_pbl) then + ! Compute + call check_error_msg('rrtmgp_lw_main_pbl_cloud_optics',lw_cloud_props%cloud_optics(& + cld_pbl_lwp(iCol:iCol2,:), & ! IN - PBL cloud liquid water path (g/m2) + cld_pbl_iwp(iCol:iCol2,:), & ! IN - PBL cloud ice water path (g/m2) + cld_pbl_reliq(iCol:iCol2,:), & ! IN - PBL cloud liquid effective radius (microns) + cld_pbl_reice(iCol:iCol2,:), & ! IN - PBL cloud ice effective radius (microns) + lw_optical_props_pblcloudsByBand)) ! OUT - RRTMGP DDT containing PBL cloud radiative properties + ! in each band + ! Increment + call check_error_msg('rrtmgp_lw_main_increment_pblclouds_to_clouds',& + lw_optical_props_pblcloudsByBand%increment(lw_optical_props_cloudsByBand)) + endif + endif + + ! ################################################################################### + ! + ! Cloud precipitation optics: rain and snow(+groupel) + ! + ! ################################################################################### + tau_rain(:) = 0._kind_phys + tau_snow(:) = 0._kind_phys + do ix=1,rrtmgp_phys_blksz + do iLay=1,nLay + if (cld_frac(iCol+ix-1,iLay) .gt. eps) then + ! Rain optical-depth (No band dependence) + tau_rain(ix) = absrain*cld_rwp(iCol+ix-1,iLay) + + ! Snow (+groupel) optical-depth (No band dependence) + if (cld_swp(iCol+ix-1,iLay) .gt. 0. .and. cld_resnow(iCol+ix-1,iLay) .gt. 10._kind_phys) then + tau_snow(ix) = abssnow0*1.05756*cld_swp(iCol+ix-1,iLay)/cld_resnow(iCol+ix-1,iLay) + else + tau_snow(ix) = 0.0 + endif + do iBand=1,lw_gas_props%get_nband() + lw_optical_props_precipByBand%tau(ix,iLay,iBand) = tau_rain(ix) + tau_snow(ix) + enddo + endif + enddo + enddo + ! Increment + call check_error_msg('rrtmgp_lw_main_increment_precip_to_clouds',& + lw_optical_props_precipByBand%increment(lw_optical_props_cloudsByBand)) + + ! ################################################################################### + ! + ! Cloud-sampling + ! *Note* All of the included cloud-types are sampled together, not independently. + ! + ! ################################################################################### + if (any(zcf1 .gt. eps)) then + ! Change random number seed value for each radiation invocation (isubc_lw =1 or 2). + if(isubc_lw == 1) then ! advance prescribed permutation seed + do ix=1,rrtmgp_phys_blksz + ipseed_lw(ix) = lw_gas_props%get_ngpt() + iCol + ix - 1 + enddo + elseif (isubc_lw == 2) then ! use input array of permutaion seeds + do ix=1,rrtmgp_phys_blksz + ipseed_lw(ix) = icseed_lw(iCol+ix-1) + enddo + endif + + ! Call RNG + do ix=1,rrtmgp_phys_blksz + call random_setseed(ipseed_lw(ix),rng_stat) + ! Use same rng for each layer + if (iovr == iovr_max) then + call random_number(rng1D,rng_stat) + do iLay=1,nLay + rng3D(:,iLay,ix) = rng1D + enddo + else + do iLay=1,nLay + call random_number(rng1D,rng_stat) + rng3D(:,iLay,ix) = rng1D + enddo + endif + enddo + + ! Cloud-overlap. + ! Maximum-random, random or maximum. + if (iovr == iovr_maxrand .or. iovr == iovr_rand .or. iovr == iovr_max) then + call sampled_mask(real(rng3D,kind=kind_phys), cld_frac(iCol:iCol2,:), maskMCICA) + endif + ! Exponential decorrelation length overlap + if (iovr == iovr_dcorr) then + do ix=1,rrtmgp_phys_blksz + ! Generate second RNG + call random_setseed(ipseed_lw(ix),rng_stat) + call random_number(rng2D,rng_stat) + rng3D2(:,:,ix) = reshape(source = rng2D,shape=[lw_gas_props%get_ngpt(),nLay]) + enddo + ! + call sampled_mask(real(rng3D,kind=kind_phys), cld_frac(iCol:iCol2,:), maskMCICA, & + overlap_param = cloud_overlap_param(iCol:iCol2,1:nLay-1), randoms2 = real(rng3D2, kind=kind_phys)) + endif + ! Exponential or Exponential-random + if (iovr == iovr_exp .or. iovr == iovr_exprand) then + call sampled_mask(real(rng3D,kind=kind_phys), cld_frac(iCol:iCol2,:), maskMCICA, & + overlap_param = cloud_overlap_param(iCol:iCol2,1:nLay-1)) + endif + ! Sampling. Map band optical depth to each g-point using McICA + call check_error_msg('rrtmgp_lw_main_cloud_sampling',& + draw_samples(maskMCICA, .true., & + lw_optical_props_cloudsByBand, lw_optical_props_clouds)) + endif + + ! ################################################################################### + ! + ! Compute clear-sky fluxes (gaseous+aerosol) (optional) + ! + ! ################################################################################### + ! Increment + lw_optical_props_aerosol_local%tau = aerlw_tau(iCol:iCol2,:,:) + call check_error_msg('rrtmgp_lw_main_increment_aerosol_to_clrsky',& + lw_optical_props_aerosol_local%increment(lw_optical_props_clrsky)) + + ! Call RTE solver + if (doLWclrsky) then + call check_error_msg('rrtmgp_lw_main_opt_angle',& + lw_gas_props%compute_optimal_angles(lw_optical_props_clrsky,lw_Ds)) + if (nGauss_angles .gt. 1) then + call check_error_msg('rrtmgp_lw_main_lw_rte_clrsky',rte_lw( & + lw_optical_props_clrsky, & ! IN - optical-properties + top_at_1, & ! IN - veritcal ordering flag + sources, & ! IN - source function + sfc_emiss_byband, & ! IN - surface emissivity in each LW band + flux_clrsky, & ! OUT - Fluxes + n_gauss_angles = nGauss_angles)) ! IN - Number of angles in Gaussian quadrature + else + call check_error_msg('rrtmgp_lw_main_lw_rte_clrsky',rte_lw( & + lw_optical_props_clrsky, & ! IN - optical-properties + top_at_1, & ! IN - veritcal ordering flag + sources, & ! IN - source function + sfc_emiss_byband, & ! IN - surface emissivity in each LW band + flux_clrsky, & ! OUT - Fluxes + lw_Ds = lw_Ds)) + endif + + ! Store fluxes + fluxlwUP_clrsky(iCol:iCol2,:) = sum(flux_clrsky%bnd_flux_up, dim=3) + fluxlwDOWN_clrsky(iCol:iCol2,:) = sum(flux_clrsky%bnd_flux_dn, dim=3) + else + fluxlwUP_clrsky(iCol:iCol2,:) = 0.0 + fluxlwDOWN_clrsky(iCol:iCol2,:) = 0.0 + endif + + ! ################################################################################### + ! + ! All-sky fluxes (clear-sky + clouds + precipitation) + ! *Note* CCPP does not allow for polymorphic types, they are ambiguous to the CCPP + ! framework. rte-rrtmgp uses polymorphic types extensively, for example, querying the + ! type to determine physics configuration/pathway/etc... + ! + ! The logic in the code below is to satisfy the polymorphishm in the rte-rrtmgp code. + ! The rte-rrtmgp "increment" procedures are utilized to provide the correct type to the + ! rte solver (rte_lw). Rte_lw quieries the type determine if scattering is to be + ! included in the calculation. The increment procedures are called so that the correct + ! optical properties are inherited. ugh... + ! + ! ################################################################################### + + ! Include LW cloud-scattering? + if (doGP_lwscat) then + ! Increment + call check_error_msg('rrtmgp_lw_main_increment_clrsky_to_clouds',& + lw_optical_props_clrsky%increment(lw_optical_props_clouds)) + + if (use_LW_jacobian) then + ! Compute LW Jacobians + call check_error_msg('rrtmgp_lw_main_lw_rte_allsky',rte_lw( & + lw_optical_props_clouds, & ! IN - optical-properties + top_at_1, & ! IN - veritcal ordering flag + sources, & ! IN - source function + sfc_emiss_byband, & ! IN - surface emissivity in each LW band + flux_allsky, & ! OUT - Flxues + n_gauss_angles = nGauss_angles, & ! IN - Number of angles in Gaussian quadrature + flux_up_Jac = fluxlwUP_jac)) ! OUT - surface temperature flux (upward) Jacobian (W/m2/K) + else + call check_error_msg('rrtmgp_lw_main_lw_rte_allsky',rte_lw( & + lw_optical_props_clouds, & ! IN - optical-properties + top_at_1, & ! IN - veritcal ordering flag + sources, & ! IN - source function + sfc_emiss_byband, & ! IN - surface emissivity in each LW band + flux_allsky, & ! OUT - Flxues + n_gauss_angles = nGauss_angles)) ! IN - Number of angles in Gaussian quadrature + end if + ! No scattering in LW clouds. + else + ! Increment + call check_error_msg('rrtmgp_lw_main_increment_clouds_to_clrsky', & + lw_optical_props_clouds%increment(lw_optical_props_clrsky)) + + if (use_LW_jacobian) then + ! Compute LW Jacobians + call check_error_msg('rrtmgp_lw_rte_run',rte_lw( & + lw_optical_props_clrsky, & ! IN - optical-properties + top_at_1, & ! IN - veritcal ordering flag + sources, & ! IN - source function + sfc_emiss_byband, & ! IN - surface emissivity in each LW band + flux_allsky, & ! OUT - Flxues + n_gauss_angles = nGauss_angles, & ! IN - Number of angles in Gaussian quadrature + flux_up_Jac = fluxlwUP_jac)) ! OUT - surface temperature flux (upward) Jacobian (W/m2/K) + else + call check_error_msg('rrtmgp_lw_rte_run',rte_lw( & + lw_optical_props_clrsky, & ! IN - optical-properties + top_at_1, & ! IN - veritcal ordering flag + sources, & ! IN - source function + sfc_emiss_byband, & ! IN - surface emissivity in each LW band + flux_allsky, & ! OUT - Flxues + n_gauss_angles = nGauss_angles)) ! IN - Number of angles in Gaussian quadrature + end if + endif + + ! Store fluxes + fluxlwUP_allsky(iCol:iCol2,:) = sum(flux_allsky%bnd_flux_up, dim=3) + fluxlwDOWN_allsky(iCol:iCol2,:) = sum(flux_allsky%bnd_flux_dn, dim=3) + + ! Save fluxes for coupling + fluxlwUP_radtime(iCol:iCol2,:) = fluxlwUP_allsky(iCol:iCol2,:) + fluxlwDOWN_radtime(iCol:iCol2,:) = fluxlwDOWN_allsky(iCol:iCol2,:) + + enddo + + end subroutine rrtmgp_lw_main_run +!> @} +end module rrtmgp_lw_main diff --git a/physics/rrtmgp_lw_main.meta b/physics/rrtmgp_lw_main.meta new file mode 100644 index 000000000..a1a384b25 --- /dev/null +++ b/physics/rrtmgp_lw_main.meta @@ -0,0 +1,641 @@ +[ccpp-table-properties] + name = rrtmgp_lw_main + type = scheme + dependencies = machine.F,radiation_tools.F90,GFS_rrtmgp_pre.F90,rte-rrtmgp/rrtmgp/mo_gas_optics_rrtmgp.F90 + dependencies = rte-rrtmgp/rte/mo_rte_kind.F90,rte-rrtmgp/rrtmgp/mo_gas_concentrations.F90,rte-rrtmgp/rte/mo_optical_props.F90 + dependencies = rte-rrtmgp/rte/mo_source_functions.F90,rte-rrtmgp/rte/mo_rte_lw.F90,rte-rrtmgp/rte/mo_fluxes.F90 + dependencies = rte-rrtmgp/rte/kernels/mo_fluxes_broadband_kernels.F90, rte-rrtmgp/rte/kernels/mo_rte_solver_kernels.F90 + dependencies = mersenne_twister.f,rrtmgp_sampling.F90,rte-rrtmgp/extensions/mo_fluxes_byband.F90 + dependencies = rrtmgp_lw_gas_optics.F90, rrtmgp_lw_cloud_optics.F90 + +######################################################################## +[ccpp-arg-table] + name = rrtmgp_lw_main_init + type = scheme +[rrtmgp_root_dir] + standard_name = directory_for_rte_rrtmgp_source_code + long_name = directory for rte+rrtmgp source code + units = none + dimensions = () + type = character + intent = in + kind = len=128 +[rrtmgp_lw_file_gas] + standard_name = filename_of_rrtmgp_longwave_k_distribution + long_name = file containing RRTMGP LW k-distribution + units = none + dimensions = () + type = character + intent = in + kind = len=128 +[rrtmgp_lw_file_clouds] + standard_name = filename_of_rrtmgp_longwave_cloud_optics_coefficients + long_name = file containing coefficients for RRTMGP LW cloud optics + units = none + dimensions = () + type = character + intent = in + kind = len=128 +[doGP_cldoptics_PADE] + standard_name = flag_to_calc_lw_cld_optics_using_RRTMGP_PADE + long_name = logical flag to control cloud optics scheme. + units = flag + dimensions = () + type = logical + intent = in +[doGP_cldoptics_LUT] + standard_name = flag_to_calc_lw_cld_optics_using_RRTMGP_LUT + long_name = logical flag to control cloud optics scheme. + units = flag + dimensions = () + type = logical + intent = in +[doGP_sgs_cnv] + standard_name = flag_to_include_sgs_convective_cloud_in_RRTMGP + long_name = logical flag to control sgs convective cloud in RRTMGP + units = flag + dimensions = () + type = logical + intent = in +[doGP_sgs_pbl] + standard_name = flag_to_include_sgs_MYNN_EDMF_cloud_in_RRTMGP + long_name = logical flag to control MYNN-EDMF PBL cloud in RRTMGP + units = flag + dimensions = () + type = logical + intent = in +[nrghice] + standard_name = number_of_ice_roughness_categories + long_name = number of ice-roughness categories in RRTMGP calculation + units = count + dimensions = () + type = integer + intent = inout +[mpirank] + standard_name = mpi_rank + long_name = current MPI rank + units = index + dimensions = () + type = integer + intent = in +[mpiroot] + standard_name = mpi_root + long_name = master MPI rank + units = index + dimensions = () + type = integer + intent = in +[mpicomm] + standard_name = mpi_communicator + long_name = MPI communicator + units = index + dimensions = () + type = integer + intent = in +[rrtmgp_phys_blksz] + standard_name = number_of_columns_per_RRTMGP_LW_block + long_name = number of columns to process at a time by RRTMGP LW scheme + units = count + dimensions = () + type = integer + intent = in +[nLay] + standard_name = vertical_layer_dimension + long_name = number of vertical levels + units = count + dimensions = () + type = integer + intent = in +[active_gases_array] + standard_name = list_of_active_gases_used_by_RRTMGP + long_name = list of active gases used by RRTMGP + units = none + dimensions = (number_of_active_gases_used_by_RRTMGP) + type = character + kind = len=* + intent = in +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out +[errflg] + standard_name = ccpp_error_code + long_name = error code for error handling in CCPP + units = 1 + dimensions = () + type = integer + intent = out + +######################################################################## +[ccpp-arg-table] + name = rrtmgp_lw_main_run + type = scheme +[doLWrad] + standard_name = flag_for_calling_longwave_radiation + long_name = logical flags for lw radiation calls + units = flag + dimensions = () + type = logical + intent = in +[doLWclrsky] + standard_name = flag_for_output_of_tendency_of_air_temperature_due_to_longwave_heating_on_radiation_timestep_assuming_clear_sky + long_name = flag to output lw heating rate (Radtend%lwhc) + units = flag + dimensions = () + type = logical + intent = in +[top_at_1] + standard_name = flag_for_vertical_ordering_in_RRTMGP + long_name = flag for vertical ordering in RRTMGP + units = flag + dimensions = () + type = logical + intent = in +[use_LW_jacobian] + standard_name = flag_to_calc_RRTMGP_LW_jacobian + long_name = logical flag to control RRTMGP LW calculation + units = flag + dimensions = () + type = logical + intent = in +[doGP_lwscat] + standard_name = flag_to_include_longwave_scattering_in_cloud_optics + long_name = logical flag to control the addition of LW scattering in RRTMGP + units = flag + dimensions = () + type = logical + intent = in +[doGP_sgs_cnv] + standard_name = flag_to_include_sgs_convective_cloud_in_RRTMGP + long_name = logical flag to control sgs convective cloud in RRTMGP + units = flag + dimensions = () + type = logical + intent = in +[doGP_sgs_pbl] + standard_name = flag_to_include_sgs_MYNN_EDMF_cloud_in_RRTMGP + long_name = logical flag to control MYNN-EDMF PBL cloud in RRTMGP + units = flag + dimensions = () + type = logical + intent = in +[ncol] + standard_name = horizontal_loop_extent + long_name = horizontal dimension + units = count + dimensions = () + type = integer + intent = in +[rrtmgp_phys_blksz] + standard_name = number_of_columns_per_RRTMGP_LW_block + long_name = number of columns to process at a time by RRTMGP LW scheme + units = count + dimensions = () + type = integer + intent = in +[nLay] + standard_name = vertical_layer_dimension + long_name = number of vertical levels + units = count + dimensions = () + type = integer + intent = in +[nGauss_angles] + standard_name = number_of_gaussian_quadrature_angles_for_radiation + long_name = Number of angles used in Gaussian quadrature + units = count + dimensions = () + type = integer + intent = in +[nGases] + standard_name = number_of_active_gases_used_by_RRTMGP + long_name = number of gases available used by RRTMGP (Model%nGases) + units = count + dimensions = () + type = integer + intent = in +[isubc_lw] + standard_name = flag_for_lw_clouds_sub_grid_approximation + long_name = flag for lw clouds sub-grid approximation + units = flag + dimensions = () + type = integer + intent = in +[iovr] + standard_name = flag_for_cloud_overlap_method_for_radiation + long_name = max-random overlap clouds + units = flag + dimensions = () + type = integer + intent = in +[iovr_maxrand] + standard_name = flag_for_maximum_random_cloud_overlap_method + long_name = choice of maximum-random cloud overlap method + units = flag + dimensions = () + type = integer + intent = in +[iovr_dcorr] + standard_name = flag_for_decorrelation_length_cloud_overlap_method + long_name = choice of decorrelation-length cloud overlap method + units = flag + dimensions = () + type = integer + intent = in +[iovr_exp] + standard_name = flag_for_exponential_cloud_overlap_method + long_name = choice of exponential cloud overlap method + units = flag + dimensions = () + type = integer + intent = in +[iovr_exprand] + standard_name = flag_for_exponential_random_cloud_overlap_method + long_name = choice of exponential-random cloud overlap method + units = flag + dimensions = () + type = integer + intent = in +[iovr_rand] + standard_name = flag_for_random_cloud_overlap_method + long_name = choice of random cloud overlap method + units = flag + dimensions = () + type = integer + intent = in +[iovr_max] + standard_name = flag_for_maximum_cloud_overlap_method + long_name = choice of maximum cloud overlap method + units = flag + dimensions = () + type = integer + intent = in +[iovr_convcld] + standard_name = flag_for_convective_cloud_overlap_method_for_radiation + long_name = flag for convective cloud overlap method + units = flag + dimensions = () + type = integer + intent = in +[icseed_lw] + standard_name = random_number_seed_for_mcica_longwave + long_name = seed for random number generation for longwave radiation + units = none + dimensions = (horizontal_loop_extent) + type = integer + intent = in +[semis] + standard_name = surface_longwave_emissivity + long_name = surface lw emissivity in fraction + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in +[tsfg] + standard_name = surface_ground_temperature_for_radiation + long_name = surface ground temperature for radiation + units = K + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in +[p_lay] + standard_name = air_pressure_at_layer_for_RRTMGP + long_name = air pressure at vertical layer for radiation calculation + units = Pa + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = in +[p_lev] + standard_name = air_pressure_at_interface_for_RRTMGP + long_name = air pressure at vertical interface for radiation calculation + units = Pa + dimensions = (horizontal_loop_extent,vertical_interface_dimension) + type = real + kind = kind_phys + intent = in +[t_lay] + standard_name = air_temperature_at_layer_for_RRTMGP + long_name = air temperature at vertical layer for radiation calculation + units = K + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = in +[t_lev] + standard_name = air_temperature_at_interface_for_RRTMGP + long_name = air temperature at vertical interface for radiation calculation + units = K + dimensions = (horizontal_loop_extent,vertical_interface_dimension) + type = real + kind = kind_phys + intent = in +[vmr_o2] + standard_name = volume_mixing_ratio_for_o2 + long_name = molar mixing ratio of o2 in with respect to dry air + units = 1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = in +[vmr_h2o] + standard_name = volume_mixing_ratio_for_h2o + long_name = molar mixing ratio of h2o in with respect to dry air + units = 1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = in +[vmr_o3] + standard_name = volume_mixing_ratio_for_o3 + long_name = molar mixing ratio of o3 in with respect to dry air + units = 1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = in +[vmr_ch4] + standard_name = volume_mixing_ratio_for_ch4 + long_name = molar mixing ratio of ch4 in with respect to dry air + units = 1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = in +[vmr_n2o] + standard_name = volume_mixing_ratio_for_n2o + long_name = molar mixing ratio of n2o in with respect to dry air + units = 1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = in +[vmr_co2] + standard_name = volume_mixing_ratio_for_co2 + long_name = molar mixing ratio of co2 in with respect to dry air + units = 1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = in +[cld_frac] + standard_name = total_cloud_fraction + long_name = layer total cloud fraction + units = frac + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = in +[cld_lwp] + standard_name = cloud_liquid_water_path + long_name = layer cloud liquid water path + units = g m-2 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = in +[cld_reliq] + standard_name = mean_effective_radius_for_liquid_cloud + long_name = mean effective radius for liquid cloud + units = um + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = in +[cld_iwp] + standard_name = cloud_ice_water_path + long_name = layer cloud ice water path + units = g m-2 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = in +[cld_reice] + standard_name = mean_effective_radius_for_ice_cloud + long_name = mean effective radius for ice cloud + units = um + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = in +[cld_swp] + standard_name = cloud_snow_water_path + long_name = layer cloud snow water path + units = g m-2 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = in +[cld_resnow] + standard_name = mean_effective_radius_for_snow_flake + long_name = mean effective radius for snow cloud + units = um + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = in +[cld_rwp] + standard_name = cloud_rain_water_path + long_name = layer cloud rain water path + units = g m-2 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = in +[cld_rerain] + standard_name = mean_effective_radius_for_rain_drop + long_name = mean effective radius for rain cloud + units = um + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = in +[precip_frac] + standard_name = precipitation_fraction_by_layer + long_name = precipitation fraction in each layer + units = frac + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = in +[cld_cnv_lwp] + standard_name = convective_cloud_liquid_water_path + long_name = layer convective cloud liquid water path + units = g m-2 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = in +[cld_cnv_iwp] + standard_name = convective_cloud_ice_water_path + long_name = layer convective cloud ice water path + units = g m-2 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = in +[cld_cnv_reliq] + standard_name = mean_effective_radius_for_liquid_convective_cloud + long_name = mean effective radius for liquid convective cloud + units = um + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = in +[cld_cnv_reice] + standard_name = mean_effective_radius_for_ice_convective_cloud + long_name = mean effective radius for ice convective cloud + units = um + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = in +[cld_pbl_lwp] + standard_name = MYNN_SGS_cloud_liquid_water_path + long_name = layer convective cloud liquid water path + units = g m-2 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = in +[cld_pbl_iwp] + standard_name = MYNN_SGS_cloud_ice_water_path + long_name = layer convective cloud ice water path + units = g m-2 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = in +[cld_pbl_reliq] + standard_name = mean_effective_radius_for_liquid_MYNN_SGS_cloud + long_name = mean effective radius for liquid MYNN_SGS cloud + units = um + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = in +[cld_pbl_reice] + standard_name = mean_effective_radius_for_ice_MYNN_SGS_cloud + long_name = mean effective radius for ice MYNN_SGS cloud + units = um + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = in +[cloud_overlap_param] + standard_name = cloud_overlap_param + long_name = cloud overlap parameter + units = km + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = in +[active_gases_array] + standard_name = list_of_active_gases_used_by_RRTMGP + long_name = list of active gases used by RRTMGP + units = none + dimensions = (number_of_active_gases_used_by_RRTMGP) + type = character + kind = len=* + intent = in +[aerlw_tau] + standard_name = aerosol_optical_depth_for_longwave_bands_01_16 + long_name = aerosol optical depth for longwave bands 01-16 + units = none + dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_aerosol_bands_for_longwave_radiation) + type = real + kind = kind_phys + intent = in +[aerlw_ssa] + standard_name = aerosol_single_scattering_albedo_for_longwave_bands_01_16 + long_name = aerosol single scattering albedo for longwave bands 01-16 + units = frac + dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_aerosol_bands_for_longwave_radiation) + type = real + kind = kind_phys + intent = in +[aerlw_g] + standard_name = aerosol_asymmetry_parameter_for_longwave_bands_01_16 + long_name = aerosol asymmetry parameter for longwave bands 01-16 + units = none + dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_aerosol_bands_for_longwave_radiation) + type = real + kind = kind_phys + intent = in +[fluxlwUP_radtime] + standard_name = RRTMGP_lw_flux_profile_upward_allsky_on_radiation_timestep + long_name = RRTMGP upward longwave all-sky flux profile + units = W m-2 + dimensions = (horizontal_loop_extent,vertical_interface_dimension) + type = real + kind = kind_phys + intent = inout +[fluxlwDOWN_radtime] + standard_name = RRTMGP_lw_flux_profile_downward_allsky_on_radiation_timestep + long_name = RRTMGP downward longwave all-sky flux profile + units = W m-2 + dimensions = (horizontal_loop_extent,vertical_interface_dimension) + type = real + kind = kind_phys + intent = inout +[fluxlwUP_allsky] + standard_name = RRTMGP_lw_flux_profile_upward_allsky + long_name = RRTMGP upward longwave all-sky flux profile + units = W m-2 + dimensions = (horizontal_loop_extent,vertical_interface_dimension) + type = real + kind = kind_phys + intent = inout +[fluxlwDOWN_allsky] + standard_name = RRTMGP_lw_flux_profile_downward_allsky + long_name = RRTMGP downward longwave all-sky flux profile + units = W m-2 + dimensions = (horizontal_loop_extent,vertical_interface_dimension) + type = real + kind = kind_phys + intent = inout +[fluxlwUP_clrsky] + standard_name = RRTMGP_lw_flux_profile_upward_clrsky + long_name = RRTMGP upward longwave clr-sky flux profile + units = W m-2 + dimensions = (horizontal_loop_extent,vertical_interface_dimension) + type = real + kind = kind_phys + intent = inout +[fluxlwDOWN_clrsky] + standard_name = RRTMGP_lw_flux_profile_downward_clrsky + long_name = RRTMGP downward longwave clr-sky flux profile + units = W m-2 + dimensions = (horizontal_loop_extent,vertical_interface_dimension) + type = real + kind = kind_phys + intent = inout +[fluxlwUP_jac] + standard_name = RRTMGP_jacobian_of_lw_flux_upward + long_name = RRTMGP Jacobian upward longwave flux profile + units = W m-2 K-1 + dimensions = (horizontal_loop_extent,vertical_interface_dimension) + type = real + kind = kind_phys + intent = inout +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out +[errflg] + standard_name = ccpp_error_code + long_name = error code for error handling in CCPP + units = 1 + dimensions = () + type = integer + intent = out \ No newline at end of file diff --git a/physics/rrtmgp_lw_pre.F90 b/physics/rrtmgp_lw_pre.F90 deleted file mode 100644 index 1501ca319..000000000 --- a/physics/rrtmgp_lw_pre.F90 +++ /dev/null @@ -1,61 +0,0 @@ -!> \file rrtmgp_lw_pre.F90 -!! -!> \defgroup rrtmgp_lw_pre rrtmgp_lw_pre.F90 -!! -!! \brief RRTMGP Longwave pre-processing routine. -!! -module rrtmgp_lw_pre - use machine, only: & - kind_phys ! Working type - use mo_gas_optics_rrtmgp, only: & - ty_gas_optics_rrtmgp - use rrtmgp_lw_gas_optics, only: lw_gas_props - - implicit none - - public rrtmgp_lw_pre_run - -contains - -!>\defgroup rrtmgp_lw_pre_mode GFS RRTMGP-LW Pre Module -!> \section arg_table_rrtmgp_lw_pre_run -!! \htmlinclude rrtmgp_lw_pre_run.html -!! -!> \ingroup rrtmgp_lw_pre -!! -!! \brief -!! -!! \section rrtmgp_lw_pre_run - subroutine rrtmgp_lw_pre_run (doLWrad, semis, sfc_emiss_byband, errmsg, errflg) - - ! Inputs - logical, intent(in) :: & - doLWrad - real(kind_phys), dimension(:), intent(in) :: & - semis - - ! Outputs - real(kind_phys), dimension(:,:), intent(inout) :: & - sfc_emiss_byband ! Surface emissivity in each band - character(len=*), intent(out) :: & - errmsg ! Error message - integer, intent(out) :: & - errflg ! Error flag - - ! Local variables - integer :: iBand - - ! Initialize CCPP error handling variables - errmsg = '' - errflg = 0 - - if (.not. doLWrad) return - - ! Assign same emissivity to all bands - do iBand=1,lw_gas_props%get_nband() - sfc_emiss_byband(iBand,:) = semis - enddo - - end subroutine rrtmgp_lw_pre_run - -end module rrtmgp_lw_pre diff --git a/physics/rrtmgp_lw_pre.meta b/physics/rrtmgp_lw_pre.meta deleted file mode 100644 index aa2a06a0f..000000000 --- a/physics/rrtmgp_lw_pre.meta +++ /dev/null @@ -1,47 +0,0 @@ -[ccpp-table-properties] - name = rrtmgp_lw_pre - type = scheme - dependencies = iounitdef.f,machine.F - -######################################################################## -[ccpp-arg-table] - name = rrtmgp_lw_pre_run - type = scheme -[doLWrad] - standard_name = flag_for_calling_longwave_radiation - long_name = logical flags for lw radiation calls - units = flag - dimensions = () - type = logical - intent = in -[semis] - standard_name = surface_longwave_emissivity - long_name = surface lw emissivity in fraction - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in -[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_longwave_bands,horizontal_loop_extent) - type = real - kind = kind_phys - intent = inout -[errmsg] - standard_name = ccpp_error_message - long_name = error message for error handling in CCPP - units = none - dimensions = () - type = character - kind = len=* - intent = out -[errflg] - standard_name = ccpp_error_code - long_name = error code for error handling in CCPP - units = 1 - dimensions = () - type = integer - intent = out diff --git a/physics/rrtmgp_lw_rte.F90 b/physics/rrtmgp_lw_rte.F90 deleted file mode 100644 index 9109a5780..000000000 --- a/physics/rrtmgp_lw_rte.F90 +++ /dev/null @@ -1,208 +0,0 @@ -!> \file rrtmgp_lw_rte.F90 -!! -!> \defgroup rrtmgp_lw_rte rrtmgp_lw_rte.F90 -!! -!! \brief This module contains the main rte longwave driver. -!! -module rrtmgp_lw_rte - use machine, only: kind_phys - use mo_optical_props, only: ty_optical_props_1scl, ty_optical_props_2str - use mo_rte_lw, only: rte_lw - use mo_fluxes_byband, only: ty_fluxes_byband - use mo_source_functions, only: ty_source_func_lw - use radiation_tools, only: check_error_msg - use rrtmgp_lw_gas_optics, only: lw_gas_props - implicit none - - public rrtmgp_lw_rte_run -contains - -!>\defgroup rrtmgp_lw_rte_mod GFS RRTMGP-LW RTE Module -!> \section arg_table_rrtmgp_lw_rte_run -!! \htmlinclude rrtmgp_lw_rte_run.html -!! -!> \ingroup rrtmgp_lw_rte -!! -!! \brief This routine takes all of the longwave optical properties ,ty_optical_props_1scl, -!! and computes the longwave radiative fluxes for cloudy and clear-sky conditions. -!! -!! \section rrtmgp_lw_rte_run - subroutine rrtmgp_lw_rte_run(doLWrad, doLWclrsky, use_LW_jacobian, doGP_lwscat, nCol, & - nLev, top_at_1, doGP_sgs_cnv, doGP_sgs_mynn, sfc_emiss_byband, sources, & - lw_optical_props_clrsky, lw_optical_props_clouds, lw_optical_props_precipByBand, & - lw_optical_props_cnvcloudsByBand, lw_optical_props_MYNNcloudsByBand, & - lw_optical_props_aerosol, nGauss_angles, fluxlwUP_allsky, fluxlwDOWN_allsky, & - fluxlwUP_clrsky, fluxlwDOWN_clrsky, fluxlwUP_jac, fluxlwUP_radtime, & - fluxlwDOWN_radtime, errmsg, errflg) - - ! Inputs - logical, intent(in) :: & - top_at_1, & ! Vertical ordering flag - doLWrad, & ! Logical flag for longwave radiation call - doLWclrsky, & ! Compute clear-sky fluxes for clear-sky heating-rate? - use_LW_jacobian, & ! Compute Jacobian of LW to update radiative fluxes between radiation calls? - doGP_sgs_mynn, & ! Flag for sgs MYNN-EDMF PBL cloud scheme - doGP_sgs_cnv, & ! Flagg for sgs convective cloud scheme - doGP_lwscat ! Include scattering in LW cloud-optics? - integer, intent(in) :: & - nCol, & ! Number of horizontal gridpoints - nLev, & ! Number of vertical levels - nGauss_angles ! Number of angles used in Gaussian quadrature - real(kind_phys), dimension(:,:), intent(in) :: & - sfc_emiss_byband ! Surface emissivity in each band - type(ty_source_func_lw),intent(in) :: & - sources ! RRTMGP DDT: longwave source functions - type(ty_optical_props_1scl),intent(inout) :: & - lw_optical_props_aerosol, &! RRTMGP DDT: longwave aerosol optical properties - lw_optical_props_clrsky ! RRTMGP DDT: longwave clear-sky optical properties - type(ty_optical_props_2str),intent(inout) :: & - lw_optical_props_clouds, & ! RRTMGP DDT: longwave cloud optical properties - lw_optical_props_precipByBand, & ! RRTMGP DDT: longwave precipitation optical properties - lw_optical_props_cnvcloudsByBand, & ! RRTMGP DDT: longwave convective cloud optical properties - lw_optical_props_MYNNcloudsByBand ! RRTMGP DDT: longwave MYNN-EDMF PBL cloud optical properties - ! Outputs - real(kind_phys), dimension(:,:), intent(inout) :: & - fluxlwUP_jac, & ! Jacobian of upwelling LW surface radiation (W/m2/K) - fluxlwUP_allsky, & ! All-sky flux (W/m2) - fluxlwDOWN_allsky, & ! All-sky flux (W/m2) - fluxlwUP_clrsky, & ! Clear-sky flux (W/m2) - fluxlwDOWN_clrsky, & ! All-sky flux (W/m2) - fluxlwUP_radtime, & ! Copy of fluxes (Used for coupling) - fluxlwDOWN_radtime - character(len=*), intent(out) :: & - errmsg ! CCPP error message - integer, intent(out) :: & - errflg ! CCPP error flag - - ! Local variables - type(ty_fluxes_byband) :: & - flux_allsky, flux_clrsky - real(kind_phys), dimension(ncol,nLev+1,lw_gas_props%get_nband()),target :: & - fluxLW_up_allsky, fluxLW_up_clrsky, fluxLW_dn_allsky, fluxLW_dn_clrsky - real(kind_phys), dimension(nCol,lw_gas_props%get_ngpt()) :: lw_Ds - - ! Initialize CCPP error handling variables - errmsg = '' - errflg = 0 - - if (.not. doLWrad) return - - ! Initialize RRTMGP DDT containing 2D(3D) fluxes - flux_allsky%bnd_flux_up => fluxLW_up_allsky - flux_allsky%bnd_flux_dn => fluxLW_dn_allsky - flux_clrsky%bnd_flux_up => fluxLW_up_clrsky - flux_clrsky%bnd_flux_dn => fluxLW_dn_clrsky - - ! - ! Compute clear-sky fluxes (if requested) - ! - ! Add aerosol optics to gas optics - call check_error_msg('rrtmgp_lw_rte_run',lw_optical_props_aerosol%increment(lw_optical_props_clrsky)) - - ! Call RTE solver - if (doLWclrsky) then - call check_error_msg('rrtmgp_lw_rte_run_opt_angle',lw_gas_props%compute_optimal_angles(lw_optical_props_clrsky,lw_Ds)) - if (nGauss_angles .gt. 1) then - call check_error_msg('rrtmgp_lw_rte_run',rte_lw( & - lw_optical_props_clrsky, & ! IN - optical-properties - top_at_1, & ! IN - veritcal ordering flag - sources, & ! IN - source function - sfc_emiss_byband, & ! IN - surface emissivity in each LW band - flux_clrsky, & ! OUT - Fluxes - n_gauss_angles = nGauss_angles)) ! IN - Number of angles in Gaussian quadrature - else - call check_error_msg('rrtmgp_lw_rte_run',rte_lw( & - lw_optical_props_clrsky, & ! IN - optical-properties - top_at_1, & ! IN - veritcal ordering flag - sources, & ! IN - source function - sfc_emiss_byband, & ! IN - surface emissivity in each LW band - flux_clrsky, & ! OUT - Fluxes - lw_Ds = lw_Ds)) - endif - - ! Store fluxes - fluxlwUP_clrsky = sum(flux_clrsky%bnd_flux_up,dim=3) - fluxlwDOWN_clrsky = sum(flux_clrsky%bnd_flux_dn,dim=3) - else - fluxlwUP_clrsky = 0.0 - fluxlwDOWN_clrsky = 0.0 - endif - - ! - ! All-sky fluxes (clear-sky + clouds + precipitation) - ! - - ! Include convective cloud? - if (doGP_sgs_cnv) then - call check_error_msg('rrtmgp_lw_rte_run',lw_optical_props_cnvcloudsByBand%increment(lw_optical_props_clrsky)) - endif - - ! Include MYNN-EDMF PBL clouds? - if (doGP_sgs_mynn) then - call check_error_msg('rrtmgp_lw_rte_run',lw_optical_props_MYNNcloudsByBand%increment(lw_optical_props_clrsky)) - endif - - ! Add in precipitation - call check_error_msg('rrtmgp_lw_rte_run',lw_optical_props_precipByBand%increment(lw_optical_props_clouds)) - - ! Include LW cloud-scattering? - if (doGP_lwscat) then - ! Add clear-sky optics to cloud-optics (2-stream) - call check_error_msg('rrtmgp_lw_rte_run',lw_optical_props_clrsky%increment(lw_optical_props_clouds)) - - if (use_LW_jacobian) then - ! Compute LW Jacobians - call check_error_msg('rrtmgp_lw_rte_run',rte_lw( & - lw_optical_props_clouds, & ! IN - optical-properties - top_at_1, & ! IN - veritcal ordering flag - sources, & ! IN - source function - sfc_emiss_byband, & ! IN - surface emissivity in each LW band - flux_allsky, & ! OUT - Flxues - n_gauss_angles = nGauss_angles, & ! IN - Number of angles in Gaussian quadrature - flux_up_Jac = fluxlwUP_jac)) ! OUT - surface temperature flux (upward) Jacobian (W/m2/K) - else - call check_error_msg('rrtmgp_lw_rte_run',rte_lw( & - lw_optical_props_clouds, & ! IN - optical-properties - top_at_1, & ! IN - veritcal ordering flag - sources, & ! IN - source function - sfc_emiss_byband, & ! IN - surface emissivity in each LW band - flux_allsky, & ! OUT - Flxues - n_gauss_angles = nGauss_angles)) ! IN - Number of angles in Gaussian quadrature - end if - ! No scattering in LW clouds. - else - ! Add cloud optics to clear-sky optics (scalar) - call check_error_msg('rrtmgp_lw_rte_run',lw_optical_props_clouds%increment(lw_optical_props_clrsky)) - - if (use_LW_jacobian) then - ! Compute LW Jacobians - call check_error_msg('rrtmgp_lw_rte_run',rte_lw( & - lw_optical_props_clrsky, & ! IN - optical-properties - top_at_1, & ! IN - veritcal ordering flag - sources, & ! IN - source function - sfc_emiss_byband, & ! IN - surface emissivity in each LW band - flux_allsky, & ! OUT - Flxues - n_gauss_angles = nGauss_angles, & ! IN - Number of angles in Gaussian quadrature - flux_up_Jac = fluxlwUP_jac)) ! OUT - surface temperature flux (upward) Jacobian (W/m2/K) - else - call check_error_msg('rrtmgp_lw_rte_run',rte_lw( & - lw_optical_props_clrsky, & ! IN - optical-properties - top_at_1, & ! IN - veritcal ordering flag - sources, & ! IN - source function - sfc_emiss_byband, & ! IN - surface emissivity in each LW band - flux_allsky, & ! OUT - Flxues - n_gauss_angles = nGauss_angles)) ! IN - Number of angles in Gaussian quadrature - end if - endif - - ! Store fluxes - fluxlwUP_allsky = sum(flux_allsky%bnd_flux_up,dim=3) - fluxlwDOWN_allsky = sum(flux_allsky%bnd_flux_dn,dim=3) - - ! Save fluxes for coupling - fluxlwUP_radtime = fluxlwUP_allsky - fluxlwDOWN_radtime = fluxlwDOWN_allsky - - end subroutine rrtmgp_lw_rte_run - -end module rrtmgp_lw_rte diff --git a/physics/rrtmgp_lw_rte.meta b/physics/rrtmgp_lw_rte.meta deleted file mode 100644 index 15dbc1062..000000000 --- a/physics/rrtmgp_lw_rte.meta +++ /dev/null @@ -1,208 +0,0 @@ -[ccpp-table-properties] - name = rrtmgp_lw_rte - type = scheme - dependencies = machine.F,rte-rrtmgp/rte/mo_rte_lw.F90,rte-rrtmgp/rte/mo_fluxes.F90,rte-rrtmgp/rte/kernels/mo_fluxes_broadband_kernels.F90,radiation_tools.F90 - dependencies = rte-rrtmgp/rte/kernels/mo_rte_solver_kernels.F90,rte-rrtmgp/extensions/mo_fluxes_byband.F90 - -######################################################################## -[ccpp-arg-table] - name = rrtmgp_lw_rte_run - type = scheme -[doLWrad] - standard_name = flag_for_calling_longwave_radiation - long_name = logical flags for lw radiation calls - units = flag - dimensions = () - type = logical - intent = in -[doLWclrsky] - standard_name = flag_for_output_of_tendency_of_air_temperature_due_to_longwave_heating_on_radiation_timestep_assuming_clear_sky - long_name = flag to output lw heating rate (Radtend%lwhc) - units = flag - dimensions = () - type = logical - intent = in -[use_LW_jacobian] - standard_name = flag_to_calc_RRTMGP_LW_jacobian - long_name = logical flag to control RRTMGP LW calculation - units = flag - dimensions = () - type = logical - intent = in -[doGP_lwscat] - standard_name = flag_to_include_longwave_scattering_in_cloud_optics - long_name = logical flag to control the addition of LW scattering in RRTMGP - units = flag - dimensions = () - type = logical - intent = in -[doGP_sgs_cnv] - standard_name = flag_to_include_sgs_convective_cloud_in_RRTMGP - long_name = logical flag to control sgs convective cloud in RRTMGP - units = flag - dimensions = () - type = logical - intent = in -[doGP_sgs_mynn] - standard_name = flag_to_include_sgs_MYNN_EDMF_cloud_in_RRTMGP - long_name = logical flag to control MYNN-EDMF PBL cloud in RRTMGP - units = flag - dimensions = () - type = logical - intent = in -[ncol] - standard_name = horizontal_loop_extent - long_name = horizontal dimension - units = count - dimensions = () - type = integer - intent = in -[nLev] - standard_name = vertical_layer_dimension - long_name = number of vertical levels - units = count - dimensions = () - type = integer - intent = in -[nGauss_angles] - standard_name = number_of_gaussian_quadrature_angles_for_radiation - long_name = Number of angles used in Gaussian quadrature - units = count - dimensions = () - type = integer - intent = in -[top_at_1] - standard_name = flag_for_vertical_ordering_in_radiation - long_name = flag for vertical ordering in radiation - units = flag - dimensions = () - type = logical - intent = in -[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_longwave_bands,horizontal_loop_extent) - type = real - kind = kind_phys - intent = in -[lw_optical_props_clrsky] - standard_name = longwave_optical_properties_for_clear_sky - long_name = Fortran DDT containing RRTMGP optical properties - units = DDT - dimensions = () - type = ty_optical_props_1scl - intent = inout -[lw_optical_props_clouds] - standard_name = longwave_optical_properties_for_cloudy_atmosphere - long_name = Fortran DDT containing RRTMGP optical properties - units = DDT - dimensions = () - type = ty_optical_props_2str - intent = inout -[lw_optical_props_precipByBand] - standard_name = longwave_optical_properties_for_precipitation_by_band - long_name = Fortran DDT containing RRTMGP optical properties - units = DDT - dimensions = () - type = ty_optical_props_2str - intent = inout -[lw_optical_props_cnvcloudsByBand] - standard_name = longwave_optical_properties_for_convective_cloudy_atmosphere_by_band - long_name = Fortran DDT containing RRTMGP optical properties - units = DDT - dimensions = () - type = ty_optical_props_2str - intent = inout -[lw_optical_props_MYNNcloudsByBand] - standard_name = longwave_optical_properties_for_MYNN_EDMF_PBL_cloudy_atmosphere_by_band - long_name = Fortran DDT containing RRTMGP optical properties - units = DDT - dimensions = () - type = ty_optical_props_2str - intent = inout -[lw_optical_props_aerosol] - standard_name = longwave_optical_properties_for_aerosols - long_name = Fortran DDT containing RRTMGP optical properties - units = DDT - dimensions = () - type = ty_optical_props_1scl - intent = inout -[sources] - standard_name = longwave_source_function - long_name = Fortran DDT containing RRTMGP source functions - units = DDT - dimensions = () - type = ty_source_func_lw - intent = in -[fluxlwUP_radtime] - standard_name = RRTMGP_lw_flux_profile_upward_allsky_on_radiation_timestep - long_name = RRTMGP upward longwave all-sky flux profile - units = W m-2 - dimensions = (horizontal_loop_extent,vertical_interface_dimension) - type = real - kind = kind_phys - intent = inout -[fluxlwDOWN_radtime] - standard_name = RRTMGP_lw_flux_profile_downward_allsky_on_radiation_timestep - long_name = RRTMGP downward longwave all-sky flux profile - units = W m-2 - dimensions = (horizontal_loop_extent,vertical_interface_dimension) - type = real - kind = kind_phys - intent = inout -[fluxlwUP_allsky] - standard_name = RRTMGP_lw_flux_profile_upward_allsky - long_name = RRTMGP upward longwave all-sky flux profile - units = W m-2 - dimensions = (horizontal_loop_extent,vertical_interface_dimension) - type = real - kind = kind_phys - intent = inout -[fluxlwDOWN_allsky] - standard_name = RRTMGP_lw_flux_profile_downward_allsky - long_name = RRTMGP downward longwave all-sky flux profile - units = W m-2 - dimensions = (horizontal_loop_extent,vertical_interface_dimension) - type = real - kind = kind_phys - intent = inout -[fluxlwUP_clrsky] - standard_name = RRTMGP_lw_flux_profile_upward_clrsky - long_name = RRTMGP upward longwave clr-sky flux profile - units = W m-2 - dimensions = (horizontal_loop_extent,vertical_interface_dimension) - type = real - kind = kind_phys - intent = inout -[fluxlwDOWN_clrsky] - standard_name = RRTMGP_lw_flux_profile_downward_clrsky - long_name = RRTMGP downward longwave clr-sky flux profile - units = W m-2 - dimensions = (horizontal_loop_extent,vertical_interface_dimension) - type = real - kind = kind_phys - intent = inout -[fluxlwUP_jac] - standard_name = RRTMGP_jacobian_of_lw_flux_upward - long_name = RRTMGP Jacobian upward longwave flux profile - units = W m-2 K-1 - dimensions = (horizontal_loop_extent,vertical_interface_dimension) - type = real - kind = kind_phys - intent = inout -[errmsg] - standard_name = ccpp_error_message - long_name = error message for error handling in CCPP - units = none - dimensions = () - type = character - kind = len=* - intent = out -[errflg] - standard_name = ccpp_error_code - long_name = error code for error handling in CCPP - units = 1 - dimensions = () - type = integer - intent = out diff --git a/physics/rrtmgp_sw_cloud_optics.F90 b/physics/rrtmgp_sw_cloud_optics.F90 index 3aab115cd..4293a7be6 100644 --- a/physics/rrtmgp_sw_cloud_optics.F90 +++ b/physics/rrtmgp_sw_cloud_optics.F90 @@ -1,18 +1,7 @@ -!> \file rrtmgp_sw_cloud_optics.F90 -!! -!> \defgroup rrtmgp_sw_cloud_optics rrtmgp_sw_cloud_optics.F90 -!! -!! \brief This module contains two routines: The first initializes data and functions -!! needed to compute the shortwave cloud radiative properteis in RRTMGP. The second routine -!! is a ccpp scheme within the "radiation loop", where the shortwave optical prperties -!! (optical-depth, single-scattering albedo, asymmetry parameter) are computed for ALL -!! cloud types visible to RRTMGP. module rrtmgp_sw_cloud_optics use machine, only: kind_phys use mo_rte_kind, only: wl use mo_cloud_optics, only: ty_cloud_optics - use mo_optical_props, only: ty_optical_props_2str - use mo_rrtmg_sw_cloud_optics, only: rrtmg_sw_cloud_optics use rrtmgp_sw_gas_optics, only: sw_gas_props use radiation_tools, only: check_error_msg use netcdf @@ -59,52 +48,41 @@ module rrtmgp_sw_cloud_optics pade_exticeSW, & ! PADE coefficients for shortwave ice extinction pade_ssaiceSW, & ! PADE coefficients for shortwave ice single scattering albedo pade_asyiceSW ! PADE coefficients for shortwave ice asymmetry parameter + real(kind_phys) :: & + radliq_lwrSW, & ! Liquid particle size lower bound for LUT interpolation + radliq_uprSW, & ! Liquid particle size upper bound for LUT interpolation + radice_lwrSW, & ! Ice particle size upper bound for LUT interpolation + radice_uprSW ! Ice particle size lower bound for LUT interpolation - ! Parameters used for rain and snow(+groupel) RRTMGP cloud-optics + ! Parameters used for rain and snow(+groupel) RRTMGP cloud-optics. *NOTE* Same as in RRTMG + ! Need to document these magic numbers below. real(kind_phys),parameter :: & - a0r = 3.07e-3, & ! - a0s = 0.0, & ! - a1s = 1.5 ! + a0r = 3.07e-3, & ! + a0s = 0.0, & ! + a1s = 1.5 ! real(kind_phys),dimension(:),allocatable :: b0r,b0s,b1s,c0r,c0s - real(kind_phys) :: & - radliq_lwrSW, & ! Liquid particle size lower bound for LUT interpolation - radliq_uprSW, & ! Liquid particle size upper bound for LUT interpolation - radice_lwrSW, & ! Ice particle size upper bound for LUT interpolation - radice_uprSW ! Ice particle size lower bound for LUT interpolation contains - -!>\defgroup rrtmgp_sw_cloud_optics_mod GFS RRTMGP-SW Cloud Optics Module -!> \section arg_table_rrtmgp_sw_cloud_optics_init -!! \htmlinclude rrtmgp_lw_cloud_optics.html -!! -!> \ingroup rrtmgp_sw_cloud_optics -!! -!! RRTMGP relies heavily on derived-data-types, which contain type-bound procedures -!! that are referenced frequently throughout the RRTMGP shortwave scheme. The data needed -!! to compute the shortwave cloud optical properties are initialized here and loaded into -!! the RRTMGP DDT, ty_cloud_optics. -!! -!! \section rrtmgp_sw_cloud_optics_init ! ###################################################################################### - subroutine rrtmgp_sw_cloud_optics_init(doG_cldoptics, doGP_cldoptics_PADE, & - doGP_cldoptics_LUT, nrghice, rrtmgp_root_dir, rrtmgp_sw_file_clouds, mpicomm, & - mpirank, mpiroot, errmsg, errflg) + ! SUBROUTINE sw_cloud_optics_init + ! ###################################################################################### + subroutine rrtmgp_sw_cloud_optics_init( rrtmgp_root_dir, rrtmgp_sw_file_clouds, & + doGP_cldoptics_PADE, doGP_cldoptics_LUT, nrghice, mpicomm, mpirank, mpiroot, & + errmsg, errflg) ! Inputs + character(len=128),intent(in) :: & + rrtmgp_root_dir, & ! RTE-RRTMGP root directory + rrtmgp_sw_file_clouds ! RRTMGP file containing cloud-optic data logical, intent(in) :: & - doG_cldoptics, & ! Use legacy RRTMG cloud-optics? - doGP_cldoptics_PADE, & ! Use RRTMGP cloud-optics: PADE approximation? - doGP_cldoptics_LUT ! Use RRTMGP cloud-optics: LUTs? + doGP_cldoptics_PADE,& ! Use RRTMGP cloud-optics: PADE approximation? + doGP_cldoptics_LUT ! Use RRTMGP cloud-optics: LUTs? integer, intent(inout) :: & nrghice ! Number of ice-roughness categories integer, intent(in) :: & mpicomm, & ! MPI communicator mpirank, & ! Current MPI rank mpiroot ! Master MPI rank - character(len=128),intent(in) :: & - rrtmgp_root_dir, & ! RTE-RRTMGP root directory - rrtmgp_sw_file_clouds ! RRTMGP file containing coefficients used to compute clouds optical properties ! Outputs character(len=*), intent(out) :: & @@ -120,8 +98,6 @@ subroutine rrtmgp_sw_cloud_optics_init(doG_cldoptics, doGP_cldoptics_PADE, errmsg = '' errflg = 0 - if (doG_cldoptics) return - ! Filenames are set in the physics_nml sw_cloud_props_file = trim(rrtmgp_root_dir)//trim(rrtmgp_sw_file_clouds) @@ -180,7 +156,7 @@ subroutine rrtmgp_sw_cloud_optics_init(doG_cldoptics, doGP_cldoptics_PADE, call mpi_bcast(nPairsSW, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) #endif - ! Has the number of ice-roughnesses provided from the namelist? + ! Has the number of ice-roughnes categories been provided from the namelist? ! If so, override nrghice from cloud-optics file if (nrghice .ne. 0) nrghice_fromfileSW = nrghice #ifdef MPI @@ -404,182 +380,4 @@ subroutine rrtmgp_sw_cloud_optics_init(doG_cldoptics, doGP_cldoptics_PADE, 0.970, 0.970, 0.970, 0.700, 0.700, 0.700, 0.700/) end subroutine rrtmgp_sw_cloud_optics_init - -!> \section arg_table_rrtmgp_sw_cloud_optics_run -!! \htmlinclude rrtmgp_sw_cloud_optics.html -!! -!> \ingroup rrtmgp_sw_cloud_optics -!! -!! Compute shortwave optical prperties (optical-depth, single-scattering albedo, -!! asymmetry parameter) for ALL cloud types visible to RRTMGP. -!! -!! \section rrtmgp_sw_gas_optics_run - ! ###################################################################################### - subroutine rrtmgp_sw_cloud_optics_run(doSWrad, doG_cldoptics, icliq_sw, icice_sw, & - doGP_cldoptics_PADE, doGP_cldoptics_LUT, do_mynnedmf, imfdeepcnv, imfdeepcnv_gf, & - imfdeepcnv_samf, nCol, nLev, nDay, nbndsGPsw, idxday, cld_frac, cld_lwp, cld_reliq, & - cld_iwp, cld_reice, cld_swp, cld_resnow, cld_rwp, cld_rerain, precip_frac, & - cld_cnv_lwp, cld_cnv_reliq, cld_cnv_iwp, cld_cnv_reice, cld_pbl_lwp, cld_pbl_reliq, & - cld_pbl_iwp, cld_pbl_reice, sw_optical_props_cloudsByBand, & - sw_optical_props_cnvcloudsByBand, sw_optical_props_precipByBand, & - sw_optical_props_MYNNcloudsByBand, cldtausw, errmsg, errflg) - - ! Inputs - logical, intent(in) :: & - doSWrad, & ! Logical flag for shortwave radiation call - doG_cldoptics, & ! Use legacy RRTMG cloud-optics? - doGP_cldoptics_PADE, & ! Use RRTMGP cloud-optics: PADE approximation? - doGP_cldoptics_LUT, & ! Use RRTMGP cloud-optics: LUTs? - do_mynnedmf ! - integer, intent(in) :: & - nbndsGPsw, & ! Number of shortwave bands - nCol, & ! Number of horizontal gridpoints - nLev, & ! Number of vertical levels - nday, & ! Number of daylit points. - icliq_sw, & ! Choice of treatment of liquid cloud optical properties (RRTMG legacy) - icice_sw, & ! Choice of treatment of ice cloud optical properties (RRTMG legacy) - imfdeepcnv, & ! - imfdeepcnv_gf, & ! - imfdeepcnv_samf ! - integer,intent(in),dimension(:) :: & - idxday ! Indices for daylit points. - real(kind_phys), dimension(:,:),intent(in) :: & - cld_frac, & ! Total cloud fraction by layer - cld_lwp, & ! Cloud liquid water path - cld_reliq, & ! Cloud liquid effective radius - cld_iwp, & ! Cloud ice water path - cld_reice, & ! Cloud ice effective radius - cld_swp, & ! Cloud snow water path - cld_resnow, & ! Cloud snow effective radius - cld_rwp, & ! Cloud rain water path - cld_rerain, & ! Cloud rain effective radius - precip_frac, & ! Precipitation fraction by layer - cld_cnv_lwp, & ! Water path for convective liquid cloud-particles (microns) - cld_cnv_reliq, & ! Effective radius for convective liquid cloud-particles (microns) - cld_cnv_iwp, & ! Water path for convective ice cloud-particles (microns) - cld_cnv_reice, & ! Effective radius for convective ice cloud-particles (microns) - cld_pbl_lwp, & ! Water path for SGS PBL liquid cloud-particles - cld_pbl_reliq, & ! Effective radius for SGS PBL liquid cloud-particles - cld_pbl_iwp, & ! Water path for SGS PBL ice cloud-particles - cld_pbl_reice ! Effective radius for SGS PBL ice cloud-particles - ! Outputs - character(len=*), intent(out) :: & - errmsg ! CCPP error message - integer, intent(out) :: & - errflg ! CCPP error flag - type(ty_optical_props_2str),intent(out) :: & - sw_optical_props_cloudsByBand, & ! RRTMGP DDT: Shortwave optical properties in each band (clouds) - sw_optical_props_cnvcloudsByBand, & ! RRTMGP DDT: Shortwave optical properties in each band (convective cloud) - sw_optical_props_MYNNcloudsByBand,& ! RRTMGP DDT: Shortwave optical properties in each band (MYNN PBL cloud) - sw_optical_props_precipByBand ! RRTMGP DDT: Shortwave optical properties in each band (cloud precipitation) - real(kind_phys), dimension(:,:), intent(out) :: & - cldtausw ! Approx 10.mu band layer cloud optical depth - - ! Local variables - integer :: iDay, iLay, iBand - real(kind_phys) :: tau_rain, tau_snow, ssa_rain, ssa_snow, asy_rain, asy_snow, & - tau_prec, asy_prec, ssa_prec, asyw, ssaw, za1, za2 - real(kind_phys), dimension(nday,nLev,nbndsGPsw) :: & - tau_cld, ssa_cld, asy_cld, tau_precip, ssa_precip, asy_precip - type(ty_optical_props_2str) :: sw_optical_props_cloudsByBand_daylit - - ! Initialize CCPP error handling variables - errmsg = '' - errflg = 0 - - if (.not. doSWrad) return - - ! Only process sunlit points... - if (nDay .gt. 0) then - - ! Compute cloud/precipitation optics. - if (doGP_cldoptics_PADE .or. doGP_cldoptics_LUT) then - ! i) Cloud-optics. - call check_error_msg('rrtmgp_sw_cloud_optics_run - sw_optical_props_cloudsByBand',& - sw_optical_props_cloudsByBand%alloc_2str(nday, nLev, sw_cloud_props%get_band_lims_wavenumber())) - - call check_error_msg('rrtmgp_sw_cloud_optics_run - clouds',sw_cloud_props%cloud_optics(& - 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 - cld_reice(idxday(1:nday),:), & ! IN - Cloud ice effective radius - sw_optical_props_cloudsByBand)) ! OUT - RRTMGP DDT: Shortwave optical properties, - ! in each band (tau,ssa,g) - - ! ii) Convective cloud-optics - if (imfdeepcnv == imfdeepcnv_samf .or. imfdeepcnv == imfdeepcnv_gf) then - call check_error_msg('rrtmgp_sw_cloud_optics_run - sw_optical_props_cnvcloudsByBand',& - sw_optical_props_cnvcloudsByBand%alloc_2str(nday, nLev, sw_cloud_props%get_band_lims_wavenumber())) - - call check_error_msg('rrtmgp_sw_cloud_optics_run - convective clouds',sw_cloud_props%cloud_optics(& - cld_cnv_lwp(idxday(1:nday),:), & ! IN - Convective cloud liquid water path - cld_cnv_iwp(idxday(1:nday),:), & ! IN - Convective cloud ice water path - cld_cnv_reliq(idxday(1:nday),:), & ! IN - Convective cloud liquid effective radius - cld_cnv_reice(idxday(1:nday),:), & ! IN - Convective cloud ice effective radius - sw_optical_props_cnvcloudsByBand)) ! OUT - RRTMGP DDT: Shortwave optical properties, - ! in each band (tau,ssa,g) - endif - - ! iii) MYNN cloud-optics - if (do_mynnedmf) then - call check_error_msg('rrtmgp_sw_cloud_optics_run - sw_optical_props_MYNNcloudsByBand',& - sw_optical_props_MYNNcloudsByBand%alloc_2str(nday, nLev, sw_cloud_props%get_band_lims_wavenumber())) - - call check_error_msg('rrtmgp_sw_MYNNcloud_optics_run - MYNN-EDMF cloud',sw_cloud_props%cloud_optics(& - cld_pbl_lwp(idxday(1:nday),:), & ! IN - MYNN-EDMF PBL cloud liquid water path (g/m2) - cld_pbl_iwp(idxday(1:nday),:), & ! IN - MYNN-EDMF PBL cloud ice water path (g/m2) - cld_pbl_reliq(idxday(1:nday),:), & ! IN - MYNN-EDMF PBL cloud liquid effective radius (microns) - cld_pbl_reice(idxday(1:nday),:), & ! IN - MYNN-EDMF PBL cloud ice effective radius (microns) - sw_optical_props_MYNNcloudsByBand)) ! OUT - RRTMGP DDT containing MYNN-EDMF PBL cloud radiative properties - ! in each band - endif - - ! iv) Cloud precipitation optics: rain and snow(+groupel) - call check_error_msg('rrtmgp_sw_cloud_optics_run - sw_optical_props_precipByBand',& - sw_optical_props_precipByBand%alloc_2str(nday, nLev, sw_cloud_props%get_band_lims_wavenumber())) - sw_optical_props_precipByBand%tau(:,:,:) = 0._kind_phys - sw_optical_props_precipByBand%ssa(:,:,:) = 1._kind_phys - sw_optical_props_precipByBand%g(:,:,:) = 0._kind_phys - - do iDay=1,nDay - do iLay=1,nLev - if (cld_frac(idxday(iDay),iLay) .gt. 1.e-12_kind_phys) then - ! Rain/Snow optical depth (No band dependence) - tau_rain = cld_rwp(idxday(iDay),iLay)*a0r - if (cld_swp(idxday(iDay),iLay) .gt. 0. .and. cld_resnow(idxday(iDay),iLay) .gt. 10._kind_phys) then - tau_snow = cld_swp(idxday(iDay),iLay)*1.09087*(a0s + a1s/(1.0315*cld_resnow(idxday(iDay),iLay))) ! fu's formula - else - tau_snow = 0._kind_phys - endif - - ! Rain/Snow single-scattering albedo and asymmetry (Band dependent) - do iBand=1,nbndsGPsw - ! By species - ssa_rain = tau_rain*(1.-b0r(iBand)) - asy_rain = ssa_rain*c0r(iBand) - ssa_snow = tau_snow*(1.-(b0s(iBand)+b1s(iBand)*1.0315*cld_resnow(idxday(iDay),iLay))) - asy_snow = ssa_snow*c0s(iBand) - ! Combine - tau_prec = max(1.e-12_kind_phys, tau_rain + tau_snow) - ssa_prec = max(1.e-12_kind_phys, ssa_rain + ssa_snow) - asy_prec = max(1.e-12_kind_phys, asy_rain + asy_snow) - asyw = asy_prec/max(1.e-12_kind_phys, ssa_prec) - ssaw = min(1._kind_phys-0.000001, ssa_prec/tau_prec) - za1 = asyw * asyw - za2 = ssaw * za1 - sw_optical_props_precipByBand%tau(iDay,iLay,iBand) = (1._kind_phys - za2) * tau_prec - sw_optical_props_precipByBand%ssa(iDay,iLay,iBand) = (ssaw - za2) / (1._kind_phys - za2) - sw_optical_props_precipByBand%g(iDay,iLay,iBand) = asyw/(1+asyw) - enddo - endif - enddo - enddo - endif - - ! All-sky SW optical depth ~0.55microns (DJS asks: Move to cloud diagnostics?) - cldtausw(idxday(1:nDay),:) = sw_optical_props_cloudsByBand%tau(:,:,11) - endif - - end subroutine rrtmgp_sw_cloud_optics_run - end module rrtmgp_sw_cloud_optics diff --git a/physics/rrtmgp_sw_cloud_optics.meta b/physics/rrtmgp_sw_cloud_optics.meta deleted file mode 100644 index 064b7cf80..000000000 --- a/physics/rrtmgp_sw_cloud_optics.meta +++ /dev/null @@ -1,393 +0,0 @@ -[ccpp-table-properties] - name = rrtmgp_sw_cloud_optics - type = scheme - dependencies = machine.F,rrtmg_sw_cloud_optics.F90,radiation_tools.F90 - -######################################################################## -[ccpp-arg-table] - name = rrtmgp_sw_cloud_optics_init - type = scheme -[doG_cldoptics] - standard_name = flag_to_calc_lw_cld_optics_using_RRTMG - long_name = logical flag to control cloud optics scheme. - units = flag - dimensions = () - type = logical - intent = in -[doGP_cldoptics_PADE] - standard_name = flag_to_calc_lw_cld_optics_using_RRTMGP_PADE - long_name = logical flag to control cloud optics scheme. - units = flag - dimensions = () - type = logical - intent = in -[doGP_cldoptics_LUT] - standard_name = flag_to_calc_lw_cld_optics_using_RRTMGP_LUT - long_name = logical flag to control cloud optics scheme. - units = flag - dimensions = () - type = logical - intent = in -[nrghice] - standard_name = number_of_ice_roughness_categories - long_name = number of ice-roughness categories in RRTMGP calculation - units = count - dimensions = () - type = integer - intent = inout -[rrtmgp_root_dir] - standard_name = directory_for_rte_rrtmgp_source_code - long_name = directory for rte+rrtmgp source code - units = none - dimensions = () - type = character - intent = in - kind = len=128 -[rrtmgp_sw_file_clouds] - standard_name = filename_of_rrtmgp_shortwave_cloud_optics_coefficients - long_name = file containing coefficients for RRTMGP SW cloud optics - units = none - dimensions = () - type = character - intent = in - kind = len=128 -[mpirank] - standard_name = mpi_rank - long_name = current MPI rank - units = index - dimensions = () - type = integer - intent = in -[mpiroot] - standard_name = mpi_root - long_name = master MPI rank - units = index - dimensions = () - type = integer - intent = in -[mpicomm] - standard_name = mpi_communicator - long_name = MPI communicator - units = index - dimensions = () - type = integer - intent = in -[errmsg] - standard_name = ccpp_error_message - long_name = error message for error handling in CCPP - units = none - dimensions = () - type = character - kind = len=* - intent = out -[errflg] - standard_name = ccpp_error_code - long_name = error code for error handling in CCPP - units = 1 - dimensions = () - type = integer - intent = out -######################################################################## -[ccpp-arg-table] - name = rrtmgp_sw_cloud_optics_run - type = scheme -[doSWrad] - standard_name = flag_for_calling_shortwave_radiation - long_name = logical flags for sw radiation calls - units = flag - dimensions = () - type = logical - intent = in -[ncol] - standard_name = horizontal_loop_extent - long_name = horizontal dimension - units = count - dimensions = () - type = integer - intent = in -[nLev] - standard_name = vertical_layer_dimension - long_name = number of vertical levels - units = count - dimensions = () - type = integer - intent = in -[doG_cldoptics] - standard_name = flag_to_calc_lw_cld_optics_using_RRTMG - long_name = logical flag to control cloud optics scheme. - units = flag - dimensions = () - type = logical - intent = in -[icliq_sw] - standard_name = control_for_shortwave_radiation_liquid_clouds - long_name = sw optical property for liquid clouds - units = flag - dimensions = () - type = integer - intent = in -[icice_sw] - standard_name = flag_for_optical_property_for_ice_clouds_for_shortwave_radiation - long_name = sw optical property for ice clouds - units = flag - dimensions = () - type = integer - intent = in -[doGP_cldoptics_PADE] - standard_name = flag_to_calc_lw_cld_optics_using_RRTMGP_PADE - long_name = logical flag to control cloud optics scheme. - units = flag - dimensions = () - type = logical - intent = in -[doGP_cldoptics_LUT] - standard_name = flag_to_calc_lw_cld_optics_using_RRTMGP_LUT - long_name = logical flag to control cloud optics scheme. - units = flag - dimensions = () - type = logical - intent = in -[do_mynnedmf] - standard_name = flag_for_mellor_yamada_nakanishi_niino_pbl_scheme - long_name = flag to activate MYNN-EDMF - units = flag - dimensions = () - type = logical - intent = in -[imfdeepcnv] - standard_name = control_for_deep_convection_scheme - long_name = flag for mass-flux deep convection scheme - units = flag - dimensions = () - type = integer - intent = in -[imfdeepcnv_gf] - standard_name = identifier_for_grell_freitas_deep_convection - long_name = flag for Grell-Freitas deep convection scheme - units = flag - dimensions = () - type = integer - intent = in -[imfdeepcnv_samf] - standard_name = identifer_for_scale_aware_mass_flux_deep_convection - long_name = flag for SAMF deep convection scheme - units = flag - dimensions = () - type = integer - intent = in -[cld_frac] - standard_name = total_cloud_fraction - long_name = layer total cloud fraction - units = frac - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = in -[cld_lwp] - standard_name = cloud_liquid_water_path - long_name = layer cloud liquid water path - units = g m-2 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = in -[cld_reliq] - standard_name = mean_effective_radius_for_liquid_cloud - long_name = mean effective radius for liquid cloud - units = um - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = in -[cld_iwp] - standard_name = cloud_ice_water_path - long_name = layer cloud ice water path - units = g m-2 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = in -[cld_reice] - standard_name = mean_effective_radius_for_ice_cloud - long_name = mean effective radius for ice cloud - units = um - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = in -[cld_swp] - standard_name = cloud_snow_water_path - long_name = layer cloud snow water path - units = g m-2 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = in -[cld_resnow] - standard_name = mean_effective_radius_for_snow_flake - long_name = mean effective radius for snow cloud - units = um - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = in -[cld_rwp] - standard_name = cloud_rain_water_path - long_name = layer cloud rain water path - units = g m-2 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = in -[cld_rerain] - standard_name = mean_effective_radius_for_rain_drop - long_name = mean effective radius for rain cloud - units = um - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = in -[precip_frac] - standard_name = precipitation_fraction_by_layer - long_name = precipitation fraction in each layer - units = frac - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = in -[cld_cnv_lwp] - standard_name = convective_cloud_liquid_water_path - long_name = layer convective cloud liquid water path - units = g m-2 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = in -[cld_cnv_iwp] - standard_name = convective_cloud_ice_water_path - long_name = layer convective cloud ice water path - units = g m-2 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = in -[cld_cnv_reliq] - standard_name = mean_effective_radius_for_liquid_convective_cloud - long_name = mean effective radius for liquid convective cloud - units = um - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = in -[cld_cnv_reice] - standard_name = mean_effective_radius_for_ice_convective_cloud - long_name = mean effective radius for ice convective cloud - units = um - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = in -[cld_pbl_lwp] - standard_name = MYNN_SGS_cloud_liquid_water_path - long_name = layer convective cloud liquid water path - units = g m-2 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = in -[cld_pbl_iwp] - standard_name = MYNN_SGS_cloud_ice_water_path - long_name = layer convective cloud ice water path - units = g m-2 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = in -[cld_pbl_reliq] - standard_name = mean_effective_radius_for_liquid_MYNN_SGS_cloud - long_name = mean effective radius for liquid MYNN_SGS cloud - units = um - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = in -[cld_pbl_reice] - standard_name = mean_effective_radius_for_ice_MYNN_SGS_cloud - long_name = mean effective radius for ice MYNN_SGS cloud - units = um - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = in -[nbndsGPsw] - standard_name = number_of_shortwave_bands - long_name = number of sw bands used in RRTMGP - units = count - dimensions = () - type = integer - intent = in -[nday] - standard_name = daytime_points_dimension - long_name = daytime points dimension - units = count - dimensions = () - type = integer - intent = in -[idxday] - standard_name = daytime_points - long_name = daytime points - units = index - dimensions = (horizontal_loop_extent) - type = integer - intent = in -[sw_optical_props_cloudsByBand] - standard_name = shortwave_optical_properties_for_cloudy_atmosphere_by_band - long_name = Fortran DDT containing RRTMGP optical properties - units = DDT - dimensions = () - type = ty_optical_props_2str - intent = out -[sw_optical_props_cnvcloudsByBand] - standard_name = shortwave_optical_properties_for_convective_cloudy_atmosphere_by_band - long_name = Fortran DDT containing RRTMGP optical properties - units = DDT - dimensions = () - type = ty_optical_props_2str - intent = out -[sw_optical_props_precipByBand] - standard_name = shortwave_optical_properties_for_precipitation_by_band - long_name = Fortran DDT containing RRTMGP optical properties - units = DDT - dimensions = () - type = ty_optical_props_2str - intent = out -[sw_optical_props_MYNNcloudsByBand] - standard_name = shortwave_optical_properties_for_MYNN_EDMF_PBL_cloudy_atmosphere_by_band - long_name = Fortran DDT containing RRTMGP optical properties - units = DDT - dimensions = () - type = ty_optical_props_2str - intent = out -[cldtausw] - standard_name = cloud_optical_depth_layers_at_0p55mu_band - long_name = approx .55mu band layer cloud optical depth - units = none - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = out -[errmsg] - standard_name = ccpp_error_message - long_name = error message for error handling in CCPP - units = none - dimensions = () - type = character - kind = len=* - intent = out -[errflg] - standard_name = ccpp_error_code - long_name = error code for error handling in CCPP - units = 1 - dimensions = () - type = integer - intent = out diff --git a/physics/rrtmgp_sw_cloud_sampling.F90 b/physics/rrtmgp_sw_cloud_sampling.F90 deleted file mode 100644 index 238ed7d1c..000000000 --- a/physics/rrtmgp_sw_cloud_sampling.F90 +++ /dev/null @@ -1,174 +0,0 @@ -!> \file rrtmgp_sw_cloud_sampling.F90 -!! -!> \defgroup rrtmgp_sw_cloud_sampling rrtmgp_sw_cloud_sampling.F90 -!! -module rrtmgp_sw_cloud_sampling - use machine, only: kind_phys, kind_dbl_prec - use mo_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp - use mo_optical_props, only: ty_optical_props_2str - use rrtmgp_sampling, only: sampled_mask, draw_samples - use mersenne_twister, only: random_setseed, random_number, random_stat - use radiation_tools, only: check_error_msg - use rrtmgp_sw_gas_optics, only: sw_gas_props - use netcdf - - implicit none - -contains - -!>\defgroup rrtmgp_sw_cloud_sampling_mod GFS RRTMGP-SW Cloud Sampling Module -!> @{ -!> \section arg_table_rrtmgp_sw_cloud_sampling_run -!! \htmlinclude rrtmgp_sw_cloud_sampling.html -!! -!> \ingroup rrtmgp_sw_cloud_sampling -!! -!! \brief This routine performs the McICA cloud-sampling and maps the shortwave cloud- -!! optical properties, defined for each spectral band, to each spectral point (g-point). -!! -!! \section rrtmgp_sw_cloud_sampling_run - subroutine rrtmgp_sw_cloud_sampling_run(doSWrad, nCol, nDay, nLev, idxday, iovr, & - iovr_convcld, iovr_max, iovr_maxrand, iovr_rand, iovr_dcorr, iovr_exp, iovr_exprand, & - isubc_sw,icseed_sw, cld_frac, precip_frac, cloud_overlap_param, precip_overlap_param,& - imfdeepcnv, imfdeepcnv_gf, imfdeepcnv_samf, cnv_cloud_overlap_param, cld_cnv_frac, & - sw_optical_props_cnvcloudsByBand, sw_optical_props_cloudsByBand, & - sw_optical_props_precipByBand, sw_optical_props_clouds, sw_optical_props_cnvclouds, & - sw_optical_props_precip, errmsg, errflg) - - ! Inputs - logical, intent(in) :: & - doSWrad ! Logical flag for shortwave radiation call - integer, intent(in) :: & - nCol, & ! Number of horizontal gridpoints - nDay, & ! Number of daylit points. - nLev, & ! Number of vertical layers - imfdeepcnv, & ! - imfdeepcnv_gf, & ! - imfdeepcnv_samf, & ! - iovr, & ! Choice of cloud-overlap method - iovr_convcld, & ! Choice of convective cloud-overlap method - iovr_max, & ! Flag for maximum cloud overlap method - iovr_maxrand, & ! Flag for maximum-random cloud overlap method - iovr_rand, & ! Flag for random cloud overlap method - iovr_dcorr, & ! Flag for decorrelation-length cloud overlap method - iovr_exp, & ! Flag for exponential cloud overlap method - iovr_exprand, & ! Flag for exponential-random cloud overlap method - isubc_sw - integer,intent(in),dimension(:) :: & - idxday ! Indices for daylit points. - integer,intent(in),dimension(:) :: & - icseed_sw ! auxiliary special cloud related array when module - ! variable isubc_sw=2, it provides permutation seed - ! for each column profile that are used for generating - ! random numbers. when isubc_sw /=2, it will not be used. - real(kind_phys), dimension(:,:),intent(in) :: & - cld_frac, & ! Total cloud fraction by layer - cld_cnv_frac, & ! Convective cloud fraction by layer - precip_frac ! Precipitation fraction by layer - real(kind_phys), dimension(:,:), intent(in) :: & - cloud_overlap_param, & ! Cloud overlap parameter - cnv_cloud_overlap_param, & ! Convective cloud overlap parameter - precip_overlap_param ! Precipitation overlap parameter - type(ty_optical_props_2str),intent(in) :: & - sw_optical_props_cloudsByBand, & ! RRTMGP DDT: Shortwave optical properties in each band (clouds) - sw_optical_props_cnvcloudsByBand,& ! RRTMGP DDT: Shortwave optical properties in each band (convectivecloud) - sw_optical_props_precipByBand ! RRTMGP DDT: Shortwave optical properties in each band (precipitation) - - ! Outputs - character(len=*), intent(out) :: & - errmsg ! Error message - integer, intent(out) :: & - errflg ! Error flag - type(ty_optical_props_2str),intent(out) :: & - sw_optical_props_clouds, & ! RRTMGP DDT: Shortwave optical properties at each spectral point (clouds) - sw_optical_props_cnvclouds, & ! RRTMGP DDT: Shortwave optical properties at each spectral point (convectivecloud) - sw_optical_props_precip ! RRTMGP DDT: Shortwave optical properties at each spectral point (precipitation) - - ! Local variables - integer :: iday,iLay,iGpt - integer,dimension(nday) :: ipseed_sw - type(random_stat) :: rng_stat - real(kind_phys) :: tauloc,asyloc,ssaloc - real(kind_dbl_prec), dimension(sw_gas_props%get_ngpt(),nLev,nday) :: rng3D,rng3D2 - real(kind_dbl_prec), dimension(sw_gas_props%get_ngpt()*nLev) :: rng2D - real(kind_dbl_prec), dimension(sw_gas_props%get_ngpt()) :: rng1D - logical, dimension(nday,nLev,sw_gas_props%get_ngpt()) :: maskMCICA - - ! Initialize CCPP error handling variables - errmsg = '' - errflg = 0 - - if (.not. doSWrad) return - if (nDay .gt. 0) then - ! ################################################################################# - ! First sample the clouds... - ! ################################################################################# - - ! Allocate space RRTMGP DDTs [nday,nLev,nGpt] - call check_error_msg('rrtmgp_sw_cloud_sampling_run', & - sw_optical_props_clouds%alloc_2str(nday, nLev, sw_gas_props)) - - ! Change random number seed value for each radiation invocation (isubc_sw =1 or 2). - if(isubc_sw == 1) then ! advance prescribed permutation seed - do iday = 1, nday - ipseed_sw(iday) = sw_gas_props%get_ngpt() + iday - enddo - elseif (isubc_sw == 2) then ! use input array of permutaion seeds - do iday = 1, nday - ipseed_sw(iday) = icseed_sw(idxday(iday)) - enddo - endif - - ! Call RNG. Mersennse Twister accepts 1D array, so loop over columns and collapse along G-points - ! and layers. ([nGpts,nLev,nDayumn]-> [nGpts*nLev]*nDayumn) - do iday=1,nday - call random_setseed(ipseed_sw(iday),rng_stat) - ! Use same rng for each layer - if (iovr == iovr_max) then - call random_number(rng1D,rng_stat) - do iLay=1,nLev - rng3D(:,iLay,iday) = rng1D - enddo - else - do iLay=1,nLev - call random_number(rng1D,rng_stat) - rng3D(:,iLay,iday) = rng1D - enddo - endif - enddo - - ! Cloud overlap. - ! Maximum-random, random, or maximum cloud overlap - if (iovr == iovr_maxrand .or. iovr == iovr_max .or. iovr == iovr_rand) then - call sampled_mask(real(rng3D, kind=kind_phys), cld_frac(idxday(1:nDay),:), maskMCICA) - endif - ! Decorrelation-length overlap - if (iovr == iovr_dcorr) then - do iday=1,nday - call random_setseed(ipseed_sw(iday),rng_stat) - call random_number(rng2D,rng_stat) - rng3D2(:,:,iday) = reshape(source = rng2D,shape=[sw_gas_props%get_ngpt(),nLev]) - enddo - call sampled_mask(real(rng3D, kind=kind_phys), cld_frac(idxday(1:nDay),:), maskMCICA, & - overlap_param = cloud_overlap_param(idxday(1:nDay),1:nLev-1), & - randoms2 = real(rng3D2, kind=kind_phys)) - endif - ! Exponential or exponential-random cloud overlap - if (iovr == iovr_exp .or. iovr == iovr_exprand) then - call sampled_mask(real(rng3D, kind=kind_phys), cld_frac(idxday(1:nDay),:), maskMCICA, & - overlap_param = cloud_overlap_param(idxday(1:nDay),1:nLev-1)) - endif - - ! - ! Sampling. Map band optical depth to each g-point using McICA - ! - call check_error_msg('rrtmgp_sw_cloud_sampling_run_draw_samples', & - draw_samples(maskMCICA, .true., & - sw_optical_props_cloudsByBand, & - sw_optical_props_clouds)) - endif - - end subroutine rrtmgp_sw_cloud_sampling_run - -!> @} -end module rrtmgp_sw_cloud_sampling diff --git a/physics/rrtmgp_sw_cloud_sampling.meta b/physics/rrtmgp_sw_cloud_sampling.meta deleted file mode 100644 index 1415108f8..000000000 --- a/physics/rrtmgp_sw_cloud_sampling.meta +++ /dev/null @@ -1,240 +0,0 @@ -[ccpp-table-properties] - name = rrtmgp_sw_cloud_sampling - type = scheme - dependencies = machine.F,mersenne_twister.f,rrtmgp_sampling.F90,radiation_tools.F90 - -###################################################### -[ccpp-arg-table] - name = rrtmgp_sw_cloud_sampling_run - type = scheme -[doSWrad] - standard_name = flag_for_calling_shortwave_radiation - long_name = logical flags for sw radiation calls - units = flag - dimensions = () - type = logical - intent = in -[imfdeepcnv] - standard_name = control_for_deep_convection_scheme - long_name = flag for mass-flux deep convection scheme - units = flag - dimensions = () - type = integer - intent = in -[imfdeepcnv_gf] - standard_name = identifier_for_grell_freitas_deep_convection - long_name = flag for Grell-Freitas deep convection scheme - units = flag - dimensions = () - type = integer - intent = in -[imfdeepcnv_samf] - standard_name = identifer_for_scale_aware_mass_flux_deep_convection - long_name = flag for SAMF deep convection scheme - units = flag - dimensions = () - type = integer - intent = in -[iovr_convcld] - standard_name = flag_for_convective_cloud_overlap_method_for_radiation - long_name = flag for convective cloud overlap method - units = flag - dimensions = () - type = integer - intent = in -[ncol] - standard_name = horizontal_loop_extent - long_name = horizontal dimension - units = count - dimensions = () - type = integer - intent = in -[nday] - standard_name = daytime_points_dimension - long_name = daytime points dimension - units = count - dimensions = () - type = integer - intent = in -[nLev] - standard_name = vertical_layer_dimension - long_name = number of vertical levels - units = count - dimensions = () - type = integer - intent = in -[isubc_sw] - standard_name = flag_for_sw_clouds_grid_approximation - long_name = flag for sw clouds sub-grid approximation - units = flag - dimensions = () - type = integer - intent = in -[idxday] - standard_name = daytime_points - long_name = daytime points - units = index - dimensions = (horizontal_loop_extent) - type = integer - intent = in -[iovr] - standard_name = flag_for_cloud_overlap_method_for_radiation - long_name = max-random overlap clouds - units = flag - dimensions = () - type = integer - intent = in -[iovr_maxrand] - standard_name = flag_for_maximum_random_cloud_overlap_method - long_name = choice of maximum-random cloud overlap method - units = flag - dimensions = () - type = integer - intent = in -[iovr_dcorr] - standard_name = flag_for_decorrelation_length_cloud_overlap_method - long_name = choice of decorrelation-length cloud overlap method - units = flag - dimensions = () - type = integer - intent = in -[iovr_exp] - standard_name = flag_for_exponential_cloud_overlap_method - long_name = choice of exponential cloud overlap method - units = flag - dimensions = () - type = integer - intent = in -[iovr_exprand] - standard_name = flag_for_exponential_random_cloud_overlap_method - long_name = choice of exponential-random cloud overlap method - units = flag - dimensions = () - type = integer - intent = in -[iovr_rand] - standard_name = flag_for_random_cloud_overlap_method - long_name = choice of random cloud overlap method - units = flag - dimensions = () - type = integer - intent = in -[iovr_max] - standard_name = flag_for_maximum_cloud_overlap_method - long_name = choice of maximum cloud overlap method - units = flag - dimensions = () - type = integer - intent = in -[icseed_sw] - standard_name = random_number_seed_for_mcica_shortwave - long_name = seed for random number generation for shortwave radiation - units = none - dimensions = (horizontal_loop_extent) - type = integer - intent = in -[cld_frac] - standard_name = total_cloud_fraction - long_name = layer total cloud fraction - units = frac - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = in -[precip_frac] - standard_name = precipitation_fraction_by_layer - long_name = precipitation fraction in each layer - units = frac - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = in -[cld_cnv_frac] - standard_name = convective_cloud_fraction_for_RRTMGP - long_name = layer convective cloud fraction - units = frac - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = in -[cnv_cloud_overlap_param] - standard_name = convective_cloud_overlap_param - long_name = convective cloud overlap parameter - units = km - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = in -[cloud_overlap_param] - standard_name = cloud_overlap_param - long_name = cloud overlap parameter - units = km - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = in -[precip_overlap_param] - standard_name = precip_overlap_param - long_name = precipitation overlap parameter - units = km - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = in -[sw_optical_props_cloudsByBand] - standard_name = shortwave_optical_properties_for_cloudy_atmosphere_by_band - long_name = Fortran DDT containing RRTMGP optical properties - units = DDT - dimensions = () - type = ty_optical_props_2str - intent = in -[sw_optical_props_cnvcloudsByBand] - standard_name = shortwave_optical_properties_for_convective_cloudy_atmosphere_by_band - long_name = Fortran DDT containing RRTMGP optical properties - units = DDT - dimensions = () - type = ty_optical_props_2str - intent = in -[sw_optical_props_precipByBand] - standard_name = shortwave_optical_properties_for_precipitation_by_band - long_name = Fortran DDT containing RRTMGP optical properties - units = DDT - dimensions = () - type = ty_optical_props_2str - intent = in -[sw_optical_props_clouds] - standard_name = shortwave_optical_properties_for_cloudy_atmosphere - long_name = Fortran DDT containing RRTMGP optical properties - units = DDT - dimensions = () - type = ty_optical_props_2str - intent = out -[sw_optical_props_cnvclouds] - standard_name = shortwave_optical_properties_for_convective_cloudy_atmosphere - long_name = Fortran DDT containing RRTMGP optical properties - units = DDT - dimensions = () - type = ty_optical_props_2str - intent = out -[sw_optical_props_precip] - standard_name = shortwave_optical_properties_for_precipitation - long_name = Fortran DDT containing RRTMGP optical properties - units = DDT - dimensions = () - type = ty_optical_props_2str - intent = out -[errmsg] - standard_name = ccpp_error_message - long_name = error message for error handling in CCPP - units = none - dimensions = () - type = character - kind = len=* - intent = out -[errflg] - standard_name = ccpp_error_code - long_name = error code for error handling in CCPP - units = 1 - dimensions = () - type = integer - intent = out diff --git a/physics/rrtmgp_sw_gas_optics.F90 b/physics/rrtmgp_sw_gas_optics.F90 index 4bafa56a4..f62a75e4b 100644 --- a/physics/rrtmgp_sw_gas_optics.F90 +++ b/physics/rrtmgp_sw_gas_optics.F90 @@ -2,11 +2,8 @@ !! !> \defgroup rrtmgp_sw_gas_optics rrtmgp_sw_gas_optics.F90 !! -!! \brief This module contains two routines: One to initialize the k-distribution data -!! and functions needed to compute the shortwave gaseous optical properties in RRTMGP. -!! The second routine is a ccpp scheme within the "radiation loop", where the shortwave -!! optical prperties (optical-depth, single-scattering albedo, asymmetry parameter) are -!! computed for clear-sky conditions (no aerosols) +!! \brief This module contains a routine to initialize the k-distribution data used +!! by the RRTMGP shortwave radiation scheme. !! module rrtmgp_sw_gas_optics use machine, only: kind_phys @@ -14,7 +11,6 @@ module rrtmgp_sw_gas_optics use mo_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp use mo_gas_concentrations, only: ty_gas_concs use radiation_tools, only: check_error_msg - use mo_optical_props, only: ty_optical_props_2str use netcdf #ifdef MPI use mpi @@ -83,7 +79,7 @@ module rrtmgp_sw_gas_optics scale_by_complement_upperSW ! Absorption is scaled by concentration of scaling_gas (F) or its complement (T) contains - + ! ###################################################################################### !>\defgroup rrtmgp_sw_gas_optics_mod GFS RRTMGP-SW Gas Optics Module !> @{ !! \section arg_table_rrtmgp_sw_gas_optics_init @@ -100,19 +96,19 @@ module rrtmgp_sw_gas_optics !! \section rrtmgp_sw_gas_optics_init !> @{ ! ###################################################################################### - subroutine rrtmgp_sw_gas_optics_init(rrtmgp_root_dir, rrtmgp_sw_file_gas, & + subroutine rrtmgp_sw_gas_optics_init(rrtmgp_root_dir, rrtmgp_sw_file_gas, & active_gases_array, mpicomm, mpirank, mpiroot, errmsg, errflg) ! Inputs character(len=128),intent(in) :: & rrtmgp_root_dir, & ! RTE-RRTMGP root directory - rrtmgp_sw_file_gas ! RRTMGP file containing coefficients used to compute gaseous optical properties + rrtmgp_sw_file_gas ! RRTMGP file containing K-distribution data + character(len=*), dimension(:), intent(in) :: & + active_gases_array ! List of active gases from namelist as array integer,intent(in) :: & mpicomm, & ! MPI communicator mpirank, & ! Current MPI rank mpiroot ! Master MPI rank - character(len=*), dimension(:), intent(in) :: & - active_gases_array ! List of active gases from namelist as array ! Outputs character(len=*), intent(out) :: & @@ -121,11 +117,10 @@ subroutine rrtmgp_sw_gas_optics_init(rrtmgp_root_dir, rrtmgp_sw_file_gas, errflg ! CCPP error code ! Local variables - integer :: status, ncid, dimid, varID, iGas, mpierr, iChar + integer :: status, ncid, dimid, varID, mpierr, iChar integer,dimension(:),allocatable :: temp1, temp2, temp3, temp4 character(len=264) :: sw_gas_props_file - type(ty_gas_concs) :: gas_concentrations ! RRTMGP DDT containing active trace gases - + type(ty_gas_concs) :: gas_concs ! RRTMGP DDT containing active trace gases ! Initialize errmsg = '' @@ -488,129 +483,19 @@ subroutine rrtmgp_sw_gas_optics_init(rrtmgp_root_dir, rrtmgp_sw_file_gas, ! Initialize RRTMGP DDT's... ! ! ####################################################################################### - allocate(gas_concentrations%gas_name(1:size(active_gases_array))) - gas_concentrations%gas_name(:) = active_gases_array(:) - call check_error_msg('sw_gas_optics_init',sw_gas_props%load(gas_concentrations, & + call check_error_msg('rrtmgp_sw_gas_optics_init_gas_concs',gas_concs%init(active_gases_array)) + call check_error_msg('rrtmgp_sw_gas_optics_init_load',sw_gas_props%load(gas_concs, & gas_namesSW, key_speciesSW, band2gptSW, band_limsSW, press_refSW, press_ref_tropSW,& temp_refSW, temp_ref_pSW, temp_ref_tSW, vmr_refSW, kmajorSW, kminor_lowerSW, & kminor_upperSW, gas_minorSW, identifier_minorSW, minor_gases_lowerSW, & minor_gases_upperSW, minor_limits_gpt_lowerSW, minor_limits_gpt_upperSW, & minor_scales_with_density_lowerSW, minor_scales_with_density_upperSW, & scaling_gas_lowerSW, scaling_gas_upperSW, scale_by_complement_lowerSW, & - - scale_by_complement_upperSW, kminor_start_lowerSW, kminor_start_upperSW, & solar_quietSW, solar_facularSW, solar_sunspotSW, tsi_defaultSW, mg_defaultSW, & sb_defaultSW, rayl_lowerSW, rayl_upperSW)) end subroutine rrtmgp_sw_gas_optics_init - -!> @} - ! ###################################################################################### -!> \section arg_table_rrtmgp_sw_gas_optics_run -!! \htmlinclude rrtmgp_sw_gas_optics.html -!! -!> \ingroup rrtmgp_sw_gas_optics -!! -!! Compute shortwave optical prperties (optical-depth, single-scattering albedo, -!! asymmetry parameter) for clear-sky conditions. -!! -!! \section rrtmgp_sw_gas_optics_run -!> @{ - ! ###################################################################################### - subroutine rrtmgp_sw_gas_optics_run(doSWrad, nCol, nLev, ngptsGPsw, nday, idxday, p_lay, & - p_lev, toa_src_sw, t_lay, t_lev, active_gases_array, gas_concentrations, solcon, & - sw_optical_props_clrsky, errmsg, errflg) - - ! Inputs - logical, intent(in) :: & - doSWrad ! Flag to calculate SW irradiances - integer,intent(in) :: & - ngptsGPsw, & ! Number of spectral (g) points. - nDay, & ! Number of daylit points. - nCol, & ! Number of horizontal points - nLev ! Number of vertical levels - integer,intent(in),dimension(ncol) :: & - idxday ! Indices for daylit points. - real(kind_phys), dimension(ncol,nLev), intent(in) :: & - p_lay, & ! Pressure @ model layer-centers (Pa) - t_lay ! Temperature (K) - real(kind_phys), dimension(ncol,nLev+1), intent(in) :: & - p_lev, & ! Pressure @ model layer-interfaces (Pa) - t_lev ! Temperature @ model levels - type(ty_gas_concs),intent(inout) :: & - gas_concentrations ! RRTMGP DDT: trace gas concentrations (vmr) - real(kind_phys), intent(in) :: & - solcon ! Solar constant - - ! Output - character(len=*), intent(out) :: & - errmsg ! CCPP error message - integer, intent(out) :: & - errflg ! CCPP error code - type(ty_optical_props_2str),intent(out) :: & - sw_optical_props_clrsky ! RRTMGP DDT: clear-sky shortwave optical properties, spectral (tau,ssa,g) - real(kind_phys), dimension(nCol,ngptsGPsw), intent(out) :: & - toa_src_sw ! TOA incident spectral flux (W/m2) - character(len=*), dimension(:), intent(in) :: & - active_gases_array ! List of active gases from namelist as array - - ! Local variables - integer :: ij,iGas - real(kind_phys), dimension(ncol,nLev) :: vmrTemp - real(kind_phys), dimension(nday,ngptsGPsw) :: toa_src_sw_temp - type(ty_gas_concs) :: gas_concentrations_daylit - - ! Initialize CCPP error handling variables - errmsg = '' - errflg = 0 - - if (.not. doSWrad) return - - gas_concentrations%gas_name(:) = active_gases_array(:) - - toa_src_sw(:,:) = 0._kind_phys - if (nDay .gt. 0) then - ! Allocate space - call check_error_msg('rrtmgp_sw_gas_optics_run_alloc_2str',& - sw_optical_props_clrsky%alloc_2str(nday, nLev, sw_gas_props)) - - gas_concentrations_daylit%ncol = nDay - gas_concentrations_daylit%nlay = nLev - allocate(gas_concentrations_daylit%gas_name(gas_concentrations%get_num_gases())) - allocate(gas_concentrations_daylit%concs(gas_concentrations%get_num_gases())) - do iGas=1,gas_concentrations%get_num_gases() - allocate(gas_concentrations_daylit%concs(iGas)%conc(nDay, nLev)) - enddo - gas_concentrations_daylit%gas_name(:) = active_gases_array(:) - - ! Subset the gas concentrations. - do iGas=1,gas_concentrations%get_num_gases() - call check_error_msg('rrtmgp_sw_gas_optics_run_get_vmr',& - gas_concentrations%get_vmr(trim(gas_concentrations_daylit%gas_name(iGas)),vmrTemp)) - call check_error_msg('rrtmgp_sw_gas_optics_run_set_vmr',& - gas_concentrations_daylit%set_vmr(trim(gas_concentrations_daylit%gas_name(iGas)),vmrTemp(idxday(1:nday),:))) - enddo - - ! Call SW gas-optics - call check_error_msg('rrtmgp_sw_gas_optics_run',sw_gas_props%gas_optics(& - p_lay(idxday(1:nday),:), & ! IN - Pressure @ layer-centers (Pa) - p_lev(idxday(1:nday),:), & ! IN - Pressure @ layer-interfaces (Pa) - t_lay(idxday(1:nday),:), & ! IN - Temperature @ layer-centers (K) - gas_concentrations_daylit, & ! IN - RRTMGP DDT: trace gas volumne mixing-ratios - sw_optical_props_clrsky, & ! OUT - RRTMGP DDT: Shortwave optical properties, by - ! spectral point (tau,ssa,g) - toa_src_sw_temp)) ! OUT - TOA incident shortwave radiation (spectral) - toa_src_sw(idxday(1:nday),:) = toa_src_sw_temp - - ! Scale incident flux - do ij=1,nday - toa_src_sw(idxday(ij),:) = toa_src_sw(idxday(ij),:)*solcon/ & - sum(toa_src_sw(idxday(ij),:)) - enddo - endif - - end subroutine rrtmgp_sw_gas_optics_run !> @} end module rrtmgp_sw_gas_optics diff --git a/physics/rrtmgp_sw_gas_optics.meta b/physics/rrtmgp_sw_gas_optics.meta deleted file mode 100644 index 1fdbc946b..000000000 --- a/physics/rrtmgp_sw_gas_optics.meta +++ /dev/null @@ -1,201 +0,0 @@ -[ccpp-table-properties] - name = rrtmgp_sw_gas_optics - type = scheme - dependencies = machine.F,radiation_tools.F90,GFS_rrtmgp_pre.F90,rte-rrtmgp/rrtmgp/mo_gas_optics_rrtmgp.F90,rte-rrtmgp/rte/mo_rte_kind.F90,rte-rrtmgp/rrtmgp/mo_gas_concentrations.F90,rte-rrtmgp/rte/mo_optical_props.F90 - -######################################################################## -[ccpp-arg-table] - name = rrtmgp_sw_gas_optics_init - type = scheme -[rrtmgp_root_dir] - standard_name = directory_for_rte_rrtmgp_source_code - long_name = directory for rte+rrtmgp source code - units = none - dimensions = () - type = character - intent = in - kind = len=128 -[rrtmgp_sw_file_gas] - standard_name = filename_of_rrtmgp_shortwave_k_distribution - long_name = file containing RRTMGP SW k-distribution - units = none - dimensions = () - type = character - intent = in - kind = len=128 -[active_gases_array] - standard_name = list_of_active_gases_used_by_RRTMGP - long_name = list of active gases used by RRTMGP - units = none - dimensions = (number_of_active_gases_used_by_RRTMGP) - type = character - kind = len=* - intent = in -[mpirank] - standard_name = mpi_rank - long_name = current MPI rank - units = index - dimensions = () - type = integer - intent = in -[mpiroot] - standard_name = mpi_root - long_name = master MPI rank - units = index - dimensions = () - type = integer - intent = in -[mpicomm] - standard_name = mpi_communicator - long_name = MPI communicator - units = index - dimensions = () - type = integer - intent = in -[errmsg] - standard_name = ccpp_error_message - long_name = error message for error handling in CCPP - units = none - dimensions = () - type = character - kind = len=* - intent = out -[errflg] - standard_name = ccpp_error_code - long_name = error code for error handling in CCPP - units = 1 - dimensions = () - type = integer - intent = out - -######################################################################## -[ccpp-arg-table] - name = rrtmgp_sw_gas_optics_run - type = scheme -[doSWrad] - standard_name = flag_for_calling_shortwave_radiation - long_name = flag to calculate SW irradiances - units = flag - dimensions = () - type = logical - intent = in -[ncol] - standard_name = horizontal_loop_extent - long_name = horizontal dimension - units = count - dimensions = () - type = integer - intent = in -[nLev] - standard_name = vertical_layer_dimension - long_name = number of vertical levels - units = count - dimensions = () - type = integer - intent = in -[nday] - standard_name = daytime_points_dimension - long_name = daytime points dimension - units = count - dimensions = () - type = integer - intent = in -[idxday] - standard_name = daytime_points - long_name = daytime points - units = index - dimensions = (horizontal_loop_extent) - type = integer - intent = in -[ngptsGPsw] - standard_name = number_of_shortwave_spectral_points - long_name = number of spectral points in RRTMGP SW calculation - units = count - dimensions = () - type = integer - intent = in -[p_lay] - standard_name = air_pressure_at_layer_for_RRTMGP - long_name = air pressure layer - units = Pa - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = in -[p_lev] - standard_name = air_pressure_at_interface_for_RRTMGP - long_name = air pressure level - units = Pa - dimensions = (horizontal_loop_extent,vertical_interface_dimension) - type = real - kind = kind_phys - intent = in -[t_lay] - standard_name = air_temperature_at_layer_for_RRTMGP - long_name = air temperature layer - units = K - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = in -[t_lev] - standard_name = air_temperature_at_interface_for_RRTMGP - long_name = air temperature level - units = K - dimensions = (horizontal_loop_extent,vertical_interface_dimension) - type = real - kind = kind_phys - intent = in -[toa_src_sw] - standard_name = toa_incident_sw_flux_by_spectral_point - long_name = TOA shortwave incident flux at each spectral points - units = W m-2 - dimensions = (horizontal_loop_extent,number_of_shortwave_spectral_points) - type = real - kind = kind_phys - intent = out -[active_gases_array] - standard_name = list_of_active_gases_used_by_RRTMGP - long_name = list of active gases used by RRTMGP - units = none - dimensions = (number_of_active_gases_used_by_RRTMGP) - type = character - kind = len=* - intent = in -[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 = inout -[solcon] - standard_name = solar_constant - long_name = solar constant - units = W m-2 - dimensions = () - type = real - kind = kind_phys - intent = in -[errmsg] - standard_name = ccpp_error_message - long_name = error message for error handling in CCPP - units = none - dimensions = () - type = character - kind = len=* - intent = out -[errflg] - standard_name = ccpp_error_code - long_name = error code for error handling in CCPP - units = 1 - dimensions = () - type = integer - intent = out -[sw_optical_props_clrsky] - standard_name = shortwave_optical_properties_for_clear_sky - long_name = Fortran DDT containing RRTMGP optical properties - units = DDT - dimensions = () - type = ty_optical_props_2str - intent = out diff --git a/physics/rrtmgp_sw_main.F90 b/physics/rrtmgp_sw_main.F90 new file mode 100644 index 000000000..b25e093e7 --- /dev/null +++ b/physics/rrtmgp_sw_main.F90 @@ -0,0 +1,683 @@ +! ########################################################################################### +! ########################################################################################### +module rrtmgp_sw_main + use machine, only: kind_phys, kind_dbl_prec + use mo_optical_props, only: ty_optical_props_2str + use mo_cloud_optics, only: ty_cloud_optics + use module_radsw_parameters, only: cmpfsw_type + use mo_rte_sw, only: rte_sw + use mo_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp + use mo_gas_concentrations, only: ty_gas_concs + use mo_fluxes_byband, only: ty_fluxes_byband + use radiation_tools, only: check_error_msg + use rrtmgp_sw_gas_optics, only: sw_gas_props,rrtmgp_sw_gas_optics_init + use rrtmgp_sw_cloud_optics, only: sw_cloud_props, rrtmgp_sw_cloud_optics_init, a0r, a0s, & + a1s, b0r, b0s, b1s, c0r, c0s + use GFS_rrtmgp_pre, only: iStr_h2o, iStr_co2, iStr_o3, iStr_n2o, iStr_ch4, & + iStr_o2, iStr_ccl4, iStr_cfc11, iStr_cfc12, iStr_cfc22, & + eps, oneminus, ftiny + use mersenne_twister, only: random_setseed, random_number, random_stat + use rrtmgp_sampling, only: sampled_mask, draw_samples + implicit none + + type(ty_gas_concs) :: gas_concs + type(ty_optical_props_2str) :: sw_optical_props_accum, sw_optical_props_aerosol_local, & + sw_optical_props_cloudsByBand, sw_optical_props_cnvcloudsByBand, & + sw_optical_props_pblcloudsByBand, sw_optical_props_precipByBand, & + sw_optical_props_clouds + + public rrtmgp_sw_main_init, rrtmgp_sw_main_run + +contains + + ! ######################################################################################### + ! SUBROUTINE rrtmgp_sw_main_init + ! ######################################################################################### +!! \section arg_table_rrtmgp_sw_main_init +!! \htmlinclude rrtmgp_sw_main_init.html +!! + subroutine rrtmgp_sw_main_init(rrtmgp_root_dir, rrtmgp_sw_file_gas, rrtmgp_sw_file_clouds,& + active_gases_array, doGP_cldoptics_PADE, doGP_cldoptics_LUT, doGP_sgs_pbl, & + doGP_sgs_cnv, nrghice, mpicomm, mpirank, mpiroot, nLay, rrtmgp_phys_blksz, & + errmsg, errflg) + + ! Inputs + character(len=128),intent(in) :: & + rrtmgp_root_dir, & ! RTE-RRTMGP root directory + rrtmgp_sw_file_clouds, & ! RRTMGP file containing K-distribution data + rrtmgp_sw_file_gas ! RRTMGP file containing cloud-optics data + character(len=*), dimension(:), intent(in) :: & + active_gases_array ! List of active gases from namelist as array) + logical, intent(in) :: & + doGP_cldoptics_PADE, & ! Use RRTMGP cloud-optics: PADE approximation? + doGP_cldoptics_LUT, & ! Use RRTMGP cloud-optics: LUTs? + doGP_sgs_pbl, & ! Flag to include sgs PBL clouds + doGP_sgs_cnv ! Flag to include sgs convective clouds + integer, intent(inout) :: & + nrghice ! Number of ice-roughness categories + integer,intent(in) :: & + mpicomm, & ! MPI communicator + mpirank, & ! Current MPI rank + mpiroot, & ! Master MPI rank + rrtmgp_phys_blksz, & ! Number of horizontal points to process at once. + nLay + ! Outputs + character(len=*), intent(out) :: & + errmsg ! CCPP error message + integer, intent(out) :: & + errflg ! CCPP error code + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + ! RRTMGP shortwave gas-optics (k-distribution) initialization + call rrtmgp_sw_gas_optics_init(rrtmgp_root_dir, rrtmgp_sw_file_gas, active_gases_array,& + mpicomm, mpirank, mpiroot, errmsg, errflg) + + ! RRTMGP shortwave cloud-optics initialization + call rrtmgp_sw_cloud_optics_init(rrtmgp_root_dir, rrtmgp_sw_file_clouds, & + doGP_cldoptics_PADE, doGP_cldoptics_LUT, nrghice, mpicomm, mpirank, mpiroot, & + errmsg, errflg) + + ! DDTs + + ! ty_gas_concs + call check_error_msg('rrtmgp_sw_main_gas_concs_init',gas_concs%init(active_gases_array)) + + ! ty_optical_props + call check_error_msg('rrtmgp_sw_main_accumulated_optics_init',& + sw_optical_props_accum%alloc_2str(rrtmgp_phys_blksz, nLay, sw_gas_props)) + call check_error_msg('rrtmgp_sw_main_cloud_optics_init',& + sw_optical_props_cloudsByBand%alloc_2str(rrtmgp_phys_blksz, nLay, sw_gas_props%get_band_lims_wavenumber())) + call check_error_msg('rrtmgp_sw_main_precip_optics_init',& + sw_optical_props_precipByBand%alloc_2str(rrtmgp_phys_blksz, nLay, sw_gas_props%get_band_lims_wavenumber())) + call check_error_msg('rrtmgp_sw_mian_cloud_sampling_init', & + sw_optical_props_clouds%alloc_2str(rrtmgp_phys_blksz, nLay, sw_gas_props)) + call check_error_msg('rrtmgp_sw_main_aerosol_optics_init',& + sw_optical_props_aerosol_local%alloc_2str(rrtmgp_phys_blksz, nLay, sw_gas_props%get_band_lims_wavenumber())) + if (doGP_sgs_cnv) then + call check_error_msg('rrtmgp_sw_main_cnv_cloud_optics_init',& + sw_optical_props_cnvcloudsByBand%alloc_2str(rrtmgp_phys_blksz, nLay, sw_gas_props%get_band_lims_wavenumber())) + endif + if (doGP_sgs_pbl) then + call check_error_msg('rrtmgp_sw_main_pbl_cloud_optics_init',& + sw_optical_props_pblcloudsByBand%alloc_2str(rrtmgp_phys_blksz, nLay, sw_gas_props%get_band_lims_wavenumber())) + endif + end subroutine rrtmgp_sw_main_init + + ! ######################################################################################### + ! SUBROUTINE rrtmgp_sw_main_run + ! ######################################################################################### +!! \section arg_table_rrtmgp_sw_main_run +!! \htmlinclude rrtmgp_sw_main_run.html +!! + subroutine rrtmgp_sw_main_run(doSWrad, doSWclrsky, top_at_1, doGP_sgs_cnv, doGP_sgs_pbl, & + nCol, nDay, nLay, nGases, rrtmgp_phys_blksz, idx, icseed_sw, iovr, iovr_convcld, & + iovr_max, iovr_maxrand, iovr_rand, iovr_dcorr, iovr_exp, iovr_exprand, isubc_sw, & + iSFC, sfc_alb_nir_dir, sfc_alb_nir_dif, sfc_alb_uvvis_dir, sfc_alb_uvvis_dif, coszen,& + p_lay, p_lev, t_lay, t_lev, vmr_o2, vmr_h2o, vmr_o3, vmr_ch4, vmr_n2o, vmr_co2, & + cld_frac, cld_lwp, cld_reliq, cld_iwp, cld_reice, cld_swp, cld_resnow, cld_rwp, & + cld_rerain, precip_frac, cld_cnv_lwp, cld_cnv_reliq, cld_cnv_iwp, cld_cnv_reice, & + cld_pbl_lwp, cld_pbl_reliq, cld_pbl_iwp, cld_pbl_reice, cloud_overlap_param, & + active_gases_array, aersw_tau, aersw_ssa, aersw_g, solcon, scmpsw, & + fluxswUP_allsky, fluxswDOWN_allsky, fluxswUP_clrsky, fluxswDOWN_clrsky, cldtausw, & + errmsg, errflg) + + ! Inputs + logical, intent(in) :: & + doSWrad, & ! Flag to perform shortwave calculation + doSWclrsky, & ! Flag to compute clear-sky fluxes + top_at_1, & ! Flag for vertical ordering convention + doGP_sgs_pbl, & ! Flag to include sgs PBL clouds + doGP_sgs_cnv ! Flag to include sgs convective clouds + integer,intent(in) :: & + nCol, & ! Number of horizontal points + nDay, & ! Number of daytime points + nLay, & ! Number of vertical grid points. + nGases, & ! Number of active gases + rrtmgp_phys_blksz, & ! Number of horizontal points to process at once. + iovr, & ! Choice of cloud-overlap method + iovr_convcld, & ! Choice of convective cloud-overlap + iovr_max, & ! Flag for maximum cloud overlap method + iovr_maxrand, & ! Flag for maximum-random cloud overlap method + iovr_rand, & ! Flag for random cloud overlap method + iovr_dcorr, & ! Flag for decorrelation-length cloud overlap method + iovr_exp, & ! Flag for exponential cloud overlap method + iovr_exprand, & ! Flag for exponential-random cloud overlap method + isubc_sw, & ! + iSFC + integer,intent(in),dimension(:) :: & + idx, & ! Index array for daytime points + icseed_sw ! Seed for random number generation for shortwave radiation + real(kind_phys), dimension(:), intent(in) :: & + 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) + coszen ! Cosize of SZA + real(kind_phys), dimension(:,:), intent(in) :: & + p_lay, & ! Pressure @ model layer-centers (Pa) + t_lay, & ! Temperature (K) + p_lev, & ! Pressure @ model layer-interfaces (Pa) + t_lev, & ! Temperature @ model levels (K) + vmr_o2, & ! Molar-mixing ratio oxygen + vmr_h2o, & ! Molar-mixing ratio water vapor + vmr_o3, & ! Molar-mixing ratio ozone + vmr_ch4, & ! Molar-mixing ratio methane + vmr_n2o, & ! Molar-mixing ratio nitrous oxide + vmr_co2, & ! Molar-mixing ratio carbon dioxide + cld_frac, & ! Cloud-fraction for stratiform clouds + cld_lwp, & ! Water path for stratiform liquid cloud-particles + cld_reliq, & ! Effective radius for stratiform liquid cloud-particles + cld_iwp, & ! Water path for stratiform ice cloud-particles + cld_reice, & ! Effective radius for stratiform ice cloud-particles + cld_swp, & ! Water path for snow hydrometeors + cld_resnow, & ! Effective radius for snow hydrometeors + cld_rwp, & ! Water path for rain hydrometeors + cld_rerain, & ! Effective radius for rain hydrometeors + precip_frac, & ! Precipitation fraction + cld_cnv_lwp, & ! Water path for convective liquid cloud-particles + cld_cnv_reliq, & ! Effective radius for convective liquid cloud-particles + cld_cnv_iwp, & ! Water path for convective ice cloud-particles + cld_cnv_reice, & ! Effective radius for convective ice cloud-particles + cld_pbl_lwp, & ! Water path for PBL liquid cloud-particles + cld_pbl_reliq, & ! Effective radius for PBL liquid cloud-particles + cld_pbl_iwp, & ! Water path for PBL ice cloud-particles + cld_pbl_reice, & ! Effective radius for PBL ice cloud-particles + cloud_overlap_param ! + real(kind_phys), dimension(:,:,:), intent(in) :: & + aersw_tau, & ! Aerosol optical depth + aersw_ssa, & ! Aerosol single scattering albedo + aersw_g ! Aerosol asymmetry paramter + character(len=*), dimension(:), intent(in) :: & + active_gases_array ! List of active gases from namelist as array + real(kind_phys), intent(in) :: & + solcon ! Solar constant + + ! Outputs + character(len=*), intent(out) :: & + errmsg ! CCPP error message + integer, intent(out) :: & + errflg ! CCPP error flag + real(kind_phys), dimension(:,:), intent(inout) :: & + cldtausw ! Approx 10.mu band layer cloud optical depth + real(kind_phys), dimension(:,:), intent(inout) :: & + fluxswUP_allsky, & ! RRTMGP upward all-sky flux profiles (W/m2) + fluxswDOWN_allsky, & ! RRTMGP downward all-sky flux profiles (W/m2) + fluxswUP_clrsky, & ! RRTMGP upward clear-sky flux profiles (W/m2) + fluxswDOWN_clrsky ! RRTMGP downward clear-sky flux profiles (W/m2) + type(cmpfsw_type), dimension(:), intent(inout) :: & + scmpsw ! 2D surface fluxes, components: + ! uvbfc - total sky downward uv-b flux (W/m2) + ! uvbf0 - clear sky downward uv-b flux (W/m2) + ! nirbm - downward nir direct beam flux (W/m2) + ! nirdf - downward nir diffused flux (W/m2) + ! visbm - downward uv+vis direct beam flux (W/m2) + ! visdf - downward uv+vis diffused flux (W/m2) + + ! Local variables + type(cmpfsw_type), dimension(rrtmgp_phys_blksz) :: scmpsw_clrsky, scmpsw_allsky + type(ty_fluxes_byband) :: flux_allsky, flux_clrsky + real(kind_phys) :: tau_rain, tau_snow, ssa_rain, ssa_snow, asy_rain, asy_snow, & + tau_prec, asy_prec, ssa_prec, asyw, ssaw, za1, za2, flux_dir, flux_dif + real(kind_phys), dimension(rrtmgp_phys_blksz) :: zcf0, zcf1 + real(kind_dbl_prec), dimension(sw_gas_props%get_ngpt()) :: rng1D + real(kind_dbl_prec), dimension(sw_gas_props%get_ngpt(),nLay,rrtmgp_phys_blksz) :: rng3D,rng3D2 + real(kind_dbl_prec), dimension(sw_gas_props%get_ngpt()*nLay) :: rng2D + logical, dimension(rrtmgp_phys_blksz,nLay,sw_gas_props%get_ngpt()) :: maskMCICA + logical :: cloudy_column, clear_column + real(kind_phys), dimension(sw_gas_props%get_nband(),rrtmgp_phys_blksz) :: & + sfc_alb_dir, sfc_alb_dif + real(kind_phys), dimension(rrtmgp_phys_blksz,nLay+1,sw_gas_props%get_nband()),target :: & + fluxSW_up_allsky, fluxSW_up_clrsky, fluxSW_dn_dir_clrsky, fluxSW_dn_allsky, & + fluxSW_dn_clrsky, fluxSW_dn_dir_allsky + integer :: iBand, ibd, ibd_uv, iCol, iGas, iLay, ix, ix2, iblck + integer, dimension(rrtmgp_phys_blksz) :: ipseed_sw, iCols + type(random_stat) :: rng_stat + real(kind_phys), dimension(2,sw_gas_props%get_nband()) :: bandlimits + real(kind_phys), dimension(2), parameter :: & + nIR_uvvis_bnd = (/12850,16000/), & + uvb_bnd = (/29000,38000/) + real(kind_phys), dimension(rrtmgp_phys_blksz,sw_gas_props%get_ngpt()) :: toa_src_sw + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + if (.not. doSWrad) return + + if (nDay .gt. 0) then + + bandlimits = sw_gas_props%get_band_lims_wavenumber() + ! ###################################################################################### + ! + ! Loop over all (daylit) columns... + ! + ! ###################################################################################### + do iCol=1,nDay,rrtmgp_phys_blksz + !ix = idx(iCol) + !ix2 = idx(iCol + rrtmgp_phys_blksz - 1) + iCols = idx(iCol:iCol + rrtmgp_phys_blksz - 1) + + ! Create clear/cloudy indicator + zcf0(:) = 1._kind_phys + zcf1(:) = 1._kind_phys + do iblck = 1, rrtmgp_phys_blksz + do iLay=1,nLay + zcf0(iblck) = min(zcf0(iblck), 1._kind_phys - cld_frac(iCols(iblck),iLay)) + enddo + if (zcf0(iblck) <= ftiny) zcf0(iblck) = 0._kind_phys + if (zcf0(iblck) > oneminus) zcf0(iblck) = 1._kind_phys + zcf1(iblck) = 1._kind_phys - zcf0(iblck) + enddo + cloudy_column = any(zcf1 .gt. eps) + clear_column = .true. + if (cloudy_column) clear_column = .false. + + ! ################################################################################### + ! + ! Initialize/reset + ! + ! ################################################################################### + sw_optical_props_clouds%tau = 0._kind_phys + sw_optical_props_clouds%ssa = 0._kind_phys + sw_optical_props_clouds%g = 0._kind_phys + sw_optical_props_accum%tau = 0._kind_phys + sw_optical_props_accum%ssa = 0._kind_phys + sw_optical_props_accum%g = 0._kind_phys + sw_optical_props_cloudsByBand%tau = 0._kind_phys + sw_optical_props_cloudsByBand%ssa = 0._kind_phys + sw_optical_props_cloudsByBand%g = 0._kind_phys + sw_optical_props_precipByBand%tau = 0._kind_phys + sw_optical_props_precipByBand%ssa = 0._kind_phys + sw_optical_props_precipByBand%g = 0._kind_phys + if (doGP_sgs_cnv) then + sw_optical_props_cnvcloudsByBand%tau = 0._kind_phys + sw_optical_props_cnvcloudsByBand%ssa = 0._kind_phys + sw_optical_props_cnvcloudsByBand%g = 0._kind_phys + endif + if (doGP_sgs_pbl) then + sw_optical_props_pblcloudsByBand%tau = 0._kind_phys + sw_optical_props_pblcloudsByBand%ssa = 0._kind_phys + sw_optical_props_pblcloudsByBand%g = 0._kind_phys + endif + scmpsw_clrsky= cmpfsw_type( 0.0, 0.0, 0.0, 0.0, 0.0, 0.0 ) + scmpsw_allsky= cmpfsw_type( 0.0, 0.0, 0.0, 0.0, 0.0, 0.0 ) + cldtausw = 0._kind_phys + + ! ty_fluxes_byband + fluxSW_up_allsky = 0._kind_phys + fluxSW_dn_allsky = 0._kind_phys + fluxSW_dn_dir_allsky = 0._kind_phys + fluxSW_up_clrsky = 0._kind_phys + fluxSW_dn_clrsky = 0._kind_phys + flux_allsky%bnd_flux_up => fluxSW_up_allsky + flux_allsky%bnd_flux_dn => fluxSW_dn_allsky + flux_allsky%bnd_flux_dn_dir => fluxSW_dn_dir_allsky + flux_clrsky%bnd_flux_up => fluxSW_up_clrsky + flux_clrsky%bnd_flux_dn => fluxSW_dn_clrsky + + ! ################################################################################### + ! + ! Set gas-concentrations + ! + ! ################################################################################### + call check_error_msg('rrtmgp_sw_main_set_vmr_o2', & + gas_concs%set_vmr(trim(active_gases_array(istr_o2)), vmr_o2(iCols,:))) + call check_error_msg('rrtmgp_sw_main_set_vmr_co2', & + gas_concs%set_vmr(trim(active_gases_array(istr_co2)),vmr_co2(iCols,:))) + call check_error_msg('rrtmgp_sw_main_set_vmr_ch4', & + gas_concs%set_vmr(trim(active_gases_array(istr_ch4)),vmr_ch4(iCols,:))) + call check_error_msg('rrtmgp_sw_main_set_vmr_n2o', & + gas_concs%set_vmr(trim(active_gases_array(istr_n2o)),vmr_n2o(iCols,:))) + call check_error_msg('rrtmgp_sw_main_set_vmr_h2o', & + gas_concs%set_vmr(trim(active_gases_array(istr_h2o)),vmr_h2o(iCols,:))) + call check_error_msg('rrtmgp_sw_main_set_vmr_o3', & + gas_concs%set_vmr(trim(active_gases_array(istr_o3)), vmr_o3(iCols,:))) + + ! ################################################################################### + ! + ! Compute gas-optics + ! + ! ################################################################################### + + call check_error_msg('rrtmgp_sw_main_gas_optics',sw_gas_props%gas_optics(& + p_lay(iCols,:), & ! IN - Pressure @ layer-centers (Pa) + p_lev(iCols,:), & ! IN - Pressure @ layer-interfaces (Pa) + t_lay(iCols,:), & ! IN - Temperature @ layer-centers (K) + gas_concs, & ! IN - RRTMGP DDT: trace gas volumne mixing-ratios + sw_optical_props_accum, & ! OUT - RRTMGP DDT: Shortwave optical properties, by + ! spectral point (tau,ssa,g) + toa_src_sw)) ! OUT - TOA incident shortwave radiation (spectral) + ! Scale incident flux + do iblck = 1, rrtmgp_phys_blksz + toa_src_sw(iblck,:) = toa_src_sw(iblck,:)*solcon / sum(toa_src_sw(iblck,:)) + enddo + + ! ################################################################################### + ! + ! Set surface albedo + ! + ! Use near-IR albedo for bands with wavenumbers extending to 12850cm-1 + ! Use uv-vis albedo for bands with wavenumbers greater than 16000cm-1 + ! For overlapping band, average near-IR and us-vis albedos. + ! + ! ################################################################################### + do iblck = 1, rrtmgp_phys_blksz + do iBand=1,sw_gas_props%get_nband() + if (bandlimits(1,iBand) .lt. nIR_uvvis_bnd(1)) then + sfc_alb_dir(iBand,iblck) = sfc_alb_nir_dir(iCols(iblck)) + sfc_alb_dif(iBand,iblck) = sfc_alb_nir_dif(iCols(iblck)) + endif + if (bandlimits(1,iBand) .eq. nIR_uvvis_bnd(1)) then + sfc_alb_dir(iBand,iblck) = 0.5_kind_phys*(sfc_alb_nir_dir(iCols(iblck)) + & + sfc_alb_uvvis_dir(iCols(iblck))) + sfc_alb_dif(iBand,iblck) = 0.5_kind_phys*(sfc_alb_nir_dif(iCols(iblck)) + & + sfc_alb_uvvis_dif(iCols(iblck))) + ibd = iBand + endif + if (bandlimits(1,iBand) .ge. nIR_uvvis_bnd(2)) then + sfc_alb_dir(iBand,iblck) = sfc_alb_uvvis_dir(iCols(iblck)) + sfc_alb_dif(iBand,iblck) = sfc_alb_uvvis_dif(iCols(iblck)) + endif + if (bandlimits(1,iBand) .eq. uvb_bnd(1)) ibd_uv = iBand + enddo + enddo + + ! ################################################################################### + ! + ! Compute optics for cloud(s) and precipitation, sample clouds... + ! + ! ################################################################################### + if (cloudy_column) then + ! Gridmean/mp-clouds + call check_error_msg('rrtmgp_sw_main_cloud_optics',sw_cloud_props%cloud_optics(& + cld_lwp(iCols,:), & ! IN - Cloud liquid water path + cld_iwp(iCols,:), & ! IN - Cloud ice water path + cld_reliq(iCols,:), & ! IN - Cloud liquid effective radius + cld_reice(iCols,:), & ! IN - Cloud ice effective radius + sw_optical_props_cloudsByBand)) ! OUT - RRTMGP DDT: Shortwave optical properties, + ! in each band (tau,ssa,g) + cldtausw(iCols,:) = sw_optical_props_cloudsByBand%tau(:,:,11) + + ! Include convective clouds? + if (doGP_sgs_cnv) then + ! Compute + call check_error_msg('rrtmgp_sw_main_cnv_cloud_optics',sw_cloud_props%cloud_optics(& + cld_cnv_lwp(iCols,:), & ! IN - Convective cloud liquid water path (g/m2) + cld_cnv_iwp(iCols,:), & ! IN - Convective cloud ice water path (g/m2) + cld_cnv_reliq(iCols,:), & ! IN - Convective cloud liquid effective radius (microns) + cld_cnv_reice(iCols,:), & ! IN - Convective cloud ice effective radius (microns) + sw_optical_props_cnvcloudsByBand)) ! OUT - RRTMGP DDT containing convective cloud radiative properties + ! in each band + ! Increment + call check_error_msg('rrtmgp_sw_main_increment_cnvclouds_to_clouds',& + sw_optical_props_cnvcloudsByBand%increment(sw_optical_props_cloudsByBand)) + endif + + ! Include PBL clouds? + if (doGP_sgs_pbl) then + ! Compute + call check_error_msg('rrtmgp_sw_main_pbl_cloud_optics',sw_cloud_props%cloud_optics(& + cld_pbl_lwp(iCols,:), & ! IN - PBL cloud liquid water path (g/m2) + cld_pbl_iwp(iCols,:), & ! IN - PBL cloud ice water path (g/m2) + cld_pbl_reliq(iCols,:), & ! IN - PBL cloud liquid effective radius (microns) + cld_pbl_reice(iCols,:), & ! IN - PBL cloud ice effective radius (microns) + sw_optical_props_pblcloudsByBand)) ! OUT - RRTMGP DDT containing PBL cloud radiative properties + ! in each band + ! Increment + call check_error_msg('rrtmgp_sw_main_increment_pblclouds_to_clouds',& + sw_optical_props_pblcloudsByBand%increment(sw_optical_props_cloudsByBand)) + endif + + ! Cloud precipitation optics: rain and snow(+groupel) + do iblck = 1, rrtmgp_phys_blksz + do iLay=1,nLay + if (cld_frac(iCols(iblck),iLay) .gt. ftiny) then + ! Rain/Snow optical depth (No band dependence) + tau_rain = cld_rwp(iCols(iblck),iLay)*a0r + if (cld_swp(iCols(iblck),iLay) .gt. 0. .and. cld_resnow(iCols(iblck),iLay) .gt. 10._kind_phys) then + tau_snow = cld_swp(iCols(iblck),iLay)*1.09087*(a0s + a1s/(1.0315*cld_resnow(iCols(iblck),iLay))) ! fu's formula + else + tau_snow = 0._kind_phys + endif + + ! Rain/Snow single-scattering albedo and asymmetry (Band dependent) + do iBand=1,sw_gas_props%get_nband() + ! By species + ssa_rain = tau_rain*(1.-b0r(iBand)) + asy_rain = ssa_rain*c0r(iBand) + ssa_snow = tau_snow*(1.-(b0s(iBand)+b1s(iBand)*1.0315*cld_resnow(iCols(iblck),iLay))) + asy_snow = ssa_snow*c0s(iBand) + ! Combine + tau_prec = max(1.e-12_kind_phys, tau_rain + tau_snow) + ssa_prec = max(1.e-12_kind_phys, ssa_rain + ssa_snow) + asy_prec = max(1.e-12_kind_phys, asy_rain + asy_snow) + asyw = asy_prec/max(1.e-12_kind_phys, ssa_prec) + ssaw = min(1._kind_phys-0.000001, ssa_prec/tau_prec) + za1 = asyw * asyw + za2 = ssaw * za1 + sw_optical_props_precipByBand%tau(iblck,iLay,iBand) = (1._kind_phys - za2) * tau_prec + sw_optical_props_precipByBand%ssa(iblck,iLay,iBand) = (ssaw - za2) / (1._kind_phys - za2) + sw_optical_props_precipByBand%g(iblck,iLay,iBand) = asyw/(1+asyw) + enddo + endif + enddo + enddo + ! Increment + call check_error_msg('rrtmgp_sw_main_increment_precip_to_clouds',& + sw_optical_props_precipByBand%increment(sw_optical_props_cloudsByBand)) + + ! ################################################################################### + ! + ! Cloud-sampling + ! + ! ################################################################################### + ! Change random number seed value for each radiation invocation (isubc_sw =1 or 2). + if(isubc_sw == 1) then ! advance prescribed permutation seed + do iblck = 1, rrtmgp_phys_blksz + ipseed_sw(iblck) = sw_gas_props%get_ngpt() + iCols(iblck) + enddo + elseif (isubc_sw == 2) then ! use input array of permutaion seeds + do iblck = 1, rrtmgp_phys_blksz + ipseed_sw(iblck) = icseed_sw(iCols(iblck)) + enddo + endif + + ! Call RNG + do iblck = 1, rrtmgp_phys_blksz + call random_setseed(ipseed_sw(iblck),rng_stat) + ! Use same rng for each layer + if (iovr == iovr_max) then + call random_number(rng1D,rng_stat) + do iLay=1,nLay + rng3D(:,iLay,iblck) = rng1D + enddo + else + do iLay=1,nLay + call random_number(rng1D,rng_stat) + rng3D(:,iLay,iblck) = rng1D + enddo + endif + enddo + + ! Cloud-overlap. + ! Maximum-random, random or maximum. + if (iovr == iovr_maxrand .or. iovr == iovr_rand .or. iovr == iovr_max) then + call sampled_mask(real(rng3D, kind=kind_phys), cld_frac(iCols,:), maskMCICA) + endif + ! Exponential decorrelation length overlap + if (iovr == iovr_dcorr) then + do iblck = 1, rrtmgp_phys_blksz + ! Generate second RNG + call random_setseed(ipseed_sw(iblck),rng_stat) + call random_number(rng2D,rng_stat) + rng3D2(:,:,iblck) = reshape(source = rng2D,shape=[sw_gas_props%get_ngpt(),nLay]) + enddo + ! + call sampled_mask(real(rng3D, kind=kind_phys), cld_frac(iCols,:), maskMCICA, & + overlap_param = cloud_overlap_param(iCols,1:nLay-1), randoms2 = real(rng3D2, kind=kind_phys)) + endif + ! Exponential or Exponential-random + if (iovr == iovr_exp .or. iovr == iovr_exprand) then + call sampled_mask(real(rng3D, kind=kind_phys), cld_frac(iCols,:), maskMCICA, & + overlap_param = cloud_overlap_param(iCols,1:nLay-1)) + endif + ! Sampling. Map band optical depth to each g-point using McICA + call check_error_msg('rrtmgp_sw_main_cloud_sampling',& + draw_samples(maskMCICA, .true., & + sw_optical_props_cloudsByBand, sw_optical_props_clouds)) + endif ! cloudy_column + + ! ################################################################################### + ! + ! Compute clear-sky fluxes (gaseous+aerosol) + ! + ! ################################################################################### + ! Increment optics (always) + sw_optical_props_aerosol_local%tau = aersw_tau(iCols,:,:) + sw_optical_props_aerosol_local%ssa = aersw_ssa(iCols,:,:) + sw_optical_props_aerosol_local%g = aersw_g(iCols,:,:) + call check_error_msg('rrtmgp_sw_main_increment_aerosol_to_clrsky', & + sw_optical_props_aerosol_local%increment(sw_optical_props_accum)) + + ! Compute clear-sky fluxes (Yes for no-clouds. Optional for cloudy scenes) + if (clear_column .or. doSWclrsky) then + call check_error_msg('rrtmgp_sw_main_rte_sw_clrsky',rte_sw( & + sw_optical_props_accum, & ! IN - optical-properties + top_at_1, & ! IN - veritcal ordering flag + coszen(iCols), & ! IN - Cosine of solar zenith angle + toa_src_sw, & ! IN - incident solar flux at TOA + sfc_alb_dir, & ! IN - Shortwave surface albedo (direct) + sfc_alb_dif, & ! IN - Shortwave surface albedo (diffuse) + flux_clrsky)) ! OUT - Fluxes, clear-sky, 3D (1,nLay,nBand) + + ! Store fluxes + fluxswUP_clrsky(iCols,:) = sum(flux_clrsky%bnd_flux_up, dim=3) + fluxswDOWN_clrsky(iCols,:) = sum(flux_clrsky%bnd_flux_dn, dim=3) + + ! Compute surface downward beam/diffused flux components + do iblck = 1, rrtmgp_phys_blksz + do iBand=1,sw_gas_props%get_nband() + flux_dir = flux_clrsky%bnd_flux_dn(iblck,iSFC,iBand) + flux_dif = 0._kind_phys + ! Near-IR bands + if (iBand < ibd) then + scmpsw_clrsky(iblck)%nirbm = scmpsw_clrsky(iblck)%nirbm + flux_dir + scmpsw_clrsky(iblck)%nirdf = scmpsw_clrsky(iblck)%nirdf + flux_dif + endif + ! Transition band + if (iBand == ibd) then + scmpsw_clrsky(iblck)%nirbm = scmpsw_clrsky(iblck)%nirbm + flux_dir*0.5_kind_phys + scmpsw_clrsky(iblck)%nirdf = scmpsw_clrsky(iblck)%nirdf + flux_dif*0.5_kind_phys + scmpsw_clrsky(iblck)%visbm = scmpsw_clrsky(iblck)%visbm + flux_dir*0.5_kind_phys + scmpsw_clrsky(iblck)%visdf = scmpsw_clrsky(iblck)%visdf + flux_dif*0.5_kind_phys + endif + ! UV-VIS bands + if (iBand > ibd) then + scmpsw_clrsky(iblck)%visbm = scmpsw_clrsky(iblck)%visbm + flux_dir + scmpsw_clrsky(iblck)%visdf = scmpsw_clrsky(iblck)%visdf + flux_dif + endif + ! uv-b surface downward flux + scmpsw_clrsky(iblck)%uvbfc = flux_clrsky%bnd_flux_dn(iblck,iSFC,ibd_uv) + enddo + enddo + else + fluxswUP_clrsky(iCols,:) = 0._kind_phys + fluxswDOWN_clrsky(iCols,:) = 0._kind_phys + scmpsw = cmpfsw_type( 0.0, 0.0, 0.0, 0.0, 0.0, 0.0 ) + endif + + ! ################################################################################### + ! + ! All-sky fluxes (clear-sky + clouds + precipitation) + ! + ! ################################################################################### + if (cloudy_column) then + ! Delta scale + !call check_error_msg('rrtmgp_sw_main_delta_scale',sw_optical_props_clouds%delta_scale()) + + ! Increment + call check_error_msg('rrtmgp_sw_main_increment_clouds_to_clrsky', & + sw_optical_props_clouds%increment(sw_optical_props_accum)) + + ! Compute fluxes + call check_error_msg('rrtmgp_sw_main_rte_sw_allsky',rte_sw( & + sw_optical_props_accum, & ! IN - optical-properties + top_at_1, & ! IN - veritcal ordering flag + coszen(iCols), & ! IN - Cosine of solar zenith angle + toa_src_sw, & ! IN - incident solar flux at TOA + sfc_alb_dir, & ! IN - Shortwave surface albedo (direct) + sfc_alb_dif, & ! IN - Shortwave surface albedo (diffuse) + flux_allsky)) ! OUT - Fluxes, clear-sky, 3D (1,nLay,nBand) + + ! Store fluxes + fluxswUP_allsky(iCols,:) = sum(flux_allsky%bnd_flux_up, dim=3) + fluxswDOWN_allsky(iCols,:) = sum(flux_allsky%bnd_flux_dn, dim=3) + + ! Compute and store downward beam/diffused flux components + do iblck = 1, rrtmgp_phys_blksz + ! Loop over bands, sum fluxes... + do iBand=1,sw_gas_props%get_nband() + flux_dir = flux_allsky%bnd_flux_dn_dir(iblck,iSFC,iBand) + flux_dif = flux_allsky%bnd_flux_dn(iblck,iSFC,iBand) - flux_allsky%bnd_flux_dn_dir(iblck,iSFC,iBand) + ! Near-IR bands + if (iBand < ibd) then + scmpsw_allsky(iblck)%nirbm = scmpsw_allsky(iblck)%nirbm + flux_dir + scmpsw_allsky(iblck)%nirdf = scmpsw_allsky(iblck)%nirdf + flux_dif + endif + ! Transition band + if (iBand == ibd) then + scmpsw_allsky(iblck)%nirbm = scmpsw_allsky(iblck)%nirbm + flux_dir*0.5_kind_phys + scmpsw_allsky(iblck)%nirdf = scmpsw_allsky(iblck)%nirdf + flux_dif*0.5_kind_phys + scmpsw_allsky(iblck)%visbm = scmpsw_allsky(iblck)%visbm + flux_dir*0.5_kind_phys + scmpsw_allsky(iblck)%visdf = scmpsw_allsky(iblck)%visdf + flux_dif*0.5_kind_phys + endif + ! UV-VIS bands + if (iBand > ibd) then + scmpsw_allsky(iblck)%visbm = scmpsw_allsky(iblck)%visbm + flux_dir + scmpsw_allsky(iblck)%visdf = scmpsw_allsky(iblck)%visdf + flux_dif + endif + ! uv-b surface downward flux + scmpsw_allsky(iblck)%uvbfc = flux_allsky%bnd_flux_dn(iblck,iSFC,ibd_uv) + enddo + ! Store surface downward beam/diffused flux components + if (zcf1(iblck) .gt. eps) then + scmpsw(iCols(iblck))%nirbm = scmpsw_allsky(iblck)%nirbm + scmpsw(iCols(iblck))%nirdf = scmpsw_allsky(iblck)%nirdf + scmpsw(iCols(iblck))%visbm = scmpsw_allsky(iblck)%visbm + scmpsw(iCols(iblck))%visdf = scmpsw_allsky(iblck)%visdf + scmpsw(iCols(iblck))%uvbfc = flux_allsky%bnd_flux_dn(iblck,iSFC,ibd_uv) + else + scmpsw(iCols(iblck))%nirbm = scmpsw_clrsky(iblck)%nirbm + scmpsw(iCols(iblck))%nirdf = scmpsw_clrsky(iblck)%nirdf + scmpsw(iCols(iblck))%visbm = scmpsw_clrsky(iblck)%visbm + scmpsw(iCols(iblck))%visdf = scmpsw_clrsky(iblck)%visdf + scmpsw(iCols(iblck))%uvbfc = flux_clrsky%bnd_flux_dn(iblck,iSFC,ibd_uv) + endif + scmpsw(iCols(iblck))%uvbf0 = flux_clrsky%bnd_flux_dn(iblck,iSFC,ibd_uv) + enddo + else ! No clouds + fluxswUP_allsky(iCols,:) = sum(flux_clrsky%bnd_flux_up, dim=3) + fluxswDOWN_allsky(iCols,:) = sum(flux_clrsky%bnd_flux_dn, dim=3) + do iblck = 1, rrtmgp_phys_blksz + scmpsw(iCols(iblck))%nirbm = scmpsw_clrsky(iblck)%nirbm + scmpsw(iCols(iblck))%nirdf = scmpsw_clrsky(iblck)%nirdf + scmpsw(iCols(iblck))%visbm = scmpsw_clrsky(iblck)%visbm + scmpsw(iCols(iblck))%visdf = scmpsw_clrsky(iblck)%visdf + scmpsw(iCols(iblck))%uvbfc = flux_clrsky%bnd_flux_dn(iblck,iSFC,ibd_uv) + scmpsw(iCols(iblck))%uvbf0 = flux_clrsky%bnd_flux_dn(iblck,iSFC,ibd_uv) + enddo + endif + ! + enddo ! nday + else + fluxswUP_allsky(:,:) = 0._kind_phys + fluxswDOWN_allsky(:,:) = 0._kind_phys + fluxswUP_clrsky(:,:) = 0._kind_phys + fluxswDOWN_clrsky(:,:) = 0._kind_phys + scmpsw = cmpfsw_type( 0.0, 0.0, 0.0, 0.0, 0.0, 0.0 ) + endif + end subroutine rrtmgp_sw_main_run +end module rrtmgp_sw_main diff --git a/physics/rrtmgp_sw_main.meta b/physics/rrtmgp_sw_main.meta new file mode 100644 index 000000000..4ca6cc716 --- /dev/null +++ b/physics/rrtmgp_sw_main.meta @@ -0,0 +1,664 @@ +[ccpp-table-properties] + name = rrtmgp_sw_main + type = scheme + dependencies = machine.F,radiation_tools.F90,GFS_rrtmgp_pre.F90,rte-rrtmgp/rrtmgp/mo_gas_optics_rrtmgp.F90 + dependencies = rte-rrtmgp/rte/mo_rte_kind.F90,rte-rrtmgp/rrtmgp/mo_gas_concentrations.F90,rte-rrtmgp/rte/mo_optical_props.F90 + dependencies = rte-rrtmgp/rte/mo_rte_sw.F90,rte-rrtmgp/rte/mo_fluxes.F90 + dependencies = rte-rrtmgp/rte/kernels/mo_fluxes_broadband_kernels.F90, rte-rrtmgp/rte/kernels/mo_rte_solver_kernels.F90 + dependencies = mersenne_twister.f,rrtmgp_sampling.F90,rte-rrtmgp/extensions/mo_fluxes_byband.F90 + dependencies = rrtmgp_sw_gas_optics.F90, rrtmgp_sw_cloud_optics.F90 + +######################################################################## +[ccpp-arg-table] + name = rrtmgp_sw_main_init + type = scheme +[rrtmgp_root_dir] + standard_name = directory_for_rte_rrtmgp_source_code + long_name = directory for rte+rrtmgp source code + units = none + dimensions = () + type = character + intent = in + kind = len=128 +[rrtmgp_sw_file_gas] + standard_name = filename_of_rrtmgp_shortwave_k_distribution + long_name = file containing RRTMGP SW k-distribution + units = none + dimensions = () + type = character + intent = in + kind = len=128 +[rrtmgp_sw_file_clouds] + standard_name = filename_of_rrtmgp_shortwave_cloud_optics_coefficients + long_name = file containing coefficients for RRTMGP SW cloud optics + units = none + dimensions = () + type = character + intent = in + kind = len=128 +[doGP_cldoptics_PADE] + standard_name = flag_to_calc_lw_cld_optics_using_RRTMGP_PADE + long_name = logical flag to control cloud optics scheme. + units = flag + dimensions = () + type = logical + intent = in +[doGP_cldoptics_LUT] + standard_name = flag_to_calc_lw_cld_optics_using_RRTMGP_LUT + long_name = logical flag to control cloud optics scheme. + units = flag + dimensions = () + type = logical + intent = in +[nrghice] + standard_name = number_of_ice_roughness_categories + long_name = number of ice-roughness categories in RRTMGP calculation + units = count + dimensions = () + type = integer + intent = inout +[doGP_sgs_cnv] + standard_name = flag_to_include_sgs_convective_cloud_in_RRTMGP + long_name = logical flag to control sgs convective cloud in RRTMGP + units = flag + dimensions = () + type = logical + intent = in +[doGP_sgs_pbl] + standard_name = flag_to_include_sgs_MYNN_EDMF_cloud_in_RRTMGP + long_name = logical flag to control MYNN-EDMF PBL cloud in RRTMGP + units = flag + dimensions = () + type = logical + intent = in +[rrtmgp_phys_blksz] + standard_name = number_of_columns_per_RRTMGP_SW_block + long_name = number of columns to process at a time by RRTMGP SW scheme + units = count + dimensions = () + type = integer + intent = in +[nLay] + standard_name = vertical_layer_dimension + long_name = number of vertical levels + units = count + dimensions = () + type = integer + intent = in +[mpirank] + standard_name = mpi_rank + long_name = current MPI rank + units = index + dimensions = () + type = integer + intent = in +[mpiroot] + standard_name = mpi_root + long_name = master MPI rank + units = index + dimensions = () + type = integer + intent = in +[mpicomm] + standard_name = mpi_communicator + long_name = MPI communicator + units = index + dimensions = () + type = integer + intent = in +[active_gases_array] + standard_name = list_of_active_gases_used_by_RRTMGP + long_name = list of active gases used by RRTMGP + units = none + dimensions = (number_of_active_gases_used_by_RRTMGP) + type = character + kind = len=* + intent = in +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out +[errflg] + standard_name = ccpp_error_code + long_name = error code for error handling in CCPP + units = 1 + dimensions = () + type = integer + intent = out + +######################################################################## +[ccpp-arg-table] + name = rrtmgp_sw_main_run + type = scheme +[doSWrad] + standard_name = flag_for_calling_shortwave_radiation + long_name = logical flags for sw radiation calls + units = flag + dimensions = () + type = logical + intent = in +[doSWclrsky] + standard_name = flag_for_output_of_tendency_of_air_temperature_due_to_shortwave_heating_on_radiation_timestep_assuming_clear_sky + long_name = flag to output sw heating rate (Radtend%swhc) + units = flag + dimensions = () + type = logical + intent = in +[top_at_1] + standard_name = flag_for_vertical_ordering_in_RRTMGP + long_name = flag for vertical ordering in RRTMGP + units = flag + dimensions = () + type = logical + intent = in +[iSFC] + standard_name = vertical_index_for_surface_in_RRTMGP + long_name = index for surface layer in RRTMGP + units = flag + dimensions = () + type = integer + intent = in +[doGP_sgs_cnv] + standard_name = flag_to_include_sgs_convective_cloud_in_RRTMGP + long_name = logical flag to control sgs convective cloud in RRTMGP + units = flag + dimensions = () + type = logical + intent = in +[doGP_sgs_pbl] + standard_name = flag_to_include_sgs_MYNN_EDMF_cloud_in_RRTMGP + long_name = logical flag to control MYNN-EDMF PBL cloud in RRTMGP + units = flag + dimensions = () + type = logical + intent = in +[ncol] + standard_name = horizontal_loop_extent + long_name = horizontal dimension + units = count + dimensions = () + type = integer + intent = in +[nLay] + standard_name = vertical_layer_dimension + long_name = number of vertical levels + units = count + dimensions = () + type = integer + intent = in +[rrtmgp_phys_blksz] + standard_name = number_of_columns_per_RRTMGP_SW_block + long_name = number of columns to process at a time by RRTMGP SW scheme + units = count + dimensions = () + type = integer + intent = in +[nGases] + standard_name = number_of_active_gases_used_by_RRTMGP + long_name = number of gases available used by RRTMGP (Model%nGases) + units = count + dimensions = () + type = integer + intent = in +[nday] + standard_name = daytime_points_dimension + long_name = daytime points dimension + units = count + dimensions = () + type = integer + intent = in +[idx] + standard_name = daytime_points + long_name = daytime points + units = index + dimensions = (horizontal_loop_extent) + type = integer + intent = in +[coszen] + standard_name = cosine_of_solar_zenith_angle_for_daytime_points_on_radiation_timestep + long_name = mean cos of zenith angle over rad call period + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in +[isubc_sw] + standard_name = flag_for_sw_clouds_grid_approximation + long_name = flag for sw clouds sub-grid approximation + units = flag + dimensions = () + type = integer + intent = in +[iovr] + standard_name = flag_for_cloud_overlap_method_for_radiation + long_name = max-random overlap clouds + units = flag + dimensions = () + type = integer + intent = in +[iovr_maxrand] + standard_name = flag_for_maximum_random_cloud_overlap_method + long_name = choice of maximum-random cloud overlap method + units = flag + dimensions = () + type = integer + intent = in +[iovr_dcorr] + standard_name = flag_for_decorrelation_length_cloud_overlap_method + long_name = choice of decorrelation-length cloud overlap method + units = flag + dimensions = () + type = integer + intent = in +[iovr_exp] + standard_name = flag_for_exponential_cloud_overlap_method + long_name = choice of exponential cloud overlap method + units = flag + dimensions = () + type = integer + intent = in +[iovr_exprand] + standard_name = flag_for_exponential_random_cloud_overlap_method + long_name = choice of exponential-random cloud overlap method + units = flag + dimensions = () + type = integer + intent = in +[iovr_rand] + standard_name = flag_for_random_cloud_overlap_method + long_name = choice of random cloud overlap method + units = flag + dimensions = () + type = integer + intent = in +[iovr_max] + standard_name = flag_for_maximum_cloud_overlap_method + long_name = choice of maximum cloud overlap method + units = flag + dimensions = () + type = integer + intent = in +[iovr_convcld] + standard_name = flag_for_convective_cloud_overlap_method_for_radiation + long_name = flag for convective cloud overlap method + units = flag + dimensions = () + type = integer + intent = in +[icseed_sw] + standard_name = random_number_seed_for_mcica_shortwave + long_name = seed for random number generation for shortwave radiation + units = none + dimensions = (horizontal_loop_extent) + type = integer + intent = in +[p_lay] + standard_name = air_pressure_at_layer_for_RRTMGP + long_name = air pressure at vertical layer for radiation calculation + units = Pa + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = in +[p_lev] + standard_name = air_pressure_at_interface_for_RRTMGP + long_name = air pressure at vertical interface for radiation calculation + units = Pa + dimensions = (horizontal_loop_extent,vertical_interface_dimension) + type = real + kind = kind_phys + intent = in +[t_lay] + standard_name = air_temperature_at_layer_for_RRTMGP + long_name = air temperature at vertical layer for radiation calculation + units = K + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = in +[t_lev] + standard_name = air_temperature_at_interface_for_RRTMGP + long_name = air temperature at vertical interface for radiation calculation + units = K + dimensions = (horizontal_loop_extent,vertical_interface_dimension) + type = real + kind = kind_phys + intent = in +[vmr_o2] + standard_name = volume_mixing_ratio_for_o2 + long_name = molar mixing ratio of o2 in with respect to dry air + units = 1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = in +[vmr_h2o] + standard_name = volume_mixing_ratio_for_h2o + long_name = molar mixing ratio of h2o in with respect to dry air + units = 1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = in +[vmr_o3] + standard_name = volume_mixing_ratio_for_o3 + long_name = molar mixing ratio of o3 in with respect to dry air + units = 1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = in +[vmr_ch4] + standard_name = volume_mixing_ratio_for_ch4 + long_name = molar mixing ratio of ch4 in with respect to dry air + units = 1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = in +[vmr_n2o] + standard_name = volume_mixing_ratio_for_n2o + long_name = molar mixing ratio of n2o in with respect to dry air + units = 1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = in +[vmr_co2] + standard_name = volume_mixing_ratio_for_co2 + long_name = molar mixing ratio of co2 in with respect to dry air + units = 1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = in +[cld_frac] + standard_name = total_cloud_fraction + long_name = layer total cloud fraction + units = frac + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = in +[cld_lwp] + standard_name = cloud_liquid_water_path + long_name = layer cloud liquid water path + units = g m-2 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = in +[cld_reliq] + standard_name = mean_effective_radius_for_liquid_cloud + long_name = mean effective radius for liquid cloud + units = um + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = in +[cld_iwp] + standard_name = cloud_ice_water_path + long_name = layer cloud ice water path + units = g m-2 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = in +[cld_reice] + standard_name = mean_effective_radius_for_ice_cloud + long_name = mean effective radius for ice cloud + units = um + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = in +[cld_swp] + standard_name = cloud_snow_water_path + long_name = layer cloud snow water path + units = g m-2 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = in +[cld_resnow] + standard_name = mean_effective_radius_for_snow_flake + long_name = mean effective radius for snow cloud + units = um + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = in +[cld_rwp] + standard_name = cloud_rain_water_path + long_name = layer cloud rain water path + units = g m-2 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = in +[cld_rerain] + standard_name = mean_effective_radius_for_rain_drop + long_name = mean effective radius for rain cloud + units = um + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = in +[precip_frac] + standard_name = precipitation_fraction_by_layer + long_name = precipitation fraction in each layer + units = frac + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = in +[cld_cnv_lwp] + standard_name = convective_cloud_liquid_water_path + long_name = layer convective cloud liquid water path + units = g m-2 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = in +[cld_cnv_iwp] + standard_name = convective_cloud_ice_water_path + long_name = layer convective cloud ice water path + units = g m-2 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = in +[cld_cnv_reliq] + standard_name = mean_effective_radius_for_liquid_convective_cloud + long_name = mean effective radius for liquid convective cloud + units = um + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = in +[cld_cnv_reice] + standard_name = mean_effective_radius_for_ice_convective_cloud + long_name = mean effective radius for ice convective cloud + units = um + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = in +[cld_pbl_lwp] + standard_name = MYNN_SGS_cloud_liquid_water_path + long_name = layer convective cloud liquid water path + units = g m-2 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = in +[cld_pbl_iwp] + standard_name = MYNN_SGS_cloud_ice_water_path + long_name = layer convective cloud ice water path + units = g m-2 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = in +[cld_pbl_reliq] + standard_name = mean_effective_radius_for_liquid_MYNN_SGS_cloud + long_name = mean effective radius for liquid MYNN_SGS cloud + units = um + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = in +[cld_pbl_reice] + standard_name = mean_effective_radius_for_ice_MYNN_SGS_cloud + long_name = mean effective radius for ice MYNN_SGS cloud + units = um + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = in +[cloud_overlap_param] + standard_name = cloud_overlap_param + long_name = cloud overlap parameter + units = km + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = in +[sfc_alb_nir_dir] + standard_name = surface_albedo_due_to_near_IR_direct + long_name = surface albedo due to near IR direct beam + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in +[sfc_alb_nir_dif] + standard_name = surface_albedo_due_to_near_IR_diffused + long_name = surface albedo due to near IR diffused beam + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in +[sfc_alb_uvvis_dir] + standard_name = surface_albedo_due_to_UV_and_VIS_direct + long_name = surface albedo due to UV+VIS direct beam + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in +[sfc_alb_uvvis_dif] + standard_name = surface_albedo_due_to_UV_and_VIS_diffused + long_name = surface albedo due to UV+VIS diffused beam + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in +[active_gases_array] + standard_name = list_of_active_gases_used_by_RRTMGP + long_name = list of active gases used by RRTMGP + units = none + dimensions = (number_of_active_gases_used_by_RRTMGP) + type = character + kind = len=* + intent = in +[aersw_tau] + standard_name = aerosol_optical_depth_for_shortwave_bands_01_16 + long_name = aerosol optical depth for shortwave bands 01-16 + units = none + dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_aerosol_bands_for_shortwave_radiation) + type = real + kind = kind_phys + intent = in +[aersw_ssa] + standard_name = aerosol_single_scattering_albedo_for_shortwave_bands_01_16 + long_name = aerosol single scattering albedo for shortwave bands 01-16 + units = frac + dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_aerosol_bands_for_shortwave_radiation) + type = real + kind = kind_phys + intent = in +[aersw_g] + standard_name = aerosol_asymmetry_parameter_for_shortwave_bands_01_16 + long_name = aerosol asymmetry parameter for shortwave bands 01-16 + units = none + dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_aerosol_bands_for_shortwave_radiation) + type = real + kind = kind_phys + intent = in +[solcon] + standard_name = solar_constant + long_name = solar constant + units = W m-2 + dimensions = () + type = real + kind = kind_phys + intent = in +[scmpsw] + standard_name = components_of_surface_downward_shortwave_fluxes + long_name = derived type for special components of surface downward shortwave fluxes + units = W m-2 + dimensions = (horizontal_loop_extent) + type = cmpfsw_type + intent = inout +[fluxswUP_allsky] + standard_name = RRTMGP_sw_flux_profile_upward_allsky + long_name = RRTMGP upward shortwave all-sky flux profile + units = W m-2 + dimensions = (horizontal_loop_extent,vertical_interface_dimension) + type = real + kind = kind_phys + intent = inout +[fluxswDOWN_allsky] + standard_name = RRTMGP_sw_flux_profile_downward_allsky + long_name = RRTMGP downward shortwave all-sky flux profile + units = W m-2 + dimensions = (horizontal_loop_extent,vertical_interface_dimension) + type = real + kind = kind_phys + intent = inout +[fluxswUP_clrsky] + standard_name = RRTMGP_sw_flux_profile_upward_clrsky + long_name = RRTMGP upward shortwave clr-sky flux profile + units = W m-2 + dimensions = (horizontal_loop_extent,vertical_interface_dimension) + type = real + kind = kind_phys + intent = inout +[fluxswDOWN_clrsky] + standard_name = RRTMGP_sw_flux_profile_downward_clrsky + long_name = RRTMGP downward shortwave clr-sky flux profile + units = W m-2 + dimensions = (horizontal_loop_extent,vertical_interface_dimension) + type = real + kind = kind_phys + intent = inout +[cldtausw] + standard_name = cloud_optical_depth_layers_at_0p55mu_band + long_name = approx .55mu band layer cloud optical depth + units = none + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out +[errflg] + standard_name = ccpp_error_code + long_name = error code for error handling in CCPP + units = 1 + dimensions = () + type = integer + intent = out diff --git a/physics/rrtmgp_sw_rte.F90 b/physics/rrtmgp_sw_rte.F90 deleted file mode 100644 index 521aae2c1..000000000 --- a/physics/rrtmgp_sw_rte.F90 +++ /dev/null @@ -1,219 +0,0 @@ -!> \file rrtmgp_sw_rte.F90 -!! -!> \defgroup rrtmgp_sw_rte rrtmgp_sw_rte.F90 -!! -!! \brief This module contains the main rte shortwave driver. -module rrtmgp_sw_rte - use machine, only: kind_phys - use mo_optical_props, only: ty_optical_props_2str - use mo_rte_sw, only: rte_sw - use mo_fluxes_byband, only: ty_fluxes_byband - use module_radsw_parameters, only: cmpfsw_type - use radiation_tools, only: check_error_msg - use rrtmgp_sw_gas_optics, only: sw_gas_props - implicit none - - public rrtmgp_sw_rte_run - -contains -!>\defgroup rrtmgp_sw_rte_mod GFS RRTMGP-SW RTE Module -!> \section arg_table_rrtmgp_sw_rte_run -!! \htmlinclude rrtmgp_sw_rte.html -!! -!> \ingroup rrtmgp_sw_rte -!! -!! \brief This routine takes all of the shortwave optical properties ,ty_optical_props_2str, -!! and computes the shortwave radiative fluxes for cloudy and clear-sky conditions. -!! -!! \section rrtmgp_sw_rte_run Main Driver -!> @{ - ! ###################################################################################### - subroutine rrtmgp_sw_rte_run(doSWrad, doSWclrsky, nCol, nLev, nDay, idxday, coszen, p_lay,& - t_lay, top_at_1, doGP_sgs_cnv, doGP_sgs_mynn, iSFC, sfc_alb_nir_dir, sfc_alb_nir_dif,& - sfc_alb_uvvis_dir, sfc_alb_uvvis_dif, toa_src_sw, sw_optical_props_clrsky, & - sw_optical_props_clouds, sw_optical_props_precipByBand, & - sw_optical_props_cnvcloudsByBand, sw_optical_props_MYNNcloudsByBand, & - sw_optical_props_aerosol, scmpsw, fluxswUP_allsky, fluxswDOWN_allsky, & - fluxswUP_clrsky, fluxswDOWN_clrsky, errmsg, errflg) - - ! Inputs - logical, intent(in) :: & - top_at_1, & ! Vertical ordering flag - doGP_sgs_mynn, & ! Flag for MYNN-EDMF PBL cloud scheme - doGP_sgs_cnv, & ! Flag for sgs convective clouds scheme - doSWrad, & ! Flag to calculate SW irradiances - doSWclrsky ! Compute clear-sky fluxes? - integer, intent(in) :: & - nCol, & ! Number of horizontal gridpoints - nday, & ! Number of daytime points - nLev, & ! Number of vertical levels - iSFC ! Vertical index for surface-level - integer, intent(in), dimension(:) :: & - idxday ! Index array for daytime points - real(kind_phys),intent(in), dimension(:) :: & - 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) - coszen ! Cosize of SZA - real(kind_phys), dimension(:,:), intent(in) :: & - p_lay, & ! Pressure @ model layer-centers (Pa) - t_lay, & ! Temperature (K) - toa_src_sw ! TOA incident spectral flux (W/m2) - type(ty_optical_props_2str),intent(inout) :: & - 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 optical properties - sw_optical_props_cnvcloudsByBand, & ! RRTMGP DDT: shortwave convecive cloud optical properties - sw_optical_props_MYNNcloudsByBand, & ! RRTMGP DDT: shortwave MYNN-EDMF PBL cloud optical properties - sw_optical_props_precipByBand, & ! RRTMGP DDT: shortwave precipitation optical properties - sw_optical_props_aerosol ! RRTMGP DDT: shortwave aerosol optical properties - - ! Outputs - character(len=*), intent(out) :: & - errmsg ! CCPP error message - integer, intent(out) :: & - errflg ! CCPP error flag - real(kind_phys), dimension(:,:), intent(inout) :: & - fluxswUP_allsky, & ! RRTMGP upward all-sky flux profiles (W/m2) - fluxswDOWN_allsky, & ! RRTMGP downward all-sky flux profiles (W/m2) - fluxswUP_clrsky, & ! RRTMGP upward clear-sky flux profiles (W/m2) - fluxswDOWN_clrsky ! RRTMGP downward clear-sky flux profiles (W/m2) - type(cmpfsw_type), dimension(:), intent(inout) :: & - scmpsw ! 2D surface fluxes, components: - ! uvbfc - total sky downward uv-b flux (W/m2) - ! uvbf0 - clear sky downward uv-b flux (W/m2) - ! nirbm - downward nir direct beam flux (W/m2) - ! nirdf - downward nir diffused flux (W/m2) - ! visbm - downward uv+vis direct beam flux (W/m2) - ! visdf - downward uv+vis diffused flux (W/m2) - - ! Local variables - real(kind_phys), dimension(sw_gas_props%get_nband(),nday) :: & - sfc_alb_dir,sfc_alb_dif - type(ty_fluxes_byband) :: & - flux_allsky, & ! All-sky flux (W/m2) - flux_clrsky ! Clear-sky flux (W/m2) - real(kind_phys), dimension(nday,NLev+1,sw_gas_props%get_nband()),target :: & - fluxSW_up_allsky, fluxSW_up_clrsky, fluxSW_dn_allsky, fluxSW_dn_clrsky, fluxSW_dn_dir_allsky - real(kind_phys), dimension(ncol,NLev) :: vmrTemp - integer :: iBand, iDay,ibd - real(kind_phys), dimension(2,sw_gas_props%get_nband()) :: bandlimits - real(kind_phys), dimension(2), parameter :: nIR_uvvis_bnd = (/12850,16000/) - - ! Initialize CCPP error handling variables - errmsg = '' - errflg = 0 - - if (.not. doSWrad) return - - if (nDay .gt. 0) then - - ! Initialize RRTMGP DDT containing 2D(3D) fluxes - flux_allsky%bnd_flux_up => fluxSW_up_allsky - flux_allsky%bnd_flux_dn => fluxSW_dn_allsky - flux_allsky%bnd_flux_dn_dir => fluxSW_dn_dir_allsky - flux_clrsky%bnd_flux_up => fluxSW_up_clrsky - flux_clrsky%bnd_flux_dn => fluxSW_dn_clrsky - - ! Use near-IR albedo for bands with wavenumbers extending to 12850cm-1 - ! Use uv-vis albedo for bands with wavenumbers greater than 16000cm-1 - ! For overlapping band, average near-IR and us-vis albedos. - bandlimits = sw_gas_props%get_band_lims_wavenumber() - do iBand=1,sw_gas_props%get_nband() - if (bandlimits(1,iBand) .lt. nIR_uvvis_bnd(1)) then - sfc_alb_dir(iBand,:) = sfc_alb_nir_dir(idxday(1:nday)) - sfc_alb_dif(iBand,:) = sfc_alb_nir_dif(idxday(1:nday)) - endif - if (bandlimits(1,iBand) .eq. nIR_uvvis_bnd(1)) then - sfc_alb_dir(iBand,:) = 0.5_kind_phys*(sfc_alb_nir_dir(idxday(1:nday)) + sfc_alb_uvvis_dir(idxday(1:nday))) - sfc_alb_dif(iBand,:) = 0.5_kind_phys*(sfc_alb_nir_dif(idxday(1:nday)) + sfc_alb_uvvis_dif(idxday(1:nday))) - ibd = iBand - endif - if (bandlimits(1,iBand) .ge. nIR_uvvis_bnd(2)) then - sfc_alb_dir(iBand,:) = sfc_alb_uvvis_dir(idxday(1:nday)) - sfc_alb_dif(iBand,:) = sfc_alb_uvvis_dif(idxday(1:nday)) - endif - enddo - - ! - ! Compute clear-sky fluxes (if requested) - ! - - ! Clear-sky fluxes (gas+aerosol) - call check_error_msg('rrtmgp_sw_rte_run',sw_optical_props_aerosol%increment(sw_optical_props_clrsky)) - ! Delta-scale optical properties - call check_error_msg('rrtmgp_sw_rte_run',sw_optical_props_clrsky%delta_scale()) - if (doSWclrsky) then - call check_error_msg('rrtmgp_sw_rte_run',rte_sw( & - sw_optical_props_clrsky, & ! IN - optical-properties - top_at_1, & ! IN - veritcal ordering flag - coszen(idxday(1:nday)), & ! IN - Cosine of solar zenith angle - toa_src_sw(idxday(1:nday),:), & ! IN - incident solar flux at TOA - sfc_alb_dir, & ! IN - Shortwave surface albedo (direct) - sfc_alb_dif, & ! IN - Shortwave surface albedo (diffuse) - flux_clrsky)) ! OUT - Fluxes, clear-sky, 3D (nCol,NLev,nBand) - ! Store fluxes - fluxswUP_clrsky(idxday(1:nday),:) = sum(flux_clrsky%bnd_flux_up,dim=3) - fluxswDOWN_clrsky(idxday(1:nday),:) = sum(flux_clrsky%bnd_flux_dn,dim=3) - endif - - ! - ! Compute all-sky fluxes - ! - - ! Include convective cloud? - if (doGP_sgs_cnv) then - call check_error_msg('rrtmgp_sw_rte_run',sw_optical_props_cnvcloudsByBand%increment(sw_optical_props_clrsky)) - endif - - ! Include MYNN-EDMF PBL cloud? - if (doGP_sgs_mynn) then - call check_error_msg('rrtmgp_sw_rte_run',sw_optical_props_MYNNcloudsByBand%increment(sw_optical_props_clrsky)) - endif - - ! All-sky fluxes (clear-sky + clouds + precipitation) - call check_error_msg('rrtmgp_sw_rte_run',sw_optical_props_precipByBand%increment(sw_optical_props_clrsky)) - 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_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 - coszen(idxday(1:nday)), & ! IN - Cosine of solar zenith angle - toa_src_sw(idxday(1:nday),:), & ! IN - incident solar flux at TOA - sfc_alb_dir, & ! IN - Shortwave surface albedo (direct) - sfc_alb_dif, & ! IN - Shortwave surface albedo (diffuse) - flux_allsky)) ! OUT - Fluxes, clear-sky, 3D (nCol,NLev,nBand) - - ! Store fluxes - fluxswUP_allsky(idxday(1:nday),:) = sum(flux_allsky%bnd_flux_up,dim=3) - fluxswDOWN_allsky(idxday(1:nday),:) = sum(flux_allsky%bnd_flux_dn,dim=3) - do iDay=1,nDay - ! Near IR - scmpsw(idxday(iDay))%nirbm = sum(flux_allsky%bnd_flux_dn_dir(iDay,iSFC,1:ibd-1)) + & - flux_allsky%bnd_flux_dn_dir(iDay,iSFC,ibd)/2. - scmpsw(idxday(iDay))%nirdf = (sum(flux_allsky%bnd_flux_dn(iDay,iSFC,1:ibd-1)) + & - flux_allsky%bnd_flux_dn(iDay,iSFC,ibd)/2.) - & - (sum(flux_allsky%bnd_flux_dn_dir(iDay,iSFC,1:ibd-1)) + & - flux_allsky%bnd_flux_dn_dir(iDay,iSFC,ibd)/2.) - ! UV-VIS - scmpsw(idxday(iDay))%visbm = sum(flux_allsky%bnd_flux_dn_dir(iDay,iSFC,ibd+1:sw_gas_props%get_nband())) + & - flux_allsky%bnd_flux_dn_dir(iDay,iSFC,ibd)/2. - scmpsw(idxday(iDay))%visdf = (sum(flux_allsky%bnd_flux_dn(iDay,iSFC,ibd+1:sw_gas_props%get_nband())) + & - flux_allsky%bnd_flux_dn(iDay,iSFC,ibd)/2. ) - & - (sum(flux_allsky%bnd_flux_dn_dir(iDay,iSFC,ibd+1:sw_gas_props%get_nband())) + & - flux_allsky%bnd_flux_dn_dir(iDay,iSFC,ibd)/2.) - enddo - else - fluxswUP_allsky(:,:) = 0._kind_phys - fluxswDOWN_allsky(:,:) = 0._kind_phys - fluxswUP_clrsky(:,:) = 0._kind_phys - fluxswDOWN_clrsky(:,:) = 0._kind_phys - scmpsw = cmpfsw_type( 0.0, 0.0, 0.0, 0.0, 0.0, 0.0 ) - endif - - end subroutine rrtmgp_sw_rte_run -!> @} -end module rrtmgp_sw_rte diff --git a/physics/rrtmgp_sw_rte.meta b/physics/rrtmgp_sw_rte.meta deleted file mode 100644 index 3f5bf2b3c..000000000 --- a/physics/rrtmgp_sw_rte.meta +++ /dev/null @@ -1,240 +0,0 @@ -[ccpp-table-properties] - name = rrtmgp_sw_rte - type = scheme - dependencies = machine.F,radsw_param.f,rte-rrtmgp/rte/mo_rte_sw.F90,rte-rrtmgp/rte/mo_fluxes.F90,rte-rrtmgp/rte/kernels/mo_fluxes_broadband_kernels.F90,radiation_tools.F90 - dependencies = rte-rrtmgp/rte/kernels/mo_rte_solver_kernels.F90,rte-rrtmgp/extensions/mo_fluxes_byband.F90 - -######################################################################## -[ccpp-arg-table] - name = rrtmgp_sw_rte_run - type = scheme -[doSWrad] - standard_name = flag_for_calling_shortwave_radiation - long_name = flag to calculate SW irradiances - units = flag - dimensions = () - type = logical - intent = in -[doSWclrsky] - standard_name = flag_for_output_of_tendency_of_air_temperature_due_to_shortwave_heating_on_radiation_timestep_assuming_clear_sky - long_name = flag to output sw heating rate (Radtend%swhc) - units = flag - dimensions = () - type = logical - intent = in -[ncol] - standard_name = horizontal_loop_extent - long_name = horizontal dimension - units = count - dimensions = () - type = integer - intent = in -[nLev] - standard_name = vertical_layer_dimension - long_name = number of vertical levels - units = count - dimensions = () - type = integer - intent = in -[nday] - standard_name = daytime_points_dimension - long_name = daytime points dimension - units = count - dimensions = () - type = integer - intent = in -[idxday] - standard_name = daytime_points - long_name = daytime points - units = index - dimensions = (horizontal_loop_extent) - type = integer - intent = in -[coszen] - standard_name = cosine_of_solar_zenith_angle_for_daytime_points_on_radiation_timestep - long_name = mean cos of zenith angle over rad call period - units = none - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in -[p_lay] - standard_name = air_pressure_at_layer_for_RRTMGP - long_name = air pressure layer - units = Pa - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = in -[top_at_1] - standard_name = flag_for_vertical_ordering_in_radiation - long_name = flag for vertical ordering in radiation - units = flag - dimensions = () - type = logical - intent = in -[doGP_sgs_cnv] - standard_name = flag_to_include_sgs_convective_cloud_in_RRTMGP - long_name = logical flag to control sgs convective cloud in RRTMGP - units = flag - dimensions = () - type = logical - intent = in -[doGP_sgs_mynn] - standard_name = flag_to_include_sgs_MYNN_EDMF_cloud_in_RRTMGP - long_name = logical flag to control MYNN-EDMF PBL cloud in RRTMGP - units = flag - dimensions = () - type = logical - intent = in -[iSFC] - standard_name = vertical_index_for_surface_in_RRTMGP - long_name = index for surface layer in RRTMGP - units = flag - dimensions = () - type = integer - intent = in -[t_lay] - standard_name = air_temperature_at_layer_for_RRTMGP - long_name = air temperature layer - units = K - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = in -[sw_optical_props_clrsky] - standard_name = shortwave_optical_properties_for_clear_sky - long_name = Fortran DDT containing RRTMGP optical properties - units = DDT - dimensions = () - type = ty_optical_props_2str - intent = inout -[sw_optical_props_clouds] - standard_name = shortwave_optical_properties_for_cloudy_atmosphere - long_name = Fortran DDT containing RRTMGP optical properties - units = DDT - dimensions = () - type = ty_optical_props_2str - intent = in -[sw_optical_props_precipByBand] - standard_name = shortwave_optical_properties_for_precipitation_by_band - long_name = Fortran DDT containing RRTMGP optical properties - units = DDT - dimensions = () - type = ty_optical_props_2str - intent = in -[sw_optical_props_cnvcloudsByBand] - standard_name = shortwave_optical_properties_for_convective_cloudy_atmosphere_by_band - long_name = Fortran DDT containing RRTMGP optical properties - units = DDT - dimensions = () - type = ty_optical_props_2str - intent = in -[sw_optical_props_MYNNcloudsByBand] - standard_name = shortwave_optical_properties_for_MYNN_EDMF_PBL_cloudy_atmosphere_by_band - long_name = Fortran DDT containing RRTMGP optical properties - units = DDT - dimensions = () - type = ty_optical_props_2str - intent = in -[sw_optical_props_aerosol] - standard_name = shortwave_optical_properties_for_aerosols - long_name = Fortran DDT containing RRTMGP optical properties - units = DDT - dimensions = () - type = ty_optical_props_2str - intent = in -[sfc_alb_nir_dir] - standard_name = surface_albedo_due_to_near_IR_direct - long_name = surface albedo due to near IR direct beam - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in -[sfc_alb_nir_dif] - standard_name = surface_albedo_due_to_near_IR_diffused - long_name = surface albedo due to near IR diffused beam - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in -[sfc_alb_uvvis_dir] - standard_name = surface_albedo_due_to_UV_and_VIS_direct - long_name = surface albedo due to UV+VIS direct beam - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in -[sfc_alb_uvvis_dif] - standard_name = surface_albedo_due_to_UV_and_VIS_diffused - long_name = surface albedo due to UV+VIS diffused beam - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in -[toa_src_sw] - standard_name = toa_incident_sw_flux_by_spectral_point - long_name = TOA shortwave incident flux at each spectral points - units = W m-2 - dimensions = (horizontal_loop_extent,number_of_shortwave_spectral_points) - type = real - kind = kind_phys - intent = in -[scmpsw] - standard_name = components_of_surface_downward_shortwave_fluxes - long_name = derived type for special components of surface downward shortwave fluxes - units = W m-2 - dimensions = (horizontal_loop_extent) - type = cmpfsw_type - intent = inout -[fluxswUP_allsky] - standard_name = RRTMGP_sw_flux_profile_upward_allsky - long_name = RRTMGP upward shortwave all-sky flux profile - units = W m-2 - dimensions = (horizontal_loop_extent,vertical_interface_dimension) - type = real - kind = kind_phys - intent = inout -[fluxswDOWN_allsky] - standard_name = RRTMGP_sw_flux_profile_downward_allsky - long_name = RRTMGP downward shortwave all-sky flux profile - units = W m-2 - dimensions = (horizontal_loop_extent,vertical_interface_dimension) - type = real - kind = kind_phys - intent = inout -[fluxswUP_clrsky] - standard_name = RRTMGP_sw_flux_profile_upward_clrsky - long_name = RRTMGP upward shortwave clr-sky flux profile - units = W m-2 - dimensions = (horizontal_loop_extent,vertical_interface_dimension) - type = real - kind = kind_phys - intent = inout -[fluxswDOWN_clrsky] - standard_name = RRTMGP_sw_flux_profile_downward_clrsky - long_name = RRTMGP downward shortwave clr-sky flux profile - units = W m-2 - dimensions = (horizontal_loop_extent,vertical_interface_dimension) - type = real - kind = kind_phys - intent = inout -[errmsg] - standard_name = ccpp_error_message - long_name = error message for error handling in CCPP - units = none - dimensions = () - type = character - kind = len=* - intent = out -[errflg] - standard_name = ccpp_error_code - long_name = error code for error handling in CCPP - units = 1 - dimensions = () - type = integer - intent = out diff --git a/physics/rte-rrtmgp b/physics/rte-rrtmgp index 7f01618c9..0dc54f5ec 160000 --- a/physics/rte-rrtmgp +++ b/physics/rte-rrtmgp @@ -1 +1 @@ -Subproject commit 7f01618c92409658bddd3afa9acb004c608f6a0d +Subproject commit 0dc54f5ecaeb1e1e342efd1e02d0bcd41737bde2