From 5263dfa3a0d17fa62eaf1780ed171b8d355048d6 Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Thu, 23 Apr 2020 14:05:56 -0600 Subject: [PATCH 01/50] Updated rte-rrtmgp submodule. Modified impacted interfaces in physics/ --- physics/rrtmgp_lw_gas_optics.F90 | 15 +++++++++--- physics/rrtmgp_sw_gas_optics.F90 | 39 +++++++++++++++++++++++++------- physics/rte-rrtmgp | 2 +- 3 files changed, 44 insertions(+), 12 deletions(-) diff --git a/physics/rrtmgp_lw_gas_optics.F90 b/physics/rrtmgp_lw_gas_optics.F90 index 408cc48f5..c446bd70c 100644 --- a/physics/rrtmgp_lw_gas_optics.F90 +++ b/physics/rrtmgp_lw_gas_optics.F90 @@ -66,7 +66,8 @@ subroutine rrtmgp_lw_gas_optics_init(rrtmgp_root_dir, rrtmgp_lw_file_gas, rrtmgp temp_ref ! Temperatures for reference atmosphere; temp_ref(# reference layers) [K] real(kind_phys), dimension(:,:), allocatable :: & band_lims, & ! Beginning and ending wavenumber [cm -1] for each band - totplnk ! Integrated Planck function by band + totplnk, & ! Integrated Planck function by band + optimal_angle_fit real(kind_phys), dimension(:,:,:), allocatable :: & vmr_ref, & ! volume mixing ratios for reference atmosphere kminor_lower, & ! (transformed from [nTemp x nEta x nGpt x nAbsorbers] array to @@ -97,7 +98,7 @@ subroutine rrtmgp_lw_gas_optics_init(rrtmgp_root_dir, rrtmgp_lw_file_gas, rrtmgp ntemps, npress, ngpts, nabsorbers, nextrabsorbers, nminorabsorbers,& nmixingfracs, nlayers, nbnds, npairs, ninternalSourcetemps, & nminor_absorber_intervals_lower, nminor_absorber_intervals_upper, & - ncontributors_lower, ncontributors_upper + ncontributors_lower, ncontributors_upper,nfit_coeffs ! Local variables integer :: ncid, dimID, varID, status, iGas, ierr @@ -142,6 +143,8 @@ subroutine rrtmgp_lw_gas_optics_init(rrtmgp_root_dir, rrtmgp_lw_file_gas, rrtmgp status = nf90_inquire_dimension(ncid, dimid, len = ncontributors_lower) status = nf90_inq_dimid(ncid, 'contributors_upper', dimid) status = nf90_inquire_dimension(ncid, dimid, len = ncontributors_upper) + status = nf90_inq_dimid(ncid, 'fit_coeffs', dimid) + status = nf90_inquire_dimension(ncid, dimid, len = nfit_coeffs) status = nf90_inq_dimid(ncid, 'minor_absorber_intervals_lower', dimid) status = nf90_inquire_dimension(ncid, dimid, len = nminor_absorber_intervals_lower) status = nf90_inq_dimid(ncid, 'minor_absorber_intervals_upper', dimid) @@ -170,6 +173,7 @@ subroutine rrtmgp_lw_gas_optics_init(rrtmgp_root_dir, rrtmgp_lw_file_gas, rrtmgp allocate(kminor_start_lower(nminor_absorber_intervals_lower)) allocate(kminor_upper(ncontributors_upper, nmixingfracs, ntemps)) allocate(kminor_start_upper(nminor_absorber_intervals_upper)) + allocate(optimal_angle_fit(nfit_coeffs,nbnds)) allocate(minor_scales_with_density_lower(nminor_absorber_intervals_lower)) allocate(minor_scales_with_density_upper(nminor_absorber_intervals_upper)) allocate(scale_by_complement_lower(nminor_absorber_intervals_lower)) @@ -223,6 +227,8 @@ subroutine rrtmgp_lw_gas_optics_init(rrtmgp_root_dir, rrtmgp_lw_file_gas, rrtmgp status = nf90_get_var( ncid, varID, kminor_upper) status = nf90_inq_varid(ncid, 'vmr_ref', varID) status = nf90_get_var( ncid, varID, vmr_ref) + status = nf90_inq_varid(ncid, 'optimal_angle_fit',varID) + status = nf90_get_var( ncid, varID, optimal_angle_fit) status = nf90_inq_varid(ncid, 'kmajor', varID) status = nf90_get_var( ncid, varID, kmajor) status = nf90_inq_varid(ncid, 'kminor_start_lower', varID) @@ -257,6 +263,8 @@ subroutine rrtmgp_lw_gas_optics_init(rrtmgp_root_dir, rrtmgp_lw_file_gas, rrtmgp ! endif ! Initialize gas concentrations and gas optics class + print*,'nfit_coeffs: ',nfit_coeffs + print*,'optimal_angle_fit: ',optimal_angle_fit call check_error_msg('lw_gas_optics_init',gas_concentrations%init(active_gases_array)) call check_error_msg('lw_gas_optics_init',lw_gas_props%load(gas_concentrations, gas_names, & key_species, band2gpt, band_lims, press_ref, press_ref_trop, temp_ref, temp_ref_p, & @@ -264,7 +272,8 @@ subroutine rrtmgp_lw_gas_optics_init(rrtmgp_root_dir, rrtmgp_lw_file_gas, rrtmgp minor_gases_lower, minor_gases_upper, minor_limits_gpt_lower, minor_limits_gpt_upper, & minor_scales_with_density_lower, minor_scales_with_density_upper, scaling_gas_lower, & scaling_gas_upper, scale_by_complement_lower, scale_by_complement_upper, & - kminor_start_lower, kminor_start_upper, totplnk, planck_frac, rayl_lower, rayl_upper)) + kminor_start_lower, kminor_start_upper, totplnk, planck_frac, rayl_lower, rayl_upper, & + optimal_angle_fit)) end subroutine rrtmgp_lw_gas_optics_init diff --git a/physics/rrtmgp_sw_gas_optics.F90 b/physics/rrtmgp_sw_gas_optics.F90 index 7945f43fe..cb081c6d4 100644 --- a/physics/rrtmgp_sw_gas_optics.F90 +++ b/physics/rrtmgp_sw_gas_optics.F90 @@ -60,14 +60,18 @@ subroutine rrtmgp_sw_gas_optics_init(rrtmgp_root_dir, rrtmgp_sw_file_gas, rrtmgp real(kind_phys) :: & press_ref_trop, & ! Reference pressure separating the lower and upper atmosphere [Pa] temp_ref_p, & ! Standard spectroscopic reference pressure [Pa] - temp_ref_t ! Standard spectroscopic reference temperature [K] + temp_ref_t, & ! Standard spectroscopic reference temperature [K] + tsi_default, & ! + mg_default, & ! + sb_default ! real(kind_phys), dimension(:), allocatable :: & press_ref, & ! Pressures for reference atmosphere; press_ref(# reference layers) [Pa] temp_ref, & ! Temperatures for reference atmosphere; temp_ref(# reference layers) [K] - solar_source ! Stored solar source function from original RRTM + solar_quiet, & ! + solar_facular, & ! + solar_sunspot ! real(kind_phys), dimension(:,:), allocatable :: & band_lims ! Beginning and ending wavenumber [cm -1] for each band - real(kind_phys), dimension(:,:,:), allocatable :: & vmr_ref, & ! Volume mixing ratios for reference atmosphere kminor_lower, & ! (transformed from [nTemp x nEta x nGpt x nAbsorbers] array to @@ -172,7 +176,9 @@ subroutine rrtmgp_sw_gas_optics_init(rrtmgp_root_dir, rrtmgp_sw_file_gas, rrtmgp allocate(scale_by_complement_upper(nminor_absorber_intervals_upper)) allocate(rayl_upper(ngpts, nmixingfracs, ntemps)) allocate(rayl_lower(ngpts, nmixingfracs, ntemps)) - allocate(solar_source(ngpts)) + allocate(solar_quiet(ngpts)) + allocate(solar_facular(ngpts)) + allocate(solar_sunspot(ngpts)) allocate(temp1(nminor_absorber_intervals_lower)) allocate(temp2(nminor_absorber_intervals_upper)) allocate(temp3(nminor_absorber_intervals_lower)) @@ -211,7 +217,13 @@ subroutine rrtmgp_sw_gas_optics_init(rrtmgp_root_dir, rrtmgp_sw_file_gas, rrtmgp status = nf90_inq_varid(ncid, 'absorption_coefficient_ref_P', varID) status = nf90_get_var( ncid, varID, temp_ref_p) status = nf90_inq_varid(ncid, 'absorption_coefficient_ref_T', varID) - status = nf90_get_var( ncid, varID, temp_ref_t) + status = nf90_get_var( ncid, varID, temp_ref_t) + status = nf90_inq_varid(ncid, 'tsi_default', varID) + status = nf90_get_var( ncid, varID, tsi_default) + status = nf90_inq_varid(ncid, 'mg_default', varID) + status = nf90_get_var( ncid, varID, mg_default) + status = nf90_inq_varid(ncid, 'sb_default', varID) + status = nf90_get_var( ncid, varID, sb_default) status = nf90_inq_varid(ncid, 'press_ref_trop', varID) status = nf90_get_var( ncid, varID, press_ref_trop) status = nf90_inq_varid(ncid, 'kminor_lower', varID) @@ -226,8 +238,12 @@ subroutine rrtmgp_sw_gas_optics_init(rrtmgp_root_dir, rrtmgp_sw_file_gas, rrtmgp status = nf90_get_var( ncid, varID, kminor_start_lower) status = nf90_inq_varid(ncid, 'kminor_start_upper', varID) status = nf90_get_var( ncid, varID, kminor_start_upper) - status = nf90_inq_varid(ncid, 'solar_source', varID) - status = nf90_get_var( ncid, varID, solar_source) + status = nf90_inq_varid(ncid, 'solar_source_quiet', varID) + status = nf90_get_var( ncid, varID, solar_quiet) + status = nf90_inq_varid(ncid, 'solar_source_facular', varID) + status = nf90_get_var( ncid, varID, solar_facular) + status = nf90_inq_varid(ncid, 'solar_source_sunspot', varID) + status = nf90_get_var( ncid, varID, solar_sunspot) status = nf90_inq_varid(ncid, 'rayl_lower', varID) status = nf90_get_var( ncid, varID, rayl_lower) status = nf90_inq_varid(ncid, 'rayl_upper', varID) @@ -257,6 +273,12 @@ subroutine rrtmgp_sw_gas_optics_init(rrtmgp_root_dir, rrtmgp_sw_file_gas, rrtmgp ! Initialize gas concentrations and gas optics class + print*,'tsi_default: ',tsi_default + print*,'mg_default: ',mg_default + print*,'sv_default: ',sb_default + print*,'solar_quiet: ',solar_quiet + print*,'solar_facular: ',solar_facular + print*,'solar_sunspot: ',solar_sunspot call check_error_msg('sw_gas_optics_init',gas_concentrations%init(active_gases_array)) call check_error_msg('sw_gas_optics_init',sw_gas_props%load(gas_concentrations, gas_names, & key_species, band2gpt, band_lims, press_ref, press_ref_trop, temp_ref, temp_ref_p, & @@ -264,7 +286,8 @@ subroutine rrtmgp_sw_gas_optics_init(rrtmgp_root_dir, rrtmgp_sw_file_gas, rrtmgp minor_gases_lower, minor_gases_upper, minor_limits_gpt_lower,minor_limits_gpt_upper, & minor_scales_with_density_lower, minor_scales_with_density_upper, scaling_gas_lower, & scaling_gas_upper, scale_by_complement_lower, scale_by_complement_upper, & - kminor_start_lower, kminor_start_upper, solar_source, rayl_lower, rayl_upper)) + kminor_start_lower, kminor_start_upper, solar_quiet, solar_facular, solar_sunspot, & + tsi_default, mg_default, sb_default, rayl_lower, rayl_upper)) end subroutine rrtmgp_sw_gas_optics_init diff --git a/physics/rte-rrtmgp b/physics/rte-rrtmgp index 7dfff2025..bab7d03c1 160000 --- a/physics/rte-rrtmgp +++ b/physics/rte-rrtmgp @@ -1 +1 @@ -Subproject commit 7dfff2025cae02c84b12df2402a39d77065f0e62 +Subproject commit bab7d03c1bc10e43b7077832aa36cb84c4598c08 From 066c357aaf6c1b80811a18012a4b3d4203d63d67 Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Mon, 27 Apr 2020 12:20:11 -0600 Subject: [PATCH 02/50] Updated GP suite heating rates. --- physics/GFS_rrtmgp_lw_post.F90 | 11 +++++------ physics/GFS_rrtmgp_lw_post.meta | 18 ++++++++++++++++++ physics/GFS_rrtmgp_sw_post.F90 | 10 ++++++---- physics/GFS_rrtmgp_sw_post.meta | 18 ++++++++++++++++++ physics/rrtmgp_lw_gas_optics.F90 | 2 -- physics/rrtmgp_sw_gas_optics.F90 | 6 ------ 6 files changed, 47 insertions(+), 18 deletions(-) diff --git a/physics/GFS_rrtmgp_lw_post.F90 b/physics/GFS_rrtmgp_lw_post.F90 index 103d88274..8f5bb3611 100644 --- a/physics/GFS_rrtmgp_lw_post.F90 +++ b/physics/GFS_rrtmgp_lw_post.F90 @@ -33,7 +33,7 @@ end subroutine GFS_rrtmgp_lw_post_init subroutine GFS_rrtmgp_lw_post_run (Model, Grid, Radtend, Coupling, Diag, Statein, im, & p_lev, tsfa, fluxlwUP_allsky, fluxlwDOWN_allsky, fluxlwUP_clrsky, fluxlwDOWN_clrsky,& raddt, aerodp, cldsa, mtopa, mbota, cld_frac, cldtaulw, & - flxprf_lw, errmsg, errflg) + flxprf_lw, hlwc, hlw0, errmsg, errflg) ! Inputs type(GFS_control_type), intent(in) :: & @@ -65,9 +65,6 @@ subroutine GFS_rrtmgp_lw_post_run (Model, Grid, Radtend, Coupling, Diag, Statei real(kind_phys), dimension(im,Model%levs), intent(in) :: & cld_frac, & ! Total cloud fraction in each layer cldtaulw ! approx 10.mu band layer cloud optical depth - real(kind_phys),dimension(size(Grid%xlon,1), Model%levs) :: & - hlwc, & ! Longwave all-sky heating-rate (K/sec) - hlw0 ! Longwave clear-sky heating-rate (K/sec) ! Outputs (mandatory) character(len=*), intent(out) :: & @@ -80,7 +77,8 @@ subroutine GFS_rrtmgp_lw_post_run (Model, Grid, Radtend, Coupling, Diag, Statei Radtend ! Fortran DDT: FV3-GFS radiation tendencies type(GFS_diag_type), intent(inout) :: & Diag ! Fortran DDT: FV3-GFS diagnotics data - + real(kind_phys),dimension(size(Grid%xlon,1), Model%levs), intent(inout) :: & + hlwc ! Longwave all-sky heating-rate (K/sec) ! Outputs (optional) type(proflw_type), dimension(size(Grid%xlon,1), Model%levs+1), optional, intent(inout) :: & flxprf_lw ! 2D radiative fluxes, components: @@ -88,7 +86,8 @@ subroutine GFS_rrtmgp_lw_post_run (Model, Grid, Radtend, Coupling, Diag, Statei ! dnfxc - total sky dnward flux (W/m2) ! upfx0 - clear sky upward flux (W/m2) ! dnfx0 - clear sky dnward flux (W/m2) - + real(kind_phys),dimension(size(Grid%xlon,1), Model%levs),intent(inout),optional :: & + hlw0 ! Longwave clear-sky heating-rate (K/sec) ! Local variables integer :: i, j, k, iSFC, iTOA, itop, ibtc logical :: l_fluxeslw2d, top_at_1 diff --git a/physics/GFS_rrtmgp_lw_post.meta b/physics/GFS_rrtmgp_lw_post.meta index dbe96120d..274bc1129 100644 --- a/physics/GFS_rrtmgp_lw_post.meta +++ b/physics/GFS_rrtmgp_lw_post.meta @@ -180,6 +180,24 @@ type = proflw_type intent = inout optional = T +[hlwc] + standard_name = tendency_of_air_temperature_due_to_longwave_heating_on_radiation_time_step_and_radiation_levels + long_name = longwave total sky heating rate + units = K s-1 + dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + type = real + kind = kind_phys + intent = inout + optional = F +[hlw0] + standard_name = tendency_of_air_temperature_due_to_longwave_heating_assuming_clear_sky_on_radiation_time_step_and_radiation_levels + long_name = longwave clear sky heating rate + units = K s-1 + dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + type = real + kind = kind_phys + intent = inout + optional = T [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 4e9f8a33f..086bceb4c 100644 --- a/physics/GFS_rrtmgp_sw_post.F90 +++ b/physics/GFS_rrtmgp_sw_post.F90 @@ -30,7 +30,7 @@ subroutine GFS_rrtmgp_sw_post_run (Model, Grid, Diag, Radtend, Coupling, Statein nCol, p_lev, sfc_alb_nir_dir, sfc_alb_nir_dif, sfc_alb_uvvis_dir, sfc_alb_uvvis_dif, & sw_gas_props, nday, idxday, fluxswUP_allsky, fluxswDOWN_allsky, fluxswUP_clrsky, & fluxswDOWN_clrsky, raddt, aerodp, cldsa, mbota, mtopa, cld_frac, cldtausw, flxprf_sw,& - errmsg, errflg) + hswc, hsw0, errmsg, errflg) ! Inputs type(GFS_control_type), intent(in) :: & @@ -76,11 +76,10 @@ subroutine GFS_rrtmgp_sw_post_run (Model, Grid, Diag, Radtend, Coupling, Statein real(kind_phys), dimension(nCol,Model%levs), intent(in) :: & cld_frac, & ! Total cloud fraction in each layer cldtausw ! approx .55mu band layer cloud optical depth - real(kind_phys),dimension(nCol, Model%levs) :: & - hswc, & ! All-sky heating rate (K/s) - hsw0 ! Clear-sky heating rate (K/s) ! Outputs (mandatory) + real(kind_phys),dimension(nCol, Model%levs), intent(inout) :: & + hswc ! All-sky heating rate (K/s) character(len=*), intent(out) :: & errmsg integer, intent(out) :: & @@ -101,6 +100,9 @@ subroutine GFS_rrtmgp_sw_post_run (Model, Grid, Diag, Radtend, Coupling, Statein ! 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_phys),dimension(nCol, Model%levs),intent(inout),optional :: & + hsw0 ! Clear-sky heating rate (K/s) + ! Local variables integer :: i, j, k, iSFC, iTOA, itop, ibtc real(kind_phys) :: tem0d, tem1, tem2 diff --git a/physics/GFS_rrtmgp_sw_post.meta b/physics/GFS_rrtmgp_sw_post.meta index a817d9332..96155580b 100644 --- a/physics/GFS_rrtmgp_sw_post.meta +++ b/physics/GFS_rrtmgp_sw_post.meta @@ -239,6 +239,24 @@ type = profsw_type intent = inout optional = T +[hswc] + standard_name = tendency_of_air_temperature_due_to_shortwave_heating_on_radiation_time_step_and_radiation_levels + long_name = shortwave total sky heating rate + units = K s-1 + dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + type = real + kind = kind_phys + intent = inout + optional = F +[hsw0] + standard_name = tendency_of_air_temperature_due_to_shortwave_heating_assuming_clear_sky_on_radiation_time_step_and_radiation_levels + long_name = shortwave clear sky heating rate + units = K s-1 + dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + type = real + kind = kind_phys + intent = inout + optional = T [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/rrtmgp_lw_gas_optics.F90 b/physics/rrtmgp_lw_gas_optics.F90 index c446bd70c..418420dd6 100644 --- a/physics/rrtmgp_lw_gas_optics.F90 +++ b/physics/rrtmgp_lw_gas_optics.F90 @@ -263,8 +263,6 @@ subroutine rrtmgp_lw_gas_optics_init(rrtmgp_root_dir, rrtmgp_lw_file_gas, rrtmgp ! endif ! Initialize gas concentrations and gas optics class - print*,'nfit_coeffs: ',nfit_coeffs - print*,'optimal_angle_fit: ',optimal_angle_fit call check_error_msg('lw_gas_optics_init',gas_concentrations%init(active_gases_array)) call check_error_msg('lw_gas_optics_init',lw_gas_props%load(gas_concentrations, gas_names, & key_species, band2gpt, band_lims, press_ref, press_ref_trop, temp_ref, temp_ref_p, & diff --git a/physics/rrtmgp_sw_gas_optics.F90 b/physics/rrtmgp_sw_gas_optics.F90 index cb081c6d4..63b499432 100644 --- a/physics/rrtmgp_sw_gas_optics.F90 +++ b/physics/rrtmgp_sw_gas_optics.F90 @@ -273,12 +273,6 @@ subroutine rrtmgp_sw_gas_optics_init(rrtmgp_root_dir, rrtmgp_sw_file_gas, rrtmgp ! Initialize gas concentrations and gas optics class - print*,'tsi_default: ',tsi_default - print*,'mg_default: ',mg_default - print*,'sv_default: ',sb_default - print*,'solar_quiet: ',solar_quiet - print*,'solar_facular: ',solar_facular - print*,'solar_sunspot: ',solar_sunspot call check_error_msg('sw_gas_optics_init',gas_concentrations%init(active_gases_array)) call check_error_msg('sw_gas_optics_init',sw_gas_props%load(gas_concentrations, gas_names, & key_species, band2gpt, band_lims, press_ref, press_ref_trop, temp_ref, temp_ref_p, & From c0c684c5fa13e466c202f0aaa6ceddc008f756e4 Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Thu, 30 Apr 2020 10:52:56 -0600 Subject: [PATCH 03/50] Change nf90 mode from WRITE to NOWRITE. --- physics/rrtmgp_lw_cloud_optics.F90 | 2 +- physics/rrtmgp_lw_gas_optics.F90 | 2 +- physics/rrtmgp_sw_cloud_optics.F90 | 2 +- physics/rrtmgp_sw_gas_optics.F90 | 2 +- 4 files changed, 4 insertions(+), 4 deletions(-) diff --git a/physics/rrtmgp_lw_cloud_optics.F90 b/physics/rrtmgp_lw_cloud_optics.F90 index 1738f895d..acff26bb6 100644 --- a/physics/rrtmgp_lw_cloud_optics.F90 +++ b/physics/rrtmgp_lw_cloud_optics.F90 @@ -105,7 +105,7 @@ subroutine rrtmgp_lw_cloud_optics_init(cld_optics_scheme, nrghice, rrtmgp_root_d ! On master processor only... ! if (mpirank .eq. mpiroot) then ! Open file - status = nf90_open(trim(lw_cloud_props_file), NF90_WRITE, ncid) + status = nf90_open(trim(lw_cloud_props_file), NF90_NOWRITE, ncid) ! Read dimensions status = nf90_inq_dimid(ncid, 'nband', dimid) diff --git a/physics/rrtmgp_lw_gas_optics.F90 b/physics/rrtmgp_lw_gas_optics.F90 index 418420dd6..787db6bb4 100644 --- a/physics/rrtmgp_lw_gas_optics.F90 +++ b/physics/rrtmgp_lw_gas_optics.F90 @@ -116,7 +116,7 @@ subroutine rrtmgp_lw_gas_optics_init(rrtmgp_root_dir, rrtmgp_lw_file_gas, rrtmgp ! On master processor only... ! if (mpirank .eq. mpiroot) then ! Open file - status = nf90_open(trim(lw_gas_props_file), NF90_WRITE, ncid) + status = nf90_open(trim(lw_gas_props_file), NF90_NOWRITE, ncid) ! Read dimensions for k-distribution fields status = nf90_inq_dimid(ncid, 'temperature', dimid) diff --git a/physics/rrtmgp_sw_cloud_optics.F90 b/physics/rrtmgp_sw_cloud_optics.F90 index 79e439030..dfc80a859 100644 --- a/physics/rrtmgp_sw_cloud_optics.F90 +++ b/physics/rrtmgp_sw_cloud_optics.F90 @@ -105,7 +105,7 @@ subroutine rrtmgp_sw_cloud_optics_init(cld_optics_scheme, nrghice, rrtmgp_root_d ! On master processor only... ! if (mpirank .eq. mpiroot) then ! Open file - status = nf90_open(trim(sw_cloud_props_file), NF90_WRITE, ncid) + status = nf90_open(trim(sw_cloud_props_file), NF90_NOWRITE, ncid) ! Read dimensions status = nf90_inq_dimid(ncid, 'nband', dimid) diff --git a/physics/rrtmgp_sw_gas_optics.F90 b/physics/rrtmgp_sw_gas_optics.F90 index 63b499432..efe611e0c 100644 --- a/physics/rrtmgp_sw_gas_optics.F90 +++ b/physics/rrtmgp_sw_gas_optics.F90 @@ -117,7 +117,7 @@ subroutine rrtmgp_sw_gas_optics_init(rrtmgp_root_dir, rrtmgp_sw_file_gas, rrtmgp ! Read dimensions for k-distribution fields (only on master processor(0)) ! if (mpirank .eq. mpiroot) then ! Open file - status = nf90_open(trim(sw_gas_props_file), NF90_WRITE, ncid) + status = nf90_open(trim(sw_gas_props_file), NF90_NOWRITE, ncid) ! Read dimensions for k-distribution fields status = nf90_inq_dimid(ncid, 'temperature', dimid) From 4909bb67e854814097957415dcbafc7ecc052817 Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Thu, 30 Apr 2020 13:32:51 -0600 Subject: [PATCH 04/50] Fixed bug in pre radiation routine. --- physics/GFS_rrtmgp_pre.F90 | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/physics/GFS_rrtmgp_pre.F90 b/physics/GFS_rrtmgp_pre.F90 index 1344f269c..775627010 100644 --- a/physics/GFS_rrtmgp_pre.F90 +++ b/physics/GFS_rrtmgp_pre.F90 @@ -482,7 +482,7 @@ subroutine cloud_microphysics(Model, Tbd, Grid, Sfcprop, ncol, tracer, p_lay, t_ ! Local variables real(kind_phys), dimension(ncol, Model%levs, Model%ncnd) :: cld_condensate - integer :: i,k + integer :: i,k,ncndl real(kind_phys), parameter :: xrc3 = 100. real(kind_phys), dimension(ncol, Model%levs) :: delta_q, cnv_w, cnv_c, effr_l, & effr_i, effr_r, effr_s, cldcov @@ -497,6 +497,10 @@ subroutine cloud_microphysics(Model, Tbd, Grid, Sfcprop, ncol, tracer, p_lay, t_ ! call module_radiation_clouds::progcld3() ! call module_radiation_clouds::progclduni() for unified cloud and ncld=2 ! ####################################################################################### + + ! Note, snow and groupel are treated the same by radiation scheme. + ncndl = min(Model%ncnd,4) + cld_condensate = 0.0_kind_phys if (Model%ncnd == 1) then ! Zhao_Carr_Sundqvist cld_condensate(1:NCOL,1:Model%levs,1) = tracer(1:NCOL,1:Model%levs,Model%ntcw) ! -liquid water/ice @@ -719,7 +723,7 @@ subroutine cloud_microphysics(Model, Tbd, Grid, Sfcprop, ncol, tracer, p_lay, t_ t_lay, & ! IN - Temperature at layer centers (K) tv_lay, & ! IN - Virtual temperature at layer centers (K) cld_condensate, & ! IN - Cloud condensate amount (Model%ncnd types) () - Model%ncnd, & ! IN - Number of cloud condensate types () + ncndl, & ! IN - Number of cloud condensate types () Grid%xlat, & ! IN - Latitude (radians) Grid%xlon, & ! IN - Longitude (radians) Sfcprop%slmsk, & ! IN - Land/Sea mask () From c4ae36821dce3abb1dd6c32eb843da4df88c506b Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Thu, 30 Apr 2020 13:42:43 -0600 Subject: [PATCH 05/50] Omission from previous commit --- physics/GFS_rrtmgp_pre.F90 | 52 +++++++++++++++++++------------------- 1 file changed, 26 insertions(+), 26 deletions(-) diff --git a/physics/GFS_rrtmgp_pre.F90 b/physics/GFS_rrtmgp_pre.F90 index 775627010..b6be512f4 100644 --- a/physics/GFS_rrtmgp_pre.F90 +++ b/physics/GFS_rrtmgp_pre.F90 @@ -717,32 +717,32 @@ subroutine cloud_microphysics(Model, Tbd, Grid, Sfcprop, ncol, tracer, p_lay, t_ mbota, & ! OUT - vertical indices for low, mid, hi cloud bases (NCOL,3) de_lgth) ! OUT - clouds decorrelation length (km) else - call progclduni( & - p_lay/100., & ! IN - Pressure at model layer centers (mb) - p_lev/100., & ! IN - Pressure at model interfaces (mb) - t_lay, & ! IN - Temperature at layer centers (K) - tv_lay, & ! IN - Virtual temperature at layer centers (K) - cld_condensate, & ! IN - Cloud condensate amount (Model%ncnd types) () - ncndl, & ! IN - Number of cloud condensate types () - Grid%xlat, & ! IN - Latitude (radians) - Grid%xlon, & ! IN - Longitude (radians) - Sfcprop%slmsk, & ! IN - Land/Sea mask () - deltaZ, & ! IN - Layer thickness (km) - deltaP/100., & ! IN - Layer thickness (hPa) - NCOL, & ! IN - Number of horizontal gridpoints - MODEL%LEVS, & ! IN - Number of model layers - MODEL%LEVS+1, & ! IN - Number of model levels - cldcov, & ! IN - Layer cloud fraction (used if uni_cld=.true.) - effr_l, & ! IN - Liquid-water effective radius (microns) - effr_i, & ! IN - Ice-water effective radius (microns) - effr_r, & ! IN - Rain-water effective radius (microns) - effr_s, & ! IN - Snow-water effective radius (microns) - Model%effr_in, & ! IN - Logical, if .true. use input effective radii - clouds, & ! OUT - Cloud properties (NCOL,Model%levs,NF_CLDS) - cldsa, & ! OUT - fraction of clouds for low, mid, hi, tot, bl (NCOL,5) - mtopa, & ! OUT - vertical indices for low, mid, hi cloud tops (NCOL,3) - mbota, & ! OUT - vertical indices for low, mid, hi cloud bases (NCOL,3) - de_lgth) ! OUT - clouds decorrelation length (km) + call progclduni( & + p_lay/100., & ! IN - Pressure at model layer centers (mb) + p_lev/100., & ! IN - Pressure at model interfaces (mb) + t_lay, & ! IN - Temperature at layer centers (K) + tv_lay, & ! IN - Virtual temperature at layer centers (K) + cld_condensate(:,:,1:ncndl), & ! IN - Cloud condensate amount (ncndl types) () + ncndl, & ! IN - Number of cloud condensate types () + Grid%xlat, & ! IN - Latitude (radians) + Grid%xlon, & ! IN - Longitude (radians) + Sfcprop%slmsk, & ! IN - Land/Sea mask () + deltaZ, & ! IN - Layer thickness (km) + deltaP/100., & ! IN - Layer thickness (hPa) + NCOL, & ! IN - Number of horizontal gridpoints + MODEL%LEVS, & ! IN - Number of model layers + MODEL%LEVS+1, & ! IN - Number of model levels + cldcov, & ! IN - Layer cloud fraction (used if uni_cld=.true.) + effr_l, & ! IN - Liquid-water effective radius (microns) + effr_i, & ! IN - Ice-water effective radius (microns) + effr_r, & ! IN - Rain-water effective radius (microns) + effr_s, & ! IN - Snow-water effective radius (microns) + Model%effr_in, & ! IN - Logical, if .true. use input effective radii + clouds, & ! OUT - Cloud properties (NCOL,Model%levs,NF_CLDS) + cldsa, & ! OUT - fraction of clouds for low, mid, hi, tot, bl (NCOL,5) + mtopa, & ! OUT - vertical indices for low, mid, hi cloud tops (NCOL,3) + mbota, & ! OUT - vertical indices for low, mid, hi cloud bases (NCOL,3) + de_lgth) ! OUT - clouds decorrelation length (km) endif ! *) Thompson / WSM6 cloud micrphysics scheme elseif(Model%imp_physics == 8 .or. Model%imp_physics == 6) then From fd8d3b4f1242e43584981d27b5c832eac7c23346 Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Thu, 30 Apr 2020 14:20:57 -0600 Subject: [PATCH 06/50] Fix bug in sw cloud-optics band ordering. --- physics/rrtmgp_sw_cloud_optics.F90 | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/physics/rrtmgp_sw_cloud_optics.F90 b/physics/rrtmgp_sw_cloud_optics.F90 index dfc80a859..ec44c7f8d 100644 --- a/physics/rrtmgp_sw_cloud_optics.F90 +++ b/physics/rrtmgp_sw_cloud_optics.F90 @@ -350,9 +350,12 @@ subroutine rrtmgp_sw_cloud_optics_run(doSWrad, nCol, nLev, nDay, idxday, nrghice cld_swp(idxday(1:nday),:), cld_resnow(idxday(1:nday),:), & cld_frac(idxday(1:nday),:), tau_cld, ssa_cld, asy_cld) endif - sw_optical_props_cloudsByBand%tau(:,:,:) = tau_cld - sw_optical_props_cloudsByBand%ssa(:,:,:) = ssa_cld - sw_optical_props_cloudsByBand%g(:,:,:) = asy_cld + sw_optical_props_cloudsByBand%tau(:,:,1) = tau_cld(:,:,sw_gas_props%get_nband()) + sw_optical_props_cloudsByBand%ssa(:,:,1) = ssa_cld(:,:,sw_gas_props%get_nband()) + sw_optical_props_cloudsByBand%g(:,:,1) = asy_cld(:,:,sw_gas_props%get_nband()) + sw_optical_props_cloudsByBand%tau(:,:,2:sw_gas_props%get_nband()) = tau_cld(:,:,1:sw_gas_props%get_nband()-1) + sw_optical_props_cloudsByBand%ssa(:,:,2:sw_gas_props%get_nband()) = ssa_cld(:,:,1:sw_gas_props%get_nband()-1) + sw_optical_props_cloudsByBand%g(:,:,2:sw_gas_props%get_nband()) = asy_cld(:,:,1:sw_gas_props%get_nband()-1) endif ! All-sky SW optical depth ~0.55microns From 328a76bff6b97c374915b6ef7f49d027f79bcf7f Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Fri, 8 May 2020 11:47:55 -0600 Subject: [PATCH 07/50] Moved rte-rrtmgp cloud-sampling extension into ccpp-physics. Added new cloud-overlap scheme, not complete. --- physics/GFS_rrtmgp_pre.F90 | 38 ++-- physics/GFS_rrtmgp_pre.meta | 9 + physics/GFS_rrtmgp_sw_pre.F90 | 4 +- physics/GFS_rrtmgp_sw_pre.meta | 9 - physics/mo_cloud_sampling.F90 | 308 ++++++++++++++++++++++++++ physics/rrtmgp_sw_cloud_sampling.F90 | 13 +- physics/rrtmgp_sw_cloud_sampling.meta | 9 + 7 files changed, 360 insertions(+), 30 deletions(-) create mode 100644 physics/mo_cloud_sampling.F90 diff --git a/physics/GFS_rrtmgp_pre.F90 b/physics/GFS_rrtmgp_pre.F90 index b6be512f4..374d1e2e5 100644 --- a/physics/GFS_rrtmgp_pre.F90 +++ b/physics/GFS_rrtmgp_pre.F90 @@ -189,7 +189,7 @@ subroutine GFS_rrtmgp_pre_run (Model, Grid, Statein, Coupling, Radtend, Sfcprop, sec_diff_byband, raddt, p_lay, t_lay, p_lev, t_lev, tsfg, tsfa, cld_frac, cld_lwp,& ! OUT cld_reliq, cld_iwp, cld_reice, cld_swp, cld_resnow, cld_rwp, cld_rerain, & ! OUT tv_lay, relhum, tracer, cldsa, mtopa, mbota, de_lgth, gas_concentrations, & ! OUT - errmsg, errflg) + overlap_param, errmsg, errflg) ! Inputs type(GFS_control_type), intent(in) :: & @@ -244,7 +244,7 @@ subroutine GFS_rrtmgp_pre_run (Model, Grid, Statein, Coupling, Radtend, Sfcprop, real(kind_phys), dimension(ncol,Model%levs),intent(out) :: & tv_lay, & ! Virtual temperatue at model-layers relhum ! Relative-humidity at model-layers - real(kind_phys), dimension(ncol, Model%levs, 2:Model%ntrac),intent(out) :: & + real(kind_phys), dimension(ncol, Model%levs, Model%ntrac),intent(out) :: & tracer ! Array containing trace gases integer,dimension(ncol,3),intent(out) :: & mbota, & ! Vertical indices for cloud tops @@ -253,6 +253,8 @@ subroutine GFS_rrtmgp_pre_run (Model, Grid, Statein, Coupling, Radtend, Sfcprop, cldsa ! Fraction of clouds for low, middle, high, total and BL real(kind_phys), dimension(ncol), intent(out) :: & de_lgth ! Decorrelation length + real(kind_phys), dimension(nCol,Model%levs), intent(out) :: & + overlap_param ! Cloud-overlap parameter real(kind_phys), dimension(lw_gas_props%get_nband(),ncol),intent(out) :: & sec_diff_byband @@ -419,6 +421,14 @@ subroutine GFS_rrtmgp_pre_run (Model, Grid, Statein, Coupling, Radtend, Sfcprop, call cloud_microphysics(Model, Tbd, Grid, Sfcprop, ncol, tracer, p_lay, t_lay, p_lev, & tv_lay, relhum, qs_lay, q_lay, deltaZ, deltaP, clouds, cldsa, mbota, mtopa, de_lgth) + ! Cloud-overlap parameter (only needed for iovr = 3) + overlap_param(:,1) = 0._kind_phys + do iCol=1,nCol + do iLay=Model%levs,2,-1 + overlap_param(iCol,iLay) = exp( -0.5 * (deltaZ(iCol,iLay)+deltaZ(iCol,iLay-1)) / de_lgth(iCol) ) + enddo + enddo + ! Copy output cloud fields cld_frac = clouds(:,:,1) cld_lwp = clouds(:,:,2) @@ -455,7 +465,7 @@ subroutine cloud_microphysics(Model, Tbd, Grid, Sfcprop, ncol, tracer, p_lay, t_ Sfcprop ! DDT: FV3-GFS surface fields integer, intent(in) :: & ncol ! Number of horizontal gridpoints - real(kind_phys), dimension(ncol, Model%levs, 2:Model%ntrac),intent(in) :: & + real(kind_phys), dimension(ncol, Model%levs, Model%ntrac),intent(in) :: & tracer ! Cloud condensate amount in layer by type () real(kind_phys), dimension(ncol,Model%levs), intent(in) :: & p_lay, & ! Pressure @ model layer centers (Pa) @@ -481,8 +491,8 @@ subroutine cloud_microphysics(Model, Tbd, Grid, Sfcprop, ncol, tracer, p_lay, t_ cldsa ! Fraction of clouds for low, mid, hi, tot, bl (NCOL,5) ! Local variables - real(kind_phys), dimension(ncol, Model%levs, Model%ncnd) :: cld_condensate - integer :: i,k,ncndl + real(kind_phys), dimension(ncol, Model%levs, min(4,Model%ncnd)) :: cld_condensate + integer :: i,k,l,ncndl real(kind_phys), parameter :: xrc3 = 100. real(kind_phys), dimension(ncol, Model%levs) :: delta_q, cnv_w, cnv_c, effr_l, & effr_i, effr_r, effr_s, cldcov @@ -519,8 +529,15 @@ subroutine cloud_microphysics(Model, Tbd, Grid, Sfcprop, ncol, tracer, p_lay, t_ cld_condensate(1:NCOL,1:Model%levs,4) = tracer(1:NCOL,1:Model%levs,Model%ntsw) + & ! -snow + grapuel tracer(1:NCOL,1:Model%levs,Model%ntgl) endif - where(cld_condensate < epsq) cld_condensate = 0.0 - + + do l=1,ncndl + do k=1,Model%levs + do i=1,NCOL + if (cld_condensate(i,k,l) < epsq) cld_condensate(i,k,l) = 0.0 + enddo + enddo + enddo + ! For GFDL microphysics scheme... if (Model%imp_physics == 11 ) then if (.not. Model%lgfdlmprad) then @@ -587,11 +604,6 @@ subroutine cloud_microphysics(Model, Tbd, Grid, Sfcprop, ncol, tracer, p_lay, t_ cld_condensate(1:NCOL,1:Model%levs,1) = cld_condensate(1:NCOL,1:Model%levs,1) + cnv_w(1:NCOL,1:Model%levs) endif - ! For MG prognostic cloud scheme, add in convective cloud water to liquid-and-ice-cloud condensate - if (Model%imp_physics == 10) then - cld_condensate(1:NCOL,1:Model%levs,1) = cld_condensate(1:NCOL,1:Model%levs,1) + cnv_w(1:NCOL,1:Model%levs) + cld_condensate(1:NCOL,1:Model%levs,2) - endif - ! ####################################################################################### ! MICROPHYSICS ! ####################################################################################### @@ -722,7 +734,7 @@ subroutine cloud_microphysics(Model, Tbd, Grid, Sfcprop, ncol, tracer, p_lay, t_ p_lev/100., & ! IN - Pressure at model interfaces (mb) t_lay, & ! IN - Temperature at layer centers (K) tv_lay, & ! IN - Virtual temperature at layer centers (K) - cld_condensate(:,:,1:ncndl), & ! IN - Cloud condensate amount (ncndl types) () + cld_condensate, & ! IN - Cloud condensate amount (ncndl types) () ncndl, & ! IN - Number of cloud condensate types () Grid%xlat, & ! IN - Latitude (radians) Grid%xlon, & ! IN - Longitude (radians) diff --git a/physics/GFS_rrtmgp_pre.meta b/physics/GFS_rrtmgp_pre.meta index c80098709..f9c882fa7 100644 --- a/physics/GFS_rrtmgp_pre.meta +++ b/physics/GFS_rrtmgp_pre.meta @@ -334,6 +334,15 @@ kind = kind_phys intent = out optional = F +[overlap_param] + standard_name = cloud_overlap_param + long_name = cloud overlap parameter + units = km + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F [cldsa] standard_name = cloud_area_fraction_for_radiation long_name = fraction of clouds for low, middle, high, total and BL diff --git a/physics/GFS_rrtmgp_sw_pre.F90 b/physics/GFS_rrtmgp_sw_pre.F90 index 6987c3e4a..c9b5a1b87 100644 --- a/physics/GFS_rrtmgp_sw_pre.F90 +++ b/physics/GFS_rrtmgp_sw_pre.F90 @@ -36,7 +36,7 @@ end subroutine GFS_rrtmgp_sw_pre_init !! \htmlinclude GFS_rrtmgp_sw_pre.html !! subroutine GFS_rrtmgp_sw_pre_run(Model, Grid, Sfcprop, Statein, ncol, p_lay, p_lev, & - tv_lay, relhum, tracer, sw_gas_props, nday, idxday, alb1d, sfc_alb_nir_dir, & + tv_lay, relhum, sw_gas_props, nday, idxday, alb1d, sfc_alb_nir_dir, & sfc_alb_nir_dif, sfc_alb_uvvis_dir, sfc_alb_uvvis_dif, RadTend, Coupling, & errmsg, errflg) @@ -55,8 +55,6 @@ subroutine GFS_rrtmgp_sw_pre_run(Model, Grid, Sfcprop, Statein, ncol, p_lay, p_ p_lay, & ! Layer pressure tv_lay, & ! Layer virtual-temperature relhum ! Layer relative-humidity - real(kind_phys), dimension(ncol, Model%levs, 2:Model%ntrac),intent(in) :: & - tracer real(kind_phys), dimension(ncol,Model%levs+1),intent(in) :: & p_lev ! Pressure @ layer interfaces (Pa) type(ty_gas_optics_rrtmgp),intent(in) :: & diff --git a/physics/GFS_rrtmgp_sw_pre.meta b/physics/GFS_rrtmgp_sw_pre.meta index 73df740e1..d7e32510f 100644 --- a/physics/GFS_rrtmgp_sw_pre.meta +++ b/physics/GFS_rrtmgp_sw_pre.meta @@ -93,15 +93,6 @@ kind = kind_phys intent = in optional = F -[tracer] - standard_name = chemical_tracers - long_name = chemical tracers - units = g g-1 - dimensions = (horizontal_dimension,vertical_dimension,number_of_tracers) - type = real - kind = kind_phys - intent = in - optional = F [sw_gas_props] standard_name = coefficients_for_sw_gas_optics long_name = DDT containing spectral information for RRTMGP SW radiation scheme diff --git a/physics/mo_cloud_sampling.F90 b/physics/mo_cloud_sampling.F90 new file mode 100644 index 000000000..b814d461f --- /dev/null +++ b/physics/mo_cloud_sampling.F90 @@ -0,0 +1,308 @@ +! This code is part of RRTM for GCM Applications - Parallel (RRTMGP) +! +! Contacts: Robert Pincus and Eli Mlawer +! email: rrtmgp@aer.com +! +! Copyright 2015-2019, Atmospheric and Environmental Research and +! Regents of the University of Colorado. All right reserved. +! +! Use and duplication is permitted under the terms of the +! BSD 3-clause license, see http://opensource.org/licenses/BSD-3-Clause +! ------------------------------------------------------------------------------------------------- +! +! This module provides a simple implementation of sampling for the +! Monte Carlo Independent Pixel Approximation (McICA, doi:10.1029/2002jd003322) +! Cloud optical properties, defined by band and assumed homogenous within each cell (column/layer), +! are randomly sampled to preserve the mean cloud fraction and one of several possible overlap assumptions +! Users supply random numbers with order ngpt,nlay,ncol +! These are only accessed if cloud_fraction(icol,ilay) > 0 so many values don't need to be filled in +! +! ------------------------------------------------------------------------------------------------- +module mo_cloud_sampling + use mo_rte_kind, only: wp, wl + use mo_optical_props, only: ty_optical_props_arry, & + ty_optical_props_1scl, & + ty_optical_props_2str, & + ty_optical_props_nstr + implicit none + private + public :: draw_samples, sampled_mask_max_ran, sampled_mask_exp_ran +contains + ! ------------------------------------------------------------------------------------------------- + ! + ! Apply a T/F sampled cloud mask to cloud optical properties defined by band to produce + ! McICA-sampled cloud optical properties + ! + function draw_samples(cloud_mask,clouds,clouds_sampled) result(error_msg) + logical, dimension(:,:,:), intent(in ) :: cloud_mask ! Dimensions ncol,nlay,ngpt + class(ty_optical_props_arry), intent(in ) :: clouds ! Defined by band + class(ty_optical_props_arry), intent(inout) :: clouds_sampled ! Defined by g-point + character(len=128) :: error_msg + ! ------------------------ + integer :: ncol,nlay,nbnd,ngpt + integer :: imom + ! ------------------------ + ! + ! Error checking + ! + error_msg = "" + if(.not. clouds%is_initialized()) then + error_msg = "draw_samples: cloud optical properties are not initialized" + return + end if + if(.not. clouds_sampled%is_initialized()) then + error_msg = "draw_samples: sampled cloud optical properties are not initialized" + return + end if + + ! + ! Variables clouds and clouds_sampled have to be of the same type (have the same set of fields) + ! nstr isn't supported + ! 2str is checked at assignment + ! + select type(clouds) + type is (ty_optical_props_1scl) + select type(clouds_sampled) + type is (ty_optical_props_2str) + error_msg = "draw_samples: by-band and sampled cloud properties need to be the same variable type" + return + type is (ty_optical_props_nstr) + error_msg = "draw_samples: by-band and sampled cloud properties need to be the same variable type" + return + end select + type is (ty_optical_props_nstr) + error_msg = "draw_samples: sampling isn't implemented yet for ty_optical_props_nstr" + return + end select + + ! + ! Spectral discretization + ! + if(.not. clouds%bands_are_equal(clouds_sampled)) then + error_msg = "draw_samples: by-band and sampled cloud properties spectral structure is different" + return + end if + + ! + ! Array extents + ! + ncol = clouds%get_ncol() + nlay = clouds%get_nlay() + nbnd = clouds%get_nband() + ngpt = clouds_sampled%get_ngpt() + if (any([size(cloud_mask,1), size(cloud_mask,2), size(cloud_mask,3)] /= [ncol,nlay,ngpt])) then + error_msg = "draw_samples: cloud mask and cloud optical properties have different ncol and/or nlay" + return + end if + if (any([clouds_sampled%get_ncol(), clouds_sampled%get_nlay()] /= [ncol,nlay])) then + error_msg = "draw_samples: sampled/unsampled cloud optical properties have different ncol and/or nlay" + return + end if + ! ------------------------ + ! + ! Finally - sample fields according to the cloud mask + ! + ! Optical depth assignment works for 1scl, 2str (also nstr) + call apply_cloud_mask(ncol,nlay,nbnd,ngpt,clouds_sampled%get_band_lims_gpoint(),cloud_mask,clouds%tau,clouds_sampled%tau) + ! + ! For 2-stream + ! + select type(clouds) + type is (ty_optical_props_2str) + select type(clouds_sampled) + type is (ty_optical_props_2str) + call apply_cloud_mask(ncol,nlay,nbnd,ngpt,clouds_sampled%get_band_lims_gpoint(),cloud_mask,clouds%ssa,clouds_sampled%ssa) + call apply_cloud_mask(ncol,nlay,nbnd,ngpt,clouds_sampled%get_band_lims_gpoint(),cloud_mask,clouds%g, clouds_sampled%g ) + class default + error_msg = "draw_samples: by-band and sampled cloud properties need to be the same variable type" + end select + end select + end function draw_samples + ! ------------------------------------------------------------------------------------------------- + ! + ! Generate a McICA-sampled cloud mask for maximum-random overlap + ! + function sampled_mask_max_ran(randoms,cloud_frac,cloud_mask) result(error_msg) + real(wp), dimension(:,:,:), intent(in ) :: randoms !ngpt,nlay,ncol + real(wp), dimension(:,:), intent(in ) :: cloud_frac ! ncol,nlay + logical, dimension(:,:,:), intent(out) :: cloud_mask ! ncol,nlay,ngpt + character(len=128) :: error_msg + ! ------------------------ + integer :: ncol, nlay, ngpt, icol, ilay, igpt + integer :: cloud_lay_fst, cloud_lay_lst + real(wp), dimension(size(randoms,1)) :: local_rands + logical, dimension(size(randoms,2)) :: cloud_mask_layer + ! ------------------------ + ! + ! Error checking + ! + error_msg = "" + ncol = size(randoms, 3) + nlay = size(randoms, 2) + ngpt = size(randoms, 1) + if(any([ncol,nlay] /= [size(cloud_frac, 1),size(cloud_frac, 2)])) then + error_msg = "sampled_mask_max_ran: sizes of randoms(ngpt,nlay,ncol) and cloud_frac(ncol,nlay) are inconsistent" + return + end if + if(any([ncol,nlay,ngpt] /= [size(cloud_mask, 1),size(cloud_mask, 2), size(cloud_mask,3)])) then + error_msg = "sampled_mask_max_ran: sizes of randoms(ngpt,nlay,ncol) and cloud_mask(ncol,nlay,ngpt) are inconsistent" + return + end if + if(any(cloud_frac > 1._wp) .or. any(cloud_frac < 0._wp)) then + error_msg = "sampled_mask_max_ran: cloud fraction values out of range [0,1]" + return + end if + ! + ! We chould check the random numbers but that would be computationally heavy + ! + ! ------------------------ + ! + ! Construct the cloud mask for each column + ! + do icol = 1, ncol + cloud_mask_layer(1:nlay) = cloud_frac(icol,1:nlay) > 0._wp + if(.not. any(cloud_mask_layer)) then + cloud_mask(icol,1:nlay,1:ngpt) = .false. + cycle + end if + cloud_lay_fst = findloc(cloud_mask_layer, .true., dim=1) + cloud_lay_lst = findloc(cloud_mask_layer, .true., dim=1, back = .true.) + cloud_mask(icol,1:cloud_lay_fst,1:ngpt) = .false. + + ilay = cloud_lay_fst + local_rands(1:ngpt) = randoms(1:ngpt,cloud_lay_fst,icol) + cloud_mask(icol,ilay,1:ngpt) = local_rands(1:ngpt) > (1._wp - cloud_frac(icol,ilay)) + do ilay = cloud_lay_fst+1, cloud_lay_lst + if(cloud_mask_layer(ilay)) then + ! + ! Max-random overlap: + ! new random deviates if the adjacent layer isn't cloudy + ! same random deviates if the adjacent layer is cloudy + ! + if(.not. cloud_mask_layer(ilay-1)) local_rands(1:ngpt) = randoms(1:ngpt,ilay,icol) + cloud_mask(icol,ilay,1:ngpt) = local_rands(1:ngpt) > (1._wp - cloud_frac(icol,ilay)) + else + cloud_mask(icol,ilay,1:ngpt) = .false. + end if + end do + + cloud_mask(icol,cloud_lay_lst+1:nlay, 1:ngpt) = .false. + end do + + end function sampled_mask_max_ran + ! ------------------------------------------------------------------------------------------------- + ! + ! Generate a McICA-sampled cloud mask for exponential-random overlap + ! The overlap parameter alpha is defined between pairs of layers + ! for layer i, alpha(i) describes the overlap betwen cloud_frac(i) and cloud_frac(i+1) + ! By skipping layers with 0 cloud fraction the code forces alpha(i) = 0 for cloud_frac(i) = 0. + ! + function sampled_mask_exp_ran(randoms,cloud_frac,overlap_param,cloud_mask) result(error_msg) + real(wp), dimension(:,:,:), intent(in ) :: randoms ! ngpt,nlay,ncol + real(wp), dimension(:,:), intent(in ) :: cloud_frac ! ncol,nlay + real(wp), dimension(:,:), intent(in ) :: overlap_param ! ncol,nlay-1 + logical, dimension(:,:,:), intent(out) :: cloud_mask ! ncol,nlay,ngpt + character(len=128) :: error_msg + ! ------------------------ + integer :: ncol, nlay, ngpt, icol, ilay, igpt + integer :: cloud_lay_fst, cloud_lay_lst + real(wp) :: rho ! correlation coefficient + real(wp), dimension(size(randoms,1)) :: local_rands + logical, dimension(size(randoms,2)) :: cloud_mask_layer + ! ------------------------ + ! + ! Error checking + ! + error_msg = "" + ncol = size(randoms, 3) + nlay = size(randoms, 2) + ngpt = size(randoms, 1) + if(any([ncol,nlay] /= [size(cloud_frac, 1),size(cloud_frac, 2)])) then + error_msg = "sampled_mask_max_ran: sizes of randoms(ngpt,nlay,ncol) and cloud_frac(ncol,nlay) are inconsistent" + return + end if + if(any([ncol,nlay-1] /= [size(overlap_param, 1),size(overlap_param, 2)])) then + error_msg = "sampled_mask_max_ran: sizes of randoms(ngpt,nlay,ncol) and overlap_param(ncol,nlay-1) are inconsistent" + return + end if + if(any([ncol,nlay,ngpt] /= [size(cloud_mask, 1),size(cloud_mask, 2), size(cloud_mask,3)])) then + error_msg = "sampled_mask_max_ran: sizes of randoms(ngpt,nlay,ncol) and cloud_mask(ncol,nlay,ngpt) are inconsistent" + return + end if + + if(any(cloud_frac > 1._wp) .or. any(cloud_frac < 0._wp)) then + error_msg = "sampled_mask_max_ran: cloud fraction values out of range [0,1]" + return + end if + if(any(overlap_param > 1._wp) .or. any(overlap_param < -1._wp)) then + error_msg = "sampled_mask_max_ran: overlap_param values out of range [-1,1]" + return + end if + ! + ! We chould check the random numbers but that would be computationally heavy + ! + ! ------------------------ + ! Construct the cloud mask for each column + ! + do icol = 1, ncol + cloud_mask_layer(1:nlay) = cloud_frac(icol,1:nlay) > 0._wp + if(.not. any(cloud_mask_layer)) then + cloud_mask(icol,1:nlay,1:ngpt) = .false. + cycle + end if + cloud_lay_fst = findloc(cloud_mask_layer, .true., dim=1) + cloud_lay_lst = findloc(cloud_mask_layer, .true., dim=1, back = .true.) + cloud_mask(icol,1:cloud_lay_fst,1:ngpt) = .false. + + ilay = cloud_lay_fst + local_rands(1:ngpt) = randoms(1:ngpt,ilay,icol) + cloud_mask(icol,ilay,1:ngpt) = local_rands(1:ngpt) > (1._wp - cloud_frac(icol,ilay)) + do ilay = cloud_lay_fst+1, cloud_lay_lst + if(cloud_mask_layer(ilay)) then + ! + ! Exponential-random overlap: + ! new random deviates if the adjacent layer isn't cloudy + ! correlated deviates if the adjacent layer is cloudy + ! + if(cloud_mask_layer(ilay-1)) then + ! + ! Create random deviates correlated between this layer and the previous layer + ! (have to remove mean value before enforcing correlation) + ! + rho = overlap_param(icol,ilay-1) + local_rands(1:ngpt) = rho*(local_rands(1:ngpt) -0.5_wp) + & + sqrt(1._wp-rho*rho)*(randoms(1:ngpt,ilay,icol)-0.5_wp) + 0.5_wp + else + local_rands(1:ngpt) = randoms(1:ngpt,ilay,icol) + end if + cloud_mask(icol,ilay,1:ngpt) = local_rands(1:ngpt) > (1._wp - cloud_frac(icol,ilay)) + end if + end do + + cloud_mask(icol,cloud_lay_lst+1:nlay, 1:ngpt) = .false. + end do + + end function sampled_mask_exp_ran + ! ------------------------------------------------------------------------------------------------- + ! + ! Apply a true/false cloud mask to a homogeneous field + ! This could be a kernel + ! + subroutine apply_cloud_mask(ncol,nlay,nbnd,ngpt,band_lims_gpt,cloud_mask,input_field,sampled_field) + integer, intent(in ) :: ncol,nlay,nbnd,ngpt + integer, dimension(2,nbnd), intent(in ) :: band_lims_gpt + logical, dimension(ncol,nlay,ngpt), intent(in ) :: cloud_mask + real(wp), dimension(ncol,nlay,nbnd), intent(in ) :: input_field + real(wp), dimension(ncol,nlay,ngpt), intent(out) :: sampled_field + + integer :: icol,ilay,ibnd,igpt + + do ibnd = 1, nbnd + do igpt = band_lims_gpt(1,ibnd), band_lims_gpt(2,ibnd) + do ilay = 1, nlay + sampled_field(1:ncol,ilay,igpt) = merge(input_field(1:ncol,ilay,ibnd), 0._wp, cloud_mask(1:ncol,ilay,igpt)) + end do + end do + end do + end subroutine apply_cloud_mask +end module mo_cloud_sampling diff --git a/physics/rrtmgp_sw_cloud_sampling.F90 b/physics/rrtmgp_sw_cloud_sampling.F90 index 0c839afb2..64d015ff6 100644 --- a/physics/rrtmgp_sw_cloud_sampling.F90 +++ b/physics/rrtmgp_sw_cloud_sampling.F90 @@ -38,7 +38,7 @@ end subroutine rrtmgp_sw_cloud_sampling_init !! \htmlinclude rrtmgp_sw_cloud_sampling.html !! subroutine rrtmgp_sw_cloud_sampling_run(doSWrad, nCol, nDay, nLev, ipsdsw0, idxday, & - icseed_sw, cld_frac, sw_gas_props, sw_optical_props_cloudsByBand, & + icseed_sw, cld_frac, overlap_param, sw_gas_props, sw_optical_props_cloudsByBand, & sw_optical_props_clouds, errmsg, errflg) ! Inputs @@ -58,6 +58,8 @@ subroutine rrtmgp_sw_cloud_sampling_run(doSWrad, nCol, nDay, nLev, ipsdsw0, idxd ! random numbers. when isubcsw /=2, it will not be used. real(kind_phys), dimension(ncol,nLev),intent(in) :: & cld_frac ! Total cloud fraction by layer + real(kind_phys), dimension(ncol,nLev), intent(in) :: & + overlap_param ! Overlap parameter type(ty_gas_optics_rrtmgp),intent(in) :: & sw_gas_props ! RRTMGP DDT: K-distribution data type(ty_optical_props_2str),intent(in) :: & @@ -72,7 +74,7 @@ subroutine rrtmgp_sw_cloud_sampling_run(doSWrad, nCol, nDay, nLev, ipsdsw0, idxd sw_optical_props_clouds ! RRTMGP DDT: Shortwave optical properties (cloudy atmosphere) ! Local variables - integer :: iCol + integer :: iCol,iLay integer,dimension(ncol) :: ipseed_sw type(random_stat) :: rng_stat real(kind_phys), dimension(sw_gas_props%get_ngpt(),nLev,ncol) :: rng3D @@ -110,12 +112,13 @@ subroutine rrtmgp_sw_cloud_sampling_run(doSWrad, nCol, nDay, nLev, ipsdsw0, idxd call random_number(rng1D,rng_stat) rng3D(:,:,iCol) = reshape(source = rng1D,shape=[sw_gas_props%get_ngpt(),nLev]) enddo - + print*,'overlap_param: ',overlap_param ! Call McICA select case ( iovrsw ) - ! Maximumn-random - case(1) + case(1) ! Maximum-random call check_error_msg('rrtmgp_sw_cloud_sampling_run',sampled_mask_max_ran(rng3D,cld_frac,cldfracMCICA)) + case(3) ! Exponential-random + call check_error_msg('rrtmgp_sw_cloud_sampling_run',sampled_mask_exp_ran(rng3D,cld_frac,overlap_param(:,1:nLev-1),cldfracMCICA)) end select ! Map band optical depth to each g-point using McICA diff --git a/physics/rrtmgp_sw_cloud_sampling.meta b/physics/rrtmgp_sw_cloud_sampling.meta index 3ad9073d5..eed1101b8 100644 --- a/physics/rrtmgp_sw_cloud_sampling.meta +++ b/physics/rrtmgp_sw_cloud_sampling.meta @@ -87,6 +87,15 @@ kind = kind_phys intent = in optional = F +[overlap_param] + standard_name = cloud_overlap_param + long_name = cloud overlap parameter + units = km + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F [sw_gas_props] standard_name = coefficients_for_sw_gas_optics long_name = DDT containing spectral information for RRTMGP SW radiation scheme From 23e967501acc99bbd27d8f3578b9c60a0746e695 Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Fri, 8 May 2020 14:37:58 -0600 Subject: [PATCH 08/50] Found bug in SW (snow) cloud-optics. --- physics/rrtmg_sw_cloud_optics.F90 | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/physics/rrtmg_sw_cloud_optics.F90 b/physics/rrtmg_sw_cloud_optics.F90 index 7ff57039e..f576033d5 100644 --- a/physics/rrtmg_sw_cloud_optics.F90 +++ b/physics/rrtmg_sw_cloud_optics.F90 @@ -8,7 +8,9 @@ module mo_rrtmg_sw_cloud_optics integer,parameter :: & nBandsSW_RRTMG = 14 real(kind_phys),parameter :: & - a0r = 3.07e-3 + a0r = 3.07e-3, & + a0s = 0.0, &! + a1s = 1.5 ! real(kind_phys),dimension(nBandsSW_RRTMG),parameter :: & b0r = (/0.466, 0.437, 0.416, 0.391, 0.374, 0.352, 0.183, & 0.048, 0.012, 0.000, 0.000, 0.000, 0.000, 0.496/) @@ -2025,8 +2027,6 @@ module mo_rrtmg_sw_cloud_optics 9.727157e-03/), & ! shape = (/46,nBandsSW_RRTMG/)) - - real(kind_phys),dimension(5) :: & abari = (/ 3.448e-03,3.448e-03,3.448e-03,3.448e-03,3.448e-03 /), & bbari = (/ 2.431e+00,2.431e+00,2.431e+00,2.431e+00,2.431e+00 /), & @@ -2116,7 +2116,7 @@ subroutine rrtmg_sw_cloud_optics(ncol, nlay, nBandsSW, cld_lwp, cld_ref_liq, cld ! ########################################################################### ! Snow optical depth (No band dependence) if (cld_swp(iCol,iLay) .gt. 0. .and. cld_ref_snow(iCol,iLay) .gt. 10._kind_phys) then - tau_snow = cld_swp(iCol,iLay) + tau_snow = cld_swp(iCol,iLay)*1.09087*(a0s + a1s/(1.0315*cld_ref_snow(iCol,iLay))) ! fu's formula else tau_snow = 0._kind_phys endif From 156594cdd64ef18daf510f6745f676c25f9d37f4 Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Mon, 11 May 2020 10:24:04 -0600 Subject: [PATCH 09/50] Added in new overlap assumtion used in GFS_FV3_v16beta physics suite. --- physics/GFS_rrtmgp_pre.F90 | 2 +- physics/mo_cloud_sampling.F90 | 80 +++++++++++++-------------- physics/rrtmgp_lw_cloud_sampling.F90 | 16 ++++-- physics/rrtmgp_lw_cloud_sampling.meta | 9 +++ physics/rrtmgp_sw_cloud_sampling.F90 | 11 ++-- 5 files changed, 67 insertions(+), 51 deletions(-) diff --git a/physics/GFS_rrtmgp_pre.F90 b/physics/GFS_rrtmgp_pre.F90 index 374d1e2e5..eb2a5534c 100644 --- a/physics/GFS_rrtmgp_pre.F90 +++ b/physics/GFS_rrtmgp_pre.F90 @@ -425,7 +425,7 @@ subroutine GFS_rrtmgp_pre_run (Model, Grid, Statein, Coupling, Radtend, Sfcprop, overlap_param(:,1) = 0._kind_phys do iCol=1,nCol do iLay=Model%levs,2,-1 - overlap_param(iCol,iLay) = exp( -0.5 * (deltaZ(iCol,iLay)+deltaZ(iCol,iLay-1)) / de_lgth(iCol) ) + overlap_param(iCol,iLay-1) = exp( -0.5 * (deltaZ(iCol,iLay)+deltaZ(iCol,iLay-1)) / de_lgth(iCol) ) enddo enddo diff --git a/physics/mo_cloud_sampling.F90 b/physics/mo_cloud_sampling.F90 index b814d461f..d2225a230 100644 --- a/physics/mo_cloud_sampling.F90 +++ b/physics/mo_cloud_sampling.F90 @@ -26,7 +26,7 @@ module mo_cloud_sampling ty_optical_props_nstr implicit none private - public :: draw_samples, sampled_mask_max_ran, sampled_mask_exp_ran + public :: draw_samples, sampled_mask_max_ran, sampled_mask_exp_dcorr contains ! ------------------------------------------------------------------------------------------------- ! @@ -192,13 +192,11 @@ function sampled_mask_max_ran(randoms,cloud_frac,cloud_mask) result(error_msg) end function sampled_mask_max_ran ! ------------------------------------------------------------------------------------------------- ! - ! Generate a McICA-sampled cloud mask for exponential-random overlap + ! Generate a McICA-sampled cloud mask for exponential-decorrelation overlap ! The overlap parameter alpha is defined between pairs of layers - ! for layer i, alpha(i) describes the overlap betwen cloud_frac(i) and cloud_frac(i+1) - ! By skipping layers with 0 cloud fraction the code forces alpha(i) = 0 for cloud_frac(i) = 0. ! - function sampled_mask_exp_ran(randoms,cloud_frac,overlap_param,cloud_mask) result(error_msg) - real(wp), dimension(:,:,:), intent(in ) :: randoms ! ngpt,nlay,ncol + function sampled_mask_exp_dcorr(randoms1,randoms2,cloud_frac,overlap_param,cloud_mask) result(error_msg) + real(wp), dimension(:,:,:), intent(in ) :: randoms1,randoms2 ! ngpt,nlay,ncol real(wp), dimension(:,:), intent(in ) :: cloud_frac ! ncol,nlay real(wp), dimension(:,:), intent(in ) :: overlap_param ! ncol,nlay-1 logical, dimension(:,:,:), intent(out) :: cloud_mask ! ncol,nlay,ngpt @@ -206,27 +204,25 @@ function sampled_mask_exp_ran(randoms,cloud_frac,overlap_param,cloud_mask) resul ! ------------------------ integer :: ncol, nlay, ngpt, icol, ilay, igpt integer :: cloud_lay_fst, cloud_lay_lst - real(wp) :: rho ! correlation coefficient - real(wp), dimension(size(randoms,1)) :: local_rands - logical, dimension(size(randoms,2)) :: cloud_mask_layer + logical, dimension(size(randoms1,2)) :: cloud_mask_layer ! ------------------------ ! ! Error checking ! error_msg = "" - ncol = size(randoms, 3) - nlay = size(randoms, 2) - ngpt = size(randoms, 1) + ncol = size(randoms1, 3) + nlay = size(randoms1, 2) + ngpt = size(randoms1, 1) if(any([ncol,nlay] /= [size(cloud_frac, 1),size(cloud_frac, 2)])) then - error_msg = "sampled_mask_max_ran: sizes of randoms(ngpt,nlay,ncol) and cloud_frac(ncol,nlay) are inconsistent" + error_msg = "sampled_mask_max_ran: sizes of randoms1(ngpt,nlay,ncol) and cloud_frac(ncol,nlay) are inconsistent" return end if if(any([ncol,nlay-1] /= [size(overlap_param, 1),size(overlap_param, 2)])) then - error_msg = "sampled_mask_max_ran: sizes of randoms(ngpt,nlay,ncol) and overlap_param(ncol,nlay-1) are inconsistent" + error_msg = "sampled_mask_max_ran: sizes of randoms1(ngpt,nlay,ncol) and overlap_param(ncol,nlay-1) are inconsistent" return end if if(any([ncol,nlay,ngpt] /= [size(cloud_mask, 1),size(cloud_mask, 2), size(cloud_mask,3)])) then - error_msg = "sampled_mask_max_ran: sizes of randoms(ngpt,nlay,ncol) and cloud_mask(ncol,nlay,ngpt) are inconsistent" + error_msg = "sampled_mask_max_ran: sizes of randoms1(ngpt,nlay,ncol) and cloud_mask(ncol,nlay,ngpt) are inconsistent" return end if @@ -238,51 +234,51 @@ function sampled_mask_exp_ran(randoms,cloud_frac,overlap_param,cloud_mask) resul error_msg = "sampled_mask_max_ran: overlap_param values out of range [-1,1]" return end if - ! - ! We chould check the random numbers but that would be computationally heavy - ! - ! ------------------------ - ! Construct the cloud mask for each column + ! do icol = 1, ncol + ! Column cloud-mask cloud_mask_layer(1:nlay) = cloud_frac(icol,1:nlay) > 0._wp + + ! Skip column if no clouds if(.not. any(cloud_mask_layer)) then cloud_mask(icol,1:nlay,1:ngpt) = .false. cycle end if + + ! Pull out indices for First/Last cloudy layers cloud_lay_fst = findloc(cloud_mask_layer, .true., dim=1) cloud_lay_lst = findloc(cloud_mask_layer, .true., dim=1, back = .true.) + + ! Set cloud-mask in layers above cloud to false cloud_mask(icol,1:cloud_lay_fst,1:ngpt) = .false. + ! Loop over cloudy-layers + ! + ! First layer + ! ilay = cloud_lay_fst - local_rands(1:ngpt) = randoms(1:ngpt,ilay,icol) - cloud_mask(icol,ilay,1:ngpt) = local_rands(1:ngpt) > (1._wp - cloud_frac(icol,ilay)) + cloud_mask(icol,ilay,1:ngpt) = randoms1(1:ngpt,iLay,iCol) > (1._wp - cloud_frac(iCol,iLay)) + ! + ! Subsequent-layers + ! do ilay = cloud_lay_fst+1, cloud_lay_lst - if(cloud_mask_layer(ilay)) then - ! - ! Exponential-random overlap: - ! new random deviates if the adjacent layer isn't cloudy - ! correlated deviates if the adjacent layer is cloudy - ! - if(cloud_mask_layer(ilay-1)) then - ! - ! Create random deviates correlated between this layer and the previous layer - ! (have to remove mean value before enforcing correlation) - ! - rho = overlap_param(icol,ilay-1) - local_rands(1:ngpt) = rho*(local_rands(1:ngpt) -0.5_wp) + & - sqrt(1._wp-rho*rho)*(randoms(1:ngpt,ilay,icol)-0.5_wp) + 0.5_wp - else - local_rands(1:ngpt) = randoms(1:ngpt,ilay,icol) - end if - cloud_mask(icol,ilay,1:ngpt) = local_rands(1:ngpt) > (1._wp - cloud_frac(icol,ilay)) - end if + !if(cloud_mask_layer(ilay) .and. cloud_mask_layer(ilay-1)) then + where(randoms2(1:nGpt,iLay,iCol) .le. overlap_param(iCol,iLay)) + cloud_mask(iCol,iLay,1:nGpt) = randoms1(1:ngpt,iLay-1,iCol) > (1._wp - cloud_frac(iCol,iLay)) + elsewhere + cloud_mask(iCol,iLay,1:nGpt) = randoms1(1:ngpt,iLay,iCol) > (1._wp - cloud_frac(iCol,iLay)) + endwhere + !else + ! cloud_mask(iCol,iLay,1:nGpt) = .false. + !endif end do + ! Set cloud-mask in layer below clouds to false cloud_mask(icol,cloud_lay_lst+1:nlay, 1:ngpt) = .false. end do - end function sampled_mask_exp_ran + end function sampled_mask_exp_dcorr ! ------------------------------------------------------------------------------------------------- ! ! Apply a true/false cloud mask to a homogeneous field diff --git a/physics/rrtmgp_lw_cloud_sampling.F90 b/physics/rrtmgp_lw_cloud_sampling.F90 index e42336923..b95292d48 100644 --- a/physics/rrtmgp_lw_cloud_sampling.F90 +++ b/physics/rrtmgp_lw_cloud_sampling.F90 @@ -3,7 +3,7 @@ module rrtmgp_lw_cloud_sampling use mo_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp use physparam, only: isubclw, iovrlw use mo_optical_props, only: ty_optical_props_1scl - use mo_cloud_sampling, only: sampled_mask_max_ran, sampled_mask_exp_ran, draw_samples + use mo_cloud_sampling, only: sampled_mask_max_ran, sampled_mask_exp_dcorr, draw_samples use mersenne_twister, only: random_setseed, random_number, random_stat use rrtmgp_aux, only: check_error_msg use netcdf @@ -38,7 +38,8 @@ end subroutine rrtmgp_lw_cloud_sampling_init !! \htmlinclude rrtmgp_lw_cloud_sampling_run.html !! subroutine rrtmgp_lw_cloud_sampling_run(doLWrad, nCol, nLev, ipsdlw0, icseed_lw, cld_frac,& - lw_gas_props, lw_optical_props_cloudsByBand, lw_optical_props_clouds, errmsg, errflg) + overlap_param, lw_gas_props, lw_optical_props_cloudsByBand, lw_optical_props_clouds, & + errmsg, errflg) ! Inputs logical, intent(in) :: & @@ -54,6 +55,8 @@ subroutine rrtmgp_lw_cloud_sampling_run(doLWrad, nCol, nLev, ipsdlw0, icseed_lw, ! random numbers. when isubclw /=2, it will not be used. real(kind_phys), dimension(ncol,nLev),intent(in) :: & cld_frac ! Total cloud fraction by layer + real(kind_phys), dimension(ncol,nLev), intent(in) :: & + overlap_param ! Overlap parameter type(ty_gas_optics_rrtmgp),intent(in) :: & lw_gas_props ! RRTMGP DDT: K-distribution data type(ty_optical_props_1scl),intent(in) :: & @@ -71,7 +74,7 @@ subroutine rrtmgp_lw_cloud_sampling_run(doLWrad, nCol, nLev, ipsdlw0, icseed_lw, integer :: iCol integer,dimension(ncol) :: ipseed_lw type(random_stat) :: rng_stat - real(kind_phys), dimension(lw_gas_props%get_ngpt(),nLev,ncol) :: rng3D + real(kind_phys), dimension(lw_gas_props%get_ngpt(),nLev,ncol) :: rng3D,rng3D2 real(kind_phys), dimension(lw_gas_props%get_ngpt()*nLev) :: rng1D logical, dimension(ncol,nLev,lw_gas_props%get_ngpt()) :: cldfracMCICA real(kind_phys), dimension(ncol,nLev) :: cld_frac_noSamp @@ -109,8 +112,13 @@ subroutine rrtmgp_lw_cloud_sampling_run(doLWrad, nCol, nLev, ipsdlw0, icseed_lw, ! Call McICA select case ( iovrlw ) ! Maximumn-random - case(1) + case(1) ! Maximum-random overlap call check_error_msg('rrtmgp_lw_cloud_sampling_run',sampled_mask_max_ran(rng3D,cld_frac,cldfracMCICA)) + case(3) ! Exponential decorrelation length overlap + ! Generate second RNG + call random_number(rng1D,rng_stat) + rng3D2(:,:,iCol) = reshape(source = rng1D,shape=[lw_gas_props%get_ngpt(),nLev]) + call check_error_msg('rrtmgp_lw_cloud_sampling_run',sampled_mask_exp_dcorr(rng3D,rng3D2,cld_frac,overlap_param(:,1:nLev-1),cldfracMCICA)) end select ! Map band optical depth to each g-point using McICA diff --git a/physics/rrtmgp_lw_cloud_sampling.meta b/physics/rrtmgp_lw_cloud_sampling.meta index 547c6177c..4267cab3e 100644 --- a/physics/rrtmgp_lw_cloud_sampling.meta +++ b/physics/rrtmgp_lw_cloud_sampling.meta @@ -71,6 +71,15 @@ kind = kind_phys intent = in optional = F +[overlap_param] + standard_name = cloud_overlap_param + long_name = cloud overlap parameter + units = km + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F [lw_gas_props] standard_name = coefficients_for_lw_gas_optics long_name = DDT containing spectral information for RRTMGP LW radiation scheme diff --git a/physics/rrtmgp_sw_cloud_sampling.F90 b/physics/rrtmgp_sw_cloud_sampling.F90 index 64d015ff6..48afb0303 100644 --- a/physics/rrtmgp_sw_cloud_sampling.F90 +++ b/physics/rrtmgp_sw_cloud_sampling.F90 @@ -3,7 +3,7 @@ module rrtmgp_sw_cloud_sampling use mo_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp use physparam, only: isubcsw, iovrsw use mo_optical_props, only: ty_optical_props_2str - use mo_cloud_sampling, only: sampled_mask_max_ran, sampled_mask_exp_ran, draw_samples + use mo_cloud_sampling, only: sampled_mask_max_ran, sampled_mask_exp_dcorr, draw_samples use mersenne_twister, only: random_setseed, random_number, random_stat use rrtmgp_aux, only: check_error_msg use netcdf @@ -77,7 +77,7 @@ subroutine rrtmgp_sw_cloud_sampling_run(doSWrad, nCol, nDay, nLev, ipsdsw0, idxd integer :: iCol,iLay integer,dimension(ncol) :: ipseed_sw type(random_stat) :: rng_stat - real(kind_phys), dimension(sw_gas_props%get_ngpt(),nLev,ncol) :: rng3D + real(kind_phys), dimension(sw_gas_props%get_ngpt(),nLev,ncol) :: rng3D,rng3D2 real(kind_phys), dimension(sw_gas_props%get_ngpt()*nLev) :: rng1D logical, dimension(ncol,nLev,sw_gas_props%get_ngpt()) :: cldfracMCICA real(kind_phys), dimension(ncol,nLev) :: cld_frac_noSamp @@ -112,13 +112,16 @@ subroutine rrtmgp_sw_cloud_sampling_run(doSWrad, nCol, nDay, nLev, ipsdsw0, idxd call random_number(rng1D,rng_stat) rng3D(:,:,iCol) = reshape(source = rng1D,shape=[sw_gas_props%get_ngpt(),nLev]) enddo - print*,'overlap_param: ',overlap_param + ! Call McICA select case ( iovrsw ) case(1) ! Maximum-random call check_error_msg('rrtmgp_sw_cloud_sampling_run',sampled_mask_max_ran(rng3D,cld_frac,cldfracMCICA)) case(3) ! Exponential-random - call check_error_msg('rrtmgp_sw_cloud_sampling_run',sampled_mask_exp_ran(rng3D,cld_frac,overlap_param(:,1:nLev-1),cldfracMCICA)) + ! Generate second RNG + call random_number(rng1D,rng_stat) + rng3D2(:,:,iCol) = reshape(source = rng1D,shape=[sw_gas_props%get_ngpt(),nLev]) + call check_error_msg('rrtmgp_sw_cloud_sampling_run',sampled_mask_exp_dcorr(rng3D,rng3D2,cld_frac,overlap_param(:,1:nLev-1),cldfracMCICA)) end select ! Map band optical depth to each g-point using McICA From d3a81cd7b12bbf4bb89358911c762de3ca06fb7c Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Mon, 11 May 2020 11:36:40 -0600 Subject: [PATCH 10/50] Added loop over second RNG call in overlap routine. --- physics/rrtmgp_lw_cloud_sampling.F90 | 7 +++++-- physics/rrtmgp_sw_cloud_sampling.F90 | 7 +++++-- 2 files changed, 10 insertions(+), 4 deletions(-) diff --git a/physics/rrtmgp_lw_cloud_sampling.F90 b/physics/rrtmgp_lw_cloud_sampling.F90 index b95292d48..efb383a5d 100644 --- a/physics/rrtmgp_lw_cloud_sampling.F90 +++ b/physics/rrtmgp_lw_cloud_sampling.F90 @@ -116,8 +116,11 @@ subroutine rrtmgp_lw_cloud_sampling_run(doLWrad, nCol, nLev, ipsdlw0, icseed_lw, call check_error_msg('rrtmgp_lw_cloud_sampling_run',sampled_mask_max_ran(rng3D,cld_frac,cldfracMCICA)) case(3) ! Exponential decorrelation length overlap ! Generate second RNG - call random_number(rng1D,rng_stat) - rng3D2(:,:,iCol) = reshape(source = rng1D,shape=[lw_gas_props%get_ngpt(),nLev]) + do iCol=1,ncol + call random_setseed(ipseed_lw(icol),rng_stat) + call random_number(rng1D,rng_stat) + rng3D2(:,:,iCol) = reshape(source = rng1D,shape=[lw_gas_props%get_ngpt(),nLev]) + enddo call check_error_msg('rrtmgp_lw_cloud_sampling_run',sampled_mask_exp_dcorr(rng3D,rng3D2,cld_frac,overlap_param(:,1:nLev-1),cldfracMCICA)) end select diff --git a/physics/rrtmgp_sw_cloud_sampling.F90 b/physics/rrtmgp_sw_cloud_sampling.F90 index 48afb0303..22718418a 100644 --- a/physics/rrtmgp_sw_cloud_sampling.F90 +++ b/physics/rrtmgp_sw_cloud_sampling.F90 @@ -119,8 +119,11 @@ subroutine rrtmgp_sw_cloud_sampling_run(doSWrad, nCol, nDay, nLev, ipsdsw0, idxd call check_error_msg('rrtmgp_sw_cloud_sampling_run',sampled_mask_max_ran(rng3D,cld_frac,cldfracMCICA)) case(3) ! Exponential-random ! Generate second RNG - call random_number(rng1D,rng_stat) - rng3D2(:,:,iCol) = reshape(source = rng1D,shape=[sw_gas_props%get_ngpt(),nLev]) + do iCol=1,ncol + call random_setseed(ipseed_sw(icol),rng_stat) + call random_number(rng1D,rng_stat) + rng3D2(:,:,iCol) = reshape(source = rng1D,shape=[sw_gas_props%get_ngpt(),nLev]) + enddo call check_error_msg('rrtmgp_sw_cloud_sampling_run',sampled_mask_exp_dcorr(rng3D,rng3D2,cld_frac,overlap_param(:,1:nLev-1),cldfracMCICA)) end select From 0c438491004bdc476769d6e330f9fa4e04c12f2d Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Mon, 11 May 2020 14:02:16 -0600 Subject: [PATCH 11/50] Added conditional statement to avoid divide by zero. --- physics/GFS_rrtmgp_pre.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/physics/GFS_rrtmgp_pre.F90 b/physics/GFS_rrtmgp_pre.F90 index eb2a5534c..2c269f009 100644 --- a/physics/GFS_rrtmgp_pre.F90 +++ b/physics/GFS_rrtmgp_pre.F90 @@ -425,7 +425,7 @@ subroutine GFS_rrtmgp_pre_run (Model, Grid, Statein, Coupling, Radtend, Sfcprop, overlap_param(:,1) = 0._kind_phys do iCol=1,nCol do iLay=Model%levs,2,-1 - overlap_param(iCol,iLay-1) = exp( -0.5 * (deltaZ(iCol,iLay)+deltaZ(iCol,iLay-1)) / de_lgth(iCol) ) + if (de_lgth(iCol) .gt. 0) overlap_param(iCol,iLay-1) = exp( -0.5 * (deltaZ(iCol,iLay)+deltaZ(iCol,iLay-1)) / de_lgth(iCol) ) enddo enddo From 4c8a5815d235284d4e6d5a7f356e20a9fd0ecac4 Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Thu, 14 May 2020 13:40:21 -0600 Subject: [PATCH 12/50] Major reorganization of GFDLMP-2-RRTMGP interface. --- physics/GFS_cloud_diagnostics.F90 | 566 +++++++++++++++++++++++++++++ physics/GFS_cloud_diagnostics.meta | 123 +++++++ physics/GFS_rrtmgp_gfdlmp_pre.F90 | 288 +++++++++++++++ physics/GFS_rrtmgp_gfdlmp_pre.meta | 248 +++++++++++++ physics/GFS_rrtmgp_pre.F90 | 469 +----------------------- physics/GFS_rrtmgp_pre.meta | 166 +-------- physics/GFS_rrtmgp_setup.F90 | 15 +- physics/rrtmgp_lw_rte.F90 | 18 +- physics/rrtmgp_lw_rte.meta | 9 - 9 files changed, 1266 insertions(+), 636 deletions(-) create mode 100644 physics/GFS_cloud_diagnostics.F90 create mode 100644 physics/GFS_cloud_diagnostics.meta create mode 100644 physics/GFS_rrtmgp_gfdlmp_pre.F90 create mode 100644 physics/GFS_rrtmgp_gfdlmp_pre.meta diff --git a/physics/GFS_cloud_diagnostics.F90 b/physics/GFS_cloud_diagnostics.F90 new file mode 100644 index 000000000..b497e5102 --- /dev/null +++ b/physics/GFS_cloud_diagnostics.F90 @@ -0,0 +1,566 @@ +module GFS_cloud_diagnostics + use machine, only: kind_phys + use physcons, only: con_pi + use physparam, only: iovrlw, iovrsw, ivflip, icldflg + use GFS_typedefs, only: GFS_control_type + + ! Module parameters (imported directly from radiation_cloud.f) + integer, parameter :: & + NF_CLDS = 9, & ! Number of fields in cloud array + NK_CLDS = 3 ! Number of cloud vertical domains + real(kind_phys), parameter :: & + climit = 0.001, & ! Lowest allowable cloud-fraction + ovcst = 1.0 - 1.0e-8 ! Overcast cloud-fraction 0.999999999 + real(kind_phys), parameter, dimension(NK_CLDS+1,2) :: & + ptopc = reshape(source=(/ 1050., 650., 400., 0.0, 1050., 750., 500., 0.0 /), & + shape=(/NK_CLDS+1,2/)) + + ! Version tag and last revision date + character(40), parameter :: VTAGCLD='NCEP-Radiation_clouds v5.1 Nov 2012 ' + + ! Module variables + integer :: & + iovr = 1, & ! Cloud overlap used for diagnostic HML cloud outputs + llyr = 2 ! Upper limit of boundary layer clouds + + + public GFS_cloud_diagnostics_run, GFS_cloud_diagnostics_init,& + GFS_cloud_diagnostics_finalize, hml_cloud_diagnostics_init +contains + ! ###################################################################################### + ! ###################################################################################### + subroutine GFS_cloud_diagnostics_init() + end subroutine GFS_cloud_diagnostics_init + + ! ###################################################################################### + ! ###################################################################################### +!! \section arg_table_GFS_cloud_diagnostics_run +!! \htmlinclude GFS_cloud_diagnostics_run.html +!! + subroutine GFS_cloud_diagnostics_run(Model, nCol, nLev, lat, p_lay, deltaZ, cld_frac, & + mbota, mtopa, cldsa, de_lgth, overlap_param, errmsg, errflg) + implicit none + + ! Inputs + type(GFS_control_type), intent(in) :: & + Model ! DDT: FV3-GFS model control parameters + integer, intent(in) :: & + nCol, & ! Number of horizontal grid-points + nLev ! Number of vertical-layers + real(kind_phys), dimension(nCol), intent(in) :: & + lat ! Latitude + real(kind_phys), dimension(nCol,nLev), intent(in) :: & + p_lay, & ! Pressure at model-layer + deltaZ, & ! Layer thickness at model-layers + cld_frac ! Total cloud fraction + + ! Outputs + character(len=*), intent(out) :: & + errmsg ! Error message + integer, intent(out) :: & + errflg ! Error flag + integer,dimension(ncol,3),intent(out) :: & + mbota, & ! Vertical indices for cloud tops + mtopa ! Vertical indices for cloud bases + real(kind_phys), dimension(ncol,5), intent(out) :: & + cldsa ! Fraction of clouds for low, middle, high, total and BL + real(kind_phys), dimension(ncol), intent(out) :: & + de_lgth ! Decorrelation length + real(kind_phys), dimension(nCol,nLev), intent(out) :: & + overlap_param ! Cloud-overlap parameter + + ! Local variables + integer i,id,iCol,iLay,icld + real(kind_phys) :: tem1 + real(kind_phys),dimension(nCol,NK_CLDS+1) :: ptop1 + real(kind_phys),dimension(nCol) :: rlat + real(kind_phys),dimension(nCol,nLev) :: cldcnv + + if (.not. (Model%lsswr .or. Model%lslwr)) return + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + ! This is set to zero in all of the progcld() routines and passed to gethml(). + cldcnv(:,:) = 0._kind_phys + + do icld = 1, NK_CLDS+1 + tem1 = ptopc(icld,2) - ptopc(icld,1) + do i=1,nCol + rlat(i) = abs(lat(i) / con_pi ) + ptop1(i,icld) = ptopc(icld,1) + tem1*max( 0.0, 4.0*rlat(i)-1.0 ) + enddo + enddo + + ! Estimate clouds decorrelation length in km + ! *this is only a tentative test, need to consider change later* + if ( iovrlw == 3 .and. iovrsw == 3) then + do iCol =1,nCol + de_lgth(iCol) = max( 0.6, 2.78-4.6*rlat(iCol) ) + do iLay=nLev,2,-1 + if (de_lgth(iCol) .gt. 0) then + overlap_param(iCol,iLay-1) = & + exp( -0.5 * (deltaZ(iCol,iLay)+deltaZ(iCol,iLay-1)) / de_lgth(iCol) ) + endif + enddo + enddo + endif + + ! Compute low, mid, high, total, and boundary layer cloud fractions + ! and clouds top/bottom layer indices for low, mid, and high clouds. + ! The three cloud domain boundaries are defined by ptopc. The cloud + ! overlapping method is defined by control flag 'iovr', which may + ! be different for lw and sw radiation programs. + call gethml(p_lay, ptop1, cld_frac, cldcnv, deltaZ, de_lgth, nCol, nLev, cldsa, mtopa, mbota) + + end subroutine GFS_cloud_diagnostics_run + + ! ###################################################################################### + ! ###################################################################################### + subroutine GFS_cloud_diagnostics_finalize() + end subroutine GFS_cloud_diagnostics_finalize + + ! ###################################################################################### + ! Initialization routine for High/Mid/Low cloud diagnostics. + ! ###################################################################################### + subroutine hml_cloud_diagnostics_initialize(Model, nLev, mpi_rank, sigmainit) + implicit none + ! Inputs + type(GFS_control_type), intent(in) :: & + Model ! DDT: FV3-GFS model control parameters + integer, intent(in) :: & + nLev, & ! Number of vertical-layers + mpi_rank + real(kind_phys), dimension(nLev+1), intent(in) :: & + sigmainit + + ! Local variables + integer :: iLay, kl + + ! Cloud overlap used for diagnostic HML cloud outputs + iovr = max(iovrsw,iovrlw) + + if (mpi_rank == 0) print *, VTAGCLD !print out version tag + + if ( icldflg == 0 ) then + print *,' - Diagnostic Cloud Method has been discontinued' + stop ! NoNo + else + if (mpi_rank == 0) then + print *,' - Using Prognostic Cloud Method' + if (Model%imp_physics == Model%imp_physics_zhao_carr) then + print *,' --- Zhao/Carr/Sundqvist microphysics' + elseif (Model%imp_physics == Model%imp_physics_zhao_carr_pdf) then + print *,' --- zhao/carr/sundqvist + pdf cloud' + elseif (Model%imp_physics == Model%imp_physics_gfdl) then + print *,' --- GFDL Lin cloud microphysics' + elseif (Model%imp_physics == Model%imp_physics_thompson) then + print *,' --- Thompson cloud microphysics' + elseif (Model%imp_physics == Model%imp_physics_wsm6) then + print *,' --- WSM6 cloud microphysics' + elseif (Model%imp_physics == Model%imp_physics_mg) then + print *,' --- MG cloud microphysics' + elseif (Model%imp_physics == Model%imp_physics_fer_hires) then + print *,' --- Ferrier-Aligo cloud microphysics' + else + print *,' !!! ERROR in cloud microphysc specification!!!', & + ' imp_physics (NP3D) =',Model%imp_physics + stop + endif + endif + endif + + ! Compute the top of BL cld (llyr), which is the topmost non cld(low) layer for + ! stratiform (at or above lowest 0.1 of the atmosphere). + lab_do_k0 : do iLay = nLev, 2, -1 + kl = iLay + if (sigmainit(iLay) < 0.9e0) exit lab_do_k0 + enddo lab_do_k0 + llyr = kl + + return + end subroutine hml_cloud_diagnostics_initialize + + ! ######################################################################################### + ! ######################################################################################### + subroutine gethml & + & ( plyr, ptop1, cldtot, cldcnv, dz, de_lgth, & ! --- inputs: + & IX, NLAY, & + & clds, mtop, mbot & ! --- outputs: + & ) + +! =================================================================== ! +! ! +! abstract: compute high, mid, low, total, and boundary cloud fractions ! +! and cloud top/bottom layer indices for model diagnostic output. ! +! the three cloud domain boundaries are defined by ptopc. the cloud ! +! overlapping method is defined by control flag 'iovr', which is also ! +! used by lw and sw radiation programs. ! +! ! +! usage: call gethml ! +! ! +! subprograms called: none ! +! ! +! attributes: ! +! language: fortran 90 ! +! machine: ibm-sp, sgi ! +! ! +! ! +! ==================== definition of variables ==================== ! +! ! +! input variables: ! +! plyr (IX,NLAY) : model layer mean pressure in mb (100Pa) ! +! ptop1 (IX,4) : pressure limits of cloud domain interfaces ! +! (sfc,low,mid,high) in mb (100Pa) ! +! cldtot(IX,NLAY) : total or straiform cloud profile in fraction ! +! cldcnv(IX,NLAY) : convective cloud (for diagnostic scheme only) ! +! dz (ix,nlay) : layer thickness (km) ! +! de_lgth(ix) : clouds vertical de-correlation length (km) ! +! IX : horizontal dimention ! +! NLAY : vertical layer dimensions ! +! ! +! output variables: ! +! clds (IX,5) : fraction of clouds for low, mid, hi, tot, bl ! +! mtop (IX,3) : vertical indices for low, mid, hi cloud tops ! +! mbot (IX,3) : vertical indices for low, mid, hi cloud bases ! +! ! +! external module variables: (in physparam) ! +! ivflip : control flag of vertical index direction ! +! =0: index from toa to surface ! +! =1: index from surface to toa ! +! ! +! internal module variables: ! +! iovr : control flag for cloud overlap ! +! =0 random overlapping clouds ! +! =1 max/ran overlapping clouds ! +! =2 maximum overlapping ( for mcica only ) ! +! =3 decorr-length ovlp ( for mcica only ) ! +! ! +! ==================== end of description ===================== ! +! + implicit none! + +! --- inputs: + integer, intent(in) :: IX, NLAY + + real (kind=kind_phys), dimension(:,:), intent(in) :: plyr, ptop1, & + & cldtot, cldcnv, dz + real (kind=kind_phys), dimension(:), intent(in) :: de_lgth + +! --- outputs + real (kind=kind_phys), dimension(:,:), intent(out) :: clds + + integer, dimension(:,:), intent(out) :: mtop, mbot + +! --- local variables: + real (kind=kind_phys) :: cl1(IX), cl2(IX), dz1(ix) + real (kind=kind_phys) :: pcur, pnxt, ccur, cnxt, alfa + + integer, dimension(IX):: idom, kbt1, kth1, kbt2, kth2 + integer :: i, k, id, id1, kstr, kend, kinc + +! +!===> ... begin here +! + clds(:,:) = 0.0 + + do i = 1, IX + cl1(i) = 1.0 + cl2(i) = 1.0 + enddo + +! --- total and bl clouds, where cl1, cl2 are fractions of clear-sky view +! layer processed from surface and up + +!> - Calculate total and BL cloud fractions (maximum-random cloud +!! overlapping is operational). + + if ( ivflip == 0 ) then ! input data from toa to sfc + kstr = NLAY + kend = 1 + kinc = -1 + else ! input data from sfc to toa + kstr = 1 + kend = NLAY + kinc = 1 + endif ! end_if_ivflip + + if ( iovr == 0 ) then ! random overlap + + do k = kstr, kend, kinc + do i = 1, IX + ccur = min( ovcst, max( cldtot(i,k), cldcnv(i,k) )) + if (ccur >= climit) cl1(i) = cl1(i) * (1.0 - ccur) + enddo + + if (k == llyr) then + do i = 1, IX + clds(i,5) = 1.0 - cl1(i) ! save bl cloud + enddo + endif + enddo + + do i = 1, IX + clds(i,4) = 1.0 - cl1(i) ! save total cloud + enddo + + elseif ( iovr == 1 ) then ! max/ran overlap + + do k = kstr, kend, kinc + do i = 1, IX + ccur = min( ovcst, max( cldtot(i,k), cldcnv(i,k) )) + if (ccur >= climit) then ! cloudy layer + cl2(i) = min( cl2(i), (1.0 - ccur) ) + else ! clear layer + cl1(i) = cl1(i) * cl2(i) + cl2(i) = 1.0 + endif + enddo + + if (k == llyr) then + do i = 1, IX + clds(i,5) = 1.0 - cl1(i) * cl2(i) ! save bl cloud + enddo + endif + enddo + + do i = 1, IX + clds(i,4) = 1.0 - cl1(i) * cl2(i) ! save total cloud + enddo + + elseif ( iovr == 2 ) then ! maximum overlap all levels + + cl1(:) = 0.0 + + do k = kstr, kend, kinc + do i = 1, IX + ccur = min( ovcst, max( cldtot(i,k), cldcnv(i,k) )) + if (ccur >= climit) cl1(i) = max( cl1(i), ccur ) + enddo + + if (k == llyr) then + do i = 1, IX + clds(i,5) = cl1(i) ! save bl cloud + enddo + endif + enddo + + do i = 1, IX + clds(i,4) = cl1(i) ! save total cloud + enddo + + elseif ( iovr == 3 ) then ! random if clear-layer divided, + ! otherwise de-corrlength method + do i = 1, ix + dz1(i) = - dz(i,kstr) + enddo + + do k = kstr, kend, kinc + do i = 1, ix + ccur = min( ovcst, max( cldtot(i,k), cldcnv(i,k) )) + if (ccur >= climit) then ! cloudy layer + alfa = exp( -0.5*((dz1(i)+dz(i,k)))/de_lgth(i) ) + dz1(i) = dz(i,k) + cl2(i) = alfa * min(cl2(i), (1.0 - ccur)) & ! maximum part + & + (1.0 - alfa) * (cl2(i) * (1.0 - ccur)) ! random part + else ! clear layer + cl1(i) = cl1(i) * cl2(i) + cl2(i) = 1.0 + if (k /= kend) dz1(i) = -dz(i,k+kinc) + endif + enddo + + if (k == llyr) then + do i = 1, ix + clds(i,5) = 1.0 - cl1(i) * cl2(i) ! save bl cloud + enddo + endif + enddo + + do i = 1, ix + clds(i,4) = 1.0 - cl1(i) * cl2(i) ! save total cloud + enddo + + endif ! end_if_iovr + +! --- high, mid, low clouds, where cl1, cl2 are cloud fractions +! layer processed from one layer below llyr and up +! --- change! layer processed from surface to top, so low clouds will +! contains both bl and low clouds. + +!> - Calculte high, mid, low cloud fractions and vertical indices of +!! cloud tops/bases. + if ( ivflip == 0 ) then ! input data from toa to sfc + + do i = 1, IX + cl1 (i) = 0.0 + cl2 (i) = 0.0 + kbt1(i) = NLAY + kbt2(i) = NLAY + kth1(i) = 0 + kth2(i) = 0 + idom(i) = 1 + mbot(i,1) = NLAY + mtop(i,1) = NLAY + mbot(i,2) = NLAY - 1 + mtop(i,2) = NLAY - 1 + mbot(i,3) = NLAY - 1 + mtop(i,3) = NLAY - 1 + enddo + +!org do k = llyr-1, 1, -1 + do k = NLAY, 1, -1 + do i = 1, IX + id = idom(i) + id1= id + 1 + + pcur = plyr(i,k) + ccur = min( ovcst, max( cldtot(i,k), cldcnv(i,k) )) + + if (k > 1) then + pnxt = plyr(i,k-1) + cnxt = min( ovcst, max( cldtot(i,k-1), cldcnv(i,k-1) )) + else + pnxt = -1.0 + cnxt = 0.0 + endif + + if (pcur < ptop1(i,id1)) then + id = id + 1 + id1= id1 + 1 + idom(i) = id + endif + + if (ccur >= climit) then + if (kth2(i) == 0) kbt2(i) = k + kth2(i) = kth2(i) + 1 + + if ( iovr == 0 ) then + cl2(i) = cl2(i) + ccur - cl2(i)*ccur + else + cl2(i) = max( cl2(i), ccur ) + endif + + if (cnxt < climit .or. pnxt < ptop1(i,id1)) then + kbt1(i) = nint( (cl1(i)*kbt1(i) + cl2(i)*kbt2(i) ) & + & / (cl1(i) + cl2(i)) ) + kth1(i) = nint( (cl1(i)*kth1(i) + cl2(i)*kth2(i) ) & + & / (cl1(i) + cl2(i)) ) + cl1 (i) = cl1(i) + cl2(i) - cl1(i)*cl2(i) + + kbt2(i) = k - 1 + kth2(i) = 0 + cl2 (i) = 0.0 + endif ! end_if_cnxt_or_pnxt + endif ! end_if_ccur + + if (pnxt < ptop1(i,id1)) then + clds(i,id) = cl1(i) + mtop(i,id) = min( kbt1(i), kbt1(i)-kth1(i)+1 ) + mbot(i,id) = kbt1(i) + + cl1 (i) = 0.0 + kbt1(i) = k - 1 + kth1(i) = 0 + + if (id1 <= NK_CLDS) then + mbot(i,id1) = kbt1(i) + mtop(i,id1) = kbt1(i) + endif + endif ! end_if_pnxt + + enddo ! end_do_i_loop + enddo ! end_do_k_loop + + else ! input data from sfc to toa + + do i = 1, IX + cl1 (i) = 0.0 + cl2 (i) = 0.0 + kbt1(i) = 1 + kbt2(i) = 1 + kth1(i) = 0 + kth2(i) = 0 + idom(i) = 1 + mbot(i,1) = 1 + mtop(i,1) = 1 + mbot(i,2) = 2 + mtop(i,2) = 2 + mbot(i,3) = 2 + mtop(i,3) = 2 + enddo + +!org do k = llyr+1, NLAY + do k = 1, NLAY + do i = 1, IX + id = idom(i) + id1= id + 1 + + pcur = plyr(i,k) + ccur = min( ovcst, max( cldtot(i,k), cldcnv(i,k) )) + + if (k < NLAY) then + pnxt = plyr(i,k+1) + cnxt = min( ovcst, max( cldtot(i,k+1), cldcnv(i,k+1) )) + else + pnxt = -1.0 + cnxt = 0.0 + endif + + if (pcur < ptop1(i,id1)) then + id = id + 1 + id1= id1 + 1 + idom(i) = id + endif + + if (ccur >= climit) then + if (kth2(i) == 0) kbt2(i) = k + kth2(i) = kth2(i) + 1 + + if ( iovr == 0 ) then + cl2(i) = cl2(i) + ccur - cl2(i)*ccur + else + cl2(i) = max( cl2(i), ccur ) + endif + + if (cnxt < climit .or. pnxt < ptop1(i,id1)) then + kbt1(i) = nint( (cl1(i)*kbt1(i) + cl2(i)*kbt2(i)) & + & / (cl1(i) + cl2(i)) ) + kth1(i) = nint( (cl1(i)*kth1(i) + cl2(i)*kth2(i)) & + & / (cl1(i) + cl2(i)) ) + cl1 (i) = cl1(i) + cl2(i) - cl1(i)*cl2(i) + + kbt2(i) = k + 1 + kth2(i) = 0 + cl2 (i) = 0.0 + endif ! end_if_cnxt_or_pnxt + endif ! end_if_ccur + + if (pnxt < ptop1(i,id1)) then + clds(i,id) = cl1(i) + mtop(i,id) = max( kbt1(i), kbt1(i)+kth1(i)-1 ) + mbot(i,id) = kbt1(i) + + cl1 (i) = 0.0 + kbt1(i) = min(k+1, nlay) + kth1(i) = 0 + + if (id1 <= NK_CLDS) then + mbot(i,id1) = kbt1(i) + mtop(i,id1) = kbt1(i) + endif + endif ! end_if_pnxt + + enddo ! end_do_i_loop + enddo ! end_do_k_loop + + endif ! end_if_ivflip + +! + return +!................................... + end subroutine gethml + + +end module GFS_cloud_diagnostics \ No newline at end of file diff --git a/physics/GFS_cloud_diagnostics.meta b/physics/GFS_cloud_diagnostics.meta new file mode 100644 index 000000000..84ddb03c2 --- /dev/null +++ b/physics/GFS_cloud_diagnostics.meta @@ -0,0 +1,123 @@ +######################################################################## +[ccpp-arg-table] + name = GFS_cloud_diagnostics_run + type = scheme +[Model] + standard_name = GFS_control_type_instance + long_name = instance of derived type GFS_control_type + units = DDT + dimensions = () + type = GFS_control_type + intent = in + optional = F +[ncol] + standard_name = horizontal_loop_extent + long_name = horizontal dimension + units = count + dimensions = () + type = integer + intent = in + optional = F +[nLev] + standard_name = vertical_dimension + long_name = number of vertical levels + units = count + dimensions = () + type = integer + intent = in + optional = F +[lat] + standard_name = latitude + long_name = latitude + units = radians + dimensions = (horizontal_dimension) + type = real + intent = in + kind = kind_phys +[p_lay] + standard_name = air_pressure_at_layer_for_RRTMGP_in_hPa + long_name = air pressure at vertical layer for radiation calculation + units = hPa + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[deltaZ] + standard_name = layer_thickness + long_name = layer_thickness + units = m + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[cld_frac] + standard_name = total_cloud_fraction + long_name = layer total cloud fraction + units = frac + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[mtopa] + standard_name = model_layer_number_at_cloud_top + long_name = vertical indices for low, middle and high cloud tops + units = index + dimensions = (horizontal_dimension,3) + type = integer + intent = out + optional = F +[mbota] + standard_name = model_layer_number_at_cloud_base + long_name = vertical indices for low, middle and high cloud bases + units = index + dimensions = (horizontal_dimension,3) + type = integer + intent = out + optional = F +[de_lgth] + standard_name = cloud_decorrelation_length + long_name = cloud decorrelation length + units = km + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[overlap_param] + standard_name = cloud_overlap_param + long_name = cloud overlap parameter + units = km + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[cldsa] + standard_name = cloud_area_fraction_for_radiation + long_name = fraction of clouds for low, middle, high, total and BL + units = frac + dimensions = (horizontal_dimension,5) + type = real + kind = kind_phys + intent = out + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F \ No newline at end of file diff --git a/physics/GFS_rrtmgp_gfdlmp_pre.F90 b/physics/GFS_rrtmgp_gfdlmp_pre.F90 new file mode 100644 index 000000000..509ebb4e6 --- /dev/null +++ b/physics/GFS_rrtmgp_gfdlmp_pre.F90 @@ -0,0 +1,288 @@ +module GFS_rrtmgp_gfdlmp_pre + use machine, only: kind_phys + use GFS_typedefs, only: GFS_control_type, GFS_tbd_type + use physcons, only: con_ttp, & ! Temperature at h2o 3pt (K) + con_rd, & ! Gas constant for dry air (J/KgK) + con_pi, & ! PI + con_g ! Gravity (m/s2) + use physparam, only: lcnorm,lcrick + ! Parameters + real(kind_phys), parameter :: & + reliq_def = 10.0, & ! Default liq radius to 10 micron + reice_def = 50.0, & ! Default ice radius to 50 micron + rrain_def = 1000.0, & ! Default rain radius to 1000 micron + rsnow_def = 250.0, & ! Default snow radius to 250 micron + epsq = 1.0e-12, & ! Tiny value + cllimit = 0.001, & ! Lowest cloud fraction in GFDL MP scheme + gfac=1.0e5/con_g ! + +contains + ! ###################################################################################### + ! ###################################################################################### + subroutine GFS_rrtmgp_gfdlmp_pre_init() + end subroutine GFS_rrtmgp_gfdlmp_pre_init + + ! ###################################################################################### + ! ###################################################################################### +!! \section arg_table_GFS_rrtmgp_gfdlmp_pre_run +!! \htmlinclude GFS_rrtmgp_gfdlmp_pre_run.html +!! + subroutine GFS_rrtmgp_gfdlmp_pre_run(Model, Tbd, nCol, nLev, slmsk, lon, lat, p_lay, & + p_lev, t_lay, t_lev, tv_lay, relhum, qs_lay, q_lay, deltaZ, tracer, & + cld_frac, cld_lwp, cld_reliq, cld_iwp, cld_reice, cld_swp, cld_resnow, cld_rwp, & + cld_rerain, errmsg, errflg) + implicit none + + ! Inputs + type(GFS_control_type), intent(in) :: & + Model ! DDT: FV3-GFS model control parameters + type(GFS_tbd_type), intent(in) :: & + Tbd ! DDT: FV3-GFS data not yet assigned to a defined container + integer, intent(in) :: & + nCol, & ! Number of horizontal grid-points + nLev ! Number of vertical-layers + real(kind_phys), dimension(nCol), intent(in) :: & + slmsk, & ! Land/sea/sea-ice mask + lon, & ! Longitude + lat ! Latitude + real(kind_phys), dimension(nCol,nLev), intent(in) :: & + p_lay, & ! Pressure at model-layer (Pa) + t_lay, & ! Temperature at model layer (K) + tv_lay, & ! Virtual temperature at model-layers (K) + relhum, & ! Relative-humidity at model-layers + qs_lay, & ! Saturation mixing-ratio at model-layers (kg/kg) + q_lay, & ! Water-vapor mixing-ratio at model-layers (kg/kg) + deltaZ ! Layer thickness at model-layers (km) + real(kind_phys), dimension(nCol,nLev+1), intent(in) :: & + p_lev, & ! Pressure at model-level interfaces (Pa) + t_lev ! Temperature at model-level interfaces (K) + real(kind_phys), dimension(nCol, nLev, Model%ntrac),intent(in) :: & + tracer ! Cloud condensate amount in layer by type () + + ! Outputs + real(kind_phys), dimension(nCol,nLev),intent(out) :: & + cld_frac, & ! Total cloud fraction + cld_lwp, & ! Cloud liquid water path + cld_reliq, & ! Cloud liquid effective radius + cld_iwp, & ! Cloud ice water path + cld_reice, & ! Cloud ice effecive 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 + character(len=*), intent(out) :: & + errmsg ! Error message + integer, intent(out) :: & + errflg ! Error flag + + ! Local variables + real(kind_phys) :: tem1, tem2, tem3, clwt + real(kind_phys), dimension(nCol) :: rlat + real(kind_phys), dimension(nCol, nLev, min(4,Model%ncnd)) :: cld_condensate, clwf + integer :: i,k,l,ncndl,icnd + real(kind_phys), dimension(nCol,nLev) :: deltaP, cldcov + real(kind_phys), dimension(nCol,nLev,9) :: clouds + + if (.not. (Model%lsswr .or. Model%lslwr)) return + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + ! Initialize outputs + cld_lwp(:,:) = 0.0 + cld_reliq(:,:) = 0.0 + cld_iwp(:,:) = 0.0 + cld_reice(:,:) = 0.0 + cld_rwp(:,:) = 0.0 + cld_rerain(:,:) = 0.0 + cld_swp(:,:) = 0.0 + cld_resnow(:,:) = 0.0 + + ! Compute layer pressure thickness (hPa) + deltaP = abs(p_lev(:,2:nLev+1)-p_lev(:,1:nLev))/100. + + ! #################################################################################### + ! Pull out cloud information for GFDL MP scheme. + ! #################################################################################### + ! Cloud hydrometeors + cld_condensate(:,:,:) = 0._kind_phys + if (Model%ncnd .eq. 2) then + cld_condensate(1:nCol,1:nLev,1) = tracer(1:nCol,1:nLev,Model%ntcw) ! -liquid water + cld_condensate(1:nCol,1:nLev,2) = tracer(1:nCol,1:nLev,Model%ntiw) ! -ice water + ncndl = Model%ncnd + endif + if (Model%ncnd .eq. 5) then + cld_condensate(1:nCol,1:nLev,1) = tracer(1:nCol,1:nLev,Model%ntcw) ! -liquid water + cld_condensate(1:nCol,1:nLev,2) = tracer(1:nCol,1:nLev,Model%ntiw) ! -ice water + cld_condensate(1:nCol,1:nLev,3) = tracer(1:nCol,1:nLev,Model%ntrw) ! -rain water + cld_condensate(1:nCol,1:nLev,4) = tracer(1:nCol,1:nLev,Model%ntsw) + & ! -snow + grapuel + tracer(1:nCol,1:nLev,Model%ntgl) + + ! Since we combine the snow and grapuel, define local variable for number of condensate types. + ncndl = min(4,Model%ncnd) + endif + + ! Cloud-fraction + cld_frac(1:nCol,1:nLev) = tracer(1:nCol,1:nCol,Model%ntclamt) + + ! Set really tiny suspended particle amounts to clear + do l=1,ncndl + do k=1,nLev + do i=1,nCol + if (cld_condensate(i,k,l) < epsq) cld_condensate(i,k,l) = 0.0 + enddo + enddo + enddo + + ! DJS asks. Do we need lcrick? If not replace clwf with cld_condensate(:,:,1) + if ( lcrick ) then + do icnd=1,ncndl + do i = 1, nCol + clwf(i,1,icnd) = 0.75*cld_condensate(i,1,icnd) + 0.25*cld_condensate(i,2,icnd) + clwf(i,nlev,icnd) = 0.75*cld_condensate(i,nLev,icnd) + 0.25*cld_condensate(i,nLev-1,icnd) + enddo + do k = 2, nLev-1 + do i = 1, nCol + clwf(i,k,icnd) = 0.25*cld_condensate(i,k-1,icnd) + 0.5*cld_condensate(i,k,icnd) + & + 0.25*cld_condensate(i,k+1,icnd) + enddo + enddo + enddo + else + do icnd=1,ncndl + do k = 1, nLev + do i = 1, nCol + clwf(i,k,icnd) = cld_condensate(i,k,icnd) + enddo + enddo + enddo + endif + + ! #################################################################################### + ! A) Compute Liquid/Ice/Rain/Snow(+groupel) cloud condensate paths + ! #################################################################################### + + ! #################################################################################### + ! i) This option uses the mixing-ratios and effective radii for 5 cloud hydrometeor types, + ! Liquid, Ice, Rain, and Snow(+groupel), to determine cloud properties. + ! Formerly progclduni() + ! #################################################################################### + if (Model%lgfdlmprad) then + ! Compute liquid/ice condensate path from mixing ratios (kg/kg)->(g/m2) + do k = 1, nLev + do i = 1, nCol + if (cld_frac(i,k) .ge. cllimit) then + tem1 = gfac * deltaP(i,k) + cld_lwp(i,k) = clwf(i,k,1) * tem1 + cld_iwp(i,k) = clwf(i,k,2) * tem1 + ! Also Rain and Snow(+groupel) if provided + if (ncndl .eq. 4) then + cld_rwp(i,k) = clwf(i,k,3) * tem1 + cld_swp(i,k) = clwf(i,k,4) * tem1 + endif + endif + enddo + enddo + ! #################################################################################### + ! ii) This option uses only a single mixing-ratio and partitions into liquid/ice cloud + ! properties by phase. + ! Formerly progcld4() + ! #################################################################################### + else + ! Compute total-cloud suspended water. + clwf(:,:,1) = sum(clwf,dim=3) + + ! Compute liquid/ice condensate path (g/m2) + do k = 1, nLev + do i = 1, nCol + if (cld_frac(i,k) .ge. cllimit) then + clwt = max(0.0,clwf(i,k,1)) * gfac * deltaP(i,k) + tem2 = min( 1.0, max( 0.0, (con_ttp-t_lay(i,k))*0.05 ) ) + cld_iwp(i,k) = clwt * tem2 + cld_lwp(i,k) = clwt - cld_iwp(i,k) + endif + enddo + enddo + endif + + ! #################################################################################### + ! B) Particle sizes + ! #################################################################################### + + ! #################################################################################### + ! i) Use radii provided from the macrophysics + ! #################################################################################### + if (Model%effr_in) then + do k=1,nLev + do i=1,nCol + cld_reliq(i,k) = Tbd%phy_f3d(i,k,1) + cld_reice(i,k) = max(10.0, min(150.0,Tbd%phy_f3d(i,k,2))) + cld_rerain(i,k) = Tbd%phy_f3d(i,k,3) + cld_resnow(i,k) = Tbd%phy_f3d(i,k,4) + enddo + enddo + ! #################################################################################### + ! ii) Start with default values. Modify liquid sizes over land. Adjust ice sizes following + ! Hemsfield and McFarquhar (1996) https://doi.org/10.1175/1520-0469 + ! #################################################################################### + else + cld_reliq(:,:) = reliq_def + cld_reice(:,:) = reice_def + cld_rerain(:,:) = rrain_def + cld_resnow(:,:) = rsnow_def + + ! Compute effective liquid cloud droplet radius over land. + do i = 1, nCol + if (nint(slmsk(i)) == 1) then + do k = 1, nLev + tem2 = min( 1.0, max( 0.0, (con_ttp-t_lay(i,k))*0.05 ) ) + cld_reliq(i,k) = 5.0 + 5.0 * tem2 + enddo + endif + enddo + + ! Compute effective ice cloud droplet radius. + do k = 1, nLev + do i = 1, nCol + tem2 = t_lay(i,k) - con_ttp + if (cld_iwp(i,k) > 0.0) then + tem3 = (con_g/con_rd)* cld_iwp(i,k) * (p_lay(i,k)/100.) / (deltaP(i,k)*tv_lay(i,k)) + if (tem2 < -50.0) then + cld_reice(i,k) = (1250.0/9.917) * tem3 ** 0.109 + elseif (tem2 < -40.0) then + cld_reice(i,k) = (1250.0/9.337) * tem3 ** 0.08 + elseif (tem2 < -30.0) then + cld_reice(i,k) = (1250.0/9.208) * tem3 ** 0.055 + else + cld_reice(i,k) = (1250.0/9.387) * tem3 ** 0.031 + endif + cld_reice(i,k) = max(10.0, min(cld_reice(i,k), 150.0)) + endif + enddo + enddo + endif + + ! Normalize cloud-condensate by cloud-cover? + if ( lcnorm ) then + do k = 1, nLev + do i = 1, nCol + if (cld_frac(i,k) >= cllimit) then + tem1 = 1.0 / max(0.05, cld_frac(i,k)) + cld_lwp(i,k) = cld_lwp(i,k) * tem1 + cld_iwp(i,k) = cld_iwp(i,k) * tem1 + cld_rwp(i,k) = cld_rwp(i,k) * tem1 + cld_swp(i,k) = cld_swp(i,k) * tem1 + endif + enddo + enddo + endif + + end subroutine GFS_rrtmgp_gfdlmp_pre_run + + ! ######################################################################################### + ! ######################################################################################### + subroutine GFS_rrtmgp_gfdlmp_pre_finalize() + end subroutine GFS_rrtmgp_gfdlmp_pre_finalize + +end module GFS_rrtmgp_gfdlmp_pre \ No newline at end of file diff --git a/physics/GFS_rrtmgp_gfdlmp_pre.meta b/physics/GFS_rrtmgp_gfdlmp_pre.meta new file mode 100644 index 000000000..5b792bc6c --- /dev/null +++ b/physics/GFS_rrtmgp_gfdlmp_pre.meta @@ -0,0 +1,248 @@ +######################################################################## +[ccpp-arg-table] + name = GFS_rrtmgp_gfdlmp_pre_run + type = scheme +[Model] + standard_name = GFS_control_type_instance + long_name = instance of derived type GFS_control_type + units = DDT + dimensions = () + type = GFS_control_type + intent = in + optional = F +[Tbd] + standard_name = GFS_tbd_type_instance + long_name = instance of derived type GFS_tbd_type + units = DDT + dimensions = () + type = GFS_tbd_type + intent = in + optional = F +[ncol] + standard_name = horizontal_loop_extent + long_name = horizontal dimension + units = count + dimensions = () + type = integer + intent = in + optional = F +[nLev] + standard_name = vertical_dimension + long_name = number of vertical levels + units = count + dimensions = () + type = integer + intent = in + optional = F +[slmsk] + standard_name = sea_land_ice_mask_real + long_name = landmask: sea/land/ice=0/1/2 + units = flag + dimensions = (horizontal_dimension) + type = real + intent = in + kind = kind_phys +[lat] + standard_name = latitude + long_name = latitude + units = radians + dimensions = (horizontal_dimension) + type = real + intent = in + kind = kind_phys +[lon] + standard_name = longitude + long_name = longitude + units = radians + dimensions = (horizontal_dimension) + type = real + intent = in + kind = kind_phys +[p_lay] + standard_name = air_pressure_at_layer_for_RRTMGP_in_hPa + long_name = air pressure at vertical layer for radiation calculation + units = hPa + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[p_lev] + standard_name = air_pressure_at_interface_for_RRTMGP_in_hPa + long_name = air pressure at vertical interface for radiation calculation + units = hPa + dimensions = (horizontal_dimension,vertical_dimension_plus_one) + type = real + kind = kind_phys + intent = in + optional = F +[t_lay] + standard_name = air_temperature_at_layer_for_RRTMGP + long_name = air temperature at vertical layer for radiation calculation + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[t_lev] + standard_name = air_temperature_at_interface_for_RRTMGP + long_name = air temperature at vertical interface for radiation calculation + units = K + dimensions = (horizontal_dimension,vertical_dimension_plus_one) + type = real + kind = kind_phys + intent = in + optional = F +[tv_lay] + standard_name = virtual_temperature + long_name = layer virtual temperature + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[relhum] + standard_name = relative_humidity + long_name = layer relative humidity + units = frac + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[qs_lay] + standard_name = saturation_mixing_ratio + long_name = saturation mixing ratio + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[q_lay] + standard_name = water_vapor_mixing_ratio + long_name = water mixing ratio + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[deltaZ] + standard_name = layer_thickness + long_name = layer_thickness + units = m + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[tracer] + standard_name = chemical_tracers + long_name = chemical tracers + units = g g-1 + dimensions = (horizontal_dimension,vertical_dimension,number_of_tracers) + type = real + kind = kind_phys + intent = in + optional = F +[cld_frac] + standard_name = total_cloud_fraction + long_name = layer total cloud fraction + units = frac + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[cld_lwp] + standard_name = cloud_liquid_water_path + long_name = layer cloud liquid water path + units = g m-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[cld_reliq] + standard_name = mean_effective_radius_for_liquid_cloud + long_name = mean effective radius for liquid cloud + units = micron + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[cld_iwp] + standard_name = cloud_ice_water_path + long_name = layer cloud ice water path + units = g m-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[cld_reice] + standard_name = mean_effective_radius_for_ice_cloud + long_name = mean effective radius for ice cloud + units = micron + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[cld_swp] + standard_name = cloud_snow_water_path + long_name = layer cloud snow water path + units = g m-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[cld_resnow] + standard_name = mean_effective_radius_for_snow_flake + long_name = mean effective radius for snow cloud + units = micron + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[cld_rwp] + standard_name = cloud_rain_water_path + long_name = layer cloud rain water path + units = g m-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[cld_rerain] + standard_name = mean_effective_radius_for_rain_drop + long_name = mean effective radius for rain cloud + units = micron + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F \ No newline at end of file diff --git a/physics/GFS_rrtmgp_pre.F90 b/physics/GFS_rrtmgp_pre.F90 index 2c269f009..f3f2f3dc4 100644 --- a/physics/GFS_rrtmgp_pre.F90 +++ b/physics/GFS_rrtmgp_pre.F90 @@ -6,11 +6,9 @@ module GFS_rrtmgp_pre GFS_statein_type, & ! Prognostic state data in from dycore GFS_stateout_type, & ! Prognostic state or tendencies return to dycore GFS_sfcprop_type, & ! Surface fields - GFS_coupling_type, & ! Fields to/from coupling with other components (e.g. land/ice/ocean/etc.) GFS_control_type, & ! Model control parameters GFS_grid_type, & ! Grid and interpolation related data GFS_tbd_type, & ! To-Be-Determined data that doesn't fit in any one container - GFS_radtend_type, & ! Radiation tendencies needed in physics GFS_diag_type ! Fields targetted for diagnostic output use physcons, only: & eps => con_eps, & ! Rd/Rv @@ -85,12 +83,10 @@ module GFS_rrtmgp_pre !! \section arg_table_GFS_rrtmgp_pre_init !! \htmlinclude GFS_rrtmgp_pre_init.html !! - subroutine GFS_rrtmgp_pre_init(Model, Radtend, active_gases_array, errmsg, errflg) + subroutine GFS_rrtmgp_pre_init(Model, active_gases_array, errmsg, errflg) ! Inputs type(GFS_control_type), intent(inout) :: & Model ! DDT: FV3-GFS model control parameters - type(GFS_radtend_type), intent(inout) :: & - Radtend ! DDT: FV3-GFS radiation tendencies ! Outputs character(len=*),dimension(Model%ngases), intent(out) :: & @@ -184,12 +180,10 @@ end subroutine GFS_rrtmgp_pre_init !> \section arg_table_GFS_rrtmgp_pre_run !! \htmlinclude GFS_rrtmgp_pre_run.html !! - subroutine GFS_rrtmgp_pre_run (Model, Grid, Statein, Coupling, Radtend, Sfcprop, Tbd, & ! IN - ncol, lw_gas_props, active_gases_array, & ! IN - sec_diff_byband, raddt, p_lay, t_lay, p_lev, t_lev, tsfg, tsfa, cld_frac, cld_lwp,& ! OUT - cld_reliq, cld_iwp, cld_reice, cld_swp, cld_resnow, cld_rwp, cld_rerain, & ! OUT - tv_lay, relhum, tracer, cldsa, mtopa, mbota, de_lgth, gas_concentrations, & ! OUT - overlap_param, errmsg, errflg) + subroutine GFS_rrtmgp_pre_run (Model, Grid, Statein, Sfcprop, Tbd, ncol, lw_gas_props, & + active_gases_array, & ! IN + raddt, p_lay, t_lay, p_lev, t_lev, tsfg, tsfa, tv_lay, relhum, qs_lay, q_lay, & ! OUT + deltaZ, tracer, gas_concentrations, errmsg, errflg) ! Inputs type(GFS_control_type), intent(in) :: & @@ -198,10 +192,6 @@ subroutine GFS_rrtmgp_pre_run (Model, Grid, Statein, Coupling, Radtend, Sfcprop, Grid ! DDT: FV3-GFS grid and interpolation related data type(GFS_statein_type), intent(in) :: & Statein ! DDT: FV3-GFS prognostic state data in from dycore - type(GFS_coupling_type), intent(in) :: & - Coupling ! DDT: FV3-GFS fields to/from coupling with other components - type(GFS_radtend_type), intent(inout) :: & - Radtend ! DDT: FV3-GFS radiation tendencies type(GFS_sfcprop_type), intent(in) :: & Sfcprop ! DDT: FV3-GFS surface fields type(GFS_tbd_type), intent(in) :: & @@ -232,42 +222,22 @@ subroutine GFS_rrtmgp_pre_run (Model, Grid, Statein, Coupling, Radtend, Sfcprop, integer, intent(out) :: & errflg ! Error flag real(kind_phys), dimension(ncol,Model%levs),intent(out) :: & - cld_frac, & ! Total cloud fraction - cld_lwp, & ! Cloud liquid water path - cld_reliq, & ! Cloud liquid effective radius - cld_iwp, & ! Cloud ice water path - cld_reice, & ! Cloud ice effecive 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 - real(kind_phys), dimension(ncol,Model%levs),intent(out) :: & - tv_lay, & ! Virtual temperatue at model-layers - relhum ! Relative-humidity at model-layers + tv_lay, & ! Virtual temperature at model-layers + relhum, & ! Relative-humidity at model-layers + qs_lay, & ! Saturation mixing-ratio at model-layers + q_lay, & ! Water-vapor mixing-ratio at model-layers + deltaZ ! Layer thickness at model-layers real(kind_phys), dimension(ncol, Model%levs, Model%ntrac),intent(out) :: & tracer ! Array containing trace gases - integer,dimension(ncol,3),intent(out) :: & - mbota, & ! Vertical indices for cloud tops - mtopa ! Vertical indices for cloud bases - real(kind_phys), dimension(ncol,5), intent(out) :: & - cldsa ! Fraction of clouds for low, middle, high, total and BL - real(kind_phys), dimension(ncol), intent(out) :: & - de_lgth ! Decorrelation length - real(kind_phys), dimension(nCol,Model%levs), intent(out) :: & - overlap_param ! Cloud-overlap parameter - real(kind_phys), dimension(lw_gas_props%get_nband(),ncol),intent(out) :: & - sec_diff_byband ! Local variables integer :: i, j, iCol, iBand, iSFC, iTOA, iLay logical :: top_at_1 - real(kind_phys),dimension(NCOL,Model%levs) :: vmr_o3, vmr_h2o, coldry, tem0, colamt + real(kind_phys),dimension(NCOL,Model%levs) :: vmr_o3, vmr_h2o real(kind_phys) :: es, qs, tem1, tem2 real(kind_phys), dimension(ncol, NF_ALBD) :: sfcalb - real(kind_phys), dimension(ncol, Model%levs) :: qs_lay, q_lay, deltaZ, deltaP, o3_lay + real(kind_phys), dimension(ncol, Model%levs) :: o3_lay real(kind_phys), dimension(ncol, Model%levs, NF_VGAS) :: gas_vmr - real(kind_phys), dimension(ncol, Model%levs, NF_CLDS) :: clouds - real(kind_phys), dimension(ncol) :: precipitableH2o ! Initialize CCPP error handling variables errmsg = '' @@ -314,12 +284,10 @@ subroutine GFS_rrtmgp_pre_run (Model, Grid, Statein, Coupling, Radtend, Sfcprop, t_lev(1:NCOL,2:iTOA) = (t_lay(1:NCOL,2:iTOA)+t_lay(1:NCOL,1:iTOA-1))/2._kind_phys t_lev(1:NCOL,iTOA+1) = t_lay(1:NCOL,iTOA) endif - - ! Compute layer pressure thicknes - deltaP = abs(p_lev(:,2:model%levs+1)-p_lev(:,1:model%levs)) - ! Compute a bunch of thermodynamic fields needed by the macrophysics schemes. Relative humidity, - ! saturation mixing-ratio, vapor mixing-ratio, virtual temperature, layer thickness,... + ! Compute a bunch of thermodynamic fields needed by the cloud microphysics schemes. + ! Relative humidity, saturation mixing-ratio, vapor mixing-ratio, virtual temperature, + ! layer thickness,... do iCol=1,NCOL do iLay=1,Model%levs es = min( p_lay(iCol,iLay), fpvs( t_lay(iCol,iLay) ) ) ! fpvs and prsl in pa @@ -370,40 +338,6 @@ subroutine GFS_rrtmgp_pre_run (Model, Grid, Statein, Coupling, Radtend, Sfcprop, call check_error_msg('GFS_rrtmgp_pre_run',gas_concentrations%set_vmr(active_gases_array(iStr_h2o), vmr_h2o)) call check_error_msg('GFS_rrtmgp_pre_run',gas_concentrations%set_vmr(active_gases_array(iStr_o3), vmr_o3)) - ! ####################################################################################### - ! Compute diffusivity angle adjustments for each longwave band - ! *NOTE* Legacy RRTMGP code - ! ####################################################################################### - ! Conpute diffusivity angle adjustments. - ! First need to compute precipitable water in each column - tem0 = (1._kind_phys - vmr_h2o)*amd + vmr_h2o*amw - coldry = ( 1.0e-20 * 1.0e3 *avogad)*(deltap*.01) / (100.*grav*tem0*(1._kind_phys + vmr_h2o)) - colamt = max(0._kind_phys, coldry*vmr_h2o) - do iCol=1,nCol - tem1 = 0._kind_phys - tem2 = 0._kind_phys - do iLay=1,Model%levs - tem1 = tem1 + coldry(iCol,iLay)+colamt(iCol,iLay) - tem2 = tem2 + colamt(iCol,iLay) - enddo - precipitableH2o(iCol) = p_lev(iCol,iSFC)*0.01*(10._kind_phys*tem2 / (amdw*tem1*grav)) - enddo - - ! Reset diffusivity angle for Bands 2-3 and 5-9 to vary (between 1.50 - ! and 1.80) as a function of total column water vapor. the function - ! has been defined to minimize flux and cooling rate errors in these bands - ! over a wide range of precipitable water values. - do iCol=1,nCol - do iBand = 1, lw_gas_props%get_nband() - if (iBand==1 .or. iBand==4 .or. iBand==10) then - sec_diff_byband(iBand,iCol) = diffusivityB1410 - else - sec_diff_byband(iBand,iCol) = min( diffusivityHigh, max(diffusivityLow, & - a0(iBand)+a1(iBand)*exp(a2(iBand)*precipitableH2o(iCol)))) - endif - enddo - enddo - ! ####################################################################################### ! Radiation time step (output) (Is this really needed?) (Used by some diangostics) ! ####################################################################################### @@ -415,31 +349,6 @@ subroutine GFS_rrtmgp_pre_run (Model, Grid, Statein, Coupling, Radtend, Sfcprop, tsfg(1:NCOL) = Sfcprop%tsfc(1:NCOL) tsfa(1:NCOL) = Sfcprop%tsfc(1:NCOL) - ! ####################################################################################### - ! Cloud microphysics - ! ####################################################################################### - call cloud_microphysics(Model, Tbd, Grid, Sfcprop, ncol, tracer, p_lay, t_lay, p_lev, & - tv_lay, relhum, qs_lay, q_lay, deltaZ, deltaP, clouds, cldsa, mbota, mtopa, de_lgth) - - ! Cloud-overlap parameter (only needed for iovr = 3) - overlap_param(:,1) = 0._kind_phys - do iCol=1,nCol - do iLay=Model%levs,2,-1 - if (de_lgth(iCol) .gt. 0) overlap_param(iCol,iLay-1) = exp( -0.5 * (deltaZ(iCol,iLay)+deltaZ(iCol,iLay-1)) / de_lgth(iCol) ) - enddo - enddo - - ! Copy output cloud fields - cld_frac = clouds(:,:,1) - cld_lwp = clouds(:,:,2) - cld_reliq = clouds(:,:,3) - cld_iwp = clouds(:,:,4) - cld_reice = clouds(:,:,5) - cld_rwp = clouds(:,:,6) - cld_rerain = clouds(:,:,7) - cld_swp = clouds(:,:,8) - cld_resnow = clouds(:,:,9) - end subroutine GFS_rrtmgp_pre_run ! ######################################################################################### @@ -448,352 +357,4 @@ end subroutine GFS_rrtmgp_pre_run subroutine GFS_rrtmgp_pre_finalize () end subroutine GFS_rrtmgp_pre_finalize - ! ######################################################################################### - ! Subroutine cloud_microphysics() - ! ######################################################################################### - subroutine cloud_microphysics(Model, Tbd, Grid, Sfcprop, ncol, tracer, p_lay, t_lay, p_lev,& - tv_lay, relhum, qs_lay, q_lay, deltaZ, deltaP, clouds, cldsa, mbota, mtopa, de_lgth) - - ! Inputs - type(GFS_control_type), intent(in) :: & - Model ! DDT: FV3-GFS model control parameters - type(GFS_tbd_type), intent(in) :: & - Tbd ! DDT: FV3-GFS data not yet assigned to a defined container - type(GFS_grid_type), intent(in) :: & - Grid ! DDT: FV3-GFS grid and interpolation related data - type(GFS_sfcprop_type), intent(in) :: & - Sfcprop ! DDT: FV3-GFS surface fields - integer, intent(in) :: & - ncol ! Number of horizontal gridpoints - real(kind_phys), dimension(ncol, Model%levs, Model%ntrac),intent(in) :: & - tracer ! Cloud condensate amount in layer by type () - real(kind_phys), dimension(ncol,Model%levs), intent(in) :: & - p_lay, & ! Pressure @ model layer centers (Pa) - t_lay, & ! Temperature @ layer centers (K) - tv_lay, & ! Virtual temperature @ layer centers (K) - relhum, & ! Relative humidity @ layer centers(1) - qs_lay, & ! Saturation specific humidity @ layer center (kg/kg) - q_lay, & ! Specific humidity @ layer centers(kg/kg) - deltaZ, & ! Layer thickness (km) - deltaP ! Layer thickness (Pa) - real(kind_phys), dimension(ncol,Model%levs+1), intent(in) :: & - p_lev ! Pressure @ model layer interface (Pa) - - ! Outputs - real(kind_phys), dimension(ncol, Model%levs, NF_CLDS),intent(out) :: & - clouds ! Cloud properties (NCOL,Model%levs,NF_CLDS) - integer,dimension(ncol,3), intent(out) :: & - mbota, & ! Vertical indices for low, mid, hi cloud bases (NCOL,3) - mtopa ! Vertical indices for low, mid, hi cloud tops (NCOL,3) - real(kind_phys), dimension(ncol), intent(out) ::& - de_lgth ! Clouds decorrelation length (km) - real(kind_phys), dimension(ncol, 5), intent(out) :: & - cldsa ! Fraction of clouds for low, mid, hi, tot, bl (NCOL,5) - - ! Local variables - real(kind_phys), dimension(ncol, Model%levs, min(4,Model%ncnd)) :: cld_condensate - integer :: i,k,l,ncndl - real(kind_phys), parameter :: xrc3 = 100. - real(kind_phys), dimension(ncol, Model%levs) :: delta_q, cnv_w, cnv_c, effr_l, & - effr_i, effr_r, effr_s, cldcov - - ! ####################################################################################### - ! Obtain cloud information for radiation calculations - ! (clouds,cldsa,mtopa,mbota) - ! for prognostic cloud: - ! - For Zhao/Moorthi's prognostic cloud scheme, - ! call module_radiation_clouds::progcld1() - ! - For Zhao/Moorthi's prognostic cloud+pdfcld, - ! call module_radiation_clouds::progcld3() - ! call module_radiation_clouds::progclduni() for unified cloud and ncld=2 - ! ####################################################################################### - - ! Note, snow and groupel are treated the same by radiation scheme. - ncndl = min(Model%ncnd,4) - - cld_condensate = 0.0_kind_phys - if (Model%ncnd == 1) then ! Zhao_Carr_Sundqvist - cld_condensate(1:NCOL,1:Model%levs,1) = tracer(1:NCOL,1:Model%levs,Model%ntcw) ! -liquid water/ice - elseif (Model%ncnd == 2) then ! MG - cld_condensate(1:NCOL,1:Model%levs,1) = tracer(1:NCOL,1:Model%levs,Model%ntcw) ! -liquid water - cld_condensate(1:NCOL,1:Model%levs,2) = tracer(1:NCOL,1:Model%levs,Model%ntiw) ! -ice water - elseif (Model%ncnd == 4) then ! MG2 - cld_condensate(1:NCOL,1:Model%levs,1) = tracer(1:NCOL,1:Model%levs,Model%ntcw) ! -liquid water - cld_condensate(1:NCOL,1:Model%levs,2) = tracer(1:NCOL,1:Model%levs,Model%ntiw) ! -ice water - cld_condensate(1:NCOL,1:Model%levs,3) = tracer(1:NCOL,1:Model%levs,Model%ntrw) ! -rain water - cld_condensate(1:NCOL,1:Model%levs,4) = tracer(1:NCOL,1:Model%levs,Model%ntsw) ! -snow water - elseif (Model%ncnd == 5) then ! GFDL MP, Thompson, MG3 - cld_condensate(1:NCOL,1:Model%levs,1) = tracer(1:NCOL,1:Model%levs,Model%ntcw) ! -liquid water - cld_condensate(1:NCOL,1:Model%levs,2) = tracer(1:NCOL,1:Model%levs,Model%ntiw) ! -ice water - cld_condensate(1:NCOL,1:Model%levs,3) = tracer(1:NCOL,1:Model%levs,Model%ntrw) ! -rain water - cld_condensate(1:NCOL,1:Model%levs,4) = tracer(1:NCOL,1:Model%levs,Model%ntsw) + & ! -snow + grapuel - tracer(1:NCOL,1:Model%levs,Model%ntgl) - endif - - do l=1,ncndl - do k=1,Model%levs - do i=1,NCOL - if (cld_condensate(i,k,l) < epsq) cld_condensate(i,k,l) = 0.0 - enddo - enddo - enddo - - ! For GFDL microphysics scheme... - if (Model%imp_physics == 11 ) then - if (.not. Model%lgfdlmprad) then - cld_condensate(:,:,1) = tracer(:,1:Model%levs,Model%ntcw) - cld_condensate(:,:,1) = cld_condensate(:,:,1) + tracer(:,1:Model%levs,Model%ntrw) - cld_condensate(:,:,1) = cld_condensate(:,:,1) + tracer(:,1:Model%levs,Model%ntiw) - cld_condensate(:,:,1) = cld_condensate(:,:,1) + tracer(:,1:Model%levs,Model%ntsw) - cld_condensate(:,:,1) = cld_condensate(:,:,1) + tracer(:,1:Model%levs,Model%ntgl) - endif - do k=1,Model%levs - do i=1,NCOL - if (cld_condensate(i,k,1) < EPSQ ) cld_condensate(i,k,1) = 0.0 - enddo - enddo - endif - - if (Model%uni_cld) then - if (Model%effr_in) then - cldcov(:,:) = Tbd%phy_f3d(:,:,Model%indcld) - effr_l(:,:) = Tbd%phy_f3d(:,:,2) - effr_i(:,:) = Tbd%phy_f3d(:,:,3) - effr_r(:,:) = Tbd%phy_f3d(:,:,4) - effr_s(:,:) = Tbd%phy_f3d(:,:,5) - else - do k=1,model%levs - do i=1,ncol - cldcov(i,k) = Tbd%phy_f3d(i,k,Model%indcld) - enddo - enddo - endif - elseif (Model%imp_physics == Model%imp_physics_gfdl) then ! GFDL MP - cldcov(1:NCOL,1:Model%levs) = tracer(1:NCOL,1:Model%levs,Model%ntclamt) - if (Model%effr_in) then - effr_l(:,:) = Tbd%phy_f3d(:,:,1) - effr_i(:,:) = Tbd%phy_f3d(:,:,2) - effr_r(:,:) = Tbd%phy_f3d(:,:,3) - effr_s(:,:) = Tbd%phy_f3d(:,:,4) - endif - else ! neither of the other two cases - cldcov = 0.0 - endif - - - ! Add suspended convective cloud water to grid-scale cloud water - ! only for cloud fraction & radiation computation it is to enhance - ! cloudiness due to suspended convec cloud water for zhao/moorthi's - ! (imp_phys=99) & ferrier's (imp_phys=5) microphysics schemes - if ((Model%num_p3d == 4) .and. (Model%npdf3d == 3)) then ! same as Model%imp_physics = 99 - delta_q(1:ncol,1:Model%levs) = Tbd%phy_f3d(1:ncol,Model%levs:1:-1,5) - cnv_w (1:ncol,1:Model%levs) = Tbd%phy_f3d(1:ncol,Model%levs:1:-1,6) - cnv_c (1:ncol,1:Model%levs) = Tbd%phy_f3d(1:ncol,Model%levs:1:-1,7) - elseif ((Model%npdf3d == 0) .and. (Model%ncnvcld3d == 1)) then ! same as MOdel%imp_physics=98 - delta_q(1:ncol,1:Model%levs) = 0.0 - cnv_w (1:ncol,1:Model%levs) = Tbd%phy_f3d(1:ncol,1:Model%levs,Model%num_p3d+1) - cnv_c (1:ncol,1:Model%levs) = 0.0 - else ! all the rest - delta_q(1:ncol,1:Model%levs) = 0.0 - cnv_w (1:ncol,1:Model%levs) = 0.0 - cnv_c (1:ncol,1:Model%levs) = 0.0 - endif - - ! For zhao/moorthi's prognostic cloud scheme, add in convective cloud water to liquid-cloud water - if (Model%imp_physics == 99) then - cld_condensate(1:NCOL,1:Model%levs,1) = cld_condensate(1:NCOL,1:Model%levs,1) + cnv_w(1:NCOL,1:Model%levs) - endif - - ! ####################################################################################### - ! MICROPHYSICS - ! ####################################################################################### - ! *) zhao/moorthi's prognostic cloud scheme or unified cloud and/or with MG microphysics - if (Model%imp_physics == 99 .or. Model%imp_physics == 10) then - if (Model%uni_cld .and. Model%ncld >= 2) then - call progclduni( & - p_lay/100., & ! IN - Pressure at model layer centers (mb) - p_lev/100., & ! IN - Pressure at model interfaces (mb) - t_lay, & ! IN - Temperature at layer centers (K) - tv_lay, & ! IN - Virtual temperature at layer centers (K) - cld_condensate, & ! IN - Cloud condensate amount (Model%ncnd types) () - Model%ncnd, & ! IN - Number of cloud condensate types () - Grid%xlat, & ! IN - Latitude (radians) - Grid%xlon, & ! IN - Longitude (radians) - Sfcprop%slmsk, & ! IN - Land/Sea mask () - deltaZ, & ! IN - Layer thickness (km) - deltaP/100., & ! IN - Layer thickness (hPa) - NCOL, & ! IN - Number of horizontal gridpoints - MODEL%LEVS, & ! IN - Number of model layers - MODEL%LEVS+1, & ! IN - Number of model levels - cldcov, & ! IN - Layer cloud fraction (used if uni_cld=.true.) - effr_l, & ! IN - Liquid-water effective radius (microns) - effr_i, & ! IN - Ice-water effective radius (microns) - effr_r, & ! IN - Rain-water effective radius (microns) - effr_s, & ! IN - Snow-water effective radius (microns) - Model%effr_in, & ! IN - Logical, if .true. use input effective radii - clouds, & ! OUT - Cloud properties (NCOL,Model%levs,NF_CLDS) - cldsa, & ! OUT - fraction of clouds for low, mid, hi, tot, bl (NCOL,5) - mtopa, & ! OUT - vertical indices for low, mid, hi cloud tops (NCOL,3) - mbota, & ! OUT - vertical indices for low, mid, hi cloud bases (NCOL,3) - de_lgth) ! OUT - clouds decorrelation length (km) - else - call progcld1 ( & - p_lay/100., & ! IN - Pressure at model layer centers (mb) - p_lev/100., & ! IN - Pressure at model interfaces (mb) - t_lay, & ! IN - Temperature at layer centers (K) - tv_lay, & ! IN - Virtual temperature at layer centers (K) - q_lay, & ! IN - Specific humidity at layer center (kg/kg) - qs_lay, & ! IN - Saturation specific humidity at layer center (kg/kg) - relhum, & ! IN - Relative humidity at layer center (1) - cld_condensate(:,:,1),& ! IN - Cloud condensate amount () - ! (Zhao: liq+convective; MG: liq+ice+convective) - Grid%xlat, & ! IN - Latitude (radians) - Grid%xlon, & ! IN - Longitude (radians) - Sfcprop%slmsk, & ! IN - Land/Sea mask () - deltaZ, & ! IN - Layer thickness (km) - deltaP/100., & ! IN - Layer thickness (hPa) - NCOL, & ! IN - Number of horizontal gridpoints - MODEL%LEVS, & ! IN - Number of model layers - MODEL%LEVS+1, & ! IN - Number of model levels - Model%uni_cld, & ! IN - True for cloud fraction from shoc - Model%lmfshal, & ! IN - True for mass flux shallow convection - Model%lmfdeep2, & ! IN - True for mass flux deep convection - cldcov, & ! IN - Layer cloud fraction (used if uni_cld=.true.) - effr_l, & ! IN - Liquid-water effective radius (microns) - effr_i, & ! IN - Ice-water effective radius (microns) - effr_r, & ! IN - Rain-water effective radius (microns) - effr_s, & ! IN - Snow-water effective radius (microns) - Model%effr_in, & ! IN - Logical, if .true. use input effective radii - clouds, & ! OUT - Cloud properties (NCOL,Model%levs,NF_CLDS) - cldsa, & ! OUT - fraction of clouds for low, mid, hi, tot, bl (NCOL,5) - mtopa, & ! OUT - vertical indices for low, mid, hi cloud tops (NCOL,3) - mbota, & ! OUT - vertical indices for low, mid, hi cloud bases (NCOL,3) - de_lgth) ! OUT - clouds decorrelation length (km) - endif - ! *) zhao/moorthi's prognostic cloud+pdfcld - elseif(Model%imp_physics == 98) then - call progcld3 ( & - p_lay/100., & ! IN - Pressure at model layer centers (mb) - p_lev/100., & ! IN - Pressure at model interfaces (mb) - t_lay, & ! IN - Temperature at layer centers (K) - tv_lay, & ! IN - Virtual temperature at layer centers (K) - q_lay, & ! IN - Specific humidity at layer center (kg/kg) - qs_lay, & ! IN - Saturation specific humidity at layer center (kg/kg) - relhum, & ! IN - Relative humidity at layer center (1) - cld_condensate(:,:,1),& ! IN - Cloud condensate amount (only h20) () - cnv_w, & ! IN - Layer convective cloud condensate - cnv_c, & ! IN - Layer convective cloud cover - Grid%xlat, & ! IN - Latitude (radians) - Grid%xlon, & ! IN - Longitude (radians) - Sfcprop%slmsk, & ! IN - Land/Sea mask () - deltaZ, & ! IN - Layer thickness (km) - deltaP/100., & ! IN - Layer thickness (hPa) - NCOL, & ! IN - Number of horizontal gridpoints - MODEL%LEVS, & ! IN - Number of model layers - MODEL%LEVS+1, & ! IN - Number of model levels - delta_q, & ! IN - Total water distribution width - Model%sup, & ! IN - ??? Supersaturation? - Model%kdt, & ! IN - ??? - Model%me, & ! IN - ??? NOT USED IN PROGCLD3() - clouds, & ! OUT - Cloud properties (NCOL,Model%levs,NF_CLDS) - cldsa, & ! OUT - fraction of clouds for low, mid, hi, tot, bl (NCOL,5) - mtopa, & ! OUT - vertical indices for low, mid, hi cloud tops (NCOL,3) - mbota, & ! OUT - vertical indices for low, mid, hi cloud bases (NCOL,3) - de_lgth) ! OUT - clouds decorrelation length (km) - ! *) GFDL cloud scheme - elseif (Model%imp_physics == 11) then - if (.not.Model%lgfdlmprad) then - call progcld4 ( & - p_lay/100., & ! IN - Pressure at model layer centers (mb) - p_lev/100., & ! IN - Pressure at model interfaces (mb) - t_lay, & ! IN - Temperature at layer centers (K) - tv_lay, & ! IN - Virtual temperature at layer centers (K) - q_lay, & ! IN - Specific humidity at layer center (kg/kg) - qs_lay, & ! IN - Saturation specific humidity at layer center (kg/kg) - relhum, & ! IN - Relative humidity at layer center (1) - cld_condensate(:,:,1),& ! IN - Cloud condensate amount (only h20) () - cnv_w, & ! IN - Layer convective cloud condensate - cnv_c, & ! IN - Layer convective cloud cover - Grid%xlat, & ! IN - Latitude (radians) - Grid%xlon, & ! IN - Longitude (radians) - Sfcprop%slmsk, & ! IN - Land/Sea mask () - cldcov, & ! IN - Layer cloud fraction (used if uni_cld=.true.) - deltaZ, & ! IN - Layer thickness (km) - deltaP/100., & ! IN - Layer thickness (hPa) - NCOL, & ! IN - Number of horizontal gridpoints - MODEL%LEVS, & ! IN - Number of model layers - MODEL%LEVS+1, & ! IN - Number of model levels - clouds, & ! OUT - Cloud properties (NCOL,Model%levs,NF_CLDS) - cldsa, & ! OUT - fraction of clouds for low, mid, hi, tot, bl (NCOL,5) - mtopa, & ! OUT - vertical indices for low, mid, hi cloud tops (NCOL,3) - mbota, & ! OUT - vertical indices for low, mid, hi cloud bases (NCOL,3) - de_lgth) ! OUT - clouds decorrelation length (km) - else - call progclduni( & - p_lay/100., & ! IN - Pressure at model layer centers (mb) - p_lev/100., & ! IN - Pressure at model interfaces (mb) - t_lay, & ! IN - Temperature at layer centers (K) - tv_lay, & ! IN - Virtual temperature at layer centers (K) - cld_condensate, & ! IN - Cloud condensate amount (ncndl types) () - ncndl, & ! IN - Number of cloud condensate types () - Grid%xlat, & ! IN - Latitude (radians) - Grid%xlon, & ! IN - Longitude (radians) - Sfcprop%slmsk, & ! IN - Land/Sea mask () - deltaZ, & ! IN - Layer thickness (km) - deltaP/100., & ! IN - Layer thickness (hPa) - NCOL, & ! IN - Number of horizontal gridpoints - MODEL%LEVS, & ! IN - Number of model layers - MODEL%LEVS+1, & ! IN - Number of model levels - cldcov, & ! IN - Layer cloud fraction (used if uni_cld=.true.) - effr_l, & ! IN - Liquid-water effective radius (microns) - effr_i, & ! IN - Ice-water effective radius (microns) - effr_r, & ! IN - Rain-water effective radius (microns) - effr_s, & ! IN - Snow-water effective radius (microns) - Model%effr_in, & ! IN - Logical, if .true. use input effective radii - clouds, & ! OUT - Cloud properties (NCOL,Model%levs,NF_CLDS) - cldsa, & ! OUT - fraction of clouds for low, mid, hi, tot, bl (NCOL,5) - mtopa, & ! OUT - vertical indices for low, mid, hi cloud tops (NCOL,3) - mbota, & ! OUT - vertical indices for low, mid, hi cloud bases (NCOL,3) - de_lgth) ! OUT - clouds decorrelation length (km) - endif - ! *) Thompson / WSM6 cloud micrphysics scheme - elseif(Model%imp_physics == 8 .or. Model%imp_physics == 6) then - - call progcld5 ( & ! IN - p_lay/100., & ! IN - Pressure at model layer centers (mb) - p_lev/100., & ! IN - Pressure at model interfaces (mb) - t_lay, & ! IN - Temperature at layer centers (K) - q_lay, & ! IN - Specific humidity at layer center (kg/kg) - qs_lay, & ! IN - Saturation specific humidity at layer center (kg/kg) - relhum, & ! IN - Relative humidity at layer center (1) - tracer, & ! IN - Cloud condensate amount in layer by type () - Grid%xlat, & ! IN - Latitude (radians) - Grid%xlon, & ! IN - Longitude (radians) - Sfcprop%slmsk, & ! IN - Land/Sea mask () - deltaZ, & ! IN - Layer thickness (km) - deltaP/100., & ! IN - Layer thickness (hPa) - Model%ntrac-1, & ! IN - Number of tracers - Model%ntcw-1, & ! IN - Tracer index for cloud condensate (or liquid water) - Model%ntiw-1, & ! IN - Tracer index for ice - Model%ntrw-1, & ! IN - Tracer index for rain - Model%ntsw-1, & ! IN - Tracer index for snow - Model%ntgl-1, & ! IN - Tracer index for groupel - NCOL, & ! IN - Number of horizontal gridpoints - MODEL%LEVS, & ! IN - Number of model layers - MODEL%LEVS+1, & ! IN - Number of model levels - Model%uni_cld, & ! IN - True for cloud fraction from shoc - Model%lmfshal, & ! IN - True for mass flux shallow convection - Model%lmfdeep2, & ! IN - True for mass flux deep convection - cldcov(:,1:Model%levs), & ! IN - Layer cloud fraction (used if uni_cld=.true.) - Tbd%phy_f3d(:,:,1), & ! IN - Liquid-water effective radius (microns) - Tbd%phy_f3d(:,:,2), & ! IN - Ice-water effective radius (microns) - Tbd%phy_f3d(:,:,3), & ! IN - LSnow-water effective radius (microns) - clouds, & ! OUT - Cloud properties (NCOL,Model%levs,NF_CLDS) - cldsa, & ! OUT - fraction of clouds for low, mid, hi, tot, bl (NCOL,5) - mtopa, & ! OUT - vertical indices for low, mid, hi cloud tops (NCOL,3) - mbota, & ! OUT - vertical indices for low, mid, hi cloud bases (NCOL,3) - de_lgth) ! OUT - clouds decorrelation length (km) - endif ! end if_imp_physics - end subroutine cloud_microphysics - ! end module GFS_rrtmgp_pre diff --git a/physics/GFS_rrtmgp_pre.meta b/physics/GFS_rrtmgp_pre.meta index f9c882fa7..980190b5a 100644 --- a/physics/GFS_rrtmgp_pre.meta +++ b/physics/GFS_rrtmgp_pre.meta @@ -9,14 +9,6 @@ type = GFS_control_type intent = inout optional = F -[Radtend] - standard_name = GFS_radtend_type_instance - long_name = instance of derived type GFS_radtend_type - units = DDT - dimensions = () - type = GFS_radtend_type - intent = inout - optional = F [active_gases_array] standard_name = list_of_active_gases_used_by_RRTMGP long_name = list of active gases used by RRTMGP @@ -88,22 +80,6 @@ type = GFS_tbd_type intent = in optional = F -[Coupling] - standard_name = GFS_coupling_type_instance - long_name = instance of derived type GFS_coupling_type - units = DDT - dimensions = () - type = GFS_coupling_type - intent = in - optional = F -[Radtend] - standard_name = GFS_radtend_type_instance - long_name = instance of derived type GFS_radtend_type - units = DDT - dimensions = () - type = GFS_radtend_type - intent = inout - optional = F [ncol] standard_name = horizontal_loop_extent long_name = horizontal loop extent @@ -138,15 +114,6 @@ kind = kind_phys intent = out optional = F -[sec_diff_byband] - standard_name = secant_of_diffusivity_angle_each_RRTMGP_LW_band - long_name = secant of diffusivity angle in each RRTMGP LW band - units = none - dimensions = (number_of_lw_bands_rrtmgp,horizontal_dimension) - type = real - kind = kind_phys - intent = out - optional = F [p_lay] standard_name = air_pressure_at_layer_for_RRTMGP_in_hPa long_name = air pressure at vertical layer for radiation calculation @@ -219,135 +186,38 @@ kind = kind_phys intent = out optional = F -[tracer] - standard_name = chemical_tracers - long_name = chemical tracers - units = g g-1 - dimensions = (horizontal_dimension,vertical_dimension,number_of_tracers) - type = real - kind = kind_phys - intent = out - optional = F -[cld_frac] - standard_name = total_cloud_fraction - long_name = layer total cloud fraction - units = frac - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = out - optional = F -[cld_lwp] - standard_name = cloud_liquid_water_path - long_name = layer cloud liquid water path - units = g m-2 - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = out - optional = F -[cld_reliq] - standard_name = mean_effective_radius_for_liquid_cloud - long_name = mean effective radius for liquid cloud - units = micron - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = out - optional = F -[cld_iwp] - standard_name = cloud_ice_water_path - long_name = layer cloud ice water path - units = g m-2 - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = out - optional = F -[cld_reice] - standard_name = mean_effective_radius_for_ice_cloud - long_name = mean effective radius for ice cloud - units = micron - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = out - optional = F -[cld_swp] - standard_name = cloud_snow_water_path - long_name = layer cloud snow water path - units = g m-2 - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = out - optional = F -[cld_resnow] - standard_name = mean_effective_radius_for_snow_flake - long_name = mean effective radius for snow cloud - units = micron - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = out - optional = F -[cld_rwp] - standard_name = cloud_rain_water_path - long_name = layer cloud rain water path - units = g m-2 +[qs_lay] + standard_name = saturation_mixing_ratio + long_name = saturation mixing ratio + units = kg kg-1 dimensions = (horizontal_dimension,vertical_dimension) type = real kind = kind_phys intent = out optional = F -[cld_rerain] - standard_name = mean_effective_radius_for_rain_drop - long_name = mean effective radius for rain cloud - units = micron +[q_lay] + standard_name = water_vapor_mixing_ratio + long_name = water mixing ratio + units = kg kg-1 dimensions = (horizontal_dimension,vertical_dimension) type = real kind = kind_phys intent = out optional = F -[mtopa] - standard_name = model_layer_number_at_cloud_top - long_name = vertical indices for low, middle and high cloud tops - units = index - dimensions = (horizontal_dimension,3) - type = integer - intent = out - optional = F -[mbota] - standard_name = model_layer_number_at_cloud_base - long_name = vertical indices for low, middle and high cloud bases - units = index - dimensions = (horizontal_dimension,3) - type = integer - intent = out - optional = F -[de_lgth] - standard_name = cloud_decorrelation_length - long_name = cloud decorrelation length - units = km - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = out - optional = F -[overlap_param] - standard_name = cloud_overlap_param - long_name = cloud overlap parameter - units = km +[deltaZ] + standard_name = layer_thickness + long_name = layer_thickness + units = m dimensions = (horizontal_dimension,vertical_dimension) type = real kind = kind_phys intent = out - optional = F -[cldsa] - standard_name = cloud_area_fraction_for_radiation - long_name = fraction of clouds for low, middle, high, total and BL - units = frac - dimensions = (horizontal_dimension,5) + optional = F +[tracer] + standard_name = chemical_tracers + long_name = chemical tracers + units = g g-1 + dimensions = (horizontal_dimension,vertical_dimension,number_of_tracers) type = real kind = kind_phys intent = out diff --git a/physics/GFS_rrtmgp_setup.F90 b/physics/GFS_rrtmgp_setup.F90 index 45bc4397b..894450773 100644 --- a/physics/GFS_rrtmgp_setup.F90 +++ b/physics/GFS_rrtmgp_setup.F90 @@ -120,10 +120,8 @@ subroutine GFS_rrtmgp_setup_init (Model, si, levr, ictm, isol, ico2, & ' ccnorm=',ccnorm,' norad_precip=',norad_precip endif - ! Hack for using RRTMGP-Sw and RRTMG-LW - if (.not. Model%do_GPsw_Glw) then - call radinit( si, levr, imp_physics, me ) - endif + + call radinit( Model, si, levr, imp_physics, me ) if ( me == 0 ) then print *,' Radiation sub-cloud initial seed =',ipsd0, & @@ -199,7 +197,7 @@ end subroutine GFS_rrtmgp_setup_finalize ! Private functions - subroutine radinit( si, NLAY, imp_physics, me ) + subroutine radinit( Model, si, NLAY, imp_physics, me ) !................................... ! --- inputs: @@ -316,13 +314,14 @@ subroutine radinit( si, NLAY, imp_physics, me ) use module_radiation_aerosols, only : aer_init use module_radiation_gases, only : gas_init use module_radiation_surface, only : sfc_init - use module_radiation_clouds, only : cld_init + use GFS_cloud_diagnostics, only : hml_cloud_diagnostics_initialize implicit none ! --- inputs: integer, intent(in) :: NLAY, me, imp_physics - + type(GFS_control_type), intent(in) :: & + Model ! DDT containing model control parameters real (kind=kind_phys), intent(in) :: si(:) ! --- outputs: (none, to module variables) @@ -409,7 +408,7 @@ subroutine radinit( si, NLAY, imp_physics, me ) call aer_init ( NLAY, me ) ! --- ... aerosols initialization routine call gas_init ( me ) ! --- ... co2 and other gases initialization routine call sfc_init ( me ) ! --- ... surface initialization routine - call cld_init ( si, NLAY, imp_physics, me) ! --- ... cloud initialization routine + call hml_cloud_diagnostics_initialize( Model, NLAY, me, si) return !................................... diff --git a/physics/rrtmgp_lw_rte.F90 b/physics/rrtmgp_lw_rte.F90 index 583fa9ee2..d4873799b 100644 --- a/physics/rrtmgp_lw_rte.F90 +++ b/physics/rrtmgp_lw_rte.F90 @@ -31,7 +31,7 @@ end subroutine rrtmgp_lw_rte_init !! subroutine rrtmgp_lw_rte_run(doLWrad, nCol, nLev, p_lay, t_lay, p_lev, skt, lw_gas_props, & sfc_emiss_byband, sources, lw_optical_props_clrsky, lw_optical_props_clouds, & - lw_optical_props_aerosol, secdiff, nGauss_angles, fluxlwUP_allsky, fluxlwDOWN_allsky,& + lw_optical_props_aerosol, nGauss_angles, fluxlwUP_allsky, fluxlwDOWN_allsky,& fluxlwUP_clrsky, fluxlwDOWN_clrsky, hlwb, errmsg, errflg) ! Inputs @@ -59,8 +59,6 @@ subroutine rrtmgp_lw_rte_run(doLWrad, nCol, nLev, p_lay, t_lay, p_lev, skt, lw_g type(ty_optical_props_1scl),intent(in) :: & lw_optical_props_clouds, & ! RRTMGP DDT: longwave cloud radiative properties lw_optical_props_aerosol ! RRTMGP DDT: longwave aerosol radiative properties - real(kind_phys), dimension(lw_gas_props%get_nband(),ncol),intent(in) :: & - secdiff ! Outputs real(kind_phys), dimension(ncol,nLev+1), intent(out) :: & fluxlwUP_allsky, & ! All-sky flux (W/m2) @@ -110,13 +108,6 @@ subroutine rrtmgp_lw_rte_run(doLWrad, nCol, nLev, p_lay, t_lay, p_lev, skt, lw_g ! Add aerosol optics to gas optics call check_error_msg('rrtmgp_lw_rte_run',lw_optical_props_aerosol%increment(lw_optical_props_clrsky)) - ! Apply diffusivity angle adjustment (RRTMG legacy) - do iCol=1,nCol - do iBand=1,lw_gas_props%get_nband() - lw_optical_props_clrsky%tau(iCol,1:nLev,iBand) = lw_optical_props_clrsky%tau(iCol,1:nLev,iBand)*secdiff(iBand,iCol) - enddo - enddo - ! Call RTE solver call check_error_msg('rrtmgp_lw_rte_run',rte_lw( & lw_optical_props_clrsky, & ! IN - optical-properties @@ -132,13 +123,6 @@ subroutine rrtmgp_lw_rte_run(doLWrad, nCol, nLev, p_lay, t_lay, p_lev, skt, lw_g ! ! All-sky fluxes ! - - ! Apply diffusivity angle adjustment (RRTMG legacy) - !do iCol=1,nCol - ! do iBand=1,lw_gas_props%get_nband() - ! lw_optical_props_clouds%tau(iCol,1:nLev,iBand) = lw_optical_props_clouds%tau(iCol,1:nLev,iBand)*secdiff(iBand,iCol) - ! enddo - !enddo ! Add cloud optics to clear-sky optics call check_error_msg('rrtmgp_lw_rte_run',lw_optical_props_clouds%increment(lw_optical_props_clrsky)) diff --git a/physics/rrtmgp_lw_rte.meta b/physics/rrtmgp_lw_rte.meta index a8426bc15..a2350b4c2 100644 --- a/physics/rrtmgp_lw_rte.meta +++ b/physics/rrtmgp_lw_rte.meta @@ -127,15 +127,6 @@ kind = kind_phys intent = in optional = T -[secdiff] - standard_name = secant_of_diffusivity_angle_each_RRTMGP_LW_band - long_name = secant of diffusivity angle in each RRTMGP LW band - units = none - dimensions = (number_of_lw_bands_rrtmgp,horizontal_dimension) - type = real - kind = kind_phys - intent = in - optional = F [fluxlwUP_allsky] standard_name = RRTMGP_lw_flux_profile_upward_allsky long_name = RRTMGP upward longwave all-sky flux profile From 59d06ab27fbda4d690b50936ae49a3c97fa3a0a8 Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Fri, 15 May 2020 10:49:00 -0600 Subject: [PATCH 13/50] Bug fix and some housekeeping. Working for both EMC SDFs. --- physics/GFS_cloud_diagnostics.F90 | 21 ++++++++---- physics/GFS_cloud_diagnostics.meta | 21 ++++++++---- physics/GFS_rrtmgp_gfdlmp_pre.F90 | 16 +++------ physics/GFS_rrtmgp_gfdlmp_pre.meta | 55 +----------------------------- physics/GFS_rrtmgp_pre.F90 | 50 ++++++++++++--------------- physics/GFS_rrtmgp_pre.meta | 35 ------------------- 6 files changed, 57 insertions(+), 141 deletions(-) diff --git a/physics/GFS_cloud_diagnostics.F90 b/physics/GFS_cloud_diagnostics.F90 index b497e5102..83f43356d 100644 --- a/physics/GFS_cloud_diagnostics.F90 +++ b/physics/GFS_cloud_diagnostics.F90 @@ -1,9 +1,9 @@ module GFS_cloud_diagnostics use machine, only: kind_phys - use physcons, only: con_pi + use physcons, only: con_pi, con_rog use physparam, only: iovrlw, iovrsw, ivflip, icldflg use GFS_typedefs, only: GFS_control_type - + ! Module parameters (imported directly from radiation_cloud.f) integer, parameter :: & NF_CLDS = 9, & ! Number of fields in cloud array @@ -37,8 +37,8 @@ end subroutine GFS_cloud_diagnostics_init !! \section arg_table_GFS_cloud_diagnostics_run !! \htmlinclude GFS_cloud_diagnostics_run.html !! - subroutine GFS_cloud_diagnostics_run(Model, nCol, nLev, lat, p_lay, deltaZ, cld_frac, & - mbota, mtopa, cldsa, de_lgth, overlap_param, errmsg, errflg) + subroutine GFS_cloud_diagnostics_run(Model, nCol, nLev, lat, p_lay, tv_lay, cld_frac, & + p_lev, mbota, mtopa, cldsa, de_lgth, overlap_param, errmsg, errflg) implicit none ! Inputs @@ -51,8 +51,10 @@ subroutine GFS_cloud_diagnostics_run(Model, nCol, nLev, lat, p_lay, deltaZ, cld_ lat ! Latitude real(kind_phys), dimension(nCol,nLev), intent(in) :: & p_lay, & ! Pressure at model-layer - deltaZ, & ! Layer thickness at model-layers + tv_lay, & ! Virtual temperature cld_frac ! Total cloud fraction + real(kind_phys), dimension(nCol,nLev+1), intent(in) :: & + p_lev ! Pressure at model interfaces ! Outputs character(len=*), intent(out) :: & @@ -74,7 +76,7 @@ subroutine GFS_cloud_diagnostics_run(Model, nCol, nLev, lat, p_lay, deltaZ, cld_ real(kind_phys) :: tem1 real(kind_phys),dimension(nCol,NK_CLDS+1) :: ptop1 real(kind_phys),dimension(nCol) :: rlat - real(kind_phys),dimension(nCol,nLev) :: cldcnv + real(kind_phys),dimension(nCol,nLev) :: cldcnv, deltaZ if (.not. (Model%lsswr .or. Model%lslwr)) return @@ -92,6 +94,13 @@ subroutine GFS_cloud_diagnostics_run(Model, nCol, nLev, lat, p_lay, deltaZ, cld_ ptop1(i,icld) = ptopc(icld,1) + tem1*max( 0.0, 4.0*rlat(i)-1.0 ) enddo enddo + + ! Compute layer-thickness + do iCol=1,nCol + do iLay=1,nLev + deltaZ(iCol,iLay) = (con_rog*0.001) * abs(log(p_lev(iCol,iLay)) - log(p_lev(iCol,iLay+1))) * tv_lay(iCol,iLay) + enddo + enddo ! Estimate clouds decorrelation length in km ! *this is only a tentative test, need to consider change later* diff --git a/physics/GFS_cloud_diagnostics.meta b/physics/GFS_cloud_diagnostics.meta index 84ddb03c2..8967ba386 100644 --- a/physics/GFS_cloud_diagnostics.meta +++ b/physics/GFS_cloud_diagnostics.meta @@ -43,15 +43,15 @@ kind = kind_phys intent = in optional = F -[deltaZ] - standard_name = layer_thickness - long_name = layer_thickness - units = m +[tv_lay] + standard_name = virtual_temperature + long_name = layer virtual temperature + units = K dimensions = (horizontal_dimension,vertical_dimension) type = real kind = kind_phys intent = in - optional = F + optional = F [cld_frac] standard_name = total_cloud_fraction long_name = layer total cloud fraction @@ -60,7 +60,16 @@ type = real kind = kind_phys intent = in - optional = F + optional = F +[p_lev] + standard_name = air_pressure_at_interface_for_RRTMGP_in_hPa + long_name = air pressure at vertical interface for radiation calculation + units = hPa + dimensions = (horizontal_dimension,vertical_dimension_plus_one) + type = real + kind = kind_phys + intent = in + optional = F [mtopa] standard_name = model_layer_number_at_cloud_top long_name = vertical indices for low, middle and high cloud tops diff --git a/physics/GFS_rrtmgp_gfdlmp_pre.F90 b/physics/GFS_rrtmgp_gfdlmp_pre.F90 index 509ebb4e6..27e541160 100644 --- a/physics/GFS_rrtmgp_gfdlmp_pre.F90 +++ b/physics/GFS_rrtmgp_gfdlmp_pre.F90 @@ -27,8 +27,8 @@ end subroutine GFS_rrtmgp_gfdlmp_pre_init !! \section arg_table_GFS_rrtmgp_gfdlmp_pre_run !! \htmlinclude GFS_rrtmgp_gfdlmp_pre_run.html !! - subroutine GFS_rrtmgp_gfdlmp_pre_run(Model, Tbd, nCol, nLev, slmsk, lon, lat, p_lay, & - p_lev, t_lay, t_lev, tv_lay, relhum, qs_lay, q_lay, deltaZ, tracer, & + subroutine GFS_rrtmgp_gfdlmp_pre_run(Model, Tbd, nCol, nLev, slmsk, lat, p_lay, p_lev, & + t_lay, tv_lay, tracer, & cld_frac, cld_lwp, cld_reliq, cld_iwp, cld_reice, cld_swp, cld_resnow, cld_rwp, & cld_rerain, errmsg, errflg) implicit none @@ -43,19 +43,13 @@ subroutine GFS_rrtmgp_gfdlmp_pre_run(Model, Tbd, nCol, nLev, slmsk, lon, lat, p_ nLev ! Number of vertical-layers real(kind_phys), dimension(nCol), intent(in) :: & slmsk, & ! Land/sea/sea-ice mask - lon, & ! Longitude lat ! Latitude real(kind_phys), dimension(nCol,nLev), intent(in) :: & p_lay, & ! Pressure at model-layer (Pa) t_lay, & ! Temperature at model layer (K) - tv_lay, & ! Virtual temperature at model-layers (K) - relhum, & ! Relative-humidity at model-layers - qs_lay, & ! Saturation mixing-ratio at model-layers (kg/kg) - q_lay, & ! Water-vapor mixing-ratio at model-layers (kg/kg) - deltaZ ! Layer thickness at model-layers (km) + tv_lay ! Virtual temperature at model-layers (K) real(kind_phys), dimension(nCol,nLev+1), intent(in) :: & - p_lev, & ! Pressure at model-level interfaces (Pa) - t_lev ! Temperature at model-level interfaces (K) + p_lev ! Pressure at model-level interfaces (Pa) real(kind_phys), dimension(nCol, nLev, Model%ntrac),intent(in) :: & tracer ! Cloud condensate amount in layer by type () @@ -124,7 +118,7 @@ subroutine GFS_rrtmgp_gfdlmp_pre_run(Model, Tbd, nCol, nLev, slmsk, lon, lat, p_ endif ! Cloud-fraction - cld_frac(1:nCol,1:nLev) = tracer(1:nCol,1:nCol,Model%ntclamt) + cld_frac(1:nCol,1:nLev) = tracer(1:nCol,1:nLev,Model%ntclamt) ! Set really tiny suspended particle amounts to clear do l=1,ncndl diff --git a/physics/GFS_rrtmgp_gfdlmp_pre.meta b/physics/GFS_rrtmgp_gfdlmp_pre.meta index 5b792bc6c..a9f61739e 100644 --- a/physics/GFS_rrtmgp_gfdlmp_pre.meta +++ b/physics/GFS_rrtmgp_gfdlmp_pre.meta @@ -49,15 +49,7 @@ dimensions = (horizontal_dimension) type = real intent = in - kind = kind_phys -[lon] - standard_name = longitude - long_name = longitude - units = radians - dimensions = (horizontal_dimension) - type = real - intent = in - kind = kind_phys + kind = kind_phys [p_lay] standard_name = air_pressure_at_layer_for_RRTMGP_in_hPa long_name = air pressure at vertical layer for radiation calculation @@ -85,15 +77,6 @@ kind = kind_phys intent = in optional = F -[t_lev] - standard_name = air_temperature_at_interface_for_RRTMGP - long_name = air temperature at vertical interface for radiation calculation - units = K - dimensions = (horizontal_dimension,vertical_dimension_plus_one) - type = real - kind = kind_phys - intent = in - optional = F [tv_lay] standard_name = virtual_temperature long_name = layer virtual temperature @@ -103,42 +86,6 @@ kind = kind_phys intent = in optional = F -[relhum] - standard_name = relative_humidity - long_name = layer relative humidity - units = frac - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = in - optional = F -[qs_lay] - standard_name = saturation_mixing_ratio - long_name = saturation mixing ratio - units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = in - optional = F -[q_lay] - standard_name = water_vapor_mixing_ratio - long_name = water mixing ratio - units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = in - optional = F -[deltaZ] - standard_name = layer_thickness - long_name = layer_thickness - units = m - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = in - optional = F [tracer] standard_name = chemical_tracers long_name = chemical tracers diff --git a/physics/GFS_rrtmgp_pre.F90 b/physics/GFS_rrtmgp_pre.F90 index f3f2f3dc4..7c3609af4 100644 --- a/physics/GFS_rrtmgp_pre.F90 +++ b/physics/GFS_rrtmgp_pre.F90 @@ -180,10 +180,9 @@ end subroutine GFS_rrtmgp_pre_init !> \section arg_table_GFS_rrtmgp_pre_run !! \htmlinclude GFS_rrtmgp_pre_run.html !! - subroutine GFS_rrtmgp_pre_run (Model, Grid, Statein, Sfcprop, Tbd, ncol, lw_gas_props, & - active_gases_array, & ! IN - raddt, p_lay, t_lay, p_lev, t_lev, tsfg, tsfa, tv_lay, relhum, qs_lay, q_lay, & ! OUT - deltaZ, tracer, gas_concentrations, errmsg, errflg) + subroutine GFS_rrtmgp_pre_run(Model, Grid, Statein, Sfcprop, Tbd, ncol, active_gases_array, & + raddt, p_lay, t_lay, p_lev, t_lev, tsfg, tsfa, tv_lay, relhum, tracer, & + gas_concentrations, errmsg, errflg) ! Inputs type(GFS_control_type), intent(in) :: & @@ -198,53 +197,47 @@ subroutine GFS_rrtmgp_pre_run (Model, Grid, Statein, Sfcprop, Tbd, ncol, lw_gas_ Tbd ! DDT: FV3-GFS data not yet assigned to a defined container integer, intent(in) :: & ncol ! Number of horizontal grid points - type(ty_gas_optics_rrtmgp),intent(in) :: & - lw_gas_props ! RRTMGP DDT: longwave spectral information character(len=*),dimension(Model%ngases), intent(in) :: & active_gases_array ! Character array containing trace gases to include in RRTMGP ! Outputs - real(kind_phys), dimension(ncol,Model%levs), intent(out) :: & - p_lay, & ! Pressure at model-layer - t_lay ! Temperature at model layer - real(kind_phys), dimension(ncol,Model%levs+1), intent(out) :: & - p_lev, & ! Pressure at model-interface - t_lev ! Temperature at model-interface + character(len=*), intent(out) :: & + errmsg ! Error message + integer, intent(out) :: & + errflg ! Error flag real(kind_phys), intent(out) :: & raddt ! Radiation time-step real(kind_phys), dimension(ncol), intent(out) :: & tsfg, & ! Ground temperature - tsfa ! Skin temperature - type(ty_gas_concs),intent(out) :: & - gas_concentrations ! RRTMGP DDT: gas volumne mixing ratios - character(len=*), intent(out) :: & - errmsg ! Error message - integer, intent(out) :: & - errflg ! Error flag - real(kind_phys), dimension(ncol,Model%levs),intent(out) :: & + tsfa ! Skin temperature + real(kind_phys), dimension(ncol,Model%levs), intent(out) :: & + p_lay, & ! Pressure at model-layer + t_lay, & ! Temperature at model layer tv_lay, & ! Virtual temperature at model-layers - relhum, & ! Relative-humidity at model-layers - qs_lay, & ! Saturation mixing-ratio at model-layers - q_lay, & ! Water-vapor mixing-ratio at model-layers - deltaZ ! Layer thickness at model-layers + relhum ! Relative-humidity at model-layers + real(kind_phys), dimension(ncol,Model%levs+1), intent(out) :: & + p_lev, & ! Pressure at model-interface + t_lev ! Temperature at model-interface real(kind_phys), dimension(ncol, Model%levs, Model%ntrac),intent(out) :: & tracer ! Array containing trace gases - + type(ty_gas_concs),intent(out) :: & + gas_concentrations ! RRTMGP DDT: gas volumne mixing ratios + ! Local variables integer :: i, j, iCol, iBand, iSFC, iTOA, iLay logical :: top_at_1 real(kind_phys),dimension(NCOL,Model%levs) :: vmr_o3, vmr_h2o real(kind_phys) :: es, qs, tem1, tem2 real(kind_phys), dimension(ncol, NF_ALBD) :: sfcalb - real(kind_phys), dimension(ncol, Model%levs) :: o3_lay + real(kind_phys), dimension(ncol, Model%levs) :: o3_lay, qs_lay, q_lay real(kind_phys), dimension(ncol, Model%levs, NF_VGAS) :: gas_vmr + if (.not. (Model%lsswr .or. Model%lslwr)) return + ! Initialize CCPP error handling variables errmsg = '' errflg = 0 - if (.not. (Model%lsswr .or. Model%lslwr)) return - ! ####################################################################################### ! What is vertical ordering? ! ####################################################################################### @@ -295,7 +288,6 @@ subroutine GFS_rrtmgp_pre_run (Model, Grid, Statein, Sfcprop, Tbd, ncol, lw_gas_ relhum(iCol,iLay) = max( 0._kind_phys, min( 1._kind_phys, max(QMIN, q_lay(iCol,iLay))/qs ) ) qs_lay(iCol,iLay) = qs tv_lay(iCol,iLay) = t_lay(iCol,iLay) * (1._kind_phys + fvirt*q_lay(iCol,iLay)) - deltaZ(iCol,iLay) = (rog*0.001) * abs(log(p_lev(iCol,iLay)) - log(p_lev(iCol,iLay+1))) * tv_lay(iCol,iLay) enddo enddo diff --git a/physics/GFS_rrtmgp_pre.meta b/physics/GFS_rrtmgp_pre.meta index 980190b5a..cf0195a39 100644 --- a/physics/GFS_rrtmgp_pre.meta +++ b/physics/GFS_rrtmgp_pre.meta @@ -88,14 +88,6 @@ type = integer intent = in optional = F -[lw_gas_props] - standard_name = coefficients_for_lw_gas_optics - long_name = DDT containing spectral information for RRTMGP LW radiation scheme - units = DDT - dimensions = () - type = ty_gas_optics_rrtmgp - intent = in - optional = F [active_gases_array] standard_name = list_of_active_gases_used_by_RRTMGP long_name = list of active gases used by RRTMGP @@ -186,33 +178,6 @@ kind = kind_phys intent = out optional = F -[qs_lay] - standard_name = saturation_mixing_ratio - long_name = saturation mixing ratio - units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = out - optional = F -[q_lay] - standard_name = water_vapor_mixing_ratio - long_name = water mixing ratio - units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = out - optional = F -[deltaZ] - standard_name = layer_thickness - long_name = layer_thickness - units = m - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = out - optional = F [tracer] standard_name = chemical_tracers long_name = chemical tracers From 506c29aae9c960d2679ee79dca2ba2fe2d6941e0 Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Mon, 18 May 2020 11:30:18 -0600 Subject: [PATCH 14/50] Housekeeping --- physics/GFS_cloud_diagnostics.F90 | 828 +++++++++++++++--------------- physics/GFS_rrtmgp_gfdlmp_pre.F90 | 207 ++++---- 2 files changed, 518 insertions(+), 517 deletions(-) diff --git a/physics/GFS_cloud_diagnostics.F90 b/physics/GFS_cloud_diagnostics.F90 index 83f43356d..c77bac5ce 100644 --- a/physics/GFS_cloud_diagnostics.F90 +++ b/physics/GFS_cloud_diagnostics.F90 @@ -1,108 +1,112 @@ +! ######################################################################################## +! This module contains code to produce the UFS High/Mid/Low cloud-diagnostics. +! This was bundled together with the prognostic cloud modules within the RRTMG implementation. +! For the RRTMGP implementation we propose to keep these diagnostics independent. +! ######################################################################################## module GFS_cloud_diagnostics use machine, only: kind_phys use physcons, only: con_pi, con_rog use physparam, only: iovrlw, iovrsw, ivflip, icldflg use GFS_typedefs, only: GFS_control_type - + ! Module parameters (imported directly from radiation_cloud.f) integer, parameter :: & - NF_CLDS = 9, & ! Number of fields in cloud array - NK_CLDS = 3 ! Number of cloud vertical domains + NF_CLDS = 9, & ! Number of fields in cloud array + NK_CLDS = 3 ! Number of cloud vertical domains real(kind_phys), parameter :: & - climit = 0.001, & ! Lowest allowable cloud-fraction - ovcst = 1.0 - 1.0e-8 ! Overcast cloud-fraction 0.999999999 + climit = 0.001, & ! Lowest allowable cloud-fraction + ovcst = 1.0 - 1.0e-8 ! Overcast cloud-fraction 0.999999999 real(kind_phys), parameter, dimension(NK_CLDS+1,2) :: & - ptopc = reshape(source=(/ 1050., 650., 400., 0.0, 1050., 750., 500., 0.0 /), & - shape=(/NK_CLDS+1,2/)) + ptopc = reshape(source=(/ 1050., 650., 400., 0.0, 1050., 750., 500., 0.0 /), & + shape=(/NK_CLDS+1,2/)) ! Version tag and last revision date - character(40), parameter :: VTAGCLD='NCEP-Radiation_clouds v5.1 Nov 2012 ' + character(40), parameter :: VTAGCLD='UFS-cloud-diagnostics vX.x May 2020 ' ! Module variables integer :: & - iovr = 1, & ! Cloud overlap used for diagnostic HML cloud outputs - llyr = 2 ! Upper limit of boundary layer clouds - + iovr = 1, & ! Cloud overlap used for diagnostic HML cloud outputs + llyr = 2 ! Upper limit of boundary layer clouds public GFS_cloud_diagnostics_run, GFS_cloud_diagnostics_init,& - GFS_cloud_diagnostics_finalize, hml_cloud_diagnostics_init + GFS_cloud_diagnostics_finalize, hml_cloud_diagnostics_init contains ! ###################################################################################### ! ###################################################################################### subroutine GFS_cloud_diagnostics_init() end subroutine GFS_cloud_diagnostics_init - + ! ###################################################################################### ! ###################################################################################### !! \section arg_table_GFS_cloud_diagnostics_run !! \htmlinclude GFS_cloud_diagnostics_run.html !! subroutine GFS_cloud_diagnostics_run(Model, nCol, nLev, lat, p_lay, tv_lay, cld_frac, & - p_lev, mbota, mtopa, cldsa, de_lgth, overlap_param, errmsg, errflg) + p_lev, mbota, mtopa, cldsa, de_lgth, overlap_param, errmsg, errflg) implicit none ! Inputs type(GFS_control_type), intent(in) :: & - Model ! DDT: FV3-GFS model control parameters + Model ! DDT: FV3-GFS model control parameters integer, intent(in) :: & - nCol, & ! Number of horizontal grid-points - nLev ! Number of vertical-layers + nCol, & ! Number of horizontal grid-points + nLev ! Number of vertical-layers real(kind_phys), dimension(nCol), intent(in) :: & - lat ! Latitude + lat ! Latitude real(kind_phys), dimension(nCol,nLev), intent(in) :: & - p_lay, & ! Pressure at model-layer - tv_lay, & ! Virtual temperature - cld_frac ! Total cloud fraction + p_lay, & ! Pressure at model-layer + tv_lay, & ! Virtual temperature + cld_frac ! Total cloud fraction real(kind_phys), dimension(nCol,nLev+1), intent(in) :: & - p_lev ! Pressure at model interfaces - + p_lev ! Pressure at model interfaces + ! Outputs character(len=*), intent(out) :: & - errmsg ! Error message + errmsg ! Error message integer, intent(out) :: & - errflg ! Error flag + errflg ! Error flag integer,dimension(ncol,3),intent(out) :: & - mbota, & ! Vertical indices for cloud tops - mtopa ! Vertical indices for cloud bases + mbota, & ! Vertical indices for cloud tops + mtopa ! Vertical indices for cloud bases real(kind_phys), dimension(ncol,5), intent(out) :: & - cldsa ! Fraction of clouds for low, middle, high, total and BL + cldsa ! Fraction of clouds for low, middle, high, total and BL real(kind_phys), dimension(ncol), intent(out) :: & - de_lgth ! Decorrelation length + de_lgth ! Decorrelation length real(kind_phys), dimension(nCol,nLev), intent(out) :: & - overlap_param ! Cloud-overlap parameter - - ! Local variables - integer i,id,iCol,iLay,icld - real(kind_phys) :: tem1 - real(kind_phys),dimension(nCol,NK_CLDS+1) :: ptop1 - real(kind_phys),dimension(nCol) :: rlat - real(kind_phys),dimension(nCol,nLev) :: cldcnv, deltaZ + overlap_param ! Cloud-overlap parameter + + ! Local variables + integer i,id,iCol,iLay,icld + real(kind_phys) :: tem1 + real(kind_phys),dimension(nCol,NK_CLDS+1) :: ptop1 + real(kind_phys),dimension(nCol) :: rlat + real(kind_phys),dimension(nCol,nLev) :: cldcnv, deltaZ if (.not. (Model%lsswr .or. Model%lslwr)) return - + ! Initialize CCPP error handling variables errmsg = '' errflg = 0 - - ! This is set to zero in all of the progcld() routines and passed to gethml(). + + ! This is set to zero in all of the progcld() routines and passed to gethml(). cldcnv(:,:) = 0._kind_phys - + do icld = 1, NK_CLDS+1 tem1 = ptopc(icld,2) - ptopc(icld,1) - do i=1,nCol - rlat(i) = abs(lat(i) / con_pi ) + do i=1,nCol + rlat(i) = abs(lat(i) / con_pi ) ptop1(i,icld) = ptopc(icld,1) + tem1*max( 0.0, 4.0*rlat(i)-1.0 ) - enddo + enddo enddo ! Compute layer-thickness do iCol=1,nCol do iLay=1,nLev - deltaZ(iCol,iLay) = (con_rog*0.001) * abs(log(p_lev(iCol,iLay)) - log(p_lev(iCol,iLay+1))) * tv_lay(iCol,iLay) + deltaZ(iCol,iLay) = (con_rog*0.001) * abs(log(p_lev(iCol,iLay)) - log(p_lev(iCol,iLay+1))) * tv_lay(iCol,iLay) enddo enddo - - ! Estimate clouds decorrelation length in km + + ! Estimate clouds decorrelation length in km ! *this is only a tentative test, need to consider change later* if ( iovrlw == 3 .and. iovrsw == 3) then do iCol =1,nCol @@ -110,48 +114,47 @@ subroutine GFS_cloud_diagnostics_run(Model, nCol, nLev, lat, p_lay, tv_lay, cld_ do iLay=nLev,2,-1 if (de_lgth(iCol) .gt. 0) then overlap_param(iCol,iLay-1) = & - exp( -0.5 * (deltaZ(iCol,iLay)+deltaZ(iCol,iLay-1)) / de_lgth(iCol) ) + exp( -0.5 * (deltaZ(iCol,iLay)+deltaZ(iCol,iLay-1)) / de_lgth(iCol) ) endif - enddo + enddo enddo - endif + endif - ! Compute low, mid, high, total, and boundary layer cloud fractions - ! and clouds top/bottom layer indices for low, mid, and high clouds. - ! The three cloud domain boundaries are defined by ptopc. The cloud - ! overlapping method is defined by control flag 'iovr', which may - ! be different for lw and sw radiation programs. + ! Compute low, mid, high, total, and boundary layer cloud fractions and clouds top/bottom + ! layer indices for low, mid, and high clouds. The three cloud domain boundaries are + ! defined by ptopc. The cloud overlapping method is defined by control flag 'iovr', which may + ! be different for lw and sw radiation programs. call gethml(p_lay, ptop1, cld_frac, cldcnv, deltaZ, de_lgth, nCol, nLev, cldsa, mtopa, mbota) - + end subroutine GFS_cloud_diagnostics_run - + ! ###################################################################################### ! ###################################################################################### subroutine GFS_cloud_diagnostics_finalize() end subroutine GFS_cloud_diagnostics_finalize - + ! ###################################################################################### ! Initialization routine for High/Mid/Low cloud diagnostics. ! ###################################################################################### subroutine hml_cloud_diagnostics_initialize(Model, nLev, mpi_rank, sigmainit) implicit none - ! Inputs + ! Inputs type(GFS_control_type), intent(in) :: & - Model ! DDT: FV3-GFS model control parameters + Model ! DDT: FV3-GFS model control parameters integer, intent(in) :: & - nLev, & ! Number of vertical-layers - mpi_rank + nLev, & ! Number of vertical-layers + mpi_rank real(kind_phys), dimension(nLev+1), intent(in) :: & - sigmainit - + sigmainit + ! Local variables integer :: iLay, kl - + ! Cloud overlap used for diagnostic HML cloud outputs iovr = max(iovrsw,iovrlw) if (mpi_rank == 0) print *, VTAGCLD !print out version tag - + if ( icldflg == 0 ) then print *,' - Diagnostic Cloud Method has been discontinued' stop ! NoNo @@ -159,250 +162,245 @@ subroutine hml_cloud_diagnostics_initialize(Model, nLev, mpi_rank, sigmainit) if (mpi_rank == 0) then print *,' - Using Prognostic Cloud Method' if (Model%imp_physics == Model%imp_physics_zhao_carr) then - print *,' --- Zhao/Carr/Sundqvist microphysics' + print *,' --- Zhao/Carr/Sundqvist microphysics' elseif (Model%imp_physics == Model%imp_physics_zhao_carr_pdf) then - print *,' --- zhao/carr/sundqvist + pdf cloud' + print *,' --- zhao/carr/sundqvist + pdf cloud' elseif (Model%imp_physics == Model%imp_physics_gfdl) then - print *,' --- GFDL Lin cloud microphysics' + print *,' --- GFDL Lin cloud microphysics' elseif (Model%imp_physics == Model%imp_physics_thompson) then - print *,' --- Thompson cloud microphysics' + print *,' --- Thompson cloud microphysics' elseif (Model%imp_physics == Model%imp_physics_wsm6) then - print *,' --- WSM6 cloud microphysics' + print *,' --- WSM6 cloud microphysics' elseif (Model%imp_physics == Model%imp_physics_mg) then - print *,' --- MG cloud microphysics' + print *,' --- MG cloud microphysics' elseif (Model%imp_physics == Model%imp_physics_fer_hires) then - print *,' --- Ferrier-Aligo cloud microphysics' + print *,' --- Ferrier-Aligo cloud microphysics' else - print *,' !!! ERROR in cloud microphysc specification!!!', & - ' imp_physics (NP3D) =',Model%imp_physics - stop + print *,' !!! ERROR in cloud microphysc specification!!!', & + ' imp_physics (NP3D) =',Model%imp_physics + stop endif - endif - endif - - ! Compute the top of BL cld (llyr), which is the topmost non cld(low) layer for - ! stratiform (at or above lowest 0.1 of the atmosphere). - lab_do_k0 : do iLay = nLev, 2, -1 - kl = iLay - if (sigmainit(iLay) < 0.9e0) exit lab_do_k0 - enddo lab_do_k0 - llyr = kl + endif + endif + + ! Compute the top of BL cld (llyr), which is the topmost non cld(low) layer for + ! stratiform (at or above lowest 0.1 of the atmosphere). + lab_do_k0 : do iLay = nLev, 2, -1 + kl = iLay + if (sigmainit(iLay) < 0.9e0) exit lab_do_k0 + enddo lab_do_k0 + llyr = kl - return + return end subroutine hml_cloud_diagnostics_initialize ! ######################################################################################### ! ######################################################################################### - subroutine gethml & - & ( plyr, ptop1, cldtot, cldcnv, dz, de_lgth, & ! --- inputs: - & IX, NLAY, & - & clds, mtop, mbot & ! --- outputs: - & ) - -! =================================================================== ! -! ! -! abstract: compute high, mid, low, total, and boundary cloud fractions ! -! and cloud top/bottom layer indices for model diagnostic output. ! -! the three cloud domain boundaries are defined by ptopc. the cloud ! -! overlapping method is defined by control flag 'iovr', which is also ! -! used by lw and sw radiation programs. ! -! ! -! usage: call gethml ! -! ! -! subprograms called: none ! -! ! -! attributes: ! -! language: fortran 90 ! -! machine: ibm-sp, sgi ! -! ! -! ! -! ==================== definition of variables ==================== ! -! ! -! input variables: ! -! plyr (IX,NLAY) : model layer mean pressure in mb (100Pa) ! -! ptop1 (IX,4) : pressure limits of cloud domain interfaces ! -! (sfc,low,mid,high) in mb (100Pa) ! -! cldtot(IX,NLAY) : total or straiform cloud profile in fraction ! -! cldcnv(IX,NLAY) : convective cloud (for diagnostic scheme only) ! -! dz (ix,nlay) : layer thickness (km) ! -! de_lgth(ix) : clouds vertical de-correlation length (km) ! -! IX : horizontal dimention ! -! NLAY : vertical layer dimensions ! -! ! -! output variables: ! -! clds (IX,5) : fraction of clouds for low, mid, hi, tot, bl ! -! mtop (IX,3) : vertical indices for low, mid, hi cloud tops ! -! mbot (IX,3) : vertical indices for low, mid, hi cloud bases ! -! ! -! external module variables: (in physparam) ! -! ivflip : control flag of vertical index direction ! -! =0: index from toa to surface ! -! =1: index from surface to toa ! -! ! -! internal module variables: ! -! iovr : control flag for cloud overlap ! -! =0 random overlapping clouds ! -! =1 max/ran overlapping clouds ! -! =2 maximum overlapping ( for mcica only ) ! -! =3 decorr-length ovlp ( for mcica only ) ! -! ! -! ==================== end of description ===================== ! -! - implicit none! - -! --- inputs: - integer, intent(in) :: IX, NLAY - - real (kind=kind_phys), dimension(:,:), intent(in) :: plyr, ptop1, & - & cldtot, cldcnv, dz - real (kind=kind_phys), dimension(:), intent(in) :: de_lgth - -! --- outputs - real (kind=kind_phys), dimension(:,:), intent(out) :: clds - - integer, dimension(:,:), intent(out) :: mtop, mbot - -! --- local variables: - real (kind=kind_phys) :: cl1(IX), cl2(IX), dz1(ix) - real (kind=kind_phys) :: pcur, pnxt, ccur, cnxt, alfa - - integer, dimension(IX):: idom, kbt1, kth1, kbt2, kth2 - integer :: i, k, id, id1, kstr, kend, kinc - -! -!===> ... begin here -! - clds(:,:) = 0.0 - - do i = 1, IX - cl1(i) = 1.0 - cl2(i) = 1.0 - enddo - -! --- total and bl clouds, where cl1, cl2 are fractions of clear-sky view -! layer processed from surface and up - -!> - Calculate total and BL cloud fractions (maximum-random cloud -!! overlapping is operational). - - if ( ivflip == 0 ) then ! input data from toa to sfc - kstr = NLAY - kend = 1 - kinc = -1 - else ! input data from sfc to toa - kstr = 1 - kend = NLAY - kinc = 1 - endif ! end_if_ivflip - - if ( iovr == 0 ) then ! random overlap - - do k = kstr, kend, kinc + subroutine gethml(plyr, ptop1, cldtot, cldcnv, dz, de_lgth, IX, NLAY, clds, mtop, mbot) + ! =================================================================== ! + ! ! + ! abstract: compute high, mid, low, total, and boundary cloud fractions ! + ! and cloud top/bottom layer indices for model diagnostic output. ! + ! the three cloud domain boundaries are defined by ptopc. the cloud ! + ! overlapping method is defined by control flag 'iovr', which is also ! + ! used by lw and sw radiation programs. ! + ! ! + ! usage: call gethml ! + ! ! + ! subprograms called: none ! + ! ! + ! attributes: ! + ! language: fortran 90 ! + ! machine: ibm-sp, sgi ! + ! ! + ! ! + ! ==================== definition of variables ==================== ! + ! ! + ! input variables: ! + ! plyr (IX,NLAY) : model layer mean pressure in mb (100Pa) ! + ! ptop1 (IX,4) : pressure limits of cloud domain interfaces ! + ! (sfc,low,mid,high) in mb (100Pa) ! + ! cldtot(IX,NLAY) : total or straiform cloud profile in fraction ! + ! cldcnv(IX,NLAY) : convective cloud (for diagnostic scheme only) ! + ! dz (ix,nlay) : layer thickness (km) ! + ! de_lgth(ix) : clouds vertical de-correlation length (km) ! + ! IX : horizontal dimention ! + ! NLAY : vertical layer dimensions ! + ! ! + ! output variables: ! + ! clds (IX,5) : fraction of clouds for low, mid, hi, tot, bl ! + ! mtop (IX,3) : vertical indices for low, mid, hi cloud tops ! + ! mbot (IX,3) : vertical indices for low, mid, hi cloud bases ! + ! ! + ! external module variables: (in physparam) ! + ! ivflip : control flag of vertical index direction ! + ! =0: index from toa to surface ! + ! =1: index from surface to toa ! + ! ! + ! internal module variables: ! + ! iovr : control flag for cloud overlap ! + ! =0 random overlapping clouds ! + ! =1 max/ran overlapping clouds ! + ! =2 maximum overlapping ( for mcica only ) ! + ! =3 decorr-length ovlp ( for mcica only ) ! + ! ! + ! ==================== end of description ===================== ! + ! + implicit none! + + ! --- inputs: + integer, intent(in) :: IX, NLAY + + real (kind=kind_phys), dimension(:,:), intent(in) :: plyr, ptop1, & + cldtot, cldcnv, dz + real (kind=kind_phys), dimension(:), intent(in) :: de_lgth + + ! --- outputs + real (kind=kind_phys), dimension(:,:), intent(out) :: clds + + integer, dimension(:,:), intent(out) :: mtop, mbot + + ! --- local variables: + real (kind=kind_phys) :: cl1(IX), cl2(IX), dz1(ix) + real (kind=kind_phys) :: pcur, pnxt, ccur, cnxt, alfa + + integer, dimension(IX):: idom, kbt1, kth1, kbt2, kth2 + integer :: i, k, id, id1, kstr, kend, kinc + + ! + !===> ... begin here + ! + clds(:,:) = 0.0 + + do i = 1, IX + cl1(i) = 1.0 + cl2(i) = 1.0 + enddo + + ! --- total and bl clouds, where cl1, cl2 are fractions of clear-sky view + ! layer processed from surface and up + + !> - Calculate total and BL cloud fractions (maximum-random cloud + !! overlapping is operational). + + if ( ivflip == 0 ) then ! input data from toa to sfc + kstr = NLAY + kend = 1 + kinc = -1 + else ! input data from sfc to toa + kstr = 1 + kend = NLAY + kinc = 1 + endif ! end_if_ivflip + + if ( iovr == 0 ) then ! random overlap + + do k = kstr, kend, kinc do i = 1, IX - ccur = min( ovcst, max( cldtot(i,k), cldcnv(i,k) )) - if (ccur >= climit) cl1(i) = cl1(i) * (1.0 - ccur) + ccur = min( ovcst, max( cldtot(i,k), cldcnv(i,k) )) + if (ccur >= climit) cl1(i) = cl1(i) * (1.0 - ccur) enddo - + if (k == llyr) then - do i = 1, IX - clds(i,5) = 1.0 - cl1(i) ! save bl cloud - enddo + do i = 1, IX + clds(i,5) = 1.0 - cl1(i) ! save bl cloud + enddo endif - enddo - - do i = 1, IX + enddo + + do i = 1, IX clds(i,4) = 1.0 - cl1(i) ! save total cloud - enddo - - elseif ( iovr == 1 ) then ! max/ran overlap - - do k = kstr, kend, kinc + enddo + + elseif ( iovr == 1 ) then ! max/ran overlap + + do k = kstr, kend, kinc do i = 1, IX - ccur = min( ovcst, max( cldtot(i,k), cldcnv(i,k) )) - if (ccur >= climit) then ! cloudy layer - cl2(i) = min( cl2(i), (1.0 - ccur) ) - else ! clear layer - cl1(i) = cl1(i) * cl2(i) - cl2(i) = 1.0 - endif + ccur = min( ovcst, max( cldtot(i,k), cldcnv(i,k) )) + if (ccur >= climit) then ! cloudy layer + cl2(i) = min( cl2(i), (1.0 - ccur) ) + else ! clear layer + cl1(i) = cl1(i) * cl2(i) + cl2(i) = 1.0 + endif enddo - + if (k == llyr) then - do i = 1, IX - clds(i,5) = 1.0 - cl1(i) * cl2(i) ! save bl cloud - enddo + do i = 1, IX + clds(i,5) = 1.0 - cl1(i) * cl2(i) ! save bl cloud + enddo endif - enddo - - do i = 1, IX + enddo + + do i = 1, IX clds(i,4) = 1.0 - cl1(i) * cl2(i) ! save total cloud - enddo - - elseif ( iovr == 2 ) then ! maximum overlap all levels - - cl1(:) = 0.0 - - do k = kstr, kend, kinc + enddo + + elseif ( iovr == 2 ) then ! maximum overlap all levels + + cl1(:) = 0.0 + + do k = kstr, kend, kinc do i = 1, IX - ccur = min( ovcst, max( cldtot(i,k), cldcnv(i,k) )) - if (ccur >= climit) cl1(i) = max( cl1(i), ccur ) + ccur = min( ovcst, max( cldtot(i,k), cldcnv(i,k) )) + if (ccur >= climit) cl1(i) = max( cl1(i), ccur ) enddo - + if (k == llyr) then - do i = 1, IX - clds(i,5) = cl1(i) ! save bl cloud - enddo + do i = 1, IX + clds(i,5) = cl1(i) ! save bl cloud + enddo endif - enddo - - do i = 1, IX + enddo + + do i = 1, IX clds(i,4) = cl1(i) ! save total cloud - enddo - - elseif ( iovr == 3 ) then ! random if clear-layer divided, - ! otherwise de-corrlength method - do i = 1, ix + enddo + + elseif ( iovr == 3 ) then ! random if clear-layer divided, + ! otherwise de-corrlength method + do i = 1, ix dz1(i) = - dz(i,kstr) - enddo - - do k = kstr, kend, kinc + enddo + + do k = kstr, kend, kinc do i = 1, ix - ccur = min( ovcst, max( cldtot(i,k), cldcnv(i,k) )) - if (ccur >= climit) then ! cloudy layer - alfa = exp( -0.5*((dz1(i)+dz(i,k)))/de_lgth(i) ) - dz1(i) = dz(i,k) - cl2(i) = alfa * min(cl2(i), (1.0 - ccur)) & ! maximum part - & + (1.0 - alfa) * (cl2(i) * (1.0 - ccur)) ! random part - else ! clear layer - cl1(i) = cl1(i) * cl2(i) - cl2(i) = 1.0 - if (k /= kend) dz1(i) = -dz(i,k+kinc) - endif + ccur = min( ovcst, max( cldtot(i,k), cldcnv(i,k) )) + if (ccur >= climit) then ! cloudy layer + alfa = exp( -0.5*((dz1(i)+dz(i,k)))/de_lgth(i) ) + dz1(i) = dz(i,k) + cl2(i) = alfa * min(cl2(i), (1.0 - ccur)) & ! maximum part + + (1.0 - alfa) * (cl2(i) * (1.0 - ccur)) ! random part + else ! clear layer + cl1(i) = cl1(i) * cl2(i) + cl2(i) = 1.0 + if (k /= kend) dz1(i) = -dz(i,k+kinc) + endif enddo - + if (k == llyr) then - do i = 1, ix - clds(i,5) = 1.0 - cl1(i) * cl2(i) ! save bl cloud - enddo + do i = 1, ix + clds(i,5) = 1.0 - cl1(i) * cl2(i) ! save bl cloud + enddo endif - enddo - - do i = 1, ix + enddo + + do i = 1, ix clds(i,4) = 1.0 - cl1(i) * cl2(i) ! save total cloud - enddo - - endif ! end_if_iovr - -! --- high, mid, low clouds, where cl1, cl2 are cloud fractions -! layer processed from one layer below llyr and up -! --- change! layer processed from surface to top, so low clouds will -! contains both bl and low clouds. - -!> - Calculte high, mid, low cloud fractions and vertical indices of -!! cloud tops/bases. - if ( ivflip == 0 ) then ! input data from toa to sfc - - do i = 1, IX + enddo + + endif ! end_if_iovr + + ! --- high, mid, low clouds, where cl1, cl2 are cloud fractions + ! layer processed from one layer below llyr and up + ! --- change! layer processed from surface to top, so low clouds will + ! contains both bl and low clouds. + + !> - Calculte high, mid, low cloud fractions and vertical indices of + !! cloud tops/bases. + if ( ivflip == 0 ) then ! input data from toa to sfc + + do i = 1, IX cl1 (i) = 0.0 cl2 (i) = 0.0 kbt1(i) = NLAY @@ -416,75 +414,75 @@ subroutine gethml & mtop(i,2) = NLAY - 1 mbot(i,3) = NLAY - 1 mtop(i,3) = NLAY - 1 - enddo - -!org do k = llyr-1, 1, -1 - do k = NLAY, 1, -1 + enddo + + !org do k = llyr-1, 1, -1 + do k = NLAY, 1, -1 do i = 1, IX - id = idom(i) - id1= id + 1 - - pcur = plyr(i,k) - ccur = min( ovcst, max( cldtot(i,k), cldcnv(i,k) )) - - if (k > 1) then - pnxt = plyr(i,k-1) - cnxt = min( ovcst, max( cldtot(i,k-1), cldcnv(i,k-1) )) - else - pnxt = -1.0 - cnxt = 0.0 - endif - - if (pcur < ptop1(i,id1)) then - id = id + 1 - id1= id1 + 1 - idom(i) = id - endif - - if (ccur >= climit) then - if (kth2(i) == 0) kbt2(i) = k - kth2(i) = kth2(i) + 1 - - if ( iovr == 0 ) then - cl2(i) = cl2(i) + ccur - cl2(i)*ccur - else - cl2(i) = max( cl2(i), ccur ) - endif - - if (cnxt < climit .or. pnxt < ptop1(i,id1)) then - kbt1(i) = nint( (cl1(i)*kbt1(i) + cl2(i)*kbt2(i) ) & - & / (cl1(i) + cl2(i)) ) - kth1(i) = nint( (cl1(i)*kth1(i) + cl2(i)*kth2(i) ) & - & / (cl1(i) + cl2(i)) ) - cl1 (i) = cl1(i) + cl2(i) - cl1(i)*cl2(i) - - kbt2(i) = k - 1 - kth2(i) = 0 - cl2 (i) = 0.0 - endif ! end_if_cnxt_or_pnxt - endif ! end_if_ccur - - if (pnxt < ptop1(i,id1)) then - clds(i,id) = cl1(i) - mtop(i,id) = min( kbt1(i), kbt1(i)-kth1(i)+1 ) - mbot(i,id) = kbt1(i) - - cl1 (i) = 0.0 - kbt1(i) = k - 1 - kth1(i) = 0 - - if (id1 <= NK_CLDS) then - mbot(i,id1) = kbt1(i) - mtop(i,id1) = kbt1(i) - endif - endif ! end_if_pnxt - + id = idom(i) + id1= id + 1 + + pcur = plyr(i,k) + ccur = min( ovcst, max( cldtot(i,k), cldcnv(i,k) )) + + if (k > 1) then + pnxt = plyr(i,k-1) + cnxt = min( ovcst, max( cldtot(i,k-1), cldcnv(i,k-1) )) + else + pnxt = -1.0 + cnxt = 0.0 + endif + + if (pcur < ptop1(i,id1)) then + id = id + 1 + id1= id1 + 1 + idom(i) = id + endif + + if (ccur >= climit) then + if (kth2(i) == 0) kbt2(i) = k + kth2(i) = kth2(i) + 1 + + if ( iovr == 0 ) then + cl2(i) = cl2(i) + ccur - cl2(i)*ccur + else + cl2(i) = max( cl2(i), ccur ) + endif + + if (cnxt < climit .or. pnxt < ptop1(i,id1)) then + kbt1(i) = nint( (cl1(i)*kbt1(i) + cl2(i)*kbt2(i) ) & + / (cl1(i) + cl2(i)) ) + kth1(i) = nint( (cl1(i)*kth1(i) + cl2(i)*kth2(i) ) & + / (cl1(i) + cl2(i)) ) + cl1 (i) = cl1(i) + cl2(i) - cl1(i)*cl2(i) + + kbt2(i) = k - 1 + kth2(i) = 0 + cl2 (i) = 0.0 + endif ! end_if_cnxt_or_pnxt + endif ! end_if_ccur + + if (pnxt < ptop1(i,id1)) then + clds(i,id) = cl1(i) + mtop(i,id) = min( kbt1(i), kbt1(i)-kth1(i)+1 ) + mbot(i,id) = kbt1(i) + + cl1 (i) = 0.0 + kbt1(i) = k - 1 + kth1(i) = 0 + + if (id1 <= NK_CLDS) then + mbot(i,id1) = kbt1(i) + mtop(i,id1) = kbt1(i) + endif + endif ! end_if_pnxt + enddo ! end_do_i_loop - enddo ! end_do_k_loop - - else ! input data from sfc to toa - - do i = 1, IX + enddo ! end_do_k_loop + + else ! input data from sfc to toa + + do i = 1, IX cl1 (i) = 0.0 cl2 (i) = 0.0 kbt1(i) = 1 @@ -498,78 +496,76 @@ subroutine gethml & mtop(i,2) = 2 mbot(i,3) = 2 mtop(i,3) = 2 - enddo - -!org do k = llyr+1, NLAY - do k = 1, NLAY + enddo + + !org do k = llyr+1, NLAY + do k = 1, NLAY do i = 1, IX - id = idom(i) - id1= id + 1 - - pcur = plyr(i,k) - ccur = min( ovcst, max( cldtot(i,k), cldcnv(i,k) )) - - if (k < NLAY) then - pnxt = plyr(i,k+1) - cnxt = min( ovcst, max( cldtot(i,k+1), cldcnv(i,k+1) )) - else - pnxt = -1.0 - cnxt = 0.0 - endif - - if (pcur < ptop1(i,id1)) then - id = id + 1 - id1= id1 + 1 - idom(i) = id - endif - - if (ccur >= climit) then - if (kth2(i) == 0) kbt2(i) = k - kth2(i) = kth2(i) + 1 - - if ( iovr == 0 ) then - cl2(i) = cl2(i) + ccur - cl2(i)*ccur - else - cl2(i) = max( cl2(i), ccur ) - endif - - if (cnxt < climit .or. pnxt < ptop1(i,id1)) then - kbt1(i) = nint( (cl1(i)*kbt1(i) + cl2(i)*kbt2(i)) & - & / (cl1(i) + cl2(i)) ) - kth1(i) = nint( (cl1(i)*kth1(i) + cl2(i)*kth2(i)) & - & / (cl1(i) + cl2(i)) ) - cl1 (i) = cl1(i) + cl2(i) - cl1(i)*cl2(i) - - kbt2(i) = k + 1 - kth2(i) = 0 - cl2 (i) = 0.0 - endif ! end_if_cnxt_or_pnxt - endif ! end_if_ccur - - if (pnxt < ptop1(i,id1)) then - clds(i,id) = cl1(i) - mtop(i,id) = max( kbt1(i), kbt1(i)+kth1(i)-1 ) - mbot(i,id) = kbt1(i) - - cl1 (i) = 0.0 - kbt1(i) = min(k+1, nlay) - kth1(i) = 0 - - if (id1 <= NK_CLDS) then - mbot(i,id1) = kbt1(i) - mtop(i,id1) = kbt1(i) - endif - endif ! end_if_pnxt - + id = idom(i) + id1= id + 1 + + pcur = plyr(i,k) + ccur = min( ovcst, max( cldtot(i,k), cldcnv(i,k) )) + + if (k < NLAY) then + pnxt = plyr(i,k+1) + cnxt = min( ovcst, max( cldtot(i,k+1), cldcnv(i,k+1) )) + else + pnxt = -1.0 + cnxt = 0.0 + endif + + if (pcur < ptop1(i,id1)) then + id = id + 1 + id1= id1 + 1 + idom(i) = id + endif + + if (ccur >= climit) then + if (kth2(i) == 0) kbt2(i) = k + kth2(i) = kth2(i) + 1 + + if ( iovr == 0 ) then + cl2(i) = cl2(i) + ccur - cl2(i)*ccur + else + cl2(i) = max( cl2(i), ccur ) + endif + + if (cnxt < climit .or. pnxt < ptop1(i,id1)) then + kbt1(i) = nint( (cl1(i)*kbt1(i) + cl2(i)*kbt2(i)) & + / (cl1(i) + cl2(i)) ) + kth1(i) = nint( (cl1(i)*kth1(i) + cl2(i)*kth2(i)) & + / (cl1(i) + cl2(i)) ) + cl1 (i) = cl1(i) + cl2(i) - cl1(i)*cl2(i) + + kbt2(i) = k + 1 + kth2(i) = 0 + cl2 (i) = 0.0 + endif ! end_if_cnxt_or_pnxt + endif ! end_if_ccur + + if (pnxt < ptop1(i,id1)) then + clds(i,id) = cl1(i) + mtop(i,id) = max( kbt1(i), kbt1(i)+kth1(i)-1 ) + mbot(i,id) = kbt1(i) + + cl1 (i) = 0.0 + kbt1(i) = min(k+1, nlay) + kth1(i) = 0 + + if (id1 <= NK_CLDS) then + mbot(i,id1) = kbt1(i) + mtop(i,id1) = kbt1(i) + endif + endif ! end_if_pnxt + enddo ! end_do_i_loop - enddo ! end_do_k_loop - - endif ! end_if_ivflip - -! - return -!................................... - end subroutine gethml - - -end module GFS_cloud_diagnostics \ No newline at end of file + enddo ! end_do_k_loop + + endif ! end_if_ivflip + + ! + return + !................................... + end subroutine gethml +end module GFS_cloud_diagnostics diff --git a/physics/GFS_rrtmgp_gfdlmp_pre.F90 b/physics/GFS_rrtmgp_gfdlmp_pre.F90 index 27e541160..442975d10 100644 --- a/physics/GFS_rrtmgp_gfdlmp_pre.F90 +++ b/physics/GFS_rrtmgp_gfdlmp_pre.F90 @@ -1,20 +1,25 @@ +! ######################################################################################## +! This module contains the interface between the GFDL macrophysics and the RRTMGP radiation +! schemes. Only compatable with Model%imp_physics = Model%imp_physics_gfdl +! ######################################################################################## module GFS_rrtmgp_gfdlmp_pre use machine, only: kind_phys use GFS_typedefs, only: GFS_control_type, GFS_tbd_type use physcons, only: con_ttp, & ! Temperature at h2o 3pt (K) - con_rd, & ! Gas constant for dry air (J/KgK) - con_pi, & ! PI - con_g ! Gravity (m/s2) + con_rd, & ! Gas constant for dry air (J/KgK) + con_pi, & ! PI + con_g ! Gravity (m/s2) use physparam, only: lcnorm,lcrick + ! Parameters real(kind_phys), parameter :: & - reliq_def = 10.0, & ! Default liq radius to 10 micron - reice_def = 50.0, & ! Default ice radius to 50 micron - rrain_def = 1000.0, & ! Default rain radius to 1000 micron - rsnow_def = 250.0, & ! Default snow radius to 250 micron - epsq = 1.0e-12, & ! Tiny value - cllimit = 0.001, & ! Lowest cloud fraction in GFDL MP scheme - gfac=1.0e5/con_g ! + reliq_def = 10.0, & ! Default liq radius to 10 micron + reice_def = 50.0, & ! Default ice radius to 50 micron + rrain_def = 1000.0, & ! Default rain radius to 1000 micron + rsnow_def = 250.0, & ! Default snow radius to 250 micron + epsq = 1.0e-12, & ! Tiny value + cllimit = 0.001, & ! Lowest cloud fraction in GFDL MP scheme + gfac = 1.0e5/con_g contains ! ###################################################################################### @@ -28,9 +33,9 @@ end subroutine GFS_rrtmgp_gfdlmp_pre_init !! \htmlinclude GFS_rrtmgp_gfdlmp_pre_run.html !! subroutine GFS_rrtmgp_gfdlmp_pre_run(Model, Tbd, nCol, nLev, slmsk, lat, p_lay, p_lev, & - t_lay, tv_lay, tracer, & - cld_frac, cld_lwp, cld_reliq, cld_iwp, cld_reice, cld_swp, cld_resnow, cld_rwp, & - cld_rerain, errmsg, errflg) + t_lay, tv_lay, tracer, & + cld_frac, cld_lwp, cld_reliq, cld_iwp, cld_reice, cld_swp, cld_resnow, cld_rwp, & + cld_rerain, errmsg, errflg) implicit none ! Inputs @@ -68,7 +73,7 @@ subroutine GFS_rrtmgp_gfdlmp_pre_run(Model, Tbd, nCol, nLev, slmsk, lat, p_lay, errmsg ! Error message integer, intent(out) :: & errflg ! Error flag - + ! Local variables real(kind_phys) :: tem1, tem2, tem3, clwt real(kind_phys), dimension(nCol) :: rlat @@ -82,7 +87,7 @@ subroutine GFS_rrtmgp_gfdlmp_pre_run(Model, Tbd, nCol, nLev, slmsk, lat, p_lay, ! Initialize CCPP error handling variables errmsg = '' errflg = 0 - + ! Initialize outputs cld_lwp(:,:) = 0.0 cld_reliq(:,:) = 0.0 @@ -92,11 +97,11 @@ subroutine GFS_rrtmgp_gfdlmp_pre_run(Model, Tbd, nCol, nLev, slmsk, lat, p_lay, cld_rerain(:,:) = 0.0 cld_swp(:,:) = 0.0 cld_resnow(:,:) = 0.0 - + ! Compute layer pressure thickness (hPa) deltaP = abs(p_lev(:,2:nLev+1)-p_lev(:,1:nLev))/100. - - ! #################################################################################### + + ! #################################################################################### ! Pull out cloud information for GFDL MP scheme. ! #################################################################################### ! Cloud hydrometeors @@ -105,7 +110,7 @@ subroutine GFS_rrtmgp_gfdlmp_pre_run(Model, Tbd, nCol, nLev, slmsk, lat, p_lay, cld_condensate(1:nCol,1:nLev,1) = tracer(1:nCol,1:nLev,Model%ntcw) ! -liquid water cld_condensate(1:nCol,1:nLev,2) = tracer(1:nCol,1:nLev,Model%ntiw) ! -ice water ncndl = Model%ncnd - endif + endif if (Model%ncnd .eq. 5) then cld_condensate(1:nCol,1:nLev,1) = tracer(1:nCol,1:nLev,Model%ntcw) ! -liquid water cld_condensate(1:nCol,1:nLev,2) = tracer(1:nCol,1:nLev,Model%ntiw) ! -ice water @@ -117,18 +122,18 @@ subroutine GFS_rrtmgp_gfdlmp_pre_run(Model, Tbd, nCol, nLev, slmsk, lat, p_lay, ncndl = min(4,Model%ncnd) endif - ! Cloud-fraction + ! Cloud-fraction cld_frac(1:nCol,1:nLev) = tracer(1:nCol,1:nLev,Model%ntclamt) - - ! Set really tiny suspended particle amounts to clear + + ! Set really tiny suspended particle amounts to clear do l=1,ncndl do k=1,nLev do i=1,nCol if (cld_condensate(i,k,l) < epsq) cld_condensate(i,k,l) = 0.0 - enddo + enddo enddo enddo - + ! DJS asks. Do we need lcrick? If not replace clwf with cld_condensate(:,:,1) if ( lcrick ) then do icnd=1,ncndl @@ -138,23 +143,23 @@ subroutine GFS_rrtmgp_gfdlmp_pre_run(Model, Tbd, nCol, nLev, slmsk, lat, p_lay, enddo do k = 2, nLev-1 do i = 1, nCol - clwf(i,k,icnd) = 0.25*cld_condensate(i,k-1,icnd) + 0.5*cld_condensate(i,k,icnd) + & - 0.25*cld_condensate(i,k+1,icnd) + clwf(i,k,icnd) = 0.25*cld_condensate(i,k-1,icnd) + 0.5*cld_condensate(i,k,icnd) + & + 0.25*cld_condensate(i,k+1,icnd) enddo enddo - enddo + enddo else do icnd=1,ncndl do k = 1, nLev do i = 1, nCol clwf(i,k,icnd) = cld_condensate(i,k,icnd) enddo - enddo - enddo - endif + enddo + enddo + endif ! #################################################################################### - ! A) Compute Liquid/Ice/Rain/Snow(+groupel) cloud condensate paths + ! A) Compute Liquid/Ice/Rain/Snow(+groupel) cloud condensate paths ! #################################################################################### ! #################################################################################### @@ -163,59 +168,59 @@ subroutine GFS_rrtmgp_gfdlmp_pre_run(Model, Tbd, nCol, nLev, slmsk, lat, p_lay, ! Formerly progclduni() ! #################################################################################### if (Model%lgfdlmprad) then - ! Compute liquid/ice condensate path from mixing ratios (kg/kg)->(g/m2) - do k = 1, nLev - do i = 1, nCol - if (cld_frac(i,k) .ge. cllimit) then - tem1 = gfac * deltaP(i,k) - cld_lwp(i,k) = clwf(i,k,1) * tem1 - cld_iwp(i,k) = clwf(i,k,2) * tem1 - ! Also Rain and Snow(+groupel) if provided - if (ncndl .eq. 4) then - cld_rwp(i,k) = clwf(i,k,3) * tem1 - cld_swp(i,k) = clwf(i,k,4) * tem1 - endif - endif + ! Compute liquid/ice condensate path from mixing ratios (kg/kg)->(g/m2) + do k = 1, nLev + do i = 1, nCol + if (cld_frac(i,k) .ge. cllimit) then + tem1 = gfac * deltaP(i,k) + cld_lwp(i,k) = clwf(i,k,1) * tem1 + cld_iwp(i,k) = clwf(i,k,2) * tem1 + ! Also Rain and Snow(+groupel) if provided + if (ncndl .eq. 4) then + cld_rwp(i,k) = clwf(i,k,3) * tem1 + cld_swp(i,k) = clwf(i,k,4) * tem1 + endif + endif enddo - enddo + enddo ! #################################################################################### ! ii) This option uses only a single mixing-ratio and partitions into liquid/ice cloud ! properties by phase. ! Formerly progcld4() ! #################################################################################### else - ! Compute total-cloud suspended water. + ! Compute total-cloud suspended water. clwf(:,:,1) = sum(clwf,dim=3) - ! Compute liquid/ice condensate path (g/m2) - do k = 1, nLev - do i = 1, nCol - if (cld_frac(i,k) .ge. cllimit) then - clwt = max(0.0,clwf(i,k,1)) * gfac * deltaP(i,k) - tem2 = min( 1.0, max( 0.0, (con_ttp-t_lay(i,k))*0.05 ) ) - cld_iwp(i,k) = clwt * tem2 - cld_lwp(i,k) = clwt - cld_iwp(i,k) - endif - enddo - enddo - endif + ! Compute liquid/ice condensate path (g/m2) + do k = 1, nLev + do i = 1, nCol + if (cld_frac(i,k) .ge. cllimit) then + clwt = max(0.0,clwf(i,k,1)) * gfac * deltaP(i,k) + tem2 = min( 1.0, max( 0.0, (con_ttp-t_lay(i,k))*0.05 ) ) + cld_iwp(i,k) = clwt * tem2 + cld_lwp(i,k) = clwt - cld_iwp(i,k) + endif + enddo + enddo + endif ! #################################################################################### ! B) Particle sizes ! #################################################################################### - + ! #################################################################################### ! i) Use radii provided from the macrophysics ! #################################################################################### if (Model%effr_in) then do k=1,nLev do i=1,nCol - cld_reliq(i,k) = Tbd%phy_f3d(i,k,1) - cld_reice(i,k) = max(10.0, min(150.0,Tbd%phy_f3d(i,k,2))) - cld_rerain(i,k) = Tbd%phy_f3d(i,k,3) - cld_resnow(i,k) = Tbd%phy_f3d(i,k,4) + cld_reliq(i,k) = Tbd%phy_f3d(i,k,1) + cld_reice(i,k) = max(10.0, min(150.0,Tbd%phy_f3d(i,k,2))) + cld_rerain(i,k) = Tbd%phy_f3d(i,k,3) + cld_resnow(i,k) = Tbd%phy_f3d(i,k,4) enddo - enddo + enddo ! #################################################################################### ! ii) Start with default values. Modify liquid sizes over land. Adjust ice sizes following ! Hemsfield and McFarquhar (1996) https://doi.org/10.1175/1520-0469 @@ -226,51 +231,51 @@ subroutine GFS_rrtmgp_gfdlmp_pre_run(Model, Tbd, nCol, nLev, slmsk, lat, p_lay, cld_rerain(:,:) = rrain_def cld_resnow(:,:) = rsnow_def - ! Compute effective liquid cloud droplet radius over land. + ! Compute effective liquid cloud droplet radius over land. do i = 1, nCol - if (nint(slmsk(i)) == 1) then - do k = 1, nLev - tem2 = min( 1.0, max( 0.0, (con_ttp-t_lay(i,k))*0.05 ) ) - cld_reliq(i,k) = 5.0 + 5.0 * tem2 - enddo - endif + if (nint(slmsk(i)) == 1) then + do k = 1, nLev + tem2 = min( 1.0, max( 0.0, (con_ttp-t_lay(i,k))*0.05 ) ) + cld_reliq(i,k) = 5.0 + 5.0 * tem2 + enddo + endif enddo - + ! Compute effective ice cloud droplet radius. do k = 1, nLev do i = 1, nCol tem2 = t_lay(i,k) - con_ttp if (cld_iwp(i,k) > 0.0) then - tem3 = (con_g/con_rd)* cld_iwp(i,k) * (p_lay(i,k)/100.) / (deltaP(i,k)*tv_lay(i,k)) - if (tem2 < -50.0) then - cld_reice(i,k) = (1250.0/9.917) * tem3 ** 0.109 - elseif (tem2 < -40.0) then - cld_reice(i,k) = (1250.0/9.337) * tem3 ** 0.08 - elseif (tem2 < -30.0) then - cld_reice(i,k) = (1250.0/9.208) * tem3 ** 0.055 - else - cld_reice(i,k) = (1250.0/9.387) * tem3 ** 0.031 - endif - cld_reice(i,k) = max(10.0, min(cld_reice(i,k), 150.0)) + tem3 = (con_g/con_rd)* cld_iwp(i,k) * (p_lay(i,k)/100.) / (deltaP(i,k)*tv_lay(i,k)) + if (tem2 < -50.0) then + cld_reice(i,k) = (1250.0/9.917) * tem3 ** 0.109 + elseif (tem2 < -40.0) then + cld_reice(i,k) = (1250.0/9.337) * tem3 ** 0.08 + elseif (tem2 < -30.0) then + cld_reice(i,k) = (1250.0/9.208) * tem3 ** 0.055 + else + cld_reice(i,k) = (1250.0/9.387) * tem3 ** 0.031 + endif + cld_reice(i,k) = max(10.0, min(cld_reice(i,k), 150.0)) endif - enddo - enddo - endif + enddo + enddo + endif - ! Normalize cloud-condensate by cloud-cover? - if ( lcnorm ) then - do k = 1, nLev - do i = 1, nCol - if (cld_frac(i,k) >= cllimit) then - tem1 = 1.0 / max(0.05, cld_frac(i,k)) - cld_lwp(i,k) = cld_lwp(i,k) * tem1 - cld_iwp(i,k) = cld_iwp(i,k) * tem1 - cld_rwp(i,k) = cld_rwp(i,k) * tem1 - cld_swp(i,k) = cld_swp(i,k) * tem1 - endif - enddo - enddo - endif + ! Normalize cloud-condensate by cloud-cover? + if ( lcnorm ) then + do k = 1, nLev + do i = 1, nCol + if (cld_frac(i,k) >= cllimit) then + tem1 = 1.0 / max(0.05, cld_frac(i,k)) + cld_lwp(i,k) = cld_lwp(i,k) * tem1 + cld_iwp(i,k) = cld_iwp(i,k) * tem1 + cld_rwp(i,k) = cld_rwp(i,k) * tem1 + cld_swp(i,k) = cld_swp(i,k) * tem1 + endif + enddo + enddo + endif end subroutine GFS_rrtmgp_gfdlmp_pre_run @@ -279,4 +284,4 @@ end subroutine GFS_rrtmgp_gfdlmp_pre_run subroutine GFS_rrtmgp_gfdlmp_pre_finalize() end subroutine GFS_rrtmgp_gfdlmp_pre_finalize -end module GFS_rrtmgp_gfdlmp_pre \ No newline at end of file +end module GFS_rrtmgp_gfdlmp_pre From cfdf0bb41bedb78c1a9d2931b36d5d5acddc85f4 Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Tue, 19 May 2020 14:21:35 -0600 Subject: [PATCH 15/50] Fixed unit error in cloud-diagnostic call --- physics/GFS_cloud_diagnostics.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/physics/GFS_cloud_diagnostics.F90 b/physics/GFS_cloud_diagnostics.F90 index c77bac5ce..77e28582e 100644 --- a/physics/GFS_cloud_diagnostics.F90 +++ b/physics/GFS_cloud_diagnostics.F90 @@ -124,7 +124,7 @@ subroutine GFS_cloud_diagnostics_run(Model, nCol, nLev, lat, p_lay, tv_lay, cld_ ! layer indices for low, mid, and high clouds. The three cloud domain boundaries are ! defined by ptopc. The cloud overlapping method is defined by control flag 'iovr', which may ! be different for lw and sw radiation programs. - call gethml(p_lay, ptop1, cld_frac, cldcnv, deltaZ, de_lgth, nCol, nLev, cldsa, mtopa, mbota) + call gethml(p_lay/100., ptop1, cld_frac, cldcnv, deltaZ, de_lgth, nCol, nLev, cldsa, mtopa, mbota) end subroutine GFS_cloud_diagnostics_run From 3e74dc233912b980c040464918abab7a321eda23 Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Wed, 20 May 2020 13:49:56 -0600 Subject: [PATCH 16/50] Cleaned up optional arguments for rte routines. --- physics/rrtmgp_lw_rte.F90 | 51 +++++++++++++++++--------------------- physics/rrtmgp_lw_rte.meta | 17 ++++++------- physics/rrtmgp_sw_rte.F90 | 42 +++++++++++++++---------------- physics/rrtmgp_sw_rte.meta | 17 ++++++------- 4 files changed, 59 insertions(+), 68 deletions(-) diff --git a/physics/rrtmgp_lw_rte.F90 b/physics/rrtmgp_lw_rte.F90 index d4873799b..66a968af6 100644 --- a/physics/rrtmgp_lw_rte.F90 +++ b/physics/rrtmgp_lw_rte.F90 @@ -29,14 +29,15 @@ end subroutine rrtmgp_lw_rte_init !! \section arg_table_rrtmgp_lw_rte_run !! \htmlinclude rrtmgp_lw_rte_run.html !! - subroutine rrtmgp_lw_rte_run(doLWrad, nCol, nLev, p_lay, t_lay, p_lev, skt, lw_gas_props, & - sfc_emiss_byband, sources, lw_optical_props_clrsky, lw_optical_props_clouds, & - lw_optical_props_aerosol, nGauss_angles, fluxlwUP_allsky, fluxlwDOWN_allsky,& - fluxlwUP_clrsky, fluxlwDOWN_clrsky, hlwb, errmsg, errflg) + subroutine rrtmgp_lw_rte_run(doLWrad, doLWclrsky, nCol, nLev, p_lay, t_lay, p_lev, skt, & + lw_gas_props, sfc_emiss_byband, sources, lw_optical_props_clrsky, & + lw_optical_props_clouds, lw_optical_props_aerosol, nGauss_angles, fluxlwUP_allsky, & + fluxlwDOWN_allsky, fluxlwUP_clrsky, fluxlwDOWN_clrsky, errmsg, errflg) ! Inputs logical, intent(in) :: & - doLWrad ! Logical flag for longwave radiation call + doLWrad, & ! Logical flag for longwave radiation call + doLWclrsky ! Compute clear-sky fluxes for clear-sky heating-rate? integer, intent(in) :: & nCol, & ! Number of horizontal gridpoints nLev, & ! Number of vertical levels @@ -70,10 +71,6 @@ subroutine rrtmgp_lw_rte_run(doLWrad, nCol, nLev, p_lay, t_lay, p_lev, skt, lw_g integer, intent(out) :: & errflg ! CCPP error flag - ! Outputs (optional) - real(kind_phys), dimension(ncol,nLev,lw_gas_props%get_nband()), optional, intent(inout) :: & - hlwb ! All-sky heating rate, by band (K/sec) - ! Local variables integer :: & iCol, iBand, iLay @@ -82,7 +79,7 @@ subroutine rrtmgp_lw_rte_run(doLWrad, nCol, nLev, p_lay, t_lay, p_lev, skt, lw_g 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 logical :: & - l_AllSky_HR_byband, top_at_1 + top_at_1 ! Initialize CCPP error handling variables errmsg = '' @@ -93,9 +90,6 @@ subroutine rrtmgp_lw_rte_run(doLWrad, nCol, nLev, p_lay, t_lay, p_lev, skt, lw_g ! Vertical ordering? top_at_1 = (p_lev(1,1) .lt. p_lev(1, nLev)) - ! Are any optional outputs requested? Need to know now to compute correct fluxes. - l_AllSky_HR_byband = present(hlwb) - ! Initialize RRTMGP DDT containing 2D(3D) fluxes flux_allsky%bnd_flux_up => fluxLW_up_allsky flux_allsky%bnd_flux_dn => fluxLW_dn_allsky @@ -109,17 +103,22 @@ subroutine rrtmgp_lw_rte_run(doLWrad, nCol, nLev, p_lay, t_lay, p_lev, skt, lw_g call check_error_msg('rrtmgp_lw_rte_run',lw_optical_props_aerosol%increment(lw_optical_props_clrsky)) ! Call RTE solver - 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)) - ! Store fluxes - fluxlwUP_clrsky = sum(flux_clrsky%bnd_flux_up,dim=3) - fluxlwDOWN_clrsky = sum(flux_clrsky%bnd_flux_dn,dim=3) - + if (doLWclrsky) 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)) + ! 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 ! @@ -138,10 +137,6 @@ subroutine rrtmgp_lw_rte_run(doLWrad, nCol, nLev, p_lay, t_lay, p_lev, skt, lw_g fluxlwUP_allsky = sum(flux_allsky%bnd_flux_up,dim=3) fluxlwDOWN_allsky = sum(flux_allsky%bnd_flux_dn,dim=3) - ! Only output fluxes by-band when heating-rate profiles by band are requested. - !if (l_AllSky_HR_byband) then - !endif - end subroutine rrtmgp_lw_rte_run ! ######################################################################################### diff --git a/physics/rrtmgp_lw_rte.meta b/physics/rrtmgp_lw_rte.meta index a2350b4c2..d3876a211 100644 --- a/physics/rrtmgp_lw_rte.meta +++ b/physics/rrtmgp_lw_rte.meta @@ -9,6 +9,14 @@ type = logical intent = in optional = F +[doLWclrsky] + standard_name = flag_for_output_of_longwave_heating_rate + long_name = flag to output lw heating rate (Radtend%lwhc) + units = flag + dimensions = () + type = logical + intent = in + optional = F [ncol] standard_name = horizontal_loop_extent long_name = horizontal dimension @@ -118,15 +126,6 @@ type = ty_source_func_lw intent = in optional = F -[hlwb] - standard_name = RRTMGP_lw_heating_rate_spectral - long_name = RRTMGP longwave total sky heating rate (spectral) - units = K s-1 - dimensions = (horizontal_dimension,vertical_dimension,number_of_lw_spectral_points_rrtmgp) - type = real - kind = kind_phys - intent = in - optional = T [fluxlwUP_allsky] standard_name = RRTMGP_lw_flux_profile_upward_allsky long_name = RRTMGP upward longwave all-sky flux profile diff --git a/physics/rrtmgp_sw_rte.F90 b/physics/rrtmgp_sw_rte.F90 index 98f95a1bd..9719c6e86 100644 --- a/physics/rrtmgp_sw_rte.F90 +++ b/physics/rrtmgp_sw_rte.F90 @@ -28,15 +28,16 @@ end subroutine rrtmgp_sw_rte_init !! \section arg_table_rrtmgp_sw_rte_run !! \htmlinclude rrtmgp_sw_rte.html !! - subroutine rrtmgp_sw_rte_run(doSWrad, nCol, nLev, nDay, idxday, coszen, p_lay, t_lay, & - p_lev, sw_gas_props, sw_optical_props_clrsky, sfc_alb_nir_dir, sfc_alb_nir_dif, & + subroutine rrtmgp_sw_rte_run(doSWrad, doSWclrsky, nCol, nLev, nDay, idxday, coszen, p_lay, & + t_lay, p_lev, sw_gas_props, sw_optical_props_clrsky, sfc_alb_nir_dir, sfc_alb_nir_dif,& sfc_alb_uvvis_dir, sfc_alb_uvvis_dif, toa_src_sw, sw_optical_props_clouds, & sw_optical_props_aerosol, rrtmgp_nGases, active_gases_array, scmpsw, fluxswUP_allsky, & - fluxswDOWN_allsky, fluxswUP_clrsky, fluxswDOWN_clrsky, hswb, errmsg, errflg) + fluxswDOWN_allsky, fluxswUP_clrsky, fluxswDOWN_clrsky, errmsg, errflg) ! Inputs logical, intent(in) :: & - doSWrad ! Flag to calculate SW irradiances + doSWrad, & ! Flag to calculate SW irradiances + doSWclrsky ! Compute clear-sky fluxes? integer, intent(in) :: & nCol, & ! Number of horizontal gridpoints nday, & ! Number of daytime points @@ -69,10 +70,6 @@ subroutine rrtmgp_sw_rte_run(doSWrad, nCol, nLev, nDay, idxday, coszen, p_lay, t character(len=*),dimension(rrtmgp_nGases), intent(in) :: & active_gases_array ! Character array containing trace gases to include in RRTMGP - ! Inputs (optional) (NOTE. We only need the optional arguments to know what fluxes to output, HR's are computed later) - real(kind_phys), dimension(ncol,NLev,sw_gas_props%get_nband()), intent(inout), optional :: & - hswb ! All-sky heating rate, by band (K/sec) - ! Outputs character(len=*), intent(out) :: & errmsg ! CCPP error message @@ -103,7 +100,7 @@ subroutine rrtmgp_sw_rte_run(doSWrad, nCol, nLev, nDay, idxday, coszen, p_lay, t 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 - logical :: l_AllSky_HR_byband=.false., l_scmpsw=.false., top_at_1 + logical :: l_scmpsw=.false., top_at_1 integer :: iGas,iSFC,iTOA,iBand ! Initialize CCPP error handling variables @@ -131,7 +128,6 @@ subroutine rrtmgp_sw_rte_run(doSWrad, nCol, nLev, nDay, idxday, coszen, p_lay, t endif ! Are any optional outputs requested? Need to know now to compute correct fluxes. - l_AllSky_HR_byband = present(hswb) l_scmpsw = present(scmpsw) if ( l_scmpsw ) then scmpsw = cmpfsw_type (0., 0., 0., 0., 0., 0.) @@ -170,18 +166,20 @@ subroutine rrtmgp_sw_rte_run(doSWrad, nCol, nLev, nDay, idxday, coszen, p_lay, t 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()) - 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) - + 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 ! All-sky fluxes (clear-sky + clouds) call check_error_msg('rrtmgp_sw_rte_run',sw_optical_props_clouds%increment(sw_optical_props_clrsky)) diff --git a/physics/rrtmgp_sw_rte.meta b/physics/rrtmgp_sw_rte.meta index 629ede530..6f0be98c5 100644 --- a/physics/rrtmgp_sw_rte.meta +++ b/physics/rrtmgp_sw_rte.meta @@ -9,6 +9,14 @@ type = logical intent = in optional = F +[doSWclrsky] + standard_name = flag_for_output_of_shortwave_heating_rate + long_name = flag to output sw heating rate (Radtend%swhc) + units = flag + dimensions = () + type = logical + intent = in + optional = F [ncol] standard_name = horizontal_loop_extent long_name = horizontal dimension @@ -215,15 +223,6 @@ kind = kind_phys intent = inout optional = F -[hswb] - standard_name = RRTMGP_sw_heating_rate_spectral - long_name = shortwave total sky heating rate (spectral) - units = K s-1 - dimensions = (horizontal_dimension,vertical_dimension,number_of_sw_spectral_points_rrtmgp) - type = real - kind = kind_phys - intent = inout - optional = T [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP From 2a31351d96497e93329fa064aa1664537ab5788d Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Wed, 20 May 2020 13:53:50 -0600 Subject: [PATCH 17/50] Tidied up. Removed options not exercised. Replaced with errors. --- physics/GFS_rrtmgp_gfdlmp_pre.F90 | 257 +++++++++-------------------- physics/GFS_rrtmgp_gfdlmp_pre.meta | 43 ----- 2 files changed, 74 insertions(+), 226 deletions(-) diff --git a/physics/GFS_rrtmgp_gfdlmp_pre.F90 b/physics/GFS_rrtmgp_gfdlmp_pre.F90 index 442975d10..67b65b23c 100644 --- a/physics/GFS_rrtmgp_gfdlmp_pre.F90 +++ b/physics/GFS_rrtmgp_gfdlmp_pre.F90 @@ -10,13 +10,12 @@ module GFS_rrtmgp_gfdlmp_pre con_pi, & ! PI con_g ! Gravity (m/s2) use physparam, only: lcnorm,lcrick - + use rrtmgp_aux, only: check_error_msg + ! Parameters real(kind_phys), parameter :: & - reliq_def = 10.0, & ! Default liq radius to 10 micron - reice_def = 50.0, & ! Default ice radius to 50 micron - rrain_def = 1000.0, & ! Default rain radius to 1000 micron - rsnow_def = 250.0, & ! Default snow radius to 250 micron + reice_min = 10.0, & ! Minimum ice size allowed by scheme + reice_max = 150.0, & ! Maximum ice size allowed by scheme epsq = 1.0e-12, & ! Tiny value cllimit = 0.001, & ! Lowest cloud fraction in GFDL MP scheme gfac = 1.0e5/con_g @@ -32,8 +31,7 @@ end subroutine GFS_rrtmgp_gfdlmp_pre_init !! \section arg_table_GFS_rrtmgp_gfdlmp_pre_run !! \htmlinclude GFS_rrtmgp_gfdlmp_pre_run.html !! - subroutine GFS_rrtmgp_gfdlmp_pre_run(Model, Tbd, nCol, nLev, slmsk, lat, p_lay, p_lev, & - t_lay, tv_lay, tracer, & + subroutine GFS_rrtmgp_gfdlmp_pre_run(Model, Tbd, nCol, nLev, p_lev, tracer, & cld_frac, cld_lwp, cld_reliq, cld_iwp, cld_reice, cld_swp, cld_resnow, cld_rwp, & cld_rerain, errmsg, errflg) implicit none @@ -46,13 +44,6 @@ subroutine GFS_rrtmgp_gfdlmp_pre_run(Model, Tbd, nCol, nLev, slmsk, lat, p_lay, integer, intent(in) :: & nCol, & ! Number of horizontal grid-points nLev ! Number of vertical-layers - real(kind_phys), dimension(nCol), intent(in) :: & - slmsk, & ! Land/sea/sea-ice mask - lat ! Latitude - real(kind_phys), dimension(nCol,nLev), intent(in) :: & - p_lay, & ! Pressure at model-layer (Pa) - t_lay, & ! Temperature at model layer (K) - tv_lay ! Virtual temperature at model-layers (K) real(kind_phys), dimension(nCol,nLev+1), intent(in) :: & p_lev ! Pressure at model-level interfaces (Pa) real(kind_phys), dimension(nCol, nLev, Model%ntrac),intent(in) :: & @@ -75,12 +66,10 @@ subroutine GFS_rrtmgp_gfdlmp_pre_run(Model, Tbd, nCol, nLev, slmsk, lat, p_lay, errflg ! Error flag ! Local variables - real(kind_phys) :: tem1, tem2, tem3, clwt - real(kind_phys), dimension(nCol) :: rlat - real(kind_phys), dimension(nCol, nLev, min(4,Model%ncnd)) :: cld_condensate, clwf - integer :: i,k,l,ncndl,icnd - real(kind_phys), dimension(nCol,nLev) :: deltaP, cldcov - real(kind_phys), dimension(nCol,nLev,9) :: clouds + real(kind_phys) :: tem1 + real(kind_phys), dimension(nCol, nLev, min(4,Model%ncnd)) :: cld_condensate + integer :: i,k,l,ncndl + real(kind_phys), dimension(nCol,nLev) :: deltaP if (.not. (Model%lsswr .or. Model%lslwr)) return @@ -88,6 +77,42 @@ subroutine GFS_rrtmgp_gfdlmp_pre_run(Model, Tbd, nCol, nLev, slmsk, lat, p_lay, errmsg = '' errflg = 0 + ! Test inputs + if (Model%ncnd .ne. 5) then + errmsg = 'Incorrect number of cloud condensates provided' + errflg = 1 + call check_error_msg('GFS_rrtmgp_gfdlmp_pre_run',errmsg) + return + endif + ! + if (lcrick) then + errmsg = 'Namelist option lcrick is not supported.' + errflg = 1 + call check_error_msg('GFS_rrtmgp_gfdlmp_pre_run',errmsg) + return + endif + ! + if (lcnorm) then + errmsg = 'Namelist option lcnorm is not supported.' + errflg = 1 + call check_error_msg('GFS_rrtmgp_gfdlmp_pre_run',errmsg) + return + endif + ! + if (.not. Model%lgfdlmprad) then + errmsg = 'Namelist option gfdlmprad=F is not supported.' + errflg = 1 + call check_error_msg('GFS_rrtmgp_gfdlmp_pre_run',errmsg) + return + endif + ! + if(.not. Model%effr_in) then + errmsg = 'Namelist option effr_in=F is not supported.' + errflg = 1 + call check_error_msg('GFS_rrtmgp_gfdlmp_pre_run',errmsg) + return + endif + ! Initialize outputs cld_lwp(:,:) = 0.0 cld_reliq(:,:) = 0.0 @@ -98,33 +123,19 @@ subroutine GFS_rrtmgp_gfdlmp_pre_run(Model, Tbd, nCol, nLev, slmsk, lat, p_lay, cld_swp(:,:) = 0.0 cld_resnow(:,:) = 0.0 - ! Compute layer pressure thickness (hPa) - deltaP = abs(p_lev(:,2:nLev+1)-p_lev(:,1:nLev))/100. - ! #################################################################################### ! Pull out cloud information for GFDL MP scheme. ! #################################################################################### - ! Cloud hydrometeors - cld_condensate(:,:,:) = 0._kind_phys - if (Model%ncnd .eq. 2) then - cld_condensate(1:nCol,1:nLev,1) = tracer(1:nCol,1:nLev,Model%ntcw) ! -liquid water - cld_condensate(1:nCol,1:nLev,2) = tracer(1:nCol,1:nLev,Model%ntiw) ! -ice water - ncndl = Model%ncnd - endif - if (Model%ncnd .eq. 5) then - cld_condensate(1:nCol,1:nLev,1) = tracer(1:nCol,1:nLev,Model%ntcw) ! -liquid water - cld_condensate(1:nCol,1:nLev,2) = tracer(1:nCol,1:nLev,Model%ntiw) ! -ice water - cld_condensate(1:nCol,1:nLev,3) = tracer(1:nCol,1:nLev,Model%ntrw) ! -rain water - cld_condensate(1:nCol,1:nLev,4) = tracer(1:nCol,1:nLev,Model%ntsw) + & ! -snow + grapuel - tracer(1:nCol,1:nLev,Model%ntgl) + ! Condensate + cld_condensate(1:nCol,1:nLev,1) = tracer(1:nCol,1:nLev,Model%ntcw) ! -liquid water + cld_condensate(1:nCol,1:nLev,2) = tracer(1:nCol,1:nLev,Model%ntiw) ! -ice water + cld_condensate(1:nCol,1:nLev,3) = tracer(1:nCol,1:nLev,Model%ntrw) ! -rain water + cld_condensate(1:nCol,1:nLev,4) = tracer(1:nCol,1:nLev,Model%ntsw) + & ! -snow + grapuel + tracer(1:nCol,1:nLev,Model%ntgl) - ! Since we combine the snow and grapuel, define local variable for number of condensate types. - ncndl = min(4,Model%ncnd) - endif - - ! Cloud-fraction - cld_frac(1:nCol,1:nLev) = tracer(1:nCol,1:nLev,Model%ntclamt) - + ! Since we combine the snow and grapuel, define local variable for number of condensate types. + ncndl = min(4,Model%ncnd) + ! Set really tiny suspended particle amounts to clear do l=1,ncndl do k=1,nLev @@ -134,148 +145,28 @@ subroutine GFS_rrtmgp_gfdlmp_pre_run(Model, Tbd, nCol, nLev, slmsk, lat, p_lay, enddo enddo - ! DJS asks. Do we need lcrick? If not replace clwf with cld_condensate(:,:,1) - if ( lcrick ) then - do icnd=1,ncndl - do i = 1, nCol - clwf(i,1,icnd) = 0.75*cld_condensate(i,1,icnd) + 0.25*cld_condensate(i,2,icnd) - clwf(i,nlev,icnd) = 0.75*cld_condensate(i,nLev,icnd) + 0.25*cld_condensate(i,nLev-1,icnd) - enddo - do k = 2, nLev-1 - do i = 1, nCol - clwf(i,k,icnd) = 0.25*cld_condensate(i,k-1,icnd) + 0.5*cld_condensate(i,k,icnd) + & - 0.25*cld_condensate(i,k+1,icnd) - enddo - enddo - enddo - else - do icnd=1,ncndl - do k = 1, nLev - do i = 1, nCol - clwf(i,k,icnd) = cld_condensate(i,k,icnd) - enddo - enddo - enddo - endif - - ! #################################################################################### - ! A) Compute Liquid/Ice/Rain/Snow(+groupel) cloud condensate paths - ! #################################################################################### - - ! #################################################################################### - ! i) This option uses the mixing-ratios and effective radii for 5 cloud hydrometeor types, - ! Liquid, Ice, Rain, and Snow(+groupel), to determine cloud properties. - ! Formerly progclduni() - ! #################################################################################### - if (Model%lgfdlmprad) then - ! Compute liquid/ice condensate path from mixing ratios (kg/kg)->(g/m2) - do k = 1, nLev - do i = 1, nCol - if (cld_frac(i,k) .ge. cllimit) then - tem1 = gfac * deltaP(i,k) - cld_lwp(i,k) = clwf(i,k,1) * tem1 - cld_iwp(i,k) = clwf(i,k,2) * tem1 - ! Also Rain and Snow(+groupel) if provided - if (ncndl .eq. 4) then - cld_rwp(i,k) = clwf(i,k,3) * tem1 - cld_swp(i,k) = clwf(i,k,4) * tem1 - endif - endif - enddo - enddo - ! #################################################################################### - ! ii) This option uses only a single mixing-ratio and partitions into liquid/ice cloud - ! properties by phase. - ! Formerly progcld4() - ! #################################################################################### - else - ! Compute total-cloud suspended water. - clwf(:,:,1) = sum(clwf,dim=3) - - ! Compute liquid/ice condensate path (g/m2) - do k = 1, nLev - do i = 1, nCol - if (cld_frac(i,k) .ge. cllimit) then - clwt = max(0.0,clwf(i,k,1)) * gfac * deltaP(i,k) - tem2 = min( 1.0, max( 0.0, (con_ttp-t_lay(i,k))*0.05 ) ) - cld_iwp(i,k) = clwt * tem2 - cld_lwp(i,k) = clwt - cld_iwp(i,k) - endif - enddo - enddo - endif - - ! #################################################################################### - ! B) Particle sizes - ! #################################################################################### + ! Cloud-fraction + cld_frac(1:nCol,1:nLev) = tracer(1:nCol,1:nLev,Model%ntclamt) - ! #################################################################################### - ! i) Use radii provided from the macrophysics - ! #################################################################################### - if (Model%effr_in) then - do k=1,nLev - do i=1,nCol - cld_reliq(i,k) = Tbd%phy_f3d(i,k,1) - cld_reice(i,k) = max(10.0, min(150.0,Tbd%phy_f3d(i,k,2))) - cld_rerain(i,k) = Tbd%phy_f3d(i,k,3) - cld_resnow(i,k) = Tbd%phy_f3d(i,k,4) - enddo - enddo - ! #################################################################################### - ! ii) Start with default values. Modify liquid sizes over land. Adjust ice sizes following - ! Hemsfield and McFarquhar (1996) https://doi.org/10.1175/1520-0469 - ! #################################################################################### - else - cld_reliq(:,:) = reliq_def - cld_reice(:,:) = reice_def - cld_rerain(:,:) = rrain_def - cld_resnow(:,:) = rsnow_def - - ! Compute effective liquid cloud droplet radius over land. + ! Condensate and effective size + deltaP = abs(p_lev(:,2:nLev+1)-p_lev(:,1:nLev))/100. + do k = 1, nLev do i = 1, nCol - if (nint(slmsk(i)) == 1) then - do k = 1, nLev - tem2 = min( 1.0, max( 0.0, (con_ttp-t_lay(i,k))*0.05 ) ) - cld_reliq(i,k) = 5.0 + 5.0 * tem2 - enddo - endif - enddo - - ! Compute effective ice cloud droplet radius. - do k = 1, nLev - do i = 1, nCol - tem2 = t_lay(i,k) - con_ttp - if (cld_iwp(i,k) > 0.0) then - tem3 = (con_g/con_rd)* cld_iwp(i,k) * (p_lay(i,k)/100.) / (deltaP(i,k)*tv_lay(i,k)) - if (tem2 < -50.0) then - cld_reice(i,k) = (1250.0/9.917) * tem3 ** 0.109 - elseif (tem2 < -40.0) then - cld_reice(i,k) = (1250.0/9.337) * tem3 ** 0.08 - elseif (tem2 < -30.0) then - cld_reice(i,k) = (1250.0/9.208) * tem3 ** 0.055 - else - cld_reice(i,k) = (1250.0/9.387) * tem3 ** 0.031 - endif - cld_reice(i,k) = max(10.0, min(cld_reice(i,k), 150.0)) - endif - enddo - enddo - endif - - ! Normalize cloud-condensate by cloud-cover? - if ( lcnorm ) then - do k = 1, nLev - do i = 1, nCol - if (cld_frac(i,k) >= cllimit) then - tem1 = 1.0 / max(0.05, cld_frac(i,k)) - cld_lwp(i,k) = cld_lwp(i,k) * tem1 - cld_iwp(i,k) = cld_iwp(i,k) * tem1 - cld_rwp(i,k) = cld_rwp(i,k) * tem1 - cld_swp(i,k) = cld_swp(i,k) * tem1 - endif - enddo - enddo - endif + ! Compute liquid/ice condensate path from mixing ratios (kg/kg)->(g/m2) + if (cld_frac(i,k) .ge. cllimit) then + tem1 = gfac * deltaP(i,k) + cld_lwp(i,k) = cld_condensate(i,k,1) * tem1 + cld_iwp(i,k) = cld_condensate(i,k,2) * tem1 + cld_rwp(i,k) = cld_condensate(i,k,3) * tem1 + cld_swp(i,k) = cld_condensate(i,k,4) * tem1 + endif + ! Use radii provided from the macrophysics + cld_reliq(i,k) = Tbd%phy_f3d(i,k,1) + cld_reice(i,k) = max(reice_min, min(reice_max,Tbd%phy_f3d(i,k,2))) + cld_rerain(i,k) = Tbd%phy_f3d(i,k,3) + cld_resnow(i,k) = Tbd%phy_f3d(i,k,4) + enddo + enddo end subroutine GFS_rrtmgp_gfdlmp_pre_run diff --git a/physics/GFS_rrtmgp_gfdlmp_pre.meta b/physics/GFS_rrtmgp_gfdlmp_pre.meta index a9f61739e..77a4548f3 100644 --- a/physics/GFS_rrtmgp_gfdlmp_pre.meta +++ b/physics/GFS_rrtmgp_gfdlmp_pre.meta @@ -34,31 +34,6 @@ type = integer intent = in optional = F -[slmsk] - standard_name = sea_land_ice_mask_real - long_name = landmask: sea/land/ice=0/1/2 - units = flag - dimensions = (horizontal_dimension) - type = real - intent = in - kind = kind_phys -[lat] - standard_name = latitude - long_name = latitude - units = radians - dimensions = (horizontal_dimension) - type = real - intent = in - kind = kind_phys -[p_lay] - standard_name = air_pressure_at_layer_for_RRTMGP_in_hPa - long_name = air pressure at vertical layer for radiation calculation - units = hPa - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = in - optional = F [p_lev] standard_name = air_pressure_at_interface_for_RRTMGP_in_hPa long_name = air pressure at vertical interface for radiation calculation @@ -68,24 +43,6 @@ kind = kind_phys intent = in optional = F -[t_lay] - standard_name = air_temperature_at_layer_for_RRTMGP - long_name = air temperature at vertical layer for radiation calculation - units = K - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = in - optional = F -[tv_lay] - standard_name = virtual_temperature - long_name = layer virtual temperature - units = K - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = in - optional = F [tracer] standard_name = chemical_tracers long_name = chemical tracers From 22641512b02fffe57d2ac644c46796f4fb5acd83 Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Wed, 20 May 2020 15:14:01 -0600 Subject: [PATCH 18/50] Replaced integer control over cloud-optics scheme with logics. --- physics/rrtmgp_lw_cloud_optics.F90 | 95 ++++++++++++++--------------- physics/rrtmgp_lw_cloud_optics.meta | 60 +++++++++++++----- physics/rrtmgp_sw_cloud_optics.F90 | 84 +++++++++++++------------ physics/rrtmgp_sw_cloud_optics.meta | 56 +++++++++++++---- 4 files changed, 181 insertions(+), 114 deletions(-) diff --git a/physics/rrtmgp_lw_cloud_optics.F90 b/physics/rrtmgp_lw_cloud_optics.F90 index acff26bb6..c9601f7c8 100644 --- a/physics/rrtmgp_lw_cloud_optics.F90 +++ b/physics/rrtmgp_lw_cloud_optics.F90 @@ -20,14 +20,17 @@ module rrtmgp_lw_cloud_optics !! \section arg_table_rrtmgp_lw_cloud_optics_init !! \htmlinclude rrtmgp_lw_cloud_optics.html !! - subroutine rrtmgp_lw_cloud_optics_init(cld_optics_scheme, nrghice, rrtmgp_root_dir, & - rrtmgp_lw_file_clouds, mpicomm, mpirank, mpiroot, lw_cloud_props, errmsg, errflg) + subroutine rrtmgp_lw_cloud_optics_init(doG_cldoptics, doGP_cldoptics_PADE, doGP_cldoptics_LUT, & + nrghice, rrtmgp_root_dir, rrtmgp_lw_file_clouds, mpicomm, mpirank, mpiroot, lw_cloud_props, 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 integer, intent(in) :: & - cld_optics_scheme, & ! Cloud-optics scheme mpicomm, & ! MPI communicator mpirank, & ! Current MPI rank mpiroot ! Master MPI rank @@ -44,7 +47,6 @@ subroutine rrtmgp_lw_cloud_optics_init(cld_optics_scheme, nrghice, rrtmgp_root_d errflg ! Error code ! Variables that will be passed to cloud_optics%load() - ! cld_optics_scheme = 1 real(kind_phys) :: & radliq_lwr, & ! Liquid particle size lower bound for LUT interpolation radliq_upr, & ! Liquid particle size upper bound for LUT interpolation @@ -61,7 +63,6 @@ subroutine rrtmgp_lw_cloud_optics_init(cld_optics_scheme, nrghice, rrtmgp_root_d lut_extice, & ! LUT shortwave ice extinction coefficient lut_ssaice, & ! LUT shortwave ice single scattering albedo lut_asyice ! LUT shortwave ice asymmetry parameter - ! cld_optics_scheme = 2 real(kind_phys), dimension(:), allocatable :: & pade_sizereg_extliq, & ! Particle size regime boundaries for shortwave liquid extinction ! coefficient for Pade interpolation @@ -97,7 +98,7 @@ subroutine rrtmgp_lw_cloud_optics_init(cld_optics_scheme, nrghice, rrtmgp_root_d errmsg = '' errflg = 0 - if (cld_optics_scheme .eq. 0) 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) @@ -126,7 +127,6 @@ subroutine rrtmgp_lw_cloud_optics_init(cld_optics_scheme, nrghice, rrtmgp_root_d status = nf90_inquire_dimension(ncid, dimid, len=nBound) status = nf90_inq_dimid(ncid, 'pair', dimid) status = nf90_inquire_dimension(ncid, dimid, len=npairs) - status = nf90_close(ncid) ! Has the number of ice-roughnesses to use been provided from the namelist? ! If not provided, use default number of ice-roughness categories @@ -142,7 +142,7 @@ subroutine rrtmgp_lw_cloud_optics_init(cld_optics_scheme, nrghice, rrtmgp_root_d endif ! Allocate space for arrays - if (cld_optics_scheme .eq. 1) then + if (doGP_cldoptics_LUT) then allocate(lut_extliq(nSize_liq, nBand)) allocate(lut_ssaliq(nSize_liq, nBand)) allocate(lut_asyliq(nSize_liq, nBand)) @@ -150,7 +150,7 @@ subroutine rrtmgp_lw_cloud_optics_init(cld_optics_scheme, nrghice, rrtmgp_root_d allocate(lut_ssaice(nSize_ice, nBand, nrghice_fromfile)) allocate(lut_asyice(nSize_ice, nBand, nrghice_fromfile)) endif - if (cld_optics_scheme .eq. 2) then + if (doGP_cldoptics_PADE) then allocate(pade_extliq(nBand, nSizeReg, nCoeff_ext )) allocate(pade_ssaliq(nBand, nSizeReg, nCoeff_ssa_g)) allocate(pade_asyliq(nBand, nSizeReg, nCoeff_ssa_g)) @@ -167,7 +167,7 @@ subroutine rrtmgp_lw_cloud_optics_init(cld_optics_scheme, nrghice, rrtmgp_root_d allocate(band_lims(2,nBand)) ! Read in fields from file - if (cld_optics_scheme .eq. 1) then + if (doGP_cldoptics_LUT) then write (*,*) 'Reading RRTMGP longwave cloud data (LUT) ... ' status = nf90_inq_varid(ncid,'radliq_lwr',varID) status = nf90_get_var(ncid,varID,radliq_lwr) @@ -196,7 +196,7 @@ subroutine rrtmgp_lw_cloud_optics_init(cld_optics_scheme, nrghice, rrtmgp_root_d status = nf90_inq_varid(ncid,'bnd_limits_wavenumber',varID) status = nf90_get_var(ncid,varID,band_lims) endif - if (cld_optics_scheme .eq. 2) then + if (doGP_cldoptics_PADE) then write (*,*) 'Reading RRTMGP longwave cloud data (PADE) ... ' status = nf90_inq_varid(ncid,'radliq_lwr',varID) status = nf90_get_var(ncid,varID,radliq_lwr) @@ -243,18 +243,18 @@ subroutine rrtmgp_lw_cloud_optics_init(cld_optics_scheme, nrghice, rrtmgp_root_d ! endif ! Load tables data for RRTMGP cloud-optics - if (cld_optics_scheme .eq. 1) then - call check_error_msg('lw_cloud_optics_init',lw_cloud_props%load(band_lims, & - radliq_lwr, radliq_upr, radliq_fac, radice_lwr, radice_upr, radice_fac, & + if (doGP_cldoptics_LUT) then + call check_error_msg('lw_cloud_optics_init',lw_cloud_props%load(band_lims, & + radliq_lwr, radliq_upr, radliq_fac, radice_lwr, radice_upr, radice_fac, & lut_extliq, lut_ssaliq, lut_asyliq, lut_extice, lut_ssaice, lut_asyice)) endif - if (cld_optics_scheme .eq. 2) then - call check_error_msg('lw_cloud_optics_init', lw_cloud_props%load(band_lims, & + if (doGP_cldoptics_PADE) then + call check_error_msg('lw_cloud_optics_init', lw_cloud_props%load(band_lims, & pade_extliq, pade_ssaliq, pade_asyliq, pade_extice, pade_ssaice, pade_asyice,& pade_sizereg_extliq, pade_sizereg_ssaliq, pade_sizereg_asyliq, & pade_sizereg_extice, pade_sizereg_ssaice, pade_sizereg_asyice)) endif - call check_error_msg('lw_cloud_optics_init', lw_cloud_props%set_ice_roughness(nrghice)) + call check_error_msg('lw_cloud_optics_init',lw_cloud_props%set_ice_roughness(nrghice)) end subroutine rrtmgp_lw_cloud_optics_init @@ -264,37 +264,39 @@ end subroutine rrtmgp_lw_cloud_optics_init !! \section arg_table_rrtmgp_lw_cloud_optics_run !! \htmlinclude rrtmgp_lw_cloud_optics.html !! - subroutine rrtmgp_lw_cloud_optics_run(doLWrad, nCol, nLev, cld_optics_scheme, nrghice, & - cld_frac, cld_lwp, cld_reliq, cld_iwp, cld_reice, cld_swp, cld_resnow, cld_rwp, & - cld_rerain, p_lay, lw_cloud_props, lw_gas_props, lon, lat, & - cldtaulw, lw_optical_props_cloudsByBand, errmsg, errflg) + subroutine rrtmgp_lw_cloud_optics_run(doLWrad, doG_cldoptics, doGP_cldoptics_PADE, & + doGP_cldoptics_LUT, nCol, nLev, nrghice, cld_frac, cld_lwp, cld_reliq, cld_iwp, & + cld_reice, cld_swp, cld_resnow, cld_rwp, cld_rerain, p_lay, lw_cloud_props, & + lw_gas_props, lon, lat, cldtaulw, lw_optical_props_cloudsByBand, errmsg, errflg) ! Inputs logical, intent(in) :: & - doLWrad ! Logical flag for longwave radiation call - integer, intent(in) :: & - nCol, & ! Number of horizontal gridpoints - nLev, & ! Number of vertical levels - nrghice, & ! Number of ice-roughness categories - cld_optics_scheme ! Cloud-optics scheme + 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? + integer, intent(in) :: & + nCol, & ! Number of horizontal gridpoints + nLev, & ! Number of vertical levels + nrghice ! Number of ice-roughness categories real(kind_phys), dimension(nCol), intent(in) :: & - lon, & ! Longitude - lat ! Latitude + lon, & ! Longitude + lat ! Latitude real(kind_phys), dimension(ncol,nLev),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 (used only for RRTMG legacy scheme) - cld_resnow, & ! Cloud snow effective radius (used only for RRTMG legacy scheme) - cld_rwp, & ! Cloud rain water path (used only for RRTMG legacy scheme) - cld_rerain ! Cloud rain effective radius (used only for RRTMG legacy scheme) + 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 (used only for RRTMG legacy scheme) + cld_resnow, & ! Cloud snow effective radius (used only for RRTMG legacy scheme) + cld_rwp, & ! Cloud rain water path (used only for RRTMG legacy scheme) + cld_rerain ! Cloud rain effective radius (used only for RRTMG legacy scheme) type(ty_cloud_optics),intent(in) :: & - lw_cloud_props ! RRTMGP DDT: spectral information for RRTMGP LW radiation scheme + lw_cloud_props ! RRTMGP DDT: spectral information for RRTMGP LW radiation scheme type(ty_gas_optics_rrtmgp),intent(in) :: & - lw_gas_props ! RRTMGP DDT: spectral information for RRTMGP LW radiation scheme + lw_gas_props ! RRTMGP DDT: spectral information for RRTMGP LW radiation scheme ! Outputs real(kind_phys), dimension(ncol,nLev), intent(out) :: & @@ -330,22 +332,17 @@ subroutine rrtmgp_lw_cloud_optics_run(doLWrad, nCol, nLev, cld_optics_scheme, nr lw_optical_props_cloudsByBand%tau(:,:,:) = 0._kind_phys ! Compute cloud-optics for RTE. - if (cld_optics_scheme .gt. 0) then + if (doGP_cldoptics_PADE .or. doGP_cldoptics_LUT) then ! i) RRTMGP cloud-optics. call check_error_msg('rrtmgp_lw_cloud_optics_run',lw_cloud_props%cloud_optics(& - !ncol, & ! IN - Number of horizontal gridpoints - !nLev, & ! IN - Number of vertical layers - !lw_cloud_props%get_nband(), & ! IN - Number of LW bands - !nrghice, & ! IN - Number of ice-roughness categories - !liqmask, & ! IN - Liquid-cloud mask (1) - !icemask, & ! IN - Ice-cloud mask (1) 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 - else + endif + if (doG_cldoptics) then ! ii) RRTMG cloud-optics. if (any(cld_frac .gt. 0)) then call rrtmg_lw_cloud_optics(ncol, nLev, lw_gas_props%get_nband(), cld_lwp, & diff --git a/physics/rrtmgp_lw_cloud_optics.meta b/physics/rrtmgp_lw_cloud_optics.meta index cebbfc700..d00192f2f 100644 --- a/physics/rrtmgp_lw_cloud_optics.meta +++ b/physics/rrtmgp_lw_cloud_optics.meta @@ -1,14 +1,30 @@ [ccpp-arg-table] name = rrtmgp_lw_cloud_optics_init type = scheme -[cld_optics_scheme] - standard_name = rrtmgp_cloud_optics_flag - long_name = Flag to control which RRTMGP cloud-optics 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 = integer + dimensions = () + type = logical intent = in - optional = F + optional = F +[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 + optional = F +[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 + optional = F [nrghice] standard_name = number_of_rrtmgp_ice_roughness long_name = number of ice-roughness categories in RRTMGP calculation @@ -97,6 +113,30 @@ type = logical intent = in optional = F +[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 + optional = F +[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 + optional = F +[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 + optional = F [ncol] standard_name = horizontal_loop_extent long_name = horizontal dimension @@ -113,14 +153,6 @@ type = integer intent = in optional = F -[cld_optics_scheme] - standard_name = rrtmgp_cloud_optics_flag - long_name = Flag to control which RRTMGP cloud-optics scheme - units = flag - dimensions = () - type = integer - intent = in - optional = F [nrghice] standard_name = number_of_rrtmgp_ice_roughness long_name = number of ice-roughness categories in RRTMGP calculation diff --git a/physics/rrtmgp_sw_cloud_optics.F90 b/physics/rrtmgp_sw_cloud_optics.F90 index ec44c7f8d..1c11b95c7 100644 --- a/physics/rrtmgp_sw_cloud_optics.F90 +++ b/physics/rrtmgp_sw_cloud_optics.F90 @@ -20,14 +20,18 @@ module rrtmgp_sw_cloud_optics !! \section arg_table_rrtmgp_sw_cloud_optics_init !! \htmlinclude rrtmgp_lw_cloud_optics.html !! - subroutine rrtmgp_sw_cloud_optics_init(cld_optics_scheme, nrghice, rrtmgp_root_dir, & - rrtmgp_sw_file_clouds, mpicomm, mpirank, mpiroot, sw_cloud_props, errmsg, errflg) + 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, sw_cloud_props,& + 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 integer, intent(in) :: & - cld_optics_scheme, & ! Cloud-optics scheme mpicomm, & ! MPI communicator mpirank, & ! Current MPI rank mpiroot ! Master MPI rank @@ -44,7 +48,6 @@ subroutine rrtmgp_sw_cloud_optics_init(cld_optics_scheme, nrghice, rrtmgp_root_d errflg ! CCPP error code ! Variables that will be passed to cloud_optics%load() - ! cld_optics_scheme = 1 real(kind_phys) :: & radliq_lwr, & ! Liquid particle size lower bound for LUT interpolation radliq_upr, & ! Liquid particle size upper bound for LUT interpolation @@ -61,7 +64,6 @@ subroutine rrtmgp_sw_cloud_optics_init(cld_optics_scheme, nrghice, rrtmgp_root_d lut_extice, & ! LUT shortwave ice extinction coefficient lut_ssaice, & ! LUT shortwave ice single scattering albedo lut_asyice ! LUT shortwave ice asymmetry parameter - ! cld_optics_scheme = 2 real(kind_phys), dimension(:), allocatable :: & pade_sizereg_extliq, & ! Particle size regime boundaries for shortwave liquid extinction ! coefficient for Pade interpolation @@ -97,7 +99,7 @@ subroutine rrtmgp_sw_cloud_optics_init(cld_optics_scheme, nrghice, rrtmgp_root_d errmsg = '' errflg = 0 - if (cld_optics_scheme .eq. 0) return + if (doG_cldoptics) return ! Filenames are set in the physics_nml sw_cloud_props_file = trim(rrtmgp_root_dir)//trim(rrtmgp_sw_file_clouds) @@ -141,7 +143,7 @@ subroutine rrtmgp_sw_cloud_optics_init(cld_optics_scheme, nrghice, rrtmgp_root_d endif ! Allocate space for arrays - if (cld_optics_scheme .eq. 1) then + if (doGP_cldoptics_LUT) then allocate(lut_extliq(nSize_liq, nBand)) allocate(lut_ssaliq(nSize_liq, nBand)) allocate(lut_asyliq(nSize_liq, nBand)) @@ -149,7 +151,7 @@ subroutine rrtmgp_sw_cloud_optics_init(cld_optics_scheme, nrghice, rrtmgp_root_d allocate(lut_ssaice(nSize_ice, nBand, nrghice_fromfile)) allocate(lut_asyice(nSize_ice, nBand, nrghice_fromfile)) endif - if (cld_optics_scheme .eq. 2) then + if (doGP_cldoptics_PADE) then allocate(pade_extliq(nBand, nSizeReg, nCoeff_ext )) allocate(pade_ssaliq(nBand, nSizeReg, nCoeff_ssa_g)) allocate(pade_asyliq(nBand, nSizeReg, nCoeff_ssa_g)) @@ -166,7 +168,7 @@ subroutine rrtmgp_sw_cloud_optics_init(cld_optics_scheme, nrghice, rrtmgp_root_d allocate(band_lims(2,nBand)) ! Read in fields from file - if (cld_optics_scheme .eq. 1) then + if (doGP_cldoptics_LUT) then write (*,*) 'Reading RRTMGP shortwave cloud data (LUT) ... ' status = nf90_inq_varid(ncid,'radliq_lwr',varID) status = nf90_get_var(ncid,varID,radliq_lwr) @@ -195,7 +197,7 @@ subroutine rrtmgp_sw_cloud_optics_init(cld_optics_scheme, nrghice, rrtmgp_root_d status = nf90_inq_varid(ncid,'bnd_limits_wavenumber',varID) status = nf90_get_var(ncid,varID,band_lims) endif - if (cld_optics_scheme .eq. 2) then + if (doGP_cldoptics_PADE) then write (*,*) 'Reading RRTMGP shortwave cloud data (PADE) ... ' status = nf90_inq_varid(ncid,'radliq_lwr',varID) status = nf90_get_var(ncid,varID,radliq_lwr) @@ -242,18 +244,19 @@ subroutine rrtmgp_sw_cloud_optics_init(cld_optics_scheme, nrghice, rrtmgp_root_d ! endif ! Load tables data for RRTMGP cloud-optics - if (cld_optics_scheme .eq. 1) then + if (doGP_cldoptics_LUT) then call check_error_msg('sw_cloud_optics_init',sw_cloud_props%load(band_lims, & radliq_lwr, radliq_upr, radliq_fac, radice_lwr, radice_upr, radice_fac, & lut_extliq, lut_ssaliq, lut_asyliq, lut_extice, lut_ssaice, lut_asyice)) endif - if (cld_optics_scheme .eq. 2) then + if (doGP_cldoptics_PADE) then call check_error_msg('sw_cloud_optics_init', sw_cloud_props%load(band_lims, & pade_extliq, pade_ssaliq, pade_asyliq, pade_extice, pade_ssaice, pade_asyice,& pade_sizereg_extliq, pade_sizereg_ssaliq, pade_sizereg_asyliq, & pade_sizereg_extice, pade_sizereg_ssaice, pade_sizereg_asyice)) endif call check_error_msg('sw_cloud_optics_init',sw_cloud_props%set_ice_roughness(nrghice)) + end subroutine rrtmgp_sw_cloud_optics_init ! ######################################################################################### @@ -262,36 +265,38 @@ end subroutine rrtmgp_sw_cloud_optics_init !! \section arg_table_rrtmgp_sw_cloud_optics_run !! \htmlinclude rrtmgp_sw_cloud_optics.html !! - subroutine rrtmgp_sw_cloud_optics_run(doSWrad, nCol, nLev, nDay, idxday, nrghice, & - cld_optics_scheme, cld_frac, cld_lwp, cld_reliq, cld_iwp, cld_reice, cld_swp, & - cld_resnow, cld_rwp, cld_rerain, sw_cloud_props, sw_gas_props, & - sw_optical_props_cloudsByBand, cldtausw, errmsg, errflg) + subroutine rrtmgp_sw_cloud_optics_run(doSWrad, doG_cldoptics, doGP_cldoptics_PADE, & + doGP_cldoptics_LUT, nCol, nLev, nDay, idxday, nrghice, cld_frac, cld_lwp, cld_reliq, & + cld_iwp, cld_reice, cld_swp, cld_resnow, cld_rwp, cld_rerain, sw_cloud_props, & + sw_gas_props, sw_optical_props_cloudsByBand, cldtausw, errmsg, errflg) ! Inputs logical, intent(in) :: & - doSWrad ! Logical flag for shortwave radiation call + 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? integer, intent(in) :: & - nCol, & ! Number of horizontal gridpoints - nLev, & ! Number of vertical levels - nday, & ! Number of daylit points. - nrghice, & ! Number of ice-roughness categories - cld_optics_scheme ! Cloud-optics scheme + nCol, & ! Number of horizontal gridpoints + nLev, & ! Number of vertical levels + nday, & ! Number of daylit points. + nrghice ! Number of ice-roughness categories integer,intent(in),dimension(ncol) :: & - idxday ! Indices for daylit points. + idxday ! Indices for daylit points. real(kind_phys), dimension(ncol,nLev),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 + 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 type(ty_cloud_optics),intent(in) :: & - sw_cloud_props ! RRTMGP DDT: shortwave cloud properties + sw_cloud_props ! RRTMGP DDT: shortwave cloud properties type(ty_gas_optics_rrtmgp),intent(in) :: & - sw_gas_props ! RRTMGP DDT: shortwave K-distribution data + sw_gas_props ! RRTMGP DDT: shortwave K-distribution data ! Outputs character(len=*), intent(out) :: & @@ -328,7 +333,7 @@ subroutine rrtmgp_sw_cloud_optics_run(doSWrad, nCol, nLev, nDay, idxday, nrghice sw_optical_props_cloudsByBand%g(:,:,:) = 0._kind_phys ! Compute cloud-optics for RTE. - if (cld_optics_scheme .gt. 0) then + if (doGP_cldoptics_PADE .or. doGP_cldoptics_LUT) then ! RRTMGP cloud-optics. call check_error_msg('rrtmgp_sw_cloud_optics_run',sw_cloud_props%cloud_optics(& cld_lwp(idxday(1:nday),:), & ! IN - Cloud liquid water path @@ -337,7 +342,8 @@ subroutine rrtmgp_sw_cloud_optics_run(doSWrad, nCol, nLev, nDay, idxday, nrghice 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) - else + endif + if (doG_cldoptics) then ! RRTMG cloud-optics tau_cld(:,:,:) = 0._kind_phys ssa_cld(:,:,:) = 0._kind_phys @@ -353,9 +359,9 @@ subroutine rrtmgp_sw_cloud_optics_run(doSWrad, nCol, nLev, nDay, idxday, nrghice sw_optical_props_cloudsByBand%tau(:,:,1) = tau_cld(:,:,sw_gas_props%get_nband()) sw_optical_props_cloudsByBand%ssa(:,:,1) = ssa_cld(:,:,sw_gas_props%get_nband()) sw_optical_props_cloudsByBand%g(:,:,1) = asy_cld(:,:,sw_gas_props%get_nband()) - sw_optical_props_cloudsByBand%tau(:,:,2:sw_gas_props%get_nband()) = tau_cld(:,:,1:sw_gas_props%get_nband()-1) - sw_optical_props_cloudsByBand%ssa(:,:,2:sw_gas_props%get_nband()) = ssa_cld(:,:,1:sw_gas_props%get_nband()-1) - sw_optical_props_cloudsByBand%g(:,:,2:sw_gas_props%get_nband()) = asy_cld(:,:,1:sw_gas_props%get_nband()-1) + sw_optical_props_cloudsByBand%tau(:,:,2:sw_gas_props%get_nband()) = tau_cld(:,:,1:sw_gas_props%get_nband()-1) + sw_optical_props_cloudsByBand%ssa(:,:,2:sw_gas_props%get_nband()) = ssa_cld(:,:,1:sw_gas_props%get_nband()-1) + sw_optical_props_cloudsByBand%g(:,:,2:sw_gas_props%get_nband()) = asy_cld(:,:,1:sw_gas_props%get_nband()-1) endif ! All-sky SW optical depth ~0.55microns diff --git a/physics/rrtmgp_sw_cloud_optics.meta b/physics/rrtmgp_sw_cloud_optics.meta index c60ae90d6..cc28b0f00 100644 --- a/physics/rrtmgp_sw_cloud_optics.meta +++ b/physics/rrtmgp_sw_cloud_optics.meta @@ -1,14 +1,30 @@ [ccpp-arg-table] name = rrtmgp_sw_cloud_optics_init type = scheme -[cld_optics_scheme] - standard_name = rrtmgp_cloud_optics_flag - long_name = Flag to control which RRTMGP cloud-optics 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 = integer + dimensions = () + type = logical intent = in - optional = F + optional = F +[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 + optional = F +[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 + optional = F [nrghice] standard_name = number_of_rrtmgp_ice_roughness long_name = number of ice-roughness categories in RRTMGP calculation @@ -113,14 +129,30 @@ type = integer intent = in optional = F -[cld_optics_scheme] - standard_name = rrtmgp_cloud_optics_flag - long_name = Flag to control which RRTMGP cloud-optics 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 = integer + dimensions = () + type = logical intent = in - optional = F + optional = F +[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 + optional = F +[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 + optional = F [nrghice] standard_name = number_of_rrtmgp_ice_roughness long_name = number of ice-roughness categories in RRTMGP calculation From 1879026da7fa3aa7cb84f2e8d90ddac3a1a5fa54 Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Thu, 21 May 2020 16:22:05 -0600 Subject: [PATCH 19/50] Seperated cloud/precipitation optics. --- physics/GFS_cloud_diagnostics.F90 | 27 ++-- physics/GFS_cloud_diagnostics.meta | 11 +- physics/GFS_rrtmgp_gfdlmp_pre.F90 | 10 +- physics/GFS_rrtmgp_gfdlmp_pre.meta | 9 ++ physics/rrtmg_lw_cloud_optics.F90 | 171 ++------------------- physics/rrtmg_sw_cloud_optics.F90 | 208 +++++--------------------- physics/rrtmgp_lw_cloud_optics.F90 | 88 +++++++---- physics/rrtmgp_lw_cloud_optics.meta | 17 +++ physics/rrtmgp_lw_cloud_sampling.F90 | 108 ++++++++++--- physics/rrtmgp_lw_cloud_sampling.meta | 36 ++++- physics/rrtmgp_sw_cloud_optics.F90 | 124 ++++++++++++--- physics/rrtmgp_sw_cloud_optics.meta | 17 +++ physics/rrtmgp_sw_cloud_sampling.F90 | 125 ++++++++++++---- physics/rrtmgp_sw_cloud_sampling.meta | 36 ++++- 14 files changed, 543 insertions(+), 444 deletions(-) diff --git a/physics/GFS_cloud_diagnostics.F90 b/physics/GFS_cloud_diagnostics.F90 index 77e28582e..2d616d3dc 100644 --- a/physics/GFS_cloud_diagnostics.F90 +++ b/physics/GFS_cloud_diagnostics.F90 @@ -42,7 +42,8 @@ end subroutine GFS_cloud_diagnostics_init !! \htmlinclude GFS_cloud_diagnostics_run.html !! subroutine GFS_cloud_diagnostics_run(Model, nCol, nLev, lat, p_lay, tv_lay, cld_frac, & - p_lev, mbota, mtopa, cldsa, de_lgth, overlap_param, errmsg, errflg) + p_lev, mbota, mtopa, cldsa, de_lgth, cloud_overlap_param, precip_overlap_param, & + errmsg, errflg) implicit none ! Inputs @@ -62,18 +63,19 @@ subroutine GFS_cloud_diagnostics_run(Model, nCol, nLev, lat, p_lay, tv_lay, cld_ ! Outputs character(len=*), intent(out) :: & - errmsg ! Error message + errmsg ! Error message integer, intent(out) :: & - errflg ! Error flag + errflg ! Error flag integer,dimension(ncol,3),intent(out) :: & - mbota, & ! Vertical indices for cloud tops - mtopa ! Vertical indices for cloud bases + mbota, & ! Vertical indices for cloud tops + mtopa ! Vertical indices for cloud bases real(kind_phys), dimension(ncol,5), intent(out) :: & - cldsa ! Fraction of clouds for low, middle, high, total and BL + cldsa ! Fraction of clouds for low, middle, high, total and BL real(kind_phys), dimension(ncol), intent(out) :: & - de_lgth ! Decorrelation length + de_lgth ! Decorrelation length real(kind_phys), dimension(nCol,nLev), intent(out) :: & - overlap_param ! Cloud-overlap parameter + cloud_overlap_param, & ! Cloud-overlap parameter + precip_overlap_param ! Precipitation overlap parameter ! Local variables integer i,id,iCol,iLay,icld @@ -106,6 +108,9 @@ subroutine GFS_cloud_diagnostics_run(Model, nCol, nLev, lat, p_lay, tv_lay, cld_ enddo enddo + ! + ! Cloud overlap parameter + ! ! Estimate clouds decorrelation length in km ! *this is only a tentative test, need to consider change later* if ( iovrlw == 3 .and. iovrsw == 3) then @@ -113,13 +118,17 @@ subroutine GFS_cloud_diagnostics_run(Model, nCol, nLev, lat, p_lay, tv_lay, cld_ de_lgth(iCol) = max( 0.6, 2.78-4.6*rlat(iCol) ) do iLay=nLev,2,-1 if (de_lgth(iCol) .gt. 0) then - overlap_param(iCol,iLay-1) = & + cloud_overlap_param(iCol,iLay-1) = & exp( -0.5 * (deltaZ(iCol,iLay)+deltaZ(iCol,iLay-1)) / de_lgth(iCol) ) endif enddo enddo endif + ! + ! Precipitation overlap parameter (Hack. Using same as cloud for now) + precip_overlap_param = cloud_overlap_param + ! Compute low, mid, high, total, and boundary layer cloud fractions and clouds top/bottom ! layer indices for low, mid, and high clouds. The three cloud domain boundaries are ! defined by ptopc. The cloud overlapping method is defined by control flag 'iovr', which may diff --git a/physics/GFS_cloud_diagnostics.meta b/physics/GFS_cloud_diagnostics.meta index 8967ba386..9b4340b18 100644 --- a/physics/GFS_cloud_diagnostics.meta +++ b/physics/GFS_cloud_diagnostics.meta @@ -95,7 +95,7 @@ kind = kind_phys intent = out optional = F -[overlap_param] +[cloud_overlap_param] standard_name = cloud_overlap_param long_name = cloud overlap parameter units = km @@ -104,6 +104,15 @@ kind = kind_phys intent = out optional = F +[precip_overlap_param] + standard_name = precip_overlap_param + long_name = precipitation overlap parameter + units = km + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F [cldsa] standard_name = cloud_area_fraction_for_radiation long_name = fraction of clouds for low, middle, high, total and BL diff --git a/physics/GFS_rrtmgp_gfdlmp_pre.F90 b/physics/GFS_rrtmgp_gfdlmp_pre.F90 index 67b65b23c..0ab67baa9 100644 --- a/physics/GFS_rrtmgp_gfdlmp_pre.F90 +++ b/physics/GFS_rrtmgp_gfdlmp_pre.F90 @@ -33,7 +33,7 @@ end subroutine GFS_rrtmgp_gfdlmp_pre_init !! subroutine GFS_rrtmgp_gfdlmp_pre_run(Model, Tbd, nCol, nLev, p_lev, tracer, & cld_frac, cld_lwp, cld_reliq, cld_iwp, cld_reice, cld_swp, cld_resnow, cld_rwp, & - cld_rerain, errmsg, errflg) + cld_rerain, precip_frac, errmsg, errflg) implicit none ! Inputs @@ -59,7 +59,8 @@ subroutine GFS_rrtmgp_gfdlmp_pre_run(Model, Tbd, nCol, nLev, p_lev, tracer, cld_swp, & ! Cloud snow water path cld_resnow, & ! Cloud snow effective radius cld_rwp, & ! Cloud rain water path - cld_rerain ! Cloud rain effective radius + cld_rerain, & ! Cloud rain effective radius + precip_frac ! Precipitation fraction character(len=*), intent(out) :: & errmsg ! Error message integer, intent(out) :: & @@ -146,7 +147,10 @@ subroutine GFS_rrtmgp_gfdlmp_pre_run(Model, Tbd, nCol, nLev, p_lev, tracer, enddo ! Cloud-fraction - cld_frac(1:nCol,1:nLev) = tracer(1:nCol,1:nLev,Model%ntclamt) + cld_frac(1:nCol,1:nLev) = tracer(1:nCol,1:nLev,Model%ntclamt) + + ! Precipitation fraction (Hack. For now use cloud-fraction) + precip_frac(1:nCol,1:nLev) = tracer(1:nCol,1:nLev,Model%ntclamt) ! Condensate and effective size deltaP = abs(p_lev(:,2:nLev+1)-p_lev(:,1:nLev))/100. diff --git a/physics/GFS_rrtmgp_gfdlmp_pre.meta b/physics/GFS_rrtmgp_gfdlmp_pre.meta index 77a4548f3..248348b9b 100644 --- a/physics/GFS_rrtmgp_gfdlmp_pre.meta +++ b/physics/GFS_rrtmgp_gfdlmp_pre.meta @@ -133,6 +133,15 @@ kind = kind_phys intent = out optional = F +[precip_frac] + standard_name = precipitation_fraction_by_layer + long_name = precipitation fraction in each layer + units = frac + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/rrtmg_lw_cloud_optics.F90 b/physics/rrtmg_lw_cloud_optics.F90 index 31551d797..ea0a703c7 100644 --- a/physics/rrtmg_lw_cloud_optics.F90 +++ b/physics/rrtmg_lw_cloud_optics.F90 @@ -554,7 +554,8 @@ module mo_rrtmg_lw_cloud_optics ! subroutine rrtmg_lw_cloud_optics ! ####################################################################################### subroutine rrtmg_lw_cloud_optics(ncol, nlay, nBandsLW, cld_lwp, cld_ref_liq, cld_iwp, & - cld_ref_ice, cld_rwp, cld_ref_rain, cld_swp, cld_ref_snow, cld_frac, tau_cld) + cld_ref_ice, cld_rwp, cld_ref_rain, cld_swp, cld_ref_snow, cld_frac, tau_cld, & + tau_precip) ! Inputs integer,intent(in) :: & nBandsLW, & ! Number of spectral bands @@ -573,14 +574,16 @@ subroutine rrtmg_lw_cloud_optics(ncol, nlay, nBandsLW, cld_lwp, cld_ref_liq, cld ! Outputs real(kind_phys),dimension(ncol,nlay,nBandsLW),intent(out) :: & - tau_cld - + tau_cld, & ! Cloud optical-depth (1) + tau_precip ! Precipitation optical-depth (1) + ! Local variables integer :: ij,ik,ib,index,ia real(kind_phys) :: factor,fint,cld_ref_iceTemp,tau_snow, tau_rain real(kind_phys),dimension(nBandsLW) :: tau_liq, tau_ice - tau_cld(:,:,:) = 0._kind_phys + tau_cld(:,:,:) = 0._kind_phys + tau_precip(:,:,:) = 0._kind_phys if (ilwcliq .gt. 0) then do ij=1,ncol @@ -655,167 +658,11 @@ subroutine rrtmg_lw_cloud_optics(ncol, nlay, nBandsLW, cld_lwp, cld_ref_liq, cld endif ! Cloud optical depth do ib = 1, nBandsLW - tau_cld(ij,ik,ib) = tau_ice(ib) + tau_liq(ib) + tau_rain + tau_snow + tau_cld(ij,ik,ib) = tau_ice(ib) + tau_liq(ib) + tau_precip(ij,ik,ib) = tau_rain + tau_snow enddo end do end do endif end subroutine rrtmg_lw_cloud_optics - ! ####################################################################################### - ! SUBROUTINE mcica_subcol_lw - ! ####################################################################################### - subroutine mcica_subcol_lw(ncol, nlay, ngpts, cld_frac, icseed, dzlyr, de_lgth, cld_frac_mcica) - ! Inputs - integer,intent(in) :: & - ncol, & ! Number of horizontal gridpoints - nlay, & ! Number of vertical layers - ngpts ! Number of spectral g-points - integer,dimension(ncol),intent(in) :: & - icseed ! Permutation seed for each column. - real(kind_phys), dimension(ncol), intent(in) :: & - de_lgth ! Cloud decorrelation length (km) - real(kind_phys), dimension(ncol,nlay), intent(in) :: & - cld_frac, & ! Cloud-fraction - dzlyr ! Layer thinkness (km) - ! Outputs - !real(kind_phys),dimension(ncol,nlay,ngpts),intent(out) :: & - logical,dimension(ncol,nlay,ngpts),intent(out) :: & - cld_frac_mcica - ! Local variables - type(random_stat) :: stat - integer :: icol,n,k,k1 - real(kind_phys) :: tem1 - real(kind_phys),dimension(ngpts) :: rand1D - real(kind_phys),dimension(nlay*ngpts) :: rand2D - real(kind_phys),dimension(ngpts,nlay) :: cdfunc,cdfun2 - real(kind_phys),dimension(nlay) :: fac_lcf - logical,dimension(ngpts,nlay) :: lcloudy - - ! Loop over all columns - do icol=1,ncol - ! Call random_setseed() to advance random number generator by "icseed" values. - call random_setseed(icseed(icol),stat) - - ! ################################################################################### - ! Sub-column set up according to overlapping assumption: - ! - For random overlap, pick a random value at every level - ! - For max-random overlap, pick a random value at every level - ! - For maximum overlap, pick same random numebr at every level - ! ################################################################################### - select case ( iovrlw ) - ! ################################################################################### - ! 0) Random overlap - ! ################################################################################### - case( 0 ) - call random_number(rand2D,stat) - k1 = 0 - do n = 1, ngpts - do k = 1, nlay - k1 = k1 + 1 - cdfunc(n,k) = rand2d(k1) - enddo - enddo - - ! ################################################################################### - ! 1) Maximum-random overlap - ! ################################################################################### - case(1) - call random_number(rand2D,stat) - k1 = 0 - do n = 1, ngpts - do k = 1, nlay - k1 = k1 + 1 - cdfunc(n,k) = rand2d(k1) - enddo - enddo - - ! First pick a random number for bottom (or top) layer. - ! then walk up the column: (aer's code) - ! if layer below is cloudy, use the same rand num in the layer below - ! if layer below is clear, use a new random number - do k = 2, nlay - k1 = k - 1 - tem1 = 1._kind_phys - cld_frac(icol,k1) - do n = 1, ngpts - if ( cdfunc(n,k1) > tem1 ) then - cdfunc(n,k) = cdfunc(n,k1) - else - cdfunc(n,k) = cdfunc(n,k) * tem1 - endif - enddo - enddo - - ! ################################################################################### - ! 2) Maximum overlap - ! ################################################################################### - case(2) - call random_number(rand1d,stat) - do n = 1, ngpts - tem1 = rand1d(n) - do k = 1, nlay - cdfunc(n,k) = tem1 - enddo - enddo - - ! ################################################################################### - ! 3) Decorrelation length - ! ################################################################################### - case(3) - ! Compute overlapping factors based on layer midpoint distances and decorrelation - ! depths - do k = nlay, 2, -1 - fac_lcf(k) = exp( -0.5 * (dzlyr(iCol,k)+dzlyr(iCol,k-1)) / de_lgth(iCol) ) - enddo - - ! Setup 2 sets of random numbers - call random_number ( rand2d, stat ) - k1 = 0 - do k = 1, nlay - do n = 1, ngpts - k1 = k1 + 1 - cdfunc(n,k) = rand2d(k1) - enddo - enddo - ! - call random_number ( rand2d, stat ) - k1 = 0 - do k = 1, nlay - do n = 1, ngpts - k1 = k1 + 1 - cdfun2(n,k) = rand2d(k1) - enddo - enddo - - ! Then working from the top down: - ! if a random number (from an independent set -cdfun2) is smaller then the - ! scale factor: use the upper layer's number, otherwise use a new random - ! number (keep the original assigned one). - do k = nlay-1, 1, -1 - k1 = k + 1 - do n = 1, ngpts - if ( cdfun2(n,k) <= fac_lcf(k1) ) then - cdfunc(n,k) = cdfunc(n,k1) - endif - enddo - enddo - - end select - - ! ################################################################################### - ! Generate subcolumn cloud mask (.false./.true. for clear/cloudy) - ! ################################################################################### - do k = 1, nlay - tem1 = 1._kind_phys - cld_frac(icol,k) - do n = 1, ngpts - lcloudy(n,k) = cdfunc(n,k) >= tem1 - if (lcloudy(n,k)) then - cld_frac_mcica(icol,k,n) = .true. - else - cld_frac_mcica(icol,k,n) = .false. - endif - enddo - enddo - enddo ! END LOOP OVER COLUMNS - end subroutine mcica_subcol_lw - end module mo_rrtmg_lw_cloud_optics diff --git a/physics/rrtmg_sw_cloud_optics.F90 b/physics/rrtmg_sw_cloud_optics.F90 index f576033d5..37b4e094c 100644 --- a/physics/rrtmg_sw_cloud_optics.F90 +++ b/physics/rrtmg_sw_cloud_optics.F90 @@ -2043,9 +2043,9 @@ module mo_rrtmg_sw_cloud_optics ! ######################################################################################### ! rrtmg_sw_cloud_optics ! ######################################################################################### - subroutine rrtmg_sw_cloud_optics(ncol, nlay, nBandsSW, cld_lwp, cld_ref_liq, cld_iwp, & - cld_ref_ice, cld_rwp, cld_ref_rain, cld_swp, cld_ref_snow, cld_frac, & - tau_cld, ssa_cld, asy_cld) + subroutine rrtmg_sw_cloud_optics(ncol, nlay, nBandsSW, cld_lwp, cld_ref_liq, cld_iwp, & + cld_ref_ice, cld_rwp, cld_ref_rain, cld_swp, cld_ref_snow, cld_frac, & + tau_cld, ssa_cld, asy_cld, tau_precip, ssa_precip, asy_precip) ! Inputs integer,intent(in) :: & nBandsSW, & ! Number of spectral bands @@ -2066,7 +2066,10 @@ subroutine rrtmg_sw_cloud_optics(ncol, nlay, nBandsSW, cld_lwp, cld_ref_liq, cld real(kind_phys),dimension(ncol,nlay,nBandsSW),intent(out) :: & tau_cld, & ! In-cloud optical depth (1) ssa_cld, & ! In-cloud single-scattering albedo (1) - asy_cld ! In-cloud asymmetry parameter (1) + asy_cld, & ! In-cloud asymmetry parameter (1) + tau_precip, & ! Precipitation optical depth (1) + ssa_precip, & ! Precipitation single-scattering albedo (1) + asy_precip ! Precipitation asymmetry parameter (1) ! Local variables integer :: iCol, iLay, iBand, index, ia @@ -2077,11 +2080,14 @@ subroutine rrtmg_sw_cloud_optics(ncol, nlay, nBandsSW, cld_lwp, cld_ref_liq, cld forwice, extcoice, asycoice, ssacoice, fdelta, extcoliq, ssacoliq ! Initialize - tau_cld(:,:,:) = 0._kind_phys - ssa_cld(:,:,:) = 1._kind_phys - asy_cld(:,:,:) = 0._kind_phys + tau_cld(:,:,:) = 0._kind_phys + ssa_cld(:,:,:) = 1._kind_phys + asy_cld(:,:,:) = 0._kind_phys + tau_precip(:,:,:) = 0._kind_phys + ssa_precip(:,:,:) = 1._kind_phys + asy_precip(:,:,:) = 0._kind_phys - ! Compute cloud radiative properties for cloud. + ! Compute cloud/precipitation radiative properties if (iswcliq > 0) then do iCol=1,ncol do iLay=1,nlay @@ -2229,15 +2235,18 @@ subroutine rrtmg_sw_cloud_optics(ncol, nlay, nBandsSW, cld_lwp, cld_ref_liq, cld endif ! IF cloudy column ! ########################################################################### - ! Compute total cloud radiative properties (tau, omega, and g) + ! Compute total cloud and precipitation radiative properties (tau, omega, and g) ! ########################################################################### if (cld_frac(iCol,iLay) .gt. 1.e-12_kind_phys) then do iBand = 1,nBandsSW + ! + ! Cloud optics + ! ! Sum up radiative properties by type. - tau_cld(iCol,iLay,iBand) = max(1.e-12_kind_phys, tau_liq(iBand) + tau_ice(iBand) + tau_rain + tau_snow) - ssa_cld(iCol,iLay,iBand) = max(1.e-12_kind_phys, ssa_liq(iBand) + ssa_ice(iBand) + ssa_rain(iBand) + ssa_snow(iBand)) - asy_cld(iCol,iLay,iBand) = max(1.e-12_kind_phys, asy_liq(iBand) + asy_ice(iBand) + asy_rain(iBand) + asy_snow(iBand)) - ! Delta-scale + tau_cld(iCol,iLay,iBand) = max(1.e-12_kind_phys, tau_liq(iBand) + tau_ice(iBand)) + ssa_cld(iCol,iLay,iBand) = max(1.e-12_kind_phys, ssa_liq(iBand) + ssa_ice(iBand)) + asy_cld(iCol,iLay,iBand) = max(1.e-12_kind_phys, asy_liq(iBand) + asy_ice(iBand)) + ! Combine asyw = asy_cld(iCol,iLay,iBand)/max(1.e-12_kind_phys, ssa_cld(iCol,iLay,iBand)) ssaw = min(1._kind_phys-0.000001, ssa_cld(iCol,iLay,iBand)/tau_cld(iCol,iLay,iBand)) za1 = asyw * asyw @@ -2245,6 +2254,22 @@ subroutine rrtmg_sw_cloud_optics(ncol, nlay, nBandsSW, cld_lwp, cld_ref_liq, cld tau_cld(iCol,iLay,iBand) = (1._kind_phys - za2) * tau_cld(iCol,iLay,iBand) ssa_cld(iCol,iLay,iBand) = (ssaw - za2) / (1._kind_phys - za2) asy_cld(iCol,iLay,iBand) = asyw/(1+asyw) + ! + ! Precipitation optics + ! + ! Sum up radiative properties by type. + tau_precip(iCol,iLay,iBand) = max(1.e-12_kind_phys, tau_rain + tau_snow) + ssa_precip(iCol,iLay,iBand) = max(1.e-12_kind_phys, ssa_rain(iBand) + ssa_snow(iBand)) + asy_precip(iCol,iLay,iBand) = max(1.e-12_kind_phys, asy_rain(iBand) + asy_snow(iBand)) + ! Combine + asyw = asy_precip(iCol,iLay,iBand)/max(1.e-12_kind_phys, ssa_precip(iCol,iLay,iBand)) + ssaw = min(1._kind_phys-0.000001, ssa_precip(iCol,iLay,iBand)/tau_precip(iCol,iLay,iBand)) + za1 = asyw * asyw + za2 = ssaw * za1 + tau_precip(iCol,iLay,iBand) = (1._kind_phys - za2) * tau_precip(iCol,iLay,iBand) + ssa_precip(iCol,iLay,iBand) = (ssaw - za2) / (1._kind_phys - za2) + asy_precip(iCol,iLay,iBand) = asyw/(1+asyw) + enddo ! Loop over SW bands endif ! END sum cloudy properties ! @@ -2252,161 +2277,4 @@ subroutine rrtmg_sw_cloud_optics(ncol, nlay, nBandsSW, cld_lwp, cld_ref_liq, cld enddo ! Loop over columns endif end subroutine rrtmg_sw_cloud_optics - - ! ####################################################################################### - ! SUBROUTINE mcica_subcol_sw - ! ###################################################################################### - subroutine mcica_subcol_sw(ncol, nlay, ngpts, cld_frac, icseed, dzlyr, de_lgth, & - cld_frac_mcica) - ! Inputs - integer,intent(in) :: & - ncol, & ! Number of horizontal gridpoints - nlay, & ! Number of vertical layers - ngpts ! Number of spectral g-points - integer,dimension(ncol),intent(in) :: & - icseed ! Permutation seed for each column. - real(kind_phys), dimension(ncol), intent(in) :: & - de_lgth ! Cloud decorrelation length (km) - real(kind_phys), dimension(ncol,nlay), intent(in) :: & - cld_frac, & ! Cloud-fraction - dzlyr ! Layer thinkness (km) - ! Outputs - logical,dimension(ncol,nlay,ngpts),intent(out) :: & - cld_frac_mcica - ! Local variables - type(random_stat) :: stat - integer :: icol,n,k,k1 - real(kind_phys) :: tem1 - real(kind_phys),dimension(ngpts) :: rand1D - real(kind_phys),dimension(nlay*ngpts) :: rand2D - real(kind_phys),dimension(ngpts,nlay) :: cdfunc,cdfun2 - real(kind_phys),dimension(nlay) :: fac_lcf - logical,dimension(ngpts,nlay) :: lcloudy - - ! Loop over all columns - do icol=1,ncol - ! Call random_setseed() to advance random number generator by "icseed" values. - call random_setseed(icseed(icol),stat) - - ! ################################################################################### - ! Sub-column set up according to overlapping assumption: - ! - For random overlap, pick a random value at every level - ! - For max-random overlap, pick a random value at every level - ! - For maximum overlap, pick same random numebr at every level - ! ################################################################################### - select case ( iovrsw ) - ! ################################################################################### - ! 0) Random overlap - ! ################################################################################### - case( 0 ) - call random_number(rand2D,stat) - k1 = 0 - do n = 1, ngpts - do k = 1, nlay - k1 = k1 + 1 - cdfunc(n,k) = rand2d(k1) - enddo - enddo - - ! ################################################################################### - ! 1) Maximum-random overlap - ! ################################################################################### - case(1) - call random_number(rand2D,stat) - k1 = 0 - do n = 1, ngpts - do k = 1, nlay - k1 = k1 + 1 - cdfunc(n,k) = rand2d(k1) - enddo - enddo - - ! First pick a random number for bottom (or top) layer. - ! then walk up the column: (aer's code) - ! if layer below is cloudy, use the same rand num in the layer below - ! if layer below is clear, use a new random number - do k = 2, nlay - k1 = k - 1 - tem1 = 1._kind_phys - cld_frac(icol,k1) - do n = 1, ngpts - if ( cdfunc(n,k1) > tem1 ) then - cdfunc(n,k) = cdfunc(n,k1) - else - cdfunc(n,k) = cdfunc(n,k) * tem1 - endif - enddo - enddo - - ! ################################################################################### - ! 2) Maximum overlap - ! ################################################################################### - case(2) - call random_number(rand1d,stat) - do n = 1, ngpts - tem1 = rand1d(n) - do k = 1, nlay - cdfunc(n,k) = tem1 - enddo - enddo - - ! ################################################################################### - ! 3) Decorrelation length - ! ################################################################################### - case(3) - ! Compute overlapping factors based on layer midpoint distances and decorrelation - ! depths - do k = nlay, 2, -1 - fac_lcf(k) = exp( -0.5 * (dzlyr(iCol,k)+dzlyr(iCol,k-1)) / de_lgth(iCol) ) - enddo - - ! Setup 2 sets of random numbers - call random_number ( rand2d, stat ) - k1 = 0 - do k = 1, nlay - do n = 1, ngpts - k1 = k1 + 1 - cdfunc(n,k) = rand2d(k1) - enddo - enddo - ! - call random_number ( rand2d, stat ) - k1 = 0 - do k = 1, nlay - do n = 1, ngpts - k1 = k1 + 1 - cdfun2(n,k) = rand2d(k1) - enddo - enddo - - ! Then working from the top down: - ! if a random number (from an independent set -cdfun2) is smaller then the - ! scale factor: use the upper layer's number, otherwise use a new random - ! number (keep the original assigned one). - do k = nlay-1, 1, -1 - k1 = k + 1 - do n = 1, ngpts - if ( cdfun2(n,k) <= fac_lcf(k1) ) then - cdfunc(n,k) = cdfunc(n,k1) - endif - enddo - enddo - - end select - - ! ################################################################################### - ! Generate subcolumn cloud mask (0/1 for clear/cloudy) - ! ################################################################################### - do k = 1, nlay - tem1 = 1._kind_phys - cld_frac(icol,k) - do n = 1, ngpts - lcloudy(n,k) = cdfunc(n,k) >= tem1 - if (lcloudy(n,k)) then - cld_frac_mcica(icol,k,n) = .true. - else - cld_frac_mcica(icol,k,n) = .false. - endif - enddo - enddo - enddo ! END LOOP OVER COLUMNS - end subroutine mcica_subcol_sw end module mo_rrtmg_sw_cloud_optics diff --git a/physics/rrtmgp_lw_cloud_optics.F90 b/physics/rrtmgp_lw_cloud_optics.F90 index c9601f7c8..aee4533a0 100644 --- a/physics/rrtmgp_lw_cloud_optics.F90 +++ b/physics/rrtmgp_lw_cloud_optics.F90 @@ -12,6 +12,12 @@ module rrtmgp_lw_cloud_optics public rrtmgp_lw_cloud_optics_init, rrtmgp_lw_cloud_optics_run, rrtmgp_lw_cloud_optics_finalize + ! Parameters used for rain and snow(+groupel) RRTMGP cloud-optics + real(kind_phys), parameter :: & + absrain = 0.33e-3, & ! Rain drop absorption coefficient \f$(m^{2}/g)\f$ . + abssnow0 = 1.5, & ! Snow flake absorption coefficient (micron), fu coeff + abssnow1 = 2.34e-3 ! Snow flake absorption coefficient \f$(m^{2}/g)\f$, ncar coef + contains ! ######################################################################################### @@ -29,7 +35,7 @@ subroutine rrtmgp_lw_cloud_optics_init(doG_cldoptics, doGP_cldoptics_PADE, doGP_ 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 @@ -265,9 +271,10 @@ end subroutine rrtmgp_lw_cloud_optics_init !! \htmlinclude rrtmgp_lw_cloud_optics.html !! subroutine rrtmgp_lw_cloud_optics_run(doLWrad, doG_cldoptics, doGP_cldoptics_PADE, & - doGP_cldoptics_LUT, nCol, nLev, nrghice, cld_frac, cld_lwp, cld_reliq, cld_iwp, & - cld_reice, cld_swp, cld_resnow, cld_rwp, cld_rerain, p_lay, lw_cloud_props, & - lw_gas_props, lon, lat, cldtaulw, lw_optical_props_cloudsByBand, errmsg, errflg) + doGP_cldoptics_LUT, nCol, nLev, nrghice, p_lay, cld_frac, cld_lwp, cld_reliq, & + cld_iwp, cld_reice, cld_swp, cld_resnow, cld_rwp, cld_rerain, precip_frac, & + lw_cloud_props, lw_gas_props, lon, lat, cldtaulw, lw_optical_props_cloudsByBand, & + lw_optical_props_precipByBand, errmsg, errflg) ! Inputs logical, intent(in) :: & @@ -289,48 +296,53 @@ subroutine rrtmgp_lw_cloud_optics_run(doLWrad, doG_cldoptics, doGP_cldoptics_PAD cld_reliq, & ! Cloud liquid effective radius cld_iwp, & ! Cloud ice water path cld_reice, & ! Cloud ice effective radius - cld_swp, & ! Cloud snow water path (used only for RRTMG legacy scheme) - cld_resnow, & ! Cloud snow effective radius (used only for RRTMG legacy scheme) - cld_rwp, & ! Cloud rain water path (used only for RRTMG legacy scheme) - cld_rerain ! Cloud rain effective radius (used only for RRTMG legacy scheme) + 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. type(ty_cloud_optics),intent(in) :: & lw_cloud_props ! RRTMGP DDT: spectral information for RRTMGP LW radiation scheme type(ty_gas_optics_rrtmgp),intent(in) :: & lw_gas_props ! RRTMGP DDT: spectral information for RRTMGP LW radiation scheme ! Outputs - real(kind_phys), dimension(ncol,nLev), intent(out) :: & - cldtaulw ! Approx. 10.mu band layer cloud optical depth - type(ty_optical_props_1scl),intent(out) :: & - lw_optical_props_cloudsByBand ! RRTMGP DDT: longwave cloud optical properties in each band - integer, intent(out) :: & - errflg ! CCPP error flag character(len=*), intent(out) :: & - errmsg ! CCPP error message - + errmsg ! CCPP error message + integer, intent(out) :: & + errflg ! CCPP error flag + type(ty_optical_props_1scl),intent(out) :: & + lw_optical_props_cloudsByBand, & ! RRTMGP DDT: Longwave optical properties in each band (clouds) + lw_optical_props_precipByBand ! RRTMGP DDT: Longwave optical properties in each band (precipitation) + real(kind_phys), dimension(ncol,nLev), intent(out) :: & + cldtaulw ! Approx 10.mu band layer cloud optical depth + ! Local variables - logical,dimension(ncol,nLev) :: liqmask, icemask + real(kind_phys) :: tau_rain, tau_snow real(kind_phys), dimension(ncol,nLev,lw_gas_props%get_nband()) :: & - tau_cld - integer :: iCol, iLay + tau_cld, tau_precip + integer :: iCol, iLay, iBand ! Initialize CCPP error handling variables errmsg = '' errflg = 0 - tau_cld = 0. + + ! Initialize locals + tau_cld = 0._kind_phys + tau_precip = 0._kind_phys if (.not. doLWrad) return - - ! Compute ice/liquid cloud masks, needed by rrtmgp_cloud_optics - liqmask = (cld_frac .gt. 0 .and. cld_lwp .gt. 0) - icemask = (cld_frac .gt. 0 .and. cld_iwp .gt. 0) - ! Allocate space for RRTMGP DDTs containing cloud radiative properties + ! Allocate space for RRTMGP DDTs containing cloud radiative properties ! Cloud optics [nCol,nLev,nBands] call check_error_msg('rrtmgp_lw_cloud_optics_run',lw_optical_props_cloudsByBand%alloc_1scl(& ncol, nLev, lw_gas_props%get_band_lims_wavenumber())) - lw_optical_props_cloudsByBand%tau(:,:,:) = 0._kind_phys - + lw_optical_props_cloudsByBand%tau(:,:,:) = 0._kind_phys + ! Precipitation optics [nCol,nLev,nBands] + call check_error_msg('rrtmgp_lw_cloud_optics_run',lw_optical_props_precipByBand%alloc_1scl(& + ncol, nLev, lw_gas_props%get_band_lims_wavenumber())) + lw_optical_props_precipByBand%tau(:,:,:) = 0._kind_phys + ! Compute cloud-optics for RTE. if (doGP_cldoptics_PADE .or. doGP_cldoptics_LUT) then ! i) RRTMGP cloud-optics. @@ -341,15 +353,35 @@ subroutine rrtmgp_lw_cloud_optics_run(doLWrad, doG_cldoptics, doGP_cldoptics_PAD cld_reice, & ! IN - Cloud ice effective radius (microns) lw_optical_props_cloudsByBand)) ! OUT - RRTMGP DDT containing cloud radiative properties ! in each band + ! Add in rain and snow(+groupel) + 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,lw_gas_props%get_nband() + lw_optical_props_precipByBand%tau(iCol,iLay,iBand) = tau_rain + tau_snow + enddo + endif + enddo + enddo endif if (doG_cldoptics) then ! ii) RRTMG cloud-optics. if (any(cld_frac .gt. 0)) then call rrtmg_lw_cloud_optics(ncol, nLev, lw_gas_props%get_nband(), cld_lwp, & cld_reliq, cld_iwp, cld_reice, cld_rwp, cld_rerain, cld_swp, cld_resnow, & - cld_frac, tau_cld) + cld_frac, tau_cld, tau_precip) endif lw_optical_props_cloudsByBand%tau = tau_cld + lw_optical_props_precipByBand%tau = tau_precip endif ! All-sky LW optical depth ~10microns diff --git a/physics/rrtmgp_lw_cloud_optics.meta b/physics/rrtmgp_lw_cloud_optics.meta index d00192f2f..649b964e3 100644 --- a/physics/rrtmgp_lw_cloud_optics.meta +++ b/physics/rrtmgp_lw_cloud_optics.meta @@ -233,6 +233,15 @@ 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_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F [p_lay] standard_name = air_pressure_at_layer_for_RRTMGP_in_hPa long_name = air pressure layer @@ -293,6 +302,14 @@ type = ty_optical_props_1scl intent = out optional = F +[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_1scl + intent = out + optional = F [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/rrtmgp_lw_cloud_sampling.F90 b/physics/rrtmgp_lw_cloud_sampling.F90 index efb383a5d..383694db0 100644 --- a/physics/rrtmgp_lw_cloud_sampling.F90 +++ b/physics/rrtmgp_lw_cloud_sampling.F90 @@ -38,29 +38,33 @@ end subroutine rrtmgp_lw_cloud_sampling_init !! \htmlinclude rrtmgp_lw_cloud_sampling_run.html !! subroutine rrtmgp_lw_cloud_sampling_run(doLWrad, nCol, nLev, ipsdlw0, icseed_lw, cld_frac,& - overlap_param, lw_gas_props, lw_optical_props_cloudsByBand, lw_optical_props_clouds, & - errmsg, errflg) + precip_frac, cloud_overlap_param, precip_overlap_param, lw_gas_props, & + lw_optical_props_cloudsByBand, lw_optical_props_precipByBand, & + lw_optical_props_clouds, lw_optical_props_precip, errmsg, errflg) ! Inputs logical, intent(in) :: & - doLWrad ! Logical flag for shortwave radiation call + doLWrad ! Logical flag for shortwave radiation call integer, intent(in) :: & - nCol, & ! Number of horizontal gridpoints - nLev, & ! Number of vertical layers - ipsdlw0 ! Initial permutation seed for McICA + nCol, & ! Number of horizontal gridpoints + nLev, & ! Number of vertical layers + ipsdlw0 ! Initial permutation seed for McICA integer,intent(in),dimension(ncol) :: & - icseed_lw ! auxiliary special cloud related array when module - ! variable isubclw=2, it provides permutation seed - ! for each column profile that are used for generating - ! random numbers. when isubclw /=2, it will not be used. + icseed_lw ! auxiliary special cloud related array when module + ! variable isubclw=2, it provides permutation seed + ! for each column profile that are used for generating + ! random numbers. when isubclw /=2, it will not be used. real(kind_phys), dimension(ncol,nLev),intent(in) :: & - cld_frac ! Total cloud fraction by layer + cld_frac, & ! Total cloud fraction by layer + precip_frac ! Precipitation fraction by layer real(kind_phys), dimension(ncol,nLev), intent(in) :: & - overlap_param ! Overlap parameter + cloud_overlap_param, & ! Cloud overlap parameter + precip_overlap_param ! Precipitation overlap parameter type(ty_gas_optics_rrtmgp),intent(in) :: & - lw_gas_props ! RRTMGP DDT: K-distribution data + lw_gas_props ! RRTMGP DDT: K-distribution data type(ty_optical_props_1scl),intent(in) :: & - lw_optical_props_cloudsByBand ! RRTMGP DDT: Shortwave optical properties (cloudy atmosphere) + lw_optical_props_cloudsByBand, & ! RRTMGP DDT: Longwave optical properties in each band (clouds) + lw_optical_props_precipByBand ! RRTMGP DDT: Longwave optical properties in each band (precipitation) ! Outputs character(len=*), intent(out) :: & @@ -68,7 +72,8 @@ subroutine rrtmgp_lw_cloud_sampling_run(doLWrad, nCol, nLev, ipsdlw0, icseed_lw, integer, intent(out) :: & errflg ! CCPP error code type(ty_optical_props_1scl),intent(out) :: & - lw_optical_props_clouds ! RRTMGP DDT: Shortwave optical properties (cloudy atmosphere) + lw_optical_props_clouds, & ! RRTMGP DDT: Shortwave optical properties by spectral point (clouds) + lw_optical_props_precip ! RRTMGP DDT: Shortwave optical properties by spectral point (precipitation) ! Local variables integer :: iCol @@ -76,15 +81,24 @@ subroutine rrtmgp_lw_cloud_sampling_run(doLWrad, nCol, nLev, ipsdlw0, icseed_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) :: rng1D - logical, dimension(ncol,nLev,lw_gas_props%get_ngpt()) :: cldfracMCICA - real(kind_phys), dimension(ncol,nLev) :: cld_frac_noSamp + logical, dimension(ncol,nLev,lw_gas_props%get_ngpt()) :: cldfracMCICA,precipfracSAMP ! Initialize CCPP error handling variables errmsg = '' errflg = 0 + ! + if (iovrlw .ne. 1 .and. iovrlw .ne. 3) then + errmsg = 'Cloud overlap assumption not supported by GFDL microphysics suite.' + errflg = 1 + call check_error_msg('rrtmgp_lw_cloud_sampling',errmsg) + return + endif + if (.not. doLWrad) return - + ! + ! First sample the clouds... + ! ! Allocate space RRTMGP DDTs [nCol,nLev,nGpt] call check_error_msg('rrtmgp_lw_cloud_sampling_run',& lw_optical_props_clouds%alloc_1scl(nCol, nLev, lw_gas_props)) @@ -121,13 +135,69 @@ subroutine rrtmgp_lw_cloud_sampling_run(doLWrad, nCol, nLev, ipsdlw0, icseed_lw, call random_number(rng1D,rng_stat) rng3D2(:,:,iCol) = reshape(source = rng1D,shape=[lw_gas_props%get_ngpt(),nLev]) enddo - call check_error_msg('rrtmgp_lw_cloud_sampling_run',sampled_mask_exp_dcorr(rng3D,rng3D2,cld_frac,overlap_param(:,1:nLev-1),cldfracMCICA)) + call check_error_msg('rrtmgp_lw_cloud_sampling_run',& + sampled_mask_exp_dcorr(rng3D,rng3D2,cld_frac,cloud_overlap_param(:,1:nLev-1),cldfracMCICA)) end select ! Map band optical depth to each g-point using McICA call check_error_msg('rrtmgp_lw_cloud_sampling_run',draw_samples(& cldfracMCICA,lw_optical_props_cloudsByBand,lw_optical_props_clouds)) + ! + ! Next sample the precipitation... + ! + ! Allocate space RRTMGP DDTs [nCol,nLev,nGpt] + call check_error_msg('rrtmgp_lw_cloud_sampling_run',& + lw_optical_props_precip%alloc_1scl(nCol, nLev, lw_gas_props)) + + ! Change random number seed value for each radiation invocation (isubclw =1 or 2). + if(isubclw == 1) then ! advance prescribed permutation seed + do iCol = 1, ncol + ipseed_lw(iCol) = ipsdlw0 + iCol + enddo + elseif (isubclw == 2) then ! use input array of permutaion seeds + do iCol = 1, ncol + ipseed_lw(iCol) = icseed_lw(iCol) + enddo + endif + + ! Call McICA to generate subcolumns. + ! No need to call RNG second time for now, just use the same seeds for precip as clouds. + !! 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) + ! call random_number(rng1D,rng_stat) + ! rng3D(:,:,iCol) = reshape(source = rng1D,shape=[lw_gas_props%get_ngpt(),nLev]) + !enddo + + ! Call McICA + select case ( iovrlw ) + ! Maximumn-random + case(1) ! Maximum-random overlap + call check_error_msg('rrtmgp_lw_cloud_sampling_run',sampled_mask_max_ran(rng3D,precip_frac,precipfracSAMP)) + case(3) ! Exponential decorrelation length overlap + ! No need to call RNG second time for now, just use the same seeds for precip as clouds. + !! Generate second RNG + !do iCol=1,ncol + ! call random_setseed(ipseed_lw(icol),rng_stat) + ! call random_number(rng1D,rng_stat) + ! rng3D2(:,:,iCol) = reshape(source = rng1D,shape=[lw_gas_props%get_ngpt(),nLev]) + !enddo + call check_error_msg('rrtmgp_lw_cloud_sampling_run', & + sampled_mask_exp_dcorr(rng3D,rng3D2,precip_frac,precip_overlap_param(:,1:nLev-1),precipfracSAMP)) + end select + + ! Map band optical depth to each g-point using McICA + call check_error_msg('rrtmgp_lw_cloud_sampling_run',draw_samples(& + precipfracSAMP,lw_optical_props_precipByBand,lw_optical_props_precip)) + + ! + ! For GFDL MP just add precipitation optics to cloud-optics + ! + call check_error_msg('rrtmgp_lw_cloud_sampling_run', & + lw_optical_props_precip%increment(lw_optical_props_clouds)) + end subroutine rrtmgp_lw_cloud_sampling_run ! ######################################################################################### diff --git a/physics/rrtmgp_lw_cloud_sampling.meta b/physics/rrtmgp_lw_cloud_sampling.meta index 4267cab3e..d54932fa3 100644 --- a/physics/rrtmgp_lw_cloud_sampling.meta +++ b/physics/rrtmgp_lw_cloud_sampling.meta @@ -71,7 +71,16 @@ kind = kind_phys intent = in optional = F -[overlap_param] +[precip_frac] + standard_name = precipitation_fraction_by_layer + long_name = precipitation fraction in each layer + units = frac + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[cloud_overlap_param] standard_name = cloud_overlap_param long_name = cloud overlap parameter units = km @@ -80,6 +89,15 @@ kind = kind_phys intent = in optional = F +[precip_overlap_param] + standard_name = precip_overlap_param + long_name = precipitation overlap parameter + units = km + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F [lw_gas_props] standard_name = coefficients_for_lw_gas_optics long_name = DDT containing spectral information for RRTMGP LW radiation scheme @@ -96,6 +114,14 @@ type = ty_optical_props_1scl intent = in optional = F +[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_1scl + intent = in + optional = F [lw_optical_props_clouds] standard_name = longwave_optical_properties_for_cloudy_atmosphere long_name = Fortran DDT containing RRTMGP optical properties @@ -104,6 +130,14 @@ type = ty_optical_props_1scl intent = out optional = F +[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_1scl + intent = out + optional = F [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/rrtmgp_sw_cloud_optics.F90 b/physics/rrtmgp_sw_cloud_optics.F90 index 1c11b95c7..434dbe9f3 100644 --- a/physics/rrtmgp_sw_cloud_optics.F90 +++ b/physics/rrtmgp_sw_cloud_optics.F90 @@ -12,6 +12,13 @@ module rrtmgp_sw_cloud_optics implicit none public rrtmgp_sw_cloud_optics_init, rrtmgp_sw_cloud_optics_run, rrtmgp_sw_cloud_optics_finalize + + ! Parameters used for rain and snow(+groupel) RRTMGP cloud-optics + real(kind_phys),parameter :: & + a0r = 3.07e-3, & ! + a0s = 0.0, & ! + a1s = 1.5 ! + real(kind_phys),dimension(:),allocatable :: b0r,b0s,b1s,c0r,c0s contains ! ######################################################################################### @@ -257,6 +264,21 @@ subroutine rrtmgp_sw_cloud_optics_init(doG_cldoptics, doGP_cldoptics_PADE, doGP_ endif call check_error_msg('sw_cloud_optics_init',sw_cloud_props%set_ice_roughness(nrghice)) + ! Initialize coefficients for rain and snow(+groupel) cloud optics + allocate(b0r(sw_cloud_props%get_nband()),b0s(sw_cloud_props%get_nband()), & + b1s(sw_cloud_props%get_nband()),c0r(sw_cloud_props%get_nband()), & + c0s(sw_cloud_props%get_nband())) + b0r = (/0.496, 0.466, 0.437, 0.416, 0.391, 0.374, 0.352, & + 0.183, 0.048, 0.012, 0.000, 0.000, 0.000, 0.000/) + b0s = (/0.460, 0.460, 0.460, 0.460, 0.460, 0.460, 0.460, & + 0.460, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000/) + b1s = (/0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000,& + 0.000, 1.62e-5, 1.62e-5, 0.000, 0.000, 0.000, 0.000/) + c0r = (/0.980, 0.975, 0.965, 0.960, 0.955, 0.952, 0.950, & + 0.944, 0.894, 0.884, 0.883, 0.883, 0.883, 0.883/) + c0s = (/0.970, 0.970, 0.970, 0.970, 0.970, 0.970, 0.970, & + 0.970, 0.970, 0.970, 0.700, 0.700, 0.700, 0.700/) + end subroutine rrtmgp_sw_cloud_optics_init ! ######################################################################################### @@ -267,8 +289,9 @@ end subroutine rrtmgp_sw_cloud_optics_init !! subroutine rrtmgp_sw_cloud_optics_run(doSWrad, doG_cldoptics, doGP_cldoptics_PADE, & doGP_cldoptics_LUT, nCol, nLev, nDay, idxday, nrghice, cld_frac, cld_lwp, cld_reliq, & - cld_iwp, cld_reice, cld_swp, cld_resnow, cld_rwp, cld_rerain, sw_cloud_props, & - sw_gas_props, sw_optical_props_cloudsByBand, cldtausw, errmsg, errflg) + cld_iwp, cld_reice, cld_swp, cld_resnow, cld_rwp, cld_rerain, precip_frac, & + sw_cloud_props, sw_gas_props, sw_optical_props_cloudsByBand, & + sw_optical_props_precipByBand, cldtausw, errmsg, errflg) ! Inputs logical, intent(in) :: & @@ -292,7 +315,8 @@ subroutine rrtmgp_sw_cloud_optics_run(doSWrad, doG_cldoptics, doGP_cldoptics_PAD cld_swp, & ! Cloud snow water path cld_resnow, & ! Cloud snow effective radius cld_rwp, & ! Cloud rain water path - cld_rerain ! Cloud rain effective radius + cld_rerain, & ! Cloud rain effective radius + precip_frac ! Precipitation fraction by layer type(ty_cloud_optics),intent(in) :: & sw_cloud_props ! RRTMGP DDT: shortwave cloud properties type(ty_gas_optics_rrtmgp),intent(in) :: & @@ -300,39 +324,47 @@ subroutine rrtmgp_sw_cloud_optics_run(doSWrad, doG_cldoptics, doGP_cldoptics_PAD ! Outputs character(len=*), intent(out) :: & - errmsg ! CCPP error message + errmsg ! CCPP error message integer, intent(out) :: & - errflg ! CCPP error code + errflg ! CCPP error flag type(ty_optical_props_2str),intent(out) :: & - sw_optical_props_cloudsByBand ! RRTMGP DDT: Shortwave optical properties (cloudy atmosphere) + sw_optical_props_cloudsByBand, & ! RRTMGP DDT: Shortwave optical properties in each band (clouds) + sw_optical_props_precipByBand ! RRTMGP DDT: Shortwave optical properties in each band (cloud precipitation) real(kind_phys), dimension(ncol,NLev), intent(out) :: & - cldtausw ! approx 10.mu band layer cloud optical depth + cldtausw ! Approx 10.mu band layer cloud optical depth ! Local variables - logical,dimension(nday,nLev) :: liqmask, icemask + 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,sw_gas_props%get_nband()) :: & - tau_cld, ssa_cld, asy_cld - + tau_cld, ssa_cld, asy_cld, tau_precip, ssa_precip, asy_precip + ! Initialize CCPP error handling variables errmsg = '' errflg = 0 if (.not. doSWrad) return + + ! Only process sunlit points... if (nDay .gt. 0) then - ! Compute ice/liquid cloud masks, needed by rrtmgp_cloud_optics - liqmask = (cld_frac(idxday(1:nday),:) .gt. 0 .and. cld_lwp(idxday(1:nday),:) .gt. 0) - icemask = (cld_frac(idxday(1:nday),:) .gt. 0 .and. cld_iwp(idxday(1:nday),:) .gt. 0) - - ! Allocate space for RRTMGP DDTs containing cloud radiative properties + ! Allocate space for RRTMGP DDTs containing cloud/precipitation radiative properties ! Cloud optics [nday,nLev,nBands] call check_error_msg('rrtmgp_sw_cloud_optics_run',sw_optical_props_cloudsByBand%alloc_2str(& nday, nLev, sw_gas_props%get_band_lims_wavenumber())) sw_optical_props_cloudsByBand%tau(:,:,:) = 0._kind_phys sw_optical_props_cloudsByBand%ssa(:,:,:) = 0._kind_phys sw_optical_props_cloudsByBand%g(:,:,:) = 0._kind_phys - - ! Compute cloud-optics for RTE. + + ! Cloud-precipitation optics [nday,nLev,nBands] + call check_error_msg('rrtmgp_sw_cloud_optics_run',sw_optical_props_precipByBand%alloc_2str(& + nday, nLev, sw_gas_props%get_band_lims_wavenumber())) + sw_optical_props_precipByBand%tau(:,:,:) = 0._kind_phys + sw_optical_props_precipByBand%ssa(:,:,:) = 0._kind_phys + sw_optical_props_precipByBand%g(:,:,:) = 0._kind_phys + + ! Compute cloud/precipitation optics. if (doGP_cldoptics_PADE .or. doGP_cldoptics_LUT) then ! RRTMGP cloud-optics. call check_error_msg('rrtmgp_sw_cloud_optics_run',sw_cloud_props%cloud_optics(& @@ -342,32 +374,78 @@ subroutine rrtmgp_sw_cloud_optics_run(doSWrad, doG_cldoptics, doGP_cldoptics_PAD 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) + ! Cloud precipitation optics: rain and snow(+groupel) + 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,sw_cloud_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(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 if (doG_cldoptics) then - ! RRTMG cloud-optics - tau_cld(:,:,:) = 0._kind_phys - ssa_cld(:,:,:) = 0._kind_phys - asy_cld(:,:,:) = 0._kind_phys + ! RRTMG cloud(+precipitation) optics + tau_cld(:,:,:) = 0._kind_phys + ssa_cld(:,:,:) = 0._kind_phys + asy_cld(:,:,:) = 0._kind_phys + tau_precip(:,:,:) = 0._kind_phys + ssa_precip(:,:,:) = 0._kind_phys + asy_precip(:,:,:) = 0._kind_phys if (any(cld_frac .gt. 0)) then call rrtmg_sw_cloud_optics(nday, nLev, sw_gas_props%get_nband(), & cld_lwp(idxday(1:nday),:), cld_reliq(idxday(1:nday),:), & cld_iwp(idxday(1:nday),:), cld_reice(idxday(1:nday),:), & cld_rwp(idxday(1:nday),:), cld_rerain(idxday(1:nday),:), & cld_swp(idxday(1:nday),:), cld_resnow(idxday(1:nday),:), & - cld_frac(idxday(1:nday),:), tau_cld, ssa_cld, asy_cld) + cld_frac(idxday(1:nday),:), tau_cld, ssa_cld, asy_cld, tau_precip, ssa_precip, asy_precip) endif + ! Cloud-optics (Need to reorder from G->GP band conventions) sw_optical_props_cloudsByBand%tau(:,:,1) = tau_cld(:,:,sw_gas_props%get_nband()) sw_optical_props_cloudsByBand%ssa(:,:,1) = ssa_cld(:,:,sw_gas_props%get_nband()) sw_optical_props_cloudsByBand%g(:,:,1) = asy_cld(:,:,sw_gas_props%get_nband()) sw_optical_props_cloudsByBand%tau(:,:,2:sw_gas_props%get_nband()) = tau_cld(:,:,1:sw_gas_props%get_nband()-1) sw_optical_props_cloudsByBand%ssa(:,:,2:sw_gas_props%get_nband()) = ssa_cld(:,:,1:sw_gas_props%get_nband()-1) sw_optical_props_cloudsByBand%g(:,:,2:sw_gas_props%get_nband()) = asy_cld(:,:,1:sw_gas_props%get_nband()-1) + ! Precipitation-optics (Need to reorder from G->GP band conventions) + sw_optical_props_precipByBand%tau(:,:,1) = tau_precip(:,:,sw_gas_props%get_nband()) + sw_optical_props_precipByBand%ssa(:,:,1) = ssa_precip(:,:,sw_gas_props%get_nband()) + sw_optical_props_precipByBand%g(:,:,1) = asy_precip(:,:,sw_gas_props%get_nband()) + sw_optical_props_precipByBand%tau(:,:,2:sw_gas_props%get_nband()) = tau_precip(:,:,1:sw_gas_props%get_nband()-1) + sw_optical_props_precipByBand%ssa(:,:,2:sw_gas_props%get_nband()) = ssa_precip(:,:,1:sw_gas_props%get_nband()-1) + sw_optical_props_precipByBand%g(:,:,2:sw_gas_props%get_nband()) = asy_precip(:,:,1:sw_gas_props%get_nband()-1) endif ! All-sky SW optical depth ~0.55microns cldtausw(idxday(1:nDay),:) = sw_optical_props_cloudsByBand%tau(:,:,11) endif - + end subroutine rrtmgp_sw_cloud_optics_run ! ######################################################################################### diff --git a/physics/rrtmgp_sw_cloud_optics.meta b/physics/rrtmgp_sw_cloud_optics.meta index cc28b0f00..9edb4130a 100644 --- a/physics/rrtmgp_sw_cloud_optics.meta +++ b/physics/rrtmgp_sw_cloud_optics.meta @@ -242,6 +242,15 @@ kind = kind_phys intent = in optional = F +[precip_frac] + standard_name = precipitation_fraction_by_layer + long_name = precipitation fraction in each layer + units = frac + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F [sw_cloud_props] standard_name = coefficients_for_sw_cloud_optics long_name = DDT containing spectral information for cloudy RRTMGP SW radiation scheme @@ -282,6 +291,14 @@ type = ty_optical_props_2str intent = out optional = F +[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 + optional = F [cldtausw] standard_name = RRTMGP_cloud_optical_depth_layers_at_0_55mu_band long_name = approx .55mu band layer cloud optical depth diff --git a/physics/rrtmgp_sw_cloud_sampling.F90 b/physics/rrtmgp_sw_cloud_sampling.F90 index 22718418a..2a3b7b58f 100644 --- a/physics/rrtmgp_sw_cloud_sampling.F90 +++ b/physics/rrtmgp_sw_cloud_sampling.F90 @@ -38,40 +38,45 @@ end subroutine rrtmgp_sw_cloud_sampling_init !! \htmlinclude rrtmgp_sw_cloud_sampling.html !! subroutine rrtmgp_sw_cloud_sampling_run(doSWrad, nCol, nDay, nLev, ipsdsw0, idxday, & - icseed_sw, cld_frac, overlap_param, sw_gas_props, sw_optical_props_cloudsByBand, & - sw_optical_props_clouds, errmsg, errflg) + icseed_sw, cld_frac, precip_frac, cloud_overlap_param, precip_overlap_param, & + sw_gas_props, sw_optical_props_cloudsByBand, sw_optical_props_precipByBand, & + sw_optical_props_clouds, sw_optical_props_precip, errmsg, errflg) ! Inputs logical, intent(in) :: & - doSWrad ! Logical flag for shortwave radiation call + 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 - ipsdsw0 ! Initial permutation seed for McICA + nCol, & ! Number of horizontal gridpoints + nDay, & ! Number of daylit points. + nLev, & ! Number of vertical layers + ipsdsw0 ! Initial permutation seed for McICA integer,intent(in),dimension(ncol) :: & - idxday ! Indices for daylit points. + idxday ! Indices for daylit points. integer,intent(in),dimension(ncol) :: & - icseed_sw ! auxiliary special cloud related array when module - ! variable isubcsw=2, it provides permutation seed - ! for each column profile that are used for generating - ! random numbers. when isubcsw /=2, it will not be used. + icseed_sw ! auxiliary special cloud related array when module + ! variable isubcsw=2, it provides permutation seed + ! for each column profile that are used for generating + ! random numbers. when isubcsw /=2, it will not be used. real(kind_phys), dimension(ncol,nLev),intent(in) :: & - cld_frac ! Total cloud fraction by layer + cld_frac, & ! Total cloud fraction by layer + precip_frac ! Precipitation fraction by layer real(kind_phys), dimension(ncol,nLev), intent(in) :: & - overlap_param ! Overlap parameter + cloud_overlap_param, & ! Cloud overlap parameter + precip_overlap_param ! Precipitation overlap parameter type(ty_gas_optics_rrtmgp),intent(in) :: & - sw_gas_props ! RRTMGP DDT: K-distribution data + sw_gas_props ! RRTMGP DDT: K-distribution data type(ty_optical_props_2str),intent(in) :: & - sw_optical_props_cloudsByBand ! RRTMGP DDT: Shortwave optical properties (cloudy atmosphere) + sw_optical_props_cloudsByBand, & ! RRTMGP DDT: Shortwave optical properties in each band (clouds) + sw_optical_props_precipByBand ! RRTMGP DDT: Shortwave optical properties in each band (precipitation) ! Outputs character(len=*), intent(out) :: & - errmsg ! Error message + errmsg ! Error message integer, intent(out) :: & - errflg ! Error code + errflg ! Error flag type(ty_optical_props_2str),intent(out) :: & - sw_optical_props_clouds ! RRTMGP DDT: Shortwave optical properties (cloudy atmosphere) + sw_optical_props_clouds, & ! RRTMGP DDT: Shortwave optical properties at each spectral point (clouds) + sw_optical_props_precip ! RRTMGP DDT: Shortwave optical properties at each spectral point (precipitation) ! Local variables integer :: iCol,iLay @@ -79,18 +84,76 @@ subroutine rrtmgp_sw_cloud_sampling_run(doSWrad, nCol, nDay, nLev, ipsdsw0, idxd type(random_stat) :: rng_stat real(kind_phys), dimension(sw_gas_props%get_ngpt(),nLev,ncol) :: rng3D,rng3D2 real(kind_phys), dimension(sw_gas_props%get_ngpt()*nLev) :: rng1D - logical, dimension(ncol,nLev,sw_gas_props%get_ngpt()) :: cldfracMCICA - real(kind_phys), dimension(ncol,nLev) :: cld_frac_noSamp + logical, dimension(ncol,nLev,sw_gas_props%get_ngpt()) :: cldfracMCICA,precipfracSAMP ! Initialize CCPP error handling variables errmsg = '' errflg = 0 + + ! + if (iovrsw .ne. 1 .and. iovrsw .ne. 3) then + errmsg = 'Cloud overlap assumption not supported by GFDL microphysics suite.' + errflg = 1 + call check_error_msg('rrtmgp_sw_cloud_sampling',errmsg) + return + endif 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 (isubcsw =1 or 2). + if(isubcsw == 1) then ! advance prescribed permutation seed + do iCol = 1, ncol + ipseed_sw(iCol) = ipsdsw0 + iCol + enddo + elseif (isubcsw == 2) then ! use input array of permutaion seeds + do iCol = 1, ncol + ipseed_sw(iCol) = icseed_sw(iCol) + enddo + endif + + ! Call McICA to generate subcolumns. + ! No need to call RNG second time for now, just use the same seeds for precip as clouds. + !! 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_sw(icol),rng_stat) + ! call random_number(rng1D,rng_stat) + ! rng3D(:,:,iCol) = reshape(source = rng1D,shape=[sw_gas_props%get_ngpt(),nLev]) + !enddo + + ! Call McICA + select case ( iovrsw ) + case(1) ! Maximum-random + call check_error_msg('rrtmgp_sw_cloud_sampling_run', & + sampled_mask_max_ran(rng3D,cld_frac,cldfracMCICA)) + case(3) ! Exponential-random + ! No need to call RNG second time for now, just use the same seeds for precip as clouds. + !! Generate second RNG + !do iCol=1,ncol + ! call random_setseed(ipseed_sw(icol),rng_stat) + ! call random_number(rng1D,rng_stat) + ! rng3D2(:,:,iCol) = reshape(source = rng1D,shape=[sw_gas_props%get_ngpt(),nLev]) + !enddo + call check_error_msg('rrtmgp_sw_cloud_sampling_run', & + sampled_mask_exp_dcorr(rng3D,rng3D2,cld_frac,cloud_overlap_param(:,1:nLev-1),cldfracMCICA)) + end select + ! Map band optical depth to each g-point using McICA + call check_error_msg('rrtmgp_sw_cloud_sampling_run',draw_samples(& + cldfracMCICA(idxday(1:nDay),:,:),sw_optical_props_cloudsByBand,sw_optical_props_clouds)) + + ! + ! Next sample precipitation (same as clouds for now) + ! ! Allocate space RRTMGP DDTs [nday,nLev,nGpt] - call check_error_msg('rrtmgp_sw_cloud_sampling_run',sw_optical_props_clouds%alloc_2str( & + call check_error_msg('rrtmgp_sw_cloud_sampling_run',sw_optical_props_precip%alloc_2str( & nday, nLev, sw_gas_props)) ! Change random number seed value for each radiation invocation (isubcsw =1 or 2). @@ -116,7 +179,8 @@ subroutine rrtmgp_sw_cloud_sampling_run(doSWrad, nCol, nDay, nLev, ipsdsw0, idxd ! Call McICA select case ( iovrsw ) case(1) ! Maximum-random - call check_error_msg('rrtmgp_sw_cloud_sampling_run',sampled_mask_max_ran(rng3D,cld_frac,cldfracMCICA)) + call check_error_msg('rrtmgp_sw_cloud_sampling_run', & + sampled_mask_max_ran(rng3D,precip_frac,precipfracSAMP)) case(3) ! Exponential-random ! Generate second RNG do iCol=1,ncol @@ -124,15 +188,22 @@ subroutine rrtmgp_sw_cloud_sampling_run(doSWrad, nCol, nDay, nLev, ipsdsw0, idxd call random_number(rng1D,rng_stat) rng3D2(:,:,iCol) = reshape(source = rng1D,shape=[sw_gas_props%get_ngpt(),nLev]) enddo - call check_error_msg('rrtmgp_sw_cloud_sampling_run',sampled_mask_exp_dcorr(rng3D,rng3D2,cld_frac,overlap_param(:,1:nLev-1),cldfracMCICA)) + call check_error_msg('rrtmgp_sw_cloud_sampling_run', & + sampled_mask_exp_dcorr(rng3D,rng3D2,precip_frac,precip_overlap_param(:,1:nLev-1),precipfracSAMP)) end select ! Map band optical depth to each g-point using McICA call check_error_msg('rrtmgp_sw_cloud_sampling_run',draw_samples(& - cldfracMCICA(idxday(1:nDay),:,:),sw_optical_props_cloudsByBand,sw_optical_props_clouds)) - + precipfracSAMP(idxday(1:nDay),:,:),sw_optical_props_precipByBand,sw_optical_props_precip)) + endif - + + ! + ! For GFDL MP just add precipitation optics to cloud-optics + ! + call check_error_msg('rrtmgp_sw_cloud_sampling_run', & + sw_optical_props_precip%increment(sw_optical_props_clouds)) + end subroutine rrtmgp_sw_cloud_sampling_run ! ######################################################################################### diff --git a/physics/rrtmgp_sw_cloud_sampling.meta b/physics/rrtmgp_sw_cloud_sampling.meta index eed1101b8..4afdaa4db 100644 --- a/physics/rrtmgp_sw_cloud_sampling.meta +++ b/physics/rrtmgp_sw_cloud_sampling.meta @@ -87,7 +87,16 @@ kind = kind_phys intent = in optional = F -[overlap_param] +[precip_frac] + standard_name = precipitation_fraction_by_layer + long_name = precipitation fraction in each layer + units = frac + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[cloud_overlap_param] standard_name = cloud_overlap_param long_name = cloud overlap parameter units = km @@ -96,6 +105,15 @@ kind = kind_phys intent = in optional = F +[precip_overlap_param] + standard_name = precip_overlap_param + long_name = precipitation overlap parameter + units = km + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F [sw_gas_props] standard_name = coefficients_for_sw_gas_optics long_name = DDT containing spectral information for RRTMGP SW radiation scheme @@ -112,6 +130,14 @@ type = ty_optical_props_2str intent = in optional = F +[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 + optional = F [sw_optical_props_clouds] standard_name = shortwave_optical_properties_for_cloudy_atmosphere long_name = Fortran DDT containing RRTMGP optical properties @@ -120,6 +146,14 @@ type = ty_optical_props_2str intent = out optional = F +[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 + optional = F [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP From 3375e32cd9eec7bc6c3447b830de2b0afd7b9a8a Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Fri, 22 May 2020 13:54:41 -0600 Subject: [PATCH 20/50] Added pieces for combining cloud+precipitation optical properties. Still not producing same results as before the split. --- physics/rrtmgp_lw_cloud_sampling.F90 | 5 ++-- physics/rrtmgp_sw_cloud_sampling.F90 | 38 +++++++++++++++++++++++++--- 2 files changed, 36 insertions(+), 7 deletions(-) diff --git a/physics/rrtmgp_lw_cloud_sampling.F90 b/physics/rrtmgp_lw_cloud_sampling.F90 index 383694db0..d783af9c1 100644 --- a/physics/rrtmgp_lw_cloud_sampling.F90 +++ b/physics/rrtmgp_lw_cloud_sampling.F90 @@ -195,9 +195,8 @@ subroutine rrtmgp_lw_cloud_sampling_run(doLWrad, nCol, nLev, ipsdlw0, icseed_lw, ! ! For GFDL MP just add precipitation optics to cloud-optics ! - call check_error_msg('rrtmgp_lw_cloud_sampling_run', & - lw_optical_props_precip%increment(lw_optical_props_clouds)) - + lw_optical_props_clouds%tau = lw_optical_props_clouds%tau + lw_optical_props_precip%tau + end subroutine rrtmgp_lw_cloud_sampling_run ! ######################################################################################### diff --git a/physics/rrtmgp_sw_cloud_sampling.F90 b/physics/rrtmgp_sw_cloud_sampling.F90 index 2a3b7b58f..ec86c147f 100644 --- a/physics/rrtmgp_sw_cloud_sampling.F90 +++ b/physics/rrtmgp_sw_cloud_sampling.F90 @@ -79,9 +79,10 @@ subroutine rrtmgp_sw_cloud_sampling_run(doSWrad, nCol, nDay, nLev, ipsdsw0, idxd sw_optical_props_precip ! RRTMGP DDT: Shortwave optical properties at each spectral point (precipitation) ! Local variables - integer :: iCol,iLay + integer :: iCol,iLay,iGpt integer,dimension(ncol) :: ipseed_sw type(random_stat) :: rng_stat + real(kind_phys) :: tauloc,asyloc,ssaloc real(kind_phys), dimension(sw_gas_props%get_ngpt(),nLev,ncol) :: rng3D,rng3D2 real(kind_phys), dimension(sw_gas_props%get_ngpt()*nLev) :: rng1D logical, dimension(ncol,nLev,sw_gas_props%get_ngpt()) :: cldfracMCICA,precipfracSAMP @@ -201,9 +202,38 @@ subroutine rrtmgp_sw_cloud_sampling_run(doSWrad, nCol, nDay, nLev, ipsdsw0, idxd ! ! For GFDL MP just add precipitation optics to cloud-optics ! - call check_error_msg('rrtmgp_sw_cloud_sampling_run', & - sw_optical_props_precip%increment(sw_optical_props_clouds)) - + do iGpt=1,sw_gas_props%get_ngpt() + do iCol=1,nCol + do iLay=1,nLev + tauloc = sw_optical_props_clouds%tau(iCol,iLay,iGpt) + & + sw_optical_props_precip%tau(iCol,iLay,iGpt) + if (tauloc > 0) then + ssaloc = (sw_optical_props_clouds%tau(iCol,iLay,iGpt) * & + sw_optical_props_clouds%ssa(iCol,iLay,iGpt) + & + sw_optical_props_precip%tau(iCol,iLay,iGpt) * & + sw_optical_props_precip%ssa(iCol,iLay,iGpt)) / & + tauloc + if (ssaloc > 0) then + asyloc = (sw_optical_props_clouds%tau(iCol,iLay,iGpt) * & + sw_optical_props_clouds%ssa(iCol,iLay,iGpt) * & + sw_optical_props_clouds%g(iCol,iLay,iGpt) + & + sw_optical_props_precip%tau(iCol,iLay,iGpt) * & + sw_optical_props_precip%ssa(iCol,iLay,iGpt) * & + sw_optical_props_precip%g(iCol,iLay,iGpt)) / & + (tauloc*ssaloc) + sw_optical_props_clouds%ssa(iCol,iLay,iGpt) = ssaloc + sw_optical_props_clouds%g(iCol,iLay,iGpt) = asyloc + endif + sw_optical_props_clouds%tau(iCol,iLay,iGpt) = tauloc + endif + enddo + enddo + enddo + +! call combine_optics_2str(sw_optical_props_precip%tau, sw_optical_props_precip%ssa, & +! sw_optical_props_precip%g,sw_optical_props_clouds%tau,& +! sw_optical_props_clouds%ssa, sw_optical_props_clouds%g) + end subroutine rrtmgp_sw_cloud_sampling_run ! ######################################################################################### From 48e94f402794b3dc8095c6d1c336aca908f201ac Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Tue, 26 May 2020 11:23:31 -0600 Subject: [PATCH 21/50] Some small changes. Minor differences in SW down at the surface still present. --- physics/rrtmgp_sw_cloud_optics.F90 | 4 +- physics/rrtmgp_sw_cloud_sampling.F90 | 55 +++++++++++++++------------- 2 files changed, 32 insertions(+), 27 deletions(-) diff --git a/physics/rrtmgp_sw_cloud_optics.F90 b/physics/rrtmgp_sw_cloud_optics.F90 index 434dbe9f3..2eb3b95b3 100644 --- a/physics/rrtmgp_sw_cloud_optics.F90 +++ b/physics/rrtmgp_sw_cloud_optics.F90 @@ -413,10 +413,10 @@ subroutine rrtmgp_sw_cloud_optics_run(doSWrad, doG_cldoptics, doGP_cldoptics_PAD if (doG_cldoptics) then ! RRTMG cloud(+precipitation) optics tau_cld(:,:,:) = 0._kind_phys - ssa_cld(:,:,:) = 0._kind_phys + ssa_cld(:,:,:) = 1._kind_phys asy_cld(:,:,:) = 0._kind_phys tau_precip(:,:,:) = 0._kind_phys - ssa_precip(:,:,:) = 0._kind_phys + ssa_precip(:,:,:) = 1._kind_phys asy_precip(:,:,:) = 0._kind_phys if (any(cld_frac .gt. 0)) then call rrtmg_sw_cloud_optics(nday, nLev, sw_gas_props%get_nband(), & diff --git a/physics/rrtmgp_sw_cloud_sampling.F90 b/physics/rrtmgp_sw_cloud_sampling.F90 index ec86c147f..f2069bb95 100644 --- a/physics/rrtmgp_sw_cloud_sampling.F90 +++ b/physics/rrtmgp_sw_cloud_sampling.F90 @@ -158,24 +158,25 @@ subroutine rrtmgp_sw_cloud_sampling_run(doSWrad, nCol, nDay, nLev, ipsdsw0, idxd nday, nLev, sw_gas_props)) ! Change random number seed value for each radiation invocation (isubcsw =1 or 2). - if(isubcsw == 1) then ! advance prescribed permutation seed - do iCol = 1, ncol - ipseed_sw(iCol) = ipsdsw0 + iCol - enddo - elseif (isubcsw == 2) then ! use input array of permutaion seeds - do iCol = 1, ncol - ipseed_sw(iCol) = icseed_sw(iCol) - enddo - endif + !if(isubcsw == 1) then ! advance prescribed permutation seed + ! do iCol = 1, ncol + ! ipseed_sw(iCol) = ipsdsw0 + iCol + ! enddo + !elseif (isubcsw == 2) then ! use input array of permutaion seeds + ! do iCol = 1, ncol + ! ipseed_sw(iCol) = icseed_sw(iCol) + ! enddo + !endif ! Call McICA to generate subcolumns. - ! 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_sw(icol),rng_stat) - call random_number(rng1D,rng_stat) - rng3D(:,:,iCol) = reshape(source = rng1D,shape=[sw_gas_props%get_ngpt(),nLev]) - enddo + ! No need to call RNG second time for now, just use the same seeds for precip as clouds. + !! 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_sw(icol),rng_stat) + ! call random_number(rng1D,rng_stat) + ! rng3D(:,:,iCol) = reshape(source = rng1D,shape=[sw_gas_props%get_ngpt(),nLev]) + !enddo ! Call McICA select case ( iovrsw ) @@ -183,12 +184,13 @@ subroutine rrtmgp_sw_cloud_sampling_run(doSWrad, nCol, nDay, nLev, ipsdsw0, idxd call check_error_msg('rrtmgp_sw_cloud_sampling_run', & sampled_mask_max_ran(rng3D,precip_frac,precipfracSAMP)) case(3) ! Exponential-random - ! Generate second RNG - do iCol=1,ncol - call random_setseed(ipseed_sw(icol),rng_stat) - call random_number(rng1D,rng_stat) - rng3D2(:,:,iCol) = reshape(source = rng1D,shape=[sw_gas_props%get_ngpt(),nLev]) - enddo + ! No need to call RNG second time for now, just use the same seeds for precip as clouds. + !! Generate second RNG + !do iCol=1,ncol + !call random_setseed(ipseed_sw(icol),rng_stat) + ! call random_number(rng1D,rng_stat) + ! rng3D2(:,:,iCol) = reshape(source = rng1D,shape=[sw_gas_props%get_ngpt(),nLev]) + !enddo call check_error_msg('rrtmgp_sw_cloud_sampling_run', & sampled_mask_exp_dcorr(rng3D,rng3D2,precip_frac,precip_overlap_param(:,1:nLev-1),precipfracSAMP)) end select @@ -220,11 +222,14 @@ subroutine rrtmgp_sw_cloud_sampling_run(doSWrad, nCol, nDay, nLev, ipsdsw0, idxd sw_optical_props_precip%tau(iCol,iLay,iGpt) * & sw_optical_props_precip%ssa(iCol,iLay,iGpt) * & sw_optical_props_precip%g(iCol,iLay,iGpt)) / & - (tauloc*ssaloc) - sw_optical_props_clouds%ssa(iCol,iLay,iGpt) = ssaloc - sw_optical_props_clouds%g(iCol,iLay,iGpt) = asyloc + (tauloc*ssaloc) + else + ssaloc = 1. + asyloc = 0. endif sw_optical_props_clouds%tau(iCol,iLay,iGpt) = tauloc + sw_optical_props_clouds%ssa(iCol,iLay,iGpt) = ssaloc + sw_optical_props_clouds%g(iCol,iLay,iGpt) = asyloc endif enddo enddo From 333c30f0862c30abb05c09eefdcb06de9a8cf316 Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Tue, 26 May 2020 15:02:13 -0600 Subject: [PATCH 22/50] Moved copy statement into conditional statement. --- physics/rrtmgp_sw_cloud_optics.F90 | 50 +++++++++++++++++------------- 1 file changed, 29 insertions(+), 21 deletions(-) diff --git a/physics/rrtmgp_sw_cloud_optics.F90 b/physics/rrtmgp_sw_cloud_optics.F90 index 2eb3b95b3..55a4304eb 100644 --- a/physics/rrtmgp_sw_cloud_optics.F90 +++ b/physics/rrtmgp_sw_cloud_optics.F90 @@ -278,6 +278,8 @@ subroutine rrtmgp_sw_cloud_optics_init(doG_cldoptics, doGP_cldoptics_PADE, doGP_ 0.944, 0.894, 0.884, 0.883, 0.883, 0.883, 0.883/) c0s = (/0.970, 0.970, 0.970, 0.970, 0.970, 0.970, 0.970, & 0.970, 0.970, 0.970, 0.700, 0.700, 0.700, 0.700/) + + open(43,file='dumpGP.optics.txt',status='unknown') end subroutine rrtmgp_sw_cloud_optics_init @@ -412,12 +414,6 @@ subroutine rrtmgp_sw_cloud_optics_run(doSWrad, doG_cldoptics, doGP_cldoptics_PAD endif if (doG_cldoptics) then ! RRTMG cloud(+precipitation) optics - tau_cld(:,:,:) = 0._kind_phys - ssa_cld(:,:,:) = 1._kind_phys - asy_cld(:,:,:) = 0._kind_phys - tau_precip(:,:,:) = 0._kind_phys - ssa_precip(:,:,:) = 1._kind_phys - asy_precip(:,:,:) = 0._kind_phys if (any(cld_frac .gt. 0)) then call rrtmg_sw_cloud_optics(nday, nLev, sw_gas_props%get_nband(), & cld_lwp(idxday(1:nday),:), cld_reliq(idxday(1:nday),:), & @@ -425,21 +421,32 @@ subroutine rrtmgp_sw_cloud_optics_run(doSWrad, doG_cldoptics, doGP_cldoptics_PAD cld_rwp(idxday(1:nday),:), cld_rerain(idxday(1:nday),:), & cld_swp(idxday(1:nday),:), cld_resnow(idxday(1:nday),:), & cld_frac(idxday(1:nday),:), tau_cld, ssa_cld, asy_cld, tau_precip, ssa_precip, asy_precip) - endif - ! Cloud-optics (Need to reorder from G->GP band conventions) - sw_optical_props_cloudsByBand%tau(:,:,1) = tau_cld(:,:,sw_gas_props%get_nband()) - sw_optical_props_cloudsByBand%ssa(:,:,1) = ssa_cld(:,:,sw_gas_props%get_nband()) - sw_optical_props_cloudsByBand%g(:,:,1) = asy_cld(:,:,sw_gas_props%get_nband()) - sw_optical_props_cloudsByBand%tau(:,:,2:sw_gas_props%get_nband()) = tau_cld(:,:,1:sw_gas_props%get_nband()-1) - sw_optical_props_cloudsByBand%ssa(:,:,2:sw_gas_props%get_nband()) = ssa_cld(:,:,1:sw_gas_props%get_nband()-1) - sw_optical_props_cloudsByBand%g(:,:,2:sw_gas_props%get_nband()) = asy_cld(:,:,1:sw_gas_props%get_nband()-1) - ! Precipitation-optics (Need to reorder from G->GP band conventions) - sw_optical_props_precipByBand%tau(:,:,1) = tau_precip(:,:,sw_gas_props%get_nband()) - sw_optical_props_precipByBand%ssa(:,:,1) = ssa_precip(:,:,sw_gas_props%get_nband()) - sw_optical_props_precipByBand%g(:,:,1) = asy_precip(:,:,sw_gas_props%get_nband()) - sw_optical_props_precipByBand%tau(:,:,2:sw_gas_props%get_nband()) = tau_precip(:,:,1:sw_gas_props%get_nband()-1) - sw_optical_props_precipByBand%ssa(:,:,2:sw_gas_props%get_nband()) = ssa_precip(:,:,1:sw_gas_props%get_nband()-1) - sw_optical_props_precipByBand%g(:,:,2:sw_gas_props%get_nband()) = asy_precip(:,:,1:sw_gas_props%get_nband()-1) + + ! Cloud-optics (Need to reorder from G->GP band conventions) + sw_optical_props_cloudsByBand%tau(:,:,1) = tau_cld(:,:,sw_gas_props%get_nband()) + sw_optical_props_cloudsByBand%ssa(:,:,1) = ssa_cld(:,:,sw_gas_props%get_nband()) + sw_optical_props_cloudsByBand%g(:,:,1) = asy_cld(:,:,sw_gas_props%get_nband()) + sw_optical_props_cloudsByBand%tau(:,:,2:sw_gas_props%get_nband()) = tau_cld(:,:,1:sw_gas_props%get_nband()-1) + sw_optical_props_cloudsByBand%ssa(:,:,2:sw_gas_props%get_nband()) = ssa_cld(:,:,1:sw_gas_props%get_nband()-1) + sw_optical_props_cloudsByBand%g(:,:,2:sw_gas_props%get_nband()) = asy_cld(:,:,1:sw_gas_props%get_nband()-1) + ! Precipitation-optics (Need to reorder from G->GP band conventions) + sw_optical_props_precipByBand%tau(:,:,1) = tau_precip(:,:,sw_gas_props%get_nband()) + sw_optical_props_precipByBand%ssa(:,:,1) = ssa_precip(:,:,sw_gas_props%get_nband()) + sw_optical_props_precipByBand%g(:,:,1) = asy_precip(:,:,sw_gas_props%get_nband()) + sw_optical_props_precipByBand%tau(:,:,2:sw_gas_props%get_nband()) = tau_precip(:,:,1:sw_gas_props%get_nband()-1) + sw_optical_props_precipByBand%ssa(:,:,2:sw_gas_props%get_nband()) = ssa_precip(:,:,1:sw_gas_props%get_nband()-1) + sw_optical_props_precipByBand%g(:,:,2:sw_gas_props%get_nband()) = asy_precip(:,:,1:sw_gas_props%get_nband()-1) + + do iLay=1,nLev + write(43,'(a10,i5)') 'nLay: ',iLay + write(43,'(a10,14f12.7)') 'tau_cld: ',sw_optical_props_cloudsByBand%tau(1,iLay,:) + write(43,'(a10,14f12.7)') 'ssa_cld: ',sw_optical_props_cloudsByBand%ssa(1,iLay,:) + write(43,'(a10,14f12.7)') 'asy_cld: ',sw_optical_props_cloudsByBand%g(1,iLay,:) + write(43,'(a10,14f12.7)') 'tau_prec: ',sw_optical_props_precipByBand%tau(1,iLay,:) + write(43,'(a10,14f12.7)') 'ssa_prec: ',sw_optical_props_precipByBand%ssa(1,iLay,:) + write(43,'(a10,14f12.7)') 'asy_prec: ',sw_optical_props_precipByBand%g(1,iLay,:) + enddo + endif endif ! All-sky SW optical depth ~0.55microns @@ -452,6 +459,7 @@ end subroutine rrtmgp_sw_cloud_optics_run ! SUBROTUINE rrtmgp_sw_cloud_optics_finalize() ! ######################################################################################### subroutine rrtmgp_sw_cloud_optics_finalize() + close(43) end subroutine rrtmgp_sw_cloud_optics_finalize end module rrtmgp_sw_cloud_optics From 17e038239eef3fe6ae34a7774a6150be43c70ab3 Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Wed, 27 May 2020 13:18:05 -0600 Subject: [PATCH 23/50] Housekeeping --- physics/rrtmgp_sw_cloud_optics.F90 | 9 --------- physics/rrtmgp_sw_cloud_sampling.F90 | 5 ----- 2 files changed, 14 deletions(-) diff --git a/physics/rrtmgp_sw_cloud_optics.F90 b/physics/rrtmgp_sw_cloud_optics.F90 index 55a4304eb..78b6f7e2a 100644 --- a/physics/rrtmgp_sw_cloud_optics.F90 +++ b/physics/rrtmgp_sw_cloud_optics.F90 @@ -437,15 +437,6 @@ subroutine rrtmgp_sw_cloud_optics_run(doSWrad, doG_cldoptics, doGP_cldoptics_PAD sw_optical_props_precipByBand%ssa(:,:,2:sw_gas_props%get_nband()) = ssa_precip(:,:,1:sw_gas_props%get_nband()-1) sw_optical_props_precipByBand%g(:,:,2:sw_gas_props%get_nband()) = asy_precip(:,:,1:sw_gas_props%get_nband()-1) - do iLay=1,nLev - write(43,'(a10,i5)') 'nLay: ',iLay - write(43,'(a10,14f12.7)') 'tau_cld: ',sw_optical_props_cloudsByBand%tau(1,iLay,:) - write(43,'(a10,14f12.7)') 'ssa_cld: ',sw_optical_props_cloudsByBand%ssa(1,iLay,:) - write(43,'(a10,14f12.7)') 'asy_cld: ',sw_optical_props_cloudsByBand%g(1,iLay,:) - write(43,'(a10,14f12.7)') 'tau_prec: ',sw_optical_props_precipByBand%tau(1,iLay,:) - write(43,'(a10,14f12.7)') 'ssa_prec: ',sw_optical_props_precipByBand%ssa(1,iLay,:) - write(43,'(a10,14f12.7)') 'asy_prec: ',sw_optical_props_precipByBand%g(1,iLay,:) - enddo endif endif diff --git a/physics/rrtmgp_sw_cloud_sampling.F90 b/physics/rrtmgp_sw_cloud_sampling.F90 index f2069bb95..1104c8ae4 100644 --- a/physics/rrtmgp_sw_cloud_sampling.F90 +++ b/physics/rrtmgp_sw_cloud_sampling.F90 @@ -234,11 +234,6 @@ subroutine rrtmgp_sw_cloud_sampling_run(doSWrad, nCol, nDay, nLev, ipsdsw0, idxd enddo enddo enddo - -! call combine_optics_2str(sw_optical_props_precip%tau, sw_optical_props_precip%ssa, & -! sw_optical_props_precip%g,sw_optical_props_clouds%tau,& -! sw_optical_props_clouds%ssa, sw_optical_props_clouds%g) - end subroutine rrtmgp_sw_cloud_sampling_run ! ######################################################################################### From f49767db2b82519518ed2f474806ae32789176cf Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Thu, 28 May 2020 11:11:18 -0600 Subject: [PATCH 24/50] Add print statements for UFS debugging. --- physics/rrtmgp_sw_cloud_sampling.F90 | 3 +++ 1 file changed, 3 insertions(+) diff --git a/physics/rrtmgp_sw_cloud_sampling.F90 b/physics/rrtmgp_sw_cloud_sampling.F90 index 1104c8ae4..c335dfc81 100644 --- a/physics/rrtmgp_sw_cloud_sampling.F90 +++ b/physics/rrtmgp_sw_cloud_sampling.F90 @@ -204,9 +204,12 @@ subroutine rrtmgp_sw_cloud_sampling_run(doSWrad, nCol, nDay, nLev, ipsdsw0, idxd ! ! For GFDL MP just add precipitation optics to cloud-optics ! + print*,'ShapeC: ',shape(sw_optical_props_clouds%tau) + print*,'ShapeP: ',shape(sw_optical_props_precip%tau) do iGpt=1,sw_gas_props%get_ngpt() do iCol=1,nCol do iLay=1,nLev + write(*,"(a10,3i,2f10.4)") 'tauloc: ',iGpt,iCol,iLay,sw_optical_props_clouds%tau(iCol,iLay,iGpt),sw_optical_props_precip%tau(iCol,iLay,iGpt) tauloc = sw_optical_props_clouds%tau(iCol,iLay,iGpt) + & sw_optical_props_precip%tau(iCol,iLay,iGpt) if (tauloc > 0) then From 70f1c0d1c9faee1156ed908d162999d749b69a2e Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Thu, 28 May 2020 13:34:04 -0600 Subject: [PATCH 25/50] Cleanup SW cloud sampling routine. --- physics/rrtmgp_sw_cloud_sampling.F90 | 99 +++++++++++++--------------- 1 file changed, 46 insertions(+), 53 deletions(-) diff --git a/physics/rrtmgp_sw_cloud_sampling.F90 b/physics/rrtmgp_sw_cloud_sampling.F90 index c335dfc81..ced442e66 100644 --- a/physics/rrtmgp_sw_cloud_sampling.F90 +++ b/physics/rrtmgp_sw_cloud_sampling.F90 @@ -25,10 +25,10 @@ subroutine rrtmgp_sw_cloud_sampling_init(sw_gas_props, ipsdsw0) ! Outputs integer, intent(out) :: & ipsdsw0 ! Initial permutation seed for McICA - + ! Set initial permutation seed for McICA, initially set to number of G-points ipsdsw0 = sw_gas_props%get_ngpt() - + end subroutine rrtmgp_sw_cloud_sampling_init ! ######################################################################################### @@ -91,14 +91,14 @@ subroutine rrtmgp_sw_cloud_sampling_run(doSWrad, nCol, nDay, nLev, ipsdsw0, idxd errmsg = '' errflg = 0 - ! + ! Only works w/ SDFs v15p2 and v16beta if (iovrsw .ne. 1 .and. iovrsw .ne. 3) then - errmsg = 'Cloud overlap assumption not supported by GFDL microphysics suite.' - errflg = 1 - call check_error_msg('rrtmgp_sw_cloud_sampling',errmsg) - return - endif - + errmsg = 'Cloud overlap assumption not supported by GFDL microphysics suite.' + errflg = 1 + call check_error_msg('rrtmgp_sw_cloud_sampling',errmsg) + return + endif + if (.not. doSWrad) return if (nDay .gt. 0) then ! @@ -106,7 +106,7 @@ subroutine rrtmgp_sw_cloud_sampling_run(doSWrad, nCol, nDay, nLev, ipsdsw0, idxd ! ! 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)) + sw_optical_props_clouds%alloc_2str(nday, nLev, sw_gas_props)) ! Change random number seed value for each radiation invocation (isubcsw =1 or 2). if(isubcsw == 1) then ! advance prescribed permutation seed @@ -120,30 +120,27 @@ subroutine rrtmgp_sw_cloud_sampling_run(doSWrad, nCol, nDay, nLev, ipsdsw0, idxd endif ! Call McICA to generate subcolumns. - ! No need to call RNG second time for now, just use the same seeds for precip as clouds. - !! 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_sw(icol),rng_stat) - ! call random_number(rng1D,rng_stat) - ! rng3D(:,:,iCol) = reshape(source = rng1D,shape=[sw_gas_props%get_ngpt(),nLev]) - !enddo + ! 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_sw(icol),rng_stat) + call random_number(rng1D,rng_stat) + rng3D(:,:,iCol) = reshape(source = rng1D,shape=[sw_gas_props%get_ngpt(),nLev]) + enddo ! Call McICA select case ( iovrsw ) case(1) ! Maximum-random call check_error_msg('rrtmgp_sw_cloud_sampling_run', & - sampled_mask_max_ran(rng3D,cld_frac,cldfracMCICA)) + sampled_mask_max_ran(rng3D,cld_frac,cldfracMCICA)) case(3) ! Exponential-random - ! No need to call RNG second time for now, just use the same seeds for precip as clouds. - !! Generate second RNG - !do iCol=1,ncol - ! call random_setseed(ipseed_sw(icol),rng_stat) - ! call random_number(rng1D,rng_stat) - ! rng3D2(:,:,iCol) = reshape(source = rng1D,shape=[sw_gas_props%get_ngpt(),nLev]) - !enddo + do iCol=1,ncol + call random_setseed(ipseed_sw(icol),rng_stat) + call random_number(rng1D,rng_stat) + rng3D2(:,:,iCol) = reshape(source = rng1D,shape=[sw_gas_props%get_ngpt(),nLev]) + enddo call check_error_msg('rrtmgp_sw_cloud_sampling_run', & - sampled_mask_exp_dcorr(rng3D,rng3D2,cld_frac,cloud_overlap_param(:,1:nLev-1),cldfracMCICA)) + sampled_mask_exp_dcorr(rng3D,rng3D2,cld_frac,cloud_overlap_param(:,1:nLev-1),cldfracMCICA)) end select ! Map band optical depth to each g-point using McICA @@ -182,37 +179,32 @@ subroutine rrtmgp_sw_cloud_sampling_run(doSWrad, nCol, nDay, nLev, ipsdsw0, idxd select case ( iovrsw ) case(1) ! Maximum-random call check_error_msg('rrtmgp_sw_cloud_sampling_run', & - sampled_mask_max_ran(rng3D,precip_frac,precipfracSAMP)) + sampled_mask_max_ran(rng3D,precip_frac,precipfracSAMP)) case(3) ! Exponential-random - ! No need to call RNG second time for now, just use the same seeds for precip as clouds. !! Generate second RNG - !do iCol=1,ncol - !call random_setseed(ipseed_sw(icol),rng_stat) - ! call random_number(rng1D,rng_stat) - ! rng3D2(:,:,iCol) = reshape(source = rng1D,shape=[sw_gas_props%get_ngpt(),nLev]) - !enddo + !do iCol=1,ncol + ! call random_setseed(ipseed_sw(icol),rng_stat) + ! call random_number(rng1D,rng_stat) + ! rng3D2(:,:,iCol) = reshape(source = rng1D,shape=[sw_gas_props%get_ngpt(),nLev]) + !enddo call check_error_msg('rrtmgp_sw_cloud_sampling_run', & - sampled_mask_exp_dcorr(rng3D,rng3D2,precip_frac,precip_overlap_param(:,1:nLev-1),precipfracSAMP)) + sampled_mask_exp_dcorr(rng3D,rng3D2,precip_frac,precip_overlap_param(:,1:nLev-1),precipfracSAMP)) end select ! Map band optical depth to each g-point using McICA call check_error_msg('rrtmgp_sw_cloud_sampling_run',draw_samples(& - precipfracSAMP(idxday(1:nDay),:,:),sw_optical_props_precipByBand,sw_optical_props_precip)) - + precipfracSAMP(idxday(1:nDay),:,:),sw_optical_props_precipByBand,sw_optical_props_precip)) endif ! - ! For GFDL MP just add precipitation optics to cloud-optics + ! For GFDL MP just add precipitation optics to cloud-optics ! - print*,'ShapeC: ',shape(sw_optical_props_clouds%tau) - print*,'ShapeP: ',shape(sw_optical_props_precip%tau) - do iGpt=1,sw_gas_props%get_ngpt() - do iCol=1,nCol - do iLay=1,nLev - write(*,"(a10,3i,2f10.4)") 'tauloc: ',iGpt,iCol,iLay,sw_optical_props_clouds%tau(iCol,iLay,iGpt),sw_optical_props_precip%tau(iCol,iLay,iGpt) - tauloc = sw_optical_props_clouds%tau(iCol,iLay,iGpt) + & - sw_optical_props_precip%tau(iCol,iLay,iGpt) - if (tauloc > 0) then + do iGpt=1,sw_gas_props%get_ngpt() + do iCol=1,nCol + do iLay=1,nLev + tauloc = sw_optical_props_clouds%tau(iCol,iLay,iGpt) + & + sw_optical_props_precip%tau(iCol,iLay,iGpt) + if (sw_optical_props_precip%tau(iCol,iLay,iGpt) > 0) then ssaloc = (sw_optical_props_clouds%tau(iCol,iLay,iGpt) * & sw_optical_props_clouds%ssa(iCol,iLay,iGpt) + & sw_optical_props_precip%tau(iCol,iLay,iGpt) * & @@ -227,16 +219,17 @@ subroutine rrtmgp_sw_cloud_sampling_run(doSWrad, nCol, nDay, nLev, ipsdsw0, idxd sw_optical_props_precip%g(iCol,iLay,iGpt)) / & (tauloc*ssaloc) else - ssaloc = 1. - asyloc = 0. - endif + tauloc = sw_optical_props_clouds%tau(iCol,iLay,iGpt) + ssaloc = sw_optical_props_clouds%ssa(iCol,iLay,iGpt) + asyloc = sw_optical_props_clouds%g(iCol,iLay,iGpt) + endif sw_optical_props_clouds%tau(iCol,iLay,iGpt) = tauloc sw_optical_props_clouds%ssa(iCol,iLay,iGpt) = ssaloc sw_optical_props_clouds%g(iCol,iLay,iGpt) = asyloc - endif - enddo + endif + enddo enddo - enddo + enddo end subroutine rrtmgp_sw_cloud_sampling_run ! ######################################################################################### From 24376d32a7ba150713ffc6ab3de82e530670bfc9 Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Thu, 28 May 2020 13:59:36 -0600 Subject: [PATCH 26/50] Try using cloud-fraction for precipitation sampling. --- physics/rrtmgp_sw_cloud_optics.F90 | 4 ++-- physics/rrtmgp_sw_cloud_sampling.F90 | 5 ++--- 2 files changed, 4 insertions(+), 5 deletions(-) diff --git a/physics/rrtmgp_sw_cloud_optics.F90 b/physics/rrtmgp_sw_cloud_optics.F90 index 78b6f7e2a..a5f470617 100644 --- a/physics/rrtmgp_sw_cloud_optics.F90 +++ b/physics/rrtmgp_sw_cloud_optics.F90 @@ -356,14 +356,14 @@ subroutine rrtmgp_sw_cloud_optics_run(doSWrad, doG_cldoptics, doGP_cldoptics_PAD call check_error_msg('rrtmgp_sw_cloud_optics_run',sw_optical_props_cloudsByBand%alloc_2str(& nday, nLev, sw_gas_props%get_band_lims_wavenumber())) sw_optical_props_cloudsByBand%tau(:,:,:) = 0._kind_phys - sw_optical_props_cloudsByBand%ssa(:,:,:) = 0._kind_phys + sw_optical_props_cloudsByBand%ssa(:,:,:) = 1._kind_phys sw_optical_props_cloudsByBand%g(:,:,:) = 0._kind_phys ! Cloud-precipitation optics [nday,nLev,nBands] call check_error_msg('rrtmgp_sw_cloud_optics_run',sw_optical_props_precipByBand%alloc_2str(& nday, nLev, sw_gas_props%get_band_lims_wavenumber())) sw_optical_props_precipByBand%tau(:,:,:) = 0._kind_phys - sw_optical_props_precipByBand%ssa(:,:,:) = 0._kind_phys + sw_optical_props_precipByBand%ssa(:,:,:) = 1._kind_phys sw_optical_props_precipByBand%g(:,:,:) = 0._kind_phys ! Compute cloud/precipitation optics. diff --git a/physics/rrtmgp_sw_cloud_sampling.F90 b/physics/rrtmgp_sw_cloud_sampling.F90 index ced442e66..8412bd56c 100644 --- a/physics/rrtmgp_sw_cloud_sampling.F90 +++ b/physics/rrtmgp_sw_cloud_sampling.F90 @@ -11,9 +11,8 @@ module rrtmgp_sw_cloud_sampling implicit none contains - ! ######################################################################################### - ! SUBROUTINE mcica_init + ! SUBROUTINE rrtmgp_sw_cloud_sampling_init() ! ######################################################################################### !! \section arg_table_rrtmgp_sw_cloud_sampling_init !! \htmlinclude rrtmgp_sw_cloud_sampling.html @@ -193,7 +192,7 @@ subroutine rrtmgp_sw_cloud_sampling_run(doSWrad, nCol, nDay, nLev, ipsdsw0, idxd ! Map band optical depth to each g-point using McICA call check_error_msg('rrtmgp_sw_cloud_sampling_run',draw_samples(& - precipfracSAMP(idxday(1:nDay),:,:),sw_optical_props_precipByBand,sw_optical_props_precip)) + cldfracMCICA(idxday(1:nDay),:,:),sw_optical_props_precipByBand,sw_optical_props_precip)) endif ! From 0d7483337842a7f50bf003818b37e316a46904d3 Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Thu, 28 May 2020 14:30:57 -0600 Subject: [PATCH 27/50] Fixed nDay/nCol bug in sw cloud sampling. --- physics/rrtmgp_sw_cloud_sampling.F90 | 114 ++++++++++++++------------- 1 file changed, 59 insertions(+), 55 deletions(-) diff --git a/physics/rrtmgp_sw_cloud_sampling.F90 b/physics/rrtmgp_sw_cloud_sampling.F90 index 8412bd56c..6d0f9ee97 100644 --- a/physics/rrtmgp_sw_cloud_sampling.F90 +++ b/physics/rrtmgp_sw_cloud_sampling.F90 @@ -78,13 +78,13 @@ subroutine rrtmgp_sw_cloud_sampling_run(doSWrad, nCol, nDay, nLev, ipsdsw0, idxd sw_optical_props_precip ! RRTMGP DDT: Shortwave optical properties at each spectral point (precipitation) ! Local variables - integer :: iCol,iLay,iGpt - integer,dimension(ncol) :: ipseed_sw + 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,ncol) :: rng3D,rng3D2 + real(kind_phys), dimension(sw_gas_props%get_ngpt(),nLev,nday) :: rng3D,rng3D2 real(kind_phys), dimension(sw_gas_props%get_ngpt()*nLev) :: rng1D - logical, dimension(ncol,nLev,sw_gas_props%get_ngpt()) :: cldfracMCICA,precipfracSAMP + logical, dimension(nday,nLev,sw_gas_props%get_ngpt()) :: cldfracMCICA,precipfracSAMP ! Initialize CCPP error handling variables errmsg = '' @@ -109,42 +109,44 @@ subroutine rrtmgp_sw_cloud_sampling_run(doSWrad, nCol, nDay, nLev, ipsdsw0, idxd ! Change random number seed value for each radiation invocation (isubcsw =1 or 2). if(isubcsw == 1) then ! advance prescribed permutation seed - do iCol = 1, ncol - ipseed_sw(iCol) = ipsdsw0 + iCol + do iday = 1, nday + ipseed_sw(iday) = ipsdsw0 + iday enddo elseif (isubcsw == 2) then ! use input array of permutaion seeds - do iCol = 1, ncol - ipseed_sw(iCol) = icseed_sw(iCol) + do iday = 1, nday + ipseed_sw(iday) = icseed_sw(iday) enddo endif ! Call McICA to generate subcolumns. ! 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_sw(icol),rng_stat) + ! and layers. ([nGpts,nLev,nDayumn]-> [nGpts*nLev]*nDayumn) + do iday=1,nday + call random_setseed(ipseed_sw(iday),rng_stat) call random_number(rng1D,rng_stat) - rng3D(:,:,iCol) = reshape(source = rng1D,shape=[sw_gas_props%get_ngpt(),nLev]) + rng3D(:,:,iday) = reshape(source = rng1D,shape=[sw_gas_props%get_ngpt(),nLev]) enddo ! Call McICA select case ( iovrsw ) case(1) ! Maximum-random call check_error_msg('rrtmgp_sw_cloud_sampling_run', & - sampled_mask_max_ran(rng3D,cld_frac,cldfracMCICA)) + sampled_mask_max_ran(rng3D,cld_frac(idxday(1:nDay),:),cldfracMCICA)) case(3) ! Exponential-random - do iCol=1,ncol - call random_setseed(ipseed_sw(icol),rng_stat) + do iday=1,nday + call random_setseed(ipseed_sw(iday),rng_stat) call random_number(rng1D,rng_stat) - rng3D2(:,:,iCol) = reshape(source = rng1D,shape=[sw_gas_props%get_ngpt(),nLev]) + rng3D2(:,:,iday) = reshape(source = rng1D,shape=[sw_gas_props%get_ngpt(),nLev]) enddo call check_error_msg('rrtmgp_sw_cloud_sampling_run', & - sampled_mask_exp_dcorr(rng3D,rng3D2,cld_frac,cloud_overlap_param(:,1:nLev-1),cldfracMCICA)) + sampled_mask_exp_dcorr(rng3D, rng3D2, cld_frac(idxday(1:nDay),:), & + cloud_overlap_param(idxday(1:nDay),1:nLev-1), & + cldfracMCICA)) end select ! Map band optical depth to each g-point using McICA - call check_error_msg('rrtmgp_sw_cloud_sampling_run',draw_samples(& - cldfracMCICA(idxday(1:nDay),:,:),sw_optical_props_cloudsByBand,sw_optical_props_clouds)) + call check_error_msg('rrtmgp_sw_cloud_sampling_run', & + draw_samples(cldfracMCICA, sw_optical_props_cloudsByBand, sw_optical_props_clouds)) ! ! Next sample precipitation (same as clouds for now) @@ -155,76 +157,78 @@ subroutine rrtmgp_sw_cloud_sampling_run(doSWrad, nCol, nDay, nLev, ipsdsw0, idxd ! Change random number seed value for each radiation invocation (isubcsw =1 or 2). !if(isubcsw == 1) then ! advance prescribed permutation seed - ! do iCol = 1, ncol - ! ipseed_sw(iCol) = ipsdsw0 + iCol + ! do iday = 1, nday + ! ipseed_sw(iday) = ipsdsw0 + iday ! enddo !elseif (isubcsw == 2) then ! use input array of permutaion seeds - ! do iCol = 1, ncol - ! ipseed_sw(iCol) = icseed_sw(iCol) + ! do iday = 1, nday + ! ipseed_sw(iday) = icseed_sw(iday) ! enddo !endif ! Call McICA to generate subcolumns. ! No need to call RNG second time for now, just use the same seeds for precip as clouds. !! 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_sw(icol),rng_stat) + !! and layers. ([nGpts,nLev,nDay]-> [nGpts*nLev]*nDay) + !do iday=1,nday + ! call random_setseed(ipseed_sw(iday),rng_stat) ! call random_number(rng1D,rng_stat) - ! rng3D(:,:,iCol) = reshape(source = rng1D,shape=[sw_gas_props%get_ngpt(),nLev]) + ! rng3D(:,:,iday) = reshape(source = rng1D,shape=[sw_gas_props%get_ngpt(),nLev]) !enddo ! Call McICA select case ( iovrsw ) case(1) ! Maximum-random call check_error_msg('rrtmgp_sw_cloud_sampling_run', & - sampled_mask_max_ran(rng3D,precip_frac,precipfracSAMP)) + sampled_mask_max_ran(rng3D,precip_frac(idxday(1:nDay),:),precipfracSAMP)) case(3) ! Exponential-random !! Generate second RNG - !do iCol=1,ncol - ! call random_setseed(ipseed_sw(icol),rng_stat) + !do iday=1,nday + ! call random_setseed(ipseed_sw(iday),rng_stat) ! call random_number(rng1D,rng_stat) - ! rng3D2(:,:,iCol) = reshape(source = rng1D,shape=[sw_gas_props%get_ngpt(),nLev]) + ! rng3D2(:,:,iday) = reshape(source = rng1D,shape=[sw_gas_props%get_ngpt(),nLev]) !enddo - call check_error_msg('rrtmgp_sw_cloud_sampling_run', & - sampled_mask_exp_dcorr(rng3D,rng3D2,precip_frac,precip_overlap_param(:,1:nLev-1),precipfracSAMP)) + call check_error_msg('rrtmgp_sw_cloud_sampling_run', & + sampled_mask_exp_dcorr(rng3D,rng3D2,precip_frac(idxday(1:nDay),:), & + precip_overlap_param(idxday(1:nDay),1:nLev-1), & + precipfracSAMP)) end select ! Map band optical depth to each g-point using McICA - call check_error_msg('rrtmgp_sw_cloud_sampling_run',draw_samples(& - cldfracMCICA(idxday(1:nDay),:,:),sw_optical_props_precipByBand,sw_optical_props_precip)) + call check_error_msg('rrtmgp_sw_cloud_sampling_run', & + draw_samples(precipfracSAMP, sw_optical_props_precipByBand, sw_optical_props_precip)) endif ! ! For GFDL MP just add precipitation optics to cloud-optics ! do iGpt=1,sw_gas_props%get_ngpt() - do iCol=1,nCol + do iday=1,nDay do iLay=1,nLev - tauloc = sw_optical_props_clouds%tau(iCol,iLay,iGpt) + & - sw_optical_props_precip%tau(iCol,iLay,iGpt) - if (sw_optical_props_precip%tau(iCol,iLay,iGpt) > 0) then - ssaloc = (sw_optical_props_clouds%tau(iCol,iLay,iGpt) * & - sw_optical_props_clouds%ssa(iCol,iLay,iGpt) + & - sw_optical_props_precip%tau(iCol,iLay,iGpt) * & - sw_optical_props_precip%ssa(iCol,iLay,iGpt)) / & + tauloc = sw_optical_props_clouds%tau(iday,iLay,iGpt) + & + sw_optical_props_precip%tau(iday,iLay,iGpt) + if (sw_optical_props_precip%tau(iday,iLay,iGpt) > 0) then + ssaloc = (sw_optical_props_clouds%tau(iday,iLay,iGpt) * & + sw_optical_props_clouds%ssa(iday,iLay,iGpt) + & + sw_optical_props_precip%tau(iday,iLay,iGpt) * & + sw_optical_props_precip%ssa(iday,iLay,iGpt)) / & tauloc if (ssaloc > 0) then - asyloc = (sw_optical_props_clouds%tau(iCol,iLay,iGpt) * & - sw_optical_props_clouds%ssa(iCol,iLay,iGpt) * & - sw_optical_props_clouds%g(iCol,iLay,iGpt) + & - sw_optical_props_precip%tau(iCol,iLay,iGpt) * & - sw_optical_props_precip%ssa(iCol,iLay,iGpt) * & - sw_optical_props_precip%g(iCol,iLay,iGpt)) / & + asyloc = (sw_optical_props_clouds%tau(iday,iLay,iGpt) * & + sw_optical_props_clouds%ssa(iday,iLay,iGpt) * & + sw_optical_props_clouds%g(iday,iLay,iGpt) + & + sw_optical_props_precip%tau(iday,iLay,iGpt) * & + sw_optical_props_precip%ssa(iday,iLay,iGpt) * & + sw_optical_props_precip%g(iday,iLay,iGpt)) / & (tauloc*ssaloc) else - tauloc = sw_optical_props_clouds%tau(iCol,iLay,iGpt) - ssaloc = sw_optical_props_clouds%ssa(iCol,iLay,iGpt) - asyloc = sw_optical_props_clouds%g(iCol,iLay,iGpt) + tauloc = sw_optical_props_clouds%tau(iday,iLay,iGpt) + ssaloc = sw_optical_props_clouds%ssa(iday,iLay,iGpt) + asyloc = sw_optical_props_clouds%g(iday,iLay,iGpt) endif - sw_optical_props_clouds%tau(iCol,iLay,iGpt) = tauloc - sw_optical_props_clouds%ssa(iCol,iLay,iGpt) = ssaloc - sw_optical_props_clouds%g(iCol,iLay,iGpt) = asyloc + sw_optical_props_clouds%tau(iday,iLay,iGpt) = tauloc + sw_optical_props_clouds%ssa(iday,iLay,iGpt) = ssaloc + sw_optical_props_clouds%g(iday,iLay,iGpt) = asyloc endif enddo enddo From 9d98056157ec6af0175b917bb73fbc69ed6b8799 Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Thu, 28 May 2020 14:51:41 -0600 Subject: [PATCH 28/50] Housekeeeping. Working with both EMC SDFs in SCM and UFS. --- physics/GFS_rrtmgp_gfdlmp_pre.F90 | 80 ++++++++++++++-------------- physics/rrtmgp_lw_cloud_optics.F90 | 46 ++++++++-------- physics/rrtmgp_lw_cloud_sampling.F90 | 14 ++--- physics/rrtmgp_sw_cloud_optics.F90 | 77 +++++++++++++------------- 4 files changed, 107 insertions(+), 110 deletions(-) diff --git a/physics/GFS_rrtmgp_gfdlmp_pre.F90 b/physics/GFS_rrtmgp_gfdlmp_pre.F90 index 0ab67baa9..976443055 100644 --- a/physics/GFS_rrtmgp_gfdlmp_pre.F90 +++ b/physics/GFS_rrtmgp_gfdlmp_pre.F90 @@ -80,38 +80,38 @@ subroutine GFS_rrtmgp_gfdlmp_pre_run(Model, Tbd, nCol, nLev, p_lev, tracer, ! Test inputs if (Model%ncnd .ne. 5) then - errmsg = 'Incorrect number of cloud condensates provided' - errflg = 1 - call check_error_msg('GFS_rrtmgp_gfdlmp_pre_run',errmsg) - return + errmsg = 'Incorrect number of cloud condensates provided' + errflg = 1 + call check_error_msg('GFS_rrtmgp_gfdlmp_pre_run',errmsg) + return endif ! if (lcrick) then - errmsg = 'Namelist option lcrick is not supported.' - errflg = 1 - call check_error_msg('GFS_rrtmgp_gfdlmp_pre_run',errmsg) - return + errmsg = 'Namelist option lcrick is not supported.' + errflg = 1 + call check_error_msg('GFS_rrtmgp_gfdlmp_pre_run',errmsg) + return endif ! if (lcnorm) then - errmsg = 'Namelist option lcnorm is not supported.' - errflg = 1 - call check_error_msg('GFS_rrtmgp_gfdlmp_pre_run',errmsg) - return - endif + errmsg = 'Namelist option lcnorm is not supported.' + errflg = 1 + call check_error_msg('GFS_rrtmgp_gfdlmp_pre_run',errmsg) + return + endif ! if (.not. Model%lgfdlmprad) then - errmsg = 'Namelist option gfdlmprad=F is not supported.' - errflg = 1 - call check_error_msg('GFS_rrtmgp_gfdlmp_pre_run',errmsg) - return + errmsg = 'Namelist option gfdlmprad=F is not supported.' + errflg = 1 + call check_error_msg('GFS_rrtmgp_gfdlmp_pre_run',errmsg) + return endif ! if(.not. Model%effr_in) then - errmsg = 'Namelist option effr_in=F is not supported.' - errflg = 1 - call check_error_msg('GFS_rrtmgp_gfdlmp_pre_run',errmsg) - return + errmsg = 'Namelist option effr_in=F is not supported.' + errflg = 1 + call check_error_msg('GFS_rrtmgp_gfdlmp_pre_run',errmsg) + return endif ! Initialize outputs @@ -148,35 +148,35 @@ subroutine GFS_rrtmgp_gfdlmp_pre_run(Model, Tbd, nCol, nLev, p_lev, tracer, ! Cloud-fraction cld_frac(1:nCol,1:nLev) = tracer(1:nCol,1:nLev,Model%ntclamt) - + ! Precipitation fraction (Hack. For now use cloud-fraction) precip_frac(1:nCol,1:nLev) = tracer(1:nCol,1:nLev,Model%ntclamt) - ! Condensate and effective size - deltaP = abs(p_lev(:,2:nLev+1)-p_lev(:,1:nLev))/100. + ! Condensate and effective size + deltaP = abs(p_lev(:,2:nLev+1)-p_lev(:,1:nLev))/100. do k = 1, nLev do i = 1, nCol - ! Compute liquid/ice condensate path from mixing ratios (kg/kg)->(g/m2) - if (cld_frac(i,k) .ge. cllimit) then - tem1 = gfac * deltaP(i,k) - cld_lwp(i,k) = cld_condensate(i,k,1) * tem1 - cld_iwp(i,k) = cld_condensate(i,k,2) * tem1 - cld_rwp(i,k) = cld_condensate(i,k,3) * tem1 - cld_swp(i,k) = cld_condensate(i,k,4) * tem1 - endif - ! Use radii provided from the macrophysics - cld_reliq(i,k) = Tbd%phy_f3d(i,k,1) - cld_reice(i,k) = max(reice_min, min(reice_max,Tbd%phy_f3d(i,k,2))) - cld_rerain(i,k) = Tbd%phy_f3d(i,k,3) - cld_resnow(i,k) = Tbd%phy_f3d(i,k,4) - enddo + ! Compute liquid/ice condensate path from mixing ratios (kg/kg)->(g/m2) + if (cld_frac(i,k) .ge. cllimit) then + tem1 = gfac * deltaP(i,k) + cld_lwp(i,k) = cld_condensate(i,k,1) * tem1 + cld_iwp(i,k) = cld_condensate(i,k,2) * tem1 + cld_rwp(i,k) = cld_condensate(i,k,3) * tem1 + cld_swp(i,k) = cld_condensate(i,k,4) * tem1 + endif + ! Use radii provided from the macrophysics + cld_reliq(i,k) = Tbd%phy_f3d(i,k,1) + cld_reice(i,k) = max(reice_min, min(reice_max,Tbd%phy_f3d(i,k,2))) + cld_rerain(i,k) = Tbd%phy_f3d(i,k,3) + cld_resnow(i,k) = Tbd%phy_f3d(i,k,4) + enddo enddo end subroutine GFS_rrtmgp_gfdlmp_pre_run - + ! ######################################################################################### ! ######################################################################################### subroutine GFS_rrtmgp_gfdlmp_pre_finalize() end subroutine GFS_rrtmgp_gfdlmp_pre_finalize - + end module GFS_rrtmgp_gfdlmp_pre diff --git a/physics/rrtmgp_lw_cloud_optics.F90 b/physics/rrtmgp_lw_cloud_optics.F90 index aee4533a0..93e38994b 100644 --- a/physics/rrtmgp_lw_cloud_optics.F90 +++ b/physics/rrtmgp_lw_cloud_optics.F90 @@ -353,25 +353,25 @@ subroutine rrtmgp_lw_cloud_optics_run(doLWrad, doG_cldoptics, doGP_cldoptics_PAD cld_reice, & ! IN - Cloud ice effective radius (microns) lw_optical_props_cloudsByBand)) ! OUT - RRTMGP DDT containing cloud radiative properties ! in each band - ! Add in rain and snow(+groupel) - 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,lw_gas_props%get_nband() - lw_optical_props_precipByBand%tau(iCol,iLay,iBand) = tau_rain + tau_snow - enddo - endif - enddo - enddo + ! Add in rain and snow(+groupel) + 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,lw_gas_props%get_nband() + lw_optical_props_precipByBand%tau(iCol,iLay,iBand) = tau_rain + tau_snow + enddo + endif + enddo + enddo endif if (doG_cldoptics) then ! ii) RRTMG cloud-optics. @@ -382,11 +382,11 @@ subroutine rrtmgp_lw_cloud_optics_run(doLWrad, doG_cldoptics, doGP_cldoptics_PAD endif lw_optical_props_cloudsByBand%tau = tau_cld lw_optical_props_precipByBand%tau = tau_precip - endif - - ! All-sky LW optical depth ~10microns + 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 ! ######################################################################################### diff --git a/physics/rrtmgp_lw_cloud_sampling.F90 b/physics/rrtmgp_lw_cloud_sampling.F90 index d783af9c1..2a9374e5c 100644 --- a/physics/rrtmgp_lw_cloud_sampling.F90 +++ b/physics/rrtmgp_lw_cloud_sampling.F90 @@ -89,12 +89,12 @@ subroutine rrtmgp_lw_cloud_sampling_run(doLWrad, nCol, nLev, ipsdlw0, icseed_lw, ! if (iovrlw .ne. 1 .and. iovrlw .ne. 3) then - errmsg = 'Cloud overlap assumption not supported by GFDL microphysics suite.' - errflg = 1 - call check_error_msg('rrtmgp_lw_cloud_sampling',errmsg) - return - endif - + errmsg = 'Cloud overlap assumption not supported by GFDL microphysics suite.' + errflg = 1 + call check_error_msg('rrtmgp_lw_cloud_sampling',errmsg) + return + endif + if (.not. doLWrad) return ! ! First sample the clouds... @@ -193,7 +193,7 @@ subroutine rrtmgp_lw_cloud_sampling_run(doLWrad, nCol, nLev, ipsdlw0, icseed_lw, precipfracSAMP,lw_optical_props_precipByBand,lw_optical_props_precip)) ! - ! For GFDL MP just add precipitation optics to cloud-optics + ! For GFDL MP just add precipitation optics to cloud-optics ! lw_optical_props_clouds%tau = lw_optical_props_clouds%tau + lw_optical_props_precip%tau diff --git a/physics/rrtmgp_sw_cloud_optics.F90 b/physics/rrtmgp_sw_cloud_optics.F90 index a5f470617..7ab3c27e3 100644 --- a/physics/rrtmgp_sw_cloud_optics.F90 +++ b/physics/rrtmgp_sw_cloud_optics.F90 @@ -28,14 +28,14 @@ module rrtmgp_sw_cloud_optics !! \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, sw_cloud_props,& - errmsg, errflg) + nrghice, rrtmgp_root_dir, rrtmgp_sw_file_clouds, mpicomm, mpirank, mpiroot, sw_cloud_props,& + 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? + 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 integer, intent(in) :: & @@ -45,7 +45,7 @@ subroutine rrtmgp_sw_cloud_optics_init(doG_cldoptics, doGP_cldoptics_PADE, doGP_ 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 type(ty_cloud_optics),intent(out) :: & sw_cloud_props ! RRTMGP DDT: shortwave spectral information @@ -53,7 +53,7 @@ subroutine rrtmgp_sw_cloud_optics_init(doG_cldoptics, doGP_cldoptics_PADE, doGP_ errmsg ! CCPP error message integer, intent(out) :: & errflg ! CCPP error code - + ! Variables that will be passed to cloud_optics%load() real(kind_phys) :: & radliq_lwr, & ! Liquid particle size lower bound for LUT interpolation @@ -268,18 +268,16 @@ subroutine rrtmgp_sw_cloud_optics_init(doG_cldoptics, doGP_cldoptics_PADE, doGP_ allocate(b0r(sw_cloud_props%get_nband()),b0s(sw_cloud_props%get_nband()), & b1s(sw_cloud_props%get_nband()),c0r(sw_cloud_props%get_nband()), & c0s(sw_cloud_props%get_nband())) - b0r = (/0.496, 0.466, 0.437, 0.416, 0.391, 0.374, 0.352, & - 0.183, 0.048, 0.012, 0.000, 0.000, 0.000, 0.000/) - b0s = (/0.460, 0.460, 0.460, 0.460, 0.460, 0.460, 0.460, & - 0.460, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000/) - b1s = (/0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000,& + b0r = (/0.496, 0.466, 0.437, 0.416, 0.391, 0.374, 0.352, & + 0.183, 0.048, 0.012, 0.000, 0.000, 0.000, 0.000/) + b0s = (/0.460, 0.460, 0.460, 0.460, 0.460, 0.460, 0.460, & + 0.460, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000/) + b1s = (/0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & 0.000, 1.62e-5, 1.62e-5, 0.000, 0.000, 0.000, 0.000/) - c0r = (/0.980, 0.975, 0.965, 0.960, 0.955, 0.952, 0.950, & - 0.944, 0.894, 0.884, 0.883, 0.883, 0.883, 0.883/) - c0s = (/0.970, 0.970, 0.970, 0.970, 0.970, 0.970, 0.970, & - 0.970, 0.970, 0.970, 0.700, 0.700, 0.700, 0.700/) - - open(43,file='dumpGP.optics.txt',status='unknown') + c0r = (/0.980, 0.975, 0.965, 0.960, 0.955, 0.952, 0.950, & + 0.944, 0.894, 0.884, 0.883, 0.883, 0.883, 0.883/) + c0s = (/0.970, 0.970, 0.970, 0.970, 0.970, 0.970, 0.970, & + 0.970, 0.970, 0.970, 0.700, 0.700, 0.700, 0.700/) end subroutine rrtmgp_sw_cloud_optics_init @@ -323,7 +321,7 @@ subroutine rrtmgp_sw_cloud_optics_run(doSWrad, doG_cldoptics, doGP_cldoptics_PAD sw_cloud_props ! RRTMGP DDT: shortwave cloud properties type(ty_gas_optics_rrtmgp),intent(in) :: & sw_gas_props ! RRTMGP DDT: shortwave K-distribution data - + ! Outputs character(len=*), intent(out) :: & errmsg ! CCPP error message @@ -334,18 +332,18 @@ subroutine rrtmgp_sw_cloud_optics_run(doSWrad, doG_cldoptics, doGP_cldoptics_PAD sw_optical_props_precipByBand ! RRTMGP DDT: Shortwave optical properties in each band (cloud precipitation) real(kind_phys), dimension(ncol,NLev), 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,sw_gas_props%get_nband()) :: & tau_cld, ssa_cld, asy_cld, tau_precip, ssa_precip, asy_precip - + ! Initialize CCPP error handling variables errmsg = '' errflg = 0 - + if (.not. doSWrad) return ! Only process sunlit points... @@ -387,7 +385,7 @@ subroutine rrtmgp_sw_cloud_optics_run(doSWrad, doG_cldoptics, doGP_cldoptics_PAD else tau_snow = 0._kind_phys endif - + ! Rain/Snow single-scattering albedo and asymmetry (Band dependent) do iBand=1,sw_cloud_props%get_nband() ! By species @@ -395,8 +393,7 @@ subroutine rrtmgp_sw_cloud_optics_run(doSWrad, doG_cldoptics, doGP_cldoptics_PAD 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 + ! 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) @@ -407,10 +404,10 @@ subroutine rrtmgp_sw_cloud_optics_run(doSWrad, doG_cldoptics, doGP_cldoptics_PAD 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 + enddo endif - enddo - enddo + enddo + enddo endif if (doG_cldoptics) then ! RRTMG cloud(+precipitation) optics @@ -420,27 +417,28 @@ subroutine rrtmgp_sw_cloud_optics_run(doSWrad, doG_cldoptics, doGP_cldoptics_PAD cld_iwp(idxday(1:nday),:), cld_reice(idxday(1:nday),:), & cld_rwp(idxday(1:nday),:), cld_rerain(idxday(1:nday),:), & cld_swp(idxday(1:nday),:), cld_resnow(idxday(1:nday),:), & - cld_frac(idxday(1:nday),:), tau_cld, ssa_cld, asy_cld, tau_precip, ssa_precip, asy_precip) + cld_frac(idxday(1:nday),:), & + tau_cld, ssa_cld, asy_cld, & + tau_precip, ssa_precip, asy_precip) ! Cloud-optics (Need to reorder from G->GP band conventions) sw_optical_props_cloudsByBand%tau(:,:,1) = tau_cld(:,:,sw_gas_props%get_nband()) sw_optical_props_cloudsByBand%ssa(:,:,1) = ssa_cld(:,:,sw_gas_props%get_nband()) sw_optical_props_cloudsByBand%g(:,:,1) = asy_cld(:,:,sw_gas_props%get_nband()) - sw_optical_props_cloudsByBand%tau(:,:,2:sw_gas_props%get_nband()) = tau_cld(:,:,1:sw_gas_props%get_nband()-1) - sw_optical_props_cloudsByBand%ssa(:,:,2:sw_gas_props%get_nband()) = ssa_cld(:,:,1:sw_gas_props%get_nband()-1) - sw_optical_props_cloudsByBand%g(:,:,2:sw_gas_props%get_nband()) = asy_cld(:,:,1:sw_gas_props%get_nband()-1) + sw_optical_props_cloudsByBand%tau(:,:,2:sw_gas_props%get_nband()) = tau_cld(:,:,1:sw_gas_props%get_nband()-1) + sw_optical_props_cloudsByBand%ssa(:,:,2:sw_gas_props%get_nband()) = ssa_cld(:,:,1:sw_gas_props%get_nband()-1) + sw_optical_props_cloudsByBand%g(:,:,2:sw_gas_props%get_nband()) = asy_cld(:,:,1:sw_gas_props%get_nband()-1) ! Precipitation-optics (Need to reorder from G->GP band conventions) sw_optical_props_precipByBand%tau(:,:,1) = tau_precip(:,:,sw_gas_props%get_nband()) sw_optical_props_precipByBand%ssa(:,:,1) = ssa_precip(:,:,sw_gas_props%get_nband()) sw_optical_props_precipByBand%g(:,:,1) = asy_precip(:,:,sw_gas_props%get_nband()) - sw_optical_props_precipByBand%tau(:,:,2:sw_gas_props%get_nband()) = tau_precip(:,:,1:sw_gas_props%get_nband()-1) - sw_optical_props_precipByBand%ssa(:,:,2:sw_gas_props%get_nband()) = ssa_precip(:,:,1:sw_gas_props%get_nband()-1) - sw_optical_props_precipByBand%g(:,:,2:sw_gas_props%get_nband()) = asy_precip(:,:,1:sw_gas_props%get_nband()-1) - - endif + sw_optical_props_precipByBand%tau(:,:,2:sw_gas_props%get_nband()) = tau_precip(:,:,1:sw_gas_props%get_nband()-1) + sw_optical_props_precipByBand%ssa(:,:,2:sw_gas_props%get_nband()) = ssa_precip(:,:,1:sw_gas_props%get_nband()-1) + sw_optical_props_precipByBand%g(:,:,2:sw_gas_props%get_nband()) = asy_precip(:,:,1:sw_gas_props%get_nband()-1) + endif endif - - ! All-sky SW optical depth ~0.55microns + + ! All-sky SW optical depth ~0.55microns (DJS asks: Move to cloud diagnostics?) cldtausw(idxday(1:nDay),:) = sw_optical_props_cloudsByBand%tau(:,:,11) endif @@ -450,7 +448,6 @@ end subroutine rrtmgp_sw_cloud_optics_run ! SUBROTUINE rrtmgp_sw_cloud_optics_finalize() ! ######################################################################################### subroutine rrtmgp_sw_cloud_optics_finalize() - close(43) end subroutine rrtmgp_sw_cloud_optics_finalize end module rrtmgp_sw_cloud_optics From 499b3ddb629e02d8d4956323f8901799baf003f0 Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Mon, 1 Jun 2020 11:05:12 -0600 Subject: [PATCH 29/50] Renamed sampling routines. --- ...90 => rrtmgp_gfdlmp_lw_cloud_sampling.F90} | 48 +++++++++---------- ...a => rrtmgp_gfdlmp_lw_cloud_sampling.meta} | 4 +- ...90 => rrtmgp_gfdlmp_sw_cloud_sampling.F90} | 48 +++++++++---------- ...a => rrtmgp_gfdlmp_sw_cloud_sampling.meta} | 4 +- 4 files changed, 52 insertions(+), 52 deletions(-) rename physics/{rrtmgp_lw_cloud_sampling.F90 => rrtmgp_gfdlmp_lw_cloud_sampling.F90} (83%) rename physics/{rrtmgp_lw_cloud_sampling.meta => rrtmgp_gfdlmp_lw_cloud_sampling.meta} (97%) rename physics/{rrtmgp_sw_cloud_sampling.F90 => rrtmgp_gfdlmp_sw_cloud_sampling.F90} (87%) rename physics/{rrtmgp_sw_cloud_sampling.meta => rrtmgp_gfdlmp_sw_cloud_sampling.meta} (97%) diff --git a/physics/rrtmgp_lw_cloud_sampling.F90 b/physics/rrtmgp_gfdlmp_lw_cloud_sampling.F90 similarity index 83% rename from physics/rrtmgp_lw_cloud_sampling.F90 rename to physics/rrtmgp_gfdlmp_lw_cloud_sampling.F90 index 2a9374e5c..94c813a94 100644 --- a/physics/rrtmgp_lw_cloud_sampling.F90 +++ b/physics/rrtmgp_gfdlmp_lw_cloud_sampling.F90 @@ -1,4 +1,4 @@ -module rrtmgp_lw_cloud_sampling +module rrtmgp_gfdlmp_lw_cloud_sampling use machine, only: kind_phys use mo_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp use physparam, only: isubclw, iovrlw @@ -15,10 +15,10 @@ module rrtmgp_lw_cloud_sampling ! ######################################################################################### ! SUBROUTINE mcica_init ! ######################################################################################### -!! \section arg_table_rrtmgp_lw_cloud_sampling_init -!! \htmlinclude rrtmgp_lw_cloud_sampling_init.html +!! \section arg_table_rrtmgp_gfdlmp_lw_cloud_sampling_init +!! \htmlinclude rrtmgp_gfdlmp_lw_cloud_sampling_init.html !! - subroutine rrtmgp_lw_cloud_sampling_init(lw_gas_props, ipsdlw0) + subroutine rrtmgp_gfdlmp_lw_cloud_sampling_init(lw_gas_props, ipsdlw0) ! Inputs type(ty_gas_optics_rrtmgp),intent(in) :: & lw_gas_props ! RRTMGP DDT: K-distribution data @@ -29,16 +29,16 @@ subroutine rrtmgp_lw_cloud_sampling_init(lw_gas_props, ipsdlw0) ! Set initial permutation seed for McICA, initially set to number of G-points ipsdlw0 = lw_gas_props%get_ngpt() - end subroutine rrtmgp_lw_cloud_sampling_init + end subroutine rrtmgp_gfdlmp_lw_cloud_sampling_init ! ######################################################################################### - ! SUBROTUINE rrtmgp_lw_cloud_sampling_run() + ! SUBROTUINE rrtmgp_gfdlmp_lw_cloud_sampling_run() ! ######################################################################################### -!! \section arg_table_rrtmgp_lw_cloud_sampling_run -!! \htmlinclude rrtmgp_lw_cloud_sampling_run.html +!! \section arg_table_rrtmgp_gfdlmp_lw_cloud_sampling_run +!! \htmlinclude rrtmgp_gfdlmp_lw_cloud_sampling_run.html !! - subroutine rrtmgp_lw_cloud_sampling_run(doLWrad, nCol, nLev, ipsdlw0, icseed_lw, cld_frac,& - precip_frac, cloud_overlap_param, precip_overlap_param, lw_gas_props, & + subroutine rrtmgp_gfdlmp_lw_cloud_sampling_run(doLWrad, nCol, nLev, ipsdlw0, icseed_lw, & + cld_frac, precip_frac, cloud_overlap_param, precip_overlap_param, lw_gas_props, & lw_optical_props_cloudsByBand, lw_optical_props_precipByBand, & lw_optical_props_clouds, lw_optical_props_precip, errmsg, errflg) @@ -91,7 +91,7 @@ subroutine rrtmgp_lw_cloud_sampling_run(doLWrad, nCol, nLev, ipsdlw0, icseed_lw, if (iovrlw .ne. 1 .and. iovrlw .ne. 3) then errmsg = 'Cloud overlap assumption not supported by GFDL microphysics suite.' errflg = 1 - call check_error_msg('rrtmgp_lw_cloud_sampling',errmsg) + call check_error_msg('rrtmgp_gfdlmp_lw_cloud_sampling',errmsg) return endif @@ -100,7 +100,7 @@ subroutine rrtmgp_lw_cloud_sampling_run(doLWrad, nCol, nLev, ipsdlw0, icseed_lw, ! First sample the clouds... ! ! Allocate space RRTMGP DDTs [nCol,nLev,nGpt] - call check_error_msg('rrtmgp_lw_cloud_sampling_run',& + call check_error_msg('rrtmgp_gfdlmp_lw_cloud_sampling_run',& lw_optical_props_clouds%alloc_1scl(nCol, nLev, lw_gas_props)) ! Change random number seed value for each radiation invocation (isubclw =1 or 2). @@ -127,7 +127,7 @@ subroutine rrtmgp_lw_cloud_sampling_run(doLWrad, nCol, nLev, ipsdlw0, icseed_lw, select case ( iovrlw ) ! Maximumn-random case(1) ! Maximum-random overlap - call check_error_msg('rrtmgp_lw_cloud_sampling_run',sampled_mask_max_ran(rng3D,cld_frac,cldfracMCICA)) + call check_error_msg('rrtmgp_gfdlmp_lw_cloud_sampling_run',sampled_mask_max_ran(rng3D,cld_frac,cldfracMCICA)) case(3) ! Exponential decorrelation length overlap ! Generate second RNG do iCol=1,ncol @@ -135,19 +135,19 @@ subroutine rrtmgp_lw_cloud_sampling_run(doLWrad, nCol, nLev, ipsdlw0, icseed_lw, call random_number(rng1D,rng_stat) rng3D2(:,:,iCol) = reshape(source = rng1D,shape=[lw_gas_props%get_ngpt(),nLev]) enddo - call check_error_msg('rrtmgp_lw_cloud_sampling_run',& + call check_error_msg('rrtmgp_gfdlmp_lw_cloud_sampling_run',& sampled_mask_exp_dcorr(rng3D,rng3D2,cld_frac,cloud_overlap_param(:,1:nLev-1),cldfracMCICA)) end select ! Map band optical depth to each g-point using McICA - call check_error_msg('rrtmgp_lw_cloud_sampling_run',draw_samples(& + call check_error_msg('rrtmgp_gfdlmp_lw_cloud_sampling_run',draw_samples(& cldfracMCICA,lw_optical_props_cloudsByBand,lw_optical_props_clouds)) ! ! Next sample the precipitation... ! ! Allocate space RRTMGP DDTs [nCol,nLev,nGpt] - call check_error_msg('rrtmgp_lw_cloud_sampling_run',& + call check_error_msg('rrtmgp_gfdlmp_lw_cloud_sampling_run',& lw_optical_props_precip%alloc_1scl(nCol, nLev, lw_gas_props)) ! Change random number seed value for each radiation invocation (isubclw =1 or 2). @@ -175,7 +175,7 @@ subroutine rrtmgp_lw_cloud_sampling_run(doLWrad, nCol, nLev, ipsdlw0, icseed_lw, select case ( iovrlw ) ! Maximumn-random case(1) ! Maximum-random overlap - call check_error_msg('rrtmgp_lw_cloud_sampling_run',sampled_mask_max_ran(rng3D,precip_frac,precipfracSAMP)) + call check_error_msg('rrtmgp_gfdlmp_lw_cloud_sampling_run',sampled_mask_max_ran(rng3D,precip_frac,precipfracSAMP)) case(3) ! Exponential decorrelation length overlap ! No need to call RNG second time for now, just use the same seeds for precip as clouds. !! Generate second RNG @@ -184,12 +184,12 @@ subroutine rrtmgp_lw_cloud_sampling_run(doLWrad, nCol, nLev, ipsdlw0, icseed_lw, ! call random_number(rng1D,rng_stat) ! rng3D2(:,:,iCol) = reshape(source = rng1D,shape=[lw_gas_props%get_ngpt(),nLev]) !enddo - call check_error_msg('rrtmgp_lw_cloud_sampling_run', & + call check_error_msg('rrtmgp_gfdlmp_lw_cloud_sampling_run', & sampled_mask_exp_dcorr(rng3D,rng3D2,precip_frac,precip_overlap_param(:,1:nLev-1),precipfracSAMP)) end select ! Map band optical depth to each g-point using McICA - call check_error_msg('rrtmgp_lw_cloud_sampling_run',draw_samples(& + call check_error_msg('rrtmgp_gfdlmp_lw_cloud_sampling_run',draw_samples(& precipfracSAMP,lw_optical_props_precipByBand,lw_optical_props_precip)) ! @@ -197,12 +197,12 @@ subroutine rrtmgp_lw_cloud_sampling_run(doLWrad, nCol, nLev, ipsdlw0, icseed_lw, ! lw_optical_props_clouds%tau = lw_optical_props_clouds%tau + lw_optical_props_precip%tau - end subroutine rrtmgp_lw_cloud_sampling_run + end subroutine rrtmgp_gfdlmp_lw_cloud_sampling_run ! ######################################################################################### - ! SUBROTUINE rrtmgp_lw_cloud_sampling_finalize() + ! SUBROTUINE rrtmgp_gfdlmp_lw_cloud_sampling_finalize() ! ######################################################################################### - subroutine rrtmgp_lw_cloud_sampling_finalize() - end subroutine rrtmgp_lw_cloud_sampling_finalize + subroutine rrtmgp_gfdlmp_lw_cloud_sampling_finalize() + end subroutine rrtmgp_gfdlmp_lw_cloud_sampling_finalize -end module rrtmgp_lw_cloud_sampling +end module rrtmgp_gfdlmp_lw_cloud_sampling diff --git a/physics/rrtmgp_lw_cloud_sampling.meta b/physics/rrtmgp_gfdlmp_lw_cloud_sampling.meta similarity index 97% rename from physics/rrtmgp_lw_cloud_sampling.meta rename to physics/rrtmgp_gfdlmp_lw_cloud_sampling.meta index d54932fa3..2a1699c34 100644 --- a/physics/rrtmgp_lw_cloud_sampling.meta +++ b/physics/rrtmgp_gfdlmp_lw_cloud_sampling.meta @@ -1,5 +1,5 @@ [ccpp-arg-table] - name = rrtmgp_lw_cloud_sampling_init + name = rrtmgp_gfdlmp_lw_cloud_sampling_init type = scheme [lw_gas_props] standard_name = coefficients_for_lw_gas_optics @@ -20,7 +20,7 @@ ###################################################### [ccpp-arg-table] - name = rrtmgp_lw_cloud_sampling_run + name = rrtmgp_gfdlmp_lw_cloud_sampling_run type = scheme [doLWrad] standard_name = flag_to_calc_lw diff --git a/physics/rrtmgp_sw_cloud_sampling.F90 b/physics/rrtmgp_gfdlmp_sw_cloud_sampling.F90 similarity index 87% rename from physics/rrtmgp_sw_cloud_sampling.F90 rename to physics/rrtmgp_gfdlmp_sw_cloud_sampling.F90 index 6d0f9ee97..19f0a2d8a 100644 --- a/physics/rrtmgp_sw_cloud_sampling.F90 +++ b/physics/rrtmgp_gfdlmp_sw_cloud_sampling.F90 @@ -1,4 +1,4 @@ -module rrtmgp_sw_cloud_sampling +module rrtmgp_gfdlmp_sw_cloud_sampling use machine, only: kind_phys use mo_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp use physparam, only: isubcsw, iovrsw @@ -12,12 +12,12 @@ module rrtmgp_sw_cloud_sampling contains ! ######################################################################################### - ! SUBROUTINE rrtmgp_sw_cloud_sampling_init() + ! SUBROUTINE rrtmgp_gfdlmp_sw_cloud_sampling_init() ! ######################################################################################### -!! \section arg_table_rrtmgp_sw_cloud_sampling_init -!! \htmlinclude rrtmgp_sw_cloud_sampling.html +!! \section arg_table_rrtmgp_gfdlmp_sw_cloud_sampling_init +!! \htmlinclude rrtmgp_gfdlmp_sw_cloud_sampling.html !! - subroutine rrtmgp_sw_cloud_sampling_init(sw_gas_props, ipsdsw0) + subroutine rrtmgp_gfdlmp_sw_cloud_sampling_init(sw_gas_props, ipsdsw0) ! Inputs type(ty_gas_optics_rrtmgp),intent(in) :: & sw_gas_props ! RRTMGP DDT: K-distribution data @@ -28,15 +28,15 @@ subroutine rrtmgp_sw_cloud_sampling_init(sw_gas_props, ipsdsw0) ! Set initial permutation seed for McICA, initially set to number of G-points ipsdsw0 = sw_gas_props%get_ngpt() - end subroutine rrtmgp_sw_cloud_sampling_init + end subroutine rrtmgp_gfdlmp_sw_cloud_sampling_init ! ######################################################################################### - ! SUBROTUINE rrtmgp_sw_cloud_sampling_run() + ! SUBROTUINE rrtmgp_gfdlmp_sw_cloud_sampling_run() ! ######################################################################################### -!! \section arg_table_rrtmgp_sw_cloud_sampling_run -!! \htmlinclude rrtmgp_sw_cloud_sampling.html +!! \section arg_table_rrtmgp_gfdlmp_sw_cloud_sampling_run +!! \htmlinclude rrtmgp_gfdlmp_sw_cloud_sampling.html !! - subroutine rrtmgp_sw_cloud_sampling_run(doSWrad, nCol, nDay, nLev, ipsdsw0, idxday, & + subroutine rrtmgp_gfdlmp_sw_cloud_sampling_run(doSWrad, nCol, nDay, nLev, ipsdsw0, idxday, & icseed_sw, cld_frac, precip_frac, cloud_overlap_param, precip_overlap_param, & sw_gas_props, sw_optical_props_cloudsByBand, sw_optical_props_precipByBand, & sw_optical_props_clouds, sw_optical_props_precip, errmsg, errflg) @@ -94,7 +94,7 @@ subroutine rrtmgp_sw_cloud_sampling_run(doSWrad, nCol, nDay, nLev, ipsdsw0, idxd if (iovrsw .ne. 1 .and. iovrsw .ne. 3) then errmsg = 'Cloud overlap assumption not supported by GFDL microphysics suite.' errflg = 1 - call check_error_msg('rrtmgp_sw_cloud_sampling',errmsg) + call check_error_msg('rrtmgp_gfdlmp_sw_cloud_sampling',errmsg) return endif @@ -104,7 +104,7 @@ subroutine rrtmgp_sw_cloud_sampling_run(doSWrad, nCol, nDay, nLev, ipsdsw0, idxd ! First sample the clouds... ! ! Allocate space RRTMGP DDTs [nday,nLev,nGpt] - call check_error_msg('rrtmgp_sw_cloud_sampling_run', & + call check_error_msg('rrtmgp_gfdlmp_sw_cloud_sampling_run', & sw_optical_props_clouds%alloc_2str(nday, nLev, sw_gas_props)) ! Change random number seed value for each radiation invocation (isubcsw =1 or 2). @@ -130,7 +130,7 @@ subroutine rrtmgp_sw_cloud_sampling_run(doSWrad, nCol, nDay, nLev, ipsdsw0, idxd ! Call McICA select case ( iovrsw ) case(1) ! Maximum-random - call check_error_msg('rrtmgp_sw_cloud_sampling_run', & + call check_error_msg('rrtmgp_gfdlmp_sw_cloud_sampling_run', & sampled_mask_max_ran(rng3D,cld_frac(idxday(1:nDay),:),cldfracMCICA)) case(3) ! Exponential-random do iday=1,nday @@ -138,21 +138,21 @@ subroutine rrtmgp_sw_cloud_sampling_run(doSWrad, nCol, nDay, nLev, ipsdsw0, idxd call random_number(rng1D,rng_stat) rng3D2(:,:,iday) = reshape(source = rng1D,shape=[sw_gas_props%get_ngpt(),nLev]) enddo - call check_error_msg('rrtmgp_sw_cloud_sampling_run', & + call check_error_msg('rrtmgp_gfdlmp_sw_cloud_sampling_run', & sampled_mask_exp_dcorr(rng3D, rng3D2, cld_frac(idxday(1:nDay),:), & cloud_overlap_param(idxday(1:nDay),1:nLev-1), & cldfracMCICA)) end select ! Map band optical depth to each g-point using McICA - call check_error_msg('rrtmgp_sw_cloud_sampling_run', & + call check_error_msg('rrtmgp_gfdlmp_sw_cloud_sampling_run', & draw_samples(cldfracMCICA, sw_optical_props_cloudsByBand, sw_optical_props_clouds)) ! ! Next sample precipitation (same as clouds for now) ! ! Allocate space RRTMGP DDTs [nday,nLev,nGpt] - call check_error_msg('rrtmgp_sw_cloud_sampling_run',sw_optical_props_precip%alloc_2str( & + call check_error_msg('rrtmgp_gfdlmp_sw_cloud_sampling_run',sw_optical_props_precip%alloc_2str( & nday, nLev, sw_gas_props)) ! Change random number seed value for each radiation invocation (isubcsw =1 or 2). @@ -179,7 +179,7 @@ subroutine rrtmgp_sw_cloud_sampling_run(doSWrad, nCol, nDay, nLev, ipsdsw0, idxd ! Call McICA select case ( iovrsw ) case(1) ! Maximum-random - call check_error_msg('rrtmgp_sw_cloud_sampling_run', & + call check_error_msg('rrtmgp_gfdlmp_sw_cloud_sampling_run', & sampled_mask_max_ran(rng3D,precip_frac(idxday(1:nDay),:),precipfracSAMP)) case(3) ! Exponential-random !! Generate second RNG @@ -188,14 +188,14 @@ subroutine rrtmgp_sw_cloud_sampling_run(doSWrad, nCol, nDay, nLev, ipsdsw0, idxd ! call random_number(rng1D,rng_stat) ! rng3D2(:,:,iday) = reshape(source = rng1D,shape=[sw_gas_props%get_ngpt(),nLev]) !enddo - call check_error_msg('rrtmgp_sw_cloud_sampling_run', & + call check_error_msg('rrtmgp_gfdlmp_sw_cloud_sampling_run', & sampled_mask_exp_dcorr(rng3D,rng3D2,precip_frac(idxday(1:nDay),:), & precip_overlap_param(idxday(1:nDay),1:nLev-1), & precipfracSAMP)) end select ! Map band optical depth to each g-point using McICA - call check_error_msg('rrtmgp_sw_cloud_sampling_run', & + call check_error_msg('rrtmgp_gfdlmp_sw_cloud_sampling_run', & draw_samples(precipfracSAMP, sw_optical_props_precipByBand, sw_optical_props_precip)) endif @@ -233,12 +233,12 @@ subroutine rrtmgp_sw_cloud_sampling_run(doSWrad, nCol, nDay, nLev, ipsdsw0, idxd enddo enddo enddo - end subroutine rrtmgp_sw_cloud_sampling_run + end subroutine rrtmgp_gfdlmp_sw_cloud_sampling_run ! ######################################################################################### - ! SUBROTUINE rrtmgp_sw_cloud_sampling_finalize() + ! SUBROTUINE rrtmgp_gfdlmp_sw_cloud_sampling_finalize() ! ######################################################################################### - subroutine rrtmgp_sw_cloud_sampling_finalize() - end subroutine rrtmgp_sw_cloud_sampling_finalize + subroutine rrtmgp_gfdlmp_sw_cloud_sampling_finalize() + end subroutine rrtmgp_gfdlmp_sw_cloud_sampling_finalize -end module rrtmgp_sw_cloud_sampling +end module rrtmgp_gfdlmp_sw_cloud_sampling diff --git a/physics/rrtmgp_sw_cloud_sampling.meta b/physics/rrtmgp_gfdlmp_sw_cloud_sampling.meta similarity index 97% rename from physics/rrtmgp_sw_cloud_sampling.meta rename to physics/rrtmgp_gfdlmp_sw_cloud_sampling.meta index 4afdaa4db..cdf3dc977 100644 --- a/physics/rrtmgp_sw_cloud_sampling.meta +++ b/physics/rrtmgp_gfdlmp_sw_cloud_sampling.meta @@ -1,5 +1,5 @@ [ccpp-arg-table] - name = rrtmgp_sw_cloud_sampling_init + name = rrtmgp_gfdlmp_sw_cloud_sampling_init type = scheme [sw_gas_props] standard_name = coefficients_for_sw_gas_optics @@ -20,7 +20,7 @@ ###################################################### [ccpp-arg-table] - name = rrtmgp_sw_cloud_sampling_run + name = rrtmgp_gfdlmp_sw_cloud_sampling_run type = scheme [doSWrad] standard_name = flag_to_calc_sw From 4983b5b7e8e174be466c5da2f716ca7d831d0fb4 Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Tue, 9 Jun 2020 13:01:00 -0600 Subject: [PATCH 30/50] Fixed bug in .meta file standard_name --- physics/GFS_rrtmgp_sw_post.meta | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/physics/GFS_rrtmgp_sw_post.meta b/physics/GFS_rrtmgp_sw_post.meta index 96155580b..50da46a35 100644 --- a/physics/GFS_rrtmgp_sw_post.meta +++ b/physics/GFS_rrtmgp_sw_post.meta @@ -249,7 +249,7 @@ intent = inout optional = F [hsw0] - standard_name = tendency_of_air_temperature_due_to_shortwave_heating_assuming_clear_sky_on_radiation_time_step_and_radiation_levels + standard_name = tendency_of_air_temperature_due_to_shortwave_heating_assuming_clear_sky_on_radiation_time_step long_name = shortwave clear sky heating rate units = K s-1 dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) From 245dc3b0a6bbfd9f148749762d4446201b7eb61b Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Tue, 9 Jun 2020 13:09:02 -0600 Subject: [PATCH 31/50] Updated rte-rrtmgp submodule. --- physics/rte-rrtmgp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/physics/rte-rrtmgp b/physics/rte-rrtmgp index bab7d03c1..6ee0b62c1 160000 --- a/physics/rte-rrtmgp +++ b/physics/rte-rrtmgp @@ -1 +1 @@ -Subproject commit bab7d03c1bc10e43b7077832aa36cb84c4598c08 +Subproject commit 6ee0b62c1ac6204a89a4e922382b611c16dd5fa7 From 16ab8762e1f16bc3228b4f173308326769a294e2 Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Tue, 9 Jun 2020 16:23:20 -0600 Subject: [PATCH 32/50] Add LW Jacobians as interstitial fields. --- physics/GFS_rrtmgp_lw_post.F90 | 5 ++-- physics/GFS_rrtmgp_lw_post.meta | 9 ------ physics/GFS_rrtmgp_sw_post.F90 | 6 ++-- physics/GFS_rrtmgp_sw_post.meta | 11 +------- physics/rrtmgp_lw_rte.F90 | 50 +++++++++++++++++++++++---------- physics/rrtmgp_lw_rte.meta | 26 +++++++++++++++++ 6 files changed, 66 insertions(+), 41 deletions(-) diff --git a/physics/GFS_rrtmgp_lw_post.F90 b/physics/GFS_rrtmgp_lw_post.F90 index 8f5bb3611..7555f7278 100644 --- a/physics/GFS_rrtmgp_lw_post.F90 +++ b/physics/GFS_rrtmgp_lw_post.F90 @@ -33,7 +33,7 @@ end subroutine GFS_rrtmgp_lw_post_init subroutine GFS_rrtmgp_lw_post_run (Model, Grid, Radtend, Coupling, Diag, Statein, im, & p_lev, tsfa, fluxlwUP_allsky, fluxlwDOWN_allsky, fluxlwUP_clrsky, fluxlwDOWN_clrsky,& raddt, aerodp, cldsa, mtopa, mbota, cld_frac, cldtaulw, & - flxprf_lw, hlwc, hlw0, errmsg, errflg) + flxprf_lw, hlw0, errmsg, errflg) ! Inputs type(GFS_control_type), intent(in) :: & @@ -77,8 +77,6 @@ subroutine GFS_rrtmgp_lw_post_run (Model, Grid, Radtend, Coupling, Diag, Statei Radtend ! Fortran DDT: FV3-GFS radiation tendencies type(GFS_diag_type), intent(inout) :: & Diag ! Fortran DDT: FV3-GFS diagnotics data - real(kind_phys),dimension(size(Grid%xlon,1), Model%levs), intent(inout) :: & - hlwc ! Longwave all-sky heating-rate (K/sec) ! Outputs (optional) type(proflw_type), dimension(size(Grid%xlon,1), Model%levs+1), optional, intent(inout) :: & flxprf_lw ! 2D radiative fluxes, components: @@ -92,6 +90,7 @@ subroutine GFS_rrtmgp_lw_post_run (Model, Grid, Radtend, Coupling, Diag, Statei integer :: i, j, k, iSFC, iTOA, itop, ibtc logical :: l_fluxeslw2d, top_at_1 real(kind_phys) :: tem0d, tem1, tem2 + real(kind_phys),dimension(size(Grid%xlon,1), Model%levs) :: hlwc ! Initialize CCPP error handling variables errmsg = '' diff --git a/physics/GFS_rrtmgp_lw_post.meta b/physics/GFS_rrtmgp_lw_post.meta index 274bc1129..646945d90 100644 --- a/physics/GFS_rrtmgp_lw_post.meta +++ b/physics/GFS_rrtmgp_lw_post.meta @@ -180,15 +180,6 @@ type = proflw_type intent = inout optional = T -[hlwc] - standard_name = tendency_of_air_temperature_due_to_longwave_heating_on_radiation_time_step_and_radiation_levels - long_name = longwave total sky heating rate - units = K s-1 - dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) - type = real - kind = kind_phys - intent = inout - optional = F [hlw0] standard_name = tendency_of_air_temperature_due_to_longwave_heating_assuming_clear_sky_on_radiation_time_step_and_radiation_levels long_name = longwave clear sky heating rate diff --git a/physics/GFS_rrtmgp_sw_post.F90 b/physics/GFS_rrtmgp_sw_post.F90 index 086bceb4c..2ec5477b9 100644 --- a/physics/GFS_rrtmgp_sw_post.F90 +++ b/physics/GFS_rrtmgp_sw_post.F90 @@ -30,7 +30,7 @@ subroutine GFS_rrtmgp_sw_post_run (Model, Grid, Diag, Radtend, Coupling, Statein nCol, p_lev, sfc_alb_nir_dir, sfc_alb_nir_dif, sfc_alb_uvvis_dir, sfc_alb_uvvis_dif, & sw_gas_props, nday, idxday, fluxswUP_allsky, fluxswDOWN_allsky, fluxswUP_clrsky, & fluxswDOWN_clrsky, raddt, aerodp, cldsa, mbota, mtopa, cld_frac, cldtausw, flxprf_sw,& - hswc, hsw0, errmsg, errflg) + hsw0, errmsg, errflg) ! Inputs type(GFS_control_type), intent(in) :: & @@ -78,8 +78,6 @@ subroutine GFS_rrtmgp_sw_post_run (Model, Grid, Diag, Radtend, Coupling, Statein cldtausw ! approx .55mu band layer cloud optical depth ! Outputs (mandatory) - real(kind_phys),dimension(nCol, Model%levs), intent(inout) :: & - hswc ! All-sky heating rate (K/s) character(len=*), intent(out) :: & errmsg integer, intent(out) :: & @@ -108,7 +106,7 @@ subroutine GFS_rrtmgp_sw_post_run (Model, Grid, Diag, Radtend, Coupling, Statein real(kind_phys) :: tem0d, tem1, tem2 real(kind_phys), dimension(nDay, Model%levs) :: thetaTendClrSky, thetaTendAllSky logical :: l_fluxessw2d, top_at_1, l_sfcFluxessw1D - + real(kind_phys),dimension(nCol, Model%levs) :: hswc ! Initialize CCPP error handling variables errmsg = '' errflg = 0 diff --git a/physics/GFS_rrtmgp_sw_post.meta b/physics/GFS_rrtmgp_sw_post.meta index 50da46a35..ce27d0096 100644 --- a/physics/GFS_rrtmgp_sw_post.meta +++ b/physics/GFS_rrtmgp_sw_post.meta @@ -239,17 +239,8 @@ type = profsw_type intent = inout optional = T -[hswc] - standard_name = tendency_of_air_temperature_due_to_shortwave_heating_on_radiation_time_step_and_radiation_levels - long_name = shortwave total sky heating rate - units = K s-1 - dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) - type = real - kind = kind_phys - intent = inout - optional = F [hsw0] - standard_name = tendency_of_air_temperature_due_to_shortwave_heating_assuming_clear_sky_on_radiation_time_step + standard_name = tendency_of_air_temperature_due_to_shortwave_heating_assuming_clear_sky_on_radiation_time_step_and_radiation_levels long_name = shortwave clear sky heating rate units = K s-1 dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) diff --git a/physics/rrtmgp_lw_rte.F90 b/physics/rrtmgp_lw_rte.F90 index 66a968af6..dc49260f6 100644 --- a/physics/rrtmgp_lw_rte.F90 +++ b/physics/rrtmgp_lw_rte.F90 @@ -14,7 +14,6 @@ module rrtmgp_lw_rte implicit none public rrtmgp_lw_rte_init, rrtmgp_lw_rte_run, rrtmgp_lw_rte_finalize - contains ! ######################################################################################### @@ -29,15 +28,17 @@ end subroutine rrtmgp_lw_rte_init !! \section arg_table_rrtmgp_lw_rte_run !! \htmlinclude rrtmgp_lw_rte_run.html !! - subroutine rrtmgp_lw_rte_run(doLWrad, doLWclrsky, nCol, nLev, p_lay, t_lay, p_lev, skt, & - lw_gas_props, sfc_emiss_byband, sources, lw_optical_props_clrsky, & - lw_optical_props_clouds, lw_optical_props_aerosol, nGauss_angles, fluxlwUP_allsky, & - fluxlwDOWN_allsky, fluxlwUP_clrsky, fluxlwDOWN_clrsky, errmsg, errflg) + subroutine rrtmgp_lw_rte_run(doLWrad, doLWclrsky, use_LW_jacobian, nCol, nLev, p_lay, & + t_lay, p_lev, skt, lw_gas_props, sfc_emiss_byband, sources, lw_optical_props_clrsky,& + lw_optical_props_clouds, lw_optical_props_aerosol, nGauss_angles, fluxlwUP_allsky, & + fluxlwDOWN_allsky, fluxlwUP_clrsky, fluxlwDOWN_clrsky, fluxlwUP_jac, & + fluxlwDOWN_jac, errmsg, errflg) ! Inputs logical, intent(in) :: & doLWrad, & ! Logical flag for longwave radiation call - doLWclrsky ! Compute clear-sky fluxes for clear-sky heating-rate? + doLWclrsky, & ! Compute clear-sky fluxes for clear-sky heating-rate? + use_LW_jacobian ! Compute Jacobian of LW to update radiative fluxes between radiation calls? integer, intent(in) :: & nCol, & ! Number of horizontal gridpoints nLev, & ! Number of vertical levels @@ -70,6 +71,10 @@ subroutine rrtmgp_lw_rte_run(doLWrad, doLWclrsky, nCol, nLev, p_lay, t_lay, p_le errmsg ! CCPP error message integer, intent(out) :: & errflg ! CCPP error flag + ! Outputs (optional) + real(kind_phys), dimension(ncol,nLev+1), intent(out), optional :: & + fluxlwUP_jac, & ! Jacobian of upward LW flux (W/m2/K) + fluxlwDOWN_jac ! Jacobian of downward LW flux (W/m2/K) ! Local variables integer :: & @@ -89,7 +94,7 @@ subroutine rrtmgp_lw_rte_run(doLWrad, doLWclrsky, nCol, nLev, p_lay, t_lay, p_le ! Vertical ordering? top_at_1 = (p_lev(1,1) .lt. p_lev(1, nLev)) - + ! Initialize RRTMGP DDT containing 2D(3D) fluxes flux_allsky%bnd_flux_up => fluxLW_up_allsky flux_allsky%bnd_flux_dn => fluxLW_dn_allsky @@ -110,7 +115,8 @@ subroutine rrtmgp_lw_rte_run(doLWrad, doLWclrsky, nCol, nLev, p_lay, t_lay, p_le sources, & ! IN - source function sfc_emiss_byband, & ! IN - surface emissivity in each LW band flux_clrsky, & ! OUT - Fluxes - n_gauss_angles = nGauss_angles)) + n_gauss_angles = nGauss_angles)) ! IN - Number of angles in Gaussian quadrature + ! Store fluxes fluxlwUP_clrsky = sum(flux_clrsky%bnd_flux_up,dim=3) fluxlwDOWN_clrsky = sum(flux_clrsky%bnd_flux_dn,dim=3) @@ -126,13 +132,27 @@ subroutine rrtmgp_lw_rte_run(doLWrad, doLWclrsky, nCol, nLev, p_lay, t_lay, p_le call check_error_msg('rrtmgp_lw_rte_run',lw_optical_props_clouds%increment(lw_optical_props_clrsky)) ! Call RTE solver - 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)) + 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) + flux_dn_Jac = fluxlwDOWN_jac)) ! OUT - surface temperature flux (downward) 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 + ! Store fluxes fluxlwUP_allsky = sum(flux_allsky%bnd_flux_up,dim=3) fluxlwDOWN_allsky = sum(flux_allsky%bnd_flux_dn,dim=3) diff --git a/physics/rrtmgp_lw_rte.meta b/physics/rrtmgp_lw_rte.meta index d3876a211..f8cdfe891 100644 --- a/physics/rrtmgp_lw_rte.meta +++ b/physics/rrtmgp_lw_rte.meta @@ -17,6 +17,14 @@ type = logical intent = in optional = F +[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 + optional = F [ncol] standard_name = horizontal_loop_extent long_name = horizontal dimension @@ -162,6 +170,24 @@ kind = kind_phys intent = out optional = F +[fluxlwUP_jac] + standard_name = RRTMGP_jacobian_of_lw_flux_profile_upward + long_name = RRTMGP Jacobian upward longwave flux profile + units = W m-2 K-1 + dimensions = (horizontal_dimension,vertical_dimension_plus_one) + type = real + kind = kind_phys + intent = out + optional = T +[fluxlwDOWN_jac] + standard_name = RRTMGP_jacobian_of_lw_flux_profile_downward + long_name = RRTMGP Jacobian downward of longwave flux profile + units = W m-2 K-1 + dimensions = (horizontal_dimension,vertical_dimension_plus_one) + type = real + kind = kind_phys + intent = out + optional = T [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP From b00d5fbf2189e65365ef0e04c741b82e1c6fe80b Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Thu, 11 Jun 2020 15:22:43 -0600 Subject: [PATCH 33/50] Added new scheme for RRTMGP LW surface flux adjustment between radiation time-steps. --- physics/GFS_suite_interstitial.F90 | 92 ++++++++++++----------- physics/GFS_suite_interstitial.meta | 8 ++ physics/rrtmgp_lwadj.F90 | 77 ++++++++++++++++++++ physics/rrtmgp_lwadj.meta | 109 ++++++++++++++++++++++++++++ 4 files changed, 242 insertions(+), 44 deletions(-) create mode 100644 physics/rrtmgp_lwadj.F90 create mode 100644 physics/rrtmgp_lwadj.meta diff --git a/physics/GFS_suite_interstitial.F90 b/physics/GFS_suite_interstitial.F90 index 935dd9430..9f497af26 100644 --- a/physics/GFS_suite_interstitial.F90 +++ b/physics/GFS_suite_interstitial.F90 @@ -157,10 +157,10 @@ end subroutine GFS_suite_interstitial_2_finalize !! \htmlinclude GFS_suite_interstitial_2_run.html !! #endif - subroutine GFS_suite_interstitial_2_run (im, levs, lssav, ldiag3d, lsidea, cplflx, flag_cice, shal_cnv, old_monin, mstrat, & - do_shoc, frac_grid, imfshalcnv, dtf, xcosz, adjsfcdsw, adjsfcdlw, cice, pgr, ulwsfc_cice, lwhd, htrsw, htrlw, xmu, ctei_rm, & - work1, work2, prsi, tgrs, prsl, qgrs_water_vapor, qgrs_cloud_water, cp, hvap, prslk, suntim, adjsfculw, adjsfculw_lnd, & - adjsfculw_ice, adjsfculw_ocn, dlwsfc, ulwsfc, psmean, dt3dt_lw, dt3dt_sw, dt3dt_pbl, dt3dt_dcnv, dt3dt_scnv, dt3dt_mp, & + subroutine GFS_suite_interstitial_2_run (im, levs, lssav, ldiag3d, lsidea, cplflx, flag_cice, shal_cnv, old_monin, mstrat, use_GP_jacobian, & + do_shoc, frac_grid, imfshalcnv, dtf, xcosz, adjsfcdsw, adjsfcdlw, cice, pgr, ulwsfc_cice, lwhd, htrsw, htrlw, xmu, ctei_rm, & + work1, work2, prsi, tgrs, prsl, qgrs_water_vapor, qgrs_cloud_water, cp, hvap, prslk, suntim, adjsfculw, adjsfculw_lnd, & + adjsfculw_ice, adjsfculw_ocn, dlwsfc, ulwsfc, psmean, dt3dt_lw, dt3dt_sw, dt3dt_pbl, dt3dt_dcnv, dt3dt_scnv, dt3dt_mp, & ctei_rml, ctei_r, kinver, dry, icy, wet, frland, huge, errmsg, errflg) implicit none @@ -168,7 +168,7 @@ subroutine GFS_suite_interstitial_2_run (im, levs, lssav, ldiag3d, lsidea, cplfl ! interface variables integer, intent(in ) :: im, levs, imfshalcnv logical, intent(in ) :: lssav, ldiag3d, lsidea, cplflx, shal_cnv - logical, intent(in ) :: old_monin, mstrat, do_shoc, frac_grid + logical, intent(in ) :: old_monin, mstrat, do_shoc, frac_grid, use_GP_jacobian real(kind=kind_phys), intent(in ) :: dtf, cp, hvap logical, intent(in ), dimension(im) :: flag_cice @@ -182,7 +182,7 @@ subroutine GFS_suite_interstitial_2_run (im, levs, lssav, ldiag3d, lsidea, cplfl integer, intent(inout), dimension(im) :: kinver real(kind=kind_phys), intent(inout), dimension(im) :: suntim, dlwsfc, ulwsfc, psmean, ctei_rml, ctei_r real(kind=kind_phys), intent(in ), dimension(im) :: adjsfculw_lnd, adjsfculw_ice, adjsfculw_ocn - real(kind=kind_phys), intent( out), dimension(im) :: adjsfculw + real(kind=kind_phys), intent(inout), dimension(im) :: adjsfculw ! These arrays are only allocated if ldiag3d is .true. real(kind=kind_phys), intent(inout), dimension(:,:) :: dt3dt_lw, dt3dt_sw, dt3dt_pbl, dt3dt_dcnv, dt3dt_scnv, dt3dt_mp @@ -225,45 +225,49 @@ subroutine GFS_suite_interstitial_2_run (im, levs, lssav, ldiag3d, lsidea, cplfl enddo ! --- ... sfc lw fluxes used by atmospheric model are saved for output - - if (frac_grid) then - do i=1,im - tem = (one - frland(i)) * cice(i) ! tem = ice fraction wrt whole cell - if (flag_cice(i)) then - adjsfculw(i) = adjsfculw_lnd(i) * frland(i) & - + ulwsfc_cice(i) * tem & - + adjsfculw_ocn(i) * (one - frland(i) - tem) - else - adjsfculw(i) = adjsfculw_lnd(i) * frland(i) & - + adjsfculw_ice(i) * tem & - + adjsfculw_ocn(i) * (one - frland(i) - tem) - endif - enddo - else - do i=1,im - if (dry(i)) then ! all land - adjsfculw(i) = adjsfculw_lnd(i) - elseif (icy(i)) then ! ice (and water) - tem = one - cice(i) - if (flag_cice(i)) then - if (wet(i) .and. adjsfculw_ocn(i) /= huge) then - adjsfculw(i) = ulwsfc_cice(i)*cice(i) + adjsfculw_ocn(i)*tem - else - adjsfculw(i) = ulwsfc_cice(i) - endif - else - if (wet(i) .and. adjsfculw_ocn(i) /= huge) then - adjsfculw(i) = adjsfculw_ice(i)*cice(i) + adjsfculw_ocn(i)*tem +! --- ... when using RRTMGP w/ use_GP_jacobian, these adjustment factors are pre-computed +! --- ... and provided as inputs in this routine. + + if (.not. use_GP_jacobian) then + if (frac_grid) then + do i=1,im + tem = (one - frland(i)) * cice(i) ! tem = ice fraction wrt whole cell + if (flag_cice(i)) then + adjsfculw(i) = adjsfculw_lnd(i) * frland(i) & + + ulwsfc_cice(i) * tem & + + adjsfculw_ocn(i) * (one - frland(i) - tem) else - adjsfculw(i) = adjsfculw_ice(i) - endif - endif - else ! all water - adjsfculw(i) = adjsfculw_ocn(i) - endif - enddo - endif - + adjsfculw(i) = adjsfculw_lnd(i) * frland(i) & + + adjsfculw_ice(i) * tem & + + adjsfculw_ocn(i) * (one - frland(i) - tem) + endif + enddo + else + do i=1,im + if (dry(i)) then ! all land + adjsfculw(i) = adjsfculw_lnd(i) + elseif (icy(i)) then ! ice (and water) + tem = one - cice(i) + if (flag_cice(i)) then + if (wet(i) .and. adjsfculw_ocn(i) /= huge) then + adjsfculw(i) = ulwsfc_cice(i)*cice(i) + adjsfculw_ocn(i)*tem + else + adjsfculw(i) = ulwsfc_cice(i) + endif + else + if (wet(i) .and. adjsfculw_ocn(i) /= huge) then + adjsfculw(i) = adjsfculw_ice(i)*cice(i) + adjsfculw_ocn(i)*tem + else + adjsfculw(i) = adjsfculw_ice(i) + endif + endif + else ! all water + adjsfculw(i) = adjsfculw_ocn(i) + endif + enddo + endif + endif + do i=1,im dlwsfc(i) = dlwsfc(i) + adjsfcdlw(i)*dtf ulwsfc(i) = ulwsfc(i) + adjsfculw(i)*dtf diff --git a/physics/GFS_suite_interstitial.meta b/physics/GFS_suite_interstitial.meta index 5c206ef30..083326dff 100644 --- a/physics/GFS_suite_interstitial.meta +++ b/physics/GFS_suite_interstitial.meta @@ -354,6 +354,14 @@ type = logical intent = in optional = F +[use_GP_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 + optional = F [frac_grid] standard_name = flag_for_fractional_grid long_name = flag for fractional grid diff --git a/physics/rrtmgp_lwadj.F90 b/physics/rrtmgp_lwadj.F90 new file mode 100644 index 000000000..19918d1ec --- /dev/null +++ b/physics/rrtmgp_lwadj.F90 @@ -0,0 +1,77 @@ +! ########################################################################################### +! ########################################################################################### +module rrtmgp_lwadj + use machine, only: kind_phys + use rrtmgp_aux, only: check_error_msg + implicit none + + logical :: & + linit_mod = .false. ! + + public rrtmgp_lwadj_init, rrtmgp_lwadj_run, rrtmgp_lwadj_finalize +contains + + ! ######################################################################################### + ! SUBROUTINE rrtmgp_lwadj_init + ! ######################################################################################### + subroutine rrtmgp_lwadj_init() + end subroutine rrtmgp_lwadj_init + + ! ######################################################################################### + ! SUBROUTINE rrtmgp_lwadj_run + ! ######################################################################################### + subroutine rrtmgp_lwadj_run(use_LW_jacobian, nCol, nLev, skt, sktp1r, fluxlwUP_jac, & + fluxlwDOWN_jac, adjsfculw, adjsfcdlw, errmsg, errflg) + + ! Inputs + logical, intent(in) :: & + use_LW_jacobian ! If true the GP scheme is using the Jacobians of the upward/downward + ! to adjust the LW surface fluxes between radiation calls. + integer, intent(in) :: & + nCol, & ! Number of horizontal gridpoints + nLev ! Number of vertical levels + real(kind_phys), dimension(nCol), intent(in) :: & + skt ! Surface(skin) temperature (K) + real(kind_phys), dimension(nCol), intent(inout) :: & + sktp1r ! Surface(skin) temperature from previous radiation time step (K) + real(kind_phys), dimension(nCol,nLev+1), intent(in) :: & + fluxlwUP_jac, & ! Jacobian of upward LW flux (W/m2/K) + fluxlwDOWN_jac ! Jacobian of downward LW flux (W/m2/K) + + ! Outputs + character(len=*), intent(out) :: & + errmsg ! CCPP error message + integer, intent(out) :: & + errflg ! CCPP error flag + real(kind_phys), dimension(nCol), intent(out) :: & + adjsfculw, & ! + adjsfcdlw ! + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + if (.not. use_LW_jacobian) return + + ! Compute adjustment to the surface flux using Jacobian. + if(linit_mod) then + adjsfculw(:) = (skt(:) - sktp1r(:)) * fluxlwUP_jac(:,nLev+1) + adjsfcdlw(:) = (skt(:) - sktp1r(:)) * fluxlwDOWN_jac(:,nLev+1) + else + adjsfculw(:) = 0. + adjsfcdlw(:) = 0. + linit_mod = .true. + endif + + ! Store surface temperature for next iteration + sktp1r(:) = skt(:) + + end subroutine rrtmgp_lwadj_run + + ! ######################################################################################### + ! SUBROUTINE rrtmgp_lwadj_finalize + ! ######################################################################################### + subroutine rrtmgp_lwadj_finalize() + end subroutine rrtmgp_lwadj_finalize + +end module rrtmgp_lwadj diff --git a/physics/rrtmgp_lwadj.meta b/physics/rrtmgp_lwadj.meta new file mode 100644 index 000000000..bea4201e4 --- /dev/null +++ b/physics/rrtmgp_lwadj.meta @@ -0,0 +1,109 @@ +######################################################################## +# +######################################################################## +[ccpp-arg-table] + name = rrtmgp_lwadj_init + type = scheme + +######################################################################## +# +######################################################################## +[ccpp-arg-table] + name = rrtmgp_lwadj_run + type = scheme +[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 + optional = F +[ncol] + standard_name = horizontal_loop_extent + long_name = horizontal dimension + units = count + dimensions = () + type = integer + intent = in + optional = F +[nLev] + standard_name = vertical_dimension + long_name = number of vertical levels + units = count + dimensions = () + type = integer + intent = in + optional = F +[skt] + standard_name = surface_ground_temperature_for_radiation + long_name = surface ground temperature for radiation + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[sktp1r] + standard_name = surface_ground_temperature_for_radiation_at_previous_rad_time_step + long_name = surface ground temperature for radiation at previous radiation time step + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[fluxlwUP_jac] + standard_name = RRTMGP_jacobian_of_lw_flux_profile_upward + long_name = RRTMGP Jacobian upward longwave flux profile + units = W m-2 K-1 + dimensions = (horizontal_dimension,vertical_dimension_plus_one) + type = real + kind = kind_phys + intent = in + optional = F +[fluxlwDOWN_jac] + standard_name = RRTMGP_jacobian_of_lw_flux_profile_downward + long_name = RRTMGP Jacobian downward of longwave flux profile + units = W m-2 K-1 + dimensions = (horizontal_dimension,vertical_dimension_plus_one) + type = real + kind = kind_phys + intent = in + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F +[adjsfcdlw] + standard_name = surface_downwelling_longwave_flux + long_name = surface downwelling longwave flux at current time + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[adjsfculw] + standard_name = surface_upwelling_longwave_flux + long_name = surface upwelling longwave flux at current time + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F + From 4d21e5fc791885e97df8e4cede60a1f75b20c7f3 Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Fri, 12 Jun 2020 08:34:50 -0600 Subject: [PATCH 34/50] Changed intent of fields from in to inout. --- physics/rrtmgp_lwadj.meta | 12 +----------- 1 file changed, 1 insertion(+), 11 deletions(-) diff --git a/physics/rrtmgp_lwadj.meta b/physics/rrtmgp_lwadj.meta index bea4201e4..d431c07b1 100644 --- a/physics/rrtmgp_lwadj.meta +++ b/physics/rrtmgp_lwadj.meta @@ -1,13 +1,3 @@ -######################################################################## -# -######################################################################## -[ccpp-arg-table] - name = rrtmgp_lwadj_init - type = scheme - -######################################################################## -# -######################################################################## [ccpp-arg-table] name = rrtmgp_lwadj_run type = scheme @@ -95,7 +85,7 @@ dimensions = (horizontal_dimension) type = real kind = kind_phys - intent = inout + intent = out optional = F [adjsfculw] standard_name = surface_upwelling_longwave_flux From dbaba27e7d5661862415b9ff54c4a502544289e6 Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Tue, 16 Jun 2020 14:17:05 -0600 Subject: [PATCH 35/50] Make Jacbians optional inputs --- physics/rrtmgp_lwadj.F90 | 17 ++++++++++++++--- physics/rrtmgp_lwadj.meta | 18 +++++++++--------- 2 files changed, 23 insertions(+), 12 deletions(-) diff --git a/physics/rrtmgp_lwadj.F90 b/physics/rrtmgp_lwadj.F90 index 19918d1ec..35d11acb4 100644 --- a/physics/rrtmgp_lwadj.F90 +++ b/physics/rrtmgp_lwadj.F90 @@ -20,6 +20,9 @@ end subroutine rrtmgp_lwadj_init ! ######################################################################################### ! SUBROUTINE rrtmgp_lwadj_run ! ######################################################################################### +!> \section arg_table_rrtmgp_lwadj_run Argument Table +!! \htmlinclude rrtmgp_lwadj_run.html +!! subroutine rrtmgp_lwadj_run(use_LW_jacobian, nCol, nLev, skt, sktp1r, fluxlwUP_jac, & fluxlwDOWN_jac, adjsfculw, adjsfcdlw, errmsg, errflg) @@ -34,7 +37,7 @@ subroutine rrtmgp_lwadj_run(use_LW_jacobian, nCol, nLev, skt, sktp1r, fluxlwUP_j skt ! Surface(skin) temperature (K) real(kind_phys), dimension(nCol), intent(inout) :: & sktp1r ! Surface(skin) temperature from previous radiation time step (K) - real(kind_phys), dimension(nCol,nLev+1), intent(in) :: & + real(kind_phys), dimension(nCol,nLev+1), intent(in), optional :: & fluxlwUP_jac, & ! Jacobian of upward LW flux (W/m2/K) fluxlwDOWN_jac ! Jacobian of downward LW flux (W/m2/K) @@ -46,17 +49,25 @@ subroutine rrtmgp_lwadj_run(use_LW_jacobian, nCol, nLev, skt, sktp1r, fluxlwUP_j real(kind_phys), dimension(nCol), intent(out) :: & adjsfculw, & ! adjsfcdlw ! + + ! Local + real(kind_phys),dimension(nCol) :: dT ! Initialize CCPP error handling variables errmsg = '' errflg = 0 + print*,'skt: ',skt,sktp1r,linit_mod + print*,'Jacobian(up): ',fluxlwUP_jac + print*,'Jacobian(dn): ',fluxlwDOWN_jac + if (.not. use_LW_jacobian) return ! Compute adjustment to the surface flux using Jacobian. if(linit_mod) then - adjsfculw(:) = (skt(:) - sktp1r(:)) * fluxlwUP_jac(:,nLev+1) - adjsfcdlw(:) = (skt(:) - sktp1r(:)) * fluxlwDOWN_jac(:,nLev+1) + dT(:) = (skt(:) - sktp1r(:)) + adjsfculw(:) = fluxlwUP_jac(:,nLev+1) * dT(:) + adjsfcdlw(:) = fluxlwDOWN_jac(:,nLev+1) * dT(:) else adjsfculw(:) = 0. adjsfcdlw(:) = 0. diff --git a/physics/rrtmgp_lwadj.meta b/physics/rrtmgp_lwadj.meta index d431c07b1..f6809275a 100644 --- a/physics/rrtmgp_lwadj.meta +++ b/physics/rrtmgp_lwadj.meta @@ -26,23 +26,23 @@ intent = in optional = F [skt] - standard_name = surface_ground_temperature_for_radiation - long_name = surface ground temperature for radiation + standard_name = surface_skin_temperature + long_name = surface skin temperature units = K dimensions = (horizontal_dimension) type = real - kind = kind_phys + kind = kind_phys intent = in optional = F [sktp1r] - standard_name = surface_ground_temperature_for_radiation_at_previous_rad_time_step - long_name = surface ground temperature for radiation at previous radiation time step + standard_name = surface_skin_temperature_at_previous_time_step + long_name = surface skin temperature at previous time step units = K dimensions = (horizontal_dimension) type = real - kind = kind_phys + kind = kind_phys intent = in - optional = F + optional = F [fluxlwUP_jac] standard_name = RRTMGP_jacobian_of_lw_flux_profile_upward long_name = RRTMGP Jacobian upward longwave flux profile @@ -51,7 +51,7 @@ type = real kind = kind_phys intent = in - optional = F + optional = T [fluxlwDOWN_jac] standard_name = RRTMGP_jacobian_of_lw_flux_profile_downward long_name = RRTMGP Jacobian downward of longwave flux profile @@ -60,7 +60,7 @@ type = real kind = kind_phys intent = in - optional = F + optional = T [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP From d8253bd38d8a5c78d3d462fe1a5eb3231260461f Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Fri, 19 Jun 2020 13:26:44 -0600 Subject: [PATCH 36/50] Fixed bug in previous commit. --- physics/rrtmgp_lwadj.F90 | 53 +++++++++++++++++++-------------------- physics/rrtmgp_lwadj.meta | 2 +- 2 files changed, 27 insertions(+), 28 deletions(-) diff --git a/physics/rrtmgp_lwadj.F90 b/physics/rrtmgp_lwadj.F90 index 35d11acb4..5b9906442 100644 --- a/physics/rrtmgp_lwadj.F90 +++ b/physics/rrtmgp_lwadj.F90 @@ -4,19 +4,19 @@ module rrtmgp_lwadj use machine, only: kind_phys use rrtmgp_aux, only: check_error_msg implicit none - + logical :: & linit_mod = .false. ! - + public rrtmgp_lwadj_init, rrtmgp_lwadj_run, rrtmgp_lwadj_finalize contains - + ! ######################################################################################### ! SUBROUTINE rrtmgp_lwadj_init ! ######################################################################################### subroutine rrtmgp_lwadj_init() end subroutine rrtmgp_lwadj_init - + ! ######################################################################################### ! SUBROUTINE rrtmgp_lwadj_run ! ######################################################################################### @@ -24,12 +24,12 @@ end subroutine rrtmgp_lwadj_init !! \htmlinclude rrtmgp_lwadj_run.html !! subroutine rrtmgp_lwadj_run(use_LW_jacobian, nCol, nLev, skt, sktp1r, fluxlwUP_jac, & - fluxlwDOWN_jac, adjsfculw, adjsfcdlw, errmsg, errflg) + fluxlwDOWN_jac, adjsfculw, adjsfcdlw, errmsg, errflg) - ! Inputs - logical, intent(in) :: & - use_LW_jacobian ! If true the GP scheme is using the Jacobians of the upward/downward - ! to adjust the LW surface fluxes between radiation calls. + ! Inputs + logical, intent(in) :: & + use_LW_jacobian ! If true the GP scheme is using the Jacobians of the upward/downward + ! to adjust the LW surface fluxes between radiation calls. integer, intent(in) :: & nCol, & ! Number of horizontal gridpoints nLev ! Number of vertical levels @@ -37,40 +37,39 @@ subroutine rrtmgp_lwadj_run(use_LW_jacobian, nCol, nLev, skt, sktp1r, fluxlwUP_j skt ! Surface(skin) temperature (K) real(kind_phys), dimension(nCol), intent(inout) :: & sktp1r ! Surface(skin) temperature from previous radiation time step (K) - real(kind_phys), dimension(nCol,nLev+1), intent(in), optional :: & + real(kind_phys), dimension(nCol,nLev+1), intent(in),optional :: & fluxlwUP_jac, & ! Jacobian of upward LW flux (W/m2/K) fluxlwDOWN_jac ! Jacobian of downward LW flux (W/m2/K) - ! Outputs + ! Outputs character(len=*), intent(out) :: & errmsg ! CCPP error message integer, intent(out) :: & errflg ! CCPP error flag - real(kind_phys), dimension(nCol), intent(out) :: & - adjsfculw, & ! - adjsfcdlw ! + real(kind_phys), dimension(nCol), intent(inout) :: & + adjsfculw, & ! + adjsfcdlw ! - ! Local - real(kind_phys),dimension(nCol) :: dT - + ! Local + real(kind_phys),dimension(nCol) :: dT + ! Initialize CCPP error handling variables errmsg = '' errflg = 0 - - print*,'skt: ',skt,sktp1r,linit_mod - print*,'Jacobian(up): ',fluxlwUP_jac - print*,'Jacobian(dn): ',fluxlwDOWN_jac - - if (.not. use_LW_jacobian) return + + print*,'skt: ',skt,sktp1r,linit_mod + print*,'Jacobian(up): ',fluxlwUP_jac + print*,'use_LW_jacobian: ',use_LW_jacobian + + if (.not. present(fluxlwUP_jac)) return + if (.not. use_LW_jacobian) return ! Compute adjustment to the surface flux using Jacobian. - if(linit_mod) then - dT(:) = (skt(:) - sktp1r(:)) + if(linit_mod) then + dT(:) = (skt(:) - sktp1r(:)) adjsfculw(:) = fluxlwUP_jac(:,nLev+1) * dT(:) - adjsfcdlw(:) = fluxlwDOWN_jac(:,nLev+1) * dT(:) else adjsfculw(:) = 0. - adjsfcdlw(:) = 0. linit_mod = .true. endif diff --git a/physics/rrtmgp_lwadj.meta b/physics/rrtmgp_lwadj.meta index f6809275a..202ccb841 100644 --- a/physics/rrtmgp_lwadj.meta +++ b/physics/rrtmgp_lwadj.meta @@ -85,7 +85,7 @@ dimensions = (horizontal_dimension) type = real kind = kind_phys - intent = out + intent = inout optional = F [adjsfculw] standard_name = surface_upwelling_longwave_flux From 556c67320ffabb14bb673555fb315518e0c57c18 Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Fri, 19 Jun 2020 16:35:48 -0600 Subject: [PATCH 37/50] LW adjusted flux using GP Jacobians is working. --- physics/rrtmgp_lwadj.F90 | 15 ++++++--------- physics/rrtmgp_lwadj.meta | 19 ++++++++++++++----- 2 files changed, 20 insertions(+), 14 deletions(-) diff --git a/physics/rrtmgp_lwadj.F90 b/physics/rrtmgp_lwadj.F90 index 5b9906442..4f5bcb89e 100644 --- a/physics/rrtmgp_lwadj.F90 +++ b/physics/rrtmgp_lwadj.F90 @@ -24,7 +24,7 @@ end subroutine rrtmgp_lwadj_init !! \htmlinclude rrtmgp_lwadj_run.html !! subroutine rrtmgp_lwadj_run(use_LW_jacobian, nCol, nLev, skt, sktp1r, fluxlwUP_jac, & - fluxlwDOWN_jac, adjsfculw, adjsfcdlw, errmsg, errflg) + fluxlwDOWN_jac, fluxlwUP, adjsfculw, adjsfcdlw, errmsg, errflg) ! Inputs logical, intent(in) :: & @@ -38,6 +38,7 @@ subroutine rrtmgp_lwadj_run(use_LW_jacobian, nCol, nLev, skt, sktp1r, fluxlwUP_j real(kind_phys), dimension(nCol), intent(inout) :: & sktp1r ! Surface(skin) temperature from previous radiation time step (K) real(kind_phys), dimension(nCol,nLev+1), intent(in),optional :: & + fluxlwUP, & ! Upwelling LW flux fluxlwUP_jac, & ! Jacobian of upward LW flux (W/m2/K) fluxlwDOWN_jac ! Jacobian of downward LW flux (W/m2/K) @@ -56,23 +57,19 @@ subroutine rrtmgp_lwadj_run(use_LW_jacobian, nCol, nLev, skt, sktp1r, fluxlwUP_j ! Initialize CCPP error handling variables errmsg = '' errflg = 0 - - print*,'skt: ',skt,sktp1r,linit_mod - print*,'Jacobian(up): ',fluxlwUP_jac - print*,'use_LW_jacobian: ',use_LW_jacobian - - if (.not. present(fluxlwUP_jac)) return + if (.not. use_LW_jacobian) return ! Compute adjustment to the surface flux using Jacobian. if(linit_mod) then dT(:) = (skt(:) - sktp1r(:)) - adjsfculw(:) = fluxlwUP_jac(:,nLev+1) * dT(:) + adjsfculw(:) = fluxlwUP(:,1) + fluxlwUP_jac(:,1) * dT(:) else adjsfculw(:) = 0. linit_mod = .true. endif - + print*,'adjsfculw: ',adjsfculw + ! Store surface temperature for next iteration sktp1r(:) = skt(:) diff --git a/physics/rrtmgp_lwadj.meta b/physics/rrtmgp_lwadj.meta index 202ccb841..8e1ca06a8 100644 --- a/physics/rrtmgp_lwadj.meta +++ b/physics/rrtmgp_lwadj.meta @@ -24,14 +24,14 @@ dimensions = () type = integer intent = in - optional = F + optional = F [skt] - standard_name = surface_skin_temperature - long_name = surface skin temperature + standard_name = air_temperature_at_lowest_model_layer + long_name = air temperature at lowest model layer units = K dimensions = (horizontal_dimension) type = real - kind = kind_phys + kind = kind_phys intent = in optional = F [sktp1r] @@ -42,7 +42,16 @@ type = real kind = kind_phys intent = in - optional = F + optional = F +[fluxlwUP] + standard_name = RRTMGP_lw_flux_profile_upward_allsky + long_name = RRTMGP upward longwave all-sky flux profile + units = W m-2 + dimensions = (horizontal_dimension,vertical_dimension_plus_one) + type = real + kind = kind_phys + intent = in + optional = F [fluxlwUP_jac] standard_name = RRTMGP_jacobian_of_lw_flux_profile_upward long_name = RRTMGP Jacobian upward longwave flux profile From 0a5ab18b6d87145a6f2439d94fcff55e32760e48 Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Mon, 22 Jun 2020 18:05:13 -0600 Subject: [PATCH 38/50] Moved rrtmgp_lwadj into conditional in GFS_suite_interstitial_2_run. --- physics/GFS_suite_interstitial.F90 | 45 +++++++++--- physics/GFS_suite_interstitial.meta | 56 ++++++++++++--- physics/rrtmgp_lwadj.F90 | 84 ---------------------- physics/rrtmgp_lwadj.meta | 108 ---------------------------- 4 files changed, 80 insertions(+), 213 deletions(-) delete mode 100644 physics/rrtmgp_lwadj.F90 delete mode 100644 physics/rrtmgp_lwadj.meta diff --git a/physics/GFS_suite_interstitial.F90 b/physics/GFS_suite_interstitial.F90 index 9f497af26..680185729 100644 --- a/physics/GFS_suite_interstitial.F90 +++ b/physics/GFS_suite_interstitial.F90 @@ -144,6 +144,7 @@ module GFS_suite_interstitial_2 use machine, only: kind_phys real(kind=kind_phys), parameter :: one = 1.0d0 + logical :: linit_mod = .false. contains @@ -157,18 +158,18 @@ end subroutine GFS_suite_interstitial_2_finalize !! \htmlinclude GFS_suite_interstitial_2_run.html !! #endif - subroutine GFS_suite_interstitial_2_run (im, levs, lssav, ldiag3d, lsidea, cplflx, flag_cice, shal_cnv, old_monin, mstrat, use_GP_jacobian, & - do_shoc, frac_grid, imfshalcnv, dtf, xcosz, adjsfcdsw, adjsfcdlw, cice, pgr, ulwsfc_cice, lwhd, htrsw, htrlw, xmu, ctei_rm, & - work1, work2, prsi, tgrs, prsl, qgrs_water_vapor, qgrs_cloud_water, cp, hvap, prslk, suntim, adjsfculw, adjsfculw_lnd, & - adjsfculw_ice, adjsfculw_ocn, dlwsfc, ulwsfc, psmean, dt3dt_lw, dt3dt_sw, dt3dt_pbl, dt3dt_dcnv, dt3dt_scnv, dt3dt_mp, & - ctei_rml, ctei_r, kinver, dry, icy, wet, frland, huge, errmsg, errflg) + subroutine GFS_suite_interstitial_2_run (im, levs, lssav, ldiag3d, lsidea, cplflx, flag_cice, shal_cnv, old_monin, mstrat, & + do_shoc, frac_grid, imfshalcnv, dtf, xcosz, adjsfcdsw, adjsfcdlw, cice, pgr, ulwsfc_cice, lwhd, htrsw, htrlw, xmu, ctei_rm, & + work1, work2, prsi, tgrs, prsl, qgrs_water_vapor, qgrs_cloud_water, cp, hvap, prslk, suntim, adjsfculw, adjsfculw_lnd, & + adjsfculw_ice, adjsfculw_ocn, dlwsfc, ulwsfc, psmean, dt3dt_lw, dt3dt_sw, dt3dt_pbl, dt3dt_dcnv, dt3dt_scnv, dt3dt_mp, & + ctei_rml, ctei_r, kinver, dry, icy, wet, frland, huge, use_GP_jacobian, skt, sktp1r, fluxlwUP, fluxlwUP_jac, errmsg, errflg) implicit none ! interface variables integer, intent(in ) :: im, levs, imfshalcnv logical, intent(in ) :: lssav, ldiag3d, lsidea, cplflx, shal_cnv - logical, intent(in ) :: old_monin, mstrat, do_shoc, frac_grid, use_GP_jacobian + logical, intent(in ) :: old_monin, mstrat, do_shoc, frac_grid real(kind=kind_phys), intent(in ) :: dtf, cp, hvap logical, intent(in ), dimension(im) :: flag_cice @@ -178,11 +179,21 @@ subroutine GFS_suite_interstitial_2_run (im, levs, lssav, ldiag3d, lsidea, cplfl real(kind=kind_phys), intent(in ), dimension(im, levs) :: htrsw, htrlw, tgrs, prsl, qgrs_water_vapor, qgrs_cloud_water, prslk real(kind=kind_phys), intent(in ), dimension(im, levs+1) :: prsi real(kind=kind_phys), intent(in ), dimension(im, levs, 6) :: lwhd - integer, intent(inout), dimension(im) :: kinver real(kind=kind_phys), intent(inout), dimension(im) :: suntim, dlwsfc, ulwsfc, psmean, ctei_rml, ctei_r real(kind=kind_phys), intent(in ), dimension(im) :: adjsfculw_lnd, adjsfculw_ice, adjsfculw_ocn - real(kind=kind_phys), intent(inout), dimension(im) :: adjsfculw + real(kind=kind_phys), intent( out), dimension(im) :: adjsfculw + + ! RRTMGP + logical, intent(in ) :: & + use_GP_jacobian ! Use RRTMGP LW Jacobian of upwelling to adjust the surface flux? + real(kind=kind_phys), intent(in ), dimension(im) :: & + skt ! Skin temperature + real(kind=kind_phys), intent(inout), dimension(im) :: & + sktp1r ! Skin temperature at previous timestep + real(kind=kind_phys), intent(in ), dimension(im,levs+1), optional :: & + fluxlwUP, & ! Upwelling LW flux (W/m2) + fluxlwUP_jac ! Jacobian of upwelling LW flux (W/m2/K) ! These arrays are only allocated if ldiag3d is .true. real(kind=kind_phys), intent(inout), dimension(:,:) :: dt3dt_lw, dt3dt_sw, dt3dt_pbl, dt3dt_dcnv, dt3dt_scnv, dt3dt_mp @@ -199,7 +210,7 @@ subroutine GFS_suite_interstitial_2_run (im, levs, lssav, ldiag3d, lsidea, cplfl integer :: i, k real(kind=kind_phys) :: tem1, tem2, tem, hocp logical, dimension(im) :: invrsn - real(kind=kind_phys), dimension(im) :: tx1, tx2 + real(kind=kind_phys), dimension(im) :: tx1, tx2, dT real(kind=kind_phys), parameter :: qmin = 1.0d-10 @@ -227,8 +238,20 @@ subroutine GFS_suite_interstitial_2_run (im, levs, lssav, ldiag3d, lsidea, cplfl ! --- ... sfc lw fluxes used by atmospheric model are saved for output ! --- ... when using RRTMGP w/ use_GP_jacobian, these adjustment factors are pre-computed ! --- ... and provided as inputs in this routine. - - if (.not. use_GP_jacobian) then + + if (use_GP_jacobian) then + ! Compute adjustment to the surface flux using Jacobian. + if(linit_mod) then + dT(:) = (skt(:) - sktp1r(:)) + adjsfculw(:) = fluxlwUP(:,1) + fluxlwUP_jac(:,1) * dT(:) + else + adjsfculw(:) = 0. + linit_mod = .true. + endif + + ! Store surface temperature for next iteration + sktp1r(:) = skt(:) + else if (frac_grid) then do i=1,im tem = (one - frland(i)) * cice(i) ! tem = ice fraction wrt whole cell diff --git a/physics/GFS_suite_interstitial.meta b/physics/GFS_suite_interstitial.meta index 083326dff..605380198 100644 --- a/physics/GFS_suite_interstitial.meta +++ b/physics/GFS_suite_interstitial.meta @@ -353,15 +353,7 @@ dimensions = () type = logical intent = in - optional = F -[use_GP_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 - optional = F + optional = F [frac_grid] standard_name = flag_for_fractional_grid long_name = flag for fractional grid @@ -592,7 +584,7 @@ dimensions = (horizontal_dimension) type = real kind = kind_phys - intent = inout + intent = out optional = F [adjsfculw_lnd] standard_name = surface_upwelling_longwave_flux_over_land_interstitial @@ -770,6 +762,50 @@ kind = kind_phys intent = in optional = F +[use_GP_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 + optional = F +[skt] + standard_name = air_temperature_at_lowest_model_layer + long_name = air temperature at lowest model layer + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[sktp1r] + standard_name = surface_skin_temperature_at_previous_time_step + long_name = surface skin temperature at previous time step + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[fluxlwUP] + standard_name = RRTMGP_lw_flux_profile_upward_allsky + long_name = RRTMGP upward longwave all-sky flux profile + units = W m-2 + dimensions = (horizontal_dimension,vertical_dimension_plus_one) + type = real + kind = kind_phys + intent = in + optional = F +[fluxlwUP_jac] + standard_name = RRTMGP_jacobian_of_lw_flux_profile_upward + long_name = RRTMGP Jacobian upward longwave flux profile + units = W m-2 K-1 + dimensions = (horizontal_dimension,vertical_dimension_plus_one) + type = real + kind = kind_phys + intent = in + optional = T [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/rrtmgp_lwadj.F90 b/physics/rrtmgp_lwadj.F90 deleted file mode 100644 index 4f5bcb89e..000000000 --- a/physics/rrtmgp_lwadj.F90 +++ /dev/null @@ -1,84 +0,0 @@ -! ########################################################################################### -! ########################################################################################### -module rrtmgp_lwadj - use machine, only: kind_phys - use rrtmgp_aux, only: check_error_msg - implicit none - - logical :: & - linit_mod = .false. ! - - public rrtmgp_lwadj_init, rrtmgp_lwadj_run, rrtmgp_lwadj_finalize -contains - - ! ######################################################################################### - ! SUBROUTINE rrtmgp_lwadj_init - ! ######################################################################################### - subroutine rrtmgp_lwadj_init() - end subroutine rrtmgp_lwadj_init - - ! ######################################################################################### - ! SUBROUTINE rrtmgp_lwadj_run - ! ######################################################################################### -!> \section arg_table_rrtmgp_lwadj_run Argument Table -!! \htmlinclude rrtmgp_lwadj_run.html -!! - subroutine rrtmgp_lwadj_run(use_LW_jacobian, nCol, nLev, skt, sktp1r, fluxlwUP_jac, & - fluxlwDOWN_jac, fluxlwUP, adjsfculw, adjsfcdlw, errmsg, errflg) - - ! Inputs - logical, intent(in) :: & - use_LW_jacobian ! If true the GP scheme is using the Jacobians of the upward/downward - ! to adjust the LW surface fluxes between radiation calls. - integer, intent(in) :: & - nCol, & ! Number of horizontal gridpoints - nLev ! Number of vertical levels - real(kind_phys), dimension(nCol), intent(in) :: & - skt ! Surface(skin) temperature (K) - real(kind_phys), dimension(nCol), intent(inout) :: & - sktp1r ! Surface(skin) temperature from previous radiation time step (K) - real(kind_phys), dimension(nCol,nLev+1), intent(in),optional :: & - fluxlwUP, & ! Upwelling LW flux - fluxlwUP_jac, & ! Jacobian of upward LW flux (W/m2/K) - fluxlwDOWN_jac ! Jacobian of downward LW flux (W/m2/K) - - ! Outputs - character(len=*), intent(out) :: & - errmsg ! CCPP error message - integer, intent(out) :: & - errflg ! CCPP error flag - real(kind_phys), dimension(nCol), intent(inout) :: & - adjsfculw, & ! - adjsfcdlw ! - - ! Local - real(kind_phys),dimension(nCol) :: dT - - ! Initialize CCPP error handling variables - errmsg = '' - errflg = 0 - - if (.not. use_LW_jacobian) return - - ! Compute adjustment to the surface flux using Jacobian. - if(linit_mod) then - dT(:) = (skt(:) - sktp1r(:)) - adjsfculw(:) = fluxlwUP(:,1) + fluxlwUP_jac(:,1) * dT(:) - else - adjsfculw(:) = 0. - linit_mod = .true. - endif - print*,'adjsfculw: ',adjsfculw - - ! Store surface temperature for next iteration - sktp1r(:) = skt(:) - - end subroutine rrtmgp_lwadj_run - - ! ######################################################################################### - ! SUBROUTINE rrtmgp_lwadj_finalize - ! ######################################################################################### - subroutine rrtmgp_lwadj_finalize() - end subroutine rrtmgp_lwadj_finalize - -end module rrtmgp_lwadj diff --git a/physics/rrtmgp_lwadj.meta b/physics/rrtmgp_lwadj.meta deleted file mode 100644 index 8e1ca06a8..000000000 --- a/physics/rrtmgp_lwadj.meta +++ /dev/null @@ -1,108 +0,0 @@ -[ccpp-arg-table] - name = rrtmgp_lwadj_run - type = scheme -[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 - optional = F -[ncol] - standard_name = horizontal_loop_extent - long_name = horizontal dimension - units = count - dimensions = () - type = integer - intent = in - optional = F -[nLev] - standard_name = vertical_dimension - long_name = number of vertical levels - units = count - dimensions = () - type = integer - intent = in - optional = F -[skt] - standard_name = air_temperature_at_lowest_model_layer - long_name = air temperature at lowest model layer - units = K - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = in - optional = F -[sktp1r] - standard_name = surface_skin_temperature_at_previous_time_step - long_name = surface skin temperature at previous time step - units = K - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = in - optional = F -[fluxlwUP] - standard_name = RRTMGP_lw_flux_profile_upward_allsky - long_name = RRTMGP upward longwave all-sky flux profile - units = W m-2 - dimensions = (horizontal_dimension,vertical_dimension_plus_one) - type = real - kind = kind_phys - intent = in - optional = F -[fluxlwUP_jac] - standard_name = RRTMGP_jacobian_of_lw_flux_profile_upward - long_name = RRTMGP Jacobian upward longwave flux profile - units = W m-2 K-1 - dimensions = (horizontal_dimension,vertical_dimension_plus_one) - type = real - kind = kind_phys - intent = in - optional = T -[fluxlwDOWN_jac] - standard_name = RRTMGP_jacobian_of_lw_flux_profile_downward - long_name = RRTMGP Jacobian downward of longwave flux profile - units = W m-2 K-1 - dimensions = (horizontal_dimension,vertical_dimension_plus_one) - type = real - kind = kind_phys - intent = in - optional = T -[errmsg] - standard_name = ccpp_error_message - long_name = error message for error handling in CCPP - units = none - dimensions = () - type = character - kind = len=* - intent = out - optional = F -[errflg] - standard_name = ccpp_error_flag - long_name = error flag for error handling in CCPP - units = flag - dimensions = () - type = integer - intent = out - optional = F -[adjsfcdlw] - standard_name = surface_downwelling_longwave_flux - long_name = surface downwelling longwave flux at current time - units = W m-2 - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = inout - optional = F -[adjsfculw] - standard_name = surface_upwelling_longwave_flux - long_name = surface upwelling longwave flux at current time - units = W m-2 - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = inout - optional = F - From fea249135c5f9e75ffe3a32b0981656ba13d5b0e Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Mon, 27 Jul 2020 18:17:02 -0600 Subject: [PATCH 39/50] Some bug fixes from previous commit. Now running --- physics/GFS_suite_interstitial.F90 | 18 +++++++++--------- physics/rrtmgp_gfdlmp_lw_cloud_sampling.F90 | 10 +++++++++- physics/rrtmgp_gfdlmp_sw_cloud_sampling.F90 | 10 +++++++++- 3 files changed, 27 insertions(+), 11 deletions(-) diff --git a/physics/GFS_suite_interstitial.F90 b/physics/GFS_suite_interstitial.F90 index b04561db2..5e6104478 100644 --- a/physics/GFS_suite_interstitial.F90 +++ b/physics/GFS_suite_interstitial.F90 @@ -161,7 +161,7 @@ end subroutine GFS_suite_interstitial_2_finalize subroutine GFS_suite_interstitial_2_run (im, levs, lssav, ldiag3d, lsidea, cplflx, flag_cice, shal_cnv, old_monin, mstrat, & do_shoc, frac_grid, imfshalcnv, dtf, xcosz, adjsfcdsw, adjsfcdlw, cice, pgr, ulwsfc_cice, lwhd, htrsw, htrlw, xmu, ctei_rm, & work1, work2, prsi, tgrs, prsl, qgrs_water_vapor, qgrs_cloud_water, cp, hvap, prslk, suntim, adjsfculw, adjsfculw_lnd, & - adjsfculw_ice, adjsfculw_ocn, dlwsfc, ulwsfc, psmean, dt3dt_lw, dt3dt_sw, dt3dt_pbl, dt3dt_dcnv, dt3dt_scnv, dt3dt_mp, & + adjsfculw_ice, adjsfculw_wat, dlwsfc, ulwsfc, psmean, dt3dt_lw, dt3dt_sw, dt3dt_pbl, dt3dt_dcnv, dt3dt_scnv, dt3dt_mp, & ctei_rml, ctei_r, kinver, dry, icy, wet, frland, huge, use_GP_jacobian, skt, sktp1r, fluxlwUP, fluxlwUP_jac, errmsg, errflg) implicit none @@ -169,7 +169,7 @@ subroutine GFS_suite_interstitial_2_run (im, levs, lssav, ldiag3d, lsidea, cplfl ! interface variables integer, intent(in ) :: im, levs, imfshalcnv logical, intent(in ) :: lssav, ldiag3d, lsidea, cplflx, shal_cnv - logical, intent(in ) :: old_monin, mstrat, do_shoc, frac_grid, use_GP_jacobian + logical, intent(in ) :: old_monin, mstrat, do_shoc, frac_grid real(kind=kind_phys), intent(in ) :: dtf, cp, hvap logical, intent(in ), dimension(im) :: flag_cice @@ -259,11 +259,11 @@ subroutine GFS_suite_interstitial_2_run (im, levs, lssav, ldiag3d, lsidea, cplfl if (flag_cice(i)) then adjsfculw(i) = adjsfculw_lnd(i) * frland(i) & + ulwsfc_cice(i) * tem & - + adjsfculw_ocn(i) * (one - frland(i) - tem) + + adjsfculw_wat(i) * (one - frland(i) - tem) else adjsfculw(i) = adjsfculw_lnd(i) * frland(i) & + adjsfculw_ice(i) * tem & - + adjsfculw_ocn(i) * (one - frland(i) - tem) + + adjsfculw_wat(i) * (one - frland(i) - tem) endif enddo else @@ -273,20 +273,20 @@ subroutine GFS_suite_interstitial_2_run (im, levs, lssav, ldiag3d, lsidea, cplfl elseif (icy(i)) then ! ice (and water) tem = one - cice(i) if (flag_cice(i)) then - if (wet(i) .and. adjsfculw_ocn(i) /= huge) then - adjsfculw(i) = ulwsfc_cice(i)*cice(i) + adjsfculw_ocn(i)*tem + if (wet(i) .and. adjsfculw_wat(i) /= huge) then + adjsfculw(i) = ulwsfc_cice(i)*cice(i) + adjsfculw_wat(i)*tem else adjsfculw(i) = ulwsfc_cice(i) endif else - if (wet(i) .and. adjsfculw_ocn(i) /= huge) then - adjsfculw(i) = adjsfculw_ice(i)*cice(i) + adjsfculw_ocn(i)*tem + if (wet(i) .and. adjsfculw_wat(i) /= huge) then + adjsfculw(i) = adjsfculw_ice(i)*cice(i) + adjsfculw_wat(i)*tem else adjsfculw(i) = adjsfculw_ice(i) endif endif else ! all water - adjsfculw(i) = adjsfculw_ocn(i) + adjsfculw(i) = adjsfculw_wat(i) endif enddo endif diff --git a/physics/rrtmgp_gfdlmp_lw_cloud_sampling.F90 b/physics/rrtmgp_gfdlmp_lw_cloud_sampling.F90 index 94c813a94..cde622728 100644 --- a/physics/rrtmgp_gfdlmp_lw_cloud_sampling.F90 +++ b/physics/rrtmgp_gfdlmp_lw_cloud_sampling.F90 @@ -18,13 +18,21 @@ module rrtmgp_gfdlmp_lw_cloud_sampling !! \section arg_table_rrtmgp_gfdlmp_lw_cloud_sampling_init !! \htmlinclude rrtmgp_gfdlmp_lw_cloud_sampling_init.html !! - subroutine rrtmgp_gfdlmp_lw_cloud_sampling_init(lw_gas_props, ipsdlw0) + subroutine rrtmgp_gfdlmp_lw_cloud_sampling_init(lw_gas_props, ipsdlw0, errmsg, errflg) ! Inputs type(ty_gas_optics_rrtmgp),intent(in) :: & lw_gas_props ! RRTMGP DDT: K-distribution data ! Outputs integer, intent(out) :: & ipsdlw0 ! Initial permutation seed for McICA + character(len=*), intent(out) :: & + errmsg ! Error message + integer, intent(out) :: & + errflg ! Error flag + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 ! Set initial permutation seed for McICA, initially set to number of G-points ipsdlw0 = lw_gas_props%get_ngpt() diff --git a/physics/rrtmgp_gfdlmp_sw_cloud_sampling.F90 b/physics/rrtmgp_gfdlmp_sw_cloud_sampling.F90 index 19f0a2d8a..43032032b 100644 --- a/physics/rrtmgp_gfdlmp_sw_cloud_sampling.F90 +++ b/physics/rrtmgp_gfdlmp_sw_cloud_sampling.F90 @@ -17,13 +17,21 @@ module rrtmgp_gfdlmp_sw_cloud_sampling !! \section arg_table_rrtmgp_gfdlmp_sw_cloud_sampling_init !! \htmlinclude rrtmgp_gfdlmp_sw_cloud_sampling.html !! - subroutine rrtmgp_gfdlmp_sw_cloud_sampling_init(sw_gas_props, ipsdsw0) + subroutine rrtmgp_gfdlmp_sw_cloud_sampling_init(sw_gas_props, ipsdsw0, errmsg, errflg) ! Inputs type(ty_gas_optics_rrtmgp),intent(in) :: & sw_gas_props ! RRTMGP DDT: K-distribution data ! Outputs integer, intent(out) :: & ipsdsw0 ! Initial permutation seed for McICA + character(len=*), intent(out) :: & + errmsg ! Error message + integer, intent(out) :: & + errflg ! Error flag + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 ! Set initial permutation seed for McICA, initially set to number of G-points ipsdsw0 = sw_gas_props%get_ngpt() From fc7d561e31c92b42dc867df0670b3f5b99f6150c Mon Sep 17 00:00:00 2001 From: "Linlin.Pan" Date: Thu, 30 Jul 2020 13:39:20 +0000 Subject: [PATCH 40/50] Bug fix for rrfs_v1beta debug regression test modified file physics/drag_suite.F90 physics/module_sf_noahmp_glacier.f90 The codes have been tested on Hera. --- physics/drag_suite.F90 | 1 + physics/module_sf_noahmp_glacier.f90 | 2 ++ 2 files changed, 3 insertions(+) diff --git a/physics/drag_suite.F90 b/physics/drag_suite.F90 index 725011ee4..1a0c0a3d8 100644 --- a/physics/drag_suite.F90 +++ b/physics/drag_suite.F90 @@ -473,6 +473,7 @@ subroutine drag_suite_run( & ! Initialize CCPP error handling variables errmsg = '' errflg = 0 + var_temp2=0. !-------------------------------------------------------------------- diff --git a/physics/module_sf_noahmp_glacier.f90 b/physics/module_sf_noahmp_glacier.f90 index 1b9b3cf3f..61d7b4e3a 100644 --- a/physics/module_sf_noahmp_glacier.f90 +++ b/physics/module_sf_noahmp_glacier.f90 @@ -1111,6 +1111,8 @@ subroutine glacier_flux (nsoil ,nsnow ,emg ,isnow ,df ,dzsnso ,z dtg = 0. mozsgn = 0 mozold = 0. + moz=0. + h = 0. fv = 0.1 From eba02e9d518921c786e617f883c5d143cbf6e8ae Mon Sep 17 00:00:00 2001 From: "Linlin.Pan" Date: Thu, 30 Jul 2020 14:07:23 +0000 Subject: [PATCH 41/50] Update the codes according to the comments. Modified codes: physics/drag_suite.F90 physics/module_sf_noahmp_glacier.f90 --- physics/drag_suite.F90 | 2 +- physics/module_sf_noahmp_glacier.f90 | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/physics/drag_suite.F90 b/physics/drag_suite.F90 index 1a0c0a3d8..55ef9c268 100644 --- a/physics/drag_suite.F90 +++ b/physics/drag_suite.F90 @@ -473,7 +473,7 @@ subroutine drag_suite_run( & ! Initialize CCPP error handling variables errmsg = '' errflg = 0 - var_temp2=0. + var_temp2 = 0. !-------------------------------------------------------------------- diff --git a/physics/module_sf_noahmp_glacier.f90 b/physics/module_sf_noahmp_glacier.f90 index 61d7b4e3a..f3e0531f5 100644 --- a/physics/module_sf_noahmp_glacier.f90 +++ b/physics/module_sf_noahmp_glacier.f90 @@ -1111,7 +1111,7 @@ subroutine glacier_flux (nsoil ,nsnow ,emg ,isnow ,df ,dzsnso ,z dtg = 0. mozsgn = 0 mozold = 0. - moz=0. + moz = 0. h = 0. fv = 0.1 From 390e5d6b2213c890fe0158559c9980d408e586a2 Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Thu, 30 Jul 2020 16:23:37 +0000 Subject: [PATCH 42/50] Add new cloud-overlap assumptions (see NCAR/ccpp-physics PR#477). Moving over to SCM for debugging. --- physics/GFS_cloud_diagnostics.F90 | 38 ++++++++- physics/mo_cloud_sampling.F90 | 95 ++++++++++++++++++++- physics/rrtmgp_gfdlmp_lw_cloud_sampling.F90 | 7 +- physics/rrtmgp_gfdlmp_sw_cloud_sampling.F90 | 11 ++- 4 files changed, 139 insertions(+), 12 deletions(-) diff --git a/physics/GFS_cloud_diagnostics.F90 b/physics/GFS_cloud_diagnostics.F90 index 2d616d3dc..fc956f711 100644 --- a/physics/GFS_cloud_diagnostics.F90 +++ b/physics/GFS_cloud_diagnostics.F90 @@ -113,7 +113,7 @@ subroutine GFS_cloud_diagnostics_run(Model, nCol, nLev, lat, p_lay, tv_lay, cld_ ! ! Estimate clouds decorrelation length in km ! *this is only a tentative test, need to consider change later* - if ( iovrlw == 3 .and. iovrsw == 3) then + if ( iovr == 3) then do iCol =1,nCol de_lgth(iCol) = max( 0.6, 2.78-4.6*rlat(iCol) ) do iLay=nLev,2,-1 @@ -124,10 +124,17 @@ subroutine GFS_cloud_diagnostics_run(Model, nCol, nLev, lat, p_lay, tv_lay, cld_ enddo enddo endif + + + ! Call subroutine get_alpha to define alpha parameter for EXP and ER cloud overlap options + if ( iovr == 4 .or. iovr == 5 ) then + call get_alpha(nCol, nLev, deltaZ, iovr, lat, julian, yearlen, cldtot, cloud_overlap_param) + endif - ! - ! Precipitation overlap parameter (Hack. Using same as cloud for now) - precip_overlap_param = cloud_overlap_param + ! + ! Precipitation overlap parameter (Hack. Using same as cloud for now) + precip_overlap_param = cloud_overlap_param + ! Compute low, mid, high, total, and boundary layer cloud fractions and clouds top/bottom ! layer indices for low, mid, and high clouds. The three cloud domain boundaries are @@ -398,6 +405,29 @@ subroutine gethml(plyr, ptop1, cldtot, cldcnv, dz, de_lgth, IX, NLAY, clds, mtop clds(i,4) = 1.0 - cl1(i) * cl2(i) ! save total cloud enddo + elseif ( iovr == 4 .or. iovr == 5 ) then ! exponential overlap (iovr=4), or + ! exponential-random (iovr=5); + ! distinction defined by alpha + do k = kstr, kend, kinc + do i = 1, ix + ccur = min( ovcst, max( cldtot(i,k), cldcnv(i,k) )) + if (ccur >= climit) then ! cloudy layer + cl2(i) = alpha(i,k) * min(cl2(i), (1.0 - ccur)) & ! maximum part + + (1.0 - alpha(i,k)) * (cl2(i) * (1.0 - ccur)) ! random part + else ! clear layer + cl1(i) = cl1(i) * cl2(i) + cl2(i) = 1.0 + endif + enddo + if (k == llyr) then + do i = 1, ix + clds(i,5) = 1.0 - cl1(i) * cl2(i) ! save bl cloud + enddo + endif + enddo + do i = 1, ix + clds(i,4) = 1.0 - cl1(i) * cl2(i) ! save total cloud + enddo endif ! end_if_iovr ! --- high, mid, low clouds, where cl1, cl2 are cloud fractions diff --git a/physics/mo_cloud_sampling.F90 b/physics/mo_cloud_sampling.F90 index d2225a230..d743a7af2 100644 --- a/physics/mo_cloud_sampling.F90 +++ b/physics/mo_cloud_sampling.F90 @@ -192,8 +192,101 @@ function sampled_mask_max_ran(randoms,cloud_frac,cloud_mask) result(error_msg) end function sampled_mask_max_ran ! ------------------------------------------------------------------------------------------------- ! - ! Generate a McICA-sampled cloud mask for exponential-decorrelation overlap + ! Generate a McICA-sampled cloud mask for exponential-random overlap ! The overlap parameter alpha is defined between pairs of layers + ! for layer i, alpha(i) describes the overlap betwen cloud_frac(i) and cloud_frac(i+1) + ! By skipping layers with 0 cloud fraction the code forces alpha(i) = 0 for cloud_frac(i) = 0. + ! + function sampled_mask_exp_ran(randoms,cloud_frac,overlap_param,cloud_mask) result(error_msg) + real(wp), dimension(:,:,:), intent(in ) :: randoms ! ngpt,nlay,ncol + real(wp), dimension(:,:), intent(in ) :: cloud_frac ! ncol,nlay + real(wp), dimension(:,:), intent(in ) :: overlap_param ! ncol,nlay-1 + logical, dimension(:,:,:), intent(out) :: cloud_mask ! ncol,nlay,ngpt + character(len=128) :: error_msg + ! ------------------------ + integer :: ncol, nlay, ngpt, icol, ilay, igpt + integer :: cloud_lay_fst, cloud_lay_lst + real(wp) :: rho ! correlation coefficient + real(wp), dimension(size(randoms,1)) :: local_rands + logical, dimension(size(randoms,2)) :: cloud_mask_layer + ! ------------------------ + ! + ! Error checking + ! + error_msg = "" + ncol = size(randoms, 3) + nlay = size(randoms, 2) + ngpt = size(randoms, 1) + if(any([ncol,nlay] /= [size(cloud_frac, 1),size(cloud_frac, 2)])) then + error_msg = "sampled_mask_max_ran: sizes of randoms(ngpt,nlay,ncol) and cloud_frac(ncol,nlay) are inconsistent" + return + end if + if(any([ncol,nlay-1] /= [size(overlap_param, 1),size(overlap_param, 2)])) then + error_msg = "sampled_mask_max_ran: sizes of randoms(ngpt,nlay,ncol) and overlap_param(ncol,nlay-1) are inconsistent" + return + end if + if(any([ncol,nlay,ngpt] /= [size(cloud_mask, 1),size(cloud_mask, 2), size(cloud_mask,3)])) then + error_msg = "sampled_mask_max_ran: sizes of randoms(ngpt,nlay,ncol) and cloud_mask(ncol,nlay,ngpt) are inconsistent" + return + end if + + if(any(cloud_frac > 1._wp) .or. any(cloud_frac < 0._wp)) then + error_msg = "sampled_mask_max_ran: cloud fraction values out of range [0,1]" + return + end if + if(any(overlap_param > 1._wp) .or. any(overlap_param < -1._wp)) then + error_msg = "sampled_mask_max_ran: overlap_param values out of range [-1,1]" + return + end if + ! + ! We chould check the random numbers but that would be computationally heavy + ! + ! ------------------------ + ! Construct the cloud mask for each column + ! + do icol = 1, ncol + cloud_mask_layer(1:nlay) = cloud_frac(icol,1:nlay) > 0._wp + if(.not. any(cloud_mask_layer)) then + cloud_mask(icol,1:nlay,1:ngpt) = .false. + cycle + end if + cloud_lay_fst = findloc(cloud_mask_layer, .true., dim=1) + cloud_lay_lst = findloc(cloud_mask_layer, .true., dim=1, back = .true.) + cloud_mask(icol,1:cloud_lay_fst,1:ngpt) = .false. + + ilay = cloud_lay_fst + local_rands(1:ngpt) = randoms(1:ngpt,ilay,icol) + cloud_mask(icol,ilay,1:ngpt) = local_rands(1:ngpt) > (1._wp - cloud_frac(icol,ilay)) + do ilay = cloud_lay_fst+1, cloud_lay_lst + if(cloud_mask_layer(ilay)) then + ! + ! Exponential-random overlap: + ! new random deviates if the adjacent layer isn't cloudy + ! correlated deviates if the adjacent layer is cloudy + ! + if(cloud_mask_layer(ilay-1)) then + ! + ! Create random deviates correlated between this layer and the previous layer + ! (have to remove mean value before enforcing correlation) + ! + rho = overlap_param(icol,ilay-1) + local_rands(1:ngpt) = rho*(local_rands(1:ngpt) -0.5_wp) + & + sqrt(1._wp-rho*rho)*(randoms(1:ngpt,ilay,icol)-0.5_wp) + 0.5_wp + else + local_rands(1:ngpt) = randoms(1:ngpt,ilay,icol) + end if + cloud_mask(icol,ilay,1:ngpt) = local_rands(1:ngpt) > (1._wp - cloud_frac(icol,ilay)) + end if + end do + + cloud_mask(icol,cloud_lay_lst+1:nlay, 1:ngpt) = .false. + end do + end function sampled_mask_exp_ran + + ! ------------------------------------------------------------------------------------------------- + ! + ! Generate a McICA-sampled cloud mask for exponential-decorrelation overlap + ! The overlap parameter is defined between pairs of layers ! function sampled_mask_exp_dcorr(randoms1,randoms2,cloud_frac,overlap_param,cloud_mask) result(error_msg) real(wp), dimension(:,:,:), intent(in ) :: randoms1,randoms2 ! ngpt,nlay,ncol diff --git a/physics/rrtmgp_gfdlmp_lw_cloud_sampling.F90 b/physics/rrtmgp_gfdlmp_lw_cloud_sampling.F90 index cde622728..4b97a1301 100644 --- a/physics/rrtmgp_gfdlmp_lw_cloud_sampling.F90 +++ b/physics/rrtmgp_gfdlmp_lw_cloud_sampling.F90 @@ -3,7 +3,7 @@ module rrtmgp_gfdlmp_lw_cloud_sampling use mo_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp use physparam, only: isubclw, iovrlw use mo_optical_props, only: ty_optical_props_1scl - use mo_cloud_sampling, only: sampled_mask_max_ran, sampled_mask_exp_dcorr, draw_samples + use mo_cloud_sampling, only: sampled_mask_max_ran, sampled_mask_exp_dcorr, sampled_mask_exp_ran, draw_samples use mersenne_twister, only: random_setseed, random_number, random_stat use rrtmgp_aux, only: check_error_msg use netcdf @@ -96,7 +96,7 @@ subroutine rrtmgp_gfdlmp_lw_cloud_sampling_run(doLWrad, nCol, nLev, ipsdlw0, ics errflg = 0 ! - if (iovrlw .ne. 1 .and. iovrlw .ne. 3) then + if (iovrlw .ne. 1 .and. iovrlw .ne. 3 .and. iovrlw .ne. 4 .and. iovrlw .ne. 5) then errmsg = 'Cloud overlap assumption not supported by GFDL microphysics suite.' errflg = 1 call check_error_msg('rrtmgp_gfdlmp_lw_cloud_sampling',errmsg) @@ -133,7 +133,6 @@ subroutine rrtmgp_gfdlmp_lw_cloud_sampling_run(doLWrad, nCol, nLev, ipsdlw0, ics ! Call McICA select case ( iovrlw ) - ! Maximumn-random case(1) ! Maximum-random overlap call check_error_msg('rrtmgp_gfdlmp_lw_cloud_sampling_run',sampled_mask_max_ran(rng3D,cld_frac,cldfracMCICA)) case(3) ! Exponential decorrelation length overlap @@ -145,6 +144,8 @@ subroutine rrtmgp_gfdlmp_lw_cloud_sampling_run(doLWrad, nCol, nLev, ipsdlw0, ics enddo call check_error_msg('rrtmgp_gfdlmp_lw_cloud_sampling_run',& sampled_mask_exp_dcorr(rng3D,rng3D2,cld_frac,cloud_overlap_param(:,1:nLev-1),cldfracMCICA)) + case(5) ! Exponential-random overlap + call check_error_msg('rrtmgp_gfdlmp_lw_cloud_sampling_run',sampled_mask_exp_ran(rng3D,cld_frac,cldfracMCICA)) end select ! Map band optical depth to each g-point using McICA diff --git a/physics/rrtmgp_gfdlmp_sw_cloud_sampling.F90 b/physics/rrtmgp_gfdlmp_sw_cloud_sampling.F90 index 43032032b..ebf2257de 100644 --- a/physics/rrtmgp_gfdlmp_sw_cloud_sampling.F90 +++ b/physics/rrtmgp_gfdlmp_sw_cloud_sampling.F90 @@ -3,7 +3,7 @@ module rrtmgp_gfdlmp_sw_cloud_sampling use mo_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp use physparam, only: isubcsw, iovrsw use mo_optical_props, only: ty_optical_props_2str - use mo_cloud_sampling, only: sampled_mask_max_ran, sampled_mask_exp_dcorr, draw_samples + use mo_cloud_sampling, only: sampled_mask_max_ran, sampled_mask_exp_dcorr, sampled_mask_exp_ran, draw_samples use mersenne_twister, only: random_setseed, random_number, random_stat use rrtmgp_aux, only: check_error_msg use netcdf @@ -99,7 +99,7 @@ subroutine rrtmgp_gfdlmp_sw_cloud_sampling_run(doSWrad, nCol, nDay, nLev, ipsdsw errflg = 0 ! Only works w/ SDFs v15p2 and v16beta - if (iovrsw .ne. 1 .and. iovrsw .ne. 3) then + if (iovrsw .ne. 1 .and. iovrsw .ne. 3 .and. iovrsw .ne. 4 .an. iovrsw .ne. 5) then errmsg = 'Cloud overlap assumption not supported by GFDL microphysics suite.' errflg = 1 call check_error_msg('rrtmgp_gfdlmp_sw_cloud_sampling',errmsg) @@ -137,10 +137,10 @@ subroutine rrtmgp_gfdlmp_sw_cloud_sampling_run(doSWrad, nCol, nDay, nLev, ipsdsw ! Call McICA select case ( iovrsw ) - case(1) ! Maximum-random + case(1) ! Maximum-random overlap call check_error_msg('rrtmgp_gfdlmp_sw_cloud_sampling_run', & sampled_mask_max_ran(rng3D,cld_frac(idxday(1:nDay),:),cldfracMCICA)) - case(3) ! Exponential-random + case(3) ! Decorrelation-length overlap do iday=1,nday call random_setseed(ipseed_sw(iday),rng_stat) call random_number(rng1D,rng_stat) @@ -150,6 +150,9 @@ subroutine rrtmgp_gfdlmp_sw_cloud_sampling_run(doSWrad, nCol, nDay, nLev, ipsdsw sampled_mask_exp_dcorr(rng3D, rng3D2, cld_frac(idxday(1:nDay),:), & cloud_overlap_param(idxday(1:nDay),1:nLev-1), & cldfracMCICA)) + case(5) ! Exponential-random overlap + call check_error_msg('rrtmgp_gfdlmp_sw_cloud_sampling_run', & + sampled_mask_exp_ran(rng3D,cld_frac(idxday(1:nDay),:),cldfracMCICA)) end select ! Map band optical depth to each g-point using McICA From a696a8478b861336da0ec0ea06fbebc882e5d4a6 Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Thu, 30 Jul 2020 15:30:46 -0600 Subject: [PATCH 43/50] Added exponential-random and exponential cloud-overlap assumptions to the RRTMGP radiation scheme. This is based on NCAR/ccpp-physics PR 477, but for the GP scheme. --- physics/GFS_cloud_diagnostics.F90 | 73 ++--- physics/GFS_cloud_diagnostics.meta | 28 +- physics/GFS_rrtmgp_gfdlmp_pre.F90 | 311 ++++++++++++++++++-- physics/GFS_rrtmgp_gfdlmp_pre.meta | 79 +++++ physics/mo_cloud_sampling.F90 | 3 +- physics/physcons.F90 | 3 + physics/physparam.f | 10 +- physics/rrtmgp_gfdlmp_lw_cloud_sampling.F90 | 88 ++++-- physics/rrtmgp_gfdlmp_sw_cloud_sampling.F90 | 104 ++++--- 9 files changed, 541 insertions(+), 158 deletions(-) diff --git a/physics/GFS_cloud_diagnostics.F90 b/physics/GFS_cloud_diagnostics.F90 index fc956f711..9055cd578 100644 --- a/physics/GFS_cloud_diagnostics.F90 +++ b/physics/GFS_cloud_diagnostics.F90 @@ -5,8 +5,8 @@ ! ######################################################################################## module GFS_cloud_diagnostics use machine, only: kind_phys - use physcons, only: con_pi, con_rog - use physparam, only: iovrlw, iovrsw, ivflip, icldflg + use physcons, only: con_pi, con_rog, decorr_con + use physparam, only: iovrlw, iovrsw, ivflip, icldflg, idcor use GFS_typedefs, only: GFS_control_type ! Module parameters (imported directly from radiation_cloud.f) @@ -41,9 +41,9 @@ end subroutine GFS_cloud_diagnostics_init !! \section arg_table_GFS_cloud_diagnostics_run !! \htmlinclude GFS_cloud_diagnostics_run.html !! - subroutine GFS_cloud_diagnostics_run(Model, nCol, nLev, lat, p_lay, tv_lay, cld_frac, & - p_lev, mbota, mtopa, cldsa, de_lgth, cloud_overlap_param, precip_overlap_param, & - errmsg, errflg) + subroutine GFS_cloud_diagnostics_run(Model, nCol, nLev, lat, de_lgth, p_lay, cld_frac, & + p_lev, deltaZ, cloud_overlap_param, precip_overlap_param, & + mbota, mtopa, cldsa, errmsg, errflg) implicit none ! Inputs @@ -53,13 +53,17 @@ subroutine GFS_cloud_diagnostics_run(Model, nCol, nLev, lat, p_lay, tv_lay, cld_ nCol, & ! Number of horizontal grid-points nLev ! Number of vertical-layers real(kind_phys), dimension(nCol), intent(in) :: & - lat ! Latitude + lat, & ! Latitude + de_lgth ! Decorrelation length real(kind_phys), dimension(nCol,nLev), intent(in) :: & p_lay, & ! Pressure at model-layer - tv_lay, & ! Virtual temperature cld_frac ! Total cloud fraction real(kind_phys), dimension(nCol,nLev+1), intent(in) :: & - p_lev ! Pressure at model interfaces + p_lev ! Pressure at model interfaces + real(kind_phys), dimension(nCol,nLev), intent(in) :: & + deltaZ, & ! Layer thickness (km) + cloud_overlap_param, & ! Cloud-overlap parameter + precip_overlap_param ! Precipitation overlap parameter ! Outputs character(len=*), intent(out) :: & @@ -71,18 +75,15 @@ subroutine GFS_cloud_diagnostics_run(Model, nCol, nLev, lat, p_lay, tv_lay, cld_ mtopa ! Vertical indices for cloud bases real(kind_phys), dimension(ncol,5), intent(out) :: & cldsa ! Fraction of clouds for low, middle, high, total and BL - real(kind_phys), dimension(ncol), intent(out) :: & - de_lgth ! Decorrelation length - real(kind_phys), dimension(nCol,nLev), intent(out) :: & - cloud_overlap_param, & ! Cloud-overlap parameter - precip_overlap_param ! Precipitation overlap parameter + + ! Local variables integer i,id,iCol,iLay,icld real(kind_phys) :: tem1 real(kind_phys),dimension(nCol,NK_CLDS+1) :: ptop1 real(kind_phys),dimension(nCol) :: rlat - real(kind_phys),dimension(nCol,nLev) :: cldcnv, deltaZ + real(kind_phys),dimension(nCol,nLev) :: cldcnv if (.not. (Model%lsswr .or. Model%lslwr)) return @@ -100,47 +101,13 @@ subroutine GFS_cloud_diagnostics_run(Model, nCol, nLev, lat, p_lay, tv_lay, cld_ ptop1(i,icld) = ptopc(icld,1) + tem1*max( 0.0, 4.0*rlat(i)-1.0 ) enddo enddo - - ! Compute layer-thickness - do iCol=1,nCol - do iLay=1,nLev - deltaZ(iCol,iLay) = (con_rog*0.001) * abs(log(p_lev(iCol,iLay)) - log(p_lev(iCol,iLay+1))) * tv_lay(iCol,iLay) - enddo - enddo - - ! - ! Cloud overlap parameter - ! - ! Estimate clouds decorrelation length in km - ! *this is only a tentative test, need to consider change later* - if ( iovr == 3) then - do iCol =1,nCol - de_lgth(iCol) = max( 0.6, 2.78-4.6*rlat(iCol) ) - do iLay=nLev,2,-1 - if (de_lgth(iCol) .gt. 0) then - cloud_overlap_param(iCol,iLay-1) = & - exp( -0.5 * (deltaZ(iCol,iLay)+deltaZ(iCol,iLay-1)) / de_lgth(iCol) ) - endif - enddo - enddo - endif - - - ! Call subroutine get_alpha to define alpha parameter for EXP and ER cloud overlap options - if ( iovr == 4 .or. iovr == 5 ) then - call get_alpha(nCol, nLev, deltaZ, iovr, lat, julian, yearlen, cldtot, cloud_overlap_param) - endif - - ! - ! Precipitation overlap parameter (Hack. Using same as cloud for now) - precip_overlap_param = cloud_overlap_param - ! Compute low, mid, high, total, and boundary layer cloud fractions and clouds top/bottom ! layer indices for low, mid, and high clouds. The three cloud domain boundaries are ! defined by ptopc. The cloud overlapping method is defined by control flag 'iovr', which may ! be different for lw and sw radiation programs. - call gethml(p_lay/100., ptop1, cld_frac, cldcnv, deltaZ, de_lgth, nCol, nLev, cldsa, mtopa, mbota) + call gethml(p_lay/100., ptop1, cld_frac, cldcnv, deltaZ, de_lgth, cloud_overlap_param,& + nCol, nLev, cldsa, mtopa, mbota) end subroutine GFS_cloud_diagnostics_run @@ -212,7 +179,7 @@ end subroutine hml_cloud_diagnostics_initialize ! ######################################################################################### ! ######################################################################################### - subroutine gethml(plyr, ptop1, cldtot, cldcnv, dz, de_lgth, IX, NLAY, clds, mtop, mbot) + subroutine gethml(plyr, ptop1, cldtot, cldcnv, dz, de_lgth, alpha, IX, NLAY, clds, mtop, mbot) ! =================================================================== ! ! ! ! abstract: compute high, mid, low, total, and boundary cloud fractions ! @@ -240,6 +207,7 @@ subroutine gethml(plyr, ptop1, cldtot, cldcnv, dz, de_lgth, IX, NLAY, clds, mtop ! cldcnv(IX,NLAY) : convective cloud (for diagnostic scheme only) ! ! dz (ix,nlay) : layer thickness (km) ! ! de_lgth(ix) : clouds vertical de-correlation length (km) ! + ! alpha(ix,nlay) : alpha decorrelation parameter ! ! IX : horizontal dimention ! ! NLAY : vertical layer dimensions ! ! ! @@ -259,6 +227,8 @@ subroutine gethml(plyr, ptop1, cldtot, cldcnv, dz, de_lgth, IX, NLAY, clds, mtop ! =1 max/ran overlapping clouds ! ! =2 maximum overlapping ( for mcica only ) ! ! =3 decorr-length ovlp ( for mcica only ) ! + ! =4 exponential cloud overlap (AER; mcica only) ! + ! =5 exponential-random overlap (AER; mcica only) ! ! ! ! ==================== end of description ===================== ! ! @@ -270,6 +240,7 @@ subroutine gethml(plyr, ptop1, cldtot, cldcnv, dz, de_lgth, IX, NLAY, clds, mtop real (kind=kind_phys), dimension(:,:), intent(in) :: plyr, ptop1, & cldtot, cldcnv, dz real (kind=kind_phys), dimension(:), intent(in) :: de_lgth + real (kind=kind_phys), dimension(:,:), intent(in) :: alpha ! --- outputs real (kind=kind_phys), dimension(:,:), intent(out) :: clds diff --git a/physics/GFS_cloud_diagnostics.meta b/physics/GFS_cloud_diagnostics.meta index c54e78aa2..babc2cb28 100644 --- a/physics/GFS_cloud_diagnostics.meta +++ b/physics/GFS_cloud_diagnostics.meta @@ -42,16 +42,7 @@ type = real kind = kind_phys intent = in - optional = F -[tv_lay] - standard_name = virtual_temperature - long_name = layer virtual temperature - units = K - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = in - optional = F + optional = F [cld_frac] standard_name = total_cloud_fraction long_name = layer total cloud fraction @@ -69,7 +60,7 @@ type = real kind = kind_phys intent = in - optional = F + optional = F [mtopa] standard_name = model_layer_number_at_cloud_top long_name = vertical indices for low, middle and high cloud tops @@ -93,8 +84,17 @@ dimensions = (horizontal_dimension) type = real kind = kind_phys - intent = out + intent = in optional = F +[deltaZ] + standard_name = layer_thickness + long_name = layer_thickness + units = m + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F [cloud_overlap_param] standard_name = cloud_overlap_param long_name = cloud overlap parameter @@ -102,7 +102,7 @@ dimensions = (horizontal_dimension,vertical_dimension) type = real kind = kind_phys - intent = out + intent = in optional = F [precip_overlap_param] standard_name = precip_overlap_param @@ -111,7 +111,7 @@ dimensions = (horizontal_dimension,vertical_dimension) type = real kind = kind_phys - intent = out + intent = in optional = F [cldsa] standard_name = cloud_area_fraction_for_radiation diff --git a/physics/GFS_rrtmgp_gfdlmp_pre.F90 b/physics/GFS_rrtmgp_gfdlmp_pre.F90 index 976443055..d63bcc321 100644 --- a/physics/GFS_rrtmgp_gfdlmp_pre.F90 +++ b/physics/GFS_rrtmgp_gfdlmp_pre.F90 @@ -8,8 +8,10 @@ module GFS_rrtmgp_gfdlmp_pre use physcons, only: con_ttp, & ! Temperature at h2o 3pt (K) con_rd, & ! Gas constant for dry air (J/KgK) con_pi, & ! PI - con_g ! Gravity (m/s2) - use physparam, only: lcnorm,lcrick + con_g, & ! Gravity (m/s2) + con_rog, & + decorr_con + use physparam, only: lcnorm, lcrick, idcor, iovrlw, iovrsw use rrtmgp_aux, only: check_error_msg ! Parameters @@ -20,6 +22,8 @@ module GFS_rrtmgp_gfdlmp_pre cllimit = 0.001, & ! Lowest cloud fraction in GFDL MP scheme gfac = 1.0e5/con_g + public GFS_rrtmgp_gfdlmp_pre_init, GFS_rrtmgp_gfdlmp_pre_run, GFS_rrtmgp_gfdlmp_pre_finalize + private get_alpha_dcorr, get_alpha_exp contains ! ###################################################################################### ! ###################################################################################### @@ -31,9 +35,10 @@ end subroutine GFS_rrtmgp_gfdlmp_pre_init !! \section arg_table_GFS_rrtmgp_gfdlmp_pre_run !! \htmlinclude GFS_rrtmgp_gfdlmp_pre_run.html !! - subroutine GFS_rrtmgp_gfdlmp_pre_run(Model, Tbd, nCol, nLev, p_lev, tracer, & - cld_frac, cld_lwp, cld_reliq, cld_iwp, cld_reice, cld_swp, cld_resnow, cld_rwp, & - cld_rerain, precip_frac, errmsg, errflg) + subroutine GFS_rrtmgp_gfdlmp_pre_run(Model, Tbd, nCol, nLev, yearlen, julian, lat, & + p_lev, p_lay, tv_lay, tracer, cld_frac, cld_lwp, cld_reliq, cld_iwp, cld_reice, & + cld_swp, cld_resnow, cld_rwp, cld_rerain, precip_frac, cloud_overlap_param, & + precip_overlap_param, de_lgth, deltaZ, errmsg, errflg) implicit none ! Inputs @@ -43,24 +48,37 @@ subroutine GFS_rrtmgp_gfdlmp_pre_run(Model, Tbd, nCol, nLev, p_lev, tracer, Tbd ! DDT: FV3-GFS data not yet assigned to a defined container integer, intent(in) :: & nCol, & ! Number of horizontal grid-points - nLev ! Number of vertical-layers + nLev, & ! Number of vertical-layers + yearlen ! Length of current year (365/366) WTF? + real(kind_phys), intent(in) :: & + julian ! Julian day + real(kind_phys), dimension(nCol), intent(in) :: & + lat ! Latitude + real(kind_phys), dimension(nCol,nLev), intent(in) :: & + tv_lay, & ! Virtual temperature (K) + p_lay ! Pressure at model-layers (Pa) real(kind_phys), dimension(nCol,nLev+1), intent(in) :: & p_lev ! Pressure at model-level interfaces (Pa) real(kind_phys), dimension(nCol, nLev, Model%ntrac),intent(in) :: & tracer ! Cloud condensate amount in layer by type () ! Outputs + real(kind_phys), dimension(nCol),intent(out) :: & + de_lgth ! Decorrelation length real(kind_phys), dimension(nCol,nLev),intent(out) :: & - cld_frac, & ! Total cloud fraction - cld_lwp, & ! Cloud liquid water path - cld_reliq, & ! Cloud liquid effective radius - cld_iwp, & ! Cloud ice water path - cld_reice, & ! Cloud ice effecive 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 + cld_frac, & ! Total cloud fraction + cld_lwp, & ! Cloud liquid water path + cld_reliq, & ! Cloud liquid effective radius + cld_iwp, & ! Cloud ice water path + cld_reice, & ! Cloud ice effecive 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 + cloud_overlap_param, & ! Cloud-overlap parameter + precip_overlap_param, & ! Precipitation overlap parameter + deltaZ ! Layer thickness (km) character(len=*), intent(out) :: & errmsg ! Error message integer, intent(out) :: & @@ -69,7 +87,7 @@ subroutine GFS_rrtmgp_gfdlmp_pre_run(Model, Tbd, nCol, nLev, p_lev, tracer, ! Local variables real(kind_phys) :: tem1 real(kind_phys), dimension(nCol, nLev, min(4,Model%ncnd)) :: cld_condensate - integer :: i,k,l,ncndl + integer :: iCol,iLay,l,ncndl,iovr real(kind_phys), dimension(nCol,nLev) :: deltaP if (.not. (Model%lsswr .or. Model%lslwr)) return @@ -139,9 +157,9 @@ subroutine GFS_rrtmgp_gfdlmp_pre_run(Model, Tbd, nCol, nLev, p_lev, tracer, ! Set really tiny suspended particle amounts to clear do l=1,ncndl - do k=1,nLev - do i=1,nCol - if (cld_condensate(i,k,l) < epsq) cld_condensate(i,k,l) = 0.0 + do iLay=1,nLev + do iCol=1,nCol + if (cld_condensate(iCol,iLay,l) < epsq) cld_condensate(iCol,iLay,l) = 0.0 enddo enddo enddo @@ -154,24 +172,52 @@ subroutine GFS_rrtmgp_gfdlmp_pre_run(Model, Tbd, nCol, nLev, p_lev, tracer, ! Condensate and effective size deltaP = abs(p_lev(:,2:nLev+1)-p_lev(:,1:nLev))/100. - do k = 1, nLev - do i = 1, nCol + do iLay = 1, nLev + do iCol = 1, nCol ! Compute liquid/ice condensate path from mixing ratios (kg/kg)->(g/m2) - if (cld_frac(i,k) .ge. cllimit) then - tem1 = gfac * deltaP(i,k) - cld_lwp(i,k) = cld_condensate(i,k,1) * tem1 - cld_iwp(i,k) = cld_condensate(i,k,2) * tem1 - cld_rwp(i,k) = cld_condensate(i,k,3) * tem1 - cld_swp(i,k) = cld_condensate(i,k,4) * tem1 + if (cld_frac(iCol,iLay) .ge. cllimit) then + tem1 = gfac * deltaP(iCol,iLay) + cld_lwp(iCol,iLay) = cld_condensate(iCol,iLay,1) * tem1 + cld_iwp(iCol,iLay) = cld_condensate(iCol,iLay,2) * tem1 + cld_rwp(iCol,iLay) = cld_condensate(iCol,iLay,3) * tem1 + cld_swp(iCol,iLay) = cld_condensate(iCol,iLay,4) * tem1 endif ! Use radii provided from the macrophysics - cld_reliq(i,k) = Tbd%phy_f3d(i,k,1) - cld_reice(i,k) = max(reice_min, min(reice_max,Tbd%phy_f3d(i,k,2))) - cld_rerain(i,k) = Tbd%phy_f3d(i,k,3) - cld_resnow(i,k) = Tbd%phy_f3d(i,k,4) + cld_reliq(iCol,iLay) = Tbd%phy_f3d(iCol,iLay,1) + cld_reice(iCol,iLay) = max(reice_min, min(reice_max,Tbd%phy_f3d(iCol,iLay,2))) + cld_rerain(iCol,iLay) = Tbd%phy_f3d(iCol,iLay,3) + cld_resnow(iCol,iLay) = Tbd%phy_f3d(iCol,iLay,4) enddo enddo + ! #################################################################################### + ! Cloud (and precipitation) overlap + ! #################################################################################### + + iovr = max(iovrsw,iovrlw) + + ! Compute layer-thickness + do iCol=1,nCol + do iLay=1,nLev + deltaZ(iCol,iLay) = (con_rog*0.001) * abs(log(p_lev(iCol,iLay)) - log(p_lev(iCol,iLay+1))) * tv_lay(iCol,iLay) + enddo + enddo + + ! + ! Cloud overlap parameter + ! + if (iovr == 3) then + call get_alpha_dcorr(nCol, nLev, lat, deltaZ, de_lgth, cloud_overlap_param) + endif + if (iovr == 4 .or. iovr == 5) then + call get_alpha_exp(nCol, nLev, deltaZ, iovr, lat, julian, yearlen, cld_frac, cloud_overlap_param) + endif + + ! + ! Compute precipitation overlap parameter (Hack. Using same as cloud for now) + ! + precip_overlap_param = cloud_overlap_param + end subroutine GFS_rrtmgp_gfdlmp_pre_run ! ######################################################################################### @@ -179,4 +225,205 @@ end subroutine GFS_rrtmgp_gfdlmp_pre_run subroutine GFS_rrtmgp_gfdlmp_pre_finalize() end subroutine GFS_rrtmgp_gfdlmp_pre_finalize + ! ######################################################################################### + ! Private module routines + ! ######################################################################################### + + ! ######################################################################################### + ! Subroutine to compute cloud-overlap parameter, alpha, for decorrelation-length cloud + ! overlap assumption. + ! ######################################################################################### + subroutine get_alpha_dcorr(nCol, nLev, lat, deltaZ, de_lgth, cloud_overlap_param) + + ! Inputs + integer, intent(in) :: & + nCol, & ! Number of horizontal grid-points + nLev ! Number of vertical-layers + real(kind_phys), dimension(nCol), intent(in) :: & + lat ! Latitude + real(kind_phys), dimension(nCol,nLev),intent(in) :: & + deltaZ ! Layer thickness + + ! Outputs + real(kind_phys), dimension(nCol),intent(out) :: & + de_lgth ! Decorrelation length + real(kind_phys), dimension(nCol,nLev),intent(out) :: & + cloud_overlap_param ! Cloud-overlap parameter + + ! Local + integer :: iCol, iLay + + do iCol =1,nCol + de_lgth(iCol) = max( 0.6, 2.78-4.6*abs(lat(iCol)/con_pi) ) + do iLay=nLev,2,-1 + if (de_lgth(iCol) .gt. 0) then + cloud_overlap_param(iCol,iLay-1) = & + exp( -0.5 * (deltaZ(iCol,iLay)+deltaZ(iCol,iLay-1)) / de_lgth(iCol) ) + endif + enddo + enddo + end subroutine get_alpha_dcorr + + ! ######################################################################################### +!> \ingroup module_radiation_clouds +!! This program derives the exponential transition, alpha, from maximum to +!! random overlap needed to define the fractional cloud vertical correlation +!! for the exponential (EXP, iovrlp=4) or the exponential-random (ER, iovrlp=5) +!! cloud overlap options for RRTMGP. For exponential, the transition from +!! maximum to random with distance through model layers occurs without regard +!! to the configuration of clear and cloudy layers. For the ER method, each +!! block of adjacent cloudy layers is treated with a separate transition from +!! maximum to random, and blocks of cloudy layers separated by one or more +!! clear layers are correlated randomly. +!> /param nlon : number of model longitude points +!> /param nlay : vertical layer dimension +!> /param dzlay(nlon,nlay) : distance between the center of model layers +!> /param iovrlp : cloud overlap method +!> : 0 = random +!> : 1 = maximum-random +!> : 2 = maximum +!> : 3 = decorrelation (NOAA/Hou) +!> : 4 = exponential (AER) +!> : 5 = exponential-random (AER) +!> /param latdeg(nlon) : latitude (in degrees 90 -> -90) +!> /param juldat : day of the year (fractional julian day) +!> /param yearlen : current length of the year (365/366 days) +!> /param cldf(nlon,nlay) : cloud fraction +!> /param idcor : decorrelation length method +!> : 0 = constant value (AER; decorr_con) +!> : 1 = latitude and day of year varying value (AER; Oreopoulos, et al., 2012) +!> /param decorr_con : decorrelation length constant +!! +!>\section detail Detailed Algorithm +!! @{ + subroutine get_alpha_exp(nlon, nlay, dzlay, iovrlp, latdeg, juldat, yearlen, cldf, alpha) +! =================================================================== ! +! ! +! abstract: Derives the exponential transition, alpha, from maximum to ! +! random overlap needed to define the fractional cloud vertical ! +! correlation for the exponential (EXP, iovrlp=4) or the exponential- ! +! random (ER, iovrlp=5) cloud overlap options for RRTMG. For ! +! exponential, the transition from maximum to random with distance ! +! through model layers occurs without regard to the configuration of ! +! clear and cloudy layers. For the ER method, each block of adjacent ! +! cloudy layers is treated with a separate transition from maximum to ! +! random, and blocks of cloudy layers separated by one or more ! +! clear layers are correlated randomly. ! +! ! +! usage: call get_alpha ! +! ! +! subprograms called: none ! +! ! +! attributes: ! +! language: fortran 90 ! +! machine: ibm-sp, sgi ! +! ! +! author: m.j. iacono (AER) for use with the RRTMG radiation code ! +! ! +! ==================== definition of variables ==================== ! +! ! +! Input variables: ! +! nlon : number of model longitude points ! +! nlay : vertical layer dimension ! +! dzlay(nlon,nlay) : distance between the center of model layers ! +! iovrlp : cloud overlap method ! +! : 0 = random ! +! : 1 = maximum-random ! +! : 2 = maximum ! +! : 3 = decorrelation (NOAA/Hou) ! +! : 4 = exponential (AER) ! +! : 5 = exponential-random (AER) ! +! latdeg(nlon) : latitude (in degrees 90 -> -90) ! +! juldat : day of the year (fractional julian day) ! +! yearlen : current length of the year (365/366 days) ! +! cldf(nlon,nlay) : cloud fraction ! +! ! +! output variables: ! +! alpha(nlon,nlay) : alpha exponential transition parameter for ! +! : cloud vertical correlation ! +! ! +! external module variables: (in physcons) ! +! decorr_con : decorrelation length constant (km) ! +! ! +! external module variables: (in physparam) ! +! idcor : control flag for decorrelation length method ! +! =0: constant decorrelation length (decorr_con) ! +! =1: latitude and day-of-year varying decorrelation! +! length (AER; Oreopoulos, et al., 2012) ! +! ! +! ==================== end of description ===================== ! +! + use physcons, only: decorr_con + use physparam, only: idcor + implicit none +! Input + integer, intent(in) :: nlon, nlay + integer, intent(in) :: iovrlp + integer, intent(in) :: yearlen + real(kind_phys), dimension(:,:), intent(in) :: dzlay + real(kind_phys), dimension(:,:), intent(in) :: cldf + real(kind_phys), dimension(:), intent(in) :: latdeg + real(kind_phys), intent(in) :: juldat +! Output + real(kind_phys), dimension(:,:), intent(out):: alpha +! Local + integer :: i, k + real(kind_phys) :: decorr_len(nlon) ! Decorrelation length (km) +! Constants for latitude and day-of-year dependent decorrlation length (Oreopoulos et al, 2012) +! Used when idcor = 1 + real(kind_phys), parameter :: am1 = 1.4315_kind_phys + real(kind_phys), parameter :: am2 = 2.1219_kind_phys + real(kind_phys), parameter :: am4 = -25.584_kind_phys + real(kind_phys), parameter :: amr = 7.0_kind_phys + real(kind_phys) :: am3 + real(kind_phys), parameter :: zero = 0.0d0 + real(kind_phys), parameter :: one = 1.0d0 +! +!===> ... begin here +! +! If exponential or exponential-random cloud overlap is used: +! derive day-of-year and latitude-varying decorrelation lendth if requested; +! otherwise use the constant decorrelation length, decorr_con, specified in physcons.F90 + do i = 1, nlon + if (iovrlp == 4 .or. iovrlp == 5) then + if (idcor .eq. 1) then + if (juldat .gt. 181._kind_phys) then + am3 = -4._kind_phys * amr * (juldat - 272._kind_phys) / yearlen + else + am3 = 4._kind_phys * amr * (juldat - 91._kind_phys) / yearlen + endif +! For latitude in degrees, decorr_len in km + decorr_len(i) = am1 + am2 * exp( -(latdeg(i) - am3)**2 / am4**2) + else + decorr_len(i) = decorr_con + endif + endif + enddo +! For atmospheric data defined from surface to toa; define alpha from surface to toa +! Exponential cloud overlap + if (iovrlp == 4) then + do i = 1, nlon + alpha(i,1) = zero + do k = 2, nlay + alpha(i,k) = exp( -(dzlay(i,k)) / decorr_len(i)) + enddo + enddo + endif +! Exponential-random cloud overlap + if (iovrlp == 5) then + do i = 1, nlon + alpha(i,1) = zero + do k = 2, nlay + alpha(i,k) = exp( -(dzlay(i,k)) / decorr_len(i)) + ! Decorrelate layers when a clear layer follows a cloudy layer to enforce + ! random correlation between non-adjacent blocks of cloudy layers + if (cldf(i,k) .eq. zero .and. cldf(i,k-1) .gt. zero) then + alpha(i,k) = zero + endif + enddo + enddo + endif + return + end subroutine get_alpha_exp + end module GFS_rrtmgp_gfdlmp_pre diff --git a/physics/GFS_rrtmgp_gfdlmp_pre.meta b/physics/GFS_rrtmgp_gfdlmp_pre.meta index 248348b9b..586587510 100644 --- a/physics/GFS_rrtmgp_gfdlmp_pre.meta +++ b/physics/GFS_rrtmgp_gfdlmp_pre.meta @@ -34,6 +34,31 @@ type = integer intent = in optional = F +[yearlen] + standard_name = number_of_days_in_year + long_name = number of days in a year + units = days + dimensions = () + type = integer + intent = in + optional = F +[julian] + standard_name = julian_day + long_name = julian day + units = days + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[lat] + standard_name = latitude + long_name = latitude + units = radian + dimensions = (horizontal_dimension) + type = real + intent = in + kind = kind_phys [p_lev] standard_name = air_pressure_at_interface_for_RRTMGP_in_hPa long_name = air pressure at vertical interface for radiation calculation @@ -43,6 +68,24 @@ kind = kind_phys intent = in optional = F +[p_lay] + standard_name = air_pressure_at_layer_for_RRTMGP_in_hPa + long_name = air pressure at vertical layer for radiation calculation + units = hPa + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[tv_lay] + standard_name = virtual_temperature + long_name = layer virtual temperature + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F [tracer] standard_name = chemical_tracers long_name = chemical tracers @@ -52,6 +95,15 @@ kind = kind_phys intent = in optional = F +[de_lgth] + standard_name = cloud_decorrelation_length + long_name = cloud decorrelation length + units = km + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F [cld_frac] standard_name = total_cloud_fraction long_name = layer total cloud fraction @@ -142,6 +194,33 @@ kind = kind_phys intent = out optional = F +[cloud_overlap_param] + standard_name = cloud_overlap_param + long_name = cloud overlap parameter + units = km + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[precip_overlap_param] + standard_name = precip_overlap_param + long_name = precipitation overlap parameter + units = km + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[deltaZ] + standard_name = layer_thickness + long_name = layer_thickness + units = m + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/mo_cloud_sampling.F90 b/physics/mo_cloud_sampling.F90 index d743a7af2..02741439f 100644 --- a/physics/mo_cloud_sampling.F90 +++ b/physics/mo_cloud_sampling.F90 @@ -26,7 +26,7 @@ module mo_cloud_sampling ty_optical_props_nstr implicit none private - public :: draw_samples, sampled_mask_max_ran, sampled_mask_exp_dcorr + public :: draw_samples, sampled_mask_max_ran, sampled_mask_exp_dcorr, sampled_mask_exp_ran contains ! ------------------------------------------------------------------------------------------------- ! @@ -394,4 +394,5 @@ subroutine apply_cloud_mask(ncol,nlay,nbnd,ngpt,band_lims_gpt,cloud_mask,input_f end do end do end subroutine apply_cloud_mask + end module mo_cloud_sampling diff --git a/physics/physcons.F90 b/physics/physcons.F90 index 5fb993ac3..8fbdc9930 100644 --- a/physics/physcons.F90 +++ b/physics/physcons.F90 @@ -137,6 +137,9 @@ module physcons real(kind=kind_phys),parameter:: rhosnow = 100._kind_phys !< density of snow (kg/m^3) real(kind=kind_phys),parameter:: rhoair = 1.28_kind_phys !< density of air near surface (kg/m^3) +! Decorrelation length constant (km) for iovrlw/iovrsw = 4 or 5 and idcor = 0 + real(kind=kind_phys),parameter:: decorr_con = 2.50_kind_phys + !........................................! end module physcons ! !========================================! diff --git a/physics/physparam.f b/physics/physparam.f index 795cb4fab..0747b2a14 100644 --- a/physics/physparam.f +++ b/physics/physparam.f @@ -234,6 +234,8 @@ module physparam !!\n =1:use maximum-random cloud overlapping method !!\n =2:use maximum cloud overlapping method !!\n =3:use decorrelation length overlapping method +!!\n =4:use exponential overlapping method +!!\n =5:use exponential-random overlapping method !!\n Opr GFS/CFS=1; see IOVR_SW in run scripts integer, save :: iovrsw = 1 !> cloud overlapping control flag for LW @@ -241,9 +243,15 @@ module physparam !!\n =1:use maximum-random cloud overlapping method !!\n =2:use maximum cloud overlapping method !!\n =3:use decorrelation length overlapping method +!!\n =4:use exponential overlapping method +!!\n =5:use exponential-random overlapping method !!\n Opr GFS/CFS=1; see IOVR_LW in run scripts integer, save :: iovrlw = 1 - +!!\n Decorrelation length type for iovrlw/iovrsw = 4 or 5 +!!\n =0:use constant decorrelation length defined by decorr_con (in module physcons) +!!\n =1:use day-of-year and latitude-varying decorrelation length + integer, save :: idcor = 1 + !> sub-column cloud approx flag in SW radiation !!\n =0:no McICA approximation in SW radiation !!\n =1:use McICA with precribed permutation seeds (test mode) diff --git a/physics/rrtmgp_gfdlmp_lw_cloud_sampling.F90 b/physics/rrtmgp_gfdlmp_lw_cloud_sampling.F90 index 4b97a1301..8b3b57208 100644 --- a/physics/rrtmgp_gfdlmp_lw_cloud_sampling.F90 +++ b/physics/rrtmgp_gfdlmp_lw_cloud_sampling.F90 @@ -104,9 +104,11 @@ subroutine rrtmgp_gfdlmp_lw_cloud_sampling_run(doLWrad, nCol, nLev, ipsdlw0, ics endif if (.not. doLWrad) return - ! + + ! #################################################################################### ! First sample the clouds... - ! + ! #################################################################################### + ! Allocate space RRTMGP DDTs [nCol,nLev,nGpt] call check_error_msg('rrtmgp_gfdlmp_lw_cloud_sampling_run',& lw_optical_props_clouds%alloc_1scl(nCol, nLev, lw_gas_props)) @@ -122,7 +124,6 @@ subroutine rrtmgp_gfdlmp_lw_cloud_sampling_run(doLWrad, nCol, nLev, ipsdlw0, ics enddo endif - ! Call McICA to generate subcolumns. ! 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 @@ -131,10 +132,13 @@ subroutine rrtmgp_gfdlmp_lw_cloud_sampling_run(doLWrad, nCol, nLev, ipsdlw0, ics rng3D(:,:,iCol) = reshape(source = rng1D,shape=[lw_gas_props%get_ngpt(),nLev]) enddo - ! Call McICA + ! Cloud-overlap. select case ( iovrlw ) case(1) ! Maximum-random overlap - call check_error_msg('rrtmgp_gfdlmp_lw_cloud_sampling_run',sampled_mask_max_ran(rng3D,cld_frac,cldfracMCICA)) + call check_error_msg('rrtmgp_gfdlmp_lw_cloud_sampling_run', & + sampled_mask_max_ran(rng3D, & + cld_frac, & + cldfracMCICA)) case(3) ! Exponential decorrelation length overlap ! Generate second RNG do iCol=1,ncol @@ -142,19 +146,36 @@ subroutine rrtmgp_gfdlmp_lw_cloud_sampling_run(doLWrad, nCol, nLev, ipsdlw0, ics call random_number(rng1D,rng_stat) rng3D2(:,:,iCol) = reshape(source = rng1D,shape=[lw_gas_props%get_ngpt(),nLev]) enddo - call check_error_msg('rrtmgp_gfdlmp_lw_cloud_sampling_run',& - sampled_mask_exp_dcorr(rng3D,rng3D2,cld_frac,cloud_overlap_param(:,1:nLev-1),cldfracMCICA)) + call check_error_msg('rrtmgp_gfdlmp_lw_cloud_sampling_run', & + sampled_mask_exp_dcorr(rng3D, & + rng3D2, & + cld_frac, & + cloud_overlap_param(:,1:nLev-1), & + cldfracMCICA)) + case(4) ! Exponential overlap + call check_error_msg('rrtmgp_gfdlmp_lw_cloud_sampling_run', & + sampled_mask_exp_ran(rng3D, & + cld_frac, & + cloud_overlap_param(:,1:nLev-1), & + cldfracMCICA)) case(5) ! Exponential-random overlap - call check_error_msg('rrtmgp_gfdlmp_lw_cloud_sampling_run',sampled_mask_exp_ran(rng3D,cld_frac,cldfracMCICA)) + call check_error_msg('rrtmgp_gfdlmp_lw_cloud_sampling_run', & + sampled_mask_exp_ran(rng3D, & + cld_frac, & + cloud_overlap_param(:,1:nLev-1), & + cldfracMCICA)) end select - ! Map band optical depth to each g-point using McICA - call check_error_msg('rrtmgp_gfdlmp_lw_cloud_sampling_run',draw_samples(& - cldfracMCICA,lw_optical_props_cloudsByBand,lw_optical_props_clouds)) + ! Sampling. Map band optical depth to each g-point using McICA + call check_error_msg('rrtmgp_gfdlmp_lw_cloud_sampling_run', & + draw_samples(cldfracMCICA, & + lw_optical_props_cloudsByBand, & + lw_optical_props_clouds)) - ! + ! #################################################################################### ! Next sample the precipitation... - ! + ! #################################################################################### + ! Allocate space RRTMGP DDTs [nCol,nLev,nGpt] call check_error_msg('rrtmgp_gfdlmp_lw_cloud_sampling_run',& lw_optical_props_precip%alloc_1scl(nCol, nLev, lw_gas_props)) @@ -170,7 +191,6 @@ subroutine rrtmgp_gfdlmp_lw_cloud_sampling_run(doLWrad, nCol, nLev, ipsdlw0, ics enddo endif - ! Call McICA to generate subcolumns. ! No need to call RNG second time for now, just use the same seeds for precip as clouds. !! Call RNG. Mersennse Twister accepts 1D array, so loop over columns and collapse along G-points !! and layers. ([nGpts,nLev,nColumn]-> [nGpts*nLev]*nColumn) @@ -180,11 +200,13 @@ subroutine rrtmgp_gfdlmp_lw_cloud_sampling_run(doLWrad, nCol, nLev, ipsdlw0, ics ! rng3D(:,:,iCol) = reshape(source = rng1D,shape=[lw_gas_props%get_ngpt(),nLev]) !enddo - ! Call McICA + ! Precipitation overlap. select case ( iovrlw ) - ! Maximumn-random case(1) ! Maximum-random overlap - call check_error_msg('rrtmgp_gfdlmp_lw_cloud_sampling_run',sampled_mask_max_ran(rng3D,precip_frac,precipfracSAMP)) + call check_error_msg('rrtmgp_gfdlmp_lw_cloud_sampling_run', & + sampled_mask_max_ran(rng3D, & + precip_frac, & + precipfracSAMP)) case(3) ! Exponential decorrelation length overlap ! No need to call RNG second time for now, just use the same seeds for precip as clouds. !! Generate second RNG @@ -193,17 +215,35 @@ subroutine rrtmgp_gfdlmp_lw_cloud_sampling_run(doLWrad, nCol, nLev, ipsdlw0, ics ! call random_number(rng1D,rng_stat) ! rng3D2(:,:,iCol) = reshape(source = rng1D,shape=[lw_gas_props%get_ngpt(),nLev]) !enddo - call check_error_msg('rrtmgp_gfdlmp_lw_cloud_sampling_run', & - sampled_mask_exp_dcorr(rng3D,rng3D2,precip_frac,precip_overlap_param(:,1:nLev-1),precipfracSAMP)) + call check_error_msg('rrtmgp_gfdlmp_lw_cloud_sampling_run', & + sampled_mask_exp_dcorr(rng3D, & + rng3D2, & + precip_frac, & + precip_overlap_param(:,1:nLev-1), & + precipfracSAMP)) + case(4) ! Exponential overlap + call check_error_msg('rrtmgp_gfdlmp_lw_cloud_sampling_run', & + sampled_mask_exp_ran(rng3D, & + precip_frac, & + precip_overlap_param(:,1:nLev-1), & + precipfracSAMP)) + case(5) ! Exponential-random overlap + call check_error_msg('rrtmgp_gfdlmp_lw_cloud_sampling_run', & + sampled_mask_exp_ran(rng3D, & + precip_frac, & + precip_overlap_param(:,1:nLev-1), & + precipfracSAMP)) end select - ! Map band optical depth to each g-point using McICA - call check_error_msg('rrtmgp_gfdlmp_lw_cloud_sampling_run',draw_samples(& - precipfracSAMP,lw_optical_props_precipByBand,lw_optical_props_precip)) + ! Sampling. Map band optical depth to each g-point using McICA + call check_error_msg('rrtmgp_gfdlmp_lw_cloud_sampling_run', & + draw_samples(precipfracSAMP, & + lw_optical_props_precipByBand, & + lw_optical_props_precip)) - ! + ! #################################################################################### ! For GFDL MP just add precipitation optics to cloud-optics - ! + ! #################################################################################### lw_optical_props_clouds%tau = lw_optical_props_clouds%tau + lw_optical_props_precip%tau end subroutine rrtmgp_gfdlmp_lw_cloud_sampling_run diff --git a/physics/rrtmgp_gfdlmp_sw_cloud_sampling.F90 b/physics/rrtmgp_gfdlmp_sw_cloud_sampling.F90 index ebf2257de..4986e3d61 100644 --- a/physics/rrtmgp_gfdlmp_sw_cloud_sampling.F90 +++ b/physics/rrtmgp_gfdlmp_sw_cloud_sampling.F90 @@ -3,7 +3,8 @@ module rrtmgp_gfdlmp_sw_cloud_sampling use mo_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp use physparam, only: isubcsw, iovrsw use mo_optical_props, only: ty_optical_props_2str - use mo_cloud_sampling, only: sampled_mask_max_ran, sampled_mask_exp_dcorr, sampled_mask_exp_ran, draw_samples + use mo_cloud_sampling, only: sampled_mask_max_ran, sampled_mask_exp_dcorr, & + sampled_mask_exp_ran, draw_samples use mersenne_twister, only: random_setseed, random_number, random_stat use rrtmgp_aux, only: check_error_msg use netcdf @@ -99,7 +100,7 @@ subroutine rrtmgp_gfdlmp_sw_cloud_sampling_run(doSWrad, nCol, nDay, nLev, ipsdsw errflg = 0 ! Only works w/ SDFs v15p2 and v16beta - if (iovrsw .ne. 1 .and. iovrsw .ne. 3 .and. iovrsw .ne. 4 .an. iovrsw .ne. 5) then + if (iovrsw .ne. 1 .and. iovrsw .ne. 3 .and. iovrsw .ne. 4 .and. iovrsw .ne. 5) then errmsg = 'Cloud overlap assumption not supported by GFDL microphysics suite.' errflg = 1 call check_error_msg('rrtmgp_gfdlmp_sw_cloud_sampling',errmsg) @@ -108,9 +109,10 @@ subroutine rrtmgp_gfdlmp_sw_cloud_sampling_run(doSWrad, nCol, nDay, nLev, ipsdsw 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_gfdlmp_sw_cloud_sampling_run', & sw_optical_props_clouds%alloc_2str(nday, nLev, sw_gas_props)) @@ -126,7 +128,6 @@ subroutine rrtmgp_gfdlmp_sw_cloud_sampling_run(doSWrad, nCol, nDay, nLev, ipsdsw enddo endif - ! Call McICA to generate subcolumns. ! 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 @@ -135,49 +136,64 @@ subroutine rrtmgp_gfdlmp_sw_cloud_sampling_run(doSWrad, nCol, nDay, nLev, ipsdsw rng3D(:,:,iday) = reshape(source = rng1D,shape=[sw_gas_props%get_ngpt(),nLev]) enddo - ! Call McICA + ! Cloud overlap. select case ( iovrsw ) case(1) ! Maximum-random overlap - call check_error_msg('rrtmgp_gfdlmp_sw_cloud_sampling_run', & - sampled_mask_max_ran(rng3D,cld_frac(idxday(1:nDay),:),cldfracMCICA)) + call check_error_msg('rrtmgp_gfdlmp_sw_cloud_sampling_run', & + sampled_mask_max_ran(rng3D, & + cld_frac(idxday(1:nDay),:), & + cldfracMCICA)) case(3) ! Decorrelation-length overlap do iday=1,nday call random_setseed(ipseed_sw(iday),rng_stat) call random_number(rng1D,rng_stat) rng3D2(:,:,iday) = reshape(source = rng1D,shape=[sw_gas_props%get_ngpt(),nLev]) enddo - call check_error_msg('rrtmgp_gfdlmp_sw_cloud_sampling_run', & - sampled_mask_exp_dcorr(rng3D, rng3D2, cld_frac(idxday(1:nDay),:), & + call check_error_msg('rrtmgp_gfdlmp_sw_cloud_sampling_run', & + sampled_mask_exp_dcorr(rng3D, & + rng3D2, & + cld_frac(idxday(1:nDay),:), & cloud_overlap_param(idxday(1:nDay),1:nLev-1), & cldfracMCICA)) + case(4) ! Exponential overlap + call check_error_msg('rrtmgp_gfdlmp_sw_cloud_sampling_run', & + sampled_mask_exp_ran(rng3D, & + cld_frac(idxday(1:nDay),:), & + cloud_overlap_param(idxday(1:nDay),1:nLev-1), & + cldfracMCICA)) case(5) ! Exponential-random overlap - call check_error_msg('rrtmgp_gfdlmp_sw_cloud_sampling_run', & - sampled_mask_exp_ran(rng3D,cld_frac(idxday(1:nDay),:),cldfracMCICA)) + call check_error_msg('rrtmgp_gfdlmp_sw_cloud_sampling_run', & + sampled_mask_exp_ran(rng3D, & + cld_frac(idxday(1:nDay),:), & + cloud_overlap_param(idxday(1:nDay),1:nLev-1), & + cldfracMCICA)) end select - ! Map band optical depth to each g-point using McICA + ! Sampling. Map band optical depth to each g-point using McICA call check_error_msg('rrtmgp_gfdlmp_sw_cloud_sampling_run', & - draw_samples(cldfracMCICA, sw_optical_props_cloudsByBand, sw_optical_props_clouds)) + draw_samples(cldfracMCICA, & + sw_optical_props_cloudsByBand, & + sw_optical_props_clouds)) - ! + ! ################################################################################# ! Next sample precipitation (same as clouds for now) - ! + ! ################################################################################# + ! Allocate space RRTMGP DDTs [nday,nLev,nGpt] - call check_error_msg('rrtmgp_gfdlmp_sw_cloud_sampling_run',sw_optical_props_precip%alloc_2str( & - nday, nLev, sw_gas_props)) + call check_error_msg('rrtmgp_gfdlmp_sw_cloud_sampling_run', & + sw_optical_props_precip%alloc_2str( nday, nLev, sw_gas_props)) ! Change random number seed value for each radiation invocation (isubcsw =1 or 2). - !if(isubcsw == 1) then ! advance prescribed permutation seed - ! do iday = 1, nday - ! ipseed_sw(iday) = ipsdsw0 + iday - ! enddo - !elseif (isubcsw == 2) then ! use input array of permutaion seeds - ! do iday = 1, nday - ! ipseed_sw(iday) = icseed_sw(iday) - ! enddo - !endif + if(isubcsw == 1) then ! advance prescribed permutation seed + do iday = 1, nday + ipseed_sw(iday) = ipsdsw0 + iday + enddo + elseif (isubcsw == 2) then ! use input array of permutaion seeds + do iday = 1, nday + ipseed_sw(iday) = icseed_sw(iday) + enddo + endif - ! Call McICA to generate subcolumns. ! No need to call RNG second time for now, just use the same seeds for precip as clouds. !! Call RNG. Mersennse Twister accepts 1D array, so loop over columns and collapse along G-points !! and layers. ([nGpts,nLev,nDay]-> [nGpts*nLev]*nDay) @@ -187,11 +203,13 @@ subroutine rrtmgp_gfdlmp_sw_cloud_sampling_run(doSWrad, nCol, nDay, nLev, ipsdsw ! rng3D(:,:,iday) = reshape(source = rng1D,shape=[sw_gas_props%get_ngpt(),nLev]) !enddo - ! Call McICA + ! Precipitation overlap select case ( iovrsw ) case(1) ! Maximum-random call check_error_msg('rrtmgp_gfdlmp_sw_cloud_sampling_run', & - sampled_mask_max_ran(rng3D,precip_frac(idxday(1:nDay),:),precipfracSAMP)) + sampled_mask_max_ran(rng3D, & + precip_frac(idxday(1:nDay),:), & + precipfracSAMP)) case(3) ! Exponential-random !! Generate second RNG !do iday=1,nday @@ -199,20 +217,36 @@ subroutine rrtmgp_gfdlmp_sw_cloud_sampling_run(doSWrad, nCol, nDay, nLev, ipsdsw ! call random_number(rng1D,rng_stat) ! rng3D2(:,:,iday) = reshape(source = rng1D,shape=[sw_gas_props%get_ngpt(),nLev]) !enddo - call check_error_msg('rrtmgp_gfdlmp_sw_cloud_sampling_run', & - sampled_mask_exp_dcorr(rng3D,rng3D2,precip_frac(idxday(1:nDay),:), & + call check_error_msg('rrtmgp_gfdlmp_sw_cloud_sampling_run', & + sampled_mask_exp_dcorr(rng3D, & + rng3D2, & + precip_frac(idxday(1:nDay),:), & precip_overlap_param(idxday(1:nDay),1:nLev-1), & precipfracSAMP)) + case(4) ! Exponential overlap + call check_error_msg('rrtmgp_gfdlmp_sw_cloud_sampling_run', & + sampled_mask_exp_ran(rng3D, & + precip_frac(idxday(1:nDay),:), & + precip_overlap_param(idxday(1:nDay),1:nLev-1), & + precipfracSAMP)) + case(5) ! Exponential-random overlap + call check_error_msg('rrtmgp_gfdlmp_sw_cloud_sampling_run', & + sampled_mask_exp_ran(rng3D, & + precip_frac(idxday(1:nDay),:), & + precip_overlap_param(idxday(1:nDay),1:nLev-1), & + precipfracSAMP)) end select ! Map band optical depth to each g-point using McICA call check_error_msg('rrtmgp_gfdlmp_sw_cloud_sampling_run', & - draw_samples(precipfracSAMP, sw_optical_props_precipByBand, sw_optical_props_precip)) + draw_samples(precipfracSAMP, & + sw_optical_props_precipByBand, & + sw_optical_props_precip)) endif - ! + ! #################################################################################### ! For GFDL MP just add precipitation optics to cloud-optics - ! + ! #################################################################################### do iGpt=1,sw_gas_props%get_ngpt() do iday=1,nDay do iLay=1,nLev From 8a0f31bb21c0a64c9231bfce2949143d18563b3e Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Fri, 31 Jul 2020 13:57:36 -0600 Subject: [PATCH 44/50] Added RRTMGP interface for Zhao-Carr scheme. --- physics/GFS_rrtmgp_zhaocarr_pre.F90 | 245 ++++++++++++++++++ physics/GFS_rrtmgp_zhaocarr_pre.meta | 205 +++++++++++++++ ...pling.F90 => rrtmgp_lw_cloud_sampling.F90} | 54 ++-- ...ing.meta => rrtmgp_lw_cloud_sampling.meta} | 4 +- ...pling.F90 => rrtmgp_sw_cloud_sampling.F90} | 68 ++--- ...ing.meta => rrtmgp_sw_cloud_sampling.meta} | 4 +- 6 files changed, 515 insertions(+), 65 deletions(-) create mode 100644 physics/GFS_rrtmgp_zhaocarr_pre.F90 create mode 100644 physics/GFS_rrtmgp_zhaocarr_pre.meta rename physics/{rrtmgp_gfdlmp_lw_cloud_sampling.F90 => rrtmgp_lw_cloud_sampling.F90} (86%) rename physics/{rrtmgp_gfdlmp_lw_cloud_sampling.meta => rrtmgp_lw_cloud_sampling.meta} (97%) rename physics/{rrtmgp_gfdlmp_sw_cloud_sampling.F90 => rrtmgp_sw_cloud_sampling.F90} (85%) rename physics/{rrtmgp_gfdlmp_sw_cloud_sampling.meta => rrtmgp_sw_cloud_sampling.meta} (98%) diff --git a/physics/GFS_rrtmgp_zhaocarr_pre.F90 b/physics/GFS_rrtmgp_zhaocarr_pre.F90 new file mode 100644 index 000000000..20330f0c6 --- /dev/null +++ b/physics/GFS_rrtmgp_zhaocarr_pre.F90 @@ -0,0 +1,245 @@ +! ######################################################################################## +! This module contains the interface between the Zhao-Carr macrophysics and the RRTMGP +! radiation schemes. Only compatable with Model%imp_physics = Model%imp_physics_zhaocarr +! ######################################################################################## +module GFS_rrtmgp_zhaocarr_pre + use machine, only: kind_phys + use GFS_typedefs, only: GFS_control_type, GFS_tbd_type + use physcons, only: con_ttp, & ! Temperature at h2o 3pt (K) + con_rd, & ! Gas constant for dry air (J/KgK) + con_pi, & ! PI + con_g, & ! Gravity (m/s2) + con_rog, & + eps => con_eps, & ! Rd/Rv + epsm1 => con_epsm1 ! Rd/Rv-1 + use physparam, only: lcnorm, lcrick, idcor, iovrlw, iovrsw + use rrtmgp_aux, only: check_error_msg + use funcphys, only: fpvs + use radcons, only: qmin + ! Parameters + real(kind_phys), parameter :: & + reliq_def = 10.0 , & ! fault liq radius to 10 micron + reice_def = 50.0, & ! Default ice radius to 50 micron + rerain_def = 1000.0, & ! Default rain radius to 1000 micron + resnow_def = 250.0, & ! Default snow radius to 250 micron + epsq = 1.0e-12, & ! Tiny value + xrc3 = 100., & !??? + gfac = 1.0e5/con_g, & + gord = con_g/con_rd + public GFS_rrtmgp_zhaocarr_pre_init, GFS_rrtmgp_zhaocarr_pre_run, GFS_rrtmgp_zhaocarr_pre_finalize + +contains + ! ###################################################################################### + ! ###################################################################################### + subroutine GFS_rrtmgp_zhaocarr_pre_init() + end subroutine GFS_rrtmgp_zhaocarr_pre_init + + ! ###################################################################################### + ! ###################################################################################### +!! \section arg_table_GFS_rrtmgp_zhaocarr_pre_run +!! \htmlinclude GFS_rrtmgp_zhaocarr_pre_run.html +!! + subroutine GFS_rrtmgp_zhaocarr_pre_run(Model, Tbd, nCol, nLev, lat, lsmask, & + p_lev, p_lay, t_lay, relhum, tv_lay, tracer, cld_frac, cld_lwp, cld_reliq, cld_iwp, cld_reice, & + cld_swp, cld_resnow, cld_rwp, cld_rerain, errmsg, errflg) + implicit none + + ! Inputs + type(GFS_control_type), intent(in) :: & + Model ! DDT: FV3-GFS model control parameters + type(GFS_tbd_type), intent(in) :: & + Tbd ! DDT: FV3-GFS data not yet assigned to a defined container + integer, intent(in) :: & + nCol, & ! Number of horizontal grid-points + nLev ! Number of vertical-layers + + real(kind_phys), dimension(nCol), intent(in) :: & + lsmask, & ! Land/Sea mask + lat ! Latitude + real(kind_phys), dimension(nCol,nLev), intent(in) :: & + tv_lay, & ! Virtual temperature (K) + p_lay, & ! Pressure at model-layers (Pa) + t_lay, & ! Temperature at model-layers (K) + relhum ! Relative humidity at model-layers () + real(kind_phys), dimension(nCol,nLev+1), intent(in) :: & + p_lev ! Pressure at model-level interfaces (Pa) + real(kind_phys), dimension(nCol, nLev, Model%ntrac),intent(in) :: & + tracer ! Cloud condensate amount in layer by type () + + ! Outputs + real(kind_phys), dimension(nCol,nLev),intent(out) :: & + cld_frac, & ! Total cloud fraction + cld_lwp, & ! Cloud liquid water path + cld_reliq, & ! Cloud liquid effective radius + cld_iwp, & ! Cloud ice water path + cld_reice, & ! Cloud ice effecive 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 + + character(len=*), intent(out) :: & + errmsg ! Error message + integer, intent(out) :: & + errflg ! Error flag + + ! Local variables + real(kind_phys) :: tem1,tem2,tem3,clwt,onemrh,clwm,clwmin,es,qs,value + real(kind_phys), dimension(nCol, nLev, min(4,Model%ncnd)) :: cld_condensate + integer :: iCol,iLay,l,ncndl,iovr + real(kind_phys), dimension(nCol,nLev) :: deltaP + + if (.not. (Model%lsswr .or. Model%lslwr)) return + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + ! Test inputs + if (lcnorm) then + errmsg = 'Namelist option lcnorm is not supported.' + errflg = 1 + call check_error_msg('GFS_rrtmgp_gfdlmp_pre_run',errmsg) + return + endif + + ! Initialize outputs + cld_lwp(:,:) = 0.0 + cld_reliq(:,:) = 0.0 + cld_iwp(:,:) = 0.0 + cld_reice(:,:) = 0.0 + cld_rwp(:,:) = 0.0 + cld_rerain(:,:) = 0.0 + cld_swp(:,:) = 0.0 + cld_resnow(:,:) = 0.0 + + ! #################################################################################### + ! Pull out cloud information for Zhao-Carr MP scheme. + ! #################################################################################### + ! Condensate + cld_condensate(1:nCol,1:nLev,1) = tracer(1:nCol,1:nLev,Model%ntcw) ! Liquid water + + ! Set really tiny suspended particle amounts to clear + do iLay=1,nLev + do iCol=1,nCol + if (cld_condensate(iCol,iLay,1) < epsq) cld_condensate(iCol,iLay,1) = 0.0 + enddo + enddo + + ! Use radii provided from the macrophysics + if (Model%effr_in) then + cld_reliq(1:nCol,1:nLev) = Tbd%phy_f3d(1:nCol,1:nLev,2) + cld_reice(1:nCol,1:nLev) = Tbd%phy_f3d(1:nCol,1:nLev,3) + cld_rerain(1:nCol,1:nLev) = Tbd%phy_f3d(1:nCol,1:nLev,4) + cld_resnow(1:nCol,1:nLev) = Tbd%phy_f3d(1:nCol,1:nLev,5) + else + cld_reliq(1:nCol,1:nLev) = reliq_def + cld_reice(1:nCol,1:nLev) = reice_def + cld_rerain(1:nCol,1:nLev) = rerain_def + cld_resnow(1:nCol,1:nLev) = resnow_def + endif + + ! Use cloud-fraction from SHOC? + if (Model%uni_cld) then + cld_frac(1:nCol,1:nLev) = Tbd%phy_f3d(1:nCol,1:nLev,Model%indcld) + ! Compute cloud-fraction + else + clwmin = 0.0e-6 + if (.not. Model%lmfshal) then + do iLay = 1,nLev + do iCol = 1, nCol + es = min( p_lay(iCol,iLay), fpvs( t_lay(iCol,iLay) ) ) ! fpvs and prsl in pa + qs = max( QMIN, eps * es / (p_lay(iCol,iLay) + epsm1*es) ) + clwt = 1.0e-6 * (p_lay(iCol,iLay)*0.001) + if (cld_condensate(iCol,iLay,1) > clwt) then + onemrh= max( 1.e-10, 1.0-relhum(iCol,iLay) ) + clwm = clwmin / max( 0.01, p_lay(iCol,iLay)*0.001 ) + tem1 = min(max(sqrt(sqrt(onemrh*qs)),0.0001),1.0) + tem1 = 2000.0 / tem1 + value = max( min( tem1*(cld_condensate(iCol,iLay,1)-clwm), 50.0 ), 0.0 ) + tem2 = sqrt( sqrt(relhum(iCol,iLay)) ) + cld_frac(iCol,iLay) = max( tem2*(1.0-exp(-value)), 0.0 ) + endif + enddo + enddo + else + do iLay=1,nLev + do iCol = 1, nCol + es = min( p_lay(iCol,iLay), fpvs( t_lay(iCol,iLay) ) ) ! fpvs and prsl in pa + qs = max( QMIN, eps * es / (p_lay(iCol,iLay) + epsm1*es) ) + clwt = 1.0e-6 * (p_lay(iCol,iLay)*0.001) + if (cld_condensate(iCol,iLay,1) > clwt) then + onemrh= max( 1.e-10, 1.0-relhum(iCol,iLay) ) + clwm = clwmin / max( 0.01, p_lay(iCol,iLay)*0.001 ) + tem1 = min(max((onemrh*qs)**0.49,0.0001),1.0) !jhan + if (Model%lmfdeep2) then + tem1 = xrc3 / tem1 + else + tem1 = 100.0 / tem1 + endif + value = max( min( tem1*(cld_condensate(iCol,iLay,1)-clwm), 50.0 ), 0.0 ) + tem2 = sqrt( sqrt(relhum(iCol,iLay)) ) + cld_frac(iCol,iLay) = max( tem2*(1.0-exp(-value)), 0.0 ) + endif + enddo + enddo + endif + endif + + ! Add suspended convective cloud water to grid-scale cloud water only for cloud + ! fraction & radiation computation it is to enhance cloudiness due to suspended convec + ! cloud water for zhao/moorthi's (imp_phys=99) + cld_condensate(1:nCol,1:nLev,1) = cld_condensate(1:nCol,1:nLev,1) + Tbd%phy_f3d(1:nCol,1:nLev,6) + + ! Compute cloud liquid/ice condensate path. + do iLay=1,nLev + do iCol=1,nCol + tem1 = max(0.0, cld_condensate(iCol,iLay,1)) * gfac * deltaP(iCol,iLay) + cld_iwp(iCol,iLay) = tem1*(t_lay(iCol,iLay) - 273.16) + cld_lwp(iCol,iLay) = tem1 - cld_iwp(iCol,iLay) + enddo + enddo + + ! Compute effective liquid cloud droplet radius over land. + if(.not. Model%effr_in) then + do iCol = 1, nCol + if (nint(lsmask(iCol)) == 1) then + do iLay = 1, nLev + cld_reliq(iCol,iLay) = 5.0 + 5.0 * (t_lay(iCol,iLay) - 273.16) + enddo + endif + enddo + endif + + ! Compute effective ice cloud droplet radius following Heymsfield + ! and McFarquhar (1996) \cite heymsfield_and_mcfarquhar_1996. + if(.not. Model%effr_in) then + deltaP = abs(p_lev(:,2:nLev+1)-p_lev(:,1:nLev))/100. + do iLay=1,nLev + do iCol=1,nCol + tem2 = t_lay(iCol,iLay) - con_ttp + if (cld_iwp(iCol,iLay) > 0.0) then + tem3 = gord * cld_iwp(iCol,iLay) * p_lay(iCol,iLay) / (deltaP(iCol,iLay)*tv_lay(iCol,iLay)) + if (tem2 < -50.0) then + cld_reice(iCol,iLay) = (1250.0/9.917) * tem3 ** 0.109 + elseif (tem2 < -40.0) then + cld_reice(iCol,iLay) = (1250.0/9.337) * tem3 ** 0.08 + elseif (tem2 < -30.0) then + cld_reice(iCol,iLay) = (1250.0/9.208) * tem3 ** 0.055 + else + cld_reice(iCol,iLay) = (1250.0/9.387) * tem3 ** 0.031 + endif + cld_reice(iCol,iLay) = max(10.0, min(cld_reice(iCol,iLay), 150.0)) + endif + enddo + enddo + endif + + end subroutine GFS_rrtmgp_zhaocarr_pre_run + + ! ######################################################################################### + ! ######################################################################################### + subroutine GFS_rrtmgp_zhaocarr_pre_finalize() + end subroutine GFS_rrtmgp_zhaocarr_pre_finalize + +end module GFS_rrtmgp_zhaocarr_pre diff --git a/physics/GFS_rrtmgp_zhaocarr_pre.meta b/physics/GFS_rrtmgp_zhaocarr_pre.meta new file mode 100644 index 000000000..0afed8c1e --- /dev/null +++ b/physics/GFS_rrtmgp_zhaocarr_pre.meta @@ -0,0 +1,205 @@ +######################################################################## +[ccpp-arg-table] + name = GFS_rrtmgp_zhaocarr_pre_run + type = scheme +[Model] + standard_name = GFS_control_type_instance + long_name = instance of derived type GFS_control_type + units = DDT + dimensions = () + type = GFS_control_type + intent = in + optional = F +[Tbd] + standard_name = GFS_tbd_type_instance + long_name = instance of derived type GFS_tbd_type + units = DDT + dimensions = () + type = GFS_tbd_type + intent = in + optional = F +[ncol] + standard_name = horizontal_loop_extent + long_name = horizontal dimension + units = count + dimensions = () + type = integer + intent = in + optional = F +[nLev] + standard_name = vertical_dimension + long_name = number of vertical levels + units = count + dimensions = () + type = integer + intent = in + optional = F +[lat] + standard_name = latitude + long_name = latitude + units = radian + dimensions = (horizontal_dimension) + type = real + intent = in + kind = kind_phys +[p_lev] + standard_name = air_pressure_at_interface_for_RRTMGP_in_hPa + long_name = air pressure at vertical interface for radiation calculation + units = hPa + dimensions = (horizontal_dimension,vertical_dimension_plus_one) + type = real + kind = kind_phys + intent = in + optional = F +[p_lay] + standard_name = air_pressure_at_layer_for_RRTMGP_in_hPa + long_name = air pressure at vertical layer for radiation calculation + units = hPa + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[tv_lay] + standard_name = virtual_temperature + long_name = layer virtual temperature + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[relhum] + standard_name = relative_humidity + long_name = layer relative humidity + units = frac + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[t_lay] + standard_name = air_temperature_at_layer_for_RRTMGP + long_name = air temperature at vertical layer for radiation calculation + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[tracer] + standard_name = chemical_tracers + long_name = chemical tracers + units = g g-1 + dimensions = (horizontal_dimension,vertical_dimension,number_of_tracers) + type = real + kind = kind_phys + intent = in + optional = F +[lsmask] + standard_name = sea_land_ice_mask_real + long_name = landmask: sea/land/ice=0/1/2 + units = flag + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[cld_frac] + standard_name = total_cloud_fraction + long_name = layer total cloud fraction + units = frac + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[cld_lwp] + standard_name = cloud_liquid_water_path + long_name = layer cloud liquid water path + units = g m-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[cld_reliq] + standard_name = mean_effective_radius_for_liquid_cloud + long_name = mean effective radius for liquid cloud + units = micron + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[cld_iwp] + standard_name = cloud_ice_water_path + long_name = layer cloud ice water path + units = g m-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[cld_reice] + standard_name = mean_effective_radius_for_ice_cloud + long_name = mean effective radius for ice cloud + units = micron + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[cld_swp] + standard_name = cloud_snow_water_path + long_name = layer cloud snow water path + units = g m-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[cld_resnow] + standard_name = mean_effective_radius_for_snow_flake + long_name = mean effective radius for snow cloud + units = micron + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[cld_rwp] + standard_name = cloud_rain_water_path + long_name = layer cloud rain water path + units = g m-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[cld_rerain] + standard_name = mean_effective_radius_for_rain_drop + long_name = mean effective radius for rain cloud + units = micron + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F \ No newline at end of file diff --git a/physics/rrtmgp_gfdlmp_lw_cloud_sampling.F90 b/physics/rrtmgp_lw_cloud_sampling.F90 similarity index 86% rename from physics/rrtmgp_gfdlmp_lw_cloud_sampling.F90 rename to physics/rrtmgp_lw_cloud_sampling.F90 index 8b3b57208..396c98a76 100644 --- a/physics/rrtmgp_gfdlmp_lw_cloud_sampling.F90 +++ b/physics/rrtmgp_lw_cloud_sampling.F90 @@ -1,4 +1,4 @@ -module rrtmgp_gfdlmp_lw_cloud_sampling +module rrtmgp_lw_cloud_sampling use machine, only: kind_phys use mo_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp use physparam, only: isubclw, iovrlw @@ -15,10 +15,10 @@ module rrtmgp_gfdlmp_lw_cloud_sampling ! ######################################################################################### ! SUBROUTINE mcica_init ! ######################################################################################### -!! \section arg_table_rrtmgp_gfdlmp_lw_cloud_sampling_init -!! \htmlinclude rrtmgp_gfdlmp_lw_cloud_sampling_init.html +!! \section arg_table_rrtmgp_lw_cloud_sampling_init +!! \htmlinclude rrtmgp_lw_cloud_sampling_init.html !! - subroutine rrtmgp_gfdlmp_lw_cloud_sampling_init(lw_gas_props, ipsdlw0, errmsg, errflg) + subroutine rrtmgp_lw_cloud_sampling_init(lw_gas_props, ipsdlw0, errmsg, errflg) ! Inputs type(ty_gas_optics_rrtmgp),intent(in) :: & lw_gas_props ! RRTMGP DDT: K-distribution data @@ -37,15 +37,15 @@ subroutine rrtmgp_gfdlmp_lw_cloud_sampling_init(lw_gas_props, ipsdlw0, errmsg, e ! Set initial permutation seed for McICA, initially set to number of G-points ipsdlw0 = lw_gas_props%get_ngpt() - end subroutine rrtmgp_gfdlmp_lw_cloud_sampling_init + end subroutine rrtmgp_lw_cloud_sampling_init ! ######################################################################################### - ! SUBROTUINE rrtmgp_gfdlmp_lw_cloud_sampling_run() + ! SUBROTUINE rrtmgp_lw_cloud_sampling_run() ! ######################################################################################### -!! \section arg_table_rrtmgp_gfdlmp_lw_cloud_sampling_run -!! \htmlinclude rrtmgp_gfdlmp_lw_cloud_sampling_run.html +!! \section arg_table_rrtmgp_lw_cloud_sampling_run +!! \htmlinclude rrtmgp_lw_cloud_sampling_run.html !! - subroutine rrtmgp_gfdlmp_lw_cloud_sampling_run(doLWrad, nCol, nLev, ipsdlw0, icseed_lw, & + subroutine rrtmgp_lw_cloud_sampling_run(doLWrad, nCol, nLev, ipsdlw0, icseed_lw, & cld_frac, precip_frac, cloud_overlap_param, precip_overlap_param, lw_gas_props, & lw_optical_props_cloudsByBand, lw_optical_props_precipByBand, & lw_optical_props_clouds, lw_optical_props_precip, errmsg, errflg) @@ -99,7 +99,7 @@ subroutine rrtmgp_gfdlmp_lw_cloud_sampling_run(doLWrad, nCol, nLev, ipsdlw0, ics if (iovrlw .ne. 1 .and. iovrlw .ne. 3 .and. iovrlw .ne. 4 .and. iovrlw .ne. 5) then errmsg = 'Cloud overlap assumption not supported by GFDL microphysics suite.' errflg = 1 - call check_error_msg('rrtmgp_gfdlmp_lw_cloud_sampling',errmsg) + call check_error_msg('rrtmgp_lw_cloud_sampling',errmsg) return endif @@ -110,7 +110,7 @@ subroutine rrtmgp_gfdlmp_lw_cloud_sampling_run(doLWrad, nCol, nLev, ipsdlw0, ics ! #################################################################################### ! Allocate space RRTMGP DDTs [nCol,nLev,nGpt] - call check_error_msg('rrtmgp_gfdlmp_lw_cloud_sampling_run',& + call check_error_msg('rrtmgp_lw_cloud_sampling_run',& lw_optical_props_clouds%alloc_1scl(nCol, nLev, lw_gas_props)) ! Change random number seed value for each radiation invocation (isubclw =1 or 2). @@ -135,7 +135,7 @@ subroutine rrtmgp_gfdlmp_lw_cloud_sampling_run(doLWrad, nCol, nLev, ipsdlw0, ics ! Cloud-overlap. select case ( iovrlw ) case(1) ! Maximum-random overlap - call check_error_msg('rrtmgp_gfdlmp_lw_cloud_sampling_run', & + call check_error_msg('rrtmgp_lw_cloud_sampling_run', & sampled_mask_max_ran(rng3D, & cld_frac, & cldfracMCICA)) @@ -146,20 +146,20 @@ subroutine rrtmgp_gfdlmp_lw_cloud_sampling_run(doLWrad, nCol, nLev, ipsdlw0, ics call random_number(rng1D,rng_stat) rng3D2(:,:,iCol) = reshape(source = rng1D,shape=[lw_gas_props%get_ngpt(),nLev]) enddo - call check_error_msg('rrtmgp_gfdlmp_lw_cloud_sampling_run', & + call check_error_msg('rrtmgp_lw_cloud_sampling_run', & sampled_mask_exp_dcorr(rng3D, & rng3D2, & cld_frac, & cloud_overlap_param(:,1:nLev-1), & cldfracMCICA)) case(4) ! Exponential overlap - call check_error_msg('rrtmgp_gfdlmp_lw_cloud_sampling_run', & + call check_error_msg('rrtmgp_lw_cloud_sampling_run', & sampled_mask_exp_ran(rng3D, & cld_frac, & cloud_overlap_param(:,1:nLev-1), & cldfracMCICA)) case(5) ! Exponential-random overlap - call check_error_msg('rrtmgp_gfdlmp_lw_cloud_sampling_run', & + call check_error_msg('rrtmgp_lw_cloud_sampling_run', & sampled_mask_exp_ran(rng3D, & cld_frac, & cloud_overlap_param(:,1:nLev-1), & @@ -167,7 +167,7 @@ subroutine rrtmgp_gfdlmp_lw_cloud_sampling_run(doLWrad, nCol, nLev, ipsdlw0, ics end select ! Sampling. Map band optical depth to each g-point using McICA - call check_error_msg('rrtmgp_gfdlmp_lw_cloud_sampling_run', & + call check_error_msg('rrtmgp_lw_cloud_sampling_run', & draw_samples(cldfracMCICA, & lw_optical_props_cloudsByBand, & lw_optical_props_clouds)) @@ -177,7 +177,7 @@ subroutine rrtmgp_gfdlmp_lw_cloud_sampling_run(doLWrad, nCol, nLev, ipsdlw0, ics ! #################################################################################### ! Allocate space RRTMGP DDTs [nCol,nLev,nGpt] - call check_error_msg('rrtmgp_gfdlmp_lw_cloud_sampling_run',& + call check_error_msg('rrtmgp_lw_cloud_sampling_run',& lw_optical_props_precip%alloc_1scl(nCol, nLev, lw_gas_props)) ! Change random number seed value for each radiation invocation (isubclw =1 or 2). @@ -203,7 +203,7 @@ subroutine rrtmgp_gfdlmp_lw_cloud_sampling_run(doLWrad, nCol, nLev, ipsdlw0, ics ! Precipitation overlap. select case ( iovrlw ) case(1) ! Maximum-random overlap - call check_error_msg('rrtmgp_gfdlmp_lw_cloud_sampling_run', & + call check_error_msg('rrtmgp_lw_cloud_sampling_run', & sampled_mask_max_ran(rng3D, & precip_frac, & precipfracSAMP)) @@ -215,20 +215,20 @@ subroutine rrtmgp_gfdlmp_lw_cloud_sampling_run(doLWrad, nCol, nLev, ipsdlw0, ics ! call random_number(rng1D,rng_stat) ! rng3D2(:,:,iCol) = reshape(source = rng1D,shape=[lw_gas_props%get_ngpt(),nLev]) !enddo - call check_error_msg('rrtmgp_gfdlmp_lw_cloud_sampling_run', & + call check_error_msg('rrtmgp_lw_cloud_sampling_run', & sampled_mask_exp_dcorr(rng3D, & rng3D2, & precip_frac, & precip_overlap_param(:,1:nLev-1), & precipfracSAMP)) case(4) ! Exponential overlap - call check_error_msg('rrtmgp_gfdlmp_lw_cloud_sampling_run', & + call check_error_msg('rrtmgp_lw_cloud_sampling_run', & sampled_mask_exp_ran(rng3D, & precip_frac, & precip_overlap_param(:,1:nLev-1), & precipfracSAMP)) case(5) ! Exponential-random overlap - call check_error_msg('rrtmgp_gfdlmp_lw_cloud_sampling_run', & + call check_error_msg('rrtmgp_lw_cloud_sampling_run', & sampled_mask_exp_ran(rng3D, & precip_frac, & precip_overlap_param(:,1:nLev-1), & @@ -236,7 +236,7 @@ subroutine rrtmgp_gfdlmp_lw_cloud_sampling_run(doLWrad, nCol, nLev, ipsdlw0, ics end select ! Sampling. Map band optical depth to each g-point using McICA - call check_error_msg('rrtmgp_gfdlmp_lw_cloud_sampling_run', & + call check_error_msg('rrtmgp_lw_cloud_sampling_run', & draw_samples(precipfracSAMP, & lw_optical_props_precipByBand, & lw_optical_props_precip)) @@ -246,12 +246,12 @@ subroutine rrtmgp_gfdlmp_lw_cloud_sampling_run(doLWrad, nCol, nLev, ipsdlw0, ics ! #################################################################################### lw_optical_props_clouds%tau = lw_optical_props_clouds%tau + lw_optical_props_precip%tau - end subroutine rrtmgp_gfdlmp_lw_cloud_sampling_run + end subroutine rrtmgp_lw_cloud_sampling_run ! ######################################################################################### - ! SUBROTUINE rrtmgp_gfdlmp_lw_cloud_sampling_finalize() + ! SUBROTUINE rrtmgp_lw_cloud_sampling_finalize() ! ######################################################################################### - subroutine rrtmgp_gfdlmp_lw_cloud_sampling_finalize() - end subroutine rrtmgp_gfdlmp_lw_cloud_sampling_finalize + subroutine rrtmgp_lw_cloud_sampling_finalize() + end subroutine rrtmgp_lw_cloud_sampling_finalize -end module rrtmgp_gfdlmp_lw_cloud_sampling +end module rrtmgp_lw_cloud_sampling diff --git a/physics/rrtmgp_gfdlmp_lw_cloud_sampling.meta b/physics/rrtmgp_lw_cloud_sampling.meta similarity index 97% rename from physics/rrtmgp_gfdlmp_lw_cloud_sampling.meta rename to physics/rrtmgp_lw_cloud_sampling.meta index 0eb0835ea..251e1e880 100644 --- a/physics/rrtmgp_gfdlmp_lw_cloud_sampling.meta +++ b/physics/rrtmgp_lw_cloud_sampling.meta @@ -1,5 +1,5 @@ [ccpp-arg-table] - name = rrtmgp_gfdlmp_lw_cloud_sampling_init + name = rrtmgp_lw_cloud_sampling_init type = scheme [lw_gas_props] standard_name = coefficients_for_lw_gas_optics @@ -37,7 +37,7 @@ ###################################################### [ccpp-arg-table] - name = rrtmgp_gfdlmp_lw_cloud_sampling_run + name = rrtmgp_lw_cloud_sampling_run type = scheme [doLWrad] standard_name = flag_to_calc_lw diff --git a/physics/rrtmgp_gfdlmp_sw_cloud_sampling.F90 b/physics/rrtmgp_sw_cloud_sampling.F90 similarity index 85% rename from physics/rrtmgp_gfdlmp_sw_cloud_sampling.F90 rename to physics/rrtmgp_sw_cloud_sampling.F90 index 4986e3d61..3be4b023e 100644 --- a/physics/rrtmgp_gfdlmp_sw_cloud_sampling.F90 +++ b/physics/rrtmgp_sw_cloud_sampling.F90 @@ -1,4 +1,4 @@ -module rrtmgp_gfdlmp_sw_cloud_sampling +module rrtmgp_sw_cloud_sampling use machine, only: kind_phys use mo_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp use physparam, only: isubcsw, iovrsw @@ -13,12 +13,12 @@ module rrtmgp_gfdlmp_sw_cloud_sampling contains ! ######################################################################################### - ! SUBROUTINE rrtmgp_gfdlmp_sw_cloud_sampling_init() + ! SUBROUTINE rrtmgp_sw_cloud_sampling_init() ! ######################################################################################### -!! \section arg_table_rrtmgp_gfdlmp_sw_cloud_sampling_init -!! \htmlinclude rrtmgp_gfdlmp_sw_cloud_sampling.html +!! \section arg_table_rrtmgp_sw_cloud_sampling_init +!! \htmlinclude rrtmgp_sw_cloud_sampling.html !! - subroutine rrtmgp_gfdlmp_sw_cloud_sampling_init(sw_gas_props, ipsdsw0, errmsg, errflg) + subroutine rrtmgp_sw_cloud_sampling_init(sw_gas_props, ipsdsw0, errmsg, errflg) ! Inputs type(ty_gas_optics_rrtmgp),intent(in) :: & sw_gas_props ! RRTMGP DDT: K-distribution data @@ -37,15 +37,15 @@ subroutine rrtmgp_gfdlmp_sw_cloud_sampling_init(sw_gas_props, ipsdsw0, errmsg, e ! Set initial permutation seed for McICA, initially set to number of G-points ipsdsw0 = sw_gas_props%get_ngpt() - end subroutine rrtmgp_gfdlmp_sw_cloud_sampling_init + end subroutine rrtmgp_sw_cloud_sampling_init ! ######################################################################################### - ! SUBROTUINE rrtmgp_gfdlmp_sw_cloud_sampling_run() + ! SUBROTUINE rrtmgp_sw_cloud_sampling_run() ! ######################################################################################### -!! \section arg_table_rrtmgp_gfdlmp_sw_cloud_sampling_run -!! \htmlinclude rrtmgp_gfdlmp_sw_cloud_sampling.html +!! \section arg_table_rrtmgp_sw_cloud_sampling_run +!! \htmlinclude rrtmgp_sw_cloud_sampling.html !! - subroutine rrtmgp_gfdlmp_sw_cloud_sampling_run(doSWrad, nCol, nDay, nLev, ipsdsw0, idxday, & + subroutine rrtmgp_sw_cloud_sampling_run(doSWrad, nCol, nDay, nLev, ipsdsw0, idxday, & icseed_sw, cld_frac, precip_frac, cloud_overlap_param, precip_overlap_param, & sw_gas_props, sw_optical_props_cloudsByBand, sw_optical_props_precipByBand, & sw_optical_props_clouds, sw_optical_props_precip, errmsg, errflg) @@ -103,7 +103,7 @@ subroutine rrtmgp_gfdlmp_sw_cloud_sampling_run(doSWrad, nCol, nDay, nLev, ipsdsw if (iovrsw .ne. 1 .and. iovrsw .ne. 3 .and. iovrsw .ne. 4 .and. iovrsw .ne. 5) then errmsg = 'Cloud overlap assumption not supported by GFDL microphysics suite.' errflg = 1 - call check_error_msg('rrtmgp_gfdlmp_sw_cloud_sampling',errmsg) + call check_error_msg('rrtmgp_sw_cloud_sampling',errmsg) return endif @@ -114,7 +114,7 @@ subroutine rrtmgp_gfdlmp_sw_cloud_sampling_run(doSWrad, nCol, nDay, nLev, ipsdsw ! ################################################################################# ! Allocate space RRTMGP DDTs [nday,nLev,nGpt] - call check_error_msg('rrtmgp_gfdlmp_sw_cloud_sampling_run', & + 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 (isubcsw =1 or 2). @@ -139,7 +139,7 @@ subroutine rrtmgp_gfdlmp_sw_cloud_sampling_run(doSWrad, nCol, nDay, nLev, ipsdsw ! Cloud overlap. select case ( iovrsw ) case(1) ! Maximum-random overlap - call check_error_msg('rrtmgp_gfdlmp_sw_cloud_sampling_run', & + call check_error_msg('rrtmgp_sw_cloud_sampling_run', & sampled_mask_max_ran(rng3D, & cld_frac(idxday(1:nDay),:), & cldfracMCICA)) @@ -149,20 +149,20 @@ subroutine rrtmgp_gfdlmp_sw_cloud_sampling_run(doSWrad, nCol, nDay, nLev, ipsdsw call random_number(rng1D,rng_stat) rng3D2(:,:,iday) = reshape(source = rng1D,shape=[sw_gas_props%get_ngpt(),nLev]) enddo - call check_error_msg('rrtmgp_gfdlmp_sw_cloud_sampling_run', & + call check_error_msg('rrtmgp_sw_cloud_sampling_run', & sampled_mask_exp_dcorr(rng3D, & rng3D2, & cld_frac(idxday(1:nDay),:), & cloud_overlap_param(idxday(1:nDay),1:nLev-1), & cldfracMCICA)) case(4) ! Exponential overlap - call check_error_msg('rrtmgp_gfdlmp_sw_cloud_sampling_run', & + call check_error_msg('rrtmgp_sw_cloud_sampling_run', & sampled_mask_exp_ran(rng3D, & cld_frac(idxday(1:nDay),:), & cloud_overlap_param(idxday(1:nDay),1:nLev-1), & cldfracMCICA)) case(5) ! Exponential-random overlap - call check_error_msg('rrtmgp_gfdlmp_sw_cloud_sampling_run', & + call check_error_msg('rrtmgp_sw_cloud_sampling_run', & sampled_mask_exp_ran(rng3D, & cld_frac(idxday(1:nDay),:), & cloud_overlap_param(idxday(1:nDay),1:nLev-1), & @@ -170,9 +170,9 @@ subroutine rrtmgp_gfdlmp_sw_cloud_sampling_run(doSWrad, nCol, nDay, nLev, ipsdsw end select ! Sampling. Map band optical depth to each g-point using McICA - call check_error_msg('rrtmgp_gfdlmp_sw_cloud_sampling_run', & - draw_samples(cldfracMCICA, & - sw_optical_props_cloudsByBand, & + call check_error_msg('rrtmgp_sw_cloud_sampling_run', & + draw_samples(cldfracMCICA, & + sw_optical_props_cloudsByBand, & sw_optical_props_clouds)) ! ################################################################################# @@ -180,7 +180,7 @@ subroutine rrtmgp_gfdlmp_sw_cloud_sampling_run(doSWrad, nCol, nDay, nLev, ipsdsw ! ################################################################################# ! Allocate space RRTMGP DDTs [nday,nLev,nGpt] - call check_error_msg('rrtmgp_gfdlmp_sw_cloud_sampling_run', & + call check_error_msg('rrtmgp_sw_cloud_sampling_run', & sw_optical_props_precip%alloc_2str( nday, nLev, sw_gas_props)) ! Change random number seed value for each radiation invocation (isubcsw =1 or 2). @@ -206,9 +206,9 @@ subroutine rrtmgp_gfdlmp_sw_cloud_sampling_run(doSWrad, nCol, nDay, nLev, ipsdsw ! Precipitation overlap select case ( iovrsw ) case(1) ! Maximum-random - call check_error_msg('rrtmgp_gfdlmp_sw_cloud_sampling_run', & - sampled_mask_max_ran(rng3D, & - precip_frac(idxday(1:nDay),:), & + call check_error_msg('rrtmgp_sw_cloud_sampling_run', & + sampled_mask_max_ran(rng3D, & + precip_frac(idxday(1:nDay),:), & precipfracSAMP)) case(3) ! Exponential-random !! Generate second RNG @@ -217,20 +217,20 @@ subroutine rrtmgp_gfdlmp_sw_cloud_sampling_run(doSWrad, nCol, nDay, nLev, ipsdsw ! call random_number(rng1D,rng_stat) ! rng3D2(:,:,iday) = reshape(source = rng1D,shape=[sw_gas_props%get_ngpt(),nLev]) !enddo - call check_error_msg('rrtmgp_gfdlmp_sw_cloud_sampling_run', & + call check_error_msg('rrtmgp_sw_cloud_sampling_run', & sampled_mask_exp_dcorr(rng3D, & rng3D2, & precip_frac(idxday(1:nDay),:), & precip_overlap_param(idxday(1:nDay),1:nLev-1), & precipfracSAMP)) case(4) ! Exponential overlap - call check_error_msg('rrtmgp_gfdlmp_sw_cloud_sampling_run', & + call check_error_msg('rrtmgp_sw_cloud_sampling_run', & sampled_mask_exp_ran(rng3D, & precip_frac(idxday(1:nDay),:), & precip_overlap_param(idxday(1:nDay),1:nLev-1), & precipfracSAMP)) case(5) ! Exponential-random overlap - call check_error_msg('rrtmgp_gfdlmp_sw_cloud_sampling_run', & + call check_error_msg('rrtmgp_sw_cloud_sampling_run', & sampled_mask_exp_ran(rng3D, & precip_frac(idxday(1:nDay),:), & precip_overlap_param(idxday(1:nDay),1:nLev-1), & @@ -238,9 +238,9 @@ subroutine rrtmgp_gfdlmp_sw_cloud_sampling_run(doSWrad, nCol, nDay, nLev, ipsdsw end select ! Map band optical depth to each g-point using McICA - call check_error_msg('rrtmgp_gfdlmp_sw_cloud_sampling_run', & - draw_samples(precipfracSAMP, & - sw_optical_props_precipByBand, & + call check_error_msg('rrtmgp_sw_cloud_sampling_run', & + draw_samples(precipfracSAMP, & + sw_optical_props_precipByBand, & sw_optical_props_precip)) endif @@ -278,12 +278,12 @@ subroutine rrtmgp_gfdlmp_sw_cloud_sampling_run(doSWrad, nCol, nDay, nLev, ipsdsw enddo enddo enddo - end subroutine rrtmgp_gfdlmp_sw_cloud_sampling_run + end subroutine rrtmgp_sw_cloud_sampling_run ! ######################################################################################### - ! SUBROTUINE rrtmgp_gfdlmp_sw_cloud_sampling_finalize() + ! SUBROTUINE rrtmgp_sw_cloud_sampling_finalize() ! ######################################################################################### - subroutine rrtmgp_gfdlmp_sw_cloud_sampling_finalize() - end subroutine rrtmgp_gfdlmp_sw_cloud_sampling_finalize + subroutine rrtmgp_sw_cloud_sampling_finalize() + end subroutine rrtmgp_sw_cloud_sampling_finalize -end module rrtmgp_gfdlmp_sw_cloud_sampling +end module rrtmgp_sw_cloud_sampling diff --git a/physics/rrtmgp_gfdlmp_sw_cloud_sampling.meta b/physics/rrtmgp_sw_cloud_sampling.meta similarity index 98% rename from physics/rrtmgp_gfdlmp_sw_cloud_sampling.meta rename to physics/rrtmgp_sw_cloud_sampling.meta index 42aa3c2de..7ce6a708d 100644 --- a/physics/rrtmgp_gfdlmp_sw_cloud_sampling.meta +++ b/physics/rrtmgp_sw_cloud_sampling.meta @@ -1,5 +1,5 @@ [ccpp-arg-table] - name = rrtmgp_gfdlmp_sw_cloud_sampling_init + name = rrtmgp_sw_cloud_sampling_init type = scheme [sw_gas_props] standard_name = coefficients_for_sw_gas_optics @@ -37,7 +37,7 @@ ###################################################### [ccpp-arg-table] - name = rrtmgp_gfdlmp_sw_cloud_sampling_run + name = rrtmgp_sw_cloud_sampling_run type = scheme [doSWrad] standard_name = flag_to_calc_sw From 7fcec1f48fdea6686083a03b7151ea0829746887 Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Fri, 31 Jul 2020 17:40:21 -0600 Subject: [PATCH 45/50] Cleanup from Doms comments in PR 446 --- physics/GFS_cloud_diagnostics.F90 | 12 +++++++++--- physics/GFS_cloud_diagnostics.meta | 1 + physics/GFS_rrtmgp_setup.F90 | 12 ++++++++---- 3 files changed, 18 insertions(+), 7 deletions(-) diff --git a/physics/GFS_cloud_diagnostics.F90 b/physics/GFS_cloud_diagnostics.F90 index 9055cd578..8ee548aea 100644 --- a/physics/GFS_cloud_diagnostics.F90 +++ b/physics/GFS_cloud_diagnostics.F90 @@ -119,7 +119,7 @@ end subroutine GFS_cloud_diagnostics_finalize ! ###################################################################################### ! Initialization routine for High/Mid/Low cloud diagnostics. ! ###################################################################################### - subroutine hml_cloud_diagnostics_initialize(Model, nLev, mpi_rank, sigmainit) + subroutine hml_cloud_diagnostics_initialize(Model, nLev, mpi_rank, sigmainit, errflg) implicit none ! Inputs type(GFS_control_type), intent(in) :: & @@ -129,9 +129,15 @@ subroutine hml_cloud_diagnostics_initialize(Model, nLev, mpi_rank, sigmainit) mpi_rank real(kind_phys), dimension(nLev+1), intent(in) :: & sigmainit + ! Outputs + integer, intent(out) :: & + errflg ! Local variables integer :: iLay, kl + + ! Initialize error flag + errflg = 0 ! Cloud overlap used for diagnostic HML cloud outputs iovr = max(iovrsw,iovrlw) @@ -140,7 +146,7 @@ subroutine hml_cloud_diagnostics_initialize(Model, nLev, mpi_rank, sigmainit) if ( icldflg == 0 ) then print *,' - Diagnostic Cloud Method has been discontinued' - stop ! NoNo + errflg = 1 else if (mpi_rank == 0) then print *,' - Using Prognostic Cloud Method' @@ -161,7 +167,7 @@ subroutine hml_cloud_diagnostics_initialize(Model, nLev, mpi_rank, sigmainit) else print *,' !!! ERROR in cloud microphysc specification!!!', & ' imp_physics (NP3D) =',Model%imp_physics - stop + errflg = 1 endif endif endif diff --git a/physics/GFS_cloud_diagnostics.meta b/physics/GFS_cloud_diagnostics.meta index babc2cb28..b3cb423c5 100644 --- a/physics/GFS_cloud_diagnostics.meta +++ b/physics/GFS_cloud_diagnostics.meta @@ -34,6 +34,7 @@ type = real intent = in kind = kind_phys + optional = F [p_lay] standard_name = air_pressure_at_layer_for_RRTMGP_in_hPa long_name = air pressure at vertical layer for radiation calculation diff --git a/physics/GFS_rrtmgp_setup.F90 b/physics/GFS_rrtmgp_setup.F90 index 894450773..f890b30ee 100644 --- a/physics/GFS_rrtmgp_setup.F90 +++ b/physics/GFS_rrtmgp_setup.F90 @@ -121,7 +121,7 @@ subroutine GFS_rrtmgp_setup_init (Model, si, levr, ictm, isol, ico2, & endif - call radinit( Model, si, levr, imp_physics, me ) + call radinit( Model, si, levr, imp_physics, me, errflg ) if ( me == 0 ) then print *,' Radiation sub-cloud initial seed =',ipsd0, & @@ -197,13 +197,13 @@ end subroutine GFS_rrtmgp_setup_finalize ! Private functions - subroutine radinit( Model, si, NLAY, imp_physics, me ) + subroutine radinit( Model, si, NLAY, imp_physics, me, errflg ) !................................... ! --- inputs: ! & ( si, NLAY, imp_physics, me ) ! --- outputs: -! ( none ) +! ( errflg ) ! ================= subprogram documentation block ================ ! ! ! @@ -325,9 +325,13 @@ subroutine radinit( Model, si, NLAY, imp_physics, me ) real (kind=kind_phys), intent(in) :: si(:) ! --- outputs: (none, to module variables) + integer, intent(out) :: & + errflg ! --- locals: + ! Initialize + errflg = 0 ! !===> ... begin here ! @@ -408,7 +412,7 @@ subroutine radinit( Model, si, NLAY, imp_physics, me ) call aer_init ( NLAY, me ) ! --- ... aerosols initialization routine call gas_init ( me ) ! --- ... co2 and other gases initialization routine call sfc_init ( me ) ! --- ... surface initialization routine - call hml_cloud_diagnostics_initialize( Model, NLAY, me, si) + call hml_cloud_diagnostics_initialize( Model, NLAY, me, si, errflg) return !................................... From b7c2a5ed7e2340a1397ea373ec0e6e68207759c3 Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Fri, 31 Jul 2020 17:41:03 -0600 Subject: [PATCH 46/50] Add optional to field in meta file --- physics/GFS_rrtmgp_gfdlmp_pre.meta | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/physics/GFS_rrtmgp_gfdlmp_pre.meta b/physics/GFS_rrtmgp_gfdlmp_pre.meta index 586587510..5a20836b8 100644 --- a/physics/GFS_rrtmgp_gfdlmp_pre.meta +++ b/physics/GFS_rrtmgp_gfdlmp_pre.meta @@ -58,7 +58,8 @@ dimensions = (horizontal_dimension) type = real intent = in - kind = kind_phys + kind = kind_phys + optional = F [p_lev] standard_name = air_pressure_at_interface_for_RRTMGP_in_hPa long_name = air pressure at vertical interface for radiation calculation From 0d72c531630a7c5560fb86ce59a8f2fd91419ca6 Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Fri, 31 Jul 2020 17:42:29 -0600 Subject: [PATCH 47/50] Remove DDTs from argument list in GFS_rrtmgp_pre. Also removed use statements and added physical/algorithmic constants to the Interstitial type. --- physics/GFS_rrtmgp_pre.F90 | 182 +++++++++++++---------------- physics/GFS_rrtmgp_pre.meta | 226 +++++++++++++++++++++++++++++------- 2 files changed, 264 insertions(+), 144 deletions(-) diff --git a/physics/GFS_rrtmgp_pre.F90 b/physics/GFS_rrtmgp_pre.F90 index 7c3609af4..e4110c950 100644 --- a/physics/GFS_rrtmgp_pre.F90 +++ b/physics/GFS_rrtmgp_pre.F90 @@ -1,54 +1,16 @@ module GFS_rrtmgp_pre - use physparam use machine, only: & kind_phys ! Working type - use GFS_typedefs, only: & - GFS_statein_type, & ! Prognostic state data in from dycore - GFS_stateout_type, & ! Prognostic state or tendencies return to dycore - GFS_sfcprop_type, & ! Surface fields - GFS_control_type, & ! Model control parameters - GFS_grid_type, & ! Grid and interpolation related data - GFS_tbd_type, & ! To-Be-Determined data that doesn't fit in any one container - GFS_diag_type ! Fields targetted for diagnostic output - use physcons, only: & - eps => con_eps, & ! Rd/Rv - epsm1 => con_epsm1, & ! Rd/Rv-1 - fvirt => con_fvirt, & ! Rv/Rd-1 - rog => con_rog ! Rd/g - use radcons, only: & - qmin, epsq ! Minimum vlaues for varius calculations use funcphys, only: & fpvs ! Function ot compute sat. vapor pressure over liq. - use module_radiation_astronomy,only: & - coszmn ! Function to compute cos(SZA) use module_radiation_gases, only: & NF_VGAS, & ! Number of active gas species getgases, & ! Routine to setup trace gases getozn ! Routine to setup ozone - 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_clouds, only: & - NF_CLDS, & ! Number of fields in "clouds" array (e.g. (cloud(1)=lwp,clouds(2)=ReffLiq,...) - progcld1, & ! Zhao/Moorthi's prognostic cloud scheme - progcld3, & ! Zhao/Moorthi's prognostic cloud+pdfcld - progcld4, & ! GFDL cloud scheme - progcld5, & ! Thompson / WSM6 cloud micrphysics scheme - progclduni ! Unified cloud-scheme - use surface_perturbation, only: & - cdfnor ! Routine to compute CDF (used to compute percentiles) - use module_radiation_surface, only: & - setemis, & ! Routine to compute surface-emissivity - NF_ALBD, & ! Number of surface albedo categories (4; nir-direct, nir-diffuse, uvvis-direct, uvvis-diffuse) - setalb ! Routine to compute surface albedo ! RRTMGP types use mo_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp use mo_gas_concentrations, only: ty_gas_concs - use rrtmgp_aux, only: check_error_msg!, rrtmgp_minP, rrtmgp_minT - use mo_rrtmgp_constants, only: grav, avogad - use mo_rrtmg_lw_cloud_optics + use rrtmgp_aux, only: check_error_msg real(kind_phys), parameter :: & amd = 28.9644_kind_phys, & ! Molecular weight of dry-air (g/mol) @@ -83,13 +45,14 @@ module GFS_rrtmgp_pre !! \section arg_table_GFS_rrtmgp_pre_init !! \htmlinclude GFS_rrtmgp_pre_init.html !! - subroutine GFS_rrtmgp_pre_init(Model, active_gases_array, errmsg, errflg) + subroutine GFS_rrtmgp_pre_init(nGases, active_gases, active_gases_array, errmsg, errflg) ! Inputs - type(GFS_control_type), intent(inout) :: & - Model ! DDT: FV3-GFS model control parameters - + integer, intent(in) :: & + nGases ! Number of active gases in RRTMGP + character(len=*), intent(in) :: & + active_gases ! List of active gases from namelist. ! Outputs - character(len=*),dimension(Model%ngases), intent(out) :: & + character(len=*),dimension(nGases), intent(out) :: & active_gases_array ! Character array containing trace gases to include in RRTMGP character(len=*), intent(out) :: & errmsg ! Error message @@ -99,13 +62,13 @@ subroutine GFS_rrtmgp_pre_init(Model, active_gases_array, errmsg, errflg) ! Local variables character(len=1) :: tempstr integer :: ij, count - integer,dimension(Model%ngases,2) :: gasIndices + integer,dimension(nGases,2) :: gasIndices ! Initialize errmsg = '' errflg = 0 - if (len(Model%active_gases) .eq. 0) return + if (len(active_gases) .eq. 0) return ! Which gases are active? Provided via physics namelist. @@ -113,23 +76,23 @@ subroutine GFS_rrtmgp_pre_init(Model, active_gases_array, errmsg, errflg) ! First grab indices in character array corresponding to start:end of gas name. gasIndices(1,1)=1 count=1 - do ij=1,len(Model%active_gases) - tempstr=trim(Model%active_gases(ij:ij)) + do ij=1,len(active_gases) + tempstr=trim(active_gases(ij:ij)) if (tempstr .eq. '_') then gasIndices(count,2)=ij-1 gasIndices(count+1,1)=ij+1 count=count+1 endif enddo - gasIndices(Model%ngases,2)=len(trim(Model%active_gases)) + gasIndices(nGases,2)=len(trim(active_gases)) ! Now extract the gas names - do ij=1,Model%ngases - active_gases_array(ij) = Model%active_gases(gasIndices(ij,1):gasIndices(ij,2)) + do ij=1,nGases + active_gases_array(ij) = active_gases(gasIndices(ij,1):gasIndices(ij,2)) enddo ! Which gases are active? (This is purely for flexibility) - do ij=1,Model%ngases + do ij=1,nGases if(trim(active_gases_array(ij)) .eq. 'h2o') then isActive_h2o = .true. istr_h2o = ij @@ -180,25 +143,45 @@ end subroutine GFS_rrtmgp_pre_init !> \section arg_table_GFS_rrtmgp_pre_run !! \htmlinclude GFS_rrtmgp_pre_run.html !! - subroutine GFS_rrtmgp_pre_run(Model, Grid, Statein, Sfcprop, Tbd, ncol, active_gases_array, & - raddt, p_lay, t_lay, p_lev, t_lev, tsfg, tsfa, tv_lay, relhum, tracer, & + subroutine GFS_rrtmgp_pre_run(nCol, nLev, nGases, nTracers, i_o3, lsswr, lslwr, fhswr, & + fhlwr, xlat, xlon, prsl, tgrs, prslk, prsi, qgrs, tsfc, active_gases_array, & + pcon_eps, pcon_epsm1, pcon_fvirt, acon_qMin, & + raddt, p_lay, t_lay, p_lev, t_lev, tsfg, tsfa, tv_lay, relhum, tracer, & gas_concentrations, errmsg, errflg) - ! Inputs - type(GFS_control_type), intent(in) :: & - Model ! DDT: FV3-GFS model control parameters - type(GFS_grid_type), intent(in) :: & - Grid ! DDT: FV3-GFS grid and interpolation related data - type(GFS_statein_type), intent(in) :: & - Statein ! DDT: FV3-GFS prognostic state data in from dycore - type(GFS_sfcprop_type), intent(in) :: & - Sfcprop ! DDT: FV3-GFS surface fields - type(GFS_tbd_type), intent(in) :: & - Tbd ! DDT: FV3-GFS data not yet assigned to a defined container + ! Inputs integer, intent(in) :: & - ncol ! Number of horizontal grid points - character(len=*),dimension(Model%ngases), intent(in) :: & + nCol, & ! Number of horizontal grid points + nLev, & ! Number of vertical layers + nGases, & ! Number of active gases in RRTMGP. + 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 + character(len=*),dimension(nGases), intent(in) :: & active_gases_array ! Character array containing trace gases to include in RRTMGP + real(kind_phys), intent(in) :: & + fhswr, & ! Frequency of SW radiation call. + fhlwr ! Frequency of LW radiation call. + real(kind_phys), intent(in) :: & + pcon_eps, & ! Physical constant: Epsilon (Rd/Rv) + pcon_epsm1, & ! Physical constant: Epsilon (Rd/Rv) minus one + pcon_fvirt, & ! Physical constant: Inverse of epsilon minus one + acon_qMin ! Algorithmic constant: Lower limit for saturation vapor pressure + + real(kind_phys), dimension(nCol), intent(in) :: & + xlon, & ! Longitude + xlat, & ! Latitude + tsfc ! Surface skin temperature (K) + real(kind_phys), dimension(nCol,nLev), intent(in) :: & + prsl, & ! Pressure at model-layer centers (Pa) + tgrs, & ! Temperature at model-layer centers (K) + prslk ! Exner function at model layer centers (1) + real(kind_phys), dimension(nCol,nLev+1) :: & + prsi ! Pressure at model-interfaces (Pa) + real(kind_phys), dimension(nCol,nLev,nTracers) :: & + qgrs ! Tracer concentrations (kg/kg) ! Outputs character(len=*), intent(out) :: & @@ -210,15 +193,15 @@ subroutine GFS_rrtmgp_pre_run(Model, Grid, Statein, Sfcprop, Tbd, ncol, active_g real(kind_phys), dimension(ncol), intent(out) :: & tsfg, & ! Ground temperature tsfa ! Skin temperature - real(kind_phys), dimension(ncol,Model%levs), intent(out) :: & + real(kind_phys), dimension(nCol,nLev), intent(out) :: & p_lay, & ! Pressure at model-layer t_lay, & ! Temperature at model layer tv_lay, & ! Virtual temperature at model-layers relhum ! Relative-humidity at model-layers - real(kind_phys), dimension(ncol,Model%levs+1), intent(out) :: & + real(kind_phys), dimension(nCol,nLev+1), intent(out) :: & p_lev, & ! Pressure at model-interface t_lev ! Temperature at model-interface - real(kind_phys), dimension(ncol, Model%levs, Model%ntrac),intent(out) :: & + real(kind_phys), dimension(nCol, nLev, nTracers),intent(out) :: & tracer ! Array containing trace gases type(ty_gas_concs),intent(out) :: & gas_concentrations ! RRTMGP DDT: gas volumne mixing ratios @@ -226,28 +209,27 @@ subroutine GFS_rrtmgp_pre_run(Model, Grid, Statein, Sfcprop, Tbd, ncol, active_g ! Local variables integer :: i, j, iCol, iBand, iSFC, iTOA, iLay logical :: top_at_1 - real(kind_phys),dimension(NCOL,Model%levs) :: vmr_o3, vmr_h2o + real(kind_phys),dimension(nCol,nLev) :: vmr_o3, vmr_h2o real(kind_phys) :: es, qs, tem1, tem2 - real(kind_phys), dimension(ncol, NF_ALBD) :: sfcalb - real(kind_phys), dimension(ncol, Model%levs) :: o3_lay, qs_lay, q_lay - real(kind_phys), dimension(ncol, Model%levs, NF_VGAS) :: gas_vmr - - if (.not. (Model%lsswr .or. Model%lslwr)) return + real(kind_phys), dimension(nCol,nLev) :: o3_lay, qs_lay, q_lay + real(kind_phys), dimension(nCol,nLev, NF_VGAS) :: gas_vmr ! Initialize CCPP error handling variables errmsg = '' errflg = 0 + if (.not. (lsswr .or. lslwr)) return + ! ####################################################################################### ! What is vertical ordering? ! ####################################################################################### - top_at_1 = (Statein%prsi(1,1) .lt. Statein%prsi(1, Model%levs)) + top_at_1 = (prsi(1,1) .lt. prsi(1, nLev)) if (top_at_1) then - iSFC = Model%levs + iSFC = nLev iTOA = 1 else iSFC = 1 - iTOA = Model%levs + iTOA = nLev endif ! ####################################################################################### @@ -255,25 +237,25 @@ subroutine GFS_rrtmgp_pre_run(Model, Grid, Statein, Sfcprop, Tbd, ncol, active_g ! ####################################################################################### ! Water-vapor mixing-ratio - q_lay(1:ncol,:) = Statein%qgrs(1:NCOL,:,1) + q_lay(1:ncol,:) = qgrs(1:NCOL,:,1) where(q_lay .lt. 1.e-6) q_lay = 1.e-6 ! Pressure at layer-interface - p_lev(1:NCOL,:) = Statein%prsi(1:NCOL,:) + p_lev(1:NCOL,:) = prsi(1:NCOL,:) ! Pressure at layer-center - p_lay(1:NCOL,:) = Statein%prsl(1:NCOL,:) + p_lay(1:NCOL,:) = prsl(1:NCOL,:) ! Temperature at layer-center - t_lay(1:NCOL,:) = Statein%tgrs(1:NCOL,:) + t_lay(1:NCOL,:) = tgrs(1:NCOL,:) ! Temperature at layer-interfaces if (top_at_1) then t_lev(1:NCOL,1) = t_lay(1:NCOL,iTOA) t_lev(1:NCOL,2:iSFC) = (t_lay(1:NCOL,2:iSFC)+t_lay(1:NCOL,1:iSFC-1))/2._kind_phys - t_lev(1:NCOL,iSFC+1) = Sfcprop%tsfc(1:NCOL) + t_lev(1:NCOL,iSFC+1) = tsfc(1:NCOL) else - t_lev(1:NCOL,1) = Sfcprop%tsfc(1:NCOL) + t_lev(1:NCOL,1) = tsfc(1:NCOL) t_lev(1:NCOL,2:iTOA) = (t_lay(1:NCOL,2:iTOA)+t_lay(1:NCOL,1:iTOA-1))/2._kind_phys t_lev(1:NCOL,iTOA+1) = t_lay(1:NCOL,iTOA) endif @@ -282,12 +264,12 @@ subroutine GFS_rrtmgp_pre_run(Model, Grid, Statein, Sfcprop, Tbd, ncol, active_g ! Relative humidity, saturation mixing-ratio, vapor mixing-ratio, virtual temperature, ! layer thickness,... do iCol=1,NCOL - do iLay=1,Model%levs + do iLay=1,nLev es = min( p_lay(iCol,iLay), fpvs( t_lay(iCol,iLay) ) ) ! fpvs and prsl in pa - qs = max( QMIN, eps * es / (p_lay(iCol,iLay) + epsm1*es) ) - relhum(iCol,iLay) = max( 0._kind_phys, min( 1._kind_phys, max(QMIN, q_lay(iCol,iLay))/qs ) ) + qs = max( acon_qMin, pcon_eps * es / (p_lay(iCol,iLay) + pcon_epsm1*es) ) + relhum(iCol,iLay) = max( 0._kind_phys, min( 1._kind_phys, max(acon_qMin, q_lay(iCol,iLay))/qs ) ) qs_lay(iCol,iLay) = qs - tv_lay(iCol,iLay) = t_lay(iCol,iLay) * (1._kind_phys + fvirt*q_lay(iCol,iLay)) + tv_lay(iCol,iLay) = t_lay(iCol,iLay) * (1._kind_phys + pcon_fvirt*q_lay(iCol,iLay)) enddo enddo @@ -295,27 +277,27 @@ subroutine GFS_rrtmgp_pre_run(Model, Grid, Statein, Sfcprop, Tbd, ncol, active_g ! Get layer ozone mass mixing ratio ! ####################################################################################### ! First recast remaining all tracers (except sphum) forcing them all to be positive - do j = 2, model%NTRAC - tracer(1:NCOL,:,j) = Statein%qgrs(1:NCOL,:,j) + 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 (Model%ntoz > 0) then - do iLay=1,Model%levs + if (i_o3 > 0) then + do iLay=1,nlev do iCol=1,NCOL - o3_lay(iCol,iLay) = max( QMIN, tracer(iCol,iLay,Model%ntoz) ) + o3_lay(iCol,iLay) = max( acon_qMin, tracer(iCol,iLay,i_o3) ) enddo enddo ! OR Use climatological ozone data else - call getozn (Statein%prslk(1:NCOL,:), Grid%xlat, NCOL, Model%levs, o3_lay) + call getozn (prslk(1:NCOL,:), xlat, nCol, nLev, o3_lay) endif ! ####################################################################################### ! Set gas concentrations for RRTMGP ! ####################################################################################### ! Call getgases(), to set up non-prognostic gas volume mixing ratios (gas_vmr). - call getgases (p_lev/100., Grid%xlon, Grid%xlat, NCOL, Model%levs, gas_vmr) + call getgases (p_lev/100., xlon, xlat, nCol, nLev, gas_vmr) ! Compute volume mixing-ratios for ozone (mmr) and specific-humidity. vmr_h2o = merge((q_lay/(1-q_lay))*amdw, 0., q_lay .ne. 1.) @@ -331,15 +313,15 @@ subroutine GFS_rrtmgp_pre_run(Model, Grid, Statein, Sfcprop, Tbd, ncol, active_g call check_error_msg('GFS_rrtmgp_pre_run',gas_concentrations%set_vmr(active_gases_array(iStr_o3), vmr_o3)) ! ####################################################################################### - ! Radiation time step (output) (Is this really needed?) (Used by some diangostics) + ! Radiation time step (output) (Is this really needed?) (Used by some diagnostics) ! ####################################################################################### - raddt = min(Model%fhswr, Model%fhlwr) + raddt = min(fhswr, fhlwr) ! ####################################################################################### ! Setup surface ground temperature and ground/air skin temperature if required. ! ####################################################################################### - tsfg(1:NCOL) = Sfcprop%tsfc(1:NCOL) - tsfa(1:NCOL) = Sfcprop%tsfc(1:NCOL) + tsfg(1:NCOL) = tsfc(1:NCOL) + tsfa(1:NCOL) = tsfc(1:NCOL) end subroutine GFS_rrtmgp_pre_run diff --git a/physics/GFS_rrtmgp_pre.meta b/physics/GFS_rrtmgp_pre.meta index cf0195a39..721cff001 100644 --- a/physics/GFS_rrtmgp_pre.meta +++ b/physics/GFS_rrtmgp_pre.meta @@ -1,14 +1,23 @@ [ccpp-arg-table] name = GFS_rrtmgp_pre_init type = scheme -[Model] - standard_name = GFS_control_type_instance - long_name = instance of derived type GFS_control_type - units = DDT - dimensions = () - type = GFS_control_type - intent = inout - optional = F +[active_gases] + standard_name = active_gases_used_by_RRTMGP + long_name = active gases used by RRTMGP + units = none + dimensions = () + type = character + kind = len=128 + intent = in + optional = F +[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 + optional = F [active_gases_array] standard_name = list_of_active_gases_used_by_RRTMGP long_name = list of active gases used by RRTMGP @@ -40,53 +49,151 @@ [ccpp-arg-table] name = GFS_rrtmgp_pre_run type = scheme -[Model] - standard_name = GFS_control_type_instance - long_name = instance of derived type GFS_control_type - units = DDT +[ncol] + standard_name = horizontal_loop_extent + long_name = horizontal dimension + units = count dimensions = () - type = GFS_control_type + type = integer intent = in optional = F -[Grid] - standard_name = GFS_grid_type_instance - long_name = instance of derived type GFS_grid_type - units = DDT +[nLev] + standard_name = vertical_dimension + long_name = number of vertical levels + units = count dimensions = () - type = GFS_grid_type + type = integer intent = in - optional = F -[Sfcprop] - standard_name = GFS_sfcprop_type_instance - long_name = instance of derived type GFS_sfcprop_type - units = DDT + optional = F +[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 + optional = F +[nTracers] + standard_name = number_of_tracers + long_name = number of tracers + units = count dimensions = () - type = GFS_sfcprop_type + type = integer intent = in optional = F -[Statein] - standard_name = GFS_statein_type_instance - long_name = instance of derived type GFS_statein_type - units = DDT +[lsswr] + standard_name = flag_to_calc_sw + long_name = logical flags for sw radiation calls + units = flag dimensions = () - type = GFS_statein_type + type = logical intent = in optional = F -[Tbd] - standard_name = GFS_tbd_type_instance - long_name = instance of derived type GFS_tbd_type - units = DDT +[lslwr] + standard_name = flag_to_calc_lw + long_name = logical flags for lw radiation calls + units = flag dimensions = () - type = GFS_tbd_type + type = logical intent = in - optional = F -[ncol] - standard_name = horizontal_loop_extent - long_name = horizontal loop extent - units = count + optional = F +[i_o3] + standard_name = index_for_ozone + long_name = tracer index for ozone mixing ratio + units = index dimensions = () type = integer intent = in + optional = F +[fhswr] + standard_name = frequency_for_shortwave_radiation + long_name = frequency for shortwave radiation + units = s + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[fhlwr] + standard_name = frequency_for_longwave_radiation + long_name = frequency for longwave radiation + units = s + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[xlat] + standard_name = latitude + long_name = latitude + units = radian + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[xlon] + standard_name = longitude + long_name = longitude + units = radian + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[prsi] + standard_name = air_pressure_at_interface + long_name = air pressure at model layer interfaces + units = Pa + dimensions = (horizontal_dimension,vertical_dimension_plus_one) + type = real + kind = kind_phys + intent = in + optional = F +[prslk] + standard_name = dimensionless_exner_function_at_model_layers + long_name = dimensionless Exner function at model layer centers + units = none + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[prsl] + standard_name = air_pressure + long_name = mean layer pressure + units = Pa + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[tgrs] + standard_name = air_temperature + long_name = model layer mean temperature + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[qgrs] + standard_name = tracer_concentration + long_name = model layer mean tracer concentration + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension,number_of_tracers) + type = real + kind = kind_phys + intent = in + optional = F +[tsfc] + standard_name = surface_skin_temperature + long_name = surface skin temperature + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in optional = F [active_gases_array] standard_name = list_of_active_gases_used_by_RRTMGP @@ -97,6 +204,42 @@ kind = len=* intent = in optional = F +[pcon_eps] + standard_name = physical_constant_epsilon + long_name = gas constant for air divided by gas constant for h2o + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[pcon_epsm1] + standard_name = physical_constant_epsilon_minus_one + long_name = gas constant for air divided by gas constant for h2o minus one + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[pcon_fvirt] + standard_name = physical_constant_inverse_of_epsilon + long_name = gas constant for h2o divided by gas constant fir air minus one + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[acon_qMin] + standard_name = algorithmic_constant_lower_limit_for_saturation_vapor_pressure + long_name = lower limit allowed when computing saturation vapor pressure + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F [raddt] standard_name = time_step_for_radiation long_name = radiation time step @@ -212,8 +355,3 @@ type = integer intent = out optional = F - -######################################################################## -[ccpp-arg-table] - name = GFS_rrtmgp_pre_finalize - type = scheme From 732fcd2e444e9572e141f0a5a50c680bd8d0b3d7 Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Sun, 2 Aug 2020 16:28:48 -0600 Subject: [PATCH 48/50] Removed all GFS DDTs. Replaced with flat fields. Physical constants are also passed via argument lists in the RRTMGP suite level files (still need to add constants to scheme level code). --- physics/GFS_cloud_diagnostics.F90 | 51 +++-- physics/GFS_cloud_diagnostics.meta | 33 ++- physics/GFS_rrtmgp_gfdlmp_pre.F90 | 109 +++++----- physics/GFS_rrtmgp_gfdlmp_pre.meta | 178 +++++++++++++-- physics/GFS_rrtmgp_lw_post.F90 | 242 ++++++++++----------- physics/GFS_rrtmgp_lw_post.meta | 143 +++++++----- physics/GFS_rrtmgp_pre.F90 | 18 +- physics/GFS_rrtmgp_pre.meta | 32 +-- physics/GFS_rrtmgp_setup.F90 | 55 +++-- physics/GFS_rrtmgp_setup.meta | 74 +++++-- physics/GFS_rrtmgp_sw_post.F90 | 334 +++++++++++++++-------------- physics/GFS_rrtmgp_sw_post.meta | 287 ++++++++++++++++++------- physics/GFS_rrtmgp_sw_pre.F90 | 95 ++++---- physics/GFS_rrtmgp_sw_pre.meta | 286 ++++++++++++++++++++---- 14 files changed, 1290 insertions(+), 647 deletions(-) diff --git a/physics/GFS_cloud_diagnostics.F90 b/physics/GFS_cloud_diagnostics.F90 index 8ee548aea..c62cc685d 100644 --- a/physics/GFS_cloud_diagnostics.F90 +++ b/physics/GFS_cloud_diagnostics.F90 @@ -5,9 +5,7 @@ ! ######################################################################################## module GFS_cloud_diagnostics use machine, only: kind_phys - use physcons, only: con_pi, con_rog, decorr_con use physparam, only: iovrlw, iovrsw, ivflip, icldflg, idcor - use GFS_typedefs, only: GFS_control_type ! Module parameters (imported directly from radiation_cloud.f) integer, parameter :: & @@ -41,17 +39,20 @@ end subroutine GFS_cloud_diagnostics_init !! \section arg_table_GFS_cloud_diagnostics_run !! \htmlinclude GFS_cloud_diagnostics_run.html !! - subroutine GFS_cloud_diagnostics_run(Model, nCol, nLev, lat, de_lgth, p_lay, cld_frac, & - p_lev, deltaZ, cloud_overlap_param, precip_overlap_param, & + subroutine GFS_cloud_diagnostics_run(nCol, nLev, lsswr, lslwr, lat, de_lgth, p_lay, & + cld_frac, p_lev, deltaZ, cloud_overlap_param, precip_overlap_param, con_pi, & mbota, mtopa, cldsa, errmsg, errflg) implicit none - ! Inputs - type(GFS_control_type), intent(in) :: & - Model ! DDT: FV3-GFS model control parameters + ! Inputs integer, intent(in) :: & nCol, & ! Number of horizontal grid-points nLev ! Number of vertical-layers + logical, intent(in) :: & + lsswr, & ! Call SW radiation? + lslwr ! Call LW radiation + real(kind_phys), intent(in) :: & + con_pi ! Physical constant: pi real(kind_phys), dimension(nCol), intent(in) :: & lat, & ! Latitude de_lgth ! Decorrelation length @@ -75,8 +76,6 @@ subroutine GFS_cloud_diagnostics_run(Model, nCol, nLev, lat, de_lgth, p_lay, cld mtopa ! Vertical indices for cloud bases real(kind_phys), dimension(ncol,5), intent(out) :: & cldsa ! Fraction of clouds for low, middle, high, total and BL - - ! Local variables integer i,id,iCol,iLay,icld @@ -85,7 +84,7 @@ subroutine GFS_cloud_diagnostics_run(Model, nCol, nLev, lat, de_lgth, p_lay, cld real(kind_phys),dimension(nCol) :: rlat real(kind_phys),dimension(nCol,nLev) :: cldcnv - if (.not. (Model%lsswr .or. Model%lslwr)) return + if (.not. (lsswr .or. lslwr)) return ! Initialize CCPP error handling variables errmsg = '' @@ -119,11 +118,21 @@ end subroutine GFS_cloud_diagnostics_finalize ! ###################################################################################### ! Initialization routine for High/Mid/Low cloud diagnostics. ! ###################################################################################### - subroutine hml_cloud_diagnostics_initialize(Model, nLev, mpi_rank, sigmainit, errflg) + subroutine hml_cloud_diagnostics_initialize(imp_physics, imp_physics_fer_hires, & + imp_physics_gfdl, imp_physics_thompson, imp_physics_wsm6, & + imp_physics_zhao_carr, imp_physics_zhao_carr_pdf, imp_physics_mg, nLev, & + mpi_rank, sigmainit, errflg) implicit none ! Inputs - type(GFS_control_type), intent(in) :: & - Model ! DDT: FV3-GFS model control parameters + integer, intent(in) :: & + imp_physics, & ! Flag for MP scheme + imp_physics_fer_hires, & ! Flag for fer-hires scheme + imp_physics_gfdl, & ! Flag for gfdl scheme + imp_physics_thompson, & ! Flag for thompsonscheme + imp_physics_wsm6, & ! Flag for wsm6 scheme + imp_physics_zhao_carr, & ! Flag for zhao-carr scheme + imp_physics_zhao_carr_pdf, & ! Flag for zhao-carr+PDF scheme + imp_physics_mg ! Flag for MG scheme integer, intent(in) :: & nLev, & ! Number of vertical-layers mpi_rank @@ -150,23 +159,23 @@ subroutine hml_cloud_diagnostics_initialize(Model, nLev, mpi_rank, sigmainit, er else if (mpi_rank == 0) then print *,' - Using Prognostic Cloud Method' - if (Model%imp_physics == Model%imp_physics_zhao_carr) then + if (imp_physics == imp_physics_zhao_carr) then print *,' --- Zhao/Carr/Sundqvist microphysics' - elseif (Model%imp_physics == Model%imp_physics_zhao_carr_pdf) then + elseif (imp_physics == imp_physics_zhao_carr_pdf) then print *,' --- zhao/carr/sundqvist + pdf cloud' - elseif (Model%imp_physics == Model%imp_physics_gfdl) then + elseif (imp_physics == imp_physics_gfdl) then print *,' --- GFDL Lin cloud microphysics' - elseif (Model%imp_physics == Model%imp_physics_thompson) then + elseif (imp_physics == imp_physics_thompson) then print *,' --- Thompson cloud microphysics' - elseif (Model%imp_physics == Model%imp_physics_wsm6) then + elseif (imp_physics == imp_physics_wsm6) then print *,' --- WSM6 cloud microphysics' - elseif (Model%imp_physics == Model%imp_physics_mg) then + elseif (imp_physics == imp_physics_mg) then print *,' --- MG cloud microphysics' - elseif (Model%imp_physics == Model%imp_physics_fer_hires) then + elseif (imp_physics == imp_physics_fer_hires) then print *,' --- Ferrier-Aligo cloud microphysics' else print *,' !!! ERROR in cloud microphysc specification!!!', & - ' imp_physics (NP3D) =',Model%imp_physics + ' imp_physics (NP3D) =',imp_physics errflg = 1 endif endif diff --git a/physics/GFS_cloud_diagnostics.meta b/physics/GFS_cloud_diagnostics.meta index b3cb423c5..f78a76490 100644 --- a/physics/GFS_cloud_diagnostics.meta +++ b/physics/GFS_cloud_diagnostics.meta @@ -2,14 +2,6 @@ [ccpp-arg-table] name = GFS_cloud_diagnostics_run type = scheme -[Model] - standard_name = GFS_control_type_instance - long_name = instance of derived type GFS_control_type - units = DDT - dimensions = () - type = GFS_control_type - intent = in - optional = F [ncol] standard_name = horizontal_loop_extent long_name = horizontal dimension @@ -26,6 +18,22 @@ type = integer intent = in optional = F +[lsswr] + standard_name = flag_to_calc_sw + long_name = logical flags for sw radiation calls + units = flag + dimensions = () + type = logical + intent = in + optional = F +[lslwr] + standard_name = flag_to_calc_lw + long_name = logical flags for lw radiation calls + units = flag + dimensions = () + type = logical + intent = in + optional = F [lat] standard_name = latitude long_name = latitude @@ -114,6 +122,15 @@ kind = kind_phys intent = in optional = F +[con_pi] + standard_name = pi + long_name = ratio of a circle's circumference to its diameter + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F [cldsa] standard_name = cloud_area_fraction_for_radiation long_name = fraction of clouds for low, middle, high, total and BL diff --git a/physics/GFS_rrtmgp_gfdlmp_pre.F90 b/physics/GFS_rrtmgp_gfdlmp_pre.F90 index d63bcc321..938e6ac95 100644 --- a/physics/GFS_rrtmgp_gfdlmp_pre.F90 +++ b/physics/GFS_rrtmgp_gfdlmp_pre.F90 @@ -4,13 +4,6 @@ ! ######################################################################################## module GFS_rrtmgp_gfdlmp_pre use machine, only: kind_phys - use GFS_typedefs, only: GFS_control_type, GFS_tbd_type - use physcons, only: con_ttp, & ! Temperature at h2o 3pt (K) - con_rd, & ! Gas constant for dry air (J/KgK) - con_pi, & ! PI - con_g, & ! Gravity (m/s2) - con_rog, & - decorr_con use physparam, only: lcnorm, lcrick, idcor, iovrlw, iovrsw use rrtmgp_aux, only: check_error_msg @@ -18,10 +11,9 @@ module GFS_rrtmgp_gfdlmp_pre real(kind_phys), parameter :: & reice_min = 10.0, & ! Minimum ice size allowed by scheme reice_max = 150.0, & ! Maximum ice size allowed by scheme - epsq = 1.0e-12, & ! Tiny value cllimit = 0.001, & ! Lowest cloud fraction in GFDL MP scheme - gfac = 1.0e5/con_g - + decorr_con = 2.50 ! Decorrelation length constant (km) for iovrlw/iovrsw = 4 or 5 and idcor = 0 + public GFS_rrtmgp_gfdlmp_pre_init, GFS_rrtmgp_gfdlmp_pre_run, GFS_rrtmgp_gfdlmp_pre_finalize private get_alpha_dcorr, get_alpha_exp contains @@ -35,31 +27,50 @@ end subroutine GFS_rrtmgp_gfdlmp_pre_init !! \section arg_table_GFS_rrtmgp_gfdlmp_pre_run !! \htmlinclude GFS_rrtmgp_gfdlmp_pre_run.html !! - subroutine GFS_rrtmgp_gfdlmp_pre_run(Model, Tbd, nCol, nLev, yearlen, julian, lat, & - p_lev, p_lay, tv_lay, tracer, cld_frac, cld_lwp, cld_reliq, cld_iwp, cld_reice, & - cld_swp, cld_resnow, cld_rwp, cld_rerain, precip_frac, cloud_overlap_param, & - precip_overlap_param, de_lgth, deltaZ, errmsg, errflg) + subroutine GFS_rrtmgp_gfdlmp_pre_run(nCol, nLev, nTracers, ncnd, i_cldliq, i_cldice, & + i_cldrain, i_cldsnow, i_cldgrpl, i_cldtot, yearlen, lsswr, lslwr, effr_in, julian,& + lat, p_lev, p_lay, tv_lay, effrin_cldliq, effrin_cldice, effrin_cldrain, & + effrin_cldsnow, tracer, con_pi, con_g, con_rd, con_epsq, & + cld_frac, cld_lwp, cld_reliq, cld_iwp, cld_reice, cld_swp, cld_resnow, cld_rwp, & + cld_rerain, precip_frac, cloud_overlap_param, precip_overlap_param, de_lgth, & + deltaZ, errmsg, errflg) implicit none - ! Inputs - type(GFS_control_type), intent(in) :: & - Model ! DDT: FV3-GFS model control parameters - type(GFS_tbd_type), intent(in) :: & - Tbd ! DDT: FV3-GFS data not yet assigned to a defined container - integer, intent(in) :: & - nCol, & ! Number of horizontal grid-points - nLev, & ! Number of vertical-layers - yearlen ! Length of current year (365/366) WTF? + ! Inputs + integer, intent(in) :: & + nCol, & ! Number of horizontal grid points + nLev, & ! Number of vertical layers + ncnd, & ! Number of cloud condensation types. + nTracers, & ! Number of tracers from model. + i_cldliq, & ! Index into tracer array for cloud liquid. + i_cldice, & ! Index into tracer array for cloud ice. + i_cldrain, & ! Index into tracer array for cloud rain. + i_cldsnow, & ! Index into tracer array for cloud snow. + i_cldgrpl, & ! Index into tracer array for cloud groupel. + i_cldtot, & ! Index into tracer array for cloud total amount. + yearlen ! Length of current year (365/366) WTF? + logical, intent(in) :: & + lsswr, & ! Call SW radiation? + lslwr, & ! Call LW radiation + effr_in ! Provide hydrometeor radii from macrophysics? real(kind_phys), intent(in) :: & - julian ! Julian day + julian, & ! Julian day + con_pi, & ! Physical constant: pi + con_g, & ! Physical constant: gravitational constant + con_rd, & ! Physical constant: gas-constant for dry air + con_epsq ! Physical constant(?): Minimum value for specific humidity real(kind_phys), dimension(nCol), intent(in) :: & lat ! Latitude real(kind_phys), dimension(nCol,nLev), intent(in) :: & tv_lay, & ! Virtual temperature (K) - p_lay ! Pressure at model-layers (Pa) + p_lay, & ! Pressure at model-layers (Pa) + effrin_cldliq, & ! Effective radius for liquid cloud-particles (microns) + effrin_cldice, & ! Effective radius for ice cloud-particles (microns) + effrin_cldrain, & ! Effective radius for rain cloud-particles (microns) + effrin_cldsnow ! Effective radius for snow cloud-particles (microns) real(kind_phys), dimension(nCol,nLev+1), intent(in) :: & p_lev ! Pressure at model-level interfaces (Pa) - real(kind_phys), dimension(nCol, nLev, Model%ntrac),intent(in) :: & + real(kind_phys), dimension(nCol, nLev, nTracers),intent(in) :: & tracer ! Cloud condensate amount in layer by type () ! Outputs @@ -86,18 +97,18 @@ subroutine GFS_rrtmgp_gfdlmp_pre_run(Model, Tbd, nCol, nLev, yearlen, julian, la ! Local variables real(kind_phys) :: tem1 - real(kind_phys), dimension(nCol, nLev, min(4,Model%ncnd)) :: cld_condensate + real(kind_phys), dimension(nCol, nLev, min(4,ncnd)) :: cld_condensate integer :: iCol,iLay,l,ncndl,iovr real(kind_phys), dimension(nCol,nLev) :: deltaP - if (.not. (Model%lsswr .or. Model%lslwr)) return + if (.not. (lsswr .or. lslwr)) return ! Initialize CCPP error handling variables errmsg = '' errflg = 0 ! Test inputs - if (Model%ncnd .ne. 5) then + if (ncnd .ne. 5) then errmsg = 'Incorrect number of cloud condensates provided' errflg = 1 call check_error_msg('GFS_rrtmgp_gfdlmp_pre_run',errmsg) @@ -118,14 +129,7 @@ subroutine GFS_rrtmgp_gfdlmp_pre_run(Model, Tbd, nCol, nLev, yearlen, julian, la return endif ! - if (.not. Model%lgfdlmprad) then - errmsg = 'Namelist option gfdlmprad=F is not supported.' - errflg = 1 - call check_error_msg('GFS_rrtmgp_gfdlmp_pre_run',errmsg) - return - endif - ! - if(.not. Model%effr_in) then + if(.not. effr_in) then errmsg = 'Namelist option effr_in=F is not supported.' errflg = 1 call check_error_msg('GFS_rrtmgp_gfdlmp_pre_run',errmsg) @@ -146,29 +150,29 @@ subroutine GFS_rrtmgp_gfdlmp_pre_run(Model, Tbd, nCol, nLev, yearlen, julian, la ! Pull out cloud information for GFDL MP scheme. ! #################################################################################### ! Condensate - cld_condensate(1:nCol,1:nLev,1) = tracer(1:nCol,1:nLev,Model%ntcw) ! -liquid water - cld_condensate(1:nCol,1:nLev,2) = tracer(1:nCol,1:nLev,Model%ntiw) ! -ice water - cld_condensate(1:nCol,1:nLev,3) = tracer(1:nCol,1:nLev,Model%ntrw) ! -rain water - cld_condensate(1:nCol,1:nLev,4) = tracer(1:nCol,1:nLev,Model%ntsw) + & ! -snow + grapuel - tracer(1:nCol,1:nLev,Model%ntgl) + cld_condensate(1:nCol,1:nLev,1) = tracer(1:nCol,1:nLev,i_cldliq) ! -liquid water + cld_condensate(1:nCol,1:nLev,2) = tracer(1:nCol,1:nLev,i_cldice) ! -ice water + cld_condensate(1:nCol,1:nLev,3) = tracer(1:nCol,1:nLev,i_cldrain) ! -rain water + cld_condensate(1:nCol,1:nLev,4) = tracer(1:nCol,1:nLev,i_cldsnow) + &! -snow + grapuel + tracer(1:nCol,1:nLev,i_cldgrpl) ! Since we combine the snow and grapuel, define local variable for number of condensate types. - ncndl = min(4,Model%ncnd) + ncndl = min(4,ncnd) ! Set really tiny suspended particle amounts to clear do l=1,ncndl do iLay=1,nLev do iCol=1,nCol - if (cld_condensate(iCol,iLay,l) < epsq) cld_condensate(iCol,iLay,l) = 0.0 + if (cld_condensate(iCol,iLay,l) < con_epsq) cld_condensate(iCol,iLay,l) = 0.0 enddo enddo enddo ! Cloud-fraction - cld_frac(1:nCol,1:nLev) = tracer(1:nCol,1:nLev,Model%ntclamt) + cld_frac(1:nCol,1:nLev) = tracer(1:nCol,1:nLev,i_cldtot) ! Precipitation fraction (Hack. For now use cloud-fraction) - precip_frac(1:nCol,1:nLev) = tracer(1:nCol,1:nLev,Model%ntclamt) + precip_frac(1:nCol,1:nLev) = tracer(1:nCol,1:nLev,i_cldtot) ! Condensate and effective size deltaP = abs(p_lev(:,2:nLev+1)-p_lev(:,1:nLev))/100. @@ -176,17 +180,17 @@ subroutine GFS_rrtmgp_gfdlmp_pre_run(Model, Tbd, nCol, nLev, yearlen, julian, la do iCol = 1, nCol ! Compute liquid/ice condensate path from mixing ratios (kg/kg)->(g/m2) if (cld_frac(iCol,iLay) .ge. cllimit) then - tem1 = gfac * deltaP(iCol,iLay) + tem1 = (1.0e5/con_g) * deltaP(iCol,iLay) cld_lwp(iCol,iLay) = cld_condensate(iCol,iLay,1) * tem1 cld_iwp(iCol,iLay) = cld_condensate(iCol,iLay,2) * tem1 cld_rwp(iCol,iLay) = cld_condensate(iCol,iLay,3) * tem1 cld_swp(iCol,iLay) = cld_condensate(iCol,iLay,4) * tem1 endif ! Use radii provided from the macrophysics - cld_reliq(iCol,iLay) = Tbd%phy_f3d(iCol,iLay,1) - cld_reice(iCol,iLay) = max(reice_min, min(reice_max,Tbd%phy_f3d(iCol,iLay,2))) - cld_rerain(iCol,iLay) = Tbd%phy_f3d(iCol,iLay,3) - cld_resnow(iCol,iLay) = Tbd%phy_f3d(iCol,iLay,4) + cld_reliq(iCol,iLay) = effrin_cldliq(iCol,iLay) + cld_reice(iCol,iLay) = max(reice_min, min(reice_max,effrin_cldice(iCol,iLay))) + cld_rerain(iCol,iLay) = effrin_cldrain(iCol,iLay) + cld_resnow(iCol,iLay) = effrin_cldsnow(iCol,iLay) enddo enddo @@ -199,7 +203,7 @@ subroutine GFS_rrtmgp_gfdlmp_pre_run(Model, Tbd, nCol, nLev, yearlen, julian, la ! Compute layer-thickness do iCol=1,nCol do iLay=1,nLev - deltaZ(iCol,iLay) = (con_rog*0.001) * abs(log(p_lev(iCol,iLay)) - log(p_lev(iCol,iLay+1))) * tv_lay(iCol,iLay) + deltaZ(iCol,iLay) = ((con_rd/con_g)*0.001) * abs(log(p_lev(iCol,iLay)) - log(p_lev(iCol,iLay+1))) * tv_lay(iCol,iLay) enddo enddo @@ -353,7 +357,6 @@ subroutine get_alpha_exp(nlon, nlay, dzlay, iovrlp, latdeg, juldat, yearlen, cld ! ! ! ==================== end of description ===================== ! ! - use physcons, only: decorr_con use physparam, only: idcor implicit none ! Input diff --git a/physics/GFS_rrtmgp_gfdlmp_pre.meta b/physics/GFS_rrtmgp_gfdlmp_pre.meta index 5a20836b8..67efc4b4f 100644 --- a/physics/GFS_rrtmgp_gfdlmp_pre.meta +++ b/physics/GFS_rrtmgp_gfdlmp_pre.meta @@ -2,23 +2,7 @@ [ccpp-arg-table] name = GFS_rrtmgp_gfdlmp_pre_run type = scheme -[Model] - standard_name = GFS_control_type_instance - long_name = instance of derived type GFS_control_type - units = DDT - dimensions = () - type = GFS_control_type - intent = in - optional = F -[Tbd] - standard_name = GFS_tbd_type_instance - long_name = instance of derived type GFS_tbd_type - units = DDT - dimensions = () - type = GFS_tbd_type - intent = in - optional = F -[ncol] +[nCol] standard_name = horizontal_loop_extent long_name = horizontal dimension units = count @@ -34,6 +18,130 @@ type = integer intent = in optional = F +[nTracers] + standard_name = number_of_tracers + long_name = number of tracers + units = count + dimensions = () + type = integer + intent = in + optional = F +[ncnd] + standard_name = number_of_cloud_condensate_types + long_name = number of cloud condensate types + units = count + dimensions = () + type = integer + intent = in + optional = F +[lsswr] + standard_name = flag_to_calc_sw + long_name = logical flags for sw radiation calls + units = flag + dimensions = () + type = logical + intent = in + optional = F +[lslwr] + standard_name = flag_to_calc_lw + long_name = logical flags for lw radiation calls + units = flag + dimensions = () + type = logical + intent = in + optional = F +[effr_in] + standard_name = flag_for_cloud_effective_radii + long_name = flag for cloud effective radii calculations in GFDL microphysics + units = + dimensions = () + type = logical + intent = in + optional = F +[i_cldliq] + standard_name = index_for_liquid_cloud_condensate + long_name = tracer index for cloud condensate (or liquid water) + units = index + dimensions = () + type = integer + intent = in + optional = F +[i_cldice] + standard_name = index_for_ice_cloud_condensate + long_name = tracer index for ice water + units = index + dimensions = () + type = integer + intent = in + optional = F +[i_cldrain] + standard_name = index_for_rain_water + long_name = tracer index for rain water + units = index + dimensions = () + type = integer + intent = in + optional = F +[i_cldsnow] + standard_name = index_for_snow_water + long_name = tracer index for snow water + units = index + dimensions = () + type = integer + intent = in + optional = F +[i_cldgrpl] + standard_name = index_for_graupel + long_name = tracer index for graupel + units = index + dimensions = () + type = integer + intent = in + optional = F +[i_cldtot] + standard_name = index_for_cloud_amount + long_name = tracer index for cloud amount integer + units = index + dimensions = () + type = integer + intent = in + optional = F +[effrin_cldliq] + standard_name = effective_radius_of_stratiform_cloud_liquid_water_particle_in_um + long_name = eff. radius of cloud liquid water particle in micrometer + units = um + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[effrin_cldice] + standard_name = effective_radius_of_stratiform_cloud_ice_particle_in_um + long_name = eff. radius of cloud ice water particle in micrometer + units = um + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[effrin_cldrain] + standard_name = effective_radius_of_stratiform_cloud_rain_particle_in_um + long_name = effective radius of cloud rain particle in micrometers + units = um + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[effrin_cldsnow] + standard_name = effective_radius_of_stratiform_cloud_snow_particle_in_um + long_name = effective radius of cloud snow particle in micrometers + units = um + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F [yearlen] standard_name = number_of_days_in_year long_name = number of days in a year @@ -96,6 +204,42 @@ kind = kind_phys intent = in optional = F +[con_pi] + standard_name = pi + long_name = ratio of a circle's circumference to its diameter + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[con_g] + standard_name = gravitational_acceleration + long_name = gravitational acceleration + units = m s-2 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[con_rd] + standard_name = gas_constant_dry_air + long_name = ideal gas constant for dry air + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[con_epsq] + standard_name = minimum_value_of_specific_humidity + long_name = floor value for specific humidity + units = kg kg-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F [de_lgth] standard_name = cloud_decorrelation_length long_name = cloud decorrelation length diff --git a/physics/GFS_rrtmgp_lw_post.F90 b/physics/GFS_rrtmgp_lw_post.F90 index 7555f7278..a9a238cc9 100644 --- a/physics/GFS_rrtmgp_lw_post.F90 +++ b/physics/GFS_rrtmgp_lw_post.F90 @@ -1,11 +1,5 @@ module GFS_rrtmgp_lw_post - use machine, only: kind_phys - use GFS_typedefs, only: GFS_coupling_type, & - GFS_control_type, & - GFS_grid_type, & - GFS_radtend_type, & - GFS_statein_type, & - GFS_diag_type + use machine, only: kind_phys use module_radiation_aerosols, only: NSPC1 use module_radlw_parameters, only: topflw_type, sfcflw_type, proflw_type ! RRTMGP DDT's @@ -30,73 +24,80 @@ end subroutine GFS_rrtmgp_lw_post_init !> \section arg_table_GFS_rrtmgp_lw_post_run !! \htmlinclude GFS_rrtmgp_lw_post.html !! - subroutine GFS_rrtmgp_lw_post_run (Model, Grid, Radtend, Coupling, Diag, Statein, im, & - p_lev, tsfa, fluxlwUP_allsky, fluxlwDOWN_allsky, fluxlwUP_clrsky, fluxlwDOWN_clrsky,& + 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, fluxlwDOWN_clrsky,& raddt, aerodp, cldsa, mtopa, mbota, cld_frac, cldtaulw, & - flxprf_lw, hlw0, errmsg, errflg) + sfcdlw, sfcflw, tsflw, htrlw, topflw, flxprf_lw, htrlwc, errmsg, errflg) - ! Inputs - type(GFS_control_type), intent(in) :: & - Model ! Fortran DDT: FV3-GFS model control parameters - type(GFS_grid_type), intent(in) :: & - Grid ! Fortran DDT: FV3-GFS grid and interpolation related data - type(GFS_statein_type), intent(in) :: & - Statein ! Fortran DDT: FV3-GFS prognostic state data in from dycore + ! Inputs integer, intent(in) :: & - im ! Horizontal loop extent - real(kind_phys), dimension(size(Grid%xlon,1)), intent(in) :: & + nCol, & ! Horizontal loop extent + nLev ! Number of vertical layers + 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(size(Grid%xlon,1), Model%levs+1), intent(in) :: & - p_lev ! Pressure @ model layer-interfaces (hPa) - real(kind_phys), dimension(size(Grid%xlon,1), Model%levs+1), intent(in) :: & + 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(im,NSPC1), intent(in) :: & + real(kind_phys), dimension(nCol,NSPC1), intent(in) :: & aerodp ! Vertical integrated optical depth for various aerosol species - real(kind_phys), dimension(im,5), intent(in) :: & + real(kind_phys), dimension(nCol,5), intent(in) :: & cldsa ! Fraction of clouds for low, middle, high, total and BL - integer, dimension(im,3), intent(in) ::& + 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(im,Model%levs), intent(in) :: & + 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 ! Outputs (mandatory) + real(kind_phys), dimension(nCol), intent(out) :: & + sfcdlw, & ! Total sky sfc downward lw flux (W/m2) + tsflw ! surface air temp during lw calculation (K) + type(sfcflw_type), dimension(nCol), intent(out) :: & + sfcflw ! LW radiation fluxes at sfc + real(kind_phys), dimension(nCol,nLev), intent(out) :: & + htrlw ! LW all-sky heating rate + type(topflw_type), dimension(nCol), intent(out) :: & + topflw ! lw_fluxes_top_atmosphere character(len=*), intent(out) :: & errmsg integer, intent(out) :: & errflg - type(GFS_coupling_type), intent(inout) :: & - Coupling ! Fortran DDT: FV3-GFS fields to/from coupling with other components - type(GFS_radtend_type), intent(inout) :: & - Radtend ! Fortran DDT: FV3-GFS radiation tendencies - type(GFS_diag_type), intent(inout) :: & - Diag ! Fortran DDT: FV3-GFS diagnotics data + ! Outputs (optional) - type(proflw_type), dimension(size(Grid%xlon,1), Model%levs+1), optional, intent(inout) :: & + type(proflw_type), dimension(nCol, nLev+1), optional, intent(out) :: & flxprf_lw ! 2D radiative fluxes, components: ! upfxc - total sky upward flux (W/m2) ! dnfxc - total sky dnward flux (W/m2) ! upfx0 - clear sky upward flux (W/m2) ! dnfx0 - clear sky dnward flux (W/m2) - real(kind_phys),dimension(size(Grid%xlon,1), Model%levs),intent(inout),optional :: & - hlw0 ! Longwave clear-sky heating-rate (K/sec) + real(kind_phys),dimension(nCol, nLev),intent(out),optional :: & + htrlwc ! Longwave clear-sky heating-rate (K/sec) + ! Local variables integer :: i, j, k, iSFC, iTOA, itop, ibtc logical :: l_fluxeslw2d, top_at_1 real(kind_phys) :: tem0d, tem1, tem2 - real(kind_phys),dimension(size(Grid%xlon,1), Model%levs) :: hlwc + real(kind_phys),dimension(nCol,nLev) :: hlwc ! Initialize CCPP error handling variables errmsg = '' errflg = 0 - if (.not. Model%lslwr) return + if (.not. lslwr) return ! Are any optional outputs requested? l_fluxeslw2d = present(flxprf_lw) @@ -104,72 +105,59 @@ subroutine GFS_rrtmgp_lw_post_run (Model, Grid, Radtend, Coupling, Diag, Statei ! ####################################################################################### ! What is vertical ordering? ! ####################################################################################### - top_at_1 = (p_lev(1,1) .lt. p_lev(1, Model%levs)) + top_at_1 = (p_lev(1,1) .lt. p_lev(1, nLev)) if (top_at_1) then - iSFC = Model%levs+1 + iSFC = nLev+1 iTOA = 1 else iSFC = 1 - iTOA = Model%levs+1 + iTOA = nLev+1 endif ! ####################################################################################### ! Compute LW heating-rates. ! ####################################################################################### - if (Model%lslwr) then - ! Clear-sky heating-rate (optional) - if (Model%lwhtr) 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) - hlw0)) ! 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) - hlwc)) ! OUT - Longwave all-sky heating rate (K/sec) - - ! Copy fluxes from RRTGMP types into model radiation types. - ! Mandatory outputs - Diag%topflw(:)%upfxc = fluxlwUP_allsky(:,iTOA) - Diag%topflw(:)%upfx0 = fluxlwUP_clrsky(:,iTOA) - Radtend%sfcflw(:)%upfxc = fluxlwUP_allsky(:,iSFC) - Radtend%sfcflw(:)%upfx0 = fluxlwUP_clrsky(:,iSFC) - Radtend%sfcflw(:)%dnfxc = fluxlwDOWN_allsky(:,iSFC) - Radtend%sfcflw(:)%dnfx0 = fluxlwDOWN_clrsky(:,iSFC) - - ! Optional outputs - if(l_fluxeslw2d) then - flxprf_lw%upfxc = fluxlwUP_allsky - flxprf_lw%dnfxc = fluxlwDOWN_allsky - flxprf_lw%upfx0 = fluxlwUP_clrsky - flxprf_lw%dnfx0 = fluxlwDOWN_clrsky - endif + ! 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. + ! Save LW outputs. ! ####################################################################################### - if (Model%lslwr) then - ! Save surface air temp for diurnal adjustment at model t-steps - Radtend%tsflw (:) = tsfa(:) + ! Copy fluxes from RRTGMP types into model radiation types. + ! Mandatory outputs + topflw(:)%upfxc = fluxlwUP_allsky(:,iTOA) + topflw(:)%upfx0 = fluxlwUP_clrsky(:,iTOA) + sfcflw(:)%upfxc = fluxlwUP_allsky(:,iSFC) + sfcflw(:)%upfx0 = fluxlwUP_clrsky(:,iSFC) + sfcflw(:)%dnfxc = fluxlwDOWN_allsky(:,iSFC) + sfcflw(:)%dnfx0 = fluxlwDOWN_clrsky(:,iSFC) - ! All-sky heating rate profile - do k = 1, model%levs - Radtend%htrlw(1:im,k) = hlwc(1:im,k) - enddo - if (Model%lwhtr) then - do k = 1, model%levs - Radtend%lwhc(1:im,k) = hlw0(1:im,k) - enddo - endif - - ! Radiation fluxes for other physics processes - Coupling%sfcdlw(:) = Radtend%sfcflw(:)%dnfxc - endif + ! Optional outputs + if(l_fluxeslw2d) then + flxprf_lw%upfxc = fluxlwUP_allsky + flxprf_lw%dnfxc = fluxlwDOWN_allsky + flxprf_lw%upfx0 = fluxlwUP_clrsky + flxprf_lw%dnfx0 = fluxlwDOWN_clrsky + endif + + ! Save surface air temp for diurnal adjustment at model t-steps + tsflw (:) = tsfa(:) + + ! Radiation fluxes for other physics processes + sfcdlw(:) = sfcflw(:)%dnfxc ! ####################################################################################### ! Save LW diagnostics @@ -179,45 +167,43 @@ subroutine GFS_rrtmgp_lw_post_run (Model, Grid, Radtend, Coupling, Diag, Statei ! corresponding slots of array fluxr with appropriate time weights. ! - Collect the fluxr data for wrtsfc ! ####################################################################################### - if (Model%lssav) then - if (Model%lslwr) then - do i=1,im - ! LW all-sky fluxes - Diag%fluxr(i,1 ) = Diag%fluxr(i,1 ) + Model%fhlwr * fluxlwUP_allsky( i,iTOA) ! total sky top lw up - Diag%fluxr(i,19) = Diag%fluxr(i,19) + Model%fhlwr * fluxlwDOWN_allsky(i,iSFC) ! total sky sfc lw dn - Diag%fluxr(i,20) = Diag%fluxr(i,20) + Model%fhlwr * fluxlwUP_allsky( i,iSFC) ! total sky sfc lw up - ! LW clear-sky fluxes - Diag%fluxr(i,28) = Diag%fluxr(i,28) + Model%fhlwr * fluxlwUP_clrsky( i,iTOA) ! clear sky top lw up - Diag%fluxr(i,30) = Diag%fluxr(i,30) + Model%fhlwr * fluxlwDOWN_clrsky(i,iSFC) ! clear sky sfc lw dn - Diag%fluxr(i,33) = Diag%fluxr(i,33) + Model%fhlwr * fluxlwUP_clrsky( i,iSFC) ! clear sky sfc lw up - enddo - - do i=1,im - Diag%fluxr(i,17) = Diag%fluxr(i,17) + raddt * cldsa(i,4) - Diag%fluxr(i,18) = Diag%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, IM - tem0d = raddt * cldsa(i,j) - itop = mtopa(i,j) - ibtc = mbota(i,j) - Diag%fluxr(i, 8-j) = Diag%fluxr(i, 8-j) + tem0d - Diag%fluxr(i,11-j) = Diag%fluxr(i,11-j) + tem0d * Statein%prsi(i,itop) - Diag%fluxr(i,14-j) = Diag%fluxr(i,14-j) + tem0d * Statein%prsi(i,ibtc) - Diag%fluxr(i,17-j) = Diag%fluxr(i,17-j) + tem0d * Statein%tgrs(i,itop) - - ! Add optical depth and emissivity output - tem2 = 0. - do k=ibtc,itop - tem2 = tem2 + cldtaulw(i,k) ! approx 10. mu channel - enddo - Diag%fluxr(i,46-j) = Diag%fluxr(i,46-j) + tem0d * (1.0-exp(-tem2)) - enddo - enddo - endif + if (save_diag) then +! do i=1,nCol +! ! LW all-sky fluxes +! Diag%fluxr(i,1 ) = Diag%fluxr(i,1 ) + fhlwr * fluxlwUP_allsky( i,iTOA) ! total sky top lw up +! Diag%fluxr(i,19) = Diag%fluxr(i,19) + fhlwr * fluxlwDOWN_allsky(i,iSFC) ! total sky sfc lw dn +! Diag%fluxr(i,20) = Diag%fluxr(i,20) + fhlwr * fluxlwUP_allsky( i,iSFC) ! total sky sfc lw up +! ! LW clear-sky fluxes +! Diag%fluxr(i,28) = Diag%fluxr(i,28) + fhlwr * fluxlwUP_clrsky( i,iTOA) ! clear sky top lw up +! Diag%fluxr(i,30) = Diag%fluxr(i,30) + fhlwr * fluxlwDOWN_clrsky(i,iSFC) ! clear sky sfc lw dn +! Diag%fluxr(i,33) = Diag%fluxr(i,33) + fhlwr * fluxlwUP_clrsky( i,iSFC) ! clear sky sfc lw up +! enddo +! +! do i=1,nCol +! Diag%fluxr(i,17) = Diag%fluxr(i,17) + raddt * cldsa(i,4) +! Diag%fluxr(i,18) = Diag%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) +! Diag%fluxr(i, 8-j) = Diag%fluxr(i, 8-j) + tem0d +! Diag%fluxr(i,11-j) = Diag%fluxr(i,11-j) + tem0d * p_lev(i,itop) +! Diag%fluxr(i,14-j) = Diag%fluxr(i,14-j) + tem0d * p_lev(i,ibtc) +! Diag%fluxr(i,17-j) = Diag%fluxr(i,17-j) + tem0d * t_lay(i,itop) +! +! ! Add optical depth and emissivity output +! tem2 = 0. +! do k=ibtc,itop +! tem2 = tem2 + cldtaulw(i,k) ! approx 10. mu channel +! enddo +! Diag%fluxr(i,46-j) = Diag%fluxr(i,46-j) + tem0d * (1.0-exp(-tem2)) +! enddo +! enddo endif end subroutine GFS_rrtmgp_lw_post_run diff --git a/physics/GFS_rrtmgp_lw_post.meta b/physics/GFS_rrtmgp_lw_post.meta index 646945d90..c261a7797 100644 --- a/physics/GFS_rrtmgp_lw_post.meta +++ b/physics/GFS_rrtmgp_lw_post.meta @@ -1,62 +1,55 @@ [ccpp-arg-table] name = GFS_rrtmgp_lw_post_run type = scheme -[Model] - standard_name = GFS_control_type_instance - long_name = instance of derived type GFS_control_type - units = DDT +[nCol] + standard_name = horizontal_loop_extent + long_name = horizontal loop extent + units = count dimensions = () - type = GFS_control_type + type = integer intent = in optional = F -[Grid] - standard_name = GFS_grid_type_instance - long_name = instance of derived type GFS_grid_type - units = DDT +[nLev] + standard_name = vertical_dimension + long_name = number of vertical levels + units = count dimensions = () - type = GFS_grid_type + type = integer intent = in - optional = F -[Radtend] - standard_name = GFS_radtend_type_instance - long_name = instance of derived type GFS_radtend_type - units = DDT - dimensions = () - type = GFS_radtend_type - intent = inout - optional = F -[Coupling] - standard_name = GFS_coupling_type_instance - long_name = instance of derived type GFS_coupling_type - units = DDT + optional = F +[lslwr] + standard_name = flag_to_calc_lw + long_name = logical flags for lw radiation calls + units = flag dimensions = () - type = GFS_coupling_type - intent = inout - optional = F -[Diag] - standard_name = GFS_diag_type_instance - long_name = instance of derived type GFS_diag_type - units = DDT + type = logical + intent = in + optional = F +[do_lw_clrsky_hr] + standard_name = flag_for_output_of_longwave_heating_rate + long_name = flag to output lw heating rate + units = flag dimensions = () - type = GFS_diag_type - intent = inout - optional = F -[Statein] - standard_name = GFS_statein_type_instance - long_name = instance of derived type GFS_statein_type - units = DDT + type = logical + intent = in + optional = F +[save_diag] + standard_name = flag_diagnostics + long_name = logical flag for storing diagnostics + units = flag dimensions = () - type = GFS_statein_type + type = logical intent = in - optional = F -[im] - standard_name = horizontal_loop_extent - long_name = horizontal loop extent - units = count + optional = F +[fhlwr] + standard_name = frequency_for_longwave_radiation + long_name = frequency for longwave radiation + units = s dimensions = () - type = integer + type = real + kind = kind_phys intent = in - optional = F + optional = F [tsfa] standard_name = surface_air_temperature_for_radiation long_name = lowest model layer air temperature for radiation @@ -66,6 +59,15 @@ kind = kind_phys intent = in optional = F +[t_lay] + standard_name = air_temperature_at_layer_for_RRTMGP + long_name = air temperature at vertical layer for radiation calculation + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F [p_lev] standard_name = air_pressure_at_interface_for_RRTMGP_in_hPa long_name = air pressure level @@ -172,22 +174,65 @@ kind = kind_phys intent = in optional = F +[sfcdlw] + standard_name = surface_downwelling_longwave_flux_on_radiation_time_step + long_name = total sky sfc downward lw flux + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[sfcflw] + standard_name = lw_fluxes_sfc + long_name = lw radiation fluxes at sfc + units = W m-2 + dimensions = (horizontal_dimension) + type = sfcflw_type + intent = out + optional = F +[tsflw] + standard_name = surface_midlayer_air_temperature_in_longwave_radiation + long_name = surface air temp during lw calculation + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[htrlw] + standard_name = tendency_of_air_temperature_due_to_longwave_heating_on_radiation_time_step + long_name = total sky lw heating rate + units = K s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[topflw] + standard_name = lw_fluxes_top_atmosphere + long_name = lw radiation fluxes at top + units = W m-2 + dimensions = (horizontal_dimension) + type = topflw_type + intent = out + optional = F [flxprf_lw] standard_name = RRTMGP_lw_fluxes long_name = lw fluxes total sky / csk and up / down at levels units = W m-2 dimensions = (horizontal_dimension,vertical_dimension_plus_one) type = proflw_type - intent = inout + intent = out optional = T -[hlw0] - standard_name = tendency_of_air_temperature_due_to_longwave_heating_assuming_clear_sky_on_radiation_time_step_and_radiation_levels +[htrlwc] + standard_name = tendency_of_air_temperature_due_to_longwave_heating_assuming_clear_sky_on_radiation_time_step long_name = longwave clear sky heating rate units = K s-1 dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) type = real kind = kind_phys - intent = inout + intent = out optional = T [errmsg] standard_name = ccpp_error_message diff --git a/physics/GFS_rrtmgp_pre.F90 b/physics/GFS_rrtmgp_pre.F90 index e4110c950..01a56a00f 100644 --- a/physics/GFS_rrtmgp_pre.F90 +++ b/physics/GFS_rrtmgp_pre.F90 @@ -145,7 +145,7 @@ end subroutine GFS_rrtmgp_pre_init !! subroutine GFS_rrtmgp_pre_run(nCol, nLev, nGases, nTracers, i_o3, lsswr, lslwr, fhswr, & fhlwr, xlat, xlon, prsl, tgrs, prslk, prsi, qgrs, tsfc, active_gases_array, & - pcon_eps, pcon_epsm1, pcon_fvirt, acon_qMin, & + con_eps, con_epsm1, con_fvirt, qs_Min, & raddt, p_lay, t_lay, p_lev, t_lev, tsfg, tsfa, tv_lay, relhum, tracer, & gas_concentrations, errmsg, errflg) @@ -165,10 +165,10 @@ subroutine GFS_rrtmgp_pre_run(nCol, nLev, nGases, nTracers, i_o3, lsswr, lslwr, fhswr, & ! Frequency of SW radiation call. fhlwr ! Frequency of LW radiation call. real(kind_phys), intent(in) :: & - pcon_eps, & ! Physical constant: Epsilon (Rd/Rv) - pcon_epsm1, & ! Physical constant: Epsilon (Rd/Rv) minus one - pcon_fvirt, & ! Physical constant: Inverse of epsilon minus one - acon_qMin ! Algorithmic constant: Lower limit for saturation vapor pressure + con_eps, & ! Physical constant: Epsilon (Rd/Rv) + con_epsm1, & ! Physical constant: Epsilon (Rd/Rv) minus one + con_fvirt, & ! Physical constant: Inverse of epsilon minus one + qs_Min ! Algorithmic constant: Lower limit for saturation vapor pressure real(kind_phys), dimension(nCol), intent(in) :: & xlon, & ! Longitude @@ -266,10 +266,10 @@ subroutine GFS_rrtmgp_pre_run(nCol, nLev, nGases, nTracers, i_o3, lsswr, lslwr, do iCol=1,NCOL do iLay=1,nLev es = min( p_lay(iCol,iLay), fpvs( t_lay(iCol,iLay) ) ) ! fpvs and prsl in pa - qs = max( acon_qMin, pcon_eps * es / (p_lay(iCol,iLay) + pcon_epsm1*es) ) - relhum(iCol,iLay) = max( 0._kind_phys, min( 1._kind_phys, max(acon_qMin, q_lay(iCol,iLay))/qs ) ) + qs = max( qs_Min, con_eps * es / (p_lay(iCol,iLay) + con_epsm1*es) ) + relhum(iCol,iLay) = max( 0._kind_phys, min( 1._kind_phys, max(qs_Min, q_lay(iCol,iLay))/qs ) ) qs_lay(iCol,iLay) = qs - tv_lay(iCol,iLay) = t_lay(iCol,iLay) * (1._kind_phys + pcon_fvirt*q_lay(iCol,iLay)) + tv_lay(iCol,iLay) = t_lay(iCol,iLay) * (1._kind_phys + con_fvirt*q_lay(iCol,iLay)) enddo enddo @@ -285,7 +285,7 @@ subroutine GFS_rrtmgp_pre_run(nCol, nLev, nGases, nTracers, i_o3, lsswr, lslwr, if (i_o3 > 0) then do iLay=1,nlev do iCol=1,NCOL - o3_lay(iCol,iLay) = max( acon_qMin, tracer(iCol,iLay,i_o3) ) + o3_lay(iCol,iLay) = max( qs_Min, tracer(iCol,iLay,i_o3) ) enddo enddo ! OR Use climatological ozone data diff --git a/physics/GFS_rrtmgp_pre.meta b/physics/GFS_rrtmgp_pre.meta index 721cff001..b5fcc7879 100644 --- a/physics/GFS_rrtmgp_pre.meta +++ b/physics/GFS_rrtmgp_pre.meta @@ -204,42 +204,42 @@ kind = len=* intent = in optional = F -[pcon_eps] - standard_name = physical_constant_epsilon - long_name = gas constant for air divided by gas constant for h2o +[qs_Min] + standard_name = lower_limit_for_saturation_vapor_pressure + long_name = lower limit allowed when computing saturation vapor pressure units = none dimensions = () type = real kind = kind_phys intent = in - optional = F -[pcon_epsm1] - standard_name = physical_constant_epsilon_minus_one - long_name = gas constant for air divided by gas constant for h2o minus one + optional = F +[con_eps] + standard_name = ratio_of_dry_air_to_water_vapor_gas_constants + long_name = rd/rv units = none dimensions = () type = real - kind = kind_phys + kind = kind_phys intent = in optional = F -[pcon_fvirt] - standard_name = physical_constant_inverse_of_epsilon - long_name = gas constant for h2o divided by gas constant fir air minus one +[con_epsm1] + standard_name = ratio_of_dry_air_to_water_vapor_gas_constants_minus_one + long_name = (rd/rv) - 1 units = none dimensions = () type = real kind = kind_phys intent = in optional = F -[acon_qMin] - standard_name = algorithmic_constant_lower_limit_for_saturation_vapor_pressure - long_name = lower limit allowed when computing saturation vapor pressure +[con_fvirt] + standard_name = ratio_of_vapor_to_dry_air_gas_constants_minus_one + long_name = (rv/rd) - 1 (rv = ideal gas constant for water vapor) units = none dimensions = () type = real - kind = kind_phys + kind = kind_phys intent = in - optional = F + optional = F [raddt] standard_name = time_step_for_radiation long_name = radiation time step diff --git a/physics/GFS_rrtmgp_setup.F90 b/physics/GFS_rrtmgp_setup.F90 index f890b30ee..9b503e3bc 100644 --- a/physics/GFS_rrtmgp_setup.F90 +++ b/physics/GFS_rrtmgp_setup.F90 @@ -8,8 +8,6 @@ module GFS_rrtmgp_setup isubcsw, isubclw, ivflip , ipsd0, iswcliq use machine, only: & kind_phys ! Working type - use GFS_typedefs, only: & - GFS_control_type ! Model control parameters implicit none public GFS_rrtmgp_setup_init, GFS_rrtmgp_setup_run, GFS_rrtmgp_setup_finalize @@ -39,21 +37,28 @@ module GFS_rrtmgp_setup !! \section arg_table_GFS_rrtmgp_setup_init !! \htmlinclude GFS_rrtmgp_setup_init.html !! - subroutine GFS_rrtmgp_setup_init (Model, si, levr, ictm, isol, ico2, & - iaer, ialb, iems, ntcw, num_p3d, ntoz, iovr_sw, iovr_lw, & - isubc_sw, isubc_lw, icliq_sw, crick_proof, ccnorm, imp_physics, & - norad_precip, idate, iflip, me, & - errmsg, errflg) + subroutine GFS_rrtmgp_setup_init(imp_physics, imp_physics_fer_hires, imp_physics_gfdl,& + imp_physics_thompson, imp_physics_wsm6, imp_physics_zhao_carr, & + imp_physics_zhao_carr_pdf, imp_physics_mg, si, levr, ictm, isol, ico2, iaer, & + ialb, iems, ntcw, num_p3d, ntoz, iovr_sw, iovr_lw, isubc_sw, isubc_lw, & + icliq_sw, crick_proof, ccnorm, norad_precip, idate, iflip, me, errmsg, errflg) implicit none ! Inputs - type(GFS_control_type), intent(in) :: & - Model ! DDT containing model control parameters + integer, intent(in) :: & + imp_physics, & ! Flag for MP scheme + imp_physics_fer_hires, & ! Flag for fer-hires scheme + imp_physics_gfdl, & ! Flag for gfdl scheme + imp_physics_thompson, & ! Flag for thompsonscheme + imp_physics_wsm6, & ! Flag for wsm6 scheme + imp_physics_zhao_carr, & ! Flag for zhao-carr scheme + imp_physics_zhao_carr_pdf, & ! Flag for zhao-carr+PDF scheme + imp_physics_mg ! Flag for MG scheme real(kind_phys), dimension(levr+1), intent(in) :: & si integer, intent(in) :: levr, ictm, isol, ico2, iaer, ialb, iems, & ntcw, num_p3d, ntoz, iovr_sw, iovr_lw, isubc_sw, isubc_lw, & - icliq_sw, imp_physics, iflip, me + icliq_sw, iflip, me logical, intent(in) :: & crick_proof, ccnorm, norad_precip integer, intent(in), dimension(4) :: & @@ -121,7 +126,9 @@ subroutine GFS_rrtmgp_setup_init (Model, si, levr, ictm, isol, ico2, & endif - call radinit( Model, si, levr, imp_physics, me, errflg ) + call radinit( si, levr, imp_physics, imp_physics_fer_hires, imp_physics_gfdl, & + imp_physics_thompson, imp_physics_wsm6, imp_physics_zhao_carr, & + imp_physics_zhao_carr_pdf, imp_physics_mg, me, errflg ) if ( me == 0 ) then print *,' Radiation sub-cloud initial seed =',ipsd0, & @@ -197,11 +204,15 @@ end subroutine GFS_rrtmgp_setup_finalize ! Private functions - subroutine radinit( Model, si, NLAY, imp_physics, me, errflg ) + subroutine radinit(si, NLAY, imp_physics, imp_physics_fer_hires, imp_physics_gfdl, & + imp_physics_thompson, imp_physics_wsm6, imp_physics_zhao_carr, & + imp_physics_zhao_carr_pdf, imp_physics_mg, me, errflg ) !................................... ! --- inputs: -! & ( si, NLAY, imp_physics, me ) +! & ( si, NLAY, imp_physics, imp_physics_fer_hires, imp_physics_gfdl, & +! & imp_physics_thompson, imp_physics_wsm6, imp_physics_zhao_carr, & +! & imp_physics_zhao_carr_pdf, imp_physics_mg, me ) ! --- outputs: ! ( errflg ) @@ -319,9 +330,16 @@ subroutine radinit( Model, si, NLAY, imp_physics, me, errflg ) implicit none ! --- inputs: - integer, intent(in) :: NLAY, me, imp_physics - type(GFS_control_type), intent(in) :: & - Model ! DDT containing model control parameters + integer, intent(in) :: & + imp_physics, & ! Flag for MP scheme + imp_physics_fer_hires, & ! Flag for fer-hires scheme + imp_physics_gfdl, & ! Flag for gfdl scheme + imp_physics_thompson, & ! Flag for thompsonscheme + imp_physics_wsm6, & ! Flag for wsm6 scheme + imp_physics_zhao_carr, & ! Flag for zhao-carr scheme + imp_physics_zhao_carr_pdf, & ! Flag for zhao-carr+PDF scheme + imp_physics_mg ! Flag for MG scheme + integer, intent(in) :: NLAY, me real (kind=kind_phys), intent(in) :: si(:) ! --- outputs: (none, to module variables) @@ -412,7 +430,10 @@ subroutine radinit( Model, si, NLAY, imp_physics, me, errflg ) call aer_init ( NLAY, me ) ! --- ... aerosols initialization routine call gas_init ( me ) ! --- ... co2 and other gases initialization routine call sfc_init ( me ) ! --- ... surface initialization routine - call hml_cloud_diagnostics_initialize( Model, NLAY, me, si, errflg) + call hml_cloud_diagnostics_initialize(imp_physics, imp_physics_fer_hires, & + imp_physics_gfdl, imp_physics_thompson, imp_physics_wsm6, & + imp_physics_zhao_carr, imp_physics_zhao_carr_pdf, imp_physics_mg, NLAY, me, si,& + errflg) return !................................... diff --git a/physics/GFS_rrtmgp_setup.meta b/physics/GFS_rrtmgp_setup.meta index 9165117c5..aec1b4374 100644 --- a/physics/GFS_rrtmgp_setup.meta +++ b/physics/GFS_rrtmgp_setup.meta @@ -1,14 +1,70 @@ [ccpp-arg-table] name = GFS_rrtmgp_setup_init type = scheme -[Model] - standard_name = GFS_control_type_instance - long_name = instance of derived type GFS_control_type - units = DDT +[imp_physics] + standard_name = flag_for_microphysics_scheme + long_name = choice of microphysics scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F +[imp_physics_fer_hires] + standard_name = flag_for_fer_hires_microphysics_scheme + long_name = choice of Ferrier-Aligo microphysics scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F +[imp_physics_gfdl] + standard_name = flag_for_gfdl_microphysics_scheme + long_name = choice of GFDL microphysics scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F +[imp_physics_thompson] + standard_name = flag_for_thompson_microphysics_scheme + long_name = choice of Thompson microphysics scheme + units = flag + dimensions = () + type = integer +[imp_physics_wsm6] + intent = in + optional = F + standard_name = flag_for_wsm6_microphysics_scheme + long_name = choice of WSM6 microphysics scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F +[imp_physics_zhao_carr] + standard_name = flag_for_zhao_carr_microphysics_scheme + long_name = choice of Zhao-Carr microphysics scheme + units = flag dimensions = () - type = GFS_control_type + type = integer + intent = in + optional = F +[imp_physics_zhao_carr_pdf] + standard_name = flag_for_zhao_carr_pdf_microphysics_scheme + long_name = choice of Zhao-Carr microphysics scheme with PDF clouds + units = flag + dimensions = () + type = integer intent = in optional = F +[imp_physics_mg] + standard_name = flag_for_morrison_gettelman_microphysics_scheme + long_name = choice of Morrison-Gettelman microphysics scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F [si] standard_name = vertical_sigma_coordinate_for_radiation_initialization long_name = vertical sigma coordinate for radiation initialization @@ -154,14 +210,6 @@ type = logical intent = in optional = F -[imp_physics] - standard_name = flag_for_microphysics_scheme - long_name = choice of microphysics scheme - units = flag - dimensions = () - type = integer - intent = in - optional = F [norad_precip] standard_name = flag_for_precipitation_effect_on_radiation long_name = radiation precip flag for Ferrier/Moorthi diff --git a/physics/GFS_rrtmgp_sw_post.F90 b/physics/GFS_rrtmgp_sw_post.F90 index 56d96a90f..840360429 100644 --- a/physics/GFS_rrtmgp_sw_post.F90 +++ b/physics/GFS_rrtmgp_sw_post.F90 @@ -1,7 +1,5 @@ module GFS_rrtmgp_sw_post use machine, only: kind_phys - use GFS_typedefs, only: GFS_coupling_type, GFS_control_type, GFS_grid_type, & - GFS_radtend_type, GFS_diag_type, GFS_statein_type use module_radiation_aerosols, only: NSPC1 use module_radsw_parameters, only: topfsw_type, sfcfsw_type, profsw_type, cmpfsw_type use mo_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp @@ -26,40 +24,41 @@ end subroutine GFS_rrtmgp_sw_post_init !> \section arg_table_GFS_rrtmgp_sw_post_run !! \htmlinclude GFS_rrtmgp_sw_post_run.html !! - subroutine GFS_rrtmgp_sw_post_run (Model, Grid, Diag, Radtend, Coupling, Statein, scmpsw, & - nCol, p_lev, sfc_alb_nir_dir, sfc_alb_nir_dif, sfc_alb_uvvis_dir, sfc_alb_uvvis_dif, & - sw_gas_props, nday, idxday, fluxswUP_allsky, fluxswDOWN_allsky, fluxswUP_clrsky, & - fluxswDOWN_clrsky, raddt, aerodp, cldsa, mbota, mtopa, cld_frac, cldtausw, flxprf_sw,& - hsw0, errmsg, errflg) + 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, sw_gas_props, fluxswUP_allsky, & + fluxswDOWN_allsky, fluxswUP_clrsky, fluxswDOWN_clrsky, raddt, aerodp, cldsa, mbota, & + mtopa, cld_frac, cldtausw, & + nirbmdi, nirdfdi, visbmdi, visdfdi, nirbmui, nirdfui, visbmui, visdfui, sfcnsw, & + sfcdsw, htrsw, sfcfsw, topfsw, htrswc, flxprf_sw, scmpsw, errmsg, errflg) - ! Inputs - type(GFS_control_type), intent(in) :: & - Model ! Fortran DDT: FV3-GFS model control parameters - type(GFS_grid_type), intent(in) :: & - Grid ! Fortran DDT: FV3-GFS grid and interpolation related data - type(GFS_coupling_type), intent(inout) :: & - Coupling ! Fortran DDT: FV3-GFS fields to/from coupling with other components - type(GFS_radtend_type), intent(inout) :: & - Radtend ! Fortran DDT: FV3-GFS radiation tendencies - type(GFS_diag_type), intent(inout) :: & - Diag ! Fortran DDT: FV3-GFS diagnotics data - type(GFS_statein_type), intent(in) :: & - Statein ! Fortran DDT: FV3-GFS prognostic state data in from dycore + ! Inputs integer, intent(in) :: & nCol, & ! Horizontal loop extent + nLev, & ! Number of vertical layers nDay ! Number of daylit columns integer, intent(in), dimension(nday) :: & idxday ! Index array for daytime points + logical, intent(in) :: & + lsswr, & ! Call SW radiation? + do_sw_clrsky_hr, & ! Output clear-sky SW heating-rate? + save_diag ! Output radiation diagnostics? type(ty_gas_optics_rrtmgp),intent(in) :: & sw_gas_props ! DDT containing SW spectral information - real(kind_phys), dimension(nCol, Model%levs+1), intent(in) :: & - p_lev ! Pressure @ model layer-interfaces (hPa) + 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(sw_gas_props%get_nband(),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, Model%levs+1), intent(in) :: & + 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) @@ -73,95 +72,119 @@ subroutine GFS_rrtmgp_sw_post_run (Model, Grid, Diag, Radtend, Coupling, Statein 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,Model%levs), intent(in) :: & + real(kind_phys), dimension(nCol,nLev), intent(in) :: & cld_frac, & ! Total cloud fraction in each layer - cldtausw ! approx .55mu band layer cloud optical depth + cldtausw ! approx .55mu band layer cloud optical depth + + ! Inputs (optional) + type(cmpfsw_type), dimension(nCol), intent(in), optional :: & + scmpsw ! 2D surface fluxes, components: + ! uvbfc - total sky downward uv-b flux at (W/m2) + ! uvbf0 - clear sky downward uv-b flux at (W/m2) + ! nirbm - downward nir direct beam flux (W/m2) + ! nirdf - downward nir diffused flux (W/m2) + ! visbm - downward uv+vis direct beam flux (W/m2) + ! visdf - downward uv+vis diffused flux (W/m2) ! Outputs (mandatory) + real(kind_phys), dimension(nCol), intent(out) :: & + 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(out) :: & + htrsw ! SW all-sky heating rate + type(sfcfsw_type), dimension(nCol), intent(out) :: & + sfcfsw ! sw radiation fluxes at sfc + type(topfsw_type), dimension(nCol), intent(out) :: & + topfsw ! sw_fluxes_top_atmosphere character(len=*), intent(out) :: & errmsg integer, intent(out) :: & errflg ! Outputs (optional) - type(profsw_type), dimension(nCol, Model%levs+1), intent(inout), optional :: & + type(profsw_type), dimension(nCol, nLev), intent(out), optional :: & flxprf_sw ! 2D radiative fluxes, components: ! upfxc - total sky upward flux (W/m2) ! dnfxc - total sky dnward flux (W/m2) ! upfx0 - clear sky upward flux (W/m2) ! dnfx0 - clear sky dnward flux (W/m2) - type(cmpfsw_type), dimension(nCol), intent(inout), optional :: & - scmpsw ! 2D surface fluxes, components: - ! uvbfc - total sky downward uv-b flux at (W/m2) - ! uvbf0 - clear sky downward uv-b flux at (W/m2) - ! 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_phys),dimension(nCol, Model%levs),intent(inout),optional :: & - hsw0 ! Clear-sky heating rate (K/s) - + real(kind_phys),dimension(nCol, nLev),intent(out),optional :: & + htrswc ! Clear-sky heating rate (K/s) + ! Local variables integer :: i, j, k, iSFC, iTOA, itop, ibtc real(kind_phys) :: tem0d, tem1, tem2 - real(kind_phys), dimension(nDay, Model%levs) :: thetaTendClrSky, thetaTendAllSky - logical :: l_fluxessw2d, top_at_1 - real(kind_phys),dimension(nCol, Model%levs) :: hswc + real(kind_phys), dimension(nDay, nLev) :: thetaTendClrSky, thetaTendAllSky + logical :: l_fluxessw2d, top_at_1, l_scmpsw ! Initialize CCPP error handling variables errmsg = '' errflg = 0 - if (.not. Model%lsswr) return + if (.not. lsswr) return if (nDay .gt. 0) then ! Are any optional outputs requested? - l_fluxessw2d = present(flxprf_sw) + l_fluxessw2d = present(flxprf_sw) + + ! Are the components of the surface fluxes provided? + l_scmpsw = present(scmpsw) ! ####################################################################################### ! What is vertical ordering? ! ####################################################################################### - top_at_1 = (p_lev(1,1) .lt. p_lev(1, Model%levs)) + top_at_1 = (p_lev(1,1) .lt. p_lev(1, nLev)) if (top_at_1) then - iSFC = Model%levs+1 + iSFC = nLev+1 iTOA = 1 else iSFC = 1 - iTOA = Model%levs+1 + iTOA = nLev+1 endif ! ####################################################################################### ! Compute SW heating-rates ! ####################################################################################### ! Clear-sky heating-rate (optional) - if (Model%swhtr) then - hsw0(:,:) = 0._kind_phys + 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) - hsw0(idxday(1:nDay),:)=thetaTendClrSky + 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) - hswc(:,:) = 0._kind_phys + 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) - hswc(idxday(1:nDay),:) = thetaTendAllSky + htrsw(idxday(1:nDay),:) = thetaTendAllSky + ! ####################################################################################### + ! Save SW outputs + ! ####################################################################################### ! Copy fluxes from RRTGMP types into model radiation types. ! Mandatory outputs - Diag%topfsw(:)%upfxc = fluxswUP_allsky(:,iTOA) - Diag%topfsw(:)%upfx0 = fluxswUP_clrsky(:,iTOA) - Diag%topfsw(:)%dnfxc = fluxswDOWN_allsky(:,iTOA) - Radtend%sfcfsw(:)%upfxc = fluxswUP_allsky(:,iSFC) - Radtend%sfcfsw(:)%upfx0 = fluxswUP_clrsky(:,iSFC) - Radtend%sfcfsw(:)%dnfxc = fluxswDOWN_allsky(:,iSFC) - Radtend%sfcfsw(:)%dnfx0 = fluxswDOWN_clrsky(:,iSFC) + topfsw(:)%upfxc = fluxswUP_allsky(:,iTOA) + topfsw(:)%upfx0 = fluxswUP_clrsky(:,iTOA) + topfsw(:)%dnfxc = fluxswDOWN_allsky(:,iTOA) + sfcfsw(:)%upfxc = fluxswUP_allsky(:,iSFC) + sfcfsw(:)%upfx0 = fluxswUP_clrsky(:,iSFC) + sfcfsw(:)%dnfxc = fluxswDOWN_allsky(:,iSFC) + sfcfsw(:)%dnfx0 = fluxswDOWN_clrsky(:,iSFC) ! Optional output if(l_fluxessw2D) then @@ -171,63 +194,54 @@ subroutine GFS_rrtmgp_sw_post_run (Model, Grid, Diag, Radtend, Coupling, Statein flxprf_sw(:,:)%dnfx0 = fluxswDOWN_clrsky(:,:) endif - ! ####################################################################################### - ! Save SW outputs - ! ####################################################################################### - ! All-sky heating rate - do k = 1, Model%levs - Radtend%htrsw(1:nCol,k) = hswc(1:nCol,k) - enddo - ! Clear-sky heating rate - if (Model%swhtr) then - do k = 1, Model%levs - Radtend%swhc(1:nCol,k) = hsw0(1:nCol,k) - enddo - endif - ! Surface down and up spectral component fluxes ! - Save two spectral bands' surface downward and upward fluxes for output. - do i=1,nCol - Coupling%nirbmdi(i) = scmpsw(i)%nirbm - Coupling%nirdfdi(i) = scmpsw(i)%nirdf - Coupling%visbmdi(i) = scmpsw(i)%visbm - Coupling%visdfdi(i) = scmpsw(i)%visdf - - Coupling%nirbmui(i) = scmpsw(i)%nirbm * sfc_alb_nir_dir(1,i) - Coupling%nirdfui(i) = scmpsw(i)%nirdf * sfc_alb_nir_dif(1,i) - Coupling%visbmui(i) = scmpsw(i)%visbm * sfc_alb_uvvis_dir(1,i) - Coupling%visdfui(i) = scmpsw(i)%visdf * sfc_alb_uvvis_dif(1,i) - enddo + if (l_scmpsw) then + 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(1,i) + nirdfui(i) = scmpsw(i)%nirdf * sfc_alb_nir_dif(1,i) + visbmui(i) = scmpsw(i)%visbm * sfc_alb_uvvis_dir(1,i) + visdfui(i) = scmpsw(i)%visdf * sfc_alb_uvvis_dif(1,i) + enddo + else + nirbmdi(:) = 0.0 + nirdfdi(:) = 0.0 + visbmdi(:) = 0.0 + visdfdi(:) = 0.0 + nirbmui(:) = 0.0 + nirdfui(:) = 0.0 + visbmui(:) = 0.0 + visdfui(:) = 0.0 + endif else ! if_nday_block ! ####################################################################################### - ! Save SW outputs + ! Dark everywhere ! ####################################################################################### - Radtend%htrsw(:,:) = 0.0 - Radtend%sfcfsw = sfcfsw_type( 0.0, 0.0, 0.0, 0.0 ) - Diag%topfsw = topfsw_type( 0.0, 0.0, 0.0 ) - scmpsw = cmpfsw_type( 0.0, 0.0, 0.0, 0.0, 0.0, 0.0 ) + htrsw(:,:) = 0.0 + sfcfsw = sfcfsw_type( 0.0, 0.0, 0.0, 0.0 ) + topfsw = topfsw_type( 0.0, 0.0, 0.0 ) + nirbmdi(:) = 0.0 + nirdfdi(:) = 0.0 + visbmdi(:) = 0.0 + visdfdi(:) = 0.0 + nirbmui(:) = 0.0 + nirdfui(:) = 0.0 + visbmui(:) = 0.0 + visdfui(:) = 0.0 - do i=1,nCol - Coupling%nirbmdi(i) = 0.0 - Coupling%nirdfdi(i) = 0.0 - Coupling%visbmdi(i) = 0.0 - Coupling%visdfdi(i) = 0.0 - - Coupling%nirbmui(i) = 0.0 - Coupling%nirdfui(i) = 0.0 - Coupling%visbmui(i) = 0.0 - Coupling%visdfui(i) = 0.0 - enddo - - if (Model%swhtr) then - Radtend%swhc(:,:) = 0 + if (do_sw_clrsky_hr) then + htrswc(:,:) = 0 endif endif ! end_if_nday ! Radiation fluxes for other physics processes do i=1,nCol - Coupling%sfcnsw(i) = Radtend%sfcfsw(i)%dnfxc - Radtend%sfcfsw(i)%upfxc - Coupling%sfcdsw(i) = Radtend%sfcfsw(i)%dnfxc + sfcnsw(i) = sfcfsw(i)%dnfxc - sfcfsw(i)%upfxc + sfcdsw(i) = sfcfsw(i)%dnfxc enddo ! ####################################################################################### @@ -238,63 +252,63 @@ subroutine GFS_rrtmgp_sw_post_run (Model, Grid, Diag, Radtend, Coupling, Statein ! corresponding slots of array fluxr with appropriate time weights. ! - Collect the fluxr data for wrtsfc ! ####################################################################################### - if (Model%lssav) then - do i=1,nCol - Diag%fluxr(i,34) = Diag%fluxr(i,34) + Model%fhswr*aerodp(i,1) ! total aod at 550nm - Diag%fluxr(i,35) = Diag%fluxr(i,35) + Model%fhswr*aerodp(i,2) ! DU aod at 550nm - Diag%fluxr(i,36) = Diag%fluxr(i,36) + Model%fhswr*aerodp(i,3) ! BC aod at 550nm - Diag%fluxr(i,37) = Diag%fluxr(i,37) + Model%fhswr*aerodp(i,4) ! OC aod at 550nm - Diag%fluxr(i,38) = Diag%fluxr(i,38) + Model%fhswr*aerodp(i,5) ! SU aod at 550nm - Diag%fluxr(i,39) = Diag%fluxr(i,39) + Model%fhswr*aerodp(i,6) ! SS aod at 550nm - if (Radtend%coszen(i) > 0.) then - ! SW all-sky fluxes - tem0d = Model%fhswr * Radtend%coszdg(i) / Radtend%coszen(i) - Diag%fluxr(i,2 ) = Diag%fluxr(i,2) + Diag%topfsw(i)%upfxc * tem0d ! total sky top sw up - Diag%fluxr(i,3 ) = Diag%fluxr(i,3) + Radtend%sfcfsw(i)%upfxc * tem0d - Diag%fluxr(i,4 ) = Diag%fluxr(i,4) + Radtend%sfcfsw(i)%dnfxc * tem0d ! total sky sfc sw dn - ! SW uv-b fluxes - Diag%fluxr(i,21) = Diag%fluxr(i,21) + scmpsw(i)%uvbfc * tem0d ! total sky uv-b sw dn - Diag%fluxr(i,22) = Diag%fluxr(i,22) + scmpsw(i)%uvbf0 * tem0d ! clear sky uv-b sw dn - ! SW TOA incoming fluxes - Diag%fluxr(i,23) = Diag%fluxr(i,23) + Diag%topfsw(i)%dnfxc * tem0d ! top sw dn - ! SW SFC flux components - Diag%fluxr(i,24) = Diag%fluxr(i,24) + scmpsw(i)%visbm * tem0d ! uv/vis beam sw dn - Diag%fluxr(i,25) = Diag%fluxr(i,25) + scmpsw(i)%visdf * tem0d ! uv/vis diff sw dn - Diag%fluxr(i,26) = Diag%fluxr(i,26) + scmpsw(i)%nirbm * tem0d ! nir beam sw dn - Diag%fluxr(i,27) = Diag%fluxr(i,27) + scmpsw(i)%nirdf * tem0d ! nir diff sw dn - ! SW clear-sky fluxes - Diag%fluxr(i,29) = Diag%fluxr(i,29) + Diag%topfsw(i)%upfx0 * tem0d - Diag%fluxr(i,31) = Diag%fluxr(i,31) + Radtend%sfcfsw(i)%upfx0 * tem0d - Diag%fluxr(i,32) = Diag%fluxr(i,32) + Radtend%sfcfsw(i)%dnfx0 * tem0d - endif - enddo - - ! Save total and boundary-layer clouds - do i=1,nCol - Diag%fluxr(i,17) = Diag%fluxr(i,17) + raddt * cldsa(i,4) - Diag%fluxr(i,18) = Diag%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) - Diag%fluxr(i, 8-j) = Diag%fluxr(i, 8-j) + tem0d - Diag%fluxr(i,11-j) = Diag%fluxr(i,11-j) + tem0d * Statein%prsi(i,itop) - Diag%fluxr(i,14-j) = Diag%fluxr(i,14-j) + tem0d * Statein%prsi(i,ibtc) - Diag%fluxr(i,17-j) = Diag%fluxr(i,17-j) + tem0d * Statein%tgrs(i,itop) - - ! Add optical depth and emissivity output - tem1 = 0. - do k=ibtc,itop - tem1 = tem1 + cldtausw(i,k) ! approx .55 mu channel - enddo - Diag%fluxr(i,43-j) = Diag%fluxr(i,43-j) + tem0d * tem1 - enddo - enddo + if (save_diag) then +! do i=1,nCol +! Diag%fluxr(i,34) = Diag%fluxr(i,34) + fhswr*aerodp(i,1) ! total aod at 550nm +! Diag%fluxr(i,35) = Diag%fluxr(i,35) + fhswr*aerodp(i,2) ! DU aod at 550nm +! Diag%fluxr(i,36) = Diag%fluxr(i,36) + fhswr*aerodp(i,3) ! BC aod at 550nm +! Diag%fluxr(i,37) = Diag%fluxr(i,37) + fhswr*aerodp(i,4) ! OC aod at 550nm +! Diag%fluxr(i,38) = Diag%fluxr(i,38) + fhswr*aerodp(i,5) ! SU aod at 550nm +! Diag%fluxr(i,39) = Diag%fluxr(i,39) + fhswr*aerodp(i,6) ! SS aod at 550nm +! if (coszen(i) > 0.) then +! ! SW all-sky fluxes +! tem0d = fhswr * coszdg(i) / coszen(i) +! Diag%fluxr(i,2 ) = Diag%fluxr(i,2) + topfsw(i)%upfxc * tem0d ! total sky top sw up +! Diag%fluxr(i,3 ) = Diag%fluxr(i,3) + sfcfsw(i)%upfxc * tem0d +! Diag%fluxr(i,4 ) = Diag%fluxr(i,4) + sfcfsw(i)%dnfxc * tem0d ! total sky sfc sw dn +! ! SW uv-b fluxes +! Diag%fluxr(i,21) = Diag%fluxr(i,21) + scmpsw(i)%uvbfc * tem0d ! total sky uv-b sw dn +! Diag%fluxr(i,22) = Diag%fluxr(i,22) + scmpsw(i)%uvbf0 * tem0d ! clear sky uv-b sw dn +! ! SW TOA incoming fluxes +! Diag%fluxr(i,23) = Diag%fluxr(i,23) + topfsw(i)%dnfxc * tem0d ! top sw dn +! ! SW SFC flux components +! Diag%fluxr(i,24) = Diag%fluxr(i,24) + visbmdi(i) * tem0d ! uv/vis beam sw dn +! Diag%fluxr(i,25) = Diag%fluxr(i,25) + visdfdi(i) * tem0d ! uv/vis diff sw dn +! Diag%fluxr(i,26) = Diag%fluxr(i,26) + nirbmdi(i) * tem0d ! nir beam sw dn +! Diag%fluxr(i,27) = Diag%fluxr(i,27) + nirdfdi(i) * tem0d ! nir diff sw dn +! ! SW clear-sky fluxes +! Diag%fluxr(i,29) = Diag%fluxr(i,29) + topfsw(i)%upfx0 * tem0d +! Diag%fluxr(i,31) = Diag%fluxr(i,31) + sfcfsw(i)%upfx0 * tem0d +! Diag%fluxr(i,32) = Diag%fluxr(i,32) + sfcfsw(i)%dnfx0 * tem0d +! endif +! enddo +! +! ! Save total and boundary-layer clouds +! do i=1,nCol +! Diag%fluxr(i,17) = Diag%fluxr(i,17) + raddt * cldsa(i,4) +! Diag%fluxr(i,18) = Diag%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) +! Diag%fluxr(i, 8-j) = Diag%fluxr(i, 8-j) + tem0d +! Diag%fluxr(i,11-j) = Diag%fluxr(i,11-j) + tem0d * p_lev(i,itop) +! Diag%fluxr(i,14-j) = Diag%fluxr(i,14-j) + tem0d * p_lev(i,ibtc) +! Diag%fluxr(i,17-j) = Diag%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 +! Diag%fluxr(i,43-j) = Diag%fluxr(i,43-j) + tem0d * tem1 +! enddo +! enddo endif end subroutine GFS_rrtmgp_sw_post_run diff --git a/physics/GFS_rrtmgp_sw_post.meta b/physics/GFS_rrtmgp_sw_post.meta index ce27d0096..94f2cbf5f 100644 --- a/physics/GFS_rrtmgp_sw_post.meta +++ b/physics/GFS_rrtmgp_sw_post.meta @@ -1,68 +1,96 @@ [ccpp-arg-table] name = GFS_rrtmgp_sw_post_run type = scheme -[Model] - standard_name = GFS_control_type_instance - long_name = instance of derived type GFS_control_type - units = DDT +[ncol] + standard_name = horizontal_loop_extent + long_name = horizontal loop extent + units = count dimensions = () - type = GFS_control_type + type = integer intent = in optional = F -[Grid] - standard_name = GFS_grid_type_instance - long_name = instance of derived type GFS_grid_type - units = DDT +[nLev] + standard_name = vertical_dimension + long_name = number of vertical levels + units = count dimensions = () - type = GFS_grid_type + type = integer intent = in - optional = F -[Diag] - standard_name = GFS_diag_type_instance - long_name = instance of derived type GFS_diag_type - units = DDT + optional = F +[nday] + standard_name = daytime_points_dimension + long_name = daytime points dimension + units = count dimensions = () - type = GFS_diag_type - intent = inout + type = integer + intent = in optional = F -[Radtend] - standard_name = GFS_radtend_type_instance - long_name = instance of derived type GFS_radtend_type - units = DDT - dimensions = () - type = GFS_radtend_type - intent = inout +[idxday] + standard_name = daytime_points + long_name = daytime points + units = index + dimensions = (horizontal_dimension) + type = integer + intent = in optional = F -[Coupling] - standard_name = GFS_coupling_type_instance - long_name = instance of derived type GFS_coupling_type - units = DDT +[lsswr] + standard_name = flag_to_calc_sw + long_name = logical flags for sw radiation calls + units = flag dimensions = () - type = GFS_coupling_type - intent = inout + type = logical + intent = in optional = F -[Statein] - standard_name = GFS_statein_type_instance - long_name = instance of derived type GFS_statein_type - units = DDT +[do_sw_clrsky_hr] + standard_name = flag_for_output_of_shortwave_heating_rate + long_name = flag to output sw heating rate + units = flag dimensions = () - type = GFS_statein_type + type = logical intent = in - optional = F -[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_dimension) - type = cmpfsw_type - intent = inout - optional = T -[ncol] - standard_name = horizontal_loop_extent - long_name = horizontal loop extent - units = count + optional = F +[save_diag] + standard_name = flag_diagnostics + long_name = logical flag for storing diagnostics + units = flag dimensions = () - type = integer + type = logical + intent = in + optional = F +[fhswr] + standard_name = frequency_for_shortwave_radiation + long_name = frequency for shortwave radiation + units = s + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[coszen] + standard_name = cosine_of_zenith_angle + long_name = mean cos of zenith angle over rad call period + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[coszdg] + standard_name = daytime_mean_cosz_over_rad_call_period + long_name = daytime mean cosz over rad call period + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[t_lay] + standard_name = air_temperature_at_layer_for_RRTMGP + long_name = air temperature at vertical layer for radiation calculation + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys intent = in optional = F [p_lev] @@ -110,22 +138,6 @@ kind = kind_phys intent = in optional = F -[nday] - standard_name = daytime_points_dimension - long_name = daytime points dimension - units = count - dimensions = () - type = integer - intent = in - optional = F -[idxday] - standard_name = daytime_points - long_name = daytime points - units = index - dimensions = (horizontal_dimension) - type = integer - intent = in - optional = F [fluxswUP_allsky] standard_name = RRTMGP_sw_flux_profile_upward_allsky long_name = RRTMGP upward shortwave all-sky flux profile @@ -231,23 +243,146 @@ type = ty_gas_optics_rrtmgp intent = in optional = F +[nirbmdi] + standard_name = surface_downwelling_direct_near_infrared_shortwave_flux_on_radiation_time_step + long_name = sfc nir beam sw downward flux + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[nirdfdi] + standard_name = surface_downwelling_diffuse_near_infrared_shortwave_flux_on_radiation_time_step + long_name = sfc nir diff sw downward flux + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[visbmdi] + standard_name = surface_downwelling_direct_ultraviolet_and_visible_shortwave_flux_on_radiation_time_step + long_name = sfc uv+vis beam sw downward flux + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[visdfdi] + standard_name = surface_downwelling_diffuse_ultraviolet_and_visible_shortwave_flux_on_radiation_time_step + long_name = sfc uv+vis diff sw downward flux + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[nirbmui] + standard_name = surface_upwelling_direct_near_infrared_shortwave_flux_on_radiation_time_step + long_name = sfc nir beam sw upward flux + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[nirdfui] + standard_name = surface_upwelling_diffuse_near_infrared_shortwave_flux_on_radiation_time_step + long_name = sfc nir diff sw upward flux + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[visbmui] + standard_name = surface_upwelling_direct_ultraviolet_and_visible_shortwave_flux_on_radiation_time_step + long_name = sfc uv+vis beam sw upward flux + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[visdfui] + standard_name = surface_upwelling_diffuse_ultraviolet_and_visible_shortwave_flux_on_radiation_time_step + long_name = sfc uv+vis diff sw upward flux + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[sfcnsw] + standard_name = surface_net_downwelling_shortwave_flux_on_radiation_time_step + long_name = total sky sfc netsw flx into ground + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[sfcdsw] + standard_name = surface_downwelling_shortwave_flux_on_radiation_time_step + long_name = total sky sfc downward sw flux + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[sfcfsw] + standard_name = sw_fluxes_sfc + long_name = sw radiation fluxes at sfc + units = W m-2 + dimensions = (horizontal_dimension) + type = sfcfsw_type + intent = out + optional = F +[htrsw] + standard_name = tendency_of_air_temperature_due_to_shortwave_heating_on_radiation_time_step + long_name = total sky sw heating rate + units = K s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[topfsw] + standard_name = sw_fluxes_top_atmosphere + long_name = sw radiation fluxes at toa + units = W m-2 + dimensions = (horizontal_dimension) + type = topfsw_type + intent = out + optional = F +[htrswc] + standard_name = tendency_of_air_temperature_due_to_shortwave_heating_assuming_clear_sky_on_radiation_time_step + long_name = clear sky sw heating rates + units = K s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = T +[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_dimension) + type = cmpfsw_type + intent = in + optional = T [flxprf_sw] standard_name = RRTMGP_sw_fluxes long_name = sw fluxes total sky / csk and up / down at levels units = W m-2 dimensions = (horizontal_dimension,adjusted_vertical_level_dimension_plus_one) type = profsw_type - intent = inout - optional = T -[hsw0] - standard_name = tendency_of_air_temperature_due_to_shortwave_heating_assuming_clear_sky_on_radiation_time_step_and_radiation_levels - long_name = shortwave clear sky heating rate - units = K s-1 - dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) - type = real - kind = kind_phys - intent = inout - optional = T + intent = out + optional = T [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 index c9b5a1b87..c4208d872 100644 --- a/physics/GFS_rrtmgp_sw_pre.F90 +++ b/physics/GFS_rrtmgp_sw_pre.F90 @@ -2,14 +2,6 @@ module GFS_rrtmgp_sw_pre use physparam use machine, only: & kind_phys ! Working type - use GFS_typedefs, only: & - GFS_sfcprop_type, & ! Surface fields - GFS_control_type, & ! Model control parameters - GFS_grid_type, & ! Grid and interpolation related data - GFS_coupling_type, & ! - GFS_statein_type, & ! - GFS_radtend_type, & ! Radiation tendencies needed in physics - GFS_interstitial_type use module_radiation_astronomy,only: & coszmn ! Function to compute cos(SZA) use module_radiation_surface, only: & @@ -35,27 +27,52 @@ end subroutine GFS_rrtmgp_sw_pre_init !> \section arg_table_GFS_rrtmgp_sw_pre_run !! \htmlinclude GFS_rrtmgp_sw_pre.html !! - subroutine GFS_rrtmgp_sw_pre_run(Model, Grid, Sfcprop, Statein, ncol, p_lay, p_lev, & - tv_lay, relhum, sw_gas_props, nday, idxday, alb1d, sfc_alb_nir_dir, & - sfc_alb_nir_dif, sfc_alb_uvvis_dir, sfc_alb_uvvis_dif, RadTend, Coupling, & - errmsg, errflg) + subroutine GFS_rrtmgp_sw_pre_run(me, nCol, nLev, nsfcpert, lsswr, do_sfcperts, solhr, & + pertalb, lon, coslat, sinlat, snowd, sncovr, snoalb, zorl, tsfc, hprime, alvsf, & + alnsf, alvwf, alnwf, facsf, facwf, fice, tisfc, lsmask, sfc_wts, p_lay, tv_lay, & + relhum, p_lev, sw_gas_props, & + nday, idxday, alb1d, coszen, coszdg, sfc_alb_nir_dir, sfc_alb_nir_dif, & + sfc_alb_uvvis_dir, sfc_alb_uvvis_dif, sfc_alb_dif, errmsg, errflg) - ! Inputs - type(GFS_control_type), intent(in) :: & - Model ! DDT: FV3-GFS model control parameters - type(GFS_grid_type), intent(in) :: & - Grid ! DDT: FV3-GFS grid and interpolation related data - type(GFS_sfcprop_type), intent(in) :: & - Sfcprop ! DDT: FV3-GFS surface fields - type(GFS_statein_type), intent(in) :: & - Statein ! DDT: FV3-GFS prognostic state data in from dycore + ! Inputs integer, intent(in) :: & - ncol ! Number of horizontal grid points - real(kind_phys), dimension(ncol,Model%levs),intent(in) :: & + me, & ! Current MPI rank + nCol, & ! Number of horizontal grid points + nLev, & ! Number of vertical layers + nsfcpert ! Number of surface perturbations + logical,intent(in) :: & + lsswr, & ! Call RRTMGP SW radiation? + do_sfcperts + real(kind_phys), intent(in) :: & + solhr ! Time in hours after 00z at the current timestep + real(kind_phys), dimension(5), intent(in) :: & + pertalb ! Magnitude of surface albedo perturbation (frac) + real(kind_phys), dimension(nCol), intent(in) :: & + lsmask, & ! Landmask: sea/land/ice=0/1/2 + lon, & ! Longitude + coslat, & ! Cosine(latitude) + sinlat, & ! Sine(latitude) + snowd, & ! Water equivalent snow depth (mm) + sncovr, & ! Surface snow area fraction (frac) + snoalb, & ! Maximum snow albedo (frac) + zorl, & ! Surface roughness length (cm) + tsfc, & ! Surface skin temperature (K) + hprime, & ! Standard deviation of subgrid orography (m) + alvsf, & ! Mean vis albedo with strong cosz dependency (frac) + alnsf, & ! Mean nir albedo with strong cosz dependency (frac) + alvwf, & ! Mean vis albedo with weak cosz dependency (frac) + alnwf, & ! Mean nir albedo with weak cosz dependency (frac) + facsf, & ! Fractional coverage with strong cosz dependency (frac) + facwf, & ! Fractional coverage with weak cosz dependency (frac) + fice, & ! Ice fraction over open water (frac) + tisfc ! Sea ice surface skin temperature (K) + real(kind_phys), dimension(nCol,nsfcpert), intent(in) :: & + sfc_wts ! Weights for stochastic surface physics perturbation () + real(kind_phys), dimension(nCol,nLev),intent(in) :: & p_lay, & ! Layer pressure tv_lay, & ! Layer virtual-temperature relhum ! Layer relative-humidity - real(kind_phys), dimension(ncol,Model%levs+1),intent(in) :: & + real(kind_phys), dimension(nCol,nLev+1),intent(in) :: & p_lev ! Pressure @ layer interfaces (Pa) type(ty_gas_optics_rrtmgp),intent(in) :: & sw_gas_props ! RRTMGP DDT: spectral information for SW calculation @@ -66,16 +83,15 @@ subroutine GFS_rrtmgp_sw_pre_run(Model, Grid, Sfcprop, Statein, ncol, p_lay, p_ integer, dimension(ncol), intent(out) :: & idxday ! Indices for daylit points real(kind_phys), dimension(ncol), intent(out) :: & - alb1d ! Surface albedo pertubation + alb1d, & ! Surface albedo pertubation + coszen, & ! Cosine of SZA + coszdg, & ! Cosine of SZA, daytime + sfc_alb_dif ! Mean surface diffused (nIR+uvvis) sw albedo real(kind_phys), dimension(sw_gas_props%get_nband(),ncol), intent(out) :: & sfc_alb_nir_dir, & ! Surface albedo (direct) sfc_alb_nir_dif, & ! Surface albedo (diffuse) sfc_alb_uvvis_dir, & ! Surface albedo (direct) sfc_alb_uvvis_dif ! Surface albedo (diffuse) - type(GFS_radtend_type), intent(inout) :: & - Radtend ! DDT: FV3-GFS radiation tendencies - type(GFS_coupling_type), intent(inout) :: & - Coupling ! DDT: FV3-GFS coupling arrays character(len=*), intent(out) :: & errmsg ! Error message integer, intent(out) :: & @@ -89,13 +105,12 @@ subroutine GFS_rrtmgp_sw_pre_run(Model, Grid, Sfcprop, Statein, ncol, p_lay, p_ errmsg = '' errflg = 0 - if (.not. Model%lsswr) return + if (.not. lsswr) return ! ####################################################################################### ! Compute cosine of zenith angle (only when SW is called) ! ####################################################################################### - call coszmn (Grid%xlon, Grid%sinlat, Grid%coslat, Model%solhr, NCOL, Model%me, & - Radtend%coszen, Radtend%coszdg) + call coszmn (lon, sinlat, coslat, solhr, nCol, me, coszen, coszdg) ! ####################################################################################### ! For SW gather daylit points @@ -103,7 +118,7 @@ subroutine GFS_rrtmgp_sw_pre_run(Model, Grid, Sfcprop, Statein, ncol, p_lay, p_ nday = 0 idxday = 0 do i = 1, NCOL - if (Radtend%coszen(i) >= 0.0001) then + if (coszen(i) >= 0.0001) then nday = nday + 1 idxday(nday) = i endif @@ -115,10 +130,10 @@ subroutine GFS_rrtmgp_sw_pre_run(Model, Grid, Sfcprop, Statein, ncol, p_lay, p_ ! --- turn vegetation fraction pattern into percentile pattern ! ####################################################################################### alb1d(:) = 0. - if (Model%do_sfcperts) then - if (Model%pertalb(1) > 0.) then + if (do_sfcperts) then + if (pertalb(1) > 0.) then do i=1,ncol - call cdfnor(Coupling%sfc_wts(i,5),alb1d(i)) + call cdfnor(sfc_wts(i,5),alb1d(i)) enddo endif endif @@ -126,13 +141,11 @@ subroutine GFS_rrtmgp_sw_pre_run(Model, Grid, Sfcprop, Statein, ncol, p_lay, p_ ! ####################################################################################### ! Call module_radiation_surface::setalb() to setup surface albedo. ! ####################################################################################### - call setalb (Sfcprop%slmsk, Sfcprop%snowd, Sfcprop%sncovr, Sfcprop%snoalb, Sfcprop%zorl, & - Radtend%coszen, Sfcprop%tsfc, Sfcprop%tsfc, Sfcprop%hprime(:,1), Sfcprop%alvsf, & - Sfcprop%alnsf, Sfcprop%alvwf, Sfcprop%alnwf, Sfcprop%facsf, Sfcprop%facwf, & - Sfcprop%fice, Sfcprop%tisfc, NCOL, alb1d, Model%pertalb, sfcalb) + call setalb (lsmask, snowd, sncovr, snoalb, zorl, coszen, tsfc, tsfc, hprime, alvsf, & + alnsf, alvwf, alnwf, facsf, facwf, fice, tisfc, NCOL, alb1d, pertalb, sfcalb) ! Approximate mean surface albedo from vis- and nir- diffuse values. - Radtend%sfalb(:) = max(0.01, 0.5 * (sfcalb(:,2) + sfcalb(:,4))) + sfc_alb_dif(:) = max(0.01, 0.5 * (sfcalb(:,2) + sfcalb(:,4))) ! Spread across all SW bands do iBand=1,sw_gas_props%get_nband() diff --git a/physics/GFS_rrtmgp_sw_pre.meta b/physics/GFS_rrtmgp_sw_pre.meta index 40949834c..1cccf6ffd 100644 --- a/physics/GFS_rrtmgp_sw_pre.meta +++ b/physics/GFS_rrtmgp_sw_pre.meta @@ -1,60 +1,241 @@ [ccpp-arg-table] name = GFS_rrtmgp_sw_pre_run type = scheme -[Model] - standard_name = GFS_control_type_instance - long_name = instance of derived type GFS_control_type - units = DDT +[me] + standard_name = mpi_rank + long_name = current MPI-rank + units = index dimensions = () - type = GFS_control_type + type = integer intent = in optional = F -[Grid] - standard_name = GFS_grid_type_instance - long_name = instance of derived type GFS_grid_type - units = DDT +[ncol] + standard_name = horizontal_loop_extent + long_name = horizontal loop extent + units = count dimensions = () - type = GFS_grid_type + type = integer intent = in optional = F -[Sfcprop] - standard_name = GFS_sfcprop_type_instance - long_name = instance of derived type GFS_sfcprop_type - units = DDT +[nLev] + standard_name = vertical_dimension + long_name = number of vertical levels + units = count dimensions = () - type = GFS_sfcprop_type + type = integer intent = in - optional = F -[Statein] - standard_name = GFS_statein_type_instance - long_name = instance of derived type GFS_statein_type - units = DDT + optional = F +[nsfcpert] + standard_name = number_of_surface_perturbations + long_name = number of surface perturbations + units = count dimensions = () - type = GFS_statein_type + type = integer intent = in - optional = F -[Radtend] - standard_name = GFS_radtend_type_instance - long_name = instance of derived type GFS_radtend_type - units = DDT + optional = F +[lsswr] + standard_name = flag_to_calc_sw + long_name = logical flags for sw radiation calls + units = flag dimensions = () - type = GFS_radtend_type - intent = inout + type = logical + intent = in optional = F -[Coupling] - standard_name = GFS_coupling_type_instance - long_name = Fortran DDT containing FV3-GFS fields to/from coupling with other components - units = DDT +[do_sfcperts] + standard_name = flag_for_stochastic_surface_perturbations + long_name = flag for stochastic surface perturbations option + units = flag dimensions = () - type = GFS_coupling_type - intent = inout + type = logical + intent = in optional = F -[ncol] - standard_name = horizontal_loop_extent - long_name = horizontal loop extent - units = count +[solhr] + standard_name = forecast_hour_of_the_day + long_name = time in hours after 00z at the current timestep + units = h dimensions = () - type = integer + type = real + kind = kind_phys + intent = in + optional = F +[pertalb] + standard_name = magnitude_of_surface_albedo_perturbation + long_name = magnitude of surface albedo perturbation + units = frac + dimensions = (5) + type = real + kind = kind_phys + intent = in + optional = F +[lon] + standard_name = longitude + long_name = longitude + units = radian + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[coslat] + standard_name = cosine_of_latitude + long_name = cosine of latitude + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[sinlat] + standard_name = sine_of_latitude + long_name = sine of latitude + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[lsmask] + standard_name = sea_land_ice_mask_real + long_name = landmask: sea/land/ice=0/1/2 + units = flag + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[snowd] + standard_name = surface_snow_thickness_water_equivalent + long_name = water equivalent snow depth + units = mm + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[sncovr] + standard_name = surface_snow_area_fraction_over_land + long_name = surface snow area fraction + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[snoalb] + standard_name = upper_bound_on_max_albedo_over_deep_snow + long_name = maximum snow albedo + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[zorl] + standard_name = surface_roughness_length + long_name = surface roughness length + units = cm + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[tsfc] + standard_name = surface_skin_temperature + long_name = surface skin temperature + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[hprime] + standard_name = standard_deviation_of_subgrid_orography + long_name = standard deviation of subgrid orography + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[alvsf] + standard_name = mean_vis_albedo_with_strong_cosz_dependency + long_name = mean vis albedo with strong cosz dependency + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[alnsf] + standard_name = mean_nir_albedo_with_strong_cosz_dependency + long_name = mean nir albedo with strong cosz dependency + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[alvwf] + standard_name = mean_vis_albedo_with_weak_cosz_dependency + long_name = mean vis albedo with weak cosz dependency + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[alnwf] + standard_name = mean_nir_albedo_with_weak_cosz_dependency + long_name = mean nir albedo with weak cosz dependency + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[facsf] + standard_name =fractional_coverage_with_strong_cosz_dependency + long_name = fractional coverage with strong cosz dependency + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[facwf] + standard_name = fractional_coverage_with_weak_cosz_dependency + long_name = fractional coverage with weak cosz dependency + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[fice] + standard_name = sea_ice_concentration + long_name = ice fraction over open water + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[tisfc] + standard_name = sea_ice_temperature + long_name = sea ice surface skin temperature + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[sfc_wts] + standard_name = weights_for_stochastic_surface_physics_perturbation + long_name = weights for stochastic surface physics perturbation + units = none + dimensions = (horizontal_dimension,number_of_surface_perturbations) + type = real + kind = kind_phys intent = in optional = F [tv_lay] @@ -162,6 +343,33 @@ type = integer intent = out optional = F +[coszen] + standard_name = cosine_of_zenith_angle + long_name = mean cos of zenith angle over rad call period + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[coszdg] + standard_name = daytime_mean_cosz_over_rad_call_period + long_name = daytime mean cosz over rad call period + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[sfc_alb_dif] + standard_name = surface_diffused_shortwave_albedo + long_name = mean surface diffused sw albedo + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP From 405d5fcc97ad2e6f8255980682687b55d70dc04d Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Mon, 3 Aug 2020 11:55:04 -0600 Subject: [PATCH 49/50] All DDTs have been removed from argument lists. Physical constatns have been added to the argument lists. Some cleanup. --- physics/GFS_rrtmgp_gfdlmp_pre.F90 | 36 ++--- physics/GFS_rrtmgp_lw_post.F90 | 10 +- physics/GFS_rrtmgp_pre.F90 | 14 +- physics/GFS_rrtmgp_pre.meta | 18 +-- physics/GFS_rrtmgp_sw_post.F90 | 12 +- physics/GFS_rrtmgp_zhaocarr_pre.F90 | 134 +++++++++--------- physics/GFS_rrtmgp_zhaocarr_pre.meta | 197 ++++++++++++++++++++++++--- physics/rrtmgp_lw_cloud_sampling.F90 | 24 ++-- physics/rrtmgp_sw_cloud_sampling.F90 | 4 +- 9 files changed, 307 insertions(+), 142 deletions(-) diff --git a/physics/GFS_rrtmgp_gfdlmp_pre.F90 b/physics/GFS_rrtmgp_gfdlmp_pre.F90 index 938e6ac95..79b1aaeb1 100644 --- a/physics/GFS_rrtmgp_gfdlmp_pre.F90 +++ b/physics/GFS_rrtmgp_gfdlmp_pre.F90 @@ -9,10 +9,13 @@ module GFS_rrtmgp_gfdlmp_pre ! Parameters real(kind_phys), parameter :: & - reice_min = 10.0, & ! Minimum ice size allowed by scheme - reice_max = 150.0, & ! Maximum ice size allowed by scheme - cllimit = 0.001, & ! Lowest cloud fraction in GFDL MP scheme - decorr_con = 2.50 ! Decorrelation length constant (km) for iovrlw/iovrsw = 4 or 5 and idcor = 0 + reliq_def = 10.0 , & ! Default liq radius to 10 micron (used when effr_in=F) + reice_def = 50.0, & ! Default ice radius to 50 micron (used when effr_in=F) + rerain_def = 1000.0, & ! Default rain radius to 1000 micron (used when effr_in=F) + resnow_def = 250.0, & ! Default snow radius to 250 micron (used when effr_in=F) + reice_min = 10.0, & ! Minimum ice size allowed by scheme + reice_max = 150.0, & ! Maximum ice size allowed by scheme + cllimit = 0.001 ! Lowest cloud fraction in GFDL MP scheme public GFS_rrtmgp_gfdlmp_pre_init, GFS_rrtmgp_gfdlmp_pre_run, GFS_rrtmgp_gfdlmp_pre_finalize private get_alpha_dcorr, get_alpha_exp @@ -128,14 +131,7 @@ subroutine GFS_rrtmgp_gfdlmp_pre_run(nCol, nLev, nTracers, ncnd, i_cldliq, i_cld call check_error_msg('GFS_rrtmgp_gfdlmp_pre_run',errmsg) return endif - ! - if(.not. effr_in) then - errmsg = 'Namelist option effr_in=F is not supported.' - errflg = 1 - call check_error_msg('GFS_rrtmgp_gfdlmp_pre_run',errmsg) - return - endif - + ! Initialize outputs cld_lwp(:,:) = 0.0 cld_reliq(:,:) = 0.0 @@ -187,10 +183,17 @@ subroutine GFS_rrtmgp_gfdlmp_pre_run(nCol, nLev, nTracers, ncnd, i_cldliq, i_cld cld_swp(iCol,iLay) = cld_condensate(iCol,iLay,4) * tem1 endif ! Use radii provided from the macrophysics - cld_reliq(iCol,iLay) = effrin_cldliq(iCol,iLay) - cld_reice(iCol,iLay) = max(reice_min, min(reice_max,effrin_cldice(iCol,iLay))) - cld_rerain(iCol,iLay) = effrin_cldrain(iCol,iLay) - cld_resnow(iCol,iLay) = effrin_cldsnow(iCol,iLay) + if (effr_in) then + cld_reliq(iCol,iLay) = effrin_cldliq(iCol,iLay) + cld_reice(iCol,iLay) = max(reice_min, min(reice_max,effrin_cldice(iCol,iLay))) + cld_rerain(iCol,iLay) = effrin_cldrain(iCol,iLay) + cld_resnow(iCol,iLay) = effrin_cldsnow(iCol,iLay) + else + cld_reliq(iCol,iLay) = reliq_def + cld_reice(iCol,iLay) = reice_def + cld_rerain(iCol,iLay) = rerain_def + cld_resnow(iCol,iLay) = resnow_def + endif enddo enddo @@ -358,6 +361,7 @@ subroutine get_alpha_exp(nlon, nlay, dzlay, iovrlp, latdeg, juldat, yearlen, cld ! ==================== end of description ===================== ! ! use physparam, only: idcor + use physcons, only: decorr_con implicit none ! Input integer, intent(in) :: nlon, nlay diff --git a/physics/GFS_rrtmgp_lw_post.F90 b/physics/GFS_rrtmgp_lw_post.F90 index a9a238cc9..a6b37acfc 100644 --- a/physics/GFS_rrtmgp_lw_post.F90 +++ b/physics/GFS_rrtmgp_lw_post.F90 @@ -20,14 +20,14 @@ end subroutine GFS_rrtmgp_lw_post_init ! ######################################################################################### ! SUBROUTINE GFS_rrtmgp_lw_post_run - ! ######################################################################################### + ! ######################################################################################## !> \section arg_table_GFS_rrtmgp_lw_post_run !! \htmlinclude GFS_rrtmgp_lw_post.html !! - 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, fluxlwDOWN_clrsky,& - raddt, aerodp, cldsa, mtopa, mbota, cld_frac, cldtaulw, & - sfcdlw, sfcflw, tsflw, htrlw, topflw, flxprf_lw, htrlwc, errmsg, errflg) + 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, & + fluxlwDOWN_clrsky, raddt, aerodp, cldsa, mtopa, mbota, cld_frac, cldtaulw, sfcdlw, & + sfcflw, tsflw, htrlw, topflw, flxprf_lw, htrlwc, errmsg, errflg) ! Inputs integer, intent(in) :: & diff --git a/physics/GFS_rrtmgp_pre.F90 b/physics/GFS_rrtmgp_pre.F90 index 01a56a00f..0e5d65f5c 100644 --- a/physics/GFS_rrtmgp_pre.F90 +++ b/physics/GFS_rrtmgp_pre.F90 @@ -145,7 +145,7 @@ end subroutine GFS_rrtmgp_pre_init !! subroutine GFS_rrtmgp_pre_run(nCol, nLev, nGases, nTracers, i_o3, lsswr, lslwr, fhswr, & fhlwr, xlat, xlon, prsl, tgrs, prslk, prsi, qgrs, tsfc, active_gases_array, & - con_eps, con_epsm1, con_fvirt, qs_Min, & + con_eps, con_epsm1, con_fvirt, con_epsqs, & raddt, p_lay, t_lay, p_lev, t_lev, tsfg, tsfa, tv_lay, relhum, tracer, & gas_concentrations, errmsg, errflg) @@ -168,8 +168,7 @@ subroutine GFS_rrtmgp_pre_run(nCol, nLev, nGases, nTracers, i_o3, lsswr, lslwr, con_eps, & ! Physical constant: Epsilon (Rd/Rv) con_epsm1, & ! Physical constant: Epsilon (Rd/Rv) minus one con_fvirt, & ! Physical constant: Inverse of epsilon minus one - qs_Min ! Algorithmic constant: Lower limit for saturation vapor pressure - + con_epsqs ! Physical constant: Minimum saturation mixing-ratio (kg/kg) real(kind_phys), dimension(nCol), intent(in) :: & xlon, & ! Longitude xlat, & ! Latitude @@ -211,7 +210,7 @@ subroutine GFS_rrtmgp_pre_run(nCol, nLev, nGases, nTracers, i_o3, lsswr, lslwr, logical :: top_at_1 real(kind_phys),dimension(nCol,nLev) :: vmr_o3, vmr_h2o real(kind_phys) :: es, qs, tem1, tem2 - real(kind_phys), dimension(nCol,nLev) :: o3_lay, qs_lay, q_lay + real(kind_phys), dimension(nCol,nLev) :: o3_lay, q_lay real(kind_phys), dimension(nCol,nLev, NF_VGAS) :: gas_vmr ! Initialize CCPP error handling variables @@ -266,9 +265,8 @@ subroutine GFS_rrtmgp_pre_run(nCol, nLev, nGases, nTracers, i_o3, lsswr, lslwr, do iCol=1,NCOL do iLay=1,nLev es = min( p_lay(iCol,iLay), fpvs( t_lay(iCol,iLay) ) ) ! fpvs and prsl in pa - qs = max( qs_Min, con_eps * es / (p_lay(iCol,iLay) + con_epsm1*es) ) - relhum(iCol,iLay) = max( 0._kind_phys, min( 1._kind_phys, max(qs_Min, q_lay(iCol,iLay))/qs ) ) - qs_lay(iCol,iLay) = qs + qs = max( con_epsqs, con_eps * es / (p_lay(iCol,iLay) + con_epsm1*es) ) + relhum(iCol,iLay) = max( 0._kind_phys, min( 1._kind_phys, max(con_epsqs, q_lay(iCol,iLay))/qs ) ) tv_lay(iCol,iLay) = t_lay(iCol,iLay) * (1._kind_phys + con_fvirt*q_lay(iCol,iLay)) enddo enddo @@ -285,7 +283,7 @@ subroutine GFS_rrtmgp_pre_run(nCol, nLev, nGases, nTracers, i_o3, lsswr, lslwr, if (i_o3 > 0) then do iLay=1,nlev do iCol=1,NCOL - o3_lay(iCol,iLay) = max( qs_Min, tracer(iCol,iLay,i_o3) ) + o3_lay(iCol,iLay) = max( con_epsqs, tracer(iCol,iLay,i_o3) ) enddo enddo ! OR Use climatological ozone data diff --git a/physics/GFS_rrtmgp_pre.meta b/physics/GFS_rrtmgp_pre.meta index b5fcc7879..95a9403cd 100644 --- a/physics/GFS_rrtmgp_pre.meta +++ b/physics/GFS_rrtmgp_pre.meta @@ -204,15 +204,6 @@ kind = len=* intent = in optional = F -[qs_Min] - standard_name = lower_limit_for_saturation_vapor_pressure - long_name = lower limit allowed when computing saturation vapor pressure - units = none - dimensions = () - type = real - kind = kind_phys - intent = in - optional = F [con_eps] standard_name = ratio_of_dry_air_to_water_vapor_gas_constants long_name = rd/rv @@ -240,6 +231,15 @@ kind = kind_phys intent = in optional = F +[con_epsqs] + standard_name = minimum_value_of_saturation_mixing_ratio + long_name = floor value for saturation mixing ratio + units = kg kg-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F [raddt] standard_name = time_step_for_radiation long_name = radiation time step diff --git a/physics/GFS_rrtmgp_sw_post.F90 b/physics/GFS_rrtmgp_sw_post.F90 index 840360429..0d3991fcf 100644 --- a/physics/GFS_rrtmgp_sw_post.F90 +++ b/physics/GFS_rrtmgp_sw_post.F90 @@ -24,12 +24,12 @@ end subroutine GFS_rrtmgp_sw_post_init !> \section arg_table_GFS_rrtmgp_sw_post_run !! \htmlinclude GFS_rrtmgp_sw_post_run.html !! - 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, sw_gas_props, fluxswUP_allsky, & - fluxswDOWN_allsky, fluxswUP_clrsky, fluxswDOWN_clrsky, raddt, aerodp, cldsa, mbota, & - mtopa, cld_frac, cldtausw, & - nirbmdi, nirdfdi, visbmdi, visdfdi, nirbmui, nirdfui, visbmui, visdfui, sfcnsw, & + 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, sw_gas_props, fluxswUP_allsky, & + fluxswDOWN_allsky, fluxswUP_clrsky, fluxswDOWN_clrsky, raddt, aerodp, cldsa, mbota, & + mtopa, cld_frac, cldtausw, & + nirbmdi, nirdfdi, visbmdi, visdfdi, nirbmui, nirdfui, visbmui, visdfui, sfcnsw, & sfcdsw, htrsw, sfcfsw, topfsw, htrswc, flxprf_sw, scmpsw, errmsg, errflg) ! Inputs diff --git a/physics/GFS_rrtmgp_zhaocarr_pre.F90 b/physics/GFS_rrtmgp_zhaocarr_pre.F90 index 20330f0c6..edba20958 100644 --- a/physics/GFS_rrtmgp_zhaocarr_pre.F90 +++ b/physics/GFS_rrtmgp_zhaocarr_pre.F90 @@ -1,31 +1,19 @@ ! ######################################################################################## ! This module contains the interface between the Zhao-Carr macrophysics and the RRTMGP -! radiation schemes. Only compatable with Model%imp_physics = Model%imp_physics_zhaocarr +! radiation schemes. Only compatable with imp_physics = imp_physics_zhaocarr ! ######################################################################################## module GFS_rrtmgp_zhaocarr_pre use machine, only: kind_phys - use GFS_typedefs, only: GFS_control_type, GFS_tbd_type - use physcons, only: con_ttp, & ! Temperature at h2o 3pt (K) - con_rd, & ! Gas constant for dry air (J/KgK) - con_pi, & ! PI - con_g, & ! Gravity (m/s2) - con_rog, & - eps => con_eps, & ! Rd/Rv - epsm1 => con_epsm1 ! Rd/Rv-1 - use physparam, only: lcnorm, lcrick, idcor, iovrlw, iovrsw use rrtmgp_aux, only: check_error_msg use funcphys, only: fpvs - use radcons, only: qmin - ! Parameters + + ! Zhao-Carr MP parameters. real(kind_phys), parameter :: & - reliq_def = 10.0 , & ! fault liq radius to 10 micron + reliq_def = 10.0 , & ! Default liq radius to 10 micron reice_def = 50.0, & ! Default ice radius to 50 micron rerain_def = 1000.0, & ! Default rain radius to 1000 micron - resnow_def = 250.0, & ! Default snow radius to 250 micron - epsq = 1.0e-12, & ! Tiny value - xrc3 = 100., & !??? - gfac = 1.0e5/con_g, & - gord = con_g/con_rd + resnow_def = 250.0 ! Default snow radius to 250 micron + public GFS_rrtmgp_zhaocarr_pre_init, GFS_rrtmgp_zhaocarr_pre_run, GFS_rrtmgp_zhaocarr_pre_finalize contains @@ -39,20 +27,36 @@ end subroutine GFS_rrtmgp_zhaocarr_pre_init !! \section arg_table_GFS_rrtmgp_zhaocarr_pre_run !! \htmlinclude GFS_rrtmgp_zhaocarr_pre_run.html !! - subroutine GFS_rrtmgp_zhaocarr_pre_run(Model, Tbd, nCol, nLev, lat, lsmask, & - p_lev, p_lay, t_lay, relhum, tv_lay, tracer, cld_frac, cld_lwp, cld_reliq, cld_iwp, cld_reice, & - cld_swp, cld_resnow, cld_rwp, cld_rerain, errmsg, errflg) + subroutine GFS_rrtmgp_zhaocarr_pre_run(nCol, nLev, nCnd, nTracers, i_cldliq, lsswr, & + lslwr, effr_in, uni_cld, lmfshal, lat, lsmask, p_lev, p_lay, t_lay, relhum, & + tv_lay, effrin_cldliq, effrin_cldice, effrin_cldrain, effrin_cldsnow, & + shoc_sgs_cldfrac, cncvw, tracer, & + con_eps, con_epsq, con_epsqs, con_epsm1, con_g, con_ttp, con_rd, & + cld_frac, cld_lwp, cld_reliq, cld_iwp, cld_reice, cld_swp, cld_resnow, cld_rwp, & + cld_rerain, errmsg, errflg) implicit none - - ! Inputs - type(GFS_control_type), intent(in) :: & - Model ! DDT: FV3-GFS model control parameters - type(GFS_tbd_type), intent(in) :: & - Tbd ! DDT: FV3-GFS data not yet assigned to a defined container - integer, intent(in) :: & - nCol, & ! Number of horizontal grid-points - nLev ! Number of vertical-layers - + + ! Inputs + integer, intent(in) :: & + nCol, & ! Number of horizontal grid points + nLev, & ! Number of vertical layers + nCnd, & ! Number of cloud condensation types. + nTracers, & ! Number of tracers from model. + i_cldliq ! Index into tracer array for cloud liquid. + logical, intent(in) :: & + lsswr, & ! Call SW radiation? + lslwr, & ! Call LW radiation + effr_in, & ! Provide hydrometeor radii from macrophysics? + uni_cld, & ! + lmfshal + real(kind_phys), intent(in) :: & + con_eps, & ! rd/rv + con_epsm1, & ! (rd/rv) - 1 + con_epsq, & ! Floor value for specific humidity + con_epsqs, & ! Floor value for saturation mixing ratio + con_g, & ! Gravitational acceleration (m/s2) + con_ttp, & ! Triple point temperature of water (K) + con_rd ! Ideal gas constant for dry air (J/kg/K) real(kind_phys), dimension(nCol), intent(in) :: & lsmask, & ! Land/Sea mask lat ! Latitude @@ -60,10 +64,16 @@ subroutine GFS_rrtmgp_zhaocarr_pre_run(Model, Tbd, nCol, nLev, lat, lsmask, & tv_lay, & ! Virtual temperature (K) p_lay, & ! Pressure at model-layers (Pa) t_lay, & ! Temperature at model-layers (K) - relhum ! Relative humidity at model-layers () + relhum, & ! Relative humidity at model-layers () + effrin_cldliq, & ! Effective radius for liquid cloud-particles (microns) + effrin_cldice, & ! Effective radius for ice cloud-particles (microns) + effrin_cldrain, & ! Effective radius for rain cloud-particles (microns) + effrin_cldsnow, & ! Effective radius for snow cloud-particles (microns) + shoc_sgs_cldfrac, & ! Subgrid-scale cloud fraction from the SHOC scheme + cncvw ! Convective cloud water mixing ratio (kg/kg) real(kind_phys), dimension(nCol,nLev+1), intent(in) :: & p_lev ! Pressure at model-level interfaces (Pa) - real(kind_phys), dimension(nCol, nLev, Model%ntrac),intent(in) :: & + real(kind_phys), dimension(nCol, nLev, nTracers),intent(in) :: & tracer ! Cloud condensate amount in layer by type () ! Outputs @@ -85,24 +95,16 @@ subroutine GFS_rrtmgp_zhaocarr_pre_run(Model, Tbd, nCol, nLev, lat, lsmask, & ! Local variables real(kind_phys) :: tem1,tem2,tem3,clwt,onemrh,clwm,clwmin,es,qs,value - real(kind_phys), dimension(nCol, nLev, min(4,Model%ncnd)) :: cld_condensate + real(kind_phys), dimension(nCol, nLev, min(4,nCnd)) :: cld_condensate integer :: iCol,iLay,l,ncndl,iovr real(kind_phys), dimension(nCol,nLev) :: deltaP - if (.not. (Model%lsswr .or. Model%lslwr)) return + if (.not. (lsswr .or. lslwr)) return ! Initialize CCPP error handling variables errmsg = '' errflg = 0 - - ! Test inputs - if (lcnorm) then - errmsg = 'Namelist option lcnorm is not supported.' - errflg = 1 - call check_error_msg('GFS_rrtmgp_gfdlmp_pre_run',errmsg) - return - endif - + ! Initialize outputs cld_lwp(:,:) = 0.0 cld_reliq(:,:) = 0.0 @@ -117,21 +119,21 @@ subroutine GFS_rrtmgp_zhaocarr_pre_run(Model, Tbd, nCol, nLev, lat, lsmask, & ! Pull out cloud information for Zhao-Carr MP scheme. ! #################################################################################### ! Condensate - cld_condensate(1:nCol,1:nLev,1) = tracer(1:nCol,1:nLev,Model%ntcw) ! Liquid water + cld_condensate(1:nCol,1:nLev,1) = tracer(1:nCol,1:nLev,i_cldliq) ! Liquid water ! Set really tiny suspended particle amounts to clear do iLay=1,nLev do iCol=1,nCol - if (cld_condensate(iCol,iLay,1) < epsq) cld_condensate(iCol,iLay,1) = 0.0 + if (cld_condensate(iCol,iLay,1) < con_epsq) cld_condensate(iCol,iLay,1) = 0.0 enddo enddo - ! Use radii provided from the macrophysics - if (Model%effr_in) then - cld_reliq(1:nCol,1:nLev) = Tbd%phy_f3d(1:nCol,1:nLev,2) - cld_reice(1:nCol,1:nLev) = Tbd%phy_f3d(1:nCol,1:nLev,3) - cld_rerain(1:nCol,1:nLev) = Tbd%phy_f3d(1:nCol,1:nLev,4) - cld_resnow(1:nCol,1:nLev) = Tbd%phy_f3d(1:nCol,1:nLev,5) + ! Use radii provided from the macrophysics? + if (effr_in) then + cld_reliq(1:nCol,1:nLev) = effrin_cldliq(1:nCol,1:nLev) + cld_reice(1:nCol,1:nLev) = effrin_cldice(1:nCol,1:nLev) + cld_rerain(1:nCol,1:nLev) = effrin_cldrain(1:nCol,1:nLev) + cld_resnow(1:nCol,1:nLev) = effrin_cldsnow(1:nCol,1:nLev) else cld_reliq(1:nCol,1:nLev) = reliq_def cld_reice(1:nCol,1:nLev) = reice_def @@ -140,16 +142,16 @@ subroutine GFS_rrtmgp_zhaocarr_pre_run(Model, Tbd, nCol, nLev, lat, lsmask, & endif ! Use cloud-fraction from SHOC? - if (Model%uni_cld) then - cld_frac(1:nCol,1:nLev) = Tbd%phy_f3d(1:nCol,1:nLev,Model%indcld) - ! Compute cloud-fraction + if (uni_cld) then + cld_frac(1:nCol,1:nLev) = shoc_sgs_cldfrac(1:nCol,1:nLev) + ! Compute cloud-fraction? else clwmin = 0.0e-6 - if (.not. Model%lmfshal) then + if (.not. lmfshal) then do iLay = 1,nLev do iCol = 1, nCol es = min( p_lay(iCol,iLay), fpvs( t_lay(iCol,iLay) ) ) ! fpvs and prsl in pa - qs = max( QMIN, eps * es / (p_lay(iCol,iLay) + epsm1*es) ) + qs = max( con_epsqs, con_eps * es / (p_lay(iCol,iLay) + con_epsm1*es) ) clwt = 1.0e-6 * (p_lay(iCol,iLay)*0.001) if (cld_condensate(iCol,iLay,1) > clwt) then onemrh= max( 1.e-10, 1.0-relhum(iCol,iLay) ) @@ -166,17 +168,13 @@ subroutine GFS_rrtmgp_zhaocarr_pre_run(Model, Tbd, nCol, nLev, lat, lsmask, & do iLay=1,nLev do iCol = 1, nCol es = min( p_lay(iCol,iLay), fpvs( t_lay(iCol,iLay) ) ) ! fpvs and prsl in pa - qs = max( QMIN, eps * es / (p_lay(iCol,iLay) + epsm1*es) ) + qs = max( con_epsqs, con_eps * es / (p_lay(iCol,iLay) + con_epsm1*es) ) clwt = 1.0e-6 * (p_lay(iCol,iLay)*0.001) if (cld_condensate(iCol,iLay,1) > clwt) then onemrh= max( 1.e-10, 1.0-relhum(iCol,iLay) ) clwm = clwmin / max( 0.01, p_lay(iCol,iLay)*0.001 ) tem1 = min(max((onemrh*qs)**0.49,0.0001),1.0) !jhan - if (Model%lmfdeep2) then - tem1 = xrc3 / tem1 - else - tem1 = 100.0 / tem1 - endif + tem1 = 100.0 / tem1 value = max( min( tem1*(cld_condensate(iCol,iLay,1)-clwm), 50.0 ), 0.0 ) tem2 = sqrt( sqrt(relhum(iCol,iLay)) ) cld_frac(iCol,iLay) = max( tem2*(1.0-exp(-value)), 0.0 ) @@ -189,19 +187,19 @@ subroutine GFS_rrtmgp_zhaocarr_pre_run(Model, Tbd, nCol, nLev, lat, lsmask, & ! Add suspended convective cloud water to grid-scale cloud water only for cloud ! fraction & radiation computation it is to enhance cloudiness due to suspended convec ! cloud water for zhao/moorthi's (imp_phys=99) - cld_condensate(1:nCol,1:nLev,1) = cld_condensate(1:nCol,1:nLev,1) + Tbd%phy_f3d(1:nCol,1:nLev,6) + cld_condensate(1:nCol,1:nLev,1) = cld_condensate(1:nCol,1:nLev,1) + cncvw(1:nCol,1:nLev) ! Compute cloud liquid/ice condensate path. do iLay=1,nLev do iCol=1,nCol - tem1 = max(0.0, cld_condensate(iCol,iLay,1)) * gfac * deltaP(iCol,iLay) + tem1 = max(0.0, cld_condensate(iCol,iLay,1)) * (1.0e5/con_g) * deltaP(iCol,iLay) cld_iwp(iCol,iLay) = tem1*(t_lay(iCol,iLay) - 273.16) cld_lwp(iCol,iLay) = tem1 - cld_iwp(iCol,iLay) enddo enddo ! Compute effective liquid cloud droplet radius over land. - if(.not. Model%effr_in) then + if(.not. effr_in) then do iCol = 1, nCol if (nint(lsmask(iCol)) == 1) then do iLay = 1, nLev @@ -213,13 +211,13 @@ subroutine GFS_rrtmgp_zhaocarr_pre_run(Model, Tbd, nCol, nLev, lat, lsmask, & ! Compute effective ice cloud droplet radius following Heymsfield ! and McFarquhar (1996) \cite heymsfield_and_mcfarquhar_1996. - if(.not. Model%effr_in) then + if(.not. effr_in) then deltaP = abs(p_lev(:,2:nLev+1)-p_lev(:,1:nLev))/100. do iLay=1,nLev do iCol=1,nCol tem2 = t_lay(iCol,iLay) - con_ttp if (cld_iwp(iCol,iLay) > 0.0) then - tem3 = gord * cld_iwp(iCol,iLay) * p_lay(iCol,iLay) / (deltaP(iCol,iLay)*tv_lay(iCol,iLay)) + tem3 = (con_g/con_rd ) * cld_iwp(iCol,iLay) * p_lay(iCol,iLay) / (deltaP(iCol,iLay)*tv_lay(iCol,iLay)) if (tem2 < -50.0) then cld_reice(iCol,iLay) = (1250.0/9.917) * tem3 ** 0.109 elseif (tem2 < -40.0) then diff --git a/physics/GFS_rrtmgp_zhaocarr_pre.meta b/physics/GFS_rrtmgp_zhaocarr_pre.meta index 0afed8c1e..bf72d7400 100644 --- a/physics/GFS_rrtmgp_zhaocarr_pre.meta +++ b/physics/GFS_rrtmgp_zhaocarr_pre.meta @@ -2,22 +2,6 @@ [ccpp-arg-table] name = GFS_rrtmgp_zhaocarr_pre_run type = scheme -[Model] - standard_name = GFS_control_type_instance - long_name = instance of derived type GFS_control_type - units = DDT - dimensions = () - type = GFS_control_type - intent = in - optional = F -[Tbd] - standard_name = GFS_tbd_type_instance - long_name = instance of derived type GFS_tbd_type - units = DDT - dimensions = () - type = GFS_tbd_type - intent = in - optional = F [ncol] standard_name = horizontal_loop_extent long_name = horizontal dimension @@ -34,6 +18,70 @@ type = integer intent = in optional = F +[nTracers] + standard_name = number_of_tracers + long_name = number of tracers + units = count + dimensions = () + type = integer + intent = in + optional = F +[ncnd] + standard_name = number_of_cloud_condensate_types + long_name = number of cloud condensate types + units = count + dimensions = () + type = integer + intent = in + optional = F +[lsswr] + standard_name = flag_to_calc_sw + long_name = logical flags for sw radiation calls + units = flag + dimensions = () + type = logical + intent = in + optional = F +[lslwr] + standard_name = flag_to_calc_lw + long_name = logical flags for lw radiation calls + units = flag + dimensions = () + type = logical + intent = in + optional = F +[effr_in] + standard_name = flag_for_cloud_effective_radii + long_name = flag for cloud effective radii calculations in GFDL microphysics + units = + dimensions = () + type = logical + intent = in + optional = F +[uni_cld] + standard_name = flag_for_uni_cld + long_name = flag for uni_cld + units = flag + dimensions = () + type = logical + intent = in + optional = F +[lmfshal] + standard_name = flag_for_lmfshal + long_name = flag for lmfshal + units = flag + dimensions = () + type = logical + intent = in + optional = F +[i_cldliq] + standard_name = index_for_liquid_cloud_condensate + long_name = tracer index for cloud condensate (or liquid water) + units = index + dimensions = () + type = integer + intent = in + optional = F [lat] standard_name = latitude long_name = latitude @@ -87,6 +135,60 @@ kind = kind_phys intent = in optional = F +[effrin_cldliq] + standard_name = effective_radius_of_stratiform_cloud_liquid_water_particle_in_um + long_name = eff. radius of cloud liquid water particle in micrometer + units = um + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[effrin_cldice] + standard_name = effective_radius_of_stratiform_cloud_ice_particle_in_um + long_name = eff. radius of cloud ice water particle in micrometer + units = um + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[effrin_cldrain] + standard_name = effective_radius_of_stratiform_cloud_rain_particle_in_um + long_name = effective radius of cloud rain particle in micrometers + units = um + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[effrin_cldsnow] + standard_name = effective_radius_of_stratiform_cloud_snow_particle_in_um + long_name = effective radius of cloud snow particle in micrometers + units = um + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[shoc_sgs_cldfrac] + standard_name = subgrid_scale_cloud_fraction_from_shoc + long_name = subgrid-scale cloud fraction from the SHOC scheme + units = frac + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[cncvw] + standard_name = convective_cloud_water_mixing_ratio_in_phy_f3d + long_name = convective cloud water mixing ratio in the phy_f3d array + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F [tracer] standard_name = chemical_tracers long_name = chemical tracers @@ -105,6 +207,69 @@ kind = kind_phys intent = in optional = F +[con_ttp] + standard_name = triple_point_temperature_of_water + long_name = triple point temperature of water + units = K + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[con_epsq] + standard_name = minimum_value_of_specific_humidity + long_name = floor value for specific humidity + units = kg kg-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[con_epsqs] + standard_name = minimum_value_of_saturation_mixing_ratio + long_name = floor value for saturation mixing ratio + units = kg kg-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[con_eps] + standard_name = ratio_of_dry_air_to_water_vapor_gas_constants + long_name = rd/rv + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[con_epsm1] + standard_name = ratio_of_dry_air_to_water_vapor_gas_constants_minus_one + long_name = (rd/rv) - 1 + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[con_g] + standard_name = gravitational_acceleration + long_name = gravitational acceleration + units = m s-2 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[con_rd] + standard_name = gas_constant_dry_air + long_name = ideal gas constant for dry air + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F [cld_frac] standard_name = total_cloud_fraction long_name = layer total cloud fraction diff --git a/physics/rrtmgp_lw_cloud_sampling.F90 b/physics/rrtmgp_lw_cloud_sampling.F90 index 396c98a76..1d6cc06a1 100644 --- a/physics/rrtmgp_lw_cloud_sampling.F90 +++ b/physics/rrtmgp_lw_cloud_sampling.F90 @@ -97,7 +97,7 @@ subroutine rrtmgp_lw_cloud_sampling_run(doLWrad, nCol, nLev, ipsdlw0, icseed_lw, ! if (iovrlw .ne. 1 .and. iovrlw .ne. 3 .and. iovrlw .ne. 4 .and. iovrlw .ne. 5) then - errmsg = 'Cloud overlap assumption not supported by GFDL microphysics suite.' + errmsg = 'Cloud overlap assumption not supported.' errflg = 1 call check_error_msg('rrtmgp_lw_cloud_sampling',errmsg) return @@ -135,7 +135,7 @@ subroutine rrtmgp_lw_cloud_sampling_run(doLWrad, nCol, nLev, ipsdlw0, icseed_lw, ! Cloud-overlap. select case ( iovrlw ) case(1) ! Maximum-random overlap - call check_error_msg('rrtmgp_lw_cloud_sampling_run', & + call check_error_msg('rrtmgp_lw_cloud_sampling_run', & sampled_mask_max_ran(rng3D, & cld_frac, & cldfracMCICA)) @@ -146,20 +146,20 @@ subroutine rrtmgp_lw_cloud_sampling_run(doLWrad, nCol, nLev, ipsdlw0, icseed_lw, call random_number(rng1D,rng_stat) rng3D2(:,:,iCol) = reshape(source = rng1D,shape=[lw_gas_props%get_ngpt(),nLev]) enddo - call check_error_msg('rrtmgp_lw_cloud_sampling_run', & + call check_error_msg('rrtmgp_lw_cloud_sampling_run', & sampled_mask_exp_dcorr(rng3D, & rng3D2, & cld_frac, & cloud_overlap_param(:,1:nLev-1), & cldfracMCICA)) case(4) ! Exponential overlap - call check_error_msg('rrtmgp_lw_cloud_sampling_run', & + call check_error_msg('rrtmgp_lw_cloud_sampling_run', & sampled_mask_exp_ran(rng3D, & cld_frac, & cloud_overlap_param(:,1:nLev-1), & cldfracMCICA)) case(5) ! Exponential-random overlap - call check_error_msg('rrtmgp_lw_cloud_sampling_run', & + call check_error_msg('rrtmgp_lw_cloud_sampling_run', & sampled_mask_exp_ran(rng3D, & cld_frac, & cloud_overlap_param(:,1:nLev-1), & @@ -167,7 +167,7 @@ subroutine rrtmgp_lw_cloud_sampling_run(doLWrad, nCol, nLev, ipsdlw0, icseed_lw, end select ! Sampling. Map band optical depth to each g-point using McICA - call check_error_msg('rrtmgp_lw_cloud_sampling_run', & + call check_error_msg('rrtmgp_lw_cloud_sampling_run', & draw_samples(cldfracMCICA, & lw_optical_props_cloudsByBand, & lw_optical_props_clouds)) @@ -203,7 +203,7 @@ subroutine rrtmgp_lw_cloud_sampling_run(doLWrad, nCol, nLev, ipsdlw0, icseed_lw, ! Precipitation overlap. select case ( iovrlw ) case(1) ! Maximum-random overlap - call check_error_msg('rrtmgp_lw_cloud_sampling_run', & + call check_error_msg('rrtmgp_lw_cloud_sampling_run', & sampled_mask_max_ran(rng3D, & precip_frac, & precipfracSAMP)) @@ -215,20 +215,20 @@ subroutine rrtmgp_lw_cloud_sampling_run(doLWrad, nCol, nLev, ipsdlw0, icseed_lw, ! call random_number(rng1D,rng_stat) ! rng3D2(:,:,iCol) = reshape(source = rng1D,shape=[lw_gas_props%get_ngpt(),nLev]) !enddo - call check_error_msg('rrtmgp_lw_cloud_sampling_run', & + call check_error_msg('rrtmgp_lw_cloud_sampling_run', & sampled_mask_exp_dcorr(rng3D, & rng3D2, & precip_frac, & precip_overlap_param(:,1:nLev-1), & precipfracSAMP)) case(4) ! Exponential overlap - call check_error_msg('rrtmgp_lw_cloud_sampling_run', & + call check_error_msg('rrtmgp_lw_cloud_sampling_run', & sampled_mask_exp_ran(rng3D, & precip_frac, & precip_overlap_param(:,1:nLev-1), & precipfracSAMP)) case(5) ! Exponential-random overlap - call check_error_msg('rrtmgp_lw_cloud_sampling_run', & + call check_error_msg('rrtmgp_lw_cloud_sampling_run', & sampled_mask_exp_ran(rng3D, & precip_frac, & precip_overlap_param(:,1:nLev-1), & @@ -236,13 +236,13 @@ subroutine rrtmgp_lw_cloud_sampling_run(doLWrad, nCol, nLev, ipsdlw0, icseed_lw, end select ! Sampling. Map band optical depth to each g-point using McICA - call check_error_msg('rrtmgp_lw_cloud_sampling_run', & + call check_error_msg('rrtmgp_lw_cloud_sampling_run', & draw_samples(precipfracSAMP, & lw_optical_props_precipByBand, & lw_optical_props_precip)) ! #################################################################################### - ! For GFDL MP just add precipitation optics to cloud-optics + ! Just add precipitation optics to cloud-optics ! #################################################################################### lw_optical_props_clouds%tau = lw_optical_props_clouds%tau + lw_optical_props_precip%tau diff --git a/physics/rrtmgp_sw_cloud_sampling.F90 b/physics/rrtmgp_sw_cloud_sampling.F90 index 3be4b023e..0a0511bc2 100644 --- a/physics/rrtmgp_sw_cloud_sampling.F90 +++ b/physics/rrtmgp_sw_cloud_sampling.F90 @@ -101,7 +101,7 @@ subroutine rrtmgp_sw_cloud_sampling_run(doSWrad, nCol, nDay, nLev, ipsdsw0, idxd ! Only works w/ SDFs v15p2 and v16beta if (iovrsw .ne. 1 .and. iovrsw .ne. 3 .and. iovrsw .ne. 4 .and. iovrsw .ne. 5) then - errmsg = 'Cloud overlap assumption not supported by GFDL microphysics suite.' + errmsg = 'Cloud overlap assumption not supported.' errflg = 1 call check_error_msg('rrtmgp_sw_cloud_sampling',errmsg) return @@ -245,7 +245,7 @@ subroutine rrtmgp_sw_cloud_sampling_run(doSWrad, nCol, nDay, nLev, ipsdsw0, idxd endif ! #################################################################################### - ! For GFDL MP just add precipitation optics to cloud-optics + ! Just add precipitation optics to cloud-optics ! #################################################################################### do iGpt=1,sw_gas_props%get_ngpt() do iday=1,nDay From 7b6a9cf3950b5ceaad4e0f73e3c943781c9af9b4 Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Tue, 4 Aug 2020 00:47:21 +0000 Subject: [PATCH 50/50] Some changes to work in UFS. --- physics/GFS_rrtmgp_gfdlmp_pre.F90 | 208 +-------------------------- physics/GFS_rrtmgp_gfdlmp_pre.meta | 2 +- physics/GFS_rrtmgp_zhaocarr_pre.F90 | 56 +++++--- physics/GFS_rrtmgp_zhaocarr_pre.meta | 36 +++++ physics/physcons.F90 | 1 + physics/radiation_clouds.f | 201 +++++++++++++++++++++++++- 6 files changed, 274 insertions(+), 230 deletions(-) diff --git a/physics/GFS_rrtmgp_gfdlmp_pre.F90 b/physics/GFS_rrtmgp_gfdlmp_pre.F90 index 79b1aaeb1..b67b22d41 100644 --- a/physics/GFS_rrtmgp_gfdlmp_pre.F90 +++ b/physics/GFS_rrtmgp_gfdlmp_pre.F90 @@ -6,7 +6,7 @@ module GFS_rrtmgp_gfdlmp_pre use machine, only: kind_phys use physparam, only: lcnorm, lcrick, idcor, iovrlw, iovrsw use rrtmgp_aux, only: check_error_msg - + use module_radiation_clouds, only: get_alpha_exp, get_alpha_dcorr ! Parameters real(kind_phys), parameter :: & reliq_def = 10.0 , & ! Default liq radius to 10 micron (used when effr_in=F) @@ -18,7 +18,7 @@ module GFS_rrtmgp_gfdlmp_pre cllimit = 0.001 ! Lowest cloud fraction in GFDL MP scheme public GFS_rrtmgp_gfdlmp_pre_init, GFS_rrtmgp_gfdlmp_pre_run, GFS_rrtmgp_gfdlmp_pre_finalize - private get_alpha_dcorr, get_alpha_exp + contains ! ###################################################################################### ! ###################################################################################### @@ -214,7 +214,7 @@ subroutine GFS_rrtmgp_gfdlmp_pre_run(nCol, nLev, nTracers, ncnd, i_cldliq, i_cld ! Cloud overlap parameter ! if (iovr == 3) then - call get_alpha_dcorr(nCol, nLev, lat, deltaZ, de_lgth, cloud_overlap_param) + call get_alpha_dcorr(nCol, nLev, lat, con_pi, deltaZ, de_lgth, cloud_overlap_param) endif if (iovr == 4 .or. iovr == 5) then call get_alpha_exp(nCol, nLev, deltaZ, iovr, lat, julian, yearlen, cld_frac, cloud_overlap_param) @@ -231,206 +231,4 @@ end subroutine GFS_rrtmgp_gfdlmp_pre_run ! ######################################################################################### subroutine GFS_rrtmgp_gfdlmp_pre_finalize() end subroutine GFS_rrtmgp_gfdlmp_pre_finalize - - ! ######################################################################################### - ! Private module routines - ! ######################################################################################### - - ! ######################################################################################### - ! Subroutine to compute cloud-overlap parameter, alpha, for decorrelation-length cloud - ! overlap assumption. - ! ######################################################################################### - subroutine get_alpha_dcorr(nCol, nLev, lat, deltaZ, de_lgth, cloud_overlap_param) - - ! Inputs - integer, intent(in) :: & - nCol, & ! Number of horizontal grid-points - nLev ! Number of vertical-layers - real(kind_phys), dimension(nCol), intent(in) :: & - lat ! Latitude - real(kind_phys), dimension(nCol,nLev),intent(in) :: & - deltaZ ! Layer thickness - - ! Outputs - real(kind_phys), dimension(nCol),intent(out) :: & - de_lgth ! Decorrelation length - real(kind_phys), dimension(nCol,nLev),intent(out) :: & - cloud_overlap_param ! Cloud-overlap parameter - - ! Local - integer :: iCol, iLay - - do iCol =1,nCol - de_lgth(iCol) = max( 0.6, 2.78-4.6*abs(lat(iCol)/con_pi) ) - do iLay=nLev,2,-1 - if (de_lgth(iCol) .gt. 0) then - cloud_overlap_param(iCol,iLay-1) = & - exp( -0.5 * (deltaZ(iCol,iLay)+deltaZ(iCol,iLay-1)) / de_lgth(iCol) ) - endif - enddo - enddo - end subroutine get_alpha_dcorr - - ! ######################################################################################### -!> \ingroup module_radiation_clouds -!! This program derives the exponential transition, alpha, from maximum to -!! random overlap needed to define the fractional cloud vertical correlation -!! for the exponential (EXP, iovrlp=4) or the exponential-random (ER, iovrlp=5) -!! cloud overlap options for RRTMGP. For exponential, the transition from -!! maximum to random with distance through model layers occurs without regard -!! to the configuration of clear and cloudy layers. For the ER method, each -!! block of adjacent cloudy layers is treated with a separate transition from -!! maximum to random, and blocks of cloudy layers separated by one or more -!! clear layers are correlated randomly. -!> /param nlon : number of model longitude points -!> /param nlay : vertical layer dimension -!> /param dzlay(nlon,nlay) : distance between the center of model layers -!> /param iovrlp : cloud overlap method -!> : 0 = random -!> : 1 = maximum-random -!> : 2 = maximum -!> : 3 = decorrelation (NOAA/Hou) -!> : 4 = exponential (AER) -!> : 5 = exponential-random (AER) -!> /param latdeg(nlon) : latitude (in degrees 90 -> -90) -!> /param juldat : day of the year (fractional julian day) -!> /param yearlen : current length of the year (365/366 days) -!> /param cldf(nlon,nlay) : cloud fraction -!> /param idcor : decorrelation length method -!> : 0 = constant value (AER; decorr_con) -!> : 1 = latitude and day of year varying value (AER; Oreopoulos, et al., 2012) -!> /param decorr_con : decorrelation length constant -!! -!>\section detail Detailed Algorithm -!! @{ - subroutine get_alpha_exp(nlon, nlay, dzlay, iovrlp, latdeg, juldat, yearlen, cldf, alpha) -! =================================================================== ! -! ! -! abstract: Derives the exponential transition, alpha, from maximum to ! -! random overlap needed to define the fractional cloud vertical ! -! correlation for the exponential (EXP, iovrlp=4) or the exponential- ! -! random (ER, iovrlp=5) cloud overlap options for RRTMG. For ! -! exponential, the transition from maximum to random with distance ! -! through model layers occurs without regard to the configuration of ! -! clear and cloudy layers. For the ER method, each block of adjacent ! -! cloudy layers is treated with a separate transition from maximum to ! -! random, and blocks of cloudy layers separated by one or more ! -! clear layers are correlated randomly. ! -! ! -! usage: call get_alpha ! -! ! -! subprograms called: none ! -! ! -! attributes: ! -! language: fortran 90 ! -! machine: ibm-sp, sgi ! -! ! -! author: m.j. iacono (AER) for use with the RRTMG radiation code ! -! ! -! ==================== definition of variables ==================== ! -! ! -! Input variables: ! -! nlon : number of model longitude points ! -! nlay : vertical layer dimension ! -! dzlay(nlon,nlay) : distance between the center of model layers ! -! iovrlp : cloud overlap method ! -! : 0 = random ! -! : 1 = maximum-random ! -! : 2 = maximum ! -! : 3 = decorrelation (NOAA/Hou) ! -! : 4 = exponential (AER) ! -! : 5 = exponential-random (AER) ! -! latdeg(nlon) : latitude (in degrees 90 -> -90) ! -! juldat : day of the year (fractional julian day) ! -! yearlen : current length of the year (365/366 days) ! -! cldf(nlon,nlay) : cloud fraction ! -! ! -! output variables: ! -! alpha(nlon,nlay) : alpha exponential transition parameter for ! -! : cloud vertical correlation ! -! ! -! external module variables: (in physcons) ! -! decorr_con : decorrelation length constant (km) ! -! ! -! external module variables: (in physparam) ! -! idcor : control flag for decorrelation length method ! -! =0: constant decorrelation length (decorr_con) ! -! =1: latitude and day-of-year varying decorrelation! -! length (AER; Oreopoulos, et al., 2012) ! -! ! -! ==================== end of description ===================== ! -! - use physparam, only: idcor - use physcons, only: decorr_con - implicit none -! Input - integer, intent(in) :: nlon, nlay - integer, intent(in) :: iovrlp - integer, intent(in) :: yearlen - real(kind_phys), dimension(:,:), intent(in) :: dzlay - real(kind_phys), dimension(:,:), intent(in) :: cldf - real(kind_phys), dimension(:), intent(in) :: latdeg - real(kind_phys), intent(in) :: juldat -! Output - real(kind_phys), dimension(:,:), intent(out):: alpha -! Local - integer :: i, k - real(kind_phys) :: decorr_len(nlon) ! Decorrelation length (km) -! Constants for latitude and day-of-year dependent decorrlation length (Oreopoulos et al, 2012) -! Used when idcor = 1 - real(kind_phys), parameter :: am1 = 1.4315_kind_phys - real(kind_phys), parameter :: am2 = 2.1219_kind_phys - real(kind_phys), parameter :: am4 = -25.584_kind_phys - real(kind_phys), parameter :: amr = 7.0_kind_phys - real(kind_phys) :: am3 - real(kind_phys), parameter :: zero = 0.0d0 - real(kind_phys), parameter :: one = 1.0d0 -! -!===> ... begin here -! -! If exponential or exponential-random cloud overlap is used: -! derive day-of-year and latitude-varying decorrelation lendth if requested; -! otherwise use the constant decorrelation length, decorr_con, specified in physcons.F90 - do i = 1, nlon - if (iovrlp == 4 .or. iovrlp == 5) then - if (idcor .eq. 1) then - if (juldat .gt. 181._kind_phys) then - am3 = -4._kind_phys * amr * (juldat - 272._kind_phys) / yearlen - else - am3 = 4._kind_phys * amr * (juldat - 91._kind_phys) / yearlen - endif -! For latitude in degrees, decorr_len in km - decorr_len(i) = am1 + am2 * exp( -(latdeg(i) - am3)**2 / am4**2) - else - decorr_len(i) = decorr_con - endif - endif - enddo -! For atmospheric data defined from surface to toa; define alpha from surface to toa -! Exponential cloud overlap - if (iovrlp == 4) then - do i = 1, nlon - alpha(i,1) = zero - do k = 2, nlay - alpha(i,k) = exp( -(dzlay(i,k)) / decorr_len(i)) - enddo - enddo - endif -! Exponential-random cloud overlap - if (iovrlp == 5) then - do i = 1, nlon - alpha(i,1) = zero - do k = 2, nlay - alpha(i,k) = exp( -(dzlay(i,k)) / decorr_len(i)) - ! Decorrelate layers when a clear layer follows a cloudy layer to enforce - ! random correlation between non-adjacent blocks of cloudy layers - if (cldf(i,k) .eq. zero .and. cldf(i,k-1) .gt. zero) then - alpha(i,k) = zero - endif - enddo - enddo - endif - return - end subroutine get_alpha_exp - end module GFS_rrtmgp_gfdlmp_pre diff --git a/physics/GFS_rrtmgp_gfdlmp_pre.meta b/physics/GFS_rrtmgp_gfdlmp_pre.meta index 67efc4b4f..932ffeb8f 100644 --- a/physics/GFS_rrtmgp_gfdlmp_pre.meta +++ b/physics/GFS_rrtmgp_gfdlmp_pre.meta @@ -364,7 +364,7 @@ dimensions = (horizontal_dimension,vertical_dimension) type = real kind = kind_phys - intent = in + intent = out optional = F [errmsg] standard_name = ccpp_error_message diff --git a/physics/GFS_rrtmgp_zhaocarr_pre.F90 b/physics/GFS_rrtmgp_zhaocarr_pre.F90 index edba20958..ac9fb7446 100644 --- a/physics/GFS_rrtmgp_zhaocarr_pre.F90 +++ b/physics/GFS_rrtmgp_zhaocarr_pre.F90 @@ -6,7 +6,8 @@ module GFS_rrtmgp_zhaocarr_pre use machine, only: kind_phys use rrtmgp_aux, only: check_error_msg use funcphys, only: fpvs - + use module_radiation_clouds, only: get_alpha_dcorr + ! Zhao-Carr MP parameters. real(kind_phys), parameter :: & reliq_def = 10.0 , & ! Default liq radius to 10 micron @@ -31,9 +32,9 @@ subroutine GFS_rrtmgp_zhaocarr_pre_run(nCol, nLev, nCnd, nTracers, i_cldliq, lss lslwr, effr_in, uni_cld, lmfshal, lat, lsmask, p_lev, p_lay, t_lay, relhum, & tv_lay, effrin_cldliq, effrin_cldice, effrin_cldrain, effrin_cldsnow, & shoc_sgs_cldfrac, cncvw, tracer, & - con_eps, con_epsq, con_epsqs, con_epsm1, con_g, con_ttp, con_rd, & + con_eps, con_epsq, con_epsqs, con_epsm1, con_g, con_ttp, con_rd, con_pi, & cld_frac, cld_lwp, cld_reliq, cld_iwp, cld_reice, cld_swp, cld_resnow, cld_rwp, & - cld_rerain, errmsg, errflg) + cld_rerain, de_lgth, deltaZ, cloud_overlap_param, errmsg, errflg) implicit none ! Inputs @@ -56,7 +57,8 @@ subroutine GFS_rrtmgp_zhaocarr_pre_run(nCol, nLev, nCnd, nTracers, i_cldliq, lss con_epsqs, & ! Floor value for saturation mixing ratio con_g, & ! Gravitational acceleration (m/s2) con_ttp, & ! Triple point temperature of water (K) - con_rd ! Ideal gas constant for dry air (J/kg/K) + con_rd, & ! Ideal gas constant for dry air (J/kg/K) + con_pi ! Pi real(kind_phys), dimension(nCol), intent(in) :: & lsmask, & ! Land/Sea mask lat ! Latitude @@ -77,6 +79,8 @@ subroutine GFS_rrtmgp_zhaocarr_pre_run(nCol, nLev, nCnd, nTracers, i_cldliq, lss tracer ! Cloud condensate amount in layer by type () ! Outputs + real(kind_phys), dimension(nCol),intent(out) :: & + de_lgth ! Decorrelation length real(kind_phys), dimension(nCol,nLev),intent(out) :: & cld_frac, & ! Total cloud fraction cld_lwp, & ! Cloud liquid water path @@ -86,8 +90,9 @@ subroutine GFS_rrtmgp_zhaocarr_pre_run(nCol, nLev, nCnd, nTracers, i_cldliq, lss cld_swp, & ! Cloud snow water path cld_resnow, & ! Cloud snow effective radius cld_rwp, & ! Cloud rain water path - cld_rerain ! Cloud rain effective radius - + cld_rerain, & ! Cloud rain effective radius + deltaZ, & ! Layer thickness (km) + cloud_overlap_param ! Cloud-overlap parameter character(len=*), intent(out) :: & errmsg ! Error message integer, intent(out) :: & @@ -96,7 +101,7 @@ subroutine GFS_rrtmgp_zhaocarr_pre_run(nCol, nLev, nCnd, nTracers, i_cldliq, lss ! Local variables real(kind_phys) :: tem1,tem2,tem3,clwt,onemrh,clwm,clwmin,es,qs,value real(kind_phys), dimension(nCol, nLev, min(4,nCnd)) :: cld_condensate - integer :: iCol,iLay,l,ncndl,iovr + integer :: iCol,iLay real(kind_phys), dimension(nCol,nLev) :: deltaP if (.not. (lsswr .or. lslwr)) return @@ -134,11 +139,6 @@ subroutine GFS_rrtmgp_zhaocarr_pre_run(nCol, nLev, nCnd, nTracers, i_cldliq, lss cld_reice(1:nCol,1:nLev) = effrin_cldice(1:nCol,1:nLev) cld_rerain(1:nCol,1:nLev) = effrin_cldrain(1:nCol,1:nLev) cld_resnow(1:nCol,1:nLev) = effrin_cldsnow(1:nCol,1:nLev) - else - cld_reliq(1:nCol,1:nLev) = reliq_def - cld_reice(1:nCol,1:nLev) = reice_def - cld_rerain(1:nCol,1:nLev) = rerain_def - cld_resnow(1:nCol,1:nLev) = resnow_def endif ! Use cloud-fraction from SHOC? @@ -152,10 +152,10 @@ subroutine GFS_rrtmgp_zhaocarr_pre_run(nCol, nLev, nCnd, nTracers, i_cldliq, lss do iCol = 1, nCol es = min( p_lay(iCol,iLay), fpvs( t_lay(iCol,iLay) ) ) ! fpvs and prsl in pa qs = max( con_epsqs, con_eps * es / (p_lay(iCol,iLay) + con_epsm1*es) ) - clwt = 1.0e-6 * (p_lay(iCol,iLay)*0.001) + clwt = 1.0e-6 * (p_lay(iCol,iLay)*0.00001) if (cld_condensate(iCol,iLay,1) > clwt) then onemrh= max( 1.e-10, 1.0-relhum(iCol,iLay) ) - clwm = clwmin / max( 0.01, p_lay(iCol,iLay)*0.001 ) + clwm = clwmin / max( 0.01, p_lay(iCol,iLay)*0.00001 ) tem1 = min(max(sqrt(sqrt(onemrh*qs)),0.0001),1.0) tem1 = 2000.0 / tem1 value = max( min( tem1*(cld_condensate(iCol,iLay,1)-clwm), 50.0 ), 0.0 ) @@ -169,10 +169,10 @@ subroutine GFS_rrtmgp_zhaocarr_pre_run(nCol, nLev, nCnd, nTracers, i_cldliq, lss do iCol = 1, nCol es = min( p_lay(iCol,iLay), fpvs( t_lay(iCol,iLay) ) ) ! fpvs and prsl in pa qs = max( con_epsqs, con_eps * es / (p_lay(iCol,iLay) + con_epsm1*es) ) - clwt = 1.0e-6 * (p_lay(iCol,iLay)*0.001) + clwt = 1.0e-6 * (p_lay(iCol,iLay)*0.00001) if (cld_condensate(iCol,iLay,1) > clwt) then onemrh= max( 1.e-10, 1.0-relhum(iCol,iLay) ) - clwm = clwmin / max( 0.01, p_lay(iCol,iLay)*0.001 ) + clwm = clwmin / max( 0.01, p_lay(iCol,iLay)*0.00001 ) tem1 = min(max((onemrh*qs)**0.49,0.0001),1.0) !jhan tem1 = 100.0 / tem1 value = max( min( tem1*(cld_condensate(iCol,iLay,1)-clwm), 50.0 ), 0.0 ) @@ -190,6 +190,7 @@ subroutine GFS_rrtmgp_zhaocarr_pre_run(nCol, nLev, nCnd, nTracers, i_cldliq, lss cld_condensate(1:nCol,1:nLev,1) = cld_condensate(1:nCol,1:nLev,1) + cncvw(1:nCol,1:nLev) ! Compute cloud liquid/ice condensate path. + deltaP = abs(p_lev(:,2:nLev+1)-p_lev(:,1:nLev))/100. do iLay=1,nLev do iCol=1,nCol tem1 = max(0.0, cld_condensate(iCol,iLay,1)) * (1.0e5/con_g) * deltaP(iCol,iLay) @@ -207,17 +208,14 @@ subroutine GFS_rrtmgp_zhaocarr_pre_run(nCol, nLev, nCnd, nTracers, i_cldliq, lss enddo endif enddo - endif - ! Compute effective ice cloud droplet radius following Heymsfield - ! and McFarquhar (1996) \cite heymsfield_and_mcfarquhar_1996. - if(.not. effr_in) then - deltaP = abs(p_lev(:,2:nLev+1)-p_lev(:,1:nLev))/100. + ! Compute effective ice cloud droplet radius following Heymsfield + ! and McFarquhar (1996) \cite heymsfield_and_mcfarquhar_1996. do iLay=1,nLev do iCol=1,nCol tem2 = t_lay(iCol,iLay) - con_ttp if (cld_iwp(iCol,iLay) > 0.0) then - tem3 = (con_g/con_rd ) * cld_iwp(iCol,iLay) * p_lay(iCol,iLay) / (deltaP(iCol,iLay)*tv_lay(iCol,iLay)) + tem3 = (con_g/con_rd ) * cld_iwp(iCol,iLay) * (0.01*p_lay(iCol,iLay)) / (deltaP(iCol,iLay)*tv_lay(iCol,iLay)) if (tem2 < -50.0) then cld_reice(iCol,iLay) = (1250.0/9.917) * tem3 ** 0.109 elseif (tem2 < -40.0) then @@ -232,7 +230,19 @@ subroutine GFS_rrtmgp_zhaocarr_pre_run(nCol, nLev, nCnd, nTracers, i_cldliq, lss enddo enddo endif - + + ! #################################################################################### + ! Cloud (and precipitation) overlap ! #################################################################################### + ! Compute layer-thickness + do iCol=1,nCol + do iLay=1,nLev + deltaZ(iCol,iLay) = ((con_rd/con_g)*0.001) * abs(log(p_lev(iCol,iLay)) - log(p_lev(iCol,iLay+1))) * tv_lay(iCol,iLay) + enddo + enddo + + ! Cloud overlap parameter + call get_alpha_dcorr(nCol, nLev, lat, con_pi, deltaZ, de_lgth, cloud_overlap_param) + end subroutine GFS_rrtmgp_zhaocarr_pre_run ! ######################################################################################### diff --git a/physics/GFS_rrtmgp_zhaocarr_pre.meta b/physics/GFS_rrtmgp_zhaocarr_pre.meta index bf72d7400..052da5798 100644 --- a/physics/GFS_rrtmgp_zhaocarr_pre.meta +++ b/physics/GFS_rrtmgp_zhaocarr_pre.meta @@ -270,6 +270,15 @@ kind = kind_phys intent = in optional = F +[con_pi] + standard_name = pi + long_name = ratio of a circle's circumference to its diameter + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F [cld_frac] standard_name = total_cloud_fraction long_name = layer total cloud fraction @@ -351,6 +360,33 @@ kind = kind_phys intent = out optional = F +[cloud_overlap_param] + standard_name = cloud_overlap_param + long_name = cloud overlap parameter + units = km + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[deltaZ] + standard_name = layer_thickness + long_name = layer_thickness + units = m + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[de_lgth] + standard_name = cloud_decorrelation_length + long_name = cloud decorrelation length + units = km + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/physcons.F90 b/physics/physcons.F90 index 8fbdc9930..6a41bda44 100644 --- a/physics/physcons.F90 +++ b/physics/physcons.F90 @@ -79,6 +79,7 @@ module physcons real(kind=kind_phys),parameter:: con_jcal =4.1855E+0_kind_phys !< joules per calorie real(kind=kind_phys),parameter:: con_rhw0 =1022.0_kind_phys !< sea water reference density (\f$kg/m^{3}\f$) real(kind=kind_phys),parameter:: con_epsq =1.0E-12_kind_phys !< min q for computing precip type + real(kind=kind_phys),parameter:: con_epsqs =1.0E-10_kind_phys ! Selected thermodynamics constants with kind=kind_dyn real(kind=kind_dyn), parameter:: con_rd_dyn =2.8705e+2_kind_dyn !< gas constant air (\f$J/kg/K\f$) real(kind=kind_dyn), parameter:: con_rv_dyn =4.6150e+2_kind_dyn !< gas constant H2O (\f$J/kg/K\f$) diff --git a/physics/radiation_clouds.f b/physics/radiation_clouds.f index 5b4aa54ab..f6d7e32cb 100644 --- a/physics/radiation_clouds.f +++ b/physics/radiation_clouds.f @@ -243,7 +243,8 @@ module module_radiation_clouds integer :: iovr = 1 !< maximum-random cloud overlapping method public progcld1, progcld2, progcld3, progcld4, progclduni, & - & cld_init, progcld5, progcld4o, gethml + & cld_init, progcld5, progcld4o, gethml, & + & get_alpha_dcorr, get_alpha_exp ! ================= @@ -3451,6 +3452,204 @@ subroutine gethml & end subroutine gethml !----------------------------------- !! @} + ! ######################################################################################### + ! Subroutine to compute cloud-overlap parameter, alpha, for decorrelation-length cloud + ! overlap assumption. + ! ######################################################################################### + subroutine get_alpha_dcorr(nCol, nLev, lat, con_pi, deltaZ, & + & de_lgth, cloud_overlap_param) + + integer, intent(in) :: nCol, nLev + real(kind_phys), intent(in) :: con_pi + real(kind_phys), dimension(nCol), intent(in) :: lat + real(kind_phys), dimension(nCol,nLev),intent(in) :: deltaZ + real(kind_phys), dimension(nCol),intent(out) :: de_lgth + real(kind_phys), dimension(nCol,nLev),intent(out) :: & + & cloud_overlap_param + + ! Local + integer :: iCol, iLay + + do iCol =1,nCol + de_lgth(iCol) = max( 0.6, 2.78-4.6*abs(lat(iCol)/con_pi) ) + do iLay=nLev,2,-1 + if (de_lgth(iCol) .gt. 0) then + cloud_overlap_param(iCol,iLay-1) = & + & exp( -0.5 * (deltaZ(iCol,iLay)+deltaZ(iCol,iLay-1))/& + & de_lgth(iCol)) + endif + enddo + enddo + end subroutine get_alpha_dcorr + + ! ######################################################################################### +!> \ingroup module_radiation_clouds +!! This program derives the exponential transition, alpha, from maximum to +!! random overlap needed to define the fractional cloud vertical correlation +!! for the exponential (EXP, iovrlp=4) or the exponential-random (ER, iovrlp=5) +!! cloud overlap options for RRTMGP. For exponential, the transition from +!! maximum to random with distance through model layers occurs without regard +!! to the configuration of clear and cloudy layers. For the ER method, each +!! block of adjacent cloudy layers is treated with a separate transition from +!! maximum to random, and blocks of cloudy layers separated by one or more +!! clear layers are correlated randomly. +!> /param nlon : number of model longitude points +!> /param nlay : vertical layer dimension +!> /param dzlay(nlon,nlay) : distance between the center of model layers +!> /param iovrlp : cloud overlap method +!> : 0 = random +!> : 1 = maximum-random +!> : 2 = maximum +!> : 3 = decorrelation (NOAA/Hou) +!> : 4 = exponential (AER) +!> : 5 = exponential-random (AER) +!> /param latdeg(nlon) : latitude (in degrees 90 -> -90) +!> /param juldat : day of the year (fractional julian day) +!> /param yearlen : current length of the year (365/366 days) +!> /param cldf(nlon,nlay) : cloud fraction +!> /param idcor : decorrelation length method +!> : 0 = constant value (AER; decorr_con) +!> : 1 = latitude and day of year varying value (AER; Oreopoulos, et al., 2012) +!> /param decorr_con : decorrelation length constant +!! +!>\section detail Detailed Algorithm +!! @{ + subroutine get_alpha_exp(nlon, nlay, dzlay, iovrlp, latdeg, & + & juldat, yearlen, cldf, alpha) +! =================================================================== ! +! ! +! abstract: Derives the exponential transition, alpha, from maximum to ! +! random overlap needed to define the fractional cloud vertical ! +! correlation for the exponential (EXP, iovrlp=4) or the exponential- ! +! random (ER, iovrlp=5) cloud overlap options for RRTMG. For ! +! exponential, the transition from maximum to random with distance ! +! through model layers occurs without regard to the configuration of ! +! clear and cloudy layers. For the ER method, each block of adjacent ! +! cloudy layers is treated with a separate transition from maximum to ! +! random, and blocks of cloudy layers separated by one or more ! +! clear layers are correlated randomly. ! +! ! +! usage: call get_alpha ! +! ! +! subprograms called: none ! +! ! +! attributes: ! +! language: fortran 90 ! +! machine: ibm-sp, sgi ! +! ! +! author: m.j. iacono (AER) for use with the RRTMG radiation code ! +! ! +! ==================== definition of variables ==================== ! +! ! +! Input variables: ! +! nlon : number of model longitude points ! +! nlay : vertical layer dimension ! +! dzlay(nlon,nlay) : distance between the center of model layers ! +! iovrlp : cloud overlap method ! +! : 0 = random ! +! : 1 = maximum-random ! +! : 2 = maximum ! +! : 3 = decorrelation (NOAA/Hou) ! +! : 4 = exponential (AER) ! +! : 5 = exponential-random (AER) ! +! latdeg(nlon) : latitude (in degrees 90 -> -90) ! +! juldat : day of the year (fractional julian day) ! +! yearlen : current length of the year (365/366 days) ! +! cldf(nlon,nlay) : cloud fraction ! +! ! +! output variables: ! +! alpha(nlon,nlay) : alpha exponential transition parameter for ! +! : cloud vertical correlation ! +! ! +! external module variables: (in physcons) ! +! decorr_con : decorrelation length constant (km) ! +! ! +! external module variables: (in physparam) ! +! idcor : control flag for decorrelation length method ! +! =0: constant decorrelation length (decorr_con) ! +! =1: latitude and day-of-year varying decorrelation! +! length (AER; Oreopoulos, et al., 2012) ! +! ! +! ==================== end of description ===================== ! +! + use physparam, only: idcor + use physcons, only: decorr_con + implicit none +! Input + integer, intent(in) :: nlon, nlay + integer, intent(in) :: iovrlp + integer, intent(in) :: yearlen + real(kind_phys), dimension(:,:), intent(in) :: dzlay + real(kind_phys), dimension(:,:), intent(in) :: cldf + real(kind_phys), dimension(:), intent(in) :: latdeg + real(kind_phys), intent(in) :: juldat +! Output + real(kind_phys), dimension(:,:), intent(out):: alpha +! Local + integer :: i, k + real(kind_phys) :: decorr_len(nlon) ! Decorrelation length (km) +! Constants for latitude and day-of-year dependent decorrlation length (Oreopoulos et al, 2012) +! Used when idcor = 1 + real(kind_phys), parameter :: am1 = 1.4315_kind_phys + real(kind_phys), parameter :: am2 = 2.1219_kind_phys + real(kind_phys), parameter :: am4 = -25.584_kind_phys + real(kind_phys), parameter :: amr = 7.0_kind_phys + real(kind_phys) :: am3 + real(kind_phys), parameter :: zero = 0.0d0 + real(kind_phys), parameter :: one = 1.0d0 +! +!===> ... begin here +! +! If exponential or exponential-random cloud overlap is used: +! derive day-of-year and latitude-varying decorrelation lendth if requested; +! otherwise use the constant decorrelation length, decorr_con, specified in physcons.F90 + do i = 1, nlon + if (iovrlp == 4 .or. iovrlp == 5) then + if (idcor .eq. 1) then + if (juldat .gt. 181._kind_phys) then + am3 = -4._kind_phys * amr * (juldat - 272._kind_phys)/& + & yearlen + else + am3 = 4._kind_phys * amr * (juldat - 91._kind_phys) / & + & yearlen + endif +! For latitude in degrees, decorr_len in km + decorr_len(i) = am1 + am2 * exp( -(latdeg(i) - am3)**2 / & + & am4**2) + else + decorr_len(i) = decorr_con + endif + endif + enddo +! For atmospheric data defined from surface to toa; define alpha from surface to toa +! Exponential cloud overlap + if (iovrlp == 4) then + do i = 1, nlon + alpha(i,1) = zero + do k = 2, nlay + alpha(i,k) = exp( -(dzlay(i,k)) / decorr_len(i)) + enddo + enddo + endif +! Exponential-random cloud overlap + if (iovrlp == 5) then + do i = 1, nlon + alpha(i,1) = zero + do k = 2, nlay + alpha(i,k) = exp( -(dzlay(i,k)) / decorr_len(i)) + ! Decorrelate layers when a clear layer follows a cloudy layer to enforce + ! random correlation between non-adjacent blocks of cloudy layers + if (cldf(i,k) .eq. zero .and. cldf(i,k-1) .gt. zero) then + alpha(i,k) = zero + endif + enddo + enddo + endif + + return + end subroutine get_alpha_exp + + ! !........................................!