diff --git a/CONTRIBUTORS.md b/CONTRIBUTORS.md index d0daddc6..8d9ccac1 100644 --- a/CONTRIBUTORS.md +++ b/CONTRIBUTORS.md @@ -16,3 +16,4 @@ | mo-alistairp | Alistair Pirrie | Met Office | 2026-01-19 | | jasonjunweilyu | Junwei (Jason) Lyu | Bureau of Meteorology, Australia | 2025-12-17 | | EdHone | Ed Hone | Met Office | 2026-01-26 | +| alanjhewitt | Alan J Hewitt | Met Office | 2026-01-28 | \ No newline at end of file diff --git a/build/extract/extract.yaml b/build/extract/extract.yaml index d5fdeebe..04e7eda2 100644 --- a/build/extract/extract.yaml +++ b/build/extract/extract.yaml @@ -355,6 +355,7 @@ ukca: - src/science/radaer/spcrg3a_mod.F90 - src/science/radaer/ukca_radaer_band_average.F90 - src/science/radaer/ukca_radaer_compute_aod.F90 + - src/science/radaer/ukca_radaer_lfric_mod.F90 - src/science/radaer/ukca_radaer_lut_mod.F90 - src/science/radaer/ukca_radaer_populate_lut_mod.F90 - src/science/radaer/ukca_radaer_precalc_mod.F90 diff --git a/dependencies.yaml b/dependencies.yaml index a52d14b2..13cd8cf9 100644 --- a/dependencies.yaml +++ b/dependencies.yaml @@ -52,3 +52,5 @@ socrates-spectral: ukca: source: git@github.com:MetOffice/ukca.git ref: 2025.12.1 + +#gotta point at ukca branch diff --git a/interfaces/physics_schemes_interface/source/algorithm/radaer_alg_mod.x90 b/interfaces/physics_schemes_interface/source/algorithm/radaer_alg_mod.x90 index 2b1cde14..a9211541 100644 --- a/interfaces/physics_schemes_interface/source/algorithm/radaer_alg_mod.x90 +++ b/interfaces/physics_schemes_interface/source/algorithm/radaer_alg_mod.x90 @@ -10,28 +10,28 @@ module radaer_alg_mod ! Derived Types use field_mod, only: field_type use integer_field_mod, only: integer_field_type - use field_collection_mod, & + use field_collection_mod, & only: field_collection_type use function_space_mod, only: function_space_type - use function_space_collection_mod, & + use function_space_collection_mod, & only: function_space_collection use socrates_init_mod, only: n_sw_band, n_lw_band - use io_config_mod, only: use_xios_io, & + use io_config_mod, only: use_xios_io, & write_diag use timing_mod, only: start_timing, stop_timing, tik, LPROF use constants_mod, only: i_def, l_def - use radiation_config_mod, & + use radiation_config_mod, & only: n_radstep use aerosol_config_mod, only: n_radaer_step use mesh_mod, only: mesh_type - use multires_coupling_config_mod, & - only: lowest_order_aero_flag, & + use multires_coupling_config_mod, & + only: lowest_order_aero_flag, & coarse_rad_aerosol - use multidata_field_dimensions_mod, & + use multidata_field_dimensions_mod, & only: get_ndata_val => get_multidata_field_dimension use fs_continuity_mod, only: Wtheta, W3 - use intermesh_mappings_alg_mod, & - only: map_scalar_intermesh, & + use intermesh_mappings_alg_mod, & + only: map_scalar_intermesh, & map_mr_intermesh use radaer_main_diags_mod, only: initialise_main_diags_for_radaer, & @@ -75,6 +75,7 @@ contains timestep ) use radaer_kernel_mod, only: radaer_kernel_type + use um_sizes_init_mod, only: um_sizes_init implicit none @@ -92,6 +93,7 @@ contains type(mesh_type), intent( in ), pointer :: aerosol_mesh type(mesh_type), intent( in ), pointer :: aerosol_twod_mesh integer( kind=i_def ), intent( in ) :: timestep + integer( kind=i_def ) :: ncells type(function_space_type), pointer :: w3_2d_aero => null() type(function_space_type), pointer :: wth_aero => null() @@ -179,17 +181,17 @@ contains type( field_type ), pointer :: n_cor_ins_aero => null() type( field_type ), pointer :: cor_ins_du_aero => null() - type( field_type ), target :: lit_fraction_rts_coarse, & - aer_mix_ratio_coarse, & - aer_sw_absorption_coarse, & - aer_sw_scattering_coarse, & - aer_sw_asymmetry_coarse, & - aer_lw_absorption_coarse, & - aer_lw_scattering_coarse, & - aer_lw_asymmetry_coarse, & - n_acc_ins_coarse, & - acc_ins_du_coarse, & - n_cor_ins_coarse, & + type( field_type ), target :: lit_fraction_rts_coarse, & + aer_mix_ratio_coarse, & + aer_sw_absorption_coarse, & + aer_sw_scattering_coarse, & + aer_sw_asymmetry_coarse, & + aer_lw_absorption_coarse, & + aer_lw_scattering_coarse, & + aer_lw_asymmetry_coarse, & + n_acc_ins_coarse, & + acc_ins_du_coarse, & + n_cor_ins_coarse, & cor_ins_du_coarse type( field_type ) :: aod_ukca_ait_sol @@ -276,10 +278,11 @@ contains call radiation_fields%get_field('aer_lw_absorption', aer_lw_absorption) call radiation_fields%get_field('aer_lw_scattering', aer_lw_scattering) call radiation_fields%get_field('aer_lw_asymmetry', aer_lw_asymmetry) - ! If coarse RADAER, initialise new coarse fields, map data, and point to them + ! If coarse RADAER, initialise new coarse fields, map data, and + ! point to them w3_2d_aero => function_space_collection%get_fs( aerosol_twod_mesh, & 0, 0, W3) - wth_aero => function_space_collection%get_fs( aerosol_mesh, & + wth_aero => function_space_collection%get_fs( aerosol_mesh, & 0, 0, WTHETA ) call cor_ins_du_coarse%initialise(vector_space = wth_aero) call acc_ins_du_coarse%initialise(vector_space = wth_aero) @@ -290,35 +293,38 @@ contains call aerosol_fields%get_field('n_cor_ins', n_cor_ins) call aerosol_fields%get_field('cor_ins_du', cor_ins_du) - wth_aero => function_space_collection%get_fs( aerosol_mesh, & - 0, 0, WTHETA, & - get_ndata_val('aero_modes') ) + wth_aero => function_space_collection%get_fs( & + aerosol_mesh, & + 0, 0, WTHETA, & + get_ndata_val('aero_modes') ) call aer_mix_ratio_coarse%initialise(vector_space = wth_aero) - wth_aero => function_space_collection%get_fs( aerosol_mesh, & - 0, 0, WTHETA, & - get_ndata_val('sw_bands_aero_modes') ) + wth_aero => function_space_collection%get_fs( & + aerosol_mesh, & + 0, 0, WTHETA, & + get_ndata_val('sw_bands_aero_modes') ) call aer_sw_absorption_coarse%initialise(vector_space = wth_aero) call aer_sw_scattering_coarse%initialise(vector_space = wth_aero) call aer_sw_asymmetry_coarse%initialise(vector_space = wth_aero) - wth_aero => function_space_collection%get_fs( aerosol_mesh, & - 0, 0, WTHETA, & - get_ndata_val('lw_bands_aero_modes') ) + wth_aero => function_space_collection%get_fs( & + aerosol_mesh, & + 0, 0, WTHETA, & + get_ndata_val('lw_bands_aero_modes') ) call aer_lw_absorption_coarse%initialise(vector_space = wth_aero) call aer_lw_scattering_coarse%initialise(vector_space = wth_aero) call aer_lw_asymmetry_coarse%initialise(vector_space = wth_aero) call lit_fraction_rts_coarse%initialise(vector_space = w3_2d_aero) - call invoke(setval_c(lit_fraction_rts_coarse, 1.0_r_def), & - setval_c(aer_mix_ratio_coarse, 0.0_r_def), & - setval_c(aer_sw_absorption_coarse, 0.0_r_def), & - setval_c(aer_sw_scattering_coarse, 0.0_r_def), & - setval_c(aer_sw_asymmetry_coarse, 0.0_r_def), & - setval_c(aer_lw_absorption_coarse, 0.0_r_def), & - setval_c( aer_lw_scattering_coarse, 0.0_r_def), & - setval_c( aer_lw_asymmetry_coarse, 0.0_r_def) ) + call invoke(setval_c(lit_fraction_rts_coarse, 1.0_r_def), & + setval_c(aer_mix_ratio_coarse, 0.0_r_def), & + setval_c(aer_sw_absorption_coarse, 0.0_r_def), & + setval_c(aer_sw_scattering_coarse, 0.0_r_def), & + setval_c(aer_sw_asymmetry_coarse, 0.0_r_def), & + setval_c(aer_lw_absorption_coarse, 0.0_r_def), & + setval_c( aer_lw_scattering_coarse, 0.0_r_def), & + setval_c( aer_lw_asymmetry_coarse, 0.0_r_def) ) call map_scalar_intermesh(lit_fraction_rts_coarse, lit_fraction_rts) call map_mr_intermesh(n_acc_ins_coarse, n_acc_ins, rho_aero, rho) @@ -341,14 +347,21 @@ contains cor_ins_du_aero => cor_ins_du_coarse else ! Unpack RADAER fields for radiation - call radiation_fields%get_field('lit_fraction_rts', lit_fraction_rts_aero) + call radiation_fields%get_field('lit_fraction_rts', & + lit_fraction_rts_aero) call radiation_fields%get_field('aer_mix_ratio', aer_mix_ratio_aero) - call radiation_fields%get_field('aer_sw_absorption', aer_sw_absorption_aero) - call radiation_fields%get_field('aer_sw_scattering', aer_sw_scattering_aero) - call radiation_fields%get_field('aer_sw_asymmetry', aer_sw_asymmetry_aero) - call radiation_fields%get_field('aer_lw_absorption', aer_lw_absorption_aero) - call radiation_fields%get_field('aer_lw_scattering', aer_lw_scattering_aero) - call radiation_fields%get_field('aer_lw_asymmetry', aer_lw_asymmetry_aero) + call radiation_fields%get_field('aer_sw_absorption', & + aer_sw_absorption_aero) + call radiation_fields%get_field('aer_sw_scattering', & + aer_sw_scattering_aero) + call radiation_fields%get_field('aer_sw_asymmetry', & + aer_sw_asymmetry_aero) + call radiation_fields%get_field('aer_lw_absorption', & + aer_lw_absorption_aero) + call radiation_fields%get_field('aer_lw_scattering', & + aer_lw_scattering_aero) + call radiation_fields%get_field('aer_lw_asymmetry', & + aer_lw_asymmetry_aero) ! Unpack RADAER fields for aerosol call aerosol_fields%get_field('n_acc_ins', n_acc_ins_aero) @@ -372,6 +385,9 @@ contains aaod_ukca_cor_ins, & trop_level ) + ncells = mesh%get_last_edge_cell() + call um_sizes_init(ncells) + call invoke( radaer_kernel_type( theta_in_wth, & exner_in_wth, & exner_in_w3, & @@ -453,6 +469,8 @@ contains aod_ukca_cor_ins, & aaod_ukca_cor_ins ) ) + call um_sizes_init(1_i_def) + if ( coarse_rad_aerosol ) then call map_scalar_intermesh( aer_mix_ratio, aer_mix_ratio_aero, & source_mask=lit_fraction_rts_aero, & diff --git a/interfaces/physics_schemes_interface/source/kernel/radaer_kernel_mod.F90 b/interfaces/physics_schemes_interface/source/kernel/radaer_kernel_mod.F90 index 1a25974f..6d6ad1b5 100644 --- a/interfaces/physics_schemes_interface/source/kernel/radaer_kernel_mod.F90 +++ b/interfaces/physics_schemes_interface/source/kernel/radaer_kernel_mod.F90 @@ -11,7 +11,7 @@ module radaer_kernel_mod use argument_mod, only: arg_type, & GH_FIELD, GH_REAL, GH_READ, GH_WRITE, & - CELL_COLUMN, GH_INTEGER, & + DOMAIN, GH_INTEGER, & ANY_DISCONTINUOUS_SPACE_1, & ANY_DISCONTINUOUS_SPACE_2, & ANY_DISCONTINUOUS_SPACE_3, & @@ -137,7 +137,7 @@ module radaer_kernel_mod ! aaod_ukca_cor_ins arg_type(GH_FIELD, GH_REAL, GH_WRITE, ANY_DISCONTINUOUS_SPACE_5) & /) - integer :: operates_on = CELL_COLUMN + integer :: operates_on = DOMAIN contains procedure, nopass :: radaer_code end type @@ -148,6 +148,7 @@ module radaer_kernel_mod !> @brief Interface to glomap aerosol climatology scheme. !> @param[in] nlayers The number of layers +!> @param[in] ncells Number of horizontal cells in segment !> @param[in] theta_in_wth Potential temperature field !> @param[in] exner_in_wth Exner pressure !> in potential temperature space @@ -261,6 +262,7 @@ module radaer_kernel_mod !> column for aod_wavel subroutine radaer_code( nlayers, & + ncells, & theta_in_wth, & exner_in_wth, & exner_in_w3, & @@ -349,21 +351,16 @@ subroutine radaer_code( nlayers, & ndf_rmode_lw, undf_rmode_lw, map_rmode_lw, & ndf_aod_wavel, undf_aod_wavel, map_aod_wavel ) - use constants_mod, only: r_def, i_def, r_um, i_um use aerosol_config_mod, only: n_radaer_step use socrates_init_mod, only: n_sw_band, & - sw_n_band_exclude, & sw_index_exclude, & n_lw_band, & - lw_n_band_exclude, & lw_index_exclude use um_physics_init_mod, only: n_radaer_mode, & n_aer_mode_sw, n_aer_mode_lw - use nlsizes_namelist_mod, only: row_length, rows - use ukca_mode_setup, only: nmodes, ncp_max, & mode_nuc_sol, & mode_ait_sol, mode_acc_sol, & @@ -372,16 +369,7 @@ subroutine radaer_code( nlayers, & cp_su, cp_bc, cp_oc, & cp_cl, cp_du, cp_so, & cp_no3, cp_nn, cp_nh4, & - i_ukca_bc_tuned, & - ip_ukca_mode_aitken, & - ip_ukca_mode_accum, & - ip_ukca_mode_coarse - - use ukca_radaer_band_average_mod, only: ukca_radaer_band_average - - use ukca_radaer_prepare_mod, only: ukca_radaer_prepare - - use ukca_radaer_compute_aod_mod, only: ukca_radaer_compute_aod + i_ukca_bc_tuned use planet_config_mod, only: p_zero, kappa, gravity @@ -389,39 +377,45 @@ subroutine radaer_code( nlayers, & use ukca_option_mod, only: do_not_prescribe + use ukca_radaer_lfric_mod, only: ukca_radaer_lfric_interface + implicit none ! Arguments integer(kind=i_def), intent(in) :: nlayers + integer(kind=i_def), intent(in) :: ncells integer(kind=i_def), intent(in) :: ndf_wth integer(kind=i_def), intent(in) :: undf_wth - integer(kind=i_def), dimension(ndf_wth), intent(in) :: map_wth + integer(kind=i_def), dimension(ndf_wth, ncells), intent(in) :: map_wth integer(kind=i_def), intent(in) :: ndf_w3 integer(kind=i_def), intent(in) :: undf_w3 - integer(kind=i_def), dimension(ndf_w3), intent(in) :: map_w3 + integer(kind=i_def), dimension(ndf_w3, ncells), intent(in) :: map_w3 integer(kind=i_def), intent(in) :: ndf_2d integer(kind=i_def), intent(in) :: undf_2d - integer(kind=i_def), dimension(ndf_2d), intent(in) :: map_2d + integer(kind=i_def), dimension(ndf_2d, ncells), intent(in) :: map_2d integer(kind=i_def), intent(in) :: ndf_mode integer(kind=i_def), intent(in) :: undf_mode - integer(kind=i_def), dimension(ndf_mode), intent(in) :: map_mode + integer(kind=i_def), dimension(ndf_mode, ncells), intent(in) :: map_mode integer(kind=i_def), intent(in) :: ndf_rmode_sw integer(kind=i_def), intent(in) :: undf_rmode_sw - integer(kind=i_def), dimension(ndf_rmode_sw), intent(in) :: map_rmode_sw + integer(kind=i_def), dimension(ndf_rmode_sw, ncells), intent(in) :: & + map_rmode_sw integer(kind=i_def), intent(in) :: ndf_rmode_lw integer(kind=i_def), intent(in) :: undf_rmode_lw - integer(kind=i_def), dimension(ndf_rmode_lw), intent(in) :: map_rmode_lw + integer(kind=i_def), dimension(ndf_rmode_lw, ncells), intent(in) :: & + map_rmode_lw integer(kind=i_def), intent(in) :: ndf_aod_wavel integer(kind=i_def), intent(in) :: undf_aod_wavel - integer(kind=i_def), dimension(ndf_aod_wavel), intent(in) :: map_aod_wavel + integer(kind=i_def), dimension(ndf_aod_wavel, ncells), intent(in) :: & + map_aod_wavel real(kind=r_def), intent(in), dimension(undf_wth) :: theta_in_wth real(kind=r_def), intent(in), dimension(undf_wth) :: exner_in_wth @@ -523,8 +517,6 @@ subroutine radaer_code( nlayers, & integer(i_um), parameter :: ip_solar = 1 integer(i_um), parameter :: ip_infra_red = 2 - integer(i_um) :: npd_profile - ! Prescribed single-scattering albedo dummy variables ! Make these namelist options later integer, parameter :: i_ukca_radaer_prescribe_ssa = do_not_prescribe @@ -535,64 +527,45 @@ subroutine radaer_code( nlayers, & ukca_radaer_presc_ssa ! Loop counters - integer(i_um) :: k, i, i_band, i_mode, i_rmode + integer(i_um) :: k, i, ii, i_band, i_mode, i_rmode , j, jj + + integer(i_um), dimension(:), allocatable :: trindxrad_um ! pressure on theta levels - real(r_um),dimension( row_length, rows, nlayers ) :: p_theta_levels + real(r_um), dimension(:,:), allocatable :: p_theta_levels_um ! temperature on theta levels - real(r_um),dimension( row_length, rows, nlayers ) :: t_theta_levels + real(r_um), dimension(:,:), allocatable :: t_theta_levels_um ! d_mass on theta levels - real(r_um),dimension( row_length, rows, nlayers ) :: d_mass_theta_levels_um - - real(r_um),dimension( n_ukca_cpnt, row_length*rows, nlayers ) :: & - ukca_comp_vol_um - - real(r_um),dimension( n_ukca_cpnt, row_length*rows, nlayers ) :: & - ukca_mix_ratio_um - - real(r_um),dimension( row_length*rows, nlayers, n_ukca_mode ) :: & - ukca_dry_diam_um - - real(r_um),dimension( row_length*rows, nlayers, n_ukca_mode ) :: & - ukca_wet_diam_um - - real(r_um),dimension( row_length*rows, nlayers, n_ukca_mode ) :: & - ukca_modal_nbr_um - - real(r_um),dimension( row_length*rows, nlayers, n_ukca_mode ) :: & - ukca_modal_number_um - - real(r_um),dimension( row_length*rows, nlayers, n_ukca_mode ) :: & - ukca_modal_rho_um - - real(r_um),dimension( row_length*rows, nlayers, n_ukca_mode ) :: & - ukca_modal_vol_um - - real(r_um),dimension( row_length*rows, nlayers, n_ukca_mode ) :: & - ukca_modal_wtv_um - - real(r_um),dimension( row_length*rows, nlayers, n_radaer_mode) :: & - ukca_mode_mix_ratio_um + real(r_um), dimension(:,:), allocatable :: d_mass_theta_levels_um + + real(r_um), dimension(:,:,:), allocatable :: ukca_comp_vol_um + real(r_um), dimension(:,:,:), allocatable :: ukca_mix_ratio_um + real(r_um), dimension(:,:,:), allocatable :: ukca_dry_diam_um + real(r_um), dimension(:,:,:), allocatable :: ukca_wet_diam_um + real(r_um), dimension(:,:,:), allocatable :: ukca_modal_nbr_um + real(r_um), dimension(:,:,:), allocatable :: ukca_modal_rho_um + real(r_um), dimension(:,:,:), allocatable :: ukca_modal_vol_um + real(r_um), dimension(:,:,:), allocatable :: ukca_modal_wtv_um + real(r_um), dimension(:,:,:), allocatable :: ukca_mode_mix_ratio_um + + real(r_um), dimension(:,:,:,:), allocatable :: aer_lw_absorption_um + real(r_um), dimension(:,:,:,:), allocatable :: aer_lw_scattering_um + real(r_um), dimension(:,:,:,:), allocatable :: aer_lw_asymmetry_um + real(r_um), dimension(:,:,:,:), allocatable :: aer_sw_absorption_um + real(r_um), dimension(:,:,:,:), allocatable :: aer_sw_scattering_um + real(r_um), dimension(:,:,:,:), allocatable :: aer_sw_asymmetry_um + + ! UKCA modal optical depth diagnostics: full domain + real(r_um), dimension(:,:,:), allocatable :: aod_ukca_all_modes_um - real(r_um),dimension( row_length*rows, nlayers, n_radaer_mode, n_lw_band) :: & - aer_lw_absorption_um - - real(r_um),dimension( row_length*rows, nlayers, n_radaer_mode, n_lw_band) :: & - aer_lw_scattering_um - - real(r_um),dimension( row_length*rows, nlayers, n_radaer_mode, n_lw_band) :: & - aer_lw_asymmetry_um - - real(r_um),dimension( row_length*rows, nlayers, n_radaer_mode, n_sw_band) :: & - aer_sw_absorption_um - - real(r_um),dimension( row_length*rows, nlayers, n_radaer_mode, n_sw_band) :: & - aer_sw_scattering_um + ! Not yet included as diagnostic + ! UKCA modal optical depth diagnostics: stratosphere + real(r_um), dimension(:,:,:), allocatable :: sod_ukca_all_modes_um - real(r_um),dimension( row_length*rows, nlayers, n_radaer_mode, n_sw_band) :: & - aer_sw_asymmetry_um + ! UKCA modal absorption optical depth diagnostics: full column + real(r_um), dimension(:,:,:), allocatable :: aaod_ukca_all_modes_um integer, parameter :: i_ukca_tune_bc = i_ukca_bc_tuned integer, parameter :: i_glomap_clim_tune_bc = i_ukca_bc_tuned @@ -613,7 +586,9 @@ subroutine radaer_code( nlayers, & ! Since we are calling from LFRic, arrays will not be inverted ! This matters for determining whether a level is above the tropopause logical, parameter :: l_inverted = .false. - integer(i_um) :: trindxrad_um( row_length * rows ) + + ! Whether we need to run shortwave band_average because lit or not + logical :: l_any_lit_points_um ! Variables close to but not exactly 1 or -1 for bounding asymmetry real(r_def), parameter :: one_minus_eps = 1.0_r_def - epsilon(1.0_r_def) @@ -625,27 +600,29 @@ subroutine radaer_code( nlayers, & logical, parameter :: soluble_unwanted = .false. !----------------------------------------------------------------------- + ! Segmetation - ! UKCA modal optical depth diagnostics: full column - real(r_um) :: aod_ukca_this_mode_um( row_length*rows, npd_ukca_aod_wavel ) - ! Not yet included as diagnostic - ! UKCA modal optical depth diagnostics: stratosphere - real(r_um) :: sod_ukca_this_mode_um( row_length*rows, npd_ukca_aod_wavel ) - ! UKCA modal absorption optical depth diagnostics: full column - real(r_um) :: aaod_ukca_this_mode_um( row_length*rows, npd_ukca_aod_wavel ) + integer(i_um) :: nml_segment_size , num_seg , seg_size - !----------------------------------------------------------------------- + ! + ! + ! Hard coded here, but need to make this a namelist item later + ! + ! + integer, parameter :: ukca_radaer_segment_size = 4 - ncp_max_x_nmodes = ncp_max * nmodes + !----------------------------------------------------------------------- - npd_profile = row_length * rows + logical :: l_aod_ukca_ait_sol, l_aaod_ukca_ait_sol, & + l_aod_ukca_acc_sol, l_aaod_ukca_acc_sol, & + l_aod_ukca_cor_sol, l_aaod_ukca_cor_sol, & + l_aod_ukca_ait_ins, l_aaod_ukca_ait_ins, & + l_aod_ukca_acc_ins, l_aaod_ukca_acc_ins, & + l_aod_ukca_cor_ins, l_aaod_ukca_cor_ins - npd_exclude_lw = SIZE( lw_index_exclude, 1 ) - npd_exclude_sw = SIZE( sw_index_exclude, 1 ) + !----------------------------------------------------------------------- - ! Note that this is inverted compared to the UM - ! This will be dealt with in ukca_radaer_band_average - trindxrad_um(1) = trop_level( map_2d(1) ) + ncp_max_x_nmodes = ncp_max * nmodes !----------------------------------------------------------------------- ! Populate ukca_radaer element arrays @@ -683,350 +660,544 @@ subroutine radaer_code( nlayers, & -1, -1, -1, -1, -1, -1, -1, -1, -1 /) !----------------------------------------------------------------------- - ! Initialisation of prognostic variables and arrays + + l_aod_ukca_ait_sol = ( .not. associated( aod_ukca_ait_sol, empty_real_data )) + l_aaod_ukca_ait_sol= ( .not. associated(aaod_ukca_ait_sol, empty_real_data )) + l_aod_ukca_acc_sol = ( .not. associated( aod_ukca_acc_sol, empty_real_data )) + l_aaod_ukca_acc_sol= ( .not. associated(aaod_ukca_acc_sol, empty_real_data )) + l_aod_ukca_cor_sol = ( .not. associated( aod_ukca_cor_sol, empty_real_data )) + l_aaod_ukca_cor_sol= ( .not. associated(aaod_ukca_cor_sol, empty_real_data )) + l_aod_ukca_ait_ins = ( .not. associated( aod_ukca_ait_ins, empty_real_data )) + l_aaod_ukca_ait_ins= ( .not. associated(aaod_ukca_ait_ins, empty_real_data )) + l_aod_ukca_acc_ins = ( .not. associated( aod_ukca_acc_ins, empty_real_data )) + l_aaod_ukca_acc_ins= ( .not. associated(aaod_ukca_acc_ins, empty_real_data )) + l_aod_ukca_cor_ins = ( .not. associated( aod_ukca_cor_ins, empty_real_data )) + l_aaod_ukca_cor_ins= ( .not. associated(aaod_ukca_cor_ins, empty_real_data )) + + !----------------------------------------------------------------------- + ! Start of segmetation + + nml_segment_size = min( ukca_radaer_segment_size, ncells ) + + num_seg = ceiling( real(ncells,r_um) / real(nml_segment_size,r_um) ) + + allocate( trindxrad_um( nml_segment_size ) ) + + allocate( p_theta_levels_um( nml_segment_size, nlayers ) ) + allocate( t_theta_levels_um( nml_segment_size, nlayers ) ) + allocate( d_mass_theta_levels_um( nml_segment_size, nlayers ) ) + + allocate( ukca_comp_vol_um( n_ukca_cpnt, nml_segment_size, nlayers ) ) + allocate( ukca_mix_ratio_um( n_ukca_cpnt, nml_segment_size, nlayers ) ) + + allocate( ukca_dry_diam_um( nml_segment_size, nlayers, n_ukca_mode ) ) + allocate( ukca_wet_diam_um( nml_segment_size, nlayers, n_ukca_mode ) ) + allocate( ukca_modal_nbr_um( nml_segment_size, nlayers, n_ukca_mode ) ) + allocate( ukca_modal_rho_um( nml_segment_size, nlayers, n_ukca_mode ) ) + allocate( ukca_modal_vol_um( nml_segment_size, nlayers, n_ukca_mode ) ) + allocate( ukca_modal_wtv_um( nml_segment_size, nlayers, n_ukca_mode ) ) + + allocate( ukca_mode_mix_ratio_um( nml_segment_size, nlayers, n_radaer_mode ) ) + + allocate( aer_lw_absorption_um( nml_segment_size, nlayers, n_radaer_mode, & + n_lw_band ) ) + + allocate( aer_lw_scattering_um( nml_segment_size, nlayers, n_radaer_mode, & + n_lw_band ) ) + + allocate( aer_lw_asymmetry_um( nml_segment_size, nlayers, n_radaer_mode, & + n_lw_band ) ) + + allocate( aer_sw_absorption_um( nml_segment_size, nlayers, n_radaer_mode, & + n_sw_band ) ) + + allocate( aer_sw_scattering_um( nml_segment_size, nlayers, n_radaer_mode, & + n_sw_band ) ) + + allocate( aer_sw_asymmetry_um( nml_segment_size, nlayers, n_radaer_mode, & + n_sw_band ) ) + + allocate( aod_ukca_all_modes_um( nml_segment_size, npd_ukca_aod_wavel, & + n_ukca_mode ) ) + + allocate( sod_ukca_all_modes_um( nml_segment_size, npd_ukca_aod_wavel, & + n_ukca_mode ) ) + + allocate( aaod_ukca_all_modes_um(nml_segment_size, npd_ukca_aod_wavel, & + n_ukca_mode ) ) + !----------------------------------------------------------------------- - do k = 1, nlayers - p_theta_levels(1,1,k) = p_zero * & - ( exner_in_wth(map_wth(1) + k) )**(1.0_r_um/kappa) - end do - - do k = 1, nlayers - t_theta_levels(1,1,k) = exner_in_wth(map_wth(1) + k) * & - theta_in_wth(map_wth(1) + k) - end do - - ! note - zeroth level is redundant for these fields in UM - do k = 1, nlayers - ukca_comp_vol_um(1, 1,k) = pvol_su_ait_sol(map_wth(1) + k) - ukca_comp_vol_um(2, 1,k) = pvol_bc_ait_sol(map_wth(1) + k) - ukca_comp_vol_um(3, 1,k) = pvol_om_ait_sol(map_wth(1) + k) - ukca_comp_vol_um(4, 1,k) = pvol_su_acc_sol(map_wth(1) + k) - ukca_comp_vol_um(5, 1,k) = pvol_bc_acc_sol(map_wth(1) + k) - ukca_comp_vol_um(6, 1,k) = pvol_om_acc_sol(map_wth(1) + k) - ukca_comp_vol_um(7, 1,k) = pvol_ss_acc_sol(map_wth(1) + k) - ukca_comp_vol_um(8, 1,k) = 0.0_r_um ! no pvol_du_acc_sol prognostic - ukca_comp_vol_um(9, 1,k) = pvol_su_cor_sol(map_wth(1) + k) - ukca_comp_vol_um(10,1,k) = pvol_bc_cor_sol(map_wth(1) + k) - ukca_comp_vol_um(11,1,k) = pvol_om_cor_sol(map_wth(1) + k) - ukca_comp_vol_um(12,1,k) = pvol_ss_cor_sol(map_wth(1) + k) - ukca_comp_vol_um(13,1,k) = 0.0_r_um ! no pvol_du_cor_sol prognostic - ukca_comp_vol_um(14,1,k) = pvol_bc_ait_ins(map_wth(1) + k) - ukca_comp_vol_um(15,1,k) = pvol_om_ait_ins(map_wth(1) + k) - ukca_comp_vol_um(16,1,k) = pvol_du_acc_ins(map_wth(1) + k) - ukca_comp_vol_um(17,1,k) = pvol_du_cor_ins(map_wth(1) + k) - - ukca_mix_ratio_um(1, 1,k) = ait_sol_su(map_wth(1) + k) - ukca_mix_ratio_um(2, 1,k) = ait_sol_bc(map_wth(1) + k) - ukca_mix_ratio_um(3, 1,k) = ait_sol_om(map_wth(1) + k) - ukca_mix_ratio_um(4, 1,k) = acc_sol_su(map_wth(1) + k) - ukca_mix_ratio_um(5, 1,k) = acc_sol_bc(map_wth(1) + k) - ukca_mix_ratio_um(6, 1,k) = acc_sol_om(map_wth(1) + k) - ukca_mix_ratio_um(7, 1,k) = acc_sol_ss(map_wth(1) + k) - ukca_mix_ratio_um(8, 1,k) = 0.0_r_um ! no acc_sol_du prognostic - ukca_mix_ratio_um(9, 1,k) = cor_sol_su(map_wth(1) + k) - ukca_mix_ratio_um(10,1,k) = cor_sol_bc(map_wth(1) + k) - ukca_mix_ratio_um(11,1,k) = cor_sol_om(map_wth(1) + k) - ukca_mix_ratio_um(12,1,k) = cor_sol_ss(map_wth(1) + k) - ukca_mix_ratio_um(13,1,k) = 0.0_r_um ! no cor_sol_du prognostic - ukca_mix_ratio_um(14,1,k) = ait_ins_bc(map_wth(1) + k) - ukca_mix_ratio_um(15,1,k) = ait_ins_om(map_wth(1) + k) - ukca_mix_ratio_um(16,1,k) = acc_ins_du(map_wth(1) + k) - ukca_mix_ratio_um(17,1,k) = cor_ins_du(map_wth(1) + k) - - ukca_dry_diam_um(1,k,(mode_ait_sol-1)) = drydp_ait_sol(map_wth(1) + k) - ukca_dry_diam_um(1,k,(mode_acc_sol-1)) = drydp_acc_sol(map_wth(1) + k) - ukca_dry_diam_um(1,k,(mode_cor_sol-1)) = drydp_cor_sol(map_wth(1) + k) - ukca_dry_diam_um(1,k,(mode_ait_insol-1)) = drydp_ait_ins(map_wth(1) + k) - ukca_dry_diam_um(1,k,(mode_acc_insol-1)) = drydp_acc_ins(map_wth(1) + k) - ukca_dry_diam_um(1,k,(mode_cor_insol-1)) = drydp_cor_ins(map_wth(1) + k) - - ukca_modal_nbr_um(1,k,(mode_ait_sol-1)) = n_ait_sol(map_wth(1) + k) - ukca_modal_nbr_um(1,k,(mode_acc_sol-1)) = n_acc_sol(map_wth(1) + k) - ukca_modal_nbr_um(1,k,(mode_cor_sol-1)) = n_cor_sol(map_wth(1) + k) - ukca_modal_nbr_um(1,k,(mode_ait_insol-1)) = n_ait_ins(map_wth(1) + k) - ukca_modal_nbr_um(1,k,(mode_acc_insol-1)) = n_acc_ins(map_wth(1) + k) - ukca_modal_nbr_um(1,k,(mode_cor_insol-1)) = n_cor_ins(map_wth(1) + k) - - ukca_modal_rho_um(1,k,(mode_ait_sol-1)) = rhopar_ait_sol(map_wth(1) + k) - ukca_modal_rho_um(1,k,(mode_acc_sol-1)) = rhopar_acc_sol(map_wth(1) + k) - ukca_modal_rho_um(1,k,(mode_cor_sol-1)) = rhopar_cor_sol(map_wth(1) + k) - ukca_modal_rho_um(1,k,(mode_ait_insol-1)) = rhopar_ait_ins(map_wth(1) + k) - ukca_modal_rho_um(1,k,(mode_acc_insol-1)) = rhopar_acc_ins(map_wth(1) + k) - ukca_modal_rho_um(1,k,(mode_cor_insol-1)) = rhopar_cor_ins(map_wth(1) + k) - - ukca_modal_vol_um(1,k,(mode_ait_sol-1)) = pvol_wat_ait_sol(map_wth(1) + k)+& - pvol_su_ait_sol( map_wth(1) + k)+& - pvol_bc_ait_sol( map_wth(1) + k)+& - pvol_om_ait_sol( map_wth(1) + k) - - ukca_modal_vol_um(1,k,(mode_acc_sol-1)) = pvol_wat_acc_sol(map_wth(1) + k)+& - pvol_su_acc_sol( map_wth(1) + k)+& - pvol_bc_acc_sol( map_wth(1) + k)+& - pvol_om_acc_sol( map_wth(1) + k)+& - pvol_ss_acc_sol( map_wth(1) + k) - ! add pvol_du_acc_sol if used - - ukca_modal_vol_um(1,k,(mode_cor_sol-1)) = pvol_wat_cor_sol(map_wth(1) + k)+& - pvol_su_cor_sol( map_wth(1) + k)+& - pvol_bc_cor_sol( map_wth(1) + k)+& - pvol_om_cor_sol( map_wth(1) + k)+& - pvol_ss_cor_sol( map_wth(1) + k) - ! add pvol_du_cor_sol if used - - ukca_modal_vol_um(1,k,(mode_ait_insol-1))=pvol_bc_ait_ins( map_wth(1) + k)+& - pvol_om_ait_ins( map_wth(1) + k) - - ukca_modal_vol_um(1,k,(mode_acc_insol-1))=pvol_du_acc_ins( map_wth(1) + k) - - ukca_modal_vol_um(1,k,(mode_cor_insol-1))=pvol_du_cor_ins( map_wth(1) + k) - - ukca_modal_wtv_um(1,k,(mode_ait_sol-1)) = pvol_wat_ait_sol(map_wth(1) + k) - ukca_modal_wtv_um(1,k,(mode_acc_sol-1)) = pvol_wat_acc_sol(map_wth(1) + k) - ukca_modal_wtv_um(1,k,(mode_cor_sol-1)) = pvol_wat_cor_sol(map_wth(1) + k) - ukca_modal_wtv_um(1,k,(mode_ait_insol-1)) = 0.0_r_um - ukca_modal_wtv_um(1,k,(mode_acc_insol-1)) = 0.0_r_um - ukca_modal_wtv_um(1,k,(mode_cor_insol-1)) = 0.0_r_um - - ukca_wet_diam_um(1,k,(mode_ait_sol-1)) = wetdp_ait_sol(map_wth(1) + k) - ukca_wet_diam_um(1,k,(mode_acc_sol-1)) = wetdp_acc_sol(map_wth(1) + k) - ukca_wet_diam_um(1,k,(mode_cor_sol-1)) = wetdp_cor_sol(map_wth(1) + k) - ukca_wet_diam_um(1,k,(mode_ait_insol-1)) = drydp_ait_ins(map_wth(1) + k) - ukca_wet_diam_um(1,k,(mode_acc_insol-1)) = drydp_acc_ins(map_wth(1) + k) - ukca_wet_diam_um(1,k,(mode_cor_insol-1)) = drydp_cor_ins(map_wth(1) + k) - end do - - call ukca_radaer_prepare( & - ! Input Actual array dimensions - npd_profile, nlayers, n_ukca_mode, n_ukca_cpnt, & - ! Input Fixed array dimensions - npd_profile, nlayers, n_radaer_mode, & - ! Input from the UKCA_RADAER structure - nmodes, ncp_max, i_cpnt_index, n_cpnt_in_mode, & - ! Input Component mass-mixing ratios - ukca_mix_ratio_um, & - ! Input modal number concentrations - ukca_modal_nbr_um, & - ! Input Pressure and temperature - p_theta_levels, t_theta_levels, & - ! Output Modal mass-mixing ratios - ukca_mode_mix_ratio_um, & - ! Output modal number concentrations - ukca_modal_number_um & - ) - - ! MODE aerosol mixing ratios - do i_mode = 1, n_radaer_mode - do k = 1, nlayers - aer_mix_ratio( map_mode(1) + ( (i_mode-1)*(nlayers+1) ) + k ) = & - ukca_mode_mix_ratio_um( 1, k, i_mode ) + seg_size = nml_segment_size + + npd_exclude_lw = SIZE( lw_index_exclude, 1 ) + npd_exclude_sw = SIZE( sw_index_exclude, 1 ) + + !----------------------------------------------------------------------- + + ! The following appear to be parameters so dont need to be shared + ! npd_ukca_aod_wavel, n_ukca_mode, n_ukca_cpnt, + ! nd_prof_ssa, nd_layr_ssa, nd_band_ssa, nmodes, ncp_max, + ! i_ukca_tune_bc, i_ukca_radaer_prescribe_ssa, i_glomap_clim_tune_bc, + ! ip_infra_red, ip_solar, + ! soluble_wanted, soluble_unwanted, + ! l_exclude_lw, l_exclude_sw, l_nitrate, l_sustrat, + ! l_cornarrow_ins, l_inverted, + ! mode_ait_sol, mode_acc_sol, mode_cor_sol, + ! mode_ait_insol, mode_acc_insol, mode_cor_insol, + ! minus1_plus_eps, one_minus_eps, + +!$OMP PARALLEL DEFAULT(none) & +!$OMP private( i, ii, j, jj, k, i_mode, i_rmode, i_band, & +!$OMP l_any_lit_points_um, trindxrad_um, & +!$OMP p_theta_levels_um, t_theta_levels_um, ukca_comp_vol_um, & +!$OMP ukca_mix_ratio_um, ukca_dry_diam_um, ukca_modal_nbr_um, & +!$OMP ukca_modal_rho_um, ukca_modal_vol_um, ukca_modal_wtv_um, & +!$OMP ukca_wet_diam_um, d_mass_theta_levels_um, & +!$OMP ukca_mode_mix_ratio_um, & +!$OMP aer_lw_absorption_um, aer_lw_scattering_um, aer_lw_asymmetry_um,& +!$OMP aer_sw_absorption_um, aer_sw_scattering_um, aer_sw_asymmetry_um,& +!$OMP aod_ukca_all_modes_um, aaod_ukca_all_modes_um ) & +!$OMP shared( num_seg, seg_size, n_radaer_step, nlayers, npd_exclude_lw, & +!$OMP npd_exclude_sw, & +!$OMP ncp_max_x_nmodes, n_cpnt_in_mode, n_radaer_mode, n_lw_band, & +!$OMP n_sw_band, n_aer_mode_lw, n_aer_mode_sw, & +!$OMP i_cpnt_index, i_cpnt_type, i_mode_type, & +!$OMP trop_level, p_zero, kappa, lit_fraction, gravity, & +!$OMP theta_in_wth, exner_in_wth, ukca_radaer_presc_ssa, & +!$OMP map_2d, map_wth, map_w3, map_mode, map_rmode_lw, map_rmode_sw, & +!$OMP map_aod_wavel, & +!$OMP l_soluble, & +!$OMP l_aod_ukca_ait_sol, l_aod_ukca_acc_sol, l_aod_ukca_cor_sol, & +!$OMP l_aaod_ukca_ait_sol, l_aaod_ukca_acc_sol, l_aaod_ukca_cor_sol, & +!$OMP l_aod_ukca_ait_ins, l_aod_ukca_acc_ins, l_aod_ukca_cor_ins, & +!$OMP l_aaod_ukca_ait_ins, l_aaod_ukca_acc_ins, l_aaod_ukca_cor_ins, & +!$OMP pvol_wat_ait_sol, pvol_wat_acc_sol, pvol_wat_cor_sol, & +!$OMP pvol_su_ait_sol, pvol_bc_ait_sol, pvol_om_ait_sol, & +!$OMP pvol_su_acc_sol, pvol_bc_acc_sol, pvol_om_acc_sol, & +!$OMP pvol_ss_acc_sol, & +!$OMP pvol_su_cor_sol, pvol_bc_cor_sol, pvol_om_cor_sol, & +!$OMP pvol_ss_cor_sol, & +!$OMP pvol_bc_ait_ins, pvol_om_ait_ins, & +!$OMP pvol_du_acc_ins, pvol_du_cor_ins, & +!$OMP ait_sol_su, ait_sol_bc, ait_sol_om, & +!$OMP acc_sol_su, acc_sol_bc, acc_sol_om, acc_sol_ss, & +!$OMP cor_sol_su, cor_sol_bc, cor_sol_om, cor_sol_ss, & +!$OMP ait_ins_bc, ait_ins_om, acc_ins_du, cor_ins_du, & +!$OMP n_ait_sol, n_acc_sol, n_cor_sol, n_ait_ins, n_acc_ins, n_cor_ins,& +!$OMP rhopar_ait_sol, rhopar_acc_sol, rhopar_cor_sol, & +!$OMP rhopar_ait_ins, rhopar_acc_ins, rhopar_cor_ins, & +!$OMP drydp_ait_sol, drydp_acc_sol, drydp_cor_sol, & +!$OMP drydp_ait_ins, drydp_acc_ins, drydp_cor_ins, & +!$OMP wetdp_ait_sol, wetdp_acc_sol, wetdp_cor_sol, & +!$OMP aod_ukca_ait_sol, aod_ukca_acc_sol, aod_ukca_cor_sol, & +!$OMP aaod_ukca_ait_sol, aaod_ukca_acc_sol, aaod_ukca_cor_sol, & +!$OMP aod_ukca_ait_ins, aod_ukca_acc_ins, aod_ukca_cor_ins, & +!$OMP aaod_ukca_ait_ins, aaod_ukca_acc_ins, aaod_ukca_cor_ins, & +!$OMP rho_in_wth, dz_in_wth, exner_in_w3, aer_mix_ratio, & +!$OMP aer_lw_absorption, aer_lw_scattering, aer_lw_asymmetry, & +!$OMP aer_sw_absorption, aer_sw_scattering, aer_sw_asymmetry, & +!$OMP empty_real_data ) + +!$OMP do SCHEDULE(DYNAMIC) + do j = 1, num_seg + + jj = ( (j-1)*seg_size ) + 1 + + + + ! Whether we need to run shortwave band_average because lit or not + l_any_lit_points_um = .false. + if ( n_radaer_step > 1 ) then + l_any_lit_points_um = .true. + else + do i = 1, seg_size + ii = jj + i - 1 + if ( lit_fraction( map_2d(1, ii) ) > 0.0_r_def ) then + l_any_lit_points_um = .true. + end if + end do + end if + + ! Note that this is inverted compared to the UM + ! This will be dealt with in ukca_radaer_band_average + do i = 1, seg_size + ii = jj + i - 1 + trindxrad_um(i) = trop_level( map_2d(1, ii) ) end do - end do - - ! Long wave ( e.g. ip_infra_red ) - call ukca_radaer_band_average( & - ! Fixed array dimensions (input) - npd_profile, & - nlayers, & - n_radaer_mode, & - n_lw_band, & - npd_exclude_lw, & - ! Spectral information (input) - n_lw_band, & - ip_infra_red, & - l_exclude_lw, & - lw_n_band_exclude, & - lw_index_exclude, & - ! Actual array dimensions (input) - npd_profile, & - nlayers, & - n_ukca_mode, & - n_ukca_cpnt, & - ! Prescribed SSA dimensions - nd_prof_ssa, & - nd_layr_ssa, & - nd_band_ssa, & - ! UKCA_RADAER structure (input) - nmodes, & - ncp_max, & - ncp_max_x_nmodes, & - i_cpnt_index, & - i_cpnt_type, & - i_mode_type, & - l_nitrate, & - l_soluble, & - l_sustrat, & - l_cornarrow_ins, & - n_cpnt_in_mode, & - ! Modal mass-mixing ratios (input) - ukca_mode_mix_ratio_um, & - ! Modal number concentrations (input) - ukca_modal_number_um, & - ! Modal diameters from UKCA module (input) - ukca_dry_diam_um, & - ukca_wet_diam_um, & - ! Other inputs from UKCA module (input) - ukca_comp_vol_um, & - ukca_modal_vol_um, & - ukca_modal_rho_um, & - ukca_modal_wtv_um, & - ! Logical to describe orientation - l_inverted, & - ! Logical for prescribed single scattering albedo array - i_ukca_radaer_prescribe_ssa, & - ! Model level of the tropopause (input) - trindxrad_um, & - ! Prescription of single-scattering albedo - ukca_radaer_presc_ssa, & - ! Maxwell-Garnett mixing approach logical control switches - i_ukca_tune_bc, i_glomap_clim_tune_bc, & - ! Band-averaged optical properties (output) - aer_lw_absorption_um, & - aer_lw_scattering_um, & - aer_lw_asymmetry_um & - ) - - ! Socrates arrays filled with MODE aerosol optical properties in bands - i_rmode = 0 - do i_band = 1, n_lw_band - - ! Fill the radaer modes within this band - do i_mode = 1, n_radaer_mode - i_rmode = i_rmode + 1 + + !----------------------------------------------------------------------- + ! Initialisation of prognostic variables and arrays + !----------------------------------------------------------------------- + + do i = 1, seg_size + do k = 1, nlayers + ii = jj + i - 1 + p_theta_levels_um(i,k) = p_zero * & + ( exner_in_wth(map_wth(1, ii) + k) )**(1.0_r_um/kappa) + end do + end do + + do i = 1, seg_size do k = 1, nlayers - aer_lw_absorption(map_rmode_lw(1) + ((i_rmode-1)*(nlayers+1)) + k ) = & - aer_lw_absorption_um( 1, k, i_mode, i_band ) - aer_lw_scattering(map_rmode_lw(1) + ((i_rmode-1)*(nlayers+1)) + k ) = & - aer_lw_scattering_um( 1, k, i_mode, i_band ) - aer_lw_asymmetry( map_rmode_lw(1) + ((i_rmode-1)*(nlayers+1)) + k ) = & - max(minus1_plus_eps, min(one_minus_eps, & - aer_lw_asymmetry_um( 1, k, i_mode, i_band ))) + ii = jj + i - 1 + t_theta_levels_um(i,k) = exner_in_wth(map_wth(1, ii) + k) * & + theta_in_wth(map_wth(1, ii) + k) end do end do - ! If there are additional aerosol modes not associated with radaer - ! (e.g. from easyaerosol) then i_rmode needs advancing past them - ! before starting on the next radiation band. - if (n_aer_mode_lw > n_radaer_mode) then - i_rmode = i_rmode + n_aer_mode_lw - n_radaer_mode + ! note - zeroth level is redundant for these fields in UM + do i = 1, seg_size + do k = 1, nlayers + + ii = jj + i - 1 + + ukca_comp_vol_um(1, i,k) = pvol_su_ait_sol(map_wth(1, ii) + k) + ukca_comp_vol_um(2, i,k) = pvol_bc_ait_sol(map_wth(1, ii) + k) + ukca_comp_vol_um(3, i,k) = pvol_om_ait_sol(map_wth(1, ii) + k) + ukca_comp_vol_um(4, i,k) = pvol_su_acc_sol(map_wth(1, ii) + k) + ukca_comp_vol_um(5, i,k) = pvol_bc_acc_sol(map_wth(1, ii) + k) + ukca_comp_vol_um(6, i,k) = pvol_om_acc_sol(map_wth(1, ii) + k) + ukca_comp_vol_um(7, i,k) = pvol_ss_acc_sol(map_wth(1, ii) + k) + ukca_comp_vol_um(8, i,k) = 0.0_r_um ! no pvol_du_acc_sol prognostic + ukca_comp_vol_um(9, i,k) = pvol_su_cor_sol(map_wth(1, ii) + k) + ukca_comp_vol_um(10,i,k) = pvol_bc_cor_sol(map_wth(1, ii) + k) + ukca_comp_vol_um(11,i,k) = pvol_om_cor_sol(map_wth(1, ii) + k) + ukca_comp_vol_um(12,i,k) = pvol_ss_cor_sol(map_wth(1, ii) + k) + ukca_comp_vol_um(13,i,k) = 0.0_r_um ! no pvol_du_cor_sol prognostic + ukca_comp_vol_um(14,i,k) = pvol_bc_ait_ins(map_wth(1, ii) + k) + ukca_comp_vol_um(15,i,k) = pvol_om_ait_ins(map_wth(1, ii) + k) + ukca_comp_vol_um(16,i,k) = pvol_du_acc_ins(map_wth(1, ii) + k) + ukca_comp_vol_um(17,i,k) = pvol_du_cor_ins(map_wth(1, ii) + k) + + ukca_mix_ratio_um(1, i,k) = ait_sol_su(map_wth(1, ii) + k) + ukca_mix_ratio_um(2, i,k) = ait_sol_bc(map_wth(1, ii) + k) + ukca_mix_ratio_um(3, i,k) = ait_sol_om(map_wth(1, ii) + k) + ukca_mix_ratio_um(4, i,k) = acc_sol_su(map_wth(1, ii) + k) + ukca_mix_ratio_um(5, i,k) = acc_sol_bc(map_wth(1, ii) + k) + ukca_mix_ratio_um(6, i,k) = acc_sol_om(map_wth(1, ii) + k) + ukca_mix_ratio_um(7, i,k) = acc_sol_ss(map_wth(1, ii) + k) + ukca_mix_ratio_um(8, i,k) = 0.0_r_um ! no acc_sol_du prognostic + ukca_mix_ratio_um(9, i,k) = cor_sol_su(map_wth(1, ii) + k) + ukca_mix_ratio_um(10,i,k) = cor_sol_bc(map_wth(1, ii) + k) + ukca_mix_ratio_um(11,i,k) = cor_sol_om(map_wth(1, ii) + k) + ukca_mix_ratio_um(12,i,k) = cor_sol_ss(map_wth(1, ii) + k) + ukca_mix_ratio_um(13,i,k) = 0.0_r_um ! no cor_sol_du prognostic + ukca_mix_ratio_um(14,i,k) = ait_ins_bc(map_wth(1, ii) + k) + ukca_mix_ratio_um(15,i,k) = ait_ins_om(map_wth(1, ii) + k) + ukca_mix_ratio_um(16,i,k) = acc_ins_du(map_wth(1, ii) + k) + ukca_mix_ratio_um(17,i,k) = cor_ins_du(map_wth(1, ii) + k) + + ukca_dry_diam_um(i,k,(mode_ait_sol-1)) =drydp_ait_sol(map_wth(1,ii)+ k) + ukca_dry_diam_um(i,k,(mode_acc_sol-1)) =drydp_acc_sol(map_wth(1,ii)+ k) + ukca_dry_diam_um(i,k,(mode_cor_sol-1)) =drydp_cor_sol(map_wth(1,ii)+ k) + ukca_dry_diam_um(i,k,(mode_ait_insol-1))=drydp_ait_ins(map_wth(1,ii)+ k) + ukca_dry_diam_um(i,k,(mode_acc_insol-1))=drydp_acc_ins(map_wth(1,ii)+ k) + ukca_dry_diam_um(i,k,(mode_cor_insol-1))=drydp_cor_ins(map_wth(1,ii)+ k) + + ukca_modal_nbr_um(i,k,(mode_ait_sol-1)) = n_ait_sol(map_wth(1, ii) + k) + ukca_modal_nbr_um(i,k,(mode_acc_sol-1)) = n_acc_sol(map_wth(1, ii) + k) + ukca_modal_nbr_um(i,k,(mode_cor_sol-1)) = n_cor_sol(map_wth(1, ii) + k) + ukca_modal_nbr_um(i,k,(mode_ait_insol-1))= n_ait_ins(map_wth(1, ii) + k) + ukca_modal_nbr_um(i,k,(mode_acc_insol-1))= n_acc_ins(map_wth(1, ii) + k) + ukca_modal_nbr_um(i,k,(mode_cor_insol-1))= n_cor_ins(map_wth(1, ii) + k) + + ukca_modal_rho_um(i,k,(mode_ait_sol-1)) = & + rhopar_ait_sol(map_wth(1, ii) + k) + + ukca_modal_rho_um(i,k,(mode_acc_sol-1)) = & + rhopar_acc_sol(map_wth(1, ii) + k) + + ukca_modal_rho_um(i,k,(mode_cor_sol-1)) = & + rhopar_cor_sol(map_wth(1, ii) + k) + + ukca_modal_rho_um(i,k,(mode_ait_insol-1)) = & + rhopar_ait_ins(map_wth(1, ii) + k) + + ukca_modal_rho_um(i,k,(mode_acc_insol-1)) = & + rhopar_acc_ins(map_wth(1, ii) + k) + + ukca_modal_rho_um(i,k,(mode_cor_insol-1)) = & + rhopar_cor_ins(map_wth(1, ii) + k) + + ukca_modal_vol_um(i,k,(mode_ait_sol-1)) = & + pvol_wat_ait_sol(map_wth(1, ii) + k) + & + pvol_su_ait_sol( map_wth(1, ii) + k) + & + pvol_bc_ait_sol( map_wth(1, ii) + k) + & + pvol_om_ait_sol( map_wth(1, ii) + k) + + ukca_modal_vol_um(i,k,(mode_acc_sol-1)) = & + pvol_wat_acc_sol(map_wth(1, ii) + k) + & + pvol_su_acc_sol( map_wth(1, ii) + k) + & + pvol_bc_acc_sol( map_wth(1, ii) + k) + & + pvol_om_acc_sol( map_wth(1, ii) + k) + & + pvol_ss_acc_sol( map_wth(1, ii) + k) + + ukca_modal_vol_um(i,k,(mode_cor_sol-1)) = & + pvol_wat_cor_sol(map_wth(1, ii) + k) + & + pvol_su_cor_sol( map_wth(1, ii) + k) + & + pvol_bc_cor_sol( map_wth(1, ii) + k) + & + pvol_om_cor_sol( map_wth(1, ii) + k) + & + pvol_ss_cor_sol( map_wth(1, ii) + k) + + ukca_modal_vol_um(i,k,(mode_ait_insol-1)) = & + pvol_bc_ait_ins( map_wth(1, ii) + k) + & + pvol_om_ait_ins( map_wth(1, ii) + k) + + ukca_modal_vol_um(i,k,(mode_acc_insol-1)) = & + pvol_du_acc_ins( map_wth(1, ii) + k) + + ukca_modal_vol_um(i,k,(mode_cor_insol-1)) = & + pvol_du_cor_ins( map_wth(1, ii) + k) + + ukca_modal_wtv_um(i,k,(mode_ait_sol-1)) = & + pvol_wat_ait_sol(map_wth(1, ii) + k) + + ukca_modal_wtv_um(i,k,(mode_acc_sol-1)) = & + pvol_wat_acc_sol(map_wth(1, ii) + k) + + ukca_modal_wtv_um(i,k,(mode_cor_sol-1)) = & + pvol_wat_cor_sol(map_wth(1, ii) + k) + + ukca_modal_wtv_um(i,k,(mode_ait_insol-1)) = 0.0_r_um + ukca_modal_wtv_um(i,k,(mode_acc_insol-1)) = 0.0_r_um + ukca_modal_wtv_um(i,k,(mode_cor_insol-1)) = 0.0_r_um + + ukca_wet_diam_um(i,k,(mode_ait_sol-1)) =wetdp_ait_sol(map_wth(1,ii)+ k) + ukca_wet_diam_um(i,k,(mode_acc_sol-1)) =wetdp_acc_sol(map_wth(1,ii)+ k) + ukca_wet_diam_um(i,k,(mode_cor_sol-1)) =wetdp_cor_sol(map_wth(1,ii)+ k) + ! Note that wet and dry diameter are the same for insoluble modes + ukca_wet_diam_um(i,k,(mode_ait_insol-1))=drydp_ait_ins(map_wth(1,ii)+ k) + ukca_wet_diam_um(i,k,(mode_acc_insol-1))=drydp_acc_ins(map_wth(1,ii)+ k) + ukca_wet_diam_um(i,k,(mode_cor_insol-1))=drydp_cor_ins(map_wth(1,ii)+ k) + end do + end do + + !------------------------------------------------ + ! Calculate mass thickness of vertical levels + ! This duplicates calculation of d_mass from set_thermodynamic_kernel_mod + + if ( ( .not. associated( aod_ukca_ait_sol, empty_real_data ) ) .or. & + ( .not. associated( aaod_ukca_ait_sol, empty_real_data ) ) .or. & + ( .not. associated( aod_ukca_acc_sol, empty_real_data ) ) .or. & + ( .not. associated( aaod_ukca_acc_sol, empty_real_data ) ) .or. & + ( .not. associated( aod_ukca_cor_sol, empty_real_data ) ) .or. & + ( .not. associated( aaod_ukca_cor_sol, empty_real_data ) ) .or. & + ( .not. associated( aod_ukca_ait_ins, empty_real_data ) ) .or. & + ( .not. associated( aaod_ukca_ait_ins, empty_real_data ) ) .or. & + ( .not. associated( aod_ukca_acc_ins, empty_real_data ) ) .or. & + ( .not. associated( aaod_ukca_acc_ins, empty_real_data ) ) .or. & + ( .not. associated( aod_ukca_cor_ins, empty_real_data ) ) .or. & + ( .not. associated( aaod_ukca_cor_ins, empty_real_data ) ) ) then + + do i = 1, seg_size + ii = jj + i - 1 + d_mass_theta_levels_um(i,1) = rho_in_wth( map_wth(2, ii) ) * & + ( dz_in_wth( map_wth(2, ii) ) + & + dz_in_wth( map_wth(1, ii) ) ) + end do + + do i = 1, seg_size + do k = 2, nlayers - 1 + ii = jj + i - 1 + d_mass_theta_levels_um(i,k) = rho_in_wth( map_wth(1, ii) + k ) * & + dz_in_wth( map_wth(1, ii) + k ) + end do + end do + + do i = 1, seg_size + ii = jj + i - 1 + d_mass_theta_levels_um(i,nlayers) = p_zero * & + exner_in_w3( map_w3(1, ii) + nlayers-1 )**( 1.0_r_def / kappa ) / & + gravity + end do + end if - end do ! n_lw_bands - - ! Only calculate SW on lit points - ! If superstepping (n_radaer_step>1) then need to calculate on all points - ! for use when the sun moves later - if (lit_fraction(map_2d(1)) > 0.0_r_def .or. & - n_radaer_step > 1) then - - ! Short wave (e.g. ip_solar ) - call ukca_radaer_band_average( & - ! Fixed array dimensions (input) - npd_profile, & - nlayers, & - n_radaer_mode, & - n_sw_band, & - npd_exclude_sw, & - ! Spectral information (input) - n_sw_band, & - ip_solar, & - l_exclude_sw, & - sw_n_band_exclude, & - sw_index_exclude, & - ! Actual array dimensions (input) - npd_profile, & - nlayers, & - n_ukca_mode, & - n_ukca_cpnt, & - ! Prescribed SSA dimensions - nd_prof_ssa, & - nd_layr_ssa, & - nd_band_ssa, & - ! UKCA_RADAER structure (input) - nmodes, & - ncp_max, & - ncp_max_x_nmodes, & - i_cpnt_index, & - i_cpnt_type, & - i_mode_type, & - l_nitrate, & - l_soluble, & - l_sustrat, & - l_cornarrow_ins, & - n_cpnt_in_mode, & - ! Modal mass-mixing ratios (input) - ukca_mode_mix_ratio_um, & - ! Modal number concentrations (input) - ukca_modal_number_um, & - ! Modal diameters from UKCA module (input) - ukca_dry_diam_um, & - ukca_wet_diam_um, & - ! Other inputs from UKCA module (input) - ukca_comp_vol_um, & - ukca_modal_vol_um, & - ukca_modal_rho_um, & - ukca_modal_wtv_um, & - ! Logical to describe orientation - l_inverted, & - ! Logical for prescribed single scattering albedo array - i_ukca_radaer_prescribe_ssa, & - ! Model level of the tropopause (input) - trindxrad_um, & - ! Prescription of single-scattering albedo - ukca_radaer_presc_ssa, & - ! Maxwell-Garnett mixing approach logical control switches - i_ukca_tune_bc, i_glomap_clim_tune_bc, & - ! Band-averaged optical properties (output) - aer_sw_absorption_um, & - aer_sw_scattering_um, & - aer_sw_asymmetry_um & - ) - - ! Socrates arrays filled with MODE aerosol optical properties in bands - i_rmode = 0 - do i_band = 1, n_sw_band + !----------------------------------------------------------------------- + ! Call UKCA modules + !----------------------------------------------------------------------- + + CALL ukca_radaer_lfric_interface( & + ! Fixed array dimensions (input) + seg_size, & + nlayers, & + npd_exclude_lw, & + npd_exclude_sw, & + npd_ukca_aod_wavel, & + ! Spectral information (input) + ip_infra_red, & + ip_solar, & + ! Actual array dimensions (input) + n_ukca_mode, & + n_ukca_cpnt, & + ! Prescribed SSA dimensions + nd_prof_ssa, & + nd_layr_ssa, & + nd_band_ssa, & + ! Variables related to waveband exclusion + l_exclude_lw, & + l_exclude_sw, & + ! UKCA_RADAER structure (input) + nmodes, & + ncp_max, & + ncp_max_x_nmodes, & + i_cpnt_index, & + i_cpnt_type, & + i_mode_type, & + l_nitrate, & + l_soluble, & + l_sustrat, & + l_cornarrow_ins, & + n_cpnt_in_mode, & + ! Modal diameters from UKCA module (input) + ukca_dry_diam_um, & + ukca_wet_diam_um, & + ! Other inputs from UKCA module (input) + ukca_comp_vol_um, & + ukca_modal_vol_um, & + ukca_modal_rho_um, & + ukca_modal_wtv_um, & + ! Logical to describe orientation + l_inverted, & + ! Control option for prescribed single scattering albedo array + i_ukca_radaer_prescribe_ssa, & + ! Model level of the tropopause (input) + trindxrad_um, & + ! Whether we need to run shortwave band_average because lit or not + l_any_lit_points_um, & + ! Prescription of single-scattering albedo + ukca_radaer_presc_ssa, & + ! Input Component mass-mixing ratios + ukca_mix_ratio_um, & + ! Input modal number concentrations + ukca_modal_nbr_um, & + ! Input Pressure and temperature + p_theta_levels_um, t_theta_levels_um, & + ! Maxwell-Garnett mixing approach logical control switches + i_ukca_tune_bc, i_glomap_clim_tune_bc, & + ! Type selection + soluble_wanted, & + soluble_unwanted, & + ! Which aerosol optical depth diagnostics to calculate + l_aod_ukca_ait_sol, l_aaod_ukca_ait_sol, & + l_aod_ukca_acc_sol, l_aaod_ukca_acc_sol, & + l_aod_ukca_cor_sol, l_aaod_ukca_cor_sol, & + l_aod_ukca_ait_ins, l_aaod_ukca_ait_ins, & + l_aod_ukca_acc_ins, l_aaod_ukca_acc_ins, & + l_aod_ukca_cor_ins, l_aaod_ukca_cor_ins, & + ! Mass thickness of layers + d_mass_theta_levels_um, & + ! Modal mass-mixing ratios (input output) + ukca_mode_mix_ratio_um, & + ! Band-averaged optical properties (output) + aer_lw_absorption_um, & + aer_sw_absorption_um, & + aer_lw_scattering_um, & + aer_sw_scattering_um, & + aer_lw_asymmetry_um, & + aer_sw_asymmetry_um, & + aod_ukca_all_modes_um, & + aaod_ukca_all_modes_um ) + + !----------------------------------------------------------------------- + ! Convert back to LFRic arrays + !----------------------------------------------------------------------- + + ! MODE aerosol mixing ratios + do i_mode = 1, n_radaer_mode + do k = 1, nlayers + do i = 1, seg_size + ii = jj + i - 1 + aer_mix_ratio( map_mode(1,ii) + ( (i_mode-1)*(nlayers+1) ) + k ) = & + ukca_mode_mix_ratio_um( i, k, i_mode ) + end do + end do + end do + ! Socrates arrays filled with MODE aerosol optical properties in bands + i_rmode = 0 + do i_band = 1, n_lw_band ! Fill the radaer modes within this band do i_mode = 1, n_radaer_mode i_rmode = i_rmode + 1 do k = 1, nlayers - aer_sw_absorption(map_rmode_sw(1) + ((i_rmode-1)*(nlayers+1)) + k ) & - = aer_sw_absorption_um( 1, k, i_mode, i_band ) - aer_sw_scattering(map_rmode_sw(1) + ((i_rmode-1)*(nlayers+1)) + k ) & - = aer_sw_scattering_um( 1, k, i_mode, i_band ) - aer_sw_asymmetry( map_rmode_sw(1) + ((i_rmode-1)*(nlayers+1)) + k ) & - = max(minus1_plus_eps, min(one_minus_eps, & - aer_sw_asymmetry_um( 1, k, i_mode, i_band ))) - end do - end do + do i = 1, seg_size + ii = jj + i - 1 + aer_lw_absorption( map_rmode_lw(1, ii) + & + ( (i_rmode-1)*(nlayers+1) ) + k ) = & + aer_lw_absorption_um( i, k, i_mode, i_band ) + + aer_lw_scattering( map_rmode_lw(1, ii) + & + ( (i_rmode-1)*(nlayers+1) ) + k ) = & + aer_lw_scattering_um( i, k, i_mode, i_band ) + + aer_lw_asymmetry( map_rmode_lw(1, ii) + & + ( (i_rmode-1)*(nlayers+1) ) + k ) = & + max(minus1_plus_eps, min(one_minus_eps, & + aer_lw_asymmetry_um( i, k, i_mode, i_band ) ) ) + + end do ! seg_size + end do ! n_layers + end do ! n_radaer_mode ! If there are additional aerosol modes not associated with radaer ! (e.g. from easyaerosol) then i_rmode needs advancing past them ! before starting on the next radiation band. - if (n_aer_mode_sw > n_radaer_mode) then - i_rmode = i_rmode + n_aer_mode_sw - n_radaer_mode + if (n_aer_mode_lw > n_radaer_mode) then + i_rmode = i_rmode + n_aer_mode_lw - n_radaer_mode end if - end do ! n_sw_bands + end do ! n_lw_band - else ! unlit points + ! Only calculate SW on lit points + ! If superstepping (n_radaer_step>1) then need to calculate on all points + ! for use when the sun moves later - ! Dummy values to avoid problems in radiation code + ! Socrates arrays filled with MODE aerosol optical properties in bands i_rmode = 0 do i_band = 1, n_sw_band ! Fill the radaer modes within this band do i_mode = 1, n_radaer_mode i_rmode = i_rmode + 1 + do k = 1, nlayers - aer_sw_absorption(map_rmode_sw(1) + ((i_rmode-1)*(nlayers+1)) + k ) & - = 1.0_r_def - aer_sw_scattering(map_rmode_sw(1) + ((i_rmode-1)*(nlayers+1)) + k ) & - = 1.0_r_def - aer_sw_asymmetry( map_rmode_sw(1) + ((i_rmode-1)*(nlayers+1)) + k ) & - = one_minus_eps - end do - end do + do i = 1, seg_size + ii = jj + i - 1 + ! lit points + if ( ( lit_fraction(map_2d(1, ii)) > 0.0_r_def ) .or. & + n_radaer_step > 1 ) then + + aer_sw_absorption( map_rmode_sw(1, ii) + & + ( (i_rmode-1)*(nlayers+1) ) + k ) = & + aer_sw_absorption_um( i, k, i_mode, i_band ) + + aer_sw_scattering( map_rmode_sw(1, ii) + & + ( (i_rmode-1)*(nlayers+1) ) + k ) = & + aer_sw_scattering_um( i, k, i_mode, i_band ) + + aer_sw_asymmetry( map_rmode_sw(1, ii) + & + ( (i_rmode-1)*(nlayers+1) ) + k ) = & + max(minus1_plus_eps, min(one_minus_eps, & + aer_sw_asymmetry_um( i, k, i_mode, i_band ) ) ) + + ! unlit points + else + + aer_sw_absorption( map_rmode_sw(1, ii) + & + ( (i_rmode-1)*(nlayers+1) ) + k ) = 1.0_r_def + + aer_sw_scattering( map_rmode_sw(1, ii) + & + ( (i_rmode-1)*(nlayers+1) ) + k ) = 1.0_r_def + + aer_sw_asymmetry( map_rmode_sw(1, ii) + & + ( (i_rmode-1)*(nlayers+1) ) + k ) = one_minus_eps + + end if + end do ! seg_size + end do ! nlayers + end do ! n_radaer_mode ! If there are additional aerosol modes not associated with radaer ! (e.g. from easyaerosol) then i_rmode needs advancing past them @@ -1035,552 +1206,184 @@ subroutine radaer_code( nlayers, & i_rmode = i_rmode + n_aer_mode_sw - n_radaer_mode end if - end do ! n_sw_bands - - end if ! lit points - - !------------------------------------------------ - ! Calculate mass thickness of vertical levels - ! This duplicates calculation of d_mass from set_thermodynamic_kernel_mod - if ( ( .not. associated( aod_ukca_ait_sol, empty_real_data ) ) .or. & - ( .not. associated( aaod_ukca_ait_sol, empty_real_data ) ) .or. & - ( .not. associated( aod_ukca_acc_sol, empty_real_data ) ) .or. & - ( .not. associated( aaod_ukca_acc_sol, empty_real_data ) ) .or. & - ( .not. associated( aod_ukca_cor_sol, empty_real_data ) ) .or. & - ( .not. associated( aaod_ukca_cor_sol, empty_real_data ) ) .or. & - ( .not. associated( aod_ukca_ait_ins, empty_real_data ) ) .or. & - ( .not. associated( aaod_ukca_ait_ins, empty_real_data ) ) .or. & - ( .not. associated( aod_ukca_acc_ins, empty_real_data ) ) .or. & - ( .not. associated( aaod_ukca_acc_ins, empty_real_data ) ) .or. & - ( .not. associated( aod_ukca_cor_ins, empty_real_data ) ) .or. & - ( .not. associated( aaod_ukca_cor_ins, empty_real_data ) ) ) then - - d_mass_theta_levels_um(1,1,1) = rho_in_wth( map_wth(2) ) * & - ( dz_in_wth( map_wth(2) ) + & - dz_in_wth( map_wth(1) ) ) - - do k = 2, nlayers - 1 - d_mass_theta_levels_um(1,1,k) = rho_in_wth( map_wth(1) + k ) * & - dz_in_wth( map_wth(1) + k ) - end do - - d_mass_theta_levels_um(1,1,nlayers) = p_zero * & - exner_in_w3( map_w3(1) + nlayers-1 )** & - ( 1.0_r_def / kappa ) / gravity - end if - - !------------------------------------------------ - ! Now calculate aod and aaod for Aitken Soluble mode - - if ( ( .not. associated( aod_ukca_ait_sol, empty_real_data ) ) .or. & - ( .not. associated( aaod_ukca_ait_sol, empty_real_data ) ) ) then - - call ukca_radaer_compute_aod( & - ! Fixed array dimensions (input) - npd_profile, & - nlayers, & - n_ukca_mode, & - n_ukca_cpnt, & - npd_ukca_aod_wavel, & - ! Fixed array Prescribed ssa dimensions (input) - nd_prof_ssa, & - nd_layr_ssa, & - nd_band_ssa, & - ! UKCA_RADAER structure (input) - nmodes, & - ncp_max, & - ncp_max_x_nmodes, & - i_cpnt_index, & - i_cpnt_type, & - n_cpnt_in_mode, & - l_nitrate, & - l_soluble, & - l_sustrat, & - i_mode_type, & - l_cornarrow_ins, & - ! Modal diameters from UKCA module - ukca_dry_diam_um, & - ukca_wet_diam_um, & - ! Mass thickness of layers - d_mass_theta_levels_um, & - ! Component volumes - ukca_comp_vol_um, & - ! Modal volumes, densities, and water content - ukca_modal_vol_um, & - ukca_modal_rho_um, & - ukca_modal_wtv_um, & - ! Modal mass-mixing ratios - ukca_mode_mix_ratio_um, & - ! Modal number concentrations - ukca_modal_number_um, & - ! Type selection - ip_ukca_mode_aitken, & - soluble_wanted, & - ! Switch for if prescribed SSA is on - i_ukca_radaer_prescribe_ssa, & - ! Model level of the tropopause - trindxrad_um, & - ! Prescription of single-scattering albedo - ukca_radaer_presc_ssa, & - ! Modal extinction aerosol opt depth - column (output) - aod_ukca_this_mode_um, & - ! Modal extinction aerosol opt depth - stratosphere (output) - sod_ukca_this_mode_um, & - ! Modal absorption aerosol opt depth (output) - aaod_ukca_this_mode_um, & - ! Fixed array dimensions - npd_profile, & - nlayers, & - n_radaer_mode, & - npd_ukca_aod_wavel ) + end do ! n_sw_band !------------------------------------------------ + ! Now calculate aod and aaod for Aitken Soluble mode if ( .not. associated( aod_ukca_ait_sol, empty_real_data ) ) then do k = 1, npd_ukca_aod_wavel - do i = 1, row_length - aod_ukca_ait_sol( map_aod_wavel(i) + k ) = aod_ukca_this_mode_um(i,k) + do i = 1, seg_size + ii = jj + i - 1 + aod_ukca_ait_sol( map_aod_wavel(1, ii) + k - 1 ) = & + aod_ukca_all_modes_um(i,k,mode_ait_sol-1) end do end do end if if ( .not. associated( aaod_ukca_ait_sol, empty_real_data ) ) then do k = 1, npd_ukca_aod_wavel - do i = 1, row_length - aaod_ukca_ait_sol( map_aod_wavel(i)+k ) = aaod_ukca_this_mode_um(i,k) + do i = 1, seg_size + ii = jj + i - 1 + aaod_ukca_ait_sol( map_aod_wavel(1, ii) + k - 1 ) = & + aaod_ukca_all_modes_um(i,k,mode_ait_sol-1) end do end do end if - end if ! Calculate AOD Aitken Soluble mode - - !------------------------------------------------ - ! Now calculate aod and aaod for Accumulation Soluble mode - - if ( ( .not. associated( aod_ukca_acc_sol, empty_real_data ) ) .or. & - ( .not. associated( aaod_ukca_acc_sol, empty_real_data ) ) ) then - - call ukca_radaer_compute_aod( & - ! Fixed array dimensions (input) - npd_profile, & - nlayers, & - n_ukca_mode, & - n_ukca_cpnt, & - npd_ukca_aod_wavel, & - ! Fixed array Prescribed ssa dimensions (input) - nd_prof_ssa, & - nd_layr_ssa, & - nd_band_ssa, & - ! UKCA_RADAER structure (input) - nmodes, & - ncp_max, & - ncp_max_x_nmodes, & - i_cpnt_index, & - i_cpnt_type, & - n_cpnt_in_mode, & - l_nitrate, & - l_soluble, & - l_sustrat, & - i_mode_type, & - l_cornarrow_ins, & - ! Modal diameters from UKCA module - ukca_dry_diam_um, & - ukca_wet_diam_um, & - ! Mass thickness of layers - d_mass_theta_levels_um, & - ! Component volumes - ukca_comp_vol_um, & - ! Modal volumes, densities, and water content - ukca_modal_vol_um, & - ukca_modal_rho_um, & - ukca_modal_wtv_um, & - ! Modal mass-mixing ratios - ukca_mode_mix_ratio_um, & - ! Modal number concentrations - ukca_modal_number_um, & - ! Type selection - ip_ukca_mode_accum, & - soluble_wanted, & - ! Switch for if prescribed SSA is on - i_ukca_radaer_prescribe_ssa, & - ! Model level of the tropopause - trindxrad_um, & - ! Prescription of single-scattering albedo - ukca_radaer_presc_ssa, & - ! Modal extinction aerosol opt depth - column (output) - aod_ukca_this_mode_um, & - ! Modal extinction aerosol opt depth - stratosphere (output) - sod_ukca_this_mode_um, & - ! Modal absorption aerosol opt depth (output) - aaod_ukca_this_mode_um, & - ! Fixed array dimensions - npd_profile, & - nlayers, & - n_radaer_mode, & - npd_ukca_aod_wavel ) - !------------------------------------------------ + ! Now calculate aod and aaod for Accumulation Soluble mode if ( .not. associated( aod_ukca_acc_sol, empty_real_data ) ) then do k = 1, npd_ukca_aod_wavel - do i = 1, row_length - aod_ukca_acc_sol( map_aod_wavel(i) + k ) = aod_ukca_this_mode_um(i,k) + do i = 1, seg_size + ii = jj + i - 1 + aod_ukca_acc_sol( map_aod_wavel(1, ii) + k - 1 ) = & + aod_ukca_all_modes_um(i,k,mode_acc_sol-1) end do end do end if if ( .not. associated( aaod_ukca_acc_sol, empty_real_data ) ) then do k = 1, npd_ukca_aod_wavel - do i = 1, row_length - aaod_ukca_acc_sol( map_aod_wavel(i)+k ) = aaod_ukca_this_mode_um(i,k) + do i = 1, seg_size + ii = jj + i - 1 + aaod_ukca_acc_sol( map_aod_wavel(1, ii) + k - 1 ) = & + aaod_ukca_all_modes_um(i,k,mode_acc_sol-1) end do end do end if - end if ! Calculate AOD Accumulation Soluble mode - - !------------------------------------------------ - ! Now calculate aod and aaod for Coarse Soluble mode - - if ( ( .not. associated( aod_ukca_cor_sol, empty_real_data ) ) .or. & - ( .not. associated( aaod_ukca_cor_sol, empty_real_data ) ) ) then - - call ukca_radaer_compute_aod( & - ! Fixed array dimensions (input) - npd_profile, & - nlayers, & - n_ukca_mode, & - n_ukca_cpnt, & - npd_ukca_aod_wavel, & - ! Fixed array Prescribed ssa dimensions (input) - nd_prof_ssa, & - nd_layr_ssa, & - nd_band_ssa, & - ! UKCA_RADAER structure (input) - nmodes, & - ncp_max, & - ncp_max_x_nmodes, & - i_cpnt_index, & - i_cpnt_type, & - n_cpnt_in_mode, & - l_nitrate, & - l_soluble, & - l_sustrat, & - i_mode_type, & - l_cornarrow_ins, & - ! Modal diameters from UKCA module - ukca_dry_diam_um, & - ukca_wet_diam_um, & - ! Mass thickness of layers - d_mass_theta_levels_um, & - ! Component volumes - ukca_comp_vol_um, & - ! Modal volumes, densities, and water content - ukca_modal_vol_um, & - ukca_modal_rho_um, & - ukca_modal_wtv_um, & - ! Modal mass-mixing ratios - ukca_mode_mix_ratio_um, & - ! Modal number concentrations - ukca_modal_number_um, & - ! Type selection - ip_ukca_mode_coarse, & - soluble_wanted, & - ! Switch for if prescribed SSA is on - i_ukca_radaer_prescribe_ssa, & - ! Model level of the tropopause - trindxrad_um, & - ! Prescription of single-scattering albedo - ukca_radaer_presc_ssa, & - ! Modal extinction aerosol opt depth - column (output) - aod_ukca_this_mode_um, & - ! Modal extinction aerosol opt depth - stratosphere (output) - sod_ukca_this_mode_um, & - ! Modal absorption aerosol opt depth (output) - aaod_ukca_this_mode_um, & - ! Fixed array dimensions - npd_profile, & - nlayers, & - n_radaer_mode, & - npd_ukca_aod_wavel ) - !------------------------------------------------ + ! Now calculate aod and aaod for Coarse Soluble mode if ( .not. associated( aod_ukca_cor_sol, empty_real_data ) ) then do k = 1, npd_ukca_aod_wavel - do i = 1, row_length - aod_ukca_cor_sol( map_aod_wavel(i) + k ) = aod_ukca_this_mode_um(i,k) + do i = 1, seg_size + ii = jj + i - 1 + aod_ukca_cor_sol( map_aod_wavel(1, ii) + k - 1 ) = & + aod_ukca_all_modes_um(i,k,mode_cor_sol-1) end do end do end if if ( .not. associated( aaod_ukca_cor_sol, empty_real_data ) ) then do k = 1, npd_ukca_aod_wavel - do i = 1, row_length - aaod_ukca_cor_sol( map_aod_wavel(i)+k ) = aaod_ukca_this_mode_um(i,k) + do i = 1, seg_size + ii = jj + i - 1 + aaod_ukca_cor_sol( map_aod_wavel(1, ii) + k - 1 ) = & + aaod_ukca_all_modes_um(i,k,mode_cor_sol-1) end do end do end if - end if ! Calculate AOD Coarse Soluble mode - - !------------------------------------------------ - ! Now calculate aod and aaod for Aitken Insoluble mode - - if ( ( .not. associated( aod_ukca_ait_ins, empty_real_data ) ) .or. & - ( .not. associated( aaod_ukca_ait_ins, empty_real_data ) ) ) then - - call ukca_radaer_compute_aod( & - ! Fixed array dimensions (input) - npd_profile, & - nlayers, & - n_ukca_mode, & - n_ukca_cpnt, & - npd_ukca_aod_wavel, & - ! Fixed array Prescribed ssa dimensions (input) - nd_prof_ssa, & - nd_layr_ssa, & - nd_band_ssa, & - ! UKCA_RADAER structure (input) - nmodes, & - ncp_max, & - ncp_max_x_nmodes, & - i_cpnt_index, & - i_cpnt_type, & - n_cpnt_in_mode, & - l_nitrate, & - l_soluble, & - l_sustrat, & - i_mode_type, & - l_cornarrow_ins, & - ! Modal diameters from UKCA module - ukca_dry_diam_um, & - ukca_wet_diam_um, & - ! Mass thickness of layers - d_mass_theta_levels_um, & - ! Component volumes - ukca_comp_vol_um, & - ! Modal volumes, densities, and water content - ukca_modal_vol_um, & - ukca_modal_rho_um, & - ukca_modal_wtv_um, & - ! Modal mass-mixing ratios - ukca_mode_mix_ratio_um, & - ! Modal number concentrations - ukca_modal_number_um, & - ! Type selection - ip_ukca_mode_aitken, & - soluble_unwanted, & - ! Switch for if prescribed SSA is on - i_ukca_radaer_prescribe_ssa, & - ! Model level of the tropopause - trindxrad_um, & - ! Prescription of single-scattering albedo - ukca_radaer_presc_ssa, & - ! Modal extinction aerosol opt depth - column (output) - aod_ukca_this_mode_um, & - ! Modal extinction aerosol opt depth - stratosphere (output) - sod_ukca_this_mode_um, & - ! Modal absorption aerosol opt depth (output) - aaod_ukca_this_mode_um, & - ! Fixed array dimensions - npd_profile, & - nlayers, & - n_radaer_mode, & - npd_ukca_aod_wavel ) - !------------------------------------------------ + ! Now calculate aod and aaod for Aitken Insoluble mode if ( .not. associated( aod_ukca_ait_ins, empty_real_data ) ) then do k = 1, npd_ukca_aod_wavel - do i = 1, row_length - aod_ukca_ait_ins( map_aod_wavel(i) + k ) = aod_ukca_this_mode_um(i,k) + do i = 1, seg_size + ii = jj + i - 1 + aod_ukca_ait_ins( map_aod_wavel(1, ii) + k - 1 ) = & + aod_ukca_all_modes_um(i,k,mode_ait_insol-1) end do end do end if if ( .not. associated( aaod_ukca_ait_ins, empty_real_data ) ) then do k = 1, npd_ukca_aod_wavel - do i = 1, row_length - aaod_ukca_ait_ins( map_aod_wavel(i)+k ) = aaod_ukca_this_mode_um(i,k) + do i = 1, seg_size + ii = jj + i - 1 + aaod_ukca_ait_ins( map_aod_wavel(1, ii) + k - 1 ) = & + aaod_ukca_all_modes_um(i,k,mode_ait_insol-1) end do end do end if - end if ! Calculate AOD Aitkin Insoluble mode - - !------------------------------------------------ - ! Now calculate aod and aaod for Accumulation Insoluble mode - - if ( ( .not. associated( aod_ukca_acc_ins, empty_real_data ) ) .or. & - ( .not. associated( aaod_ukca_acc_ins, empty_real_data ) ) ) then - - call ukca_radaer_compute_aod( & - ! Fixed array dimensions (input) - npd_profile, & - nlayers, & - n_ukca_mode, & - n_ukca_cpnt, & - npd_ukca_aod_wavel, & - ! Fixed array Prescribed ssa dimensions (input) - nd_prof_ssa, & - nd_layr_ssa, & - nd_band_ssa, & - ! UKCA_RADAER structure (input) - nmodes, & - ncp_max, & - ncp_max_x_nmodes, & - i_cpnt_index, & - i_cpnt_type, & - n_cpnt_in_mode, & - l_nitrate, & - l_soluble, & - l_sustrat, & - i_mode_type, & - l_cornarrow_ins, & - ! Modal diameters from UKCA module - ukca_dry_diam_um, & - ukca_wet_diam_um, & - ! Mass thickness of layers - d_mass_theta_levels_um, & - ! Component volumes - ukca_comp_vol_um, & - ! Modal volumes, densities, and water content - ukca_modal_vol_um, & - ukca_modal_rho_um, & - ukca_modal_wtv_um, & - ! Modal mass-mixing ratios - ukca_mode_mix_ratio_um, & - ! Modal number concentrations - ukca_modal_number_um, & - ! Type selection - ip_ukca_mode_accum, & - soluble_unwanted, & - ! Switch for if prescribed SSA is on - i_ukca_radaer_prescribe_ssa, & - ! Model level of the tropopause - trindxrad_um, & - ! Prescription of single-scattering albedo - ukca_radaer_presc_ssa, & - ! Modal extinction aerosol opt depth - column (output) - aod_ukca_this_mode_um, & - ! Modal extinction aerosol opt depth - stratosphere (output) - sod_ukca_this_mode_um, & - ! Modal absorption aerosol opt depth (output) - aaod_ukca_this_mode_um, & - ! Fixed array dimensions - npd_profile, & - nlayers, & - n_radaer_mode, & - npd_ukca_aod_wavel ) - !------------------------------------------------ + ! Now calculate aod and aaod for Accumulation Insoluble mode if ( .not. associated( aod_ukca_acc_ins, empty_real_data ) ) then do k = 1, npd_ukca_aod_wavel - do i = 1, row_length - aod_ukca_acc_ins( map_aod_wavel(i) + k ) = aod_ukca_this_mode_um(i,k) + do i = 1, seg_size + ii = jj + i - 1 + aod_ukca_acc_ins( map_aod_wavel(1, ii) + k - 1 ) = & + aod_ukca_all_modes_um(i,k,mode_acc_insol-1) end do end do end if if ( .not. associated( aaod_ukca_acc_ins, empty_real_data ) ) then do k = 1, npd_ukca_aod_wavel - do i = 1, row_length - aaod_ukca_acc_ins( map_aod_wavel(i)+k ) = aaod_ukca_this_mode_um(i,k) + do i = 1, seg_size + ii = jj + i - 1 + aaod_ukca_acc_ins( map_aod_wavel(1, ii) + k - 1 ) = & + aaod_ukca_all_modes_um(i,k,mode_acc_insol-1) end do end do end if - end if ! Calculate AOD Accumulation Insoluble mode - - !------------------------------------------------ - ! Now calculate aod and aaod for Coarse Insoluble mode - - if ( ( .not. associated( aod_ukca_cor_ins, empty_real_data ) ) .or. & - ( .not. associated( aaod_ukca_cor_ins, empty_real_data ) ) ) then - - call ukca_radaer_compute_aod( & - ! Fixed array dimensions (input) - npd_profile, & - nlayers, & - n_ukca_mode, & - n_ukca_cpnt, & - npd_ukca_aod_wavel, & - ! Fixed array Prescribed ssa dimensions (input) - nd_prof_ssa, & - nd_layr_ssa, & - nd_band_ssa, & - ! UKCA_RADAER structure (input) - nmodes, & - ncp_max, & - ncp_max_x_nmodes, & - i_cpnt_index, & - i_cpnt_type, & - n_cpnt_in_mode, & - l_nitrate, & - l_soluble, & - l_sustrat, & - i_mode_type, & - l_cornarrow_ins, & - ! Modal diameters from UKCA module - ukca_dry_diam_um, & - ukca_wet_diam_um, & - ! Mass thickness of layers - d_mass_theta_levels_um, & - ! Component volumes - ukca_comp_vol_um, & - ! Modal volumes, densities, and water content - ukca_modal_vol_um, & - ukca_modal_rho_um, & - ukca_modal_wtv_um, & - ! Modal mass-mixing ratios - ukca_mode_mix_ratio_um, & - ! Modal number concentrations - ukca_modal_number_um, & - ! Type selection - ip_ukca_mode_coarse, & - soluble_unwanted, & - ! Switch for if prescribed SSA is on - i_ukca_radaer_prescribe_ssa, & - ! Model level of the tropopause - trindxrad_um, & - ! Prescription of single-scattering albedo - ukca_radaer_presc_ssa, & - ! Modal extinction aerosol opt depth - column (output) - aod_ukca_this_mode_um, & - ! Modal extinction aerosol opt depth - stratosphere (output) - sod_ukca_this_mode_um, & - ! Modal absorption aerosol opt depth (output) - aaod_ukca_this_mode_um, & - ! Fixed array dimensions - npd_profile, & - nlayers, & - n_radaer_mode, & - npd_ukca_aod_wavel ) - !------------------------------------------------ + ! Now calculate aod and aaod for Coarse Insoluble mode if ( .not. associated( aod_ukca_cor_ins, empty_real_data ) ) then do k = 1, npd_ukca_aod_wavel - do i = 1, row_length - aod_ukca_cor_ins( map_aod_wavel(i) + k ) = aod_ukca_this_mode_um(i,k) + do i = 1, seg_size + ii = jj + i - 1 + aod_ukca_cor_ins( map_aod_wavel(1, ii) + k - 1 ) = & + aod_ukca_all_modes_um(i,k,mode_cor_insol-1) end do end do end if if ( .not. associated( aaod_ukca_cor_ins, empty_real_data ) ) then do k = 1, npd_ukca_aod_wavel - do i = 1, row_length - aaod_ukca_cor_ins( map_aod_wavel(i)+k ) = aaod_ukca_this_mode_um(i,k) + do i = 1, seg_size + ii = jj + i - 1 + aaod_ukca_cor_ins( map_aod_wavel(1, ii) + k - 1 ) = & + aaod_ukca_all_modes_um(i,k,mode_cor_insol-1) end do end do end if - end if ! Calculate AOD Coarse Insoluble mode + !------------------------------------------------ + + end do ! Segmentation loop +!$OMP end do + +!$OMP end PARALLEL !------------------------------------------------ + deallocate( aaod_ukca_all_modes_um ) + deallocate( sod_ukca_all_modes_um ) + deallocate( aod_ukca_all_modes_um ) + + deallocate( aer_sw_asymmetry_um ) + deallocate( aer_sw_scattering_um ) + deallocate( aer_sw_absorption_um ) + deallocate( aer_lw_asymmetry_um ) + deallocate( aer_lw_scattering_um ) + deallocate( aer_lw_absorption_um ) + + deallocate( ukca_mode_mix_ratio_um ) + + deallocate( ukca_modal_wtv_um ) + deallocate( ukca_modal_vol_um ) + deallocate( ukca_modal_rho_um ) + deallocate( ukca_modal_nbr_um ) + deallocate( ukca_wet_diam_um ) + deallocate( ukca_dry_diam_um ) + + deallocate( ukca_mix_ratio_um ) + deallocate( ukca_comp_vol_um ) + + deallocate( d_mass_theta_levels_um ) + deallocate( t_theta_levels_um ) + deallocate( p_theta_levels_um ) + + deallocate( trindxrad_um ) + end subroutine radaer_code end module radaer_kernel_mod diff --git a/rose-stem/app/lfric_coupled/file/mydef.xml b/rose-stem/app/lfric_coupled/file/mydef.xml index 6658c2d6..80753515 100644 --- a/rose-stem/app/lfric_coupled/file/mydef.xml +++ b/rose-stem/app/lfric_coupled/file/mydef.xml @@ -140,6 +140,18 @@ + + + + + + + + + + + +