From 3b66834a900028ac96ecea82c0095353f7c55fc2 Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Mon, 11 Apr 2022 19:41:33 +0000 Subject: [PATCH 01/19] Add loop over columns in RRTMGP longwave scheme. Collapse GP schemes into loop. --- physics/GFS_rrtmgp_pre.F90 | 42 +- physics/GFS_rrtmgp_pre.meta | 64 ++- physics/rrtmgp_lw_cloud_optics.F90 | 173 -------- physics/rrtmgp_lw_cloud_optics.meta | 323 -------------- physics/rrtmgp_lw_gas_optics.F90 | 76 +--- physics/rrtmgp_lw_gas_optics.meta | 102 ----- physics/rrtmgp_lw_main.F90 | 527 +++++++++++++++++++++++ physics/rrtmgp_lw_main.meta | 635 ++++++++++++++++++++++++++++ 8 files changed, 1220 insertions(+), 722 deletions(-) create mode 100644 physics/rrtmgp_lw_main.F90 create mode 100644 physics/rrtmgp_lw_main.meta diff --git a/physics/GFS_rrtmgp_pre.F90 b/physics/GFS_rrtmgp_pre.F90 index faf8d4986..7e22c41c1 100644 --- a/physics/GFS_rrtmgp_pre.F90 +++ b/physics/GFS_rrtmgp_pre.F90 @@ -9,8 +9,6 @@ module GFS_rrtmgp_pre NF_VGAS, & ! Number of active gas species getgases, & ! Routine to setup trace gases getozn ! Routine to setup ozone - ! RRTMGP types - use mo_gas_concentrations, only: ty_gas_concs use radiation_tools, only: check_error_msg,cmp_tlev real(kind_phys), parameter :: & @@ -98,18 +96,17 @@ end subroutine GFS_rrtmgp_pre_init !> \section arg_table_GFS_rrtmgp_pre_run !! \htmlinclude GFS_rrtmgp_pre_run.html !! - 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, lsswr, lslwr, 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, errmsg, errflg) + maxGPtemp, 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, errmsg, errflg) ! Inputs integer, intent(in) :: & 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 logical, intent(in) :: & lsswr, & ! Call SW radiation? @@ -173,15 +170,11 @@ 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 + 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 @@ -323,16 +316,10 @@ 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 @@ -345,21 +332,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, 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) diff --git a/physics/GFS_rrtmgp_pre.meta b/physics/GFS_rrtmgp_pre.meta index 88face855..800bc470d 100644 --- a/physics/GFS_rrtmgp_pre.meta +++ b/physics/GFS_rrtmgp_pre.meta @@ -72,13 +72,6 @@ dimensions = () type = integer intent = in -[nTracers] - standard_name = number_of_tracers - long_name = number of tracers - units = count - dimensions = () - type = integer - intent = in [lsswr] standard_name = flag_for_calling_shortwave_radiation long_name = logical flags for sw radiation calls @@ -425,11 +418,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 @@ -441,13 +474,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 diff --git a/physics/rrtmgp_lw_cloud_optics.F90 b/physics/rrtmgp_lw_cloud_optics.F90 index 835261071..68f5a4472 100644 --- a/physics/rrtmgp_lw_cloud_optics.F90 +++ b/physics/rrtmgp_lw_cloud_optics.F90 @@ -376,177 +376,4 @@ subroutine rrtmgp_lw_cloud_optics_init(nrghice, mpicomm, mpirank, mpiroot, end subroutine rrtmgp_lw_cloud_optics_init - ! ###################################################################################### - ! SUBROUTINE rrtmgp_lw_cloud_optics_run() - ! ###################################################################################### -!! \section arg_table_rrtmgp_lw_cloud_optics_run -!! \htmlinclude rrtmgp_lw_cloud_optics.html -!! - 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 - - ! ######################################################################################### - ! SUBROUTINE rrtmgp_lw_cloud_optics_finalize() - ! ######################################################################################### -!! \section arg_table_rrtmgp_lw_cloud_optics_finalize -!! \htmlinclude rrtmgp_lw_cloud_optics.html -!! - subroutine rrtmgp_lw_cloud_optics_finalize() - end subroutine rrtmgp_lw_cloud_optics_finalize - end module rrtmgp_lw_cloud_optics diff --git a/physics/rrtmgp_lw_cloud_optics.meta b/physics/rrtmgp_lw_cloud_optics.meta index c58496dc5..4b2d9cfc0 100644 --- a/physics/rrtmgp_lw_cloud_optics.meta +++ b/physics/rrtmgp_lw_cloud_optics.meta @@ -87,326 +87,3 @@ 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_gas_optics.F90 b/physics/rrtmgp_lw_gas_optics.F90 index 67a888911..d198a5859 100644 --- a/physics/rrtmgp_lw_gas_optics.F90 +++ b/physics/rrtmgp_lw_gas_optics.F90 @@ -6,6 +6,8 @@ module rrtmgp_lw_gas_optics 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 GFS_rrtmgp_pre, only: iStr_h2o, iStr_co2, iStr_o3, iStr_n2o, iStr_ch4, & + iStr_o2, iStr_ccl4, iStr_cfc11, iStr_cfc12, iStr_cfc22 use netcdf #ifdef MPI use mpi @@ -458,79 +460,5 @@ subroutine rrtmgp_lw_gas_optics_init(rrtmgp_root_dir, rrtmgp_lw_file_gas, mpicom maxGPtemp = lw_gas_props%get_temp_max() end subroutine rrtmgp_lw_gas_optics_init - - ! ######################################################################################### - ! SUBROUTINE rrtmgp_lw_gas_optics_run - ! ######################################################################################### -!! \section arg_table_rrtmgp_lw_gas_optics_run -!! \htmlinclude rrtmgp_lw_gas_optics_run.html -!! - 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 - - ! ######################################################################################### - ! SUBROUTINE rrtmgp_lw_gas_optics_finalize - ! ######################################################################################### - subroutine rrtmgp_lw_gas_optics_finalize() - end subroutine rrtmgp_lw_gas_optics_finalize end module rrtmgp_lw_gas_optics diff --git a/physics/rrtmgp_lw_gas_optics.meta b/physics/rrtmgp_lw_gas_optics.meta index 0b484b6ac..a7ca8aacb 100644 --- a/physics/rrtmgp_lw_gas_optics.meta +++ b/physics/rrtmgp_lw_gas_optics.meta @@ -99,105 +99,3 @@ 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..ce1b767b0 --- /dev/null +++ b/physics/rrtmgp_lw_main.F90 @@ -0,0 +1,527 @@ +! ########################################################################################### +! ########################################################################################### +module rrtmgp_lw_main + use machine, only: kind_phys + 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 + use mersenne_twister, only: random_setseed, random_number, random_stat + use rrtmgp_sampling, only: sampled_mask, draw_samples + implicit none + + public rrtmgp_lw_main_init, rrtmgp_lw_main_run +contains + + ! ######################################################################################### + ! SUBROUTINE rrtmgp_lw_main_init + ! ######################################################################################### +!! \section arg_table_rrtmgp_lw_main_init +!! \htmlinclude rrtmgp_lw_main_int.html +!! + subroutine rrtmgp_lw_main_init(rrtmgp_root_dir, rrtmgp_lw_file_gas, mpicomm, mpirank, & + mpiroot, minGPpres, maxGPpres, minGPtemp, maxGPtemp, active_gases_array, nrghice, & + doG_cldoptics, doGP_cldoptics_PADE, doGP_cldoptics_LUT,rrtmgp_lw_file_clouds, errmsg,& + errflg) + + ! Inputs + 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? + integer, intent(inout) :: & + nrghice ! Number of ice-roughness categories + 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 + 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) :: & + 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. + + ! 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, mpicomm, mpirank, & + mpiroot, minGPpres, maxGPpres, minGPtemp, maxGPtemp, active_gases_array, errmsg, & + errflg) + + ! RRTMGP longwave cloud-optics initialization + call 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) + + end subroutine rrtmgp_lw_main_init + + ! ######################################################################################### + ! SUBROUTINE rrtmgp_lw_main_run + ! ######################################################################################### +!! \section arg_table_rrtmgp_lw_main_run +!! \htmlinclude rrtmgp_lw_main_run.html +!! + subroutine rrtmgp_lw_main_run(doLWrad, doLWclrsky, top_at_1, doGP_lwscat, use_LW_jacobian,& + doGP_sgs_cnv, doGP_sgs_pbl, nCol, nLay, nGases, nGauss_angles, i_o3, icseed_lw, iovr,& + iovr_convcld, iovr_max, iovr_maxrand, iovr_rand, iovr_dcorr, iovr_exp, iovr_exprand, & + isubc_lw, 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, sfc_emiss_byband, active_gases_array, lw_optical_props_aerosol, & + fluxlwUP_allsky, fluxlwDOWN_allsky, fluxlwUP_clrsky, fluxlwDOWN_clrsky, fluxlwUP_jac,& + fluxlwUP_radtime, fluxlwDOWN_radtime, errmsg, errflg) + + ! Inputs + logical, intent(in) :: & + doLWrad, & ! Flag to calculate LW irradiances + doLWclrsky, & ! Flag to compute clear-sky fluxes (diagnostic) + top_at_1, & ! Vertical ordering flag + use_LW_jacobian, & ! Compute Jacobian of LW to update radiative fluxes between radiation calls? + doGP_sgs_pbl, & ! Flag for sgs MYNN-EDMF PBL cloud scheme + doGP_sgs_cnv, & ! Flag for sgs convective cloud scheme + doGP_lwscat ! Include scattering in LW cloud-optics? + integer,intent(in) :: & + nCol, & ! Number of horizontal points + nLay, & ! Number of vertical grid points. + nGases, & ! Number of active gases in RRTMGP + nGauss_angles, & ! + i_o3, & ! + 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 ! Seed for random number generation for longwave radiation + real(kind_phys), dimension(:), intent(in) :: & + tsfg ! + 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 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 + cloud_overlap_param, & ! + sfc_emiss_byband ! Surface emissivity in each band + character(len=*), dimension(:), intent(in) :: & + active_gases_array ! List of active gases from namelist as array + type(ty_optical_props_1scl),intent(inout) :: & + lw_optical_props_aerosol ! RRTMGP DDT: Longwave aerosol optical properties (tau) + + ! 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_gas_concs) :: & + gas_concentrations ! RRTMGP DDT: trace gas concentrations (vmr) + type(ty_optical_props_1scl) :: & + lw_optical_props_clrsky, & ! RRTMGP DDT: longwave clear-sky radiative properties + lw_optical_props_aerosol_local, & ! RRTMGP DDT: longwave aerosol radiative properties + 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_pblcloudsByBand, & ! RRTMGP DDT: Longwave optical properties in each band (PBL cloud) + lw_optical_props_precipByBand ! RRTMGP DDT: Longwave optical properties in each band (precipitation) + type(ty_optical_props_2str) :: & + lw_optical_props_clouds ! RRTMGP DDT: Longwave optical properties in each band (sampled clouds) + type(ty_source_func_lw) :: & + sources ! RRTMGP DDT: longwave source functions + type(ty_fluxes_byband) :: & + flux_allsky, flux_clrsky ! RRTMGP DDT: Longwave flux profiles + integer :: iCol, iLay, iGas, iBand, ipseed_lw + type(random_stat) :: rng_stat + real(kind_phys) :: tau_rain, tau_snow + real(kind_phys), dimension(lw_gas_props%get_ngpt()) :: rng1D + real(kind_phys), dimension(lw_gas_props%get_ngpt(),nLay,1) :: rng3D,rng3D2 + real(kind_phys), dimension(lw_gas_props%get_ngpt()*nLay) :: rng2D + logical, dimension(1,nLay,lw_gas_props%get_ngpt()) :: maskMCICA + real(kind_phys), dimension(1,nLay+1,lw_gas_props%get_nband()),target :: & + fluxLW_up_allsky, fluxLW_up_clrsky, fluxLW_dn_allsky, fluxLW_dn_clrsky + real(kind_phys), dimension(1,lw_gas_props%get_ngpt()) :: lw_Ds + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + if (.not. doLWrad) return + + ! ###################################################################################### + ! + ! Allocate/initialize RRTMGP DDT's + ! + ! ###################################################################################### + ! + ! ty_gas_concs + ! + gas_concentrations%ncol = 1 + gas_concentrations%nlay = nLay + allocate(gas_concentrations%gas_name(nGases)) + allocate(gas_concentrations%concs(nGases)) + do iGas=1,nGases + allocate(gas_concentrations%concs(iGas)%conc(1, nLay)) + enddo + gas_concentrations%gas_name(:) = active_gases_array(:) + ! + ! ty_optical_props + ! + call check_error_msg('rrtmgp_lw_main_gas_optics_init',& + lw_optical_props_clrsky%alloc_1scl(1, nLay, lw_gas_props)) + call check_error_msg('rrtmgp_lw_main_sources_init',& + sources%alloc(1, nLay, lw_gas_props)) + call check_error_msg('rrtmgp_lw_main_cloud_optics_init',& + lw_optical_props_cloudsByBand%alloc_1scl(1, nLay, lw_gas_props%get_band_lims_wavenumber())) + call check_error_msg('rrtmgp_lw_main_precip_optics_init',& + lw_optical_props_precipByBand%alloc_1scl(1, nLay, lw_gas_props%get_band_lims_wavenumber())) + call check_error_msg('rrtmgp_lw_mian_cloud_sampling_init', & + lw_optical_props_clouds%alloc_2str(1, nLay, lw_gas_props)) + call check_error_msg('rrtmgp_lw_main_aerosol_optics_init',& + lw_optical_props_aerosol_local%alloc_1scl(1, 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_1scl(1, 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_1scl(1, nLay, lw_gas_props%get_band_lims_wavenumber())) + endif + ! + ! ty_fluxes_byband + ! + 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 + + ! Loop over all columns... + do iCol=1,nCol + ! Initialize/reset + lw_optical_props_clrsky%tau = 0._kind_phys + lw_optical_props_clouds%tau = 0._kind_phys + lw_optical_props_clouds%ssa = 1._kind_phys + lw_optical_props_clouds%g = 0._kind_phys + lw_optical_props_precipByBand%tau = 0._kind_phys + + ! ################################################################################### + ! + ! Set gas-concentrations + ! + ! ################################################################################### + gas_concentrations%concs(istr_o2)%conc(1,:) = vmr_o2(iCol,:) + gas_concentrations%concs(istr_co2)%conc(1,:) = vmr_co2(iCol,:) + gas_concentrations%concs(istr_ch4)%conc(1,:) = vmr_ch4(iCol,:) + gas_concentrations%concs(istr_n2o)%conc(1,:) = vmr_n2o(iCol,:) + gas_concentrations%concs(istr_h2o)%conc(1,:) = vmr_h2o(iCol,:) + gas_concentrations%concs(istr_o3)%conc(1,:) = vmr_o3(iCol,:) + + ! ################################################################################### + ! + ! Gas-optics + ! + ! ################################################################################### + call check_error_msg('rrtmgp_lw_main_gas_optics',lw_gas_props%gas_optics(& + p_lay(iCol:iCol,:), & ! IN - Pressure @ layer-centers (Pa) + p_lev(iCol:iCol,:), & ! IN - Pressure @ layer-interfaces (Pa) + t_lay(iCol:iCol,:), & ! IN - Temperature @ layer-centers (K) + tsfg(iCol:iCol), & ! 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(iCol:iCol,:))) ! IN - Temperature @ layer-interfaces (K) (optional) + + ! ################################################################################### + ! + ! Cloud-optics + ! + ! ################################################################################### + call check_error_msg('rrtmgp_lw_main_cloud_optics',lw_cloud_props%cloud_optics(& + cld_lwp(iCol:iCol,:), & ! IN - Cloud liquid water path (g/m2) + cld_iwp(iCol:iCol,:), & ! IN - Cloud ice water path (g/m2) + cld_reliq(iCol:iCol,:), & ! IN - Cloud liquid effective radius (microns) + cld_reice(iCol:iCol,:), & ! IN - Cloud ice effective radius (microns) + lw_optical_props_cloudsByBand)) ! OUT - RRTMGP DDT containing cloud radiative properties + ! in each band + + ! Convective cloud-optics? + if (doGP_sgs_cnv) then + call check_error_msg('rrtmgp_lw_main_cnv_cloud_optics',lw_cloud_props%cloud_optics(& + cld_cnv_lwp(iCol:iCol,:), & ! IN - Convective cloud liquid water path (g/m2) + cld_cnv_iwp(iCol:iCol,:), & ! IN - Convective cloud ice water path (g/m2) + cld_cnv_reliq(iCol:iCol,:), & ! IN - Convective cloud liquid effective radius (microns) + cld_cnv_reice(iCol:iCol,:), & ! IN - Convective cloud ice effective radius (microns) + lw_optical_props_cnvcloudsByBand)) ! OUT - RRTMGP DDT containing convective cloud radiative properties + ! in each band + !call check_error_msg('rrtmgp_lw_main_increment_cnvclouds_to_clouds',& + ! lw_optical_props_cnvcloudsByBand%increment(lw_optical_props_cloudsByBand)) + endif + + ! MYNN PBL cloud-optics? + if (doGP_sgs_cnv) then + call check_error_msg('rrtmgp_lw_main_pbl_cloud_optics',lw_cloud_props%cloud_optics(& + cld_pbl_lwp(iCol:iCol,:), & ! IN - MYNN-EDMF PBL cloud liquid water path (g/m2) + cld_pbl_iwp(iCol:iCol,:), & ! IN - MYNN-EDMF PBL cloud ice water path (g/m2) + cld_pbl_reliq(iCol:iCol,:), & ! IN - MYNN-EDMF PBL cloud liquid effective radius (microns) + cld_pbl_reice(iCol:iCol,:), & ! IN - MYNN-EDMF PBL cloud ice effective radius (microns) + lw_optical_props_pblcloudsByBand)) ! OUT - RRTMGP DDT containing MYNN-EDMF PBL cloud radiative properties + ! in each band + !call check_error_msg('rrtmgp_lw_main_increment_pblclouds_to_clouds',& + ! lw_optical_props_pblcloudsByBand%increment(lw_optical_props_cloudsByBand)) + endif + + ! Cloud precipitation optics: rain and snow(+groupel) + do iLay=1,nLay + 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,lw_gas_props%get_nband() + lw_optical_props_precipByBand%tau(1,iLay,iBand) = tau_rain + tau_snow + enddo + endif + enddo + !call check_error_msg('rrtmgp_lw_main_increment_precip_to_clouds',& + ! lw_optical_props_precipByBand%increment(lw_optical_props_cloudsByBand)) + + ! ################################################################################### + ! + ! Cloud-sampling + ! + ! ################################################################################### + ! Change random number seed value for each radiation invocation (isubc_lw =1 or 2). + if(isubc_lw == 1) then ! advance prescribed permutation seed + ipseed_lw = lw_gas_props%get_ngpt() + iCol + elseif (isubc_lw == 2) then ! use input array of permutaion seeds + ipseed_lw = icseed_lw(iCol) + endif + ! Call RNG + call random_setseed(ipseed_lw,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,1) = rng1D + enddo + else + do iLay=1,nLay + call random_number(rng1D,rng_stat) + rng3D(:,iLay,1) = rng1D + enddo + endif + ! Cloud-overlap. + ! Maximum-random, random or maximum. + if (iovr == iovr_maxrand .or. iovr == iovr_rand .or. iovr == iovr_max) then + call sampled_mask(rng3D, cld_frac(iCol:iCol,:), maskMCICA) + endif + ! Exponential decorrelation length overlap + if (iovr == iovr_dcorr) then + ! Generate second RNG + call random_setseed(ipseed_lw,rng_stat) + call random_number(rng2D,rng_stat) + rng3D2(:,:,1) = reshape(source = rng2D,shape=[lw_gas_props%get_ngpt(),nLay]) + ! + call sampled_mask(rng3D, cld_frac(iCol:iCol,:), maskMCICA, & + overlap_param = cloud_overlap_param(iCol:iCol,1:nLay-1), randoms2 = rng3D2) + endif + ! Exponential or Exponential-random + if (iovr == iovr_exp .or. iovr == iovr_exprand) then + call sampled_mask(rng3D, cld_frac(iCol:iCol,:), maskMCICA, & + overlap_param = cloud_overlap_param(iCol:iCol,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)) + + ! ################################################################################### + ! + ! Compute clear-sky fluxes (gaseous+aerosol) (optional) + ! + ! ################################################################################### + ! Add aerosol optics to gas optics + lw_optical_props_aerosol_local%tau = lw_optical_props_aerosol%tau(iCol:iCol,:,:) + 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(:,iCol:iCol), & ! 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(:,iCol:iCol), & ! IN - surface emissivity in each LW band + flux_clrsky, & ! OUT - Fluxes + lw_Ds = lw_Ds)) + endif + + ! Store fluxes + fluxlwUP_clrsky(iCol,:) = sum(flux_clrsky%bnd_flux_up(1,:,:),dim=2) + fluxlwDOWN_clrsky(iCol,:) = sum(flux_clrsky%bnd_flux_dn(1,:,:),dim=2) + else + fluxlwUP_clrsky(iCol,:) = 0.0 + fluxlwDOWN_clrsky(iCol,:) = 0.0 + endif + + ! ################################################################################### + ! + ! All-sky fluxes (clear-sky + clouds + precipitation) + ! + ! ################################################################################### + + ! Include convective cloud? + if (doGP_sgs_cnv) then + call check_error_msg('rrtmgp_lw_main_increment_cnvclouds_to_clrsky',& + lw_optical_props_cnvcloudsByBand%increment(lw_optical_props_clouds)) + endif + + ! Include MYNN-EDMF PBL clouds? + if (doGP_sgs_pbl) then + call check_error_msg('rrtmgp_lw_main_increment_pblclouds_to_clrsky',& + lw_optical_props_pblcloudsByBand%increment(lw_optical_props_clouds)) + endif + + ! Add in precipitation + call check_error_msg('rrtmgp_lw_main_increment_precip_to_clrsky',& + 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_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(:,iCol:iCol), & ! 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(:,iCol:iCol), & ! 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_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(:,iCol:iCol), & ! 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(:,iCol:iCol), & ! 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,:) = sum(flux_allsky%bnd_flux_up(1,:,:),dim=2) + fluxlwDOWN_allsky(iCol,:) = sum(flux_allsky%bnd_flux_dn(1,:,:),dim=2) + + ! Save fluxes for coupling + fluxlwUP_radtime(iCol,:) = fluxlwUP_allsky(iCol,:) + fluxlwDOWN_radtime(iCol,:) = fluxlwDOWN_allsky(iCol,:) + + 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..6f10b8504 --- /dev/null +++ b/physics/rrtmgp_lw_main.meta @@ -0,0 +1,635 @@ +[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 +[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 +[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_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 +[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 +[i_o3] + standard_name = index_of_ozone_mixing_ratio_in_tracer_concentration_array + long_name = tracer index for ozone mixing ratio + units = index + 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 +[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 +[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 +[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 +[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 = 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 From a8d3f24d3c88f6bbd6c2360868178d996a531e60 Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Mon, 11 Apr 2022 23:14:50 +0000 Subject: [PATCH 02/19] Add loop over columns in RRTMGP scheme. Collapse GP schemes into loop. Removed deprecated scheme files. --- physics/GFS_rrtmgp_pre.F90 | 20 +- physics/GFS_rrtmgp_pre.meta | 14 + physics/GFS_rrtmgp_sw_pre.F90 | 98 ---- physics/GFS_rrtmgp_sw_pre.meta | 124 ------ physics/rrtmgp_aerosol_optics.F90 | 8 +- physics/rrtmgp_lw_cloud_optics.F90 | 2 - physics/rrtmgp_lw_cloud_optics.meta | 89 ---- physics/rrtmgp_lw_cloud_sampling.F90 | 166 ------- physics/rrtmgp_lw_cloud_sampling.meta | 226 ---------- physics/rrtmgp_lw_gas_optics.meta | 101 ----- physics/rrtmgp_lw_main.F90 | 44 +- physics/rrtmgp_lw_main.meta | 16 +- physics/rrtmgp_lw_pre.F90 | 64 --- physics/rrtmgp_lw_pre.meta | 47 -- physics/rrtmgp_lw_rte.F90 | 213 --------- physics/rrtmgp_lw_rte.meta | 208 --------- physics/rrtmgp_sw_cloud_optics.F90 | 189 +------- physics/rrtmgp_sw_cloud_optics.meta | 393 ---------------- physics/rrtmgp_sw_cloud_sampling.F90 | 170 ------- physics/rrtmgp_sw_cloud_sampling.meta | 240 ---------- physics/rrtmgp_sw_gas_optics.F90 | 115 +---- physics/rrtmgp_sw_gas_optics.meta | 201 --------- physics/rrtmgp_sw_main.F90 | 555 +++++++++++++++++++++++ physics/rrtmgp_sw_main.meta | 618 ++++++++++++++++++++++++++ physics/rrtmgp_sw_rte.F90 | 221 --------- physics/rrtmgp_sw_rte.meta | 240 ---------- 26 files changed, 1251 insertions(+), 3131 deletions(-) delete mode 100644 physics/GFS_rrtmgp_sw_pre.F90 delete mode 100644 physics/GFS_rrtmgp_sw_pre.meta delete mode 100644 physics/rrtmgp_lw_cloud_optics.meta delete mode 100644 physics/rrtmgp_lw_cloud_sampling.F90 delete mode 100644 physics/rrtmgp_lw_cloud_sampling.meta delete mode 100644 physics/rrtmgp_lw_gas_optics.meta delete mode 100644 physics/rrtmgp_lw_pre.F90 delete mode 100644 physics/rrtmgp_lw_pre.meta delete mode 100644 physics/rrtmgp_lw_rte.F90 delete mode 100644 physics/rrtmgp_lw_rte.meta delete mode 100644 physics/rrtmgp_sw_cloud_optics.meta delete mode 100644 physics/rrtmgp_sw_cloud_sampling.F90 delete mode 100644 physics/rrtmgp_sw_cloud_sampling.meta delete mode 100644 physics/rrtmgp_sw_gas_optics.meta create mode 100644 physics/rrtmgp_sw_main.F90 create mode 100644 physics/rrtmgp_sw_main.meta delete mode 100644 physics/rrtmgp_sw_rte.F90 delete mode 100644 physics/rrtmgp_sw_rte.meta diff --git a/physics/GFS_rrtmgp_pre.F90 b/physics/GFS_rrtmgp_pre.F90 index 7e22c41c1..7804ecef7 100644 --- a/physics/GFS_rrtmgp_pre.F90 +++ b/physics/GFS_rrtmgp_pre.F90 @@ -101,7 +101,8 @@ subroutine GFS_rrtmgp_pre_run(me, nCol, nLev, i_o3, lsswr, lslwr, fhswr, fhlwr, con_eps, con_epsm1, con_fvirt, con_epsqs, solhr, minGPpres, maxGPpres, minGPtemp, & maxGPtemp, 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, errmsg, errflg) + active_gases_array, tsfc_radtime, coszen, coszdg, top_at_1, iSFC, iTOA, nDay, idxday,& + errmsg, errflg) ! Inputs integer, intent(in) :: & @@ -148,7 +149,8 @@ subroutine GFS_rrtmgp_pre_run(me, nCol, nLev, i_o3, lsswr, lslwr, fhswr, fhlwr, integer, intent(out) :: & errflg, & ! Error flag iSFC, & ! Vertical index for surface - iTOA ! Vertical index for TOA + iTOA, & ! Vertical index for TOA + nDay logical, intent(out) :: & top_at_1 ! Vertical ordering flag real(kind_phys), intent(inout) :: & @@ -159,6 +161,8 @@ subroutine GFS_rrtmgp_pre_run(me, nCol, nLev, i_o3, lsswr, lslwr, fhswr, fhlwr, tsfc_radtime, & ! Surface temperature at radiation timestep coszen, & ! Cosine of SZA coszdg ! Cosine of SZA, daytime + integer, dimension(:), intent(out) :: & + idxday ! Indices for daylit points real(kind_phys), dimension(:,:), intent(inout) :: & p_lay, & ! Pressure at model-layer t_lay, & ! Temperature at model layer @@ -357,6 +361,18 @@ subroutine GFS_rrtmgp_pre_run(me, nCol, nLev, i_o3, lsswr, lslwr, fhswr, fhlwr, ! ####################################################################################### if (lsswr) 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) = i + endif + enddo + else + nday = 0 + idxday = 0 endif end subroutine GFS_rrtmgp_pre_run diff --git a/physics/GFS_rrtmgp_pre.meta b/physics/GFS_rrtmgp_pre.meta index 800bc470d..39cf198f6 100644 --- a/physics/GFS_rrtmgp_pre.meta +++ b/physics/GFS_rrtmgp_pre.meta @@ -490,6 +490,20 @@ 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 = out [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/GFS_rrtmgp_sw_pre.F90 b/physics/GFS_rrtmgp_sw_pre.F90 deleted file mode 100644 index 3566575f4..000000000 --- a/physics/GFS_rrtmgp_sw_pre.F90 +++ /dev/null @@ -1,98 +0,0 @@ -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, GFS_rrtmgp_sw_pre_init, GFS_rrtmgp_sw_pre_finalize -contains - - ! ######################################################################################### - ! SUBROUTINE GFS_rrtmgp_sw_pre_init - ! ######################################################################################### - subroutine GFS_rrtmgp_sw_pre_init () - end subroutine GFS_rrtmgp_sw_pre_init - - ! ######################################################################################### - ! SUBROUTINE GFS_rrtmgp_sw_pre_run - ! ######################################################################################### -!> \section arg_table_GFS_rrtmgp_sw_pre_run -!! \htmlinclude GFS_rrtmgp_sw_pre.html -!! - 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 - - ! ######################################################################################### - ! SUBROUTINE GFS_rrtmgp_sw_pre_finalize - ! ######################################################################################### - subroutine GFS_rrtmgp_sw_pre_finalize () - end subroutine GFS_rrtmgp_sw_pre_finalize - -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 eb7797125..9c440a09e 100644 --- a/physics/rrtmgp_aerosol_optics.F90 +++ b/physics/rrtmgp_aerosol_optics.F90 @@ -110,14 +110,10 @@ subroutine rrtmgp_aerosol_optics_run(doSWrad, doLWrad, nCol, nLev, nTracer, nTra ! Longwave if (.not. doLWrad) return + call check_error_msg('rrtmgp_aerosol_optics_run',lw_optical_props_aerosol%alloc_1scl( & + nCol, nlev, lw_gas_props%get_band_lims_wavenumber())) 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 - end subroutine rrtmgp_aerosol_optics_run end module rrtmgp_aerosol_optics diff --git a/physics/rrtmgp_lw_cloud_optics.F90 b/physics/rrtmgp_lw_cloud_optics.F90 index 68f5a4472..37d7e697f 100644 --- a/physics/rrtmgp_lw_cloud_optics.F90 +++ b/physics/rrtmgp_lw_cloud_optics.F90 @@ -2,8 +2,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 diff --git a/physics/rrtmgp_lw_cloud_optics.meta b/physics/rrtmgp_lw_cloud_optics.meta deleted file mode 100644 index 4b2d9cfc0..000000000 --- a/physics/rrtmgp_lw_cloud_optics.meta +++ /dev/null @@ -1,89 +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 diff --git a/physics/rrtmgp_lw_cloud_sampling.F90 b/physics/rrtmgp_lw_cloud_sampling.F90 deleted file mode 100644 index cb11607dc..000000000 --- a/physics/rrtmgp_lw_cloud_sampling.F90 +++ /dev/null @@ -1,166 +0,0 @@ -module rrtmgp_lw_cloud_sampling - use machine, only: kind_phys - 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 - - ! ######################################################################################### - ! SUBROTUINE rrtmgp_lw_cloud_sampling_run() - ! ######################################################################################### -!! \section arg_table_rrtmgp_lw_cloud_sampling_run -!! \htmlinclude rrtmgp_lw_cloud_sampling_run.html -!! - 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_phys), dimension(lw_gas_props%get_ngpt(),nLev,ncol) :: rng3D,rng3D2 - real(kind_phys), dimension(lw_gas_props%get_ngpt()*nLev) :: rng2D - real(kind_phys), 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(rng3D, 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(rng3D, cld_frac, maskMCICA, & - overlap_param = cloud_overlap_param(:,1:nLev-1), & - randoms2 = rng3D2) - endif - ! Exponential or Exponential-random - if (iovr == iovr_exp .or. iovr == iovr_exprand) then - call sampled_mask(rng3D, 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 - - ! ######################################################################################### - ! SUBROTUINE rrtmgp_lw_cloud_sampling_finalize() - ! ######################################################################################### - subroutine rrtmgp_lw_cloud_sampling_finalize() - end subroutine rrtmgp_lw_cloud_sampling_finalize - -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.meta b/physics/rrtmgp_lw_gas_optics.meta deleted file mode 100644 index a7ca8aacb..000000000 --- a/physics/rrtmgp_lw_gas_optics.meta +++ /dev/null @@ -1,101 +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 diff --git a/physics/rrtmgp_lw_main.F90 b/physics/rrtmgp_lw_main.F90 index ce1b767b0..0b55d9831 100644 --- a/physics/rrtmgp_lw_main.F90 +++ b/physics/rrtmgp_lw_main.F90 @@ -87,11 +87,11 @@ end subroutine rrtmgp_lw_main_init subroutine rrtmgp_lw_main_run(doLWrad, doLWclrsky, top_at_1, doGP_lwscat, use_LW_jacobian,& doGP_sgs_cnv, doGP_sgs_pbl, nCol, nLay, nGases, nGauss_angles, i_o3, icseed_lw, iovr,& iovr_convcld, iovr_max, iovr_maxrand, iovr_rand, iovr_dcorr, iovr_exp, iovr_exprand, & - isubc_lw, tsfg, p_lay, p_lev, t_lay, t_lev, vmr_o2, vmr_h2o, vmr_o3, vmr_ch4, & + 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, sfc_emiss_byband, active_gases_array, lw_optical_props_aerosol, & + cloud_overlap_param, active_gases_array, lw_optical_props_aerosol, & fluxlwUP_allsky, fluxlwDOWN_allsky, fluxlwUP_clrsky, fluxlwDOWN_clrsky, fluxlwUP_jac,& fluxlwUP_radtime, fluxlwDOWN_radtime, errmsg, errflg) @@ -122,7 +122,8 @@ subroutine rrtmgp_lw_main_run(doLWrad, doLWclrsky, top_at_1, doGP_lwscat, use_LW integer,intent(in),dimension(:) :: & icseed_lw ! Seed for random number generation for longwave radiation real(kind_phys), dimension(:), intent(in) :: & - tsfg ! + semis, & ! Surface-emissivity + tsfg ! real(kind_phys), dimension(:,:), intent(in) :: & p_lay, & ! Pressure @ model layer-centers (Pa) t_lay, & ! Temperature (K) @@ -152,8 +153,7 @@ subroutine rrtmgp_lw_main_run(doLWrad, doLWclrsky, top_at_1, doGP_lwscat, use_LW 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 - cloud_overlap_param, & ! - sfc_emiss_byband ! Surface emissivity in each band + cloud_overlap_param character(len=*), dimension(:), intent(in) :: & active_gases_array ! List of active gases from namelist as array type(ty_optical_props_1scl),intent(inout) :: & @@ -199,6 +199,7 @@ subroutine rrtmgp_lw_main_run(doLWrad, doLWclrsky, top_at_1, doGP_lwscat, use_LW real(kind_phys), dimension(1,nLay+1,lw_gas_props%get_nband()),target :: & fluxLW_up_allsky, fluxLW_up_clrsky, fluxLW_dn_allsky, fluxLW_dn_clrsky real(kind_phys), dimension(1,lw_gas_props%get_ngpt()) :: lw_Ds + real(kind_phys), dimension(lw_gas_props%get_nband(),1) :: sfc_emiss_byband ! Initialize CCPP error handling variables errmsg = '' @@ -257,10 +258,13 @@ subroutine rrtmgp_lw_main_run(doLWrad, doLWclrsky, top_at_1, doGP_lwscat, use_LW do iCol=1,nCol ! Initialize/reset lw_optical_props_clrsky%tau = 0._kind_phys + lw_optical_props_precipByBand%tau = 0._kind_phys + lw_optical_props_cloudsByBand%tau = 0._kind_phys lw_optical_props_clouds%tau = 0._kind_phys lw_optical_props_clouds%ssa = 1._kind_phys lw_optical_props_clouds%g = 0._kind_phys - lw_optical_props_precipByBand%tau = 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 ! ################################################################################### ! @@ -274,6 +278,20 @@ subroutine rrtmgp_lw_main_run(doLWrad, doLWclrsky, top_at_1, doGP_lwscat, use_LW gas_concentrations%concs(istr_h2o)%conc(1,:) = vmr_h2o(iCol,:) gas_concentrations%concs(istr_o3)%conc(1,:) = vmr_o3(iCol,:) + ! ################################################################################### + ! + ! Surface emissity in each band + ! + ! ################################################################################### + ! Assign same emissivity to all band + if (semis(iCol) > 1e-6 .and. semis(iCol) <= 1.0) then + do iBand=1,lw_gas_props%get_nband() + sfc_emiss_byband(iBand,1) = semis(iCol) + enddo + else + sfc_emiss_byband(1:lw_gas_props%get_nband(),1) = 1.0 + endif + ! ################################################################################### ! ! Gas-optics @@ -316,7 +334,7 @@ subroutine rrtmgp_lw_main_run(doLWrad, doLWclrsky, top_at_1, doGP_lwscat, use_LW endif ! MYNN PBL cloud-optics? - if (doGP_sgs_cnv) then + if (doGP_sgs_pbl) then call check_error_msg('rrtmgp_lw_main_pbl_cloud_optics',lw_cloud_props%cloud_optics(& cld_pbl_lwp(iCol:iCol,:), & ! IN - MYNN-EDMF PBL cloud liquid water path (g/m2) cld_pbl_iwp(iCol:iCol,:), & ! IN - MYNN-EDMF PBL cloud ice water path (g/m2) @@ -417,7 +435,7 @@ subroutine rrtmgp_lw_main_run(doLWrad, doLWclrsky, top_at_1, doGP_lwscat, use_LW lw_optical_props_clrsky, & ! IN - optical-properties top_at_1, & ! IN - veritcal ordering flag sources, & ! IN - source function - sfc_emiss_byband(:,iCol:iCol), & ! IN - surface emissivity in each LW band + 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 @@ -425,7 +443,7 @@ subroutine rrtmgp_lw_main_run(doLWrad, doLWclrsky, top_at_1, doGP_lwscat, use_LW lw_optical_props_clrsky, & ! IN - optical-properties top_at_1, & ! IN - veritcal ordering flag sources, & ! IN - source function - sfc_emiss_byband(:,iCol:iCol), & ! IN - surface emissivity in each LW band + sfc_emiss_byband, & ! IN - surface emissivity in each LW band flux_clrsky, & ! OUT - Fluxes lw_Ds = lw_Ds)) endif @@ -472,7 +490,7 @@ subroutine rrtmgp_lw_main_run(doLWrad, doLWclrsky, top_at_1, doGP_lwscat, use_LW lw_optical_props_clouds, & ! IN - optical-properties top_at_1, & ! IN - veritcal ordering flag sources, & ! IN - source function - sfc_emiss_byband(:,iCol:iCol), & ! IN - surface emissivity in each LW band + 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) @@ -481,7 +499,7 @@ subroutine rrtmgp_lw_main_run(doLWrad, doLWclrsky, top_at_1, doGP_lwscat, use_LW lw_optical_props_clouds, & ! IN - optical-properties top_at_1, & ! IN - veritcal ordering flag sources, & ! IN - source function - sfc_emiss_byband(:,iCol:iCol), & ! IN - surface emissivity in each LW band + 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 @@ -497,7 +515,7 @@ subroutine rrtmgp_lw_main_run(doLWrad, doLWclrsky, top_at_1, doGP_lwscat, use_LW lw_optical_props_clrsky, & ! IN - optical-properties top_at_1, & ! IN - veritcal ordering flag sources, & ! IN - source function - sfc_emiss_byband(:,iCol:iCol), & ! IN - surface emissivity in each LW band + 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) @@ -506,7 +524,7 @@ subroutine rrtmgp_lw_main_run(doLWrad, doLWclrsky, top_at_1, doGP_lwscat, use_LW lw_optical_props_clrsky, & ! IN - optical-properties top_at_1, & ! IN - veritcal ordering flag sources, & ! IN - source function - sfc_emiss_byband(:,iCol:iCol), & ! IN - surface emissivity in each LW band + 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 diff --git a/physics/rrtmgp_lw_main.meta b/physics/rrtmgp_lw_main.meta index 6f10b8504..ad0b88c86 100644 --- a/physics/rrtmgp_lw_main.meta +++ b/physics/rrtmgp_lw_main.meta @@ -299,6 +299,14 @@ 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 @@ -539,14 +547,6 @@ 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 = in [active_gases_array] standard_name = list_of_active_gases_used_by_RRTMGP long_name = list of active gases used by RRTMGP diff --git a/physics/rrtmgp_lw_pre.F90 b/physics/rrtmgp_lw_pre.F90 deleted file mode 100644 index d33a4e52c..000000000 --- a/physics/rrtmgp_lw_pre.F90 +++ /dev/null @@ -1,64 +0,0 @@ -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,rrtmgp_lw_pre_init,rrtmgp_lw_pre_finalize - -contains - - ! ######################################################################################### - ! SUBROUTINE rrtmgp_lw_pre_init - ! ######################################################################################### - subroutine rrtmgp_lw_pre_init () - end subroutine rrtmgp_lw_pre_init - - ! ######################################################################################### - ! SUBROUTINE rrtmgp_lw_pre_run - ! ######################################################################################### -!> \section arg_table_rrtmgp_lw_pre_run -!! \htmlinclude rrtmgp_lw_pre_run.html -!! - 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 - - ! ######################################################################################### - ! SUBROUTINE rrtmgp_lw_pre_finalize - ! ######################################################################################### - subroutine rrtmgp_lw_pre_finalize () - end subroutine rrtmgp_lw_pre_finalize - -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 a141a4e08..000000000 --- a/physics/rrtmgp_lw_rte.F90 +++ /dev/null @@ -1,213 +0,0 @@ -! ########################################################################################### -! ########################################################################################### -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_init, rrtmgp_lw_rte_run, rrtmgp_lw_rte_finalize -contains - - ! ######################################################################################### - ! SUBROUTINE rrtmgp_lw_rte_init - ! ######################################################################################### - subroutine rrtmgp_lw_rte_init() - end subroutine rrtmgp_lw_rte_init - - ! ######################################################################################### - ! SUBROUTINE rrtmgp_lw_rte_run - ! ######################################################################################### -!! \section arg_table_rrtmgp_lw_rte_run -!! \htmlinclude rrtmgp_lw_rte_run.html -!! - 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 - - ! ######################################################################################### - ! SUBROUTINE rrtmgp_lw_rte_finalize - ! ######################################################################################### - subroutine rrtmgp_lw_rte_finalize() - end subroutine rrtmgp_lw_rte_finalize - - -end module rrtmgp_lw_rte diff --git a/physics/rrtmgp_lw_rte.meta b/physics/rrtmgp_lw_rte.meta deleted file mode 100644 index 0ad0754b5..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_RRTMGP - long_name = flag for vertical ordering in RRTMGP - 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 fd648de02..24fafbffe 100644 --- a/physics/rrtmgp_sw_cloud_optics.F90 +++ b/physics/rrtmgp_sw_cloud_optics.F90 @@ -3,7 +3,6 @@ module rrtmgp_sw_cloud_optics 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 @@ -67,12 +66,9 @@ module rrtmgp_sw_cloud_optics ! ###################################################################################### ! SUBROUTINE sw_cloud_optics_init ! ###################################################################################### -!! \section arg_table_rrtmgp_sw_cloud_optics_init -!! \htmlinclude rrtmgp_lw_cloud_optics.html -!! - 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 rrtmgp_sw_cloud_optics_init(nrghice, mpicomm, mpirank, mpiroot, doG_cldoptics, & + doGP_cldoptics_PADE, doGP_cldoptics_LUT, rrtmgp_root_dir, rrtmgp_sw_file_clouds, & + errmsg, errflg) ! Inputs logical, intent(in) :: & @@ -388,183 +384,4 @@ subroutine rrtmgp_sw_cloud_optics_init(doG_cldoptics, doGP_cldoptics_PADE, end subroutine rrtmgp_sw_cloud_optics_init - ! ######################################################################################### - ! SUBROTUINE rrtmgp_sw_cloud_optics_run() - ! ######################################################################################### -!! \section arg_table_rrtmgp_sw_cloud_optics_run -!! \htmlinclude rrtmgp_sw_cloud_optics.html -!! - 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 - - ! ######################################################################################### - ! SUBROTUINE rrtmgp_sw_cloud_optics_finalize() - ! ######################################################################################### - subroutine rrtmgp_sw_cloud_optics_finalize() - end subroutine rrtmgp_sw_cloud_optics_finalize - 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 c4a5de4c8..000000000 --- a/physics/rrtmgp_sw_cloud_sampling.F90 +++ /dev/null @@ -1,170 +0,0 @@ -module rrtmgp_sw_cloud_sampling - use machine, only: kind_phys - 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 - - ! ######################################################################################### - ! SUBROTUINE rrtmgp_sw_cloud_sampling_run() - ! ######################################################################################### -!! \section arg_table_rrtmgp_sw_cloud_sampling_run -!! \htmlinclude rrtmgp_sw_cloud_sampling.html -!! - 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_phys), dimension(sw_gas_props%get_ngpt(),nLev,nday) :: rng3D,rng3D2 - real(kind_phys), dimension(sw_gas_props%get_ngpt()*nLev) :: rng2D - real(kind_phys), 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(rng3D, 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(rng3D, cld_frac(idxday(1:nDay),:), maskMCICA, & - overlap_param = cloud_overlap_param(idxday(1:nDay),1:nLev-1),& - randoms2 = rng3D2) - endif - ! Exponential or exponential-random cloud overlap - if (iovr == iovr_exp .or. iovr == iovr_exprand) then - call sampled_mask(rng3D, 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 - - ! ######################################################################################### - ! SUBROTUINE rrtmgp_sw_cloud_sampling_finalize() - ! ######################################################################################### - subroutine rrtmgp_sw_cloud_sampling_finalize() - end subroutine rrtmgp_sw_cloud_sampling_finalize - -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 260f65fe7..9193b9134 100644 --- a/physics/rrtmgp_sw_gas_optics.F90 +++ b/physics/rrtmgp_sw_gas_optics.F90 @@ -4,7 +4,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 @@ -76,11 +75,8 @@ module rrtmgp_sw_gas_optics ! ######################################################################################### ! SUBROUTINE sw_gas_optics_init ! ######################################################################################### -!! \section arg_table_rrtmgp_sw_gas_optics_init -!! \htmlinclude rrtmgp_sw_gas_optics.html -!! - subroutine rrtmgp_sw_gas_optics_init(rrtmgp_root_dir, rrtmgp_sw_file_gas, & - active_gases_array, mpicomm, mpirank, mpiroot, errmsg, errflg) + subroutine rrtmgp_sw_gas_optics_init(rrtmgp_root_dir, rrtmgp_sw_file_gas, mpicomm, mpirank, & + mpiroot, active_gases_array, errmsg, errflg) ! Inputs character(len=128),intent(in) :: & @@ -481,111 +477,4 @@ subroutine rrtmgp_sw_gas_optics_init(rrtmgp_root_dir, rrtmgp_sw_file_gas, end subroutine rrtmgp_sw_gas_optics_init - ! ######################################################################################### - ! SUBROUTINE rrtmgp_sw_gas_optics_run - ! ######################################################################################### -!! \section arg_table_rrtmgp_sw_gas_optics_run -!! \htmlinclude rrtmgp_sw_gas_optics.html -!! - 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 - - ! ######################################################################################### - ! SUBROUTINE rrtmgp_sw_gas_optics_finalize - ! ######################################################################################### - subroutine rrtmgp_sw_gas_optics_finalize() - end subroutine rrtmgp_sw_gas_optics_finalize - 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..fd8964c4d --- /dev/null +++ b/physics/rrtmgp_sw_main.F90 @@ -0,0 +1,555 @@ +! ########################################################################################### +! ########################################################################################### +module rrtmgp_sw_main + use machine, only: kind_phys + 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 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 + use mersenne_twister, only: random_setseed, random_number, random_stat + use rrtmgp_sampling, only: sampled_mask, draw_samples + implicit none + + 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, mpicomm, mpirank, & + mpiroot, active_gases_array, nrghice, doG_cldoptics, doGP_cldoptics_PADE, & + doGP_cldoptics_LUT,rrtmgp_sw_file_clouds, errmsg, errflg) + ! Inputs + 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? + integer, intent(inout) :: & + nrghice ! Number of ice-roughness categories + 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 + rrtmgp_sw_file_gas ! RRTMGP file containing coefficients used to compute gaseous optical properties + 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) :: & + 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, mpicomm, mpirank, & + mpiroot, active_gases_array, errmsg, errflg) + + ! RRTMGP shortwave cloud-optics initialization + call rrtmgp_sw_cloud_optics_init(nrghice, mpicomm, mpirank, mpiroot, doG_cldoptics, & + doGP_cldoptics_PADE, doGP_cldoptics_LUT, rrtmgp_root_dir, rrtmgp_sw_file_clouds, & + errmsg, errflg) + + 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, i_o3, idxday, 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, sw_optical_props_aerosol, scmpsw, fluxswUP_allsky, & + fluxswDOWN_allsky, fluxswUP_clrsky, fluxswDOWN_clrsky, cldtausw, errmsg, errflg) + + ! Inputs + logical, intent(in) :: & + doSWrad, & ! Flag to calculate SW irradiances + doSWclrsky, & ! Flag to compute clear-sky fluxes (diagnostic) + top_at_1, & ! Vertical ordering flag + doGP_sgs_pbl, & ! Flag for sgs MYNN-EDMF PBL cloud scheme + doGP_sgs_cnv ! Flag for sgs convective cloud scheme + integer,intent(in) :: & + nCol, & ! Number of horizontal points + nDay, & ! Number of daytime points + nLay, & ! Number of vertical grid points. + nGases, & ! Number of active gases in RRTMGP + i_o3, & ! + 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(:) :: & + idxday, & ! 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 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 + cloud_overlap_param ! + character(len=*), dimension(:), intent(in) :: & + active_gases_array ! List of active gases from namelist as array + type(ty_optical_props_2str),intent(in) :: & + sw_optical_props_aerosol ! RRTMGP DDT: Shortwave aerosol optical properties (tau,ssa,g) + + ! Outputs + character(len=*), intent(out) :: & + errmsg ! CCPP error message + integer, intent(out) :: & + errflg ! CCPP error flag + real(kind_phys), dimension(:,:), intent(out) :: & + 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(ty_gas_concs) :: & + gas_concentrations ! RRTMGP DDT: trace gas concentrations (vmr) + type(ty_optical_props_2str) :: & + sw_optical_props_clrsky, & ! RRTMGP DDT: Shortwave clear-sky radiative properties + sw_optical_props_aerosol_local, & ! RRTMGP DDT: Shortave aerosol radiative properties + 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_pblcloudsByBand, & ! RRTMGP DDT: Shortwave optical properties in each band (PBL cloud) + sw_optical_props_precipByBand, & ! RRTMGP DDT: Shortwave optical properties in each band (precipitation) + sw_optical_props_clouds ! RRTMGP DDT: Shortwave optical properties in each band (sampled clouds) + type(ty_fluxes_byband) :: & + flux_allsky, & ! RRTMGP DDT: All-sky flux (W/m2) + flux_clrsky ! RRTMGP DDT: Clear-sky flux (W/m2) + 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(sw_gas_props%get_ngpt()) :: rng1D + real(kind_phys), dimension(sw_gas_props%get_ngpt(),nLay,1) :: rng3D,rng3D2 + real(kind_phys), dimension(sw_gas_props%get_ngpt()*nLay) :: rng2D + logical, dimension(1,nLay,sw_gas_props%get_ngpt()) :: maskMCICA + real(kind_phys), dimension(sw_gas_props%get_nband(),1) :: & + sfc_alb_dir, sfc_alb_dif + real(kind_phys), dimension(1,nLay+1,sw_gas_props%get_nband()),target :: & + fluxSW_up_allsky, fluxSW_up_clrsky, fluxSW_dn_allsky, fluxSW_dn_clrsky, fluxSW_dn_dir_allsky + integer :: iBand, ibd, iCol, iGas, iLay, ipseed_sw + 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/) + real(kind_phys), dimension(1,sw_gas_props%get_ngpt()) :: toa_src_sw + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + if (.not. doSWrad) return + if (nDay .le. 0) then + 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 ) + return + endif + + ! ###################################################################################### + ! + ! Allocate/initialize RRTMGP DDT's + ! + ! ###################################################################################### + ! + ! ty_gas_concs + ! + gas_concentrations%ncol = 1 + gas_concentrations%nlay = nLay + allocate(gas_concentrations%gas_name(nGases)) + allocate(gas_concentrations%concs(nGases)) + do iGas=1,nGases + allocate(gas_concentrations%concs(iGas)%conc(1, nLay)) + enddo + gas_concentrations%gas_name(:) = active_gases_array(:) + ! + ! ty_optical_props + ! + call check_error_msg('rrtmgp_sw_main_gas_optics_init',& + sw_optical_props_clrsky%alloc_2str(1, nLay, sw_gas_props)) + call check_error_msg('rrtmgp_sw_main_cloud_optics_init',& + sw_optical_props_cloudsByBand%alloc_2str(1, nLay, sw_gas_props%get_band_lims_wavenumber())) + call check_error_msg('rrtmgp_sw_main_precip_optics_init',& + sw_optical_props_precipByBand%alloc_2str(1, nLay, sw_gas_props%get_band_lims_wavenumber())) + call check_error_msg('rrtmgp_sw_mian_cloud_sampling_init', & + sw_optical_props_clouds%alloc_2str(1, nLay, sw_gas_props)) + call check_error_msg('rrtmgp_sw_main_aerosol_optics_init',& + sw_optical_props_aerosol_local%alloc_2str(1, 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(1, 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(1, nLay, sw_gas_props%get_band_lims_wavenumber())) + endif + ! + ! ty_fluxes_byband + ! + 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 + + ! Loop over all (daylit)columns... + do iCol=1,nDay + ! Initialize/reset + sw_optical_props_clouds%tau = 0._kind_phys + sw_optical_props_clouds%ssa = 1._kind_phys + sw_optical_props_clouds%g = 0._kind_phys + sw_optical_props_clrsky%tau = 0._kind_phys + sw_optical_props_clrsky%ssa = 1._kind_phys + sw_optical_props_clrsky%g = 0._kind_phys + sw_optical_props_cloudsByBand%tau = 0._kind_phys + sw_optical_props_cloudsByBand%ssa = 1._kind_phys + sw_optical_props_cloudsByBand%g = 0._kind_phys + sw_optical_props_precipByBand%tau = 0._kind_phys + sw_optical_props_precipByBand%ssa = 1._kind_phys + sw_optical_props_precipByBand%g = 0._kind_phys + sw_optical_props_aerosol_local%tau = 0._kind_phys + sw_optical_props_aerosol_local%ssa = 1._kind_phys + sw_optical_props_aerosol_local%g = 0._kind_phys + if (doGP_sgs_cnv) then + sw_optical_props_cnvcloudsByBand%tau = 0._kind_phys + sw_optical_props_cnvcloudsByBand%ssa = 1._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 = 1._kind_phys + sw_optical_props_pblcloudsByBand%g = 0._kind_phys + endif + + ! ################################################################################### + ! + ! Set gas-concentrations + ! + ! ################################################################################### + gas_concentrations%concs(istr_o2)%conc(1,:) = vmr_o2(idxday(iCol),:) + gas_concentrations%concs(istr_co2)%conc(1,:) = vmr_co2(idxday(iCol),:) + gas_concentrations%concs(istr_ch4)%conc(1,:) = vmr_ch4(idxday(iCol),:) + gas_concentrations%concs(istr_n2o)%conc(1,:) = vmr_n2o(idxday(iCol),:) + gas_concentrations%concs(istr_h2o)%conc(1,:) = vmr_h2o(idxday(iCol),:) + gas_concentrations%concs(istr_o3)%conc(1,:) = vmr_o3(idxday(iCol),:) + + ! ################################################################################### + ! + ! 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. + ! + ! ################################################################################### + 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,1) = sfc_alb_nir_dir(idxday(iCol)) + sfc_alb_dif(iBand,1) = sfc_alb_nir_dif(idxday(iCol)) + endif + if (bandlimits(1,iBand) .eq. nIR_uvvis_bnd(1)) then + sfc_alb_dir(iBand,1) = 0.5_kind_phys*(sfc_alb_nir_dir(idxday(iCol)) + sfc_alb_uvvis_dir(idxday(iCol))) + sfc_alb_dif(iBand,1) = 0.5_kind_phys*(sfc_alb_nir_dif(idxday(iCol)) + sfc_alb_uvvis_dif(idxday(iCol))) + ibd = iBand + endif + if (bandlimits(1,iBand) .ge. nIR_uvvis_bnd(2)) then + sfc_alb_dir(iBand,1) = sfc_alb_uvvis_dir(idxday(iCol)) + sfc_alb_dif(iBand,1) = sfc_alb_uvvis_dif(idxday(iCol)) + endif + enddo + + ! ################################################################################### + ! + ! Gas-optics + ! + ! ################################################################################### + call check_error_msg('rrtmgp_sw_main_gas_optics',sw_gas_props%gas_optics(& + p_lay(idxday(iCol:iCol),:), & ! IN - Pressure @ layer-centers (Pa) + p_lev(idxday(iCol:iCol),:), & ! IN - Pressure @ layer-interfaces (Pa) + t_lay(idxday(iCol:iCol),:), & ! IN - Temperature @ layer-centers (K) + gas_concentrations, & ! 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)) ! OUT - TOA incident shortwave radiation (spectral) + + ! ################################################################################### + ! + ! Cloud-optics + ! + ! ################################################################################### + call check_error_msg('rrtmgp_sw_main_cloud_optics',sw_cloud_props%cloud_optics(& + cld_lwp(idxday(iCol:iCol),:), & ! IN - Cloud liquid water path + cld_iwp(idxday(iCol:iCol),:), & ! IN - Cloud ice water path + cld_reliq(idxday(iCol:iCol),:), & ! IN - Cloud liquid effective radius + cld_reice(idxday(iCol:iCol),:), & ! IN - Cloud ice effective radius + sw_optical_props_cloudsByBand)) ! OUT - RRTMGP DDT: Shortwave optical properties, + ! in each band (tau,ssa,g) + cldtausw(idxday(iCol),:) = sw_optical_props_cloudsByBand%tau(1,:,11) + + ! Convective cloud-optics? + if (doGP_sgs_cnv) then + call check_error_msg('rrtmgp_sw_main_cnv_cloud_optics',sw_cloud_props%cloud_optics(& + cld_cnv_lwp(idxday(iCol:iCol),:), & ! IN - Convective cloud liquid water path (g/m2) + cld_cnv_iwp(idxday(iCol:iCol),:), & ! IN - Convective cloud ice water path (g/m2) + cld_cnv_reliq(idxday(iCol:iCol),:), & ! IN - Convective cloud liquid effective radius (microns) + cld_cnv_reice(idxday(iCol:iCol),:), & ! IN - Convective cloud ice effective radius (microns) + sw_optical_props_cnvcloudsByBand)) ! OUT - RRTMGP DDT containing convective cloud radiative properties + ! in each band + !call check_error_msg('rrtmgp_sw_main_increment_cnvclouds_to_clouds',& + ! sw_optical_props_cnvcloudsByBand%increment(sw_optical_props_cloudsByBand)) + endif + + ! MYNN PBL cloud-optics? + if (doGP_sgs_pbl) then + call check_error_msg('rrtmgp_sw_main_pbl_cloud_optics',sw_cloud_props%cloud_optics(& + cld_pbl_lwp(idxday(iCol:iCol),:), & ! IN - MYNN-EDMF PBL cloud liquid water path (g/m2) + cld_pbl_iwp(idxday(iCol:iCol),:), & ! IN - MYNN-EDMF PBL cloud ice water path (g/m2) + cld_pbl_reliq(idxday(iCol:iCol),:), & ! IN - MYNN-EDMF PBL cloud liquid effective radius (microns) + cld_pbl_reice(idxday(iCol:iCol),:), & ! IN - MYNN-EDMF PBL cloud ice effective radius (microns) + sw_optical_props_pblcloudsByBand)) ! OUT - RRTMGP DDT containing MYNN-EDMF PBL cloud radiative properties + ! in each band + !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 iLay=1,nLay + if (cld_frac(idxday(iCol),iLay) .gt. 1.e-12_kind_phys) then + ! Rain/Snow optical depth (No band dependence) + tau_rain = cld_rwp(idxday(iCol),iLay)*a0r + if (cld_swp(idxday(iCol),iLay) .gt. 0. .and. cld_resnow(idxday(iCol),iLay) .gt. 10._kind_phys) then + tau_snow = cld_swp(idxday(iCol),iLay)*1.09087*(a0s + a1s/(1.0315*cld_resnow(idxday(iCol),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(idxday(iCol),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(1,iLay,iBand) = (1._kind_phys - za2) * tau_prec + sw_optical_props_precipByBand%ssa(1,iLay,iBand) = (ssaw - za2) / (1._kind_phys - za2) + sw_optical_props_precipByBand%g(1,iLay,iBand) = asyw/(1+asyw) + enddo + endif + enddo + + ! ################################################################################### + ! + ! 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 + ipseed_sw = sw_gas_props%get_ngpt() + iCol + elseif (isubc_sw == 2) then ! use input array of permutaion seeds + ipseed_sw = icseed_sw(idxday(iCol)) + endif + ! Call RNG + call random_setseed(ipseed_sw,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,1) = rng1D + enddo + else + do iLay=1,nLay + call random_number(rng1D,rng_stat) + rng3D(:,iLay,1) = rng1D + enddo + endif + ! Cloud-overlap. + ! Maximum-random, random or maximum. + if (iovr == iovr_maxrand .or. iovr == iovr_rand .or. iovr == iovr_max) then + call sampled_mask(rng3D, cld_frac(idxday(iCol:iCol),:), maskMCICA) + endif + ! Exponential decorrelation length overlap + if (iovr == iovr_dcorr) then + ! Generate second RNG + call random_setseed(ipseed_sw,rng_stat) + call random_number(rng2D,rng_stat) + rng3D2(:,:,1) = reshape(source = rng2D,shape=[sw_gas_props%get_ngpt(),nLay]) + ! + call sampled_mask(rng3D, cld_frac(idxday(iCol:iCol),:), maskMCICA, & + overlap_param = cloud_overlap_param(idxday(iCol:iCol),1:nLay-1), randoms2 = rng3D2) + endif + ! Exponential or Exponential-random + if (iovr == iovr_exp .or. iovr == iovr_exprand) then + call sampled_mask(rng3D, cld_frac(idxday(iCol:iCol),:), maskMCICA, & + overlap_param = cloud_overlap_param(idxday(iCol:iCol),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)) + + ! ################################################################################### + ! + ! Compute clear-sky fluxes (gaseous+aerosol) (optional) + ! + ! ################################################################################### + ! Add aerosol optics to gas optics + sw_optical_props_aerosol_local%tau = sw_optical_props_aerosol%tau(iCol:iCol,:,:) + sw_optical_props_aerosol_local%ssa = sw_optical_props_aerosol%ssa(iCol:iCol,:,:) + sw_optical_props_aerosol_local%g = sw_optical_props_aerosol%g(iCol:iCol,:,:) + call check_error_msg('rrtmgp_sw_main_increment_aerosol_to_clrsky',& + sw_optical_props_aerosol_local%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_main_rte_sw_clrsky',rte_sw( & + sw_optical_props_clrsky, & ! IN - optical-properties + top_at_1, & ! IN - veritcal ordering flag + coszen(idxday(iCol:iCol)), & ! 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(idxday(iCol),:) = sum(flux_clrsky%bnd_flux_up(1,:,:),dim=2) + fluxswDOWN_clrsky(idxday(iCol),:) = sum(flux_clrsky%bnd_flux_dn(1,:,:),dim=2) + else + fluxswUP_clrsky(idxday(iCol),:) = 0.0 + fluxswDOWN_clrsky(idxday(iCol),:) = 0.0 + endif + + ! ################################################################################### + ! + ! All-sky fluxes (clear-sky + clouds + precipitation) + ! + ! ################################################################################### + + ! Include convective cloud? + if (doGP_sgs_cnv) then + call check_error_msg('rrtmgp_sw_main_increment_cnvclouds_to_clrsky',& + sw_optical_props_cnvcloudsByBand%increment(sw_optical_props_clouds)) + endif + + ! Include MYNN-EDMF PBL clouds? + if (doGP_sgs_pbl) then + call check_error_msg('rrtmgp_sw_main_increment_pblclouds_to_clrsky',& + sw_optical_props_pblcloudsByBand%increment(sw_optical_props_clouds)) + endif + + ! Add in precipitation + call check_error_msg('rrtmgp_sw_main_increment_precip_to_clrsky',& + sw_optical_props_precipByBand%increment(sw_optical_props_clouds)) + + ! Delta-scale optical properties + call check_error_msg('rrtmgp_sw_main_delta_scale',sw_optical_props_clrsky%delta_scale()) + call check_error_msg('rrtmgp_sw_main_rte_sw_allsky',rte_sw( & + sw_optical_props_clouds, & ! IN - optical-properties + top_at_1, & ! IN - veritcal ordering flag + coszen(idxday(iCol:iCol)), & ! 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(idxday(iCol),:) = sum(flux_allsky%bnd_flux_up(1,:,:),dim=2) + fluxswDOWN_allsky(idxday(iCol),:) = sum(flux_allsky%bnd_flux_dn(1,:,:),dim=2) + ! Near IR + scmpsw(idxday(iCol))%nirbm = sum(flux_allsky%bnd_flux_dn_dir(1,iSFC,1:ibd-1)) + & + flux_allsky%bnd_flux_dn_dir(1,iSFC,ibd)/2. + scmpsw(idxday(iCol))%nirdf = (sum(flux_allsky%bnd_flux_dn(1,iSFC,1:ibd-1)) + & + flux_allsky%bnd_flux_dn(1,iSFC,ibd)/2.) - & + (sum(flux_allsky%bnd_flux_dn_dir(1,iSFC,1:ibd-1)) + & + flux_allsky%bnd_flux_dn_dir(1,iSFC,ibd)/2.) + ! UV-VIS + scmpsw(idxday(iCol))%visbm = sum(flux_allsky%bnd_flux_dn_dir(1,iSFC,ibd+1:sw_gas_props%get_nband())) + & + flux_allsky%bnd_flux_dn_dir(1,iSFC,ibd)/2. + scmpsw(idxday(iCol))%visdf = (sum(flux_allsky%bnd_flux_dn(1,iSFC,ibd+1:sw_gas_props%get_nband())) + & + flux_allsky%bnd_flux_dn(1,iSFC,ibd)/2. ) - & + (sum(flux_allsky%bnd_flux_dn_dir(1,iSFC,ibd+1:sw_gas_props%get_nband())) + & + flux_allsky%bnd_flux_dn_dir(1,iSFC,ibd)/2.) + enddo + 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..06f295230 --- /dev/null +++ b/physics/rrtmgp_sw_main.meta @@ -0,0 +1,618 @@ +[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 +[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 +[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 +[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 +[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 +[i_o3] + standard_name = index_of_ozone_mixing_ratio_in_tracer_concentration_array + long_name = tracer index for ozone mixing ratio + units = index + 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 +[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 +[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 +[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 = 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_rte.F90 b/physics/rrtmgp_sw_rte.F90 deleted file mode 100644 index e1879bd7a..000000000 --- a/physics/rrtmgp_sw_rte.F90 +++ /dev/null @@ -1,221 +0,0 @@ -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_init, rrtmgp_sw_rte_run, rrtmgp_sw_rte_finalize - -contains - - ! ######################################################################################### - ! SUBROUTINE rrtmgp_sw_rte_init - ! ######################################################################################### - subroutine rrtmgp_sw_rte_init() - end subroutine rrtmgp_sw_rte_init - - ! ######################################################################################### - ! SUBROUTINE rrtmgp_sw_rte_run - ! ######################################################################################### -!! \section arg_table_rrtmgp_sw_rte_run -!! \htmlinclude rrtmgp_sw_rte.html -!! - 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 - - ! ######################################################################################### - ! SUBROUTINE rrtmgp_sw_rte_finalize - ! ######################################################################################### - subroutine rrtmgp_sw_rte_finalize() - end subroutine rrtmgp_sw_rte_finalize - -end module rrtmgp_sw_rte diff --git a/physics/rrtmgp_sw_rte.meta b/physics/rrtmgp_sw_rte.meta deleted file mode 100644 index 9ab24c8b3..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_RRTMGP - long_name = flag for vertical ordering 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 -[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 From 8c2382394c23e484f2211b479151d4ddbc8802ca Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Tue, 12 Apr 2022 04:17:07 +0000 Subject: [PATCH 03/19] Bug fixes. Working now. --- physics/GFS_rrtmgp_pre.F90 | 17 ++-- physics/GFS_rrtmgp_pre.meta | 2 +- physics/GFS_rrtmgp_sw_post.F90 | 2 +- physics/rrtmgp_aerosol_optics.F90 | 17 ++-- physics/rrtmgp_aerosol_optics.meta | 2 +- physics/rrtmgp_sw_main.F90 | 147 +++++++++++++++-------------- physics/rrtmgp_sw_main.meta | 2 +- 7 files changed, 94 insertions(+), 95 deletions(-) diff --git a/physics/GFS_rrtmgp_pre.F90 b/physics/GFS_rrtmgp_pre.F90 index 7804ecef7..d028917d5 100644 --- a/physics/GFS_rrtmgp_pre.F90 +++ b/physics/GFS_rrtmgp_pre.F90 @@ -22,7 +22,7 @@ module GFS_rrtmgp_pre integer :: iStr_h2o, iStr_co2, iStr_o3, iStr_n2o, iStr_ch4, iStr_o2, iStr_ccl4, & iStr_cfc11, iStr_cfc12, iStr_cfc22 - public GFS_rrtmgp_pre_run,GFS_rrtmgp_pre_init,GFS_rrtmgp_pre_finalize + public GFS_rrtmgp_pre_run,GFS_rrtmgp_pre_init contains ! ######################################################################################### @@ -32,6 +32,7 @@ module GFS_rrtmgp_pre !! \htmlinclude GFS_rrtmgp_pre_init.html !! subroutine GFS_rrtmgp_pre_init(nGases, active_gases, active_gases_array, errmsg, errflg) + implicit none ! Inputs integer, intent(in) :: & nGases ! Number of active gases in RRTMGP @@ -103,9 +104,11 @@ subroutine GFS_rrtmgp_pre_run(me, nCol, nLev, i_o3, lsswr, lslwr, fhswr, fhlwr, 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,& errmsg, errflg) - + implicit none + ! Inputs integer, intent(in) :: & + me, & ! nCol, & ! Number of horizontal grid points nLev, & ! Number of vertical layers i_o3 ! Index into tracer array for ozone @@ -191,7 +194,7 @@ subroutine GFS_rrtmgp_pre_run(me, nCol, nLev, i_o3, lsswr, lslwr, fhswr, fhlwr, errflg = 0 if (.not. (lsswr .or. lslwr)) return - + ! ####################################################################################### ! What is vertical ordering? ! ####################################################################################### @@ -367,7 +370,7 @@ subroutine GFS_rrtmgp_pre_run(me, nCol, nLev, i_o3, lsswr, lslwr, fhswr, fhlwr, do iCol = 1, nCol if (coszen(iCol) >= 0.0001) then nday = nday + 1 - idxday(nday) = i + idxday(nday) = iCol endif enddo else @@ -376,10 +379,4 @@ subroutine GFS_rrtmgp_pre_run(me, nCol, nLev, i_o3, lsswr, lslwr, fhswr, fhlwr, endif end subroutine GFS_rrtmgp_pre_run - - ! ######################################################################################### - ! SUBROUTINE GFS_rrtmgp_pre_finalize - ! ######################################################################################### - subroutine GFS_rrtmgp_pre_finalize () - end subroutine GFS_rrtmgp_pre_finalize end module GFS_rrtmgp_pre diff --git a/physics/GFS_rrtmgp_pre.meta b/physics/GFS_rrtmgp_pre.meta index 39cf198f6..cc1e84a92 100644 --- a/physics/GFS_rrtmgp_pre.meta +++ b/physics/GFS_rrtmgp_pre.meta @@ -503,7 +503,7 @@ units = index dimensions = (horizontal_loop_extent) type = integer - intent = out + intent = inout [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/GFS_rrtmgp_sw_post.F90 b/physics/GFS_rrtmgp_sw_post.F90 index fafa162d9..9d537b909 100644 --- a/physics/GFS_rrtmgp_sw_post.F90 +++ b/physics/GFS_rrtmgp_sw_post.F90 @@ -38,7 +38,7 @@ subroutine GFS_rrtmgp_sw_post_run (nCol, nLev, nDay, idxday, lsswr, do_sw_clrsky nDay, & ! Number of daylit columns iSFC, & ! Vertical index for surface level iTOA ! Vertical index for TOA level - integer, intent(in), dimension(nday) :: & + integer, intent(in), dimension(:) :: & idxday ! Index array for daytime points logical, intent(in) :: & lsswr, & ! Call SW radiation? diff --git a/physics/rrtmgp_aerosol_optics.F90 b/physics/rrtmgp_aerosol_optics.F90 index 9c440a09e..fdf80c61a 100644 --- a/physics/rrtmgp_aerosol_optics.F90 +++ b/physics/rrtmgp_aerosol_optics.F90 @@ -38,7 +38,7 @@ subroutine rrtmgp_aerosol_optics_run(doSWrad, doLWrad, nCol, nLev, nTracer, nTra nLev, & ! Number of vertical layers nTracer, & ! Number of tracers nTracerAer ! Number of aerosol tracers - integer,intent(in),dimension(:) :: & + integer,dimension(:), intent(in) :: & idxday ! Indices for daylit points. real(kind_phys), dimension(:), intent(in) :: & lon, & ! Longitude @@ -61,7 +61,7 @@ subroutine rrtmgp_aerosol_optics_run(doSWrad, doLWrad, nCol, nLev, nTracer, nTra 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) :: & + type(ty_optical_props_1scl),intent(out) :: & lw_optical_props_aerosol ! RRTMGP DDT: Longwave aerosol optical properties (tau) integer, intent(out) :: & errflg ! CCPP error flag @@ -79,14 +79,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., aerosolssw2, aerosolslw, aerodp) ! 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 @@ -109,10 +109,11 @@ subroutine rrtmgp_aerosol_optics_run(doSWrad, doLWrad, nCol, nLev, nTracer, nTra endif ! Longwave - if (.not. doLWrad) return - call check_error_msg('rrtmgp_aerosol_optics_run',lw_optical_props_aerosol%alloc_1scl( & - nCol, nlev, lw_gas_props%get_band_lims_wavenumber())) - lw_optical_props_aerosol%tau = aerosolslw(:,:,:,1) * (1. - aerosolslw(:,:,:,2)) + if (doLWrad) then + call check_error_msg('rrtmgp_aerosol_optics_run',lw_optical_props_aerosol%alloc_1scl( & + nCol, nlev, lw_gas_props%get_band_lims_wavenumber())) + lw_optical_props_aerosol%tau = aerosolslw(:,:,:,1) * (1. - aerosolslw(:,:,:,2)) + endif end subroutine rrtmgp_aerosol_optics_run diff --git a/physics/rrtmgp_aerosol_optics.meta b/physics/rrtmgp_aerosol_optics.meta index cd7c77d4d..da2d79efb 100644 --- a/physics/rrtmgp_aerosol_optics.meta +++ b/physics/rrtmgp_aerosol_optics.meta @@ -164,7 +164,7 @@ units = DDT dimensions = () type = ty_optical_props_1scl - intent = inout + intent = out [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/rrtmgp_sw_main.F90 b/physics/rrtmgp_sw_main.F90 index fd8964c4d..2a66f592c 100644 --- a/physics/rrtmgp_sw_main.F90 +++ b/physics/rrtmgp_sw_main.F90 @@ -13,7 +13,6 @@ module rrtmgp_sw_main 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 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 use mersenne_twister, only: random_setseed, random_number, random_stat @@ -77,7 +76,7 @@ end subroutine rrtmgp_sw_main_init !! \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, i_o3, idxday, icseed_sw, iovr, iovr_convcld, iovr_max, & + nCol, nDay, nLay, nGases, i_o3, 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, & @@ -111,7 +110,7 @@ subroutine rrtmgp_sw_main_run(doSWrad, doSWclrsky, top_at_1, doGP_sgs_cnv, doGP_ isubc_sw, & ! iSFC integer,intent(in),dimension(:) :: & - idxday, & ! Index array for daytime points + 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) @@ -200,7 +199,7 @@ subroutine rrtmgp_sw_main_run(doSWrad, doSWclrsky, top_at_1, doGP_sgs_cnv, doGP_ sfc_alb_dir, sfc_alb_dif real(kind_phys), dimension(1,nLay+1,sw_gas_props%get_nband()),target :: & fluxSW_up_allsky, fluxSW_up_clrsky, fluxSW_dn_allsky, fluxSW_dn_clrsky, fluxSW_dn_dir_allsky - integer :: iBand, ibd, iCol, iGas, iLay, ipseed_sw + integer :: iBand, ibd, iCol, iGas, iLay, ipseed_sw, ix 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/) @@ -267,6 +266,8 @@ subroutine rrtmgp_sw_main_run(doSWrad, doSWclrsky, top_at_1, doGP_sgs_cnv, doGP_ ! Loop over all (daylit)columns... do iCol=1,nDay + ix = idx(iCol) + ! Initialize/reset sw_optical_props_clouds%tau = 0._kind_phys sw_optical_props_clouds%ssa = 1._kind_phys @@ -299,12 +300,12 @@ subroutine rrtmgp_sw_main_run(doSWrad, doSWclrsky, top_at_1, doGP_sgs_cnv, doGP_ ! Set gas-concentrations ! ! ################################################################################### - gas_concentrations%concs(istr_o2)%conc(1,:) = vmr_o2(idxday(iCol),:) - gas_concentrations%concs(istr_co2)%conc(1,:) = vmr_co2(idxday(iCol),:) - gas_concentrations%concs(istr_ch4)%conc(1,:) = vmr_ch4(idxday(iCol),:) - gas_concentrations%concs(istr_n2o)%conc(1,:) = vmr_n2o(idxday(iCol),:) - gas_concentrations%concs(istr_h2o)%conc(1,:) = vmr_h2o(idxday(iCol),:) - gas_concentrations%concs(istr_o3)%conc(1,:) = vmr_o3(idxday(iCol),:) + gas_concentrations%concs(istr_o2)%conc(1,:) = vmr_o2(ix,:) + gas_concentrations%concs(istr_co2)%conc(1,:) = vmr_co2(ix,:) + gas_concentrations%concs(istr_ch4)%conc(1,:) = vmr_ch4(ix,:) + gas_concentrations%concs(istr_n2o)%conc(1,:) = vmr_n2o(ix,:) + gas_concentrations%concs(istr_h2o)%conc(1,:) = vmr_h2o(ix,:) + gas_concentrations%concs(istr_o3)%conc(1,:) = vmr_o3(ix,:) ! ################################################################################### ! @@ -318,17 +319,17 @@ subroutine rrtmgp_sw_main_run(doSWrad, doSWclrsky, top_at_1, doGP_sgs_cnv, doGP_ 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,1) = sfc_alb_nir_dir(idxday(iCol)) - sfc_alb_dif(iBand,1) = sfc_alb_nir_dif(idxday(iCol)) + sfc_alb_dir(iBand,1) = sfc_alb_nir_dir(ix) + sfc_alb_dif(iBand,1) = sfc_alb_nir_dif(ix) endif if (bandlimits(1,iBand) .eq. nIR_uvvis_bnd(1)) then - sfc_alb_dir(iBand,1) = 0.5_kind_phys*(sfc_alb_nir_dir(idxday(iCol)) + sfc_alb_uvvis_dir(idxday(iCol))) - sfc_alb_dif(iBand,1) = 0.5_kind_phys*(sfc_alb_nir_dif(idxday(iCol)) + sfc_alb_uvvis_dif(idxday(iCol))) + sfc_alb_dir(iBand,1) = 0.5_kind_phys*(sfc_alb_nir_dir(ix) + sfc_alb_uvvis_dir(ix)) + sfc_alb_dif(iBand,1) = 0.5_kind_phys*(sfc_alb_nir_dif(ix) + sfc_alb_uvvis_dif(ix)) ibd = iBand endif if (bandlimits(1,iBand) .ge. nIR_uvvis_bnd(2)) then - sfc_alb_dir(iBand,1) = sfc_alb_uvvis_dir(idxday(iCol)) - sfc_alb_dif(iBand,1) = sfc_alb_uvvis_dif(idxday(iCol)) + sfc_alb_dir(iBand,1) = sfc_alb_uvvis_dir(ix) + sfc_alb_dif(iBand,1) = sfc_alb_uvvis_dif(ix) endif enddo @@ -338,13 +339,13 @@ subroutine rrtmgp_sw_main_run(doSWrad, doSWclrsky, top_at_1, doGP_sgs_cnv, doGP_ ! ! ################################################################################### call check_error_msg('rrtmgp_sw_main_gas_optics',sw_gas_props%gas_optics(& - p_lay(idxday(iCol:iCol),:), & ! IN - Pressure @ layer-centers (Pa) - p_lev(idxday(iCol:iCol),:), & ! IN - Pressure @ layer-interfaces (Pa) - t_lay(idxday(iCol:iCol),:), & ! IN - Temperature @ layer-centers (K) - gas_concentrations, & ! 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)) ! OUT - TOA incident shortwave radiation (spectral) + p_lay(ix:ix,:), & ! IN - Pressure @ layer-centers (Pa) + p_lev(ix:ix,:), & ! IN - Pressure @ layer-interfaces (Pa) + t_lay(ix:ix,:), & ! IN - Temperature @ layer-centers (K) + gas_concentrations, & ! 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)) ! OUT - TOA incident shortwave radiation (spectral) ! ################################################################################### ! @@ -352,23 +353,23 @@ subroutine rrtmgp_sw_main_run(doSWrad, doSWclrsky, top_at_1, doGP_sgs_cnv, doGP_ ! ! ################################################################################### call check_error_msg('rrtmgp_sw_main_cloud_optics',sw_cloud_props%cloud_optics(& - cld_lwp(idxday(iCol:iCol),:), & ! IN - Cloud liquid water path - cld_iwp(idxday(iCol:iCol),:), & ! IN - Cloud ice water path - cld_reliq(idxday(iCol:iCol),:), & ! IN - Cloud liquid effective radius - cld_reice(idxday(iCol:iCol),:), & ! IN - Cloud ice effective radius - sw_optical_props_cloudsByBand)) ! OUT - RRTMGP DDT: Shortwave optical properties, - ! in each band (tau,ssa,g) - cldtausw(idxday(iCol),:) = sw_optical_props_cloudsByBand%tau(1,:,11) + cld_lwp(ix:ix,:), & ! IN - Cloud liquid water path + cld_iwp(ix:ix,:), & ! IN - Cloud ice water path + cld_reliq(ix:ix,:), & ! IN - Cloud liquid effective radius + cld_reice(ix:ix,:), & ! IN - Cloud ice effective radius + sw_optical_props_cloudsByBand)) ! OUT - RRTMGP DDT: Shortwave optical properties, + ! in each band (tau,ssa,g) + cldtausw(ix,:) = sw_optical_props_cloudsByBand%tau(1,:,11) ! Convective cloud-optics? if (doGP_sgs_cnv) then call check_error_msg('rrtmgp_sw_main_cnv_cloud_optics',sw_cloud_props%cloud_optics(& - cld_cnv_lwp(idxday(iCol:iCol),:), & ! IN - Convective cloud liquid water path (g/m2) - cld_cnv_iwp(idxday(iCol:iCol),:), & ! IN - Convective cloud ice water path (g/m2) - cld_cnv_reliq(idxday(iCol:iCol),:), & ! IN - Convective cloud liquid effective radius (microns) - cld_cnv_reice(idxday(iCol:iCol),:), & ! IN - Convective cloud ice effective radius (microns) - sw_optical_props_cnvcloudsByBand)) ! OUT - RRTMGP DDT containing convective cloud radiative properties - ! in each band + cld_cnv_lwp(ix:ix,:), & ! IN - Convective cloud liquid water path (g/m2) + cld_cnv_iwp(ix:ix,:), & ! IN - Convective cloud ice water path (g/m2) + cld_cnv_reliq(ix:ix,:), & ! IN - Convective cloud liquid effective radius (microns) + cld_cnv_reice(ix:ix,:), & ! IN - Convective cloud ice effective radius (microns) + sw_optical_props_cnvcloudsByBand)) ! OUT - RRTMGP DDT containing convective cloud radiative properties + ! in each band !call check_error_msg('rrtmgp_sw_main_increment_cnvclouds_to_clouds',& ! sw_optical_props_cnvcloudsByBand%increment(sw_optical_props_cloudsByBand)) endif @@ -376,23 +377,23 @@ subroutine rrtmgp_sw_main_run(doSWrad, doSWclrsky, top_at_1, doGP_sgs_cnv, doGP_ ! MYNN PBL cloud-optics? if (doGP_sgs_pbl) then call check_error_msg('rrtmgp_sw_main_pbl_cloud_optics',sw_cloud_props%cloud_optics(& - cld_pbl_lwp(idxday(iCol:iCol),:), & ! IN - MYNN-EDMF PBL cloud liquid water path (g/m2) - cld_pbl_iwp(idxday(iCol:iCol),:), & ! IN - MYNN-EDMF PBL cloud ice water path (g/m2) - cld_pbl_reliq(idxday(iCol:iCol),:), & ! IN - MYNN-EDMF PBL cloud liquid effective radius (microns) - cld_pbl_reice(idxday(iCol:iCol),:), & ! IN - MYNN-EDMF PBL cloud ice effective radius (microns) - sw_optical_props_pblcloudsByBand)) ! OUT - RRTMGP DDT containing MYNN-EDMF PBL cloud radiative properties - ! in each band + cld_pbl_lwp(ix:ix,:), & ! IN - MYNN-EDMF PBL cloud liquid water path (g/m2) + cld_pbl_iwp(ix:ix,:), & ! IN - MYNN-EDMF PBL cloud ice water path (g/m2) + cld_pbl_reliq(ix:ix,:), & ! IN - MYNN-EDMF PBL cloud liquid effective radius (microns) + cld_pbl_reice(ix:ix,:), & ! IN - MYNN-EDMF PBL cloud ice effective radius (microns) + sw_optical_props_pblcloudsByBand)) ! OUT - RRTMGP DDT containing MYNN-EDMF PBL cloud radiative properties + ! in each band !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 iLay=1,nLay - if (cld_frac(idxday(iCol),iLay) .gt. 1.e-12_kind_phys) then + if (cld_frac(ix,iLay) .gt. 1.e-12_kind_phys) then ! Rain/Snow optical depth (No band dependence) - tau_rain = cld_rwp(idxday(iCol),iLay)*a0r - if (cld_swp(idxday(iCol),iLay) .gt. 0. .and. cld_resnow(idxday(iCol),iLay) .gt. 10._kind_phys) then - tau_snow = cld_swp(idxday(iCol),iLay)*1.09087*(a0s + a1s/(1.0315*cld_resnow(idxday(iCol),iLay))) ! fu's formula + tau_rain = cld_rwp(ix,iLay)*a0r + if (cld_swp(ix,iLay) .gt. 0. .and. cld_resnow(ix,iLay) .gt. 10._kind_phys) then + tau_snow = cld_swp(ix,iLay)*1.09087*(a0s + a1s/(1.0315*cld_resnow(ix,iLay))) ! fu's formula else tau_snow = 0._kind_phys endif @@ -402,7 +403,7 @@ subroutine rrtmgp_sw_main_run(doSWrad, doSWclrsky, top_at_1, doGP_sgs_cnv, doGP_ ! 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(iCol),iLay))) + ssa_snow = tau_snow*(1.-(b0s(iBand)+b1s(iBand)*1.0315*cld_resnow(ix,iLay))) asy_snow = ssa_snow*c0s(iBand) ! Combine tau_prec = max(1.e-12_kind_phys, tau_rain + tau_snow) @@ -428,7 +429,7 @@ subroutine rrtmgp_sw_main_run(doSWrad, doSWclrsky, top_at_1, doGP_sgs_cnv, doGP_ if(isubc_sw == 1) then ! advance prescribed permutation seed ipseed_sw = sw_gas_props%get_ngpt() + iCol elseif (isubc_sw == 2) then ! use input array of permutaion seeds - ipseed_sw = icseed_sw(idxday(iCol)) + ipseed_sw = icseed_sw(ix) endif ! Call RNG call random_setseed(ipseed_sw,rng_stat) @@ -447,7 +448,7 @@ subroutine rrtmgp_sw_main_run(doSWrad, doSWclrsky, top_at_1, doGP_sgs_cnv, doGP_ ! Cloud-overlap. ! Maximum-random, random or maximum. if (iovr == iovr_maxrand .or. iovr == iovr_rand .or. iovr == iovr_max) then - call sampled_mask(rng3D, cld_frac(idxday(iCol:iCol),:), maskMCICA) + call sampled_mask(rng3D, cld_frac(ix:ix,:), maskMCICA) endif ! Exponential decorrelation length overlap if (iovr == iovr_dcorr) then @@ -456,13 +457,13 @@ subroutine rrtmgp_sw_main_run(doSWrad, doSWclrsky, top_at_1, doGP_sgs_cnv, doGP_ call random_number(rng2D,rng_stat) rng3D2(:,:,1) = reshape(source = rng2D,shape=[sw_gas_props%get_ngpt(),nLay]) ! - call sampled_mask(rng3D, cld_frac(idxday(iCol:iCol),:), maskMCICA, & - overlap_param = cloud_overlap_param(idxday(iCol:iCol),1:nLay-1), randoms2 = rng3D2) + call sampled_mask(rng3D, cld_frac(ix:ix,:), maskMCICA, & + overlap_param = cloud_overlap_param(ix:ix,1:nLay-1), randoms2 = rng3D2) endif ! Exponential or Exponential-random if (iovr == iovr_exp .or. iovr == iovr_exprand) then - call sampled_mask(rng3D, cld_frac(idxday(iCol:iCol),:), maskMCICA, & - overlap_param = cloud_overlap_param(idxday(iCol:iCol),1:nLay-1)) + call sampled_mask(rng3D, cld_frac(ix:ix,:), maskMCICA, & + overlap_param = cloud_overlap_param(ix:ix,1:nLay-1)) endif ! Sampling. Map band optical depth to each g-point using McICA call check_error_msg('rrtmgp_sw_main_cloud_sampling',& @@ -487,17 +488,17 @@ subroutine rrtmgp_sw_main_run(doSWrad, doSWclrsky, top_at_1, doGP_sgs_cnv, doGP_ call check_error_msg('rrtmgp_sw_main_rte_sw_clrsky',rte_sw( & sw_optical_props_clrsky, & ! IN - optical-properties top_at_1, & ! IN - veritcal ordering flag - coszen(idxday(iCol:iCol)), & ! IN - Cosine of solar zenith angle + coszen(ix:ix), & ! 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(idxday(iCol),:) = sum(flux_clrsky%bnd_flux_up(1,:,:),dim=2) - fluxswDOWN_clrsky(idxday(iCol),:) = sum(flux_clrsky%bnd_flux_dn(1,:,:),dim=2) + fluxswUP_clrsky(ix,:) = sum(flux_clrsky%bnd_flux_up(1,:,:),dim=2) + fluxswDOWN_clrsky(ix,:) = sum(flux_clrsky%bnd_flux_dn(1,:,:),dim=2) else - fluxswUP_clrsky(idxday(iCol),:) = 0.0 - fluxswDOWN_clrsky(idxday(iCol),:) = 0.0 + fluxswUP_clrsky(ix,:) = 0.0 + fluxswDOWN_clrsky(ix,:) = 0.0 endif ! ################################################################################### @@ -527,29 +528,29 @@ subroutine rrtmgp_sw_main_run(doSWrad, doSWclrsky, top_at_1, doGP_sgs_cnv, doGP_ call check_error_msg('rrtmgp_sw_main_rte_sw_allsky',rte_sw( & sw_optical_props_clouds, & ! IN - optical-properties top_at_1, & ! IN - veritcal ordering flag - coszen(idxday(iCol:iCol)), & ! IN - Cosine of solar zenith angle + coszen(ix:ix), & ! 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(idxday(iCol),:) = sum(flux_allsky%bnd_flux_up(1,:,:),dim=2) - fluxswDOWN_allsky(idxday(iCol),:) = sum(flux_allsky%bnd_flux_dn(1,:,:),dim=2) + fluxswUP_allsky(ix,:) = sum(flux_allsky%bnd_flux_up(1,:,:),dim=2) + fluxswDOWN_allsky(ix,:) = sum(flux_allsky%bnd_flux_dn(1,:,:),dim=2) ! Near IR - scmpsw(idxday(iCol))%nirbm = sum(flux_allsky%bnd_flux_dn_dir(1,iSFC,1:ibd-1)) + & - flux_allsky%bnd_flux_dn_dir(1,iSFC,ibd)/2. - scmpsw(idxday(iCol))%nirdf = (sum(flux_allsky%bnd_flux_dn(1,iSFC,1:ibd-1)) + & - flux_allsky%bnd_flux_dn(1,iSFC,ibd)/2.) - & - (sum(flux_allsky%bnd_flux_dn_dir(1,iSFC,1:ibd-1)) + & - flux_allsky%bnd_flux_dn_dir(1,iSFC,ibd)/2.) + scmpsw(ix)%nirbm = sum(flux_allsky%bnd_flux_dn_dir(1,iSFC,1:ibd-1)) + & + flux_allsky%bnd_flux_dn_dir(1,iSFC,ibd)/2. + scmpsw(ix)%nirdf = (sum(flux_allsky%bnd_flux_dn(1,iSFC,1:ibd-1)) + & + flux_allsky%bnd_flux_dn(1,iSFC,ibd)/2.) - & + (sum(flux_allsky%bnd_flux_dn_dir(1,iSFC,1:ibd-1)) + & + flux_allsky%bnd_flux_dn_dir(1,iSFC,ibd)/2.) ! UV-VIS - scmpsw(idxday(iCol))%visbm = sum(flux_allsky%bnd_flux_dn_dir(1,iSFC,ibd+1:sw_gas_props%get_nband())) + & - flux_allsky%bnd_flux_dn_dir(1,iSFC,ibd)/2. - scmpsw(idxday(iCol))%visdf = (sum(flux_allsky%bnd_flux_dn(1,iSFC,ibd+1:sw_gas_props%get_nband())) + & - flux_allsky%bnd_flux_dn(1,iSFC,ibd)/2. ) - & - (sum(flux_allsky%bnd_flux_dn_dir(1,iSFC,ibd+1:sw_gas_props%get_nband())) + & - flux_allsky%bnd_flux_dn_dir(1,iSFC,ibd)/2.) + scmpsw(ix)%visbm = sum(flux_allsky%bnd_flux_dn_dir(1,iSFC,ibd+1:sw_gas_props%get_nband())) + & + flux_allsky%bnd_flux_dn_dir(1,iSFC,ibd)/2. + scmpsw(ix)%visdf = (sum(flux_allsky%bnd_flux_dn(1,iSFC,ibd+1:sw_gas_props%get_nband())) + & + flux_allsky%bnd_flux_dn(1,iSFC,ibd)/2. ) - & + (sum(flux_allsky%bnd_flux_dn_dir(1,iSFC,ibd+1:sw_gas_props%get_nband())) + & + flux_allsky%bnd_flux_dn_dir(1,iSFC,ibd)/2.) enddo 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 index 06f295230..1be643701 100644 --- a/physics/rrtmgp_sw_main.meta +++ b/physics/rrtmgp_sw_main.meta @@ -176,7 +176,7 @@ dimensions = () type = integer intent = in -[idxday] +[idx] standard_name = daytime_points long_name = daytime points units = index From 0532ca3d5ce2ae1ee4dfc491b7f07e411fb27c27 Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Tue, 12 Apr 2022 22:17:17 +0000 Subject: [PATCH 04/19] Some more cleanup. --- physics/GFS_rrtmgp_cloud_mp.meta | 6 +++--- physics/rrtmgp_aerosol_optics.F90 | 6 ++---- physics/rrtmgp_aerosol_optics.meta | 20 +++----------------- physics/rrtmgp_lw_main.F90 | 14 +++++++------- physics/rrtmgp_sw_main.F90 | 14 ++++++-------- 5 files changed, 21 insertions(+), 39 deletions(-) diff --git a/physics/GFS_rrtmgp_cloud_mp.meta b/physics/GFS_rrtmgp_cloud_mp.meta index 88530d84c..88a050abb 100644 --- a/physics/GFS_rrtmgp_cloud_mp.meta +++ b/physics/GFS_rrtmgp_cloud_mp.meta @@ -338,9 +338,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/rrtmgp_aerosol_optics.F90 b/physics/rrtmgp_aerosol_optics.F90 index fdf80c61a..6d3d36f57 100644 --- a/physics/rrtmgp_aerosol_optics.F90 +++ b/physics/rrtmgp_aerosol_optics.F90 @@ -24,7 +24,7 @@ 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, & + 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, & aerodp, sw_optical_props_aerosol, lw_optical_props_aerosol, errmsg, errflg ) @@ -35,9 +35,7 @@ subroutine rrtmgp_aerosol_optics_run(doSWrad, doLWrad, nCol, nLev, nTracer, nTra integer, intent(in) :: & 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 + nLev ! Number of vertical layers integer,dimension(:), intent(in) :: & idxday ! Indices for daylit points. real(kind_phys), dimension(:), intent(in) :: & diff --git a/physics/rrtmgp_aerosol_optics.meta b/physics/rrtmgp_aerosol_optics.meta index da2d79efb..61074cdff 100644 --- a/physics/rrtmgp_aerosol_optics.meta +++ b/physics/rrtmgp_aerosol_optics.meta @@ -35,20 +35,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 @@ -112,9 +98,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 diff --git a/physics/rrtmgp_lw_main.F90 b/physics/rrtmgp_lw_main.F90 index 0b55d9831..f45a5d07e 100644 --- a/physics/rrtmgp_lw_main.F90 +++ b/physics/rrtmgp_lw_main.F90 @@ -284,13 +284,13 @@ subroutine rrtmgp_lw_main_run(doLWrad, doLWclrsky, top_at_1, doGP_lwscat, use_LW ! ! ################################################################################### ! Assign same emissivity to all band - if (semis(iCol) > 1e-6 .and. semis(iCol) <= 1.0) then - do iBand=1,lw_gas_props%get_nband() - sfc_emiss_byband(iBand,1) = semis(iCol) - enddo - else - sfc_emiss_byband(1:lw_gas_props%get_nband(),1) = 1.0 - endif + !if (semis(iCol) > 1e-6 .and. semis(iCol) <= 1.0) then + do iBand=1,lw_gas_props%get_nband() + sfc_emiss_byband(iBand,1) = semis(iCol) + enddo + !else + ! sfc_emiss_byband(1:lw_gas_props%get_nband(),1) = 1.0 + !endif ! ################################################################################### ! diff --git a/physics/rrtmgp_sw_main.F90 b/physics/rrtmgp_sw_main.F90 index 2a66f592c..781af606b 100644 --- a/physics/rrtmgp_sw_main.F90 +++ b/physics/rrtmgp_sw_main.F90 @@ -209,14 +209,12 @@ subroutine rrtmgp_sw_main_run(doSWrad, doSWclrsky, top_at_1, doGP_sgs_cnv, doGP_ errflg = 0 if (.not. doSWrad) return - if (nDay .le. 0) then - 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 ) - return - endif + 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 ) + if (nDay .le. 0) return ! ###################################################################################### ! From 9345505a251524693dcab23ac1095efb9044359a Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Thu, 21 Apr 2022 22:57:17 +0000 Subject: [PATCH 05/19] Longwave RRTMGP loop over ncol working. --- physics/GFS_rrtmgp_pre.F90 | 81 ++-- physics/GFS_rrtmgp_pre.meta | 90 ++-- physics/rrtmgp_lw_cloud_optics.F90 | 3 - physics/rrtmgp_lw_gas_optics.F90 | 7 - physics/rrtmgp_lw_main.F90 | 321 +++++++------ physics/rrtmgp_lw_main.meta | 77 +-- physics/rrtmgp_sw_cloud_optics.F90 | 189 +++++++- physics/rrtmgp_sw_cloud_optics.meta | 393 +++++++++++++++ physics/rrtmgp_sw_cloud_sampling.F90 | 170 +++++++ physics/rrtmgp_sw_cloud_sampling.meta | 240 ++++++++++ physics/rrtmgp_sw_gas_optics.F90 | 115 ++++- physics/rrtmgp_sw_gas_optics.meta | 201 ++++++++ physics/rrtmgp_sw_main.F90 | 663 +++++++++++++------------- physics/rrtmgp_sw_main.meta | 29 +- physics/rrtmgp_sw_rte.F90 | 221 +++++++++ physics/rrtmgp_sw_rte.meta | 240 ++++++++++ 16 files changed, 2384 insertions(+), 656 deletions(-) create mode 100644 physics/rrtmgp_sw_cloud_optics.meta create mode 100644 physics/rrtmgp_sw_cloud_sampling.F90 create mode 100644 physics/rrtmgp_sw_cloud_sampling.meta create mode 100644 physics/rrtmgp_sw_gas_optics.meta create mode 100644 physics/rrtmgp_sw_rte.F90 create mode 100644 physics/rrtmgp_sw_rte.meta diff --git a/physics/GFS_rrtmgp_pre.F90 b/physics/GFS_rrtmgp_pre.F90 index d028917d5..e0046f61e 100644 --- a/physics/GFS_rrtmgp_pre.F90 +++ b/physics/GFS_rrtmgp_pre.F90 @@ -9,7 +9,10 @@ module GFS_rrtmgp_pre NF_VGAS, & ! Number of active gas species getgases, & ! Routine to setup trace gases getozn ! Routine to setup ozone + ! RRTMGP types + 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 real(kind_phys), parameter :: & amd = 28.9644_kind_phys, & ! Molecular weight of dry-air (g/mol) @@ -32,7 +35,6 @@ module GFS_rrtmgp_pre !! \htmlinclude GFS_rrtmgp_pre_init.html !! subroutine GFS_rrtmgp_pre_init(nGases, active_gases, active_gases_array, errmsg, errflg) - implicit none ! Inputs integer, intent(in) :: & nGases ! Number of active gases in RRTMGP @@ -97,20 +99,19 @@ end subroutine GFS_rrtmgp_pre_init !> \section arg_table_GFS_rrtmgp_pre_run !! \htmlinclude GFS_rrtmgp_pre_run.html !! - subroutine GFS_rrtmgp_pre_run(me, nCol, nLev, i_o3, lsswr, lslwr, fhswr, fhlwr, & + subroutine GFS_rrtmgp_pre_run(me, nCol, nLev, nTracers, i_o3, lsswr, lslwr, 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, 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,& - errmsg, errflg) - implicit none - + 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, semis, sfc_emiss_byband, errmsg, & + errflg) + ! Inputs integer, intent(in) :: & - me, & ! 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 logical, intent(in) :: & lsswr, & ! Call SW radiation? @@ -135,7 +136,8 @@ subroutine GFS_rrtmgp_pre_run(me, nCol, nLev, i_o3, lsswr, lslwr, fhswr, fhlwr, 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) @@ -152,8 +154,7 @@ subroutine GFS_rrtmgp_pre_run(me, nCol, nLev, i_o3, lsswr, lslwr, fhswr, fhlwr, integer, intent(out) :: & errflg, & ! Error flag iSFC, & ! Vertical index for surface - iTOA, & ! Vertical index for TOA - nDay + iTOA ! Vertical index for TOA logical, intent(out) :: & top_at_1 ! Vertical ordering flag real(kind_phys), intent(inout) :: & @@ -164,8 +165,6 @@ subroutine GFS_rrtmgp_pre_run(me, nCol, nLev, i_o3, lsswr, lslwr, fhswr, fhlwr, tsfc_radtime, & ! Surface temperature at radiation timestep coszen, & ! Cosine of SZA coszdg ! Cosine of SZA, daytime - integer, dimension(:), intent(out) :: & - idxday ! Indices for daylit points real(kind_phys), dimension(:,:), intent(inout) :: & p_lay, & ! Pressure at model-layer t_lay, & ! Temperature at model layer @@ -177,11 +176,16 @@ subroutine GFS_rrtmgp_pre_run(me, nCol, nLev, i_o3, lsswr, lslwr, fhswr, fhlwr, deltaZc, & ! Layer thickness (m) (between layer centers) deltaP, & ! Layer thickness (Pa) p_lev, & ! Pressure at model-interface - t_lev, & ! Temperature at model-interface - vmr_o2, vmr_h2o, vmr_o3, vmr_ch4, vmr_n2o, vmr_co2 + sfc_emiss_byband, & ! + 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 ! 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 @@ -194,7 +198,7 @@ subroutine GFS_rrtmgp_pre_run(me, nCol, nLev, i_o3, lsswr, lslwr, fhswr, fhlwr, errflg = 0 if (.not. (lsswr .or. lslwr)) return - + ! ####################################################################################### ! What is vertical ordering? ! ####################################################################################### @@ -323,10 +327,16 @@ subroutine GFS_rrtmgp_pre_run(me, nCol, nLev, i_o3, lsswr, lslwr, fhswr, fhlwr, ! ####################################################################################### ! 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, qgrs(iCol,iLay,i_o3) ) + o3_lay(iCol,iLay) = max( con_epsqs, tracer(iCol,iLay,i_o3) ) enddo enddo ! OR Use climatological ozone data @@ -339,14 +349,21 @@ subroutine GFS_rrtmgp_pre_run(me, nCol, nLev, i_o3, lsswr, lslwr, fhswr, fhlwr, ! ####################################################################################### ! Call getgases(), to set up non-prognostic gas volume mixing ratios (gas_vmr). call getgases (p_lev/100., xlon, xlat, nCol, nLev, 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) @@ -364,19 +381,15 @@ subroutine GFS_rrtmgp_pre_run(me, nCol, nLev, i_o3, lsswr, lslwr, fhswr, fhlwr, ! ####################################################################################### if (lsswr) 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 cc1e84a92..4992f4ef8 100644 --- a/physics/GFS_rrtmgp_pre.meta +++ b/physics/GFS_rrtmgp_pre.meta @@ -72,6 +72,13 @@ dimensions = () type = integer intent = in +[nTracers] + standard_name = number_of_tracers + long_name = number of tracers + units = count + dimensions = () + type = integer + intent = in [lsswr] standard_name = flag_for_calling_shortwave_radiation long_name = logical flags for sw radiation calls @@ -418,51 +425,11 @@ type = real kind = kind_phys intent = inout -[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) +[tracer] + standard_name = chemical_tracers + long_name = chemical tracers + units = g g-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_tracers) type = real kind = kind_phys intent = inout @@ -474,6 +441,13 @@ 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 @@ -490,19 +464,21 @@ 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 +[semis] + standard_name = surface_longwave_emissivity + long_name = surface lw emissivity in fraction + units = frac dimensions = (horizontal_loop_extent) - type = integer + 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 diff --git a/physics/rrtmgp_lw_cloud_optics.F90 b/physics/rrtmgp_lw_cloud_optics.F90 index 37d7e697f..d50900aab 100644 --- a/physics/rrtmgp_lw_cloud_optics.F90 +++ b/physics/rrtmgp_lw_cloud_optics.F90 @@ -65,9 +65,6 @@ module rrtmgp_lw_cloud_optics ! ###################################################################################### ! SUBROUTINE rrtmgp_lw_cloud_optics_init() ! ###################################################################################### -!! \section arg_table_rrtmgp_lw_cloud_optics_init -!! \htmlinclude rrtmgp_lw_cloud_optics.html -!! 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) diff --git a/physics/rrtmgp_lw_gas_optics.F90 b/physics/rrtmgp_lw_gas_optics.F90 index d198a5859..8f9e9f24c 100644 --- a/physics/rrtmgp_lw_gas_optics.F90 +++ b/physics/rrtmgp_lw_gas_optics.F90 @@ -3,11 +3,7 @@ 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 GFS_rrtmgp_pre, only: iStr_h2o, iStr_co2, iStr_o3, iStr_n2o, iStr_ch4, & - iStr_o2, iStr_ccl4, iStr_cfc11, iStr_cfc12, iStr_cfc22 use netcdf #ifdef MPI use mpi @@ -73,9 +69,6 @@ module rrtmgp_lw_gas_optics ! ######################################################################################### ! SUBROUTINE rrtmgp_lw_gas_optics_init ! ######################################################################################### -!! \section arg_table_rrtmgp_lw_gas_optics_init -!! \htmlinclude rrtmgp_lw_gas_optics_init.html -!! 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) diff --git a/physics/rrtmgp_lw_main.F90 b/physics/rrtmgp_lw_main.F90 index f45a5d07e..b58e5a45d 100644 --- a/physics/rrtmgp_lw_main.F90 +++ b/physics/rrtmgp_lw_main.F90 @@ -1,5 +1,11 @@ -! ########################################################################################### -! ########################################################################################### +! ###################################################################################### +!> \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 use mo_optical_props, only: ty_optical_props_1scl, ty_optical_props_2str @@ -11,10 +17,10 @@ module rrtmgp_lw_main 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 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, & + 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 use mersenne_twister, only: random_setseed, random_number, random_stat use rrtmgp_sampling, only: sampled_mask, draw_samples @@ -22,17 +28,21 @@ module rrtmgp_lw_main public rrtmgp_lw_main_init, rrtmgp_lw_main_run contains - - ! ######################################################################################### - ! SUBROUTINE rrtmgp_lw_main_init - ! ######################################################################################### + ! ###################################################################################### !! \section arg_table_rrtmgp_lw_main_init !! \htmlinclude rrtmgp_lw_main_int.html !! - subroutine rrtmgp_lw_main_init(rrtmgp_root_dir, rrtmgp_lw_file_gas, mpicomm, mpirank, & - mpiroot, minGPpres, maxGPpres, minGPtemp, maxGPtemp, active_gases_array, nrghice, & - doG_cldoptics, doGP_cldoptics_PADE, doGP_cldoptics_LUT,rrtmgp_lw_file_clouds, errmsg,& - errflg) +!> \ingroup rrtmgp_lw_main +!! +!! \brief +!! +!! \section rrtmgp_lw_main_init +!> @{ + ! ###################################################################################### + subroutine rrtmgp_lw_main_init(rrtmgp_root_dir, rrtmgp_lw_file_gas, mpicomm, mpirank, & + mpiroot, minGPpres, maxGPpres, minGPtemp, maxGPtemp, active_gases_array, nrghice, & + doG_cldoptics, doGP_cldoptics_PADE, doGP_cldoptics_LUT, rrtmgp_lw_file_clouds, & + errmsg, errflg) ! Inputs logical, intent(in) :: & @@ -43,8 +53,10 @@ subroutine rrtmgp_lw_main_init(rrtmgp_root_dir, rrtmgp_lw_file_gas, mpicomm, mpi nrghice ! Number of ice-roughness categories 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 + 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 integer,intent(in) :: & mpicomm, & ! MPI communicator mpirank, & ! Current MPI rank @@ -67,32 +79,37 @@ subroutine rrtmgp_lw_main_init(rrtmgp_root_dir, rrtmgp_lw_file_gas, mpicomm, mpi errflg = 0 ! RRTMGP longwave gas-optics (k-distribution) initialization - call rrtmgp_lw_gas_optics_init(rrtmgp_root_dir, rrtmgp_lw_file_gas, mpicomm, mpirank, & - mpiroot, minGPpres, maxGPpres, minGPtemp, maxGPtemp, active_gases_array, errmsg, & + call rrtmgp_lw_gas_optics_init(rrtmgp_root_dir, rrtmgp_lw_file_gas, mpicomm, mpirank,& + mpiroot, minGPpres, maxGPpres, minGPtemp, maxGPtemp, active_gases_array, errmsg,& errflg) ! RRTMGP longwave cloud-optics initialization - call rrtmgp_lw_cloud_optics_init(nrghice, mpicomm, mpirank, mpiroot, doG_cldoptics, & - doGP_cldoptics_PADE, doGP_cldoptics_LUT, rrtmgp_root_dir, rrtmgp_lw_file_clouds, & + call 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) end subroutine rrtmgp_lw_main_init - - ! ######################################################################################### - ! SUBROUTINE rrtmgp_lw_main_run - ! ######################################################################################### +!> @} + ! ###################################################################################### !! \section arg_table_rrtmgp_lw_main_run !! \htmlinclude rrtmgp_lw_main_run.html !! - subroutine rrtmgp_lw_main_run(doLWrad, doLWclrsky, top_at_1, doGP_lwscat, use_LW_jacobian,& - doGP_sgs_cnv, doGP_sgs_pbl, nCol, nLay, nGases, nGauss_angles, i_o3, 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, lw_optical_props_aerosol, & - fluxlwUP_allsky, fluxlwDOWN_allsky, fluxlwUP_clrsky, fluxlwDOWN_clrsky, fluxlwUP_jac,& +!> \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, 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, 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, sfc_emiss_byband, & + active_gases_array, lw_optical_props_aerosol, gas_concentrations, fluxlwUP_allsky,& + fluxlwDOWN_allsky, fluxlwUP_clrsky, fluxlwDOWN_clrsky, fluxlwUP_jac, & fluxlwUP_radtime, fluxlwDOWN_radtime, errmsg, errflg) ! Inputs @@ -107,9 +124,7 @@ subroutine rrtmgp_lw_main_run(doLWrad, doLWclrsky, top_at_1, doGP_lwscat, use_LW integer,intent(in) :: & nCol, & ! Number of horizontal points nLay, & ! Number of vertical grid points. - nGases, & ! Number of active gases in RRTMGP nGauss_angles, & ! - i_o3, & ! iovr, & ! Choice of cloud-overlap method iovr_convcld, & ! Choice of convective cloud-overlap iovr_max, & ! Flag for maximum cloud overlap method @@ -129,12 +144,6 @@ subroutine rrtmgp_lw_main_run(doLWrad, doLWclrsky, top_at_1, doGP_lwscat, use_LW 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 @@ -153,12 +162,14 @@ subroutine rrtmgp_lw_main_run(doLWrad, doLWclrsky, top_at_1, doGP_lwscat, use_LW 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 + sfc_emiss_byband, & ! cloud_overlap_param character(len=*), dimension(:), intent(in) :: & active_gases_array ! List of active gases from namelist as array type(ty_optical_props_1scl),intent(inout) :: & lw_optical_props_aerosol ! RRTMGP DDT: Longwave aerosol optical properties (tau) - + type(ty_gas_concs), intent(in) :: & + gas_concentrations ! RRTMGP DDT: ! Outputs real(kind_phys), dimension(:,:), intent(inout) :: & fluxlwUP_jac, & ! Jacobian of upwelling LW surface radiation (W/m2/K) @@ -175,16 +186,16 @@ subroutine rrtmgp_lw_main_run(doLWrad, doLWclrsky, top_at_1, doGP_lwscat, use_LW ! Local variables type(ty_gas_concs) :: & - gas_concentrations ! RRTMGP DDT: trace gas concentrations (vmr) + gas_concs ! RRTMGP DDT: trace gas concentrations (vmr) type(ty_optical_props_1scl) :: & lw_optical_props_clrsky, & ! RRTMGP DDT: longwave clear-sky radiative properties - lw_optical_props_aerosol_local, & ! RRTMGP DDT: longwave aerosol radiative properties + lw_optical_props_aerosol_local ! RRTMGP DDT: longwave aerosol radiative properties + type(ty_optical_props_2str) :: & + lw_optical_props_clouds, & ! RRTMGP DDT: Longwave optical properties in each band (sampled clouds) 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_pblcloudsByBand, & ! RRTMGP DDT: Longwave optical properties in each band (PBL cloud) - lw_optical_props_precipByBand ! RRTMGP DDT: Longwave optical properties in each band (precipitation) - type(ty_optical_props_2str) :: & - lw_optical_props_clouds ! RRTMGP DDT: Longwave optical properties in each band (sampled clouds) + lw_optical_props_pblcloudsByBand, & ! RRTMGP DDT: Longwave optical properties in each band (PBL cloud) + lw_optical_props_precipByBand ! RRTMGP DDT: Longwave optical properties in each band (precipitation) type(ty_source_func_lw) :: & sources ! RRTMGP DDT: longwave source functions type(ty_fluxes_byband) :: & @@ -199,7 +210,7 @@ subroutine rrtmgp_lw_main_run(doLWrad, doLWclrsky, top_at_1, doGP_lwscat, use_LW real(kind_phys), dimension(1,nLay+1,lw_gas_props%get_nband()),target :: & fluxLW_up_allsky, fluxLW_up_clrsky, fluxLW_dn_allsky, fluxLW_dn_clrsky real(kind_phys), dimension(1,lw_gas_props%get_ngpt()) :: lw_Ds - real(kind_phys), dimension(lw_gas_props%get_nband(),1) :: sfc_emiss_byband + real(kind_phys), dimension(nCol, nLay,gas_concentrations%get_num_gases()) :: vmrTemp ! Initialize CCPP error handling variables errmsg = '' @@ -207,6 +218,8 @@ subroutine rrtmgp_lw_main_run(doLWrad, doLWclrsky, top_at_1, doGP_lwscat, use_LW if (.not. doLWrad) return + fluxlwUP_clrsky(:,:) = 0._kind_phys + fluxlwDOWN_clrsky(:,:) = 0._kind_phys ! ###################################################################################### ! ! Allocate/initialize RRTMGP DDT's @@ -215,14 +228,18 @@ subroutine rrtmgp_lw_main_run(doLWrad, doLWclrsky, top_at_1, doGP_lwscat, use_LW ! ! ty_gas_concs ! - gas_concentrations%ncol = 1 - gas_concentrations%nlay = nLay - allocate(gas_concentrations%gas_name(nGases)) - allocate(gas_concentrations%concs(nGases)) - do iGas=1,nGases - allocate(gas_concentrations%concs(iGas)%conc(1, nLay)) + gas_concs%ncol = 1 + gas_concs%nlay = nLay + allocate(gas_concs%gas_name(gas_concentrations%get_num_gases())) + allocate(gas_concs%concs(gas_concentrations%get_num_gases())) + do iGas=1,gas_concentrations%get_num_gases() + allocate(gas_concs%concs(iGas)%conc(1, nLay)) + enddo + gas_concs%gas_name(:) = active_gases_array(:) + do iGas=1,gas_concentrations%get_num_gases() + call check_error_msg('rrtmgp_lw_main_get_vmr',& + gas_concentrations%get_vmr(trim(gas_concentrations%gas_name(iGas)),vmrTemp(:,:,iGas))) enddo - gas_concentrations%gas_name(:) = active_gases_array(:) ! ! ty_optical_props ! @@ -231,66 +248,63 @@ subroutine rrtmgp_lw_main_run(doLWrad, doLWclrsky, top_at_1, doGP_lwscat, use_LW call check_error_msg('rrtmgp_lw_main_sources_init',& sources%alloc(1, nLay, lw_gas_props)) call check_error_msg('rrtmgp_lw_main_cloud_optics_init',& - lw_optical_props_cloudsByBand%alloc_1scl(1, nLay, lw_gas_props%get_band_lims_wavenumber())) + lw_optical_props_cloudsByBand%alloc_2str(1, nLay, lw_gas_props%get_band_lims_wavenumber())) call check_error_msg('rrtmgp_lw_main_precip_optics_init',& - lw_optical_props_precipByBand%alloc_1scl(1, nLay, lw_gas_props%get_band_lims_wavenumber())) + lw_optical_props_precipByBand%alloc_2str(1, nLay, lw_gas_props%get_band_lims_wavenumber())) call check_error_msg('rrtmgp_lw_mian_cloud_sampling_init', & lw_optical_props_clouds%alloc_2str(1, nLay, lw_gas_props)) call check_error_msg('rrtmgp_lw_main_aerosol_optics_init',& lw_optical_props_aerosol_local%alloc_1scl(1, 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_1scl(1, nLay, lw_gas_props%get_band_lims_wavenumber())) + lw_optical_props_cnvcloudsByBand%alloc_2str(1, 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_1scl(1, nLay, lw_gas_props%get_band_lims_wavenumber())) + lw_optical_props_pblcloudsByBand%alloc_2str(1, nLay, lw_gas_props%get_band_lims_wavenumber())) endif - ! - ! ty_fluxes_byband - ! - 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 ! Loop over all columns... do iCol=1,nCol ! Initialize/reset + do iGas=1,gas_concentrations%get_num_gases() + gas_concs%concs(iGas)%conc(1,:) = 0._kind_phys + end do 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 = 1._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 + 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 ! ! ################################################################################### - gas_concentrations%concs(istr_o2)%conc(1,:) = vmr_o2(iCol,:) - gas_concentrations%concs(istr_co2)%conc(1,:) = vmr_co2(iCol,:) - gas_concentrations%concs(istr_ch4)%conc(1,:) = vmr_ch4(iCol,:) - gas_concentrations%concs(istr_n2o)%conc(1,:) = vmr_n2o(iCol,:) - gas_concentrations%concs(istr_h2o)%conc(1,:) = vmr_h2o(iCol,:) - gas_concentrations%concs(istr_o3)%conc(1,:) = vmr_o3(iCol,:) - - ! ################################################################################### - ! - ! Surface emissity in each band - ! - ! ################################################################################### - ! Assign same emissivity to all band - !if (semis(iCol) > 1e-6 .and. semis(iCol) <= 1.0) then - do iBand=1,lw_gas_props%get_nband() - sfc_emiss_byband(iBand,1) = semis(iCol) + do iGas=1,gas_concentrations%get_num_gases() + call check_error_msg('rrtmgp_sw_gas_optics_run_set_vmr',& + gas_concs%set_vmr(trim(gas_concentrations%gas_name(iGas)),vmrTemp(iCol,:,iGas))) enddo - !else - ! sfc_emiss_byband(1:lw_gas_props%get_nband(),1) = 1.0 - !endif ! ################################################################################### ! @@ -302,7 +316,7 @@ subroutine rrtmgp_lw_main_run(doLWrad, doLWclrsky, top_at_1, doGP_lwscat, use_LW p_lev(iCol:iCol,:), & ! IN - Pressure @ layer-interfaces (Pa) t_lay(iCol:iCol,:), & ! IN - Temperature @ layer-centers (K) tsfg(iCol:iCol), & ! IN - Skin-temperature (K) - gas_concentrations, & ! IN - RRTMGP DDT: trace gas volumne mixing-ratios + 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:iCol,:))) ! IN - Temperature @ layer-interfaces (K) (optional) @@ -312,14 +326,16 @@ subroutine rrtmgp_lw_main_run(doLWrad, doLWclrsky, top_at_1, doGP_lwscat, use_LW ! Cloud-optics ! ! ################################################################################### - call check_error_msg('rrtmgp_lw_main_cloud_optics',lw_cloud_props%cloud_optics(& - cld_lwp(iCol:iCol,:), & ! IN - Cloud liquid water path (g/m2) - cld_iwp(iCol:iCol,:), & ! IN - Cloud ice water path (g/m2) - cld_reliq(iCol:iCol,:), & ! IN - Cloud liquid effective radius (microns) - cld_reice(iCol:iCol,:), & ! IN - Cloud ice effective radius (microns) - lw_optical_props_cloudsByBand)) ! OUT - RRTMGP DDT containing cloud radiative properties - ! in each band - + if (any(cld_frac(iCol,:) .gt. 0.)) then + call check_error_msg('rrtmgp_lw_main_cloud_optics',lw_cloud_props%cloud_optics(& + cld_lwp(iCol:iCol,:), & ! IN - Cloud liquid water path (g/m2) + cld_iwp(iCol:iCol,:), & ! IN - Cloud ice water path (g/m2) + cld_reliq(iCol:iCol,:), & ! IN - Cloud liquid effective radius (microns) + cld_reice(iCol:iCol,:), & ! IN - Cloud ice effective radius (microns) + lw_optical_props_cloudsByBand)) ! OUT - RRTMGP DDT containing cloud radiative properties + ! in each band + endif + ! Convective cloud-optics? if (doGP_sgs_cnv) then call check_error_msg('rrtmgp_lw_main_cnv_cloud_optics',lw_cloud_props%cloud_optics(& @@ -347,6 +363,8 @@ subroutine rrtmgp_lw_main_run(doLWrad, doLWclrsky, top_at_1, doGP_lwscat, use_LW endif ! Cloud precipitation optics: rain and snow(+groupel) + tau_rain = 0._kind_phys + tau_snow = 0._kind_phys do iLay=1,nLay if (cld_frac(iCol,iLay) .gt. 0.) then ! Rain optical-depth (No band dependence) @@ -371,51 +389,52 @@ subroutine rrtmgp_lw_main_run(doLWrad, doLWclrsky, top_at_1, doGP_lwscat, use_LW ! Cloud-sampling ! ! ################################################################################### - ! Change random number seed value for each radiation invocation (isubc_lw =1 or 2). - if(isubc_lw == 1) then ! advance prescribed permutation seed - ipseed_lw = lw_gas_props%get_ngpt() + iCol - elseif (isubc_lw == 2) then ! use input array of permutaion seeds - ipseed_lw = icseed_lw(iCol) - endif - ! Call RNG - call random_setseed(ipseed_lw,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,1) = rng1D - enddo - else - do iLay=1,nLay - call random_number(rng1D,rng_stat) - rng3D(:,iLay,1) = rng1D - enddo - endif - ! Cloud-overlap. - ! Maximum-random, random or maximum. - if (iovr == iovr_maxrand .or. iovr == iovr_rand .or. iovr == iovr_max) then - call sampled_mask(rng3D, cld_frac(iCol:iCol,:), maskMCICA) - endif - ! Exponential decorrelation length overlap - if (iovr == iovr_dcorr) then - ! Generate second RNG + if (any(cld_frac(iCol,:) .gt. 0.)) then + ! Change random number seed value for each radiation invocation (isubc_lw =1 or 2). + if(isubc_lw == 1) then ! advance prescribed permutation seed + ipseed_lw = lw_gas_props%get_ngpt() + iCol + elseif (isubc_lw == 2) then ! use input array of permutaion seeds + ipseed_lw = icseed_lw(iCol) + endif + ! Call RNG call random_setseed(ipseed_lw,rng_stat) - call random_number(rng2D,rng_stat) - rng3D2(:,:,1) = reshape(source = rng2D,shape=[lw_gas_props%get_ngpt(),nLay]) - ! - call sampled_mask(rng3D, cld_frac(iCol:iCol,:), maskMCICA, & - overlap_param = cloud_overlap_param(iCol:iCol,1:nLay-1), randoms2 = rng3D2) - endif - ! Exponential or Exponential-random - if (iovr == iovr_exp .or. iovr == iovr_exprand) then - call sampled_mask(rng3D, cld_frac(iCol:iCol,:), maskMCICA, & - overlap_param = cloud_overlap_param(iCol:iCol,1:nLay-1)) + ! Use same rng for each layer + if (iovr == iovr_max) then + call random_number(rng1D,rng_stat) + do iLay=1,nLay + rng3D(:,iLay,1) = rng1D + enddo + else + do iLay=1,nLay + call random_number(rng1D,rng_stat) + rng3D(:,iLay,1) = rng1D + enddo + endif + ! Cloud-overlap. + ! Maximum-random, random or maximum. + if (iovr == iovr_maxrand .or. iovr == iovr_rand .or. iovr == iovr_max) then + call sampled_mask(rng3D, cld_frac(iCol:iCol,:), maskMCICA) + endif + ! Exponential decorrelation length overlap + if (iovr == iovr_dcorr) then + ! Generate second RNG + call random_setseed(ipseed_lw,rng_stat) + call random_number(rng2D,rng_stat) + rng3D2(:,:,1) = reshape(source = rng2D,shape=[lw_gas_props%get_ngpt(),nLay]) + ! + call sampled_mask(rng3D, cld_frac(iCol:iCol,:), maskMCICA, & + overlap_param = cloud_overlap_param(iCol:iCol,1:nLay-1), randoms2 = rng3D2) + endif + ! Exponential or Exponential-random + if (iovr == iovr_exp .or. iovr == iovr_exprand) then + call sampled_mask(rng3D, cld_frac(iCol:iCol,:), maskMCICA, & + overlap_param = cloud_overlap_param(iCol:iCol,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 - ! 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)) - ! ################################################################################### ! ! Compute clear-sky fluxes (gaseous+aerosol) (optional) @@ -435,7 +454,7 @@ subroutine rrtmgp_lw_main_run(doLWrad, doLWclrsky, top_at_1, doGP_lwscat, use_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 + sfc_emiss_byband(:,iCol:iCol), & ! IN - surface emissivity in each LW band flux_clrsky, & ! OUT - Fluxes n_gauss_angles = nGauss_angles)) ! IN - Number of angles in Gaussian quadrature else @@ -443,14 +462,14 @@ subroutine rrtmgp_lw_main_run(doLWrad, doLWclrsky, top_at_1, doGP_lwscat, use_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 + sfc_emiss_byband(:,iCol:iCol), & ! IN - surface emissivity in each LW band flux_clrsky, & ! OUT - Fluxes lw_Ds = lw_Ds)) endif ! Store fluxes - fluxlwUP_clrsky(iCol,:) = sum(flux_clrsky%bnd_flux_up(1,:,:),dim=2) - fluxlwDOWN_clrsky(iCol,:) = sum(flux_clrsky%bnd_flux_dn(1,:,:),dim=2) + fluxlwUP_clrsky(iCol:iCol,:) = sum(flux_clrsky%bnd_flux_up, dim=3) + fluxlwDOWN_clrsky(iCol:iCol,:) = sum(flux_clrsky%bnd_flux_dn, dim=3) else fluxlwUP_clrsky(iCol,:) = 0.0 fluxlwDOWN_clrsky(iCol,:) = 0.0 @@ -465,13 +484,13 @@ subroutine rrtmgp_lw_main_run(doLWrad, doLWclrsky, top_at_1, doGP_lwscat, use_LW ! Include convective cloud? if (doGP_sgs_cnv) then call check_error_msg('rrtmgp_lw_main_increment_cnvclouds_to_clrsky',& - lw_optical_props_cnvcloudsByBand%increment(lw_optical_props_clouds)) + lw_optical_props_cnvcloudsByBand%increment(lw_optical_props_clrsky)) endif ! Include MYNN-EDMF PBL clouds? if (doGP_sgs_pbl) then call check_error_msg('rrtmgp_lw_main_increment_pblclouds_to_clrsky',& - lw_optical_props_pblcloudsByBand%increment(lw_optical_props_clouds)) + lw_optical_props_pblcloudsByBand%increment(lw_optical_props_clrsky)) endif ! Add in precipitation @@ -490,7 +509,7 @@ subroutine rrtmgp_lw_main_run(doLWrad, doLWclrsky, top_at_1, doGP_lwscat, use_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 + sfc_emiss_byband(:,iCol:iCol), & ! 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) @@ -499,7 +518,7 @@ subroutine rrtmgp_lw_main_run(doLWrad, doLWclrsky, top_at_1, doGP_lwscat, use_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 + sfc_emiss_byband(:,iCol:iCol), & ! 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 @@ -515,7 +534,7 @@ subroutine rrtmgp_lw_main_run(doLWrad, doLWclrsky, top_at_1, doGP_lwscat, use_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 + sfc_emiss_byband(:,iCol:iCol), & ! 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) @@ -524,15 +543,15 @@ subroutine rrtmgp_lw_main_run(doLWrad, doLWclrsky, top_at_1, doGP_lwscat, use_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 + sfc_emiss_byband(:,iCol:iCol), & ! 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,:) = sum(flux_allsky%bnd_flux_up(1,:,:),dim=2) - fluxlwDOWN_allsky(iCol,:) = sum(flux_allsky%bnd_flux_dn(1,:,:),dim=2) + fluxlwUP_allsky(iCol:iCol,:) = sum(flux_allsky%bnd_flux_up, dim=3) + fluxlwDOWN_allsky(iCol:iCol,:) = sum(flux_allsky%bnd_flux_dn, dim=3) ! Save fluxes for coupling fluxlwUP_radtime(iCol,:) = fluxlwUP_allsky(iCol,:) @@ -541,5 +560,5 @@ subroutine rrtmgp_lw_main_run(doLWrad, doLWclrsky, top_at_1, doGP_lwscat, use_LW 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 index ad0b88c86..ec352c0a8 100644 --- a/physics/rrtmgp_lw_main.meta +++ b/physics/rrtmgp_lw_main.meta @@ -215,20 +215,6 @@ 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 -[i_o3] - standard_name = index_of_ozone_mixing_ratio_in_tracer_concentration_array - long_name = tracer index for ozone mixing ratio - units = index - 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 @@ -347,54 +333,6 @@ 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 @@ -547,6 +485,14 @@ 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 = in [active_gases_array] standard_name = list_of_active_gases_used_by_RRTMGP long_name = list of active gases used by RRTMGP @@ -562,6 +508,13 @@ dimensions = () type = ty_optical_props_1scl 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 [fluxlwUP_radtime] standard_name = RRTMGP_lw_flux_profile_upward_allsky_on_radiation_timestep long_name = RRTMGP upward longwave all-sky flux profile diff --git a/physics/rrtmgp_sw_cloud_optics.F90 b/physics/rrtmgp_sw_cloud_optics.F90 index 24fafbffe..fd648de02 100644 --- a/physics/rrtmgp_sw_cloud_optics.F90 +++ b/physics/rrtmgp_sw_cloud_optics.F90 @@ -3,6 +3,7 @@ module rrtmgp_sw_cloud_optics 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 @@ -66,9 +67,12 @@ module rrtmgp_sw_cloud_optics ! ###################################################################################### ! SUBROUTINE sw_cloud_optics_init ! ###################################################################################### - subroutine rrtmgp_sw_cloud_optics_init(nrghice, mpicomm, mpirank, mpiroot, doG_cldoptics, & - doGP_cldoptics_PADE, doGP_cldoptics_LUT, rrtmgp_root_dir, rrtmgp_sw_file_clouds, & - errmsg, errflg) +!! \section arg_table_rrtmgp_sw_cloud_optics_init +!! \htmlinclude rrtmgp_lw_cloud_optics.html +!! + 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) ! Inputs logical, intent(in) :: & @@ -384,4 +388,183 @@ subroutine rrtmgp_sw_cloud_optics_init(nrghice, mpicomm, mpirank, mpiroot, doG_c end subroutine rrtmgp_sw_cloud_optics_init + ! ######################################################################################### + ! SUBROTUINE rrtmgp_sw_cloud_optics_run() + ! ######################################################################################### +!! \section arg_table_rrtmgp_sw_cloud_optics_run +!! \htmlinclude rrtmgp_sw_cloud_optics.html +!! + 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 + + ! ######################################################################################### + ! SUBROTUINE rrtmgp_sw_cloud_optics_finalize() + ! ######################################################################################### + subroutine rrtmgp_sw_cloud_optics_finalize() + end subroutine rrtmgp_sw_cloud_optics_finalize + end module rrtmgp_sw_cloud_optics diff --git a/physics/rrtmgp_sw_cloud_optics.meta b/physics/rrtmgp_sw_cloud_optics.meta new file mode 100644 index 000000000..064b7cf80 --- /dev/null +++ b/physics/rrtmgp_sw_cloud_optics.meta @@ -0,0 +1,393 @@ +[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 new file mode 100644 index 000000000..c4a5de4c8 --- /dev/null +++ b/physics/rrtmgp_sw_cloud_sampling.F90 @@ -0,0 +1,170 @@ +module rrtmgp_sw_cloud_sampling + use machine, only: kind_phys + 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 + + ! ######################################################################################### + ! SUBROTUINE rrtmgp_sw_cloud_sampling_run() + ! ######################################################################################### +!! \section arg_table_rrtmgp_sw_cloud_sampling_run +!! \htmlinclude rrtmgp_sw_cloud_sampling.html +!! + 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_phys), dimension(sw_gas_props%get_ngpt(),nLev,nday) :: rng3D,rng3D2 + real(kind_phys), dimension(sw_gas_props%get_ngpt()*nLev) :: rng2D + real(kind_phys), 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(rng3D, 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(rng3D, cld_frac(idxday(1:nDay),:), maskMCICA, & + overlap_param = cloud_overlap_param(idxday(1:nDay),1:nLev-1),& + randoms2 = rng3D2) + endif + ! Exponential or exponential-random cloud overlap + if (iovr == iovr_exp .or. iovr == iovr_exprand) then + call sampled_mask(rng3D, 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 + + ! ######################################################################################### + ! SUBROTUINE rrtmgp_sw_cloud_sampling_finalize() + ! ######################################################################################### + subroutine rrtmgp_sw_cloud_sampling_finalize() + end subroutine rrtmgp_sw_cloud_sampling_finalize + +end module rrtmgp_sw_cloud_sampling diff --git a/physics/rrtmgp_sw_cloud_sampling.meta b/physics/rrtmgp_sw_cloud_sampling.meta new file mode 100644 index 000000000..1415108f8 --- /dev/null +++ b/physics/rrtmgp_sw_cloud_sampling.meta @@ -0,0 +1,240 @@ +[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 9193b9134..260f65fe7 100644 --- a/physics/rrtmgp_sw_gas_optics.F90 +++ b/physics/rrtmgp_sw_gas_optics.F90 @@ -4,6 +4,7 @@ module rrtmgp_sw_gas_optics use mo_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp use mo_gas_concentrations, only: ty_gas_concs use radiation_tools, only: check_error_msg + use mo_optical_props, only: ty_optical_props_2str use netcdf #ifdef MPI use mpi @@ -75,8 +76,11 @@ module rrtmgp_sw_gas_optics ! ######################################################################################### ! SUBROUTINE sw_gas_optics_init ! ######################################################################################### - subroutine rrtmgp_sw_gas_optics_init(rrtmgp_root_dir, rrtmgp_sw_file_gas, mpicomm, mpirank, & - mpiroot, active_gases_array, errmsg, errflg) +!! \section arg_table_rrtmgp_sw_gas_optics_init +!! \htmlinclude rrtmgp_sw_gas_optics.html +!! + 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) :: & @@ -477,4 +481,111 @@ subroutine rrtmgp_sw_gas_optics_init(rrtmgp_root_dir, rrtmgp_sw_file_gas, mpicom end subroutine rrtmgp_sw_gas_optics_init + ! ######################################################################################### + ! SUBROUTINE rrtmgp_sw_gas_optics_run + ! ######################################################################################### +!! \section arg_table_rrtmgp_sw_gas_optics_run +!! \htmlinclude rrtmgp_sw_gas_optics.html +!! + 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 + + ! ######################################################################################### + ! SUBROUTINE rrtmgp_sw_gas_optics_finalize + ! ######################################################################################### + subroutine rrtmgp_sw_gas_optics_finalize() + end subroutine rrtmgp_sw_gas_optics_finalize + end module rrtmgp_sw_gas_optics + diff --git a/physics/rrtmgp_sw_gas_optics.meta b/physics/rrtmgp_sw_gas_optics.meta new file mode 100644 index 000000000..1fdbc946b --- /dev/null +++ b/physics/rrtmgp_sw_gas_optics.meta @@ -0,0 +1,201 @@ +[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 index 781af606b..66f4b7553 100644 --- a/physics/rrtmgp_sw_main.F90 +++ b/physics/rrtmgp_sw_main.F90 @@ -62,7 +62,7 @@ subroutine rrtmgp_sw_main_init(rrtmgp_root_dir, rrtmgp_sw_file_gas, mpicomm, mpi call rrtmgp_sw_gas_optics_init(rrtmgp_root_dir, rrtmgp_sw_file_gas, mpicomm, mpirank, & mpiroot, active_gases_array, errmsg, errflg) - ! RRTMGP shortwave cloud-optics initialization + ! RRTMGP shortwave cloud-optics initialization call rrtmgp_sw_cloud_optics_init(nrghice, mpicomm, mpirank, mpiroot, doG_cldoptics, & doGP_cldoptics_PADE, doGP_cldoptics_LUT, rrtmgp_root_dir, rrtmgp_sw_file_clouds, & errmsg, errflg) @@ -76,15 +76,16 @@ end subroutine rrtmgp_sw_main_init !! \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, i_o3, idx, icseed_sw, iovr, iovr_convcld, iovr_max, & + nCol, nDay, nLay, 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, sw_optical_props_aerosol, scmpsw, fluxswUP_allsky, & - fluxswDOWN_allsky, fluxswUP_clrsky, fluxswDOWN_clrsky, cldtausw, errmsg, errflg) + active_gases_array, sw_optical_props_aerosol, gas_concentrations, solcon, scmpsw, & + fluxswUP_allsky, fluxswDOWN_allsky, fluxswUP_clrsky, fluxswDOWN_clrsky, cldtausw, & + errmsg, errflg) ! Inputs logical, intent(in) :: & @@ -97,8 +98,6 @@ subroutine rrtmgp_sw_main_run(doSWrad, doSWclrsky, top_at_1, doGP_sgs_cnv, doGP_ nCol, & ! Number of horizontal points nDay, & ! Number of daytime points nLay, & ! Number of vertical grid points. - nGases, & ! Number of active gases in RRTMGP - i_o3, & ! iovr, & ! Choice of cloud-overlap method iovr_convcld, & ! Choice of convective cloud-overlap iovr_max, & ! Flag for maximum cloud overlap method @@ -152,6 +151,10 @@ subroutine rrtmgp_sw_main_run(doSWrad, doSWclrsky, top_at_1, doGP_sgs_cnv, doGP_ active_gases_array ! List of active gases from namelist as array type(ty_optical_props_2str),intent(in) :: & sw_optical_props_aerosol ! RRTMGP DDT: Shortwave aerosol optical properties (tau,ssa,g) + type(ty_gas_concs), intent(in) :: & + gas_concentrations ! RRTMGP DDT: gas concentrations + real(kind_phys), intent(in) :: & + solcon ! Solar constant ! Outputs character(len=*), intent(out) :: & @@ -176,7 +179,7 @@ subroutine rrtmgp_sw_main_run(doSWrad, doSWclrsky, top_at_1, doGP_sgs_cnv, doGP_ ! Local variables type(ty_gas_concs) :: & - gas_concentrations ! RRTMGP DDT: trace gas concentrations (vmr) + gas_concs ! RRTMGP DDT: trace gas concentrations (vmr) type(ty_optical_props_2str) :: & sw_optical_props_clrsky, & ! RRTMGP DDT: Shortwave clear-sky radiative properties sw_optical_props_aerosol_local, & ! RRTMGP DDT: Shortave aerosol radiative properties @@ -204,351 +207,365 @@ subroutine rrtmgp_sw_main_run(doSWrad, doSWclrsky, top_at_1, doGP_sgs_cnv, doGP_ real(kind_phys), dimension(2,sw_gas_props%get_nband()) :: bandlimits real(kind_phys), dimension(2), parameter :: nIR_uvvis_bnd = (/12850,16000/) real(kind_phys), dimension(1,sw_gas_props%get_ngpt()) :: toa_src_sw + real(kind_phys), dimension(nCol, nLay, gas_concentrations%get_num_gases()) :: vmrTemp + ! Initialize CCPP error handling variables errmsg = '' errflg = 0 if (.not. doSWrad) return - 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 ) - if (nDay .le. 0) return - - ! ###################################################################################### - ! - ! Allocate/initialize RRTMGP DDT's - ! - ! ###################################################################################### - ! - ! ty_gas_concs - ! - gas_concentrations%ncol = 1 - gas_concentrations%nlay = nLay - allocate(gas_concentrations%gas_name(nGases)) - allocate(gas_concentrations%concs(nGases)) - do iGas=1,nGases - allocate(gas_concentrations%concs(iGas)%conc(1, nLay)) - enddo - gas_concentrations%gas_name(:) = active_gases_array(:) - ! - ! ty_optical_props - ! - call check_error_msg('rrtmgp_sw_main_gas_optics_init',& - sw_optical_props_clrsky%alloc_2str(1, nLay, sw_gas_props)) - call check_error_msg('rrtmgp_sw_main_cloud_optics_init',& - sw_optical_props_cloudsByBand%alloc_2str(1, nLay, sw_gas_props%get_band_lims_wavenumber())) - call check_error_msg('rrtmgp_sw_main_precip_optics_init',& - sw_optical_props_precipByBand%alloc_2str(1, nLay, sw_gas_props%get_band_lims_wavenumber())) - call check_error_msg('rrtmgp_sw_mian_cloud_sampling_init', & - sw_optical_props_clouds%alloc_2str(1, nLay, sw_gas_props)) - call check_error_msg('rrtmgp_sw_main_aerosol_optics_init',& - sw_optical_props_aerosol_local%alloc_2str(1, 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(1, 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(1, nLay, sw_gas_props%get_band_lims_wavenumber())) - endif - ! - ! ty_fluxes_byband - ! - 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 - - ! Loop over all (daylit)columns... - do iCol=1,nDay - ix = idx(iCol) - - ! Initialize/reset - sw_optical_props_clouds%tau = 0._kind_phys - sw_optical_props_clouds%ssa = 1._kind_phys - sw_optical_props_clouds%g = 0._kind_phys - sw_optical_props_clrsky%tau = 0._kind_phys - sw_optical_props_clrsky%ssa = 1._kind_phys - sw_optical_props_clrsky%g = 0._kind_phys - sw_optical_props_cloudsByBand%tau = 0._kind_phys - sw_optical_props_cloudsByBand%ssa = 1._kind_phys - sw_optical_props_cloudsByBand%g = 0._kind_phys - sw_optical_props_precipByBand%tau = 0._kind_phys - sw_optical_props_precipByBand%ssa = 1._kind_phys - sw_optical_props_precipByBand%g = 0._kind_phys - sw_optical_props_aerosol_local%tau = 0._kind_phys - sw_optical_props_aerosol_local%ssa = 1._kind_phys - sw_optical_props_aerosol_local%g = 0._kind_phys - if (doGP_sgs_cnv) then - sw_optical_props_cnvcloudsByBand%tau = 0._kind_phys - sw_optical_props_cnvcloudsByBand%ssa = 1._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 = 1._kind_phys - sw_optical_props_pblcloudsByBand%g = 0._kind_phys - endif - ! ################################################################################### - ! - ! Set gas-concentrations + if (nDay .gt. 0) then + ! ###################################################################################### ! - ! ################################################################################### - gas_concentrations%concs(istr_o2)%conc(1,:) = vmr_o2(ix,:) - gas_concentrations%concs(istr_co2)%conc(1,:) = vmr_co2(ix,:) - gas_concentrations%concs(istr_ch4)%conc(1,:) = vmr_ch4(ix,:) - gas_concentrations%concs(istr_n2o)%conc(1,:) = vmr_n2o(ix,:) - gas_concentrations%concs(istr_h2o)%conc(1,:) = vmr_h2o(ix,:) - gas_concentrations%concs(istr_o3)%conc(1,:) = vmr_o3(ix,:) - - ! ################################################################################### + ! Allocate/initialize RRTMGP DDT's ! - ! 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. - ! - ! ################################################################################### + ! ###################################################################################### 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,1) = sfc_alb_nir_dir(ix) - sfc_alb_dif(iBand,1) = sfc_alb_nir_dif(ix) - endif - if (bandlimits(1,iBand) .eq. nIR_uvvis_bnd(1)) then - sfc_alb_dir(iBand,1) = 0.5_kind_phys*(sfc_alb_nir_dir(ix) + sfc_alb_uvvis_dir(ix)) - sfc_alb_dif(iBand,1) = 0.5_kind_phys*(sfc_alb_nir_dif(ix) + sfc_alb_uvvis_dif(ix)) - ibd = iBand - endif - if (bandlimits(1,iBand) .ge. nIR_uvvis_bnd(2)) then - sfc_alb_dir(iBand,1) = sfc_alb_uvvis_dir(ix) - sfc_alb_dif(iBand,1) = sfc_alb_uvvis_dif(ix) - endif - enddo - - ! ################################################################################### ! - ! Gas-optics + ! ty_gas_concs ! - ! ################################################################################### - call check_error_msg('rrtmgp_sw_main_gas_optics',sw_gas_props%gas_optics(& - p_lay(ix:ix,:), & ! IN - Pressure @ layer-centers (Pa) - p_lev(ix:ix,:), & ! IN - Pressure @ layer-interfaces (Pa) - t_lay(ix:ix,:), & ! IN - Temperature @ layer-centers (K) - gas_concentrations, & ! 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)) ! OUT - TOA incident shortwave radiation (spectral) - - ! ################################################################################### + gas_concs%ncol = 1 + gas_concs%nlay = nLay + allocate(gas_concs%gas_name(gas_concentrations%get_num_gases())) + allocate(gas_concs%concs(gas_concentrations%get_num_gases())) + do iGas=1,gas_concentrations%get_num_gases() + allocate(gas_concs%concs(iGas)%conc(1, nLay)) + enddo + gas_concs%gas_name(:) = active_gases_array(:) + do iGas=1,gas_concentrations%get_num_gases() + call check_error_msg('rrtmgp_sw_main_get_vmr',& + gas_concentrations%get_vmr(trim(gas_concentrations%gas_name(iGas)),vmrTemp(:,:,iGas))) + enddo ! - ! Cloud-optics + ! ty_optical_props ! - ! ################################################################################### - call check_error_msg('rrtmgp_sw_main_cloud_optics',sw_cloud_props%cloud_optics(& - cld_lwp(ix:ix,:), & ! IN - Cloud liquid water path - cld_iwp(ix:ix,:), & ! IN - Cloud ice water path - cld_reliq(ix:ix,:), & ! IN - Cloud liquid effective radius - cld_reice(ix:ix,:), & ! IN - Cloud ice effective radius - sw_optical_props_cloudsByBand)) ! OUT - RRTMGP DDT: Shortwave optical properties, - ! in each band (tau,ssa,g) - cldtausw(ix,:) = sw_optical_props_cloudsByBand%tau(1,:,11) - - ! Convective cloud-optics? + call check_error_msg('rrtmgp_sw_main_gas_optics_init',& + sw_optical_props_clrsky%alloc_2str(1, nLay, sw_gas_props)) + call check_error_msg('rrtmgp_sw_main_cloud_optics_init',& + sw_optical_props_cloudsByBand%alloc_2str(1, nLay, sw_gas_props%get_band_lims_wavenumber())) + call check_error_msg('rrtmgp_sw_main_precip_optics_init',& + sw_optical_props_precipByBand%alloc_2str(1, nLay, sw_gas_props%get_band_lims_wavenumber())) + call check_error_msg('rrtmgp_sw_mian_cloud_sampling_init', & + sw_optical_props_clouds%alloc_2str(1, nLay, sw_gas_props)) + call check_error_msg('rrtmgp_sw_main_aerosol_optics_init',& + sw_optical_props_aerosol_local%alloc_2str(1, nLay, sw_gas_props%get_band_lims_wavenumber())) if (doGP_sgs_cnv) then - call check_error_msg('rrtmgp_sw_main_cnv_cloud_optics',sw_cloud_props%cloud_optics(& - cld_cnv_lwp(ix:ix,:), & ! IN - Convective cloud liquid water path (g/m2) - cld_cnv_iwp(ix:ix,:), & ! IN - Convective cloud ice water path (g/m2) - cld_cnv_reliq(ix:ix,:), & ! IN - Convective cloud liquid effective radius (microns) - cld_cnv_reice(ix:ix,:), & ! IN - Convective cloud ice effective radius (microns) - sw_optical_props_cnvcloudsByBand)) ! OUT - RRTMGP DDT containing convective cloud radiative properties - ! in each band - !call check_error_msg('rrtmgp_sw_main_increment_cnvclouds_to_clouds',& - ! sw_optical_props_cnvcloudsByBand%increment(sw_optical_props_cloudsByBand)) + call check_error_msg('rrtmgp_sw_main_cnv_cloud_optics_init',& + sw_optical_props_cnvcloudsByBand%alloc_2str(1, nLay, sw_gas_props%get_band_lims_wavenumber())) endif - - ! MYNN PBL cloud-optics? if (doGP_sgs_pbl) then - call check_error_msg('rrtmgp_sw_main_pbl_cloud_optics',sw_cloud_props%cloud_optics(& - cld_pbl_lwp(ix:ix,:), & ! IN - MYNN-EDMF PBL cloud liquid water path (g/m2) - cld_pbl_iwp(ix:ix,:), & ! IN - MYNN-EDMF PBL cloud ice water path (g/m2) - cld_pbl_reliq(ix:ix,:), & ! IN - MYNN-EDMF PBL cloud liquid effective radius (microns) - cld_pbl_reice(ix:ix,:), & ! IN - MYNN-EDMF PBL cloud ice effective radius (microns) - sw_optical_props_pblcloudsByBand)) ! OUT - RRTMGP DDT containing MYNN-EDMF PBL cloud radiative properties - ! in each band - !call check_error_msg('rrtmgp_sw_main_increment_pblclouds_to_clouds',& - ! sw_optical_props_pblcloudsByBand%increment(sw_optical_props_cloudsByBand)) + call check_error_msg('rrtmgp_sw_main_pbl_cloud_optics_init',& + sw_optical_props_pblcloudsByBand%alloc_2str(1, nLay, sw_gas_props%get_band_lims_wavenumber())) endif - - ! Cloud precipitation optics: rain and snow(+groupel) - do iLay=1,nLay - if (cld_frac(ix,iLay) .gt. 1.e-12_kind_phys) then - ! Rain/Snow optical depth (No band dependence) - tau_rain = cld_rwp(ix,iLay)*a0r - if (cld_swp(ix,iLay) .gt. 0. .and. cld_resnow(ix,iLay) .gt. 10._kind_phys) then - tau_snow = cld_swp(ix,iLay)*1.09087*(a0s + a1s/(1.0315*cld_resnow(ix,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(ix,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(1,iLay,iBand) = (1._kind_phys - za2) * tau_prec - sw_optical_props_precipByBand%ssa(1,iLay,iBand) = (ssaw - za2) / (1._kind_phys - za2) - sw_optical_props_precipByBand%g(1,iLay,iBand) = asyw/(1+asyw) - enddo - endif - enddo - - ! ################################################################################### ! - ! Cloud-sampling + ! ty_fluxes_byband ! - ! ################################################################################### - ! Change random number seed value for each radiation invocation (isubc_sw =1 or 2). - if(isubc_sw == 1) then ! advance prescribed permutation seed - ipseed_sw = sw_gas_props%get_ngpt() + iCol - elseif (isubc_sw == 2) then ! use input array of permutaion seeds - ipseed_sw = icseed_sw(ix) - endif - ! Call RNG - call random_setseed(ipseed_sw,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,1) = rng1D + 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 + + ! Loop over all (daylit) columns... + do iCol=1,nDay + ix = idx(iCol) + + ! Initialize/reset + 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 + 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_clrsky%tau = 0._kind_phys + sw_optical_props_clrsky%ssa = 0._kind_phys + sw_optical_props_clrsky%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 + sw_optical_props_aerosol_local%tau = 0._kind_phys + sw_optical_props_aerosol_local%ssa = 0._kind_phys + sw_optical_props_aerosol_local%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 + + ! ################################################################################### + ! + ! Set gas-concentrations + ! + ! ################################################################################### + ! Subset the gas concentrations. + do iGas=1,gas_concentrations%get_num_gases() + call check_error_msg('rrtmgp_sw_gas_optics_run_set_vmr',& + gas_concs%set_vmr(trim(gas_concentrations%gas_name(iGas)),vmrTemp(ix,:,iGas))) enddo - else + + ! ################################################################################### + ! + ! 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 iBand=1,sw_gas_props%get_nband() + if (bandlimits(1,iBand) .lt. nIR_uvvis_bnd(1)) then + sfc_alb_dir(iBand,1) = sfc_alb_nir_dir(ix) + sfc_alb_dif(iBand,1) = sfc_alb_nir_dif(ix) + endif + if (bandlimits(1,iBand) .eq. nIR_uvvis_bnd(1)) then + sfc_alb_dir(iBand,1) = 0.5_kind_phys*(sfc_alb_nir_dir(ix) + sfc_alb_uvvis_dir(ix)) + sfc_alb_dif(iBand,1) = 0.5_kind_phys*(sfc_alb_nir_dif(ix) + sfc_alb_uvvis_dif(ix)) + ibd = iBand + endif + if (bandlimits(1,iBand) .ge. nIR_uvvis_bnd(2)) then + sfc_alb_dir(iBand,1) = sfc_alb_uvvis_dir(ix) + sfc_alb_dif(iBand,1) = sfc_alb_uvvis_dif(ix) + endif + enddo + + ! ################################################################################### + ! + ! Gas-optics + ! + ! ################################################################################### + call check_error_msg('rrtmgp_sw_main_gas_optics',sw_gas_props%gas_optics(& + p_lay(ix:ix,:), & ! IN - Pressure @ layer-centers (Pa) + p_lev(ix:ix,:), & ! IN - Pressure @ layer-interfaces (Pa) + t_lay(ix:ix,:), & ! IN - Temperature @ layer-centers (K) + gas_concs, & ! 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)) ! OUT - TOA incident shortwave radiation (spectral) + + ! Scale incident flux + toa_src_sw(1,:) = toa_src_sw(1,:)*solcon / sum(toa_src_sw(1,:)) + ! ################################################################################### + ! + ! Cloud-optics + ! + ! ################################################################################### + call check_error_msg('rrtmgp_sw_main_cloud_optics',sw_cloud_props%cloud_optics(& + cld_lwp(ix:ix,:), & ! IN - Cloud liquid water path + cld_iwp(ix:ix,:), & ! IN - Cloud ice water path + cld_reliq(ix:ix,:), & ! IN - Cloud liquid effective radius + cld_reice(ix:ix,:), & ! IN - Cloud ice effective radius + sw_optical_props_cloudsByBand)) ! OUT - RRTMGP DDT: Shortwave optical properties, + ! in each band (tau,ssa,g) + cldtausw(ix,:) = sw_optical_props_cloudsByBand%tau(1,:,11) + + ! Convective cloud-optics? + if (doGP_sgs_cnv) then + call check_error_msg('rrtmgp_sw_main_cnv_cloud_optics',sw_cloud_props%cloud_optics(& + cld_cnv_lwp(ix:ix,:), & ! IN - Convective cloud liquid water path (g/m2) + cld_cnv_iwp(ix:ix,:), & ! IN - Convective cloud ice water path (g/m2) + cld_cnv_reliq(ix:ix,:), & ! IN - Convective cloud liquid effective radius (microns) + cld_cnv_reice(ix:ix,:), & ! IN - Convective cloud ice effective radius (microns) + sw_optical_props_cnvcloudsByBand)) ! OUT - RRTMGP DDT containing convective cloud radiative properties + ! in each band + !call check_error_msg('rrtmgp_sw_main_increment_cnvclouds_to_clouds',& + ! sw_optical_props_cnvcloudsByBand%increment(sw_optical_props_cloudsByBand)) + endif + + ! MYNN PBL cloud-optics? + if (doGP_sgs_pbl) then + call check_error_msg('rrtmgp_sw_main_pbl_cloud_optics',sw_cloud_props%cloud_optics(& + cld_pbl_lwp(ix:ix,:), & ! IN - MYNN-EDMF PBL cloud liquid water path (g/m2) + cld_pbl_iwp(ix:ix,:), & ! IN - MYNN-EDMF PBL cloud ice water path (g/m2) + cld_pbl_reliq(ix:ix,:), & ! IN - MYNN-EDMF PBL cloud liquid effective radius (microns) + cld_pbl_reice(ix:ix,:), & ! IN - MYNN-EDMF PBL cloud ice effective radius (microns) + sw_optical_props_pblcloudsByBand)) ! OUT - RRTMGP DDT containing MYNN-EDMF PBL cloud radiative properties + ! in each band + !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 iLay=1,nLay - call random_number(rng1D,rng_stat) - rng3D(:,iLay,1) = rng1D + if (cld_frac(ix,iLay) .gt. 1.e-12_kind_phys) then + ! Rain/Snow optical depth (No band dependence) + tau_rain = cld_rwp(ix,iLay)*a0r + if (cld_swp(ix,iLay) .gt. 0. .and. cld_resnow(ix,iLay) .gt. 10._kind_phys) then + tau_snow = cld_swp(ix,iLay)*1.09087*(a0s + a1s/(1.0315*cld_resnow(ix,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(ix,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(1,iLay,iBand) = (1._kind_phys - za2) * tau_prec + sw_optical_props_precipByBand%ssa(1,iLay,iBand) = (ssaw - za2) / (1._kind_phys - za2) + sw_optical_props_precipByBand%g(1,iLay,iBand) = asyw/(1+asyw) + enddo + endif enddo - endif - ! Cloud-overlap. - ! Maximum-random, random or maximum. - if (iovr == iovr_maxrand .or. iovr == iovr_rand .or. iovr == iovr_max) then - call sampled_mask(rng3D, cld_frac(ix:ix,:), maskMCICA) - endif - ! Exponential decorrelation length overlap - if (iovr == iovr_dcorr) then - ! Generate second RNG + + ! ################################################################################### + ! + ! 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 + ipseed_sw = sw_gas_props%get_ngpt() + iCol + elseif (isubc_sw == 2) then ! use input array of permutaion seeds + ipseed_sw = icseed_sw(ix) + endif + ! Call RNG call random_setseed(ipseed_sw,rng_stat) - call random_number(rng2D,rng_stat) - rng3D2(:,:,1) = reshape(source = rng2D,shape=[sw_gas_props%get_ngpt(),nLay]) + ! Use same rng for each layer + if (iovr == iovr_max) then + call random_number(rng1D,rng_stat) + do iLay=1,nLay + rng3D(:,iLay,1) = rng1D + enddo + else + do iLay=1,nLay + call random_number(rng1D,rng_stat) + rng3D(:,iLay,1) = rng1D + enddo + endif + ! Cloud-overlap. + ! Maximum-random, random or maximum. + if (iovr == iovr_maxrand .or. iovr == iovr_rand .or. iovr == iovr_max) then + call sampled_mask(rng3D, cld_frac(ix:ix,:), maskMCICA) + endif + ! Exponential decorrelation length overlap + if (iovr == iovr_dcorr) then + ! Generate second RNG + call random_setseed(ipseed_sw,rng_stat) + call random_number(rng2D,rng_stat) + rng3D2(:,:,1) = reshape(source = rng2D,shape=[sw_gas_props%get_ngpt(),nLay]) + ! + call sampled_mask(rng3D, cld_frac(ix:ix,:), maskMCICA, & + overlap_param = cloud_overlap_param(ix:ix,1:nLay-1), randoms2 = rng3D2) + endif + ! Exponential or Exponential-random + if (iovr == iovr_exp .or. iovr == iovr_exprand) then + call sampled_mask(rng3D, cld_frac(ix:ix,:), maskMCICA, & + overlap_param = cloud_overlap_param(ix:ix,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)) + + ! ################################################################################### ! - call sampled_mask(rng3D, cld_frac(ix:ix,:), maskMCICA, & - overlap_param = cloud_overlap_param(ix:ix,1:nLay-1), randoms2 = rng3D2) - endif - ! Exponential or Exponential-random - if (iovr == iovr_exp .or. iovr == iovr_exprand) then - call sampled_mask(rng3D, cld_frac(ix:ix,:), maskMCICA, & - overlap_param = cloud_overlap_param(ix:ix,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)) - - ! ################################################################################### - ! - ! Compute clear-sky fluxes (gaseous+aerosol) (optional) - ! - ! ################################################################################### - ! Add aerosol optics to gas optics - sw_optical_props_aerosol_local%tau = sw_optical_props_aerosol%tau(iCol:iCol,:,:) - sw_optical_props_aerosol_local%ssa = sw_optical_props_aerosol%ssa(iCol:iCol,:,:) - sw_optical_props_aerosol_local%g = sw_optical_props_aerosol%g(iCol:iCol,:,:) - call check_error_msg('rrtmgp_sw_main_increment_aerosol_to_clrsky',& - sw_optical_props_aerosol_local%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_main_rte_sw_clrsky',rte_sw( & - sw_optical_props_clrsky, & ! IN - optical-properties + ! Compute clear-sky fluxes (gaseous+aerosol) (optional) + ! + ! ################################################################################### + ! Add aerosol optics to gas optics + sw_optical_props_aerosol_local%tau = sw_optical_props_aerosol%tau(iCol:iCol,:,:) + sw_optical_props_aerosol_local%ssa = sw_optical_props_aerosol%ssa(iCol:iCol,:,:) + sw_optical_props_aerosol_local%g = sw_optical_props_aerosol%g(iCol:iCol,:,:) + call check_error_msg('rrtmgp_sw_main_increment_aerosol_to_clrsky',& + sw_optical_props_aerosol_local%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_main_rte_sw_clrsky',rte_sw( & + sw_optical_props_clrsky, & ! IN - optical-properties + top_at_1, & ! IN - veritcal ordering flag + coszen(ix:ix), & ! 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(ix,:) = sum(flux_clrsky%bnd_flux_up(1,:,:),dim=2) + fluxswDOWN_clrsky(ix,:) = sum(flux_clrsky%bnd_flux_dn(1,:,:),dim=2) + else + fluxswUP_clrsky(ix,:) = 0.0 + fluxswDOWN_clrsky(ix,:) = 0.0 + endif + + ! ################################################################################### + ! + ! All-sky fluxes (clear-sky + clouds + precipitation) + ! + ! ################################################################################### + + ! Include convective cloud? + if (doGP_sgs_cnv) then + call check_error_msg('rrtmgp_sw_main_increment_cnvclouds_to_clrsky',& + sw_optical_props_cnvcloudsByBand%increment(sw_optical_props_clouds)) + endif + + ! Include MYNN-EDMF PBL clouds? + if (doGP_sgs_pbl) then + call check_error_msg('rrtmgp_sw_main_increment_pblclouds_to_clrsky',& + sw_optical_props_pblcloudsByBand%increment(sw_optical_props_clouds)) + endif + + ! Add in precipitation + call check_error_msg('rrtmgp_sw_main_increment_precip_to_clrsky',& + sw_optical_props_precipByBand%increment(sw_optical_props_clouds)) + + ! Delta-scale optical properties + call check_error_msg('rrtmgp_sw_main_delta_scale',sw_optical_props_clrsky%delta_scale()) + call check_error_msg('rrtmgp_sw_main_rte_sw_allsky',rte_sw( & + sw_optical_props_clouds, & ! IN - optical-properties top_at_1, & ! IN - veritcal ordering flag coszen(ix:ix), & ! 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) + flux_allsky)) ! OUT - Fluxes, clear-sky, 3D (1,nLay,nBand) + ! Store fluxes - fluxswUP_clrsky(ix,:) = sum(flux_clrsky%bnd_flux_up(1,:,:),dim=2) - fluxswDOWN_clrsky(ix,:) = sum(flux_clrsky%bnd_flux_dn(1,:,:),dim=2) - else - fluxswUP_clrsky(ix,:) = 0.0 - fluxswDOWN_clrsky(ix,:) = 0.0 - endif - - ! ################################################################################### - ! - ! All-sky fluxes (clear-sky + clouds + precipitation) - ! - ! ################################################################################### - - ! Include convective cloud? - if (doGP_sgs_cnv) then - call check_error_msg('rrtmgp_sw_main_increment_cnvclouds_to_clrsky',& - sw_optical_props_cnvcloudsByBand%increment(sw_optical_props_clouds)) - endif - - ! Include MYNN-EDMF PBL clouds? - if (doGP_sgs_pbl) then - call check_error_msg('rrtmgp_sw_main_increment_pblclouds_to_clrsky',& - sw_optical_props_pblcloudsByBand%increment(sw_optical_props_clouds)) - endif - - ! Add in precipitation - call check_error_msg('rrtmgp_sw_main_increment_precip_to_clrsky',& - sw_optical_props_precipByBand%increment(sw_optical_props_clouds)) - - ! Delta-scale optical properties - call check_error_msg('rrtmgp_sw_main_delta_scale',sw_optical_props_clrsky%delta_scale()) - call check_error_msg('rrtmgp_sw_main_rte_sw_allsky',rte_sw( & - sw_optical_props_clouds, & ! IN - optical-properties - top_at_1, & ! IN - veritcal ordering flag - coszen(ix:ix), & ! 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(ix,:) = sum(flux_allsky%bnd_flux_up(1,:,:),dim=2) - fluxswDOWN_allsky(ix,:) = sum(flux_allsky%bnd_flux_dn(1,:,:),dim=2) - ! Near IR - scmpsw(ix)%nirbm = sum(flux_allsky%bnd_flux_dn_dir(1,iSFC,1:ibd-1)) + & - flux_allsky%bnd_flux_dn_dir(1,iSFC,ibd)/2. - scmpsw(ix)%nirdf = (sum(flux_allsky%bnd_flux_dn(1,iSFC,1:ibd-1)) + & - flux_allsky%bnd_flux_dn(1,iSFC,ibd)/2.) - & - (sum(flux_allsky%bnd_flux_dn_dir(1,iSFC,1:ibd-1)) + & - flux_allsky%bnd_flux_dn_dir(1,iSFC,ibd)/2.) - ! UV-VIS - scmpsw(ix)%visbm = sum(flux_allsky%bnd_flux_dn_dir(1,iSFC,ibd+1:sw_gas_props%get_nband())) + & - flux_allsky%bnd_flux_dn_dir(1,iSFC,ibd)/2. - scmpsw(ix)%visdf = (sum(flux_allsky%bnd_flux_dn(1,iSFC,ibd+1:sw_gas_props%get_nband())) + & - flux_allsky%bnd_flux_dn(1,iSFC,ibd)/2. ) - & - (sum(flux_allsky%bnd_flux_dn_dir(1,iSFC,ibd+1:sw_gas_props%get_nband())) + & - flux_allsky%bnd_flux_dn_dir(1,iSFC,ibd)/2.) - enddo + fluxswUP_allsky(ix,:) = sum(flux_allsky%bnd_flux_up(1,:,:),dim=2) + fluxswDOWN_allsky(ix,:) = sum(flux_allsky%bnd_flux_dn(1,:,:),dim=2) + ! Near IR + scmpsw(ix)%nirbm = sum(flux_allsky%bnd_flux_dn_dir(1,iSFC,1:ibd-1)) + & + flux_allsky%bnd_flux_dn_dir(1,iSFC,ibd)/2. + scmpsw(ix)%nirdf = (sum(flux_allsky%bnd_flux_dn(1,iSFC,1:ibd-1)) + & + flux_allsky%bnd_flux_dn(1,iSFC,ibd)/2.) - & + (sum(flux_allsky%bnd_flux_dn_dir(1,iSFC,1:ibd-1)) + & + flux_allsky%bnd_flux_dn_dir(1,iSFC,ibd)/2.) + ! UV-VIS + scmpsw(ix)%visbm = sum(flux_allsky%bnd_flux_dn_dir(1,iSFC,ibd+1:sw_gas_props%get_nband())) + & + flux_allsky%bnd_flux_dn_dir(1,iSFC,ibd)/2. + scmpsw(ix)%visdf = (sum(flux_allsky%bnd_flux_dn(1,iSFC,ibd+1:sw_gas_props%get_nband())) + & + flux_allsky%bnd_flux_dn(1,iSFC,ibd)/2. ) - & + (sum(flux_allsky%bnd_flux_dn_dir(1,iSFC,ibd+1:sw_gas_props%get_nband())) + & + flux_allsky%bnd_flux_dn_dir(1,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_main_run end module rrtmgp_sw_main diff --git a/physics/rrtmgp_sw_main.meta b/physics/rrtmgp_sw_main.meta index 1be643701..634516ea1 100644 --- a/physics/rrtmgp_sw_main.meta +++ b/physics/rrtmgp_sw_main.meta @@ -191,20 +191,6 @@ type = real kind = kind_phys 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 -[i_o3] - standard_name = index_of_ozone_mixing_ratio_in_tracer_concentration_array - long_name = tracer index for ozone mixing ratio - units = index - dimensions = () - type = integer - intent = in [isubc_sw] standard_name = flag_for_sw_clouds_grid_approximation long_name = flag for sw clouds sub-grid approximation @@ -554,6 +540,21 @@ dimensions = () type = ty_optical_props_2str 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 +[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 diff --git a/physics/rrtmgp_sw_rte.F90 b/physics/rrtmgp_sw_rte.F90 new file mode 100644 index 000000000..e1879bd7a --- /dev/null +++ b/physics/rrtmgp_sw_rte.F90 @@ -0,0 +1,221 @@ +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_init, rrtmgp_sw_rte_run, rrtmgp_sw_rte_finalize + +contains + + ! ######################################################################################### + ! SUBROUTINE rrtmgp_sw_rte_init + ! ######################################################################################### + subroutine rrtmgp_sw_rte_init() + end subroutine rrtmgp_sw_rte_init + + ! ######################################################################################### + ! SUBROUTINE rrtmgp_sw_rte_run + ! ######################################################################################### +!! \section arg_table_rrtmgp_sw_rte_run +!! \htmlinclude rrtmgp_sw_rte.html +!! + 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 + + ! ######################################################################################### + ! SUBROUTINE rrtmgp_sw_rte_finalize + ! ######################################################################################### + subroutine rrtmgp_sw_rte_finalize() + end subroutine rrtmgp_sw_rte_finalize + +end module rrtmgp_sw_rte diff --git a/physics/rrtmgp_sw_rte.meta b/physics/rrtmgp_sw_rte.meta new file mode 100644 index 000000000..9ab24c8b3 --- /dev/null +++ b/physics/rrtmgp_sw_rte.meta @@ -0,0 +1,240 @@ +[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_RRTMGP + long_name = flag for vertical ordering 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 +[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 From 79eb46965dd50b0a8b1c544862e1cc6cc67d0380 Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Wed, 24 Aug 2022 20:08:42 +0000 Subject: [PATCH 06/19] Changes for refactor --- physics/GFS_rrtmgp_cloud_mp.F90 | 176 ++++--- physics/GFS_rrtmgp_pre.F90 | 71 ++- physics/GFS_rrtmgp_pre.meta | 82 ++- physics/GFS_rrtmgp_setup.F90 | 6 +- physics/GFS_rrtmgp_setup.meta | 2 +- physics/rrtmgp_lw_main.F90 | 442 ++++++++-------- physics/rrtmgp_lw_main.meta | 77 ++- physics/rrtmgp_sw_cloud_optics.F90 | 44 +- physics/rrtmgp_sw_cloud_optics.meta | 393 --------------- physics/rrtmgp_sw_cloud_sampling.F90 | 174 ------- physics/rrtmgp_sw_cloud_sampling.meta | 240 --------- physics/rrtmgp_sw_gas_optics.meta | 201 -------- physics/rrtmgp_sw_main.F90 | 695 ++++++++++++++------------ physics/rrtmgp_sw_main.meta | 21 +- physics/rrtmgp_sw_rte.F90 | 219 -------- physics/rrtmgp_sw_rte.meta | 240 --------- 16 files changed, 898 insertions(+), 2185 deletions(-) delete mode 100644 physics/rrtmgp_sw_cloud_optics.meta delete mode 100644 physics/rrtmgp_sw_cloud_sampling.F90 delete mode 100644 physics/rrtmgp_sw_cloud_sampling.meta delete mode 100644 physics/rrtmgp_sw_gas_optics.meta delete mode 100644 physics/rrtmgp_sw_rte.F90 delete mode 100644 physics/rrtmgp_sw_rte.meta diff --git a/physics/GFS_rrtmgp_cloud_mp.F90 b/physics/GFS_rrtmgp_cloud_mp.F90 index ca9457b4c..966c9f2e9 100644 --- a/physics/GFS_rrtmgp_cloud_mp.F90 +++ b/physics/GFS_rrtmgp_cloud_mp.F90 @@ -1,10 +1,5 @@ -!> \file GFS_rrtmgp_cloud_mp.F90 -!! -!> \defgroup GFS_rrtmgp_cloud_mp GFS_rrtmgp_cloud_mp.F90 -!! -!! \brief This module contains the interface for ALL cloud microphysics assumptions and -!! the RRTMGP radiation scheme. Specific details below in subroutines. -!! +! ######################################################################################## +! ######################################################################################## module GFS_rrtmgp_cloud_mp use machine, only: kind_phys use radiation_tools, only: check_error_msg @@ -27,21 +22,15 @@ 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 -!>\defgroup gfs_rrtmgp_cloud_mp_mod GFS RRTMGP Cloud MP Module !! \section arg_table_GFS_rrtmgp_cloud_mp_run !! \htmlinclude GFS_rrtmgp_cloud_mp_run_html !! -!> \ingroup GFS_rrtmgp_cloud_mp -!! -!! Here the cloud-radiative properties (optical-path, particle-size and sometimes cloud- -!! fraction) are computed for cloud producing physics schemes (e.g GFDL-MP, Thompson-MP, -!! MYNN-EDMF-pbl, GF-convective, and SAMF-convective clouds). -!! -!! \section GFS_rrtmgp_cloud_mp_run + ! ###################################################################################### + ! ###################################################################################### 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, & @@ -296,22 +285,22 @@ subroutine GFS_rrtmgp_cloud_mp_run(nCol, nLev, nTracers, ncnd, i_cldliq, i_cldic end subroutine GFS_rrtmgp_cloud_mp_run -!> \ingroup GFS_rrtmgp_cloud_mp -!! Compute cloud radiative properties for Grell-Freitas convective cloud scheme. -!! (Adopted from module_SGSCloud_RadPre) -!! -!! - The total convective cloud condensate is partitoned by phase, using temperature, into -!! liquid/ice convective cloud mixing-ratios. Compute convective cloud LWP and IWP's. -!! -!! - The liquid and ice cloud effective particle sizes are assigned reference values*. -!! *TODO* Find references, include DOIs, parameterize magic numbers, etc... -!! -!! - The convective cloud-fraction is computed using Xu-Randall (1996). -!! (DJS asks: Does the GF scheme produce a cloud-fraction? If so, maybe use instead of -!! Xu-Randall? Xu-Randall is consistent with the Thompson MP scheme, but -!! not GFDL-EMC) -!! -!! \section cloud_mp_GF_gen General Algorithm + ! ###################################################################################### + ! Compute cloud radiative properties for Grell-Freitas convective cloud scheme. + ! (Adopted from module_SGSCloud_RadPre) + ! + ! - The total convective cloud condensate is partitoned by phase, using temperature, into + ! liquid/ice convective cloud mixing-ratios. Compute convective cloud LWP and IWP's. + ! + ! - The liquid and ice cloud effective particle sizes are assigned reference values*. + ! *TODO* Find references, include DOIs, parameterize magic numbers, etc... + ! + ! - The convective cloud-fraction is computed using Xu-Randall (1996). + ! (DJS asks: Does the GF scheme produce a cloud-fraction? If so, maybe use instead of + ! Xu-Randall? Xu-Randall is consistent with the Thompson MP scheme, but + ! not GFDL-EMC) + ! + ! ###################################################################################### subroutine cloud_mp_GF(nCol, nLev, lsmask, t_lay, p_lev, p_lay, qs_lay, relhum, & qci_conv, con_ttp, con_g, alpha0, cld_cnv_lwp, cld_cnv_reliq, cld_cnv_iwp, & cld_cnv_reice, cld_cnv_frac) @@ -376,17 +365,17 @@ subroutine cloud_mp_GF(nCol, nLev, lsmask, t_lay, p_lev, p_lay, qs_lay, relhum, enddo end subroutine cloud_mp_GF -!> \ingroup GFS_rrtmgp_cloud_mp -!! Compute cloud radiative properties for MYNN-EDMF PBL cloud scheme. -!! (Adopted from module_SGSCloud_RadPre) -!! -!! - Cloud-fraction, liquid, and ice condensate mixing-ratios from MYNN-EDMF cloud scheme -!! are provided as inputs. Cloud LWP and IWP are computed. -!! -!! - The liquid and ice cloud effective particle sizes are assigned reference values*. -!! *TODO* Find references, include DOIs, parameterize magic numbers, etc... -!! -!! \section cloud_mp_MYNN_gen General Algorithm + ! ###################################################################################### + ! Compute cloud radiative properties for MYNN-EDMF PBL cloud scheme. + ! (Adopted from module_SGSCloud_RadPre) + ! + ! - Cloud-fraction, liquid, and ice condensate mixing-ratios from MYNN-EDMF cloud scheme + ! are provided as inputs. Cloud LWP and IWP are computed. + ! + ! - The liquid and ice cloud effective particle sizes are assigned reference values*. + ! *TODO* Find references, include DOIs, parameterize magic numbers, etc... + ! + ! ###################################################################################### subroutine cloud_mp_MYNN(nCol, nLev, lsmask, t_lay, p_lev, p_lay, qs_lay, relhum, & qc_mynn, qi_mynn, con_ttp, con_g, cld_pbl_lwp, cld_pbl_reliq, cld_pbl_iwp, & cld_pbl_reice, cld_pbl_frac) @@ -448,18 +437,18 @@ 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. -!! -!! - The total-cloud convective mixing-ratio is partitioned by phase into liquid/ice -!! cloud properties. LWP and IWP are computed. -!! -!! - The liquid and ice cloud effective particle sizes are assigned reference values. -!! -!! - The convective cloud-fraction is computed using Xu-Randall (1996). -!! (DJS asks: Does the SAMF scheme produce a cloud-fraction?) -!! -!! \section cloud_mp_SAMF_gen General Algorithm + ! ###################################################################################### + ! Compute cloud radiative properties for SAMF convective cloud scheme. + ! + ! - The total-cloud convective mixing-ratio is partitioned by phase into liquid/ice + ! cloud properties. LWP and IWP are computed. + ! + ! - The liquid and ice cloud effective particle sizes are assigned reference values. + ! + ! - The convective cloud-fraction is computed using Xu-Randall (1996). + ! (DJS asks: Does the SAMF scheme produce a cloud-fraction?) + ! + ! ###################################################################################### subroutine cloud_mp_SAMF(nCol, nLev, t_lay, p_lev, p_lay, qs_lay, relhum, & cnv_mixratio, con_ttp, con_g, alpha0, cld_cnv_lwp, cld_cnv_reliq, cld_cnv_iwp, & cld_cnv_reice, cld_cnv_frac) @@ -489,14 +478,15 @@ subroutine cloud_mp_SAMF(nCol, nLev, t_lay, p_lev, p_lay, qs_lay, relhum, cld_cnv_frac ! Convective cloud-fraction (1) ! 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 + 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 @@ -510,13 +500,17 @@ subroutine cloud_mp_SAMF(nCol, nLev, t_lay, p_lev, p_lay, qs_lay, relhum, 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. -!! - The cloud water path is computed for all provided cloud mixing-ratios and hydrometeors. -!! - If particle sizes are provided, they are used. If not, default values are assigned. -!! \section cloud_mp_uni_gen General Algorithm + + ! ###################################################################################### + ! This routine computes the cloud radiative properties for a "unified cloud". + ! + ! - "unified cloud" implies that the cloud-fraction is PROVIDED. + ! + ! - The cloud water path is computed for all provided cloud mixing-ratios and hydrometeors. + ! + ! - If particle sizes are provided, they are used. If not, default values are assigned. + ! + ! ###################################################################################### subroutine cloud_mp_uni(nCol, nLev, nTracers, ncnd, i_cldliq, i_cldice, i_cldrain, & i_cldsnow, i_cldgrpl, i_cldtot, effr_in, kdt, lsmask, p_lev, p_lay, t_lay, tv_lay,& effrin_cldliq, effrin_cldice, effrin_cldsnow, tracer, con_g, con_rd, con_ttp, & @@ -642,20 +636,19 @@ 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. -!! -!! - The cloud water path is computed for all provided cloud mixing-ratios and hydrometeors. -!! -!! - There are no assumptions about particle size applied here. Effective particle sizes -!! are updated prior to this routine, see cmp_reff_Thompson(). -!! -!! - The cloud-fraction is computed using Xu-Randall** (1996). -!! **Additionally, Conditioned on relative-humidity** -!! -!! \section cloud_mp_thompson_gen General Algorithm + ! ###################################################################################### + ! This routine computes the cloud radiative properties for the Thompson cloud micro- + ! physics scheme. + ! + ! - The cloud water path is computed for all provided cloud mixing-ratios and hydrometeors. + ! + ! - There are no assumptions about particle size applied here. Effective particle sizes + ! are updated prior to this routine, see cmp_reff_Thompson(). + ! + ! - The cloud-fraction is computed using Xu-Randall** (1996). + ! **Additionally, Conditioned on relative-humidity** + ! + ! ###################################################################################### subroutine cloud_mp_thompson(nCol, nLev, nTracers, ncnd, i_cldliq, i_cldice, i_cldrain,& i_cldsnow, i_cldgrpl, p_lev, p_lay, tv_lay, t_lay, tracer, qs_lay, q_lay, relhum, & con_g, con_rd, con_eps, alpha0, lwp_ex, iwp_ex, lwp_fc, iwp_fc, cld_frac, cld_lwp,& @@ -768,14 +761,14 @@ subroutine cloud_mp_thompson(nCol, nLev, nTracers, ncnd, i_cldliq, i_cldice, i_c end subroutine cloud_mp_thompson -!> \ingroup GFS_rrtmgp_cloud_mp -!! This function computes the cloud-fraction following. -!! Xu-Randall(1996) A Semiempirical Cloudiness Parameterization for Use in Climate Models -!! https://doi.org/10.1175/1520-0469(1996)053<3084:ASCPFU>2.0.CO;2 -!! -!! cld_frac = {1-exp[-alpha*cld_mr/((1-relhum)*qs_lay)**lambda]}*relhum**P -!! -!! \section cld_frac_XuRandall_gen General Algorithm + ! ###################################################################################### + ! This function computes the cloud-fraction following. + ! Xu-Randall(1996) A Semiempirical Cloudiness Parameterization for Use in Climate Models + ! https://doi.org/10.1175/1520-0469(1996)053<3084:ASCPFU>2.0.CO;2 + ! + ! cld_frac = {1-exp[-alpha*cld_mr/((1-relhum)*qs_lay)**lambda]}*relhum**P + ! + ! ###################################################################################### function cld_frac_XuRandall(p_lay, qs_lay, relhum, cld_mr, alpha) implicit none ! Inputs @@ -812,11 +805,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, & effrin_cldliq, effrin_cldice, effrin_cldsnow) @@ -887,4 +880,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_pre.F90 b/physics/GFS_rrtmgp_pre.F90 index d46f60af1..5b4bb025e 100644 --- a/physics/GFS_rrtmgp_pre.F90 +++ b/physics/GFS_rrtmgp_pre.F90 @@ -15,10 +15,9 @@ module GFS_rrtmgp_pre NF_VGAS, & !< Number of active gas species getgases, & !< Routine to setup trace gases getozn !< Routine to setup ozone - ! RRTMGP types - 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 real(kind_phys), parameter :: & amd = 28.9644_kind_phys, & !< Molecular weight of dry-air (g/mol) @@ -112,23 +111,24 @@ 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, semis, sfc_emiss_byband, errmsg, & - errflg) + maxGPtemp, 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, errmsg, errflg) ! Inputs integer, intent(in) :: & + 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 logical, intent(in) :: & - 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 ... @@ -167,7 +167,8 @@ subroutine GFS_rrtmgp_pre_run(me, nCol, nLev, nTracers, i_o3, lsswr, lslwr, fhsw integer, intent(out) :: & errflg, & ! Error flag iSFC, & ! Vertical index for surface - iTOA ! Vertical index for TOA + iTOA, & ! Vertical index for TOA + nDay logical, intent(out) :: & top_at_1 ! Vertical ordering flag real(kind_phys), intent(inout) :: & @@ -178,6 +179,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 @@ -190,15 +193,11 @@ subroutine GFS_rrtmgp_pre_run(me, nCol, nLev, nTracers, i_o3, lsswr, lslwr, fhsw deltaP, & ! Layer thickness (Pa) p_lev, & ! Pressure at model-interface sfc_emiss_byband, & ! - 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 + 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 @@ -210,7 +209,7 @@ subroutine GFS_rrtmgp_pre_run(me, nCol, nLev, nTracers, i_o3, lsswr, lslwr, fhsw errmsg = '' errflg = 0 - if (.not. (lsswr .or. lslwr)) return + if (.not. (doSWrad .or. doLWrad)) return ! ####################################################################################### ! What is vertical ordering? @@ -340,16 +339,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 @@ -362,21 +356,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, 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) @@ -392,8 +379,20 @@ 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 ! ####################################################################################### diff --git a/physics/GFS_rrtmgp_pre.meta b/physics/GFS_rrtmgp_pre.meta index 4992f4ef8..2eb9a92b4 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 @@ -425,11 +418,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 @@ -441,13 +474,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 @@ -480,6 +506,20 @@ 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 3cd8af019..f028acca2 100644 --- a/physics/GFS_rrtmgp_setup.F90 +++ b/physics/GFS_rrtmgp_setup.F90 @@ -156,7 +156,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, & slag, sdec, cdec, solcon, errmsg, errflg) ! Inputs @@ -164,7 +164,7 @@ 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) :: lsswr + logical, intent(in) :: doSWrad integer, intent(in) :: me ! Outputs @@ -222,7 +222,7 @@ subroutine GFS_rrtmgp_setup_timestep_init (idate, jdate, deltsw, deltim, lsswr, endif ! Update solar forcing... - if (lsswr) then + if (doSWrad) then if ( isolar == 0 .or. isolar == 10 ) then lsol_chg = .false. elseif ( iyear0 /= iyear ) then diff --git a/physics/GFS_rrtmgp_setup.meta b/physics/GFS_rrtmgp_setup.meta index 41bf63ac8..160430765 100644 --- a/physics/GFS_rrtmgp_setup.meta +++ b/physics/GFS_rrtmgp_setup.meta @@ -256,7 +256,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/rrtmgp_lw_main.F90 b/physics/rrtmgp_lw_main.F90 index b58e5a45d..0277b276a 100644 --- a/physics/rrtmgp_lw_main.F90 +++ b/physics/rrtmgp_lw_main.F90 @@ -102,48 +102,58 @@ end subroutine rrtmgp_lw_main_init !> @{ ! ###################################################################################### subroutine rrtmgp_lw_main_run(doLWrad, doLWclrsky, top_at_1, doGP_lwscat, & - use_LW_jacobian, doGP_sgs_cnv, doGP_sgs_pbl, nCol, nLay, 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, 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, sfc_emiss_byband, & - active_gases_array, lw_optical_props_aerosol, gas_concentrations, fluxlwUP_allsky,& - fluxlwDOWN_allsky, fluxlwUP_clrsky, fluxlwDOWN_clrsky, fluxlwUP_jac, & - fluxlwUP_radtime, fluxlwDOWN_radtime, errmsg, errflg) + 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, & + lw_optical_props_aerosol, fluxlwUP_allsky, fluxlwDOWN_allsky, & + fluxlwUP_clrsky, fluxlwDOWN_clrsky, fluxlwUP_jac, fluxlwUP_radtime, & + fluxlwDOWN_radtime, errmsg, errflg) ! Inputs logical, intent(in) :: & - doLWrad, & ! Flag to calculate LW irradiances - doLWclrsky, & ! Flag to compute clear-sky fluxes (diagnostic) - top_at_1, & ! Vertical ordering flag - use_LW_jacobian, & ! Compute Jacobian of LW to update radiative fluxes between radiation calls? - doGP_sgs_pbl, & ! Flag for sgs MYNN-EDMF PBL cloud scheme - doGP_sgs_cnv, & ! Flag for sgs convective cloud scheme - doGP_lwscat ! Include scattering in LW cloud-optics? + 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. - nGauss_angles, & ! - 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 ! + 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 + icseed_lw ! Seed for random number generation for longwave radiation real(kind_phys), dimension(:), intent(in) :: & - semis, & ! Surface-emissivity - tsfg ! + 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 @@ -153,23 +163,21 @@ subroutine rrtmgp_lw_main_run(doLWrad, doLWclrsky, top_at_1, doGP_lwscat, 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 + 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 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 - sfc_emiss_byband, & ! - cloud_overlap_param + 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 character(len=*), dimension(:), intent(in) :: & active_gases_array ! List of active gases from namelist as array type(ty_optical_props_1scl),intent(inout) :: & lw_optical_props_aerosol ! RRTMGP DDT: Longwave aerosol optical properties (tau) - type(ty_gas_concs), intent(in) :: & - gas_concentrations ! RRTMGP DDT: + ! Outputs real(kind_phys), dimension(:,:), intent(inout) :: & fluxlwUP_jac, & ! Jacobian of upwelling LW surface radiation (W/m2/K) @@ -185,91 +193,87 @@ subroutine rrtmgp_lw_main_run(doLWrad, doLWclrsky, top_at_1, doGP_lwscat, errflg ! CCPP error flag ! Local variables - type(ty_gas_concs) :: & - gas_concs ! RRTMGP DDT: trace gas concentrations (vmr) - type(ty_optical_props_1scl) :: & - lw_optical_props_clrsky, & ! RRTMGP DDT: longwave clear-sky radiative properties - lw_optical_props_aerosol_local ! RRTMGP DDT: longwave aerosol radiative properties - type(ty_optical_props_2str) :: & - lw_optical_props_clouds, & ! RRTMGP DDT: Longwave optical properties in each band (sampled clouds) - 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_pblcloudsByBand, & ! RRTMGP DDT: Longwave optical properties in each band (PBL cloud) - lw_optical_props_precipByBand ! RRTMGP DDT: Longwave optical properties in each band (precipitation) - type(ty_source_func_lw) :: & - sources ! RRTMGP DDT: longwave source functions - type(ty_fluxes_byband) :: & - flux_allsky, flux_clrsky ! RRTMGP DDT: Longwave flux profiles - integer :: iCol, iLay, iGas, iBand, ipseed_lw + 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 + 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) :: tau_rain, tau_snow + 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_phys), dimension(lw_gas_props%get_ngpt()) :: rng1D - real(kind_phys), dimension(lw_gas_props%get_ngpt(),nLay,1) :: rng3D,rng3D2 + real(kind_phys), dimension(lw_gas_props%get_ngpt(),nLay,rrtmgp_phys_blksz) :: rng3D,rng3D2 real(kind_phys), dimension(lw_gas_props%get_ngpt()*nLay) :: rng2D - logical, dimension(1,nLay,lw_gas_props%get_ngpt()) :: maskMCICA - real(kind_phys), dimension(1,nLay+1,lw_gas_props%get_nband()),target :: & + 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(1,lw_gas_props%get_ngpt()) :: lw_Ds - real(kind_phys), dimension(nCol, nLay,gas_concentrations%get_num_gases()) :: vmrTemp - + 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 - fluxlwUP_clrsky(:,:) = 0._kind_phys - fluxlwDOWN_clrsky(:,:) = 0._kind_phys ! ###################################################################################### ! ! Allocate/initialize RRTMGP DDT's ! ! ###################################################################################### - ! + ! ty_gas_concs - ! - gas_concs%ncol = 1 + gas_concs%ncol = rrtmgp_phys_blksz gas_concs%nlay = nLay - allocate(gas_concs%gas_name(gas_concentrations%get_num_gases())) - allocate(gas_concs%concs(gas_concentrations%get_num_gases())) - do iGas=1,gas_concentrations%get_num_gases() - allocate(gas_concs%concs(iGas)%conc(1, nLay)) + allocate(gas_concs%gas_name(nGases)) + allocate(gas_concs%concs(nGases)) + do iGas=1,ngases + allocate(gas_concs%concs(iGas)%conc(rrtmgp_phys_blksz, nLay)) enddo gas_concs%gas_name(:) = active_gases_array(:) - do iGas=1,gas_concentrations%get_num_gases() - call check_error_msg('rrtmgp_lw_main_get_vmr',& - gas_concentrations%get_vmr(trim(gas_concentrations%gas_name(iGas)),vmrTemp(:,:,iGas))) - enddo - ! + ! ty_optical_props - ! call check_error_msg('rrtmgp_lw_main_gas_optics_init',& - lw_optical_props_clrsky%alloc_1scl(1, nLay, lw_gas_props)) + lw_optical_props_clrsky%alloc_1scl(rrtmgp_phys_blksz, nLay, lw_gas_props)) call check_error_msg('rrtmgp_lw_main_sources_init',& - sources%alloc(1, nLay, lw_gas_props)) + 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(1, nLay, lw_gas_props%get_band_lims_wavenumber())) + 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(1, nLay, lw_gas_props%get_band_lims_wavenumber())) + 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(1, nLay, lw_gas_props)) + 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(1, nLay, lw_gas_props%get_band_lims_wavenumber())) + 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(1, nLay, lw_gas_props%get_band_lims_wavenumber())) + 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(1, nLay, lw_gas_props%get_band_lims_wavenumber())) + lw_optical_props_pblcloudsByBand%alloc_2str(rrtmgp_phys_blksz, nLay, lw_gas_props%get_band_lims_wavenumber())) endif + ! ###################################################################################### + ! ! Loop over all columns... - do iCol=1,nCol + ! + ! ###################################################################################### + do iCol=1,nCol,rrtmgp_phys_blksz + iCol2 = iCol + rrtmgp_phys_blksz - 1 + + ! ################################################################################### + ! ! Initialize/reset - do iGas=1,gas_concentrations%get_num_gases() - gas_concs%concs(iGas)%conc(1,:) = 0._kind_phys + ! + ! ################################################################################### + ! ty_gas_concs + do iGas=1,nGases + gas_concs%concs(iGas)%conc(:,:) = 0._kind_phys end do + ! 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 @@ -291,6 +295,7 @@ subroutine rrtmgp_lw_main_run(doLWrad, doLWclrsky, top_at_1, doGP_lwscat, 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 flux_allsky%bnd_flux_up => fluxLW_up_allsky flux_allsky%bnd_flux_dn => fluxLW_dn_allsky flux_clrsky%bnd_flux_up => fluxLW_up_clrsky @@ -301,147 +306,183 @@ subroutine rrtmgp_lw_main_run(doLWrad, doLWclrsky, top_at_1, doGP_lwscat, ! Set gas-concentrations ! ! ################################################################################### - do iGas=1,gas_concentrations%get_num_gases() - call check_error_msg('rrtmgp_sw_gas_optics_run_set_vmr',& - gas_concs%set_vmr(trim(gas_concentrations%gas_name(iGas)),vmrTemp(iCol,:,iGas))) + gas_concs%concs(istr_o2)%conc(:,:) = vmr_o2(iCol:iCol2,:) + gas_concs%concs(istr_co2)%conc(:,:) = vmr_co2(iCol:iCol2,:) + gas_concs%concs(istr_ch4)%conc(:,:) = vmr_ch4(iCol:iCol2,:) + gas_concs%concs(istr_n2o)%conc(:,:) = vmr_n2o(iCol:iCol2,:) + gas_concs%concs(istr_h2o)%conc(:,:) = vmr_h2o(iCol:iCol2,:) + gas_concs%concs(istr_o3)%conc(:,:) = 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) > 1e-6 .and. semis(iCol+iblck-1) <= 1.0) 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 ! ################################################################################### ! - ! Gas-optics + ! Compute gas-optics... ! ! ################################################################################### call check_error_msg('rrtmgp_lw_main_gas_optics',lw_gas_props%gas_optics(& - p_lay(iCol:iCol,:), & ! IN - Pressure @ layer-centers (Pa) - p_lev(iCol:iCol,:), & ! IN - Pressure @ layer-interfaces (Pa) - t_lay(iCol:iCol,:), & ! IN - Temperature @ layer-centers (K) - tsfg(iCol:iCol), & ! IN - Skin-temperature (K) + 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:iCol,:))) ! IN - Temperature @ layer-interfaces (K) (optional) + tlev=t_lev(iCol:iCol2,:))) ! IN - Temperature @ layer-interfaces (K) (optional) ! ################################################################################### ! - ! Cloud-optics + ! Compute cloud-optics... ! ! ################################################################################### - if (any(cld_frac(iCol,:) .gt. 0.)) then + if (any(cld_frac(iCol:iCol2,:) .gt. 0.)) then + ! Microphysical (gridmean) cloud optics call check_error_msg('rrtmgp_lw_main_cloud_optics',lw_cloud_props%cloud_optics(& - cld_lwp(iCol:iCol,:), & ! IN - Cloud liquid water path (g/m2) - cld_iwp(iCol:iCol,:), & ! IN - Cloud ice water path (g/m2) - cld_reliq(iCol:iCol,:), & ! IN - Cloud liquid effective radius (microns) - cld_reice(iCol:iCol,:), & ! IN - Cloud ice effective radius (microns) - lw_optical_props_cloudsByBand)) ! OUT - RRTMGP DDT containing cloud radiative properties - ! in each band - endif - - ! Convective cloud-optics? - if (doGP_sgs_cnv) then - call check_error_msg('rrtmgp_lw_main_cnv_cloud_optics',lw_cloud_props%cloud_optics(& - cld_cnv_lwp(iCol:iCol,:), & ! IN - Convective cloud liquid water path (g/m2) - cld_cnv_iwp(iCol:iCol,:), & ! IN - Convective cloud ice water path (g/m2) - cld_cnv_reliq(iCol:iCol,:), & ! IN - Convective cloud liquid effective radius (microns) - cld_cnv_reice(iCol:iCol,:), & ! IN - Convective cloud ice effective radius (microns) - lw_optical_props_cnvcloudsByBand)) ! OUT - RRTMGP DDT containing convective cloud radiative properties - ! in each band - !call check_error_msg('rrtmgp_lw_main_increment_cnvclouds_to_clouds',& - ! lw_optical_props_cnvcloudsByBand%increment(lw_optical_props_cloudsByBand)) - endif + 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 + 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 + call check_error_msg('rrtmgp_lw_main_increment_cnvclouds_to_clouds',& + lw_optical_props_cnvcloudsByBand%increment(lw_optical_props_cloudsByBand)) + endif - ! MYNN PBL cloud-optics? - if (doGP_sgs_pbl) then - call check_error_msg('rrtmgp_lw_main_pbl_cloud_optics',lw_cloud_props%cloud_optics(& - cld_pbl_lwp(iCol:iCol,:), & ! IN - MYNN-EDMF PBL cloud liquid water path (g/m2) - cld_pbl_iwp(iCol:iCol,:), & ! IN - MYNN-EDMF PBL cloud ice water path (g/m2) - cld_pbl_reliq(iCol:iCol,:), & ! IN - MYNN-EDMF PBL cloud liquid effective radius (microns) - cld_pbl_reice(iCol:iCol,:), & ! IN - MYNN-EDMF PBL cloud ice effective radius (microns) - lw_optical_props_pblcloudsByBand)) ! OUT - RRTMGP DDT containing MYNN-EDMF PBL cloud radiative properties - ! in each band - !call check_error_msg('rrtmgp_lw_main_increment_pblclouds_to_clouds',& - ! lw_optical_props_pblcloudsByBand%increment(lw_optical_props_cloudsByBand)) + ! Include PBL (subgrid scale) clouds? + if (doGP_sgs_pbl) then + 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 + 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 iLay=1,nLay - 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 + ! + ! ################################################################################### + 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. 0.) 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 - do iBand=1,lw_gas_props%get_nband() - lw_optical_props_precipByBand%tau(1,iLay,iBand) = tau_rain + tau_snow - enddo - endif + enddo enddo - !call check_error_msg('rrtmgp_lw_main_increment_precip_to_clouds',& - ! lw_optical_props_precipByBand%increment(lw_optical_props_cloudsByBand)) + 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(cld_frac(iCol,:) .gt. 0.)) then + if (any(cld_frac(iCol:iCol2,:) .gt. 0.)) then ! Change random number seed value for each radiation invocation (isubc_lw =1 or 2). if(isubc_lw == 1) then ! advance prescribed permutation seed - ipseed_lw = lw_gas_props%get_ngpt() + iCol + 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 - ipseed_lw = icseed_lw(iCol) + do ix=1,rrtmgp_phys_blksz + ipseed_lw(ix) = icseed_lw(iCol+ix-1) + enddo endif + ! Call RNG - call random_setseed(ipseed_lw,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,1) = rng1D - enddo - else - do iLay=1,nLay + 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) - rng3D(:,iLay,1) = rng1D - enddo - endif + 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(rng3D, cld_frac(iCol:iCol,:), maskMCICA) + call sampled_mask(rng3D, cld_frac(iCol:iCol2,:), maskMCICA) endif ! Exponential decorrelation length overlap if (iovr == iovr_dcorr) then - ! Generate second RNG - call random_setseed(ipseed_lw,rng_stat) - call random_number(rng2D,rng_stat) - rng3D2(:,:,1) = reshape(source = rng2D,shape=[lw_gas_props%get_ngpt(),nLay]) + 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(rng3D, cld_frac(iCol:iCol,:), maskMCICA, & - overlap_param = cloud_overlap_param(iCol:iCol,1:nLay-1), randoms2 = rng3D2) + call sampled_mask(rng3D, cld_frac(iCol:iCol2,:), maskMCICA, & + overlap_param = cloud_overlap_param(iCol:iCol2,1:nLay-1), randoms2 = rng3D2) endif ! Exponential or Exponential-random if (iovr == iovr_exp .or. iovr == iovr_exprand) then - call sampled_mask(rng3D, cld_frac(iCol:iCol,:), maskMCICA, & - overlap_param = cloud_overlap_param(iCol:iCol,1:nLay-1)) + call sampled_mask(rng3D, 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) ! ! ################################################################################### ! Add aerosol optics to gas optics - lw_optical_props_aerosol_local%tau = lw_optical_props_aerosol%tau(iCol:iCol,:,:) + lw_optical_props_aerosol_local%tau = lw_optical_props_aerosol%tau(iCol:iCol2,:,:) call check_error_msg('rrtmgp_lw_main_increment_aerosol_to_clrsky',& lw_optical_props_aerosol_local%increment(lw_optical_props_clrsky)) @@ -454,7 +495,7 @@ subroutine rrtmgp_lw_main_run(doLWrad, doLWclrsky, top_at_1, doGP_lwscat, lw_optical_props_clrsky, & ! IN - optical-properties top_at_1, & ! IN - veritcal ordering flag sources, & ! IN - source function - sfc_emiss_byband(:,iCol:iCol), & ! IN - surface emissivity in each LW band + 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 @@ -462,41 +503,34 @@ subroutine rrtmgp_lw_main_run(doLWrad, doLWclrsky, top_at_1, doGP_lwscat, lw_optical_props_clrsky, & ! IN - optical-properties top_at_1, & ! IN - veritcal ordering flag sources, & ! IN - source function - sfc_emiss_byband(:,iCol:iCol), & ! IN - surface emissivity in each LW band + sfc_emiss_byband, & ! IN - surface emissivity in each LW band flux_clrsky, & ! OUT - Fluxes lw_Ds = lw_Ds)) endif ! Store fluxes - fluxlwUP_clrsky(iCol:iCol,:) = sum(flux_clrsky%bnd_flux_up, dim=3) - fluxlwDOWN_clrsky(iCol:iCol,:) = sum(flux_clrsky%bnd_flux_dn, dim=3) + 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,:) = 0.0 - fluxlwDOWN_clrsky(iCol,:) = 0.0 + 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 convective cloud? - if (doGP_sgs_cnv) then - call check_error_msg('rrtmgp_lw_main_increment_cnvclouds_to_clrsky',& - lw_optical_props_cnvcloudsByBand%increment(lw_optical_props_clrsky)) - endif - - ! Include MYNN-EDMF PBL clouds? - if (doGP_sgs_pbl) then - call check_error_msg('rrtmgp_lw_main_increment_pblclouds_to_clrsky',& - lw_optical_props_pblcloudsByBand%increment(lw_optical_props_clrsky)) - endif - - ! Add in precipitation - call check_error_msg('rrtmgp_lw_main_increment_precip_to_clrsky',& - 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) @@ -509,7 +543,7 @@ subroutine rrtmgp_lw_main_run(doLWrad, doLWclrsky, top_at_1, doGP_lwscat, lw_optical_props_clouds, & ! IN - optical-properties top_at_1, & ! IN - veritcal ordering flag sources, & ! IN - source function - sfc_emiss_byband(:,iCol:iCol), & ! IN - surface emissivity in each LW band + 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) @@ -518,7 +552,7 @@ subroutine rrtmgp_lw_main_run(doLWrad, doLWclrsky, top_at_1, doGP_lwscat, lw_optical_props_clouds, & ! IN - optical-properties top_at_1, & ! IN - veritcal ordering flag sources, & ! IN - source function - sfc_emiss_byband(:,iCol:iCol), & ! IN - surface emissivity in each LW band + 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 @@ -534,7 +568,7 @@ subroutine rrtmgp_lw_main_run(doLWrad, doLWclrsky, top_at_1, doGP_lwscat, lw_optical_props_clrsky, & ! IN - optical-properties top_at_1, & ! IN - veritcal ordering flag sources, & ! IN - source function - sfc_emiss_byband(:,iCol:iCol), & ! IN - surface emissivity in each LW band + 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) @@ -543,19 +577,19 @@ subroutine rrtmgp_lw_main_run(doLWrad, doLWclrsky, top_at_1, doGP_lwscat, lw_optical_props_clrsky, & ! IN - optical-properties top_at_1, & ! IN - veritcal ordering flag sources, & ! IN - source function - sfc_emiss_byband(:,iCol:iCol), & ! IN - surface emissivity in each LW band + 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:iCol,:) = sum(flux_allsky%bnd_flux_up, dim=3) - fluxlwDOWN_allsky(iCol:iCol,:) = sum(flux_allsky%bnd_flux_dn, dim=3) + 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,:) = fluxlwUP_allsky(iCol,:) - fluxlwDOWN_radtime(iCol,:) = fluxlwDOWN_allsky(iCol,:) + fluxlwUP_radtime(iCol:iCol2,:) = fluxlwUP_allsky(iCol:iCol2,:) + fluxlwDOWN_radtime(iCol:iCol2,:) = fluxlwDOWN_allsky(iCol:iCol2,:) enddo diff --git a/physics/rrtmgp_lw_main.meta b/physics/rrtmgp_lw_main.meta index ec352c0a8..334a75607 100644 --- a/physics/rrtmgp_lw_main.meta +++ b/physics/rrtmgp_lw_main.meta @@ -201,6 +201,13 @@ dimensions = () type = integer intent = in +[rrtmgp_phys_blksz] + standard_name = number_of_columns_per_RRTMGP_block + long_name = number of columns to process ata time by RRTMGP + units = count + dimensions = () + type = integer + intent = in [nLay] standard_name = vertical_layer_dimension long_name = number of vertical levels @@ -215,6 +222,13 @@ 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 @@ -333,6 +347,54 @@ 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 @@ -485,14 +547,6 @@ 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 = in [active_gases_array] standard_name = list_of_active_gases_used_by_RRTMGP long_name = list of active gases used by RRTMGP @@ -508,13 +562,6 @@ dimensions = () type = ty_optical_props_1scl 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 [fluxlwUP_radtime] standard_name = RRTMGP_lw_flux_profile_upward_allsky_on_radiation_timestep long_name = RRTMGP upward longwave all-sky flux profile diff --git a/physics/rrtmgp_sw_cloud_optics.F90 b/physics/rrtmgp_sw_cloud_optics.F90 index 3aab115cd..a750a549b 100644 --- a/physics/rrtmgp_sw_cloud_optics.F90 +++ b/physics/rrtmgp_sw_cloud_optics.F90 @@ -1,18 +1,8 @@ -!> \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 @@ -73,20 +63,12 @@ module rrtmgp_sw_cloud_optics 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 + ! ###################################################################################### + ! SUBROUTINE sw_cloud_optics_init + ! ###################################################################################### +!! \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) @@ -405,16 +387,12 @@ subroutine rrtmgp_sw_cloud_optics_init(doG_cldoptics, doGP_cldoptics_PADE, end subroutine rrtmgp_sw_cloud_optics_init -!> \section arg_table_rrtmgp_sw_cloud_optics_run + ! ######################################################################################### + ! SUBROTUINE rrtmgp_sw_cloud_optics_run() + ! ######################################################################################### +!! \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, & @@ -582,4 +560,10 @@ subroutine rrtmgp_sw_cloud_optics_run(doSWrad, doG_cldoptics, icliq_sw, icice_sw end subroutine rrtmgp_sw_cloud_optics_run + ! ######################################################################################### + ! SUBROTUINE rrtmgp_sw_cloud_optics_finalize() + ! ######################################################################################### + subroutine rrtmgp_sw_cloud_optics_finalize() + end subroutine rrtmgp_sw_cloud_optics_finalize + 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.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 index 66f4b7553..a10f899e0 100644 --- a/physics/rrtmgp_sw_main.F90 +++ b/physics/rrtmgp_sw_main.F90 @@ -59,14 +59,13 @@ subroutine rrtmgp_sw_main_init(rrtmgp_root_dir, rrtmgp_sw_file_gas, mpicomm, mpi errflg = 0 ! RRTMGP shortwave gas-optics (k-distribution) initialization - call rrtmgp_sw_gas_optics_init(rrtmgp_root_dir, rrtmgp_sw_file_gas, mpicomm, mpirank, & - mpiroot, active_gases_array, errmsg, errflg) + 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(nrghice, mpicomm, mpirank, mpiroot, doG_cldoptics, & - doGP_cldoptics_PADE, doGP_cldoptics_LUT, rrtmgp_root_dir, rrtmgp_sw_file_clouds, & - errmsg, errflg) - + call 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) end subroutine rrtmgp_sw_main_init ! ######################################################################################### @@ -76,28 +75,30 @@ end subroutine rrtmgp_sw_main_init !! \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, 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, & + 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, sw_optical_props_aerosol, gas_concentrations, solcon, scmpsw, & + active_gases_array, sw_optical_props_aerosol, solcon, scmpsw, & fluxswUP_allsky, fluxswDOWN_allsky, fluxswUP_clrsky, fluxswDOWN_clrsky, cldtausw, & errmsg, errflg) ! Inputs logical, intent(in) :: & - doSWrad, & ! Flag to calculate SW irradiances - doSWclrsky, & ! Flag to compute clear-sky fluxes (diagnostic) - top_at_1, & ! Vertical ordering flag - doGP_sgs_pbl, & ! Flag for sgs MYNN-EDMF PBL cloud scheme - doGP_sgs_cnv ! Flag for sgs convective cloud scheme + 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 @@ -142,72 +143,66 @@ subroutine rrtmgp_sw_main_run(doSWrad, doSWclrsky, top_at_1, doGP_sgs_cnv, doGP_ 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 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 + 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 ! character(len=*), dimension(:), intent(in) :: & active_gases_array ! List of active gases from namelist as array type(ty_optical_props_2str),intent(in) :: & sw_optical_props_aerosol ! RRTMGP DDT: Shortwave aerosol optical properties (tau,ssa,g) - type(ty_gas_concs), intent(in) :: & - gas_concentrations ! RRTMGP DDT: gas concentrations real(kind_phys), intent(in) :: & solcon ! Solar constant ! Outputs character(len=*), intent(out) :: & - errmsg ! CCPP error message + errmsg ! CCPP error message integer, intent(out) :: & - errflg ! CCPP error flag + errflg ! CCPP error flag real(kind_phys), dimension(:,:), intent(out) :: & - cldtausw ! Approx 10.mu band layer cloud optical depth + 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) + 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) + 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(ty_gas_concs) :: & - gas_concs ! RRTMGP DDT: trace gas concentrations (vmr) - type(ty_optical_props_2str) :: & - sw_optical_props_clrsky, & ! RRTMGP DDT: Shortwave clear-sky radiative properties - sw_optical_props_aerosol_local, & ! RRTMGP DDT: Shortave aerosol radiative properties - 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_pblcloudsByBand, & ! RRTMGP DDT: Shortwave optical properties in each band (PBL cloud) - sw_optical_props_precipByBand, & ! RRTMGP DDT: Shortwave optical properties in each band (precipitation) - sw_optical_props_clouds ! RRTMGP DDT: Shortwave optical properties in each band (sampled clouds) - type(ty_fluxes_byband) :: & - flux_allsky, & ! RRTMGP DDT: All-sky flux (W/m2) - flux_clrsky ! RRTMGP DDT: Clear-sky flux (W/m2) - 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 + type(cmpfsw_type), dimension(rrtmgp_phys_blksz) :: scmpsw_clrsky, scmpsw_allsky + 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 + 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(sw_gas_props%get_ngpt()) :: rng1D - real(kind_phys), dimension(sw_gas_props%get_ngpt(),nLay,1) :: rng3D,rng3D2 + real(kind_phys), dimension(sw_gas_props%get_ngpt(),nLay,rrtmgp_phys_blksz) :: rng3D,rng3D2 real(kind_phys), dimension(sw_gas_props%get_ngpt()*nLay) :: rng2D - logical, dimension(1,nLay,sw_gas_props%get_ngpt()) :: maskMCICA - real(kind_phys), dimension(sw_gas_props%get_nband(),1) :: & + logical, dimension(rrtmgp_phys_blksz,nLay,sw_gas_props%get_ngpt()) :: maskMCICA + real(kind_phys), dimension(sw_gas_props%get_nband(),rrtmgp_phys_blksz) :: & sfc_alb_dir, sfc_alb_dif - real(kind_phys), dimension(1,nLay+1,sw_gas_props%get_nband()),target :: & - fluxSW_up_allsky, fluxSW_up_clrsky, fluxSW_dn_allsky, fluxSW_dn_clrsky, fluxSW_dn_dir_allsky - integer :: iBand, ibd, iCol, iGas, iLay, ipseed_sw, ix + 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 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/) - real(kind_phys), dimension(1,sw_gas_props%get_ngpt()) :: toa_src_sw - real(kind_phys), dimension(nCol, nLay, gas_concentrations%get_num_gases()) :: vmrTemp + 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 = '' @@ -216,51 +211,45 @@ subroutine rrtmgp_sw_main_run(doSWrad, doSWclrsky, top_at_1, doGP_sgs_cnv, doGP_ if (.not. doSWrad) return if (nDay .gt. 0) then + + bandlimits = sw_gas_props%get_band_lims_wavenumber() ! ###################################################################################### ! ! Allocate/initialize RRTMGP DDT's ! ! ###################################################################################### - bandlimits = sw_gas_props%get_band_lims_wavenumber() - ! + ! ty_gas_concs - ! - gas_concs%ncol = 1 + gas_concs%ncol = rrtmgp_phys_blksz gas_concs%nlay = nLay - allocate(gas_concs%gas_name(gas_concentrations%get_num_gases())) - allocate(gas_concs%concs(gas_concentrations%get_num_gases())) - do iGas=1,gas_concentrations%get_num_gases() - allocate(gas_concs%concs(iGas)%conc(1, nLay)) + allocate(gas_concs%gas_name(nGases)) + allocate(gas_concs%concs(nGases)) + do iGas=1,nGases + allocate(gas_concs%concs(iGas)%conc(rrtmgp_phys_blksz, nLay)) enddo gas_concs%gas_name(:) = active_gases_array(:) - do iGas=1,gas_concentrations%get_num_gases() - call check_error_msg('rrtmgp_sw_main_get_vmr',& - gas_concentrations%get_vmr(trim(gas_concentrations%gas_name(iGas)),vmrTemp(:,:,iGas))) - enddo - ! + ! ty_optical_props - ! - call check_error_msg('rrtmgp_sw_main_gas_optics_init',& - sw_optical_props_clrsky%alloc_2str(1, nLay, sw_gas_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(1, nLay, sw_gas_props%get_band_lims_wavenumber())) + 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(1, nLay, sw_gas_props%get_band_lims_wavenumber())) + 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(1, nLay, sw_gas_props)) + 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(1, nLay, sw_gas_props%get_band_lims_wavenumber())) + 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(1, nLay, sw_gas_props%get_band_lims_wavenumber())) + 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(1, nLay, sw_gas_props%get_band_lims_wavenumber())) + sw_optical_props_pblcloudsByBand%alloc_2str(rrtmgp_phys_blksz, nLay, sw_gas_props%get_band_lims_wavenumber())) endif - ! + ! ty_fluxes_byband - ! 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 @@ -268,30 +257,31 @@ subroutine rrtmgp_sw_main_run(doSWrad, doSWclrsky, top_at_1, doGP_sgs_cnv, doGP_ flux_clrsky%bnd_flux_dn => fluxSW_dn_clrsky ! Loop over all (daylit) columns... - do iCol=1,nDay - ix = idx(iCol) - + do iCol=1,nDay,rrtmgp_phys_blksz + ix = idx(iCol) + ix2 = idx(iCol + rrtmgp_phys_blksz - 1) + ! Initialize/reset - 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 - 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_clrsky%tau = 0._kind_phys - sw_optical_props_clrsky%ssa = 0._kind_phys - sw_optical_props_clrsky%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 - sw_optical_props_aerosol_local%tau = 0._kind_phys - sw_optical_props_aerosol_local%ssa = 0._kind_phys - sw_optical_props_aerosol_local%g = 0._kind_phys + 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 + 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 + sw_optical_props_aerosol_local%tau = 0._kind_phys + sw_optical_props_aerosol_local%ssa = 0._kind_phys + sw_optical_props_aerosol_local%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 @@ -302,17 +292,20 @@ subroutine rrtmgp_sw_main_run(doSWrad, doSWclrsky, top_at_1, doGP_sgs_cnv, doGP_ 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 ) + ! ################################################################################### ! ! Set gas-concentrations ! ! ################################################################################### - ! Subset the gas concentrations. - do iGas=1,gas_concentrations%get_num_gases() - call check_error_msg('rrtmgp_sw_gas_optics_run_set_vmr',& - gas_concs%set_vmr(trim(gas_concentrations%gas_name(iGas)),vmrTemp(ix,:,iGas))) - enddo + gas_concs%concs(istr_o2)%conc(:,:) = vmr_o2(ix:ix2,:) + gas_concs%concs(istr_co2)%conc(:,:) = vmr_co2(ix:ix2,:) + gas_concs%concs(istr_ch4)%conc(:,:) = vmr_ch4(ix:ix2,:) + gas_concs%concs(istr_n2o)%conc(:,:) = vmr_n2o(ix:ix2,:) + gas_concs%concs(istr_h2o)%conc(:,:) = vmr_h2o(ix:ix2,:) + gas_concs%concs(istr_o3)%conc(:,:) = vmr_o3(ix:ix2,:) ! ################################################################################### ! @@ -323,243 +316,325 @@ subroutine rrtmgp_sw_main_run(doSWrad, doSWclrsky, top_at_1, doGP_sgs_cnv, doGP_ ! For overlapping band, average near-IR and us-vis albedos. ! ! ################################################################################### - do iBand=1,sw_gas_props%get_nband() - if (bandlimits(1,iBand) .lt. nIR_uvvis_bnd(1)) then - sfc_alb_dir(iBand,1) = sfc_alb_nir_dir(ix) - sfc_alb_dif(iBand,1) = sfc_alb_nir_dif(ix) - endif - if (bandlimits(1,iBand) .eq. nIR_uvvis_bnd(1)) then - sfc_alb_dir(iBand,1) = 0.5_kind_phys*(sfc_alb_nir_dir(ix) + sfc_alb_uvvis_dir(ix)) - sfc_alb_dif(iBand,1) = 0.5_kind_phys*(sfc_alb_nir_dif(ix) + sfc_alb_uvvis_dif(ix)) - ibd = iBand - endif - if (bandlimits(1,iBand) .ge. nIR_uvvis_bnd(2)) then - sfc_alb_dir(iBand,1) = sfc_alb_uvvis_dir(ix) - sfc_alb_dif(iBand,1) = sfc_alb_uvvis_dif(ix) - endif + 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(ix+iblck-1) + sfc_alb_dif(iBand,iblck) = sfc_alb_nir_dif(ix+iblck-1) + endif + if (bandlimits(1,iBand) .eq. nIR_uvvis_bnd(1)) then + sfc_alb_dir(iBand,iblck) = 0.5_kind_phys*(sfc_alb_nir_dir(ix+iblck-1) + sfc_alb_uvvis_dir(ix+iblck-1)) + sfc_alb_dif(iBand,iblck) = 0.5_kind_phys*(sfc_alb_nir_dif(ix+iblck-1) + sfc_alb_uvvis_dif(ix+iblck-1)) + ibd = iBand + endif + if (bandlimits(1,iBand) .ge. nIR_uvvis_bnd(2)) then + sfc_alb_dir(iBand,iblck) = sfc_alb_uvvis_dir(ix+iblck-1) + sfc_alb_dif(iBand,iblck) = sfc_alb_uvvis_dif(ix+iblck-1) + endif + if (bandlimits(1,iBand) .eq. uvb_bnd(1)) ibd_uv = iBand + enddo enddo ! ################################################################################### ! - ! Gas-optics + ! Compute gas-optics... ! ! ################################################################################### call check_error_msg('rrtmgp_sw_main_gas_optics',sw_gas_props%gas_optics(& - p_lay(ix:ix,:), & ! IN - Pressure @ layer-centers (Pa) - p_lev(ix:ix,:), & ! IN - Pressure @ layer-interfaces (Pa) - t_lay(ix:ix,:), & ! IN - Temperature @ layer-centers (K) + p_lay(ix:ix2,:), & ! IN - Pressure @ layer-centers (Pa) + p_lev(ix:ix2,:), & ! IN - Pressure @ layer-interfaces (Pa) + t_lay(ix:ix2,:), & ! IN - Temperature @ layer-centers (K) gas_concs, & ! IN - RRTMGP DDT: trace gas volumne mixing-ratios - sw_optical_props_clrsky, & ! OUT - RRTMGP DDT: Shortwave optical properties, by + 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 - toa_src_sw(1,:) = toa_src_sw(1,:)*solcon / sum(toa_src_sw(1,:)) + do iblck = 1, rrtmgp_phys_blksz + toa_src_sw(iblck,:) = toa_src_sw(iblck,:)*solcon / sum(toa_src_sw(iblck,:)) + enddo + ! ################################################################################### ! - ! Cloud-optics + ! Compute optics for cloud(s) and precipitation, sample clouds... ! ! ################################################################################### - call check_error_msg('rrtmgp_sw_main_cloud_optics',sw_cloud_props%cloud_optics(& - cld_lwp(ix:ix,:), & ! IN - Cloud liquid water path - cld_iwp(ix:ix,:), & ! IN - Cloud ice water path - cld_reliq(ix:ix,:), & ! IN - Cloud liquid effective radius - cld_reice(ix:ix,:), & ! IN - Cloud ice effective radius - sw_optical_props_cloudsByBand)) ! OUT - RRTMGP DDT: Shortwave optical properties, - ! in each band (tau,ssa,g) - cldtausw(ix,:) = sw_optical_props_cloudsByBand%tau(1,:,11) + if (any(cld_frac(ix:ix2,:) .gt. 1.e-6_kind_phys)) then + ! Gridmean/mp-clouds + call check_error_msg('rrtmgp_sw_main_cloud_optics',sw_cloud_props%cloud_optics(& + cld_lwp(ix:ix2,:), & ! IN - Cloud liquid water path + cld_iwp(ix:ix2,:), & ! IN - Cloud ice water path + cld_reliq(ix:ix2,:), & ! IN - Cloud liquid effective radius + cld_reice(ix:ix2,:), & ! IN - Cloud ice effective radius + sw_optical_props_cloudsByBand)) ! OUT - RRTMGP DDT: Shortwave optical properties, + ! in each band (tau,ssa,g) + cldtausw(ix:ix2,:) = sw_optical_props_cloudsByBand%tau(:,:,11) - ! Convective cloud-optics? - if (doGP_sgs_cnv) then - call check_error_msg('rrtmgp_sw_main_cnv_cloud_optics',sw_cloud_props%cloud_optics(& - cld_cnv_lwp(ix:ix,:), & ! IN - Convective cloud liquid water path (g/m2) - cld_cnv_iwp(ix:ix,:), & ! IN - Convective cloud ice water path (g/m2) - cld_cnv_reliq(ix:ix,:), & ! IN - Convective cloud liquid effective radius (microns) - cld_cnv_reice(ix:ix,:), & ! IN - Convective cloud ice effective radius (microns) - sw_optical_props_cnvcloudsByBand)) ! OUT - RRTMGP DDT containing convective cloud radiative properties + ! Include convective clouds? + if (doGP_sgs_cnv) then + call check_error_msg('rrtmgp_sw_main_cnv_cloud_optics',sw_cloud_props%cloud_optics(& + cld_cnv_lwp(ix:ix2,:), & ! IN - Convective cloud liquid water path (g/m2) + cld_cnv_iwp(ix:ix2,:), & ! IN - Convective cloud ice water path (g/m2) + cld_cnv_reliq(ix:ix2,:), & ! IN - Convective cloud liquid effective radius (microns) + cld_cnv_reice(ix:ix2,:), & ! IN - Convective cloud ice effective radius (microns) + sw_optical_props_cnvcloudsByBand)) ! OUT - RRTMGP DDT containing convective cloud radiative properties ! in each band - !call check_error_msg('rrtmgp_sw_main_increment_cnvclouds_to_clouds',& - ! sw_optical_props_cnvcloudsByBand%increment(sw_optical_props_cloudsByBand)) - endif + ! + call check_error_msg('rrtmgp_sw_main_increment_cnvclouds_to_clouds',& + sw_optical_props_cnvcloudsByBand%increment(sw_optical_props_cloudsByBand)) + endif - ! MYNN PBL cloud-optics? - if (doGP_sgs_pbl) then - call check_error_msg('rrtmgp_sw_main_pbl_cloud_optics',sw_cloud_props%cloud_optics(& - cld_pbl_lwp(ix:ix,:), & ! IN - MYNN-EDMF PBL cloud liquid water path (g/m2) - cld_pbl_iwp(ix:ix,:), & ! IN - MYNN-EDMF PBL cloud ice water path (g/m2) - cld_pbl_reliq(ix:ix,:), & ! IN - MYNN-EDMF PBL cloud liquid effective radius (microns) - cld_pbl_reice(ix:ix,:), & ! IN - MYNN-EDMF PBL cloud ice effective radius (microns) - sw_optical_props_pblcloudsByBand)) ! OUT - RRTMGP DDT containing MYNN-EDMF PBL cloud radiative properties + ! Include PBL clouds? + if (doGP_sgs_pbl) then + call check_error_msg('rrtmgp_sw_main_pbl_cloud_optics',sw_cloud_props%cloud_optics(& + cld_pbl_lwp(ix:ix2,:), & ! IN - PBL cloud liquid water path (g/m2) + cld_pbl_iwp(ix:ix2,:), & ! IN - PBL cloud ice water path (g/m2) + cld_pbl_reliq(ix:ix2,:), & ! IN - PBL cloud liquid effective radius (microns) + cld_pbl_reice(ix:ix2,:), & ! IN - PBL cloud ice effective radius (microns) + sw_optical_props_pblcloudsByBand)) ! OUT - RRTMGP DDT containing PBL cloud radiative properties ! in each band - !call check_error_msg('rrtmgp_sw_main_increment_pblclouds_to_clouds',& - ! sw_optical_props_pblcloudsByBand%increment(sw_optical_props_cloudsByBand)) - endif + ! + 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 iLay=1,nLay - if (cld_frac(ix,iLay) .gt. 1.e-12_kind_phys) then - ! Rain/Snow optical depth (No band dependence) - tau_rain = cld_rwp(ix,iLay)*a0r - if (cld_swp(ix,iLay) .gt. 0. .and. cld_resnow(ix,iLay) .gt. 10._kind_phys) then - tau_snow = cld_swp(ix,iLay)*1.09087*(a0s + a1s/(1.0315*cld_resnow(ix,iLay))) ! fu's formula + ! Cloud precipitation optics: rain and snow(+groupel) + do iblck = 1, rrtmgp_phys_blksz + do iLay=1,nLay + if (cld_frac(ix+iblck-1,iLay) .gt. 1.e-12_kind_phys) then + ! Rain/Snow optical depth (No band dependence) + tau_rain = cld_rwp(ix+iblck-1,iLay)*a0r + if (cld_swp(ix+iblck-1,iLay) .gt. 0. .and. cld_resnow(ix+iblck-1,iLay) .gt. 10._kind_phys) then + tau_snow = cld_swp(ix+iblck-1,iLay)*1.09087*(a0s + a1s/(1.0315*cld_resnow(ix+iblck-1,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(ix+iblck-1,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 + ! + 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() + iCol + iblck - 1 + enddo + elseif (isubc_sw == 2) then ! use input array of permutaion seeds + do iblck = 1, rrtmgp_phys_blksz + ipseed_sw(iblck) = icseed_sw(ix+iblck-1) + 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 - tau_snow = 0._kind_phys + do iLay=1,nLay + call random_number(rng1D,rng_stat) + rng3D(:,iLay,iblck) = rng1D + enddo 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(ix,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(1,iLay,iBand) = (1._kind_phys - za2) * tau_prec - sw_optical_props_precipByBand%ssa(1,iLay,iBand) = (ssaw - za2) / (1._kind_phys - za2) - sw_optical_props_precipByBand%g(1,iLay,iBand) = asyw/(1+asyw) + enddo + + ! Cloud-overlap. + ! Maximum-random, random or maximum. + if (iovr == iovr_maxrand .or. iovr == iovr_rand .or. iovr == iovr_max) then + call sampled_mask(rng3D, cld_frac(ix:ix2,:), 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(rng3D, cld_frac(ix:ix2,:), maskMCICA, & + overlap_param = cloud_overlap_param(ix:ix2,1:nLay-1), randoms2 = rng3D2) endif - enddo - + ! Exponential or Exponential-random + if (iovr == iovr_exp .or. iovr == iovr_exprand) then + call sampled_mask(rng3D, cld_frac(ix:ix2,:), maskMCICA, & + overlap_param = cloud_overlap_param(ix:ix2,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 + ! ################################################################################### ! - ! Cloud-sampling + ! Compute clear-sky fluxes (gaseous+aerosol) (optional) ! ! ################################################################################### - ! Change random number seed value for each radiation invocation (isubc_sw =1 or 2). - if(isubc_sw == 1) then ! advance prescribed permutation seed - ipseed_sw = sw_gas_props%get_ngpt() + iCol - elseif (isubc_sw == 2) then ! use input array of permutaion seeds - ipseed_sw = icseed_sw(ix) - endif - ! Call RNG - call random_setseed(ipseed_sw,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,1) = rng1D - enddo - else - do iLay=1,nLay - call random_number(rng1D,rng_stat) - rng3D(:,iLay,1) = rng1D + ! Add aerosol optics to gaseous (clear-sky) optical properties + sw_optical_props_aerosol_local%tau = sw_optical_props_aerosol%tau(ix:ix2,:,:) + sw_optical_props_aerosol_local%ssa = sw_optical_props_aerosol%ssa(ix:ix2,:,:) + sw_optical_props_aerosol_local%g = sw_optical_props_aerosol%g(ix:ix2,:,:) + call check_error_msg('rrtmgp_sw_main_increment_aerosol_to_clrsky', & + sw_optical_props_aerosol_local%increment(sw_optical_props_accum)) + + ! Delta-scale + !call check_error_msg('rrtmgp_sw_main_delta_scale',sw_optical_props_accum%delta_scale()) + + ! Compute fluxes + 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(ix:ix2), & ! 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(ix:ix2,:) = sum(flux_clrsky%bnd_flux_up, dim=3) + fluxswDOWN_clrsky(ix:ix2,:) = 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 - endif - ! Cloud-overlap. - ! Maximum-random, random or maximum. - if (iovr == iovr_maxrand .or. iovr == iovr_rand .or. iovr == iovr_max) then - call sampled_mask(rng3D, cld_frac(ix:ix,:), maskMCICA) - endif - ! Exponential decorrelation length overlap - if (iovr == iovr_dcorr) then - ! Generate second RNG - call random_setseed(ipseed_sw,rng_stat) - call random_number(rng2D,rng_stat) - rng3D2(:,:,1) = reshape(source = rng2D,shape=[sw_gas_props%get_ngpt(),nLay]) - ! - call sampled_mask(rng3D, cld_frac(ix:ix,:), maskMCICA, & - overlap_param = cloud_overlap_param(ix:ix,1:nLay-1), randoms2 = rng3D2) - endif - ! Exponential or Exponential-random - if (iovr == iovr_exp .or. iovr == iovr_exprand) then - call sampled_mask(rng3D, cld_frac(ix:ix,:), maskMCICA, & - overlap_param = cloud_overlap_param(ix:ix,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)) - + enddo + ! ################################################################################### ! - ! Compute clear-sky fluxes (gaseous+aerosol) (optional) + ! All-sky fluxes (clear-sky + clouds + precipitation) ! ! ################################################################################### - ! Add aerosol optics to gas optics - sw_optical_props_aerosol_local%tau = sw_optical_props_aerosol%tau(iCol:iCol,:,:) - sw_optical_props_aerosol_local%ssa = sw_optical_props_aerosol%ssa(iCol:iCol,:,:) - sw_optical_props_aerosol_local%g = sw_optical_props_aerosol%g(iCol:iCol,:,:) - call check_error_msg('rrtmgp_sw_main_increment_aerosol_to_clrsky',& - sw_optical_props_aerosol_local%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_main_rte_sw_clrsky',rte_sw( & - sw_optical_props_clrsky, & ! IN - optical-properties + if (any(cld_frac(ix:ix2,:) .gt. 1.e-6_kind_phys)) then + ! Delta scale + !call check_error_msg('rrtmgp_sw_main_delta_scale',sw_optical_props_clouds%delta_scale()) + + ! Add clear-sky to cloud-sky + 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(ix:ix), & ! IN - Cosine of solar zenith angle + coszen(ix:ix2), & ! 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) + flux_allsky)) ! OUT - Fluxes, clear-sky, 3D (1,nLay,nBand) + ! Store fluxes - fluxswUP_clrsky(ix,:) = sum(flux_clrsky%bnd_flux_up(1,:,:),dim=2) - fluxswDOWN_clrsky(ix,:) = sum(flux_clrsky%bnd_flux_dn(1,:,:),dim=2) - else - fluxswUP_clrsky(ix,:) = 0.0 - fluxswDOWN_clrsky(ix,:) = 0.0 + fluxswUP_allsky(ix:ix2,:) = sum(flux_allsky%bnd_flux_up, dim=3) + fluxswDOWN_allsky(ix:ix2,:) = 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 (cld_frac(ix+iblck-1,iSFC) .gt. 1.e-6_kind_phys) then + scmpsw(ix+iblck-1)%nirbm = scmpsw_allsky(iblck)%nirbm + scmpsw(ix+iblck-1)%nirdf = scmpsw_allsky(iblck)%nirdf + scmpsw(ix+iblck-1)%visbm = scmpsw_allsky(iblck)%visbm + scmpsw(ix+iblck-1)%visdf = scmpsw_allsky(iblck)%visdf + scmpsw(ix+iblck-1)%uvbfc = flux_allsky%bnd_flux_dn(iblck,iSFC,ibd_uv) + else + scmpsw(ix+iblck-1)%nirbm = scmpsw_clrsky(iblck)%nirbm + scmpsw(ix+iblck-1)%nirdf = scmpsw_clrsky(iblck)%nirdf + scmpsw(ix+iblck-1)%visbm = scmpsw_clrsky(iblck)%visbm + scmpsw(ix+iblck-1)%visdf = scmpsw_clrsky(iblck)%visdf + scmpsw(ix+iblck-1)%uvbfc = flux_clrsky%bnd_flux_dn(iblck,iSFC,ibd_uv) + endif + scmpsw(ix+iblck-1)%uvbf0 = flux_clrsky%bnd_flux_dn(iblck,iSFC,ibd_uv) + enddo + else ! No clouds + fluxswUP_allsky(ix:ix2,:) = sum(flux_clrsky%bnd_flux_up, dim=3) + fluxswDOWN_allsky(ix:ix2,:) = sum(flux_clrsky%bnd_flux_dn, dim=3) + do iblck = 1, rrtmgp_phys_blksz + scmpsw(ix+iblck-1)%nirbm = scmpsw_clrsky(iblck)%nirbm + scmpsw(ix+iblck-1)%nirdf = scmpsw_clrsky(iblck)%nirdf + scmpsw(ix+iblck-1)%visbm = scmpsw_clrsky(iblck)%visbm + scmpsw(ix+iblck-1)%visdf = scmpsw_clrsky(iblck)%visdf + scmpsw(ix+iblck-1)%uvbfc = flux_clrsky%bnd_flux_dn(iblck,iSFC,ibd_uv) + scmpsw(ix+iblck-1)%uvbf0 = flux_clrsky%bnd_flux_dn(iblck,iSFC,ibd_uv) + enddo endif - - ! ################################################################################### - ! - ! All-sky fluxes (clear-sky + clouds + precipitation) ! - ! ################################################################################### - - ! Include convective cloud? - if (doGP_sgs_cnv) then - call check_error_msg('rrtmgp_sw_main_increment_cnvclouds_to_clrsky',& - sw_optical_props_cnvcloudsByBand%increment(sw_optical_props_clouds)) - endif - - ! Include MYNN-EDMF PBL clouds? - if (doGP_sgs_pbl) then - call check_error_msg('rrtmgp_sw_main_increment_pblclouds_to_clrsky',& - sw_optical_props_pblcloudsByBand%increment(sw_optical_props_clouds)) - endif - - ! Add in precipitation - call check_error_msg('rrtmgp_sw_main_increment_precip_to_clrsky',& - sw_optical_props_precipByBand%increment(sw_optical_props_clouds)) - - ! Delta-scale optical properties - call check_error_msg('rrtmgp_sw_main_delta_scale',sw_optical_props_clrsky%delta_scale()) - call check_error_msg('rrtmgp_sw_main_rte_sw_allsky',rte_sw( & - sw_optical_props_clouds, & ! IN - optical-properties - top_at_1, & ! IN - veritcal ordering flag - coszen(ix:ix), & ! 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(ix,:) = sum(flux_allsky%bnd_flux_up(1,:,:),dim=2) - fluxswDOWN_allsky(ix,:) = sum(flux_allsky%bnd_flux_dn(1,:,:),dim=2) - ! Near IR - scmpsw(ix)%nirbm = sum(flux_allsky%bnd_flux_dn_dir(1,iSFC,1:ibd-1)) + & - flux_allsky%bnd_flux_dn_dir(1,iSFC,ibd)/2. - scmpsw(ix)%nirdf = (sum(flux_allsky%bnd_flux_dn(1,iSFC,1:ibd-1)) + & - flux_allsky%bnd_flux_dn(1,iSFC,ibd)/2.) - & - (sum(flux_allsky%bnd_flux_dn_dir(1,iSFC,1:ibd-1)) + & - flux_allsky%bnd_flux_dn_dir(1,iSFC,ibd)/2.) - ! UV-VIS - scmpsw(ix)%visbm = sum(flux_allsky%bnd_flux_dn_dir(1,iSFC,ibd+1:sw_gas_props%get_nband())) + & - flux_allsky%bnd_flux_dn_dir(1,iSFC,ibd)/2. - scmpsw(ix)%visdf = (sum(flux_allsky%bnd_flux_dn(1,iSFC,ibd+1:sw_gas_props%get_nband())) + & - flux_allsky%bnd_flux_dn(1,iSFC,ibd)/2. ) - & - (sum(flux_allsky%bnd_flux_dn_dir(1,iSFC,ibd+1:sw_gas_props%get_nband())) + & - flux_allsky%bnd_flux_dn_dir(1,iSFC,ibd)/2.) - enddo + enddo ! nday else fluxswUP_allsky(:,:) = 0._kind_phys fluxswDOWN_allsky(:,:) = 0._kind_phys diff --git a/physics/rrtmgp_sw_main.meta b/physics/rrtmgp_sw_main.meta index 634516ea1..956716c80 100644 --- a/physics/rrtmgp_sw_main.meta +++ b/physics/rrtmgp_sw_main.meta @@ -169,6 +169,20 @@ dimensions = () type = integer intent = in +[rrtmgp_phys_blksz] + standard_name = number_of_columns_per_RRTMGP_block + long_name = number of columns to process ata time by RRTMGP + 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 @@ -540,13 +554,6 @@ dimensions = () type = ty_optical_props_2str 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 [solcon] standard_name = solar_constant long_name = solar constant 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 9ab24c8b3..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_RRTMGP - long_name = flag for vertical ordering 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 -[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 From 99e032499991425b5a4af7d538228d3ac5edeecf Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Wed, 24 Aug 2022 22:44:18 +0000 Subject: [PATCH 07/19] Getting really close... --- physics/GFS_rrtmgp_lw_post.F90 | 188 --------- physics/GFS_rrtmgp_lw_post.meta | 253 ----------- physics/GFS_rrtmgp_post.F90 | 394 ++++++++++++++++++ ...tmgp_sw_post.meta => GFS_rrtmgp_post.meta} | 193 +++++++-- physics/GFS_rrtmgp_sw_post.F90 | 286 ------------- physics/rrtmgp_aerosol_optics.F90 | 49 +-- physics/rrtmgp_aerosol_optics.meta | 58 ++- physics/rrtmgp_lw_main.F90 | 15 +- physics/rrtmgp_lw_main.meta | 29 +- physics/rrtmgp_sw_cloud_optics.F90 | 181 -------- physics/rrtmgp_sw_gas_optics.F90 | 109 ----- physics/rrtmgp_sw_main.F90 | 20 +- physics/rrtmgp_sw_main.meta | 29 +- physics/rte-rrtmgp | 2 +- 14 files changed, 685 insertions(+), 1121 deletions(-) delete mode 100644 physics/GFS_rrtmgp_lw_post.F90 delete mode 100644 physics/GFS_rrtmgp_lw_post.meta create mode 100644 physics/GFS_rrtmgp_post.F90 rename physics/{GFS_rrtmgp_sw_post.meta => GFS_rrtmgp_post.meta} (70%) delete mode 100644 physics/GFS_rrtmgp_sw_post.F90 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..42161e4d6 --- /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(out) :: & + topfsw ! SW fluxes at top atmosphere + type(topflw_type), dimension(:), intent(out) :: & + 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 70% rename from physics/GFS_rrtmgp_sw_post.meta rename to physics/GFS_rrtmgp_post.meta index 7da3b10b0..0d6859f75 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,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_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 = out [nirbmdi] standard_name = surface_downwelling_direct_nir_shortwave_flux_on_radiation_timestep long_name = sfc nir beam sw downward flux @@ -338,7 +460,7 @@ units = W m-2 dimensions = (horizontal_loop_extent) type = topfsw_type - intent = inout + intent = out [htrswc] standard_name = tendency_of_air_temperature_due_to_shortwave_heating_assuming_clear_sky_on_radiation_timestep long_name = clear sky sw heating rates @@ -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_sw_post.F90 b/physics/GFS_rrtmgp_sw_post.F90 deleted file mode 100644 index 76e10df93..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(:) :: & - 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/rrtmgp_aerosol_optics.F90 b/physics/rrtmgp_aerosol_optics.F90 index c8c4991fe..cf3f7deea 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,9 +24,9 @@ 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, & - nDay, idxday, p_lev, p_lay, p_lk, tv_lay, relhum, lsmask, tracer, aerfld, lon, lat, & - 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, & + aerodp, aerlw_tau, aerlw_ssa, aerlw_g, aersw_tau, aersw_ssa, aersw_g, errmsg, errflg ) ! Inputs logical, intent(in) :: & @@ -63,19 +57,22 @@ subroutine rrtmgp_aerosol_optics_run(doSWrad, doLWrad, nCol, nLev, & ! 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(out) :: & - 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 @@ -101,22 +98,18 @@ subroutine rrtmgp_aerosol_optics_run(doSWrad, doLWrad, nCol, nLev, & 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 (doLWrad) then - call check_error_msg('rrtmgp_aerosol_optics_run',lw_optical_props_aerosol%alloc_1scl( & - nCol, nlev, lw_gas_props%get_band_lims_wavenumber())) - lw_optical_props_aerosol%tau = aerosolslw(:,:,:,1) * (1. - aerosolslw(:,:,:,2)) + 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 dee342fb5..6dbf9c73c 100644 --- a/physics/rrtmgp_aerosol_optics.meta +++ b/physics/rrtmgp_aerosol_optics.meta @@ -137,19 +137,53 @@ 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 -[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 +[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 [errmsg] standard_name = ccpp_error_message diff --git a/physics/rrtmgp_lw_main.F90 b/physics/rrtmgp_lw_main.F90 index 0277b276a..df46e8eda 100644 --- a/physics/rrtmgp_lw_main.F90 +++ b/physics/rrtmgp_lw_main.F90 @@ -109,10 +109,9 @@ subroutine rrtmgp_lw_main_run(doLWrad, doLWclrsky, top_at_1, doGP_lwscat, 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, & - lw_optical_props_aerosol, fluxlwUP_allsky, fluxlwDOWN_allsky, & - fluxlwUP_clrsky, fluxlwDOWN_clrsky, fluxlwUP_jac, fluxlwUP_radtime, & - fluxlwDOWN_radtime, errmsg, errflg) + 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) :: & @@ -173,10 +172,12 @@ subroutine rrtmgp_lw_main_run(doLWrad, doLWclrsky, top_at_1, doGP_lwscat, 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 - type(ty_optical_props_1scl),intent(inout) :: & - lw_optical_props_aerosol ! RRTMGP DDT: Longwave aerosol optical properties (tau) ! Outputs real(kind_phys), dimension(:,:), intent(inout) :: & @@ -482,7 +483,7 @@ subroutine rrtmgp_lw_main_run(doLWrad, doLWclrsky, top_at_1, doGP_lwscat, ! ! ################################################################################### ! Add aerosol optics to gas optics - lw_optical_props_aerosol_local%tau = lw_optical_props_aerosol%tau(iCol:iCol2,:,:) + 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)) diff --git a/physics/rrtmgp_lw_main.meta b/physics/rrtmgp_lw_main.meta index 334a75607..c4a0ec9ee 100644 --- a/physics/rrtmgp_lw_main.meta +++ b/physics/rrtmgp_lw_main.meta @@ -555,12 +555,29 @@ type = character kind = len=* intent = in -[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 +[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 diff --git a/physics/rrtmgp_sw_cloud_optics.F90 b/physics/rrtmgp_sw_cloud_optics.F90 index a750a549b..287fab719 100644 --- a/physics/rrtmgp_sw_cloud_optics.F90 +++ b/physics/rrtmgp_sw_cloud_optics.F90 @@ -2,7 +2,6 @@ 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 rrtmgp_sw_gas_optics, only: sw_gas_props use radiation_tools, only: check_error_msg use netcdf @@ -386,184 +385,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 - - ! ######################################################################################### - ! SUBROTUINE rrtmgp_sw_cloud_optics_run() - ! ######################################################################################### -!! \section arg_table_rrtmgp_sw_cloud_optics_run -!! \htmlinclude rrtmgp_sw_cloud_optics.html -!! - 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 - - ! ######################################################################################### - ! SUBROTUINE rrtmgp_sw_cloud_optics_finalize() - ! ######################################################################################### - subroutine rrtmgp_sw_cloud_optics_finalize() - end subroutine rrtmgp_sw_cloud_optics_finalize - end module rrtmgp_sw_cloud_optics diff --git a/physics/rrtmgp_sw_gas_optics.F90 b/physics/rrtmgp_sw_gas_optics.F90 index 4bafa56a4..823cdc1ca 100644 --- a/physics/rrtmgp_sw_gas_optics.F90 +++ b/physics/rrtmgp_sw_gas_optics.F90 @@ -14,7 +14,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 @@ -126,7 +125,6 @@ subroutine rrtmgp_sw_gas_optics_init(rrtmgp_root_dir, rrtmgp_sw_file_gas, character(len=264) :: sw_gas_props_file type(ty_gas_concs) :: gas_concentrations ! RRTMGP DDT containing active trace gases - ! Initialize errmsg = '' errflg = 0 @@ -504,113 +502,6 @@ subroutine rrtmgp_sw_gas_optics_init(rrtmgp_root_dir, rrtmgp_sw_file_gas, 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_main.F90 b/physics/rrtmgp_sw_main.F90 index a10f899e0..232bb5847 100644 --- a/physics/rrtmgp_sw_main.F90 +++ b/physics/rrtmgp_sw_main.F90 @@ -82,7 +82,7 @@ subroutine rrtmgp_sw_main_run(doSWrad, doSWclrsky, top_at_1, doGP_sgs_cnv, doGP_ 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, sw_optical_props_aerosol, solcon, scmpsw, & + active_gases_array, aersw_tau, aersw_ssa, aersw_g, solcon, scmpsw, & fluxswUP_allsky, fluxswDOWN_allsky, fluxswUP_clrsky, fluxswDOWN_clrsky, cldtausw, & errmsg, errflg) @@ -148,10 +148,12 @@ subroutine rrtmgp_sw_main_run(doSWrad, doSWclrsky, top_at_1, doGP_sgs_cnv, doGP_ 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 - type(ty_optical_props_2str),intent(in) :: & - sw_optical_props_aerosol ! RRTMGP DDT: Shortwave aerosol optical properties (tau,ssa,g) real(kind_phys), intent(in) :: & solcon ! Solar constant @@ -279,9 +281,9 @@ subroutine rrtmgp_sw_main_run(doSWrad, doSWclrsky, top_at_1, doGP_sgs_cnv, doGP_ sw_optical_props_precipByBand%tau = 0._kind_phys sw_optical_props_precipByBand%ssa = 0._kind_phys sw_optical_props_precipByBand%g = 0._kind_phys - sw_optical_props_aerosol_local%tau = 0._kind_phys - sw_optical_props_aerosol_local%ssa = 0._kind_phys - sw_optical_props_aerosol_local%g = 0._kind_phys + !sw_optical_props_aerosol_local%tau = 0._kind_phys + !sw_optical_props_aerosol_local%ssa = 0._kind_phys + !sw_optical_props_aerosol_local%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 @@ -502,9 +504,9 @@ subroutine rrtmgp_sw_main_run(doSWrad, doSWclrsky, top_at_1, doGP_sgs_cnv, doGP_ ! ! ################################################################################### ! Add aerosol optics to gaseous (clear-sky) optical properties - sw_optical_props_aerosol_local%tau = sw_optical_props_aerosol%tau(ix:ix2,:,:) - sw_optical_props_aerosol_local%ssa = sw_optical_props_aerosol%ssa(ix:ix2,:,:) - sw_optical_props_aerosol_local%g = sw_optical_props_aerosol%g(ix:ix2,:,:) + sw_optical_props_aerosol_local%tau = aersw_tau(iCol:iCol+rrtmgp_phys_blksz-1,:,:) + sw_optical_props_aerosol_local%ssa = aersw_ssa(iCol:iCol+rrtmgp_phys_blksz-1,:,:) + sw_optical_props_aerosol_local%g = aersw_g(iCol:iCol+rrtmgp_phys_blksz-1,:,:) call check_error_msg('rrtmgp_sw_main_increment_aerosol_to_clrsky', & sw_optical_props_aerosol_local%increment(sw_optical_props_accum)) diff --git a/physics/rrtmgp_sw_main.meta b/physics/rrtmgp_sw_main.meta index 956716c80..1d50a780e 100644 --- a/physics/rrtmgp_sw_main.meta +++ b/physics/rrtmgp_sw_main.meta @@ -547,12 +547,29 @@ type = character kind = len=* 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 +[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 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 From e1a452fba890f63d09fdd54b69946b3564fcaeac Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Wed, 24 Aug 2022 22:45:34 +0000 Subject: [PATCH 08/19] Updated submodule pointer --- .gitmodules | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) 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 From eeac3d6e1ea2525fbc96dcff831d6cada6a64f42 Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Fri, 26 Aug 2022 15:16:08 +0000 Subject: [PATCH 09/19] Some housekeeping. Working in UFS. --- CMakeLists.txt | 12 ----- physics/GFS_rrtmgp_post.meta | 2 +- physics/GFS_rrtmgp_pre.F90 | 32 ++++++------ physics/GFS_rrtmgp_pre.meta | 32 ------------ physics/rrtmgp_lw_cloud_optics.F90 | 34 ++++++------- physics/rrtmgp_lw_gas_optics.F90 | 35 ++++--------- physics/rrtmgp_lw_main.F90 | 81 ++++++++++++++---------------- physics/rrtmgp_lw_main.meta | 39 -------------- physics/rrtmgp_sw_cloud_optics.F90 | 43 +++++++--------- physics/rrtmgp_sw_gas_optics.F90 | 28 ++++------- physics/rrtmgp_sw_main.F90 | 73 +++++++++++++-------------- physics/rrtmgp_sw_main.meta | 7 --- 12 files changed, 144 insertions(+), 274 deletions(-) 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_post.meta b/physics/GFS_rrtmgp_post.meta index 0d6859f75..0caa1c387 100644 --- a/physics/GFS_rrtmgp_post.meta +++ b/physics/GFS_rrtmgp_post.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = GFS_rrtmgp_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 + dependencies = iounitdef.f,machine.F,radiation_aerosols.f,radlw_param.f,radiation_tools.F90,rte-rrtmgp/extensions/mo_heating_rates.F90 ######################################################################## [ccpp-arg-table] diff --git a/physics/GFS_rrtmgp_pre.F90 b/physics/GFS_rrtmgp_pre.F90 index 5b4bb025e..45b40b938 100644 --- a/physics/GFS_rrtmgp_pre.F90 +++ b/physics/GFS_rrtmgp_pre.F90 @@ -113,8 +113,8 @@ end subroutine GFS_rrtmgp_pre_init ! ######################################################################################### 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, vmr_o2, vmr_h2o, vmr_o3, vmr_ch4, & + 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, & @@ -130,10 +130,6 @@ subroutine GFS_rrtmgp_pre_run(me, nCol, nLev, i_o3, doSWrad, doLWrad, fhswr, fhl 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) :: & @@ -245,27 +241,29 @@ subroutine GFS_rrtmgp_pre_run(me, nCol, nLev, i_o3, doSWrad, doLWrad, fhswr, fhl ! 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 diff --git a/physics/GFS_rrtmgp_pre.meta b/physics/GFS_rrtmgp_pre.meta index 2eb9a92b4..f77ac89db 100644 --- a/physics/GFS_rrtmgp_pre.meta +++ b/physics/GFS_rrtmgp_pre.meta @@ -245,38 +245,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 [raddt] standard_name = time_step_for_radiation long_name = radiation time step diff --git a/physics/rrtmgp_lw_cloud_optics.F90 b/physics/rrtmgp_lw_cloud_optics.F90 index 58823a197..9915c0040 100644 --- a/physics/rrtmgp_lw_cloud_optics.F90 +++ b/physics/rrtmgp_lw_cloud_optics.F90 @@ -75,43 +75,39 @@ module rrtmgp_lw_cloud_optics ! ###################################################################################### ! SUBROUTINE rrtmgp_lw_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(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) diff --git a/physics/rrtmgp_lw_gas_optics.F90 b/physics/rrtmgp_lw_gas_optics.F90 index a50c8b7e0..8cd38f210 100644 --- a/physics/rrtmgp_lw_gas_optics.F90 +++ b/physics/rrtmgp_lw_gas_optics.F90 @@ -78,14 +78,15 @@ module rrtmgp_lw_gas_optics ! ######################################################################################### ! SUBROUTINE 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(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 @@ -96,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 = '' @@ -442,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, & @@ -454,13 +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 end module rrtmgp_lw_gas_optics diff --git a/physics/rrtmgp_lw_main.F90 b/physics/rrtmgp_lw_main.F90 index df46e8eda..4a0b47ba1 100644 --- a/physics/rrtmgp_lw_main.F90 +++ b/physics/rrtmgp_lw_main.F90 @@ -39,53 +39,46 @@ module rrtmgp_lw_main !! \section rrtmgp_lw_main_init !> @{ ! ###################################################################################### - subroutine rrtmgp_lw_main_init(rrtmgp_root_dir, rrtmgp_lw_file_gas, mpicomm, mpirank, & - mpiroot, minGPpres, maxGPpres, minGPtemp, maxGPtemp, active_gases_array, nrghice, & - doG_cldoptics, doGP_cldoptics_PADE, doGP_cldoptics_LUT, rrtmgp_lw_file_clouds, & - errmsg, errflg) + 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, nrghice, mpicomm, mpirank, mpiroot, nrghice, 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) :: & - doG_cldoptics, & ! Use legacy RRTMG cloud-optics? 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 - 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 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) :: & 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. ! 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, mpicomm, mpirank,& - mpiroot, minGPpres, maxGPpres, minGPtemp, maxGPtemp, active_gases_array, errmsg,& - errflg) + 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(nrghice, mpicomm, mpirank, mpiroot, doG_cldoptics, & - doGP_cldoptics_PADE, doGP_cldoptics_LUT, rrtmgp_root_dir, rrtmgp_lw_file_clouds,& + 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) end subroutine rrtmgp_lw_main_init @@ -226,14 +219,7 @@ subroutine rrtmgp_lw_main_run(doLWrad, doLWclrsky, top_at_1, doGP_lwscat, ! ###################################################################################### ! ty_gas_concs - gas_concs%ncol = rrtmgp_phys_blksz - gas_concs%nlay = nLay - allocate(gas_concs%gas_name(nGases)) - allocate(gas_concs%concs(nGases)) - do iGas=1,ngases - allocate(gas_concs%concs(iGas)%conc(rrtmgp_phys_blksz, nLay)) - enddo - gas_concs%gas_name(:) = active_gases_array(:) + 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',& @@ -270,10 +256,6 @@ subroutine rrtmgp_lw_main_run(doLWrad, doLWclrsky, top_at_1, doGP_lwscat, ! Initialize/reset ! ! ################################################################################### - ! ty_gas_concs - do iGas=1,nGases - gas_concs%concs(iGas)%conc(:,:) = 0._kind_phys - end do ! ty_optical_props lw_optical_props_clrsky%tau = 0._kind_phys lw_optical_props_precipByBand%tau = 0._kind_phys @@ -307,12 +289,18 @@ subroutine rrtmgp_lw_main_run(doLWrad, doLWclrsky, top_at_1, doGP_lwscat, ! Set gas-concentrations ! ! ################################################################################### - gas_concs%concs(istr_o2)%conc(:,:) = vmr_o2(iCol:iCol2,:) - gas_concs%concs(istr_co2)%conc(:,:) = vmr_co2(iCol:iCol2,:) - gas_concs%concs(istr_ch4)%conc(:,:) = vmr_ch4(iCol:iCol2,:) - gas_concs%concs(istr_n2o)%conc(:,:) = vmr_n2o(iCol:iCol2,:) - gas_concs%concs(istr_h2o)%conc(:,:) = vmr_h2o(iCol:iCol2,:) - gas_concs%concs(istr_o3)%conc(:,:) = vmr_o3(iCol:iCol2,:) + 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,:))) ! ################################################################################### ! @@ -361,6 +349,7 @@ subroutine rrtmgp_lw_main_run(doLWrad, doLWclrsky, top_at_1, doGP_lwscat, ! 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) @@ -368,12 +357,14 @@ subroutine rrtmgp_lw_main_run(doLWrad, doLWclrsky, top_at_1, doGP_lwscat, 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) @@ -381,6 +372,7 @@ subroutine rrtmgp_lw_main_run(doLWrad, doLWclrsky, top_at_1, doGP_lwscat, 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 @@ -411,6 +403,7 @@ subroutine rrtmgp_lw_main_run(doLWrad, doLWclrsky, top_at_1, doGP_lwscat, endif enddo enddo + ! Increment call check_error_msg('rrtmgp_lw_main_increment_precip_to_clouds',& lw_optical_props_precipByBand%increment(lw_optical_props_cloudsByBand)) @@ -482,7 +475,7 @@ subroutine rrtmgp_lw_main_run(doLWrad, doLWclrsky, top_at_1, doGP_lwscat, ! Compute clear-sky fluxes (gaseous+aerosol) (optional) ! ! ################################################################################### - ! Add aerosol optics to gas optics + ! 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)) @@ -534,7 +527,7 @@ subroutine rrtmgp_lw_main_run(doLWrad, doLWclrsky, top_at_1, doGP_lwscat, ! Include LW cloud-scattering? if (doGP_lwscat) then - ! Add clear-sky optics to cloud-optics (2-stream) + ! Increment call check_error_msg('rrtmgp_lw_main_increment_clrsky_to_clouds',& lw_optical_props_clrsky%increment(lw_optical_props_clouds)) @@ -559,7 +552,7 @@ subroutine rrtmgp_lw_main_run(doLWrad, doLWclrsky, top_at_1, doGP_lwscat, end if ! No scattering in LW clouds. else - ! Add cloud optics to clear-sky optics (scalar) + ! Increment call check_error_msg('rrtmgp_lw_main_increment_clouds_to_clrsky', & lw_optical_props_clouds%increment(lw_optical_props_clrsky)) diff --git a/physics/rrtmgp_lw_main.meta b/physics/rrtmgp_lw_main.meta index c4a0ec9ee..89e4bed2e 100644 --- a/physics/rrtmgp_lw_main.meta +++ b/physics/rrtmgp_lw_main.meta @@ -36,13 +36,6 @@ type = character intent = in kind = len=128 -[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. @@ -85,38 +78,6 @@ 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 diff --git a/physics/rrtmgp_sw_cloud_optics.F90 b/physics/rrtmgp_sw_cloud_optics.F90 index 287fab719..4293a7be6 100644 --- a/physics/rrtmgp_sw_cloud_optics.F90 +++ b/physics/rrtmgp_sw_cloud_optics.F90 @@ -48,44 +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 ! ###################################################################################### ! SUBROUTINE sw_cloud_optics_init ! ###################################################################################### -!! \section arg_table_rrtmgp_sw_cloud_optics_init -!! \htmlinclude rrtmgp_lw_cloud_optics.html -!! - 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 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) :: & @@ -101,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) @@ -161,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 diff --git a/physics/rrtmgp_sw_gas_optics.F90 b/physics/rrtmgp_sw_gas_optics.F90 index 823cdc1ca..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 @@ -82,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 @@ -99,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) :: & @@ -120,10 +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 = '' @@ -486,17 +483,14 @@ 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)) diff --git a/physics/rrtmgp_sw_main.F90 b/physics/rrtmgp_sw_main.F90 index 232bb5847..1c47f1cd0 100644 --- a/physics/rrtmgp_sw_main.F90 +++ b/physics/rrtmgp_sw_main.F90 @@ -28,26 +28,26 @@ module rrtmgp_sw_main !! \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, mpicomm, mpirank, & - mpiroot, active_gases_array, nrghice, doG_cldoptics, doGP_cldoptics_PADE, & - doGP_cldoptics_LUT,rrtmgp_sw_file_clouds, errmsg, errflg) + 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, 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 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) :: & - doG_cldoptics, & ! Use legacy RRTMG cloud-optics? 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 - 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 - rrtmgp_sw_file_gas ! RRTMGP file containing coefficients used to compute gaseous optical properties 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) :: & errmsg ! CCPP error message @@ -59,13 +59,14 @@ subroutine rrtmgp_sw_main_init(rrtmgp_root_dir, rrtmgp_sw_file_gas, mpicomm, mpi 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, & + 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(doG_cldoptics, doGP_cldoptics_PADE, doGP_cldoptics_LUT,& - nrghice, rrtmgp_root_dir, rrtmgp_sw_file_clouds, mpicomm, mpirank, mpiroot, errmsg,& - errflg) + 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) + end subroutine rrtmgp_sw_main_init ! ######################################################################################### @@ -222,14 +223,7 @@ subroutine rrtmgp_sw_main_run(doSWrad, doSWclrsky, top_at_1, doGP_sgs_cnv, doGP_ ! ###################################################################################### ! ty_gas_concs - gas_concs%ncol = rrtmgp_phys_blksz - gas_concs%nlay = nLay - allocate(gas_concs%gas_name(nGases)) - allocate(gas_concs%concs(nGases)) - do iGas=1,nGases - allocate(gas_concs%concs(iGas)%conc(rrtmgp_phys_blksz, nLay)) - enddo - gas_concs%gas_name(:) = active_gases_array(:) + 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',& @@ -281,9 +275,6 @@ subroutine rrtmgp_sw_main_run(doSWrad, doSWclrsky, top_at_1, doGP_sgs_cnv, doGP_ sw_optical_props_precipByBand%tau = 0._kind_phys sw_optical_props_precipByBand%ssa = 0._kind_phys sw_optical_props_precipByBand%g = 0._kind_phys - !sw_optical_props_aerosol_local%tau = 0._kind_phys - !sw_optical_props_aerosol_local%ssa = 0._kind_phys - !sw_optical_props_aerosol_local%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 @@ -302,13 +293,19 @@ subroutine rrtmgp_sw_main_run(doSWrad, doSWclrsky, top_at_1, doGP_sgs_cnv, doGP_ ! Set gas-concentrations ! ! ################################################################################### - gas_concs%concs(istr_o2)%conc(:,:) = vmr_o2(ix:ix2,:) - gas_concs%concs(istr_co2)%conc(:,:) = vmr_co2(ix:ix2,:) - gas_concs%concs(istr_ch4)%conc(:,:) = vmr_ch4(ix:ix2,:) - gas_concs%concs(istr_n2o)%conc(:,:) = vmr_n2o(ix:ix2,:) - gas_concs%concs(istr_h2o)%conc(:,:) = vmr_h2o(ix:ix2,:) - gas_concs%concs(istr_o3)%conc(:,:) = vmr_o3(ix:ix2,:) - + call check_error_msg('rrtmgp_sw_main_set_vmr_o2', & + gas_concs%set_vmr(trim(active_gases_array(istr_o2)), vmr_o2(ix:ix2,:))) + call check_error_msg('rrtmgp_sw_main_set_vmr_co2', & + gas_concs%set_vmr(trim(active_gases_array(istr_co2)),vmr_co2(ix:ix2,:))) + call check_error_msg('rrtmgp_sw_main_set_vmr_ch4', & + gas_concs%set_vmr(trim(active_gases_array(istr_ch4)),vmr_ch4(ix:ix2,:))) + call check_error_msg('rrtmgp_sw_main_set_vmr_n2o', & + gas_concs%set_vmr(trim(active_gases_array(istr_n2o)),vmr_n2o(ix:ix2,:))) + call check_error_msg('rrtmgp_sw_main_set_vmr_h2o', & + gas_concs%set_vmr(trim(active_gases_array(istr_h2o)),vmr_h2o(ix:ix2,:))) + call check_error_msg('rrtmgp_sw_main_set_vmr_o3', & + gas_concs%set_vmr(trim(active_gases_array(istr_o3)), vmr_o3(ix:ix2,:))) + ! ################################################################################### ! ! Set surface albedo @@ -373,6 +370,7 @@ subroutine rrtmgp_sw_main_run(doSWrad, doSWclrsky, top_at_1, doGP_sgs_cnv, doGP_ ! 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(ix:ix2,:), & ! IN - Convective cloud liquid water path (g/m2) cld_cnv_iwp(ix:ix2,:), & ! IN - Convective cloud ice water path (g/m2) @@ -380,13 +378,14 @@ subroutine rrtmgp_sw_main_run(doSWrad, doSWclrsky, top_at_1, doGP_sgs_cnv, doGP_ cld_cnv_reice(ix:ix2,:), & ! 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(ix:ix2,:), & ! IN - PBL cloud liquid water path (g/m2) cld_pbl_iwp(ix:ix2,:), & ! IN - PBL cloud ice water path (g/m2) @@ -394,7 +393,7 @@ subroutine rrtmgp_sw_main_run(doSWrad, doSWclrsky, top_at_1, doGP_sgs_cnv, doGP_ cld_pbl_reice(ix:ix2,:), & ! 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 @@ -433,7 +432,7 @@ subroutine rrtmgp_sw_main_run(doSWrad, doSWclrsky, top_at_1, doGP_sgs_cnv, doGP_ endif enddo enddo - ! + ! Increment call check_error_msg('rrtmgp_sw_main_increment_precip_to_clouds',& sw_optical_props_precipByBand%increment(sw_optical_props_cloudsByBand)) @@ -503,7 +502,7 @@ subroutine rrtmgp_sw_main_run(doSWrad, doSWclrsky, top_at_1, doGP_sgs_cnv, doGP_ ! Compute clear-sky fluxes (gaseous+aerosol) (optional) ! ! ################################################################################### - ! Add aerosol optics to gaseous (clear-sky) optical properties + ! Increment sw_optical_props_aerosol_local%tau = aersw_tau(iCol:iCol+rrtmgp_phys_blksz-1,:,:) sw_optical_props_aerosol_local%ssa = aersw_ssa(iCol:iCol+rrtmgp_phys_blksz-1,:,:) sw_optical_props_aerosol_local%g = aersw_g(iCol:iCol+rrtmgp_phys_blksz-1,:,:) @@ -563,7 +562,7 @@ subroutine rrtmgp_sw_main_run(doSWrad, doSWclrsky, top_at_1, doGP_sgs_cnv, doGP_ ! Delta scale !call check_error_msg('rrtmgp_sw_main_delta_scale',sw_optical_props_clouds%delta_scale()) - ! Add clear-sky to cloud-sky + ! Increment call check_error_msg('rrtmgp_sw_main_increment_clouds_to_clrsky', & sw_optical_props_clouds%increment(sw_optical_props_accum)) diff --git a/physics/rrtmgp_sw_main.meta b/physics/rrtmgp_sw_main.meta index 1d50a780e..78e435c96 100644 --- a/physics/rrtmgp_sw_main.meta +++ b/physics/rrtmgp_sw_main.meta @@ -36,13 +36,6 @@ type = character intent = in kind = len=128 -[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. From ad28dcac1e28fd53dc46e6436ae7f1a213da8739 Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Wed, 7 Sep 2022 05:47:33 +0000 Subject: [PATCH 10/19] Reorganize logic in solver loop --- physics/GFS_rrtmgp_pre.F90 | 3 ++ physics/rrtmgp_lw_main.F90 | 49 +++++++++++++++--------- physics/rrtmgp_sw_main.F90 | 78 +++++++++++++++++++++++++------------- 3 files changed, 87 insertions(+), 43 deletions(-) diff --git a/physics/GFS_rrtmgp_pre.F90 b/physics/GFS_rrtmgp_pre.F90 index 45b40b938..7de803015 100644 --- a/physics/GFS_rrtmgp_pre.F90 +++ b/physics/GFS_rrtmgp_pre.F90 @@ -25,6 +25,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, & diff --git a/physics/rrtmgp_lw_main.F90 b/physics/rrtmgp_lw_main.F90 index 4a0b47ba1..ab82dc56a 100644 --- a/physics/rrtmgp_lw_main.F90 +++ b/physics/rrtmgp_lw_main.F90 @@ -1,11 +1,11 @@ -! ###################################################################################### +! ########################################################################################### !> \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 use mo_optical_props, only: ty_optical_props_1scl, ty_optical_props_2str @@ -17,18 +17,19 @@ module rrtmgp_lw_main 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 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 + 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 public rrtmgp_lw_main_init, rrtmgp_lw_main_run contains - ! ###################################################################################### + ! ######################################################################################### !! \section arg_table_rrtmgp_lw_main_init !! \htmlinclude rrtmgp_lw_main_int.html !! @@ -38,10 +39,10 @@ module rrtmgp_lw_main !! !! \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, nrghice, mpicomm, mpirank, mpiroot, nrghice, errmsg, errflg) + ! ######################################################################################### + 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, nrghice, mpicomm, & + mpirank, mpiroot, errmsg, errflg) ! Inputs character(len=128),intent(in) :: & @@ -189,14 +190,15 @@ subroutine rrtmgp_lw_main_run(doLWrad, doLWclrsky, top_at_1, doGP_lwscat, ! Local variables 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, & + 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 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_phys), dimension(lw_gas_props%get_ngpt()) :: rng1D @@ -206,6 +208,7 @@ subroutine rrtmgp_lw_main_run(doLWrad, doLWclrsky, top_at_1, doGP_lwscat, 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 @@ -251,6 +254,18 @@ subroutine rrtmgp_lw_main_run(doLWrad, doLWclrsky, top_at_1, doGP_lwscat, do iCol=1,nCol,rrtmgp_phys_blksz iCol2 = 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(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 + ! ################################################################################### ! ! Initialize/reset @@ -309,7 +324,7 @@ subroutine rrtmgp_lw_main_run(doLWrad, doLWclrsky, top_at_1, doGP_lwscat, ! ################################################################################### ! Assign same emissivity to all band do iblck=1,rrtmgp_phys_blksz - if (semis(iCol+iblck-1) > 1e-6 .and. semis(iCol+iblck-1) <= 1.0) then + 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 @@ -338,7 +353,7 @@ subroutine rrtmgp_lw_main_run(doLWrad, doLWclrsky, top_at_1, doGP_lwscat, ! Compute cloud-optics... ! ! ################################################################################### - if (any(cld_frac(iCol:iCol2,:) .gt. 0.)) then + 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) @@ -387,7 +402,7 @@ subroutine rrtmgp_lw_main_run(doLWrad, doLWclrsky, top_at_1, doGP_lwscat, tau_snow(:) = 0._kind_phys do ix=1,rrtmgp_phys_blksz do iLay=1,nLay - if (cld_frac(iCol+ix-1,iLay) .gt. 0.) then + 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) @@ -413,7 +428,7 @@ subroutine rrtmgp_lw_main_run(doLWrad, doLWclrsky, top_at_1, doGP_lwscat, ! *Note* All of the included cloud-types are sampled together, not independently. ! ! ################################################################################### - if (any(cld_frac(iCol:iCol2,:) .gt. 0.)) then + 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 diff --git a/physics/rrtmgp_sw_main.F90 b/physics/rrtmgp_sw_main.F90 index 1c47f1cd0..325607daa 100644 --- a/physics/rrtmgp_sw_main.F90 +++ b/physics/rrtmgp_sw_main.F90 @@ -14,12 +14,14 @@ module rrtmgp_sw_main 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 + 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 public rrtmgp_sw_main_init, rrtmgp_sw_main_run + contains ! ######################################################################################### @@ -189,6 +191,7 @@ subroutine rrtmgp_sw_main_run(doSWrad, doSWclrsky, top_at_1, doGP_sgs_cnv, doGP_ 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_phys), dimension(sw_gas_props%get_ngpt()) :: rng1D real(kind_phys), dimension(sw_gas_props%get_ngpt(),nLay,rrtmgp_phys_blksz) :: rng3D,rng3D2 real(kind_phys), dimension(sw_gas_props%get_ngpt()*nLay) :: rng2D @@ -252,12 +255,32 @@ subroutine rrtmgp_sw_main_run(doSWrad, doSWclrsky, top_at_1, doGP_sgs_cnv, doGP_ flux_clrsky%bnd_flux_up => fluxSW_up_clrsky flux_clrsky%bnd_flux_dn => fluxSW_dn_clrsky + ! ###################################################################################### + ! ! Loop over all (daylit) columns... + ! + ! ###################################################################################### do iCol=1,nDay,rrtmgp_phys_blksz ix = idx(iCol) ix2 = idx(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(ix+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 + + ! ################################################################################### + ! ! Initialize/reset + ! + ! ################################################################################### fluxSW_up_allsky = 0._kind_phys fluxSW_dn_allsky = 0._kind_phys fluxSW_dn_dir_allsky = 0._kind_phys @@ -306,6 +329,25 @@ subroutine rrtmgp_sw_main_run(doSWrad, doSWclrsky, top_at_1, doGP_sgs_cnv, doGP_ call check_error_msg('rrtmgp_sw_main_set_vmr_o3', & gas_concs%set_vmr(trim(active_gases_array(istr_o3)), vmr_o3(ix:ix2,:))) + ! ################################################################################### + ! + ! Compute gas-optics + ! + ! ################################################################################### + + call check_error_msg('rrtmgp_sw_main_gas_optics',sw_gas_props%gas_optics(& + p_lay(ix:ix2,:), & ! IN - Pressure @ layer-centers (Pa) + p_lev(ix:ix2,:), & ! IN - Pressure @ layer-interfaces (Pa) + t_lay(ix:ix2,:), & ! 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 @@ -322,8 +364,10 @@ subroutine rrtmgp_sw_main_run(doSWrad, doSWclrsky, top_at_1, doGP_sgs_cnv, doGP_ sfc_alb_dif(iBand,iblck) = sfc_alb_nir_dif(ix+iblck-1) endif if (bandlimits(1,iBand) .eq. nIR_uvvis_bnd(1)) then - sfc_alb_dir(iBand,iblck) = 0.5_kind_phys*(sfc_alb_nir_dir(ix+iblck-1) + sfc_alb_uvvis_dir(ix+iblck-1)) - sfc_alb_dif(iBand,iblck) = 0.5_kind_phys*(sfc_alb_nir_dif(ix+iblck-1) + sfc_alb_uvvis_dif(ix+iblck-1)) + sfc_alb_dir(iBand,iblck) = 0.5_kind_phys*(sfc_alb_nir_dir(ix+iblck-1) + & + sfc_alb_uvvis_dir(ix+iblck-1)) + sfc_alb_dif(iBand,iblck) = 0.5_kind_phys*(sfc_alb_nir_dif(ix+iblck-1) + & + sfc_alb_uvvis_dif(ix+iblck-1)) ibd = iBand endif if (bandlimits(1,iBand) .ge. nIR_uvvis_bnd(2)) then @@ -333,31 +377,13 @@ subroutine rrtmgp_sw_main_run(doSWrad, doSWclrsky, top_at_1, doGP_sgs_cnv, doGP_ if (bandlimits(1,iBand) .eq. uvb_bnd(1)) ibd_uv = iBand enddo enddo - - ! ################################################################################### - ! - ! Compute gas-optics... - ! - ! ################################################################################### - call check_error_msg('rrtmgp_sw_main_gas_optics',sw_gas_props%gas_optics(& - p_lay(ix:ix2,:), & ! IN - Pressure @ layer-centers (Pa) - p_lev(ix:ix2,:), & ! IN - Pressure @ layer-interfaces (Pa) - t_lay(ix:ix2,:), & ! 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 ! ################################################################################### ! ! Compute optics for cloud(s) and precipitation, sample clouds... ! ! ################################################################################### - if (any(cld_frac(ix:ix2,:) .gt. 1.e-6_kind_phys)) then + if (any(zcf1 .gt. eps)) then ! Gridmean/mp-clouds call check_error_msg('rrtmgp_sw_main_cloud_optics',sw_cloud_props%cloud_optics(& cld_lwp(ix:ix2,:), & ! IN - Cloud liquid water path @@ -401,7 +427,7 @@ subroutine rrtmgp_sw_main_run(doSWrad, doSWclrsky, top_at_1, doGP_sgs_cnv, doGP_ ! Cloud precipitation optics: rain and snow(+groupel) do iblck = 1, rrtmgp_phys_blksz do iLay=1,nLay - if (cld_frac(ix+iblck-1,iLay) .gt. 1.e-12_kind_phys) then + if (cld_frac(ix+iblck-1,iLay) .gt. ftiny) then ! Rain/Snow optical depth (No band dependence) tau_rain = cld_rwp(ix+iblck-1,iLay)*a0r if (cld_swp(ix+iblck-1,iLay) .gt. 0. .and. cld_resnow(ix+iblck-1,iLay) .gt. 10._kind_phys) then @@ -499,7 +525,7 @@ subroutine rrtmgp_sw_main_run(doSWrad, doSWclrsky, top_at_1, doGP_sgs_cnv, doGP_ ! ################################################################################### ! - ! Compute clear-sky fluxes (gaseous+aerosol) (optional) + ! Compute clear-sky fluxes (gaseous+aerosol) ! ! ################################################################################### ! Increment @@ -558,7 +584,7 @@ subroutine rrtmgp_sw_main_run(doSWrad, doSWclrsky, top_at_1, doGP_sgs_cnv, doGP_ ! All-sky fluxes (clear-sky + clouds + precipitation) ! ! ################################################################################### - if (any(cld_frac(ix:ix2,:) .gt. 1.e-6_kind_phys)) then + if (any(zcf1 .gt. eps)) then ! Delta scale !call check_error_msg('rrtmgp_sw_main_delta_scale',sw_optical_props_clouds%delta_scale()) @@ -607,7 +633,7 @@ subroutine rrtmgp_sw_main_run(doSWrad, doSWclrsky, top_at_1, doGP_sgs_cnv, doGP_ scmpsw_allsky(iblck)%uvbfc = flux_allsky%bnd_flux_dn(iblck,iSFC,ibd_uv) enddo ! Store surface downward beam/diffused flux components - if (cld_frac(ix+iblck-1,iSFC) .gt. 1.e-6_kind_phys) then + if (zcf1(iblck) .gt. eps) then scmpsw(ix+iblck-1)%nirbm = scmpsw_allsky(iblck)%nirbm scmpsw(ix+iblck-1)%nirdf = scmpsw_allsky(iblck)%nirdf scmpsw(ix+iblck-1)%visbm = scmpsw_allsky(iblck)%visbm From dab7efdc064cc7f1ad36e1144ef3fa473cb2d520 Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Wed, 7 Sep 2022 15:18:11 -0600 Subject: [PATCH 11/19] Address issue 957 --- physics/GFS_rrtmgp_cloud_mp.F90 | 35 ++++++++++++++++++++------------ physics/GFS_rrtmgp_cloud_mp.meta | 8 ++++++++ 2 files changed, 30 insertions(+), 13 deletions(-) diff --git a/physics/GFS_rrtmgp_cloud_mp.F90 b/physics/GFS_rrtmgp_cloud_mp.F90 index 966c9f2e9..7b6f60554 100644 --- a/physics/GFS_rrtmgp_cloud_mp.F90 +++ b/physics/GFS_rrtmgp_cloud_mp.F90 @@ -43,7 +43,7 @@ subroutine GFS_rrtmgp_cloud_mp_run(nCol, nLev, nTracers, ncnd, i_cldliq, i_cldic 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, lwp_ex, iwp_ex, lwp_fc, iwp_fc, & - errmsg, errflg) + cldfra2d, errmsg, errflg) implicit none ! Inputs @@ -123,6 +123,8 @@ subroutine GFS_rrtmgp_cloud_mp_run(nCol, nLev, nTracers, ncnd, i_cldliq, i_cldic iwp_ex, & ! Total ice water path from explicit microphysics lwp_fc, & ! Total liquid water path from cloud fraction scheme iwp_fc ! Total ice water path from cloud fraction scheme + real(kind_phys), dimension(:), intent(out) :: & + cldfra2d ! Instantaneous 2D (max-in-column) cloud fraction real(kind_phys), dimension(:,:),intent(inout) :: & cld_frac, & ! Cloud-fraction for stratiform clouds cld_lwp, & ! Water path for stratiform liquid cloud-particles @@ -281,6 +283,13 @@ subroutine GFS_rrtmgp_cloud_mp_run(nCol, nLev, nTracers, ncnd, i_cldliq, i_cldic endif endif + do iCol = 1, nCol + cldfra2d(iCol) = 0._kind_phys + do iLay = 1, nLev-1 + cldfra2d(iCol) = max(cldfra2d(iCol), cld_frac(iCol,iLay)) + enddo + enddo + precip_frac(1:nCol,1:nLev) = cld_frac(1:nCol,1:nLev) end subroutine GFS_rrtmgp_cloud_mp_run @@ -459,23 +468,23 @@ 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) :: tem0, tem1, deltaP, clwc @@ -487,13 +496,13 @@ subroutine cloud_mp_SAMF(nCol, nLev, t_lay, p_lev, p_lay, qs_lay, relhum, 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)) * tem0 * deltaP - cld_cnv_iwp(iCol,iLay) = clwc * tem1 - cld_cnv_lwp(iCol,iLay) = clwc - cld_cnv_iwp(iCol,iLay) + 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 diff --git a/physics/GFS_rrtmgp_cloud_mp.meta b/physics/GFS_rrtmgp_cloud_mp.meta index 88a050abb..a5a986b8a 100644 --- a/physics/GFS_rrtmgp_cloud_mp.meta +++ b/physics/GFS_rrtmgp_cloud_mp.meta @@ -639,6 +639,14 @@ type = real kind = kind_phys intent = inout +[cldfra2d] + standard_name = max_in_column_cloud_fraction + long_name = instantaneous 2D (max-in-column) cloud fraction + units = frac + dimensions = (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 From d35be37ed9441d449efeb3dae2c536ceb1cb4cf9 Mon Sep 17 00:00:00 2001 From: dustinswales Date: Fri, 23 Sep 2022 08:49:05 -0600 Subject: [PATCH 12/19] Some modifications for rrtmgp physics blocking to work. --- physics/rrtmgp_lw_main.F90 | 77 ++++++++++++++++-------------- physics/rrtmgp_sw_main.F90 | 96 +++++++++++++++++++++++--------------- 2 files changed, 101 insertions(+), 72 deletions(-) diff --git a/physics/rrtmgp_lw_main.F90 b/physics/rrtmgp_lw_main.F90 index ab82dc56a..0ea0c3f7c 100644 --- a/physics/rrtmgp_lw_main.F90 +++ b/physics/rrtmgp_lw_main.F90 @@ -195,19 +195,17 @@ subroutine rrtmgp_lw_main_run(doLWrad, doLWclrsky, top_at_1, doGP_lwscat, lw_optical_props_precipByBand type(ty_source_func_lw) :: sources type(ty_fluxes_byband) :: flux_allsky, flux_clrsky - integer :: iCol, iLay, iGas, iBand, iCol2, ix, iblck - integer, dimension(rrtmgp_phys_blksz) :: ipseed_lw + integer :: iCol, iLay, iGas, iBand, iCol2, ix, iblck, blksz + 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_phys), dimension(lw_gas_props%get_ngpt()) :: rng1D - real(kind_phys), dimension(lw_gas_props%get_ngpt(),nLay,rrtmgp_phys_blksz) :: rng3D,rng3D2 - real(kind_phys), 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 + real(kind_phys) :: tau_rain, tau_snow + integer, dimension(:), allocatable :: ipseed_lw + real(kind_phys), dimension(:), allocatable :: zcf0, zcf1, rng2D + real(kind_phys), dimension(:,:), allocatable :: lw_Ds, sfc_emiss_byband + real(kind_phys), dimension(:,:,:), allocatable :: rng3D,rng3D2 + logical, dimension(:,:,:), allocatable :: maskMCICA + real(kind_phys), dimension(:,:,:), allocatable, target :: fluxLW_up_allsky, fluxLW_up_clrsky, fluxLW_dn_allsky, fluxLW_dn_clrsky ! Initialize CCPP error handling variables errmsg = '' @@ -220,30 +218,43 @@ subroutine rrtmgp_lw_main_run(doLWrad, doLWclrsky, top_at_1, doGP_lwscat, ! Allocate/initialize RRTMGP DDT's ! ! ###################################################################################### + blksz = minval((/nCol,rrtmgp_phys_blksz/)) + + allocate(ipseed_lw(blksz), zcf0(blksz), zcf1(blksz), & + maskMCICA(blksz,nLay,lw_gas_props%get_ngpt()), & + rng3D(lw_gas_props%get_ngpt(),nLay,blksz), & + rng3D2(lw_gas_props%get_ngpt(),nLay,blksz), & + rng2D(lw_gas_props%get_ngpt()*nLay), & + fluxLW_up_allsky(blksz,nLay+1,lw_gas_props%get_nband()), & + fluxLW_up_clrsky(blksz,nLay+1,lw_gas_props%get_nband()), & + fluxLW_dn_allsky(blksz,nLay+1,lw_gas_props%get_nband()), & + fluxLW_dn_clrsky(blksz,nLay+1,lw_gas_props%get_nband()), & + lw_Ds(blksz,lw_gas_props%get_ngpt()), & + sfc_emiss_byband(lw_gas_props%get_nband(),blksz)) ! 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)) + lw_optical_props_clrsky%alloc_1scl(blksz, nLay, lw_gas_props)) call check_error_msg('rrtmgp_lw_main_sources_init',& - sources%alloc(rrtmgp_phys_blksz, nLay, lw_gas_props)) + sources%alloc(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())) + lw_optical_props_cloudsByBand%alloc_2str(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())) + lw_optical_props_precipByBand%alloc_2str(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)) + lw_optical_props_clouds%alloc_2str(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())) + lw_optical_props_aerosol_local%alloc_1scl(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())) + lw_optical_props_cnvcloudsByBand%alloc_2str(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())) + lw_optical_props_pblcloudsByBand%alloc_2str(blksz, nLay, lw_gas_props%get_band_lims_wavenumber())) endif ! ###################################################################################### @@ -251,13 +262,13 @@ subroutine rrtmgp_lw_main_run(doLWrad, doLWclrsky, top_at_1, doGP_lwscat, ! Loop over all columns... ! ! ###################################################################################### - do iCol=1,nCol,rrtmgp_phys_blksz - iCol2 = iCol + rrtmgp_phys_blksz - 1 + do iCol=1,nCol,blksz + iCol2 = iCol + blksz - 1 ! Create clear/cloudy indicator zcf0(:) = 1._kind_phys zcf1(:) = 1._kind_phys - do iblck = 1, rrtmgp_phys_blksz + do iblck = 1, blksz do iLay=1,nLay zcf0(iblck) = min(zcf0(iblck), 1._kind_phys - cld_frac(iCol+iblck-1,iLay)) enddo @@ -323,7 +334,7 @@ subroutine rrtmgp_lw_main_run(doLWrad, doLWclrsky, top_at_1, doGP_lwscat, ! ! ################################################################################### ! Assign same emissivity to all band - do iblck=1,rrtmgp_phys_blksz + do iblck=1,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) @@ -398,22 +409,20 @@ subroutine rrtmgp_lw_main_run(doLWrad, doLWclrsky, top_at_1, doGP_lwscat, ! Cloud precipitation optics: rain and snow(+groupel) ! ! ################################################################################### - tau_rain(:) = 0._kind_phys - tau_snow(:) = 0._kind_phys - do ix=1,rrtmgp_phys_blksz + do ix=1,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) + tau_rain = 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) + tau_snow = abssnow0*1.05756*cld_swp(iCol+ix-1,iLay)/cld_resnow(iCol+ix-1,iLay) else - tau_snow(ix) = 0.0 + tau_snow = 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) + lw_optical_props_precipByBand%tau(ix,iLay,iBand) = tau_rain + tau_snow enddo endif enddo @@ -431,17 +440,17 @@ subroutine rrtmgp_lw_main_run(doLWrad, doLWclrsky, top_at_1, doGP_lwscat, 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 + do ix=1,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 + do ix=1,blksz ipseed_lw(ix) = icseed_lw(iCol+ix-1) enddo endif ! Call RNG - do ix=1,rrtmgp_phys_blksz + do ix=1,blksz call random_setseed(ipseed_lw(ix),rng_stat) ! Use same rng for each layer if (iovr == iovr_max) then @@ -464,7 +473,7 @@ subroutine rrtmgp_lw_main_run(doLWrad, doLWclrsky, top_at_1, doGP_lwscat, endif ! Exponential decorrelation length overlap if (iovr == iovr_dcorr) then - do ix=1,rrtmgp_phys_blksz + do ix=1,blksz ! Generate second RNG call random_setseed(ipseed_lw(ix),rng_stat) call random_number(rng2D,rng_stat) diff --git a/physics/rrtmgp_sw_main.F90 b/physics/rrtmgp_sw_main.F90 index 325607daa..ea2f36273 100644 --- a/physics/rrtmgp_sw_main.F90 +++ b/physics/rrtmgp_sw_main.F90 @@ -110,8 +110,8 @@ subroutine rrtmgp_sw_main_run(doSWrad, doSWclrsky, top_at_1, doGP_sgs_cnv, doGP_ 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 + isubc_sw, & ! Flag for sw clouds sub-grid approximation + iSFC ! Surface layer index integer,intent(in),dimension(:) :: & idx, & ! Index array for daytime points icseed_sw ! Seed for random number generation for shortwave radiation @@ -150,7 +150,7 @@ subroutine rrtmgp_sw_main_run(doSWrad, doSWclrsky, top_at_1, doGP_sgs_cnv, doGP_ 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_param ! Cloud overlap parameter real(kind_phys), dimension(:,:,:), intent(in) :: & aersw_tau, & ! Aerosol optical depth aersw_ssa, & ! Aerosol single scattering albedo @@ -182,7 +182,6 @@ subroutine rrtmgp_sw_main_run(doSWrad, doSWclrsky, top_at_1, doGP_sgs_cnv, doGP_ ! visdf - downward uv+vis diffused flux (W/m2) ! Local variables - type(cmpfsw_type), dimension(rrtmgp_phys_blksz) :: scmpsw_clrsky, scmpsw_allsky 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, & @@ -191,24 +190,24 @@ subroutine rrtmgp_sw_main_run(doSWrad, doSWclrsky, top_at_1, doGP_sgs_cnv, doGP_ 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_phys), dimension(sw_gas_props%get_ngpt()) :: rng1D - real(kind_phys), dimension(sw_gas_props%get_ngpt(),nLay,rrtmgp_phys_blksz) :: rng3D,rng3D2 real(kind_phys), dimension(sw_gas_props%get_ngpt()*nLay) :: rng2D - logical, dimension(rrtmgp_phys_blksz,nLay,sw_gas_props%get_ngpt()) :: maskMCICA - 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 + integer :: iBand, ibd, ibd_uv, iCol, iGas, iLay, ix, ix2, iblck, blksz 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 + + type(cmpfsw_type), dimension(:), allocatable :: scmpsw_clrsky, scmpsw_allsky + integer, dimension(:), allocatable :: ipseed_sw + real(kind_phys), dimension(:), allocatable :: zcf0, zcf1 + real(kind_phys), dimension(:,:), allocatable :: toa_src_sw, sfc_alb_dir, sfc_alb_dif + real(kind_phys), dimension(:,:,:), allocatable :: rng3D,rng3D2 + logical, dimension(:,:,:), allocatable :: maskMCICA + real(kind_phys), dimension(:,:,:), allocatable, target :: & + fluxSW_up_allsky, fluxSW_up_clrsky, fluxSW_dn_dir_clrsky, fluxSW_dn_allsky, & + fluxSW_dn_clrsky, fluxSW_dn_dir_allsky ! Initialize CCPP error handling variables errmsg = '' @@ -218,34 +217,51 @@ subroutine rrtmgp_sw_main_run(doSWrad, doSWclrsky, top_at_1, doGP_sgs_cnv, doGP_ if (nDay .gt. 0) then + ! bandlimits = sw_gas_props%get_band_lims_wavenumber() + ! ###################################################################################### ! ! Allocate/initialize RRTMGP DDT's ! ! ###################################################################################### + blksz = minval((/nDay,rrtmgp_phys_blksz/)) + + allocate(scmpsw_clrsky(blksz), scmpsw_allsky(blksz), zcf0(blksz), zcf1(blksz), & + rng3D(sw_gas_props%get_ngpt(),nLay,blksz), & + rng3D2(sw_gas_props%get_ngpt(),nLay,blksz), & + maskMCICA(blksz,nLay,sw_gas_props%get_ngpt()), & + sfc_alb_dir(sw_gas_props%get_nband(),blksz), & + sfc_alb_dif(sw_gas_props%get_nband(),blksz), & + fluxSW_up_allsky(blksz,nLay+1,sw_gas_props%get_nband()), & + fluxSW_up_clrsky(blksz,nLay+1,sw_gas_props%get_nband()), & + fluxSW_dn_dir_clrsky(blksz,nLay+1,sw_gas_props%get_nband()), & + fluxSW_dn_allsky(blksz,nLay+1,sw_gas_props%get_nband()), & + fluxSW_dn_clrsky(blksz,nLay+1,sw_gas_props%get_nband()), & + fluxSW_dn_dir_allsky(blksz,nLay+1,sw_gas_props%get_nband()), & + ipseed_sw(blksz), toa_src_sw(blksz,sw_gas_props%get_ngpt())) ! 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)) + sw_optical_props_accum%alloc_2str(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())) + sw_optical_props_cloudsByBand%alloc_2str(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())) + sw_optical_props_precipByBand%alloc_2str(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)) + sw_optical_props_clouds%alloc_2str(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())) + sw_optical_props_aerosol_local%alloc_2str(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())) + sw_optical_props_cnvcloudsByBand%alloc_2str(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())) + sw_optical_props_pblcloudsByBand%alloc_2str(blksz, nLay, sw_gas_props%get_band_lims_wavenumber())) endif ! ty_fluxes_byband @@ -260,14 +276,18 @@ subroutine rrtmgp_sw_main_run(doSWrad, doSWclrsky, top_at_1, doGP_sgs_cnv, doGP_ ! Loop over all (daylit) columns... ! ! ###################################################################################### - do iCol=1,nDay,rrtmgp_phys_blksz + do iCol=1,nDay,blksz ix = idx(iCol) - ix2 = idx(iCol + rrtmgp_phys_blksz - 1) + ix2 = idx(iCol) + blksz - 1 + if (ix2 > nDay) then + ix = nDay - blksz + 1 + ix2 = nDay + endif ! Create clear/cloudy indicator zcf0(:) = 1._kind_phys zcf1(:) = 1._kind_phys - do iblck = 1, rrtmgp_phys_blksz + do iblck = 1, blksz do iLay=1,nLay zcf0(iblck) = min(zcf0(iblck), 1._kind_phys - cld_frac(ix+iblck-1,iLay)) enddo @@ -344,7 +364,7 @@ subroutine rrtmgp_sw_main_run(doSWrad, doSWclrsky, top_at_1, doGP_sgs_cnv, doGP_ ! spectral point (tau,ssa,g) toa_src_sw)) ! OUT - TOA incident shortwave radiation (spectral) ! Scale incident flux - do iblck = 1, rrtmgp_phys_blksz + do iblck = 1, blksz toa_src_sw(iblck,:) = toa_src_sw(iblck,:)*solcon / sum(toa_src_sw(iblck,:)) enddo @@ -357,7 +377,7 @@ subroutine rrtmgp_sw_main_run(doSWrad, doSWclrsky, top_at_1, doGP_sgs_cnv, doGP_ ! For overlapping band, average near-IR and us-vis albedos. ! ! ################################################################################### - do iblck = 1, rrtmgp_phys_blksz + do iblck = 1, 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(ix+iblck-1) @@ -425,7 +445,7 @@ subroutine rrtmgp_sw_main_run(doSWrad, doSWclrsky, top_at_1, doGP_sgs_cnv, doGP_ endif ! Cloud precipitation optics: rain and snow(+groupel) - do iblck = 1, rrtmgp_phys_blksz + do iblck = 1, blksz do iLay=1,nLay if (cld_frac(ix+iblck-1,iLay) .gt. ftiny) then ! Rain/Snow optical depth (No band dependence) @@ -469,17 +489,17 @@ subroutine rrtmgp_sw_main_run(doSWrad, doSWclrsky, top_at_1, doGP_sgs_cnv, doGP_ ! ################################################################################### ! 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 + do iblck = 1, blksz ipseed_sw(iblck) = sw_gas_props%get_ngpt() + iCol + iblck - 1 enddo elseif (isubc_sw == 2) then ! use input array of permutaion seeds - do iblck = 1, rrtmgp_phys_blksz + do iblck = 1, blksz ipseed_sw(iblck) = icseed_sw(ix+iblck-1) enddo endif ! Call RNG - do iblck = 1, rrtmgp_phys_blksz + do iblck = 1, blksz call random_setseed(ipseed_sw(iblck),rng_stat) ! Use same rng for each layer if (iovr == iovr_max) then @@ -502,7 +522,7 @@ subroutine rrtmgp_sw_main_run(doSWrad, doSWclrsky, top_at_1, doGP_sgs_cnv, doGP_ endif ! Exponential decorrelation length overlap if (iovr == iovr_dcorr) then - do iblck = 1, rrtmgp_phys_blksz + do iblck = 1, blksz ! Generate second RNG call random_setseed(ipseed_sw(iblck),rng_stat) call random_number(rng2D,rng_stat) @@ -529,9 +549,9 @@ subroutine rrtmgp_sw_main_run(doSWrad, doSWclrsky, top_at_1, doGP_sgs_cnv, doGP_ ! ! ################################################################################### ! Increment - sw_optical_props_aerosol_local%tau = aersw_tau(iCol:iCol+rrtmgp_phys_blksz-1,:,:) - sw_optical_props_aerosol_local%ssa = aersw_ssa(iCol:iCol+rrtmgp_phys_blksz-1,:,:) - sw_optical_props_aerosol_local%g = aersw_g(iCol:iCol+rrtmgp_phys_blksz-1,:,:) + sw_optical_props_aerosol_local%tau = aersw_tau(iCol:iCol+blksz-1,:,:) + sw_optical_props_aerosol_local%ssa = aersw_ssa(iCol:iCol+blksz-1,:,:) + sw_optical_props_aerosol_local%g = aersw_g(iCol:iCol+blksz-1,:,:) call check_error_msg('rrtmgp_sw_main_increment_aerosol_to_clrsky', & sw_optical_props_aerosol_local%increment(sw_optical_props_accum)) @@ -553,7 +573,7 @@ subroutine rrtmgp_sw_main_run(doSWrad, doSWclrsky, top_at_1, doGP_sgs_cnv, doGP_ fluxswDOWN_clrsky(ix:ix2,:) = sum(flux_clrsky%bnd_flux_dn, dim=3) ! Compute surface downward beam/diffused flux components - do iblck = 1, rrtmgp_phys_blksz + do iblck = 1, blksz do iBand=1,sw_gas_props%get_nband() flux_dir = flux_clrsky%bnd_flux_dn(iblck,iSFC,iBand) flux_dif = 0._kind_phys @@ -607,7 +627,7 @@ subroutine rrtmgp_sw_main_run(doSWrad, doSWclrsky, top_at_1, doGP_sgs_cnv, doGP_ fluxswDOWN_allsky(ix:ix2,:) = sum(flux_allsky%bnd_flux_dn, dim=3) ! Compute and store downward beam/diffused flux components - do iblck = 1, rrtmgp_phys_blksz + do iblck = 1, 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) @@ -651,7 +671,7 @@ subroutine rrtmgp_sw_main_run(doSWrad, doSWclrsky, top_at_1, doGP_sgs_cnv, doGP_ else ! No clouds fluxswUP_allsky(ix:ix2,:) = sum(flux_clrsky%bnd_flux_up, dim=3) fluxswDOWN_allsky(ix:ix2,:) = sum(flux_clrsky%bnd_flux_dn, dim=3) - do iblck = 1, rrtmgp_phys_blksz + do iblck = 1, blksz scmpsw(ix+iblck-1)%nirbm = scmpsw_clrsky(iblck)%nirbm scmpsw(ix+iblck-1)%nirdf = scmpsw_clrsky(iblck)%nirdf scmpsw(ix+iblck-1)%visbm = scmpsw_clrsky(iblck)%visbm From b65af77c56476d6c7e34735fe60daa667fa84989 Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Mon, 3 Oct 2022 19:47:05 +0000 Subject: [PATCH 13/19] Revert "Some modifications for rrtmgp physics blocking to work." This reverts commit d35be37ed9441d449efeb3dae2c536ceb1cb4cf9. --- physics/rrtmgp_lw_main.F90 | 77 ++++++++++++++---------------- physics/rrtmgp_sw_main.F90 | 96 +++++++++++++++----------------------- 2 files changed, 72 insertions(+), 101 deletions(-) diff --git a/physics/rrtmgp_lw_main.F90 b/physics/rrtmgp_lw_main.F90 index 0ea0c3f7c..ab82dc56a 100644 --- a/physics/rrtmgp_lw_main.F90 +++ b/physics/rrtmgp_lw_main.F90 @@ -195,17 +195,19 @@ subroutine rrtmgp_lw_main_run(doLWrad, doLWclrsky, top_at_1, doGP_lwscat, lw_optical_props_precipByBand type(ty_source_func_lw) :: sources type(ty_fluxes_byband) :: flux_allsky, flux_clrsky - integer :: iCol, iLay, iGas, iBand, iCol2, ix, iblck, blksz - + 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_phys), dimension(lw_gas_props%get_ngpt()) :: rng1D - real(kind_phys) :: tau_rain, tau_snow - integer, dimension(:), allocatable :: ipseed_lw - real(kind_phys), dimension(:), allocatable :: zcf0, zcf1, rng2D - real(kind_phys), dimension(:,:), allocatable :: lw_Ds, sfc_emiss_byband - real(kind_phys), dimension(:,:,:), allocatable :: rng3D,rng3D2 - logical, dimension(:,:,:), allocatable :: maskMCICA - real(kind_phys), dimension(:,:,:), allocatable, target :: fluxLW_up_allsky, fluxLW_up_clrsky, fluxLW_dn_allsky, fluxLW_dn_clrsky + real(kind_phys), dimension(lw_gas_props%get_ngpt(),nLay,rrtmgp_phys_blksz) :: rng3D,rng3D2 + real(kind_phys), 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 = '' @@ -218,43 +220,30 @@ subroutine rrtmgp_lw_main_run(doLWrad, doLWclrsky, top_at_1, doGP_lwscat, ! Allocate/initialize RRTMGP DDT's ! ! ###################################################################################### - blksz = minval((/nCol,rrtmgp_phys_blksz/)) - - allocate(ipseed_lw(blksz), zcf0(blksz), zcf1(blksz), & - maskMCICA(blksz,nLay,lw_gas_props%get_ngpt()), & - rng3D(lw_gas_props%get_ngpt(),nLay,blksz), & - rng3D2(lw_gas_props%get_ngpt(),nLay,blksz), & - rng2D(lw_gas_props%get_ngpt()*nLay), & - fluxLW_up_allsky(blksz,nLay+1,lw_gas_props%get_nband()), & - fluxLW_up_clrsky(blksz,nLay+1,lw_gas_props%get_nband()), & - fluxLW_dn_allsky(blksz,nLay+1,lw_gas_props%get_nband()), & - fluxLW_dn_clrsky(blksz,nLay+1,lw_gas_props%get_nband()), & - lw_Ds(blksz,lw_gas_props%get_ngpt()), & - sfc_emiss_byband(lw_gas_props%get_nband(),blksz)) ! 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(blksz, nLay, lw_gas_props)) + lw_optical_props_clrsky%alloc_1scl(rrtmgp_phys_blksz, nLay, lw_gas_props)) call check_error_msg('rrtmgp_lw_main_sources_init',& - sources%alloc(blksz, nLay, lw_gas_props)) + 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(blksz, nLay, lw_gas_props%get_band_lims_wavenumber())) + 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(blksz, nLay, lw_gas_props%get_band_lims_wavenumber())) + 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(blksz, nLay, lw_gas_props)) + 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(blksz, nLay, lw_gas_props%get_band_lims_wavenumber())) + 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(blksz, nLay, lw_gas_props%get_band_lims_wavenumber())) + 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(blksz, nLay, lw_gas_props%get_band_lims_wavenumber())) + lw_optical_props_pblcloudsByBand%alloc_2str(rrtmgp_phys_blksz, nLay, lw_gas_props%get_band_lims_wavenumber())) endif ! ###################################################################################### @@ -262,13 +251,13 @@ subroutine rrtmgp_lw_main_run(doLWrad, doLWclrsky, top_at_1, doGP_lwscat, ! Loop over all columns... ! ! ###################################################################################### - do iCol=1,nCol,blksz - iCol2 = iCol + blksz - 1 + do iCol=1,nCol,rrtmgp_phys_blksz + iCol2 = iCol + rrtmgp_phys_blksz - 1 ! Create clear/cloudy indicator zcf0(:) = 1._kind_phys zcf1(:) = 1._kind_phys - do iblck = 1, blksz + 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 @@ -334,7 +323,7 @@ subroutine rrtmgp_lw_main_run(doLWrad, doLWclrsky, top_at_1, doGP_lwscat, ! ! ################################################################################### ! Assign same emissivity to all band - do iblck=1,blksz + 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) @@ -409,20 +398,22 @@ subroutine rrtmgp_lw_main_run(doLWrad, doLWclrsky, top_at_1, doGP_lwscat, ! Cloud precipitation optics: rain and snow(+groupel) ! ! ################################################################################### - do ix=1,blksz + 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 = absrain*cld_rwp(iCol+ix-1,iLay) + 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 = abssnow0*1.05756*cld_swp(iCol+ix-1,iLay)/cld_resnow(iCol+ix-1,iLay) + tau_snow(ix) = abssnow0*1.05756*cld_swp(iCol+ix-1,iLay)/cld_resnow(iCol+ix-1,iLay) else - tau_snow = 0.0 + tau_snow(ix) = 0.0 endif do iBand=1,lw_gas_props%get_nband() - lw_optical_props_precipByBand%tau(ix,iLay,iBand) = tau_rain + tau_snow + lw_optical_props_precipByBand%tau(ix,iLay,iBand) = tau_rain(ix) + tau_snow(ix) enddo endif enddo @@ -440,17 +431,17 @@ subroutine rrtmgp_lw_main_run(doLWrad, doLWclrsky, top_at_1, doGP_lwscat, 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,blksz + 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,blksz + do ix=1,rrtmgp_phys_blksz ipseed_lw(ix) = icseed_lw(iCol+ix-1) enddo endif ! Call RNG - do ix=1,blksz + 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 @@ -473,7 +464,7 @@ subroutine rrtmgp_lw_main_run(doLWrad, doLWclrsky, top_at_1, doGP_lwscat, endif ! Exponential decorrelation length overlap if (iovr == iovr_dcorr) then - do ix=1,blksz + do ix=1,rrtmgp_phys_blksz ! Generate second RNG call random_setseed(ipseed_lw(ix),rng_stat) call random_number(rng2D,rng_stat) diff --git a/physics/rrtmgp_sw_main.F90 b/physics/rrtmgp_sw_main.F90 index ea2f36273..325607daa 100644 --- a/physics/rrtmgp_sw_main.F90 +++ b/physics/rrtmgp_sw_main.F90 @@ -110,8 +110,8 @@ subroutine rrtmgp_sw_main_run(doSWrad, doSWclrsky, top_at_1, doGP_sgs_cnv, doGP_ 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, & ! Flag for sw clouds sub-grid approximation - iSFC ! Surface layer index + isubc_sw, & ! + iSFC integer,intent(in),dimension(:) :: & idx, & ! Index array for daytime points icseed_sw ! Seed for random number generation for shortwave radiation @@ -150,7 +150,7 @@ subroutine rrtmgp_sw_main_run(doSWrad, doSWclrsky, top_at_1, doGP_sgs_cnv, doGP_ 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 + cloud_overlap_param ! real(kind_phys), dimension(:,:,:), intent(in) :: & aersw_tau, & ! Aerosol optical depth aersw_ssa, & ! Aerosol single scattering albedo @@ -182,6 +182,7 @@ subroutine rrtmgp_sw_main_run(doSWrad, doSWclrsky, top_at_1, doGP_sgs_cnv, doGP_ ! visdf - downward uv+vis diffused flux (W/m2) ! Local variables + type(cmpfsw_type), dimension(rrtmgp_phys_blksz) :: scmpsw_clrsky, scmpsw_allsky 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, & @@ -190,24 +191,24 @@ subroutine rrtmgp_sw_main_run(doSWrad, doSWclrsky, top_at_1, doGP_sgs_cnv, doGP_ 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_phys), dimension(sw_gas_props%get_ngpt()) :: rng1D + real(kind_phys), dimension(sw_gas_props%get_ngpt(),nLay,rrtmgp_phys_blksz) :: rng3D,rng3D2 real(kind_phys), dimension(sw_gas_props%get_ngpt()*nLay) :: rng2D - integer :: iBand, ibd, ibd_uv, iCol, iGas, iLay, ix, ix2, iblck, blksz + logical, dimension(rrtmgp_phys_blksz,nLay,sw_gas_props%get_ngpt()) :: maskMCICA + 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 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/) - - type(cmpfsw_type), dimension(:), allocatable :: scmpsw_clrsky, scmpsw_allsky - integer, dimension(:), allocatable :: ipseed_sw - real(kind_phys), dimension(:), allocatable :: zcf0, zcf1 - real(kind_phys), dimension(:,:), allocatable :: toa_src_sw, sfc_alb_dir, sfc_alb_dif - real(kind_phys), dimension(:,:,:), allocatable :: rng3D,rng3D2 - logical, dimension(:,:,:), allocatable :: maskMCICA - real(kind_phys), dimension(:,:,:), allocatable, target :: & - fluxSW_up_allsky, fluxSW_up_clrsky, fluxSW_dn_dir_clrsky, fluxSW_dn_allsky, & - fluxSW_dn_clrsky, fluxSW_dn_dir_allsky + real(kind_phys), dimension(rrtmgp_phys_blksz,sw_gas_props%get_ngpt()) :: toa_src_sw ! Initialize CCPP error handling variables errmsg = '' @@ -217,51 +218,34 @@ subroutine rrtmgp_sw_main_run(doSWrad, doSWclrsky, top_at_1, doGP_sgs_cnv, doGP_ if (nDay .gt. 0) then - ! bandlimits = sw_gas_props%get_band_lims_wavenumber() - ! ###################################################################################### ! ! Allocate/initialize RRTMGP DDT's ! ! ###################################################################################### - blksz = minval((/nDay,rrtmgp_phys_blksz/)) - - allocate(scmpsw_clrsky(blksz), scmpsw_allsky(blksz), zcf0(blksz), zcf1(blksz), & - rng3D(sw_gas_props%get_ngpt(),nLay,blksz), & - rng3D2(sw_gas_props%get_ngpt(),nLay,blksz), & - maskMCICA(blksz,nLay,sw_gas_props%get_ngpt()), & - sfc_alb_dir(sw_gas_props%get_nband(),blksz), & - sfc_alb_dif(sw_gas_props%get_nband(),blksz), & - fluxSW_up_allsky(blksz,nLay+1,sw_gas_props%get_nband()), & - fluxSW_up_clrsky(blksz,nLay+1,sw_gas_props%get_nband()), & - fluxSW_dn_dir_clrsky(blksz,nLay+1,sw_gas_props%get_nband()), & - fluxSW_dn_allsky(blksz,nLay+1,sw_gas_props%get_nband()), & - fluxSW_dn_clrsky(blksz,nLay+1,sw_gas_props%get_nband()), & - fluxSW_dn_dir_allsky(blksz,nLay+1,sw_gas_props%get_nband()), & - ipseed_sw(blksz), toa_src_sw(blksz,sw_gas_props%get_ngpt())) ! 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(blksz, nLay, sw_gas_props)) + 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(blksz, nLay, sw_gas_props%get_band_lims_wavenumber())) + 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(blksz, nLay, sw_gas_props%get_band_lims_wavenumber())) + 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(blksz, nLay, sw_gas_props)) + 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(blksz, nLay, sw_gas_props%get_band_lims_wavenumber())) + 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(blksz, nLay, sw_gas_props%get_band_lims_wavenumber())) + 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(blksz, nLay, sw_gas_props%get_band_lims_wavenumber())) + sw_optical_props_pblcloudsByBand%alloc_2str(rrtmgp_phys_blksz, nLay, sw_gas_props%get_band_lims_wavenumber())) endif ! ty_fluxes_byband @@ -276,18 +260,14 @@ subroutine rrtmgp_sw_main_run(doSWrad, doSWclrsky, top_at_1, doGP_sgs_cnv, doGP_ ! Loop over all (daylit) columns... ! ! ###################################################################################### - do iCol=1,nDay,blksz + do iCol=1,nDay,rrtmgp_phys_blksz ix = idx(iCol) - ix2 = idx(iCol) + blksz - 1 - if (ix2 > nDay) then - ix = nDay - blksz + 1 - ix2 = nDay - endif + ix2 = idx(iCol + rrtmgp_phys_blksz - 1) ! Create clear/cloudy indicator zcf0(:) = 1._kind_phys zcf1(:) = 1._kind_phys - do iblck = 1, blksz + do iblck = 1, rrtmgp_phys_blksz do iLay=1,nLay zcf0(iblck) = min(zcf0(iblck), 1._kind_phys - cld_frac(ix+iblck-1,iLay)) enddo @@ -364,7 +344,7 @@ subroutine rrtmgp_sw_main_run(doSWrad, doSWclrsky, top_at_1, doGP_sgs_cnv, doGP_ ! spectral point (tau,ssa,g) toa_src_sw)) ! OUT - TOA incident shortwave radiation (spectral) ! Scale incident flux - do iblck = 1, blksz + do iblck = 1, rrtmgp_phys_blksz toa_src_sw(iblck,:) = toa_src_sw(iblck,:)*solcon / sum(toa_src_sw(iblck,:)) enddo @@ -377,7 +357,7 @@ subroutine rrtmgp_sw_main_run(doSWrad, doSWclrsky, top_at_1, doGP_sgs_cnv, doGP_ ! For overlapping band, average near-IR and us-vis albedos. ! ! ################################################################################### - do iblck = 1, blksz + 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(ix+iblck-1) @@ -445,7 +425,7 @@ subroutine rrtmgp_sw_main_run(doSWrad, doSWclrsky, top_at_1, doGP_sgs_cnv, doGP_ endif ! Cloud precipitation optics: rain and snow(+groupel) - do iblck = 1, blksz + do iblck = 1, rrtmgp_phys_blksz do iLay=1,nLay if (cld_frac(ix+iblck-1,iLay) .gt. ftiny) then ! Rain/Snow optical depth (No band dependence) @@ -489,17 +469,17 @@ subroutine rrtmgp_sw_main_run(doSWrad, doSWclrsky, top_at_1, doGP_sgs_cnv, doGP_ ! ################################################################################### ! 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, blksz + do iblck = 1, rrtmgp_phys_blksz ipseed_sw(iblck) = sw_gas_props%get_ngpt() + iCol + iblck - 1 enddo elseif (isubc_sw == 2) then ! use input array of permutaion seeds - do iblck = 1, blksz + do iblck = 1, rrtmgp_phys_blksz ipseed_sw(iblck) = icseed_sw(ix+iblck-1) enddo endif ! Call RNG - do iblck = 1, blksz + 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 @@ -522,7 +502,7 @@ subroutine rrtmgp_sw_main_run(doSWrad, doSWclrsky, top_at_1, doGP_sgs_cnv, doGP_ endif ! Exponential decorrelation length overlap if (iovr == iovr_dcorr) then - do iblck = 1, blksz + do iblck = 1, rrtmgp_phys_blksz ! Generate second RNG call random_setseed(ipseed_sw(iblck),rng_stat) call random_number(rng2D,rng_stat) @@ -549,9 +529,9 @@ subroutine rrtmgp_sw_main_run(doSWrad, doSWclrsky, top_at_1, doGP_sgs_cnv, doGP_ ! ! ################################################################################### ! Increment - sw_optical_props_aerosol_local%tau = aersw_tau(iCol:iCol+blksz-1,:,:) - sw_optical_props_aerosol_local%ssa = aersw_ssa(iCol:iCol+blksz-1,:,:) - sw_optical_props_aerosol_local%g = aersw_g(iCol:iCol+blksz-1,:,:) + sw_optical_props_aerosol_local%tau = aersw_tau(iCol:iCol+rrtmgp_phys_blksz-1,:,:) + sw_optical_props_aerosol_local%ssa = aersw_ssa(iCol:iCol+rrtmgp_phys_blksz-1,:,:) + sw_optical_props_aerosol_local%g = aersw_g(iCol:iCol+rrtmgp_phys_blksz-1,:,:) call check_error_msg('rrtmgp_sw_main_increment_aerosol_to_clrsky', & sw_optical_props_aerosol_local%increment(sw_optical_props_accum)) @@ -573,7 +553,7 @@ subroutine rrtmgp_sw_main_run(doSWrad, doSWclrsky, top_at_1, doGP_sgs_cnv, doGP_ fluxswDOWN_clrsky(ix:ix2,:) = sum(flux_clrsky%bnd_flux_dn, dim=3) ! Compute surface downward beam/diffused flux components - do iblck = 1, blksz + 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 @@ -627,7 +607,7 @@ subroutine rrtmgp_sw_main_run(doSWrad, doSWclrsky, top_at_1, doGP_sgs_cnv, doGP_ fluxswDOWN_allsky(ix:ix2,:) = sum(flux_allsky%bnd_flux_dn, dim=3) ! Compute and store downward beam/diffused flux components - do iblck = 1, blksz + 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) @@ -671,7 +651,7 @@ subroutine rrtmgp_sw_main_run(doSWrad, doSWclrsky, top_at_1, doGP_sgs_cnv, doGP_ else ! No clouds fluxswUP_allsky(ix:ix2,:) = sum(flux_clrsky%bnd_flux_up, dim=3) fluxswDOWN_allsky(ix:ix2,:) = sum(flux_clrsky%bnd_flux_dn, dim=3) - do iblck = 1, blksz + do iblck = 1, rrtmgp_phys_blksz scmpsw(ix+iblck-1)%nirbm = scmpsw_clrsky(iblck)%nirbm scmpsw(ix+iblck-1)%nirdf = scmpsw_clrsky(iblck)%nirdf scmpsw(ix+iblck-1)%visbm = scmpsw_clrsky(iblck)%visbm From 1b34a74129f055fd822e6731680d3bcef0f0f0b1 Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Mon, 3 Oct 2022 20:53:54 +0000 Subject: [PATCH 14/19] Move allocation of RRTMGP DDTs to init --- physics/rrtmgp_lw_main.F90 | 120 ++++++++--------- physics/rrtmgp_lw_main.meta | 32 ++++- physics/rrtmgp_sw_main.F90 | 252 ++++++++++++++++++------------------ physics/rrtmgp_sw_main.meta | 32 ++++- 4 files changed, 249 insertions(+), 187 deletions(-) diff --git a/physics/rrtmgp_lw_main.F90 b/physics/rrtmgp_lw_main.F90 index ab82dc56a..d6b0ab630 100644 --- a/physics/rrtmgp_lw_main.F90 +++ b/physics/rrtmgp_lw_main.F90 @@ -27,6 +27,13 @@ module rrtmgp_lw_main 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 ! ######################################################################################### @@ -41,8 +48,9 @@ module rrtmgp_lw_main !> @{ ! ######################################################################################### 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, nrghice, mpicomm, & - mpirank, mpiroot, errmsg, errflg) + 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) :: & @@ -55,13 +63,17 @@ subroutine rrtmgp_lw_main_init(rrtmgp_root_dir, rrtmgp_lw_file_gas, rrtmgp_lw_fi 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_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 + mpiroot, & ! Master MPI rank + rrtmgp_phys_blksz, & ! Number of horizontal points to process at once. + nLay ! Outputs character(len=*), intent(out) :: & @@ -82,6 +94,33 @@ subroutine rrtmgp_lw_main_init(rrtmgp_root_dir, rrtmgp_lw_file_gas, rrtmgp_lw_fi 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 !> @} ! ###################################################################################### @@ -188,13 +227,7 @@ subroutine rrtmgp_lw_main_run(doLWrad, doLWclrsky, top_at_1, doGP_lwscat, errflg ! CCPP error flag ! Local variables - 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 - type(ty_fluxes_byband) :: flux_allsky, flux_clrsky + 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 @@ -215,37 +248,6 @@ subroutine rrtmgp_lw_main_run(doLWrad, doLWclrsky, top_at_1, doGP_lwscat, if (.not. doLWrad) return - ! ###################################################################################### - ! - ! Allocate/initialize RRTMGP DDT's - ! - ! ###################################################################################### - - ! 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 - ! ###################################################################################### ! ! Loop over all columns... @@ -254,23 +256,8 @@ subroutine rrtmgp_lw_main_run(doLWrad, doLWclrsky, top_at_1, doGP_lwscat, do iCol=1,nCol,rrtmgp_phys_blksz iCol2 = 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(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 - - ! ################################################################################### - ! ! Initialize/reset - ! - ! ################################################################################### + ! ty_optical_props lw_optical_props_clrsky%tau = 0._kind_phys lw_optical_props_precipByBand%tau = 0._kind_phys @@ -293,7 +280,12 @@ subroutine rrtmgp_lw_main_run(doLWrad, doLWclrsky, top_at_1, doGP_lwscat, 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 @@ -353,6 +345,18 @@ subroutine rrtmgp_lw_main_run(doLWrad, doLWclrsky, top_at_1, doGP_lwscat, ! 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(& diff --git a/physics/rrtmgp_lw_main.meta b/physics/rrtmgp_lw_main.meta index 89e4bed2e..a1a384b25 100644 --- a/physics/rrtmgp_lw_main.meta +++ b/physics/rrtmgp_lw_main.meta @@ -50,6 +50,20 @@ 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 @@ -78,6 +92,20 @@ 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 @@ -163,8 +191,8 @@ type = integer intent = in [rrtmgp_phys_blksz] - standard_name = number_of_columns_per_RRTMGP_block - long_name = number of columns to process ata time by RRTMGP + 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 diff --git a/physics/rrtmgp_sw_main.F90 b/physics/rrtmgp_sw_main.F90 index 325607daa..114a3001a 100644 --- a/physics/rrtmgp_sw_main.F90 +++ b/physics/rrtmgp_sw_main.F90 @@ -20,6 +20,12 @@ module rrtmgp_sw_main 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 @@ -31,8 +37,9 @@ module rrtmgp_sw_main !! \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, nrghice, mpicomm, & - mpirank, mpiroot, errmsg, errflg) + 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) :: & @@ -40,16 +47,20 @@ subroutine rrtmgp_sw_main_init(rrtmgp_root_dir, rrtmgp_sw_file_gas, rrtmgp_sw_fi 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) + 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_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 + 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 @@ -69,6 +80,30 @@ subroutine rrtmgp_sw_main_init(rrtmgp_root_dir, rrtmgp_sw_file_gas, rrtmgp_sw_fi 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 ! ######################################################################################### @@ -183,11 +218,6 @@ subroutine rrtmgp_sw_main_run(doSWrad, doSWclrsky, top_at_1, doGP_sgs_cnv, doGP_ ! Local variables type(cmpfsw_type), dimension(rrtmgp_phys_blksz) :: scmpsw_clrsky, scmpsw_allsky - 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 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 @@ -202,7 +232,7 @@ subroutine rrtmgp_sw_main_run(doSWrad, doSWclrsky, top_at_1, doGP_sgs_cnv, doGP_ 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 + 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 :: & @@ -219,57 +249,22 @@ subroutine rrtmgp_sw_main_run(doSWrad, doSWclrsky, top_at_1, doGP_sgs_cnv, doGP_ if (nDay .gt. 0) then bandlimits = sw_gas_props%get_band_lims_wavenumber() - ! ###################################################################################### - ! - ! Allocate/initialize RRTMGP DDT's - ! - ! ###################################################################################### - - ! 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 - - ! ty_fluxes_byband - 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 - ! ###################################################################################### ! ! Loop over all (daylit) columns... ! ! ###################################################################################### do iCol=1,nDay,rrtmgp_phys_blksz - ix = idx(iCol) - ix2 = idx(iCol + rrtmgp_phys_blksz - 1) + !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(ix+iblck-1,iLay)) + 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 @@ -281,11 +276,6 @@ subroutine rrtmgp_sw_main_run(doSWrad, doSWclrsky, top_at_1, doGP_sgs_cnv, doGP_ ! Initialize/reset ! ! ################################################################################### - 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 sw_optical_props_clouds%tau = 0._kind_phys sw_optical_props_clouds%ssa = 0._kind_phys sw_optical_props_clouds%g = 0._kind_phys @@ -311,23 +301,35 @@ subroutine rrtmgp_sw_main_run(doSWrad, doSWclrsky, top_at_1, doGP_sgs_cnv, doGP_ 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 ) + ! 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(ix:ix2,:))) + 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(ix:ix2,:))) + 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(ix:ix2,:))) + 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(ix:ix2,:))) + 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(ix:ix2,:))) + 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(ix:ix2,:))) + gas_concs%set_vmr(trim(active_gases_array(istr_o3)), vmr_o3(iCols,:))) ! ################################################################################### ! @@ -336,9 +338,9 @@ subroutine rrtmgp_sw_main_run(doSWrad, doSWclrsky, top_at_1, doGP_sgs_cnv, doGP_ ! ################################################################################### call check_error_msg('rrtmgp_sw_main_gas_optics',sw_gas_props%gas_optics(& - p_lay(ix:ix2,:), & ! IN - Pressure @ layer-centers (Pa) - p_lev(ix:ix2,:), & ! IN - Pressure @ layer-interfaces (Pa) - t_lay(ix:ix2,:), & ! IN - Temperature @ layer-centers (K) + 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) @@ -360,19 +362,19 @@ subroutine rrtmgp_sw_main_run(doSWrad, doSWclrsky, top_at_1, doGP_sgs_cnv, doGP_ 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(ix+iblck-1) - sfc_alb_dif(iBand,iblck) = sfc_alb_nir_dif(ix+iblck-1) + 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(ix+iblck-1) + & - sfc_alb_uvvis_dir(ix+iblck-1)) - sfc_alb_dif(iBand,iblck) = 0.5_kind_phys*(sfc_alb_nir_dif(ix+iblck-1) + & - sfc_alb_uvvis_dif(ix+iblck-1)) + 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(ix+iblck-1) - sfc_alb_dif(iBand,iblck) = sfc_alb_uvvis_dif(ix+iblck-1) + 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 @@ -386,22 +388,22 @@ subroutine rrtmgp_sw_main_run(doSWrad, doSWclrsky, top_at_1, doGP_sgs_cnv, doGP_ if (any(zcf1 .gt. eps)) then ! Gridmean/mp-clouds call check_error_msg('rrtmgp_sw_main_cloud_optics',sw_cloud_props%cloud_optics(& - cld_lwp(ix:ix2,:), & ! IN - Cloud liquid water path - cld_iwp(ix:ix2,:), & ! IN - Cloud ice water path - cld_reliq(ix:ix2,:), & ! IN - Cloud liquid effective radius - cld_reice(ix:ix2,:), & ! IN - Cloud ice effective radius + 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(ix:ix2,:) = sw_optical_props_cloudsByBand%tau(:,:,11) + 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(ix:ix2,:), & ! IN - Convective cloud liquid water path (g/m2) - cld_cnv_iwp(ix:ix2,:), & ! IN - Convective cloud ice water path (g/m2) - cld_cnv_reliq(ix:ix2,:), & ! IN - Convective cloud liquid effective radius (microns) - cld_cnv_reice(ix:ix2,:), & ! IN - Convective cloud ice effective radius (microns) + 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 @@ -413,10 +415,10 @@ subroutine rrtmgp_sw_main_run(doSWrad, doSWclrsky, top_at_1, doGP_sgs_cnv, doGP_ if (doGP_sgs_pbl) then ! Compute call check_error_msg('rrtmgp_sw_main_pbl_cloud_optics',sw_cloud_props%cloud_optics(& - cld_pbl_lwp(ix:ix2,:), & ! IN - PBL cloud liquid water path (g/m2) - cld_pbl_iwp(ix:ix2,:), & ! IN - PBL cloud ice water path (g/m2) - cld_pbl_reliq(ix:ix2,:), & ! IN - PBL cloud liquid effective radius (microns) - cld_pbl_reice(ix:ix2,:), & ! IN - PBL cloud ice effective radius (microns) + 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 @@ -427,11 +429,11 @@ subroutine rrtmgp_sw_main_run(doSWrad, doSWclrsky, top_at_1, doGP_sgs_cnv, doGP_ ! Cloud precipitation optics: rain and snow(+groupel) do iblck = 1, rrtmgp_phys_blksz do iLay=1,nLay - if (cld_frac(ix+iblck-1,iLay) .gt. ftiny) then + if (cld_frac(iCols(iblck),iLay) .gt. ftiny) then ! Rain/Snow optical depth (No band dependence) - tau_rain = cld_rwp(ix+iblck-1,iLay)*a0r - if (cld_swp(ix+iblck-1,iLay) .gt. 0. .and. cld_resnow(ix+iblck-1,iLay) .gt. 10._kind_phys) then - tau_snow = cld_swp(ix+iblck-1,iLay)*1.09087*(a0s + a1s/(1.0315*cld_resnow(ix+iblck-1,iLay))) ! fu's formula + 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 @@ -441,7 +443,7 @@ subroutine rrtmgp_sw_main_run(doSWrad, doSWclrsky, top_at_1, doGP_sgs_cnv, doGP_ ! 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(ix+iblck-1,iLay))) + 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) @@ -470,11 +472,11 @@ subroutine rrtmgp_sw_main_run(doSWrad, doSWclrsky, top_at_1, doGP_sgs_cnv, doGP_ ! 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() + iCol + iblck - 1 + 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(ix+iblck-1) + ipseed_sw(iblck) = icseed_sw(iCols(iblck)) enddo endif @@ -498,7 +500,7 @@ subroutine rrtmgp_sw_main_run(doSWrad, doSWclrsky, top_at_1, doGP_sgs_cnv, doGP_ ! Cloud-overlap. ! Maximum-random, random or maximum. if (iovr == iovr_maxrand .or. iovr == iovr_rand .or. iovr == iovr_max) then - call sampled_mask(rng3D, cld_frac(ix:ix2,:), maskMCICA) + call sampled_mask(rng3D, cld_frac(iCols,:), maskMCICA) endif ! Exponential decorrelation length overlap if (iovr == iovr_dcorr) then @@ -509,13 +511,13 @@ subroutine rrtmgp_sw_main_run(doSWrad, doSWclrsky, top_at_1, doGP_sgs_cnv, doGP_ rng3D2(:,:,iblck) = reshape(source = rng2D,shape=[sw_gas_props%get_ngpt(),nLay]) enddo ! - call sampled_mask(rng3D, cld_frac(ix:ix2,:), maskMCICA, & - overlap_param = cloud_overlap_param(ix:ix2,1:nLay-1), randoms2 = rng3D2) + call sampled_mask(rng3D, cld_frac(iCols,:), maskMCICA, & + overlap_param = cloud_overlap_param(iCols,1:nLay-1), randoms2 = rng3D2) endif ! Exponential or Exponential-random if (iovr == iovr_exp .or. iovr == iovr_exprand) then - call sampled_mask(rng3D, cld_frac(ix:ix2,:), maskMCICA, & - overlap_param = cloud_overlap_param(ix:ix2,1:nLay-1)) + call sampled_mask(rng3D, 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',& @@ -529,9 +531,9 @@ subroutine rrtmgp_sw_main_run(doSWrad, doSWclrsky, top_at_1, doGP_sgs_cnv, doGP_ ! ! ################################################################################### ! Increment - sw_optical_props_aerosol_local%tau = aersw_tau(iCol:iCol+rrtmgp_phys_blksz-1,:,:) - sw_optical_props_aerosol_local%ssa = aersw_ssa(iCol:iCol+rrtmgp_phys_blksz-1,:,:) - sw_optical_props_aerosol_local%g = aersw_g(iCol:iCol+rrtmgp_phys_blksz-1,:,:) + 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)) @@ -542,15 +544,15 @@ subroutine rrtmgp_sw_main_run(doSWrad, doSWclrsky, top_at_1, doGP_sgs_cnv, doGP_ 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(ix:ix2), & ! IN - Cosine of solar zenith angle + 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(ix:ix2,:) = sum(flux_clrsky%bnd_flux_up, dim=3) - fluxswDOWN_clrsky(ix:ix2,:) = sum(flux_clrsky%bnd_flux_dn, dim=3) + 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 @@ -596,15 +598,15 @@ subroutine rrtmgp_sw_main_run(doSWrad, doSWclrsky, top_at_1, doGP_sgs_cnv, doGP_ 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(ix:ix2), & ! IN - Cosine of solar zenith angle + 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(ix:ix2,:) = sum(flux_allsky%bnd_flux_up, dim=3) - fluxswDOWN_allsky(ix:ix2,:) = sum(flux_allsky%bnd_flux_dn, dim=3) + 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 @@ -634,30 +636,30 @@ subroutine rrtmgp_sw_main_run(doSWrad, doSWclrsky, top_at_1, doGP_sgs_cnv, doGP_ enddo ! Store surface downward beam/diffused flux components if (zcf1(iblck) .gt. eps) then - scmpsw(ix+iblck-1)%nirbm = scmpsw_allsky(iblck)%nirbm - scmpsw(ix+iblck-1)%nirdf = scmpsw_allsky(iblck)%nirdf - scmpsw(ix+iblck-1)%visbm = scmpsw_allsky(iblck)%visbm - scmpsw(ix+iblck-1)%visdf = scmpsw_allsky(iblck)%visdf - scmpsw(ix+iblck-1)%uvbfc = flux_allsky%bnd_flux_dn(iblck,iSFC,ibd_uv) + 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(ix+iblck-1)%nirbm = scmpsw_clrsky(iblck)%nirbm - scmpsw(ix+iblck-1)%nirdf = scmpsw_clrsky(iblck)%nirdf - scmpsw(ix+iblck-1)%visbm = scmpsw_clrsky(iblck)%visbm - scmpsw(ix+iblck-1)%visdf = scmpsw_clrsky(iblck)%visdf - scmpsw(ix+iblck-1)%uvbfc = flux_clrsky%bnd_flux_dn(iblck,iSFC,ibd_uv) + 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(ix+iblck-1)%uvbf0 = flux_clrsky%bnd_flux_dn(iblck,iSFC,ibd_uv) + scmpsw(iCols(iblck))%uvbf0 = flux_clrsky%bnd_flux_dn(iblck,iSFC,ibd_uv) enddo else ! No clouds - fluxswUP_allsky(ix:ix2,:) = sum(flux_clrsky%bnd_flux_up, dim=3) - fluxswDOWN_allsky(ix:ix2,:) = sum(flux_clrsky%bnd_flux_dn, dim=3) + 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(ix+iblck-1)%nirbm = scmpsw_clrsky(iblck)%nirbm - scmpsw(ix+iblck-1)%nirdf = scmpsw_clrsky(iblck)%nirdf - scmpsw(ix+iblck-1)%visbm = scmpsw_clrsky(iblck)%visbm - scmpsw(ix+iblck-1)%visdf = scmpsw_clrsky(iblck)%visdf - scmpsw(ix+iblck-1)%uvbfc = flux_clrsky%bnd_flux_dn(iblck,iSFC,ibd_uv) - scmpsw(ix+iblck-1)%uvbf0 = flux_clrsky%bnd_flux_dn(iblck,iSFC,ibd_uv) + 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 ! diff --git a/physics/rrtmgp_sw_main.meta b/physics/rrtmgp_sw_main.meta index 78e435c96..c0be1658f 100644 --- a/physics/rrtmgp_sw_main.meta +++ b/physics/rrtmgp_sw_main.meta @@ -57,6 +57,34 @@ 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 @@ -163,8 +191,8 @@ type = integer intent = in [rrtmgp_phys_blksz] - standard_name = number_of_columns_per_RRTMGP_block - long_name = number of columns to process ata time by RRTMGP + 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 From 1441ed48342554e76aaa70caeb19fd4001cd9074 Mon Sep 17 00:00:00 2001 From: dustinswales Date: Fri, 13 Jan 2023 10:32:28 -0700 Subject: [PATCH 15/19] Commit before sync with upstream --- physics/rrtmgp_sw_main.F90 | 97 ++++++++++++++++++++------------------ 1 file changed, 52 insertions(+), 45 deletions(-) diff --git a/physics/rrtmgp_sw_main.F90 b/physics/rrtmgp_sw_main.F90 index 114a3001a..6477fab51 100644 --- a/physics/rrtmgp_sw_main.F90 +++ b/physics/rrtmgp_sw_main.F90 @@ -226,6 +226,7 @@ subroutine rrtmgp_sw_main_run(doSWrad, doSWclrsky, top_at_1, doGP_sgs_cnv, doGP_ real(kind_phys), dimension(sw_gas_props%get_ngpt(),nLay,rrtmgp_phys_blksz) :: rng3D,rng3D2 real(kind_phys), 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 :: & @@ -270,6 +271,9 @@ subroutine rrtmgp_sw_main_run(doSWrad, doSWclrsky, top_at_1, doGP_sgs_cnv, doGP_ 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. ! ################################################################################### ! @@ -385,7 +389,7 @@ subroutine rrtmgp_sw_main_run(doSWrad, doSWclrsky, top_at_1, doGP_sgs_cnv, doGP_ ! Compute optics for cloud(s) and precipitation, sample clouds... ! ! ################################################################################### - if (any(zcf1 .gt. eps)) then + 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 @@ -523,70 +527,73 @@ subroutine rrtmgp_sw_main_run(doSWrad, doSWclrsky, top_at_1, doGP_sgs_cnv, doGP_ call check_error_msg('rrtmgp_sw_main_cloud_sampling',& draw_samples(maskMCICA, .true., & sw_optical_props_cloudsByBand, sw_optical_props_clouds)) - endif + endif ! cloudy_column ! ################################################################################### ! ! Compute clear-sky fluxes (gaseous+aerosol) ! ! ################################################################################### - ! Increment + ! 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)) - ! Delta-scale - !call check_error_msg('rrtmgp_sw_main_delta_scale',sw_optical_props_accum%delta_scale()) - - ! Compute fluxes - 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 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) + ! 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 - 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 (any(zcf1 .gt. eps)) then + if (cloudy_column) then ! Delta scale !call check_error_msg('rrtmgp_sw_main_delta_scale',sw_optical_props_clouds%delta_scale()) From 0befb4120a2e6b559100304d529ba0114c5dd42b Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Wed, 25 Jan 2023 23:25:04 +0000 Subject: [PATCH 16/19] Added documenation back into scheme file. --- physics/GFS_rrtmgp_cloud_mp.F90 | 158 +++++++++++++++++--------------- 1 file changed, 83 insertions(+), 75 deletions(-) diff --git a/physics/GFS_rrtmgp_cloud_mp.F90 b/physics/GFS_rrtmgp_cloud_mp.F90 index b294f21b6..32104b7f8 100644 --- a/physics/GFS_rrtmgp_cloud_mp.F90 +++ b/physics/GFS_rrtmgp_cloud_mp.F90 @@ -1,5 +1,10 @@ -! ######################################################################################## -! ######################################################################################## +!> \file GFS_rrtmgp_cloud_mp.F90 +!! +!> \defgroup GFS_rrtmgp_cloud_mp GFS_rrtmgp_cloud_mp.F90 +!! +!! \brief This module contains the interface for ALL cloud microphysics assumptions and +!! the RRTMGP radiation scheme. Specific details below in subroutines. +!! module GFS_rrtmgp_cloud_mp use machine, only: kind_phys use radiation_tools, only: check_error_msg @@ -26,15 +31,21 @@ module GFS_rrtmgp_cloud_mp contains +!>\defgroup gfs_rrtmgp_cloud_mp_mod GFS RRTMGP Cloud MP Module !! \section arg_table_GFS_rrtmgp_cloud_mp_run !! \htmlinclude GFS_rrtmgp_cloud_mp_run_html !! - ! ###################################################################################### - ! ###################################################################################### +!> \ingroup GFS_rrtmgp_cloud_mp +!! +!! Here the cloud-radiative properties (optical-path, particle-size and sometimes cloud- +!! fraction) are computed for cloud producing physics schemes (e.g GFDL-MP, Thompson-MP, +!! MYNN-EDMF-pbl, GF-convective, and SAMF-convective clouds). +!! +!! \section GFS_rrtmgp_cloud_mp_run 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, & @@ -299,22 +310,22 @@ subroutine GFS_rrtmgp_cloud_mp_run(nCol, nLev, nTracers, ncnd, i_cldliq, i_cldic end subroutine GFS_rrtmgp_cloud_mp_run - ! ###################################################################################### - ! Compute cloud radiative properties for Grell-Freitas convective cloud scheme. - ! (Adopted from module_SGSCloud_RadPre) - ! - ! - The total convective cloud condensate is partitoned by phase, using temperature, into - ! liquid/ice convective cloud mixing-ratios. Compute convective cloud LWP and IWP's. - ! - ! - The liquid and ice cloud effective particle sizes are assigned reference values*. - ! *TODO* Find references, include DOIs, parameterize magic numbers, etc... - ! - ! - The convective cloud-fraction is computed using Xu-Randall (1996). - ! (DJS asks: Does the GF scheme produce a cloud-fraction? If so, maybe use instead of - ! Xu-Randall? Xu-Randall is consistent with the Thompson MP scheme, but - ! not GFDL-EMC) - ! - ! ###################################################################################### +!> \ingroup GFS_rrtmgp_cloud_mp +!! Compute cloud radiative properties for Grell-Freitas convective cloud scheme. +!! (Adopted from module_SGSCloud_RadPre) +!! +!! - The total convective cloud condensate is partitoned by phase, using temperature, into +!! liquid/ice convective cloud mixing-ratios. Compute convective cloud LWP and IWP's. +!! +!! - The liquid and ice cloud effective particle sizes are assigned reference values*. +!! *TODO* Find references, include DOIs, parameterize magic numbers, etc... +!! +!! - The convective cloud-fraction is computed using Xu-Randall (1996). +!! (DJS asks: Does the GF scheme produce a cloud-fraction? If so, maybe use instead of +!! Xu-Randall? Xu-Randall is consistent with the Thompson MP scheme, but +!! not GFDL-EMC) +!! +!! \section cloud_mp_GF_gen General Algorithm subroutine cloud_mp_GF(nCol, nLev, lsmask, t_lay, p_lev, p_lay, qs_lay, relhum, & qci_conv, con_ttp, con_g, alpha0, cld_cnv_lwp, cld_cnv_reliq, cld_cnv_iwp, & cld_cnv_reice, cld_cnv_frac) @@ -379,17 +390,17 @@ subroutine cloud_mp_GF(nCol, nLev, lsmask, t_lay, p_lev, p_lay, qs_lay, relhum, enddo end subroutine cloud_mp_GF - ! ###################################################################################### - ! Compute cloud radiative properties for MYNN-EDMF PBL cloud scheme. - ! (Adopted from module_SGSCloud_RadPre) - ! - ! - Cloud-fraction, liquid, and ice condensate mixing-ratios from MYNN-EDMF cloud scheme - ! are provided as inputs. Cloud LWP and IWP are computed. - ! - ! - The liquid and ice cloud effective particle sizes are assigned reference values*. - ! *TODO* Find references, include DOIs, parameterize magic numbers, etc... - ! - ! ###################################################################################### +!> \ingroup GFS_rrtmgp_cloud_mp +!! Compute cloud radiative properties for MYNN-EDMF PBL cloud scheme. +!! (Adopted from module_SGSCloud_RadPre) +!! +!! - Cloud-fraction, liquid, and ice condensate mixing-ratios from MYNN-EDMF cloud scheme +!! are provided as inputs. Cloud LWP and IWP are computed. +!! +!! - The liquid and ice cloud effective particle sizes are assigned reference values*. +!! *TODO* Find references, include DOIs, parameterize magic numbers, etc... +!! +!! \section cloud_mp_MYNN_gen General Algorithm subroutine cloud_mp_MYNN(nCol, nLev, lsmask, t_lay, p_lev, p_lay, qs_lay, relhum, & qc_mynn, qi_mynn, con_ttp, con_g, cld_pbl_lwp, cld_pbl_reliq, cld_pbl_iwp, & cld_pbl_reice, cld_pbl_frac) @@ -451,18 +462,19 @@ subroutine cloud_mp_MYNN(nCol, nLev, lsmask, t_lay, p_lev, p_lay, qs_lay, relhum enddo end subroutine cloud_mp_MYNN - ! ###################################################################################### - ! Compute cloud radiative properties for SAMF convective cloud scheme. - ! - ! - The total-cloud convective mixing-ratio is partitioned by phase into liquid/ice - ! cloud properties. LWP and IWP are computed. - ! - ! - The liquid and ice cloud effective particle sizes are assigned reference values. - ! - ! - The convective cloud-fraction is computed using Xu-Randall (1996). - ! (DJS asks: Does the SAMF scheme produce a cloud-fraction?) - ! - ! ###################################################################################### + +!> \ingroup GFS_rrtmgp_cloud_mp +!! Compute cloud radiative properties for SAMF convective cloud scheme. +!! +!! - The total-cloud convective mixing-ratio is partitioned by phase into liquid/ice +!! cloud properties. LWP and IWP are computed. +!! +!! - The liquid and ice cloud effective particle sizes are assigned reference values. +!! +!! - The convective cloud-fraction is computed using Xu-Randall (1996). +!! (DJS asks: Does the SAMF scheme produce a cloud-fraction?) +!! +!! \section cloud_mp_SAMF_gen General Algorithm subroutine cloud_mp_SAMF(nCol, nLev, t_lay, p_lev, p_lay, qs_lay, relhum, & cnv_mixratio, con_ttp, con_g, alpha0, cld_cnv_lwp, cld_cnv_reliq, cld_cnv_iwp, & cld_cnv_reice, cld_cnv_frac) @@ -515,16 +527,12 @@ subroutine cloud_mp_SAMF(nCol, nLev, t_lay, p_lev, p_lay, qs_lay, relhum, end subroutine cloud_mp_SAMF - ! ###################################################################################### - ! This routine computes the cloud radiative properties for a "unified cloud". - ! - ! - "unified cloud" implies that the cloud-fraction is PROVIDED. - ! - ! - The cloud water path is computed for all provided cloud mixing-ratios and hydrometeors. - ! - ! - If particle sizes are provided, they are used. If not, default values are assigned. - ! - ! ###################################################################################### +!> \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. +!! - The cloud water path is computed for all provided cloud mixing-ratios and hydrometeors. +!! - If particle sizes are provided, they are used. If not, default values are assigned. +!! \section cloud_mp_uni_gen General Algorithm subroutine cloud_mp_uni(nCol, nLev, nTracers, ncnd, i_cldliq, i_cldice, i_cldrain, & i_cldsnow, i_cldgrpl, i_cldtot, effr_in, kdt, lsmask, p_lev, p_lay, t_lay, tv_lay,& effrin_cldliq, effrin_cldice, effrin_cldsnow, tracer, con_g, con_rd, con_ttp, & @@ -650,19 +658,19 @@ subroutine cloud_mp_uni(nCol, nLev, nTracers, ncnd, i_cldliq, i_cldice, i_cldrai enddo ! nLev end subroutine cloud_mp_uni - ! ###################################################################################### - ! This routine computes the cloud radiative properties for the Thompson cloud micro- - ! physics scheme. - ! - ! - The cloud water path is computed for all provided cloud mixing-ratios and hydrometeors. - ! - ! - There are no assumptions about particle size applied here. Effective particle sizes - ! are updated prior to this routine, see cmp_reff_Thompson(). - ! - ! - The cloud-fraction is computed using Xu-Randall** (1996). - ! **Additionally, Conditioned on relative-humidity** - ! - ! ###################################################################################### +!> \ingroup GFS_rrtmgp_cloud_mp +!! This routine computes the cloud radiative properties for the Thompson cloud micro- +!! physics scheme. +!! +!! - The cloud water path is computed for all provided cloud mixing-ratios and hydrometeors. +!! +!! - There are no assumptions about particle size applied here. Effective particle sizes +!! are updated prior to this routine, see cmp_reff_Thompson(). +!! +!! - The cloud-fraction is computed using Xu-Randall** (1996). +!! **Additionally, Conditioned on relative-humidity** +!! +!! \section cloud_mp_thompson_gen General Algorithm subroutine cloud_mp_thompson(nCol, nLev, nTracers, ncnd, i_cldliq, i_cldice, i_cldrain,& i_cldsnow, i_cldgrpl, p_lev, p_lay, tv_lay, t_lay, tracer, qs_lay, q_lay, relhum, & con_ttp, con_g, con_rd, con_eps, alpha0, cnv_mixratio, lwp_ex, iwp_ex, lwp_fc, & @@ -783,14 +791,14 @@ subroutine cloud_mp_thompson(nCol, nLev, nTracers, ncnd, i_cldliq, i_cldice, i_c end subroutine cloud_mp_thompson - ! ###################################################################################### - ! This function computes the cloud-fraction following. - ! Xu-Randall(1996) A Semiempirical Cloudiness Parameterization for Use in Climate Models - ! https://doi.org/10.1175/1520-0469(1996)053<3084:ASCPFU>2.0.CO;2 - ! - ! cld_frac = {1-exp[-alpha*cld_mr/((1-relhum)*qs_lay)**lambda]}*relhum**P - ! - ! ###################################################################################### +!> \ingroup GFS_rrtmgp_cloud_mp +!! This function computes the cloud-fraction following. +!! Xu-Randall(1996) A Semiempirical Cloudiness Parameterization for Use in Climate Models +!! https://doi.org/10.1175/1520-0469(1996)053<3084:ASCPFU>2.0.CO;2 +!! +!! cld_frac = {1-exp[-alpha*cld_mr/((1-relhum)*qs_lay)**lambda]}*relhum**P +!! +!! \section cld_frac_XuRandall_gen General Algorithm function cld_frac_XuRandall(p_lay, qs_lay, relhum, cld_mr, alpha) implicit none ! Inputs From 0a053a06806f72da2082aca50e3c19b7252a1d53 Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Wed, 25 Jan 2023 23:37:52 +0000 Subject: [PATCH 17/19] Address reviewers comments --- physics/GFS_rrtmgp_post.F90 | 4 ++-- physics/GFS_rrtmgp_post.meta | 4 ++-- physics/GFS_rrtmgp_pre.F90 | 9 ++++++--- physics/GFS_rrtmgp_pre.meta | 6 +++--- 4 files changed, 13 insertions(+), 10 deletions(-) diff --git a/physics/GFS_rrtmgp_post.F90 b/physics/GFS_rrtmgp_post.F90 index 42161e4d6..22fe2fc21 100644 --- a/physics/GFS_rrtmgp_post.F90 +++ b/physics/GFS_rrtmgp_post.F90 @@ -124,9 +124,9 @@ subroutine GFS_rrtmgp_post_run (nCol, nLev, nDay, iSFC, iTOA, idxday, doLWrad, d sfcflw ! LW radiation fluxes at sfc type(sfcfsw_type), dimension(:), intent(inout) :: & sfcfsw ! SW radiation fluxes at sfc - type(topfsw_type), dimension(:), intent(out) :: & + type(topfsw_type), dimension(:), intent(inout) :: & topfsw ! SW fluxes at top atmosphere - type(topflw_type), dimension(:), intent(out) :: & + type(topflw_type), dimension(:), intent(inout) :: & topflw ! LW fluxes at top atmosphere character(len=*), intent(out) :: & errmsg ! CCPP error message diff --git a/physics/GFS_rrtmgp_post.meta b/physics/GFS_rrtmgp_post.meta index 0caa1c387..e4bc3e5dc 100644 --- a/physics/GFS_rrtmgp_post.meta +++ b/physics/GFS_rrtmgp_post.meta @@ -358,7 +358,7 @@ units = W m-2 dimensions = (horizontal_loop_extent) type = topflw_type - intent = out + intent = inout [nirbmdi] standard_name = surface_downwelling_direct_nir_shortwave_flux_on_radiation_timestep long_name = sfc nir beam sw downward flux @@ -460,7 +460,7 @@ units = W m-2 dimensions = (horizontal_loop_extent) type = topfsw_type - intent = out + intent = inout [htrswc] standard_name = tendency_of_air_temperature_due_to_shortwave_heating_assuming_clear_sky_on_radiation_timestep long_name = clear sky sw heating rates diff --git a/physics/GFS_rrtmgp_pre.F90 b/physics/GFS_rrtmgp_pre.F90 index 7de803015..8e115b774 100644 --- a/physics/GFS_rrtmgp_pre.F90 +++ b/physics/GFS_rrtmgp_pre.F90 @@ -165,10 +165,11 @@ subroutine GFS_rrtmgp_pre_run(me, nCol, nLev, i_o3, doSWrad, doLWrad, fhswr, fhl errmsg ! Error message integer, intent(out) :: & errflg, & ! Error flag - iSFC, & ! Vertical index for surface - iTOA, & ! Vertical index for TOA nDay - logical, intent(out) :: & + 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 @@ -208,6 +209,8 @@ subroutine GFS_rrtmgp_pre_run(me, nCol, nLev, i_o3, doSWrad, doLWrad, fhswr, fhl errmsg = '' errflg = 0 + nday = 0 + idxday = 0 if (.not. (doSWrad .or. doLWrad)) return ! ####################################################################################### diff --git a/physics/GFS_rrtmgp_pre.meta b/physics/GFS_rrtmgp_pre.meta index f77ac89db..455010e58 100644 --- a/physics/GFS_rrtmgp_pre.meta +++ b/physics/GFS_rrtmgp_pre.meta @@ -315,21 +315,21 @@ units = flag dimensions = () type = logical - intent = out + 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 = out + 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 = out + intent = inout [tsfc_radtime] standard_name = surface_skin_temperature_on_radiation_timestep long_name = surface skin temperature on radiation timestep From 377c0ba8b54a1427cb0127634b5c857f7f0c928a Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Thu, 26 Jan 2023 16:40:38 +0000 Subject: [PATCH 18/19] Address more reviewers comments --- physics/rrtmgp_sw_main.F90 | 3 ++- physics/rrtmgp_sw_main.meta | 2 +- 2 files changed, 3 insertions(+), 2 deletions(-) diff --git a/physics/rrtmgp_sw_main.F90 b/physics/rrtmgp_sw_main.F90 index 6477fab51..1a5b31e9e 100644 --- a/physics/rrtmgp_sw_main.F90 +++ b/physics/rrtmgp_sw_main.F90 @@ -200,7 +200,7 @@ subroutine rrtmgp_sw_main_run(doSWrad, doSWclrsky, top_at_1, doGP_sgs_cnv, doGP_ errmsg ! CCPP error message integer, intent(out) :: & errflg ! CCPP error flag - real(kind_phys), dimension(:,:), intent(out) :: & + 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) @@ -304,6 +304,7 @@ subroutine rrtmgp_sw_main_run(doSWrad, doSWclrsky, top_at_1, doGP_sgs_cnv, doGP_ 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 diff --git a/physics/rrtmgp_sw_main.meta b/physics/rrtmgp_sw_main.meta index c0be1658f..4ca6cc716 100644 --- a/physics/rrtmgp_sw_main.meta +++ b/physics/rrtmgp_sw_main.meta @@ -646,7 +646,7 @@ dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = out + intent = inout [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP From 662eeb1e34bd6f2b59c4c4a4dc257fb816ef8be6 Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Fri, 3 Feb 2023 17:09:07 +0000 Subject: [PATCH 19/19] Interface changes for SP build in GP --- physics/rrtmgp_lw_main.F90 | 16 ++++++++-------- physics/rrtmgp_sw_main.F90 | 16 ++++++++-------- 2 files changed, 16 insertions(+), 16 deletions(-) diff --git a/physics/rrtmgp_lw_main.F90 b/physics/rrtmgp_lw_main.F90 index d6b0ab630..c0bc99d35 100644 --- a/physics/rrtmgp_lw_main.F90 +++ b/physics/rrtmgp_lw_main.F90 @@ -7,7 +7,7 @@ !! ! ########################################################################################### module rrtmgp_lw_main - use machine, only: kind_phys + 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 @@ -234,9 +234,9 @@ subroutine rrtmgp_lw_main_run(doLWrad, doLWclrsky, top_at_1, doGP_lwscat, 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_phys), dimension(lw_gas_props%get_ngpt()) :: rng1D - real(kind_phys), dimension(lw_gas_props%get_ngpt(),nLay,rrtmgp_phys_blksz) :: rng3D,rng3D2 - real(kind_phys), dimension(lw_gas_props%get_ngpt()*nLay) :: rng2D + 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 @@ -464,7 +464,7 @@ subroutine rrtmgp_lw_main_run(doLWrad, doLWclrsky, top_at_1, doGP_lwscat, ! Cloud-overlap. ! Maximum-random, random or maximum. if (iovr == iovr_maxrand .or. iovr == iovr_rand .or. iovr == iovr_max) then - call sampled_mask(rng3D, cld_frac(iCol:iCol2,:), maskMCICA) + call sampled_mask(real(rng3D,kind=kind_phys), cld_frac(iCol:iCol2,:), maskMCICA) endif ! Exponential decorrelation length overlap if (iovr == iovr_dcorr) then @@ -475,12 +475,12 @@ subroutine rrtmgp_lw_main_run(doLWrad, doLWclrsky, top_at_1, doGP_lwscat, rng3D2(:,:,ix) = reshape(source = rng2D,shape=[lw_gas_props%get_ngpt(),nLay]) enddo ! - call sampled_mask(rng3D, cld_frac(iCol:iCol2,:), maskMCICA, & - overlap_param = cloud_overlap_param(iCol:iCol2,1:nLay-1), randoms2 = rng3D2) + 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(rng3D, cld_frac(iCol:iCol2,:), maskMCICA, & + 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 diff --git a/physics/rrtmgp_sw_main.F90 b/physics/rrtmgp_sw_main.F90 index 1a5b31e9e..b25e093e7 100644 --- a/physics/rrtmgp_sw_main.F90 +++ b/physics/rrtmgp_sw_main.F90 @@ -1,7 +1,7 @@ ! ########################################################################################### ! ########################################################################################### module rrtmgp_sw_main - use machine, only: kind_phys + 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 @@ -222,9 +222,9 @@ subroutine rrtmgp_sw_main_run(doSWrad, doSWclrsky, top_at_1, doGP_sgs_cnv, doGP_ 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_phys), dimension(sw_gas_props%get_ngpt()) :: rng1D - real(kind_phys), dimension(sw_gas_props%get_ngpt(),nLay,rrtmgp_phys_blksz) :: rng3D,rng3D2 - real(kind_phys), dimension(sw_gas_props%get_ngpt()*nLay) :: rng2D + 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) :: & @@ -505,7 +505,7 @@ subroutine rrtmgp_sw_main_run(doSWrad, doSWclrsky, top_at_1, doGP_sgs_cnv, doGP_ ! Cloud-overlap. ! Maximum-random, random or maximum. if (iovr == iovr_maxrand .or. iovr == iovr_rand .or. iovr == iovr_max) then - call sampled_mask(rng3D, cld_frac(iCols,:), maskMCICA) + call sampled_mask(real(rng3D, kind=kind_phys), cld_frac(iCols,:), maskMCICA) endif ! Exponential decorrelation length overlap if (iovr == iovr_dcorr) then @@ -516,12 +516,12 @@ subroutine rrtmgp_sw_main_run(doSWrad, doSWclrsky, top_at_1, doGP_sgs_cnv, doGP_ rng3D2(:,:,iblck) = reshape(source = rng2D,shape=[sw_gas_props%get_ngpt(),nLay]) enddo ! - call sampled_mask(rng3D, cld_frac(iCols,:), maskMCICA, & - overlap_param = cloud_overlap_param(iCols,1:nLay-1), randoms2 = rng3D2) + 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(rng3D, cld_frac(iCols,:), maskMCICA, & + 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